diff --git a/programs/develop/oberon07/Compiler b/programs/develop/oberon07/Compiler new file mode 100644 index 0000000000..972db287b9 Binary files /dev/null and b/programs/develop/oberon07/Compiler differ diff --git a/programs/develop/oberon07/Compiler.exe b/programs/develop/oberon07/Compiler.exe new file mode 100644 index 0000000000..7697d9f187 Binary files /dev/null and b/programs/develop/oberon07/Compiler.exe differ diff --git a/programs/develop/oberon07/Compiler.kex b/programs/develop/oberon07/Compiler.kex index 2720d5973e..55b5adbcf0 100644 Binary files a/programs/develop/oberon07/Compiler.kex and b/programs/develop/oberon07/Compiler.kex differ diff --git a/programs/develop/oberon07/Docs/About1251.txt b/programs/develop/oberon07/Docs/About1251.txt deleted file mode 100644 index 3fe358fe05..0000000000 --- a/programs/develop/oberon07/Docs/About1251.txt +++ /dev/null @@ -1,390 +0,0 @@ - Oberon-07/16 i486 - Windows/Linux/KolibriOS. ------------------------------------------------------------------------------- - - - - - ".ob07", ANSI -UTF-8 BOM-. - - PE32, ELF MENUET01/MSCOFF. - : - 1) - 2) - "console" - Windows console - "gui" - Windows GUI - "dll" - Windows DLL - "kos" - KolibriOS - "obj" - KolibriOS DLL - "elfexe" - Linux ELF-EXEC - "elfso" - Linux ELF-SO - 3) - - -out ; , - , - ( ) - -stk ( 2 , - 1 32 ) - -nochk <"ptibcwra"> (. ) - -ver ( obj) - - -nochk : - "p" - - "t" - - "i" - - "b" - INTEGER BYTE - "c" - CHR - "w" - WCHR - "r" - "bcw" - "a" - - - . - . - - : -nochk it - . - -nochk a - . - - : - - Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -stk 1 - Compiler.exe "C:\example.ob07" dll -out "C:\example.dll" - Compiler.exe "C:\example.ob07" gui -out "C:\example.exe" -stk 4 - Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -nochk pti - Compiler.kex "/tmp0/1/example.ob07" kos -out "/tmp0/1/example.kex" -stk 4 - Compiler.kex "/tmp0/1/example.ob07" obj -out "/tmp0/1/example.obj" -ver 2.7 - Compiler.exe "C:\example.ob07" elfexe -out "C:\example" -stk 1 -nochk a - - , 0, 1. - KolibriOS, . - ------------------------------------------------------------------------------- - - -1. SYSTEM -2. "_" -3. -4. CASE ( - ELSE) -5. -6. / -7. DIV MOD -8. ( "//") -9. - -10. -11. "" : '' -12. WCHAR - ------------------------------------------------------------------------------- - - -1. - - , - - INTEGER -2147483648 .. 2147483647 4 - REAL 4.94E-324 .. 1.70E+308 8 - CHAR ASCII (0X .. 0FFX) 1 - BOOLEAN FALSE, TRUE 1 - SET {0 .. 31} 4 - BYTE 0 .. 255 1 - WCHAR (0X .. 0FFFFX) 2 - -2. - 1024 -3. - 1024 (UTF-8) -4. - 5 -5. NEW -6. -7. Oberon-, - -8. BYTE INTEGER -9. -10. : - - - ASSERT(x), x = FALSE - - - - 0 - - - - - - - - CASE - - v := x, LEN(v) < LEN(x) - - x:INTEGER v:BYTE, (x < 0) OR (x > 255) - - CHR(x), (x < 0) OR (x > 255) - - WCHR(x), (x < 0) OR (x > 65535) - ------------------------------------------------------------------------------- - SYSTEM - - SYSTEM , - SYSTEM - . - - PROCEDURE ADR(v: ): INTEGER - v - ; - v - - PROCEDURE SADR(x: (CHAR UTF-8)): INTEGER - x - - PROCEDURE WSADR(x: (WCHAR)): INTEGER - x - - PROCEDURE SIZE(T): INTEGER - T - - PROCEDURE TYPEID(T): INTEGER - T - - -, - - - - PROCEDURE INF(): REAL - "" - - PROCEDURE GET(a: INTEGER; - VAR v: , PROCEDURE, POINTER) - v := [a] - - PROCEDURE PUT(a: INTEGER; x: , PROCEDURE, POINTER) - [a] := x; - x: BYTE x: WCHAR, x - 32 , SYSTEM.PUT8, - WCHAR -- SYSTEM.PUT16 - - PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) - [a] := 8 (x) - - PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) - [a] := 16 (x) - - PROCEDURE MOVE(Source, Dest, n: INTEGER) - 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(byte1, byte2,... : INTEGER) - , - byte1, byte2 ... - 0..255, - : - SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) - - - SYSTEM . - ------------------------------------------------------------------------------- - - - , - PROCEDURE : [stdcall], -[ccall], [ccall16], [windows], [linux]. : - - PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; - - [ccall16], ccall, - 16 . - [windows] - [stdcall], [linux] - [ccall16]. - "-" ([stdcall-], [linux-], ...) , - ( REAL). - - -, RECORD - [noalign]. [noalign] -. - . - , SYSTEM. - ------------------------------------------------------------------------------- - CASE - - CASE: - - CaseStatement = - CASE Expression OF ase {"|" ase} - [ELSE StatementSequence] END. - Case = [CaseLabelList ":" StatementSequence]. - CaseLabelList = CaseLabels {"," CaseLabels}. - CaseLabels = ConstExpression [".." ConstExpression]. - - : - - CASE x OF - |-1: DoSomething1 - | 1: DoSomething2 - | 0: DoSomething3 - ELSE - DoSomething4 - END - - , ELSE -. x ELSE -, . - ------------------------------------------------------------------------------- - WCHAR - - WCHAR . WCHAR -ARRAY OF WCHAR , CHAR -ARRAY OF CHAR, CHR, - CHAR. WCHAR, - WCHR CHR. , - UTF-8 c BOM. - ------------------------------------------------------------------------------- - - - - p(T) p IS T p = NIL. -Oberon- -. -, FALSE. - . - ------------------------------------------------------------------------------- - - - DISPOSE (VAR v: _) - , NEW - v^, v - NIL. - - COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); - v := x; - LEN(v) < LEN(x), x - - - LSR (x, n: INTEGER): INTEGER - x n . - - MIN (a, b: INTEGER): INTEGER - . - - MAX (a, b: INTEGER): INTEGER - . - - BITS (x: INTEGER): SET - x SET. - . - - LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER - 0X- s, 0X. - 0X , - s. s . - - WCHR (n: INTEGER): WCHAR - , CHR(n: INTEGER): CHAR - ------------------------------------------------------------------------------- - DIV MOD - - x y x DIV y x MOD y - - 5 3 1 2 - -5 3 -2 1 - 5 -3 -2 -1 - -5 -3 1 -2 - ------------------------------------------------------------------------------- - - - : - - PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; - - - callconv -- - - "library" -- - - "function" -- - - : - - PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); - - PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); - - () "END proc_name;" - - - , - "" , - . , : - , . - - - , - : - - VAR - ExitProcess: PROCEDURE [windows] (code: INTEGER); - con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); - - KolibriOS , - /rd/1/lib. - (lib_init, START) . - - Linux, . - ------------------------------------------------------------------------------- - - - , - , . - : - -1. : - PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); - : - Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) -2. - RECORD: - PROCEDURE Proc (VAR x: Rec); - : - Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) - ------------------------------------------------------------------------------- - RTL - - RTL. - ( , , - .) . - , SetDll SetFini - Windows DLL Linux SO, : - - PROCEDURE SetDll - (process_detach, thread_detach, thread_attach: DLL_ENTRY); - TYPE DLL_ENTRY = - PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - -SetDll process_detach, thread_detach, thread_attach - -- dll- (process_detach) -- (thread_attach) -- (thread_detach) - - - PROCEDURE SetFini (ProcFini: PROC); - TYPE PROC = PROCEDURE (* *) - -SetFini ProcFini so-. - - , SetDll SetFini - . - - -(Windows), (Linux), (KolibriOS). - ------------------------------------------------------------------------------- - API - - API ( ). - RTL, API . - RTL . - ------------------------------------------------------------------------------- - DLL - - . , - , - ("*"). KolibriOS DLL "version" -( ) "lib_init" - DLL: - - PROCEDURE [stdcall] lib_init (): INTEGER - - DLL. - 1. \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/About866.txt b/programs/develop/oberon07/Docs/About866.txt deleted file mode 100644 index 55dc8f9e0b..0000000000 --- a/programs/develop/oberon07/Docs/About866.txt +++ /dev/null @@ -1,390 +0,0 @@ - 몠 ணࠬ஢ Oberon-07/16 i486 - Windows/Linux/KolibriOS. ------------------------------------------------------------------------------- - - ࠬ ப - - 室 - ⥪⮢ 䠩 㫥 ७ ".ob07", ஢ ANSI -UTF-8 BOM-ᨣன. - 室 - ᯮ塞 䠩 ଠ PE32, ELF MENUET01/MSCOFF. - ࠬ: - 1) - 2) ⨯ ਫ - "console" - Windows console - "gui" - Windows GUI - "dll" - Windows DLL - "kos" - KolibriOS - "obj" - KolibriOS DLL - "elfexe" - Linux ELF-EXEC - "elfso" - Linux ELF-SO - 3) 易⥫ ࠬ- - -out १饣 䠩; 㬮砭, - ᮢ , 㣨 ७ - (ᮮ⢥ ⨯ ᯮ塞 䠩) - -stk ࠧ ( 㬮砭 2 , - ⨬ 1 32 ) - -nochk <"ptibcwra"> ⪫ ஢ન 믮 (. ) - -ver ணࠬ (⮫쪮 obj) - - ࠬ -nochk ப ᨬ: - "p" - 㪠⥫ - "t" - ⨯ - "i" - - "b" -  ਢ INTEGER BYTE - "c" - 㬥 㭪樨 CHR - "w" - 㬥 㭪樨 WCHR - "r" - ⭮ "bcw" - "a" - ஢ન - - 冷 ᨬ . 稥 ப ⮣ - ᨬ ⪫砥 ᮮ⢥ ஢. - - ਬ: -nochk it - ⪫ ஢ ᮢ ࠭ ⨯. - -nochk a - ⪫ ⪫砥 ஢ન. - - ਬ: - - Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -stk 1 - Compiler.exe "C:\example.ob07" dll -out "C:\example.dll" - Compiler.exe "C:\example.ob07" gui -out "C:\example.exe" -stk 4 - Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -nochk pti - Compiler.kex "/tmp0/1/example.ob07" kos -out "/tmp0/1/example.kex" -stk 4 - Compiler.kex "/tmp0/1/example.ob07" obj -out "/tmp0/1/example.obj" -ver 2.7 - Compiler.exe "C:\example.ob07" elfexe -out "C:\example" -stk 1 -nochk a - - 砥 ᯥ譮 樨, । 襭 0, 1. - ࠡ KolibriOS, 襭 ।. - ------------------------------------------------------------------------------- - ⫨ ਣ - -1. ७ ᥢ SYSTEM -2. 䨪 ᪠ ᨬ "_" -3. ⥬ 䫠 -4. ᮢ襭⢮ CASE ( ⠭ ࠦ - ⪠ ਠ⮢ 易⥫쭠 ⪠ ELSE) -5. ७ ⠭ 楤 -6. ⨪ ࠭/஢ન ⨯ 筥 㫥 㪠⥫ -7. ⨪ DIV MOD 筥 ⥫ ᥫ -8. ਨ (稭 ᨬ "//") -9. 襭 ᫥ ⨯-㪠⥫ -10. ᨭ⠪ 楤 譨 ⥪ -11. "ப" ⠪ 窨: 'ப' -12. ⨯ WCHAR - ------------------------------------------------------------------------------- - ᮡ ॠ樨 - -1. ᭮ ⨯ - - 祭 , - - INTEGER -2147483648 .. 2147483647 4 - REAL 4.94E-324 .. 1.70E+308 8 - CHAR ᨬ ASCII (0X .. 0FFX) 1 - BOOLEAN FALSE, TRUE 1 - SET ⢮ 楫 ᥫ {0 .. 31} 4 - BYTE 0 .. 255 1 - WCHAR ᨬ  (0X .. 0FFFFX) 2 - -2. ᨬ쭠 䨪஢ - 1024 ᨬ -3. ᨬ쭠 ப ⠭ - 1024 ᨬ (UTF-8) -4. ᨬ쭠 ࠧ୮ ᨢ - 5 -5. 楤 NEW ﬨ 뤥 -6. ६ 樠 ﬨ -7. ⫨稥 Oberon-ॠ権, ᡮ騪 ᪠ - 쭮 -8. BYTE ࠦ ᥣ ਢ INTEGER -9. ஫ ९ 祭 ࠦ ந -10. 訡 ६ 믮: - - - ASSERT(x), x = FALSE - - ࠧ묥 㫥 㪠⥫ - - 楫᫥ 0 - - 맮 楤 १ 楤 ६ 㫥 祭 - - 訡 ࠭ ⨯ - - 襭 ࠭ ᨢ - - ।ᬮ७ 祭 ࠦ CASE - - 訡 ஢ ᨢ v := x, ᫨ LEN(v) < LEN(x) - -  ਢ x:INTEGER v:BYTE, ᫨ (x < 0) OR (x > 255) - - CHR(x), ᫨ (x < 0) OR (x > 255) - - WCHR(x), ᫨ (x < 0) OR (x > 65535) - ------------------------------------------------------------------------------- - ᥢ SYSTEM - - ᥢ SYSTEM ᮤন ஢ 楤, -訡 ᯮ짮 楤 ᥢ SYSTEM ਢ -० ६ 믮 ਩ 襭 ணࠬ. - - PROCEDURE ADR(v:  ⨯): INTEGER - v - ६ 楤; - 頥 v - - PROCEDURE SADR(x: ப ⠭ (CHAR UTF-8)): INTEGER - 頥 x - - PROCEDURE WSADR(x: ப ⠭ (WCHAR)): INTEGER - 頥 x - - PROCEDURE SIZE(T): INTEGER - 頥 ࠧ ⨯ T - - PROCEDURE TYPEID(T): INTEGER - T - ⨯- ⨯-㪠⥫, - 頥 ⨯ ⠡ ⨯-ᥩ - - PROCEDURE INF(): REAL - 頥 ᯥ樠쭮 ⢥ 祭 "᪮筮" - - PROCEDURE GET(a: INTEGER; - VAR v:  ᭮ ⨯, PROCEDURE, POINTER) - v := [a] - - PROCEDURE PUT(a: INTEGER; x:  ᭮ ⨯, PROCEDURE, POINTER) - [a] := x; - ᫨ x: BYTE x: WCHAR, 祭 x 㤥 ७ - 32 , ⮢ ᯮ짮 SYSTEM.PUT8, - WCHAR -- SYSTEM.PUT16 - - PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) - [a] := 訥 8 (x) - - PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) - [a] := 訥 16 (x) - - PROCEDURE MOVE(Source, Dest, n: INTEGER) - 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(byte1, byte2,... : INTEGER) - ⠢ 設 , - byte1, byte2 ... - ⠭ 0..255, - ਬ: - SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) - - - 㭪樨 ᥢ SYSTEM ᯮ짮 ⠭ ࠦ. - ------------------------------------------------------------------------------- - ⥬ 䫠 - -  楤 ⨯ 楤, ᫥ 祢 -᫮ PROCEDURE 㪠 䫠 ᮣ襭 맮: [stdcall], -[ccall], [ccall16], [windows], [linux]. ਬ: - - PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; - - ᫨ 㪠 䫠 [ccall16], ਭ ᮣ襭 ccall, । -맮 㪠⥫ 㤥 ࠢ ࠭ 16 . - [windows] - ᨭ [stdcall], [linux] - ᨭ [ccall16]. - "-" ᫥ 䫠 ([stdcall-], [linux-], ...) 砥, -१ 楤 ஢ ( ᪠ ⨯ REAL). - -  ⨯-ᥩ, ᫥ 祢 ᫮ RECORD -㪠 䫠 [noalign]. [noalign] 砥 ⢨ ࠢ -. ⥬ 䫠 ⨯ -묨 ⨯ 㣨 ᥩ. - ᯮ짮 ⥬ 䫠, ॡ ஢ SYSTEM. - ------------------------------------------------------------------------------- - CASE - - ⠪ CASE: - - CaseStatement = - CASE Expression OF ase {"|" ase} - [ELSE StatementSequence] END. - Case = [CaseLabelList ":" StatementSequence]. - CaseLabelList = CaseLabels {"," CaseLabels}. - CaseLabels = ConstExpression [".." ConstExpression]. - - ਬ: - - CASE x OF - |-1: DoSomething1 - | 1: DoSomething2 - | 0: DoSomething3 - ELSE - DoSomething4 - END - - ⪠ ਠ⮢ ᯮ짮 ⠭ ࠦ, ⪠ ELSE -易⥫쭠. ᫨ 祭 x ᮮ⢥ ਠ ELSE -, ணࠬ 뢠 訡 ६ 믮. - ------------------------------------------------------------------------------- - WCHAR - - WCHAR 㤮 . ⨯ WCHAR -ARRAY OF WCHAR ᪠ 樨, ⨯ CHAR -ARRAY OF CHAR, ᪫祭 ஥ 楤 CHR, 頥 -⮫쪮 ⨯ CHAR. 祭 祭 ⨯ WCHAR, ᫥ ᯮ짮 -楤 WCHR CHR. ࠢ쭮 ࠡ ⨯, 室 ࠭ -室 ஢ UTF-8 c BOM. - ------------------------------------------------------------------------------- - ஢ઠ ࠭ ⨯ 㫥 㪠⥫ - - ਣ쭮 ᮮ饭 몥 । ணࠬ -믮 ࠭ p(T) ஢ન ⨯ p IS T p = NIL. -Oberon-ॠ 믮 ⠪ 樨 ਢ 訡 ६ -믮. ॠ樨 ࠭ ⨯ 㫥 㪠⥫ ਢ -訡, ஢ઠ ⨯ १ FALSE. 拉 砥 -⥫쭮 ᮪ ਬ ࠭ ⨯. - ------------------------------------------------------------------------------- - ⥫ ⠭ 楤 - - DISPOSE (VAR v: _㪠⥫) - ᢮ , 뤥 楤ன NEW - ᪮ ६ v^, ᢠ ६ v - 祭 NIL. - - COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); - v := x; - ᫨ LEN(v) < LEN(x), ப x 㤥 ᪮஢ - - - LSR (x, n: INTEGER): INTEGER - ᪨ ᤢ x n ࠢ. - - MIN (a, b: INTEGER): INTEGER - 祭. - - MAX (a, b: INTEGER): INTEGER - ᨬ 祭. - - BITS (x: INTEGER): SET - x 祭 ⨯ SET. - 믮 ⠯ 樨. - - LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER - 0X-襭 ப s, ᨬ 0X. - ᫨ ᨬ 0X , 㭪 頥 - ᨢ s. s ⠭⮩. - - WCHR (n: INTEGER): WCHAR - ८ࠧ ⨯, 筮 CHR(n: INTEGER): CHAR - ------------------------------------------------------------------------------- - DIV MOD - - x y x DIV y x MOD y - - 5 3 1 2 - -5 3 -2 1 - 5 -3 -2 -1 - -5 -3 1 -2 - ------------------------------------------------------------------------------- - ஢ 楤 - - ⠪ : - - PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; - - - callconv -- ᮣ襭 맮 - - "library" -- 䠩 ᪮ ⥪ - - "function" -- 㥬 楤 - - ਬ: - - PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); - - PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); - -  (易⥫쭮) "END proc_name;" - -  ஢ 楤 ᯮ 쭮 - ᫥  ६,  - "" 楤, ஢ ⫨ ⮫쪮 ⢨ - ⥫ 楤. ⠫쭮, ⠪ 楤ࠬ ਬ ࠢ: - 맢, ᢮ 楤୮ ६ . - - ஢ 楤 ᥣ  㪠 ᮣ襭 - 맮, ᮢ⨬ 楤 ⨯ ⮦  㪠 - ᮣ襭 맮: - - VAR - ExitProcess: PROCEDURE [windows] (code: INTEGER); - con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); - - KolibriOS ஢ 楤 ⮫쪮 ⥪, ࠧ饭 - /rd/1/lib. ஢ 뢠 㭪樨 樠樨 ⥪ - (lib_init, START) ⮬ 㦭. - - Linux, ஢ 楤 ॠ. - ------------------------------------------------------------------------------- - ࠬ 楤 - - 楤 ࠬ, ᯨ᪥ -ଠ ࠬ஢, 뢠 ஬ ࠭樨 맮. - ᫥ : - -1. 楤 ଠ ࠬ ᨢ: - PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); - 맮 ࠭᫨ ⠪: - Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) -2. 楤 ଠ ࠬ-६ ⨯ RECORD: - PROCEDURE Proc (VAR x: Rec); - 맮 ࠭᫨ ⠪: - Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) - ------------------------------------------------------------------------------- - RTL - - ணࠬ  ᯮ RTL. ࠭᫨ - 樨 (஢ઠ ࠭ ⨯, ࠢ ப, ᮮ饭 -訡 ६ 믮 .) 맮 楤 ⮣ . -᫥  뢠 楤, ᪫祭 楤 SetDll SetFini -᫨ ਫ Windows DLL Linux SO, ᮮ⢥⢥: - - PROCEDURE SetDll - (process_detach, thread_detach, thread_attach: DLL_ENTRY); - TYPE DLL_ENTRY = - PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - -SetDll 砥 楤 process_detach, thread_detach, thread_attach -뢠묨 -- 㧪 dll-⥪ (process_detach) -- ᮧ ⮪ (thread_attach) -- 㭨⮦ ⮪ (thread_detach) - - - PROCEDURE SetFini (ProcFini: PROC); - TYPE PROC = PROCEDURE (* ࠬ஢ *) - -SetFini 砥 楤 ProcFini 뢠 㧪 so-⥪. - - ⨯ ਫ, 맮 楤 SetDll SetFini - ணࠬ. - - 饭 訡 ६ 믮 뢮 -(Windows), ନ (Linux), ⫠ (KolibriOS). - ------------------------------------------------------------------------------- - API - - ᪮쪮 ॠ権 API ( ࠧ ). - RTL, API ।祭 אַ ᯮ짮. - ᯥ稢 RTL . - ------------------------------------------------------------------------------- - ᯮ塞 䠩 DLL - - 蠥 ᯮ஢ ⮫쪮 楤. ⮣, 楤 -室 㫥 ணࠬ, ⬥祭 ᨬ -ᯮ ("*"). KolibriOS DLL ᥣ ᯮ 䨪 "version" -( ணࠬ) "lib_init" - 楤 樠樨 DLL: - - PROCEDURE [stdcall] lib_init (): INTEGER - - 楤 맢 । ᯮ짮 DLL. -楤 ᥣ 頥 1. \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/KOSLib.txt b/programs/develop/oberon07/Docs/KOSLib.txt new file mode 100644 index 0000000000..01364faf9e --- /dev/null +++ b/programs/develop/oberon07/Docs/KOSLib.txt @@ -0,0 +1,566 @@ +============================================================================== + + Библиотека (KolibriOS) + +------------------------------------------------------------------------------ +MODULE Out - консольный вывод + + PROCEDURE Open + формально открывает консольный вывод + + PROCEDURE Int(x, width: INTEGER) + вывод целого числа x; + width - количество знакомест, используемых для вывода + + PROCEDURE Real(x: REAL; width: INTEGER) + вывод вещественного числа x в плавающем формате; + width - количество знакомест, используемых для вывода + + PROCEDURE Char(x: CHAR) + вывод символа x + + PROCEDURE FixReal(x: REAL; width, p: INTEGER) + вывод вещественного числа x в фиксированном формате; + width - количество знакомест, используемых для вывода; + p - количество знаков после десятичной точки + + PROCEDURE Ln + переход на следующую строку + + PROCEDURE String(s: ARRAY OF CHAR) + вывод строки s + +------------------------------------------------------------------------------ +MODULE In - консольный ввод + + VAR Done: BOOLEAN + принимает значение TRUE в случае успешного выполнения + операции ввода, иначе FALSE + + PROCEDURE Open + формально открывает консольный ввод, + также присваивает переменной Done значение TRUE + + PROCEDURE Int(VAR x: INTEGER) + ввод числа типа INTEGER + + PROCEDURE Char(VAR x: CHAR) + ввод символа + + PROCEDURE Real(VAR x: REAL) + ввод числа типа REAL + + PROCEDURE String(VAR s: ARRAY OF CHAR) + ввод строки + + PROCEDURE Ln + ожидание нажатия ENTER + +------------------------------------------------------------------------------ +MODULE Console - дополнительные процедуры консольного вывода + + CONST + + Следующие константы определяют цвет консольного вывода + + Black = 0 Blue = 1 Green = 2 + Cyan = 3 Red = 4 Magenta = 5 + Brown = 6 LightGray = 7 DarkGray = 8 + LightBlue = 9 LightGreen = 10 LightCyan = 11 + LightRed = 12 LightMagenta = 13 Yellow = 14 + White = 15 + + PROCEDURE Cls + очистка окна консоли + + PROCEDURE SetColor(FColor, BColor: INTEGER) + установка цвета консольного вывода: FColor - цвет текста, + BColor - цвет фона, возможные значения - вышеперечисленные + константы + + PROCEDURE SetCursor(x, y: INTEGER) + установка курсора консоли в позицию (x, y) + + PROCEDURE GetCursor(VAR x, y: INTEGER) + записывает в параметры текущие координаты курсора консоли + + PROCEDURE GetCursorX(): INTEGER + возвращает текущую x-координату курсора консоли + + PROCEDURE GetCursorY(): INTEGER + возвращает текущую y-координату курсора консоли + +------------------------------------------------------------------------------ +MODULE ConsoleLib - обертка библиотеки console.obj + +------------------------------------------------------------------------------ +MODULE Math - математические функции + + CONST + + pi = 3.141592653589793E+00 + e = 2.718281828459045E+00 + + + PROCEDURE IsNan(x: REAL): BOOLEAN + возвращает TRUE, если x - не число + + PROCEDURE IsInf(x: REAL): BOOLEAN + возвращает TRUE, если x - бесконечность + + PROCEDURE sqrt(x: REAL): REAL + квадратный корень x + + PROCEDURE exp(x: REAL): REAL + экспонента x + + PROCEDURE ln(x: REAL): REAL + натуральный логарифм x + + PROCEDURE sin(x: REAL): REAL + синус x + + PROCEDURE cos(x: REAL): REAL + косинус x + + PROCEDURE tan(x: REAL): REAL + тангенс x + + PROCEDURE arcsin(x: REAL): REAL + арксинус x + + PROCEDURE arccos(x: REAL): REAL + арккосинус x + + PROCEDURE arctan(x: REAL): REAL + арктангенс x + + PROCEDURE arctan2(y, x: REAL): REAL + арктангенс y/x + + PROCEDURE power(base, exponent: REAL): REAL + возведение числа base в степень exponent + + PROCEDURE log(base, x: REAL): REAL + логарифм x по основанию base + + PROCEDURE sinh(x: REAL): REAL + гиперболический синус x + + PROCEDURE cosh(x: REAL): REAL + гиперболический косинус x + + PROCEDURE tanh(x: REAL): REAL + гиперболический тангенс x + + PROCEDURE arsinh(x: REAL): REAL + обратный гиперболический синус x + + PROCEDURE arcosh(x: REAL): REAL + обратный гиперболический косинус x + + PROCEDURE artanh(x: REAL): REAL + обратный гиперболический тангенс x + + PROCEDURE round(x: REAL): REAL + округление x до ближайшего целого + + PROCEDURE frac(x: REAL): REAL; + дробная часть числа x + + PROCEDURE floor(x: REAL): REAL + наибольшее целое число (представление как REAL), + не больше x: floor(1.2) = 1.0 + + PROCEDURE ceil(x: REAL): REAL + наименьшее целое число (представление как REAL), + не меньше x: ceil(1.2) = 2.0 + + PROCEDURE sgn(x: REAL): INTEGER + если x > 0 возвращает 1 + если x < 0 возвращает -1 + если x = 0 возвращает 0 + + PROCEDURE fact(n: INTEGER): REAL + факториал n + +------------------------------------------------------------------------------ +MODULE Debug - вывод на доску отладки + Интерфейс как модуль Out + + PROCEDURE Open + открывает доску отладки + +------------------------------------------------------------------------------ +MODULE File - работа с файловой системой + + TYPE + + FNAME = ARRAY 520 OF CHAR + + FS = POINTER TO rFS + + rFS = RECORD (* информационная структура файла *) + subfunc, pos, hpos, bytes, buffer: INTEGER; + name: FNAME + END + + FD = POINTER TO rFD + + rFD = RECORD (* структура блока данных входа каталога *) + attr: INTEGER; + ntyp: CHAR; + reserved: ARRAY 3 OF CHAR; + time_create, date_create, + time_access, date_access, + time_modif, date_modif, + size, hsize: INTEGER; + name: FNAME + END + + CONST + + SEEK_BEG = 0 + SEEK_CUR = 1 + SEEK_END = 2 + + PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; + Загружает в память файл с именем FName, записывает в параметр + size размер файла, возвращает адрес загруженного файла + или 0 (ошибка). При необходимости, распаковывает + файл (kunpack). + + PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN + Записывает структуру блока данных входа каталога для файла + или папки с именем FName в параметр Info. + При ошибке возвращает FALSE. + + PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если файл с именем FName существует + + PROCEDURE Close(VAR F: FS) + освобождает память, выделенную для информационной структуры + файла F и присваивает F значение NIL + + PROCEDURE Open(FName: ARRAY OF CHAR): FS + возвращает указатель на информационную структуру файла с + именем FName, при ошибке возвращает NIL + + PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN + удаляет файл с именем FName, при ошибке возвращает FALSE + + PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER + устанавливает позицию чтения-записи файла F на Offset, + относительно Origin = (SEEK_BEG - начало файла, + SEEK_CUR - текущая позиция, SEEK_END - конец файла), + возвращает позицию относительно начала файла, например: + Seek(F, 0, SEEK_END) + устанавливает позицию на конец файла и возвращает длину + файла; при ошибке возвращает -1 + + PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER + Читает данные из файла в память. F - указатель на + информационную структуру файла, Buffer - адрес области + памяти, Count - количество байт, которое требуется прочитать + из файла; возвращает количество байт, которое было прочитано + и соответствующим образом изменяет позицию чтения/записи в + информационной структуре F. + + PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER + Записывает данные из памяти в файл. F - указатель на + информационную структуру файла, Buffer - адрес области + памяти, Count - количество байт, которое требуется записать + в файл; возвращает количество байт, которое было записано и + соответствующим образом изменяет позицию чтения/записи в + информационной структуре F. + + PROCEDURE Create(FName: ARRAY OF CHAR): FS + создает новый файл с именем FName (полное имя), возвращает + указатель на информационную структуру файла, + при ошибке возвращает NIL + + PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN + создает папку с именем DirName, все промежуточные папки + должны существовать, при ошибке возвращает FALSE + + PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN + удаляет пустую папку с именем DirName, + при ошибке возвращает FALSE + + PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если папка с именем DirName существует + +------------------------------------------------------------------------------ +MODULE Read - чтение основных типов данных из файла F + + Процедуры возвращают TRUE в случае успешной операции чтения и + соответствующим образом изменяют позицию чтения/записи в + информационной структуре F + + PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN + + PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN + + PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN + + PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN + + PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN + + PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN + +------------------------------------------------------------------------------ +MODULE Write - запись основных типов данных в файл F + + Процедуры возвращают TRUE в случае успешной операции записи и + соответствующим образом изменяют позицию чтения/записи в + информационной структуре F + + PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN + + PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN + + PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN + + PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN + + PROCEDURE Set(F: File.FS; x: SET): BOOLEAN + + PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN + +------------------------------------------------------------------------------ +MODULE DateTime - дата, время + + CONST ERR = -7.0E5 + + PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) + записывает в параметры компоненты текущей системной даты и + времени + + PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL + возвращает дату, полученную из компонентов + Year, Month, Day, Hour, Min, Sec; + при ошибке возвращает константу ERR = -7.0E5 + + PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, + Hour, Min, Sec: INTEGER): BOOLEAN + извлекает компоненты + Year, Month, Day, Hour, Min, Sec из даты Date; + при ошибке возвращает FALSE + +------------------------------------------------------------------------------ +MODULE Args - параметры программы + + VAR argc: INTEGER + количество параметров программы, включая имя + исполняемого файла + + PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) + записывает в строку s n-й параметр программы, + нумерация параметров от 0 до argc - 1, + нулевой параметр -- имя исполняемого файла + +------------------------------------------------------------------------------ +MODULE KOSAPI + + PROCEDURE sysfunc1(arg1: INTEGER): INTEGER + PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER + ... + PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER + Обертки для функций API ядра KolibriOS. + arg1 .. arg7 соответствуют регистрам + eax, ebx, ecx, edx, esi, edi, ebp; + возвращают значение регистра eax после системного вызова. + + PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER + Обертка для функций API ядра KolibriOS. + arg1 - регистр eax, arg2 - регистр ebx, + res2 - значение регистра ebx после системного вызова; + возвращает значение регистра eax после системного вызова. + + PROCEDURE malloc(size: INTEGER): INTEGER + Выделяет блок памяти. + size - размер блока в байтах, + возвращает адрес выделенного блока + + PROCEDURE free(ptr: INTEGER): INTEGER + Освобождает ранее выделенный блок памяти с адресом ptr, + возвращает 0 + + PROCEDURE realloc(ptr, size: INTEGER): INTEGER + Перераспределяет блок памяти, + ptr - адрес ранее выделенного блока, + size - новый размер, + возвращает указатель на перераспределенный блок, + 0 при ошибке + + PROCEDURE GetCommandLine(): INTEGER + Возвращает адрес строки параметров + + PROCEDURE GetName(): INTEGER + Возвращает адрес строки с именем программы + + PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER + Загружает DLL с полным именем name. Возвращает адрес таблицы + экспорта. При ошибке возвращает 0. + + PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER + name - имя процедуры + lib - адрес таблицы экспорта DLL + Возвращает адрес процедуры. При ошибке возвращает 0. + +------------------------------------------------------------------------------ +MODULE ColorDlg - работа с диалогом "Color Dialog" + + TYPE + + Dialog = POINTER TO RECORD (* структура диалога *) + status: INTEGER (* состояние диалога: + 0 - пользователь нажал Cancel + 1 - пользователь нажал OK + 2 - диалог открыт *) + + color: INTEGER (* выбранный цвет *) + END + + PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog + создать диалог + draw_window - процедура перерисовки основного окна + (TYPE DRAW_WINDOW = PROCEDURE); + процедура возвращает указатель на структуру диалога + + PROCEDURE Show(cd: Dialog) + показать диалог + cd - указатель на структуру диалога, который был создан ранее + процедурой Create + + PROCEDURE Destroy(VAR cd: Dialog) + уничтожить диалог + cd - указатель на структуру диалога + +------------------------------------------------------------------------------ +MODULE OpenDlg - работа с диалогом "Open Dialog" + + TYPE + + Dialog = POINTER TO RECORD (* структура диалога *) + status: INTEGER (* состояние диалога: + 0 - пользователь нажал Cancel + 1 - пользователь нажал OK + 2 - диалог открыт *) + + FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *) + FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного + файла *) + END + + PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, + filter: ARRAY OF CHAR): Dialog + создать диалог + draw_window - процедура перерисовки основного окна + (TYPE DRAW_WINDOW = PROCEDURE) + type - тип диалога + 0 - открыть + 1 - сохранить + 2 - выбрать папку + def_path - путь по умолчанию, папка def_path будет открыта + при первом запуске диалога + filter - в строке записано перечисление расширений файлов, + которые будут показаны в диалоговом окне, расширения + разделяются символом "|", например: "ASM|TXT|INI" + процедура возвращает указатель на структуру диалога + + PROCEDURE Show(od: Dialog; Width, Height: INTEGER) + показать диалог + od - указатель на структуру диалога, который был создан ранее + процедурой Create + Width и Height - ширина и высота диалогового окна + + PROCEDURE Destroy(VAR od: Dialog) + уничтожить диалог + od - указатель на структуру диалога + +------------------------------------------------------------------------------ +MODULE kfonts - работа с kf-шрифтами + + CONST + + bold = 1 + italic = 2 + underline = 4 + strike_through = 8 + smoothing = 16 + bpp32 = 32 + + TYPE + + TFont = POINTER TO TFont_desc (* указатель на шрифт *) + + PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont + загрузить шрифт из файла + file_name имя kf-файла + рез-т: указатель на шрифт/NIL (ошибка) + + PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN + установить размер шрифта + Font указатель на шрифт + font_size размер шрифта + рез-т: TRUE/FALSE (ошибка) + + PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN + проверить, есть ли шрифт, заданного размера + Font указатель на шрифт + font_size размер шрифта + рез-т: TRUE/FALSE (шрифта нет) + + PROCEDURE Destroy(VAR Font: TFont) + выгрузить шрифт, освободить динамическую память + Font указатель на шрифт + Присваивает переменной Font значение NIL + + PROCEDURE TextHeight(Font: TFont): INTEGER + получить высоту строки текста + Font указатель на шрифт + рез-т: высота строки текста в пикселях + + PROCEDURE TextWidth(Font: TFont; + str, length, params: INTEGER): INTEGER + получить ширину строки текста + Font указатель на шрифт + str адрес строки текста в кодировке Win-1251 + length количество символов в строке или -1, если строка + завершается нулем + params параметры-флаги см. ниже + рез-т: ширина строки текста в пикселях + + PROCEDURE TextOut(Font: TFont; + canvas, x, y, str, length, color, params: INTEGER) + вывести текст в буфер + для вывода буфера в окно, использовать ф.65 или + ф.7 (если буфер 24-битный) + Font указатель на шрифт + canvas адрес графического буфера + структура буфера: + Xsize dd + Ysize dd + picture rb Xsize * Ysize * 4 (32 бита) + или Xsize * Ysize * 3 (24 бита) + x, y координаты текста относительно левого верхнего + угла буфера + str адрес строки текста в кодировке Win-1251 + length количество символов в строке или -1, если строка + завершается нулем + color цвет текста 0x00RRGGBB + params параметры-флаги: + 1 жирный + 2 курсив + 4 подчеркнутый + 8 перечеркнутый + 16 применить сглаживание + 32 вывод в 32-битный буфер + возможно использование флагов в любых сочетаниях +------------------------------------------------------------------------------ +MODULE RasterWorks - обертка библиотеки Rasterworks.obj +------------------------------------------------------------------------------ +MODULE libimg - обертка библиотеки libimg.obj +------------------------------------------------------------------------------ \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/KOSLib1251.txt b/programs/develop/oberon07/Docs/KOSLib1251.txt deleted file mode 100644 index 985b4d0ccb..0000000000 --- a/programs/develop/oberon07/Docs/KOSLib1251.txt +++ /dev/null @@ -1,566 +0,0 @@ -============================================================================== - - (KolibriOS) - ------------------------------------------------------------------------------- -MODULE Out - - - PROCEDURE Open - - - PROCEDURE Int(x, width: INTEGER) - x; - width - , - - PROCEDURE Real(x: REAL; width: INTEGER) - x ; - width - , - - PROCEDURE Char(x: CHAR) - x - - PROCEDURE FixReal(x: REAL; width, p: INTEGER) - x ; - width - , ; - p - - - PROCEDURE Ln - - - PROCEDURE String(s: ARRAY OF CHAR) - s - ------------------------------------------------------------------------------- -MODULE In - - - VAR Done: BOOLEAN - TRUE - , FALSE - - PROCEDURE Open - , - Done TRUE - - PROCEDURE Int(VAR x: INTEGER) - INTEGER - - PROCEDURE Char(VAR x: CHAR) - - - PROCEDURE Real(VAR x: REAL) - REAL - - PROCEDURE String(VAR s: ARRAY OF CHAR) - - - PROCEDURE Ln - ENTER - ------------------------------------------------------------------------------- -MODULE Console - - - CONST - - - - Black = 0 Blue = 1 Green = 2 - Cyan = 3 Red = 4 Magenta = 5 - Brown = 6 LightGray = 7 DarkGray = 8 - LightBlue = 9 LightGreen = 10 LightCyan = 11 - LightRed = 12 LightMagenta = 13 Yellow = 14 - White = 15 - - PROCEDURE Cls - - - PROCEDURE SetColor(FColor, BColor: INTEGER) - : FColor - , - BColor - , - - - - PROCEDURE SetCursor(x, y: INTEGER) - (x, y) - - PROCEDURE GetCursor(VAR x, y: INTEGER) - - - PROCEDURE GetCursorX(): INTEGER - x- - - PROCEDURE GetCursorY(): INTEGER - y- - ------------------------------------------------------------------------------- -MODULE ConsoleLib - console.obj - ------------------------------------------------------------------------------- -MODULE Math - - - CONST - - pi = 3.141592653589793E+00 - e = 2.718281828459045E+00 - - - PROCEDURE IsNan(x: REAL): BOOLEAN - TRUE, x - - - PROCEDURE IsInf(x: REAL): BOOLEAN - TRUE, x - - - PROCEDURE sqrt(x: REAL): REAL - x - - PROCEDURE exp(x: REAL): REAL - x - - PROCEDURE ln(x: REAL): REAL - x - - PROCEDURE sin(x: REAL): REAL - x - - PROCEDURE cos(x: REAL): REAL - x - - PROCEDURE tan(x: REAL): REAL - x - - PROCEDURE arcsin(x: REAL): REAL - x - - PROCEDURE arccos(x: REAL): REAL - x - - PROCEDURE arctan(x: REAL): REAL - x - - PROCEDURE arctan2(y, x: REAL): REAL - y/x - - PROCEDURE power(base, exponent: REAL): REAL - base exponent - - PROCEDURE log(base, x: REAL): REAL - x base - - PROCEDURE sinh(x: REAL): REAL - x - - PROCEDURE cosh(x: REAL): REAL - x - - PROCEDURE tanh(x: REAL): REAL - x - - PROCEDURE arsinh(x: REAL): REAL - x - - PROCEDURE arcosh(x: REAL): REAL - x - - PROCEDURE artanh(x: REAL): REAL - x - - PROCEDURE round(x: REAL): REAL - x - - PROCEDURE frac(x: REAL): REAL; - x - - PROCEDURE floor(x: REAL): REAL - ( REAL), - x: floor(1.2) = 1.0 - - PROCEDURE ceil(x: REAL): REAL - ( REAL), - x: ceil(1.2) = 2.0 - - PROCEDURE sgn(x: REAL): INTEGER - x > 0 1 - x < 0 -1 - x = 0 0 - - PROCEDURE fact(n: INTEGER): REAL - n - ------------------------------------------------------------------------------- -MODULE Debug - - Out - - PROCEDURE Open - - ------------------------------------------------------------------------------- -MODULE File - - - TYPE - - FNAME = ARRAY 520 OF CHAR - - FS = POINTER TO rFS - - rFS = RECORD (* *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END - - FD = POINTER TO rFD - - rFD = RECORD (* *) - attr: INTEGER; - ntyp: CHAR; - reserved: ARRAY 3 OF CHAR; - time_create, date_create, - time_access, date_access, - time_modif, date_modif, - size, hsize: INTEGER; - name: FNAME - END - - CONST - - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 - - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - FName, - size , - 0 (). , - (kunpack). - - PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN - - FName Info. - FALSE. - - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - TRUE, FName - - PROCEDURE Close(VAR F: FS) - , - F F NIL - - PROCEDURE Open(FName: ARRAY OF CHAR): FS - - FName, NIL - - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - FName, FALSE - - PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER - - F Offset, - Origin = (SEEK_BEG - , - SEEK_CUR - , SEEK_END - ), - , : - Seek(F, 0, SEEK_END) - - ; -1 - - PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER - . F - - , Buffer - - , Count - , - ; , - / - F. - - PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER - . F - - , Buffer - - , Count - , - ; , - / - F. - - PROCEDURE Create(FName: ARRAY OF CHAR): FS - FName ( ), - , - NIL - - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - DirName, - , FALSE - - PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN - DirName, - FALSE - - PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN - TRUE, DirName - ------------------------------------------------------------------------------- -MODULE Read - F - - TRUE - / - F - - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - - PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN - ------------------------------------------------------------------------------- -MODULE Write - F - - TRUE - / - F - - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - - PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN - ------------------------------------------------------------------------------- -MODULE DateTime - , - - CONST ERR = -7.0E5 - - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - - - - PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL - , - Year, Month, Day, Hour, Min, Sec; - ERR = -7.0E5 - - PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, - Hour, Min, Sec: INTEGER): BOOLEAN - - Year, Month, Day, Hour, Min, Sec Date; - FALSE - ------------------------------------------------------------------------------- -MODULE Args - - - VAR argc: INTEGER - , - - - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - s n- , - 0 argc - 1, - -- - ------------------------------------------------------------------------------- -MODULE KOSAPI - - PROCEDURE sysfunc1(arg1: INTEGER): INTEGER - PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER - ... - PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER - API KolibriOS. - arg1 .. arg7 - eax, ebx, ecx, edx, esi, edi, ebp; - eax . - - PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER - API KolibriOS. - arg1 - eax, arg2 - ebx, - res2 - ebx ; - eax . - - PROCEDURE malloc(size: INTEGER): INTEGER - . - size - , - - - PROCEDURE free(ptr: INTEGER): INTEGER - ptr, - 0 - - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - , - ptr - , - size - , - , - 0 - - PROCEDURE GetCommandLine(): INTEGER - - - PROCEDURE GetName(): INTEGER - - - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - DLL name. - . 0. - - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - - lib - DLL - . 0. - ------------------------------------------------------------------------------- -MODULE ColorDlg - "Color Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* *) - status: INTEGER (* : - 0 - Cancel - 1 - OK - 2 - *) - - color: INTEGER (* *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - - draw_window - - (TYPE DRAW_WINDOW = PROCEDURE); - - - PROCEDURE Show(cd: Dialog) - - cd - , - Create - - PROCEDURE Destroy(VAR cd: Dialog) - - cd - - ------------------------------------------------------------------------------- -MODULE OpenDlg - "Open Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* *) - status: INTEGER (* : - 0 - Cancel - 1 - OK - 2 - *) - - FileName: ARRAY 4096 OF CHAR (* *) - FilePath: ARRAY 4096 OF CHAR (* - *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, - filter: ARRAY OF CHAR): Dialog - - draw_window - - (TYPE DRAW_WINDOW = PROCEDURE) - type - - 0 - - 1 - - 2 - - def_path - , def_path - - filter - , - , - "|", : "ASM|TXT|INI" - - - PROCEDURE Show(od: Dialog; Width, Height: INTEGER) - - od - , - Create - Width Height - - - PROCEDURE Destroy(VAR od: Dialog) - - od - - ------------------------------------------------------------------------------- -MODULE kfonts - kf- - - CONST - - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 - - TYPE - - TFont = POINTER TO TFont_desc (* *) - - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - - file_name kf- - -: /NIL () - - PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN - - Font - font_size - -: TRUE/FALSE () - - PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN - , , - Font - font_size - -: TRUE/FALSE ( ) - - PROCEDURE Destroy(VAR Font: TFont) - , - Font - Font NIL - - PROCEDURE TextHeight(Font: TFont): INTEGER - - Font - -: - - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - - Font - str Win-1251 - length -1, - - params - . - -: - - PROCEDURE TextOut(Font: TFont; - canvas, x, y, str, length, color, params: INTEGER) - - , .65 - .7 ( 24-) - Font - canvas - : - Xsize dd - Ysize dd - picture rb Xsize * Ysize * 4 (32 ) - Xsize * Ysize * 3 (24 ) - x, y - - str Win-1251 - length -1, - - color 0x00RRGGBB - params -: - 1 - 2 - 4 - 8 - 16 - 32 32- - ------------------------------------------------------------------------------- -MODULE RasterWorks - Rasterworks.obj ------------------------------------------------------------------------------- -MODULE libimg - libimg.obj ------------------------------------------------------------------------------- \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/KOSLib866.txt b/programs/develop/oberon07/Docs/KOSLib866.txt deleted file mode 100644 index 7b501634ae..0000000000 --- a/programs/develop/oberon07/Docs/KOSLib866.txt +++ /dev/null @@ -1,566 +0,0 @@ -============================================================================== - - ⥪ (KolibriOS) - ------------------------------------------------------------------------------- -MODULE Out - ᮫ 뢮 - - PROCEDURE Open - ଠ쭮 뢠 ᮫ 뢮 - - PROCEDURE Int(x, width: INTEGER) - 뢮 楫 ᫠ x; - width - ⢮ , ᯮ㥬 뢮 - - PROCEDURE Real(x: REAL; width: INTEGER) - 뢮 ⢥ ᫠ x 饬 ଠ; - width - ⢮ , ᯮ㥬 뢮 - - PROCEDURE Char(x: CHAR) - 뢮 ᨬ x - - PROCEDURE FixReal(x: REAL; width, p: INTEGER) - 뢮 ⢥ ᫠ x 䨪஢ ଠ; - width - ⢮ , ᯮ㥬 뢮; - p - ⢮ ᫥ 筮 窨 - - PROCEDURE Ln - 室 ᫥ ப - - PROCEDURE String(s: ARRAY OF CHAR) - 뢮 ப s - ------------------------------------------------------------------------------- -MODULE In - ᮫ - - VAR Done: BOOLEAN - ਭ 祭 TRUE 砥 ᯥ譮 믮 - 樨 , FALSE - - PROCEDURE Open - ଠ쭮 뢠 ᮫ , - ⠪ ᢠ ६ Done 祭 TRUE - - PROCEDURE Int(VAR x: INTEGER) - ᫠ ⨯ INTEGER - - PROCEDURE Char(VAR x: CHAR) - ᨬ - - PROCEDURE Real(VAR x: REAL) - ᫠ ⨯ REAL - - PROCEDURE String(VAR s: ARRAY OF CHAR) - ப - - PROCEDURE Ln - ENTER - ------------------------------------------------------------------------------- -MODULE Console - ⥫ 楤 ᮫쭮 뢮 - - CONST - - 騥 ⠭ । 梥 ᮫쭮 뢮 - - Black = 0 Blue = 1 Green = 2 - Cyan = 3 Red = 4 Magenta = 5 - Brown = 6 LightGray = 7 DarkGray = 8 - LightBlue = 9 LightGreen = 10 LightCyan = 11 - LightRed = 12 LightMagenta = 13 Yellow = 14 - White = 15 - - PROCEDURE Cls - ⪠ ᮫ - - PROCEDURE SetColor(FColor, BColor: INTEGER) - ⠭ 梥 ᮫쭮 뢮: FColor - 梥 ⥪, - BColor - 梥 䮭, 祭 - 襯᫥ - ⠭ - - PROCEDURE SetCursor(x, y: INTEGER) - ⠭ ᮫ (x, y) - - PROCEDURE GetCursor(VAR x, y: INTEGER) - 뢠 ࠬ ⥪騥 न ᮫ - - PROCEDURE GetCursorX(): INTEGER - 頥 ⥪ x-न ᮫ - - PROCEDURE GetCursorY(): INTEGER - 頥 ⥪ y-न ᮫ - ------------------------------------------------------------------------------- -MODULE ConsoleLib - ⪠ ⥪ console.obj - ------------------------------------------------------------------------------- -MODULE Math - ⥬᪨ 㭪樨 - - CONST - - pi = 3.141592653589793E+00 - e = 2.718281828459045E+00 - - - PROCEDURE IsNan(x: REAL): BOOLEAN - 頥 TRUE, ᫨ x - ᫮ - - PROCEDURE IsInf(x: REAL): BOOLEAN - 頥 TRUE, ᫨ x - ᪮筮 - - PROCEDURE sqrt(x: REAL): REAL - ७ x - - PROCEDURE exp(x: REAL): REAL - ᯮ x - - PROCEDURE ln(x: REAL): REAL - ࠫ x - - PROCEDURE sin(x: REAL): REAL - ᨭ x - - PROCEDURE cos(x: REAL): REAL - ᨭ x - - PROCEDURE tan(x: REAL): REAL - ⠭ x - - PROCEDURE arcsin(x: REAL): REAL - ᨭ x - - PROCEDURE arccos(x: REAL): REAL - પᨭ x - - PROCEDURE arctan(x: REAL): REAL - ⠭ x - - PROCEDURE arctan2(y, x: REAL): REAL - ⠭ y/x - - PROCEDURE power(base, exponent: REAL): REAL - ᫠ base ⥯ exponent - - PROCEDURE log(base, x: REAL): REAL - x ᭮ base - - PROCEDURE sinh(x: REAL): REAL - ࡮᪨ ᨭ x - - PROCEDURE cosh(x: REAL): REAL - ࡮᪨ ᨭ x - - PROCEDURE tanh(x: REAL): REAL - ࡮᪨ ⠭ x - - PROCEDURE arsinh(x: REAL): REAL - ࡮᪨ ᨭ x - - PROCEDURE arcosh(x: REAL): REAL - ࡮᪨ ᨭ x - - PROCEDURE artanh(x: REAL): REAL - ࡮᪨ ⠭ x - - PROCEDURE round(x: REAL): REAL - 㣫 x 襣 楫 - - PROCEDURE frac(x: REAL): REAL; - ஡ ᫠ x - - PROCEDURE floor(x: REAL): REAL - 襥 楫 ᫮ (।⠢ REAL), - x: floor(1.2) = 1.0 - - PROCEDURE ceil(x: REAL): REAL - 襥 楫 ᫮ (।⠢ REAL), - x: ceil(1.2) = 2.0 - - PROCEDURE sgn(x: REAL): INTEGER - ᫨ x > 0 頥 1 - ᫨ x < 0 頥 -1 - ᫨ x = 0 頥 0 - - PROCEDURE fact(n: INTEGER): REAL - 䠪ਠ n - ------------------------------------------------------------------------------- -MODULE Debug - 뢮 ⫠ - 䥩 Out - - PROCEDURE Open - 뢠 ⫠ - ------------------------------------------------------------------------------- -MODULE File - ࠡ 䠩 ⥬ - - TYPE - - FNAME = ARRAY 520 OF CHAR - - FS = POINTER TO rFS - - rFS = RECORD (* ଠ樮 䠩 *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END - - FD = POINTER TO rFD - - rFD = RECORD (* 室 ⠫ *) - attr: INTEGER; - ntyp: CHAR; - reserved: ARRAY 3 OF CHAR; - time_create, date_create, - time_access, date_access, - time_modif, date_modif, - size, hsize: INTEGER; - name: FNAME - END - - CONST - - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 - - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - 㦠 䠩 FName, 뢠 ࠬ - size ࠧ 䠩, 頥 㦥 䠩 - 0 (訡). 室, ᯠ뢠 - 䠩 (kunpack). - - PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN - 뢠 室 ⠫ 䠩 - FName ࠬ Info. - 訡 頥 FALSE. - - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - 頥 TRUE, ᫨ 䠩 FName - - PROCEDURE Close(VAR F: FS) - ᢮ , 뤥 ଠ樮 - 䠩 F ᢠ F 祭 NIL - - PROCEDURE Open(FName: ARRAY OF CHAR): FS - 頥 㪠⥫ ଠ樮 䠩 - FName, 訡 頥 NIL - - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - 㤠 䠩 FName, 訡 頥 FALSE - - PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER - ⠭ ⥭- 䠩 F Offset, - ⭮⥫쭮 Origin = (SEEK_BEG - 砫 䠩, - SEEK_CUR - ⥪ , SEEK_END - 䠩), - 頥 ⭮⥫쭮 砫 䠩, ਬ: - Seek(F, 0, SEEK_END) - ⠭ 䠩 頥 - 䠩; 訡 頥 -1 - - PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER - ⠥ 䠩 . F - 㪠⥫ - ଠ樮 䠩, Buffer - - , Count - ⢮ , ஥ ॡ - 䠩; 頥 ⢮ , ஥ 뫮 ⠭ - ᮮ⢥騬 ࠧ ⥭/ - ଠ樮 F. - - PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER - 뢠 䠩. F - 㪠⥫ - ଠ樮 䠩, Buffer - - , Count - ⢮ , ஥ ॡ - 䠩; 頥 ⢮ , ஥ 뫮 ᠭ - ᮮ⢥騬 ࠧ ⥭/ - ଠ樮 F. - - PROCEDURE Create(FName: ARRAY OF CHAR): FS - ᮧ 䠩 FName ( ), 頥 - 㪠⥫ ଠ樮 䠩, - 訡 頥 NIL - - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - ᮧ DirName, ஬ - ⢮, 訡 頥 FALSE - - PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN - 㤠 DirName, - 訡 頥 FALSE - - PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN - 頥 TRUE, ᫨ DirName - ------------------------------------------------------------------------------- -MODULE Read - ⥭ ᭮ ⨯ 䠩 F - - 楤 TRUE 砥 ᯥ譮 樨 ⥭ - ᮮ⢥騬 ࠧ ⥭/ - ଠ樮 F - - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - - PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN - ------------------------------------------------------------------------------- -MODULE Write - ᭮ ⨯ 䠩 F - - 楤 TRUE 砥 ᯥ譮 樨 - ᮮ⢥騬 ࠧ ⥭/ - ଠ樮 F - - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - - PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN - ------------------------------------------------------------------------------- -MODULE DateTime - , ६ - - CONST ERR = -7.0E5 - - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - 뢠 ࠬ ⥪饩 ⥬ - ६ - - PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL - 頥 , 祭 ⮢ - Year, Month, Day, Hour, Min, Sec; - 訡 頥 ⠭ ERR = -7.0E5 - - PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, - Hour, Min, Sec: INTEGER): BOOLEAN - - Year, Month, Day, Hour, Min, Sec Date; - 訡 頥 FALSE - ------------------------------------------------------------------------------- -MODULE Args - ࠬ ணࠬ - - VAR argc: INTEGER - ⢮ ࠬ஢ ணࠬ, - ᯮ塞 䠩 - - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - 뢠 ப s n- ࠬ ணࠬ, - 㬥 ࠬ஢ 0 argc - 1, - 㫥 ࠬ -- ᯮ塞 䠩 - ------------------------------------------------------------------------------- -MODULE KOSAPI - - PROCEDURE sysfunc1(arg1: INTEGER): INTEGER - PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER - ... - PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER - ⪨ 㭪権 API KolibriOS. - arg1 .. arg7 ᮮ⢥ ॣࠬ - eax, ebx, ecx, edx, esi, edi, ebp; - 祭 ॣ eax ᫥ ⥬ 맮. - - PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER - ⪠ 㭪権 API KolibriOS. - arg1 - ॣ eax, arg2 - ॣ ebx, - res2 - 祭 ॣ ebx ᫥ ⥬ 맮; - 頥 祭 ॣ eax ᫥ ⥬ 맮. - - PROCEDURE malloc(size: INTEGER): INTEGER - 뤥 . - size - ࠧ , - 頥 뤥 - - PROCEDURE free(ptr: INTEGER): INTEGER - ᢮ ࠭ 뤥 ᮬ ptr, - 頥 0 - - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - । , - ptr - ࠭ 뤥 , - size - ࠧ, - 頥 㪠⥫ । , - 0 訡 - - PROCEDURE GetCommandLine(): INTEGER - 頥 ப ࠬ஢ - - PROCEDURE GetName(): INTEGER - 頥 ப ணࠬ - - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - 㦠 DLL name. 頥 ⠡ - ᯮ. 訡 頥 0. - - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - 楤 - lib - ⠡ ᯮ DLL - 頥 楤. 訡 頥 0. - ------------------------------------------------------------------------------- -MODULE ColorDlg - ࠡ "Color Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* *) - status: INTEGER (* ﭨ : - 0 - 짮⥫ Cancel - 1 - 짮⥫ OK - 2 - *) - - color: INTEGER (* ࠭ 梥 *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - ᮧ - draw_window - 楤 ᮢ ᭮ - (TYPE DRAW_WINDOW = PROCEDURE); - 楤 頥 㪠⥫ - - PROCEDURE Show(cd: Dialog) - - cd - 㪠⥫ , ᮧ ࠭ - 楤ன Create - - PROCEDURE Destroy(VAR cd: Dialog) - 㭨⮦ - cd - 㪠⥫ - ------------------------------------------------------------------------------- -MODULE OpenDlg - ࠡ "Open Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* *) - status: INTEGER (* ﭨ : - 0 - 짮⥫ Cancel - 1 - 짮⥫ OK - 2 - *) - - FileName: ARRAY 4096 OF CHAR (* ࠭ 䠩 *) - FilePath: ARRAY 4096 OF CHAR (* ࠭ - 䠩 *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, - filter: ARRAY OF CHAR): Dialog - ᮧ - draw_window - 楤 ᮢ ᭮ - (TYPE DRAW_WINDOW = PROCEDURE) - type - ⨯ - 0 - - 1 - ࠭ - 2 - - def_path - 㬮砭, def_path 㤥 - ࢮ ᪥ - filter - ப ᠭ ᫥ ७ 䠩, - , ७ - ࠧ ᨬ "|", ਬ: "ASM|TXT|INI" - 楤 頥 㪠⥫ - - PROCEDURE Show(od: Dialog; Width, Height: INTEGER) - - od - 㪠⥫ , ᮧ ࠭ - 楤ன Create - Width Height - ਭ - - PROCEDURE Destroy(VAR od: Dialog) - 㭨⮦ - od - 㪠⥫ - ------------------------------------------------------------------------------- -MODULE kfonts - ࠡ kf-⠬ - - CONST - - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 - - TYPE - - TFont = POINTER TO TFont_desc (* 㪠⥫ *) - - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - 㧨 䠩 - file_name kf-䠩 - १-: 㪠⥫ /NIL (訡) - - PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN - ⠭ ࠧ - Font 㪠⥫ - font_size ࠧ - १-: TRUE/FALSE (訡) - - PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN - ஢, , ࠧ - Font 㪠⥫ - font_size ࠧ - १-: TRUE/FALSE ( ) - - PROCEDURE Destroy(VAR Font: TFont) - 㧨 , ᢮ - Font 㪠⥫ - ᢠ ६ Font 祭 NIL - - PROCEDURE TextHeight(Font: TFont): INTEGER - ப ⥪ - Font 㪠⥫ - १-: ப ⥪ ᥫ - - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - ਭ ப ⥪ - Font 㪠⥫ - str ப ⥪ ஢ Win-1251 - length ⢮ ᨬ ப -1, ᫨ ப - 蠥 㫥 - params ࠬ-䫠 . - १-: ਭ ப ⥪ ᥫ - - PROCEDURE TextOut(Font: TFont; - canvas, x, y, str, length, color, params: INTEGER) - 뢥 ⥪ - 뢮 , ᯮ짮 .65 - .7 (᫨ 24-) - Font 㪠⥫ - canvas ᪮ - : - Xsize dd - Ysize dd - picture rb Xsize * Ysize * 4 (32 ) - Xsize * Ysize * 3 (24 ) - x, y न ⥪ ⭮⥫쭮 孥 - 㣫 - str ப ⥪ ஢ Win-1251 - length ⢮ ᨬ ப -1, ᫨ ப - 蠥 㫥 - color 梥 ⥪ 0x00RRGGBB - params ࠬ-䫠: - 1 - 2 ᨢ - 4 ભ - 8 ભ - 16 ਬ ᣫ - 32 뢮 32- - ᯮ짮 䫠 ⠭ ------------------------------------------------------------------------------- -MODULE RasterWorks - ⪠ ⥪ Rasterworks.obj ------------------------------------------------------------------------------- -MODULE libimg - ⪠ ⥪ libimg.obj ------------------------------------------------------------------------------- \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/WinLib.txt b/programs/develop/oberon07/Docs/WinLib.txt new file mode 100644 index 0000000000..be342ad92b --- /dev/null +++ b/programs/develop/oberon07/Docs/WinLib.txt @@ -0,0 +1,312 @@ +============================================================================== + + Библиотека (Windows) + +------------------------------------------------------------------------------ +MODULE Out - консольный вывод + + PROCEDURE Open + открывает консольный вывод + + PROCEDURE Int(x, width: INTEGER) + вывод целого числа x; + width - количество знакомест, используемых для вывода + + PROCEDURE Real(x: REAL; width: INTEGER) + вывод вещественного числа x в плавающем формате; + width - количество знакомест, используемых для вывода + + PROCEDURE Char(x: CHAR) + вывод символа x + + PROCEDURE FixReal(x: REAL; width, p: INTEGER) + вывод вещественного числа x в фиксированном формате; + width - количество знакомест, используемых для вывода; + p - количество знаков после десятичной точки + + PROCEDURE Ln + переход на следующую строку + + PROCEDURE String(s: ARRAY OF CHAR) + вывод строки s (ASCII) + + PROCEDURE StringW(s: ARRAY OF WCHAR) + вывод строки s (UTF-16) + +------------------------------------------------------------------------------ +MODULE In - консольный ввод + + VAR Done: BOOLEAN + принимает значение TRUE в случае успешного выполнения + операции ввода и FALSE в противном случае + + PROCEDURE Open + открывает консольный ввод, + также присваивает переменной Done значение TRUE + + PROCEDURE Int(VAR x: INTEGER) + ввод числа типа INTEGER + + PROCEDURE Char(VAR x: CHAR) + ввод символа + + PROCEDURE Real(VAR x: REAL) + ввод числа типа REAL + + PROCEDURE String(VAR s: ARRAY OF CHAR) + ввод строки + + PROCEDURE Ln + ожидание нажатия ENTER + +------------------------------------------------------------------------------ +MODULE Console - дополнительные процедуры консольного вывода + + CONST + + Следующие константы определяют цвет консольного вывода + + Black = 0 Blue = 1 Green = 2 + Cyan = 3 Red = 4 Magenta = 5 + Brown = 6 LightGray = 7 DarkGray = 8 + LightBlue = 9 LightGreen = 10 LightCyan = 11 + LightRed = 12 LightMagenta = 13 Yellow = 14 + White = 15 + + PROCEDURE Cls + очистка окна консоли + + PROCEDURE SetColor(FColor, BColor: INTEGER) + установка цвета консольного вывода: FColor - цвет текста, + BColor - цвет фона, возможные значения - вышеперечисленные + константы + + PROCEDURE SetCursor(x, y: INTEGER) + установка курсора консоли в позицию (x, y) + + PROCEDURE GetCursor(VAR x, y: INTEGER) + записывает в параметры текущие координаты курсора консоли + + PROCEDURE GetCursorX(): INTEGER + возвращает текущую x-координату курсора консоли + + PROCEDURE GetCursorY(): INTEGER + возвращает текущую y-координату курсора консоли + +------------------------------------------------------------------------------ +MODULE Math - математические функции + + CONST + + pi = 3.141592653589793E+00 + e = 2.718281828459045E+00 + + PROCEDURE IsNan(x: REAL): BOOLEAN + возвращает TRUE, если x - не число + + PROCEDURE IsInf(x: REAL): BOOLEAN + возвращает TRUE, если x - бесконечность + + PROCEDURE sqrt(x: REAL): REAL + квадратный корень x + + PROCEDURE exp(x: REAL): REAL + экспонента x + + PROCEDURE ln(x: REAL): REAL + натуральный логарифм x + + PROCEDURE sin(x: REAL): REAL + синус x + + PROCEDURE cos(x: REAL): REAL + косинус x + + PROCEDURE tan(x: REAL): REAL + тангенс x + + PROCEDURE arcsin(x: REAL): REAL + арксинус x + + PROCEDURE arccos(x: REAL): REAL + арккосинус x + + PROCEDURE arctan(x: REAL): REAL + арктангенс x + + PROCEDURE arctan2(y, x: REAL): REAL + арктангенс y/x + + PROCEDURE power(base, exponent: REAL): REAL + возведение числа base в степень exponent + + PROCEDURE log(base, x: REAL): REAL + логарифм x по основанию base + + PROCEDURE sinh(x: REAL): REAL + гиперболический синус x + + PROCEDURE cosh(x: REAL): REAL + гиперболический косинус x + + PROCEDURE tanh(x: REAL): REAL + гиперболический тангенс x + + PROCEDURE arsinh(x: REAL): REAL + обратный гиперболический синус x + + PROCEDURE arcosh(x: REAL): REAL + обратный гиперболический косинус x + + PROCEDURE artanh(x: REAL): REAL + обратный гиперболический тангенс x + + PROCEDURE round(x: REAL): REAL + округление x до ближайшего целого + + PROCEDURE frac(x: REAL): REAL; + дробная часть числа x + + PROCEDURE floor(x: REAL): REAL + наибольшее целое число (представление как REAL), + не больше x: floor(1.2) = 1.0 + + PROCEDURE ceil(x: REAL): REAL + наименьшее целое число (представление как REAL), + не меньше x: ceil(1.2) = 2.0 + + PROCEDURE sgn(x: REAL): INTEGER + если x > 0 возвращает 1 + если x < 0 возвращает -1 + если x = 0 возвращает 0 + + PROCEDURE fact(n: INTEGER): REAL + факториал n + +------------------------------------------------------------------------------ +MODULE File - работа с файловой системой + + CONST + + OPEN_R = 0 + OPEN_W = 1 + OPEN_RW = 2 + + SEEK_BEG = 0 + SEEK_CUR = 1 + SEEK_END = 2 + + PROCEDURE Create(FName: ARRAY OF CHAR): INTEGER + создает новый файл с именем FName (полное имя с путем), + открывет файл для записи и возвращает идентификатор файла + (целое число), в случае ошибки, возвращает -1 + + PROCEDURE Open(FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER + открывает существующий файл с именем FName (полное имя с + путем) в режиме Mode = (OPEN_R (только чтение), OPEN_W + (только запись), OPEN_RW (чтение и запись)), возвращает + идентификатор файла (целое число), в случае ошибки, + возвращает -1 + + PROCEDURE Read(F, Buffer, Count: INTEGER): INTEGER + Читает данные из файла в память. F - числовой идентификатор + файла, Buffer - адрес области памяти, Count - количество байт, + которое требуется прочитать из файла; возвращает количество + байт, которое было прочитано из файла + + PROCEDURE Write(F, Buffer, Count: INTEGER): INTEGER + Записывает данные из памяти в файл. F - числовой идентификатор + файла, Buffer - адрес области памяти, Count - количество байт, + которое требуется записать в файл; возвращает количество байт, + которое было записано в файл + + PROCEDURE Seek(F, Offset, Origin: INTEGER): INTEGER + устанавливает позицию чтения-записи файла с идентификатором F + на Offset, относительно Origin = (SEEK_BEG - начало файла, + SEEK_CUR - текущая позиция, SEEK_END - конец файла), + возвращает позицию относительно начала файла, например: + Seek(F, 0, 2) - устанавливает позицию на конец файла и + возвращает длину файла; при ошибке возвращает -1 + + PROCEDURE Close(F: INTEGER) + закрывает ранее открытый файл с идентификатором F + + PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN + удаляет файл с именем FName (полное имя с путем), + возвращает TRUE, если файл успешно удален + + PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если файл с именем FName (полное имя) + существует + + PROCEDURE Load(FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER + загружает в память существующий файл с именем FName (полное имя с + путем), возвращает адрес памяти, куда был загружен файл, + записывает размер файла в параметр Size; + при ошибке возвращает 0 + + PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN + создает папку с именем DirName, все промежуточные папки + должны существовать. В случае ошибки, возвращает FALSE + + PROCEDURE RemoveDir(DirName: ARRAY OF CHAR): BOOLEAN + удаляет пустую папку с именем DirName. В случае ошибки, + возвращает FALSE + + PROCEDURE ExistsDir(DirName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если папка с именем DirName существует + +------------------------------------------------------------------------------ +MODULE DateTime - дата, время + + CONST ERR = -7.0E5 + + PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER) + возвращает в параметрах компоненты текущей системной даты и + времени + + PROCEDURE NowEncode(): REAL; + возвращает текущую системную дату и + время (представление REAL) + + PROCEDURE Encode(Year, Month, Day, + Hour, Min, Sec, MSec: INTEGER): REAL + возвращает дату, полученную из компонентов + Year, Month, Day, Hour, Min, Sec, MSec; + при ошибке возвращает константу ERR = -7.0E5 + + PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, + Hour, Min, Sec, MSec: INTEGER): BOOLEAN + извлекает компоненты + Year, Month, Day, Hour, Min, Sec, MSec из даты Date; + при ошибке возвращает FALSE + +------------------------------------------------------------------------------ +MODULE Args - параметры программы + + VAR argc: INTEGER + количество параметров программы, включая имя + исполняемого файла + + PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) + записывает в строку s n-й параметр программы, + нумерация параметров от 0 до argc - 1, + нулевой параметр -- имя исполняемого файла + +------------------------------------------------------------------------------ +MODULE Utils - разное + + PROCEDURE Utf8To16(source: ARRAY OF CHAR; + VAR dest: ARRAY OF CHAR): INTEGER; + преобразует символы строки source из кодировки UTF-8 в + кодировку UTF-16, результат записывает в строку dest, + возвращает количество 16-битных символов, записанных в dest + + PROCEDURE PutSeed(seed: INTEGER) + Инициализация генератора случайных чисел целым числом seed + + PROCEDURE Rnd(range: INTEGER): INTEGER + Целые случайные числа в диапазоне 0 <= x < range + +------------------------------------------------------------------------------ +MODULE WINAPI - привязки к некоторым API-функциям Windows \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/x86.txt b/programs/develop/oberon07/Docs/x86.txt new file mode 100644 index 0000000000..e26976fda6 --- /dev/null +++ b/programs/develop/oberon07/Docs/x86.txt @@ -0,0 +1,358 @@ + Компилятор языка программирования Oberon-07/16 для i486 + Windows/Linux/KolibriOS. +------------------------------------------------------------------------------ + + Параметры командной строки + + Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или +UTF-8 с BOM-сигнатурой. + Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF. + Параметры: + 1) имя главного модуля + 2) тип приложения + "win32con" - Windows console + "win32gui" - Windows GUI + "win32dll" - Windows DLL + "linux32exe" - Linux ELF-EXEC + "linux32so" - Linux ELF-SO + "kosexe" - KolibriOS + "kosdll" - KolibriOS DLL + + 3) необязательные параметры-ключи + -out имя результирующего файла; по умолчанию, + совпадает с именем главного модуля, но с другим расширением + (соответствует типу исполняемого файла) + -stk размер стэка в мегабайтах (по умолчанию 2 Мб, + допустимо от 1 до 32 Мб) + -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) + -ver версия программы (только для kosdll) + + параметр -nochk задается в виде строки из символов: + "p" - указатели + "t" - типы + "i" - индексы + "b" - неявное приведение INTEGER к BYTE + "c" - диапазон аргумента функции CHR + "w" - диапазон аргумента функции WCHR + "r" - эквивалентно "bcw" + "a" - все проверки + + Порядок символов может быть любым. Наличие в строке того или иного + символа отключает соответствующую проверку. + + Например: -nochk it - отключить проверку индексов и охрану типа. + -nochk a - отключить все отключаемые проверки. + + Например: + + Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -stk 1 + Compiler.exe "C:\example.ob07" win32dll -out "C:\example.dll" + Compiler.exe "C:\example.ob07" win32gui -out "C:\example.exe" -stk 4 + Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -nochk pti + Compiler.kex "/tmp0/1/example.ob07" kosexe -out "/tmp0/1/example.kex" -stk 4 + Compiler.kex "/tmp0/1/example.ob07" kosdll -out "/tmp0/1/mydll.obj" -ver 2.7 + Compiler.exe "C:\example.ob07" linux32exe -out "C:\example" -stk 1 -nochk a + + В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. +При работе компилятора в KolibriOS, код завершения не передается. + +------------------------------------------------------------------------------ + Отличия от оригинала + +1. Расширен псевдомодуль SYSTEM +2. В идентификаторах допускается символ "_" +3. Добавлены системные флаги +4. Усовершенствован оператор CASE (добавлены константные выражения в + метках вариантов и необязательная ветка ELSE) +5. Расширен набор стандартных процедур +6. Семантика охраны/проверки типа уточнена для нулевого указателя +7. Добавлены однострочные комментарии (начинаются с пары символов "//") +8. Разрешено наследование от типа-указателя +9. Добавлен синтаксис для импорта процедур из внешних библиотек +10. "Строки" можно заключать также в одиночные кавычки: 'строка' +11. Добавлен тип WCHAR + +------------------------------------------------------------------------------ + Особенности реализации + +1. Основные типы + + Тип Диапазон значений Размер, байт + + INTEGER -2147483648 .. 2147483647 4 + REAL 4.94E-324 .. 1.70E+308 8 + CHAR символ ASCII (0X .. 0FFX) 1 + BOOLEAN FALSE, TRUE 1 + SET множество из целых чисел {0 .. 31} 4 + BYTE 0 .. 255 1 + WCHAR символ юникода (0X .. 0FFFFX) 2 + +2. Максимальная длина идентификаторов - 1024 символов +3. Максимальная длина строковых констант - 1024 символов (UTF-8) +4. Максимальная размерность открытых массивов - 5 +5. Процедура NEW заполняет нулями выделенный блок памяти +6. Глобальные и локальные переменные инициализируются нулями +7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая + модульность отсутствуют +8. Тип BYTE в выражениях всегда приводится к INTEGER +9. Контроль переполнения значений выражений не производится +10. Ошибки времени выполнения: + + 1 ASSERT(x), при x = FALSE + 2 разыменование нулевого указателя + 3 целочисленное деление на неположительное число + 4 вызов процедуры через процедурную переменную с нулевым значением + 5 ошибка охраны типа + 6 нарушение границ массива + 7 непредусмотренное значение выражения в операторе CASE + 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) + 9 CHR(x), если (x < 0) OR (x > 255) +10 WCHR(x), если (x < 0) OR (x > 65535) +11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) + +------------------------------------------------------------------------------ + Псевдомодуль SYSTEM + + Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, +ошибки при использовании процедур псевдомодуля SYSTEM могут привести к +повреждению данных времени выполнения и аварийному завершению программы. + + PROCEDURE ADR(v: любой тип): INTEGER + v - переменная или процедура; + возвращает адрес v + + PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER + возвращает адрес x + + PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER + возвращает адрес x + + PROCEDURE SIZE(T): INTEGER + возвращает размер типа T + + PROCEDURE TYPEID(T): INTEGER + T - тип-запись или тип-указатель, + возвращает номер типа в таблице типов-записей + + PROCEDURE INF(): REAL + возвращает специальное вещественное значение "бесконечность" + + PROCEDURE GET(a: INTEGER; + VAR v: любой основной тип, PROCEDURE, POINTER) + v := Память[a] + + PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) + Память[a] := x; + Если x: BYTE или x: WCHAR, то значение x будет расширено + до 32 бит, для записи байтов использовать SYSTEM.PUT8, + для WCHAR -- SYSTEM.PUT16 + + PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) + Память[a] := младшие 8 бит (x) + + PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) + Память[a] := младшие 16 бит (x) + + PROCEDURE MOVE(Source, Dest, n: INTEGER) + Копирует 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(byte1, byte2,... : INTEGER) + Вставка машинного кода, + byte1, byte2 ... - константы в диапазоне 0..255, + например: + SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) + + + Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. + +------------------------------------------------------------------------------ + Системные флаги + + При объявлении процедурных типов и глобальных процедур, после ключевого +слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall], +[ccall], [ccall16], [windows], [linux]. Например: + + PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; + + Если указан флаг [ccall16], то принимается соглашение ccall, но перед +вызовом указатель стэка будет выравнен по границе 16 байт. + Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall16]. + Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что +результат процедуры можно игнорировать (не допускается для типа REAL). + + При объявлении типов-записей, после ключевого слова RECORD может быть +указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей +записи. Записи с системным флагом не могут иметь базовый тип и не могут быть +базовыми типами для других записей. + Для использования системных флагов, требуется импортировать SYSTEM. + +------------------------------------------------------------------------------ + Оператор CASE + + Синтаксис оператора CASE: + + CaseStatement = + CASE Expression OF Сase {"|" Сase} + [ELSE StatementSequence] END. + Case = [CaseLabelList ":" StatementSequence]. + CaseLabelList = CaseLabels {"," CaseLabels}. + CaseLabels = ConstExpression [".." ConstExpression]. + + Например: + + CASE x OF + |-1: DoSomething1 + | 1: DoSomething2 + | 0: DoSomething3 + ELSE + DoSomething4 + END + + В метках вариантов можно использовать константные выражения, ветка ELSE +необязательна. Если значение x не соответствует ни одному варианту и ELSE +отсутствует, то программа прерывается с ошибкой времени выполнения. + +------------------------------------------------------------------------------ + Тип WCHAR + + Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и +ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и +ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает +только тип CHAR. Для получения значения типа WCHAR, следует использовать +процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять +исходный код в кодировке UTF-8 c BOM. + +------------------------------------------------------------------------------ + Проверка и охрана типа нулевого указателя + + Оригинальное сообщение о языке не определяет поведение программы при +выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих +Oberon-реализациях выполнение такой операции приводит к ошибке времени +выполнения. В данной реализации охрана типа нулевого указателя не приводит к +ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет +значительно сократить частоту применения охраны типа. + +------------------------------------------------------------------------------ + Дополнительные стандартные процедуры + + DISPOSE (VAR v: любой_указатель) + Освобождает память, выделенную процедурой NEW для + динамической переменной v^, и присваивает переменной v + значение NIL. + + COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); + v := x; + Если LEN(v) < LEN(x), то строка x будет скопирована + не полностью + + LSR (x, n: INTEGER): INTEGER + Логический сдвиг x на n бит вправо. + + MIN (a, b: INTEGER): INTEGER + Минимум из двух значений. + + MAX (a, b: INTEGER): INTEGER + Максимум из двух значений. + + BITS (x: INTEGER): SET + Интерпретирует x как значение типа SET. + Выполняется на этапе компиляции. + + LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER + Длина 0X-завершенной строки s, без учета символа 0X. + Если символ 0X отсутствует, функция возвращает длину + массива s. s не может быть константой. + + WCHR (n: INTEGER): WCHAR + Преобразование типа, аналогично CHR(n: INTEGER): CHAR + +------------------------------------------------------------------------------ + Импортированные процедуры + + Синтаксис импорта: + + PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; + + - callconv -- соглашение о вызове + - "library" -- имя файла динамической библиотеки + - "function" -- имя импортируемой процедуры + + например: + + PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); + + PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); + + В конце объявления может быть добавлено (необязательно) "END proc_name;" + + Объявления импортированных процедур должны располагаться в глобальной + области видимости модуля после объявления переменных, вместе с объявлением + "обычных" процедур, от которых импортированные отличаются только отсутствием + тела процедуры. В остальном, к таким процедурам применимы те же правила: + их можно вызвать, присвоить процедурной переменной или получить адрес. + + Так как импортированная процедура всегда имеет явное указание соглашения о + вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием + соглашения о вызове: + + VAR + ExitProcess: PROCEDURE [windows] (code: INTEGER); + con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); + + В KolibriOS импортировать процедуры можно только из библиотек, размещенных + в /rd/1/lib. Импортировать и вызывать функции инициализации библиотек + (lib_init, START) при этом не нужно. + + Для Linux, импортированные процедуры не реализованы. + +------------------------------------------------------------------------------ + Скрытые параметры процедур + + Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке +формальных параметров, но учитываются компилятором при трансляции вызовов. +Это возможно в следующих случаях: + +1. Процедура имеет формальный параметр открытый массив: + PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); + Вызов транслируется так: + Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) +2. Процедура имеет формальный параметр-переменную типа RECORD: + PROCEDURE Proc (VAR x: Rec); + Вызов транслируется так: + Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) + +------------------------------------------------------------------------------ + Модуль RTL + + Все программы неявно используют модуль RTL. Компилятор транслирует +некоторые операции (проверка и охрана типа, сравнение строк, сообщения об +ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не +следует вызывать эти процедуры явно. + Сообщения об ошибках времени выполнения выводятся в диалоговых окнах +(Windows), в терминал (Linux), на доску отладки (KolibriOS). + +------------------------------------------------------------------------------ + Модуль API + + Существуют несколько реализаций модуля API (для различных ОС). + Как и модуль RTL, модуль API не предназначен для прямого использования. +Он обеспечивает связь RTL с ОС. + +------------------------------------------------------------------------------ + Генерация исполняемых файлов DLL + + Разрешается экспортировать только процедуры. Для этого, процедура должна +находиться в главном модуле программы, и ее имя должно быть отмечено символом +экспорта ("*"). KolibriOS DLL всегда экспортируют идентификаторы "version" +(версия программы) и "lib_init" - адрес процедуры инициализации DLL: + + PROCEDURE [stdcall] lib_init (): INTEGER + +Эта процедура должна быть вызвана перед использованием DLL. +Процедура всегда возвращает 1. \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/x86_64.txt b/programs/develop/oberon07/Docs/x86_64.txt new file mode 100644 index 0000000000..9655412ac4 --- /dev/null +++ b/programs/develop/oberon07/Docs/x86_64.txt @@ -0,0 +1,346 @@ + Компилятор языка программирования Oberon-07/16 для x86_64 + Windows/Linux +------------------------------------------------------------------------------ + + Параметры командной строки + + Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или +UTF-8 с BOM-сигнатурой. + Выход - испоняемый файл формата PE32+ или ELF64. + Параметры: + 1) имя главного модуля + 2) тип приложения + "win64con" - Windows64 console + "win64gui" - Windows64 GUI + "win64dll" - Windows64 DLL + "linux64exe" - Linux ELF64-EXEC + "linux64so" - Linux ELF64-SO + + 3) необязательные параметры-ключи + -out имя результирующего файла; по умолчанию, + совпадает с именем главного модуля, но с другим расширением + (соответствует типу исполняемого файла) + -stk размер стэка в мегабайтах (по умолчанию 2 Мб, + допустимо от 1 до 32 Мб) + -nochk <"ptibcwra"> отключить проверки при выполнении + + параметр -nochk задается в виде строки из символов: + "p" - указатели + "t" - типы + "i" - индексы + "b" - неявное приведение INTEGER к BYTE + "c" - диапазон аргумента функции CHR + "w" - диапазон аргумента функции WCHR + "r" - эквивалентно "bcw" + "a" - все проверки + + Порядок символов может быть любым. Наличие в строке того или иного + символа отключает соответствующую проверку. + + Например: -nochk it - отключить проверку индексов и охрану типа. + -nochk a - отключить все отключаемые проверки. + + Например: + + Compiler.exe "C:\example.ob07" win64con -out "C:\example.exe" -stk 1 + Compiler.exe "C:\example.ob07" win64dll -out "C:\example.dll" -nochk pti + Compiler "source/Compiler.ob07" linux64exe -out "source/Compiler" -nochk a + + В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. + +------------------------------------------------------------------------------ + Отличия от оригинала + +1. Расширен псевдомодуль SYSTEM +2. В идентификаторах допускается символ "_" +3. Добавлены системные флаги +4. Усовершенствован оператор CASE (добавлены константные выражения в + метках вариантов и необязательная ветка ELSE) +5. Расширен набор стандартных процедур +6. Семантика охраны/проверки типа уточнена для нулевого указателя +7. Добавлены однострочные комментарии (начинаются с пары символов "//") +8. Разрешено наследование от типа-указателя +9. Добавлен синтаксис для импорта процедур из внешних библиотек +10. "Строки" можно заключать также в одиночные кавычки: 'строка' +11. Добавлен тип WCHAR + +------------------------------------------------------------------------------ + Особенности реализации + +1. Основные типы + + Тип Диапазон значений Размер, байт + + INTEGER -9223372036854775808 .. 9223372036854775807 8 + REAL 4.94E-324 .. 1.70E+308 8 + CHAR символ ASCII (0X .. 0FFX) 1 + BOOLEAN FALSE, TRUE 1 + SET множество из целых чисел {0 .. 63} 8 + BYTE 0 .. 255 1 + WCHAR символ юникода (0X .. 0FFFFX) 2 + +2. Максимальная длина идентификаторов - 1024 символов +3. Максимальная длина строковых констант - 1024 символов (UTF-8) +4. Максимальная размерность открытых массивов - 5 +5. Процедура NEW заполняет нулями выделенный блок памяти +6. Глобальные и локальные переменные инициализируются нулями +7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая + модульность отсутствуют +8. Тип BYTE в выражениях всегда приводится к INTEGER +9. Контроль переполнения значений выражений не производится +10. Ошибки времени выполнения: + + 1 ASSERT(x), при x = FALSE + 2 разыменование нулевого указателя + 3 целочисленное деление на неположительное число + 4 вызов процедуры через процедурную переменную с нулевым значением + 5 ошибка охраны типа + 6 нарушение границ массива + 7 непредусмотренное значение выражения в операторе CASE + 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) + 9 CHR(x), если (x < 0) OR (x > 255) +10 WCHR(x), если (x < 0) OR (x > 65535) +11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) + +------------------------------------------------------------------------------ + Псевдомодуль SYSTEM + + Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, +ошибки при использовании процедур псевдомодуля SYSTEM могут привести к +повреждению данных времени выполнения и аварийному завершению программы. + + PROCEDURE ADR(v: любой тип): INTEGER + v - переменная или процедура; + возвращает адрес v + + PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER + возвращает адрес x + + PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER + возвращает адрес x + + PROCEDURE SIZE(T): INTEGER + возвращает размер типа T + + PROCEDURE TYPEID(T): INTEGER + T - тип-запись или тип-указатель, + возвращает номер типа в таблице типов-записей + + PROCEDURE INF(): REAL + возвращает специальное вещественное значение "бесконечность" + + PROCEDURE GET(a: INTEGER; + VAR v: любой основной тип, PROCEDURE, POINTER) + v := Память[a] + + PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) + Память[a] := x; + Если x: BYTE или x: WCHAR, то значение x будет расширено + до 64 бит, для записи байтов использовать SYSTEM.PUT8, + для WCHAR -- SYSTEM.PUT16 + + PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) + Память[a] := младшие 8 бит (x) + + PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) + Память[a] := младшие 16 бит (x) + + PROCEDURE PUT32(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) + Память[a] := младшие 32 бит (x) + + PROCEDURE MOVE(Source, Dest, n: INTEGER) + Копирует 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(byte1, byte2,... : BYTE) + Вставка машинного кода, + byte1, byte2 ... - константы в диапазоне 0..255, + например: + + SYSTEM.CODE(048H,08BH,045H,010H) (* mov rax,qword[rbp+16] *) + + Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не +допускаются никакие явные операции, за исключением присваивания. + + Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. + +------------------------------------------------------------------------------ + Системные флаги + + При объявлении процедурных типов и глобальных процедур, после ключевого +слова PROCEDURE может быть указан флаг соглашения о вызове: [win64], [systemv], +[windows], [linux]. +Например: + + PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER; + + Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv]. + Знак "-" после имени флага ([win64-], [linux-], ...) означает, что +результат процедуры можно игнорировать (не допускается для типа REAL). + Если флаг не указан, то принимается внутреннее соглашение о вызове. +[win64] и [systemv] используются для связи с операционной системой и внешними +приложениями. + + При объявлении типов-записей, после ключевого слова RECORD может быть +указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей +записи. Записи с системным флагом не могут иметь базовый тип и не могут быть +базовыми типами для других записей. + Для использования системных флагов, требуется импортировать SYSTEM. + +------------------------------------------------------------------------------ + Оператор CASE + + Синтаксис оператора CASE: + + CaseStatement = + CASE Expression OF Сase {"|" Сase} + [ELSE StatementSequence] END. + Case = [CaseLabelList ":" StatementSequence]. + CaseLabelList = CaseLabels {"," CaseLabels}. + CaseLabels = ConstExpression [".." ConstExpression]. + + Например: + + CASE x OF + |-1: DoSomething1 + | 1: DoSomething2 + | 0: DoSomething3 + ELSE + DoSomething4 + END + + В метках вариантов можно использовать константные выражения, ветка ELSE +необязательна. Если значение x не соответствует ни одному варианту и ELSE +отсутствует, то программа прерывается с ошибкой времени выполнения. + +------------------------------------------------------------------------------ + Тип WCHAR + + Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и +ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и +ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает +только тип CHAR. Для получения значения типа WCHAR, следует использовать +процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять +исходный код в кодировке UTF-8 c BOM. + +------------------------------------------------------------------------------ + Проверка и охрана типа нулевого указателя + + Оригинальное сообщение о языке не определяет поведение программы при +выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих +Oberon-реализациях выполнение такой операции приводит к ошибке времени +выполнения. В данной реализации охрана типа нулевого указателя не приводит к +ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет +значительно сократить частоту применения охраны типа. + +------------------------------------------------------------------------------ + Дополнительные стандартные процедуры + + DISPOSE (VAR v: любой_указатель) + Освобождает память, выделенную процедурой NEW для + динамической переменной v^, и присваивает переменной v + значение NIL. + + COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); + v := x; + Если LEN(v) < LEN(x), то строка x будет скопирована + не полностью + + LSR (x, n: INTEGER): INTEGER + Логический сдвиг x на n бит вправо. + + MIN (a, b: INTEGER): INTEGER + Минимум из двух значений. + + MAX (a, b: INTEGER): INTEGER + Максимум из двух значений. + + BITS (x: INTEGER): SET + Интерпретирует x как значение типа SET. + Выполняется на этапе компиляции. + + LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER + Длина 0X-завершенной строки s, без учета символа 0X. + Если символ 0X отсутствует, функция возвращает длину + массива s. s не может быть константой. + + WCHR (n: INTEGER): WCHAR + Преобразование типа, аналогично CHR(n: INTEGER): CHAR + +------------------------------------------------------------------------------ + Импортированные процедуры + + Синтаксис импорта: + + PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; + + - callconv -- соглашение о вызове + - "library" -- имя файла динамической библиотеки + - "function" -- имя импортируемой процедуры + + например: + + PROCEDURE [win64, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); + + + В конце объявления может быть добавлено (необязательно) "END proc_name;" + + Объявления импортированных процедур должны располагаться в глобальной + области видимости модуля после объявления переменных, вместе с объявлением + "обычных" процедур, от которых импортированные отличаются только отсутствием + тела процедуры. В остальном, к таким процедурам применимы те же правила: + их можно вызвать, присвоить процедурной переменной или получить адрес. + + Так как импортированная процедура всегда имеет явное указание соглашения о + вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием + соглашения о вызове: + + VAR + ExitProcess: PROCEDURE [win64] (code: INTEGER); + + Для Linux, импортированные процедуры не реализованы. + +------------------------------------------------------------------------------ + Скрытые параметры процедур + + Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке +формальных параметров, но учитываются компилятором при трансляции вызовов. +Это возможно в следующих случаях: + +1. Процедура имеет формальный параметр открытый массив: + PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); + Вызов транслируется так: + Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) +2. Процедура имеет формальный параметр-переменную типа RECORD: + PROCEDURE Proc (VAR x: Rec); + Вызов транслируется так: + Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) + +------------------------------------------------------------------------------ + Модуль RTL + + Все программы неявно используют модуль RTL. Компилятор транслирует +некоторые операции (проверка и охрана типа, сравнение строк, сообщения об +ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не +следует вызывать эти процедуры явно. + Сообщения об ошибках времени выполнения выводятся в диалоговых окнах +(Windows), в терминал (Linux). + +------------------------------------------------------------------------------ + Модуль API + + Существуют несколько реализаций модуля API (для различных ОС). + Как и модуль RTL, модуль API не предназначен для прямого использования. +Он обеспечивает связь RTL с ОС. + +------------------------------------------------------------------------------ + Генерация исполняемых файлов DLL + + Разрешается экспортировать только процедуры. Для этого, процедура должна +находиться в главном модуле программы, ее имя должно быть отмечено символом +экспорта ("*") и должно быть указано соглашение о вызове. \ No newline at end of file diff --git a/programs/develop/oberon07/GitHub.url b/programs/develop/oberon07/GitHub.url new file mode 100644 index 0000000000..590f82c508 --- /dev/null +++ b/programs/develop/oberon07/GitHub.url @@ -0,0 +1,2 @@ +[InternetShortcut] +URL=https://github.com/AntKrotov/oberon-07-compiler diff --git a/programs/develop/oberon07/LICENSE b/programs/develop/oberon07/LICENSE new file mode 100644 index 0000000000..e56a7ff740 --- /dev/null +++ b/programs/develop/oberon07/LICENSE @@ -0,0 +1,25 @@ +BSD 2-Clause License + +Copyright (c) 2018-2020, Anton Krotov +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 index 1786326c47..4f99171320 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2020, Anton Krotov All rights reserved. *) @@ -318,4 +318,13 @@ PROCEDURE GetTickCount* (): INTEGER; END GetTickCount; -END API. +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN 0 +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + +END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 index 20856c87af..889059d0a4 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -97,4 +97,4 @@ END GetArg; BEGIN ParamParse -END Args. +END Args. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 index 5cf255ce9c..e993d375cb 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -102,4 +102,4 @@ END Load; BEGIN Load -END ColorDlg. +END ColorDlg. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 index ee5c5d1f94..7d80c4fb01 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify diff --git a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 index 74ee3f3d43..74346a692c 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -100,4 +100,4 @@ END main; BEGIN main -END ConsoleLib. +END ConsoleLib. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 b/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 index e44bde1510..12291065f6 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -138,4 +138,4 @@ BEGIN Msec := 0 END Now; -END DateTime. +END DateTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 index b341b83fc0..daaf40ece1 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -289,4 +289,4 @@ BEGIN res := KOSAPI.sysfunc2(70, sys.ADR(info)) END Open; -END Debug. +END Debug. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 index ff61c5863c..d25a8d6938 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -313,4 +313,4 @@ BEGIN END DeleteDir; -END File. +END File. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 index 10a9def866..775291cddb 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -57,6 +57,8 @@ VAR eol*: ARRAY 3 OF CHAR; + maxreal*: REAL; + PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); @@ -453,6 +455,42 @@ PROCEDURE UnixTime* (): INTEGER; END UnixTime; +PROCEDURE d2s* (x: REAL): INTEGER; +VAR + h, l, s, e: INTEGER; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h); + + s := ASR(h, 31) MOD 2; + e := (h DIV 100000H) MOD 2048; + IF e <= 896 THEN + h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; + REPEAT + h := h DIV 2; + INC(e) + UNTIL e = 897; + e := 896; + l := (h MOD 8) * 20000000H; + h := h DIV 8 + ELSIF (1151 <= e) & (e < 2047) THEN + e := 1151; + h := 0; + l := 0 + ELSIF e = 2047 THEN + e := 1151; + IF (h MOD 100000H # 0) OR (l # 0) THEN + h := 80000H; + l := 0 + END + END; + DEC(e, 896) + + RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 +END d2s; + + PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; BEGIN SYSTEM.GET(SYSTEM.ADR(x), a); @@ -463,9 +501,11 @@ END splitf; BEGIN eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + maxreal := 1.9; + PACK(maxreal, 1023); Console := API.import; IF Console THEN con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) END; ParamParse -END HOST. +END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 b/programs/develop/oberon07/Lib/KolibriOS/In.ob07 index 6401c6dc18..50af0cb957 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/In.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify diff --git a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 index de4a9d9b99..84a881bbaf 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -427,4 +427,4 @@ BEGIN END _init; -END KOSAPI. +END KOSAPI. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 index b49668351d..b1fe62acc0 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2013, 2014, 2018, 2019 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -381,4 +381,4 @@ BEGIN END fact; -END Math. +END Math. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 b/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 index 93d0dbc7b8..c0ed629f9c 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 +++ b/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 @@ -104,4 +104,4 @@ PROCEDURE LinkStatus* (num: INTEGER): INTEGER; END LinkStatus; -END NetDevices. +END NetDevices. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 index 6240eb2b26..9bffd20f21 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -150,4 +150,4 @@ END Load; BEGIN Load -END OpenDlg. +END OpenDlg. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 index 04de78c75e..02cc14e017 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -264,4 +264,4 @@ END FixReal; PROCEDURE Open*; END Open; -END Out. +END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 index 3aa6c454e1..0929a5678a 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -16,34 +16,14 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; - bits: ARRAY MAX_SET + 1 OF INTEGER; - - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); @@ -97,7 +77,6 @@ VAR i, n, k: INTEGER; BEGIN - k := LEN(A) - 1; n := A[0]; i := 0; @@ -106,7 +85,6 @@ BEGIN INC(i) END; A[k] := n - END _rot; @@ -128,14 +106,16 @@ BEGIN END _set; -PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; +PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) BEGIN - IF ASR(a, 5) = 0 THEN - SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) - ELSE - a := 0 - END - RETURN a + SYSTEM.CODE( + 031H, 0C0H, (* xor eax, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *) + 083H, 0F9H, 01FH, (* cmp ecx, 31 *) + 077H, 003H, (* ja L *) + 00FH, 0ABH, 0C8H (* bts eax, ecx *) + (* L: *) + ) END _set1; @@ -315,7 +295,6 @@ VAR c: CHAR; BEGIN - res := strncmp(str1, str2, MIN(len1, len2)); IF res = minint THEN IF len1 > len2 THEN @@ -349,7 +328,6 @@ VAR c: WCHAR; BEGIN - res := strncmpw(str1, str2, MIN(len1, len2)); IF res = minint THEN IF len1 > len2 THEN @@ -398,7 +376,6 @@ VAR c: CHAR; BEGIN - i := 0; REPEAT str[i] := CHR(x MOD 10 + ORD("0")); @@ -422,6 +399,7 @@ END IntToStr; PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); VAR n1, n2, i, j: INTEGER; + BEGIN n1 := LENGTH(s1); n2 := LENGTH(s2); @@ -437,7 +415,6 @@ BEGIN END; s1[j] := 0X - END append; @@ -446,20 +423,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "division by zero") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -513,36 +488,16 @@ END _guard; PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - res := 0; - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - res := 0; - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - res := 0; - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - res := 0 - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -571,42 +526,8 @@ BEGIN END END; - j := 1; - FOR i := 0 TO MAX_SET DO - bits[i] := j; - j := LSL(j, 1) - END; - - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - -END RTL. +END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 index dc814845ca..5c804aa180 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 KolibriOS team This program is free software: you can redistribute it and/or modify @@ -121,4 +121,4 @@ END main; BEGIN main -END RasterWorks. +END RasterWorks. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 index 85bb58d801..c2e86e37d7 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -43,4 +43,4 @@ PROCEDURE WChar*(F: File.FS; VAR x: WCHAR): BOOLEAN; RETURN File.Read(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR) END WChar; -END Read. +END Read. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 b/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 index 138e4297fa..0e6ed5bd6d 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 @@ -1,64 +1,64 @@ -(* - BSD 2-Clause License - - Copyright (c) 2018-2019, Anton Krotov - All rights reserved. -*) - -MODULE UnixTime; - - -VAR - - days: ARRAY 12, 31, 2 OF INTEGER; - - -PROCEDURE init; -VAR - i, j, k, n0, n1: INTEGER; -BEGIN - - FOR i := 0 TO 11 DO - FOR j := 0 TO 30 DO - days[i, j, 0] := 0; - days[i, j, 1] := 0; - END - END; - - days[ 1, 28, 0] := -1; - - FOR k := 0 TO 1 DO - days[ 1, 29, k] := -1; - days[ 1, 30, k] := -1; - days[ 3, 30, k] := -1; - days[ 5, 30, k] := -1; - days[ 8, 30, k] := -1; - days[10, 30, k] := -1; - END; - - n0 := 0; - n1 := 0; - FOR i := 0 TO 11 DO - FOR j := 0 TO 30 DO - IF days[i, j, 0] = 0 THEN - days[i, j, 0] := n0; - INC(n0) - END; - IF days[i, j, 1] = 0 THEN - days[i, j, 1] := n1; - INC(n1) - END - END - END - -END init; - - -PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; - RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec -END time; - - -BEGIN - init -END UnixTime. +(* + BSD 2-Clause License + + Copyright (c) 2018-2019, Anton Krotov + All rights reserved. +*) + +MODULE UnixTime; + + +VAR + + days: ARRAY 12, 31, 2 OF INTEGER; + + +PROCEDURE init; +VAR + i, j, k, n0, n1: INTEGER; +BEGIN + + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + days[i, j, 0] := 0; + days[i, j, 1] := 0; + END + END; + + days[ 1, 28, 0] := -1; + + FOR k := 0 TO 1 DO + days[ 1, 29, k] := -1; + days[ 1, 30, k] := -1; + days[ 3, 30, k] := -1; + days[ 5, 30, k] := -1; + days[ 8, 30, k] := -1; + days[10, 30, k] := -1; + END; + + n0 := 0; + n1 := 0; + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + IF days[i, j, 0] = 0 THEN + days[i, j, 0] := n0; + INC(n0) + END; + IF days[i, j, 1] = 0 THEN + days[i, j, 1] := n1; + INC(n1) + END + END + END + +END init; + + +PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; + RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec +END time; + + +BEGIN + init +END UnixTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 index 0792204a98..46de391ccd 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 +++ b/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 @@ -118,4 +118,4 @@ BEGIN END destroy; -END Vector. +END Vector. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 index 7a9823f25b..6730d799d7 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -43,4 +43,4 @@ PROCEDURE WChar*(F: File.FS; x: WCHAR): BOOLEAN; RETURN File.Write(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR) END WChar; -END Write. +END Write. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 index 67c1080406..8ef267a004 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -489,4 +489,4 @@ BEGIN RETURN Font END LoadFont; -END kfonts. +END kfonts. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 index 9c5a516a96..425f74034a 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 @@ -1,4 +1,4 @@ -(* +(* Copyright 2016, 2018 KolibriOS team This program is free software: you can redistribute it and/or modify @@ -432,4 +432,4 @@ END main; BEGIN main -END libimg. +END libimg. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/API.ob07 b/programs/develop/oberon07/Lib/Linux32/API.ob07 index 42a337fd01..0415cdbd01 100644 --- a/programs/develop/oberon07/Lib/Linux32/API.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/API.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -13,11 +13,13 @@ IMPORT SYSTEM; CONST RTLD_LAZY* = 1; + BIT_DEPTH* = 32; TYPE TP* = ARRAY 2 OF INTEGER; + SOFINI* = PROCEDURE; VAR @@ -46,6 +48,8 @@ VAR clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + fini: SOFINI; + PROCEDURE putc* (c: CHAR); VAR @@ -103,6 +107,7 @@ END GetProcAdr; PROCEDURE init* (sp, code: INTEGER); BEGIN + fini := NIL; SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); MainParam := sp; @@ -142,4 +147,23 @@ BEGIN END exit_thread; -END API. +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN 0 +END dllentry; + + +PROCEDURE sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END sofinit; + + +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + fini := ProcFini +END SetFini; + + +END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 b/programs/develop/oberon07/Lib/Linux32/HOST.ob07 index a2f43bc83c..2851c0cab9 100644 --- a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/HOST.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -26,6 +26,8 @@ VAR eol*: ARRAY 2 OF CHAR; + maxreal*: REAL; + PROCEDURE ExitProcess* (code: INTEGER); BEGIN @@ -148,6 +150,42 @@ PROCEDURE UnixTime* (): INTEGER; END UnixTime; +PROCEDURE d2s* (x: REAL): INTEGER; +VAR + h, l, s, e: INTEGER; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h); + + s := ASR(h, 31) MOD 2; + e := (h DIV 100000H) MOD 2048; + IF e <= 896 THEN + h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; + REPEAT + h := h DIV 2; + INC(e) + UNTIL e = 897; + e := 896; + l := (h MOD 8) * 20000000H; + h := h DIV 8 + ELSIF (1151 <= e) & (e < 2047) THEN + e := 1151; + h := 0; + l := 0 + ELSIF e = 2047 THEN + e := 1151; + IF (h MOD 100000H # 0) OR (l # 0) THEN + h := 80000H; + l := 0 + END + END; + DEC(e, 896) + + RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 +END d2s; + + PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; VAR res: INTEGER; @@ -164,5 +202,7 @@ END splitf; BEGIN eol := 0AX; + maxreal := 1.9; + PACK(maxreal, 1023); SYSTEM.GET(API.MainParam, argc) -END HOST. +END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 index d38c8b3f47..31348bcadf 100644 --- a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -13,6 +13,7 @@ IMPORT SYSTEM, API; TYPE TP* = API.TP; + SOFINI* = API.SOFINI; VAR @@ -69,12 +70,17 @@ BEGIN END GetEnv; +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + API.SetFini(ProcFini) +END SetFini; + + PROCEDURE init; VAR ptr: INTEGER; BEGIN - IF API.MainParam # 0 THEN envc := -1; SYSTEM.GET(API.MainParam, argc); @@ -134,4 +140,4 @@ END syscall; BEGIN init -END LINAPI. +END LINAPI. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/Libdl.ob07 b/programs/develop/oberon07/Lib/Linux32/Libdl.ob07 new file mode 100644 index 0000000000..f8a5781d87 --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux32/Libdl.ob07 @@ -0,0 +1,65 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Libdl; + +IMPORT SYSTEM, API; + + +CONST + + LAZY* = 1; + NOW* = 2; + BINDING_MASK* = 3; + NOLOAD* = 4; + LOCAL* = 0; + GLOBAL* = 256; + NODELETE* = 4096; + + +VAR + + _close: PROCEDURE [linux] (handle: INTEGER): INTEGER; + _error: PROCEDURE [linux] (): INTEGER; + + +PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER; + RETURN API.dlopen(SYSTEM.ADR(file[0]), mode) +END open; + + +PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER; + RETURN API.dlsym(handle, SYSTEM.ADR(name[0])) +END sym; + + +PROCEDURE close* (handle: INTEGER): INTEGER; + RETURN _close(handle) +END close; + + +PROCEDURE error* (): INTEGER; + RETURN _error() +END error; + + +PROCEDURE init; +VAR + lib: INTEGER; + +BEGIN + lib := open("libdl.so.2", LAZY); + SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose")); + ASSERT(_close # NIL); + SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror")); + ASSERT(_error # NIL) +END init; + + +BEGIN + init +END Libdl. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/Math.ob07 b/programs/develop/oberon07/Lib/Linux32/Math.ob07 new file mode 100644 index 0000000000..25950952bf --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux32/Math.ob07 @@ -0,0 +1,384 @@ +(* + 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 + 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 . +*) + +MODULE Math; + +IMPORT SYSTEM; + + +CONST + + pi* = 3.141592653589793; + e* = 2.718281828459045; + + +PROCEDURE IsNan* (x: REAL): BOOLEAN; +VAR + h, l: SET; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h) + RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) +END IsNan; + + +PROCEDURE IsInf* (x: REAL): BOOLEAN; + RETURN ABS(x) = SYSTEM.INF() +END IsInf; + + +PROCEDURE Max (a, b: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF a > b THEN + res := a + ELSE + res := b + END + RETURN res +END Max; + + +PROCEDURE Min (a, b: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF a < b THEN + res := a + ELSE + res := b + END + RETURN res +END Min; + + +PROCEDURE SameValue (a, b: REAL): BOOLEAN; +VAR + eps: REAL; + res: BOOLEAN; + +BEGIN + eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12); + IF a > b THEN + res := (a - b) <= eps + ELSE + res := (b - a) <= eps + END + RETURN res +END SameValue; + + +PROCEDURE IsZero (x: REAL): BOOLEAN; + RETURN ABS(x) <= 1.0E-12 +END IsZero; + + +PROCEDURE [stdcall] sqrt* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FAH, (* fsqrt *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END sqrt; + + +PROCEDURE [stdcall] sin* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FEH, (* fsin *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END sin; + + +PROCEDURE [stdcall] cos* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FFH, (* fcos *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END cos; + + +PROCEDURE [stdcall] tan* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FBH, (* fsincos *) + 0DEH, 0F9H, (* fdivp st1, st *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END tan; + + +PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0D9H, 0F3H, (* fpatan *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 10h *) + ) + RETURN 0.0 +END arctan2; + + +PROCEDURE [stdcall] ln* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0D9H, 0EDH, (* fldln2 *) + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0F1H, (* fyl2x *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END ln; + + +PROCEDURE [stdcall] log* (base, x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0D9H, 0E8H, (* fld1 *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0D9H, 0F1H, (* fyl2x *) + 0D9H, 0E8H, (* fld1 *) + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0F1H, (* fyl2x *) + 0DEH, 0F9H, (* fdivp st1, st *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 10h *) + ) + RETURN 0.0 +END log; + + +PROCEDURE [stdcall] exp* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0EAH, (* fldl2e *) + 0DEH, 0C9H, 0D9H, 0C0H, + 0D9H, 0FCH, 0DCH, 0E9H, + 0D9H, 0C9H, 0D9H, 0F0H, + 0D9H, 0E8H, 0DEH, 0C1H, + 0D9H, 0FDH, 0DDH, 0D9H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END exp; + + +PROCEDURE [stdcall] round* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 07DH, 0F4H, 0D9H, + 07DH, 0F6H, 066H, 081H, + 04DH, 0F6H, 000H, 003H, + 0D9H, 06DH, 0F6H, 0D9H, + 0FCH, 0D9H, 06DH, 0F4H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END round; + + +PROCEDURE [stdcall] frac* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 050H, + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0C0H, 0D9H, 03CH, + 024H, 0D9H, 07CH, 024H, + 002H, 066H, 081H, 04CH, + 024H, 002H, 000H, 00FH, + 0D9H, 06CH, 024H, 002H, + 0D9H, 0FCH, 0D9H, 02CH, + 024H, 0DEH, 0E9H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END frac; + + +PROCEDURE arcsin* (x: REAL): REAL; + RETURN arctan2(x, sqrt(1.0 - x * x)) +END arcsin; + + +PROCEDURE arccos* (x: REAL): REAL; + RETURN arctan2(sqrt(1.0 - x * x), x) +END arccos; + + +PROCEDURE arctan* (x: REAL): REAL; + RETURN arctan2(x, 1.0) +END arctan; + + +PROCEDURE sinh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x - 1.0 / x) * 0.5 +END sinh; + + +PROCEDURE cosh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x + 1.0 / x) * 0.5 +END cosh; + + +PROCEDURE tanh* (x: REAL): REAL; +BEGIN + IF x > 15.0 THEN + x := 1.0 + ELSIF x < -15.0 THEN + x := -1.0 + ELSE + x := exp(2.0 * x); + x := (x - 1.0) / (x + 1.0) + END + + RETURN x +END tanh; + + +PROCEDURE arsinh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x + 1.0)) +END arsinh; + + +PROCEDURE arcosh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x - 1.0)) +END arcosh; + + +PROCEDURE artanh* (x: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF SameValue(x, 1.0) THEN + res := SYSTEM.INF() + ELSIF SameValue(x, -1.0) THEN + res := -SYSTEM.INF() + ELSE + res := 0.5 * ln((1.0 + x) / (1.0 - x)) + END + RETURN res +END artanh; + + +PROCEDURE floor* (x: REAL): REAL; +VAR + f: REAL; + +BEGIN + f := frac(x); + x := x - f; + IF f < 0.0 THEN + x := x - 1.0 + END + RETURN x +END floor; + + +PROCEDURE ceil* (x: REAL): REAL; +VAR + f: REAL; + +BEGIN + f := frac(x); + x := x - f; + IF f > 0.0 THEN + x := x + 1.0 + END + RETURN x +END ceil; + + +PROCEDURE power* (base, exponent: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF exponent = 0.0 THEN + res := 1.0 + ELSIF (base = 0.0) & (exponent > 0.0) THEN + res := 0.0 + ELSE + res := exp(exponent * ln(base)) + END + RETURN res +END power; + + +PROCEDURE sgn* (x: REAL): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF x > 0.0 THEN + res := 1 + ELSIF x < 0.0 THEN + res := -1 + 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. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/Out.ob07 b/programs/develop/oberon07/Lib/Linux32/Out.ob07 new file mode 100644 index 0000000000..1bb3f23255 --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux32/Out.ob07 @@ -0,0 +1,277 @@ +(* + Copyright 2013, 2014, 2017, 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 + 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 . +*) + +MODULE Out; + +IMPORT sys := SYSTEM, API; + +CONST + + d = 1.0 - 5.0E-12; + +VAR + + Realp: PROCEDURE (x: REAL; width: INTEGER); + + +PROCEDURE Char*(x: CHAR); +BEGIN + API.putc(x) +END Char; + + +PROCEDURE String*(s: ARRAY OF CHAR); +VAR + i: INTEGER; + +BEGIN + i := 0; + WHILE (i < LEN(s)) & (s[i] # 0X) DO + Char(s[i]); + INC(i) + END +END String; + + +PROCEDURE WriteInt(x, n: INTEGER); +VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN; +BEGIN + i := 0; + IF n < 1 THEN + n := 1 + END; + IF x < 0 THEN + x := -x; + DEC(n); + neg := TRUE + END; + REPEAT + a[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + WHILE n > i DO + Char(" "); + DEC(n) + END; + IF neg THEN + Char("-") + END; + REPEAT + DEC(i); + Char(a[i]) + UNTIL i = 0 +END WriteInt; + +PROCEDURE IsNan(AValue: REAL): BOOLEAN; +VAR h, l: SET; +BEGIN + sys.GET(sys.ADR(AValue), l); + sys.GET(sys.ADR(AValue) + 4, h) + RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) +END IsNan; + +PROCEDURE IsInf(x: REAL): BOOLEAN; + RETURN ABS(x) = sys.INF() +END IsInf; + +PROCEDURE Int*(x, width: INTEGER); +VAR i: INTEGER; +BEGIN + IF x # 80000000H THEN + WriteInt(x, width) + ELSE + FOR i := 12 TO width DO + Char(20X) + END; + String("-2147483648") + END +END Int; + +PROCEDURE OutInf(x: REAL; width: INTEGER); +VAR s: ARRAY 5 OF CHAR; i: INTEGER; +BEGIN + IF IsNan(x) THEN + s := "Nan"; + INC(width) + ELSIF IsInf(x) & (x > 0.0) THEN + s := "+Inf" + ELSIF IsInf(x) & (x < 0.0) THEN + s := "-Inf" + END; + FOR i := 1 TO width - 4 DO + Char(" ") + END; + String(s) +END OutInf; + +PROCEDURE Ln*; +BEGIN + Char(0AX) +END Ln; + +PROCEDURE _FixReal(x: REAL; width, p: INTEGER); +VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; +BEGIN + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSIF p < 0 THEN + Realp(x, width) + ELSE + len := 0; + minus := FALSE; + IF x < 0.0 THEN + minus := TRUE; + INC(len); + x := ABS(x) + END; + e := 0; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + + IF e >= 0 THEN + len := len + e + p + 1; + IF x > 9.0 + d THEN + INC(len) + END; + IF p > 0 THEN + INC(len) + END; + ELSE + len := len + p + 2 + END; + FOR i := 1 TO width - len DO + Char(" ") + END; + IF minus THEN + Char("-") + END; + y := x; + WHILE (y < 1.0) & (y # 0.0) DO + y := y * 10.0; + DEC(e) + END; + IF e < 0 THEN + IF x - FLT(FLOOR(x)) > d THEN + Char("1"); + x := 0.0 + ELSE + Char("0"); + x := x * 10.0 + END + ELSE + WHILE e >= 0 DO + IF x - FLT(FLOOR(x)) > d THEN + IF x > 9.0 THEN + String("10") + ELSE + Char(CHR(FLOOR(x) + ORD("0") + 1)) + END; + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(e) + END + END; + IF p > 0 THEN + Char(".") + END; + WHILE p > 0 DO + IF x - FLT(FLOOR(x)) > d THEN + Char(CHR(FLOOR(x) + ORD("0") + 1)); + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(p) + END + END +END _FixReal; + +PROCEDURE Real*(x: REAL; width: INTEGER); +VAR e, n, i: INTEGER; minus: BOOLEAN; +BEGIN + Realp := Real; + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSE + e := 0; + n := 0; + IF width > 23 THEN + n := width - 23; + width := 23 + ELSIF width < 9 THEN + width := 9 + END; + width := width - 5; + IF x < 0.0 THEN + x := -x; + minus := TRUE + ELSE + minus := FALSE + END; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + WHILE (x < 1.0) & (x # 0.0) DO + x := x * 10.0; + DEC(e) + END; + IF x > 9.0 + d THEN + x := 1.0; + INC(e) + END; + FOR i := 1 TO n DO + Char(" ") + END; + IF minus THEN + x := -x + END; + _FixReal(x, width, width - 3); + Char("E"); + IF e >= 0 THEN + Char("+") + ELSE + Char("-"); + e := ABS(e) + END; + IF e < 100 THEN + Char("0") + END; + IF e < 10 THEN + Char("0") + END; + Int(e, 0) + END +END Real; + +PROCEDURE FixReal*(x: REAL; width, p: INTEGER); +BEGIN + Realp := Real; + _FixReal(x, width, p) +END FixReal; + +PROCEDURE Open*; +END Open; + +END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 index 3aa6c454e1..0929a5678a 100644 --- a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -16,34 +16,14 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; - bits: ARRAY MAX_SET + 1 OF INTEGER; - - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); @@ -97,7 +77,6 @@ VAR i, n, k: INTEGER; BEGIN - k := LEN(A) - 1; n := A[0]; i := 0; @@ -106,7 +85,6 @@ BEGIN INC(i) END; A[k] := n - END _rot; @@ -128,14 +106,16 @@ BEGIN END _set; -PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; +PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) BEGIN - IF ASR(a, 5) = 0 THEN - SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) - ELSE - a := 0 - END - RETURN a + SYSTEM.CODE( + 031H, 0C0H, (* xor eax, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *) + 083H, 0F9H, 01FH, (* cmp ecx, 31 *) + 077H, 003H, (* ja L *) + 00FH, 0ABH, 0C8H (* bts eax, ecx *) + (* L: *) + ) END _set1; @@ -315,7 +295,6 @@ VAR c: CHAR; BEGIN - res := strncmp(str1, str2, MIN(len1, len2)); IF res = minint THEN IF len1 > len2 THEN @@ -349,7 +328,6 @@ VAR c: WCHAR; BEGIN - res := strncmpw(str1, str2, MIN(len1, len2)); IF res = minint THEN IF len1 > len2 THEN @@ -398,7 +376,6 @@ VAR c: CHAR; BEGIN - i := 0; REPEAT str[i] := CHR(x MOD 10 + ORD("0")); @@ -422,6 +399,7 @@ END IntToStr; PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); VAR n1, n2, i, j: INTEGER; + BEGIN n1 := LENGTH(s1); n2 := LENGTH(s2); @@ -437,7 +415,6 @@ BEGIN END; s1[j] := 0X - END append; @@ -446,20 +423,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "division by zero") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -513,36 +488,16 @@ END _guard; PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - res := 0; - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - res := 0; - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - res := 0; - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - res := 0 - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -571,42 +526,8 @@ BEGIN END END; - j := 1; - FOR i := 0 TO MAX_SET DO - bits[i] := j; - j := LSL(j, 1) - END; - - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - -END RTL. +END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/API.ob07 b/programs/develop/oberon07/Lib/Linux64/API.ob07 new file mode 100644 index 0000000000..8d845678d2 --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/API.ob07 @@ -0,0 +1,169 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE API; + +IMPORT SYSTEM; + + +CONST + + RTLD_LAZY* = 1; + BIT_DEPTH* = 64; + + +TYPE + + TP* = ARRAY 2 OF INTEGER; + SOFINI* = PROCEDURE; + + +VAR + + eol*: ARRAY 2 OF CHAR; + MainParam*: INTEGER; + + libc*, librt*: INTEGER; + + dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER; + dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER; + + stdout*, + stdin*, + stderr* : INTEGER; + + malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; + free* : PROCEDURE [linux] (ptr: INTEGER); + _exit* : PROCEDURE [linux] (code: INTEGER); + puts* : PROCEDURE [linux] (pStr: INTEGER); + fwrite*, + fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; + fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; + fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; + + clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; + time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + + fini: SOFINI; + + +PROCEDURE putc* (c: CHAR); +VAR + res: INTEGER; + +BEGIN + res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) +END putc; + + +PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); +BEGIN + puts(lpCaption); + puts(lpText) +END DebugMsg; + + +PROCEDURE _NEW* (size: INTEGER): INTEGER; +VAR + res, ptr, words: INTEGER; + +BEGIN + res := malloc(size); + IF res # 0 THEN + ptr := res; + words := size DIV SYSTEM.SIZE(INTEGER); + WHILE words > 0 DO + SYSTEM.PUT(ptr, 0); + INC(ptr, SYSTEM.SIZE(INTEGER)); + DEC(words) + END + END + + RETURN res +END _NEW; + + +PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; +BEGIN + free(p) + RETURN 0 +END _DISPOSE; + + +PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); +VAR + sym: INTEGER; + +BEGIN + sym := dlsym(lib, SYSTEM.ADR(name[0])); + ASSERT(sym # 0); + SYSTEM.PUT(VarAdr, sym) +END GetProcAdr; + + +PROCEDURE init* (sp, code: INTEGER); +BEGIN + fini := NIL; + SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); + SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); + MainParam := sp; + eol := 0AX; + + libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY); + GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc)); + GetProcAdr(libc, "free", SYSTEM.ADR(free)); + GetProcAdr(libc, "exit", SYSTEM.ADR(_exit)); + GetProcAdr(libc, "stdout", SYSTEM.ADR(stdout)); + GetProcAdr(libc, "stdin", SYSTEM.ADR(stdin)); + GetProcAdr(libc, "stderr", SYSTEM.ADR(stderr)); + SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); + SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); + SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); + GetProcAdr(libc, "puts", SYSTEM.ADR(puts)); + GetProcAdr(libc, "fwrite", SYSTEM.ADR(fwrite)); + GetProcAdr(libc, "fread", SYSTEM.ADR(fread)); + GetProcAdr(libc, "fopen", SYSTEM.ADR(fopen)); + GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose)); + GetProcAdr(libc, "time", SYSTEM.ADR(time)); + + librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); + GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) +END init; + + +PROCEDURE exit* (code: INTEGER); +BEGIN + _exit(code) +END exit; + + +PROCEDURE exit_thread* (code: INTEGER); +BEGIN + _exit(code) +END exit_thread; + + +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN 0 +END dllentry; + + +PROCEDURE sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END sofinit; + + +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + fini := ProcFini +END SetFini; + + +END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/HOST.ob07 b/programs/develop/oberon07/Lib/Linux64/HOST.ob07 new file mode 100644 index 0000000000..96bf051d5e --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/HOST.ob07 @@ -0,0 +1,208 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE HOST; + +IMPORT SYSTEM, API, RTL; + + +CONST + + slash* = "/"; + OS* = "LINUX"; + + bit_depth* = RTL.bit_depth; + maxint* = RTL.maxint; + minint* = RTL.minint; + + +VAR + + argc: INTEGER; + + eol*: ARRAY 2 OF CHAR; + + maxreal*: REAL; + + +PROCEDURE ExitProcess* (code: INTEGER); +BEGIN + API.exit(code) +END ExitProcess; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, len, ptr: INTEGER; + c: CHAR; + +BEGIN + i := 0; + len := LEN(s) - 1; + IF (n < argc) & (len > 0) THEN + SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); + REPEAT + SYSTEM.GET(ptr, c); + s[i] := c; + INC(i); + INC(ptr) + UNTIL (c = 0X) OR (i = len) + END; + s[i] := 0X +END GetArg; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +VAR + n: INTEGER; + +BEGIN + GetArg(0, path); + n := LENGTH(path) - 1; + WHILE path[n] # slash DO + DEC(n) + END; + path[n + 1] := 0X +END GetCurrentDirectory; + + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); + IF res <= 0 THEN + res := -1 + END + + RETURN res +END FileRead; + + +PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); + IF res <= 0 THEN + res := -1 + END + + RETURN res +END FileWrite; + + +PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; + RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) +END FileCreate; + + +PROCEDURE FileClose* (File: INTEGER); +BEGIN + File := API.fclose(File) +END FileClose; + + +PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; + RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) +END FileOpen; + + +PROCEDURE OutChar* (c: CHAR); +BEGIN + API.putc(c) +END OutChar; + + +PROCEDURE GetTickCount* (): INTEGER; +VAR + tp: API.TP; + res: INTEGER; + +BEGIN + IF API.clock_gettime(0, tp) = 0 THEN + res := tp[0] * 100 + tp[1] DIV 10000000 + ELSE + res := 0 + END + + RETURN res +END GetTickCount; + + +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN path[0] # slash +END isRelative; + + +PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); +END now; + + +PROCEDURE UnixTime* (): INTEGER; + RETURN API.time(0) +END UnixTime; + + +PROCEDURE d2s* (x: REAL): INTEGER; +VAR + h, l, s, e: INTEGER; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h); + + s := ASR(h, 31) MOD 2; + e := (h DIV 100000H) MOD 2048; + IF e <= 896 THEN + h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; + REPEAT + h := h DIV 2; + INC(e) + UNTIL e = 897; + e := 896; + l := (h MOD 8) * 20000000H; + h := h DIV 8 + ELSIF (1151 <= e) & (e < 2047) THEN + e := 1151; + h := 0; + l := 0 + ELSIF e = 2047 THEN + e := 1151; + IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN + h := 80000H; + l := 0 + END + END; + DEC(e, 896) + + RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 +END d2s; + + +PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + a := 0; + b := 0; + SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); + SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); + SYSTEM.GET(SYSTEM.ADR(x), res) + RETURN res +END splitf; + + +BEGIN + eol := 0AX; + maxreal := 1.9; + PACK(maxreal, 1023); + SYSTEM.GET(API.MainParam, argc) +END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07 new file mode 100644 index 0000000000..c7931e2315 --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07 @@ -0,0 +1,138 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE LINAPI; + +IMPORT SYSTEM, API; + + +TYPE + + TP* = API.TP; + SOFINI* = API.SOFINI; + + +VAR + + argc*, envc*: INTEGER; + + libc*, librt*: INTEGER; + + stdout*, + stdin*, + stderr* : INTEGER; + + malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; + free* : PROCEDURE [linux] (ptr: INTEGER); + exit* : PROCEDURE [linux] (code: INTEGER); + puts* : PROCEDURE [linux] (pStr: INTEGER); + fwrite*, + fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; + fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; + fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; + time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + + clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, len, ptr: INTEGER; + c: CHAR; + +BEGIN + i := 0; + len := LEN(s) - 1; + IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN + SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); + REPEAT + SYSTEM.GET(ptr, c); + s[i] := c; + INC(i); + INC(ptr) + UNTIL (c = 0X) OR (i = len) + END; + s[i] := 0X +END GetArg; + + +PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR); +BEGIN + IF (0 <= n) & (n < envc) THEN + GetArg(n + argc + 1, s) + ELSE + s[0] := 0X + END +END GetEnv; + + +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + API.SetFini(ProcFini) +END SetFini; + + +PROCEDURE init; +VAR + ptr: INTEGER; + +BEGIN + IF API.MainParam # 0 THEN + envc := -1; + SYSTEM.GET(API.MainParam, argc); + REPEAT + SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr); + INC(envc) + UNTIL ptr = 0 + ELSE + envc := 0; + argc := 0 + END; + + libc := API.libc; + + stdout := API.stdout; + stdin := API.stdin; + stderr := API.stderr; + + malloc := API.malloc; + free := API.free; + exit := API._exit; + puts := API.puts; + fwrite := API.fwrite; + fread := API.fread; + fopen := API.fopen; + fclose := API.fclose; + time := API.time; + + librt := API.librt; + + clock_gettime := API.clock_gettime +END init; + + +PROCEDURE [stdcall64-] syscall* (rax, rdi, rsi, rdx, r10, r8, r9: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) + 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) + 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) + 048H, 08BH, 055H, 028H, (* mov rdx, qword [rbp + 40] *) + 04CH, 08BH, 055H, 030H, (* mov r10, qword [rbp + 48] *) + 04CH, 08BH, 045H, 038H, (* mov r8, qword [rbp + 56] *) + 04CH, 08BH, 04DH, 040H, (* mov r9, qword [rbp + 64] *) + 00FH, 005H, (* syscall *) + 0C9H, (* leave *) + 0C2H, 038H, 000H (* ret 56 *) + ) + RETURN 0 +END syscall; + + +BEGIN + init +END LINAPI. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/Libdl.ob07 b/programs/develop/oberon07/Lib/Linux64/Libdl.ob07 new file mode 100644 index 0000000000..f8a5781d87 --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/Libdl.ob07 @@ -0,0 +1,65 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Libdl; + +IMPORT SYSTEM, API; + + +CONST + + LAZY* = 1; + NOW* = 2; + BINDING_MASK* = 3; + NOLOAD* = 4; + LOCAL* = 0; + GLOBAL* = 256; + NODELETE* = 4096; + + +VAR + + _close: PROCEDURE [linux] (handle: INTEGER): INTEGER; + _error: PROCEDURE [linux] (): INTEGER; + + +PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER; + RETURN API.dlopen(SYSTEM.ADR(file[0]), mode) +END open; + + +PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER; + RETURN API.dlsym(handle, SYSTEM.ADR(name[0])) +END sym; + + +PROCEDURE close* (handle: INTEGER): INTEGER; + RETURN _close(handle) +END close; + + +PROCEDURE error* (): INTEGER; + RETURN _error() +END error; + + +PROCEDURE init; +VAR + lib: INTEGER; + +BEGIN + lib := open("libdl.so.2", LAZY); + SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose")); + ASSERT(_close # NIL); + SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror")); + ASSERT(_error # NIL) +END init; + + +BEGIN + init +END Libdl. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/Math.ob07 b/programs/develop/oberon07/Lib/Linux64/Math.ob07 new file mode 100644 index 0000000000..ab80d79ebf --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/Math.ob07 @@ -0,0 +1,311 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Math; + +IMPORT SYSTEM; + + +CONST + + e *= 2.71828182845904523; + pi *= 3.14159265358979324; + ln2 *= 0.693147180559945309; + + eps = 1.0E-16; + MaxCosArg = 1000000.0 * pi; + + +VAR + + Exp: ARRAY 710 OF REAL; + + +PROCEDURE [stdcall64] sqrt* (x: REAL): REAL; +BEGIN + ASSERT(x >= 0.0); + SYSTEM.CODE( + 0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *) + 05DH, (* pop rbp *) + 0C2H, 08H, 00H (* ret 8 *) + ) + + RETURN 0.0 +END sqrt; + + +PROCEDURE exp* (x: REAL): REAL; +CONST + e25 = 1.284025416687741484; (* exp(0.25) *) + +VAR + a, s, res: REAL; + neg: BOOLEAN; + n: INTEGER; + +BEGIN + neg := x < 0.0; + IF neg THEN + x := -x + END; + + IF x < FLT(LEN(Exp)) THEN + res := Exp[FLOOR(x)]; + x := x - FLT(FLOOR(x)); + WHILE x >= 0.25 DO + res := res * e25; + x := x - 0.25 + END + ELSE + res := SYSTEM.INF(); + x := 0.0 + END; + + n := 0; + a := 1.0; + s := 1.0; + + REPEAT + INC(n); + a := a * x / FLT(n); + s := s + a + UNTIL a < eps; + + IF neg THEN + res := 1.0 / (res * s) + ELSE + res := res * s + END + + RETURN res +END exp; + + +PROCEDURE ln* (x: REAL): REAL; +VAR + a, x2, res: REAL; + n: INTEGER; + +BEGIN + ASSERT(x > 0.0); + UNPK(x, n); + + x := (x - 1.0) / (x + 1.0); + x2 := x * x; + res := x + FLT(n) * (ln2 * 0.5); + n := 1; + + REPEAT + INC(n, 2); + x := x * x2; + a := x / FLT(n); + res := res + a + UNTIL a < eps + + RETURN res * 2.0 +END ln; + + +PROCEDURE power* (base, exponent: REAL): REAL; +BEGIN + ASSERT(base > 0.0) + RETURN exp(exponent * ln(base)) +END power; + + +PROCEDURE log* (base, x: REAL): REAL; +BEGIN + ASSERT(base > 0.0); + ASSERT(x > 0.0) + RETURN ln(x) / ln(base) +END log; + + +PROCEDURE cos* (x: REAL): REAL; +VAR + a, res: REAL; + n: INTEGER; + +BEGIN + x := ABS(x); + ASSERT(x <= MaxCosArg); + + x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi); + x := x * x; + res := 0.0; + a := 1.0; + n := -1; + + REPEAT + INC(n, 2); + res := res + a; + a := -a * x / FLT(n*n + n) + UNTIL ABS(a) < eps + + RETURN res +END cos; + + +PROCEDURE sin* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) <= MaxCosArg); + x := cos(x) + RETURN sqrt(1.0 - x * x) +END sin; + + +PROCEDURE tan* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) <= MaxCosArg); + x := cos(x) + RETURN sqrt(1.0 - x * x) / x +END tan; + + +PROCEDURE arcsin* (x: REAL): REAL; + + + PROCEDURE arctan (x: REAL): REAL; + VAR + z, p, k: REAL; + + BEGIN + p := x / (x * x + 1.0); + z := p * x; + x := 0.0; + k := 0.0; + + REPEAT + k := k + 2.0; + x := x + p; + p := p * k * z / (k + 1.0) + UNTIL p < eps + + RETURN x + END arctan; + + +BEGIN + ASSERT(ABS(x) <= 1.0); + + IF ABS(x) >= 0.707 THEN + x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x) + ELSE + x := arctan(x / sqrt(1.0 - x * x)) + END + + RETURN x +END arcsin; + + +PROCEDURE arccos* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) <= 1.0) + RETURN 0.5 * pi - arcsin(x) +END arccos; + + +PROCEDURE arctan* (x: REAL): REAL; + RETURN arcsin(x / sqrt(1.0 + x * x)) +END arctan; + + +PROCEDURE sinh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x - 1.0 / x) * 0.5 +END sinh; + + +PROCEDURE cosh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x + 1.0 / x) * 0.5 +END cosh; + + +PROCEDURE tanh* (x: REAL): REAL; +BEGIN + IF x > 15.0 THEN + x := 1.0 + ELSIF x < -15.0 THEN + x := -1.0 + ELSE + x := exp(2.0 * x); + x := (x - 1.0) / (x + 1.0) + END + + RETURN x +END tanh; + + +PROCEDURE arsinh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x + 1.0)) +END arsinh; + + +PROCEDURE arcosh* (x: REAL): REAL; +BEGIN + ASSERT(x >= 1.0) + RETURN ln(x + sqrt(x * x - 1.0)) +END arcosh; + + +PROCEDURE artanh* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) < 1.0) + RETURN 0.5 * ln((1.0 + x) / (1.0 - x)) +END artanh; + + +PROCEDURE sgn* (x: REAL): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF x > 0.0 THEN + res := 1 + ELSIF x < 0.0 THEN + res := -1 + 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; + + +PROCEDURE init; +VAR + i: INTEGER; + +BEGIN + Exp[0] := 1.0; + FOR i := 1 TO LEN(Exp) - 1 DO + Exp[i] := Exp[i - 1] * e + END +END init; + + +BEGIN + init +END Math. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/Out.ob07 b/programs/develop/oberon07/Lib/Linux64/Out.ob07 new file mode 100644 index 0000000000..48d4e84c6c --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/Out.ob07 @@ -0,0 +1,276 @@ +(* + Copyright 2013, 2014, 2017, 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 + 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 . +*) + +MODULE Out; + +IMPORT sys := SYSTEM, API; + +CONST + + d = 1.0 - 5.0E-12; + +VAR + + Realp: PROCEDURE (x: REAL; width: INTEGER); + + +PROCEDURE Char*(x: CHAR); +BEGIN + API.putc(x) +END Char; + + +PROCEDURE String*(s: ARRAY OF CHAR); +VAR + i: INTEGER; + +BEGIN + i := 0; + WHILE (i < LEN(s)) & (s[i] # 0X) DO + Char(s[i]); + INC(i) + END +END String; + + +PROCEDURE WriteInt(x, n: INTEGER); +VAR i: INTEGER; a: ARRAY 24 OF CHAR; neg: BOOLEAN; +BEGIN + i := 0; + IF n < 1 THEN + n := 1 + END; + IF x < 0 THEN + x := -x; + DEC(n); + neg := TRUE + END; + REPEAT + a[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + WHILE n > i DO + Char(" "); + DEC(n) + END; + IF neg THEN + Char("-") + END; + REPEAT + DEC(i); + Char(a[i]) + UNTIL i = 0 +END WriteInt; + +PROCEDURE IsNan(AValue: REAL): BOOLEAN; +VAR s: SET; +BEGIN + sys.GET(sys.ADR(AValue), s) + RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {0..31} # {})) +END IsNan; + +PROCEDURE IsInf(x: REAL): BOOLEAN; + RETURN ABS(x) = sys.INF() +END IsInf; + +PROCEDURE Int*(x, width: INTEGER); +VAR i: INTEGER; +BEGIN + IF x # 80000000H THEN + WriteInt(x, width) + ELSE + FOR i := 12 TO width DO + Char(20X) + END; + String("-2147483648") + END +END Int; + +PROCEDURE OutInf(x: REAL; width: INTEGER); +VAR s: ARRAY 5 OF CHAR; i: INTEGER; +BEGIN + IF IsNan(x) THEN + s := "Nan"; + INC(width) + ELSIF IsInf(x) & (x > 0.0) THEN + s := "+Inf" + ELSIF IsInf(x) & (x < 0.0) THEN + s := "-Inf" + END; + FOR i := 1 TO width - 4 DO + Char(" ") + END; + String(s) +END OutInf; + +PROCEDURE Ln*; +BEGIN + Char(0AX) +END Ln; + +PROCEDURE _FixReal(x: REAL; width, p: INTEGER); +VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; +BEGIN + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSIF p < 0 THEN + Realp(x, width) + ELSE + len := 0; + minus := FALSE; + IF x < 0.0 THEN + minus := TRUE; + INC(len); + x := ABS(x) + END; + e := 0; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + + IF e >= 0 THEN + len := len + e + p + 1; + IF x > 9.0 + d THEN + INC(len) + END; + IF p > 0 THEN + INC(len) + END; + ELSE + len := len + p + 2 + END; + FOR i := 1 TO width - len DO + Char(" ") + END; + IF minus THEN + Char("-") + END; + y := x; + WHILE (y < 1.0) & (y # 0.0) DO + y := y * 10.0; + DEC(e) + END; + IF e < 0 THEN + IF x - FLT(FLOOR(x)) > d THEN + Char("1"); + x := 0.0 + ELSE + Char("0"); + x := x * 10.0 + END + ELSE + WHILE e >= 0 DO + IF x - FLT(FLOOR(x)) > d THEN + IF x > 9.0 THEN + String("10") + ELSE + Char(CHR(FLOOR(x) + ORD("0") + 1)) + END; + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(e) + END + END; + IF p > 0 THEN + Char(".") + END; + WHILE p > 0 DO + IF x - FLT(FLOOR(x)) > d THEN + Char(CHR(FLOOR(x) + ORD("0") + 1)); + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(p) + END + END +END _FixReal; + +PROCEDURE Real*(x: REAL; width: INTEGER); +VAR e, n, i: INTEGER; minus: BOOLEAN; +BEGIN + Realp := Real; + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSE + e := 0; + n := 0; + IF width > 23 THEN + n := width - 23; + width := 23 + ELSIF width < 9 THEN + width := 9 + END; + width := width - 5; + IF x < 0.0 THEN + x := -x; + minus := TRUE + ELSE + minus := FALSE + END; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + WHILE (x < 1.0) & (x # 0.0) DO + x := x * 10.0; + DEC(e) + END; + IF x > 9.0 + d THEN + x := 1.0; + INC(e) + END; + FOR i := 1 TO n DO + Char(" ") + END; + IF minus THEN + x := -x + END; + _FixReal(x, width, width - 3); + Char("E"); + IF e >= 0 THEN + Char("+") + ELSE + Char("-"); + e := ABS(e) + END; + IF e < 100 THEN + Char("0") + END; + IF e < 10 THEN + Char("0") + END; + Int(e, 0) + END +END Real; + +PROCEDURE FixReal*(x: REAL; width, p: INTEGER); +BEGIN + Realp := Real; + _FixReal(x, width, p) +END FixReal; + +PROCEDURE Open*; +END Open; + +END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux64/RTL.ob07 b/programs/develop/oberon07/Lib/Linux64/RTL.ob07 new file mode 100644 index 0000000000..94a94eafda --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux64/RTL.ob07 @@ -0,0 +1,516 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2020, Anton Krotov + All rights reserved. +*) + +MODULE RTL; + +IMPORT SYSTEM, API; + + +CONST + + bit_depth* = 64; + maxint* = 7FFFFFFFFFFFFFFFH; + minint* = 8000000000000000H; + + WORD = bit_depth DIV 8; + MAX_SET = bit_depth - 1; + + +VAR + + name: INTEGER; + types: INTEGER; + sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; + + +PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) + 048H, 085H, 0C0H, (* test rax, rax *) + 07EH, 020H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push rdi *) + 056H, (* push rsi *) + 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) + 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) + 048H, 089H, 0C1H, (* mov rcx, rax *) + 048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *) + 0F3H, 048H, 0A5H, (* rep movsd *) + 048H, 089H, 0C1H, (* mov rcx, rax *) + 048H, 083H, 0E1H, 007H, (* and rcx, 7 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop rsi *) + 05FH (* pop rdi *) + (* L: *) + ) +END _move; + + +PROCEDURE [stdcall64] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF len_src > len_dst THEN + res := FALSE + ELSE + _move(len_src * base_size, dst, src); + res := TRUE + END + + RETURN res +END _arrcpy; + + +PROCEDURE [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, dst, src) +END _strcpy; + + +PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER); +VAR + i, n, k: INTEGER; + +BEGIN + k := LEN(A) - 1; + n := A[0]; + i := 0; + WHILE i < k DO + A[i] := A[i + 1]; + INC(i) + END; + A[k] := n +END _rot; + + +PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER; +BEGIN + IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN + SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a) + ELSE + a := 0 + END + + RETURN a +END _set; + + +PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *) +BEGIN + SYSTEM.CODE( + 048H, 031H, 0C0H, (* xor rax, rax *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *) + 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *) + 077H, 004H, (* ja L *) + 048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *) + (* L: *) + ) +END _set1; + + +PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *) +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *) + 048H, 031H, 0D2H, (* xor rdx, rdx *) + 048H, 085H, 0C0H, (* test rax, rax *) + 074H, 022H, (* je L2 *) + 07FH, 003H, (* jg L1 *) + 048H, 0F7H, 0D2H, (* not rdx *) + (* L1: *) + 049H, 089H, 0C0H, (* mov r8, rax *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *) + 048H, 0F7H, 0F9H, (* idiv rcx *) + 048H, 085H, 0D2H, (* test rdx, rdx *) + 074H, 00EH, (* je L2 *) + 049H, 031H, 0C8H, (* xor r8, rcx *) + 04DH, 085H, 0C0H, (* test r8, r8 *) + 07DH, 006H, (* jge L2 *) + 048H, 0FFH, 0C8H, (* dec rax *) + 048H, 001H, 0CAH (* add rdx, rcx *) + (* L2: *) + ) +END _divmod; + + +PROCEDURE [stdcall64] _new* (t, size: INTEGER; VAR ptr: INTEGER); +BEGIN + ptr := API._NEW(size); + IF ptr # 0 THEN + SYSTEM.PUT(ptr, t); + INC(ptr, WORD) + END +END _new; + + +PROCEDURE [stdcall64] _dispose* (VAR ptr: INTEGER); +BEGIN + IF ptr # 0 THEN + ptr := API._DISPOSE(ptr - WORD) + END +END _dispose; + + +PROCEDURE [stdcall64] _length* (len, str: INTEGER); +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) + 048H, 0FFH, 0C8H, (* dec rax *) + (* L1: *) + 048H, 0FFH, 0C0H, (* inc rax *) + 080H, 038H, 000H, (* cmp byte [rax], 0 *) + 074H, 005H, (* jz L2 *) + 0E2H, 0F6H, (* loop L1 *) + 048H, 0FFH, 0C0H, (* inc rax *) + (* L2: *) + 048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *) + ) +END _length; + + +PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER); +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) + 048H, 083H, 0E8H, 002H, (* sub rax, 2 *) + (* L1: *) + 048H, 083H, 0C0H, 002H, (* add rax, 2 *) + 066H, 083H, 038H, 000H, (* cmp word [rax], 0 *) + 074H, 006H, (* jz L2 *) + 0E2H, 0F4H, (* loop L1 *) + 048H, 083H, 0C0H, 002H, (* add rax, 2 *) + (* L2: *) + 048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *) + 048H, 0D1H, 0E8H (* shr rax, 1 *) + ) +END _lengthw; + + +PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) + 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) + 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) + 04DH, 031H, 0C9H, (* xor r9, r9 *) + 04DH, 031H, 0D2H, (* xor r10, r10 *) + 048H, 0B8H, 000H, 000H, + 000H, 000H, 000H, 000H, + 000H, 080H, (* movabs rax, minint *) + (* L1: *) + 04DH, 085H, 0C0H, (* test r8, r8 *) + 07EH, 024H, (* jle L3 *) + 044H, 08AH, 009H, (* mov r9b, byte[rcx] *) + 044H, 08AH, 012H, (* mov r10b, byte[rdx] *) + 048H, 0FFH, 0C1H, (* inc rcx *) + 048H, 0FFH, 0C2H, (* inc rdx *) + 049H, 0FFH, 0C8H, (* dec r8 *) + 04DH, 039H, 0D1H, (* cmp r9, r10 *) + 074H, 008H, (* je L2 *) + 04CH, 089H, 0C8H, (* mov rax, r9 *) + 04CH, 029H, 0D0H, (* sub rax, r10 *) + 0EBH, 008H, (* jmp L3 *) + (* L2: *) + 04DH, 085H, 0C9H, (* test r9, r9 *) + 075H, 0DAH, (* jne L1 *) + 048H, 031H, 0C0H, (* xor rax, rax *) + (* L3: *) + 05DH, (* pop rbp *) + 0C2H, 018H, 000H (* ret 24 *) + ) + RETURN 0 +END strncmp; + + +PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) + 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) + 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) + 04DH, 031H, 0C9H, (* xor r9, r9 *) + 04DH, 031H, 0D2H, (* xor r10, r10 *) + 048H, 0B8H, 000H, 000H, + 000H, 000H, 000H, 000H, + 000H, 080H, (* movabs rax, minint *) + (* L1: *) + 04DH, 085H, 0C0H, (* test r8, r8 *) + 07EH, 028H, (* jle L3 *) + 066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *) + 066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *) + 048H, 083H, 0C1H, 002H, (* add rcx, 2 *) + 048H, 083H, 0C2H, 002H, (* add rdx, 2 *) + 049H, 0FFH, 0C8H, (* dec r8 *) + 04DH, 039H, 0D1H, (* cmp r9, r10 *) + 074H, 008H, (* je L2 *) + 04CH, 089H, 0C8H, (* mov rax, r9 *) + 04CH, 029H, 0D0H, (* sub rax, r10 *) + 0EBH, 008H, (* jmp L3 *) + (* L2: *) + 04DH, 085H, 0C9H, (* test r9, r9 *) + 075H, 0D6H, (* jne L1 *) + 048H, 031H, 0C0H, (* xor rax, rax *) + (* L3: *) + 05DH, (* pop rbp *) + 0C2H, 018H, 000H (* ret 24 *) + ) + RETURN 0 +END strncmpw; + + +PROCEDURE [stdcall64] _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 = minint THEN + 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 + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes +END _strcmp; + + +PROCEDURE [stdcall64] _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 = minint THEN + 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 + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes +END _strcmpw; + + +PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); +VAR + c: CHAR; + i: INTEGER; + +BEGIN + i := 0; + REPEAT + SYSTEM.GET(pchar, c); + s[i] := c; + INC(pchar); + INC(i) + UNTIL c = 0X +END PCharToStr; + + +PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a, b: INTEGER; + c: CHAR; + +BEGIN + i := 0; + REPEAT + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + + a := 0; + b := i - 1; + WHILE a < b DO + c := str[a]; + str[a] := str[b]; + str[b] := c; + INC(a); + DEC(b) + END; + str[i] := 0X +END IntToStr; + + +PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2, i, j: INTEGER; + +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + i := 0; + j := n1; + WHILE i < n2 DO + s1[j] := s2[i]; + INC(i); + INC(j) + END; + + s1[j] := 0X +END append; + + +PROCEDURE [stdcall64] _error* (module, err, line: INTEGER); +VAR + s, temp: ARRAY 1024 OF CHAR; + +BEGIN + CASE err OF + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" + END; + + append(s, API.eol); + + append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); + append(s, "line: "); IntToStr(line, temp); append(s, temp); + + API.DebugMsg(SYSTEM.ADR(s[0]), name); + + API.exit_thread(0) +END _error; + + +PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 +END _isrec; + + +PROCEDURE [stdcall64] _is* (t0, p: INTEGER): INTEGER; +BEGIN + IF p # 0 THEN + SYSTEM.GET(p - WORD, p); + SYSTEM.GET(t0 + p + types, p) + END + + RETURN p MOD 2 +END _is; + + +PROCEDURE [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 +END _guardrec; + + +PROCEDURE [stdcall64] _guard* (t0, p: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(p, p); + IF p # 0 THEN + SYSTEM.GET(p - WORD, p); + SYSTEM.GET(t0 + p + types, p) + ELSE + p := 1 + END + + RETURN p MOD 2 +END _guard; + + +PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) +END _dllentry; + + +PROCEDURE [stdcall64] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + +PROCEDURE [stdcall64] _exit* (code: INTEGER); +BEGIN + API.exit(code) +END _exit; + + +PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); +VAR + t0, t1, i, j: INTEGER; + +BEGIN + API.init(param, code); + + 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 * WORD, t1) + END; + + SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) + END + END; + + FOR i := 0 TO MAX_SET DO + FOR j := 0 TO i DO + sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i) + END + END; + + name := modname +END _init; + + +END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/API.ob07 b/programs/develop/oberon07/Lib/Windows32/API.ob07 index ec9ce7a93a..0eaf6c9a7a 100644 --- a/programs/develop/oberon07/Lib/Windows32/API.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/API.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -14,6 +14,16 @@ CONST SectionAlignment = 1000H; + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + +TYPE + + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + VAR @@ -21,6 +31,10 @@ VAR base*: INTEGER; heap: INTEGER; + process_detach, + thread_detach, + thread_attach: DLL_ENTRY; + PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); @@ -51,6 +65,9 @@ END _DISPOSE; PROCEDURE init* (reserved, code: INTEGER); BEGIN + process_detach := NIL; + thread_detach := NIL; + thread_attach := NIL; eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; base := code - SectionAlignment; heap := GetProcessHeap() @@ -69,4 +86,45 @@ BEGIN END exit_thread; -END API. +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := 0; + + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + IF thread_attach # NIL THEN + thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + IF thread_detach # NIL THEN + thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + IF process_detach # NIL THEN + process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + END + + RETURN res +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + +PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY); +BEGIN + process_detach := _process_detach; + thread_detach := _thread_detach; + thread_attach := _thread_attach +END SetDll; + + +END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/Args.ob07 b/programs/develop/oberon07/Lib/Windows32/Args.ob07 new file mode 100644 index 0000000000..7777687a4b --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/Args.ob07 @@ -0,0 +1,101 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Args; + +IMPORT SYSTEM, WINAPI; + + +CONST + + MAX_PARAM = 1024; + + +VAR + + Params: ARRAY MAX_PARAM, 2 OF INTEGER; + argc*: INTEGER; + + +PROCEDURE GetChar (adr: INTEGER): CHAR; +VAR + res: CHAR; + +BEGIN + SYSTEM.GET(adr, res) + RETURN res +END GetChar; + + +PROCEDURE ParamParse; +VAR + p, count, cond: INTEGER; + c: CHAR; + + + PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR): INTEGER; + BEGIN + IF (c <= 20X) & (c # 0X) THEN + cond := A + ELSIF c = 22X THEN + cond := B + ELSIF c = 0X THEN + cond := 6 + ELSE + cond := C + END + + RETURN cond + END ChangeCond; + + +BEGIN + p := WINAPI.GetCommandLine(); + cond := 0; + count := 0; + WHILE (count < MAX_PARAM) & (cond # 6) DO + c := GetChar(p); + CASE cond OF + |0: IF ChangeCond(0, 4, 1, cond, c) = 1 THEN Params[count, 0] := p END + |1: IF ChangeCond(0, 3, 1, cond, c) IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END + |3: IF ChangeCond(3, 1, 3, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END + |4: IF ChangeCond(5, 0, 5, cond, c) = 5 THEN Params[count, 0] := p END + |5: IF ChangeCond(5, 1, 5, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END + |6: + END; + INC(p) + END; + argc := count +END ParamParse; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, j, len: INTEGER; + c: CHAR; + +BEGIN + j := 0; + IF n < argc THEN + i := Params[n, 0]; + len := LEN(s) - 1; + WHILE (j < len) & (i <= Params[n, 1]) DO + c := GetChar(i); + IF c # '"' THEN + s[j] := c; + INC(j) + END; + INC(i) + END + END; + s[j] := 0X +END GetArg; + + +BEGIN + ParamParse +END Args. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/Console.ob07 b/programs/develop/oberon07/Lib/Windows32/Console.ob07 new file mode 100644 index 0000000000..3cbfdb0a34 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/Console.ob07 @@ -0,0 +1,100 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Console; + +IMPORT SYSTEM, WINAPI, In, Out; + + +CONST + + Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3; + Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7; + DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11; + LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15; + + +VAR + + hConsoleOutput: INTEGER; + + +PROCEDURE SetCursor* (X, Y: INTEGER); +BEGIN + WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536) +END SetCursor; + + +PROCEDURE GetCursor* (VAR X, Y: INTEGER); +VAR + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); + X := ORD(ScrBufInfo.dwCursorPosition.X); + Y := ORD(ScrBufInfo.dwCursorPosition.Y) +END GetCursor; + + +PROCEDURE Cls*; +VAR + fill: INTEGER; + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); + fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y); + WINAPI.FillConsoleOutputCharacter(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); + WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill)); + SetCursor(0, 0) +END Cls; + + +PROCEDURE SetColor* (FColor, BColor: INTEGER); +BEGIN + IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN + WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor) + END +END SetColor; + + +PROCEDURE GetCursorX* (): INTEGER; +VAR + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) + RETURN ORD(ScrBufInfo.dwCursorPosition.X) +END GetCursorX; + + +PROCEDURE GetCursorY* (): INTEGER; +VAR + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) + RETURN ORD(ScrBufInfo.dwCursorPosition.Y) +END GetCursorY; + + +PROCEDURE open*; +BEGIN + WINAPI.AllocConsole; + hConsoleOutput := WINAPI.GetStdHandle(-11); + In.Open; + Out.Open +END open; + + +PROCEDURE exit* (b: BOOLEAN); +BEGIN + WINAPI.FreeConsole +END exit; + + +END Console. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/DateTime.ob07 b/programs/develop/oberon07/Lib/Windows32/DateTime.ob07 new file mode 100644 index 0000000000..0a31732893 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/DateTime.ob07 @@ -0,0 +1,174 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE DateTime; + +IMPORT WINAPI; + + +CONST + + ERR* = -7.0E5; + + +VAR + + DateTable: ARRAY 120000, 3 OF INTEGER; + MonthsTable: ARRAY 13, 4 OF INTEGER; + + +PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL; +VAR + d, bis: INTEGER; + res: REAL; + +BEGIN + res := ERR; + IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) & + (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) & + (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) & + (MSec >= 0) & (MSec <= 999) THEN + + bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0)); + + IF Day <= MonthsTable[Month][2 + bis] THEN + DEC(Year); + d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + + MonthsTable[Month][bis] + Day - 693594; + res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0 + END + END + RETURN res +END Encode; + + +PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + d, t: INTEGER; + L, R, M: INTEGER; + +BEGIN + res := (Date >= -693593.0) & (Date < 2958466.0); + IF res THEN + d := FLOOR(Date); + t := FLOOR((Date - FLT(d)) * 86400000.0); + INC(d, 693593); + + L := 0; + R := LEN(DateTable) - 1; + M := (L + R) DIV 2; + + WHILE R - L > 1 DO + IF d > DateTable[M][0] THEN + L := M; + M := (L + R) DIV 2 + ELSIF d < DateTable[M][0] THEN + R := M; + M := (L + R) DIV 2 + ELSE + L := M; + R := M + END + END; + + Year := DateTable[L][1]; + Month := DateTable[L][2]; + Day := d - DateTable[L][0] + 1; + + Hour := t DIV 3600000; t := t MOD 3600000; + Min := t DIV 60000; t := t MOD 60000; + Sec := t DIV 1000; + MSec := t MOD 1000 + END + + RETURN res +END Decode; + + +PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER); +VAR + T: WINAPI.TSystemTime; + +BEGIN + WINAPI.GetLocalTime(T); + Year := ORD(T.Year); + Month := ORD(T.Month); + Day := ORD(T.Day); + Hour := ORD(T.Hour); + Min := ORD(T.Min); + Sec := ORD(T.Sec); + MSec := ORD(T.MSec) +END Now; + + +PROCEDURE NowEncode* (): REAL; +VAR + Year, Month, Day, Hour, Min, Sec, MSec: INTEGER; + +BEGIN + Now(Year, Month, Day, Hour, Min, Sec, MSec) + RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec) +END NowEncode; + + +PROCEDURE init; +VAR + day, year, month, i: INTEGER; + Months: ARRAY 13 OF INTEGER; + +BEGIN + Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30; + Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31; + Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31; + + day := 0; + year := 1; + month := 1; + i := 0; + + WHILE year <= 10000 DO + DateTable[i][0] := day; + DateTable[i][1] := year; + DateTable[i][2] := month; + INC(day, Months[month]); + IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN + INC(day) + END; + INC(month); + IF month > 12 THEN + month := 1; + INC(year) + END; + INC(i) + END; + + MonthsTable[1][0] := 0; + FOR i := 2 TO 12 DO + MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1] + END; + + FOR i := 1 TO 12 DO + MonthsTable[i][2] := Months[i] + END; + + Months[2] := 29; + MonthsTable[1][1] := 0; + FOR i := 2 TO 12 DO + MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1] + END; + + FOR i := 1 TO 12 DO + MonthsTable[i][3] := Months[i] + END + +END init; + + +BEGIN + init +END DateTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/File.ob07 b/programs/develop/oberon07/Lib/Windows32/File.ob07 new file mode 100644 index 0000000000..9f3470636b --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/File.ob07 @@ -0,0 +1,142 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE File; + +IMPORT SYSTEM, WINAPI; + + +CONST + + OPEN_R* = 0; OPEN_W* = 1; OPEN_RW* = 2; + SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2; + + +PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN; +VAR + FindData: WINAPI.TWin32FindData; + Handle: INTEGER; + +BEGIN + Handle := WINAPI.FindFirstFile(SYSTEM.ADR(FName[0]), FindData); + IF Handle # -1 THEN + WINAPI.FindClose(Handle); + IF 4 IN FindData.dwFileAttributes THEN + Handle := -1 + END + END + + RETURN Handle # -1 +END Exists; + + +PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN; + RETURN WINAPI.DeleteFile(SYSTEM.ADR(FName[0])) # 0 +END Delete; + + +PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER; + RETURN WINAPI.CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) +END Create; + + +PROCEDURE Close* (F: INTEGER); +BEGIN + WINAPI.CloseHandle(F) +END Close; + + +PROCEDURE Open* (FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER; +VAR + ofstr: WINAPI.OFSTRUCT; +BEGIN + RETURN WINAPI.OpenFile(SYSTEM.ADR(FName[0]), ofstr, Mode) +END Open; + + +PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER; + RETURN WINAPI.SetFilePointer(F, Offset, 0, Origin) +END Seek; + + +PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER; +VAR + res, n: INTEGER; + +BEGIN + IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(n), NIL) = 0 THEN + res := -1 + ELSE + res := n + END + + RETURN res +END Read; + + +PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER; +VAR + res, n: INTEGER; + +BEGIN + IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(n), NIL) = 0 THEN + res := -1 + ELSE + res := n + END + + RETURN res +END Write; + + +PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER; +VAR + res, n, F: INTEGER; + +BEGIN + res := 0; + F := Open(FName, OPEN_R); + + IF F # -1 THEN + Size := Seek(F, 0, SEEK_END); + n := Seek(F, 0, SEEK_BEG); + res := WINAPI.GlobalAlloc(64, Size); + IF (res = 0) OR (Read(F, res, Size) # Size) THEN + IF res # 0 THEN + WINAPI.GlobalFree(Size); + res := 0; + Size := 0 + END + END; + Close(F) + END + + RETURN res +END Load; + + +PROCEDURE RemoveDir* (DirName: ARRAY OF CHAR): BOOLEAN; + RETURN WINAPI.RemoveDirectory(SYSTEM.ADR(DirName[0])) # 0 +END RemoveDir; + + +PROCEDURE ExistsDir* (DirName: ARRAY OF CHAR): BOOLEAN; +VAR + Code: SET; + +BEGIN + Code := WINAPI.GetFileAttributes(SYSTEM.ADR(DirName[0])) + RETURN (Code # {0..31}) & (4 IN Code) +END ExistsDir; + + +PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN; + RETURN WINAPI.CreateDirectory(SYSTEM.ADR(DirName[0]), NIL) # 0 +END CreateDir; + + +END File. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 b/programs/develop/oberon07/Lib/Windows32/HOST.ob07 index 8e5568d8f1..e63f9b6d72 100644 --- a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/HOST.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -82,6 +82,8 @@ VAR eol*: ARRAY 3 OF CHAR; + maxreal*: REAL; + PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] _GetTickCount (): INTEGER; @@ -310,6 +312,42 @@ PROCEDURE UnixTime* (): INTEGER; END UnixTime; +PROCEDURE d2s* (x: REAL): INTEGER; +VAR + h, l, s, e: INTEGER; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h); + + s := ASR(h, 31) MOD 2; + e := (h DIV 100000H) MOD 2048; + IF e <= 896 THEN + h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; + REPEAT + h := h DIV 2; + INC(e) + UNTIL e = 897; + e := 896; + l := (h MOD 8) * 20000000H; + h := h DIV 8 + ELSIF (1151 <= e) & (e < 2047) THEN + e := 1151; + h := 0; + l := 0 + ELSIF e = 2047 THEN + e := 1151; + IF (h MOD 100000H # 0) OR (l # 0) THEN + h := 80000H; + l := 0 + END + END; + DEC(e, 896) + + RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 +END d2s; + + PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; VAR res: INTEGER; @@ -326,6 +364,8 @@ END splitf; BEGIN eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + maxreal := 1.9; + PACK(maxreal, 1023); hConsoleOutput := _GetStdHandle(-11); ParamParse -END HOST. +END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/In.ob07 b/programs/develop/oberon07/Lib/Windows32/In.ob07 new file mode 100644 index 0000000000..02aa8c426d --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/In.ob07 @@ -0,0 +1,289 @@ +(* + Copyright 2013, 2017, 2018 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 . +*) + +MODULE In; + +IMPORT sys := SYSTEM, WINAPI; + +TYPE + + STRING = ARRAY 260 OF CHAR; + +VAR + + Done*: BOOLEAN; + hConsoleInput: INTEGER; + +PROCEDURE digit(ch: CHAR): BOOLEAN; + RETURN (ch >= "0") & (ch <= "9") +END digit; + +PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN; +VAR i: INTEGER; +BEGIN + i := 0; + neg := FALSE; + WHILE (s[i] <= 20X) & (s[i] # 0X) DO + INC(i) + END; + IF s[i] = "-" THEN + neg := TRUE; + INC(i) + ELSIF s[i] = "+" THEN + INC(i) + END; + first := i; + WHILE digit(s[i]) DO + INC(i) + END; + last := i + RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first]) +END CheckInt; + +PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN; +VAR i: INTEGER; min: STRING; +BEGIN + i := 0; + min := "2147483648"; + WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO + INC(i) + END + RETURN i = 10 +END IsMinInt; + +PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER; +CONST maxINT = 7FFFFFFFH; +VAR i, n, res: INTEGER; flag, neg: BOOLEAN; +BEGIN + res := 0; + flag := CheckInt(str, i, n, neg, FALSE); + err := ~flag; + IF flag & neg & IsMinInt(str, i) THEN + flag := FALSE; + neg := FALSE; + res := 80000000H + END; + WHILE flag & digit(str[i]) DO + IF res > maxINT DIV 10 THEN + err := TRUE; + flag := FALSE; + res := 0 + ELSE + res := res * 10; + IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN + err := TRUE; + flag := FALSE; + res := 0 + ELSE + res := res + (ORD(str[i]) - ORD("0")); + INC(i) + END + END + END; + IF neg THEN + res := -res + END + RETURN res +END StrToInt; + +PROCEDURE Space(s: STRING): BOOLEAN; +VAR i: INTEGER; +BEGIN + i := 0; + WHILE (s[i] # 0X) & (s[i] <= 20X) DO + INC(i) + END + RETURN s[i] = 0X +END Space; + +PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN; +VAR i: INTEGER; Res: BOOLEAN; +BEGIN + Res := CheckInt(s, n, i, neg, TRUE); + IF Res THEN + IF s[i] = "." THEN + INC(i); + WHILE digit(s[i]) DO + INC(i) + END; + IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN + INC(i); + IF (s[i] = "+") OR (s[i] = "-") THEN + INC(i) + END; + Res := digit(s[i]); + WHILE digit(s[i]) DO + INC(i) + END + END + END + END + RETURN Res & (s[i] <= 20X) +END CheckReal; + +PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL; +CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH; +VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN; + + PROCEDURE part1(VAR res, d: REAL; VAR i: INTEGER; str: STRING): BOOLEAN; + BEGIN + res := 0.0; + d := 1.0; + WHILE digit(str[i]) DO + res := res * 10.0 + FLT(ORD(str[i]) - ORD("0")); + INC(i) + END; + IF str[i] = "." THEN + INC(i); + WHILE digit(str[i]) DO + d := d / 10.0; + res := res + FLT(ORD(str[i]) - ORD("0")) * d; + INC(i) + END + END + RETURN str[i] # 0X + END part1; + + PROCEDURE part2(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): BOOLEAN; + BEGIN + INC(i); + m := 10.0; + minus := FALSE; + IF str[i] = "+" THEN + INC(i) + ELSIF str[i] = "-" THEN + minus := TRUE; + INC(i); + m := 0.1 + END; + scale := 0; + err := FALSE; + WHILE ~err & digit(str[i]) DO + IF scale > maxINT DIV 10 THEN + err := TRUE; + res := 0.0 + ELSE + scale := scale * 10; + IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN + err := TRUE; + res := 0.0 + ELSE + scale := scale + (ORD(str[i]) - ORD("0")); + INC(i) + END + END + END + RETURN ~err + END part2; + + PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR scale: INTEGER; VAR res, m: REAL); + VAR i: INTEGER; + BEGIN + err := FALSE; + IF scale = maxINT THEN + err := TRUE; + res := 0.0 + END; + i := 1; + WHILE ~err & (i <= scale) DO + IF ~minus & (res > maxDBL / m) THEN + err := TRUE; + res := 0.0 + ELSE + res := res * m; + INC(i) + END + END + END part3; + +BEGIN + IF CheckReal(str, i, neg) THEN + IF part1(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN + part3(err, minus, scale, res, m) + END; + IF neg THEN + res := -res + END + ELSE + res := 0.0; + err := TRUE + END + RETURN res +END StrToFloat; + +PROCEDURE String*(VAR s: ARRAY OF CHAR); +VAR count, i: INTEGER; str: STRING; +BEGIN + WINAPI.ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0); + IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN + DEC(count, 2) + END; + str[256] := 0X; + str[count] := 0X; + i := 0; + WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO + s[i] := str[i]; + INC(i) + END; + s[i] := 0X; + Done := TRUE +END String; + +PROCEDURE Char*(VAR x: CHAR); +VAR str: STRING; +BEGIN + String(str); + x := str[0]; + Done := TRUE +END Char; + +PROCEDURE Ln*; +VAR str: STRING; +BEGIN + String(str); + Done := TRUE +END Ln; + +PROCEDURE Real*(VAR x: REAL); +VAR str: STRING; err: BOOLEAN; +BEGIN + err := FALSE; + REPEAT + String(str) + UNTIL ~Space(str); + x := StrToFloat(str, err); + Done := ~err +END Real; + +PROCEDURE Int*(VAR x: INTEGER); +VAR str: STRING; err: BOOLEAN; +BEGIN + err := FALSE; + REPEAT + String(str) + UNTIL ~Space(str); + x := StrToInt(str, err); + Done := ~err +END Int; + +PROCEDURE Open*; +BEGIN + hConsoleInput := WINAPI.GetStdHandle(-10); + Done := TRUE +END Open; + +END In. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/Math.ob07 b/programs/develop/oberon07/Lib/Windows32/Math.ob07 new file mode 100644 index 0000000000..b1fe62acc0 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/Math.ob07 @@ -0,0 +1,384 @@ +(* + 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 + 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 . +*) + +MODULE Math; + +IMPORT SYSTEM; + + +CONST + + pi* = 3.141592653589793; + e* = 2.718281828459045; + + +PROCEDURE IsNan* (x: REAL): BOOLEAN; +VAR + h, l: SET; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h) + RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) +END IsNan; + + +PROCEDURE IsInf* (x: REAL): BOOLEAN; + RETURN ABS(x) = SYSTEM.INF() +END IsInf; + + +PROCEDURE Max (a, b: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF a > b THEN + res := a + ELSE + res := b + END + RETURN res +END Max; + + +PROCEDURE Min (a, b: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF a < b THEN + res := a + ELSE + res := b + END + RETURN res +END Min; + + +PROCEDURE SameValue (a, b: REAL): BOOLEAN; +VAR + eps: REAL; + res: BOOLEAN; + +BEGIN + eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12); + IF a > b THEN + res := (a - b) <= eps + ELSE + res := (b - a) <= eps + END + RETURN res +END SameValue; + + +PROCEDURE IsZero (x: REAL): BOOLEAN; + RETURN ABS(x) <= 1.0E-12 +END IsZero; + + +PROCEDURE [stdcall] sqrt* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FAH, (* fsqrt *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END sqrt; + + +PROCEDURE [stdcall] sin* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FEH, (* fsin *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END sin; + + +PROCEDURE [stdcall] cos* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FFH, (* fcos *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END cos; + + +PROCEDURE [stdcall] tan* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FBH, (* fsincos *) + 0DEH, 0F9H, (* fdivp st1, st *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END tan; + + +PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0D9H, 0F3H, (* fpatan *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 10h *) + ) + RETURN 0.0 +END arctan2; + + +PROCEDURE [stdcall] ln* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0D9H, 0EDH, (* fldln2 *) + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0F1H, (* fyl2x *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END ln; + + +PROCEDURE [stdcall] log* (base, x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0D9H, 0E8H, (* fld1 *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0D9H, 0F1H, (* fyl2x *) + 0D9H, 0E8H, (* fld1 *) + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0F1H, (* fyl2x *) + 0DEH, 0F9H, (* fdivp st1, st *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 10h *) + ) + RETURN 0.0 +END log; + + +PROCEDURE [stdcall] exp* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0EAH, (* fldl2e *) + 0DEH, 0C9H, 0D9H, 0C0H, + 0D9H, 0FCH, 0DCH, 0E9H, + 0D9H, 0C9H, 0D9H, 0F0H, + 0D9H, 0E8H, 0DEH, 0C1H, + 0D9H, 0FDH, 0DDH, 0D9H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END exp; + + +PROCEDURE [stdcall] round* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 07DH, 0F4H, 0D9H, + 07DH, 0F6H, 066H, 081H, + 04DH, 0F6H, 000H, 003H, + 0D9H, 06DH, 0F6H, 0D9H, + 0FCH, 0D9H, 06DH, 0F4H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END round; + + +PROCEDURE [stdcall] frac* (x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 050H, + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0C0H, 0D9H, 03CH, + 024H, 0D9H, 07CH, 024H, + 002H, 066H, 081H, 04CH, + 024H, 002H, 000H, 00FH, + 0D9H, 06CH, 024H, 002H, + 0D9H, 0FCH, 0D9H, 02CH, + 024H, 0DEH, 0E9H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 +END frac; + + +PROCEDURE arcsin* (x: REAL): REAL; + RETURN arctan2(x, sqrt(1.0 - x * x)) +END arcsin; + + +PROCEDURE arccos* (x: REAL): REAL; + RETURN arctan2(sqrt(1.0 - x * x), x) +END arccos; + + +PROCEDURE arctan* (x: REAL): REAL; + RETURN arctan2(x, 1.0) +END arctan; + + +PROCEDURE sinh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x - 1.0 / x) * 0.5 +END sinh; + + +PROCEDURE cosh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x + 1.0 / x) * 0.5 +END cosh; + + +PROCEDURE tanh* (x: REAL): REAL; +BEGIN + IF x > 15.0 THEN + x := 1.0 + ELSIF x < -15.0 THEN + x := -1.0 + ELSE + x := exp(2.0 * x); + x := (x - 1.0) / (x + 1.0) + END + + RETURN x +END tanh; + + +PROCEDURE arsinh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x + 1.0)) +END arsinh; + + +PROCEDURE arcosh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x - 1.0)) +END arcosh; + + +PROCEDURE artanh* (x: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF SameValue(x, 1.0) THEN + res := SYSTEM.INF() + ELSIF SameValue(x, -1.0) THEN + res := -SYSTEM.INF() + ELSE + res := 0.5 * ln((1.0 + x) / (1.0 - x)) + END + RETURN res +END artanh; + + +PROCEDURE floor* (x: REAL): REAL; +VAR + f: REAL; + +BEGIN + f := frac(x); + x := x - f; + IF f < 0.0 THEN + x := x - 1.0 + END + RETURN x +END floor; + + +PROCEDURE ceil* (x: REAL): REAL; +VAR + f: REAL; + +BEGIN + f := frac(x); + x := x - f; + IF f > 0.0 THEN + x := x + 1.0 + END + RETURN x +END ceil; + + +PROCEDURE power* (base, exponent: REAL): REAL; +VAR + res: REAL; + +BEGIN + IF exponent = 0.0 THEN + res := 1.0 + ELSIF (base = 0.0) & (exponent > 0.0) THEN + res := 0.0 + ELSE + res := exp(exponent * ln(base)) + END + RETURN res +END power; + + +PROCEDURE sgn* (x: REAL): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF x > 0.0 THEN + res := 1 + ELSIF x < 0.0 THEN + res := -1 + 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. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/Out.ob07 b/programs/develop/oberon07/Lib/Windows32/Out.ob07 new file mode 100644 index 0000000000..6e6950c00b --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/Out.ob07 @@ -0,0 +1,280 @@ +(* + Copyright 2013, 2014, 2017, 2018 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 . +*) + +MODULE Out; + +IMPORT sys := SYSTEM, WINAPI; + +CONST + + d = 1.0 - 5.0E-12; + +VAR + + hConsoleOutput: INTEGER; + Realp: PROCEDURE (x: REAL; width: INTEGER); + + +PROCEDURE String*(s: ARRAY OF CHAR); +VAR count: INTEGER; +BEGIN + WINAPI.WriteFile(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), NIL) +END String; + +PROCEDURE StringW*(s: ARRAY OF WCHAR); +VAR count: INTEGER; +BEGIN + WINAPI.WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0) +END StringW; + +PROCEDURE Char*(x: CHAR); +VAR count: INTEGER; +BEGIN + WINAPI.WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL) +END Char; + +PROCEDURE WriteInt(x, n: INTEGER); +VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN; +BEGIN + i := 0; + IF n < 1 THEN + n := 1 + END; + IF x < 0 THEN + x := -x; + DEC(n); + neg := TRUE + END; + REPEAT + a[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + WHILE n > i DO + Char(" "); + DEC(n) + END; + IF neg THEN + Char("-") + END; + REPEAT + DEC(i); + Char(a[i]) + UNTIL i = 0 +END WriteInt; + +PROCEDURE IsNan(AValue: REAL): BOOLEAN; +VAR h, l: SET; +BEGIN + sys.GET(sys.ADR(AValue), l); + sys.GET(sys.ADR(AValue) + 4, h) + RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) +END IsNan; + +PROCEDURE IsInf(x: REAL): BOOLEAN; + RETURN ABS(x) = sys.INF() +END IsInf; + +PROCEDURE Int*(x, width: INTEGER); +VAR i: INTEGER; +BEGIN + IF x # 80000000H THEN + WriteInt(x, width) + ELSE + FOR i := 12 TO width DO + Char(20X) + END; + String("-2147483648") + END +END Int; + +PROCEDURE OutInf(x: REAL; width: INTEGER); +VAR s: ARRAY 5 OF CHAR; i: INTEGER; +BEGIN + IF IsNan(x) THEN + s := "Nan"; + INC(width) + ELSIF IsInf(x) & (x > 0.0) THEN + s := "+Inf" + ELSIF IsInf(x) & (x < 0.0) THEN + s := "-Inf" + END; + FOR i := 1 TO width - 4 DO + Char(" ") + END; + String(s) +END OutInf; + +PROCEDURE Ln*; +BEGIN + Char(0DX); + Char(0AX) +END Ln; + +PROCEDURE _FixReal(x: REAL; width, p: INTEGER); +VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; +BEGIN + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSIF p < 0 THEN + Realp(x, width) + ELSE + len := 0; + minus := FALSE; + IF x < 0.0 THEN + minus := TRUE; + INC(len); + x := ABS(x) + END; + e := 0; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + + IF e >= 0 THEN + len := len + e + p + 1; + IF x > 9.0 + d THEN + INC(len) + END; + IF p > 0 THEN + INC(len) + END; + ELSE + len := len + p + 2 + END; + FOR i := 1 TO width - len DO + Char(" ") + END; + IF minus THEN + Char("-") + END; + y := x; + WHILE (y < 1.0) & (y # 0.0) DO + y := y * 10.0; + DEC(e) + END; + IF e < 0 THEN + IF x - FLT(FLOOR(x)) > d THEN + Char("1"); + x := 0.0 + ELSE + Char("0"); + x := x * 10.0 + END + ELSE + WHILE e >= 0 DO + IF x - FLT(FLOOR(x)) > d THEN + IF x > 9.0 THEN + String("10") + ELSE + Char(CHR(FLOOR(x) + ORD("0") + 1)) + END; + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(e) + END + END; + IF p > 0 THEN + Char(".") + END; + WHILE p > 0 DO + IF x - FLT(FLOOR(x)) > d THEN + Char(CHR(FLOOR(x) + ORD("0") + 1)); + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(p) + END + END +END _FixReal; + +PROCEDURE Real*(x: REAL; width: INTEGER); +VAR e, n, i: INTEGER; minus: BOOLEAN; +BEGIN + Realp := Real; + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSE + e := 0; + n := 0; + IF width > 23 THEN + n := width - 23; + width := 23 + ELSIF width < 9 THEN + width := 9 + END; + width := width - 5; + IF x < 0.0 THEN + x := -x; + minus := TRUE + ELSE + minus := FALSE + END; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + WHILE (x < 1.0) & (x # 0.0) DO + x := x * 10.0; + DEC(e) + END; + IF x > 9.0 + d THEN + x := 1.0; + INC(e) + END; + FOR i := 1 TO n DO + Char(" ") + END; + IF minus THEN + x := -x + END; + _FixReal(x, width, width - 3); + Char("E"); + IF e >= 0 THEN + Char("+") + ELSE + Char("-"); + e := ABS(e) + END; + IF e < 100 THEN + Char("0") + END; + IF e < 10 THEN + Char("0") + END; + Int(e, 0) + END +END Real; + +PROCEDURE FixReal*(x: REAL; width, p: INTEGER); +BEGIN + Realp := Real; + _FixReal(x, width, p) +END FixReal; + +PROCEDURE Open*; +BEGIN + hConsoleOutput := WINAPI.GetStdHandle(-11) +END Open; + +END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 index 3aa6c454e1..0929a5678a 100644 --- a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -16,34 +16,14 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; - bits: ARRAY MAX_SET + 1 OF INTEGER; - - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); @@ -97,7 +77,6 @@ VAR i, n, k: INTEGER; BEGIN - k := LEN(A) - 1; n := A[0]; i := 0; @@ -106,7 +85,6 @@ BEGIN INC(i) END; A[k] := n - END _rot; @@ -128,14 +106,16 @@ BEGIN END _set; -PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; +PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) BEGIN - IF ASR(a, 5) = 0 THEN - SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) - ELSE - a := 0 - END - RETURN a + SYSTEM.CODE( + 031H, 0C0H, (* xor eax, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *) + 083H, 0F9H, 01FH, (* cmp ecx, 31 *) + 077H, 003H, (* ja L *) + 00FH, 0ABH, 0C8H (* bts eax, ecx *) + (* L: *) + ) END _set1; @@ -315,7 +295,6 @@ VAR c: CHAR; BEGIN - res := strncmp(str1, str2, MIN(len1, len2)); IF res = minint THEN IF len1 > len2 THEN @@ -349,7 +328,6 @@ VAR c: WCHAR; BEGIN - res := strncmpw(str1, str2, MIN(len1, len2)); IF res = minint THEN IF len1 > len2 THEN @@ -398,7 +376,6 @@ VAR c: CHAR; BEGIN - i := 0; REPEAT str[i] := CHR(x MOD 10 + ORD("0")); @@ -422,6 +399,7 @@ END IntToStr; PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); VAR n1, n2, i, j: INTEGER; + BEGIN n1 := LENGTH(s1); n2 := LENGTH(s2); @@ -437,7 +415,6 @@ BEGIN END; s1[j] := 0X - END append; @@ -446,20 +423,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "division by zero") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -513,36 +488,16 @@ END _guard; PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - res := 0; - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - res := 0; - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - res := 0; - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - res := 0 - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -571,42 +526,8 @@ BEGIN END END; - j := 1; - FOR i := 0 TO MAX_SET DO - bits[i] := j; - j := LSL(j, 1) - END; - - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - -END RTL. +END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/UnixTime.ob07 b/programs/develop/oberon07/Lib/Windows32/UnixTime.ob07 new file mode 100644 index 0000000000..0e6ed5bd6d --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/UnixTime.ob07 @@ -0,0 +1,64 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2019, Anton Krotov + All rights reserved. +*) + +MODULE UnixTime; + + +VAR + + days: ARRAY 12, 31, 2 OF INTEGER; + + +PROCEDURE init; +VAR + i, j, k, n0, n1: INTEGER; +BEGIN + + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + days[i, j, 0] := 0; + days[i, j, 1] := 0; + END + END; + + days[ 1, 28, 0] := -1; + + FOR k := 0 TO 1 DO + days[ 1, 29, k] := -1; + days[ 1, 30, k] := -1; + days[ 3, 30, k] := -1; + days[ 5, 30, k] := -1; + days[ 8, 30, k] := -1; + days[10, 30, k] := -1; + END; + + n0 := 0; + n1 := 0; + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + IF days[i, j, 0] = 0 THEN + days[i, j, 0] := n0; + INC(n0) + END; + IF days[i, j, 1] = 0 THEN + days[i, j, 1] := n1; + INC(n1) + END + END + END + +END init; + + +PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; + RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec +END time; + + +BEGIN + init +END UnixTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/Utils.ob07 b/programs/develop/oberon07/Lib/Windows32/Utils.ob07 new file mode 100644 index 0000000000..0f85e9808e --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/Utils.ob07 @@ -0,0 +1,76 @@ +(* + Copyright 2013, 2017, 2018, 2020 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 . +*) + +MODULE Utils; + +IMPORT WINAPI; + +PROCEDURE PutSeed*(seed: INTEGER); +BEGIN + WINAPI.srand(seed) +END PutSeed; + +PROCEDURE Rnd*(range : INTEGER): INTEGER; + RETURN WINAPI.rand() MOD range +END Rnd; + +PROCEDURE Utf8To16*(source: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR): INTEGER; +VAR i, j, L, u, N: INTEGER; +BEGIN + L := LEN(source); + N := LEN(dest); + N := N - N MOD 2 - 1; + i := 0; + j := 0; + WHILE (i < L) & (j < N) & (source[i] # 0X) DO + CASE source[i] OF + |00X..7FX: u := ORD(source[i]); + |0C1X..0DFX: + u := LSL(ORD(source[i]) - 0C0H, 6); + IF i + 1 < L THEN + u := u + ROR(LSL(ORD(source[i + 1]), 26), 26); + INC(i) + END + |0E1X..0EFX: + u := LSL(ORD(source[i]) - 0E0H, 12); + IF i + 1 < L THEN + u := u + ROR(LSL(ORD(source[i + 1]), 26), 20); + INC(i) + END; + IF i + 1 < L THEN + u := u + ROR(LSL(ORD(source[i + 1]), 26), 26); + INC(i) + END +(* |0F1X..0F7X: + |0F9X..0FBX: + |0FDX:*) + ELSE + END; + INC(i); + dest[j] := CHR(u MOD 256); + INC(j); + dest[j] := CHR(u DIV 256); + INC(j); + END; + IF j < N THEN + dest[j] := 0X; + dest[j + 1] := 0X + END + RETURN j DIV 2 +END Utf8To16; + +END Utils. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07 b/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07 new file mode 100644 index 0000000000..f6043431ad --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07 @@ -0,0 +1,241 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE WINAPI; + +IMPORT SYSTEM, API; + + +CONST + + OFS_MAXPATHNAME* = 128; + + +TYPE + + DLL_ENTRY* = API.DLL_ENTRY; + + STRING = ARRAY 260 OF CHAR; + + TCoord* = RECORD + + X*, Y*: WCHAR + + END; + + TSmallRect* = RECORD + + Left*, Top*, Right*, Bottom*: WCHAR + + END; + + TConsoleScreenBufferInfo* = RECORD + + dwSize*: TCoord; + dwCursorPosition*: TCoord; + wAttributes*: WCHAR; + srWindow*: TSmallRect; + dwMaximumWindowSize*: TCoord + + END; + + TSystemTime* = RECORD + + Year*, + Month*, + DayOfWeek*, + Day*, + Hour*, + Min*, + Sec*, + MSec*: WCHAR + + END; + + PSecurityAttributes* = POINTER TO TSecurityAttributes; + + TSecurityAttributes* = RECORD + + nLength*: INTEGER; + lpSecurityDescriptor*: INTEGER; + bInheritHandle*: INTEGER + + END; + + TFileTime* = RECORD + + dwLowDateTime*, + dwHighDateTime*: INTEGER + + END; + + TWin32FindData* = RECORD + + dwFileAttributes*: SET; + ftCreationTime*: TFileTime; + ftLastAccessTime*: TFileTime; + ftLastWriteTime*: TFileTime; + nFileSizeHigh*: INTEGER; + nFileSizeLow*: INTEGER; + dwReserved0*: INTEGER; + dwReserved1*: INTEGER; + cFileName*: STRING; + cAlternateFileName*: ARRAY 14 OF CHAR + + END; + + OFSTRUCT* = RECORD + + cBytes*: CHAR; + fFixedDisk*: CHAR; + nErrCode*: WCHAR; + Reserved1*: WCHAR; + Reserved2*: WCHAR; + szPathName*: ARRAY OFS_MAXPATHNAME OF CHAR + + END; + + POverlapped* = POINTER TO OVERLAPPED; + + OVERLAPPED* = RECORD + + Internal*: INTEGER; + InternalHigh*: INTEGER; + Offset*: INTEGER; + OffsetHigh*: INTEGER; + hEvent*: INTEGER + + END; + + +PROCEDURE [windows-, "kernel32.dll", "SetConsoleCursorPosition"] + SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetConsoleScreenBufferInfo"] + GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputCharacterA"] + FillConsoleOutputCharacter* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputAttribute"] + FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "SetConsoleTextAttribute"] + SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] + GetStdHandle* (nStdHandle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] + GetLocalTime* (T: TSystemTime); + +PROCEDURE [windows-, "kernel32.dll", "RemoveDirectoryA"] + RemoveDirectory* (lpPathName: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetFileAttributesA"] + GetFileAttributes* (lpPathName: INTEGER): SET; + +PROCEDURE [windows-, "kernel32.dll", "CreateDirectoryA"] + CreateDirectory* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "FindFirstFileA"] + FindFirstFile* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "DeleteFileA"] + DeleteFile* (lpFileName: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "FindClose"] + FindClose* (hFindFile: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] + CloseHandle* (hObject: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] + CreateFile* ( + lpFileName, dwDesiredAccess, dwShareMode: INTEGER; + lpSecurityAttributes: PSecurityAttributes; + dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "OpenFile"] + OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "SetFilePointer"] + SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ReadFile"] + ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteFile"] + WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"] + ReadConsole* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] + GetCommandLine* (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] + GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] + GlobalFree* (hMem: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteConsoleW"] + WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] + ExitProcess* (code: INTEGER); + +PROCEDURE [windows-, "kernel32.dll", "WriteConsoleA"] + WriteConsole* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] + GetTickCount* (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "Sleep"] + Sleep* (dwMilliseconds: INTEGER); + +PROCEDURE [windows-, "kernel32.dll", "FreeLibrary"] + FreeLibrary* (hLibModule: INTEGER): INTEGER; + +PROCEDURE [ccall, "msvcrt.dll", "rand"] + rand* (): INTEGER; + +PROCEDURE [ccall, "msvcrt.dll", "srand"] + srand* (seed: INTEGER); + +PROCEDURE [windows-, "user32.dll", "MessageBoxA"] + MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; + +PROCEDURE [windows-, "user32.dll", "MessageBoxW"] + MessageBox* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; + +PROCEDURE [windows-, "user32.dll", "CreateWindowExA"] + CreateWindowEx* ( + dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, + nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetProcAddress"] + GetProcAddress* (hModule, name: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "LoadLibraryA"] + LoadLibraryA* (name: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "AllocConsole"] + AllocConsole* (): BOOLEAN; + +PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] + FreeConsole* (): BOOLEAN; + + +PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + API.SetDll(process_detach, thread_detach, thread_attach) +END SetDllEntry; + + +END WINAPI. diff --git a/programs/develop/oberon07/Lib/Windows64/API.ob07 b/programs/develop/oberon07/Lib/Windows64/API.ob07 new file mode 100644 index 0000000000..0eaf6c9a7a --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/API.ob07 @@ -0,0 +1,130 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2020, Anton Krotov + All rights reserved. +*) + +MODULE API; + +IMPORT SYSTEM; + + +CONST + + SectionAlignment = 1000H; + + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + +TYPE + + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + + +VAR + + eol*: ARRAY 3 OF CHAR; + base*: INTEGER; + heap: INTEGER; + + process_detach, + thread_detach, + thread_attach: DLL_ENTRY; + + +PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); +PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); +PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): 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; + + +PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); +BEGIN + MessageBoxA(0, lpText, lpCaption, 16) +END DebugMsg; + + +PROCEDURE _NEW* (size: INTEGER): INTEGER; + RETURN HeapAlloc(heap, 8, size) +END _NEW; + + +PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; +BEGIN + HeapFree(heap, 0, p) + RETURN 0 +END _DISPOSE; + + +PROCEDURE init* (reserved, code: INTEGER); +BEGIN + process_detach := NIL; + thread_detach := NIL; + thread_attach := NIL; + eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + base := code - SectionAlignment; + heap := GetProcessHeap() +END init; + + +PROCEDURE exit* (code: INTEGER); +BEGIN + ExitProcess(code) +END exit; + + +PROCEDURE exit_thread* (code: INTEGER); +BEGIN + ExitThread(code) +END exit_thread; + + +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := 0; + + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + IF thread_attach # NIL THEN + thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + IF thread_detach # NIL THEN + thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + IF process_detach # NIL THEN + process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + END + + RETURN res +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + +PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY); +BEGIN + process_detach := _process_detach; + thread_detach := _thread_detach; + thread_attach := _thread_attach +END SetDll; + + +END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/Console.ob07 b/programs/develop/oberon07/Lib/Windows64/Console.ob07 new file mode 100644 index 0000000000..042b0317ab --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/Console.ob07 @@ -0,0 +1,100 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Console; + +IMPORT SYSTEM, WINAPI, In, Out; + + +CONST + + Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3; + Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7; + DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11; + LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15; + + +VAR + + hConsoleOutput: INTEGER; + + +PROCEDURE SetCursor* (X, Y: INTEGER); +BEGIN + WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536) +END SetCursor; + + +PROCEDURE GetCursor* (VAR X, Y: INTEGER); +VAR + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); + X := ORD(ScrBufInfo.dwCursorPosition.X); + Y := ORD(ScrBufInfo.dwCursorPosition.Y) +END GetCursor; + + +PROCEDURE Cls*; +VAR + fill: INTEGER; + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); + fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y); + WINAPI.FillConsoleOutputCharacter(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); + WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill)); + SetCursor(0, 0) +END Cls; + + +PROCEDURE SetColor* (FColor, BColor: INTEGER); +BEGIN + IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN + WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor) + END +END SetColor; + + +PROCEDURE GetCursorX* (): INTEGER; +VAR + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) + RETURN ORD(ScrBufInfo.dwCursorPosition.X) +END GetCursorX; + + +PROCEDURE GetCursorY* (): INTEGER; +VAR + ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; + +BEGIN + WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) + RETURN ORD(ScrBufInfo.dwCursorPosition.Y) +END GetCursorY; + + +PROCEDURE open*; +BEGIN + WINAPI.AllocConsole; + hConsoleOutput := WINAPI.GetStdHandle(-11); + In.Open; + Out.Open +END open; + + +PROCEDURE exit* (b: BOOLEAN); +BEGIN + WINAPI.FreeConsole +END exit; + + +END Console. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/DateTime.ob07 b/programs/develop/oberon07/Lib/Windows64/DateTime.ob07 new file mode 100644 index 0000000000..bd849fb704 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/DateTime.ob07 @@ -0,0 +1,174 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE DateTime; + +IMPORT WINAPI; + + +CONST + + ERR* = -7.0E5; + + +VAR + + DateTable: ARRAY 120000, 3 OF INTEGER; + MonthsTable: ARRAY 13, 4 OF INTEGER; + + +PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL; +VAR + d, bis: INTEGER; + res: REAL; + +BEGIN + res := ERR; + IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) & + (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) & + (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) & + (MSec >= 0) & (MSec <= 999) THEN + + bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0)); + + IF Day <= MonthsTable[Month][2 + bis] THEN + DEC(Year); + d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + + MonthsTable[Month][bis] + Day - 693594; + res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0 + END + END + RETURN res +END Encode; + + +PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + d, t: INTEGER; + L, R, M: INTEGER; + +BEGIN + res := (Date >= -693593.0) & (Date < 2958466.0); + IF res THEN + d := FLOOR(Date); + t := FLOOR((Date - FLT(d)) * 86400000.0); + INC(d, 693593); + + L := 0; + R := LEN(DateTable) - 1; + M := (L + R) DIV 2; + + WHILE R - L > 1 DO + IF d > DateTable[M][0] THEN + L := M; + M := (L + R) DIV 2 + ELSIF d < DateTable[M][0] THEN + R := M; + M := (L + R) DIV 2 + ELSE + L := M; + R := M + END + END; + + Year := DateTable[L][1]; + Month := DateTable[L][2]; + Day := d - DateTable[L][0] + 1; + + Hour := t DIV 3600000; t := t MOD 3600000; + Min := t DIV 60000; t := t MOD 60000; + Sec := t DIV 1000; + MSec := t MOD 1000 + END + + RETURN res +END Decode; + + +PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER); +VAR + T: WINAPI.TSystemTime; + +BEGIN + WINAPI.GetLocalTime(T); + Year := ORD(T.Year); + Month := ORD(T.Month); + Day := ORD(T.Day); + Hour := ORD(T.Hour); + Min := ORD(T.Min); + Sec := ORD(T.Sec); + MSec := ORD(T.MSec) +END Now; + + +PROCEDURE NowEncode* (): REAL; +VAR + Year, Month, Day, Hour, Min, Sec, MSec: INTEGER; + +BEGIN + Now(Year, Month, Day, Hour, Min, Sec, MSec) + RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec) +END NowEncode; + + +PROCEDURE init; +VAR + day, year, month, i: INTEGER; + Months: ARRAY 13 OF INTEGER; + +BEGIN + Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30; + Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31; + Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31; + + day := 0; + year := 1; + month := 1; + i := 0; + + WHILE year <= 10000 DO + DateTable[i][0] := day; + DateTable[i][1] := year; + DateTable[i][2] := month; + INC(day, Months[month]); + IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN + INC(day) + END; + INC(month); + IF month > 12 THEN + month := 1; + INC(year) + END; + INC(i) + END; + + MonthsTable[1][0] := 0; + FOR i := 2 TO 12 DO + MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1] + END; + + FOR i := 1 TO 12 DO + MonthsTable[i][2] := Months[i] + END; + + Months[2] := 29; + MonthsTable[1][1] := 0; + FOR i := 2 TO 12 DO + MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1] + END; + + FOR i := 1 TO 12 DO + MonthsTable[i][3] := Months[i] + END + +END init; + + +BEGIN + init +END DateTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/HOST.ob07 b/programs/develop/oberon07/Lib/Windows64/HOST.ob07 new file mode 100644 index 0000000000..ee6b7bf778 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/HOST.ob07 @@ -0,0 +1,371 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2020, Anton Krotov + All rights reserved. +*) + +MODULE HOST; + +IMPORT SYSTEM, RTL; + + +CONST + + slash* = "\"; + OS* = "WINDOWS"; + + bit_depth* = RTL.bit_depth; + maxint* = RTL.maxint; + minint* = RTL.minint; + + MAX_PARAM = 1024; + + OFS_MAXPATHNAME = 128; + + +TYPE + + POverlapped = POINTER TO OVERLAPPED; + + OVERLAPPED = RECORD + + Internal: INTEGER; + InternalHigh: INTEGER; + Offset: INTEGER; + OffsetHigh: INTEGER; + hEvent: INTEGER + + END; + + OFSTRUCT = RECORD + + cBytes: CHAR; + fFixedDisk: CHAR; + nErrCode: WCHAR; + Reserved1: WCHAR; + Reserved2: WCHAR; + szPathName: ARRAY OFS_MAXPATHNAME OF CHAR + + END; + + PSecurityAttributes = POINTER TO TSecurityAttributes; + + TSecurityAttributes = RECORD + + nLength: INTEGER; + lpSecurityDescriptor: INTEGER; + bInheritHandle: INTEGER + + END; + + TSystemTime = RECORD + + Year, + Month, + DayOfWeek, + Day, + Hour, + Min, + Sec, + MSec: WCHAR + + END; + + +VAR + + hConsoleOutput: INTEGER; + + Params: ARRAY MAX_PARAM, 2 OF INTEGER; + argc: INTEGER; + + eol*: ARRAY 3 OF CHAR; + + maxreal*: REAL; + + +PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] + _GetTickCount (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] + _GetStdHandle (nStdHandle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] + _GetCommandLine (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ReadFile"] + _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteFile"] + _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] + _CloseHandle (hObject: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] + _CreateFile ( + lpFileName, dwDesiredAccess, dwShareMode: INTEGER; + lpSecurityAttributes: PSecurityAttributes; + dwCreationDisposition, dwFlagsAndAttributes, + hTemplateFile: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "OpenFile"] + _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"] + _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"] + _GetSystemTime (T: TSystemTime); + +PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] + _ExitProcess (code: INTEGER); + + +PROCEDURE ExitProcess* (code: INTEGER); +BEGIN + _ExitProcess(code) +END ExitProcess; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +VAR + n: INTEGER; + +BEGIN + n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0])); + path[n] := slash; + path[n + 1] := 0X +END GetCurrentDirectory; + + +PROCEDURE GetChar (adr: INTEGER): CHAR; +VAR + res: CHAR; + +BEGIN + SYSTEM.GET(adr, res) + RETURN res +END GetChar; + + +PROCEDURE ParamParse; +VAR + p, count, cond: INTEGER; + c: CHAR; + + + PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR); + BEGIN + IF (c <= 20X) & (c # 0X) THEN + cond := A + ELSIF c = 22X THEN + cond := B + ELSIF c = 0X THEN + cond := 6 + ELSE + cond := C + END + END ChangeCond; + + +BEGIN + p := _GetCommandLine(); + cond := 0; + count := 0; + WHILE (count < MAX_PARAM) & (cond # 6) DO + c := GetChar(p); + CASE cond OF + |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END + |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END + |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END + |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |6: + END; + INC(p) + END; + argc := count +END ParamParse; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, j, len: INTEGER; + c: CHAR; + +BEGIN + j := 0; + IF n < argc THEN + len := LEN(s) - 1; + i := Params[n, 0]; + WHILE (j < len) & (i <= Params[n, 1]) DO + c := GetChar(i); + IF c # 22X THEN + s[j] := c; + INC(j) + END; + INC(i) + END + END; + s[j] := 0X +END GetArg; + + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; +VAR + res, n: INTEGER; + +BEGIN + IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN + res := -1 + ELSE + res := n + END + + RETURN res +END FileRead; + + +PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res, n: INTEGER; + +BEGIN + IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN + res := -1 + ELSE + res := n + END + + RETURN res +END FileWrite; + + +PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; + RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) +END FileCreate; + + +PROCEDURE FileClose* (F: INTEGER); +BEGIN + _CloseHandle(F) +END FileClose; + + +PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; +VAR + ofstr: OFSTRUCT; + res: INTEGER; + +BEGIN + res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0); + IF res = 0FFFFFFFFH THEN + res := -1 + END + + RETURN res +END FileOpen; + + +PROCEDURE OutChar* (c: CHAR); +VAR + count: INTEGER; +BEGIN + _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL) +END OutChar; + + +PROCEDURE GetTickCount* (): INTEGER; + RETURN _GetTickCount() DIV 10 +END GetTickCount; + + +PROCEDURE letter (c: CHAR): BOOLEAN; + RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") +END letter; + + +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN ~(letter(path[0]) & (path[1] = ":")) +END isRelative; + + +PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); +VAR + T: TSystemTime; + +BEGIN + _GetSystemTime(T); + year := ORD(T.Year); + month := ORD(T.Month); + day := ORD(T.Day); + hour := ORD(T.Hour); + min := ORD(T.Min); + sec := ORD(T.Sec) +END now; + + +PROCEDURE UnixTime* (): INTEGER; + RETURN 0 +END UnixTime; + + +PROCEDURE d2s* (x: REAL): INTEGER; +VAR + h, l, s, e: INTEGER; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h); + + s := ASR(h, 31) MOD 2; + e := (h DIV 100000H) MOD 2048; + IF e <= 896 THEN + h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; + REPEAT + h := h DIV 2; + INC(e) + UNTIL e = 897; + e := 896; + l := (h MOD 8) * 20000000H; + h := h DIV 8 + ELSIF (1151 <= e) & (e < 2047) THEN + e := 1151; + h := 0; + l := 0 + ELSIF e = 2047 THEN + e := 1151; + IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN + h := 80000H; + l := 0 + END + END; + DEC(e, 896) + + RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 +END d2s; + + +PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + a := 0; + b := 0; + SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); + SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); + SYSTEM.GET(SYSTEM.ADR(x), res) + RETURN res +END splitf; + + +BEGIN + eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + maxreal := 1.9; + PACK(maxreal, 1023); + hConsoleOutput := _GetStdHandle(-11); + ParamParse +END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/In.ob07 b/programs/develop/oberon07/Lib/Windows64/In.ob07 new file mode 100644 index 0000000000..dd4b518601 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/In.ob07 @@ -0,0 +1,295 @@ +(* + Copyright 2013, 2017, 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 + 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 . +*) + +MODULE In; + +IMPORT sys := SYSTEM; + +TYPE + + STRING = ARRAY 260 OF CHAR; + +VAR + + Done*: BOOLEAN; + hConsoleInput: INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] + GetStdHandle (nStdHandle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"] + ReadConsole (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; + +PROCEDURE digit(ch: CHAR): BOOLEAN; + RETURN (ch >= "0") & (ch <= "9") +END digit; + +PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN; +VAR i: INTEGER; +BEGIN + i := 0; + neg := FALSE; + WHILE (s[i] <= 20X) & (s[i] # 0X) DO + INC(i) + END; + IF s[i] = "-" THEN + neg := TRUE; + INC(i) + ELSIF s[i] = "+" THEN + INC(i) + END; + first := i; + WHILE digit(s[i]) DO + INC(i) + END; + last := i + RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first]) +END CheckInt; + +PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN; +VAR i: INTEGER; min: STRING; +BEGIN + i := 0; + min := "2147483648"; + WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO + INC(i) + END + RETURN i = 10 +END IsMinInt; + +PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER; +CONST maxINT = 7FFFFFFFH; +VAR i, n, res: INTEGER; flag, neg: BOOLEAN; +BEGIN + res := 0; + flag := CheckInt(str, i, n, neg, FALSE); + err := ~flag; + IF flag & neg & IsMinInt(str, i) THEN + flag := FALSE; + neg := FALSE; + res := 80000000H + END; + WHILE flag & digit(str[i]) DO + IF res > maxINT DIV 10 THEN + err := TRUE; + flag := FALSE; + res := 0 + ELSE + res := res * 10; + IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN + err := TRUE; + flag := FALSE; + res := 0 + ELSE + res := res + (ORD(str[i]) - ORD("0")); + INC(i) + END + END + END; + IF neg THEN + res := -res + END + RETURN res +END StrToInt; + +PROCEDURE Space(s: STRING): BOOLEAN; +VAR i: INTEGER; +BEGIN + i := 0; + WHILE (s[i] # 0X) & (s[i] <= 20X) DO + INC(i) + END + RETURN s[i] = 0X +END Space; + +PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN; +VAR i: INTEGER; Res: BOOLEAN; +BEGIN + Res := CheckInt(s, n, i, neg, TRUE); + IF Res THEN + IF s[i] = "." THEN + INC(i); + WHILE digit(s[i]) DO + INC(i) + END; + IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN + INC(i); + IF (s[i] = "+") OR (s[i] = "-") THEN + INC(i) + END; + Res := digit(s[i]); + WHILE digit(s[i]) DO + INC(i) + END + END + END + END + RETURN Res & (s[i] <= 20X) +END CheckReal; + +PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL; +CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH; +VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN; + + PROCEDURE part1(VAR res, d: REAL; VAR i: INTEGER; str: STRING): BOOLEAN; + BEGIN + res := 0.0; + d := 1.0; + WHILE digit(str[i]) DO + res := res * 10.0 + FLT(ORD(str[i]) - ORD("0")); + INC(i) + END; + IF str[i] = "." THEN + INC(i); + WHILE digit(str[i]) DO + d := d / 10.0; + res := res + FLT(ORD(str[i]) - ORD("0")) * d; + INC(i) + END + END + RETURN str[i] # 0X + END part1; + + PROCEDURE part2(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): BOOLEAN; + BEGIN + INC(i); + m := 10.0; + minus := FALSE; + IF str[i] = "+" THEN + INC(i) + ELSIF str[i] = "-" THEN + minus := TRUE; + INC(i); + m := 0.1 + END; + scale := 0; + err := FALSE; + WHILE ~err & digit(str[i]) DO + IF scale > maxINT DIV 10 THEN + err := TRUE; + res := 0.0 + ELSE + scale := scale * 10; + IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN + err := TRUE; + res := 0.0 + ELSE + scale := scale + (ORD(str[i]) - ORD("0")); + INC(i) + END + END + END + RETURN ~err + END part2; + + PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR scale: INTEGER; VAR res, m: REAL); + VAR i: INTEGER; + BEGIN + err := FALSE; + IF scale = maxINT THEN + err := TRUE; + res := 0.0 + END; + i := 1; + WHILE ~err & (i <= scale) DO + IF ~minus & (res > maxDBL / m) THEN + err := TRUE; + res := 0.0 + ELSE + res := res * m; + INC(i) + END + END + END part3; + +BEGIN + IF CheckReal(str, i, neg) THEN + IF part1(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN + part3(err, minus, scale, res, m) + END; + IF neg THEN + res := -res + END + ELSE + res := 0.0; + err := TRUE + END + RETURN res +END StrToFloat; + +PROCEDURE String*(VAR s: ARRAY OF CHAR); +VAR count, i: INTEGER; str: STRING; +BEGIN + ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0); + IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN + DEC(count, 2) + END; + str[256] := 0X; + str[count] := 0X; + i := 0; + WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO + s[i] := str[i]; + INC(i) + END; + s[i] := 0X; + Done := TRUE +END String; + +PROCEDURE Char*(VAR x: CHAR); +VAR str: STRING; +BEGIN + String(str); + x := str[0]; + Done := TRUE +END Char; + +PROCEDURE Ln*; +VAR str: STRING; +BEGIN + String(str); + Done := TRUE +END Ln; + +PROCEDURE Real*(VAR x: REAL); +VAR str: STRING; err: BOOLEAN; +BEGIN + err := FALSE; + REPEAT + String(str) + UNTIL ~Space(str); + x := StrToFloat(str, err); + Done := ~err +END Real; + +PROCEDURE Int*(VAR x: INTEGER); +VAR str: STRING; err: BOOLEAN; +BEGIN + err := FALSE; + REPEAT + String(str) + UNTIL ~Space(str); + x := StrToInt(str, err); + Done := ~err +END Int; + +PROCEDURE Open*; +BEGIN + hConsoleInput := GetStdHandle(-10); + Done := TRUE +END Open; + +END In. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/Math.ob07 b/programs/develop/oberon07/Lib/Windows64/Math.ob07 new file mode 100644 index 0000000000..ab80d79ebf --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/Math.ob07 @@ -0,0 +1,311 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE Math; + +IMPORT SYSTEM; + + +CONST + + e *= 2.71828182845904523; + pi *= 3.14159265358979324; + ln2 *= 0.693147180559945309; + + eps = 1.0E-16; + MaxCosArg = 1000000.0 * pi; + + +VAR + + Exp: ARRAY 710 OF REAL; + + +PROCEDURE [stdcall64] sqrt* (x: REAL): REAL; +BEGIN + ASSERT(x >= 0.0); + SYSTEM.CODE( + 0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *) + 05DH, (* pop rbp *) + 0C2H, 08H, 00H (* ret 8 *) + ) + + RETURN 0.0 +END sqrt; + + +PROCEDURE exp* (x: REAL): REAL; +CONST + e25 = 1.284025416687741484; (* exp(0.25) *) + +VAR + a, s, res: REAL; + neg: BOOLEAN; + n: INTEGER; + +BEGIN + neg := x < 0.0; + IF neg THEN + x := -x + END; + + IF x < FLT(LEN(Exp)) THEN + res := Exp[FLOOR(x)]; + x := x - FLT(FLOOR(x)); + WHILE x >= 0.25 DO + res := res * e25; + x := x - 0.25 + END + ELSE + res := SYSTEM.INF(); + x := 0.0 + END; + + n := 0; + a := 1.0; + s := 1.0; + + REPEAT + INC(n); + a := a * x / FLT(n); + s := s + a + UNTIL a < eps; + + IF neg THEN + res := 1.0 / (res * s) + ELSE + res := res * s + END + + RETURN res +END exp; + + +PROCEDURE ln* (x: REAL): REAL; +VAR + a, x2, res: REAL; + n: INTEGER; + +BEGIN + ASSERT(x > 0.0); + UNPK(x, n); + + x := (x - 1.0) / (x + 1.0); + x2 := x * x; + res := x + FLT(n) * (ln2 * 0.5); + n := 1; + + REPEAT + INC(n, 2); + x := x * x2; + a := x / FLT(n); + res := res + a + UNTIL a < eps + + RETURN res * 2.0 +END ln; + + +PROCEDURE power* (base, exponent: REAL): REAL; +BEGIN + ASSERT(base > 0.0) + RETURN exp(exponent * ln(base)) +END power; + + +PROCEDURE log* (base, x: REAL): REAL; +BEGIN + ASSERT(base > 0.0); + ASSERT(x > 0.0) + RETURN ln(x) / ln(base) +END log; + + +PROCEDURE cos* (x: REAL): REAL; +VAR + a, res: REAL; + n: INTEGER; + +BEGIN + x := ABS(x); + ASSERT(x <= MaxCosArg); + + x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi); + x := x * x; + res := 0.0; + a := 1.0; + n := -1; + + REPEAT + INC(n, 2); + res := res + a; + a := -a * x / FLT(n*n + n) + UNTIL ABS(a) < eps + + RETURN res +END cos; + + +PROCEDURE sin* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) <= MaxCosArg); + x := cos(x) + RETURN sqrt(1.0 - x * x) +END sin; + + +PROCEDURE tan* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) <= MaxCosArg); + x := cos(x) + RETURN sqrt(1.0 - x * x) / x +END tan; + + +PROCEDURE arcsin* (x: REAL): REAL; + + + PROCEDURE arctan (x: REAL): REAL; + VAR + z, p, k: REAL; + + BEGIN + p := x / (x * x + 1.0); + z := p * x; + x := 0.0; + k := 0.0; + + REPEAT + k := k + 2.0; + x := x + p; + p := p * k * z / (k + 1.0) + UNTIL p < eps + + RETURN x + END arctan; + + +BEGIN + ASSERT(ABS(x) <= 1.0); + + IF ABS(x) >= 0.707 THEN + x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x) + ELSE + x := arctan(x / sqrt(1.0 - x * x)) + END + + RETURN x +END arcsin; + + +PROCEDURE arccos* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) <= 1.0) + RETURN 0.5 * pi - arcsin(x) +END arccos; + + +PROCEDURE arctan* (x: REAL): REAL; + RETURN arcsin(x / sqrt(1.0 + x * x)) +END arctan; + + +PROCEDURE sinh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x - 1.0 / x) * 0.5 +END sinh; + + +PROCEDURE cosh* (x: REAL): REAL; +BEGIN + x := exp(x) + RETURN (x + 1.0 / x) * 0.5 +END cosh; + + +PROCEDURE tanh* (x: REAL): REAL; +BEGIN + IF x > 15.0 THEN + x := 1.0 + ELSIF x < -15.0 THEN + x := -1.0 + ELSE + x := exp(2.0 * x); + x := (x - 1.0) / (x + 1.0) + END + + RETURN x +END tanh; + + +PROCEDURE arsinh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x + 1.0)) +END arsinh; + + +PROCEDURE arcosh* (x: REAL): REAL; +BEGIN + ASSERT(x >= 1.0) + RETURN ln(x + sqrt(x * x - 1.0)) +END arcosh; + + +PROCEDURE artanh* (x: REAL): REAL; +BEGIN + ASSERT(ABS(x) < 1.0) + RETURN 0.5 * ln((1.0 + x) / (1.0 - x)) +END artanh; + + +PROCEDURE sgn* (x: REAL): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF x > 0.0 THEN + res := 1 + ELSIF x < 0.0 THEN + res := -1 + 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; + + +PROCEDURE init; +VAR + i: INTEGER; + +BEGIN + Exp[0] := 1.0; + FOR i := 1 TO LEN(Exp) - 1 DO + Exp[i] := Exp[i - 1] * e + END +END init; + + +BEGIN + init +END Math. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/Out.ob07 b/programs/develop/oberon07/Lib/Windows64/Out.ob07 new file mode 100644 index 0000000000..d75f9051e3 --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/Out.ob07 @@ -0,0 +1,308 @@ +(* + Copyright 2013, 2014, 2017, 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 + 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 . +*) + +MODULE Out; + +IMPORT sys := SYSTEM; + +CONST + + d = 1.0 - 5.0E-12; + +TYPE + + POverlapped* = POINTER TO OVERLAPPED; + + OVERLAPPED* = RECORD + + Internal*: INTEGER; + InternalHigh*: INTEGER; + Offset*: INTEGER; + OffsetHigh*: INTEGER; + hEvent*: INTEGER + + END; + +VAR + + hConsoleOutput: INTEGER; + Realp: PROCEDURE (x: REAL; width: INTEGER); + + +PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] + GetStdHandle (nStdHandle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteFile"] + WriteFile (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteConsoleW"] + WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; + + +PROCEDURE Char*(x: CHAR); +VAR count: INTEGER; +BEGIN + WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL) +END Char; + +PROCEDURE StringW*(s: ARRAY OF WCHAR); +VAR count: INTEGER; +BEGIN + WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0) +END StringW; + +PROCEDURE String*(s: ARRAY OF CHAR); +VAR len, i: INTEGER; +BEGIN + len := LENGTH(s); + FOR i := 0 TO len - 1 DO + Char(s[i]) + END +END String; + +PROCEDURE WriteInt(x, n: INTEGER); +VAR i: INTEGER; a: ARRAY 32 OF CHAR; neg: BOOLEAN; +BEGIN + i := 0; + IF n < 1 THEN + n := 1 + END; + IF x < 0 THEN + x := -x; + DEC(n); + neg := TRUE + END; + REPEAT + a[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + WHILE n > i DO + Char(" "); + DEC(n) + END; + IF neg THEN + Char("-") + END; + REPEAT + DEC(i); + Char(a[i]) + UNTIL i = 0 +END WriteInt; + +PROCEDURE IsNan(AValue: REAL): BOOLEAN; +VAR s: SET; +BEGIN + sys.GET(sys.ADR(AValue), s) + RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {0..31} # {})) +END IsNan; + +PROCEDURE IsInf(x: REAL): BOOLEAN; + RETURN ABS(x) = sys.INF() +END IsInf; + +PROCEDURE Int*(x, width: INTEGER); +VAR i, minInt: INTEGER; +BEGIN + minInt := 1; + minInt := ROR(minInt, 1); + IF x # minInt THEN + WriteInt(x, width) + ELSE + FOR i := 21 TO width DO + Char(20X) + END; + String("-9223372036854775808") + END +END Int; + +PROCEDURE OutInf(x: REAL; width: INTEGER); +VAR s: ARRAY 5 OF CHAR; i: INTEGER; +BEGIN + IF IsNan(x) THEN + s := "Nan"; + INC(width) + ELSIF IsInf(x) & (x > 0.0) THEN + s := "+Inf" + ELSIF IsInf(x) & (x < 0.0) THEN + s := "-Inf" + END; + FOR i := 1 TO width - 4 DO + Char(" ") + END; + String(s) +END OutInf; + +PROCEDURE Ln*; +BEGIN + Char(0DX); + Char(0AX) +END Ln; + +PROCEDURE _FixReal(x: REAL; width, p: INTEGER); +VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; +BEGIN + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSIF p < 0 THEN + Realp(x, width) + ELSE + len := 0; + minus := FALSE; + IF x < 0.0 THEN + minus := TRUE; + INC(len); + x := ABS(x) + END; + e := 0; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + + IF e >= 0 THEN + len := len + e + p + 1; + IF x > 9.0 + d THEN + INC(len) + END; + IF p > 0 THEN + INC(len) + END; + ELSE + len := len + p + 2 + END; + FOR i := 1 TO width - len DO + Char(" ") + END; + IF minus THEN + Char("-") + END; + y := x; + WHILE (y < 1.0) & (y # 0.0) DO + y := y * 10.0; + DEC(e) + END; + IF e < 0 THEN + IF x - FLT(FLOOR(x)) > d THEN + Char("1"); + x := 0.0 + ELSE + Char("0"); + x := x * 10.0 + END + ELSE + WHILE e >= 0 DO + IF x - FLT(FLOOR(x)) > d THEN + IF x > 9.0 THEN + String("10") + ELSE + Char(CHR(FLOOR(x) + ORD("0") + 1)) + END; + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(e) + END + END; + IF p > 0 THEN + Char(".") + END; + WHILE p > 0 DO + IF x - FLT(FLOOR(x)) > d THEN + Char(CHR(FLOOR(x) + ORD("0") + 1)); + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(p) + END + END +END _FixReal; + +PROCEDURE Real*(x: REAL; width: INTEGER); +VAR e, n, i: INTEGER; minus: BOOLEAN; +BEGIN + Realp := Real; + IF IsNan(x) OR IsInf(x) THEN + OutInf(x, width) + ELSE + e := 0; + n := 0; + IF width > 23 THEN + n := width - 23; + width := 23 + ELSIF width < 9 THEN + width := 9 + END; + width := width - 5; + IF x < 0.0 THEN + x := -x; + minus := TRUE + ELSE + minus := FALSE + END; + WHILE x >= 10.0 DO + x := x / 10.0; + INC(e) + END; + WHILE (x < 1.0) & (x # 0.0) DO + x := x * 10.0; + DEC(e) + END; + IF x > 9.0 + d THEN + x := 1.0; + INC(e) + END; + FOR i := 1 TO n DO + Char(" ") + END; + IF minus THEN + x := -x + END; + _FixReal(x, width, width - 3); + Char("E"); + IF e >= 0 THEN + Char("+") + ELSE + Char("-"); + e := ABS(e) + END; + IF e < 100 THEN + Char("0") + END; + IF e < 10 THEN + Char("0") + END; + Int(e, 0) + END +END Real; + +PROCEDURE FixReal*(x: REAL; width, p: INTEGER); +BEGIN + Realp := Real; + _FixReal(x, width, p) +END FixReal; + +PROCEDURE Open*; +BEGIN + hConsoleOutput := GetStdHandle(-11) +END Open; + +END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/RTL.ob07 b/programs/develop/oberon07/Lib/Windows64/RTL.ob07 new file mode 100644 index 0000000000..94a94eafda --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/RTL.ob07 @@ -0,0 +1,516 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2020, Anton Krotov + All rights reserved. +*) + +MODULE RTL; + +IMPORT SYSTEM, API; + + +CONST + + bit_depth* = 64; + maxint* = 7FFFFFFFFFFFFFFFH; + minint* = 8000000000000000H; + + WORD = bit_depth DIV 8; + MAX_SET = bit_depth - 1; + + +VAR + + name: INTEGER; + types: INTEGER; + sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; + + +PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) + 048H, 085H, 0C0H, (* test rax, rax *) + 07EH, 020H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push rdi *) + 056H, (* push rsi *) + 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) + 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) + 048H, 089H, 0C1H, (* mov rcx, rax *) + 048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *) + 0F3H, 048H, 0A5H, (* rep movsd *) + 048H, 089H, 0C1H, (* mov rcx, rax *) + 048H, 083H, 0E1H, 007H, (* and rcx, 7 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop rsi *) + 05FH (* pop rdi *) + (* L: *) + ) +END _move; + + +PROCEDURE [stdcall64] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF len_src > len_dst THEN + res := FALSE + ELSE + _move(len_src * base_size, dst, src); + res := TRUE + END + + RETURN res +END _arrcpy; + + +PROCEDURE [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, dst, src) +END _strcpy; + + +PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER); +VAR + i, n, k: INTEGER; + +BEGIN + k := LEN(A) - 1; + n := A[0]; + i := 0; + WHILE i < k DO + A[i] := A[i + 1]; + INC(i) + END; + A[k] := n +END _rot; + + +PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER; +BEGIN + IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN + SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a) + ELSE + a := 0 + END + + RETURN a +END _set; + + +PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *) +BEGIN + SYSTEM.CODE( + 048H, 031H, 0C0H, (* xor rax, rax *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *) + 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *) + 077H, 004H, (* ja L *) + 048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *) + (* L: *) + ) +END _set1; + + +PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *) +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *) + 048H, 031H, 0D2H, (* xor rdx, rdx *) + 048H, 085H, 0C0H, (* test rax, rax *) + 074H, 022H, (* je L2 *) + 07FH, 003H, (* jg L1 *) + 048H, 0F7H, 0D2H, (* not rdx *) + (* L1: *) + 049H, 089H, 0C0H, (* mov r8, rax *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *) + 048H, 0F7H, 0F9H, (* idiv rcx *) + 048H, 085H, 0D2H, (* test rdx, rdx *) + 074H, 00EH, (* je L2 *) + 049H, 031H, 0C8H, (* xor r8, rcx *) + 04DH, 085H, 0C0H, (* test r8, r8 *) + 07DH, 006H, (* jge L2 *) + 048H, 0FFH, 0C8H, (* dec rax *) + 048H, 001H, 0CAH (* add rdx, rcx *) + (* L2: *) + ) +END _divmod; + + +PROCEDURE [stdcall64] _new* (t, size: INTEGER; VAR ptr: INTEGER); +BEGIN + ptr := API._NEW(size); + IF ptr # 0 THEN + SYSTEM.PUT(ptr, t); + INC(ptr, WORD) + END +END _new; + + +PROCEDURE [stdcall64] _dispose* (VAR ptr: INTEGER); +BEGIN + IF ptr # 0 THEN + ptr := API._DISPOSE(ptr - WORD) + END +END _dispose; + + +PROCEDURE [stdcall64] _length* (len, str: INTEGER); +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) + 048H, 0FFH, 0C8H, (* dec rax *) + (* L1: *) + 048H, 0FFH, 0C0H, (* inc rax *) + 080H, 038H, 000H, (* cmp byte [rax], 0 *) + 074H, 005H, (* jz L2 *) + 0E2H, 0F6H, (* loop L1 *) + 048H, 0FFH, 0C0H, (* inc rax *) + (* L2: *) + 048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *) + ) +END _length; + + +PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER); +BEGIN + SYSTEM.CODE( + 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) + 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) + 048H, 083H, 0E8H, 002H, (* sub rax, 2 *) + (* L1: *) + 048H, 083H, 0C0H, 002H, (* add rax, 2 *) + 066H, 083H, 038H, 000H, (* cmp word [rax], 0 *) + 074H, 006H, (* jz L2 *) + 0E2H, 0F4H, (* loop L1 *) + 048H, 083H, 0C0H, 002H, (* add rax, 2 *) + (* L2: *) + 048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *) + 048H, 0D1H, 0E8H (* shr rax, 1 *) + ) +END _lengthw; + + +PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) + 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) + 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) + 04DH, 031H, 0C9H, (* xor r9, r9 *) + 04DH, 031H, 0D2H, (* xor r10, r10 *) + 048H, 0B8H, 000H, 000H, + 000H, 000H, 000H, 000H, + 000H, 080H, (* movabs rax, minint *) + (* L1: *) + 04DH, 085H, 0C0H, (* test r8, r8 *) + 07EH, 024H, (* jle L3 *) + 044H, 08AH, 009H, (* mov r9b, byte[rcx] *) + 044H, 08AH, 012H, (* mov r10b, byte[rdx] *) + 048H, 0FFH, 0C1H, (* inc rcx *) + 048H, 0FFH, 0C2H, (* inc rdx *) + 049H, 0FFH, 0C8H, (* dec r8 *) + 04DH, 039H, 0D1H, (* cmp r9, r10 *) + 074H, 008H, (* je L2 *) + 04CH, 089H, 0C8H, (* mov rax, r9 *) + 04CH, 029H, 0D0H, (* sub rax, r10 *) + 0EBH, 008H, (* jmp L3 *) + (* L2: *) + 04DH, 085H, 0C9H, (* test r9, r9 *) + 075H, 0DAH, (* jne L1 *) + 048H, 031H, 0C0H, (* xor rax, rax *) + (* L3: *) + 05DH, (* pop rbp *) + 0C2H, 018H, 000H (* ret 24 *) + ) + RETURN 0 +END strncmp; + + +PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) + 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) + 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) + 04DH, 031H, 0C9H, (* xor r9, r9 *) + 04DH, 031H, 0D2H, (* xor r10, r10 *) + 048H, 0B8H, 000H, 000H, + 000H, 000H, 000H, 000H, + 000H, 080H, (* movabs rax, minint *) + (* L1: *) + 04DH, 085H, 0C0H, (* test r8, r8 *) + 07EH, 028H, (* jle L3 *) + 066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *) + 066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *) + 048H, 083H, 0C1H, 002H, (* add rcx, 2 *) + 048H, 083H, 0C2H, 002H, (* add rdx, 2 *) + 049H, 0FFH, 0C8H, (* dec r8 *) + 04DH, 039H, 0D1H, (* cmp r9, r10 *) + 074H, 008H, (* je L2 *) + 04CH, 089H, 0C8H, (* mov rax, r9 *) + 04CH, 029H, 0D0H, (* sub rax, r10 *) + 0EBH, 008H, (* jmp L3 *) + (* L2: *) + 04DH, 085H, 0C9H, (* test r9, r9 *) + 075H, 0D6H, (* jne L1 *) + 048H, 031H, 0C0H, (* xor rax, rax *) + (* L3: *) + 05DH, (* pop rbp *) + 0C2H, 018H, 000H (* ret 24 *) + ) + RETURN 0 +END strncmpw; + + +PROCEDURE [stdcall64] _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 = minint THEN + 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 + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes +END _strcmp; + + +PROCEDURE [stdcall64] _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 = minint THEN + 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 + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes +END _strcmpw; + + +PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); +VAR + c: CHAR; + i: INTEGER; + +BEGIN + i := 0; + REPEAT + SYSTEM.GET(pchar, c); + s[i] := c; + INC(pchar); + INC(i) + UNTIL c = 0X +END PCharToStr; + + +PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a, b: INTEGER; + c: CHAR; + +BEGIN + i := 0; + REPEAT + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + + a := 0; + b := i - 1; + WHILE a < b DO + c := str[a]; + str[a] := str[b]; + str[b] := c; + INC(a); + DEC(b) + END; + str[i] := 0X +END IntToStr; + + +PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2, i, j: INTEGER; + +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + i := 0; + j := n1; + WHILE i < n2 DO + s1[j] := s2[i]; + INC(i); + INC(j) + END; + + s1[j] := 0X +END append; + + +PROCEDURE [stdcall64] _error* (module, err, line: INTEGER); +VAR + s, temp: ARRAY 1024 OF CHAR; + +BEGIN + CASE err OF + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" + END; + + append(s, API.eol); + + append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); + append(s, "line: "); IntToStr(line, temp); append(s, temp); + + API.DebugMsg(SYSTEM.ADR(s[0]), name); + + API.exit_thread(0) +END _error; + + +PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 +END _isrec; + + +PROCEDURE [stdcall64] _is* (t0, p: INTEGER): INTEGER; +BEGIN + IF p # 0 THEN + SYSTEM.GET(p - WORD, p); + SYSTEM.GET(t0 + p + types, p) + END + + RETURN p MOD 2 +END _is; + + +PROCEDURE [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 +END _guardrec; + + +PROCEDURE [stdcall64] _guard* (t0, p: INTEGER): INTEGER; +BEGIN + SYSTEM.GET(p, p); + IF p # 0 THEN + SYSTEM.GET(p - WORD, p); + SYSTEM.GET(t0 + p + types, p) + ELSE + p := 1 + END + + RETURN p MOD 2 +END _guard; + + +PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) +END _dllentry; + + +PROCEDURE [stdcall64] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + +PROCEDURE [stdcall64] _exit* (code: INTEGER); +BEGIN + API.exit(code) +END _exit; + + +PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); +VAR + t0, t1, i, j: INTEGER; + +BEGIN + API.init(param, code); + + 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 * WORD, t1) + END; + + SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) + END + END; + + FOR i := 0 TO MAX_SET DO + FOR j := 0 TO i DO + sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i) + END + END; + + name := modname +END _init; + + +END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/UnixTime.ob07 b/programs/develop/oberon07/Lib/Windows64/UnixTime.ob07 new file mode 100644 index 0000000000..0e6ed5bd6d --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/UnixTime.ob07 @@ -0,0 +1,64 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018-2019, Anton Krotov + All rights reserved. +*) + +MODULE UnixTime; + + +VAR + + days: ARRAY 12, 31, 2 OF INTEGER; + + +PROCEDURE init; +VAR + i, j, k, n0, n1: INTEGER; +BEGIN + + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + days[i, j, 0] := 0; + days[i, j, 1] := 0; + END + END; + + days[ 1, 28, 0] := -1; + + FOR k := 0 TO 1 DO + days[ 1, 29, k] := -1; + days[ 1, 30, k] := -1; + days[ 3, 30, k] := -1; + days[ 5, 30, k] := -1; + days[ 8, 30, k] := -1; + days[10, 30, k] := -1; + END; + + n0 := 0; + n1 := 0; + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + IF days[i, j, 0] = 0 THEN + days[i, j, 0] := n0; + INC(n0) + END; + IF days[i, j, 1] = 0 THEN + days[i, j, 1] := n1; + INC(n1) + END + END + END + +END init; + + +PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; + RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec +END time; + + +BEGIN + init +END UnixTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07 b/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07 new file mode 100644 index 0000000000..86d166008f --- /dev/null +++ b/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07 @@ -0,0 +1,170 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE WINAPI; + +IMPORT SYSTEM, API; + + +CONST + + OFS_MAXPATHNAME* = 128; + + +TYPE + + DLL_ENTRY* = API.DLL_ENTRY; + + STRING = ARRAY 260 OF CHAR; + + TCoord* = RECORD + + X*, Y*: WCHAR + + END; + + TSmallRect* = RECORD + + Left*, Top*, Right*, Bottom*: WCHAR + + END; + + TConsoleScreenBufferInfo* = RECORD + + dwSize*: TCoord; + dwCursorPosition*: TCoord; + wAttributes*: WCHAR; + srWindow*: TSmallRect; + dwMaximumWindowSize*: TCoord + + END; + + TSystemTime* = RECORD + + Year*, + Month*, + DayOfWeek*, + Day*, + Hour*, + Min*, + Sec*, + MSec*: WCHAR + + END; + + PSecurityAttributes* = POINTER TO TSecurityAttributes; + + TSecurityAttributes* = RECORD + + nLength*: INTEGER; + lpSecurityDescriptor*: INTEGER; + bInheritHandle*: INTEGER + + END; + + TFileTime* = RECORD + + dwLowDateTime*, + dwHighDateTime*: INTEGER + + END; + + OFSTRUCT* = RECORD + + cBytes*: CHAR; + fFixedDisk*: CHAR; + nErrCode*: WCHAR; + Reserved1*: WCHAR; + Reserved2*: WCHAR; + szPathName*: ARRAY OFS_MAXPATHNAME OF CHAR + + END; + + POverlapped* = POINTER TO OVERLAPPED; + + OVERLAPPED* = RECORD + + Internal*: INTEGER; + InternalHigh*: INTEGER; + Offset*: INTEGER; + OffsetHigh*: INTEGER; + hEvent*: INTEGER + + END; + + +PROCEDURE [windows-, "kernel32.dll", "SetConsoleCursorPosition"] + SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetConsoleScreenBufferInfo"] + GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputCharacterA"] + FillConsoleOutputCharacter* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputAttribute"] + FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "SetConsoleTextAttribute"] + SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] + GetStdHandle* (nStdHandle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] + CloseHandle* (hObject: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteFile"] + WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ReadFile"] + ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] + GetCommandLine* (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] + GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] + GlobalFree* (hMem: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] + ExitProcess* (code: INTEGER); + +PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] + GetTickCount* (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "Sleep"] + Sleep* (dwMilliseconds: INTEGER); + +PROCEDURE [windows-, "kernel32.dll", "FreeLibrary"] + FreeLibrary* (hLibModule: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetProcAddress"] + GetProcAddress* (hModule, name: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "LoadLibraryA"] + LoadLibraryA* (name: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "AllocConsole"] + AllocConsole* (): BOOLEAN; + +PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] + FreeConsole* (): BOOLEAN; + +PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] + GetLocalTime* (T: TSystemTime); + + +PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + API.SetDll(process_detach, thread_detach, thread_attach) +END SetDllEntry; + + +END WINAPI. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/Dialogs.ob07 b/programs/develop/oberon07/Samples/Dialogs.ob07 index d680c3ffde..9ba66c67d5 100644 --- a/programs/develop/oberon07/Samples/Dialogs.ob07 +++ b/programs/develop/oberon07/Samples/Dialogs.ob07 @@ -1,4 +1,4 @@ -MODULE Dialogs; +MODULE Dialogs; IMPORT KOSAPI, sys := SYSTEM, OpenDlg, ColorDlg; @@ -107,4 +107,4 @@ END main; BEGIN main -END Dialogs. +END Dialogs. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/HW.ob07 b/programs/develop/oberon07/Samples/HW.ob07 index 707071da17..3412f93b53 100644 --- a/programs/develop/oberon07/Samples/HW.ob07 +++ b/programs/develop/oberon07/Samples/HW.ob07 @@ -1,4 +1,4 @@ -MODULE HW; +MODULE HW; IMPORT sys := SYSTEM, KOSAPI; @@ -47,4 +47,4 @@ END Main; BEGIN Main("HW", "Hello, world!") -END HW. +END HW. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/HW_con.ob07 b/programs/develop/oberon07/Samples/HW_con.ob07 index e32bec396f..7f8f9e136c 100644 --- a/programs/develop/oberon07/Samples/HW_con.ob07 +++ b/programs/develop/oberon07/Samples/HW_con.ob07 @@ -1,4 +1,4 @@ -MODULE HW_con; +MODULE HW_con; IMPORT Out, In, Console, DateTime; @@ -60,4 +60,4 @@ BEGIN main; In.Ln; Console.exit(TRUE) -END HW_con. +END HW_con. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/AMD64.ob07 b/programs/develop/oberon07/Source/AMD64.ob07 index b93712817d..a4ae7285c8 100644 --- a/programs/develop/oberon07/Source/AMD64.ob07 +++ b/programs/develop/oberon07/Source/AMD64.ob07 @@ -1,14 +1,14 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) MODULE AMD64; -IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, - REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86; +IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, TARGETS, + REG, C := CONSOLE, UTILS, S := STRINGS, PE32, ELF, X86; CONST @@ -74,25 +74,25 @@ END OutByte; PROCEDURE OutByte2 (a, b: BYTE); BEGIN - OutByte(a); - OutByte(b) + X86.OutByte(a); + X86.OutByte(b) END OutByte2; PROCEDURE OutByte3 (a, b, c: BYTE); BEGIN - OutByte(a); - OutByte(b); - OutByte(c) + X86.OutByte(a); + X86.OutByte(b); + X86.OutByte(c) END OutByte3; PROCEDURE OutInt (n: INTEGER); BEGIN - OutByte(UTILS.Byte(n, 0)); - OutByte(UTILS.Byte(n, 1)); - OutByte(UTILS.Byte(n, 2)); - OutByte(UTILS.Byte(n, 3)) + X86.OutByte(n MOD 256); + X86.OutByte(UTILS.Byte(n, 1)); + X86.OutByte(UTILS.Byte(n, 2)); + X86.OutByte(UTILS.Byte(n, 3)) END OutInt; @@ -114,7 +114,7 @@ END long; PROCEDURE OutIntByte (n: INTEGER); BEGIN IF isByte(n) THEN - OutByte(UTILS.Byte(n, 0)) + OutByte(n MOD 256) ELSE OutInt(n) END @@ -154,74 +154,74 @@ END Rex; PROCEDURE lea (reg, offset, section: INTEGER); BEGIN Rex(0, reg); - OutByte2(8DH, 05H + 8 * (reg MOD 8)); // lea reg, [rip + offset] + OutByte2(8DH, 05H + 8 * (reg MOD 8)); (* lea reg, [rip + offset] *) X86.Reloc(section, offset) END lea; -PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); // op reg1, reg2 +PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *) BEGIN Rex(reg1, reg2); OutByte2(op, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8) END oprr; -PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); // op reg1, reg2 +PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *) BEGIN Rex(reg1, reg2); OutByte3(op1, op2, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8) END oprr2; -PROCEDURE mov (reg1, reg2: INTEGER); // mov reg1, reg2 +PROCEDURE mov (reg1, reg2: INTEGER); (* mov reg1, reg2 *) BEGIN oprr(89H, reg1, reg2) END mov; -PROCEDURE xor (reg1, reg2: INTEGER); // xor reg1, reg2 +PROCEDURE xor (reg1, reg2: INTEGER); (* xor reg1, reg2 *) BEGIN oprr(31H, reg1, reg2) END xor; -PROCEDURE and (reg1, reg2: INTEGER); // and reg1, reg2 +PROCEDURE and (reg1, reg2: INTEGER); (* and reg1, reg2 *) BEGIN oprr(21H, reg1, reg2) END and; -PROCEDURE or (reg1, reg2: INTEGER); // and reg1, reg2 +PROCEDURE or (reg1, reg2: INTEGER); (* or reg1, reg2 *) BEGIN oprr(09H, reg1, reg2) END or; -PROCEDURE add (reg1, reg2: INTEGER); // add reg1, reg2 +PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *) BEGIN oprr(01H, reg1, reg2) END add; -PROCEDURE sub (reg1, reg2: INTEGER); // sub reg1, reg2 +PROCEDURE sub (reg1, reg2: INTEGER); (* sub reg1, reg2 *) BEGIN oprr(29H, reg1, reg2) END sub; -PROCEDURE xchg (reg1, reg2: INTEGER); // xchg reg1, reg2 +PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *) BEGIN oprr(87H, reg1, reg2) END xchg; -PROCEDURE cmprr (reg1, reg2: INTEGER); // cmp reg1, reg2 +PROCEDURE cmprr (reg1, reg2: INTEGER); (* cmp reg1, reg2 *) BEGIN oprr(39H, reg1, reg2) END cmprr; -PROCEDURE pop (reg: INTEGER); // pop reg +PROCEDURE pop (reg: INTEGER); (* pop reg *) BEGIN IF reg >= 8 THEN OutByte(41H) @@ -230,7 +230,7 @@ BEGIN END pop; -PROCEDURE push (reg: INTEGER); // push reg +PROCEDURE push (reg: INTEGER); (* push reg *) BEGIN IF reg >= 8 THEN OutByte(41H) @@ -242,14 +242,14 @@ END push; PROCEDURE decr (reg: INTEGER); BEGIN Rex(reg, 0); - OutByte2(0FFH, 0C8H + reg MOD 8) // dec reg1 + OutByte2(0FFH, 0C8H + reg MOD 8) (* dec reg1 *) END decr; PROCEDURE incr (reg: INTEGER); BEGIN Rex(reg, 0); - OutByte2(0FFH, 0C0H + reg MOD 8) // inc reg1 + OutByte2(0FFH, 0C0H + reg MOD 8) (* inc reg1 *) END incr; @@ -276,7 +276,7 @@ VAR BEGIN reg := GetAnyReg(); lea(reg, label, sIMP); - IF reg >= 8 THEN // call qword[reg] + IF reg >= 8 THEN (* call qword[reg] *) OutByte(41H) END; OutByte2(0FFH, 10H + reg MOD 8); @@ -337,14 +337,14 @@ VAR BEGIN Rex(reg, 0); - OutByte(0B8H + reg MOD 8); // movabs reg, n + OutByte(0B8H + reg MOD 8); (* movabs reg, n *) FOR i := 0 TO 7 DO OutByte(UTILS.Byte(n, i)) END END movabs; -PROCEDURE movrc (reg, n: INTEGER); // mov reg, n +PROCEDURE movrc (reg, n: INTEGER); (* mov reg, n *) BEGIN IF isLong(n) THEN movabs(reg, n) @@ -358,7 +358,7 @@ BEGIN END movrc; -PROCEDURE test (reg: INTEGER); // test reg, reg +PROCEDURE test (reg: INTEGER); (* test reg, reg *) BEGIN oprr(85H, reg, reg) END test; @@ -370,6 +370,7 @@ VAR BEGIN reg2 := GetAnyReg(); + ASSERT(reg2 # reg); movabs(reg2, n); oprr(reg, reg2); drop @@ -388,30 +389,46 @@ BEGIN END oprc; -PROCEDURE cmprc (reg, n: INTEGER); // cmp reg, n +PROCEDURE cmprc (reg, n: INTEGER); (* cmp reg, n *) BEGIN - oprc(0F8H, reg, n, cmprr) + IF n = 0 THEN + test(reg) + ELSE + oprc(0F8H, reg, n, cmprr) + END END cmprc; -PROCEDURE addrc (reg, n: INTEGER); // add reg, n +PROCEDURE addrc (reg, n: INTEGER); (* add reg, n *) BEGIN oprc(0C0H, reg, n, add) END addrc; -PROCEDURE subrc (reg, n: INTEGER); // sub reg, n +PROCEDURE subrc (reg, n: INTEGER); (* sub reg, n *) BEGIN oprc(0E8H, reg, n, sub) END subrc; -PROCEDURE andrc (reg, n: INTEGER); // and reg, n +PROCEDURE andrc (reg, n: INTEGER); (* and reg, n *) BEGIN oprc(0E0H, reg, n, and) END andrc; +PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *) +BEGIN + oprc(0C8H, reg, n, or) +END orrc; + + +PROCEDURE xorrc (reg, n: INTEGER); (* xor reg, n *) +BEGIN + oprc(0F0H, reg, n, xor) +END xorrc; + + PROCEDURE pushc (n: INTEGER); VAR reg2: INTEGER; @@ -423,147 +440,57 @@ BEGIN push(reg2); drop ELSE - OutByte(68H + short(n)); OutIntByte(n) // push n + OutByte(68H + short(n)); OutIntByte(n) (* push n *) END END pushc; -PROCEDURE not (reg: INTEGER); // not reg +PROCEDURE not (reg: INTEGER); (* not reg *) BEGIN Rex(reg, 0); OutByte2(0F7H, 0D0H + reg MOD 8) END not; -PROCEDURE neg (reg: INTEGER); // neg reg +PROCEDURE neg (reg: INTEGER); (* neg reg *) BEGIN Rex(reg, 0); OutByte2(0F7H, 0D8H + reg MOD 8) END neg; -PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); // movzx reg1, byte/word[reg2 + offs] -VAR - b: BYTE; - +PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); (* movzx reg1, byte/word[reg2 + offs] *) BEGIN Rex(reg2, reg1); - OutByte2(0FH, 0B6H + ORD(word)); - IF (offs = 0) & (reg2 # rbp) THEN - b := 0 - ELSE - b := 40H + long(offs) - END; - OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); - IF reg2 = rsp THEN - OutByte(24H) - END; - IF b # 0 THEN - OutIntByte(offs) - END + X86.movzx(reg1, reg2, offs, word) END movzx; -PROCEDURE _movrm (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN); -VAR - b: BYTE; - +PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); (* mov dword[reg1+offs], reg2_32 *) BEGIN - IF size = 16 THEN - OutByte(66H) - END; - IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN - OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64)) - END; - OutByte(8BH - 2 * ORD(mr) - ORD(size = 8)); - IF (offs = 0) & (reg2 # rbp) THEN - b := 0 - ELSE - b := 40H + long(offs) - END; - OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); - IF reg2 = rsp THEN - OutByte(24H) - END; - IF b # 0 THEN - OutIntByte(offs) - END -END _movrm; - - -PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); // mov dword[reg1+offs], reg2_32 -BEGIN - _movrm(reg2, reg1, offs, 32, TRUE) + X86._movrm(reg2, reg1, offs, 32, TRUE) END movmr32; -PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); // mov reg1_32, dword[reg2+offs] +PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); (* mov reg1_32, dword[reg2+offs] *) BEGIN - _movrm(reg1, reg2, offs, 32, FALSE) + X86._movrm(reg1, reg2, offs, 32, FALSE) END movrm32; -PROCEDURE movmr8 (reg1, offs, reg2: INTEGER); // mov byte[reg1+offs], reg2_8 +PROCEDURE movmr (reg1, offs, reg2: INTEGER); (* mov qword[reg1+offs], reg2 *) BEGIN - _movrm(reg2, reg1, offs, 8, TRUE) -END movmr8; - - -PROCEDURE movrm8 (reg1, reg2, offs: INTEGER); // mov reg1_8, byte[reg2+offs] -BEGIN - _movrm(reg1, reg2, offs, 8, FALSE) -END movrm8; - - -PROCEDURE movmr16 (reg1, offs, reg2: INTEGER); // mov word[reg1+offs], reg2_16 -BEGIN - _movrm(reg2, reg1, offs, 16, TRUE) -END movmr16; - - -PROCEDURE movrm16 (reg1, reg2, offs: INTEGER); // mov reg1_16, word[reg2+offs] -BEGIN - _movrm(reg1, reg2, offs, 16, FALSE) -END movrm16; - - -PROCEDURE movmr (reg1, offs, reg2: INTEGER); // mov qword[reg1+offs], reg2 -BEGIN - _movrm(reg2, reg1, offs, 64, TRUE) + X86._movrm(reg2, reg1, offs, 64, TRUE) END movmr; -PROCEDURE movrm (reg1, reg2, offs: INTEGER); // mov reg1, qword[reg2+offs] +PROCEDURE movrm (reg1, reg2, offs: INTEGER); (* mov reg1, qword[reg2+offs] *) BEGIN - _movrm(reg1, reg2, offs, 64, FALSE) + X86._movrm(reg1, reg2, offs, 64, FALSE) END movrm; -PROCEDURE pushm (reg, offs: INTEGER); // push qword[reg+offs] -VAR - b: BYTE; - -BEGIN - IF reg >= 8 THEN - OutByte(41H) - END; - OutByte(0FFH); - IF (offs = 0) & (reg # rbp) THEN - b := 30H - ELSE - b := 70H + long(offs) - END; - OutByte(b + reg MOD 8); - IF reg = rsp THEN - OutByte(24H) - END; - IF b # 30H THEN - OutIntByte(offs) - END -END pushm; - - -PROCEDURE comisd (xmm1, xmm2: INTEGER); // comisd xmm1, xmm2 +PROCEDURE comisd (xmm1, xmm2: INTEGER); (* comisd xmm1, xmm2 *) BEGIN OutByte(66H); IF (xmm1 >= 8) OR (xmm2 >= 8) THEN @@ -598,13 +525,13 @@ BEGIN END _movsdrm; -PROCEDURE movsdrm (xmm, reg, offs: INTEGER); // movsd xmm, qword[reg+offs] +PROCEDURE movsdrm (xmm, reg, offs: INTEGER); (* movsd xmm, qword[reg+offs] *) BEGIN _movsdrm(xmm, reg, offs, FALSE) END movsdrm; -PROCEDURE movsdmr (reg, offs, xmm: INTEGER); // movsd qword[reg+offs], xmm +PROCEDURE movsdmr (reg, offs, xmm: INTEGER); (* movsd qword[reg+offs], xmm *) BEGIN _movsdrm(xmm, reg, offs, TRUE) END movsdmr; @@ -620,19 +547,19 @@ BEGIN END opxx; -PROCEDURE jcc (cc, label: INTEGER); // jcc label +PROCEDURE jcc (cc, label: INTEGER); (* jcc label *) BEGIN X86.jcc(cc, label) END jcc; -PROCEDURE jmp (label: INTEGER); // jmp label +PROCEDURE jmp (label: INTEGER); (* jmp label *) BEGIN X86.jmp(label) END jmp; -PROCEDURE setcc (cc, reg: INTEGER); //setcc reg8 +PROCEDURE setcc (cc, reg: INTEGER); (* setcc reg8 *) BEGIN IF reg >= 8 THEN OutByte(41H) @@ -680,7 +607,6 @@ VAR reg: INTEGER; max: INTEGER; loop: INTEGER; - param2: INTEGER; BEGIN loop := 1; @@ -756,17 +682,7 @@ BEGIN leaf := FALSE |IL.opDIVR, IL.opMODR: - param2 := cur.param2; - IF param2 >= 1 THEN - param2 := UTILS.Log2(param2) - ELSIF param2 <= -1 THEN - param2 := UTILS.Log2(-param2) - ELSE - param2 := -1 - END; - IF param2 < 0 THEN - leaf := FALSE - END + leaf := UTILS.Log2(cur.param2) >= 0 ELSE @@ -912,9 +828,9 @@ BEGIN comisd(xmm - 1, xmm); cc := setnc END; - OutByte2(7AH, 3 + reg DIV 8); // jp L + OutByte2(7AH, 3 + reg DIV 8); (* jp L *) setcc(cc, reg); - //L: + (* L: *) END fcmp; @@ -969,7 +885,7 @@ BEGIN |IL.opWIN64CALLP: Win64Passing(param2) |IL.opSYSVCALLP: SysVPassing(param2) END; - OutByte2(0FFH, 0D0H); // call rax + OutByte2(0FFH, 0D0H); (* call rax *) REG.Restore(R); ASSERT(R.top = -1) @@ -989,6 +905,10 @@ BEGIN |IL.opERR: CallRTL(IL._error) + |IL.opONERR: + pushc(param2); + jmp(param1) + |IL.opPUSHC: pushc(param2) @@ -1117,9 +1037,9 @@ BEGIN n := param2; IF n > 4 THEN movrc(rcx, n); - // L: + (* L: *) pushc(0); - OutByte2(0E2H, 0FCH) // loop L + OutByte2(0E2H, 0FCH) (* loop L *) ELSE WHILE n > 0 DO pushc(0); @@ -1156,9 +1076,9 @@ BEGIN pop(rbp); IF param2 > 0 THEN - OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2 + OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2 *) ELSE - OutByte(0C3H) // ret + X86.ret END; REG.Reset(R) @@ -1265,7 +1185,7 @@ BEGIN |IL.opLADR: n := param2 * 8; next := cmd.next(COMMAND); - IF next.opcode = IL.opSAVEF THEN + IF (next.opcode = IL.opSAVEF) OR (next.opcode = IL.opSAVEFI) THEN movsdmr(rbp, n, xmm); DEC(xmm); cmd := next @@ -1276,7 +1196,7 @@ BEGIN ELSE reg1 := GetAnyReg(); Rex(0, reg1); - OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n] + OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); (* lea reg1, qword[rbp+n] *) OutIntByte(n) END @@ -1291,7 +1211,7 @@ BEGIN IF reg1 >= 8 THEN OutByte(41H) END; - OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2 + OutByte3(0C6H, reg1 MOD 8, param2); (* mov byte[reg1], param2 *) drop |IL.opSAVE16C: @@ -1301,7 +1221,7 @@ BEGIN OutByte(41H) END; OutByte2(0C7H, reg1 MOD 8); - OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2 + OutByte2(param2 MOD 256, param2 DIV 256); (* mov word[reg1], param2 *) drop |IL.opSAVEC: @@ -1313,7 +1233,7 @@ BEGIN drop ELSE Rex(reg1, 0); - OutByte2(0C7H, reg1 MOD 8); // mov qword[reg1], param2 + OutByte2(0C7H, reg1 MOD 8); (* mov qword[reg1], param2 *) OutInt(param2) END; drop @@ -1346,17 +1266,17 @@ BEGIN |IL.opINCL, IL.opEXCL: BinOp(reg1, reg2); cmprc(reg1, 64); - OutByte2(73H, 04H); // jnb L + OutByte2(73H, 04H); (* jnb L *) Rex(reg2, reg1); - OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 - // L: + OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); (* bts/btr qword[reg2], reg1 *) + (* L: *) drop; drop |IL.opINCLC, IL.opEXCLC: UnOp(reg1); Rex(reg1, 0); - OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2 + OutByte2(0FH, 0BAH); (* bts/btr qword[reg1], param2 *) OutByte2(28H + 8 * ORD(opcode = IL.opEXCLC) + reg1 MOD 8, param2); drop @@ -1384,26 +1304,19 @@ BEGIN drop ELSE UnOp(reg1); - IF param2 = 0 THEN - test(reg1) - ELSE - cmprc(reg1, param2) - END + cmprc(reg1, param2) END; drop; cc := X86.cond(opcode); - IF cmd.next(COMMAND).opcode = IL.opJE THEN - label := cmd.next(COMMAND).param1; - jcc(cc, label); - cmd := cmd.next(COMMAND) - - ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN - label := cmd.next(COMMAND).param1; - jcc(X86.inv0(cc), label); - cmd := cmd.next(COMMAND) - + next := cmd.next(COMMAND); + IF next.opcode = IL.opJE THEN + jcc(cc, next.param1); + cmd := next + ELSIF next.opcode = IL.opJNE THEN + jcc(X86.inv0(cc), next.param1); + cmd := next ELSE reg1 := GetAnyReg(); setcc(cc + 16, reg1); @@ -1447,6 +1360,11 @@ BEGIN test(reg1); jcc(je, param1) + |IL.opJG: + UnOp(reg1); + test(reg1); + jcc(jg, param1) + |IL.opJE: UnOp(reg1); test(reg1); @@ -1459,7 +1377,11 @@ BEGIN jcc(je, param1); drop - |IL.opIN: + |IL.opIN, IL.opINR: + IF opcode = IL.opINR THEN + reg2 := GetAnyReg(); + movrc(reg2, param2) + END; label := NewLabel(); L := NewLabel(); BinOp(reg1, reg2); @@ -1469,25 +1391,7 @@ BEGIN jmp(label); X86.SetLabel(L); Rex(reg2, reg1); - OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1 - setcc(setc, reg1); - andrc(reg1, 1); - X86.SetLabel(label); - drop - - |IL.opINR: - label := NewLabel(); - L := NewLabel(); - UnOp(reg1); - reg2 := GetAnyReg(); - cmprc(reg1, 64); - jcc(jb, L); - xor(reg1, reg1); - jmp(label); - X86.SetLabel(L); - movrc(reg2, param2); - Rex(reg2, reg1); - OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1 + OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); (* bt reg2, reg1 *) setcc(setc, reg1); andrc(reg1, 1); X86.SetLabel(label); @@ -1496,7 +1400,7 @@ BEGIN |IL.opINL: UnOp(reg1); Rex(reg1, 0); - OutByte2(0FH, 0BAH); // bt reg1, param2 + OutByte2(0FH, 0BAH); (* bt reg1, param2 *) OutByte2(0E0H + reg1 MOD 8, param2); setcc(setc, reg1); andrc(reg1, 1) @@ -1516,9 +1420,9 @@ BEGIN |IL.opABS: UnOp(reg1); test(reg1); - OutByte2(7DH, 03H); // jge L + OutByte2(7DH, 03H); (* jge L *) neg(reg1) - // L: + (* L: *) |IL.opEQB, IL.opNEB: BinOp(reg1, reg2); @@ -1545,11 +1449,13 @@ BEGIN UnOp(reg1); andrc(reg1, param2) - |IL.opDIVSC, IL.opADDSL, IL.opADDSR: + |IL.opDIVSC: UnOp(reg1); - Rex(reg1, 0); - OutByte2(81H + short(param2), 0C8H + 28H * ORD(opcode = IL.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 - OutIntByte(param2) + xorrc(reg1, param2) + + |IL.opADDSL, IL.opADDSR: + UnOp(reg1); + orrc(reg1, param2) |IL.opSUBSL: UnOp(reg1); @@ -1646,7 +1552,7 @@ BEGIN |IL.opTYPEGD: UnOp(reg1); PushAll(0); - pushm(reg1, -8); + X86.pushm(reg1, -8); pushc(param2 * tcount); CallRTL(IL._guardrec); GetRegA @@ -1673,7 +1579,7 @@ BEGIN |IL.opINC, IL.opDEC: BinOp(reg1, reg2); - // add/sub qword[reg2], reg1 + (* add/sub qword[reg2], reg1 *) Rex(reg2, reg1); OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); drop; @@ -1684,15 +1590,15 @@ BEGIN IF isLong(param2) THEN reg2 := GetAnyReg(); movrc(reg2, param2); - // add qword[reg1], reg2 + (* add qword[reg1], reg2 *) Rex(reg1, reg2); OutByte2(01H, reg1 MOD 8 + (reg2 MOD 8) * 8); drop ELSIF ABS(param2) = 1 THEN Rex(reg1, 0); - OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) // inc/dec qword[reg1] + OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) (* inc/dec qword[reg1] *) ELSE - // add qword[reg1], param2 + (* add qword[reg1], param2 *) Rex(reg1, 0); OutByte2(81H + short(param2), reg1 MOD 8); OutIntByte(param2) @@ -1711,13 +1617,13 @@ BEGIN |IL.opSAVE8: BinOp(reg2, reg1); - movmr8(reg1, 0, reg2); + X86.movmr8(reg1, 0, reg2); drop; drop |IL.opSAVE16: BinOp(reg2, reg1); - movmr16(reg1, 0, reg2); + X86.movmr16(reg1, 0, reg2); drop; drop @@ -1727,35 +1633,24 @@ BEGIN drop; drop - |IL.opMIN: + |IL.opMAX, IL.opMIN: BinOp(reg1, reg2); cmprr(reg1, reg2); - OutByte2(7EH, 3); // jle L + OutByte2(7DH + ORD(opcode = IL.opMIN), 3); (* jge/jle L *) mov(reg1, reg2); - // L: + (* L: *) drop - |IL.opMAX: - BinOp(reg1, reg2); - cmprr(reg1, reg2); - OutByte2(7DH, 3); // jge L - mov(reg1, reg2); - // L: - drop - - |IL.opMINC: + |IL.opMAXC, IL.opMINC: UnOp(reg1); cmprc(reg1, param2); label := NewLabel(); - jcc(jle, label); - movrc(reg1, param2); - X86.SetLabel(label) - - |IL.opMAXC: - UnOp(reg1); - cmprc(reg1, param2); - label := NewLabel(); - jcc(jge, label); + IF opcode = IL.opMINC THEN + cc := jle + ELSE + cc := jge + END; + jcc(cc, label); movrc(reg1, param2); X86.SetLabel(label) @@ -1765,7 +1660,7 @@ BEGIN IF reg1 >= 8 THEN OutByte(41H) END; - OutByte3(0FH, 95H, reg1 MOD 8); // setne byte[reg1] + OutByte3(0FH, 95H, reg1 MOD 8); (* setne byte[reg1] *) drop; drop @@ -1774,13 +1669,9 @@ BEGIN IF reg1 >= 8 THEN OutByte(41H) END; - OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); // mov byte[reg1], 0/1 + OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); (* mov byte[reg1], 0/1 *) drop - |IL.opODD: - UnOp(reg1); - andrc(reg1, 1) - |IL.opUMINUS: UnOp(reg1); neg(reg1) @@ -1810,15 +1701,39 @@ BEGIN END |IL.opADDL, IL.opADDR: - IF param2 # 0 THEN + IF (param2 # 0) & ~isLong(param2) THEN UnOp(reg1); - IF param2 = 1 THEN - incr(reg1) - ELSIF param2 = -1 THEN - decr(reg1) + next := cmd.next(COMMAND); + CASE next.opcode OF + |IL.opLOAD64: + movrm(reg1, reg1, param2); + cmd := next + |IL.opLOAD32: + movrm32(reg1, reg1, param2); + shiftrc(shl, reg1, 32); + shiftrc(shr, reg1, 32); + cmd := next + |IL.opLOAD16: + movzx(reg1, reg1, param2, TRUE); + cmd := next + |IL.opLOAD8: + movzx(reg1, reg1, param2, FALSE); + cmd := next + |IL.opLOAD64_PARAM: + X86.pushm(reg1, param2); + drop; + cmd := next ELSE - addrc(reg1, param2) + IF param2 = 1 THEN + incr(reg1) + ELSIF param2 = -1 THEN + decr(reg1) + ELSE + addrc(reg1, param2) + END END + ELSIF isLong(param2) THEN + addrc(reg1, param2) END |IL.opDIV: @@ -1827,40 +1742,15 @@ BEGIN GetRegA |IL.opDIVR: - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) - ELSE - n := -1 - END; - - IF a = 1 THEN - - ELSIF a = -1 THEN + n := UTILS.Log2(param2); + IF n > 0 THEN UnOp(reg1); - neg(reg1) - ELSE - IF n > 0 THEN - UnOp(reg1); - - IF a < 0 THEN - reg2 := GetAnyReg(); - mov(reg2, reg1); - shiftrc(sar, reg1, n); - sub(reg1, reg2); - drop - ELSE - shiftrc(sar, reg1, n) - END - - ELSE - PushAll(1); - pushc(param2); - CallRTL(IL._divmod); - GetRegA - END + shiftrc(sar, reg1, n) + ELSIF n < 0 THEN + PushAll(1); + pushc(param2); + CallRTL(IL._divmod); + GetRegA END |IL.opDIVL: @@ -1879,38 +1769,19 @@ BEGIN GetRegA |IL.opMODR: - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(reg1); + andrc(reg1, param2 - 1); + ELSIF n < 0 THEN + PushAll(1); + pushc(param2); + CallRTL(IL._divmod); + mov(rax, rdx); + GetRegA ELSE - n := -1 - END; - - IF ABS(a) = 1 THEN UnOp(reg1); xor(reg1, reg1) - ELSE - IF n > 0 THEN - UnOp(reg1); - andrc(reg1, ABS(a) - 1); - - IF a < 0 THEN - test(reg1); - label := NewLabel(); - jcc(je, label); - addrc(reg1, a); - X86.SetLabel(label) - END - - ELSE - PushAll(1); - pushc(param2); - CallRTL(IL._divmod); - mov(rax, rdx); - GetRegA - END END |IL.opMODL: @@ -1925,38 +1796,56 @@ BEGIN |IL.opMUL: BinOp(reg1, reg2); - oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2 + oprr2(0FH, 0AFH, reg2, reg1); (* imul reg1, reg2 *) drop |IL.opMULC: - UnOp(reg1); - - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) + IF (cmd.next(COMMAND).opcode = IL.opADD) & ((param2 = 2) OR (param2 = 4) OR (param2 = 8)) THEN + BinOp(reg1, reg2); + OutByte2(48H + 5 * (reg1 DIV 8) + 2 * (reg2 DIV 8), 8DH); (* lea reg1, [reg1 + reg2 * param2] *) + reg1 := reg1 MOD 8; + reg2 := reg2 MOD 8; + OutByte2(04H + reg1 * 8, reg1 + reg2 * 8 + 40H * UTILS.Log2(param2)); + drop; + cmd := cmd.next(COMMAND) ELSE - n := -1 - END; + UnOp(reg1); - IF a = 1 THEN - - ELSIF a = -1 THEN - neg(reg1) - ELSIF a = 0 THEN - xor(reg1, reg1) - ELSE - IF n > 0 THEN - IF a < 0 THEN - neg(reg1) - END; - shiftrc(shl, reg1, n) + a := param2; + IF a > 1 THEN + n := UTILS.Log2(a) + ELSIF a < -1 THEN + n := UTILS.Log2(-a) ELSE - // imul reg1, a - Rex(reg1, reg1); - OutByte2(69H + short(a), 0C0H + (reg1 MOD 8) * 9); - OutIntByte(a) + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + neg(reg1) + ELSIF a = 0 THEN + xor(reg1, reg1) + ELSE + IF n > 0 THEN + IF a < 0 THEN + neg(reg1) + END; + shiftrc(shl, reg1, n) + ELSE + IF isLong(a) THEN + reg2 := GetAnyReg(); + movabs(reg2, a); + ASSERT(reg1 # reg2); + oprr2(0FH, 0AFH, reg2, reg1); (* imul reg1, reg2 *) + drop + ELSE + (* imul reg1, a *) + Rex(reg1, reg1); + OutByte2(69H + short(a), 0C0H + (reg1 MOD 8) * 9); + OutIntByte(a) + END + END END END @@ -1990,24 +1879,30 @@ BEGIN |IL.opENDSW: |IL.opCASEL: - cmprc(rax, param1); - jcc(jl, param2) - - |IL.opCASER: - cmprc(rax, param1); - jcc(jg, param2) - - |IL.opCASELR: + GetRegA; cmprc(rax, param1); jcc(jl, param2); - jcc(jg, cmd.param3) + drop + + |IL.opCASER: + GetRegA; + cmprc(rax, param1); + jcc(jg, param2); + drop + + |IL.opCASELR: + GetRegA; + cmprc(rax, param1); + jcc(jl, param2); + jcc(jg, cmd.param3); + drop |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: BinOp(reg1, reg2); xchg(reg2, rcx); Rex(reg1, 0); OutByte(0D3H); - X86.shift(opcode, reg1 MOD 8); // shift reg1, cl + X86.shift(opcode, reg1 MOD 8); (* shift reg1, cl *) xchg(reg2, rcx); drop @@ -2018,7 +1913,7 @@ BEGIN xchg(reg1, rcx); Rex(reg2, 0); OutByte(0D3H); - X86.shift(opcode, reg2 MOD 8); // shift reg2, cl + X86.shift(opcode, reg2 MOD 8); (* shift reg2, cl *) xchg(reg1, rcx); drop; drop; @@ -2038,8 +1933,8 @@ BEGIN END; drop; drop; - _movrm(reg1, reg1, 0, param2 * 8, FALSE); - _movrm(reg1, reg2, 0, param2 * 8, TRUE) + X86._movrm(reg1, reg1, 0, param2 * 8, FALSE); + X86._movrm(reg1, reg2, 0, param2 * 8, TRUE) |IL.opCHKBYTE: BinOp(reg1, reg2); @@ -2055,14 +1950,11 @@ BEGIN BinOp(reg1, reg2); IF param2 # -1 THEN cmprr(reg2, reg1); - mov(reg1, reg2); - drop; - jcc(jb, param1) - ELSE - INCL(R.regs, reg1); - DEC(R.top); - R.stk[R.top] := reg2 - END + jcc(jb, param1); + END; + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 |IL.opLENGTH: PushAll(2); @@ -2127,7 +2019,7 @@ BEGIN IF reg1 >= 8 THEN OutByte(41H) END; - OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 + OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); (* add/sub byte[reg1], param2 MOD 256 *) drop |IL.opINCB, IL.opDECB: @@ -2135,7 +2027,7 @@ BEGIN IF (reg1 >= 8) OR (reg2 >= 8) THEN OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8)) END; - OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 + OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); (* add/sub byte[reg2], reg1_8 *) drop; drop @@ -2149,7 +2041,7 @@ BEGIN IF reg1 >= 8 THEN OutByte(41H) END; - OutByte2(8FH, reg1 MOD 8); // pop qword[reg1] + OutByte2(8FH, reg1 MOD 8); (* pop qword[reg1] *) drop |IL.opCLEANUP: @@ -2181,7 +2073,7 @@ BEGIN drop; NewNumber(UTILS.splitf(float, a, b)) - |IL.opSAVEF: + |IL.opSAVEF, IL.opSAVEFI: UnOp(reg1); movsdmr(reg1, 0, xmm); DEC(xmm); @@ -2216,35 +2108,35 @@ BEGIN |IL.opUMINF: reg1 := GetAnyReg(); lea(reg1, Numbers_Offs, sDATA); - OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // xorpd xmm, xmmword[reg1] + OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* xorpd xmm, xmmword[reg1] *) OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8); drop |IL.opFABS: reg1 := GetAnyReg(); lea(reg1, Numbers_Offs + 16, sDATA); - OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // andpd xmm, xmmword[reg1] + OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* andpd xmm, xmmword[reg1] *) OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8); drop |IL.opFLT: UnOp(reg1); INC(xmm); - OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1 + OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); (* cvtsi2sd xmm, reg1 *) OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8); drop |IL.opFLOOR: reg1 := GetAnyReg(); subrc(rsp, 8); - OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4]; - OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp]; - OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); // and dword[rsp],11111111111111111001111111111111b; - OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); // or dword[rsp],00000000000000000010000000000000b; - OutByte2(00FH, 0AEH); OutByte2(014H, 024H); // ldmxcsr dword[rsp]; - OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); // cvtsd2si reg1, xmm + OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); (* stmxcsr dword[rsp+4]; *) + OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); (* stmxcsr dword[rsp]; *) + OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); (* and dword[rsp],11111111111111111001111111111111b; *) + OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); (* or dword[rsp],00000000000000000010000000000000b; *) + OutByte2(00FH, 0AEH); OutByte2(014H, 024H); (* ldmxcsr dword[rsp]; *) + OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); (* cvtsd2si reg1, xmm *) OutByte2(2DH, 0C0H + xmm MOD 8 + (reg1 MOD 8) * 8); - OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); // ldmxcsr dword[rsp+4]; + OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); (* ldmxcsr dword[rsp+4]; *) addrc(rsp, 8); DEC(xmm) @@ -2278,7 +2170,7 @@ BEGIN movrm(reg2, reg2, 0); push(reg1); - lea(reg1, Numbers_Offs + 40, sDATA); // {0..51, 63} + lea(reg1, Numbers_Offs + 40, sDATA); (* {0..51, 63} *) movrm(reg1, reg1, 0); and(reg2, reg1); pop(reg1); @@ -2299,7 +2191,7 @@ BEGIN IF ~regVar THEN reg2 := GetAnyReg(); Rex(0, reg2); - OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n] + OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); (* lea reg2, qword[rbp+n] *) OutIntByte(n) END ELSE @@ -2324,14 +2216,14 @@ BEGIN movrm(reg1, reg2, 0); push(reg2); - lea(reg2, Numbers_Offs + 48, sDATA); // {52..61} + lea(reg2, Numbers_Offs + 48, sDATA); (* {52..61} *) movrm(reg2, reg2, 0); or(reg1, reg2); pop(reg2); Rex(reg1, 0); OutByte2(0FH, 0BAH); - OutByte2(0F0H + reg1 MOD 8, 3EH); // btr reg1, 62 + OutByte2(0F0H + reg1 MOD 8, 3EH); (* btr reg1, 62 *) movmr(reg2, 0, reg1); drop; drop @@ -2340,11 +2232,11 @@ BEGIN pushDA(stroffs + param2) |IL.opVADR_PARAM: - pushm(rbp, param2 * 8) + X86.pushm(rbp, param2 * 8) |IL.opLOAD64_PARAM: UnOp(reg1); - pushm(reg1, 0); + X86.pushm(reg1, 0); drop |IL.opLLOAD64_PARAM: @@ -2352,7 +2244,7 @@ BEGIN IF reg1 # -1 THEN push(reg1) ELSE - pushm(rbp, param2 * 8) + X86.pushm(rbp, param2 * 8) END |IL.opGLOAD64_PARAM: @@ -2405,7 +2297,7 @@ BEGIN movmr(rbp, n, reg2); drop ELSE - OutByte3(48H, 0C7H, 45H + long(n)); // mov qword[rbp+n],param2 + OutByte3(48H, 0C7H, 45H + long(n)); (* mov qword[rbp+n], param2 *) OutIntByte(n); OutInt(param2) END @@ -2424,7 +2316,7 @@ BEGIN reg2 := GetAnyReg(); lea(reg2, param1, sBSS); Rex(reg2, 0); - OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2 + OutByte2(0C7H, reg2 MOD 8); (* mov qword[reg2], param2 *) OutInt(param2); drop END @@ -2450,7 +2342,7 @@ BEGIN n := param1 * 8; Rex(0, reg2); OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8); - OutIntByte(n) // add qword[rbp+n],reg2 + OutIntByte(n) (* add qword[rbp+n], reg2 *) END; drop ELSIF ABS(param2) = 1 THEN @@ -2462,7 +2354,7 @@ BEGIN END ELSE n := param1 * 8; - OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec qword[rbp+n] + OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec qword[rbp+n] *) OutIntByte(n) END ELSE @@ -2472,7 +2364,7 @@ BEGIN n := param1 * 8; OutByte3(48H, 81H + short(param2), 45H + long(n)); OutIntByte(n); - OutIntByte(param2) // add qword[rbp+n],param2 + OutIntByte(param2) (* add qword[rbp+n], param2 *) END END @@ -2490,7 +2382,7 @@ BEGIN n := param1 * 8; OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB)); OutIntByte(n); - OutByte(param2) // add/sub byte[rbp+n],param2 + OutByte(param2) (* add/sub byte[rbp+n], param2 *) END |IL.opLADR_INC, IL.opLADR_DEC: @@ -2506,7 +2398,7 @@ BEGIN n := param2 * 8; Rex(0, reg1); OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); - OutIntByte(n) // add/sub qword[rbp+n],reg1 + OutIntByte(n) (* add/sub qword[rbp+n], reg1 *) END; drop @@ -2526,7 +2418,7 @@ BEGIN OutByte(44H) END; OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); - OutIntByte(n) // add/sub byte[rbp+n], reg1_8 + OutIntByte(n) (* add/sub byte[rbp+n], reg1_8 *) END; drop @@ -2535,27 +2427,27 @@ BEGIN cmprc(reg1, 64); reg2 := GetVarReg(param2); IF reg2 # -1 THEN - OutByte2(73H, 4); // jnb L - oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 + OutByte2(73H, 4); (* jnb L *) + oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) (* bts/btr reg2, reg1 *) ELSE n := param2 * 8; - OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L + OutByte2(73H, 5 + 3 * ORD(~isByte(n))); (* jnb L *) Rex(0, reg1); OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); - OutIntByte(n) // bts/btr qword[rbp+n], reg1 + OutIntByte(n) (* bts/btr qword[rbp+n], reg1 *) END; - // L: + (* L: *) drop |IL.opLADR_INCLC, IL.opLADR_EXCLC: reg1 := GetVarReg(param1); IF reg1 # -1 THEN Rex(reg1, 0); - OutByte3(0FH, 0BAH, 0E8H); // bts/btr reg1, param2 + OutByte3(0FH, 0BAH, 0E8H); (* bts/btr reg1, param2 *) OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2) ELSE n := param1 * 8; - OutByte3(48H, 0FH, 0BAH); // bts/btr qword[rbp+n], param2 + OutByte3(48H, 0FH, 0BAH); (* bts/btr qword[rbp+n], param2 *) OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); OutIntByte(n); OutByte(param2) @@ -2586,7 +2478,7 @@ BEGIN entry := NewLabel(); X86.SetLabel(entry); - IF target = mConst.Target_iDLL64 THEN + IF target = TARGETS.Win64DLL THEN dllret := NewLabel(); push(r8); push(rdx); @@ -2596,7 +2488,7 @@ BEGIN jcc(je, dllret) END; - IF target = mConst.Target_iELF64 THEN + IF target = TARGETS.Linux64 THEN push(rsp) ELSE pushc(0) @@ -2604,12 +2496,12 @@ BEGIN lea(rax, entry, sCODE); push(rax); - pushDA(0); //TYPES + pushDA(0); (* TYPES *) pushc(tcount); - pushDA(ModName_Offs); //MODNAME + pushDA(ModName_Offs); (* MODNAME *) CallRTL(IL._init); - IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iELF64} THEN + IF target IN {TARGETS.Win64C, TARGETS.Win64GUI, TARGETS.Linux64} THEN L := NewLabel(); pushc(0); push(rsp); @@ -2619,7 +2511,9 @@ BEGIN pop(rax); test(rax); jcc(je, L); + GetRegA; addrc(rax, 1024 * 1024 * stack_size - 8); + drop; mov(rsp, rax); X86.SetLabel(L) END @@ -2655,15 +2549,15 @@ VAR BEGIN - IF target = mConst.Target_iDLL64 THEN + IF target = TARGETS.Win64DLL THEN X86.SetLabel(dllret); - OutByte(0C3H) // ret - ELSIF target = mConst.Target_iELFSO64 THEN + X86.ret + ELSIF target = TARGETS.Linux64SO THEN sofinit := NewLabel(); - OutByte(0C3H); // ret + X86.ret; X86.SetLabel(sofinit); CallRTL(IL._sofinit); - OutByte(0C3H) // ret + X86.ret ELSE pushc(0); CallRTL(IL._exit) @@ -2724,8 +2618,8 @@ PROCEDURE rsave (reg, offs, size: INTEGER); BEGIN offs := offs * 8; CASE size OF - |1: movmr8(rbp, offs, reg) - |2: movmr16(rbp, offs, reg) + |1: X86.movmr8(rbp, offs, reg) + |2: X86.movmr16(rbp, offs, reg) |4: movmr32(rbp, offs, reg) |8: movmr(rbp, offs, reg) END @@ -2778,12 +2672,12 @@ BEGIN epilog(modname, target); BIN.fixup(prog); - IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN - PE32.write(prog, outname, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) - ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN - ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE) + IF TARGETS.OS = TARGETS.osWIN64 THEN + PE32.write(prog, outname, target = TARGETS.Win64C, target = TARGETS.Win64DLL, TRUE) + ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN + ELF.write(prog, outname, sofinit, target = TARGETS.Linux64SO, TRUE) END END CodeGen; -END AMD64. +END AMD64. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/ARITH.ob07 b/programs/develop/oberon07/Source/ARITH.ob07 index 452e2b7b8c..2b10af2e1f 100644 --- a/programs/develop/oberon07/Source/ARITH.ob07 +++ b/programs/develop/oberon07/Source/ARITH.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -75,15 +75,20 @@ BEGIN END Float; +PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN; + RETURN (a <= i.int) & (i.int <= b) +END range; + + PROCEDURE check* (v: VALUE): BOOLEAN; VAR res: BOOLEAN; BEGIN CASE v.typ OF - |tINTEGER: res := (UTILS.target.minInt <= v.int) & (v.int <= UTILS.target.maxInt) - |tCHAR: res := (0 <= v.int) & (v.int <= 255) - |tWCHAR: res := (0 <= v.int) & (v.int <= 65535) + |tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt) + |tCHAR: res := range(v, 0, 255) + |tWCHAR: res := range(v, 0, 65535) |tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal) END @@ -196,61 +201,15 @@ END hconv; PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN; -VAR - max: REAL; - res: BOOLEAN; - BEGIN - max := UTILS.maxreal; - CASE op OF - |"+": - IF (a < 0.0) & (b < 0.0) THEN - res := a > -max - b - ELSIF (a > 0.0) & (b > 0.0) THEN - res := a < max - b - ELSE - res := TRUE - END; - IF res THEN - a := a + b - END - - |"-": - IF (a < 0.0) & (b > 0.0) THEN - res := a > b - max - ELSIF (a > 0.0) & (b < 0.0) THEN - res := a < b + max - ELSE - res := TRUE - END; - IF res THEN - a := a - b - END - - |"*": - IF (ABS(a) > 1.0) & (ABS(b) > 1.0) THEN - res := ABS(a) < max / ABS(b) - ELSE - res := TRUE - END; - IF res THEN - a := a * b - END - - |"/": - IF ABS(b) < 1.0 THEN - res := ABS(a) < max * ABS(b) - ELSE - res := TRUE - END; - IF res THEN - a := a / b - END - + |"+": a := a + b + |"-": a := a - b + |"*": a := a * b + |"/": a := a / b END - RETURN res + RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *) END opFloat2; @@ -407,13 +366,8 @@ VAR BEGIN ASSERT(x > 0); - n := 0; - WHILE ~ODD(x) DO - x := x DIV 2; - INC(n) - END; - - IF x # 1 THEN + n := UTILS.Log2(x); + IF n = -1 THEN n := 255 END @@ -521,7 +475,7 @@ BEGIN |"-": success := subInt(a.int, b.int) |"*": success := mulInt(a.int, b.int) |"/": success := FALSE - |"D": IF (b.int # -1) OR (a.int # UTILS.minint) THEN a.int := a.int DIV b.int ELSE success := FALSE END + |"D": a.int := a.int DIV b.int |"M": a.int := a.int MOD b.int |"L": a.int := _LSL(a.int, b.int) |"A": a.int := _ASR(a.int, b.int) @@ -670,11 +624,6 @@ BEGIN END opBoolean; -PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN; - RETURN (a <= i.int) & (i.int <= b) -END range; - - PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN; VAR res: BOOLEAN; @@ -834,4 +783,4 @@ END init; BEGIN init -END ARITH. +END ARITH. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/AVLTREES.ob07 b/programs/develop/oberon07/Source/AVLTREES.ob07 index bb0cf0bfb3..64b1990b63 100644 --- a/programs/develop/oberon07/Source/AVLTREES.ob07 +++ b/programs/develop/oberon07/Source/AVLTREES.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -194,4 +194,4 @@ END destroy; BEGIN nodes := C.create() -END AVLTREES. +END AVLTREES. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/BIN.ob07 b/programs/develop/oberon07/Source/BIN.ob07 index 554624c4d8..14c94bc8b4 100644 --- a/programs/develop/oberon07/Source/BIN.ob07 +++ b/programs/develop/oberon07/Source/BIN.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -12,17 +12,12 @@ IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS; CONST - RCODE* = 1; - RDATA* = 2; - RBSS* = 3; - RIMP* = 4; + RCODE* = 0; PICCODE* = RCODE + 1; + RDATA* = 2; PICDATA* = RDATA + 1; + RBSS* = 4; PICBSS* = RBSS + 1; + RIMP* = 6; PICIMP* = RIMP + 1; - PICCODE* = 5; - PICDATA* = 6; - PICBSS* = 7; - PICIMP* = 8; - - IMPTAB* = 9; + IMPTAB* = 8; TYPE @@ -211,6 +206,13 @@ BEGIN END PutCode32LE; +PROCEDURE PutCode16LE* (program: PROGRAM; x: INTEGER); +BEGIN + CHL.PushByte(program.code, UTILS.Byte(x, 0)); + CHL.PushByte(program.code, UTILS.Byte(x, 1)) +END PutCode16LE; + + PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER); BEGIN CHL.SetInt(program.labels, label, offset) @@ -380,4 +382,4 @@ BEGIN END InitArray; -END BIN. +END BIN. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 index d020a3a71b..03b505c2f9 100644 --- a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 +++ b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -12,8 +12,8 @@ IMPORT LISTS, WR := WRITER; CONST - LENOFBYTECHUNK = 64000; - LENOFINTCHUNK = 16000; + LENOFBYTECHUNK = 65536; + LENOFINTCHUNK = 16384; TYPE @@ -283,4 +283,4 @@ PROCEDURE Length* (list: ANYLIST): INTEGER; END Length; -END CHUNKLISTS. +END CHUNKLISTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/COLLECTIONS.ob07 b/programs/develop/oberon07/Source/COLLECTIONS.ob07 index 21b97ea336..f9b713a0b9 100644 --- a/programs/develop/oberon07/Source/COLLECTIONS.ob07 +++ b/programs/develop/oberon07/Source/COLLECTIONS.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -56,4 +56,4 @@ BEGIN END create; -END COLLECTIONS. +END COLLECTIONS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CONSOLE.ob07 b/programs/develop/oberon07/Source/CONSOLE.ob07 index 372b190da4..b5916839c7 100644 --- a/programs/develop/oberon07/Source/CONSOLE.ob07 +++ b/programs/develop/oberon07/Source/CONSOLE.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -79,4 +79,4 @@ BEGIN END Int2Ln; -END CONSOLE. +END CONSOLE. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CONSTANTS.ob07 b/programs/develop/oberon07/Source/CONSTANTS.ob07 deleted file mode 100644 index f7006b5ab3..0000000000 --- a/programs/develop/oberon07/Source/CONSTANTS.ob07 +++ /dev/null @@ -1,49 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2018-2019, Anton Krotov - All rights reserved. -*) - -MODULE CONSTANTS; - -CONST - - vMajor* = 1; - vMinor* = 13; - - FILE_EXT* = ".ob07"; - RTL_NAME* = "RTL"; - - MAX_GLOBAL_SIZE* = 1600000000; - - Target_iConsole* = 1; - Target_iGUI* = 2; - Target_iDLL* = 3; - Target_iKolibri* = 4; - Target_iObject* = 5; - Target_iConsole64* = 6; - Target_iGUI64* = 7; - Target_iDLL64* = 8; - Target_iELF32* = 9; - Target_iELFSO32* = 10; - Target_iELF64* = 11; - Target_iELFSO64* = 12; - Target_iMSP430* = 13; - - Target_sConsole* = "console"; - Target_sGUI* = "gui"; - Target_sDLL* = "dll"; - Target_sKolibri* = "kos"; - Target_sObject* = "obj"; - Target_sConsole64* = "console64"; - Target_sGUI64* = "gui64"; - Target_sDLL64* = "dll64"; - Target_sELF32* = "elfexe"; - Target_sELFSO32* = "elfso"; - Target_sELF64* = "elfexe64"; - Target_sELFSO64* = "elfso64"; - Target_sMSP430* = "msp430"; - - -END CONSTANTS. diff --git a/programs/develop/oberon07/Source/Compiler.ob07 b/programs/develop/oberon07/Source/Compiler.ob07 index ed4945902e..32b1aebac2 100644 --- a/programs/develop/oberon07/Source/Compiler.ob07 +++ b/programs/develop/oberon07/Source/Compiler.ob07 @@ -1,52 +1,14 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) MODULE Compiler; -IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430; - - -PROCEDURE Target (s: ARRAY OF CHAR): INTEGER; -VAR - res: INTEGER; - -BEGIN - IF s = mConst.Target_sConsole THEN - res := mConst.Target_iConsole - ELSIF s = mConst.Target_sGUI THEN - res := mConst.Target_iGUI - ELSIF s = mConst.Target_sDLL THEN - res := mConst.Target_iDLL - ELSIF s = mConst.Target_sKolibri THEN - res := mConst.Target_iKolibri - ELSIF s = mConst.Target_sObject THEN - res := mConst.Target_iObject - ELSIF s = mConst.Target_sConsole64 THEN - res := mConst.Target_iConsole64 - ELSIF s = mConst.Target_sGUI64 THEN - res := mConst.Target_iGUI64 - ELSIF s = mConst.Target_sDLL64 THEN - 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 - - RETURN res -END Target; +IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, + ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS; PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH); @@ -168,6 +130,22 @@ BEGIN END keys; +PROCEDURE OutTargetItem (target: INTEGER; text: ARRAY OF CHAR); +VAR + width: INTEGER; + +BEGIN + width := 15; + width := width - LENGTH(TARGETS.Targets[target].ComLinePar) - 4; + C.String(" '"); C.String(TARGETS.Targets[target].ComLinePar); C.String("'"); + WHILE width > 0 DO + C.String(20X); + DEC(width) + END; + C.StringLn(text) +END OutTargetItem; + + PROCEDURE main; VAR path: PARS.PATH; @@ -180,7 +158,6 @@ VAR param: PARS.PATH; temp: PARS.PATH; target: INTEGER; - bit_depth: INTEGER; time: INTEGER; options: PROG.OPTIONS; @@ -196,32 +173,46 @@ BEGIN UTILS.GetArg(1, inname); C.Ln; - C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); + C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor); C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); - C.StringLn("Copyright (c) 2018-2019, Anton Krotov"); + C.StringLn("Copyright (c) 2018-2020, Anton Krotov"); IF inname = "" THEN C.Ln; C.StringLn("Usage: Compiler
[optional settings]"); C.Ln; + C.StringLn("target ="); IF UTILS.bit_depth = 64 THEN - 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 | elfso | msp430'); C.Ln; + OutTargetItem(TARGETS.Win64C, "Windows64 Console"); + OutTargetItem(TARGETS.Win64GUI, "Windows64 GUI"); + OutTargetItem(TARGETS.Win64DLL, "Windows64 DLL"); + OutTargetItem(TARGETS.Linux64, "Linux64 Exec"); + OutTargetItem(TARGETS.Linux64SO, "Linux64 SO") END; + OutTargetItem(TARGETS.Win32C, "Windows32 Console"); + OutTargetItem(TARGETS.Win32GUI, "Windows32 GUI"); + OutTargetItem(TARGETS.Win32DLL, "Windows32 DLL"); + OutTargetItem(TARGETS.Linux32, "Linux32 Exec"); + OutTargetItem(TARGETS.Linux32SO, "Linux32 SO"); + OutTargetItem(TARGETS.KolibriOS, "KolibriOS Exec"); + OutTargetItem(TARGETS.KolibriOSDLL, "KolibriOS DLL"); + OutTargetItem(TARGETS.MSP430, "MSP430x{1,2}xx microcontrollers"); + OutTargetItem(TARGETS.STM32CM3, "STM32 Cortex-M3 microcontrollers"); + C.Ln; C.StringLn("optional settings:"); C.Ln; - C.StringLn(" -out output"); C.Ln; - C.StringLn(" -stk set size of stack in megabytes"); C.Ln; - C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); - C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; - C.StringLn(" -ver set version of program ('obj' target)"); C.Ln; - C.StringLn(" -ram set size of RAM in bytes ('msp430' target)"); C.Ln; - C.StringLn(" -rom set size of ROM in bytes ('msp430' target)"); C.Ln; + C.StringLn(" -out output"); C.Ln; + C.StringLn(" -stk set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln; + C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,"); + C.StringLn(" BYTE, CHR, WCHR)"); C.Ln; + C.StringLn(" -ver set version of program (KolibriOS DLL)"); C.Ln; + C.StringLn(" -ram set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; + C.StringLn(" -rom set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; UTILS.Exit(0) END; + C.StringLn("--------------------------------------------"); PATHS.split(inname, path, modname, ext); - IF ext # mConst.FILE_EXT THEN + IF ext # UTILS.FILE_EXT THEN ERRORS.Error(207) END; @@ -235,76 +226,36 @@ BEGIN ERRORS.Error(205) END; - target := Target(param); - - IF target = 0 THEN + IF TARGETS.Select(param) THEN + target := TARGETS.target + ELSE ERRORS.Error(206) END; - CASE target OF - |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: - bit_depth := 64 - |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, - mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32: - bit_depth := 32 - |mConst.Target_iMSP430: - bit_depth := 16; + IF target = TARGETS.MSP430 THEN options.ram := MSP430.minRAM; options.rom := MSP430.minROM END; - IF UTILS.bit_depth < bit_depth THEN + IF target = TARGETS.STM32CM3 THEN + options.ram := THUMB.STM32_minRAM; + options.rom := THUMB.STM32_minROM + END; + + IF UTILS.bit_depth < TARGETS.BitDepth THEN ERRORS.Error(206) END; STRINGS.append(lib_path, "lib"); STRINGS.append(lib_path, UTILS.slash); - - CASE target OF - |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL: - STRINGS.append(lib_path, "Windows32") - - |mConst.Target_iKolibri, mConst.Target_iObject: - STRINGS.append(lib_path, "KolibriOS") - - |mConst.Target_iELF32, mConst.Target_iELFSO32: - STRINGS.append(lib_path, "Linux32") - - |mConst.Target_iELF64, mConst.Target_iELFSO64: - STRINGS.append(lib_path, "Linux64") - - |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, TARGETS.LibDir); STRINGS.append(lib_path, UTILS.slash); keys(options, outname); IF outname = "" THEN outname := path; STRINGS.append(outname, modname); - CASE target OF - |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iConsole64, mConst.Target_iGUI64: - STRINGS.append(outname, ".exe") - - |mConst.Target_iObject: - STRINGS.append(outname, ".obj") - - |mConst.Target_iKolibri, mConst.Target_iELF32, mConst.Target_iELF64: - - |mConst.Target_iELFSO32, mConst.Target_iELFSO64: - STRINGS.append(outname, ".so") - - |mConst.Target_iDLL, mConst.Target_iDLL64: - STRINGS.append(outname, ".dll") - - |mConst.Target_iMSP430: - STRINGS.append(outname, ".hex") - END + STRINGS.append(outname, TARGETS.FileExt) ELSE IF PATHS.isRelative(outname) THEN PATHS.RelPath(app_path, outname, temp); @@ -312,15 +263,12 @@ BEGIN END END; - 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; + PARS.init(options); ST.compile(path, lib_path, modname, outname, target, options); time := UTILS.GetTickCount() - UTILS.time; - + C.StringLn("--------------------------------------------"); C.Int(PARS.lines); C.String(" lines, "); C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, "); C.Int(WRITER.counter); C.StringLn(" bytes"); @@ -331,4 +279,4 @@ END main; BEGIN main -END Compiler. +END Compiler. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/ELF.ob07 b/programs/develop/oberon07/Source/ELF.ob07 index d502af91a6..df64fcae5e 100644 --- a/programs/develop/oberon07/Source/ELF.ob07 +++ b/programs/develop/oberon07/Source/ELF.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -142,23 +142,27 @@ END WritePH64; PROCEDURE fixup (program: BIN.PROGRAM; text, data, bss: INTEGER; amd64: BOOLEAN); VAR reloc: BIN.RELOC; - L, delta: INTEGER; + code: CHL.BYTELIST; + L, delta, delta0: INTEGER; BEGIN + code := program.code; + delta0 := 3 - 7 * ORD(amd64); reloc := program.rel_list.first(BIN.RELOC); + WHILE reloc # NIL DO - L := BIN.get32le(program.code, reloc.offset); - delta := 3 - reloc.offset - text - 7 * ORD(amd64); + L := BIN.get32le(code, reloc.offset); + delta := delta0 - reloc.offset - text; CASE reloc.opcode OF - |BIN.PICDATA: BIN.put32le(program.code, reloc.offset, L + data + delta) - |BIN.PICCODE: BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta) - |BIN.PICBSS: BIN.put32le(program.code, reloc.offset, L + bss + delta) + |BIN.PICDATA: BIN.put32le(code, reloc.offset, L + data + delta) + |BIN.PICCODE: BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta) + |BIN.PICBSS: BIN.put32le(code, reloc.offset, L + bss + delta) END; reloc := reloc.next(BIN.RELOC) - END; + END END fixup; @@ -648,4 +652,4 @@ BEGIN END write; -END ELF. +END ELF. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/ERRORS.ob07 b/programs/develop/oberon07/Source/ERRORS.ob07 index 0121f39d0d..b925b6fe5b 100644 --- a/programs/develop/oberon07/Source/ERRORS.ob07 +++ b/programs/develop/oberon07/Source/ERRORS.ob07 @@ -1,13 +1,13 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) MODULE ERRORS; -IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS; +IMPORT C := CONSOLE, UTILS; PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); @@ -73,7 +73,7 @@ BEGIN | 43: str := "expression is not an integer" | 44: str := "out of range 0..MAXSET" | 45: str := "division by zero" - | 46: str := "integer division by zero" + | 46: str := "IV out of range" | 47: str := "'OF' or ',' expected" | 48: str := "undeclared identifier" | 49: str := "type expected" @@ -137,7 +137,7 @@ BEGIN |107: str := "too large parameter of CHR" |108: str := "a variable or a procedure expected" |109: str := "expression should be constant" - + |110: str := "out of range 0..65535" |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" @@ -146,8 +146,8 @@ BEGIN |116: str := "procedure too deep nested" |120: str := "too many formal parameters" - - |122: str := "negative divisor" + |121: str := "multiply defined handler" + |122: str := "bad divisor" |123: str := "illegal flag" |124: str := "unknown flag" |125: str := "flag not supported" @@ -184,7 +184,7 @@ END Error5; PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR); BEGIN - Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found") + Error5("procedure ", UTILS.RTL_NAME, ".", ProcName, " not found") END WrongRTL; @@ -209,9 +209,9 @@ BEGIN |204: Error1("size of variables is too large") |205: Error1("not enough parameters") |206: Error1("bad parameter ") - |207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"') + |207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"') END END Error; -END ERRORS. +END ERRORS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/FILES.ob07 b/programs/develop/oberon07/Source/FILES.ob07 index 7aa5b0be4a..1ef926ca01 100644 --- a/programs/develop/oberon07/Source/FILES.ob07 +++ b/programs/develop/oberon07/Source/FILES.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -17,7 +17,9 @@ TYPE ptr: INTEGER; buffer: ARRAY 64*1024 OF BYTE; - count: INTEGER + count: INTEGER; + + chksum*: INTEGER END; @@ -83,7 +85,8 @@ BEGIN IF ptr > 0 THEN file := NewFile(); file.ptr := ptr; - file.count := 0 + file.count := 0; + file.chksum := 0 ELSE file := NIL END @@ -190,30 +193,14 @@ END write; PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN; VAR - res: BOOLEAN; + arr: ARRAY 1 OF BYTE; BEGIN - res := TRUE; - IF (file # NIL) & (file.count >= 0) THEN - IF file.count = LEN(file.buffer) THEN - IF flush(file) # LEN(file.buffer) THEN - res := FALSE - ELSE - file.buffer[0] := byte; - file.count := 1 - END - ELSE - file.buffer[file.count] := byte; - INC(file.count) - END - ELSE - res := FALSE - END - - RETURN res + arr[0] := byte + RETURN write(file, arr, 1) = 1 END WriteByte; BEGIN files := C.create() -END FILES. +END FILES. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/HEX.ob07 b/programs/develop/oberon07/Source/HEX.ob07 new file mode 100644 index 0000000000..2bfbdd80e3 --- /dev/null +++ b/programs/develop/oberon07/Source/HEX.ob07 @@ -0,0 +1,127 @@ +(* + BSD 2-Clause License + + Copyright (c) 2020, Anton Krotov + All rights reserved. +*) + +MODULE HEX; + +IMPORT FILES, WRITER, CHL := CHUNKLISTS; + + +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 Byte (file: FILES.FILE; byte: BYTE); +BEGIN + WRITER.WriteByte(file, hexdgt(byte DIV 16)); + WRITER.WriteByte(file, hexdgt(byte MOD 16)); + INC(file.chksum, byte); +END Byte; + + +PROCEDURE NewLine (file: FILES.FILE); +BEGIN + Byte(file, (-file.chksum) MOD 256); + file.chksum := 0; + WRITER.WriteByte(file, 0DH); + WRITER.WriteByte(file, 0AH) +END NewLine; + + +PROCEDURE StartCode (file: FILES.FILE); +BEGIN + WRITER.WriteByte(file, ORD(":")); + file.chksum := 0 +END StartCode; + + +PROCEDURE Data* (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); +VAR + i, len: INTEGER; + +BEGIN + WHILE cnt > 0 DO + len := MIN(cnt, 16); + StartCode(file); + Byte(file, len); + Byte(file, idx DIV 256); + Byte(file, idx MOD 256); + Byte(file, 0); + FOR i := 1 TO len DO + Byte(file, mem[idx]); + INC(idx) + END; + DEC(cnt, len); + NewLine(file) + END +END Data; + + +PROCEDURE ExtLA* (file: FILES.FILE; LA: INTEGER); +BEGIN + ASSERT((0 <= LA) & (LA <= 0FFFFH)); + StartCode(file); + Byte(file, 2); + Byte(file, 0); + Byte(file, 0); + Byte(file, 4); + Byte(file, LA DIV 256); + Byte(file, LA MOD 256); + NewLine(file) +END ExtLA; + + +PROCEDURE Data2* (file: FILES.FILE; mem: CHL.BYTELIST; idx, cnt, LA: INTEGER); +VAR + i, len, offset: INTEGER; + +BEGIN + ExtLA(file, LA); + offset := 0; + WHILE cnt > 0 DO + ASSERT(offset <= 65536); + IF offset = 65536 THEN + INC(LA); + ExtLA(file, LA); + offset := 0 + END; + len := MIN(cnt, 16); + StartCode(file); + Byte(file, len); + Byte(file, offset DIV 256); + Byte(file, offset MOD 256); + Byte(file, 0); + FOR i := 1 TO len DO + Byte(file, CHL.GetByte(mem, idx)); + INC(idx); + INC(offset) + END; + DEC(cnt, len); + NewLine(file) + END +END Data2; + + +PROCEDURE End* (file: FILES.FILE); +BEGIN + StartCode(file); + Byte(file, 0); + Byte(file, 0); + Byte(file, 0); + Byte(file, 1); + NewLine(file) +END End; + + +END HEX. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/IL.ob07 b/programs/develop/oberon07/Source/IL.ob07 index 9ca222672d..48e7d7eda7 100644 --- a/programs/develop/oberon07/Source/IL.ob07 +++ b/programs/develop/oberon07/Source/IL.ob07 @@ -1,1183 +1,1211 @@ -(* - BSD 2-Clause License - - Copyright (c) 2018-2019, Anton Krotov - All rights reserved. -*) - -MODULE IL; - -IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS; - - -CONST - - little_endian* = 0; - big_endian* = 1; - - call_stack* = 0; - call_win64* = 1; - call_sysv* = 2; - - opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; - opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; - opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; - opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22; - opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; - opNOT* = 29; - - opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *); - opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *) - opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *) - opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *) - opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *); - - opVLOAD32* = 60; opGLOAD32* = 61; - - opJNE* = 62; opJE* = 63; - - opSAVE32* = 64; opLLOAD8* = 65; - - opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; - opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; - - opACC* = 77; opJG* = 78; - opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; - - opCASEL* = 83; opCASER* = 84; opCASELR* = 85; - - opPOPSP* = 86; - opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91; - - opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97; - opPUSHC* = 98; opSWITCH* = 99; - - opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102; - - opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106; - opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112; - opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116; - opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121; - - opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124; - opINCC* = 125; opINC* = 126; opDEC* = 127; - opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133; - opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; - opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; - opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; - opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; - opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162; - opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168; - opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; - opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179; - - opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; - opLSR* = 185; opLSR1* = 186; opLSR2* = 187; - opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192; - opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198; - opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; - opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; - - opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; - opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216; - - opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221; - - - opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4; - opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8; - opLOAD32_PARAM* = -9; - - opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12; - - opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15; - opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19; - opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23; - opLADR_UNPK* = -24; - - - _init *= 0; - _move *= 1; - _strcmpw *= 2; - _exit *= 3; - _set *= 4; - _set1 *= 5; - _lengthw *= 6; - _strcpy *= 7; - _length *= 8; - _divmod *= 9; - _dllentry *= 10; - _sofinit *= 11; - _arrcpy *= 12; - _rot *= 13; - _new *= 14; - _dispose *= 15; - _strcmp *= 16; - _error *= 17; - _is *= 18; - _isrec *= 19; - _guard *= 20; - _guardrec *= 21; - - -TYPE - - LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) - - offset*, size*, count*: INTEGER - - END; - - COMMAND* = POINTER TO RECORD (LISTS.ITEM) - - opcode*: INTEGER; - param1*: INTEGER; - param2*: INTEGER; - param3*: INTEGER; - float*: REAL; - variables*: LISTS.LIST; - allocReg*: BOOLEAN - - END; - - CMDSTACK = POINTER TO RECORD - - data: ARRAY 1000 OF COMMAND; - top: INTEGER - - END; - - EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) - - label*: INTEGER; - name*: SCAN.LEXSTR - - END; - - IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) - - name*: SCAN.LEXSTR; - procs*: LISTS.LIST - - END; - - IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) - - label*: INTEGER; - lib*: IMPORT_LIB; - name*: SCAN.LEXSTR; - count: INTEGER - - END; - - - CODES = RECORD - - last: COMMAND; - begcall: CMDSTACK; - endcall: CMDSTACK; - commands*: LISTS.LIST; - export*: LISTS.LIST; - import*: LISTS.LIST; - types*: CHL.INTLIST; - data*: CHL.BYTELIST; - dmin*: INTEGER; - lcount*: INTEGER; - bss*: INTEGER; - rtl*: ARRAY 22 OF INTEGER; - errlabels*: ARRAY 12 OF INTEGER; - - charoffs: ARRAY 256 OF INTEGER; - wcharoffs: ARRAY 65536 OF INTEGER; - - fregs: INTEGER; - wstr: ARRAY 4*1024 OF WCHAR - END; - - -VAR - - codes*: CODES; - endianness: INTEGER; - numRegsFloat: INTEGER; - - commands, variables: C.COLLECTION; - - -PROCEDURE set_dmin* (value: INTEGER); -BEGIN - codes.dmin := value -END set_dmin; - - -PROCEDURE set_bss* (value: INTEGER); -BEGIN - codes.bss := value -END set_bss; - - -PROCEDURE set_rtl* (idx, label: INTEGER); -BEGIN - codes.rtl[idx] := label -END set_rtl; - - -PROCEDURE NewCmd (): COMMAND; -VAR - cmd: COMMAND; - citem: C.ITEM; - -BEGIN - citem := C.pop(commands); - IF citem = NIL THEN - NEW(cmd) - ELSE - cmd := citem(COMMAND) - END; - - cmd.allocReg := FALSE - - RETURN cmd -END NewCmd; - - -PROCEDURE NewVar* (): LOCALVAR; -VAR - lvar: LOCALVAR; - citem: C.ITEM; - -BEGIN - citem := C.pop(variables); - IF citem = NIL THEN - NEW(lvar) - ELSE - lvar := citem(LOCALVAR) - END; - - lvar.count := 0 - - RETURN lvar -END NewVar; - - -PROCEDURE setlast* (cmd: COMMAND); -BEGIN - codes.last := cmd -END setlast; - - -PROCEDURE getlast* (): COMMAND; - RETURN codes.last -END getlast; - - -PROCEDURE PutByte (b: BYTE); -BEGIN - CHL.PushByte(codes.data, b) -END PutByte; - - -PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER; -VAR - i, n, res: INTEGER; -BEGIN - res := CHL.Length(codes.data); - - i := 0; - n := LENGTH(s); - WHILE i < n DO - PutByte(ORD(s[i])); - INC(i) - END; - - PutByte(0) - - RETURN res -END putstr; - - -PROCEDURE putstr1* (c: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - IF codes.charoffs[c] = -1 THEN - res := CHL.Length(codes.data); - PutByte(c); - PutByte(0); - codes.charoffs[c] := res - ELSE - res := codes.charoffs[c] - END - - RETURN res -END putstr1; - - -PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER; -VAR - i, n, res: INTEGER; - -BEGIN - res := CHL.Length(codes.data); - - IF ODD(res) THEN - PutByte(0); - INC(res) - END; - - n := STRINGS.Utf8To16(s, codes.wstr); - - i := 0; - WHILE i < n DO - IF endianness = little_endian THEN - PutByte(ORD(codes.wstr[i]) MOD 256); - PutByte(ORD(codes.wstr[i]) DIV 256) - ELSIF endianness = big_endian THEN - PutByte(ORD(codes.wstr[i]) DIV 256); - PutByte(ORD(codes.wstr[i]) MOD 256) - END; - INC(i) - END; - - PutByte(0); - PutByte(0) - - RETURN res -END putstrW; - - -PROCEDURE putstrW1* (c: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - IF codes.wcharoffs[c] = -1 THEN - res := CHL.Length(codes.data); - - IF ODD(res) THEN - PutByte(0); - INC(res) - END; - - IF endianness = little_endian THEN - PutByte(c MOD 256); - PutByte(c DIV 256) - ELSIF endianness = big_endian THEN - PutByte(c DIV 256); - PutByte(c MOD 256) - END; - - PutByte(0); - PutByte(0); - - codes.wcharoffs[c] := res - ELSE - res := codes.wcharoffs[c] - END - - RETURN res -END putstrW1; - - -PROCEDURE push (stk: CMDSTACK; cmd: COMMAND); -BEGIN - INC(stk.top); - stk.data[stk.top] := cmd -END push; - - -PROCEDURE pop (stk: CMDSTACK): COMMAND; -VAR - res: COMMAND; -BEGIN - res := stk.data[stk.top]; - DEC(stk.top) - RETURN res -END pop; - - -PROCEDURE pushBegEnd* (VAR beg, end: COMMAND); -BEGIN - push(codes.begcall, beg); - push(codes.endcall, end); - beg := codes.last; - end := beg.next(COMMAND) -END pushBegEnd; - - -PROCEDURE popBegEnd* (VAR beg, end: COMMAND); -BEGIN - beg := pop(codes.begcall); - end := pop(codes.endcall) -END popBegEnd; - - -PROCEDURE AddRec* (base: INTEGER); -BEGIN - CHL.PushInt(codes.types, base) -END AddRec; - - -PROCEDURE insert (cur, nov: COMMAND); -VAR - old_opcode, param2: INTEGER; - - - PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER); - BEGIN - cur.opcode := opcode; - cur.param1 := cur.param2; - cur.param2 := param2 - END set; - - -BEGIN - old_opcode := cur.opcode; - param2 := nov.param2; - - IF (nov.opcode = opPARAM) & (param2 = 1) THEN - - CASE old_opcode OF - |opGLOAD64: cur.opcode := opGLOAD64_PARAM - |opLLOAD64: cur.opcode := opLLOAD64_PARAM - |opLOAD64: cur.opcode := opLOAD64_PARAM - |opGLOAD32: cur.opcode := opGLOAD32_PARAM - |opLLOAD32: cur.opcode := opLLOAD32_PARAM - |opLOAD32: cur.opcode := opLOAD32_PARAM - |opSADR: cur.opcode := opSADR_PARAM - |opVADR: cur.opcode := opVADR_PARAM - |opCONST: cur.opcode := opCONST_PARAM - ELSE - old_opcode := -1 - END - - ELSIF old_opcode = opLADR THEN - - CASE nov.opcode OF - |opSAVEC: set(cur, opLADR_SAVEC, param2) - |opSAVE: cur.opcode := opLADR_SAVE - |opINC: cur.opcode := opLADR_INC - |opDEC: cur.opcode := opLADR_DEC - |opINCB: cur.opcode := opLADR_INCB - |opDECB: cur.opcode := opLADR_DECB - |opINCL: cur.opcode := opLADR_INCL - |opEXCL: cur.opcode := opLADR_EXCL - |opUNPK: cur.opcode := opLADR_UNPK - |opINCC: set(cur, opLADR_INCC, param2) - |opINCCB: set(cur, opLADR_INCCB, param2) - |opDECCB: set(cur, opLADR_DECCB, param2) - |opINCLC: set(cur, opLADR_INCLC, param2) - |opEXCLC: set(cur, opLADR_EXCLC, param2) - ELSE - old_opcode := -1 - END - - ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN - set(cur, opGADR_SAVEC, param2) - - ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN - cur.param2 := param2 * cur.param2 - - ELSE - old_opcode := -1 - END; - - IF old_opcode = -1 THEN - LISTS.insert(codes.commands, cur, nov); - codes.last := nov - ELSE - C.push(commands, nov); - codes.last := cur - END -END insert; - - -PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER); -VAR - cmd: COMMAND; -BEGIN - cmd := NewCmd(); - cmd.opcode := opcode; - cmd.param1 := 0; - cmd.param2 := param; - insert(codes.last, cmd) -END AddCmd; - - -PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER); -VAR - cmd: COMMAND; -BEGIN - cmd := NewCmd(); - cmd.opcode := opcode; - cmd.param1 := param1; - cmd.param2 := param2; - insert(codes.last, cmd) -END AddCmd2; - - -PROCEDURE Const* (val: INTEGER); -BEGIN - AddCmd(opCONST, val) -END Const; - - -PROCEDURE StrAdr* (adr: INTEGER); -BEGIN - AddCmd(opSADR, adr) -END StrAdr; - - -PROCEDURE Param1*; -BEGIN - AddCmd(opPARAM, 1) -END Param1; - - -PROCEDURE NewLabel* (): INTEGER; -BEGIN - INC(codes.lcount) - RETURN codes.lcount - 1 -END NewLabel; - - -PROCEDURE SetLabel* (label: INTEGER); -BEGIN - AddCmd2(opLABEL, label, 0) -END SetLabel; - - -PROCEDURE SetErrLabel* (errno: INTEGER); -BEGIN - codes.errlabels[errno] := NewLabel(); - SetLabel(codes.errlabels[errno]) -END SetErrLabel; - - -PROCEDURE AddCmd0* (opcode: INTEGER); -BEGIN - AddCmd(opcode, 0) -END AddCmd0; - - -PROCEDURE deleteVarList (list: LISTS.LIST); -VAR - last: LISTS.ITEM; - -BEGIN - WHILE list.last # NIL DO - last := LISTS.pop(list); - C.push(variables, last) - END -END deleteVarList; - - -PROCEDURE delete (cmd: COMMAND); -BEGIN - IF cmd.variables # NIL THEN - deleteVarList(cmd.variables) - END; - LISTS.delete(codes.commands, cmd); - C.push(commands, cmd) -END delete; - - -PROCEDURE delete2* (first, last: LISTS.ITEM); -VAR - cur, next: LISTS.ITEM; - -BEGIN - cur := first; - - IF first # last THEN - REPEAT - next := cur.next; - LISTS.delete(codes.commands, cur); - C.push(commands, cur); - cur := next - UNTIL cur = last - END; - - LISTS.delete(codes.commands, cur); - C.push(commands, cur) -END delete2; - - -PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER); -VAR - prev: COMMAND; - not: BOOLEAN; - -BEGIN - prev := codes.last; - not := prev.opcode = opNOT; - IF not THEN - IF opcode = opJE THEN - opcode := opJNE - ELSIF opcode = opJNE THEN - opcode := opJE - ELSE - not := FALSE - END - END; - - AddCmd2(opcode, label, label); - - IF not THEN - delete(prev) - END - -END AddJmpCmd; - - -PROCEDURE OnError* (line, error: INTEGER); -BEGIN - AddCmd(opPUSHC, line); - AddJmpCmd(opJMP, codes.errlabels[error]) -END OnError; - - -PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); -VAR - label: INTEGER; -BEGIN - AddCmd(op, t); - label := NewLabel(); - AddJmpCmd(opJE, label); - OnError(line, error); - SetLabel(label) -END TypeGuard; - - -PROCEDURE TypeCheck* (t: INTEGER); -BEGIN - AddCmd(opIS, t) -END TypeCheck; - - -PROCEDURE TypeCheckRec* (t: INTEGER); -BEGIN - AddCmd(opISREC, t) -END TypeCheckRec; - - -PROCEDURE New* (size, typenum: INTEGER); -BEGIN - AddCmd2(opNEW, typenum, size) -END New; - - -PROCEDURE fcmp* (opcode: INTEGER); -BEGIN - AddCmd(opcode, 0); - DEC(codes.fregs, 2); - ASSERT(codes.fregs >= 0) -END fcmp; - - -PROCEDURE not*; -VAR - prev: COMMAND; -BEGIN - prev := codes.last; - IF prev.opcode = opNOT THEN - codes.last := prev.prev(COMMAND); - delete(prev) - ELSE - AddCmd0(opNOT) - END -END not; - - -PROCEDURE Enter* (label, params: INTEGER): COMMAND; -VAR - cmd: COMMAND; - -BEGIN - cmd := NewCmd(); - cmd.opcode := opENTER; - cmd.param1 := label; - cmd.param3 := params; - cmd.allocReg := TRUE; - insert(codes.last, cmd) - - RETURN codes.last -END Enter; - - -PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND; -BEGIN - IF result THEN - IF float THEN - AddCmd2(opLEAVEF, locsize, paramsize) - ELSE - AddCmd2(opLEAVER, locsize, paramsize) - END - ELSE - AddCmd2(opLEAVE, locsize, paramsize) - END - - RETURN codes.last -END Leave; - - -PROCEDURE EnterC* (label: INTEGER): COMMAND; -BEGIN - SetLabel(label) - RETURN codes.last -END EnterC; - - -PROCEDURE LeaveC* (): COMMAND; -BEGIN - AddCmd0(opLEAVEC) - RETURN codes.last -END LeaveC; - - -PROCEDURE Call* (proc, callconv, fparams: INTEGER); -BEGIN - CASE callconv OF - |call_stack: AddJmpCmd(opCALL, proc) - |call_win64: AddJmpCmd(opWIN64CALL, proc) - |call_sysv: AddJmpCmd(opSYSVCALL, proc) - END; - codes.last(COMMAND).param2 := fparams -END Call; - - -PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); -BEGIN - CASE callconv OF - |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label) - |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label) - |call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label) - END; - codes.last(COMMAND).param2 := fparams -END CallImp; - - -PROCEDURE CallP* (callconv, fparams: INTEGER); -BEGIN - CASE callconv OF - |call_stack: AddCmd0(opCALLP) - |call_win64: AddCmd(opWIN64CALLP, fparams) - |call_sysv: AddCmd(opSYSVCALLP, fparams) - END -END CallP; - - -PROCEDURE AssignProc* (proc: INTEGER); -BEGIN - AddJmpCmd(opSAVEP, proc) -END AssignProc; - - -PROCEDURE AssignImpProc* (proc: LISTS.ITEM); -BEGIN - AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label) -END AssignImpProc; - - -PROCEDURE PushProc* (proc: INTEGER); -BEGIN - AddJmpCmd(opPUSHP, proc) -END PushProc; - - -PROCEDURE PushImpProc* (proc: LISTS.ITEM); -BEGIN - AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label) -END PushImpProc; - - -PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); -BEGIN - IF eq THEN - AddJmpCmd(opEQP, proc) - ELSE - AddJmpCmd(opNEP, proc) - END -END ProcCmp; - - -PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); -BEGIN - IF eq THEN - AddJmpCmd(opEQIP, proc(IMPORT_PROC).label) - ELSE - AddJmpCmd(opNEIP, proc(IMPORT_PROC).label) - END -END ProcImpCmp; - - -PROCEDURE load* (size: INTEGER); -VAR - last: COMMAND; - -BEGIN - last := codes.last; - CASE size OF - |1: - IF last.opcode = opLADR THEN - last.opcode := opLLOAD8 - ELSIF last.opcode = opVADR THEN - last.opcode := opVLOAD8 - ELSIF last.opcode = opGADR THEN - last.opcode := opGLOAD8 - ELSE - AddCmd0(opLOAD8) - END - - |2: - IF last.opcode = opLADR THEN - last.opcode := opLLOAD16 - ELSIF last.opcode = opVADR THEN - last.opcode := opVLOAD16 - ELSIF last.opcode = opGADR THEN - last.opcode := opGLOAD16 - ELSE - AddCmd0(opLOAD16) - END - - |4: - IF last.opcode = opLADR THEN - last.opcode := opLLOAD32 - ELSIF last.opcode = opVADR THEN - last.opcode := opVLOAD32 - ELSIF last.opcode = opGADR THEN - last.opcode := opGLOAD32 - ELSE - AddCmd0(opLOAD32) - END - - |8: - IF last.opcode = opLADR THEN - last.opcode := opLLOAD64 - ELSIF last.opcode = opVADR THEN - last.opcode := opVLOAD64 - ELSIF last.opcode = opGADR THEN - last.opcode := opGLOAD64 - ELSE - AddCmd0(opLOAD64) - END - END -END load; - - -PROCEDURE SysPut* (size: INTEGER); -BEGIN - CASE size OF - |1: AddCmd0(opSAVE8) - |2: AddCmd0(opSAVE16) - |4: AddCmd0(opSAVE32) - |8: AddCmd0(opSAVE64) - END -END SysPut; - - -PROCEDURE savef*; -BEGIN - AddCmd0(opSAVEF); - DEC(codes.fregs); - ASSERT(codes.fregs >= 0) -END savef; - - -PROCEDURE pushf*; -BEGIN - AddCmd0(opPUSHF); - DEC(codes.fregs); - ASSERT(codes.fregs >= 0) -END pushf; - - -PROCEDURE loadf* (): BOOLEAN; -BEGIN - AddCmd0(opLOADF); - INC(codes.fregs) - RETURN codes.fregs < numRegsFloat -END loadf; - - -PROCEDURE inf* (): BOOLEAN; -BEGIN - AddCmd0(opINF); - INC(codes.fregs) - RETURN codes.fregs < numRegsFloat -END inf; - - -PROCEDURE fbinop* (opcode: INTEGER); -BEGIN - AddCmd0(opcode); - DEC(codes.fregs); - ASSERT(codes.fregs > 0) -END fbinop; - - -PROCEDURE saves* (offset, length: INTEGER); -BEGIN - AddCmd2(opSAVES, length, offset) -END saves; - - -PROCEDURE abs* (real: BOOLEAN); -BEGIN - IF real THEN - AddCmd0(opFABS) - ELSE - AddCmd0(opABS) - END -END abs; - - -PROCEDURE floor*; -BEGIN - AddCmd0(opFLOOR); - DEC(codes.fregs); - ASSERT(codes.fregs >= 0) -END floor; - - -PROCEDURE flt* (): BOOLEAN; -BEGIN - AddCmd0(opFLT); - INC(codes.fregs) - RETURN codes.fregs < numRegsFloat -END flt; - - -PROCEDURE shift_minmax* (op: CHAR); -BEGIN - CASE op OF - |"A": AddCmd0(opASR) - |"L": AddCmd0(opLSL) - |"O": AddCmd0(opROR) - |"R": AddCmd0(opLSR) - |"m": AddCmd0(opMIN) - |"x": AddCmd0(opMAX) - END -END shift_minmax; - - -PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER); -BEGIN - CASE op OF - |"A": AddCmd(opASR1, x) - |"L": AddCmd(opLSL1, x) - |"O": AddCmd(opROR1, x) - |"R": AddCmd(opLSR1, x) - |"m": AddCmd(opMINC, x) - |"x": AddCmd(opMAXC, x) - END -END shift_minmax1; - - -PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER); -BEGIN - CASE op OF - |"A": AddCmd(opASR2, x) - |"L": AddCmd(opLSL2, x) - |"O": AddCmd(opROR2, x) - |"R": AddCmd(opLSR2, x) - |"m": AddCmd(opMINC, x) - |"x": AddCmd(opMAXC, x) - END -END shift_minmax2; - - -PROCEDURE len* (dim: INTEGER); -BEGIN - AddCmd(opLEN, dim) -END len; - - -PROCEDURE Float* (r: REAL); -VAR - cmd: COMMAND; - -BEGIN - cmd := NewCmd(); - cmd.opcode := opCONSTF; - cmd.float := r; - insert(codes.last, cmd); - INC(codes.fregs); - ASSERT(codes.fregs <= numRegsFloat) -END Float; - - -PROCEDURE precall* (flt: BOOLEAN): INTEGER; -VAR - res: INTEGER; -BEGIN - res := codes.fregs; - AddCmd2(opPRECALL, ORD(flt), res); - codes.fregs := 0 - RETURN res -END precall; - - -PROCEDURE resf* (fregs: INTEGER): BOOLEAN; -BEGIN - AddCmd(opRESF, fregs); - codes.fregs := fregs + 1 - RETURN codes.fregs < numRegsFloat -END resf; - - -PROCEDURE res* (fregs: INTEGER); -BEGIN - AddCmd(opRES, fregs); - codes.fregs := fregs -END res; - - -PROCEDURE retf*; -BEGIN - DEC(codes.fregs); - ASSERT(codes.fregs = 0) -END retf; - - -PROCEDURE drop*; -BEGIN - AddCmd0(opDROP) -END drop; - - -PROCEDURE case* (a, b, L, R: INTEGER); -VAR - cmd: COMMAND; - -BEGIN - IF a = b THEN - cmd := NewCmd(); - cmd.opcode := opCASELR; - cmd.param1 := a; - cmd.param2 := L; - cmd.param3 := R; - insert(codes.last, cmd) - ELSE - AddCmd2(opCASEL, a, L); - AddCmd2(opCASER, b, R) - END -END case; - - -PROCEDURE caset* (a, label: INTEGER); -BEGIN - AddCmd2(opCASET, label, a) -END caset; - - -PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); -VAR - exp: EXPORT_PROC; - -BEGIN - NEW(exp); - exp.label := label; - exp.name := name; - LISTS.push(codes.export, exp) -END AddExp; - - -PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC; -VAR - lib: IMPORT_LIB; - p: IMPORT_PROC; - -BEGIN - lib := codes.import.first(IMPORT_LIB); - WHILE (lib # NIL) & (lib.name # dll) DO - lib := lib.next(IMPORT_LIB) - END; - - IF lib = NIL THEN - NEW(lib); - lib.name := dll; - lib.procs := LISTS.create(NIL); - LISTS.push(codes.import, lib) - END; - - p := lib.procs.first(IMPORT_PROC); - WHILE (p # NIL) & (p.name # proc) DO - p := p.next(IMPORT_PROC) - END; - - IF p = NIL THEN - NEW(p); - p.name := proc; - p.label := NewLabel(); - p.lib := lib; - p.count := 1; - LISTS.push(lib.procs, p) - ELSE - INC(p.count) - END - - RETURN p -END AddImp; - - -PROCEDURE DelImport* (imp: LISTS.ITEM); -VAR - lib: IMPORT_LIB; - -BEGIN - DEC(imp(IMPORT_PROC).count); - IF imp(IMPORT_PROC).count = 0 THEN - lib := imp(IMPORT_PROC).lib; - LISTS.delete(lib.procs, imp); - IF lib.procs.first = NIL THEN - LISTS.delete(codes.import, lib) - END - END -END DelImport; - - -PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER); -VAR - cmd: COMMAND; - i: INTEGER; - -BEGIN - commands := C.create(); - variables := C.create(); - numRegsFloat := pNumRegsFloat; - endianness := pEndianness; - - NEW(codes.begcall); - codes.begcall.top := -1; - NEW(codes.endcall); - codes.endcall.top := -1; - codes.commands := LISTS.create(NIL); - codes.export := LISTS.create(NIL); - codes.import := LISTS.create(NIL); - codes.types := CHL.CreateIntList(); - codes.data := CHL.CreateByteList(); - - NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); - codes.last := cmd; - NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); - - AddRec(0); - - codes.lcount := 0; - - codes.fregs := 0; - - FOR i := 0 TO LEN(codes.charoffs) - 1 DO - codes.charoffs[i] := -1 - END; - - FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO - codes.wcharoffs[i] := -1 - END - -END init; - - -END IL. +(* + BSD 2-Clause License + + Copyright (c) 2018-2020, Anton Krotov + All rights reserved. +*) + +MODULE IL; + +IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS; + + +CONST + + little_endian* = 0; + big_endian* = 1; + + call_stack* = 0; + call_win64* = 1; + call_sysv* = 2; + + opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; + opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; + opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; + opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22; + opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; + opNOT* = 29; + + opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *); + opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *) + opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *) + opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *) + opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *); + + opVLOAD32* = 60; opGLOAD32* = 61; + + opJNE* = 62; opJE* = 63; + + opSAVE32* = 64; opLLOAD8* = 65; + + opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; + opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; + + opACC* = 77; opJG* = 78; + opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; + + opCASEL* = 83; opCASER* = 84; opCASELR* = 85; + + opPOPSP* = 86; + opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91; + + opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97; + opPUSHC* = 98; opSWITCH* = 99; + + opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102; + + opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106; + opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112; + opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116; + opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121; + + opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124; + opINCC* = 125; opINC* = 126; opDEC* = 127; + opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133; + opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; + opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; + opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; + opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; + opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162; + opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168; + opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; + opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179; + + opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; + opLSR* = 185; opLSR1* = 186; opLSR2* = 187; + opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192; + opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198; + opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; + opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; + + opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; + opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216; + + opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221; + + opONERR* = 222; opSAVEFI* = 223; opHANDLER* = 224; + + + opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4; + opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8; + opLOAD32_PARAM* = -9; + + opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12; + + opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15; + opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19; + opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23; + opLADR_UNPK* = -24; + + + _init *= 0; + _move *= 1; + _strcmpw *= 2; + _exit *= 3; + _set *= 4; + _set1 *= 5; + _lengthw *= 6; + _strcpy *= 7; + _length *= 8; + _divmod *= 9; + _dllentry *= 10; + _sofinit *= 11; + _arrcpy *= 12; + _rot *= 13; + _new *= 14; + _dispose *= 15; + _strcmp *= 16; + _error *= 17; + _is *= 18; + _isrec *= 19; + _guard *= 20; + _guardrec *= 21; + + _fmul *= 22; + _fdiv *= 23; + _fdivi *= 24; + _fadd *= 25; + _fsub *= 26; + _fsubi *= 27; + _fcmp *= 28; + _floor *= 29; + _flt *= 30; + _pack *= 31; + _unpk *= 32; + + +TYPE + + LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) + + offset*, size*, count*: INTEGER + + END; + + COMMAND* = POINTER TO RECORD (LISTS.ITEM) + + opcode*: INTEGER; + param1*: INTEGER; + param2*: INTEGER; + param3*: INTEGER; + float*: REAL; + variables*: LISTS.LIST; + allocReg*: BOOLEAN + + END; + + CMDSTACK = POINTER TO RECORD + + data: ARRAY 1000 OF COMMAND; + top: INTEGER + + END; + + EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + name*: SCAN.LEXSTR + + END; + + IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) + + name*: SCAN.LEXSTR; + procs*: LISTS.LIST + + END; + + IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + lib*: IMPORT_LIB; + name*: SCAN.LEXSTR; + count: INTEGER + + END; + + + CODES = RECORD + + last: COMMAND; + begcall: CMDSTACK; + endcall: CMDSTACK; + commands*: LISTS.LIST; + export*: LISTS.LIST; + import*: LISTS.LIST; + types*: CHL.INTLIST; + data*: CHL.BYTELIST; + dmin*: INTEGER; + lcount*: INTEGER; + bss*: INTEGER; + rtl*: ARRAY 33 OF INTEGER; + errlabels*: ARRAY 12 OF INTEGER; + + charoffs: ARRAY 256 OF INTEGER; + wcharoffs: ARRAY 65536 OF INTEGER; + + fregs: INTEGER; + wstr: ARRAY 4*1024 OF WCHAR + END; + + +VAR + + codes*: CODES; + endianness, numRegsFloat, CPU: INTEGER; + + commands, variables: C.COLLECTION; + + +PROCEDURE set_dmin* (value: INTEGER); +BEGIN + codes.dmin := value +END set_dmin; + + +PROCEDURE set_bss* (value: INTEGER); +BEGIN + codes.bss := value +END set_bss; + + +PROCEDURE set_rtl* (idx, label: INTEGER); +BEGIN + codes.rtl[idx] := label +END set_rtl; + + +PROCEDURE NewCmd (): COMMAND; +VAR + cmd: COMMAND; + citem: C.ITEM; + +BEGIN + citem := C.pop(commands); + IF citem = NIL THEN + NEW(cmd) + ELSE + cmd := citem(COMMAND) + END; + + cmd.allocReg := FALSE + + RETURN cmd +END NewCmd; + + +PROCEDURE NewVar* (): LOCALVAR; +VAR + lvar: LOCALVAR; + citem: C.ITEM; + +BEGIN + citem := C.pop(variables); + IF citem = NIL THEN + NEW(lvar) + ELSE + lvar := citem(LOCALVAR) + END; + + lvar.count := 0 + + RETURN lvar +END NewVar; + + +PROCEDURE setlast* (cmd: COMMAND); +BEGIN + codes.last := cmd +END setlast; + + +PROCEDURE getlast* (): COMMAND; + RETURN codes.last +END getlast; + + +PROCEDURE PutByte (b: BYTE); +BEGIN + CHL.PushByte(codes.data, b) +END PutByte; + + +PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER; +VAR + i, n, res: INTEGER; +BEGIN + res := CHL.Length(codes.data); + + i := 0; + n := LENGTH(s); + WHILE i < n DO + PutByte(ORD(s[i])); + INC(i) + END; + + PutByte(0) + + RETURN res +END putstr; + + +PROCEDURE putstr1* (c: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF codes.charoffs[c] = -1 THEN + res := CHL.Length(codes.data); + PutByte(c); + PutByte(0); + codes.charoffs[c] := res + ELSE + res := codes.charoffs[c] + END + + RETURN res +END putstr1; + + +PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER; +VAR + i, n, res: INTEGER; + +BEGIN + res := CHL.Length(codes.data); + + IF ODD(res) THEN + PutByte(0); + INC(res) + END; + + n := STRINGS.Utf8To16(s, codes.wstr); + + i := 0; + WHILE i < n DO + IF endianness = little_endian THEN + PutByte(ORD(codes.wstr[i]) MOD 256); + PutByte(ORD(codes.wstr[i]) DIV 256) + ELSIF endianness = big_endian THEN + PutByte(ORD(codes.wstr[i]) DIV 256); + PutByte(ORD(codes.wstr[i]) MOD 256) + END; + INC(i) + END; + + PutByte(0); + PutByte(0) + + RETURN res +END putstrW; + + +PROCEDURE putstrW1* (c: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF codes.wcharoffs[c] = -1 THEN + res := CHL.Length(codes.data); + + IF ODD(res) THEN + PutByte(0); + INC(res) + END; + + IF endianness = little_endian THEN + PutByte(c MOD 256); + PutByte(c DIV 256) + ELSIF endianness = big_endian THEN + PutByte(c DIV 256); + PutByte(c MOD 256) + END; + + PutByte(0); + PutByte(0); + + codes.wcharoffs[c] := res + ELSE + res := codes.wcharoffs[c] + END + + RETURN res +END putstrW1; + + +PROCEDURE push (stk: CMDSTACK; cmd: COMMAND); +BEGIN + INC(stk.top); + stk.data[stk.top] := cmd +END push; + + +PROCEDURE pop (stk: CMDSTACK): COMMAND; +VAR + res: COMMAND; +BEGIN + res := stk.data[stk.top]; + DEC(stk.top) + RETURN res +END pop; + + +PROCEDURE pushBegEnd* (VAR beg, end: COMMAND); +BEGIN + push(codes.begcall, beg); + push(codes.endcall, end); + beg := codes.last; + end := beg.next(COMMAND) +END pushBegEnd; + + +PROCEDURE popBegEnd* (VAR beg, end: COMMAND); +BEGIN + beg := pop(codes.begcall); + end := pop(codes.endcall) +END popBegEnd; + + +PROCEDURE AddRec* (base: INTEGER); +BEGIN + CHL.PushInt(codes.types, base) +END AddRec; + + +PROCEDURE insert (cur, nov: COMMAND); +VAR + old_opcode, param2: INTEGER; + + + PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER); + BEGIN + cur.opcode := opcode; + cur.param1 := cur.param2; + cur.param2 := param2 + END set; + + +BEGIN + IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN + + old_opcode := cur.opcode; + param2 := nov.param2; + + IF (nov.opcode = opPARAM) & (param2 = 1) THEN + + CASE old_opcode OF + |opGLOAD64: cur.opcode := opGLOAD64_PARAM + |opLLOAD64: cur.opcode := opLLOAD64_PARAM + |opLOAD64: cur.opcode := opLOAD64_PARAM + |opGLOAD32: cur.opcode := opGLOAD32_PARAM + |opLLOAD32: cur.opcode := opLLOAD32_PARAM + |opLOAD32: cur.opcode := opLOAD32_PARAM + |opSADR: cur.opcode := opSADR_PARAM + |opVADR: cur.opcode := opVADR_PARAM + |opCONST: cur.opcode := opCONST_PARAM + ELSE + old_opcode := -1 + END + + ELSIF old_opcode = opLADR THEN + + CASE nov.opcode OF + |opSAVEC: set(cur, opLADR_SAVEC, param2) + |opSAVE: cur.opcode := opLADR_SAVE + |opINC: cur.opcode := opLADR_INC + |opDEC: cur.opcode := opLADR_DEC + |opINCB: cur.opcode := opLADR_INCB + |opDECB: cur.opcode := opLADR_DECB + |opINCL: cur.opcode := opLADR_INCL + |opEXCL: cur.opcode := opLADR_EXCL + |opUNPK: cur.opcode := opLADR_UNPK + |opINCC: set(cur, opLADR_INCC, param2) + |opINCCB: set(cur, opLADR_INCCB, param2) + |opDECCB: set(cur, opLADR_DECCB, param2) + |opINCLC: set(cur, opLADR_INCLC, param2) + |opEXCLC: set(cur, opLADR_EXCLC, param2) + ELSE + old_opcode := -1 + END + + ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN + set(cur, opGADR_SAVEC, param2) + + ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN + cur.param2 := param2 * cur.param2 + + ELSE + old_opcode := -1 + END + ELSE + old_opcode := -1 + END; + + IF old_opcode = -1 THEN + LISTS.insert(codes.commands, cur, nov); + codes.last := nov + ELSE + C.push(commands, nov); + codes.last := cur + END +END insert; + + +PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER); +VAR + cmd: COMMAND; +BEGIN + cmd := NewCmd(); + cmd.opcode := opcode; + cmd.param1 := 0; + cmd.param2 := param; + insert(codes.last, cmd) +END AddCmd; + + +PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER); +VAR + cmd: COMMAND; +BEGIN + cmd := NewCmd(); + cmd.opcode := opcode; + cmd.param1 := param1; + cmd.param2 := param2; + insert(codes.last, cmd) +END AddCmd2; + + +PROCEDURE Const* (val: INTEGER); +BEGIN + AddCmd(opCONST, val) +END Const; + + +PROCEDURE StrAdr* (adr: INTEGER); +BEGIN + AddCmd(opSADR, adr) +END StrAdr; + + +PROCEDURE Param1*; +BEGIN + AddCmd(opPARAM, 1) +END Param1; + + +PROCEDURE NewLabel* (): INTEGER; +BEGIN + INC(codes.lcount) + RETURN codes.lcount - 1 +END NewLabel; + + +PROCEDURE SetLabel* (label: INTEGER); +BEGIN + AddCmd2(opLABEL, label, 0) +END SetLabel; + + +PROCEDURE SetErrLabel* (errno: INTEGER); +BEGIN + codes.errlabels[errno] := NewLabel(); + SetLabel(codes.errlabels[errno]) +END SetErrLabel; + + +PROCEDURE AddCmd0* (opcode: INTEGER); +BEGIN + AddCmd(opcode, 0) +END AddCmd0; + + +PROCEDURE deleteVarList (list: LISTS.LIST); +VAR + last: LISTS.ITEM; + +BEGIN + WHILE list.last # NIL DO + last := LISTS.pop(list); + C.push(variables, last) + END +END deleteVarList; + + +PROCEDURE delete (cmd: COMMAND); +BEGIN + IF cmd.variables # NIL THEN + deleteVarList(cmd.variables) + END; + LISTS.delete(codes.commands, cmd); + C.push(commands, cmd) +END delete; + + +PROCEDURE delete2* (first, last: LISTS.ITEM); +VAR + cur, next: LISTS.ITEM; + +BEGIN + cur := first; + + IF first # last THEN + REPEAT + next := cur.next; + LISTS.delete(codes.commands, cur); + C.push(commands, cur); + cur := next + UNTIL cur = last + END; + + LISTS.delete(codes.commands, cur); + C.push(commands, cur) +END delete2; + + +PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER); +VAR + prev: COMMAND; + not: BOOLEAN; + +BEGIN + prev := codes.last; + not := prev.opcode = opNOT; + IF not THEN + IF opcode = opJE THEN + opcode := opJNE + ELSIF opcode = opJNE THEN + opcode := opJE + ELSE + not := FALSE + END + END; + + AddCmd2(opcode, label, label); + + IF not THEN + delete(prev) + END + +END AddJmpCmd; + + +PROCEDURE OnError* (line, error: INTEGER); +BEGIN + AddCmd2(opONERR, codes.errlabels[error], line) +END OnError; + + +PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); +VAR + label: INTEGER; +BEGIN + AddCmd(op, t); + label := NewLabel(); + AddJmpCmd(opJE, label); + OnError(line, error); + SetLabel(label) +END TypeGuard; + + +PROCEDURE TypeCheck* (t: INTEGER); +BEGIN + AddCmd(opIS, t) +END TypeCheck; + + +PROCEDURE TypeCheckRec* (t: INTEGER); +BEGIN + AddCmd(opISREC, t) +END TypeCheckRec; + + +PROCEDURE New* (size, typenum: INTEGER); +BEGIN + AddCmd2(opNEW, typenum, size) +END New; + + +PROCEDURE fcmp* (opcode: INTEGER); +BEGIN + AddCmd(opcode, 0); + DEC(codes.fregs, 2); + ASSERT(codes.fregs >= 0) +END fcmp; + + +PROCEDURE not*; +VAR + prev: COMMAND; +BEGIN + prev := codes.last; + IF prev.opcode = opNOT THEN + codes.last := prev.prev(COMMAND); + delete(prev) + ELSE + AddCmd0(opNOT) + END +END not; + + +PROCEDURE Enter* (label, params: INTEGER): COMMAND; +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opENTER; + cmd.param1 := label; + cmd.param3 := params; + cmd.allocReg := TRUE; + insert(codes.last, cmd) + + RETURN codes.last +END Enter; + + +PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND; +BEGIN + IF result THEN + IF float THEN + AddCmd2(opLEAVEF, locsize, paramsize) + ELSE + AddCmd2(opLEAVER, locsize, paramsize) + END + ELSE + AddCmd2(opLEAVE, locsize, paramsize) + END + + RETURN codes.last +END Leave; + + +PROCEDURE EnterC* (label: INTEGER): COMMAND; +BEGIN + SetLabel(label) + RETURN codes.last +END EnterC; + + +PROCEDURE LeaveC* (): COMMAND; +BEGIN + AddCmd0(opLEAVEC) + RETURN codes.last +END LeaveC; + + +PROCEDURE Call* (proc, callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddJmpCmd(opCALL, proc) + |call_win64: AddJmpCmd(opWIN64CALL, proc) + |call_sysv: AddJmpCmd(opSYSVCALL, proc) + END; + codes.last(COMMAND).param2 := fparams +END Call; + + +PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label) + |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label) + |call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label) + END; + codes.last(COMMAND).param2 := fparams +END CallImp; + + +PROCEDURE CallP* (callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddCmd0(opCALLP) + |call_win64: AddCmd(opWIN64CALLP, fparams) + |call_sysv: AddCmd(opSYSVCALLP, fparams) + END +END CallP; + + +PROCEDURE AssignProc* (proc: INTEGER); +BEGIN + AddJmpCmd(opSAVEP, proc) +END AssignProc; + + +PROCEDURE AssignImpProc* (proc: LISTS.ITEM); +BEGIN + AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label) +END AssignImpProc; + + +PROCEDURE PushProc* (proc: INTEGER); +BEGIN + AddJmpCmd(opPUSHP, proc) +END PushProc; + + +PROCEDURE PushImpProc* (proc: LISTS.ITEM); +BEGIN + AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label) +END PushImpProc; + + +PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); +BEGIN + IF eq THEN + AddJmpCmd(opEQP, proc) + ELSE + AddJmpCmd(opNEP, proc) + END +END ProcCmp; + + +PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); +BEGIN + IF eq THEN + AddJmpCmd(opEQIP, proc(IMPORT_PROC).label) + ELSE + AddJmpCmd(opNEIP, proc(IMPORT_PROC).label) + END +END ProcImpCmp; + + +PROCEDURE load* (size: INTEGER); +VAR + last: COMMAND; + +BEGIN + last := codes.last; + CASE size OF + |1: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD8 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD8 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD8 + ELSE + AddCmd0(opLOAD8) + END + + |2: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD16 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD16 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD16 + ELSE + AddCmd0(opLOAD16) + END + + |4: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD32 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD32 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD32 + ELSE + AddCmd0(opLOAD32) + END + + |8: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD64 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD64 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD64 + ELSE + AddCmd0(opLOAD64) + END + END +END load; + + +PROCEDURE SysPut* (size: INTEGER); +BEGIN + CASE size OF + |1: AddCmd0(opSAVE8) + |2: AddCmd0(opSAVE16) + |4: AddCmd0(opSAVE32) + |8: AddCmd0(opSAVE64) + END +END SysPut; + + +PROCEDURE savef* (inv: BOOLEAN); +BEGIN + IF inv THEN + AddCmd0(opSAVEFI) + ELSE + AddCmd0(opSAVEF) + END; + DEC(codes.fregs); + ASSERT(codes.fregs >= 0) +END savef; + + +PROCEDURE pushf*; +BEGIN + AddCmd0(opPUSHF); + DEC(codes.fregs); + ASSERT(codes.fregs >= 0) +END pushf; + + +PROCEDURE loadf* (): BOOLEAN; +BEGIN + AddCmd0(opLOADF); + INC(codes.fregs) + RETURN codes.fregs < numRegsFloat +END loadf; + + +PROCEDURE inf* (): BOOLEAN; +BEGIN + AddCmd0(opINF); + INC(codes.fregs) + RETURN codes.fregs < numRegsFloat +END inf; + + +PROCEDURE fbinop* (opcode: INTEGER); +BEGIN + AddCmd0(opcode); + DEC(codes.fregs); + ASSERT(codes.fregs > 0) +END fbinop; + + +PROCEDURE saves* (offset, length: INTEGER); +BEGIN + AddCmd2(opSAVES, length, offset) +END saves; + + +PROCEDURE abs* (real: BOOLEAN); +BEGIN + IF real THEN + AddCmd0(opFABS) + ELSE + AddCmd0(opABS) + END +END abs; + + +PROCEDURE floor*; +BEGIN + AddCmd0(opFLOOR); + DEC(codes.fregs); + ASSERT(codes.fregs >= 0) +END floor; + + +PROCEDURE flt* (): BOOLEAN; +BEGIN + AddCmd0(opFLT); + INC(codes.fregs) + RETURN codes.fregs < numRegsFloat +END flt; + + +PROCEDURE shift_minmax* (op: CHAR); +BEGIN + CASE op OF + |"A": AddCmd0(opASR) + |"L": AddCmd0(opLSL) + |"O": AddCmd0(opROR) + |"R": AddCmd0(opLSR) + |"m": AddCmd0(opMIN) + |"x": AddCmd0(opMAX) + END +END shift_minmax; + + +PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER); +BEGIN + CASE op OF + |"A": AddCmd(opASR1, x) + |"L": AddCmd(opLSL1, x) + |"O": AddCmd(opROR1, x) + |"R": AddCmd(opLSR1, x) + |"m": AddCmd(opMINC, x) + |"x": AddCmd(opMAXC, x) + END +END shift_minmax1; + + +PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER); +BEGIN + CASE op OF + |"A": AddCmd(opASR2, x) + |"L": AddCmd(opLSL2, x) + |"O": AddCmd(opROR2, x) + |"R": AddCmd(opLSR2, x) + |"m": AddCmd(opMINC, x) + |"x": AddCmd(opMAXC, x) + END +END shift_minmax2; + + +PROCEDURE len* (dim: INTEGER); +BEGIN + AddCmd(opLEN, dim) +END len; + + +PROCEDURE Float* (r: REAL); +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opCONSTF; + cmd.float := r; + insert(codes.last, cmd); + INC(codes.fregs); + ASSERT(codes.fregs <= numRegsFloat) +END Float; + + +PROCEDURE precall* (flt: BOOLEAN): INTEGER; +VAR + res: INTEGER; +BEGIN + res := codes.fregs; + AddCmd2(opPRECALL, ORD(flt), res); + codes.fregs := 0 + RETURN res +END precall; + + +PROCEDURE resf* (fregs: INTEGER): BOOLEAN; +BEGIN + AddCmd(opRESF, fregs); + codes.fregs := fregs + 1 + RETURN codes.fregs < numRegsFloat +END resf; + + +PROCEDURE res* (fregs: INTEGER); +BEGIN + AddCmd(opRES, fregs); + codes.fregs := fregs +END res; + + +PROCEDURE retf*; +BEGIN + DEC(codes.fregs); + ASSERT(codes.fregs = 0) +END retf; + + +PROCEDURE drop*; +BEGIN + AddCmd0(opDROP) +END drop; + + +PROCEDURE case* (a, b, L, R: INTEGER); +VAR + cmd: COMMAND; + +BEGIN + IF a = b THEN + cmd := NewCmd(); + cmd.opcode := opCASELR; + cmd.param1 := a; + cmd.param2 := L; + cmd.param3 := R; + insert(codes.last, cmd) + ELSE + AddCmd2(opCASEL, a, L); + AddCmd2(opCASER, b, R) + END +END case; + + +PROCEDURE caset* (a, label: INTEGER); +BEGIN + AddCmd2(opCASET, label, a) +END caset; + + +PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); +VAR + exp: EXPORT_PROC; + +BEGIN + NEW(exp); + exp.label := label; + exp.name := name; + LISTS.push(codes.export, exp) +END AddExp; + + +PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC; +VAR + lib: IMPORT_LIB; + p: IMPORT_PROC; + +BEGIN + lib := codes.import.first(IMPORT_LIB); + WHILE (lib # NIL) & (lib.name # dll) DO + lib := lib.next(IMPORT_LIB) + END; + + IF lib = NIL THEN + NEW(lib); + lib.name := dll; + lib.procs := LISTS.create(NIL); + LISTS.push(codes.import, lib) + END; + + p := lib.procs.first(IMPORT_PROC); + WHILE (p # NIL) & (p.name # proc) DO + p := p.next(IMPORT_PROC) + END; + + IF p = NIL THEN + NEW(p); + p.name := proc; + p.label := NewLabel(); + p.lib := lib; + p.count := 1; + LISTS.push(lib.procs, p) + ELSE + INC(p.count) + END + + RETURN p +END AddImp; + + +PROCEDURE DelImport* (imp: LISTS.ITEM); +VAR + lib: IMPORT_LIB; + +BEGIN + DEC(imp(IMPORT_PROC).count); + IF imp(IMPORT_PROC).count = 0 THEN + lib := imp(IMPORT_PROC).lib; + LISTS.delete(lib.procs, imp); + IF lib.procs.first = NIL THEN + LISTS.delete(codes.import, lib) + END + END +END DelImport; + + +PROCEDURE init* (pCPU: INTEGER); +VAR + cmd: COMMAND; + i: INTEGER; + +BEGIN + commands := C.create(); + variables := C.create(); + + CPU := pCPU; + endianness := little_endian; + CASE CPU OF + |TARGETS.cpuAMD64: numRegsFloat := 6 + |TARGETS.cpuX86: numRegsFloat := 8 + |TARGETS.cpuMSP430: numRegsFloat := 0 + |TARGETS.cpuTHUMB: numRegsFloat := 256 + END; + + NEW(codes.begcall); + codes.begcall.top := -1; + NEW(codes.endcall); + codes.endcall.top := -1; + codes.commands := LISTS.create(NIL); + codes.export := LISTS.create(NIL); + codes.import := LISTS.create(NIL); + codes.types := CHL.CreateIntList(); + codes.data := CHL.CreateByteList(); + + NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); + codes.last := cmd; + NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); + + AddRec(0); + + codes.lcount := 0; + + codes.fregs := 0; + + FOR i := 0 TO LEN(codes.charoffs) - 1 DO + codes.charoffs[i] := -1 + END; + + FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO + codes.wcharoffs[i] := -1 + END + +END init; + + +END IL. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/KOS.ob07 b/programs/develop/oberon07/Source/KOS.ob07 index 0e5e551ec3..7f6b0aed75 100644 --- a/programs/develop/oberon07/Source/KOS.ob07 +++ b/programs/develop/oberon07/Source/KOS.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -116,6 +116,7 @@ VAR icount, dcount, ccount: INTEGER; + code: CHL.BYTELIST; BEGIN base := 0; @@ -141,43 +142,43 @@ BEGIN header.param := header.sp; header.path := header.param + PARAM_SIZE; - + code := program.code; reloc := program.rel_list.first(BIN.RELOC); WHILE reloc # NIL DO - L := BIN.get32le(program.code, reloc.offset); + L := BIN.get32le(code, reloc.offset); delta := 3 - reloc.offset - text; CASE reloc.opcode OF |BIN.RIMP: iproc := BIN.GetIProc(program, L); - BIN.put32le(program.code, reloc.offset, idata + iproc.label) + BIN.put32le(code, reloc.offset, idata + iproc.label) |BIN.RBSS: - BIN.put32le(program.code, reloc.offset, L + bss) + BIN.put32le(code, reloc.offset, L + bss) |BIN.RDATA: - BIN.put32le(program.code, reloc.offset, L + data) + BIN.put32le(code, reloc.offset, L + data) |BIN.RCODE: - BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text) + BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text) |BIN.PICDATA: - BIN.put32le(program.code, reloc.offset, L + data + delta) + BIN.put32le(code, reloc.offset, L + data + delta) |BIN.PICCODE: - BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta) + BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |BIN.PICBSS: - BIN.put32le(program.code, reloc.offset, L + bss + delta) + BIN.put32le(code, reloc.offset, L + bss + delta) |BIN.PICIMP: iproc := BIN.GetIProc(program, L); - BIN.put32le(program.code, reloc.offset, idata + iproc.label + delta) + BIN.put32le(code, reloc.offset, idata + iproc.label + delta) |BIN.IMPTAB: - BIN.put32le(program.code, reloc.offset, idata + delta) + BIN.put32le(code, reloc.offset, idata + delta) END; @@ -198,7 +199,7 @@ BEGIN WR.Write32LE(File, header.param); WR.Write32LE(File, header.path); - CHL.WriteToFile(File, program.code); + CHL.WriteToFile(File, code); WR.Padding(File, FileAlignment); CHL.WriteToFile(File, program.data); @@ -215,4 +216,4 @@ BEGIN END write; -END KOS. +END KOS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/LISTS.ob07 b/programs/develop/oberon07/Source/LISTS.ob07 index 34cfdebce6..d9a8bcc2a9 100644 --- a/programs/develop/oberon07/Source/LISTS.ob07 +++ b/programs/develop/oberon07/Source/LISTS.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -199,4 +199,4 @@ BEGIN END create; -END LISTS. +END LISTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/MSCOFF.ob07 b/programs/develop/oberon07/Source/MSCOFF.ob07 index 0907a22b12..cc37bea1e4 100644 --- a/programs/develop/oberon07/Source/MSCOFF.ob07 +++ b/programs/develop/oberon07/Source/MSCOFF.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -45,19 +45,11 @@ BEGIN WHILE reloc # NIL DO CASE reloc.opcode OF - - |BIN.RIMP, BIN.IMPTAB: - WriteReloc(File, reloc.offset, 4, 6) - - |BIN.RBSS: - WriteReloc(File, reloc.offset, 5, 6) - - |BIN.RDATA: - WriteReloc(File, reloc.offset, 2, 6) - - |BIN.RCODE: - WriteReloc(File, reloc.offset, 1, 6) - + |BIN.RIMP, + BIN.IMPTAB: WriteReloc(File, reloc.offset, 4, 6) + |BIN.RBSS: WriteReloc(File, reloc.offset, 5, 6) + |BIN.RDATA: WriteReloc(File, reloc.offset, 2, 6) + |BIN.RCODE: WriteReloc(File, reloc.offset, 1, 6) END; reloc := reloc.next(BIN.RELOC) @@ -70,23 +62,25 @@ VAR reloc: BIN.RELOC; iproc: BIN.IMPRT; res, L: INTEGER; + code: CHL.BYTELIST; BEGIN res := 0; + code := program.code; reloc := program.rel_list.first(BIN.RELOC); WHILE reloc # NIL DO INC(res); IF reloc.opcode = BIN.RIMP THEN - L := BIN.get32le(program.code, reloc.offset); + L := BIN.get32le(code, reloc.offset); iproc := BIN.GetIProc(program, L); - BIN.put32le(program.code, reloc.offset, iproc.label) + BIN.put32le(code, reloc.offset, iproc.label) END; IF reloc.opcode = BIN.RCODE THEN - L := BIN.get32le(program.code, reloc.offset); - BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L)) + L := BIN.get32le(code, reloc.offset); + BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L)) END; reloc := reloc.next(BIN.RELOC) @@ -159,7 +153,7 @@ BEGIN FileHeader.Machine := 014CX; FileHeader.NumberOfSections := 5X; FileHeader.TimeDateStamp := UTILS.UnixTime(); - //FileHeader.PointerToSymbolTable := 0; + (* FileHeader.PointerToSymbolTable := 0; *) FileHeader.NumberOfSymbols := 6; FileHeader.SizeOfOptionalHeader := 0X; FileHeader.Characteristics := 0184X; @@ -169,7 +163,7 @@ BEGIN flat.VirtualAddress := 0; flat.SizeOfRawData := ccount; flat.PointerToRawData := ORD(FileHeader.NumberOfSections) * PE32.SIZE_OF_IMAGE_SECTION_HEADER + PE32.SIZE_OF_IMAGE_FILE_HEADER; - //flat.PointerToRelocations := 0; + (* flat.PointerToRelocations := 0; *) flat.PointerToLinenumbers := 0; SetNumberOfRelocations(flat, RelocCount(program)); flat.NumberOfLinenumbers := 0X; @@ -191,7 +185,7 @@ BEGIN edata.VirtualAddress := 0; edata.SizeOfRawData := ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD + LENGTH(szversion) + 1 + ecount; edata.PointerToRawData := data.PointerToRawData + data.SizeOfRawData; - //edata.PointerToRelocations := 0; + (* edata.PointerToRelocations := 0; *) edata.PointerToLinenumbers := 0; SetNumberOfRelocations(edata, ExpCount * 2 + 1); edata.NumberOfLinenumbers := 0X; @@ -202,7 +196,7 @@ BEGIN idata.VirtualAddress := 0; idata.SizeOfRawData := isize; idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData; - //idata.PointerToRelocations := 0; + (* idata.PointerToRelocations := 0; *) idata.PointerToLinenumbers := 0; SetNumberOfRelocations(idata, ICount(ImportTable, ILen)); idata.NumberOfLinenumbers := 0X; @@ -313,4 +307,4 @@ BEGIN END write; -END MSCOFF. +END MSCOFF. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/MSP430.ob07 b/programs/develop/oberon07/Source/MSP430.ob07 index b0ce4a0526..9b6ba48099 100644 --- a/programs/develop/oberon07/Source/MSP430.ob07 +++ b/programs/develop/oberon07/Source/MSP430.ob07 @@ -1,1793 +1,1759 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019, Anton Krotov - All rights reserved. -*) - -MODULE MSP430; - -IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, FILES, WRITER, - UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; - - -CONST - - minRAM* = 128; maxRAM* = 10240; - minROM* = 2048; maxROM* = 49152; - - minStackSize = 64; - - IntVectorSize* = RTL.IntVectorSize; - - PC = 0; SP = 1; SR = 2; CG = 3; - - R4 = 4; R5 = 5; R6 = 6; R7 = 7; - - IR = 13; HP = 14; BP = 15; - - ACC = R4; - - opRRC = 1000H; opSWPB = 1080H; opRRA = 1100H; opSXT = 1180H; - opPUSH = 1200H; opCALL = 1280H; opRETI = 1300H; - - opMOV = 04000H; opADD = 05000H; opADDC = 06000H; opSUBC = 07000H; - opSUB = 08000H; opCMP = 09000H; opDADD = 0A000H; opBIT = 0B000H; - opBIC = 0C000H; opBIS = 0D000H; opXOR = 0E000H; opAND = 0F000H; - - opJNE = 2000H; opJEQ = 2400H; opJNC = 2800H; opJC = 2C00H; - opJN = 3000H; opJGE = 3400H; opJL = 3800H; opJMP = 3C00H; - - sREG = 0; sIDX = 16; sINDIR = 32; sINCR = 48; BW = 64; dIDX = 128; - - NOWORD = 10000H; - - RCODE = 0; RDATA = 1; RBSS = 2; - - je = 0; jne = je + 1; - jge = 2; jl = jge + 1; - jle = 4; jg = jle + 1; - jb = 6; - - -TYPE - - ANYCODE = POINTER TO RECORD (LISTS.ITEM) - - offset: INTEGER - - END; - - WORD = POINTER TO RECORD (ANYCODE) - - val: INTEGER - - END; - - LABEL = POINTER TO RECORD (ANYCODE) - - num: INTEGER - - END; - - JMP = POINTER TO RECORD (ANYCODE) - - cc, label: INTEGER; - short: BOOLEAN - - END; - - CALL = POINTER TO RECORD (ANYCODE) - - label: INTEGER - - END; - - COMMAND = IL.COMMAND; - - RELOC = POINTER TO RECORD (LISTS.ITEM) - - section: INTEGER; - WordPtr: WORD - - END; - - -VAR - - R: REG.REGS; - - CodeList: LISTS.LIST; - RelList: LISTS.LIST; - - mem: ARRAY 65536 OF BYTE; - - Labels: CHL.INTLIST; - - IV: ARRAY RTL.LenIV OF INTEGER; - - IdxWords: RECORD src, dst: INTEGER END; - - -PROCEDURE EmitLabel (L: INTEGER); -VAR - label: LABEL; - -BEGIN - NEW(label); - label.num := L; - LISTS.push(CodeList, label) -END EmitLabel; - - -PROCEDURE EmitWord (val: INTEGER); -VAR - word: WORD; - -BEGIN - IF val < 0 THEN - ASSERT(val >= -32768); - val := val MOD 65536 - ELSE - ASSERT(val <= 65535) - END; - NEW(word); - word.val := val; - LISTS.push(CodeList, word) -END EmitWord; - - -PROCEDURE EmitJmp (cc, label: INTEGER); -VAR - jmp: JMP; - -BEGIN - NEW(jmp); - jmp.cc := cc; - jmp.label := label; - jmp.short := FALSE; - LISTS.push(CodeList, jmp) -END EmitJmp; - - -PROCEDURE EmitCall (label: INTEGER); -VAR - call: CALL; - -BEGIN - NEW(call); - call.label := label; - LISTS.push(CodeList, call) -END EmitCall; - - -PROCEDURE bw (b: BOOLEAN): INTEGER; - RETURN BW * ORD(b) -END bw; - - -PROCEDURE src_x (x, Rn: INTEGER): INTEGER; -BEGIN - IdxWords.src := x - RETURN Rn * 256 + sIDX -END src_x; - - -PROCEDURE dst_x (x, Rn: INTEGER): INTEGER; -BEGIN - IdxWords.dst := x - RETURN Rn + dIDX -END dst_x; - - -PROCEDURE indir (Rn: INTEGER): INTEGER; - RETURN Rn * 256 + sINDIR -END indir; - - -PROCEDURE incr (Rn: INTEGER): INTEGER; - RETURN Rn * 256 + sINCR -END incr; - - -PROCEDURE imm (x: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - CASE x OF - | 0: res := CG * 256 - | 1: res := src_x(0, CG); IdxWords.src := NOWORD - | 2: res := indir(CG) - | 4: res := indir(SR) - | 8: res := incr(SR) - |-1: res := incr(CG) - ELSE - res := incr(PC); - IdxWords.src := x - END - - RETURN res -END imm; - - -PROCEDURE Op2 (op, src, dst: INTEGER); -BEGIN - ASSERT(BITS(op) + {6, 12..15} = {6, 12..15}); - ASSERT(BITS(src) + {4, 5, 8..11} = {4, 5, 8..11}); - ASSERT(BITS(dst) + {0..3, 7} = {0..3, 7}); - - EmitWord(op + src + dst); - - IF IdxWords.src # NOWORD THEN - EmitWord(IdxWords.src); - IdxWords.src := NOWORD - END; - - IF IdxWords.dst # NOWORD THEN - EmitWord(IdxWords.dst); - IdxWords.dst := NOWORD - END -END Op2; - - -PROCEDURE Op1 (op, reg, As: INTEGER); -BEGIN - EmitWord(op + reg + As) -END Op1; - - -PROCEDURE MovRR (src, dst: INTEGER); -BEGIN - Op2(opMOV, src * 256, dst) -END MovRR; - - -PROCEDURE PushImm (imm: INTEGER); -BEGIN - imm := UTILS.Long(imm); - CASE imm OF - | 0: Op1(opPUSH, CG, sREG) - | 1: Op1(opPUSH, CG, sIDX) - | 2: Op1(opPUSH, CG, sINDIR) - |-1: Op1(opPUSH, CG, sINCR) - ELSE - Op1(opPUSH, PC, sINCR); - EmitWord(imm) - END -END PushImm; - - -PROCEDURE PutWord (word: INTEGER; VAR adr: INTEGER); -BEGIN - ASSERT(~ODD(adr)); - ASSERT((0 <= word) & (word <= 65535)); - mem[adr] := word MOD 256; - mem[adr + 1] := word DIV 256; - INC(adr, 2) -END PutWord; - - -PROCEDURE NewLabel (): INTEGER; -BEGIN - CHL.PushInt(Labels, 0) - RETURN IL.NewLabel() -END NewLabel; - - -PROCEDURE LabelOffs (n: INTEGER): INTEGER; - RETURN CHL.GetInt(Labels, n) -END LabelOffs; - - -PROCEDURE Fixup (CodeAdr, IntVectorSize: INTEGER): INTEGER; -VAR - cmd: ANYCODE; - adr: INTEGER; - offset: INTEGER; - diff: INTEGER; - cc: INTEGER; - shorted: BOOLEAN; - -BEGIN - REPEAT - shorted := FALSE; - offset := CodeAdr DIV 2; - - cmd := CodeList.first(ANYCODE); - WHILE cmd # NIL DO - cmd.offset := offset; - CASE cmd OF - |LABEL: CHL.SetInt(Labels, cmd.num, offset) - |JMP: INC(offset); - IF ~cmd.short THEN - INC(offset); - IF cmd.cc # opJMP THEN - INC(offset) - END - END - - |CALL: INC(offset, 2) - |WORD: INC(offset) - END; - cmd := cmd.next(ANYCODE) - END; - - cmd := CodeList.first(ANYCODE); - WHILE cmd # NIL DO - IF (cmd IS JMP) & ~cmd(JMP).short THEN - diff := LabelOffs(cmd(JMP).label) - cmd.offset - 1; - IF ABS(diff) <= 512 THEN - cmd(JMP).short := TRUE; - shorted := TRUE - END - END; - cmd := cmd.next(ANYCODE) - END - - UNTIL ~shorted; - - IF offset * 2 > 10000H - IntVectorSize THEN - ERRORS.Error(203) - END; - - adr := CodeAdr; - cmd := CodeList.first(ANYCODE); - WHILE cmd # NIL DO - CASE cmd OF - |LABEL: - - |JMP: IF ~cmd.short THEN - CASE cmd.cc OF - |opJNE: cc := opJEQ - |opJEQ: cc := opJNE - |opJNC: cc := opJC - |opJC: cc := opJNC - |opJGE: cc := opJL - |opJL: cc := opJGE - |opJMP: cc := opJMP - END; - - IF cc # opJMP THEN - PutWord(cc + 2, adr) (* jcc L *) - END; - - PutWord(4030H, adr); (* MOV @PC+, PC *) - PutWord(LabelOffs(cmd.label) * 2, adr) - (* L: *) - ELSE - diff := LabelOffs(cmd.label) - cmd.offset - 1; - ASSERT((-512 <= diff) & (diff <= 511)); - PutWord(cmd.cc + diff MOD 1024, adr) - END - - |CALL: PutWord(12B0H, adr); (* CALL @PC+ *) - PutWord(LabelOffs(cmd.label) * 2, adr) - - |WORD: PutWord(cmd.val, adr) - - END; - cmd := cmd.next(ANYCODE) - END - - RETURN adr - CodeAdr -END Fixup; - - -PROCEDURE Push (reg: INTEGER); -BEGIN - Op1(opPUSH, reg, sREG) -END Push; - - -PROCEDURE Pop (reg: INTEGER); -BEGIN - Op2(opMOV, incr(SP), reg) -END Pop; - - -PROCEDURE Test (reg: INTEGER); -BEGIN - Op2(opCMP, imm(0), reg) -END Test; - - -PROCEDURE Clear (reg: INTEGER); -BEGIN - Op2(opMOV, imm(0), reg) -END Clear; - - -PROCEDURE mov (dst, src: INTEGER); -BEGIN - MovRR(src, dst) -END mov; - - -PROCEDURE xchg (reg1, reg2: INTEGER); -BEGIN - Push(reg1); - Push(reg2); - Pop(reg1); - Pop(reg2) -END xchg; - - -PROCEDURE Reloc (section: INTEGER); -VAR - reloc: RELOC; - -BEGIN - NEW(reloc); - reloc.section := section; - reloc.WordPtr := CodeList.last(WORD); - LISTS.push(RelList, reloc) -END Reloc; - - -PROCEDURE CallRTL (proc, params: INTEGER); -BEGIN - EmitCall(RTL.rtl[proc].label); - RTL.Used(proc); - IF params > 0 THEN - Op2(opADD, imm(params * 2), SP) - END -END CallRTL; - - -PROCEDURE UnOp (VAR reg: INTEGER); -BEGIN - REG.UnOp(R, reg) -END UnOp; - - -PROCEDURE BinOp (VAR reg1, reg2: INTEGER); -BEGIN - REG.BinOp(R, reg1, reg2) -END BinOp; - - -PROCEDURE GetRegA; -BEGIN - ASSERT(REG.GetReg(R, ACC)) -END GetRegA; - - -PROCEDURE drop; -BEGIN - REG.Drop(R) -END drop; - - -PROCEDURE GetAnyReg (): INTEGER; - RETURN REG.GetAnyReg(R) -END GetAnyReg; - - -PROCEDURE PushAll (NumberOfParameters: INTEGER); -BEGIN - REG.PushAll(R); - DEC(R.pushed, NumberOfParameters) -END PushAll; - - -PROCEDURE PushAll_1; -BEGIN - REG.PushAll_1(R) -END PushAll_1; - - -PROCEDURE cond (op: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - CASE op OF - |IL.opGT, IL.opGTC: res := jg - |IL.opGE, IL.opGEC: res := jge - |IL.opLT, IL.opLTC: res := jl - |IL.opLE, IL.opLEC: res := jle - |IL.opEQ, IL.opEQC: res := je - |IL.opNE, IL.opNEC: res := jne - END - - RETURN res -END cond; - - -PROCEDURE jcc (cc, label: INTEGER); -VAR - L: INTEGER; - -BEGIN - CASE cc OF - |jne: - EmitJmp(opJNE, label) - |je: - EmitJmp(opJEQ, label) - |jge: - EmitJmp(opJGE, label) - |jl: - EmitJmp(opJL, label) - |jle: - EmitJmp(opJL, label); - EmitJmp(opJEQ, label) - |jg: - L := NewLabel(); - EmitJmp(opJEQ, L); - EmitJmp(opJGE, label); - EmitLabel(L) - |jb: - EmitJmp(opJNC, label) - END -END jcc; - - -PROCEDURE setcc (cc, reg: INTEGER); -VAR - L: INTEGER; - -BEGIN - L := NewLabel(); - Op2(opMOV, imm(1), reg); - jcc(cc, L); - Clear(reg); - EmitLabel(L) -END setcc; - - -PROCEDURE Shift2 (op, reg, n: INTEGER); -VAR - reg2: INTEGER; - -BEGIN - IF n >= 8 THEN - CASE op OF - |IL.opASR2: Op1(opSWPB, reg, sREG); Op1(opSXT, reg, sREG) - |IL.opROR2: Op1(opSWPB, reg, sREG) - |IL.opLSL2: Op1(opSWPB, reg, sREG); Op2(opBIC, imm(255), reg) - |IL.opLSR2: Op2(opBIC, imm(255), reg); Op1(opSWPB, reg, sREG) - END; - DEC(n, 8) - END; - - IF (op = IL.opROR2) & (n > 0) THEN - reg2 := GetAnyReg(); - MovRR(reg, reg2) - ELSE - reg2 := -1 - END; - - WHILE n > 0 DO - CASE op OF - |IL.opASR2: Op1(opRRA, reg, sREG) - |IL.opROR2: Op1(opRRC, reg2, sREG); Op1(opRRC, reg, sREG) - |IL.opLSL2: Op2(opADD, reg * 256, reg) - |IL.opLSR2: Op2(opBIC, imm(1), SR); Op1(opRRC, reg, sREG) - END; - DEC(n) - END; - - IF reg2 # -1 THEN - drop - END - -END Shift2; - - -PROCEDURE Neg (reg: INTEGER); -BEGIN - Op2(opXOR, imm(-1), reg); - Op2(opADD, imm(1), reg) -END Neg; - - -PROCEDURE translate; -VAR - cmd, next: COMMAND; - - opcode, param1, param2, label, L, a, n, c1, c2: INTEGER; - - reg1, reg2: INTEGER; - - cc: INTEGER; - -BEGIN - cmd := IL.codes.commands.first(COMMAND); - - WHILE cmd # NIL DO - - param1 := cmd.param1; - param2 := cmd.param2; - - opcode := cmd.opcode; - - CASE opcode OF - |IL.opJMP: - EmitJmp(opJMP, param1) - - |IL.opCALL: - EmitCall(param1) - - |IL.opCALLP: - UnOp(reg1); - Op1(opCALL, reg1, sREG); - drop; - ASSERT(R.top = -1) - - |IL.opPRECALL: - PushAll(0) - - |IL.opLABEL: - EmitLabel(param1) - - |IL.opSADR_PARAM: - Op1(opPUSH, PC, sINCR); - EmitWord(param2); - Reloc(RDATA) - - |IL.opERR: - CallRTL(RTL._error, 2) - - |IL.opPUSHC: - PushImm(param2) - - |IL.opLEAVEC: - Pop(PC) - - |IL.opENTER: - ASSERT(R.top = -1); - - EmitLabel(param1); - - Push(BP); - MovRR(SP, BP); - - IF param2 > 8 THEN - Op2(opMOV, imm(param2), R4); - L := NewLabel(); - EmitLabel(L); - Push(CG); - Op2(opSUB, imm(1), R4); - jcc(jne, L) - ELSIF param2 > 0 THEN - WHILE param2 > 0 DO - Push(CG); - DEC(param2) - END - END - - |IL.opLEAVE, IL.opLEAVER: - ASSERT(param2 = 0); - IF opcode = IL.opLEAVER THEN - UnOp(reg1); - IF reg1 # ACC THEN - GetRegA; - ASSERT(REG.Exchange(R, reg1, ACC)); - drop - END; - drop - END; - - ASSERT(R.top = -1); - - IF param1 > 0 THEN - MovRR(BP, SP) - END; - - Pop(BP); - Pop(PC) - - |IL.opRES: - ASSERT(R.top = -1); - GetRegA - - |IL.opCLEANUP: - IF param2 # 0 THEN - Op2(opADD, imm(param2 * 2), SP) - END - - |IL.opCONST: - next := cmd.next(COMMAND); - IF next.opcode = IL.opCONST THEN - c1 := param2; - c2 := next.param2; - next := next.next(COMMAND); - IF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN - Op2(opMOV + bw(next.opcode = IL.opSAVE8), imm(c1), dst_x(c2, SR)); - cmd := next - ELSE - Op2(opMOV, imm(param2), GetAnyReg()) - END - ELSIF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN - UnOp(reg1); - Op2(opMOV + bw(next.opcode = IL.opSAVE8), reg1 * 256, dst_x(param2, SR)); - drop; - cmd := next - ELSE - Op2(opMOV, imm(param2), GetAnyReg()) - END - - |IL.opSADR: - Op2(opMOV, incr(PC), GetAnyReg()); - EmitWord(param2); - Reloc(RDATA) - - |IL.opGADR: - Op2(opMOV, incr(PC), GetAnyReg()); - EmitWord(param2); - Reloc(RBSS) - - |IL.opLADR: - reg1 := GetAnyReg(); - MovRR(BP, reg1); - Op2(opADD, imm(param2 * 2), reg1) - - |IL.opLLOAD8: - Op2(opMOV + BW, src_x(param2 * 2, BP), GetAnyReg()) - - |IL.opLLOAD16, IL.opVADR: - Op2(opMOV, src_x(param2 * 2, BP), GetAnyReg()) - - |IL.opGLOAD8: - Op2(opMOV + BW, src_x(param2, SR), GetAnyReg()); - Reloc(RBSS) - - |IL.opGLOAD16: - Op2(opMOV, src_x(param2, SR), GetAnyReg()); - Reloc(RBSS) - - |IL.opLOAD8: - UnOp(reg1); - Op2(opMOV + BW, indir(reg1), reg1) - - |IL.opLOAD16: - UnOp(reg1); - Op2(opMOV, indir(reg1), reg1) - - |IL.opVLOAD8: - reg1 := GetAnyReg(); - Op2(opMOV, src_x(param2 * 2, BP), reg1); - Op2(opMOV + BW, indir(reg1), reg1) - - |IL.opVLOAD16: - reg1 := GetAnyReg(); - Op2(opMOV, src_x(param2 * 2, BP), reg1); - Op2(opMOV, indir(reg1), reg1) - - |IL.opSAVE, IL.opSAVE16: - BinOp(reg2, reg1); - Op2(opMOV, reg2 * 256, dst_x(0, reg1)); - drop; - drop - - |IL.opSAVE8: - BinOp(reg2, reg1); - Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); - drop; - drop - - |IL.opSAVE8C: - UnOp(reg1); - Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); - drop - - |IL.opSAVE16C, IL.opSAVEC: - UnOp(reg1); - Op2(opMOV, imm(param2), dst_x(0, reg1)); - drop - - |IL.opUMINUS: - UnOp(reg1); - Neg(reg1) - - |IL.opADD: - BinOp(reg1, reg2); - Op2(opADD, reg2 * 256, reg1); - drop - - |IL.opADDL, IL.opADDR: - IF param2 # 0 THEN - UnOp(reg1); - Op2(opADD, imm(param2), reg1) - END - - |IL.opSUB: - BinOp(reg1, reg2); - Op2(opSUB, reg2 * 256, reg1); - drop - - |IL.opSUBR, IL.opSUBL: - UnOp(reg1); - IF param2 # 0 THEN - Op2(opSUB, imm(param2), reg1) - END; - IF opcode = IL.opSUBL THEN - reg2 := GetAnyReg(); - Clear(reg2); - Op2(opSUB, reg1 * 256, reg2); - drop; - drop; - ASSERT(REG.GetReg(R, reg2)) - END - - |IL.opLADR_SAVEC: - Op2(opMOV, imm(param2), dst_x(param1 * 2, BP)) - - |IL.opLADR_SAVE: - UnOp(reg1); - Op2(opMOV, reg1 * 256, dst_x(param2 * 2, BP)); - drop - - |IL.opGADR_SAVEC: - Op2(opMOV, imm(param2), dst_x(param1, SR)); - Reloc(RBSS) - - |IL.opCONST_PARAM: - PushImm(param2) - - |IL.opPARAM: - IF param2 = 1 THEN - UnOp(reg1); - Push(reg1); - drop - ELSE - ASSERT(R.top + 1 <= param2); - PushAll(param2) - END - - |IL.opEQ..IL.opGE, - IL.opEQC..IL.opGEC: - - IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN - BinOp(reg1, reg2); - Op2(opCMP, reg2 * 256, reg1); - drop - ELSE - UnOp(reg1); - Op2(opCMP, imm(param2), reg1) - END; - - drop; - cc := cond(opcode); - - IF cmd.next(COMMAND).opcode = IL.opJE THEN - label := cmd.next(COMMAND).param1; - jcc(cc, label); - cmd := cmd.next(COMMAND) - - ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN - label := cmd.next(COMMAND).param1; - jcc(ORD(BITS(cc) / {0}), label); - cmd := cmd.next(COMMAND) - - ELSE - setcc(cc, GetAnyReg()) - END - - |IL.opNOP: - - |IL.opCODE: - EmitWord(param2) - - |IL.opACC: - IF (R.top # 0) OR (R.stk[0] # ACC) THEN - PushAll(0); - GetRegA; - Pop(ACC); - DEC(R.pushed) - END - - |IL.opDROP: - UnOp(reg1); - drop - - |IL.opJNZ: - UnOp(reg1); - Test(reg1); - jcc(jne, param1) - - |IL.opJZ: - UnOp(reg1); - Test(reg1); - jcc(je, param1) - - |IL.opJG: - UnOp(reg1); - Test(reg1); - jcc(jg, param1) - - |IL.opJE: - UnOp(reg1); - Test(reg1); - jcc(jne, param1); - drop - - |IL.opJNE: - UnOp(reg1); - Test(reg1); - jcc(je, param1); - drop - - |IL.opNOT: - UnOp(reg1); - Test(reg1); - setcc(je, reg1) - - |IL.opORD: - UnOp(reg1); - Test(reg1); - setcc(jne, reg1) - - |IL.opLOOP: - |IL.opENDLOOP: - - |IL.opGET: - BinOp(reg1, reg2); - drop; - drop; - Op2(opMOV + bw(param2 = 1), indir(reg1), dst_x(0, reg2)) - - |IL.opGETC: - UnOp(reg2); - drop; - Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2)) - - |IL.opCHKIDX: - UnOp(reg1); - Op2(opCMP, imm(param2), reg1); - jcc(jb, param1) - - |IL.opCHKIDX2: - BinOp(reg1, reg2); - IF param2 # -1 THEN - Op2(opCMP, reg1 * 256, reg2); - MovRR(reg2, reg1); - drop; - jcc(jb, param1) - ELSE - INCL(R.regs, reg1); - DEC(R.top); - R.stk[R.top] := reg2 - END - - |IL.opINCC, IL.opINCCB: - UnOp(reg1); - Op2(opADD + bw(opcode = IL.opINCCB), imm(param2), dst_x(0, reg1)); - drop - - |IL.opDECCB: - UnOp(reg1); - Op2(opSUB + BW, imm(param2), dst_x(0, reg1)); - drop - - |IL.opINC, IL.opINCB: - BinOp(reg1, reg2); - Op2(opADD + bw(opcode = IL.opINCB), reg1 * 256, dst_x(0, reg2)); - drop; - drop - - |IL.opDEC, IL.opDECB: - BinOp(reg1, reg2); - Op2(opSUB + bw(opcode = IL.opDECB), reg1 * 256, dst_x(0, reg2)); - drop; - drop - - |IL.opLADR_INCC, IL.opLADR_INCCB: - Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), dst_x(param1 * 2, BP)) - - |IL.opLADR_DECCB: - Op2(opSUB + BW, imm(param2), dst_x(param1 * 2, BP)) - - |IL.opLADR_INC, IL.opLADR_INCB: - UnOp(reg1); - Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, dst_x(param2 * 2, BP)); - drop - - |IL.opLADR_DEC, IL.opLADR_DECB: - UnOp(reg1); - Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, dst_x(param2 * 2, BP)); - drop - - |IL.opPUSHT: - UnOp(reg1); - Op2(opMOV, src_x(-2, reg1), GetAnyReg()) - - |IL.opISREC: - PushAll(2); - PushImm(param2); - CallRTL(RTL._guardrec, 3); - GetRegA - - |IL.opIS: - PushAll(1); - PushImm(param2); - CallRTL(RTL._is, 2); - GetRegA - - |IL.opTYPEGR: - PushAll(1); - PushImm(param2); - CallRTL(RTL._guardrec, 2); - GetRegA - - |IL.opTYPEGP: - UnOp(reg1); - PushAll(0); - Push(reg1); - PushImm(param2); - CallRTL(RTL._guard, 2); - GetRegA - - |IL.opTYPEGD: - UnOp(reg1); - PushAll(0); - Op1(opPUSH, reg1, sIDX); - EmitWord(-2); - PushImm(param2); - CallRTL(RTL._guardrec, 2); - GetRegA - - |IL.opMULS: - BinOp(reg1, reg2); - Op2(opAND, reg2 * 256, reg1); - drop - - |IL.opMULSC: - UnOp(reg1); - Op2(opAND, imm(param2), reg1) - - |IL.opDIVS: - BinOp(reg1, reg2); - Op2(opXOR, reg2 * 256, reg1); - drop - - |IL.opDIVSC: - UnOp(reg1); - Op2(opXOR, imm(param2), reg1) - - |IL.opADDS: - BinOp(reg1, reg2); - Op2(opBIS, reg2 * 256, reg1); - drop - - |IL.opSUBS: - BinOp(reg1, reg2); - Op2(opBIC, reg2 * 256, reg1); - drop - - |IL.opADDSL, IL.opADDSR: - UnOp(reg1); - Op2(opBIS, imm(param2), reg1) - - |IL.opSUBSL: - UnOp(reg1); - Op2(opXOR, imm(-1), reg1); - Op2(opAND, imm(param2), reg1) - - |IL.opSUBSR: - UnOp(reg1); - Op2(opBIC, imm(param2), reg1) - - |IL.opUMINS: - UnOp(reg1); - Op2(opXOR, imm(-1), reg1) - - |IL.opLENGTH: - PushAll(2); - CallRTL(RTL._length, 2); - GetRegA - - |IL.opMIN: - BinOp(reg1, reg2); - Op2(opCMP, reg2 * 256, reg1); - EmitWord(opJL + 1); (* jl L *) - MovRR(reg2, reg1); - (* L: *) - drop - - - |IL.opMAX: - BinOp(reg1, reg2); - Op2(opCMP, reg2 * 256, reg1); - EmitWord(opJGE + 1); (* jge L *) - MovRR(reg2, reg1); - (* L: *) - drop - - |IL.opMINC: - UnOp(reg1); - Op2(opCMP, imm(param2), reg1); - L := NewLabel(); - jcc(jl, L); - Op2(opMOV, imm(param2), reg1); - EmitLabel(L) - - |IL.opMAXC: - UnOp(reg1); - Op2(opCMP, imm(param2), reg1); - L := NewLabel(); - jcc(jge, L); - Op2(opMOV, imm(param2), reg1); - EmitLabel(L) - - |IL.opSWITCH: - UnOp(reg1); - IF param2 = 0 THEN - reg2 := ACC - ELSE - reg2 := R5 - END; - IF reg1 # reg2 THEN - ASSERT(REG.GetReg(R, reg2)); - ASSERT(REG.Exchange(R, reg1, reg2)); - drop - END; - drop - - |IL.opENDSW: - - |IL.opCASEL: - Op2(opCMP, imm(param1), ACC); - jcc(jl, param2) - - |IL.opCASER: - Op2(opCMP, imm(param1), ACC); - jcc(jg, param2) - - |IL.opCASELR: - Op2(opCMP, imm(param1), ACC); - jcc(jl, param2); - jcc(jg, cmd.param3) - - |IL.opSBOOL: - BinOp(reg2, reg1); - Test(reg2); - setcc(jne, reg2); - Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); - drop; - drop - - |IL.opSBOOLC: - UnOp(reg1); - Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); - drop - - |IL.opODD: - UnOp(reg1); - Op2(opAND, imm(1), reg1) - - |IL.opEQS .. IL.opGES: - PushAll(4); - PushImm((opcode - IL.opEQS) * 12); - CallRTL(RTL._strcmp, 5); - GetRegA - - |IL.opLEN: - UnOp(reg1); - drop; - EXCL(R.regs, reg1); - - WHILE param2 > 0 DO - UnOp(reg2); - drop; - DEC(param2) - END; - - INCL(R.regs, reg1); - ASSERT(REG.GetReg(R, reg1)) - - |IL.opCHKBYTE: - BinOp(reg1, reg2); - Op2(opCMP, imm(256), reg1); - jcc(jb, param1) - - |IL.opLSL, IL.opASR, IL.opROR, IL.opLSR: - PushAll(2); - CASE opcode OF - |IL.opLSL: CallRTL(RTL._lsl, 2) - |IL.opASR: CallRTL(RTL._asr, 2) - |IL.opROR: CallRTL(RTL._ror, 2) - |IL.opLSR: CallRTL(RTL._lsr, 2) - END; - GetRegA - - |IL.opLSL1, IL.opASR1, IL.opROR1, IL.opLSR1: - UnOp(reg1); - PushAll_1; - PushImm(param2); - Push(reg1); - drop; - CASE opcode OF - |IL.opLSL1: CallRTL(RTL._lsl, 2) - |IL.opASR1: CallRTL(RTL._asr, 2) - |IL.opROR1: CallRTL(RTL._ror, 2) - |IL.opLSR1: CallRTL(RTL._lsr, 2) - END; - GetRegA - - |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: - param2 := param2 MOD 16; - IF param2 # 0 THEN - UnOp(reg1); - Shift2(opcode, reg1, param2) - END - - |IL.opMUL: - PushAll(2); - CallRTL(RTL._mul, 2); - GetRegA - - |IL.opMULC: - UnOp(reg1); - - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) - ELSE - n := -1 - END; - - IF a = 1 THEN - - ELSIF a = -1 THEN - Neg(reg1) - ELSIF a = 0 THEN - Clear(reg1) - ELSE - IF n > 0 THEN - IF a < 0 THEN - Neg(reg1) - END; - Shift2(IL.opLSL2, reg1, n) - ELSE - PushAll(1); - PushImm(a); - CallRTL(RTL._mul, 2); - GetRegA - END - END - - |IL.opDIV: - PushAll(2); - CallRTL(RTL._divmod, 2); - GetRegA - - |IL.opDIVR: - ASSERT(param2 > 0); - - IF param2 > 1 THEN - n := UTILS.Log2(param2); - IF n > 0 THEN - UnOp(reg1); - Shift2(IL.opASR2, reg1, n) - ELSE - PushAll(1); - PushImm(param2); - CallRTL(RTL._divmod, 2); - GetRegA - END - END - - |IL.opDIVL: - UnOp(reg1); - PushAll_1; - PushImm(param2); - Push(reg1); - drop; - CallRTL(RTL._divmod, 2); - GetRegA - - |IL.opMOD: - PushAll(2); - CallRTL(RTL._divmod, 2); - ASSERT(REG.GetReg(R, R5)) - - |IL.opMODR: - ASSERT(param2 > 0); - - IF param2 = 1 THEN - UnOp(reg1); - Clear(reg1) - ELSE - IF UTILS.Log2(param2) > 0 THEN - UnOp(reg1); - Op2(opAND, imm(param2 - 1), reg1) - ELSE - PushAll(1); - PushImm(param2); - CallRTL(RTL._divmod, 2); - ASSERT(REG.GetReg(R, R5)) - END - END - - |IL.opMODL: - UnOp(reg1); - PushAll_1; - PushImm(param2); - Push(reg1); - drop; - CallRTL(RTL._divmod, 2); - ASSERT(REG.GetReg(R, R5)) - - |IL.opCOPYS: - ASSERT(R.top = 3); - Push(R.stk[2]); - Push(R.stk[0]); - Op2(opCMP, R.stk[1] * 256, R.stk[3]); - EmitWord(3801H); (* JL L1 *) - MovRR(R.stk[1], R.stk[3]); - (* L1: *) - Push(R.stk[3]); - drop; - drop; - drop; - drop; - CallRTL(RTL._move, 3) - - |IL.opCOPY: - PushAll(2); - PushImm(param2); - CallRTL(RTL._move, 3) - - |IL.opMOVE: - PushAll(3); - CallRTL(RTL._move, 3) - - |IL.opCOPYA: - PushAll(4); - PushImm(param2); - CallRTL(RTL._arrcpy, 5); - GetRegA - - |IL.opROT: - PushAll(0); - MovRR(SP, ACC); - Push(ACC); - PushImm(param2); - CallRTL(RTL._rot, 2) - - |IL.opSAVES: - UnOp(reg1); - PushAll_1; - Op1(opPUSH, PC, sINCR); - EmitWord(param2); - Reloc(RDATA); - Push(reg1); - drop; - PushImm(param1); - CallRTL(RTL._move, 3) - - |IL.opCASET: - Push(R5); - Push(R5); - PushImm(param2); - CallRTL(RTL._guardrec, 2); - Pop(R5); - Test(ACC); - jcc(jne, param1) - - |IL.opCHR: - UnOp(reg1); - Op2(opAND, imm(255), reg1) - - |IL.opABS: - UnOp(reg1); - Test(reg1); - L := NewLabel(); - jcc(jge, L); - Neg(reg1); - EmitLabel(L) - - |IL.opEQB, IL.opNEB: - BinOp(reg1, reg2); - drop; - - Test(reg1); - L := NewLabel(); - jcc(je, L); - Op2(opMOV, imm(1), reg1); - EmitLabel(L); - - Test(reg2); - L := NewLabel(); - jcc(je, L); - Op2(opMOV, imm(1), reg2); - EmitLabel(L); - - Op2(opCMP, reg2 * 256, reg1); - IF opcode = IL.opEQB THEN - setcc(je, reg1) - ELSE - setcc(jne, reg1) - END - - |IL.opSAVEP: - UnOp(reg1); - Op2(opMOV, incr(PC), reg1 + dIDX); - EmitWord(param2); - Reloc(RCODE); - EmitWord(0); - drop - - |IL.opPUSHP: - Op2(opMOV, incr(PC), GetAnyReg()); - EmitWord(param2); - Reloc(RCODE) - - |IL.opEQP, IL.opNEP: - UnOp(reg1); - Op2(opCMP, incr(PC), reg1); - EmitWord(param1); - Reloc(RCODE); - drop; - reg1 := GetAnyReg(); - - IF opcode = IL.opEQP THEN - setcc(je, reg1) - ELSIF opcode = IL.opNEP THEN - setcc(jne, reg1) - END - - |IL.opVADR_PARAM: - Op1(opPUSH, BP, sIDX); - EmitWord(param2 * 2) - - |IL.opNEW: - PushAll(1); - n := param2 + 2; - ASSERT(UTILS.Align(n, 2)); - PushImm(n); - PushImm(param1); - CallRTL(RTL._new, 3) - - |IL.opRSET: - PushAll(2); - CallRTL(RTL._set, 2); - GetRegA - - |IL.opRSETR: - PushAll(1); - PushImm(param2); - CallRTL(RTL._set, 2); - GetRegA - - |IL.opRSETL: - UnOp(reg1); - PushAll_1; - PushImm(param2); - Push(reg1); - drop; - CallRTL(RTL._set, 2); - GetRegA - - |IL.opRSET1: - PushAll(1); - CallRTL(RTL._set1, 1); - GetRegA - - |IL.opINCLC: - UnOp(reg1); - Op2(opBIS, imm(ORD({param2})), dst_x(0, reg1)); - drop - - |IL.opEXCLC: - UnOp(reg1); - Op2(opBIC, imm(ORD({param2})), dst_x(0, reg1)); - drop - - |IL.opIN: - PushAll(2); - CallRTL(RTL._in, 2); - GetRegA - - |IL.opINR: - PushAll(1); - PushImm(param2); - CallRTL(RTL._in, 2); - GetRegA - - |IL.opINL: - PushAll(1); - PushImm(param2); - CallRTL(RTL._in2, 2); - GetRegA - - |IL.opINCL: - PushAll(2); - CallRTL(RTL._incl, 2) - - |IL.opEXCL: - PushAll(2); - CallRTL(RTL._excl, 2) - - |IL.opLADR_INCL, IL.opLADR_EXCL: - PushAll(1); - MovRR(BP, ACC); - Op2(opADD, imm(param2 * 2), ACC); - Push(ACC); - IF opcode = IL.opLADR_INCL THEN - CallRTL(RTL._incl, 2) - ELSIF opcode = IL.opLADR_EXCL THEN - CallRTL(RTL._excl, 2) - END - - |IL.opLADR_INCLC: - Op2(opBIS, imm(ORD({param2})), dst_x(param1 * 2, BP)) - - |IL.opLADR_EXCLC: - Op2(opBIC, imm(ORD({param2})), dst_x(param1 * 2, BP)) - - END; - - cmd := cmd.next(COMMAND) - END; - - ASSERT(R.pushed = 0); - ASSERT(R.top = -1) -END translate; - - -PROCEDURE prolog (ramSize: INTEGER); -VAR - i: INTEGER; - -BEGIN - RTL.Init(EmitLabel, EmitWord, EmitCall, ramSize); - FOR i := 0 TO LEN(RTL.rtl) - 1 DO - RTL.Set(i, NewLabel()) - END; - - IV[LEN(IV) - 1] := NewLabel(); - EmitLabel(IV[LEN(IV) - 1]); - Op2(opMOV, incr(PC), SP); - EmitWord(0); - Op2(opMOV, incr(PC), HP); - EmitWord(0); - Op2(opMOV, imm(5A80H), dst_x(0120H, SR)); (* stop WDT *) - Op2(opMOV, imm(RTL.empty_proc), dst_x(RTL.int, SR)); - Op2(opMOV, imm(0), dst_x(RTL.trap, SR)) -END prolog; - - -PROCEDURE epilog; -VAR - L1, i: INTEGER; - -BEGIN - Op2(opBIS, imm(10H), SR); (* CPUOFF *) - - L1 := NewLabel(); - FOR i := 0 TO LEN(IV) - 2 DO - IV[i] := NewLabel(); - EmitLabel(IV[i]); - PushImm(i); - IF i # LEN(IV) - 2 THEN - EmitJmp(opJMP, L1) - END - END; - - EmitLabel(L1); - - MovRR(SP, IR); - - FOR i := 0 TO 15 DO - IF i IN R.regs + R.vregs THEN - Push(i) - END - END; - - Push(IR); - Op1(opPUSH, IR, sINDIR); - Op1(opCALL, SR, sIDX); - EmitWord(RTL.int); - Op2(opADD, imm(4), SP); - - FOR i := 15 TO 0 BY -1 DO - IF i IN R.regs + R.vregs THEN - Pop(i) - END - END; - - Op2(opADD, imm(2), SP); - Op1(opRETI, 0, 0); - - RTL.Gen -END epilog; - - -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 WriteHexByte (file: FILES.FILE; byte: BYTE); -BEGIN - WRITER.WriteByte(file, hexdgt(byte DIV 16)); - WRITER.WriteByte(file, hexdgt(byte MOD 16)); -END WriteHexByte; - - -PROCEDURE WriteHex (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); -VAR - i, len, chksum: INTEGER; - -BEGIN - WHILE cnt > 0 DO - len := MIN(cnt, 16); - chksum := len + idx DIV 256 + idx MOD 256; - WRITER.WriteByte(file, ORD(":")); - WriteHexByte(file, len); - WriteHexByte(file, idx DIV 256); - WriteHexByte(file, idx MOD 256); - WriteHexByte(file, 0); - FOR i := 1 TO len DO - WriteHexByte(file, mem[idx]); - INC(chksum, mem[idx]); - INC(idx) - END; - WriteHexByte(file, (-chksum) MOD 256); - DEC(cnt, len); - WRITER.WriteByte(file, 0DH); - WRITER.WriteByte(file, 0AH) - END -END WriteHex; - - -PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); -VAR - i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; - - Code, Data, Bss, Free: RECORD address, size: INTEGER END; - - ram, rom: INTEGER; - - reloc: RELOC; - - file: FILES.FILE; - -BEGIN - IdxWords.src := NOWORD; - IdxWords.dst := NOWORD; - - ram := options.ram; - rom := options.rom; - - IF ODD(ram) THEN DEC(ram) END; - IF ODD(rom) THEN DEC(rom) END; - - ram := MIN(MAX(ram, minRAM), maxRAM); - rom := MIN(MAX(rom, minROM), maxROM); - - IF IL.codes.bss > ram - minStackSize - RTL.VarSize THEN - ERRORS.Error(204) - END; - - Labels := CHL.CreateIntList(); - FOR i := 1 TO IL.codes.lcount DO - CHL.PushInt(Labels, 0) - END; - - FOR i := 0 TO LEN(mem) - 1 DO - mem[i] := 0 - END; - - TypesSize := CHL.Length(IL.codes.types) * 2; - CodeList := LISTS.create(NIL); - RelList := LISTS.create(NIL); - REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {}); - - prolog(ram); - translate; - epilog; - - Code.address := 10000H - rom; - Code.size := Fixup(Code.address, IntVectorSize + TypesSize); - Data.address := Code.address + Code.size; - Data.size := CHL.Length(IL.codes.data); - Data.size := Data.size + ORD(ODD(Data.size)); - TextSize := Code.size + Data.size; - - IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN - ERRORS.Error(203) - END; - - Bss.address := RTL.ram + RTL.VarSize; - Bss.size := IL.codes.bss + ORD(ODD(IL.codes.bss)); - heap := Bss.address + Bss.size; - stack := RTL.ram + ram; - ASSERT(stack - heap >= minStackSize); - adr := Code.address + 2; - PutWord(stack, adr); - adr := Code.address + 6; - PutWord(heap, adr); - - reloc := RelList.first(RELOC); - WHILE reloc # NIL DO - adr := reloc.WordPtr.offset * 2; - CASE reloc.section OF - |RCODE: PutWord(LabelOffs(reloc.WordPtr.val) * 2, adr) - |RDATA: PutWord(reloc.WordPtr.val + Data.address, adr) - |RBSS: PutWord(reloc.WordPtr.val + Bss.address, adr) - END; - reloc := reloc.next(RELOC) - END; - - adr := Data.address; - - FOR i := 0 TO CHL.Length(IL.codes.data) - 1 DO - mem[adr] := CHL.GetByte(IL.codes.data, i); - INC(adr) - END; - - adr := 10000H - IntVectorSize - TypesSize; - - FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO - PutWord(CHL.GetInt(IL.codes.types, i), adr) - END; - - FOR i := 0 TO 15 DO - PutWord((33 - i) * i, adr); - END; - - FOR n := 0 TO 15 DO - bits := ORD({0 .. n}); - FOR i := 0 TO 15 - n DO - PutWord(bits, adr); - bits := LSL(bits, 1) - END - END; - - Free.address := Code.address + TextSize; - Free.size := rom - (IntVectorSize + TypesSize + TextSize); - - PutWord(Free.address, adr); - PutWord(Free.size, adr); - PutWord(4130H, adr); (* RET *) - PutWord(stack, adr); - - FOR i := 0 TO LEN(IV) - 1 DO - PutWord(LabelOffs(IV[i]) * 2, adr) - END; - - file := FILES.create(outname); - WriteHex(file, mem, Code.address, TextSize); - WriteHex(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); - - WRITER.WriteByte(file, ORD(":")); - WriteHexByte(file, 0); - WriteHexByte(file, 0); - WriteHexByte(file, 0); - WriteHexByte(file, 1); - WriteHexByte(file, 255); - WRITER.WriteByte(file, 0DH); - WRITER.WriteByte(file, 0AH); - - FILES.close(file); - - INC(TextSize, IntVectorSize + TypesSize); - INC(Bss.size, minStackSize + RTL.VarSize); - - C.StringLn("--------------------------------------------"); - C.String( " rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)"); - IF Free.size > 0 THEN - C.String( " "); C.Int(Free.size); C.String(" bytes free (0"); - C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)") - END; - C.Ln; - C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)"); - C.StringLn("--------------------------------------------") - -END CodeGen; - - -END MSP430. +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE MSP430; + +IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, WR := WRITER, HEX, + UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; + + +CONST + + minRAM* = 128; maxRAM* = 2048; + minROM* = 2048; maxROM* = 24576; + + minStackSize = 64; + + IntVectorSize* = RTL.IntVectorSize; + + PC = 0; SP = 1; SR = 2; CG = 3; + + R4 = 4; R5 = 5; R6 = 6; R7 = 7; + + HP = 14; IR = 15; + + ACC = R4; + + opRRC = 1000H; opSWPB = 1080H; opRRA = 1100H; opSXT = 1180H; + opPUSH = 1200H; opCALL = 1280H; opRETI = 1300H; + + opMOV = 04000H; opADD = 05000H; opADDC = 06000H; opSUBC = 07000H; + opSUB = 08000H; opCMP = 09000H; opDADD = 0A000H; opBIT = 0B000H; + opBIC = 0C000H; opBIS = 0D000H; opXOR = 0E000H; opAND = 0F000H; + + opJNE = 2000H; opJEQ = 2400H; opJNC = 2800H; opJC = 2C00H; + opJN = 3000H; opJGE = 3400H; opJL = 3800H; opJMP = 3C00H; + + sREG = 0; sIDX = 16; sINDIR = 32; sINCR = 48; BW = 64; dIDX = 128; + + NOWORD = 10000H; + + RCODE = 0; RDATA = 1; RBSS = 2; + + je = 0; jne = je + 1; + jge = 2; jl = jge + 1; + jle = 4; jg = jle + 1; + jb = 6; + + +TYPE + + ANYCODE = POINTER TO RECORD (LISTS.ITEM) + + offset: INTEGER + + END; + + WORD = POINTER TO RECORD (ANYCODE) + + val: INTEGER + + END; + + LABEL = POINTER TO RECORD (ANYCODE) + + num: INTEGER + + END; + + JMP = POINTER TO RECORD (ANYCODE) + + cc, label: INTEGER; + short: BOOLEAN + + END; + + CALL = POINTER TO RECORD (ANYCODE) + + label: INTEGER + + END; + + COMMAND = IL.COMMAND; + + RELOC = POINTER TO RECORD (LISTS.ITEM) + + section: INTEGER; + WordPtr: WORD + + END; + + +VAR + + R: REG.REGS; + + CodeList: LISTS.LIST; + RelList: LISTS.LIST; + + mem: ARRAY 65536 OF BYTE; + + Labels: CHL.INTLIST; + + IV: ARRAY RTL.LenIV OF INTEGER; + + IdxWords: RECORD src, dst: INTEGER END; + + StkCnt: INTEGER; + + +PROCEDURE EmitLabel (L: INTEGER); +VAR + label: LABEL; + +BEGIN + NEW(label); + label.num := L; + LISTS.push(CodeList, label) +END EmitLabel; + + +PROCEDURE EmitWord (val: INTEGER); +VAR + word: WORD; + +BEGIN + IF val < 0 THEN + ASSERT(val >= -32768); + val := val MOD 65536 + ELSE + ASSERT(val <= 65535) + END; + NEW(word); + word.val := val; + LISTS.push(CodeList, word) +END EmitWord; + + +PROCEDURE EmitJmp (cc, label: INTEGER); +VAR + jmp: JMP; + +BEGIN + NEW(jmp); + jmp.cc := cc; + jmp.label := label; + jmp.short := FALSE; + LISTS.push(CodeList, jmp) +END EmitJmp; + + +PROCEDURE EmitCall (label: INTEGER); +VAR + call: CALL; + +BEGIN + NEW(call); + call.label := label; + LISTS.push(CodeList, call) +END EmitCall; + + +PROCEDURE bw (b: BOOLEAN): INTEGER; + RETURN BW * ORD(b) +END bw; + + +PROCEDURE src_x (x, Rn: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF (x = 0) & ~(Rn IN {PC, SR, CG}) THEN + res := Rn * 256 + sINDIR + ELSE + IdxWords.src := x; + res := Rn * 256 + sIDX + END + + RETURN res +END src_x; + + +PROCEDURE dst_x (x, Rn: INTEGER): INTEGER; +BEGIN + IdxWords.dst := x + RETURN Rn + dIDX +END dst_x; + + +PROCEDURE indir (Rn: INTEGER): INTEGER; + RETURN Rn * 256 + sINDIR +END indir; + + +PROCEDURE incr (Rn: INTEGER): INTEGER; + RETURN Rn * 256 + sINCR +END incr; + + +PROCEDURE imm (x: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE x OF + | 0: res := CG * 256 + | 1: res := CG * 256 + sIDX + | 2: res := indir(CG) + | 4: res := indir(SR) + | 8: res := incr(SR) + |-1: res := incr(CG) + ELSE + res := incr(PC); + IdxWords.src := x + END + + RETURN res +END imm; + + +PROCEDURE Op2 (op, src, dst: INTEGER); +BEGIN + ASSERT(BITS(op) - {6, 12..15} = {}); + ASSERT(BITS(src) - {4, 5, 8..11} = {}); + ASSERT(BITS(dst) - {0..3, 7} = {}); + + EmitWord(op + src + dst); + + IF IdxWords.src # NOWORD THEN + EmitWord(IdxWords.src); + IdxWords.src := NOWORD + END; + + IF IdxWords.dst # NOWORD THEN + EmitWord(IdxWords.dst); + IdxWords.dst := NOWORD + END +END Op2; + + +PROCEDURE Op1 (op, reg, As: INTEGER); +BEGIN + EmitWord(op + reg + As) +END Op1; + + +PROCEDURE MovRR (src, dst: INTEGER); +BEGIN + Op2(opMOV, src * 256, dst) +END MovRR; + + +PROCEDURE PushImm (imm: INTEGER); +BEGIN + imm := UTILS.Long(imm); + CASE imm OF + | 0: Op1(opPUSH, CG, sREG) + | 1: Op1(opPUSH, CG, sIDX) + | 2: Op1(opPUSH, CG, sINDIR) + |-1: Op1(opPUSH, CG, sINCR) + ELSE + Op1(opPUSH, PC, sINCR); + EmitWord(imm) + END; + INC(StkCnt) +END PushImm; + + +PROCEDURE PutWord (word: INTEGER; VAR adr: INTEGER); +BEGIN + ASSERT(~ODD(adr)); + ASSERT((0 <= word) & (word <= 65535)); + mem[adr] := word MOD 256; + mem[adr + 1] := word DIV 256; + INC(adr, 2) +END PutWord; + + +PROCEDURE NewLabel (): INTEGER; +BEGIN + CHL.PushInt(Labels, 0) + RETURN IL.NewLabel() +END NewLabel; + + +PROCEDURE LabelOffs (n: INTEGER): INTEGER; + RETURN CHL.GetInt(Labels, n) +END LabelOffs; + + +PROCEDURE Fixup (CodeAdr, IntVectorSize: INTEGER): INTEGER; +VAR + cmd: ANYCODE; + adr: INTEGER; + offset: INTEGER; + diff: INTEGER; + cc: INTEGER; + shorted: BOOLEAN; + +BEGIN + REPEAT + shorted := FALSE; + offset := CodeAdr DIV 2; + + cmd := CodeList.first(ANYCODE); + WHILE cmd # NIL DO + cmd.offset := offset; + CASE cmd OF + |LABEL: CHL.SetInt(Labels, cmd.num, offset) + |JMP: INC(offset); + IF ~cmd.short THEN + INC(offset); + IF cmd.cc # opJMP THEN + INC(offset) + END + END + + |CALL: INC(offset, 2) + |WORD: INC(offset) + END; + cmd := cmd.next(ANYCODE) + END; + + cmd := CodeList.first(ANYCODE); + WHILE cmd # NIL DO + IF (cmd IS JMP) & ~cmd(JMP).short THEN + diff := LabelOffs(cmd(JMP).label) - cmd.offset - 1; + IF ABS(diff) <= 512 THEN + cmd(JMP).short := TRUE; + shorted := TRUE + END + END; + cmd := cmd.next(ANYCODE) + END + + UNTIL ~shorted; + + IF offset * 2 > 10000H - IntVectorSize THEN + ERRORS.Error(203) + END; + + adr := CodeAdr; + cmd := CodeList.first(ANYCODE); + WHILE cmd # NIL DO + CASE cmd OF + |LABEL: + + |JMP: IF ~cmd.short THEN + CASE cmd.cc OF + |opJNE: cc := opJEQ + |opJEQ: cc := opJNE + |opJNC: cc := opJC + |opJC: cc := opJNC + |opJGE: cc := opJL + |opJL: cc := opJGE + |opJMP: cc := opJMP + END; + + IF cc # opJMP THEN + PutWord(cc + 2, adr) (* jcc L *) + END; + + PutWord(4030H, adr); (* MOV @PC+, PC *) + PutWord(LabelOffs(cmd.label) * 2, adr) + (* L: *) + ELSE + diff := LabelOffs(cmd.label) - cmd.offset - 1; + ASSERT((-512 <= diff) & (diff <= 511)); + PutWord(cmd.cc + diff MOD 1024, adr) + END + + |CALL: PutWord(12B0H, adr); (* CALL @PC+ *) + PutWord(LabelOffs(cmd.label) * 2, adr) + + |WORD: PutWord(cmd.val, adr) + + END; + cmd := cmd.next(ANYCODE) + END + + RETURN adr - CodeAdr +END Fixup; + + +PROCEDURE Push (reg: INTEGER); +BEGIN + Op1(opPUSH, reg, sREG); + INC(StkCnt) +END Push; + + +PROCEDURE Pop (reg: INTEGER); +BEGIN + Op2(opMOV, incr(SP), reg); + DEC(StkCnt) +END Pop; + + +PROCEDURE Test (reg: INTEGER); +BEGIN + Op2(opCMP, imm(0), reg) +END Test; + + +PROCEDURE Clear (reg: INTEGER); +BEGIN + Op2(opMOV, imm(0), reg) +END Clear; + + +PROCEDURE mov (dst, src: INTEGER); +BEGIN + MovRR(src, dst) +END mov; + + +PROCEDURE xchg (reg1, reg2: INTEGER); +BEGIN + Push(reg1); + Push(reg2); + Pop(reg1); + Pop(reg2) +END xchg; + + +PROCEDURE Reloc (section: INTEGER); +VAR + reloc: RELOC; + +BEGIN + NEW(reloc); + reloc.section := section; + reloc.WordPtr := CodeList.last(WORD); + LISTS.push(RelList, reloc) +END Reloc; + + +PROCEDURE CallRTL (proc, params: INTEGER); +BEGIN + EmitCall(RTL.rtl[proc].label); + RTL.Used(proc); + IF params > 0 THEN + Op2(opADD, imm(params * 2), SP); + DEC(StkCnt, params) + END +END CallRTL; + + +PROCEDURE UnOp (VAR reg: INTEGER); +BEGIN + REG.UnOp(R, reg) +END UnOp; + + +PROCEDURE BinOp (VAR reg1, reg2: INTEGER); +BEGIN + REG.BinOp(R, reg1, reg2) +END BinOp; + + +PROCEDURE GetRegA; +BEGIN + ASSERT(REG.GetReg(R, ACC)) +END GetRegA; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + DEC(R.pushed, NumberOfParameters) +END PushAll; + + +PROCEDURE PushAll_1; +BEGIN + REG.PushAll_1(R) +END PushAll_1; + + +PROCEDURE cond (op: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE op OF + |IL.opGT, IL.opGTC: res := jg + |IL.opGE, IL.opGEC: res := jge + |IL.opLT, IL.opLTC: res := jl + |IL.opLE, IL.opLEC: res := jle + |IL.opEQ, IL.opEQC: res := je + |IL.opNE, IL.opNEC: res := jne + END + + RETURN res +END cond; + + +PROCEDURE jcc (cc, label: INTEGER); +VAR + L: INTEGER; + +BEGIN + CASE cc OF + |jne: + EmitJmp(opJNE, label) + |je: + EmitJmp(opJEQ, label) + |jge: + EmitJmp(opJGE, label) + |jl: + EmitJmp(opJL, label) + |jle: + EmitJmp(opJL, label); + EmitJmp(opJEQ, label) + |jg: + L := NewLabel(); + EmitJmp(opJEQ, L); + EmitJmp(opJGE, label); + EmitLabel(L) + |jb: + EmitJmp(opJNC, label) + END +END jcc; + + +PROCEDURE setcc (cc, reg: INTEGER); +VAR + L: INTEGER; + +BEGIN + L := NewLabel(); + Op2(opMOV, imm(1), reg); + jcc(cc, L); + Clear(reg); + EmitLabel(L) +END setcc; + + +PROCEDURE Shift2 (op, reg, n: INTEGER); +VAR + reg2: INTEGER; + +BEGIN + IF n >= 8 THEN + CASE op OF + |IL.opASR2: Op1(opSWPB, reg, sREG); Op1(opSXT, reg, sREG) + |IL.opROR2: Op1(opSWPB, reg, sREG) + |IL.opLSL2: Op1(opSWPB, reg, sREG); Op2(opBIC, imm(255), reg) + |IL.opLSR2: Op2(opBIC, imm(255), reg); Op1(opSWPB, reg, sREG) + END; + DEC(n, 8) + END; + + IF (op = IL.opROR2) & (n > 0) THEN + reg2 := GetAnyReg(); + MovRR(reg, reg2) + ELSE + reg2 := -1 + END; + + WHILE n > 0 DO + CASE op OF + |IL.opASR2: Op1(opRRA, reg, sREG) + |IL.opROR2: Op1(opRRC, reg2, sREG); Op1(opRRC, reg, sREG) + |IL.opLSL2: Op2(opADD, reg * 256, reg) + |IL.opLSR2: Op2(opBIC, imm(1), SR); Op1(opRRC, reg, sREG) + END; + DEC(n) + END; + + IF reg2 # -1 THEN + drop + END + +END Shift2; + + +PROCEDURE Neg (reg: INTEGER); +BEGIN + Op2(opXOR, imm(-1), reg); + Op2(opADD, imm(1), reg) +END Neg; + + +PROCEDURE LocalOffset (offset: INTEGER): INTEGER; + RETURN (offset + StkCnt - ORD(offset > 0)) * 2 +END LocalOffset; + + +PROCEDURE LocalDst (offset: INTEGER): INTEGER; + RETURN dst_x(LocalOffset(offset), SP) +END LocalDst; + + +PROCEDURE LocalSrc (offset: INTEGER): INTEGER; + RETURN src_x(LocalOffset(offset), SP) +END LocalSrc; + + +PROCEDURE translate; +VAR + cmd, next: COMMAND; + + opcode, param1, param2, L, a, n, c1, c2: INTEGER; + + reg1, reg2: INTEGER; + + cc: INTEGER; + +BEGIN + cmd := IL.codes.commands.first(COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + + opcode := cmd.opcode; + + CASE opcode OF + |IL.opJMP: + EmitJmp(opJMP, param1) + + |IL.opCALL: + EmitCall(param1) + + |IL.opCALLP: + UnOp(reg1); + Op1(opCALL, reg1, sREG); + drop; + ASSERT(R.top = -1) + + |IL.opPRECALL: + PushAll(0) + + |IL.opLABEL: + EmitLabel(param1) + + |IL.opSADR_PARAM: + Op1(opPUSH, PC, sINCR); + INC(StkCnt); + EmitWord(param2); + Reloc(RDATA) + + |IL.opERR: + CallRTL(RTL._error, 2) + + |IL.opPUSHC: + PushImm(param2) + + |IL.opONERR: + PushImm(param2); + DEC(StkCnt); + EmitJmp(opJMP, param1) + + |IL.opLEAVEC: + Pop(PC) + + |IL.opENTER: + ASSERT(R.top = -1); + StkCnt := 0; + EmitLabel(param1); + IF param2 > 8 THEN + Op2(opMOV, imm(param2), R4); + L := NewLabel(); + EmitLabel(L); + Push(CG); + Op2(opSUB, imm(1), R4); + jcc(jne, L) + ELSIF param2 > 0 THEN + WHILE param2 > 0 DO + Push(CG); + DEC(param2) + END + END + + |IL.opLEAVE, IL.opLEAVER: + ASSERT(param2 = 0); + IF opcode = IL.opLEAVER THEN + UnOp(reg1); + IF reg1 # ACC THEN + GetRegA; + ASSERT(REG.Exchange(R, reg1, ACC)); + drop + END; + drop + END; + ASSERT(R.top = -1); + ASSERT(StkCnt = param1); + IF param1 > 0 THEN + Op2(opADD, imm(param1 * 2), SP) + END; + Pop(PC) + + |IL.opRES: + ASSERT(R.top = -1); + GetRegA + + |IL.opCLEANUP: + IF param2 # 0 THEN + Op2(opADD, imm(param2 * 2), SP); + DEC(StkCnt, param2) + END + + |IL.opCONST: + next := cmd.next(COMMAND); + IF next.opcode = IL.opCONST THEN + c1 := param2; + c2 := next.param2; + next := next.next(COMMAND); + IF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN + Op2(opMOV + bw(next.opcode = IL.opSAVE8), imm(c1), dst_x(c2, SR)); + cmd := next + ELSE + Op2(opMOV, imm(param2), GetAnyReg()) + END + ELSIF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN + UnOp(reg1); + Op2(opMOV + bw(next.opcode = IL.opSAVE8), reg1 * 256, dst_x(param2, SR)); + drop; + cmd := next + ELSE + Op2(opMOV, imm(param2), GetAnyReg()) + END + + |IL.opSADR: + Op2(opMOV, incr(PC), GetAnyReg()); + EmitWord(param2); + Reloc(RDATA) + + |IL.opGADR: + Op2(opMOV, incr(PC), GetAnyReg()); + EmitWord(param2); + Reloc(RBSS) + + |IL.opLADR: + reg1 := GetAnyReg(); + n := LocalOffset(param2); + Op2(opMOV, SP * 256, reg1); + IF n # 0 THEN + Op2(opADD, imm(n), reg1) + END + + |IL.opLLOAD8: + Op2(opMOV + BW, LocalSrc(param2), GetAnyReg()) + + |IL.opLLOAD16, IL.opVADR: + Op2(opMOV, LocalSrc(param2), GetAnyReg()) + + |IL.opGLOAD8: + Op2(opMOV + BW, src_x(param2, SR), GetAnyReg()); + Reloc(RBSS) + + |IL.opGLOAD16: + Op2(opMOV, src_x(param2, SR), GetAnyReg()); + Reloc(RBSS) + + |IL.opLOAD8: + UnOp(reg1); + Op2(opMOV + BW, indir(reg1), reg1) + + |IL.opLOAD16: + UnOp(reg1); + Op2(opMOV, indir(reg1), reg1) + + |IL.opVLOAD8: + reg1 := GetAnyReg(); + Op2(opMOV, LocalSrc(param2), reg1); + Op2(opMOV + BW, indir(reg1), reg1) + + |IL.opVLOAD16: + reg1 := GetAnyReg(); + Op2(opMOV, LocalSrc(param2), reg1); + Op2(opMOV, indir(reg1), reg1) + + |IL.opSAVE, IL.opSAVE16: + BinOp(reg2, reg1); + Op2(opMOV, reg2 * 256, dst_x(0, reg1)); + drop; + drop + + |IL.opSAVE8: + BinOp(reg2, reg1); + Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); + drop; + drop + + |IL.opSAVE8C: + UnOp(reg1); + Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); + drop + + |IL.opSAVE16C, IL.opSAVEC: + UnOp(reg1); + Op2(opMOV, imm(param2), dst_x(0, reg1)); + drop + + |IL.opUMINUS: + UnOp(reg1); + Neg(reg1) + + |IL.opADD: + BinOp(reg1, reg2); + Op2(opADD, reg2 * 256, reg1); + drop + + |IL.opADDL, IL.opADDR: + IF param2 # 0 THEN + UnOp(reg1); + Op2(opADD, imm(param2), reg1) + END + + |IL.opSUB: + BinOp(reg1, reg2); + Op2(opSUB, reg2 * 256, reg1); + drop + + |IL.opSUBR, IL.opSUBL: + UnOp(reg1); + IF param2 # 0 THEN + Op2(opSUB, imm(param2), reg1) + END; + IF opcode = IL.opSUBL THEN + Neg(reg1) + END + + |IL.opLADR_SAVEC: + Op2(opMOV, imm(param2), LocalDst(param1)) + + |IL.opLADR_SAVE: + UnOp(reg1); + Op2(opMOV, reg1 * 256, LocalDst(param2)); + drop + + |IL.opGADR_SAVEC: + Op2(opMOV, imm(param2), dst_x(param1, SR)); + Reloc(RBSS) + + |IL.opCONST_PARAM: + PushImm(param2) + + |IL.opPARAM: + IF param2 = 1 THEN + UnOp(reg1); + Push(reg1); + drop + ELSE + ASSERT(R.top + 1 <= param2); + PushAll(param2) + END + + |IL.opEQ..IL.opGE, + IL.opEQC..IL.opGEC: + + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(reg1, reg2); + Op2(opCMP, reg2 * 256, reg1); + drop + ELSE + UnOp(reg1); + Op2(opCMP, imm(param2), reg1) + END; + + drop; + cc := cond(opcode); + next := cmd.next(COMMAND); + + IF next.opcode = IL.opJE THEN + jcc(cc, next.param1); + cmd := next + ELSIF next.opcode = IL.opJNE THEN + jcc(ORD(BITS(cc) / {0}), next.param1); + cmd := next + ELSE + setcc(cc, GetAnyReg()) + END + + |IL.opNOP: + + |IL.opCODE: + EmitWord(param2) + + |IL.opACC: + IF (R.top # 0) OR (R.stk[0] # ACC) THEN + PushAll(0); + GetRegA; + Pop(ACC); + DEC(R.pushed) + END + + |IL.opDROP: + UnOp(reg1); + drop + + |IL.opJNZ: + UnOp(reg1); + Test(reg1); + jcc(jne, param1) + + |IL.opJZ: + UnOp(reg1); + Test(reg1); + jcc(je, param1) + + |IL.opJG: + UnOp(reg1); + Test(reg1); + jcc(jg, param1) + + |IL.opJE: + UnOp(reg1); + Test(reg1); + jcc(jne, param1); + drop + + |IL.opJNE: + UnOp(reg1); + Test(reg1); + jcc(je, param1); + drop + + |IL.opNOT: + UnOp(reg1); + Test(reg1); + setcc(je, reg1) + + |IL.opORD: + UnOp(reg1); + Test(reg1); + setcc(jne, reg1) + + |IL.opLOOP: + |IL.opENDLOOP: + + |IL.opGET: + BinOp(reg1, reg2); + drop; + drop; + Op2(opMOV + bw(param2 = 1), indir(reg1), dst_x(0, reg2)) + + |IL.opGETC: + UnOp(reg2); + drop; + Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2)) + + |IL.opCHKIDX: + UnOp(reg1); + Op2(opCMP, imm(param2), reg1); + jcc(jb, param1) + + |IL.opCHKIDX2: + BinOp(reg1, reg2); + IF param2 # -1 THEN + Op2(opCMP, reg1 * 256, reg2); + jcc(jb, param1) + END; + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 + + |IL.opINCC, IL.opINCCB: + UnOp(reg1); + Op2(opADD + bw(opcode = IL.opINCCB), imm(param2), dst_x(0, reg1)); + drop + + |IL.opDECCB: + UnOp(reg1); + Op2(opSUB + BW, imm(param2), dst_x(0, reg1)); + drop + + |IL.opINC, IL.opINCB: + BinOp(reg1, reg2); + Op2(opADD + bw(opcode = IL.opINCB), reg1 * 256, dst_x(0, reg2)); + drop; + drop + + |IL.opDEC, IL.opDECB: + BinOp(reg1, reg2); + Op2(opSUB + bw(opcode = IL.opDECB), reg1 * 256, dst_x(0, reg2)); + drop; + drop + + |IL.opLADR_INCC, IL.opLADR_INCCB: + Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), LocalDst(param1)) + + |IL.opLADR_DECCB: + Op2(opSUB + BW, imm(param2), LocalDst(param1)) + + |IL.opLADR_INC, IL.opLADR_INCB: + UnOp(reg1); + Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, LocalDst(param2)); + drop + + |IL.opLADR_DEC, IL.opLADR_DECB: + UnOp(reg1); + Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, LocalDst(param2)); + drop + + |IL.opPUSHT: + UnOp(reg1); + Op2(opMOV, src_x(-2, reg1), GetAnyReg()) + + |IL.opISREC: + PushAll(2); + PushImm(param2); + CallRTL(RTL._guardrec, 3); + GetRegA + + |IL.opIS: + PushAll(1); + PushImm(param2); + CallRTL(RTL._is, 2); + GetRegA + + |IL.opTYPEGR: + PushAll(1); + PushImm(param2); + CallRTL(RTL._guardrec, 2); + GetRegA + + |IL.opTYPEGP: + UnOp(reg1); + PushAll(0); + Push(reg1); + PushImm(param2); + CallRTL(RTL._guard, 2); + GetRegA + + |IL.opTYPEGD: + UnOp(reg1); + PushAll(0); + Op1(opPUSH, reg1, sIDX); + INC(StkCnt); + EmitWord(-2); + PushImm(param2); + CallRTL(RTL._guardrec, 2); + GetRegA + + |IL.opMULS: + BinOp(reg1, reg2); + Op2(opAND, reg2 * 256, reg1); + drop + + |IL.opMULSC: + UnOp(reg1); + Op2(opAND, imm(param2), reg1) + + |IL.opDIVS: + BinOp(reg1, reg2); + Op2(opXOR, reg2 * 256, reg1); + drop + + |IL.opDIVSC: + UnOp(reg1); + Op2(opXOR, imm(param2), reg1) + + |IL.opADDS: + BinOp(reg1, reg2); + Op2(opBIS, reg2 * 256, reg1); + drop + + |IL.opSUBS: + BinOp(reg1, reg2); + Op2(opBIC, reg2 * 256, reg1); + drop + + |IL.opADDSL, IL.opADDSR: + UnOp(reg1); + Op2(opBIS, imm(param2), reg1) + + |IL.opSUBSL: + UnOp(reg1); + Op2(opXOR, imm(-1), reg1); + Op2(opAND, imm(param2), reg1) + + |IL.opSUBSR: + UnOp(reg1); + Op2(opBIC, imm(param2), reg1) + + |IL.opUMINS: + UnOp(reg1); + Op2(opXOR, imm(-1), reg1) + + |IL.opLENGTH: + PushAll(2); + CallRTL(RTL._length, 2); + GetRegA + + |IL.opMAX,IL.opMIN: + BinOp(reg1, reg2); + Op2(opCMP, reg2 * 256, reg1); + IF opcode = IL.opMIN THEN + cc := opJL + 1 + ELSE + cc := opJGE + 1 + END; + EmitWord(cc); (* jge/jl L *) + MovRR(reg2, reg1); + (* L: *) + drop + + |IL.opMAXC, IL.opMINC: + UnOp(reg1); + Op2(opCMP, imm(param2), reg1); + L := NewLabel(); + IF opcode = IL.opMINC THEN + cc := jl + ELSE + cc := jge + END; + jcc(cc, L); + Op2(opMOV, imm(param2), reg1); + EmitLabel(L) + + |IL.opSWITCH: + UnOp(reg1); + IF param2 = 0 THEN + reg2 := ACC + ELSE + reg2 := R5 + END; + IF reg1 # reg2 THEN + ASSERT(REG.GetReg(R, reg2)); + ASSERT(REG.Exchange(R, reg1, reg2)); + drop + END; + drop + + |IL.opENDSW: + + |IL.opCASEL: + Op2(opCMP, imm(param1), ACC); + jcc(jl, param2) + + |IL.opCASER: + Op2(opCMP, imm(param1), ACC); + jcc(jg, param2) + + |IL.opCASELR: + Op2(opCMP, imm(param1), ACC); + jcc(jl, param2); + jcc(jg, cmd.param3) + + |IL.opSBOOL: + BinOp(reg2, reg1); + Test(reg2); + setcc(jne, reg2); + Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); + drop; + drop + + |IL.opSBOOLC: + UnOp(reg1); + Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); + drop + + |IL.opEQS .. IL.opGES: + PushAll(4); + PushImm((opcode - IL.opEQS) * 12); + CallRTL(RTL._strcmp, 5); + GetRegA + + |IL.opLEN: + UnOp(reg1); + drop; + EXCL(R.regs, reg1); + + WHILE param2 > 0 DO + UnOp(reg2); + drop; + DEC(param2) + END; + + INCL(R.regs, reg1); + ASSERT(REG.GetReg(R, reg1)) + + |IL.opCHKBYTE: + BinOp(reg1, reg2); + Op2(opCMP, imm(256), reg1); + jcc(jb, param1) + + |IL.opLSL, IL.opASR, IL.opROR, IL.opLSR: + PushAll(2); + CASE opcode OF + |IL.opLSL: CallRTL(RTL._lsl, 2) + |IL.opASR: CallRTL(RTL._asr, 2) + |IL.opROR: CallRTL(RTL._ror, 2) + |IL.opLSR: CallRTL(RTL._lsr, 2) + END; + GetRegA + + |IL.opLSL1, IL.opASR1, IL.opROR1, IL.opLSR1: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CASE opcode OF + |IL.opLSL1: CallRTL(RTL._lsl, 2) + |IL.opASR1: CallRTL(RTL._asr, 2) + |IL.opROR1: CallRTL(RTL._ror, 2) + |IL.opLSR1: CallRTL(RTL._lsr, 2) + END; + GetRegA + + |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: + param2 := param2 MOD 16; + IF param2 # 0 THEN + UnOp(reg1); + Shift2(opcode, reg1, param2) + END + + |IL.opMUL: + PushAll(2); + CallRTL(RTL._mul, 2); + GetRegA + + |IL.opMULC: + UnOp(reg1); + + a := param2; + IF a > 1 THEN + n := UTILS.Log2(a) + ELSIF a < -1 THEN + n := UTILS.Log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + Neg(reg1) + ELSIF a = 0 THEN + Clear(reg1) + ELSE + IF n > 0 THEN + IF a < 0 THEN + Neg(reg1) + END; + Shift2(IL.opLSL2, reg1, n) + ELSE + PushAll(1); + PushImm(a); + CallRTL(RTL._mul, 2); + GetRegA + END + END + + |IL.opDIV: + PushAll(2); + CallRTL(RTL._divmod, 2); + GetRegA + + |IL.opDIVR: + ASSERT(param2 > 0); + + IF param2 > 1 THEN + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(reg1); + Shift2(IL.opASR2, reg1, n) + ELSE + PushAll(1); + PushImm(param2); + CallRTL(RTL._divmod, 2); + GetRegA + END + END + + |IL.opDIVL: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CallRTL(RTL._divmod, 2); + GetRegA + + |IL.opMOD: + PushAll(2); + CallRTL(RTL._divmod, 2); + ASSERT(REG.GetReg(R, R5)) + + |IL.opMODR: + ASSERT(param2 > 0); + + IF param2 = 1 THEN + UnOp(reg1); + Clear(reg1) + ELSE + IF UTILS.Log2(param2) > 0 THEN + UnOp(reg1); + Op2(opAND, imm(param2 - 1), reg1) + ELSE + PushAll(1); + PushImm(param2); + CallRTL(RTL._divmod, 2); + ASSERT(REG.GetReg(R, R5)) + END + END + + |IL.opMODL: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CallRTL(RTL._divmod, 2); + ASSERT(REG.GetReg(R, R5)) + + |IL.opCOPYS: + ASSERT(R.top = 3); + Push(R.stk[2]); + Push(R.stk[0]); + Op2(opCMP, R.stk[1] * 256, R.stk[3]); + EmitWord(3801H); (* JL L1 *) + MovRR(R.stk[1], R.stk[3]); + (* L1: *) + Push(R.stk[3]); + drop; + drop; + drop; + drop; + CallRTL(RTL._move, 3) + + |IL.opCOPY: + PushAll(2); + PushImm(param2); + CallRTL(RTL._move, 3) + + |IL.opMOVE: + PushAll(3); + CallRTL(RTL._move, 3) + + |IL.opCOPYA: + PushAll(4); + PushImm(param2); + CallRTL(RTL._arrcpy, 5); + GetRegA + + |IL.opROT: + PushAll(0); + MovRR(SP, ACC); + Push(ACC); + PushImm(param2); + CallRTL(RTL._rot, 2) + + |IL.opSAVES: + UnOp(reg1); + PushAll_1; + Op1(opPUSH, PC, sINCR); + INC(StkCnt); + EmitWord(param2); + Reloc(RDATA); + Push(reg1); + drop; + PushImm(param1); + CallRTL(RTL._move, 3) + + |IL.opCASET: + Push(R5); + Push(R5); + PushImm(param2); + CallRTL(RTL._guardrec, 2); + Pop(R5); + Test(ACC); + jcc(jne, param1) + + |IL.opCHR: + UnOp(reg1); + Op2(opAND, imm(255), reg1) + + |IL.opABS: + UnOp(reg1); + Test(reg1); + L := NewLabel(); + jcc(jge, L); + Neg(reg1); + EmitLabel(L) + + |IL.opEQB, IL.opNEB: + BinOp(reg1, reg2); + drop; + + Test(reg1); + L := NewLabel(); + jcc(je, L); + Op2(opMOV, imm(1), reg1); + EmitLabel(L); + + Test(reg2); + L := NewLabel(); + jcc(je, L); + Op2(opMOV, imm(1), reg2); + EmitLabel(L); + + Op2(opCMP, reg2 * 256, reg1); + IF opcode = IL.opEQB THEN + setcc(je, reg1) + ELSE + setcc(jne, reg1) + END + + |IL.opSAVEP: + UnOp(reg1); + Op2(opMOV, incr(PC), reg1 + dIDX); + EmitWord(param2); + Reloc(RCODE); + EmitWord(0); + drop + + |IL.opPUSHP: + Op2(opMOV, incr(PC), GetAnyReg()); + EmitWord(param2); + Reloc(RCODE) + + |IL.opEQP, IL.opNEP: + UnOp(reg1); + Op2(opCMP, incr(PC), reg1); + EmitWord(param1); + Reloc(RCODE); + drop; + reg1 := GetAnyReg(); + + IF opcode = IL.opEQP THEN + setcc(je, reg1) + ELSIF opcode = IL.opNEP THEN + setcc(jne, reg1) + END + + |IL.opVADR_PARAM: + reg1 := GetAnyReg(); + Op2(opMOV, LocalSrc(param2), reg1); + Push(reg1); + drop + + |IL.opNEW: + PushAll(1); + n := param2 + 2; + ASSERT(UTILS.Align(n, 2)); + PushImm(n); + PushImm(param1); + CallRTL(RTL._new, 3) + + |IL.opRSET: + PushAll(2); + CallRTL(RTL._set, 2); + GetRegA + + |IL.opRSETR: + PushAll(1); + PushImm(param2); + CallRTL(RTL._set, 2); + GetRegA + + |IL.opRSETL: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CallRTL(RTL._set, 2); + GetRegA + + |IL.opRSET1: + PushAll(1); + CallRTL(RTL._set1, 1); + GetRegA + + |IL.opINCLC: + UnOp(reg1); + Op2(opBIS, imm(ORD({param2})), dst_x(0, reg1)); + drop + + |IL.opEXCLC: + UnOp(reg1); + Op2(opBIC, imm(ORD({param2})), dst_x(0, reg1)); + drop + + |IL.opIN: + PushAll(2); + CallRTL(RTL._in, 2); + GetRegA + + |IL.opINR: + PushAll(1); + PushImm(param2); + CallRTL(RTL._in, 2); + GetRegA + + |IL.opINL: + PushAll(1); + PushImm(param2); + CallRTL(RTL._in2, 2); + GetRegA + + |IL.opINCL: + PushAll(2); + CallRTL(RTL._incl, 2) + + |IL.opEXCL: + PushAll(2); + CallRTL(RTL._excl, 2) + + |IL.opLADR_INCL, IL.opLADR_EXCL: + PushAll(1); + MovRR(SP, ACC); + n := LocalOffset(param2); + IF n # 0 THEN + Op2(opADD, imm(n), ACC) + END; + Push(ACC); + IF opcode = IL.opLADR_INCL THEN + CallRTL(RTL._incl, 2) + ELSIF opcode = IL.opLADR_EXCL THEN + CallRTL(RTL._excl, 2) + END + + |IL.opLADR_INCLC: + Op2(opBIS, imm(ORD({param2})), LocalDst(param1)) + + |IL.opLADR_EXCLC: + Op2(opBIC, imm(ORD({param2})), LocalDst(param1)) + + END; + + cmd := cmd.next(COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog (ramSize: INTEGER); +VAR + i: INTEGER; + +BEGIN + RTL.Init(EmitLabel, EmitWord, EmitCall, ramSize); + FOR i := 0 TO LEN(RTL.rtl) - 1 DO + RTL.Set(i, NewLabel()) + END; + + IV[LEN(IV) - 1] := NewLabel(); + EmitLabel(IV[LEN(IV) - 1]); + Op2(opMOV, incr(PC), SP); + EmitWord(0); + Op2(opMOV, incr(PC), HP); + EmitWord(0); + Op2(opMOV, imm(5A80H), dst_x(0120H, SR)); (* stop WDT *) + Op2(opMOV, imm(RTL.empty_proc), dst_x(RTL.int, SR)); + Op2(opMOV, imm(0), dst_x(RTL.trap, SR)) +END prolog; + + +PROCEDURE epilog; +VAR + L1, i: INTEGER; + +BEGIN + Op2(opBIS, imm(10H), SR); (* CPUOFF *) + + L1 := NewLabel(); + FOR i := 0 TO LEN(IV) - 2 DO + IV[i] := NewLabel(); + EmitLabel(IV[i]); + PushImm(i); + IF i # LEN(IV) - 2 THEN + EmitJmp(opJMP, L1) + END + END; + + EmitLabel(L1); + + MovRR(SP, IR); + + FOR i := 0 TO 15 DO + IF i IN R.regs + R.vregs THEN + Push(i) + END + END; + + Push(IR); + Op1(opPUSH, IR, sINDIR); + Op1(opCALL, SR, sIDX); + EmitWord(RTL.int); + Op2(opADD, imm(4), SP); + + FOR i := 15 TO 0 BY -1 DO + IF i IN R.regs + R.vregs THEN + Pop(i) + END + END; + + Op2(opADD, imm(2), SP); + Op1(opRETI, 0, 0); + + RTL.Gen +END epilog; + + +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +VAR + i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; + + Code, Data, Bss, Free: RECORD address, size: INTEGER END; + + ram, rom: INTEGER; + + reloc: RELOC; + + file: WR.FILE; + +BEGIN + IdxWords.src := NOWORD; + IdxWords.dst := NOWORD; + + ram := options.ram; + rom := options.rom; + + IF ODD(ram) THEN DEC(ram) END; + IF ODD(rom) THEN DEC(rom) END; + + ram := MIN(MAX(ram, minRAM), maxRAM); + rom := MIN(MAX(rom, minROM), maxROM); + + IF IL.codes.bss > ram - minStackSize - RTL.VarSize THEN + ERRORS.Error(204) + END; + + Labels := CHL.CreateIntList(); + FOR i := 1 TO IL.codes.lcount DO + CHL.PushInt(Labels, 0) + END; + + FOR i := 0 TO LEN(mem) - 1 DO + mem[i] := 0 + END; + + TypesSize := CHL.Length(IL.codes.types) * 2; + CodeList := LISTS.create(NIL); + RelList := LISTS.create(NIL); + REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {}); + + prolog(ram); + translate; + epilog; + + Code.address := 10000H - rom; + Code.size := Fixup(Code.address, IntVectorSize + TypesSize); + Data.address := Code.address + Code.size; + Data.size := CHL.Length(IL.codes.data); + Data.size := Data.size + Data.size MOD 2; + TextSize := Code.size + Data.size; + + IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN + ERRORS.Error(203) + END; + + Bss.address := RTL.ram + RTL.VarSize; + Bss.size := IL.codes.bss + IL.codes.bss MOD 2; + heap := Bss.address + Bss.size; + stack := RTL.ram + ram; + ASSERT(stack - heap >= minStackSize); + adr := Code.address + 2; + PutWord(stack, adr); + adr := Code.address + 6; + PutWord(heap, adr); + + reloc := RelList.first(RELOC); + WHILE reloc # NIL DO + adr := reloc.WordPtr.offset * 2; + CASE reloc.section OF + |RCODE: PutWord(LabelOffs(reloc.WordPtr.val) * 2, adr) + |RDATA: PutWord(reloc.WordPtr.val + Data.address, adr) + |RBSS: PutWord(reloc.WordPtr.val + Bss.address, adr) + END; + reloc := reloc.next(RELOC) + END; + + adr := Data.address; + + FOR i := 0 TO CHL.Length(IL.codes.data) - 1 DO + mem[adr] := CHL.GetByte(IL.codes.data, i); + INC(adr) + END; + + adr := 10000H - IntVectorSize - TypesSize; + + FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO + PutWord(CHL.GetInt(IL.codes.types, i), adr) + END; + + FOR i := 0 TO 15 DO + PutWord((33 - i) * i, adr); + END; + + FOR n := 0 TO 15 DO + bits := ORD({0 .. n}); + FOR i := 0 TO 15 - n DO + PutWord(bits, adr); + bits := LSL(bits, 1) + END + END; + + Free.address := Code.address + TextSize; + Free.size := rom - (IntVectorSize + TypesSize + TextSize); + + PutWord(Free.address, adr); + PutWord(Free.size, adr); + PutWord(4130H, adr); (* RET *) + PutWord(stack, adr); + PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *) + + FOR i := 0 TO LEN(IV) - 1 DO + PutWord(LabelOffs(IV[i]) * 2, adr) + END; + + file := WR.Create(outname); + + HEX.Data(file, mem, Code.address, TextSize); + HEX.Data(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); + HEX.End(file); + + WR.Close(file); + + INC(TextSize, IntVectorSize + TypesSize); + INC(Bss.size, minStackSize + RTL.VarSize); + + C.StringLn("--------------------------------------------"); + C.String( " rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)"); + IF Free.size > 0 THEN + C.String( " "); C.Int(Free.size); C.String(" bytes free (0"); + C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)") + END; + C.Ln; + C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)") + +END CodeGen; + + +END MSP430. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/MSP430RTL.ob07 b/programs/develop/oberon07/Source/MSP430RTL.ob07 index 17c858b86c..e2c4f6c8cd 100644 --- a/programs/develop/oberon07/Source/MSP430RTL.ob07 +++ b/programs/develop/oberon07/Source/MSP430RTL.ob07 @@ -1,677 +1,675 @@ -(* - 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. +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, 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; + bsl = iv - 2; + sp = bsl - 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 (modNum, modName, 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 <- modNum *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- modName *) + Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- err *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- line *) + Word2(4211H, sp); (* MOV sp(SR), SP *) + Word1(1207H); (* PUSH R7 *) + Word1(1206H); (* PUSH R6 *) + Word1(1205H); (* PUSH R5 *) + Word1(1204H); (* PUSH R4 *) + 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; + ram := 200H; + trap := ram; + int := trap + 2 +END Init; + + +END MSP430RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PARS.ob07 b/programs/develop/oberon07/Source/PARS.ob07 index 6694d65668..eebcd1d848 100644 --- a/programs/develop/oberon07/Source/PARS.ob07 +++ b/programs/develop/oberon07/Source/PARS.ob07 @@ -1,13 +1,14 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) MODULE PARS; -IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS; +IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, + C := COLLECTIONS, TARGETS, THUMB; CONST @@ -77,7 +78,7 @@ VAR parsers: C.COLLECTION; - lines*: INTEGER; + lines*, modules: INTEGER; PROCEDURE destroy* (VAR parser: PARSER); @@ -132,7 +133,7 @@ VAR BEGIN SCAN.Next(parser.scanner, parser.lex); errno := parser.lex.error; - IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN + IF (errno = 0) & (TARGETS.CPU = TARGETS.cpuMSP430) THEN IF parser.lex.sym = SCAN.lxFLOAT THEN errno := -SCAN.lxERROR13 ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN @@ -508,7 +509,7 @@ BEGIN check1(FALSE, parser, 124) END; - check1(sf IN program.target.sysflags, parser, 125); + check1(sf IN program.sysflags, parser, 125); IF proc THEN check1(sf IN PROG.proc_flags, parser, 123) @@ -532,15 +533,15 @@ BEGIN |PROG.sf_code: res := PROG.code |PROG.sf_windows: - IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN + IF TARGETS.OS = TARGETS.osWIN32 THEN res := PROG.stdcall - ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN + ELSIF TARGETS.OS = TARGETS.osWIN64 THEN res := PROG.win64 END |PROG.sf_linux: - IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN + IF TARGETS.OS = TARGETS.osLINUX32 THEN res := PROG.ccall16 - ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN + ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN res := PROG.systemv END |PROG.sf_noalign: @@ -577,6 +578,7 @@ BEGIN IF parser.sym = SCAN.lxCOMMA THEN ExpectSym(parser, SCAN.lxSTRING); dll := parser.lex.s; + STRINGS.UpCase(dll); ExpectSym(parser, SCAN.lxCOMMA); ExpectSym(parser, SCAN.lxSTRING); proc := parser.lex.s; @@ -586,16 +588,19 @@ BEGIN checklex(parser, SCAN.lxRSQUARE); Next(parser) ELSE - CASE program.target.bit_depth OF + CASE TARGETS.BitDepth OF |16: call := PROG.default16 - |32: call := PROG.default32 + |32: IF TARGETS.target = TARGETS.STM32CM3 THEN + call := PROG.ccall + ELSE + call := PROG.default32 + END |64: call := PROG.default64 END END; IF import # NIL THEN - check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32, - mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70) + check(TARGETS.Import, pos, 70) END RETURN call @@ -751,8 +756,8 @@ BEGIN ExpectSym(parser, SCAN.lxTO); Next(parser); - t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); - t.align := program.target.adr; + t := PROG.enterType(program, PROG.tPOINTER, TARGETS.AdrSize, 0, unit); + t.align := TARGETS.AdrSize; getpos(parser, pos); @@ -770,8 +775,8 @@ BEGIN ELSIF parser.sym = SCAN.lxPROCEDURE THEN NextPos(parser, pos); - t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); - t.align := program.target.adr; + t := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); + t.align := TARGETS.AdrSize; t.call := procflag(parser, import, FALSE); FormalParameters(parser, t) ELSE @@ -897,11 +902,13 @@ VAR variables: LISTS.LIST; int, flt: INTEGER; comma: BOOLEAN; - code: ARITH.VALUE; - codeProc: BOOLEAN; + code, iv: ARITH.VALUE; + codeProc, + handler: BOOLEAN; BEGIN endmod := FALSE; + handler := FALSE; unit := parser.unit; @@ -921,13 +928,27 @@ VAR check(PROG.openScope(unit, proc.proc), pos, 116); - proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); + proc.type := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); t := proc.type; - t.align := program.target.adr; + t.align := TARGETS.AdrSize; t.call := call; FormalParameters(parser, t); + IF parser.sym = SCAN.lxLSQUARE THEN + getpos(parser, pos2); + check(TARGETS.target = TARGETS.STM32CM3, pos2, 24); + Next(parser); + getpos(parser, pos2); + ConstExpression(parser, iv); + check(iv.typ = ARITH.tINTEGER, pos2, 43); + check((0 <= ARITH.Int(iv)) & (ARITH.Int(iv) <= THUMB.maxIVT), pos2, 46); + check(THUMB.SetIV(ARITH.Int(iv)), pos2, 121); + checklex(parser, SCAN.lxRSQUARE); + Next(parser); + handler := TRUE + END; + codeProc := call IN {PROG.code, PROG._code}; IF call IN {PROG.systemv, PROG._systemv} THEN @@ -948,7 +969,11 @@ VAR IF import = NIL THEN label := IL.NewLabel(); - proc.proc.label := label + proc.proc.label := label; + proc.proc.used := handler; + IF handler THEN + IL.AddCmd2(IL.opHANDLER, label, ARITH.Int(iv)) + END END; IF codeProc THEN @@ -958,8 +983,10 @@ VAR getpos(parser, pos2); ConstExpression(parser, code); check(code.typ = ARITH.tINTEGER, pos2, 43); - IF program.target.sys # mConst.Target_iMSP430 THEN + IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN check(ARITH.range(code, 0, 255), pos2, 42) + ELSIF TARGETS.CPU = TARGETS.cpuTHUMB THEN + check(ARITH.range(code, 0, 65535), pos2, 110) END; IL.AddCmd(IL.opCODE, ARITH.getInt(code)); comma := parser.sym = SCAN.lxCOMMA; @@ -976,8 +1003,8 @@ VAR IF import = NIL THEN - IF parser.main & proc.export & program.dll THEN - IF program.obj THEN + IF parser.main & proc.export & TARGETS.Dll THEN + IF TARGETS.target = TARGETS.KolibriOSDLL THEN check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114) END; IL.AddExp(label, proc.name.s); @@ -1023,8 +1050,8 @@ VAR 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) + IF TARGETS.CPU = TARGETS.cpuMSP430 THEN + check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.options.ram, pos1, 63) END END; @@ -1141,7 +1168,13 @@ BEGIN ImportList(parser) END; - CONSOLE.String("compiling "); CONSOLE.String(unit.name.s); + INC(modules); + + CONSOLE.String("compiling "); + IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN + CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ") + END; + CONSOLE.String(unit.name.s); IF parser.unit.sysimport THEN CONSOLE.String(" (SYSTEM)") END; @@ -1156,6 +1189,9 @@ BEGIN IL.SetLabel(errlabel); IL.StrAdr(name); IL.Param1; + IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN + IL.AddCmd(IL.opPUSHC, modules) + END; IL.AddCmd0(IL.opERR); FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO @@ -1227,7 +1263,7 @@ BEGIN parser.path := path; parser.lib_path := lib_path; - parser.ext := mConst.FILE_EXT; + parser.ext := UTILS.FILE_EXT; parser.fname := path; parser.modname := ""; parser.scanner := NIL; @@ -1247,12 +1283,13 @@ BEGIN END create; -PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS); +PROCEDURE init* (options: PROG.OPTIONS); BEGIN - program := PROG.create(bit_depth, target, options); + program := PROG.create(options); parsers := C.create(); - lines := 0 + lines := 0; + modules := 0 END init; -END PARS. +END PARS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PATHS.ob07 b/programs/develop/oberon07/Source/PATHS.ob07 index 4410514158..5532b6ca1d 100644 --- a/programs/develop/oberon07/Source/PATHS.ob07 +++ b/programs/develop/oberon07/Source/PATHS.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -106,4 +106,4 @@ BEGIN END GetCurrentDirectory; -END PATHS. +END PATHS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PE32.ob07 b/programs/develop/oberon07/Source/PE32.ob07 index 6dc88d8b70..32d1fc17e0 100644 --- a/programs/develop/oberon07/Source/PE32.ob07 +++ b/programs/develop/oberon07/Source/PE32.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -7,7 +7,7 @@ MODULE PE32; -IMPORT BIN, LISTS, UTILS, WR := WRITER, mConst := CONSTANTS, CHL := CHUNKLISTS; +IMPORT BIN, LISTS, UTILS, WR := WRITER, CHL := CHUNKLISTS; CONST @@ -165,11 +165,7 @@ VAR Relocations: LISTS.LIST; bit64: BOOLEAN; libcnt: INTEGER; - - -PROCEDURE SIZE (): INTEGER; - RETURN SIZE_OF_DWORD * (ORD(bit64) + 1) -END SIZE; + SizeOfWord: INTEGER; PROCEDURE Export (program: BIN.PROGRAM; DataRVA: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER; @@ -258,41 +254,42 @@ BEGIN import := import.next(BIN.IMPRT) END - RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SIZE() + RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord END GetImportSize; PROCEDURE fixup (program: BIN.PROGRAM; Address: VIRTUAL_ADDR); VAR - reloc: BIN.RELOC; - iproc: BIN.IMPRT; - L: INTEGER; - delta: INTEGER; - AdrImp: INTEGER; + reloc: BIN.RELOC; + iproc: BIN.IMPRT; + code: CHL.BYTELIST; + L, delta, delta0, AdrImp: INTEGER; BEGIN AdrImp := Address.Import + (libcnt + 1) * 5 * SIZE_OF_DWORD; - + code := program.code; reloc := program.rel_list.first(BIN.RELOC); + delta0 := 3 - 7 * ORD(bit64); + WHILE reloc # NIL DO - L := BIN.get32le(program.code, reloc.offset); - delta := 3 - reloc.offset - Address.Code - 7 * ORD(bit64); + L := BIN.get32le(code, reloc.offset); + delta := delta0 - reloc.offset - Address.Code; CASE reloc.opcode OF |BIN.PICDATA: - BIN.put32le(program.code, reloc.offset, L + Address.Data + delta) + BIN.put32le(code, reloc.offset, L + Address.Data + delta) |BIN.PICCODE: - BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta) + BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta) |BIN.PICBSS: - BIN.put32le(program.code, reloc.offset, L + Address.Bss + delta) + BIN.put32le(code, reloc.offset, L + Address.Bss + delta) |BIN.PICIMP: iproc := BIN.GetIProc(program, L); - BIN.put32le(program.code, reloc.offset, iproc.FirstThunk * SIZE() + AdrImp + delta) + BIN.put32le(code, reloc.offset, iproc.FirstThunk * SizeOfWord + AdrImp + delta) END; @@ -418,7 +415,6 @@ VAR i: INTEGER; BEGIN - WriteWord(file, h.Magic); WR.WriteByte(file, h.MajorLinkerVersion); @@ -499,6 +495,7 @@ VAR BEGIN bit64 := amd64; + SizeOfWord := SIZE_OF_DWORD * (ORD(bit64) + 1); Relocations := LISTS.create(NIL); Size.Code := CHL.Length(program.code); @@ -532,8 +529,8 @@ BEGIN PEHeader.FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll)); PEHeader.OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64)); - PEHeader.OptionalHeader.MajorLinkerVersion := mConst.vMajor; - PEHeader.OptionalHeader.MinorLinkerVersion := mConst.vMinor; + PEHeader.OptionalHeader.MajorLinkerVersion := UTILS.vMajor; + PEHeader.OptionalHeader.MinorLinkerVersion := UTILS.vMinor; PEHeader.OptionalHeader.SizeOfCode := align(Size.Code, FileAlignment); PEHeader.OptionalHeader.SizeOfInitializedData := 0; PEHeader.OptionalHeader.SizeOfUninitializedData := 0; @@ -563,30 +560,30 @@ BEGIN PEHeader.OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES; InitSection(SectionHeaders[0], ".text", SHC_text); - SectionHeaders[0].VirtualSize := Size.Code; - SectionHeaders[0].VirtualAddress := SectionAlignment; - SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment); - SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders; + SectionHeaders[0].VirtualSize := Size.Code; + SectionHeaders[0].VirtualAddress := SectionAlignment; + SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment); + SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders; InitSection(SectionHeaders[1], ".data", SHC_data); - SectionHeaders[1].VirtualSize := Size.Data; - SectionHeaders[1].VirtualAddress := align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment); - SectionHeaders[1].SizeOfRawData := align(Size.Data, FileAlignment); - SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData; + SectionHeaders[1].VirtualSize := Size.Data; + SectionHeaders[1].VirtualAddress := align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment); + SectionHeaders[1].SizeOfRawData := align(Size.Data, FileAlignment); + SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData; InitSection(SectionHeaders[2], ".bss", SHC_bss); - SectionHeaders[2].VirtualSize := Size.Bss; - SectionHeaders[2].VirtualAddress := align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment); - SectionHeaders[2].SizeOfRawData := 0; - SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData; + SectionHeaders[2].VirtualSize := Size.Bss; + SectionHeaders[2].VirtualAddress := align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment); + SectionHeaders[2].SizeOfRawData := 0; + SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData; Size.Import := GetImportSize(program.imp_list); InitSection(SectionHeaders[3], ".idata", SHC_data); - SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program.import); - SectionHeaders[3].VirtualAddress := align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment); - SectionHeaders[3].SizeOfRawData := align(SectionHeaders[3].VirtualSize, FileAlignment); - SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData; + SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program.import); + SectionHeaders[3].VirtualAddress := align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment); + SectionHeaders[3].SizeOfRawData := align(SectionHeaders[3].VirtualSize, FileAlignment); + SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData; Address.Code := SectionHeaders[0].VirtualAddress + PEHeader.OptionalHeader.ImageBase; Address.Data := SectionHeaders[1].VirtualAddress + PEHeader.OptionalHeader.ImageBase; @@ -599,10 +596,10 @@ BEGIN Size.Export := Export(program, SectionHeaders[1].VirtualAddress, ExportDir); InitSection(SectionHeaders[4], ".edata", SHC_data); - SectionHeaders[4].VirtualSize := Size.Export + CHL.Length(program.export); - SectionHeaders[4].VirtualAddress := align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment); - SectionHeaders[4].SizeOfRawData := align(SectionHeaders[4].VirtualSize, FileAlignment); - SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData; + SectionHeaders[4].VirtualSize := Size.Export + CHL.Length(program.export); + SectionHeaders[4].VirtualAddress := align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment); + SectionHeaders[4].SizeOfRawData := align(SectionHeaders[4].VirtualSize, FileAlignment); + SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData; END; FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO @@ -658,7 +655,7 @@ BEGIN n := (libcnt + 1) * 5; ImportTable := CHL.CreateIntList(); - FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SIZE() + n - 1 DO + FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SizeOfWord + n - 1 DO CHL.PushInt(ImportTable, 0) END; @@ -666,11 +663,11 @@ BEGIN import := program.imp_list.first(BIN.IMPRT); WHILE import # NIL DO IF import.label = 0 THEN - CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); + CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); CHL.SetInt(ImportTable, i + 1, 0); CHL.SetInt(ImportTable, i + 2, 0); CHL.SetInt(ImportTable, i + 3, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress); - CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); + CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); i := i + 5 END; import := import.next(BIN.IMPRT) @@ -738,4 +735,4 @@ BEGIN END write; -END PE32. +END PE32. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PROG.ob07 b/programs/develop/oberon07/Source/PROG.ob07 index cb9804b191..a398bef3cd 100644 --- a/programs/develop/oberon07/Source/PROG.ob07 +++ b/programs/develop/oberon07/Source/PROG.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -7,7 +7,7 @@ MODULE PROG; -IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS; +IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS; CONST @@ -199,25 +199,15 @@ TYPE locsize*: INTEGER; procs*: LISTS.LIST; - dll*: BOOLEAN; - obj*: BOOLEAN; + + sysflags*: SET; + options*: OPTIONS; stTypes*: RECORD tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_ - END; - - target*: RECORD - - bit_depth*: INTEGER; - word*: INTEGER; - adr*: INTEGER; - sys*: INTEGER; - sysflags*: SET; - options*: OPTIONS - END END; @@ -249,7 +239,6 @@ END NewIdent; PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER; VAR - word: INTEGER; size: INTEGER; BEGIN @@ -263,9 +252,8 @@ BEGIN END END ELSE - word := program.target.word; - IF UTILS.Align(size, word) THEN - size := size DIV word; + IF UTILS.Align(size, TARGETS.WordSize) THEN + size := size DIV TARGETS.WordSize; IF UTILS.maxint - program.locsize >= size THEN INC(program.locsize, size); varIdent.offset := program.locsize @@ -682,10 +670,12 @@ BEGIN ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE); ident.type := program.stTypes.tBOOLEAN; - IF program.target.sys # mConst.Target_iMSP430 THEN + IF TARGETS.RealSize # 0 THEN ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE); - ident.type := program.stTypes.tREAL; + ident.type := program.stTypes.tREAL + END; + IF TARGETS.BitDepth >= 32 THEN ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE); ident.type := program.stTypes.tWCHAR END @@ -737,14 +727,19 @@ BEGIN 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); + IF TARGETS.RealSize # 0 THEN + EnterProc(unit, "PACK", stPACK); + EnterProc(unit, "UNPK", stUNPK); + EnterFunc(unit, "FLOOR", stFLOOR); + EnterFunc(unit, "FLT", stFLT) + END; - EnterFunc(unit, "WCHR", stWCHR); - EnterFunc(unit, "FLOOR", stFLOOR); - EnterFunc(unit, "FLT", stFLT) + IF TARGETS.BitDepth >= 32 THEN + EnterFunc(unit, "WCHR", stWCHR) + END; + + IF TARGETS.Dispose THEN + EnterProc(unit, "DISPOSE", stDISPOSE) END END enterStProcs; @@ -782,7 +777,7 @@ BEGIN unit.sysimport := FALSE; - IF unit.name.s = mConst.RTL_NAME THEN + IF unit.name.s = UTILS.RTL_NAME THEN program.rtl := unit END @@ -1037,7 +1032,7 @@ BEGIN t.unit := unit; t.num := 0; - CASE program.target.bit_depth OF + CASE TARGETS.BitDepth OF |16: t.call := default16 |32: t.call := default32 |64: t.call := default64 @@ -1119,12 +1114,18 @@ BEGIN EnterProc(unit, "DINT", idSYSPROC, sysDINT) END; *) - IF program.target.sys # mConst.Target_iMSP430 THEN - EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); + IF TARGETS.RealSize # 0 THEN EnterProc(unit, "INF", idSYSFUNC, sysINF); + END; + + IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN + EnterProc(unit, "COPY", idSYSPROC, sysCOPY) + END; + + IF TARGETS.BitDepth >= 32 THEN + EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); - EnterProc(unit, "COPY", idSYSPROC, sysCOPY); ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); ident.type := program.stTypes.tCARD32; @@ -1191,41 +1192,25 @@ BEGIN END DelUnused; -PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM; +PROCEDURE create* (options: OPTIONS): PROGRAM; VAR program: PROGRAM; BEGIN idents := C.create(); - UTILS.SetBitDepth(bit_depth); + UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8); NEW(program); - program.target.bit_depth := bit_depth; - program.target.word := bit_depth DIV 8; - program.target.adr := bit_depth DIV 8; - program.target.sys := target; - program.target.options := options; + program.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} + CASE TARGETS.OS OF + |TARGETS.osWIN32: program.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} + |TARGETS.osLINUX32: program.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} + |TARGETS.osKOS: program.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} + |TARGETS.osWIN64: program.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} + |TARGETS.osLINUX64: program.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} + |TARGETS.osNONE: program.sysflags := {sf_code} END; program.recCount := -1; @@ -1235,38 +1220,35 @@ BEGIN program.types := LISTS.create(NIL); program.procs := LISTS.create(NIL); - 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.tSET := enterType(program, tSET, program.target.word, 0, NIL); - program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); + program.stTypes.tINTEGER := enterType(program, tINTEGER, TARGETS.WordSize, 0, NIL); + program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL); + program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL); + program.stTypes.tSET := enterType(program, tSET, TARGETS.WordSize, 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.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.tANYREC := enterType(program, tRECORD, 0, 0, NIL); - program.stTypes.tANYREC.closed := TRUE; - - program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size; + program.stTypes.tINTEGER.align := TARGETS.WordSize; program.stTypes.tBYTE.align := 1; - program.stTypes.tCHAR.align := program.stTypes.tCHAR.size; - program.stTypes.tSET.align := program.stTypes.tSET.size; - program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size; + program.stTypes.tCHAR.align := 1; + program.stTypes.tSET.align := TARGETS.WordSize; + program.stTypes.tBOOLEAN.align := 1; - IF target # mConst.Target_iMSP430 THEN - program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; - program.stTypes.tREAL.align := program.stTypes.tREAL.size; - program.stTypes.tCARD32.align := program.stTypes.tCARD32.size + IF TARGETS.BitDepth >= 32 THEN + program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); + program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL); + program.stTypes.tWCHAR.align := 2; + program.stTypes.tCARD32.align := 4 END; - program.dll := FALSE; - program.obj := FALSE; + IF TARGETS.RealSize # 0 THEN + program.stTypes.tREAL := enterType(program, tREAL, TARGETS.RealSize, 0, NIL); + program.stTypes.tREAL.align := TARGETS.RealSize + END; + + program.stTypes.tSTRING := enterType(program, tSTRING, TARGETS.WordSize, 0, NIL); + program.stTypes.tNIL := enterType(program, tNIL, TARGETS.WordSize, 0, NIL); + + program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); + program.stTypes.tANYREC.closed := TRUE; createSysUnit(program) @@ -1274,4 +1256,4 @@ BEGIN END create; -END PROG. +END PROG. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/REG.ob07 b/programs/develop/oberon07/Source/REG.ob07 index f5abb0f2c4..f0543cace6 100644 --- a/programs/develop/oberon07/Source/REG.ob07 +++ b/programs/develop/oberon07/Source/REG.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -435,4 +435,4 @@ BEGIN END Init; -END REG. +END REG. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/SCAN.ob07 b/programs/develop/oberon07/Source/SCAN.ob07 index e6c0aef060..029b2f34df 100644 --- a/programs/develop/oberon07/Source/SCAN.ob07 +++ b/programs/develop/oberon07/Source/SCAN.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -606,4 +606,4 @@ END init; BEGIN init -END SCAN. +END SCAN. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/STATEMENTS.ob07 b/programs/develop/oberon07/Source/STATEMENTS.ob07 index c263d4f49b..269719d789 100644 --- a/programs/develop/oberon07/Source/STATEMENTS.ob07 +++ b/programs/develop/oberon07/Source/STATEMENTS.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -9,8 +9,8 @@ MODULE STATEMENTS; IMPORT - PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, - ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; + PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, + ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS; CONST @@ -29,8 +29,6 @@ CONST chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE}; - cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3; - TYPE @@ -362,8 +360,8 @@ END CheckRange; PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN; VAR - res: BOOLEAN; - label: INTEGER; + res: BOOLEAN; + label: INTEGER; BEGIN IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN @@ -418,7 +416,7 @@ BEGIN IF e.obj = eCONST THEN IL.Float(ARITH.Float(e.value)) END; - IL.savef + IL.savef(e.obj = eCONST) ELSIF isChar(e) & (VarType = tCHAR) THEN IF e.obj = eCONST THEN IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) @@ -500,6 +498,7 @@ VAR PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER; VAR res: INTEGER; + BEGIN REPEAT res := t.length; @@ -513,8 +512,8 @@ VAR PROCEDURE OpenArray (t, t2: PROG.TYPE_); VAR - n: INTEGER; - d1, d2: INTEGER; + n, d1, d2: INTEGER; + BEGIN IF t.length # 0 THEN IL.Param1; @@ -606,7 +605,7 @@ BEGIN IF p.type.base = tCHAR THEN stroffs := String(e); IL.StrAdr(stroffs); - IF (CPU = cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN + IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN ERRORS.WarningMsg(pos.line, pos.col, 0) END ELSE (* WCHAR *) @@ -648,17 +647,16 @@ END PExpression; PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR - e2: PARS.EXPR; - pos: PARS.POSITION; - proc: INTEGER; - label: INTEGER; - n, i: INTEGER; - code: ARITH.VALUE; - e1: PARS.EXPR; - wchar: BOOLEAN; + e1, e2: PARS.EXPR; + pos: PARS.POSITION; + proc, + label, + n, i: INTEGER; + code: ARITH.VALUE; + wchar, + comma: BOOLEAN; cmd1, - cmd2: IL.COMMAND; - comma: BOOLEAN; + cmd2: IL.COMMAND; PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); @@ -675,6 +673,7 @@ VAR PROCEDURE shift_minmax (proc: INTEGER): CHAR; VAR res: CHAR; + BEGIN CASE proc OF |PROG.stASR: res := "A" @@ -777,7 +776,7 @@ BEGIN |PROG.stNEW: varparam(parser, pos, isPtr, TRUE, e); - IF CPU = cpuMSP430 THEN + IF CPU = TARGETS.cpuMSP430 THEN PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) END; IL.New(e.type.base.size, e.type.base.num) @@ -885,9 +884,9 @@ BEGIN PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); IF e2.obj = eCONST THEN IF e2.type = tREAL THEN - IL.setlast(endcall.prev(IL.COMMAND)); IL.Float(ARITH.Float(e2.value)); - IL.savef + IL.setlast(endcall.prev(IL.COMMAND)); + IL.savef(FALSE) ELSE LoadConst(e2); IL.setlast(endcall.prev(IL.COMMAND)); @@ -896,7 +895,7 @@ BEGIN ELSE IL.setlast(endcall.prev(IL.COMMAND)); IF e2.type = tREAL THEN - IL.savef + IL.savef(FALSE) ELSIF e2.type = tBYTE THEN IL.SysPut(tINTEGER.size) ELSE @@ -962,8 +961,10 @@ BEGIN getpos(parser, pos); PARS.ConstExpression(parser, code); PARS.check(code.typ = ARITH.tINTEGER, pos, 43); - IF CPU # cpuMSP430 THEN + IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN PARS.check(ARITH.range(code, 0, 255), pos, 42) + ELSIF CPU = TARGETS.cpuTHUMB THEN + PARS.check(ARITH.range(code, 0, 65535), pos, 110) END; IL.AddCmd(IL.opCODE, ARITH.getInt(code)); comma := parser.sym = SCAN.lxCOMMA; @@ -1113,7 +1114,7 @@ BEGIN IF e.obj = eCONST THEN ARITH.odd(e.value) ELSE - IL.AddCmd0(IL.opODD) + IL.AddCmd(IL.opMODR, 2) END |PROG.stORD: @@ -1340,7 +1341,7 @@ END qualident; PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); VAR - label: INTEGER; + label: INTEGER; BEGIN IF load THEN @@ -1409,9 +1410,8 @@ VAR PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); VAR - label: INTEGER; - type: PROG.TYPE_; - n, offset, k: INTEGER; + label, offset, n, k: INTEGER; + type: PROG.TYPE_; BEGIN @@ -1571,12 +1571,12 @@ END designator; PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); VAR - cconv: INTEGER; - parSize: INTEGER; - callconv: INTEGER; - fparSize: INTEGER; - int, flt: INTEGER; - stk_par: INTEGER; + cconv, + parSize, + callconv, + fparSize, + int, flt, + stk_par: INTEGER; BEGIN cconv := procType.call; @@ -1862,11 +1862,8 @@ VAR PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR pos: PARS.POSITION; - op: INTEGER; e1: PARS.EXPR; - - label: INTEGER; - label1: INTEGER; + op, label, label1: INTEGER; BEGIN factor(parser, e); @@ -1972,10 +1969,7 @@ VAR |SCAN.lxDIV, SCAN.lxMOD: PARS.check(isInt(e) & isInt(e1), pos, 37); IF e1.obj = eCONST THEN - PARS.check(~ARITH.isZero(e1.value), pos, 46); - IF CPU = cpuMSP430 THEN - PARS.check(ARITH.Int(e1.value) > 0, pos, 122) - END + PARS.check(ARITH.Int(e1.value) > 0, pos, 122) END; IF (e.obj = eCONST) & (e1.obj = eCONST) THEN @@ -1988,11 +1982,7 @@ VAR ELSE IF e1.obj # eCONST THEN label1 := IL.NewLabel(); - IF CPU = cpuMSP430 THEN - IL.AddJmpCmd(IL.opJG, label1) - ELSE - IL.AddJmpCmd(IL.opJNZ, label1) - END + IL.AddJmpCmd(IL.opJG, label1) END; IF e.obj = eCONST THEN IL.OnError(pos.line, errDIV); @@ -2223,7 +2213,6 @@ VAR res: BOOLEAN; BEGIN - res := TRUE; IF isString(e) & isCharArray(e1) THEN @@ -2527,11 +2516,11 @@ END expression; PROCEDURE ElementaryStatement (parser: PARS.PARSER); VAR - e, e1: PARS.EXPR; - pos: PARS.POSITION; - line: INTEGER; - call: BOOLEAN; - fregs: INTEGER; + e, e1: PARS.EXPR; + pos: PARS.POSITION; + line: INTEGER; + call: BOOLEAN; + fregs: INTEGER; BEGIN getpos(parser, pos); @@ -2590,8 +2579,8 @@ END ElementaryStatement; PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); VAR - e: PARS.EXPR; - pos: PARS.POSITION; + e: PARS.EXPR; + pos: PARS.POSITION; label, L: INTEGER; @@ -2731,16 +2720,16 @@ END NewVariant; PROCEDURE CaseStatement (parser: PARS.PARSER); VAR - e: PARS.EXPR; - pos: PARS.POSITION; + e: PARS.EXPR; + pos: PARS.POSITION; PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; VAR - a: INTEGER; - label: PARS.EXPR; - pos: PARS.POSITION; - value: ARITH.VALUE; + a: INTEGER; + label: PARS.EXPR; + pos: PARS.POSITION; + value: ARITH.VALUE; BEGIN getpos(parser, pos); @@ -2856,11 +2845,11 @@ VAR PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER); VAR - sym: INTEGER; - t: PROG.TYPE_; - variant: INTEGER; - node: AVL.NODE; - last: IL.COMMAND; + sym: INTEGER; + t: PROG.TYPE_; + variant: INTEGER; + node: AVL.NODE; + last: IL.COMMAND; BEGIN sym := parser.sym; @@ -2958,7 +2947,7 @@ VAR VAR table, end, else: INTEGER; tree: AVL.NODE; - item: LISTS.ITEM; + item: LISTS.ITEM; BEGIN LISTS.push(CaseVariants, NewVariant(0, NIL)); @@ -3026,11 +3015,11 @@ BEGIN ELSIF isRec(e) THEN IL.drop; IL.AddCmd(IL.opLADR, e.ident.offset - 1); - IL.load(PARS.program.target.word) + IL.load(TARGETS.WordSize) ELSIF isPtr(e) THEN deref(pos, e, FALSE, errPTR); - IL.AddCmd(IL.opSUBR, PARS.program.target.word); - IL.load(PARS.program.target.word) + IL.AddCmd(IL.opSUBR, TARGETS.WordSize); + IL.load(TARGETS.WordSize) END; PARS.checklex(parser, SCAN.lxOF); @@ -3222,7 +3211,7 @@ VAR PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER); VAR - id: PROG.IDENT; + id: PROG.IDENT; BEGIN id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); @@ -3243,29 +3232,42 @@ BEGIN rtl := PARS.program.rtl; ASSERT(rtl # NIL); - IF CPU IN {cpuX86, cpuAMD64} THEN - getproc(rtl, "_strcmp", IL._strcmp); - getproc(rtl, "_length", IL._length); - getproc(rtl, "_arrcpy", IL._arrcpy); - getproc(rtl, "_is", IL._is); - getproc(rtl, "_guard", IL._guard); - getproc(rtl, "_guardrec", IL._guardrec); - getproc(rtl, "_error", IL._error); - getproc(rtl, "_new", IL._new); - getproc(rtl, "_rot", IL._rot); - getproc(rtl, "_strcpy", IL._strcpy); - getproc(rtl, "_move", IL._move); - getproc(rtl, "_divmod", IL._divmod); - getproc(rtl, "_set", IL._set); - getproc(rtl, "_set1", IL._set1); - getproc(rtl, "_isrec", IL._isrec); - getproc(rtl, "_lengthw", IL._lengthw); - getproc(rtl, "_strcmpw", IL._strcmpw); - getproc(rtl, "_dllentry", IL._dllentry); - getproc(rtl, "_dispose", IL._dispose); - getproc(rtl, "_exit", IL._exit); - getproc(rtl, "_init", IL._init); - getproc(rtl, "_sofinit", IL._sofinit) + getproc(rtl, "_strcmp", IL._strcmp); + getproc(rtl, "_length", IL._length); + getproc(rtl, "_arrcpy", IL._arrcpy); + getproc(rtl, "_is", IL._is); + getproc(rtl, "_guard", IL._guard); + getproc(rtl, "_guardrec", IL._guardrec); + getproc(rtl, "_new", IL._new); + getproc(rtl, "_rot", IL._rot); + getproc(rtl, "_strcpy", IL._strcpy); + getproc(rtl, "_move", IL._move); + getproc(rtl, "_set", IL._set); + getproc(rtl, "_set1", IL._set1); + getproc(rtl, "_lengthw", IL._lengthw); + getproc(rtl, "_strcmpw", IL._strcmpw); + getproc(rtl, "_init", IL._init); + + IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN + getproc(rtl, "_error", IL._error); + getproc(rtl, "_divmod", IL._divmod); + getproc(rtl, "_exit", IL._exit); + getproc(rtl, "_dispose", IL._dispose); + getproc(rtl, "_isrec", IL._isrec); + getproc(rtl, "_dllentry", IL._dllentry); + getproc(rtl, "_sofinit", IL._sofinit) + ELSIF CPU = TARGETS.cpuTHUMB THEN + getproc(rtl, "_fmul", IL._fmul); + getproc(rtl, "_fdiv", IL._fdiv); + getproc(rtl, "_fdivi", IL._fdivi); + getproc(rtl, "_fadd", IL._fadd); + getproc(rtl, "_fsub", IL._fsub); + getproc(rtl, "_fsubi", IL._fsubi); + getproc(rtl, "_fcmp", IL._fcmp); + getproc(rtl, "_floor", IL._floor); + getproc(rtl, "_flt", IL._flt); + getproc(rtl, "_pack", IL._pack); + getproc(rtl, "_unpk", IL._unpk) END END setrtl; @@ -3286,44 +3288,30 @@ BEGIN tREAL := PARS.program.stTypes.tREAL; Options := options; + CPU := TARGETS.CPU; - CASE target OF - |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: - CPU := cpuAMD64 - |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, - mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, - mConst.Target_iELFSO32: - CPU := cpuX86 - |mConst.Target_iMSP430: - CPU := cpuMSP430 - END; - - ext := mConst.FILE_EXT; + ext := UTILS.FILE_EXT; CaseLabels := C.create(); CaseVar := C.create(); CaseVariants := LISTS.create(NIL); LISTS.push(CaseVariants, NewVariant(0, NIL)); - CASE CPU OF - |cpuAMD64: IL.init(6, IL.little_endian) - |cpuX86: IL.init(8, IL.little_endian) - |cpuMSP430: IL.init(0, IL.little_endian) - END; + IL.init(CPU); - IF CPU # cpuMSP430 THEN + IF CPU # TARGETS.cpuMSP430 THEN parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); - IF parser.open(parser, mConst.RTL_NAME) THEN + IF parser.open(parser, UTILS.RTL_NAME) THEN parser.parse(parser); PARS.destroy(parser) ELSE PARS.destroy(parser); parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn); - IF parser.open(parser, mConst.RTL_NAME) THEN + IF parser.open(parser, UTILS.RTL_NAME) THEN parser.parse(parser); PARS.destroy(parser) ELSE - ERRORS.FileNotFound(lib_path, mConst.RTL_NAME, mConst.FILE_EXT) + ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT) END END END; @@ -3334,16 +3322,16 @@ BEGIN IF parser.open(parser, modname) THEN parser.parse(parser) ELSE - ERRORS.FileNotFound(path, modname, mConst.FILE_EXT) + ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT) END; PARS.destroy(parser); - IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN + IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN ERRORS.Error(204) END; - IF CPU # cpuMSP430 THEN + IF CPU # TARGETS.cpuMSP430 THEN setrtl END; @@ -3352,12 +3340,13 @@ BEGIN IL.set_bss(PARS.program.bss); CASE CPU OF - | cpuAMD64: AMD64.CodeGen(outname, target, options) - | cpuX86: X86.CodeGen(outname, target, options) - |cpuMSP430: MSP430.CodeGen(outname, target, options) + |TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options) + |TARGETS.cpuX86: X86.CodeGen(outname, target, options) + |TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options) + |TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options) END END compile; -END STATEMENTS. +END STATEMENTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/STRINGS.ob07 b/programs/develop/oberon07/Source/STRINGS.ob07 index 2ab48c5e74..af3baaeb4b 100644 --- a/programs/develop/oberon07/Source/STRINGS.ob07 +++ b/programs/develop/oberon07/Source/STRINGS.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -13,6 +13,7 @@ IMPORT UTILS; PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); VAR n1, n2, i, j: INTEGER; + BEGIN n1 := LENGTH(s1); n2 := LENGTH(s2); @@ -32,13 +33,12 @@ BEGIN END append; -PROCEDURE reverse* (VAR s: ARRAY OF CHAR); +PROCEDURE reverse (VAR s: ARRAY OF CHAR); VAR i, j: INTEGER; a, b: CHAR; BEGIN - i := 0; j := LENGTH(s) - 1; @@ -172,6 +172,27 @@ PROCEDURE space* (c: CHAR): BOOLEAN; END space; +PROCEDURE cap (VAR c: CHAR); +BEGIN + IF ("a" <= c) & (c <= "z") THEN + c := CHR(ORD(c) - 32) + END +END cap; + + +PROCEDURE UpCase* (VAR str: ARRAY OF CHAR); +VAR + i: INTEGER; + +BEGIN + i := 0; + WHILE (i < LEN(str)) & (str[i] # 0X) DO + cap(str[i]); + INC(i) + END +END UpCase; + + PROCEDURE StrToInt* (str: ARRAY OF CHAR; VAR x: INTEGER): BOOLEAN; VAR i, k: INTEGER; @@ -276,21 +297,21 @@ BEGIN u := ORD(c) |0C1X..0DFX: - u := LSL(ORD(c) - 0C0H, 6); + u := (ORD(c) - 0C0H) * 64; IF i + 1 < srclen THEN INC(i); - INC(u, ORD(BITS(ORD(src[i])) * {0..5})) + INC(u, ORD(src[i]) MOD 64) END |0E1X..0EFX: - u := LSL(ORD(c) - 0E0H, 12); + u := (ORD(c) - 0E0H) * 4096; IF i + 1 < srclen THEN INC(i); - INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64) + INC(u, (ORD(src[i]) MOD 64) * 64) END; IF i + 1 < srclen THEN INC(i); - INC(u, ORD(BITS(ORD(src[i])) * {0..5})) + INC(u, ORD(src[i]) MOD 64) END (* |0F1X..0F7X: @@ -311,4 +332,4 @@ BEGIN END Utf8To16; -END STRINGS. +END STRINGS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/TARGETS.ob07 b/programs/develop/oberon07/Source/TARGETS.ob07 new file mode 100644 index 0000000000..39ceed4eb7 --- /dev/null +++ b/programs/develop/oberon07/Source/TARGETS.ob07 @@ -0,0 +1,116 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE TARGETS; + + +CONST + + MSP430* = 0; + Win32C* = 1; + Win32GUI* = 2; + Win32DLL* = 3; + KolibriOS* = 4; + KolibriOSDLL* = 5; + Win64C* = 6; + Win64GUI* = 7; + Win64DLL* = 8; + Linux32* = 9; + Linux32SO* = 10; + Linux64* = 11; + Linux64SO* = 12; + STM32CM3* = 13; + + cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3; + + osNONE* = 0; osWIN32* = 1; osWIN64* = 2; + osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5; + + +TYPE + + STRING = ARRAY 32 OF CHAR; + + TARGET = RECORD + + target, CPU, BitDepth, OS, RealSize: INTEGER; + ComLinePar*, LibDir, FileExt: STRING + + END; + + +VAR + + Targets*: ARRAY 14 OF TARGET; + + target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*: INTEGER; + ComLinePar*, LibDir*, FileExt*: STRING; + Import*, Dispose*, Dll*: BOOLEAN; + + +PROCEDURE Enter (idx, CPU, BitDepth, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); +BEGIN + Targets[idx].target := idx; + Targets[idx].CPU := CPU; + Targets[idx].BitDepth := BitDepth; + Targets[idx].RealSize := RealSize; + Targets[idx].OS := OS; + Targets[idx].ComLinePar := ComLinePar; + Targets[idx].LibDir := LibDir; + Targets[idx].FileExt := FileExt; +END Enter; + + +PROCEDURE Select* (ComLineParam: ARRAY OF CHAR): BOOLEAN; +VAR + i: INTEGER; + res: BOOLEAN; + +BEGIN + i := 0; + WHILE (i < LEN(Targets)) & (Targets[i].ComLinePar # ComLineParam) DO + INC(i) + END; + + res := i < LEN(Targets); + IF res THEN + target := Targets[i].target; + CPU := Targets[i].CPU; + BitDepth := Targets[i].BitDepth; + RealSize := Targets[i].RealSize; + OS := Targets[i].OS; + ComLinePar := Targets[i].ComLinePar; + LibDir := Targets[i].LibDir; + FileExt := Targets[i].FileExt; + + Import := OS IN {osWIN32, osWIN64, osKOS}; + Dispose := ~(target IN {MSP430, STM32CM3}); + Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL}; + WordSize := BitDepth DIV 8; + AdrSize := WordSize + END + + RETURN res +END Select; + + +BEGIN + Enter( MSP430, cpuMSP430, 16, 0, osNONE, "msp430", "MSP430", ".hex"); + Enter( Win32C, cpuX86, 32, 8, osWIN32, "win32con", "Windows32", ".exe"); + Enter( Win32GUI, cpuX86, 32, 8, osWIN32, "win32gui", "Windows32", ".exe"); + Enter( Win32DLL, cpuX86, 32, 8, osWIN32, "win32dll", "Windows32", ".dll"); + Enter( KolibriOS, cpuX86, 32, 8, osKOS, "kosexe", "KolibriOS", ""); + Enter( KolibriOSDLL, cpuX86, 32, 8, osKOS, "kosdll", "KolibriOS", ".obj"); + Enter( Win64C, cpuAMD64, 64, 8, osWIN64, "win64con", "Windows64", ".exe"); + Enter( Win64GUI, cpuAMD64, 64, 8, osWIN64, "win64gui", "Windows64", ".exe"); + Enter( Win64DLL, cpuAMD64, 64, 8, osWIN64, "win64dll", "Windows64", ".dll"); + Enter( Linux32, cpuX86, 32, 8, osLINUX32, "linux32exe", "Linux32", ""); + Enter( Linux32SO, cpuX86, 32, 8, osLINUX32, "linux32so", "Linux32", ".so"); + Enter( Linux64, cpuAMD64, 64, 8, osLINUX64, "linux64exe", "Linux64", ""); + Enter( Linux64SO, cpuAMD64, 64, 8, osLINUX64, "linux64so", "Linux64", ".so"); + Enter( STM32CM3, cpuTHUMB, 32, 4, osNONE, "stm32cm3", "STM32CM3", ".hex"); +END TARGETS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/TEXTDRV.ob07 b/programs/develop/oberon07/Source/TEXTDRV.ob07 index 4e75c78db8..9ae8b68c35 100644 --- a/programs/develop/oberon07/Source/TEXTDRV.ob07 +++ b/programs/develop/oberon07/Source/TEXTDRV.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -177,4 +177,4 @@ END open; BEGIN texts := C.create() -END TEXTDRV. +END TEXTDRV. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/THUMB.ob07 b/programs/develop/oberon07/Source/THUMB.ob07 new file mode 100644 index 0000000000..d9e8ba9ecd --- /dev/null +++ b/programs/develop/oberon07/Source/THUMB.ob07 @@ -0,0 +1,2430 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019-2020, Anton Krotov + All rights reserved. +*) + +MODULE THUMB; + +IMPORT PROG, LISTS, CHL := CHUNKLISTS, BIN, REG, IL, C := CONSOLE, + UTILS, WR := WRITER, HEX, ERRORS, TARGETS; + + +CONST + + R0 = 0; R1 = 1; R2 = 2; R3 = 3; R4 = 4; + + SP = 13; LR = 14; PC = 15; + + ACC = R0; + + je = 0; jne = 1; jnb = 2; jb = 3; jge = 10; jl = 11; jg = 12; jle = 13; + + inf = 7F800000H; + + STM32_minROM* = 16; STM32_maxROM* = 65536; + STM32_minRAM* = 4; STM32_maxRAM* = 65536; + + maxIVT* = 1023; + + +TYPE + + COMMAND = IL.COMMAND; + + ANYCODE = POINTER TO RECORD (LISTS.ITEM) + + offset: INTEGER + + END; + + CODE = POINTER TO RECORD (ANYCODE) + + code: INTEGER + + END; + + LABEL = POINTER TO RECORD (ANYCODE) + + label: INTEGER + + END; + + JUMP = POINTER TO RECORD (ANYCODE) + + label, diff, len, cond: INTEGER; + short: BOOLEAN + + END; + + JMP = POINTER TO RECORD (JUMP) + + END; + + JCC = POINTER TO RECORD (JUMP) + + END; + + CBXZ = POINTER TO RECORD (JUMP) + + reg: INTEGER + + END; + + CALL = POINTER TO RECORD (JUMP) + + END; + + RELOC = POINTER TO RECORD (ANYCODE) + + reg, rel, value: INTEGER + + END; + + RELOCCODE = ARRAY 7 OF INTEGER; + + +VAR + + R: REG.REGS; + + tcount: INTEGER; + + CodeList: LISTS.LIST; + + program: BIN.PROGRAM; + + StkCount: INTEGER; + + Target: RECORD + FlashAdr, + SRAMAdr, + IVTLen, + MinStack, + Reserved: INTEGER; + InstrSet: RECORD thumb2, it, cbxz, sdiv: BOOLEAN END + END; + + IVT: ARRAY maxIVT + 1 OF INTEGER; + + sdivProc, trap, genTrap, entry, emptyProc, int0, genInt: INTEGER; + + +PROCEDURE Code (code: INTEGER); +VAR + c: CODE; + +BEGIN + NEW(c); + c.code := code; + LISTS.push(CodeList, c) +END Code; + + +PROCEDURE Label (label: INTEGER); +VAR + L: LABEL; + +BEGIN + NEW(L); + L.label := label; + LISTS.push(CodeList, L) +END Label; + + +PROCEDURE jcc (cond, label: INTEGER); +VAR + j: JCC; + +BEGIN + NEW(j); + j.label := label; + j.cond := cond; + j.short := FALSE; + j.len := 3; + LISTS.push(CodeList, j) +END jcc; + + +PROCEDURE cbxz (cond, reg, label: INTEGER); +VAR + j: CBXZ; + +BEGIN + NEW(j); + j.label := label; + j.cond := cond; + j.reg := reg; + j.short := FALSE; + j.len := 4; + LISTS.push(CodeList, j) +END cbxz; + + +PROCEDURE jmp (label: INTEGER); +VAR + j: JMP; + +BEGIN + NEW(j); + j.label := label; + j.short := FALSE; + j.len := 2; + LISTS.push(CodeList, j) +END jmp; + + +PROCEDURE call (label: INTEGER); +VAR + c: CALL; + +BEGIN + NEW(c); + c.label := label; + c.short := FALSE; + c.len := 2; + LISTS.push(CodeList, c) +END call; + + +PROCEDURE reloc (reg, rel, value: INTEGER); +VAR + r: RELOC; + +BEGIN + NEW(r); + r.reg := reg; + r.rel := rel; + r.value := value; + LISTS.push(CodeList, r) +END reloc; + + +PROCEDURE NewLabel (): INTEGER; +BEGIN + BIN.NewLabel(program) + RETURN IL.NewLabel() +END NewLabel; + + +PROCEDURE range (x, n: INTEGER): BOOLEAN; + RETURN (0 <= x) & (x < LSL(1, n)) +END range; + + +PROCEDURE srange (x, n: INTEGER): BOOLEAN; + RETURN (-LSL(1, n - 1) <= x) & (x < LSL(1, n - 1)) +END srange; + + +PROCEDURE gen1 (op, imm, rs, rd: INTEGER); +BEGIN + ASSERT(op IN {0..2}); + ASSERT(range(imm, 5)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(LSL(op, 11) + LSL(imm, 6) + LSL(rs, 3) + rd) +END gen1; + + +PROCEDURE gen2 (i, op: BOOLEAN; imm, rs, rd: INTEGER); +BEGIN + ASSERT(range(imm, 3)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(1800H + LSL(ORD(i), 10) + LSL(ORD(op), 9) + LSL(imm, 6) + LSL(rs, 3) + rd) +END gen2; + + +PROCEDURE gen3 (op, rd, imm: INTEGER); +BEGIN + ASSERT(range(op, 2)); + ASSERT(range(rd, 3)); + ASSERT(range(imm, 8)); + Code(2000H + LSL(op, 11) + LSL(rd, 8) + imm) +END gen3; + + +PROCEDURE gen4 (op, rs, rd: INTEGER); +BEGIN + ASSERT(range(op, 4)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(4000H + LSL(op, 6) + LSL(rs, 3) + rd) +END gen4; + + +PROCEDURE gen5 (op: INTEGER; h1, h2: BOOLEAN; rs, rd: INTEGER); +BEGIN + ASSERT(range(op, 2)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(4400H + LSL(op, 8) + LSL(ORD(h1), 7) + LSL(ORD(h2), 6) + LSL(rs, 3) + rd) +END gen5; + + +PROCEDURE gen7 (l, b: BOOLEAN; ro, rb, rd: INTEGER); +BEGIN + ASSERT(range(ro, 3)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(5000H + LSL(ORD(l), 11) + LSL(ORD(b), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) +END gen7; + + +PROCEDURE gen8 (h, s: BOOLEAN; ro, rb, rd: INTEGER); +BEGIN + ASSERT(range(ro, 3)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(5200H + LSL(ORD(h), 11) + LSL(ORD(s), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) +END gen8; + + +PROCEDURE gen9 (b, l: BOOLEAN; imm, rb, rd: INTEGER); +BEGIN + ASSERT(range(imm, 5)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(6000H + LSL(ORD(b), 12) + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) +END gen9; + + +PROCEDURE gen10 (l: BOOLEAN; imm, rb, rd: INTEGER); +BEGIN + ASSERT(range(imm, 5)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(8000H + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) +END gen10; + + +PROCEDURE gen11 (l: BOOLEAN; rd, imm: INTEGER); +BEGIN + ASSERT(range(rd, 3)); + ASSERT(range(imm, 8)); + Code(9000H + LSL(ORD(l), 11) + LSL(rd, 8) + imm) +END gen11; + + +PROCEDURE gen12 (sp: BOOLEAN; rd, imm: INTEGER); +BEGIN + ASSERT(range(rd, 3)); + ASSERT(range(imm, 8)); + Code(0A000H + LSL(ORD(sp), 11) + LSL(rd, 8) + imm) +END gen12; + + +PROCEDURE gen14 (l, r: BOOLEAN; rlist: SET); +VAR + i, n: INTEGER; + +BEGIN + ASSERT(range(ORD(rlist), 8)); + + n := ORD(r); + FOR i := 0 TO 7 DO + IF i IN rlist THEN + INC(n) + END + END; + + IF l THEN + n := -n + END; + + INC(StkCount, n); + + Code(0B400H + LSL(ORD(l), 11) + LSL(ORD(r), 8) + ORD(rlist)) +END gen14; + + +PROCEDURE split16 (imm16: INTEGER; VAR imm4, imm1, imm3, imm8: INTEGER); +BEGIN + ASSERT(range(imm16, 16)); + imm8 := imm16 MOD 256; + imm4 := LSR(imm16, 12); + imm3 := LSR(imm16, 8) MOD 8; + imm1 := LSR(imm16, 11) MOD 2; +END split16; + + +PROCEDURE LslImm (r, imm5: INTEGER); +BEGIN + gen1(0, imm5, r, r) +END LslImm; + + +PROCEDURE LsrImm (r, imm5: INTEGER); +BEGIN + gen1(1, imm5, r, r) +END LsrImm; + + +PROCEDURE AsrImm (r, imm5: INTEGER); +BEGIN + gen1(2, imm5, r, r) +END AsrImm; + + +PROCEDURE AddReg (rd, rs, rn: INTEGER); +BEGIN + gen2(FALSE, FALSE, rn, rs, rd) +END AddReg; + + +PROCEDURE SubReg (rd, rs, rn: INTEGER); +BEGIN + gen2(FALSE, TRUE, rn, rs, rd) +END SubReg; + + +PROCEDURE AddImm8 (rd, imm8: INTEGER); +BEGIN + IF imm8 # 0 THEN + gen3(2, rd, imm8) + END +END AddImm8; + + +PROCEDURE SubImm8 (rd, imm8: INTEGER); +BEGIN + IF imm8 # 0 THEN + gen3(3, rd, imm8) + END +END SubImm8; + + +PROCEDURE AddSubImm12 (r, imm12: INTEGER; sub: BOOLEAN); +VAR + imm4, imm1, imm3, imm8: INTEGER; + +BEGIN + split16(imm12, imm4, imm1, imm3, imm8); + Code(0F200H + LSL(imm1, 10) + r + 0A0H * ORD(sub)); (* addw/subw r, r, imm12 *) + Code(LSL(imm3, 12) + LSL(r, 8) + imm8) +END AddSubImm12; + + +PROCEDURE MovImm8 (rd, imm8: INTEGER); +BEGIN + gen3(0, rd, imm8) +END MovImm8; + + +PROCEDURE CmpImm8 (rd, imm8: INTEGER); +BEGIN + gen3(1, rd, imm8) +END CmpImm8; + + +PROCEDURE Neg (r: INTEGER); +BEGIN + gen4(9, r, r) +END Neg; + + +PROCEDURE Mul (rd, rs: INTEGER); +BEGIN + gen4(13, rs, rd) +END Mul; + + +PROCEDURE Str32 (rs, rb: INTEGER); +BEGIN + gen9(FALSE, FALSE, 0, rb, rs) +END Str32; + + +PROCEDURE Ldr32 (rd, rb: INTEGER); +BEGIN + gen9(FALSE, TRUE, 0, rb, rd) +END Ldr32; + + +PROCEDURE Str16 (rs, rb: INTEGER); +BEGIN + gen10(FALSE, 0, rb, rs) +END Str16; + + +PROCEDURE Ldr16 (rd, rb: INTEGER); +BEGIN + gen10(TRUE, 0, rb, rd) +END Ldr16; + + +PROCEDURE Str8 (rs, rb: INTEGER); +BEGIN + gen9(TRUE, FALSE, 0, rb, rs) +END Str8; + + +PROCEDURE Ldr8 (rd, rb: INTEGER); +BEGIN + gen9(TRUE, TRUE, 0, rb, rd) +END Ldr8; + + +PROCEDURE Cmp (r1, r2: INTEGER); +BEGIN + gen4(10, r2, r1) +END Cmp; + + +PROCEDURE Tst (r: INTEGER); +BEGIN + gen3(1, r, 0) (* cmp r, #0 *) +END Tst; + + +PROCEDURE LdrSp (r, offset: INTEGER); +BEGIN + gen11(TRUE, r, offset) +END LdrSp; + + +PROCEDURE MovImm32 (r, imm32: INTEGER); +BEGIN + MovImm8(r, LSR(imm32, 24) MOD 256); + LslImm(r, 8); + AddImm8(r, LSR(imm32, 16) MOD 256); + LslImm(r, 8); + AddImm8(r, LSR(imm32, 8) MOD 256); + LslImm(r, 8); + AddImm8(r, imm32 MOD 256) +END MovImm32; + + +PROCEDURE low (x: INTEGER): INTEGER; + RETURN x MOD 65536 +END low; + + +PROCEDURE high (x: INTEGER): INTEGER; + RETURN (x DIV 65536) MOD 65536 +END high; + + +PROCEDURE movwt (r, imm16, t: INTEGER); +VAR + imm1, imm3, imm4, imm8: INTEGER; + +BEGIN + ASSERT(range(r, 3)); + ASSERT(range(imm16, 16)); + ASSERT(range(t, 1)); + split16(imm16, imm4, imm1, imm3, imm8); + Code(0F240H + imm1 * 1024 + t * 128 + imm4); + Code(imm3 * 4096 + r * 256 + imm8); +END movwt; + + +PROCEDURE inv0 (cond: INTEGER): INTEGER; + RETURN ORD(BITS(cond) / {0}) +END inv0; + + +PROCEDURE fixup (CodeAdr, DataAdr, BssAdr: INTEGER); +VAR + code: ANYCODE; + count: INTEGER; + shorted: BOOLEAN; + jump: JUMP; + + first, second: INTEGER; + + reloc, i, diff, len: INTEGER; + + RelocCode: RELOCCODE; + + + PROCEDURE genjcc (cond, offset: INTEGER): INTEGER; + BEGIN + ASSERT(range(cond, 4)); + ASSERT(srange(offset, 8)) + RETURN 0D000H + cond * 256 + offset MOD 256 + END genjcc; + + + PROCEDURE genjmp (offset: INTEGER): INTEGER; + BEGIN + ASSERT(srange(offset, 11)) + RETURN 0E000H + offset MOD 2048 + END genjmp; + + + PROCEDURE genlongjmp (offset: INTEGER; VAR first, second: INTEGER); + BEGIN + ASSERT(srange(offset, 22)); + first := 0F000H + ASR(offset, 11) MOD 2048; + second := 0F800H + offset MOD 2048 + END genlongjmp; + + + PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE); + VAR + imm1, imm3, imm4, imm8: INTEGER; + + BEGIN + split16(imm16, imm4, imm1, imm3, imm8); + code[t * 2] := 0F240H + imm1 * 1024 + t * 128 + imm4; + code[t * 2 + 1] := imm3 * 4096 + r * 256 + imm8 + END movwt; + + + PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE); + BEGIN + IF Target.InstrSet.thumb2 THEN + movwt(r, low(value), 0, code); + movwt(r, high(value), 1, code) + ELSE + code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* mov r, #imm8 *) + code[1] := 0200H + r * 9; (* lsl r, r, #8 *) + code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* add r, #imm8 *) + code[3] := code[1]; (* lsl r, r, #8 *) + code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* add r, #imm8 *) + code[5] := code[1]; (* lsl r, r, #8 *) + code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* add r, #imm8 *) + END + END genmovimm32; + + + PROCEDURE PutCode (code: INTEGER); + BEGIN + BIN.PutCode16LE(program, code) + END PutCode; + + + PROCEDURE genbc (code: JUMP); + VAR + first, second: INTEGER; + + BEGIN + CASE code.len OF + |1: PutCode(genjcc(code.cond, code.diff)) + |2: PutCode(genjcc(inv0(code.cond), 0)); + PutCode(genjmp(code.diff)) + |3: PutCode(genjcc(inv0(code.cond), 1)); + genlongjmp(code.diff, first, second); + PutCode(first); + PutCode(second) + END + END genbc; + + + PROCEDURE SetIV (idx, label, CodeAdr: INTEGER); + VAR + l, h: ANYCODE; + + BEGIN + l := CodeList.first(ANYCODE); + h := l.next(ANYCODE); + WHILE idx > 0 DO + l := h.next(ANYCODE); + h := l.next(ANYCODE); + DEC(idx) + END; + label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1; + l(CODE).code := low(label); + h(CODE).code := high(label) + END SetIV; + + +BEGIN + + REPEAT + + shorted := FALSE; + count := 0; + + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + code.offset := count; + + CASE code OF + |CODE: INC(count) + |LABEL: BIN.SetLabel(program, code.label, count) + |JUMP: INC(count, code.len); code.offset := count + ORD(code.short) + |RELOC: INC(count, 7 - ORD(Target.InstrSet.thumb2) * 3 + code.rel MOD 2) + END; + + code := code.next(ANYCODE) + END; + + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + + IF code IS JUMP THEN + jump := code(JUMP); + jump.diff := BIN.GetLabel(program, jump.label) - jump.offset; + len := jump.len; + diff := jump.diff; + CASE jump OF + |JMP: + IF (len = 2) & srange(diff, 11) THEN + len := 1 + END + + |JCC: + CASE len OF + |1: + |2: IF srange(diff, 8) THEN DEC(len) END + |3: IF srange(diff, 11) THEN DEC(len) END + END + + |CBXZ: + CASE len OF + |1: + |2: IF range(diff, 6) THEN DEC(len) END + |3: IF srange(diff, 8) THEN DEC(len) END + |4: IF srange(diff, 11) THEN DEC(len) END + END + + |CALL: + + END; + IF len # jump.len THEN + jump.len := len; + jump.short := TRUE; + shorted := TRUE + END + END; + + code := code.next(ANYCODE) + END + + UNTIL ~shorted; + + FOR i := 1 TO Target.IVTLen - 1 DO + SetIV(i, IVT[i], CodeAdr) + END; + + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + + CASE code OF + + |CODE: BIN.PutCode16LE(program, code.code) + + |LABEL: + + |JMP: + IF code.len = 1 THEN + PutCode(genjmp(code.diff)) + ELSE + genlongjmp(code.diff, first, second); + PutCode(first); + PutCode(second) + END + + |JCC: genbc(code) + + |CBXZ: + IF code.len > 1 THEN + PutCode(2800H + code.reg * 256); (* cmp code.reg, #0 *) + DEC(code.len); + genbc(code) + ELSE + (* cb(n)z code.reg, L *) + PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * ORD(code.diff >= 32) + (code.diff MOD 32) * 8 + code.reg) + END + + |CALL: + genlongjmp(code.diff, first, second); + PutCode(first); + PutCode(second) + + |RELOC: + CASE code.rel OF + |BIN.RCODE, BIN.PICCODE: reloc := BIN.GetLabel(program, code.value) * 2 + CodeAdr + |BIN.RDATA, BIN.PICDATA: reloc := code.value + DataAdr + |BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr + END; + IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN + DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(Target.InstrSet.thumb2) + 9)) + END; + genmovimm32(code.reg, reloc, RelocCode); + FOR i := 0 TO 6 - 3 * ORD(Target.InstrSet.thumb2) DO + PutCode(RelocCode[i]) + END; + IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN + PutCode(4478H + code.reg) (* add code.reg, PC *) + END + END; + + code := code.next(ANYCODE) + END + +END fixup; + + +PROCEDURE push (r: INTEGER); +BEGIN + gen14(FALSE, FALSE, {r}) +END push; + + +PROCEDURE pop (r: INTEGER); +BEGIN + gen14(TRUE, FALSE, {r}) +END pop; + + +PROCEDURE mov (r1, r2: INTEGER); +BEGIN + IF (r1 < 8) & (r2 < 8) THEN + gen1(0, 0, r2, r1) + ELSE + gen5(2, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) + END +END mov; + + +PROCEDURE xchg (r1, r2: INTEGER); +BEGIN + push(r1); push(r2); + pop(r1); pop(r2) +END xchg; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE UnOp (VAR r: INTEGER); +BEGIN + REG.UnOp(R, r) +END UnOp; + + +PROCEDURE BinOp (VAR r1, r2: INTEGER); +BEGIN + REG.BinOp(R, r1, r2) +END BinOp; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + DEC(R.pushed, NumberOfParameters) +END PushAll; + + +PROCEDURE cond (op: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE op OF + |IL.opGT, IL.opGTC: res := jg + |IL.opGE, IL.opGEC: res := jge + |IL.opLT, IL.opLTC: res := jl + |IL.opLE, IL.opLEC: res := jle + |IL.opEQ, IL.opEQC: res := je + |IL.opNE, IL.opNEC: res := jne + END + + RETURN res +END cond; + + +PROCEDURE GetRegA; +BEGIN + ASSERT(REG.GetReg(R, ACC)) +END GetRegA; + + +PROCEDURE MovConst (r, c: INTEGER); +BEGIN + IF (0 <= c) & (c <= 255) THEN + MovImm8(r, c) + ELSIF (-255 <= c) & (c < 0) THEN + MovImm8(r, -c); + Neg(r) + ELSIF UTILS.Log2(c) >= 0 THEN + MovImm8(r, 1); + LslImm(r, UTILS.Log2(c)) + ELSIF c = UTILS.min32 THEN + MovImm8(r, 1); + LslImm(r, 31) + ELSE + IF Target.InstrSet.thumb2 THEN + movwt(r, low(c), 0); + IF (c < 0) OR (c > 65535) THEN + movwt(r, high(c), 1) + END + ELSE + MovImm32(r, c) + END + END +END MovConst; + + +PROCEDURE CmpConst (r, c: INTEGER); +VAR + r2: INTEGER; + +BEGIN + IF (0 <= c) & (c <= 255) THEN + CmpImm8(r, c) + ELSE + r2 := GetAnyReg(); + ASSERT(r2 # r); + MovConst(r2, c); + Cmp(r, r2); + drop + END +END CmpConst; + + +PROCEDURE LocalOffset (offset: INTEGER): INTEGER; + RETURN offset + StkCount - ORD(offset > 0) +END LocalOffset; + + +PROCEDURE SetCC (cc, r: INTEGER); +VAR + L1, L2: INTEGER; + +BEGIN + IF Target.InstrSet.it THEN + Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *) + MovConst(r, 1); + MovConst(r, 0) + ELSE + L1 := NewLabel(); + L2 := NewLabel(); + jcc(cc, L1); + MovConst(r, 0); + jmp(L2); + Label(L1); + MovConst(r, 1); + Label(L2) + END +END SetCC; + + +PROCEDURE PushConst (n: INTEGER); +VAR + r: INTEGER; + +BEGIN + r := GetAnyReg(); + MovConst(r, n); + push(r); + drop +END PushConst; + + +PROCEDURE AddConst (r, n: INTEGER); +VAR + r2: INTEGER; + +BEGIN + IF n # 0 THEN + IF (-255 <= n) & (n <= 255) THEN + IF n > 0 THEN + AddImm8(r, n) + ELSE + SubImm8(r, -n) + END + ELSIF Target.InstrSet.thumb2 & (-4095 <= n) & (n <= 4095) THEN + IF n > 0 THEN + AddSubImm12(r, n, FALSE) + ELSE + AddSubImm12(r, -n, TRUE) + END + ELSE + r2 := GetAnyReg(); + ASSERT(r2 # r); + IF n > 0 THEN + MovConst(r2, n); + AddReg(r, r, r2) + ELSE + MovConst(r2, -n); + SubReg(r, r, r2) + END; + drop + END + END +END AddConst; + + +PROCEDURE AddHH (r1, r2: INTEGER); +BEGIN + ASSERT((r1 >= 8) OR (r2 >= 8)); + gen5(0, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) +END AddHH; + + +PROCEDURE AddSP (n: INTEGER); +BEGIN + IF n > 0 THEN + IF n < 127 THEN + Code(0B000H + n) (* add sp, n*4 *) + ELSE + ASSERT(R2 IN R.regs); + MovConst(R2, n * 4); + AddHH(SP, R2) + END; + DEC(StkCount, n) + END +END AddSP; + + +PROCEDURE cbz (r, label: INTEGER); +BEGIN + IF Target.InstrSet.cbxz THEN + cbxz(je, r, label) + ELSE + Tst(r); + jcc(je, label) + END +END cbz; + + +PROCEDURE cbnz (r, label: INTEGER); +BEGIN + IF Target.InstrSet.cbxz THEN + cbxz(jne, r, label) + ELSE + Tst(r); + jcc(jne, label) + END +END cbnz; + + +PROCEDURE Shift (op, r1, r2: INTEGER); +VAR + L: INTEGER; + +BEGIN + LslImm(r2, 27); + LsrImm(r2, 27); + L := NewLabel(); + cbz(r2, L); + CASE op OF + |IL.opLSL, IL.opLSL1: gen4(2, r2, r1) + |IL.opLSR, IL.opLSR1: gen4(3, r2, r1) + |IL.opASR, IL.opASR1: gen4(4, r2, r1) + |IL.opROR, IL.opROR1: gen4(7, r2, r1) + END; + Label(L) +END Shift; + + +PROCEDURE LocAdr (offs: INTEGER); +VAR + r1, n: INTEGER; + +BEGIN + r1 := GetAnyReg(); + n := LocalOffset(offs); + IF n <= 255 THEN + gen12(TRUE, r1, n) + ELSE + MovConst(r1, n * 4); + AddHH(r1, SP) + END +END LocAdr; + + +PROCEDURE CallRTL (proc, par: INTEGER); +BEGIN + call(IL.codes.rtl[proc]); + AddSP(par) +END CallRTL; + + +PROCEDURE divmod; +BEGIN + call(sdivProc); + AddSP(2) +END divmod; + + +PROCEDURE translate (pic, stroffs: INTEGER); +VAR + cmd, next: COMMAND; + opcode, param1, param2: INTEGER; + + r1, r2, r3: INTEGER; + + a, n, cc, L, L2: INTEGER; + +BEGIN + cmd := IL.codes.commands.first(COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + opcode := cmd.opcode; + + CASE opcode OF + + |IL.opJMP: + jmp(param1) + + |IL.opLABEL: + Label(param1) + + |IL.opHANDLER: + IF param2 = 0 THEN + int0 := param1 + ELSIF param2 = 1 THEN + trap := param1 + ELSE + IVT[param2] := param1 + END + + |IL.opCALL: + call(param1) + + |IL.opCALLP: + UnOp(r1); + AddImm8(r1, 1); + gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *) + drop; + ASSERT(R.top = -1) + + |IL.opENTER: + ASSERT(R.top = -1); + + Label(param1); + + gen14(FALSE, TRUE, {}); (* push LR *) + + n := param2; + IF n >= 5 THEN + MovConst(ACC, 0); + MovConst(R2, n); + L := NewLabel(); + Label(L); + push(ACC); + SubImm8(R2, 1); + Tst(R2); + jcc(jne, L) + ELSIF n > 0 THEN + MovConst(ACC, 0); + WHILE n > 0 DO + push(ACC); + DEC(n) + END + END; + StkCount := param2 + + |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: + IF opcode # IL.opLEAVE THEN + UnOp(r1); + IF r1 # ACC THEN + GetRegA; + ASSERT(REG.Exchange(R, r1, ACC)); + drop + END; + drop + END; + + ASSERT(R.top = -1); + ASSERT(StkCount = param1); + + AddSP(param1); + gen14(TRUE, TRUE, {}) (* pop PC *) + + |IL.opLEAVEC: + gen5(3, FALSE, TRUE, 6, 0) (* bx LR *) + + |IL.opPRECALL: + PushAll(0) + + |IL.opPARAM: + n := param2; + IF n = 1 THEN + UnOp(r1); + push(r1); + drop + ELSE + ASSERT(R.top + 1 <= n); + PushAll(n) + END + + |IL.opCLEANUP: + AddSP(param2) + + |IL.opRES, IL.opRESF: + ASSERT(R.top = -1); + GetRegA + + |IL.opPUSHC: + PushConst(param2) + + |IL.opONERR: + MovConst(R0, param2); + push(R0); + DEC(StkCount); + jmp(param1) + + |IL.opERR: + call(genTrap) + + |IL.opNOP: + + |IL.opSADR: + reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2) + + |IL.opGADR: + reloc(GetAnyReg(), BIN.RBSS + pic, param2) + + |IL.opLADR: + LocAdr(param2) + + |IL.opGLOAD32: + r1 := GetAnyReg(); + reloc(r1, BIN.RBSS + pic, param2); + Ldr32(r1, r1) + + |IL.opGLOAD16: + r1 := GetAnyReg(); + reloc(r1, BIN.RBSS + pic, param2); + Ldr16(r1, r1) + + |IL.opGLOAD8: + r1 := GetAnyReg(); + reloc(r1, BIN.RBSS + pic, param2); + Ldr8(r1, r1) + + |IL.opLLOAD32, IL.opVADR, IL.opVLOAD32: + r1 := GetAnyReg(); + n := LocalOffset(param2); + IF n <= 255 THEN + LdrSp(r1, n) + ELSE + drop; + LocAdr(param2); + UnOp(r1); + Ldr32(r1, r1) + END; + IF opcode = IL.opVLOAD32 THEN + Ldr32(r1, r1) + END + + |IL.opLLOAD16: + LocAdr(param2); + UnOp(r1); + Ldr16(r1, r1) + + |IL.opLLOAD8: + LocAdr(param2); + UnOp(r1); + Ldr8(r1, r1) + + |IL.opLOAD32, IL.opLOADF: + UnOp(r1); + Ldr32(r1, r1) + + |IL.opLOAD16: + UnOp(r1); + Ldr16(r1, r1) + + |IL.opLOAD8: + UnOp(r1); + Ldr8(r1, r1) + + |IL.opVLOAD16: + LocAdr(param2); + UnOp(r1); + Ldr32(r1, r1); + Ldr16(r1, r1) + + |IL.opVLOAD8: + LocAdr(param2); + UnOp(r1); + Ldr32(r1, r1); + Ldr8(r1, r1) + + |IL.opSBOOL: + BinOp(r2, r1); + Tst(r2); + SetCC(jne, r2); + Str8(r2, r1); + drop; + drop + + |IL.opSBOOLC: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, ORD(param2 # 0)); + Str8(r2, r1); + drop; + drop + + |IL.opSAVEC: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, param2); + Str32(r2, r1); + drop; + drop + + |IL.opSAVE16C: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, low(param2)); + Str16(r2, r1); + drop; + drop + + |IL.opSAVE8C: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, param2 MOD 256); + Str8(r2, r1); + drop; + drop + + |IL.opSAVE, IL.opSAVE32, IL.opSAVEF: + BinOp(r2, r1); + Str32(r2, r1); + drop; + drop + + |IL.opSAVEFI: + BinOp(r2, r1); + Str32(r1, r2); + drop; + drop + + |IL.opSAVE16: + BinOp(r2, r1); + Str16(r2, r1); + drop; + drop + + |IL.opSAVE8: + BinOp(r2, r1); + Str8(r2, r1); + drop; + drop + + |IL.opSAVEP: + UnOp(r1); + r2 := GetAnyReg(); + reloc(r2, BIN.RCODE + pic, param2); + Str32(r2, r1); + drop; + drop + + |IL.opPUSHP: + reloc(GetAnyReg(), BIN.RCODE + pic, param2) + + |IL.opEQB, IL.opNEB: + BinOp(r1, r2); + drop; + + L := NewLabel(); + cbz(r1, L); + MovConst(r1, 1); + Label(L); + + L := NewLabel(); + cbz(r2, L); + MovConst(r2, 1); + Label(L); + + Cmp(r1, r2); + IF opcode = IL.opEQB THEN + SetCC(je, r1) + ELSE + SetCC(jne, r1) + END + + |IL.opACC: + IF (R.top # 0) OR (R.stk[0] # ACC) THEN + PushAll(0); + GetRegA; + pop(ACC); + DEC(R.pushed) + END + + |IL.opDROP: + UnOp(r1); + drop + + |IL.opJNZ: + UnOp(r1); + cbnz(r1, param1) + + |IL.opJZ: + UnOp(r1); + cbz(r1, param1) + + |IL.opJG: + UnOp(r1); + Tst(r1); + jcc(jg, param1) + + |IL.opJE: + UnOp(r1); + cbnz(r1, param1); + drop + + |IL.opJNE: + UnOp(r1); + cbz(r1, param1); + drop + + |IL.opSWITCH: + UnOp(r1); + IF param2 = 0 THEN + r2 := ACC + ELSE + r2 := R2 + END; + IF r1 # r2 THEN + ASSERT(REG.GetReg(R, r2)); + ASSERT(REG.Exchange(R, r1, r2)); + drop + END; + drop + + |IL.opENDSW: + + |IL.opCASEL: + GetRegA; + CmpConst(ACC, param1); + jcc(jl, param2); + drop + + |IL.opCASER: + GetRegA; + CmpConst(ACC, param1); + jcc(jg, param2); + drop + + |IL.opCASELR: + GetRegA; + CmpConst(ACC, param1); + jcc(jl, param2); + jcc(jg, cmd.param3); + drop + + |IL.opCODE: + Code(param2) + + |IL.opEQ..IL.opGE, + IL.opEQC..IL.opGEC: + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(r1, r2); + Cmp(r1, r2); + drop + ELSE + UnOp(r1); + CmpConst(r1, param2) + END; + + drop; + cc := cond(opcode); + next := cmd.next(COMMAND); + + IF next.opcode = IL.opJE THEN + jcc(cc, next.param1); + cmd := next + ELSIF next.opcode = IL.opJNE THEN + jcc(inv0(cc), next.param1); + cmd := next + ELSE + SetCC(cc, GetAnyReg()) + END + + |IL.opINCC: + UnOp(r1); + r2 := GetAnyReg(); + Ldr32(r2, r1); + AddConst(r2, param2); + Str32(r2, r1); + drop; + drop + + |IL.opINCCB, IL.opDECCB: + IF opcode = IL.opDECCB THEN + param2 := -param2 + END; + UnOp(r1); + r2 := GetAnyReg(); + Ldr8(r2, r1); + AddConst(r2, param2); + Str8(r2, r1); + drop; + drop + + |IL.opUMINUS: + UnOp(r1); + Neg(r1) + + |IL.opADD: + BinOp(r1, r2); + CASE cmd.next(COMMAND).opcode OF + |IL.opLOAD32, IL.opLOADF: + gen7(TRUE, FALSE, r2, r1, r1); (* ldr r1, [r1, r2] *) + cmd := cmd.next(COMMAND) + |IL.opLOAD8: + gen7(TRUE, TRUE, r2, r1, r1); (* ldrb r1, [r1, r2] *) + cmd := cmd.next(COMMAND) + |IL.opLOAD16: + gen8(TRUE, FALSE, r2, r1, r1); (* ldrh r1, [r1, r2] *) + cmd := cmd.next(COMMAND) + ELSE + AddReg(r1, r1, r2) + END; + drop + + |IL.opADDL, IL.opADDR: + UnOp(r1); + AddConst(r1, param2) + + |IL.opSUB: + BinOp(r1, r2); + SubReg(r1, r1, r2); + drop + + |IL.opSUBL, IL.opSUBR: + UnOp(r1); + AddConst(r1, -param2); + IF opcode = IL.opSUBL THEN + Neg(r1) + END + + |IL.opMUL: + BinOp(r1, r2); + Mul(r1, r2); + drop + + |IL.opMULC: + UnOp(r1); + + a := param2; + IF a > 1 THEN + n := UTILS.Log2(a) + ELSIF a < -1 THEN + n := UTILS.Log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + Neg(r1) + ELSIF a = 0 THEN + MovConst(r1, 0) + ELSE + IF n > 0 THEN + IF a < 0 THEN + Neg(r1) + END; + LslImm(r1, n) + ELSE + r2 := GetAnyReg(); + MovConst(r2, a); + Mul(r1, r2); + drop + END + END + + |IL.opABS: + UnOp(r1); + Tst(r1); + L := NewLabel(); + jcc(jge, L); + Neg(r1); + Label(L) + + |IL.opNOT: + UnOp(r1); + Tst(r1); + SetCC(je, r1) + + |IL.opORD: + UnOp(r1); + Tst(r1); + SetCC(jne, r1) + + |IL.opCHR: + UnOp(r1); + Code(0B2C0H + r1 * 9) (* uxtb r1 *) + + |IL.opWCHR: + UnOp(r1); + Code(0B280H + r1 * 9) (* uxth r1 *) + + |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: + BinOp(r1, r2); + Shift(opcode, r1, r2); + drop + + |IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: + MovConst(GetAnyReg(), param2); + BinOp(r2, r1); + Shift(opcode, r1, r2); + INCL(R.regs, r2); + DEC(R.top); + R.stk[R.top] := r1 + + |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: + n := param2 MOD 32; + IF n # 0 THEN + UnOp(r1); + CASE opcode OF + |IL.opASR2: AsrImm(r1, n) + |IL.opROR2: r2 := GetAnyReg(); MovConst(r2, n); Shift(IL.opROR, r1, r2); drop + |IL.opLSL2: LslImm(r1, n) + |IL.opLSR2: LsrImm(r1, n) + END + END + + |IL.opCHKBYTE: + BinOp(r1, r2); + CmpConst(r1, 256); + jcc(jb, param1) + + |IL.opCHKIDX: + UnOp(r1); + CmpConst(r1, param2); + jcc(jb, param1) + + |IL.opCHKIDX2: + BinOp(r1, r2); + IF param2 # -1 THEN + Cmp(r2, r1); + jcc(jb, param1) + END; + INCL(R.regs, r1); + DEC(R.top); + R.stk[R.top] := r2 + + |IL.opLEN: + n := param2; + UnOp(r1); + drop; + EXCL(R.regs, r1); + + WHILE n > 0 DO + UnOp(r2); + drop; + DEC(n) + END; + + INCL(R.regs, r1); + ASSERT(REG.GetReg(R, r1)) + + |IL.opLOOP, IL.opENDLOOP: + + |IL.opINF: + MovConst(GetAnyReg(), inf) + + |IL.opPUSHF: + UnOp(r1); + push(r1); + drop + + |IL.opCONST: + MovConst(GetAnyReg(), param2) + + |IL.opEQP, IL.opNEP: + reloc(GetAnyReg(), BIN.RCODE + pic, param1); + BinOp(r1, r2); + Cmp(r1, r2); + drop; + IF opcode = IL.opEQP THEN + SetCC(je, r1) + ELSE + SetCC(jne, r1) + END + + |IL.opPUSHT: + UnOp(r1); + r2 := GetAnyReg(); + mov(r2, r1); + SubImm8(r2, 4); + Ldr32(r2, r2) + + |IL.opGET, IL.opGETC: + IF opcode = IL.opGET THEN + BinOp(r1, r2) + ELSIF opcode = IL.opGETC THEN + UnOp(r2); + r1 := GetAnyReg(); + MovConst(r1, param1) + END; + drop; + drop; + + CASE param2 OF + |1: Ldr8(r1, r1); Str8(r1, r2) + |2: Ldr16(r1, r1); Str16(r1, r2) + |4: Ldr32(r1, r1); Str32(r1, r2) + END + + |IL.opINC, IL.opDEC: + BinOp(r2, r1); + r3 := GetAnyReg(); + Ldr32(r3, r1); + IF opcode = IL.opINC THEN + AddReg(r3, r3, r2) + ELSE + SubReg(r3, r3, r2) + END; + Str32(r3, r1); + drop; + drop; + drop + + |IL.opINCB, IL.opDECB: + BinOp(r2, r1); + r3 := GetAnyReg(); + Ldr8(r3, r1); + IF opcode = IL.opINCB THEN + AddReg(r3, r3, r2) + ELSE + SubReg(r3, r3, r2) + END; + Str8(r3, r1); + drop; + drop; + drop + + |IL.opMIN, IL.opMAX: + BinOp(r1, r2); + Cmp(r1, r2); + L := NewLabel(); + IF opcode = IL.opMIN THEN + cc := jle + ELSE + cc := jge + END; + jcc(cc, L); + mov(r1, r2); + Label(L); + drop + + |IL.opMINC, IL.opMAXC: + UnOp(r1); + CmpConst(r1, param2); + L := NewLabel(); + IF opcode = IL.opMINC THEN + cc := jle + ELSE + cc := jge + END; + jcc(cc, L); + MovConst(r1, param2); + Label(L) + + |IL.opMULS: + BinOp(r1, r2); + gen4(0, r2, r1); (* and r1, r2 *) + drop + + |IL.opMULSC: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(0, r2, r1); (* and r1, r2 *) + drop + + |IL.opDIVS: + BinOp(r1, r2); + gen4(1, r2, r1); (* eor r1, r2 *) + drop + + |IL.opDIVSC: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(1, r2, r1); (* eor r1, r2 *) + drop + + |IL.opADDS: + BinOp(r1, r2); + gen4(12, r2, r1); (* orr r1, r2 *) + drop + + |IL.opSUBS: + BinOp(r1, r2); + gen4(14, r2, r1); (* bic r1, r2 *) + drop + + |IL.opADDSL, IL.opADDSR: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(12, r2, r1); (* orr r1, r2 *) + drop + + |IL.opSUBSL: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(14, r1, r2); (* bic r2, r1 *) + INCL(R.regs, r1); + DEC(R.top); + R.stk[R.top] := r2 + + |IL.opSUBSR: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(14, r2, r1); (* bic r1, r2 *) + drop + + |IL.opUMINS: + UnOp(r1); + gen4(15, r1, r1) (* mvn r1, r1 *) + + |IL.opINCL, IL.opEXCL: + BinOp(r1, r2); + r3 := GetAnyReg(); + MovConst(r3, 1); + CmpConst(r1, 32); + L := NewLabel(); + jcc(jnb, L); + gen4(2, r1, r3); (* lsl r3, r1 *) + Ldr32(r1, r2); + IF opcode = IL.opINCL THEN + gen4(12, r3, r1) (* orr r1, r3 *) + ELSE + gen4(14, r3, r1) (* bic r1, r3 *) + END; + Str32(r1, r2); + Label(L); + drop; + drop; + drop + + |IL.opINCLC, IL.opEXCLC: + UnOp(r2); + r1 := GetAnyReg(); + r3 := GetAnyReg(); + MovConst(r3, 1); + LslImm(r3, param2); + Ldr32(r1, r2); + IF opcode = IL.opINCLC THEN + gen4(12, r3, r1) (* orr r1, r3 *) + ELSE + gen4(14, r3, r1) (* bic r1, r3 *) + END; + Str32(r1, r2); + drop; + drop; + drop + + |IL.opLENGTH: + PushAll(2); + CallRTL(IL._length, 2); + GetRegA + + |IL.opLENGTHW: + PushAll(2); + CallRTL(IL._lengthw, 2); + GetRegA + + |IL.opSAVES: + UnOp(r2); + REG.PushAll_1(R); + r1 := GetAnyReg(); + reloc(r1, BIN.RDATA + pic, stroffs + param2); + push(r1); + drop; + push(r2); + drop; + PushConst(param1); + CallRTL(IL._move, 3) + + |IL.opEQS .. IL.opGES: + PushAll(4); + PushConst(opcode - IL.opEQS); + CallRTL(IL._strcmp, 5); + GetRegA + + |IL.opEQSW .. IL.opGESW: + PushAll(4); + PushConst(opcode - IL.opEQSW); + CallRTL(IL._strcmpw, 5); + GetRegA + + |IL.opCOPY: + PushAll(2); + PushConst(param2); + CallRTL(IL._move, 3) + + |IL.opMOVE: + PushAll(3); + CallRTL(IL._move, 3) + + |IL.opCOPYA: + PushAll(4); + PushConst(param2); + CallRTL(IL._arrcpy, 5); + GetRegA + + |IL.opCOPYS: + PushAll(4); + PushConst(param2); + CallRTL(IL._strcpy, 5) + + |IL.opDIV: + PushAll(2); + divmod; + GetRegA + + |IL.opDIVL: + UnOp(r1); + REG.PushAll_1(R); + PushConst(param2); + push(r1); + drop; + divmod; + GetRegA + + |IL.opDIVR: + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(r1); + AsrImm(r1, n) + ELSIF n < 0 THEN + PushAll(1); + PushConst(param2); + divmod; + GetRegA + END + + |IL.opMOD: + PushAll(2); + divmod; + mov(R0, R1); + GetRegA + + |IL.opMODR: + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(r1); + IF n = 8 THEN + Code(0B2C0H + r1 * 9) (* uxtb r1 *) + ELSIF n = 16 THEN + Code(0B280H + r1 * 9) (* uxth r1 *) + ELSE + LslImm(r1, 32 - n); + LsrImm(r1, 32 - n) + END + ELSIF n < 0 THEN + PushAll(1); + PushConst(param2); + divmod; + mov(R0, R1); + GetRegA + ELSE + UnOp(r1); + MovConst(r1, 0) + END + + |IL.opMODL: + UnOp(r1); + REG.PushAll_1(R); + PushConst(param2); + push(r1); + drop; + divmod; + mov(R0, R1); + GetRegA + + |IL.opIN, IL.opINR: + IF opcode = IL.opINR THEN + r2 := GetAnyReg(); + MovConst(r2, param2) + END; + L := NewLabel(); + L2 := NewLabel(); + BinOp(r1, r2); + r3 := GetAnyReg(); + CmpConst(r1, 32); + jcc(jb, L); + MovConst(r1, 0); + jmp(L2); + Label(L); + MovConst(r3, 1); + Shift(IL.opLSL, r3, r1); + gen4(0, r3, r2); (* and r2, r3 *) + SetCC(jne, r1); + Label(L2); + drop; + drop + + |IL.opINL: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, LSL(1, param2)); + gen4(0, r2, r1); (* and r1, r2 *) + SetCC(jne, r1); + drop + + |IL.opRSET: + PushAll(2); + CallRTL(IL._set, 2); + GetRegA + + |IL.opRSETR: + PushAll(1); + PushConst(param2); + CallRTL(IL._set, 2); + GetRegA + + |IL.opRSETL: + UnOp(r1); + REG.PushAll_1(R); + PushConst(param2); + push(r1); + drop; + CallRTL(IL._set, 2); + GetRegA + + |IL.opRSET1: + PushAll(1); + CallRTL(IL._set1, 1); + GetRegA + + |IL.opCONSTF: + MovConst(GetAnyReg(), UTILS.d2s(cmd.float)) + + |IL.opMULF: + PushAll(2); + CallRTL(IL._fmul, 2); + GetRegA + + |IL.opDIVF: + PushAll(2); + CallRTL(IL._fdiv, 2); + GetRegA + + |IL.opDIVFI: + PushAll(2); + CallRTL(IL._fdivi, 2); + GetRegA + + |IL.opADDF, IL.opADDFI: + PushAll(2); + CallRTL(IL._fadd, 2); + GetRegA + + |IL.opSUBFI: + PushAll(2); + CallRTL(IL._fsubi, 2); + GetRegA + + |IL.opSUBF: + PushAll(2); + CallRTL(IL._fsub, 2); + GetRegA + + |IL.opEQF..IL.opGEF: + PushAll(2); + PushConst(opcode - IL.opEQF); + CallRTL(IL._fcmp, 3); + GetRegA + + |IL.opFLOOR: + PushAll(1); + CallRTL(IL._floor, 1); + GetRegA + + |IL.opFLT: + PushAll(1); + CallRTL(IL._flt, 1); + GetRegA + + |IL.opUMINF: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, 1); + LslImm(r2, 31); + gen4(1, r2, r1); (* eor r1, r2 *) + drop + + |IL.opFABS: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, 1); + LslImm(r2, 31); + gen4(14, r2, r1); (* bic r1, r2 *) + drop + + |IL.opNEW: + PushAll(1); + n := param2 + 8; + ASSERT(UTILS.Align(n, 32)); + PushConst(n); + PushConst(param1); + CallRTL(IL._new, 3) + + |IL.opTYPEGP: + UnOp(r1); + PushAll(0); + push(r1); + PushConst(param2); + CallRTL(IL._guard, 2); + GetRegA + + |IL.opIS: + PushAll(1); + PushConst(param2); + CallRTL(IL._is, 2); + GetRegA + + |IL.opISREC: + PushAll(2); + PushConst(param2); + CallRTL(IL._guardrec, 3); + GetRegA + + |IL.opTYPEGR: + PushAll(1); + PushConst(param2); + CallRTL(IL._guardrec, 2); + GetRegA + + |IL.opTYPEGD: + UnOp(r1); + PushAll(0); + SubImm8(r1, 4); + Ldr32(r1, r1); + push(r1); + PushConst(param2); + CallRTL(IL._guardrec, 2); + GetRegA + + |IL.opCASET: + push(R2); + push(R2); + PushConst(param2); + CallRTL(IL._guardrec, 2); + pop(R2); + cbnz(ACC, param1) + + |IL.opROT: + PushAll(0); + mov(R2, SP); + push(R2); + PushConst(param2); + CallRTL(IL._rot, 2) + + |IL.opPACK: + PushAll(2); + CallRTL(IL._pack, 2) + + |IL.opPACKC: + PushAll(1); + PushConst(param2); + CallRTL(IL._pack, 2) + + |IL.opUNPK: + PushAll(2); + CallRTL(IL._unpk, 2) + + END; + + cmd := cmd.next(COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog (GlobSize, tcount, pic, FlashAdr, sp, ivt_len: INTEGER); +VAR + r1, r2, i, dcount: INTEGER; + +BEGIN + entry := NewLabel(); + emptyProc := NewLabel(); + genInt := NewLabel(); + genTrap := NewLabel(); + sdivProc := NewLabel(); + + trap := emptyProc; + int0 := emptyProc; + + IVT[0] := sp; + IVT[1] := entry; + FOR i := 2 TO ivt_len - 1 DO + IVT[i] := genInt + END; + + FOR i := 0 TO ivt_len - 1 DO + Code(low(IVT[i])); + Code(high(IVT[i])) + END; + + Label(entry); + + r1 := GetAnyReg(); + r2 := GetAnyReg(); + reloc(r1, BIN.RDATA + pic, 0); + + FOR i := 0 TO tcount - 1 DO + MovConst(r2, CHL.GetInt(IL.codes.types, i)); + Str32(r2, r1); + AddImm8(r1, 4) + END; + + dcount := CHL.Length(IL.codes.data); + FOR i := 0 TO dcount - 1 BY 4 DO + MovConst(r2, BIN.get32le(IL.codes.data, i)); + Str32(r2, r1); + AddImm8(r1, 4) + END; + + drop; + drop; + + r1 := GetAnyReg(); + MovConst(r1, sp); + mov(SP, r1); + reloc(r1, BIN.RDATA + pic, 0); + push(r1); + reloc(r1, BIN.RBSS + pic, 0); + r2 := GetAnyReg(); + MovConst(r2, GlobSize); + AddReg(r1, r1, r2); + drop; + push(r1); + drop; + PushConst(tcount); + CallRTL(IL._init, 3) +END prolog; + + +PROCEDURE epilog; +VAR + L1, L2, L3, L4: INTEGER; + +BEGIN + Code(0BF30H); (* L2: wfi *) + Code(0E7FDH); (* b L2 *) + + Label(genInt); + Code(0F3EFH); Code(08105H); (* mrs r1, ipsr *) + gen14(FALSE, TRUE, {R1}); (* push {LR, R1} *) + call(int0); + gen14(TRUE, TRUE, {R1}); (* pop {PC, R1} *) + + Label(emptyProc); + Code(04770H); (* bx lr *) + + Label(genTrap); + call(trap); + call(entry); + + Label(sdivProc); + IF Target.InstrSet.sdiv THEN + Code(09800H); (* ldr r0, [sp + #0] *) + Code(09901H); (* ldr r1, [sp + #4] *) + Code(0FB91H); (* sdiv r2, r1, r0 *) + Code(0F2F0H); + Code(00013H); (* mov r3, r2 *) + Code(04343H); (* mul r3, r0 *) + Code(01AC9H); (* sub r1, r3 *) + Code(0DA01H); (* bge L *) + Code(04401H); (* add r1, r0 *) + Code(03A01H); (* sub r2, #1 *) + (* L: *) + Code(00010H); (* mov r0, r2 *) + Code(04770H); (* bx lr *) + ELSE + (* a / b; a >= 0 *) + L1 := NewLabel(); + L2 := NewLabel(); + L3 := NewLabel(); + L4 := NewLabel(); + + LdrSp(R1, 1); + LdrSp(R2, 0); + MovConst(R0, 0); + push(R4); + + Label(L4); + Cmp(R1, R2); + jcc(jl, L1); + MovConst(R3, 2); + mov(R4, R2); + LslImm(R4, 1); + Label(L3); + Cmp(R1, R4); + jcc(jl, L2); + CmpConst(R4, 0); + jcc(jle, L2); + LslImm(R4, 1); + LslImm(R3, 1); + jmp(L3); + Label(L2); + LsrImm(R4, 1); + LsrImm(R3, 1); + SubReg(R1, R1, R4); + AddReg(R0, R0, R3); + jmp(L4); + Label(L1); + + (* a / b; a < 0 *) + L1 := NewLabel(); + L2 := NewLabel(); + L3 := NewLabel(); + L4 := NewLabel(); + + Label(L4); + CmpConst(R1, 0); + jcc(jge, L1); + MovConst(R3, 2); + mov(R4, R2); + LslImm(R4, 1); + Neg(R1); + Label(L3); + Cmp(R1, R4); + jcc(jl, L2); + CmpConst(R4, 0); + jcc(jle, L2); + LslImm(R4, 1); + LslImm(R3, 1); + jmp(L3); + Label(L2); + Neg(R1); + LsrImm(R4, 1); + LsrImm(R3, 1); + AddReg(R1, R1, R4); + SubReg(R0, R0, R3); + jmp(L4); + Label(L1); + + pop(R4); + Code(04770H); (* bx lr *) + END + +END epilog; + + +PROCEDURE CortexM3; +BEGIN + Target.FlashAdr := 08000000H; + Target.SRAMAdr := 20000000H; + Target.IVTLen := 256; + Target.Reserved := 0; + Target.MinStack := 512; + Target.InstrSet.thumb2 := TRUE; + Target.InstrSet.it := TRUE; + Target.InstrSet.sdiv := TRUE; + Target.InstrSet.cbxz := TRUE +END CortexM3; + + +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +VAR + opt: PROG.OPTIONS; + + ram, rom: INTEGER; + + DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER; + + File: WR.FILE; + +BEGIN + IF target = TARGETS.STM32CM3 THEN + CortexM3 + END; + + ram := MIN(MAX(options.ram, STM32_minRAM), STM32_maxRAM) * 1024; + rom := MIN(MAX(options.rom, STM32_minROM), STM32_maxROM) * 1024; + + tcount := CHL.Length(IL.codes.types); + + opt := options; + CodeList := LISTS.create(NIL); + + program := BIN.create(IL.codes.lcount); + + REG.Init(R, push, pop, mov, xchg, NIL, NIL, {R0, R1, R2, R3}, {}); + + StkCount := 0; + + DataAdr := Target.SRAMAdr + Target.Reserved; + DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved; + WHILE DataSize MOD 4 # 0 DO + CHL.PushByte(IL.codes.data, 0); + INC(DataSize) + END; + BssAdr := DataAdr + DataSize - Target.Reserved; + + IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); + + BssSize := IL.codes.bss; + ASSERT(UTILS.Align(BssSize, 4)); + + prolog(BssSize, tcount, ORD(opt.pic), Target.FlashAdr, Target.SRAMAdr + ram, Target.IVTLen); + translate(ORD(opt.pic), tcount * 4); + epilog; + + fixup(Target.FlashAdr, DataAdr, BssAdr); + + INC(DataSize, BssSize); + CodeSize := CHL.Length(program.code); + + IF CodeSize > rom THEN + ERRORS.Error(203) + END; + + IF DataSize > ram - Target.MinStack THEN + ERRORS.Error(204) + END; + + File := WR.Create(outname); + + HEX.Data2(File, program.code, 0, CodeSize, high(Target.FlashAdr)); + HEX.End(File); + + WR.Close(File); + + C.StringLn("--------------------------------------------"); + C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)"); + C.Ln; + C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)") + +END CodeGen; + + +PROCEDURE SetIV* (idx: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := IVT[idx] = 0; + IVT[idx] := 1 + + RETURN res +END SetIV; + + +PROCEDURE init; +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO LEN(IVT) - 1 DO + IVT[i] := 0 + END +END init; + + +BEGIN + init +END THUMB. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/UTILS.ob07 b/programs/develop/oberon07/Source/UTILS.ob07 index e64b440ec0..81c04ceaf4 100644 --- a/programs/develop/oberon07/Source/UTILS.ob07 +++ b/programs/develop/oberon07/Source/UTILS.ob07 @@ -1,7 +1,7 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -23,6 +23,14 @@ CONST min32* = -2147483647-1; max32* = 2147483647; + vMajor* = 1; + vMinor* = 29; + + FILE_EXT* = ".ob07"; + RTL_NAME* = "RTL"; + + MAX_GLOBAL_SIZE* = 1600000000; + TYPE @@ -110,6 +118,11 @@ PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; END splitf; +PROCEDURE d2s* (x: REAL): INTEGER; + RETURN HOST.d2s(x) +END d2s; + + PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; RETURN HOST.isRelative(path) END isRelative; @@ -143,7 +156,7 @@ BEGIN END UnixTime; -PROCEDURE SetBitDepth* (BitDepth: INTEGER); +PROCEDURE SetBitDepth* (BitDepth: INTEGER; Double: BOOLEAN); BEGIN ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64)); bit_diff := bit_depth - BitDepth; @@ -154,8 +167,13 @@ BEGIN 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); + + IF Double THEN + target.maxReal := maxreal + ELSE + target.maxReal := 1.9; + PACK(target.maxReal, 127) + END END SetBitDepth; @@ -197,8 +215,6 @@ VAR n: INTEGER; BEGIN - ASSERT(x > 0); - n := 0; WHILE ~ODD(x) DO x := x DIV 2; @@ -258,7 +274,6 @@ END init; BEGIN time := GetTickCount(); COPY(HOST.eol, eol); - maxreal := 1.9; - PACK(maxreal, 1023); + maxreal := HOST.maxreal; init(days) -END UTILS. +END UTILS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/WRITER.ob07 b/programs/develop/oberon07/Source/WRITER.ob07 index 985f9ddaa6..58329005f2 100644 --- a/programs/develop/oberon07/Source/WRITER.ob07 +++ b/programs/develop/oberon07/Source/WRITER.ob07 @@ -1,4 +1,4 @@ -(* +(* BSD 2-Clause License Copyright (c) 2018-2019, Anton Krotov @@ -108,4 +108,4 @@ BEGIN END Close; -END WRITER. +END WRITER. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/X86.ob07 b/programs/develop/oberon07/Source/X86.ob07 index af8fa42205..47cc4ae62a 100644 --- a/programs/develop/oberon07/Source/X86.ob07 +++ b/programs/develop/oberon07/Source/X86.ob07 @@ -1,14 +1,14 @@ -(* +(* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) MODULE X86; IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG, - mConst := CONSTANTS, CHL := CHUNKLISTS, PATHS; + CHL := CHUNKLISTS, PATHS, TARGETS; CONST @@ -93,16 +93,6 @@ VAR tcount: INTEGER; -PROCEDURE Byte (n: INTEGER): BYTE; - RETURN UTILS.Byte(n, 0) -END Byte; - - -PROCEDURE Word (n: INTEGER): INTEGER; - RETURN UTILS.Byte(n, 0) + UTILS.Byte(n, 1) * 256 -END Word; - - PROCEDURE OutByte* (n: BYTE); VAR c: CODE; @@ -127,7 +117,7 @@ END OutByte; PROCEDURE OutInt (n: INTEGER); BEGIN - OutByte(UTILS.Byte(n, 0)); + OutByte(n MOD 256); OutByte(UTILS.Byte(n, 1)); OutByte(UTILS.Byte(n, 2)); OutByte(UTILS.Byte(n, 3)) @@ -174,7 +164,7 @@ END long; PROCEDURE OutIntByte (n: INTEGER); BEGIN IF isByte(n) THEN - OutByte(Byte(n)) + OutByte(n MOD 256) ELSE OutInt(n) END @@ -194,7 +184,7 @@ END shift; PROCEDURE mov (reg1, reg2: INTEGER); BEGIN - OutByte2(89H, 0C0H + reg2 * 8 + reg1) // mov reg1, reg2 + OutByte2(89H, 0C0H + reg2 * 8 + reg1) (* mov reg1, reg2 *) END mov; @@ -205,118 +195,128 @@ VAR BEGIN regs := {reg1, reg2}; IF regs = {eax, ecx} THEN - OutByte(91H) // xchg eax, ecx + OutByte(91H) (* xchg eax, ecx *) ELSIF regs = {eax, edx} THEN - OutByte(92H) // xchg eax, edx + OutByte(92H) (* xchg eax, edx *) ELSIF regs = {ecx, edx} THEN - OutByte2(87H, 0D1H) // xchg ecx, edx + OutByte2(87H, 0D1H) (* xchg ecx, edx *) END END xchg; PROCEDURE pop (reg: INTEGER); BEGIN - OutByte(58H + reg) // pop reg + OutByte(58H + reg) (* pop reg *) END pop; PROCEDURE push (reg: INTEGER); BEGIN - OutByte(50H + reg) // push reg + OutByte(50H + reg) (* push reg *) END push; PROCEDURE movrc (reg, n: INTEGER); BEGIN - OutByte(0B8H + reg); // mov reg, n + OutByte(0B8H + reg); (* mov reg, n *) OutInt(n) END movrc; PROCEDURE pushc (n: INTEGER); BEGIN - OutByte(68H + short(n)); // push n + OutByte(68H + short(n)); (* push n *) OutIntByte(n) END pushc; PROCEDURE test (reg: INTEGER); BEGIN - OutByte2(85H, 0C0H + reg * 9) // test reg, reg + OutByte2(85H, 0C0H + reg * 9) (* test reg, reg *) END test; PROCEDURE neg (reg: INTEGER); BEGIN - OutByte2(0F7H, 0D8H + reg) // neg reg + OutByte2(0F7H, 0D8H + reg) (* neg reg *) END neg; PROCEDURE not (reg: INTEGER); BEGIN - OutByte2(0F7H, 0D0H + reg) // not reg + OutByte2(0F7H, 0D0H + reg) (* not reg *) END not; PROCEDURE add (reg1, reg2: INTEGER); BEGIN - OutByte2(01H, 0C0H + reg2 * 8 + reg1) // add reg1, reg2 + OutByte2(01H, 0C0H + reg2 * 8 + reg1) (* add reg1, reg2 *) END add; PROCEDURE andrc (reg, n: INTEGER); BEGIN - OutByte2(81H + short(n), 0E0H + reg); // and reg, n + OutByte2(81H + short(n), 0E0H + reg); (* and reg, n *) OutIntByte(n) END andrc; PROCEDURE orrc (reg, n: INTEGER); BEGIN - OutByte2(81H + short(n), 0C8H + reg); // or reg, n + OutByte2(81H + short(n), 0C8H + reg); (* or reg, n *) OutIntByte(n) END orrc; PROCEDURE addrc (reg, n: INTEGER); BEGIN - OutByte2(81H + short(n), 0C0H + reg); // add reg, n + OutByte2(81H + short(n), 0C0H + reg); (* add reg, n *) OutIntByte(n) END addrc; PROCEDURE subrc (reg, n: INTEGER); BEGIN - OutByte2(81H + short(n), 0E8H + reg); // sub reg, n + OutByte2(81H + short(n), 0E8H + reg); (* sub reg, n *) OutIntByte(n) END subrc; PROCEDURE cmprr (reg1, reg2: INTEGER); BEGIN - OutByte2(39H, 0C0H + reg2 * 8 + reg1) // cmp reg1, reg2 + OutByte2(39H, 0C0H + reg2 * 8 + reg1) (* cmp reg1, reg2 *) END cmprr; PROCEDURE cmprc (reg, n: INTEGER); BEGIN - OutByte2(81H + short(n), 0F8H + reg); // cmp reg, n - OutIntByte(n) + IF n = 0 THEN + test(reg) + ELSE + OutByte2(81H + short(n), 0F8H + reg); (* cmp reg, n *) + OutIntByte(n) + END END cmprc; PROCEDURE setcc (cond, reg: INTEGER); BEGIN - OutByte3(0FH, cond, 0C0H + reg) // setcc reg + OutByte3(0FH, cond, 0C0H + reg) (* setcc reg *) END setcc; PROCEDURE xor (reg1, reg2: INTEGER); BEGIN - OutByte2(31H, 0C0H + reg2 * 8 + reg1) // xor reg1, reg2 + OutByte2(31H, 0C0H + reg2 * 8 + reg1) (* xor reg1, reg2 *) END xor; +PROCEDURE ret*; +BEGIN + OutByte(0C3H) +END ret; + + PROCEDURE drop; BEGIN REG.Drop(R) @@ -402,10 +402,10 @@ END call; PROCEDURE Pic (reg, opcode, value: INTEGER); BEGIN - OutByte(0E8H); OutInt(0); // call L - // L: + OutByte(0E8H); OutInt(0); (* call L + L: *) pop(reg); - OutByte2(081H, 0C0H + reg); // add reg, ... + OutByte2(081H, 0C0H + reg); (* add reg, ... *) Reloc(opcode, value) END Pic; @@ -423,10 +423,10 @@ BEGIN IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICIMP, label); - OutByte2(0FFH, 010H + reg1); // call dword[reg1] + OutByte2(0FFH, 010H + reg1); (* call dword[reg1] *) drop ELSE - OutByte2(0FFH, 015H); // call dword[label] + OutByte2(0FFH, 015H); (* call dword[label] *) Reloc(BIN.RIMP, label) END ELSE @@ -504,12 +504,11 @@ BEGIN END |LABEL: - BIN.SetLabel(program, code.label, code.offset) |JMP: IF code.short THEN BIN.PutCode(program, 0EBH); - BIN.PutCode(program, Byte(code.diff)) + BIN.PutCode(program, code.diff MOD 256) ELSE BIN.PutCode(program, 0E9H); BIN.PutCode32LE(program, code.diff) @@ -518,7 +517,7 @@ BEGIN |JCC: IF code.short THEN BIN.PutCode(program, code.jmp - 16); - BIN.PutCode(program, Byte(code.diff)) + BIN.PutCode(program, code.diff MOD 256) ELSE BIN.PutCode(program, 0FH); BIN.PutCode(program, code.jmp); @@ -573,9 +572,127 @@ BEGIN END GetRegA; +PROCEDURE fcmp; +BEGIN + GetRegA; + OutByte2(0DAH, 0E9H); (* fucompp *) + OutByte3(09BH, 0DFH, 0E0H); (* fstsw ax *) + OutByte(09EH); (* sahf *) + movrc(eax, 0) +END fcmp; + + +PROCEDURE movzx* (reg1, reg2, offs: INTEGER; word: BOOLEAN); (* movzx reg1, byte/word[reg2 + offs] *) +VAR + b: BYTE; + +BEGIN + OutByte2(0FH, 0B6H + ORD(word)); + IF (offs = 0) & (reg2 # ebp) THEN + b := 0 + ELSE + b := 40H + long(offs) + END; + OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); + IF reg2 = esp THEN + OutByte(24H) + END; + IF b # 0 THEN + OutIntByte(offs) + END +END movzx; + + +PROCEDURE _movrm* (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN); +VAR + b: BYTE; + +BEGIN + IF size = 16 THEN + OutByte(66H) + END; + IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN + OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64)) + END; + OutByte(8BH - 2 * ORD(mr) - ORD(size = 8)); + IF (offs = 0) & (reg2 # ebp) THEN + b := 0 + ELSE + b := 40H + long(offs) + END; + OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); + IF reg2 = esp THEN + OutByte(24H) + END; + IF b # 0 THEN + OutIntByte(offs) + END +END _movrm; + + +PROCEDURE movmr (reg1, offs, reg2: INTEGER); (* mov dword[reg1+offs], reg2_8 *) +BEGIN + _movrm(reg2, reg1, offs, 32, TRUE) +END movmr; + + +PROCEDURE movrm (reg1, reg2, offs: INTEGER); (* mov reg1, dword[reg2 + offs] *) +BEGIN + _movrm(reg1, reg2, offs, 32, FALSE) +END movrm; + + +PROCEDURE movmr8* (reg1, offs, reg2: INTEGER); (* mov byte[reg1+offs], reg2_8 *) +BEGIN + _movrm(reg2, reg1, offs, 8, TRUE) +END movmr8; + + +PROCEDURE movrm8* (reg1, reg2, offs: INTEGER); (* mov reg1_8, byte[reg2+offs] *) +BEGIN + _movrm(reg1, reg2, offs, 8, FALSE) +END movrm8; + + +PROCEDURE movmr16* (reg1, offs, reg2: INTEGER); (* mov word[reg1+offs], reg2_16 *) +BEGIN + _movrm(reg2, reg1, offs, 16, TRUE) +END movmr16; + + +PROCEDURE movrm16* (reg1, reg2, offs: INTEGER); (* mov reg1_16, word[reg2+offs] *) +BEGIN + _movrm(reg1, reg2, offs, 16, FALSE) +END movrm16; + + +PROCEDURE pushm* (reg, offs: INTEGER); (* push qword[reg+offs] *) +VAR + b: BYTE; + +BEGIN + IF reg >= 8 THEN + OutByte(41H) + END; + OutByte(0FFH); + IF (offs = 0) & (reg # ebp) THEN + b := 30H + ELSE + b := 70H + long(offs) + END; + OutByte(b + reg MOD 8); + IF reg = esp THEN + OutByte(24H) + END; + IF b # 30H THEN + OutIntByte(offs) + END +END pushm; + + PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER); VAR - cmd: COMMAND; + cmd, next: COMMAND; reg1, reg2: INTEGER; @@ -607,16 +724,16 @@ BEGIN IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICIMP, param1); - OutByte2(0FFH, 010H + reg1); // call dword[reg1] + OutByte2(0FFH, 010H + reg1); (* call dword[reg1] *) drop ELSE - OutByte2(0FFH, 015H); // call dword[L] + OutByte2(0FFH, 015H); (* call dword[L] *) Reloc(BIN.RIMP, param1) END |IL.opCALLP: UnOp(reg1); - OutByte2(0FFH, 0D0H + reg1); // call reg1 + OutByte2(0FFH, 0D0H + reg1); (* call reg1 *) drop; ASSERT(R.top = -1) @@ -627,7 +744,7 @@ BEGIN END; WHILE n > 0 DO subrc(esp, 8); - OutByte3(0DDH, 01CH, 024H); // fstp qword[esp] + OutByte3(0DDH, 01CH, 024H); (* fstp qword[esp] *) DEC(n) END; PushAll(0) @@ -647,7 +764,7 @@ BEGIN GetRegA; n := param2; WHILE n > 0 DO - OutByte3(0DDH, 004H, 024H); // fld qword[esp] + OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) addrc(esp, 8); DEC(n) END @@ -656,12 +773,12 @@ BEGIN n := param2; IF n > 0 THEN OutByte3(0DDH, 5CH + long(n * 8), 24H); - OutIntByte(n * 8); // fstp qword[esp + n*8] + OutIntByte(n * 8); (* fstp qword[esp + n*8] *) INC(n) END; WHILE n > 0 DO - OutByte3(0DDH, 004H, 024H); // fld qword[esp] + OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) addrc(esp, 8); DEC(n) END @@ -677,8 +794,8 @@ BEGIN n := param2; IF n > 4 THEN movrc(ecx, n); - pushc(0); // @@: push 0 - OutByte2(0E2H, 0FCH) // loop @b + pushc(0); (* L: push 0 *) + OutByte2(0E2H, 0FCH) (* loop L *) ELSE WHILE n > 0 DO pushc(0); @@ -708,14 +825,18 @@ BEGIN n := param2; IF n > 0 THEN n := n * 4; - OutByte(0C2H); OutWord(Word(n)) // ret n + OutByte(0C2H); OutWord(n MOD 65536) (* ret n *) ELSE - OutByte(0C3H) // ret + ret END |IL.opPUSHC: pushc(param2) + |IL.opONERR: + pushc(param2); + jmp(param1) + |IL.opPARAM: n := param2; IF n = 1 THEN @@ -740,7 +861,7 @@ BEGIN movrc(GetAnyReg(), param2) |IL.opLABEL: - SetLabel(param1) // L: + SetLabel(param1) (* L: *) |IL.opNOP: @@ -749,121 +870,105 @@ BEGIN IF pic THEN Pic(reg1, BIN.PICBSS, param2) ELSE - OutByte(0B8H + reg1); // mov reg1, _bss + param2 + OutByte(0B8H + reg1); (* mov reg1, _bss + param2 *) Reloc(BIN.RBSS, param2) END |IL.opLADR: n := param2 * 4; - OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); // lea reg1, dword[ebp + n] + OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); (* lea reg1, dword[ebp + n] *) OutIntByte(n) - |IL.opVADR: - n := param2 * 4; - OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] - OutIntByte(n) + |IL.opVADR, IL.opLLOAD32: + movrm(GetAnyReg(), ebp, param2 * 4) |IL.opSADR: reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICDATA, stroffs + param2); ELSE - OutByte(0B8H + reg1); // mov reg1, _data + stroffs + param2 + OutByte(0B8H + reg1); (* mov reg1, _data + stroffs + param2 *) Reloc(BIN.RDATA, stroffs + param2) END |IL.opSAVEC: UnOp(reg1); - OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2 + OutByte2(0C7H, reg1); OutInt(param2); (* mov dword[reg1], param2 *) drop |IL.opSAVE8C: UnOp(reg1); - OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2 + OutByte3(0C6H, reg1, param2 MOD 256); (* mov byte[reg1], param2 *) drop |IL.opSAVE16C: UnOp(reg1); - OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2 + OutByte3(66H, 0C7H, reg1); OutWord(param2 MOD 65536); (* mov word[reg1], param2 *) drop |IL.opVLOAD32: n := param2 * 4; reg1 := GetAnyReg(); - OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] - OutIntByte(n); - OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] + movrm(reg1, ebp, param2 * 4); + movrm(reg1, reg1, 0) |IL.opGLOAD32: reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2); - OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] + movrm(reg1, reg1, 0) ELSE - OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[_bss + param2] + OutByte2(08BH, 05H + reg1 * 8); (* mov reg1, dword[_bss + param2] *) Reloc(BIN.RBSS, param2) END - |IL.opLLOAD32: - n := param2 * 4; - OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] - OutIntByte(n) - |IL.opLOAD32: UnOp(reg1); - OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] + movrm(reg1, reg1, 0) |IL.opVLOAD8: - n := param2 * 4; reg1 := GetAnyReg(); - OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] - OutIntByte(n); - OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] + movrm(reg1, ebp, param2 * 4); + movzx(reg1, reg1, 0, FALSE) |IL.opGLOAD8: reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2); - OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] + movzx(reg1, reg1, 0, FALSE) ELSE - OutByte3(00FH, 0B6H, 05H + reg1 * 8); // movzx reg1, byte[_bss + param2] + OutByte3(00FH, 0B6H, 05H + reg1 * 8); (* movzx reg1, byte[_bss + param2] *) Reloc(BIN.RBSS, param2) END |IL.opLLOAD8: - n := param2 * 4; - OutByte3(0FH, 0B6H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, byte[ebp + n] - OutIntByte(n) + movzx(GetAnyReg(), ebp, param2 * 4, FALSE) |IL.opLOAD8: UnOp(reg1); - OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] + movzx(reg1, reg1, 0, FALSE) |IL.opVLOAD16: - n := param2 * 4; reg1 := GetAnyReg(); - OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] - OutIntByte(n); - OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] + movrm(reg1, ebp, param2 * 4); + movzx(reg1, reg1, 0, TRUE) |IL.opGLOAD16: reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2); - OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] + movzx(reg1, reg1, 0, TRUE) ELSE - OutByte3(00FH, 0B7H, 05H + reg1 * 8); // movzx reg1, word[_bss + param2] + OutByte3(00FH, 0B7H, 05H + reg1 * 8); (* movzx reg1, word[_bss + param2] *) Reloc(BIN.RBSS, param2) END |IL.opLLOAD16: - n := param2 * 4; - OutByte3(0FH, 0B7H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, word[ebp + n] - OutIntByte(n) + movzx(GetAnyReg(), ebp, param2 * 4, TRUE) |IL.opLOAD16: UnOp(reg1); - OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] + movzx(reg1, reg1, 0, TRUE) |IL.opUMINUS: UnOp(reg1); @@ -877,27 +982,44 @@ BEGIN |IL.opADDL, IL.opADDR: IF param2 # 0 THEN UnOp(reg1); - IF param2 = 1 THEN - OutByte(40H + reg1) // inc reg1 - ELSIF param2 = -1 THEN - OutByte(48H + reg1) // dec reg1 + next := cmd.next(COMMAND); + CASE next.opcode OF + |IL.opLOAD32: + movrm(reg1, reg1, param2); + cmd := next + |IL.opLOAD16: + movzx(reg1, reg1, param2, TRUE); + cmd := next + |IL.opLOAD8: + movzx(reg1, reg1, param2, FALSE); + cmd := next + |IL.opLOAD32_PARAM: + pushm(reg1, param2); + drop; + cmd := next ELSE - addrc(reg1, param2) + IF param2 = 1 THEN + OutByte(40H + reg1) (* inc reg1 *) + ELSIF param2 = -1 THEN + OutByte(48H + reg1) (* dec reg1 *) + ELSE + addrc(reg1, param2) + END END END |IL.opSUB: BinOp(reg1, reg2); - OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 + OutByte2(29H, 0C0H + reg2 * 8 + reg1); (* sub reg1, reg2 *) drop |IL.opSUBR, IL.opSUBL: UnOp(reg1); n := param2; IF n = 1 THEN - OutByte(48H + reg1) // dec reg1 + OutByte(48H + reg1) (* dec reg1 *) ELSIF n = -1 THEN - OutByte(40H + reg1) // inc reg1 + OutByte(40H + reg1) (* inc reg1 *) ELSIF n # 0 THEN subrc(reg1, n) END; @@ -906,60 +1028,67 @@ BEGIN END |IL.opMULC: - UnOp(reg1); - - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) + IF (cmd.next(COMMAND).opcode = IL.opADD) & ((param2 = 2) OR (param2 = 4) OR (param2 = 8)) THEN + BinOp(reg1, reg2); + OutByte3(8DH, 04H + reg1 * 8, reg1 + reg2 * 8 + 40H * UTILS.Log2(param2)); (* lea reg1, [reg1 + reg2 * param2] *) + drop; + cmd := cmd.next(COMMAND) ELSE - n := -1 - END; + UnOp(reg1); - IF a = 1 THEN - - ELSIF a = -1 THEN - neg(reg1) - ELSIF a = 0 THEN - xor(reg1, reg1) - ELSE - IF n > 0 THEN - IF a < 0 THEN - neg(reg1) - END; - - IF n # 1 THEN - OutByte3(0C1H, 0E0H + reg1, n) // shl reg1, n - ELSE - OutByte2(0D1H, 0E0H + reg1) // shl reg1, 1 - END + a := param2; + IF a > 1 THEN + n := UTILS.Log2(a) + ELSIF a < -1 THEN + n := UTILS.Log2(-a) ELSE - OutByte2(69H + short(a), 0C0H + reg1 * 9); // imul reg1, a - OutIntByte(a) + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + neg(reg1) + ELSIF a = 0 THEN + xor(reg1, reg1) + ELSE + IF n > 0 THEN + IF a < 0 THEN + neg(reg1) + END; + + IF n # 1 THEN + OutByte3(0C1H, 0E0H + reg1, n) (* shl reg1, n *) + ELSE + OutByte2(0D1H, 0E0H + reg1) (* shl reg1, 1 *) + END + ELSE + OutByte2(69H + short(a), 0C0H + reg1 * 9); (* imul reg1, a *) + OutIntByte(a) + END END END |IL.opMUL: BinOp(reg1, reg2); - OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2 + OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); (* imul reg1, reg2 *) drop |IL.opSAVE, IL.opSAVE32: BinOp(reg2, reg1); - OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2 + movmr(reg1, 0, reg2); drop; drop |IL.opSAVE8: BinOp(reg2, reg1); - OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 + movmr8(reg1, 0, reg2); drop; drop |IL.opSAVE16: BinOp(reg2, reg1); - OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2 + movmr16(reg1, 0, reg2); drop; drop @@ -968,10 +1097,10 @@ BEGIN IF pic THEN reg2 := GetAnyReg(); Pic(reg2, BIN.PICCODE, param2); - OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2 + movmr(reg1, 0, reg2); drop ELSE - OutByte2(0C7H, reg1); // mov dword[reg1], L + OutByte2(0C7H, reg1); (* mov dword[reg1], L *) Reloc(BIN.RCODE, param2) END; drop @@ -981,13 +1110,13 @@ BEGIN IF pic THEN reg2 := GetAnyReg(); Pic(reg2, BIN.PICIMP, param2); - OutByte2(0FFH, 30H + reg2); // push dword[reg2] - OutByte2(08FH, reg1); // pop dword[reg1] + pushm(reg2, 0); + OutByte2(08FH, reg1); (* pop dword[reg1] *) drop ELSE - OutByte2(0FFH, 035H); // push dword[L] + OutByte2(0FFH, 035H); (* push dword[L] *) Reloc(BIN.RIMP, param2); - OutByte2(08FH, reg1) // pop dword[reg1] + OutByte2(08FH, reg1) (* pop dword[reg1] *) END; drop @@ -996,7 +1125,7 @@ BEGIN IF pic THEN Pic(reg1, BIN.PICCODE, param2) ELSE - OutByte(0B8H + reg1); // mov reg1, L + OutByte(0B8H + reg1); (* mov reg1, L *) Reloc(BIN.RCODE, param2) END @@ -1004,9 +1133,9 @@ BEGIN reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICIMP, param2); - OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1] + movrm(reg1, reg1, 0) ELSE - OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[L] + OutByte2(08BH, 05H + reg1 * 8); (* mov reg1, dword[L] *) Reloc(BIN.RIMP, param2) END @@ -1025,19 +1154,15 @@ BEGIN |IL.opSBOOL: BinOp(reg2, reg1); test(reg2); - OutByte3(0FH, 95H, reg1); // setne byte[reg1] + OutByte3(0FH, 95H, reg1); (* setne byte[reg1] *) drop; drop |IL.opSBOOLC: UnOp(reg1); - OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1 + OutByte3(0C6H, reg1, ORD(param2 # 0)); (* mov byte[reg1], 0/1 *) drop - |IL.opODD: - UnOp(reg1); - andrc(reg1, 1) - |IL.opEQ..IL.opGE, IL.opEQC..IL.opGEC: @@ -1047,26 +1172,19 @@ BEGIN drop ELSE UnOp(reg1); - IF param2 = 0 THEN - test(reg1) - ELSE - cmprc(reg1, param2) - END + cmprc(reg1, param2) END; drop; cc := cond(opcode); + next := cmd.next(COMMAND); - IF cmd.next(COMMAND).opcode = IL.opJE THEN - label := cmd.next(COMMAND).param1; - jcc(cc, label); - cmd := cmd.next(COMMAND) - - ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN - label := cmd.next(COMMAND).param1; - jcc(inv0(cc), label); - cmd := cmd.next(COMMAND) - + IF next.opcode = IL.opJE THEN + jcc(cc, next.param1); + cmd := next + ELSIF next.opcode = IL.opJNE THEN + jcc(inv0(cc), next.param1); + cmd := next ELSE reg1 := GetAnyReg(); setcc(cc + 16, reg1); @@ -1078,13 +1196,13 @@ BEGIN drop; test(reg1); - OutByte2(74H, 5); // je @f - movrc(reg1, 1); // mov reg1, 1 - // @@: + OutByte2(74H, 5); (* je @f *) + movrc(reg1, 1); (* mov reg1, 1 + @@: *) test(reg2); - OutByte2(74H, 5); // je @f - movrc(reg2, 1); // mov reg2, 1 - // @@: + OutByte2(74H, 5); (* je @f *) + movrc(reg2, 1); (* mov reg2, 1 + @@: *) cmprr(reg1, reg2); IF opcode = IL.opEQB THEN @@ -1116,6 +1234,11 @@ BEGIN test(reg1); jcc(je, param1) + |IL.opJG: + UnOp(reg1); + test(reg1); + jcc(jg, param1) + |IL.opJE: UnOp(reg1); test(reg1); @@ -1171,26 +1294,15 @@ BEGIN drop; drop; - CASE param2 OF - |1: - OutByte2(8AH, reg1 * 9); // mov reg1, byte[reg1] - OutByte2(88H, reg1 * 8 + reg2) // mov byte[reg2], reg1 - - |2: - OutByte3(66H, 8BH, reg1 * 9); // mov reg1, word[reg1] - OutByte3(66H, 89H, reg1 * 8 + reg2) // mov word[reg2], reg1 - - |4: - OutByte2(8BH, reg1 * 9); // mov reg1, dword[reg1] - OutByte2(89H, reg1 * 8 + reg2) // mov dword[reg2], reg1 - - |8: + IF param2 # 8 THEN + _movrm(reg1, reg1, 0, param2 * 8, FALSE); + _movrm(reg1, reg2, 0, param2 * 8, TRUE) + ELSE PushAll(0); push(reg1); push(reg2); pushc(8); CallRTL(pic, IL._move) - END |IL.opSAVES: @@ -1203,7 +1315,7 @@ BEGIN push(reg1); drop ELSE - OutByte(068H); // push _data + stroffs + param2 + OutByte(068H); (* push _data + stroffs + param2 *) Reloc(BIN.RDATA, stroffs + param2); END; @@ -1226,14 +1338,11 @@ BEGIN BinOp(reg1, reg2); IF param2 # -1 THEN cmprr(reg2, reg1); - mov(reg1, reg2); - drop; jcc(jb, param1) - ELSE - INCL(R.regs, reg1); - DEC(R.top); - R.stk[R.top] := reg2 - END + END; + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 |IL.opLEN: n := param2; @@ -1252,29 +1361,35 @@ BEGIN |IL.opINCC: UnOp(reg1); - OutByte2(81H + short(param2), reg1); OutIntByte(param2); // add dword[reg1], param2 + IF param2 = 1 THEN + OutByte2(0FFH, reg1) (* inc dword[reg1] *) + ELSIF param2 = -1 THEN + OutByte2(0FFH, reg1 + 8) (* dec dword[reg1] *) + ELSE + OutByte2(81H + short(param2), reg1); OutIntByte(param2) (* add dword[reg1], param2 *) + END; drop |IL.opINC, IL.opDEC: BinOp(reg1, reg2); - OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); // add/sub dword[reg2], reg1 + OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); (* add/sub dword[reg2], reg1 *) drop; drop |IL.opINCCB, IL.opDECCB: UnOp(reg1); - OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, Byte(param2)); // add/sub byte[reg1], n + OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, param2 MOD 256); (* add/sub byte[reg1], n *) drop |IL.opINCB, IL.opDECB: BinOp(reg1, reg2); - OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); // add/sub byte[reg2], reg1 + OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); (* add/sub byte[reg2], reg1 *) drop; drop |IL.opMULS: BinOp(reg1, reg2); - OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 + OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *) drop |IL.opMULSC: @@ -1288,18 +1403,18 @@ BEGIN |IL.opDIVSC: UnOp(reg1); - OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n + OutByte2(81H + short(param2), 0F0H + reg1); (* xor reg1, n *) OutIntByte(param2) |IL.opADDS: BinOp(reg1, reg2); - OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2 + OutByte2(9H, 0C0H + reg2 * 8 + reg1); (* or reg1, reg2 *) drop |IL.opSUBS: BinOp(reg1, reg2); not(reg2); - OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 + OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *) drop |IL.opADDSL, IL.opADDSR: @@ -1348,7 +1463,7 @@ BEGIN BinOp(reg1, reg2); ASSERT(reg2 = ecx); OutByte(0D3H); - shift(opcode, reg1); // shift reg1, cl + shift(opcode, reg1); (* shift reg1, cl *) drop |IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: @@ -1364,7 +1479,7 @@ BEGIN BinOp(reg1, reg2); ASSERT(reg1 = ecx); OutByte(0D3H); - shift(opcode, reg2); // shift reg2, cl + shift(opcode, reg2); (* shift reg2, cl *) drop; drop; ASSERT(REG.GetReg(R, reg2)) @@ -1377,66 +1492,39 @@ BEGIN ELSE OutByte(0D1H) END; - shift(opcode, reg1); // shift reg1, n + shift(opcode, reg1); (* shift reg1, n *) IF n # 1 THEN OutByte(n) END - |IL.opMIN: + |IL.opMAX, IL.opMIN: BinOp(reg1, reg2); cmprr(reg1, reg2); - OutByte2(07EH, 002H); // jle @f - mov(reg1, reg2); // mov reg1, reg2 - // @@: + OutByte2(07DH + ORD(opcode = IL.opMIN), 2); (* jge/jle L *) + mov(reg1, reg2); + (* L: *) drop - |IL.opMAX: - BinOp(reg1, reg2); - cmprr(reg1, reg2); - OutByte2(07DH, 002H); // jge @f - mov(reg1, reg2); // mov reg1, reg2 - // @@: - drop - - |IL.opMINC: + |IL.opMAXC, IL.opMINC: UnOp(reg1); cmprc(reg1, param2); - OutByte2(07EH, 005H); // jle @f - movrc(reg1, param2) // mov reg1, param2 - // @@: + OutByte2(07DH + ORD(opcode = IL.opMINC), 5); (* jge/jle L *) + movrc(reg1, param2) + (* L: *) - |IL.opMAXC: - UnOp(reg1); - cmprc(reg1, param2); - OutByte2(07DH, 005H); // jge @f - movrc(reg1, param2) // mov reg1, param2 - // @@: - - |IL.opIN: + |IL.opIN, IL.opINR: + IF opcode = IL.opINR THEN + reg2 := GetAnyReg(); + movrc(reg2, param2) + END; label := NewLabel(); BinOp(reg1, reg2); cmprc(reg1, 32); - OutByte2(72H, 4); // jb L + OutByte2(72H, 4); (* jb L *) xor(reg1, reg1); jmp(label); - //L: - OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1 - setcc(setc, reg1); - andrc(reg1, 1); - SetLabel(label); - drop - - |IL.opINR: - label := NewLabel(); - UnOp(reg1); - reg2 := GetAnyReg(); - cmprc(reg1, 32); - OutByte2(72H, 4); // jb L - xor(reg1, reg1); - jmp(label); - //L: - movrc(reg2, param2); - OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1 + (* L: *) + OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); (* bt reg2, reg1 *) setcc(setc, reg1); andrc(reg1, 1); SetLabel(label); @@ -1444,7 +1532,7 @@ BEGIN |IL.opINL: UnOp(reg1); - OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2 + OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); (* bt reg1, param2 *) setcc(setc, reg1); andrc(reg1, 1) @@ -1476,26 +1564,26 @@ BEGIN |IL.opINCL, IL.opEXCL: BinOp(reg1, reg2); cmprc(reg1, 32); - OutByte2(73H, 03H); // jnb L + OutByte2(73H, 03H); (* jnb L *) OutByte(0FH); IF opcode = IL.opINCL THEN - OutByte(0ABH) // bts dword[reg2], reg1 + OutByte(0ABH) (* bts dword[reg2], reg1 *) ELSE - OutByte(0B3H) // btr dword[reg2], reg1 + OutByte(0B3H) (* btr dword[reg2], reg1 *) END; OutByte(reg2 + 8 * reg1); - //L: + (* L: *) drop; drop |IL.opINCLC: UnOp(reg1); - OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2 + OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); (* bts dword[reg1], param2 *) drop |IL.opEXCLC: UnOp(reg1); - OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2 + OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); (* btr dword[reg1], param2 *) drop |IL.opDIV: @@ -1504,48 +1592,19 @@ BEGIN GetRegA |IL.opDIVR: - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) - ELSE - n := -1 - END; - - IF a = 1 THEN - - ELSIF a = -1 THEN + n := UTILS.Log2(param2); + IF n > 0 THEN UnOp(reg1); - neg(reg1) - ELSE - IF n > 0 THEN - UnOp(reg1); - - IF a < 0 THEN - reg2 := GetAnyReg(); - mov(reg2, reg1); - IF n # 1 THEN - OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n - ELSE - OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1 - END; - OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 - drop - ELSE - IF n # 1 THEN - OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n - ELSE - OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1 - END - END - + IF n # 1 THEN + OutByte3(0C1H, 0F8H + reg1, n) (* sar reg1, n *) ELSE - PushAll(1); - pushc(param2); - CallRTL(pic, IL._divmod); - GetRegA + OutByte2(0D1H, 0F8H + reg1) (* sar reg1, 1 *) END + ELSIF n < 0 THEN + PushAll(1); + pushc(param2); + CallRTL(pic, IL._divmod); + GetRegA END |IL.opDIVL: @@ -1564,42 +1623,19 @@ BEGIN GetRegA |IL.opMODR: - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(reg1); + andrc(reg1, param2 - 1); + ELSIF n < 0 THEN + PushAll(1); + pushc(param2); + CallRTL(pic, IL._divmod); + mov(eax, edx); + GetRegA ELSE - n := -1 - END; - - IF ABS(a) = 1 THEN UnOp(reg1); xor(reg1, reg1) - ELSE - IF n > 0 THEN - UnOp(reg1); - andrc(reg1, ABS(a) - 1); - - IF a < 0 THEN - test(reg1); - OutByte(74H); // je @f - IF isByte(a) THEN - OutByte(3) - ELSE - OutByte(6) - END; - addrc(reg1, a) - // @@: - END - - ELSE - PushAll(1); - pushc(param2); - CallRTL(pic, IL._divmod); - mov(eax, edx); - GetRegA - END END |IL.opMODL: @@ -1618,9 +1654,9 @@ BEGIN |IL.opABS: UnOp(reg1); test(reg1); - OutByte2(07DH, 002H); // jge @f - neg(reg1) // neg reg1 - // @@: + OutByte2(07DH, 002H); (* jge L *) + neg(reg1) (* neg reg1 + L: *) |IL.opCOPY: PushAll(2); @@ -1682,7 +1718,7 @@ BEGIN cmprr(reg1, reg2); drop ELSE - OutByte2(081H, 0F8H + reg1); // cmp reg1, L + OutByte2(081H, 0F8H + reg1); (* cmp reg1, L *) Reloc(BIN.RCODE, param1) END @@ -1690,10 +1726,10 @@ BEGIN IF pic THEN reg2 := GetAnyReg(); Pic(reg2, BIN.PICIMP, param1); - OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2] + OutByte2(03BH, reg1 * 8 + reg2); (* cmp reg1, dword [reg2] *) drop ELSE - OutByte2(3BH, 05H + reg1 * 8); // cmp reg1, dword[L] + OutByte2(3BH, 05H + reg1 * 8); (* cmp reg1, dword[L] *) Reloc(BIN.RIMP, param1) END @@ -1710,8 +1746,7 @@ BEGIN |IL.opPUSHT: UnOp(reg1); - reg2 := GetAnyReg(); - OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4] + movrm(GetAnyReg(), reg1, -4) |IL.opISREC: PushAll(2); @@ -1742,7 +1777,7 @@ BEGIN |IL.opTYPEGD: UnOp(reg1); PushAll(0); - OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4] + pushm(reg1, -4); pushc(param2 * tcount); CallRTL(pic, IL._guardrec); GetRegA @@ -1759,11 +1794,11 @@ BEGIN |IL.opPACK: BinOp(reg1, reg2); push(reg2); - OutByte3(0DBH, 004H, 024H); // fild dword[esp] - OutByte2(0DDH, reg1); // fld qword[reg1] - OutByte2(0D9H, 0FDH); // fscale - OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] - OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] + OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) + OutByte2(0DDH, reg1); (* fld qword[reg1] *) + OutByte2(0D9H, 0FDH); (* fscale *) + OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) + OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *) pop(reg2); drop; drop @@ -1771,187 +1806,163 @@ BEGIN |IL.opPACKC: UnOp(reg1); pushc(param2); - OutByte3(0DBH, 004H, 024H); // fild dword[esp] - OutByte2(0DDH, reg1); // fld qword[reg1] - OutByte2(0D9H, 0FDH); // fscale - OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] - OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] + OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) + OutByte2(0DDH, reg1); (* fld qword[reg1] *) + OutByte2(0D9H, 0FDH); (* fscale *) + OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) + OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *) pop(reg1); drop |IL.opUNPK: BinOp(reg1, reg2); - OutByte2(0DDH, reg1); // fld qword[reg1] - OutByte2(0D9H, 0F4H); // fxtract - OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] - OutByte2(0DBH, 018H + reg2); // fistp dword[reg2] + OutByte2(0DDH, reg1); (* fld qword[reg1] *) + OutByte2(0D9H, 0F4H); (* fxtract *) + OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) + OutByte2(0DBH, 018H + reg2); (* fistp dword[reg2] *) drop; drop |IL.opPUSHF: subrc(esp, 8); - OutByte3(0DDH, 01CH, 024H) // fstp qword[esp] + OutByte3(0DDH, 01CH, 024H) (* fstp qword[esp] *) |IL.opLOADF: UnOp(reg1); - OutByte2(0DDH, reg1); // fld qword[reg1] + OutByte2(0DDH, reg1); (* fld qword[reg1] *) drop |IL.opCONSTF: float := cmd.float; IF float = 0.0 THEN - OutByte2(0D9H, 0EEH) // fldz + OutByte2(0D9H, 0EEH) (* fldz *) ELSIF float = 1.0 THEN - OutByte2(0D9H, 0E8H) // fld1 + OutByte2(0D9H, 0E8H) (* fld1 *) ELSIF float = -1.0 THEN - OutByte2(0D9H, 0E8H); // fld1 - OutByte2(0D9H, 0E0H) // fchs + OutByte2(0D9H, 0E8H); (* fld1 *) + OutByte2(0D9H, 0E0H) (* fchs *) ELSE n := UTILS.splitf(float, a, b); pushc(b); pushc(a); - OutByte3(0DDH, 004H, 024H); // fld qword[esp] + OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) addrc(esp, 8) END - |IL.opSAVEF: + |IL.opSAVEF, IL.opSAVEFI: UnOp(reg1); - OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] + OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) drop |IL.opADDF, IL.opADDFI: - OutByte2(0DEH, 0C1H) // faddp st1, st + OutByte2(0DEH, 0C1H) (* faddp st1, st *) |IL.opSUBF: - OutByte2(0DEH, 0E9H) // fsubp st1, st + OutByte2(0DEH, 0E9H) (* fsubp st1, st *) |IL.opSUBFI: - OutByte2(0DEH, 0E1H) // fsubrp st1, st + OutByte2(0DEH, 0E1H) (* fsubrp st1, st *) |IL.opMULF: - OutByte2(0DEH, 0C9H) // fmulp st1, st + OutByte2(0DEH, 0C9H) (* fmulp st1, st *) |IL.opDIVF: - OutByte2(0DEH, 0F9H) // fdivp st1, st + OutByte2(0DEH, 0F9H) (* fdivp st1, st *) |IL.opDIVFI: - OutByte2(0DEH, 0F1H) // fdivrp st1, st + OutByte2(0DEH, 0F1H) (* fdivrp st1, st *) |IL.opUMINF: - OutByte2(0D9H, 0E0H) // fchs + OutByte2(0D9H, 0E0H) (* fchs *) |IL.opFABS: - OutByte2(0D9H, 0E1H) // fabs + OutByte2(0D9H, 0E1H) (* fabs *) |IL.opFLT: UnOp(reg1); push(reg1); - OutByte3(0DBH, 004H, 024H); // fild dword[esp] + OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) pop(reg1); drop |IL.opFLOOR: subrc(esp, 8); - OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4] - OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6] - OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); // and word[esp+4], 1111001111111111b - OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); // or word[esp+4], 0000010000000000b - OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4] - OutByte2(0D9H, 0FCH); // frndint - OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] + OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); (* fstcw word[esp+4] *) + OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); (* fstcw word[esp+6] *) + OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); (* and word[esp+4], 1111001111111111b *) + OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); (* or word[esp+4], 0000010000000000b *) + OutByte2(0D9H, 06CH); OutByte2(024H, 004H); (* fldcw word[esp+4] *) + OutByte2(0D9H, 0FCH); (* frndint *) + OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *) pop(GetAnyReg()); - OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2] + OutByte2(0D9H, 06CH); OutByte2(024H, 002H); (* fldcw word[esp+2] *) addrc(esp, 4) |IL.opEQF: - GetRegA; - OutByte2(0DAH, 0E9H); // fucompp - OutByte3(09BH, 0DFH, 0E0H); // fstsw ax - OutByte(09EH); // sahf - movrc(eax, 0); - OutByte2(07AH, 003H); // jp L + fcmp; + OutByte2(07AH, 003H); (* jp L *) setcc(sete, al) - // L: + (* L: *) |IL.opNEF: - GetRegA; - OutByte2(0DAH, 0E9H); // fucompp - OutByte3(09BH, 0DFH, 0E0H); // fstsw ax - OutByte(09EH); // sahf - movrc(eax, 0); - OutByte2(07AH, 003H); // jp L + fcmp; + OutByte2(07AH, 003H); (* jp L *) setcc(setne, al) - // L: + (* L: *) |IL.opLTF: - GetRegA; - OutByte2(0DAH, 0E9H); // fucompp - OutByte3(09BH, 0DFH, 0E0H); // fstsw ax - OutByte(09EH); // sahf - movrc(eax, 0); - OutByte2(07AH, 00EH); // jp L + fcmp; + OutByte2(07AH, 00EH); (* jp L *) setcc(setc, al); setcc(sete, ah); test(eax); setcc(sete, al); andrc(eax, 1) - // L: + (* L: *) |IL.opGTF: - GetRegA; - OutByte2(0DAH, 0E9H); // fucompp - OutByte3(09BH, 0DFH, 0E0H); // fstsw ax - OutByte(09EH); // sahf - movrc(eax, 0); - OutByte2(07AH, 00FH); // jp L + fcmp; + OutByte2(07AH, 00FH); (* jp L *) setcc(setc, al); setcc(sete, ah); cmprc(eax, 1); setcc(sete, al); andrc(eax, 1) - // L: + (* L: *) |IL.opLEF: - GetRegA; - OutByte2(0DAH, 0E9H); // fucompp - OutByte3(09BH, 0DFH, 0E0H); // fstsw ax - OutByte(09EH); // sahf - movrc(eax, 0); - OutByte2(07AH, 003H); // jp L + fcmp; + OutByte2(07AH, 003H); (* jp L *) setcc(setnc, al) - // L: + (* L: *) |IL.opGEF: - GetRegA; - OutByte2(0DAH, 0E9H); // fucompp - OutByte3(09BH, 0DFH, 0E0H); // fstsw ax - OutByte(09EH); // sahf - movrc(eax, 0); - OutByte2(07AH, 010H); // jp L + fcmp; + OutByte2(07AH, 010H); (* jp L *) setcc(setc, al); setcc(sete, ah); - OutByte2(000H, 0E0H); // add al,ah - OutByte2(03CH, 001H); // cmp al,1 + OutByte2(000H, 0E0H); (* add al, ah *) + OutByte2(03CH, 001H); (* cmp al, 1 *) setcc(sete, al); andrc(eax, 1) - // L: + (* L: *) |IL.opINF: pushc(7FF00000H); pushc(0); - OutByte3(0DDH, 004H, 024H); // fld qword[esp] + OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) addrc(esp, 8) |IL.opLADR_UNPK: n := param2 * 4; reg1 := GetAnyReg(); - OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] + OutByte2(8DH, 45H + reg1 * 8 + long(n)); (* lea reg1, dword[ebp + n] *) OutIntByte(n); BinOp(reg1, reg2); - OutByte2(0DDH, reg1); // fld qword[reg1] - OutByte2(0D9H, 0F4H); // fxtract - OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] - OutByte2(0DBH, 018H + reg2); // fistp dword[reg2] + OutByte2(0DDH, reg1); (* fld qword[reg1] *) + OutByte2(0D9H, 0F4H); (* fxtract *) + OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) + OutByte2(0DBH, 018H + reg2); (* fistp dword[reg2] *) drop; drop @@ -1962,14 +1973,12 @@ BEGIN push(reg1); drop ELSE - OutByte(068H); // push _data + stroffs + param2 + OutByte(068H); (* push _data + stroffs + param2 *) Reloc(BIN.RDATA, stroffs + param2) END - |IL.opVADR_PARAM: - n := param2 * 4; - OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] - OutIntByte(n) + |IL.opVADR_PARAM, IL.opLLOAD32_PARAM: + pushm(ebp, param2 * 4) |IL.opCONST_PARAM: pushc(param2) @@ -1978,56 +1987,49 @@ BEGIN IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICBSS, param2); - OutByte2(0FFH, 30H + reg1); // push dword[reg1] + pushm(reg1, 0); drop ELSE - OutByte2(0FFH, 035H); // push dword[_bss + param2] + OutByte2(0FFH, 035H); (* push dword[_bss + param2] *) Reloc(BIN.RBSS, param2) END - |IL.opLLOAD32_PARAM: - n := param2 * 4; - OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] - OutIntByte(n) - |IL.opLOAD32_PARAM: UnOp(reg1); - OutByte2(0FFH, 30H + reg1); // push dword[reg1] + pushm(reg1, 0); drop |IL.opGADR_SAVEC: IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICBSS, param1); - OutByte2(0C7H, reg1); // mov dword[reg1], param2 + OutByte2(0C7H, reg1); (* mov dword[reg1], param2 *) OutInt(param2); drop ELSE - OutByte2(0C7H, 05H); // mov dword[_bss + param1], param2 + OutByte2(0C7H, 05H); (* mov dword[_bss + param1], param2 *) Reloc(BIN.RBSS, param1); OutInt(param2) END |IL.opLADR_SAVEC: n := param1 * 4; - OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2 + OutByte2(0C7H, 45H + long(n)); (* mov dword[ebp + n], param2 *) OutIntByte(n); OutInt(param2) |IL.opLADR_SAVE: - n := param2 * 4; UnOp(reg1); - OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1 - OutIntByte(n); + movmr(ebp, param2 * 4, reg1); drop |IL.opLADR_INCC: n := param1 * 4; IF ABS(param2) = 1 THEN - OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec dword[ebp + n] + OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec dword[ebp + n] *) OutIntByte(n) ELSE - OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2 + OutByte2(81H + short(param2), 45H + long(n)); (* add dword[ebp + n], param2 *) OutIntByte(n); OutIntByte(param2) END @@ -2035,10 +2037,10 @@ BEGIN |IL.opLADR_INCCB, IL.opLADR_DECCB: n := param1 * 4; IF param2 = 1 THEN - OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); // inc/dec byte[ebp + n] + OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); (* inc/dec byte[ebp + n] *) OutIntByte(n) ELSE - OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); // add/sub byte[ebp + n], param2 + OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); (* add/sub byte[ebp + n], param2 *) OutIntByte(n); OutByte(param2 MOD 256) END @@ -2046,14 +2048,14 @@ BEGIN |IL.opLADR_INC, IL.opLADR_DEC: n := param2 * 4; UnOp(reg1); - OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); // add/sub dword[ebp + n], reg1 + OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); (* add/sub dword[ebp + n], reg1 *) OutIntByte(n); drop |IL.opLADR_INCB, IL.opLADR_DECB: n := param2 * 4; UnOp(reg1); - OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); // add/sub byte[ebp + n], reg1 + OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); (* add/sub byte[ebp + n], reg1 *) OutIntByte(n); drop @@ -2063,14 +2065,14 @@ BEGIN cmprc(reg1, 32); label := NewLabel(); jcc(jnb, label); - OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 + OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); (* bts(r) dword[ebp + n], reg1 *) OutIntByte(n); SetLabel(label); drop |IL.opLADR_INCLC, IL.opLADR_EXCLC: n := param1 * 4; - OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 + OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); (* bts(r) dword[ebp + n], param2 *) OutIntByte(n); OutByte(param2) @@ -2096,28 +2098,28 @@ BEGIN entry := NewLabel(); SetLabel(entry); - IF target = mConst.Target_iDLL THEN + IF target = TARGETS.Win32DLL THEN push(ebp); mov(ebp, esp); - OutByte3(0FFH, 75H, 16); // push dword[ebp+16] - OutByte3(0FFH, 75H, 12); // push dword[ebp+12] - OutByte3(0FFH, 75H, 8); // push dword[ebp+8] + pushm(ebp, 16); + pushm(ebp, 12); + pushm(ebp, 8); CallRTL(pic, IL._dllentry); test(eax); jcc(je, dllret) - ELSIF target = mConst.Target_iObject THEN + ELSIF target = TARGETS.KolibriOSDLL THEN SetLabel(dllinit) END; - IF target = mConst.Target_iKolibri THEN + IF target = TARGETS.KolibriOS THEN reg1 := GetAnyReg(); Pic(reg1, BIN.IMPTAB, 0); - push(reg1); // push IMPORT + push(reg1); (* push IMPORT *) drop - ELSIF target = mConst.Target_iObject THEN - OutByte(68H); // push IMPORT + ELSIF target = TARGETS.KolibriOSDLL THEN + OutByte(68H); (* push IMPORT *) Reloc(BIN.IMPTAB, 0) - ELSIF target = mConst.Target_iELF32 THEN + ELSIF target = TARGETS.Linux32 THEN push(esp) ELSE pushc(0) @@ -2126,20 +2128,20 @@ BEGIN IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICCODE, entry); - push(reg1); // push CODE + push(reg1); (* push CODE *) drop ELSE - OutByte(68H); // push CODE + OutByte(68H); (* push CODE *) Reloc(BIN.RCODE, entry) END; IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICDATA, 0); - push(reg1); // push _data + push(reg1); (* push _data *) drop ELSE - OutByte(68H); // push _data + OutByte(68H); (* push _data *) Reloc(BIN.RDATA, 0) END; @@ -2150,16 +2152,16 @@ BEGIN IF pic THEN reg1 := GetAnyReg(); Pic(reg1, BIN.PICDATA, tcount * 4 + dcount); - push(reg1); // push _data + tcount * 4 + dcount + push(reg1); (* push _data + tcount * 4 + dcount *) drop ELSE - OutByte(68H); // push _data + OutByte(68H); (* push _data *) Reloc(BIN.RDATA, tcount * 4 + dcount) END; CallRTL(pic, IL._init); - IF target = mConst.Target_iELF32 THEN + IF target = TARGETS.Linux32 THEN L := NewLabel(); pushc(0); push(esp); @@ -2207,22 +2209,22 @@ VAR BEGIN - IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN + IF target IN {TARGETS.Win32C, TARGETS.Win32GUI, TARGETS.KolibriOS, TARGETS.Linux32} THEN pushc(0); CallRTL(pic, IL._exit); - ELSIF target = mConst.Target_iDLL THEN + ELSIF target = TARGETS.Win32DLL THEN SetLabel(dllret); movrc(eax, 1); - OutByte(0C9H); // leave - OutByte3(0C2H, 0CH, 0) // ret 12 - ELSIF target = mConst.Target_iObject THEN + OutByte(0C9H); (* leave *) + OutByte3(0C2H, 0CH, 0) (* ret 12 *) + ELSIF target = TARGETS.KolibriOSDLL THEN movrc(eax, 1); - OutByte(0C3H) // ret - ELSIF target = mConst.Target_iELFSO32 THEN - OutByte(0C3H); // ret + ret + ELSIF target = TARGETS.Linux32SO THEN + ret; SetLabel(sofinit); CallRTL(pic, IL._sofinit); - OutByte(0C3H) // ret + ret END; fixup; @@ -2244,7 +2246,7 @@ BEGIN BIN.PutDataStr(program, ext); BIN.PutData(program, 0); - IF target = mConst.Target_iObject THEN + IF target = TARGETS.KolibriOSDLL THEN BIN.Export(program, "lib_init", dllinit); END; @@ -2280,11 +2282,11 @@ BEGIN dllret := NewLabel(); sofinit := NewLabel(); - IF target = mConst.Target_iObject THEN + IF target = TARGETS.KolibriOSDLL THEN opt.pic := FALSE END; - IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32, mConst.Target_iELFSO32} THEN + IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32} THEN opt.pic := TRUE END; @@ -2296,14 +2298,14 @@ BEGIN BIN.fixup(program); - IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN - PE32.write(program, outname, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) - ELSIF target = mConst.Target_iKolibri THEN + IF TARGETS.OS = TARGETS.osWIN32 THEN + PE32.write(program, outname, target = TARGETS.Win32C, target = TARGETS.Win32DLL, FALSE) + ELSIF target = TARGETS.KolibriOS THEN KOS.write(program, outname) - ELSIF target = mConst.Target_iObject THEN + ELSIF target = TARGETS.KolibriOSDLL THEN MSCOFF.write(program, outname, opt.version) - ELSIF target IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN - ELF.write(program, outname, sofinit, target = mConst.Target_iELFSO32, FALSE) + ELSIF TARGETS.OS = TARGETS.osLINUX32 THEN + ELF.write(program, outname, sofinit, target = TARGETS.Linux32SO, FALSE) END END CodeGen; @@ -2316,4 +2318,4 @@ BEGIN END SetProgram; -END X86. +END X86. \ No newline at end of file