Units initialization/finalization support added

This commit is contained in:
Владислав Джавадов 2020-06-07 19:39:30 +03:00
parent 92d967d122
commit bf2e9bcc4b
9 changed files with 104 additions and 42 deletions

View File

@ -4,7 +4,7 @@ uses
CRT;
begin
ConsoleInit('Console Colors');
InitConsole('Console Colors');
TextBackground(Black);
WriteLn('Black');
@ -75,6 +75,4 @@ begin
WriteLn('White');
ReadKey;
ConsoleExit(True);
end.

View File

@ -9,7 +9,7 @@ var
CursorPos: TConsolePoint;
begin
ConsoleInit('Date/Time');
InitConsole('Date/Time');
SetCursorHeight(0);
SetCursorPos(27, 11);
@ -29,6 +29,4 @@ begin
SetCursorPos(CursorPos);
Sleep(50);
until KeyPressed;
ConsoleExit(True);
end.

View File

@ -13,13 +13,11 @@ var
Buffer: array[0..BUFFER_SIZE - 1] of Char;
begin
ConsoleInit('Get Current Directory');
InitConsole('Get Current Directory', False);
GetCurrentDirectory(Buffer, BUFFER_SIZE);
Write('AppPath is "%s"'#10, AppPath^);
Write('CmdLine is "%s"'#10, CmdLine^);
Write('Current Directory is "%s"'#10, Buffer);
ConsoleExit(False);
end.

View File

@ -4,10 +4,7 @@ uses
CRT;
begin
ConsoleInit('Hello');
InitConsole('Hello');
WriteLn('Hello, world!');
ReadKey;
ConsoleExit(True);
end.

View File

@ -8,10 +8,8 @@ var
Buffer: Pointer;
begin
ConsoleInit('Load File');
InitConsole('Load File', False);
Buffer := LoadFile('/sys/example.asm', FileSize);
WriteText(Buffer, FileSize);
ConsoleExit(False);
end.

View File

@ -17,7 +17,7 @@ var
Pos: LongWord;
begin
ConsoleInit('Read Folder');
InitConsole('Read Folder', False);
if ReadFolder(FolderPath, FolderInformation, 0, 0, 0, BlocksRead) = 0 then
with FolderInformation do
@ -53,6 +53,4 @@ begin
Write(#10);
Inc(Pos);
end;
ConsoleExit(False);
end.

View File

@ -28,7 +28,8 @@ const
Yellow = 14;
White = 15;
procedure ConsoleInit(Title: PKolibriChar);
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean = True;
WndWidth: LongWord = $FFFFFFFF; WndHeight: LongWord = $FFFFFFFF; ScrWidth: LongWord = $FFFFFFFF; ScrHeight: LongWord = $FFFFFFFF);
function GetCursorPos: TConsolePoint;
procedure SetCursorPos(X, Y: Integer); overload;
@ -43,7 +44,6 @@ function WriteLn(LineBreaks: Integer = 1): LongInt; overload;
function WriteLn(Text: PKolibriChar; LineBreaks: Integer = 1): LongInt; overload;
var
ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
KeyPressed: function: Boolean;
ReadKey: function: KolibriChar; stdcall;
SetCursorHeight: function(Height: Integer): Integer; stdcall;
@ -52,6 +52,9 @@ var
implementation
var
CloseWindow: Boolean;
procedure ResetAttributes;
begin
Write(#27'[0m');
@ -129,15 +132,17 @@ end;
var
hConsole: Pointer;
ConsoleInitProc: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongInt; Caption: PKolibriChar); stdcall;
ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PKolibriChar); stdcall;
GetCursorPosProc: procedure(var X, Y: Integer); stdcall;
SetCursorPosProc: procedure(X, Y: Integer); stdcall;
procedure ConsoleInit(Title: PKolibriChar);
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean;
WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord);
begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInitProc := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
GetCursorPosProc := GetProcAddress(hConsole, 'con_get_cursor_pos');
KeyPressed := GetProcAddress(hConsole, 'con_kbhit');
ReadKey := GetProcAddress(hConsole, 'con_getch');
@ -146,7 +151,8 @@ begin
Write := GetProcAddress(hConsole, 'con_printf');
WriteText := GetProcAddress(hConsole, 'con_write_string');
ConsoleInitProc(-1, -1, -1, -1, Title);
ConsoleInit(WndWidth, WndHeight, ScrWidth, ScrHeight, Caption);
CloseWindow := CloseWindowOnExit;
end;
function GetCursorPos: TConsolePoint;
@ -165,4 +171,10 @@ begin
SetCursorPosProc(X, Y);
end;
initialization
finalization
if hConsole <> nil then
ConsoleExit(CloseWindow);
end.

View File

@ -1,15 +1,14 @@
(*
Minimal Delphi SysInit unit
KolibriOS RTL System unit
*)
unit SysInit;
interface
procedure _InitExe;
procedure _InitExe(InitTable: PPackageInfo);
var
ModuleIsLib: Boolean;
TLSIndex: Integer = -1;
TLSLast: Byte;
@ -18,8 +17,9 @@ const
implementation
procedure _InitExe;
asm
procedure _InitExe(InitTable: PPackageInfo);
begin
_StartExe(InitTable);
end;
end.

View File

@ -1,5 +1,5 @@
(*
Minimal Delphi System unit
KolibriOS RTL System unit
*)
unit System;
@ -19,33 +19,96 @@ type
D4: array [0..7] of Byte;
end;
PProcedure = procedure;
TPackageUnitEntry = packed record
Init, Finalize: PProcedure;
end;
PUnitEntryTable = ^TUnitEntryTable;
TUnitEntryTable = array [0..99999999] of TPackageUnitEntry;
PPackageInfo = ^TPackageInfo;
TPackageInfo = packed record
UnitCount: Integer;
UnitInfo: PUnitEntryTable;
end;
PInitContext = ^TInitContext;
TInitContext = record
InitTable: PPackageInfo;
InitCount: Integer;
OuterContext: PInitContext;
ExceptionFrame, InitTable, InitCount: Integer;
Module: Pointer;
DLLSaveEBP, DLLSaveEBX, DLLSaveESI, DLLSaveEDI: Pointer;
ExitProcessTLS: procedure;
DLLInitState: byte;
end;
procedure _Halt0;
procedure _HandleFinally;
procedure _StartExe(InitTable: PPackageInfo);
implementation
uses
SysInit;
procedure _Halt0;
asm
XOR EAX, EAX
DEC EAX
INT $40
end;
var
InitContext: TInitContext;
procedure _HandleFinally;
asm
end;
procedure InitUnits;
var
Idx: Integer;
begin
if InitContext.InitTable <> nil then
with InitContext.InitTable^ do
begin
Idx := 0;
while Idx < UnitCount do
begin
with UnitInfo[Idx] do
begin
if Assigned(Init) then
Init;
end;
Inc(Idx);
InitContext.InitCount := Idx;
end;
end;
end;
procedure FinalizeUnits;
begin
if InitContext.InitTable <> nil then
begin
with InitContext do
begin
while InitCount > 0 do
begin
Dec(InitCount);
with InitTable.UnitInfo[InitCount] do
if Assigned(Finalize) then
Finalize;
end;
end;
end;
end;
procedure _StartExe(InitTable: PPackageInfo);
begin
InitContext.InitTable := InitTable;
InitContext.InitCount := 0;
InitUnits;
end;
procedure _Halt0;
begin
FinalizeUnits;
asm
OR EAX, -1
INT $40
end;
end;
end.