update

src/sources/fpc-rtl/RTL_CpuInfo.pas

@@ -0,0 +1,53 @@
+// ---------------------------------------------------------------------------
+// File:   RTL_CpuInfo.pas
+// Author: Jens Kallup - paule32
+//
+// This file is part of RTL.
+//
+// (c) Copyright 2024 Jens Kallup - paule32
+// only for non-profit usage !!!
+// ---------------------------------------------------------------------------
+{$ifdef windows_header}
+{$mode delphi}
+{$M-}
+type
+    TCPU = class(TObject)
+    private
+        class var     FClassParent : TObject;
+        class function   GetParent : TObject; static;
+    public
+        constructor Create;
+        destructor Destroy;
+
+        class function ClassParent: TObject; virtual;
+        class function ClassName:    String; virtual;
+
+        class property Parent: TObject read GetParent;
+    end;
+{$endif}
+
+{$ifdef windows_source}
+{$mode delphi}
+{$M-}
+constructor TCPU.Create;
+begin
+    inherited Create;
+end;
+destructor TCPU.Destroy;
+begin
+    inherited Destroy;
+end;
+class function TCPU.ClassName: String;
+begin
+    result := 'TCPU';
+end;
+class function TCPU.ClassParent: TObject;
+begin
+    result := Parent;
+end;
+class function TCPU.GetParent: TObject;
+begin
+    result := FClassParent;
+end;
+
+{$endif}

src/sources/fpc-rtl/RTL_DosCmd.pas

@@ -0,0 +1,158 @@
+// ----------------------------------------------------------
+// File: RTL_DosCmd.pas
+// This file is part of RTL.
+//
+// (c) Copyright 2021 Jens Kallup - paule32
+// only for non-profit usage !!!
+// ----------------------------------------------------------
+{$ifdef windows_header}
+{$mode delphi}
+{$M-}
+type
+    TDosCmd = class(TObject)
+    private
+        FConsoleHandle: DWORD;
+        FNewLine: String;
+        FStdIn, FStdOut, FStdErr: DWORD;
+    public
+        constructor Create;
+        destructor Destroy; override;
+
+        procedure Free; virtual;
+
+        procedure ClrScr;
+        procedure ClearScreen;
+        procedure Cls;
+
+        function MessageBox(AText, ATitle: String): DWORD;
+
+        procedure Write  (const msg: String);
+        procedure WriteLn(const msg: String);
+
+        function  get_StdIn : DWORD;
+        function  get_StdOut: DWORD;
+        function  get_StdErr: DWORD;
+
+        procedure set_StdIn (AValueDST, AValueSRC: DWORD);
+        procedure set_StdOut(AValueDST, AValueSRC: DWORD);
+        procedure set_StdErr(AValueDST, AValueSRC: DWORD);
+
+        property StdIn : DWORD read get_StdIn ;
+        property StdOut: DWORD read get_StdOut;
+        property StdErr: DWORD read get_StdErr;
+
+        property NewLine: String read FNewLine;
+    end;
+var
+    DOS: TDosCmd;
+
+procedure InitConsole;  // constructor: TUI
+procedure DoneConsole;  // destroy: TUI
+
+{$endif}
+
+{$ifdef windows_source}
+{$mode delphi}
+{$M-}
+function StringLength(const S: String): DWORD;
+var
+    len: DWORD;
+begin
+    len := 0;
+    while S[len + 1] <> #0 do
+    inc(len);
+    result := len;
+end;
+
+(*
+procedure Write(const msg: String);
+begin
+    if (DOS = nil) or (Windows = nil) then
+    begin
+        MessageBoxA(0,
+        PChar('Error: Console not init.'),
+        PChar('Error'), 0);
+        ExitProcess(1);
+    end else
+    begin
+        DOS.Write(msg);
+    end;
+end;
+
+procedure WriteLn(const msg: String);
+begin
+    if (DOS = nil) or (Windows = nil) then
+    begin
+        MessageBoxA(0,
+        PChar('Error: Console not init.'),
+        PChar('Error'), 0);
+        ExitProcess(1);
+    end else
+    begin
+        DOS.WriteLn(msg);
+    end;
+end;*)
+
+
+{ TDosCmd }
+
+procedure InitConsole;
+begin
+    DOS := TDosCmd.Create;
+end;
+procedure DoneConsole;
+begin
+    //if DOS <> nil then
+    //DOS.Free;
+end;
+
+constructor TDosCmd.Create;
+begin
+    inherited Create;
+
+    FNewLine := #13#10;
+end;
+
+destructor TDosCmd.Destroy;
+begin
+    inherited Destroy;
+end;
+procedure TDosCmd.Free;
+begin
+    if self <> nil then
+    self.Destroy;
+end;
+
+procedure TDosCmd.Cls;
+begin
+//
+end;
+procedure TDosCmd.ClrScr;      begin Cls; end;
+procedure TDosCmd.ClearScreen; begin Cls; end;
+
+function TDosCmd.MessageBox(AText, ATitle: String): DWORD;
+begin
+    printf('Message: %s', PChar(AText ));
+    printf('Title  : %s', PChar(ATitle));
+    result := 0;
+end;
+
+procedure TDosCmd.Write(const msg: String);
+begin
+    printf('%s', PChar(msg));
+end;
+
+procedure TDosCmd.WriteLn(const msg: String);
+begin
+    printf('%s'#13#10, PChar(msg));
+end;
+
+function  TDosCmd.get_StdIn : DWORD; begin result := GetStdHandle(STD_INPUT_HANDLE ); end;
+function  TDosCmd.get_StdOut: DWORD; begin result := GetStdHandle(STD_OUTPUT_HANDLE); end;
+function  TDosCmd.get_StdErr: DWORD; begin result := GetStdHandle(STD_ERROR_HANDLE ); end;
+
+procedure TDosCmd.set_StdIn (AValueDST, AValueSRC: DWORD); begin SetStdHandle(AValueSRC, GetStdHandle(AValueDST)); end;
+procedure TDosCmd.set_StdOut(AValueDST, AValueSRC: DWORD); begin SetStdHandle(AValueSRC, GetStdHandle(AValueDST)); end;
+procedure TDosCmd.set_StdErr(AValueDST, AValueSRC: DWORD); begin SetStdHandle(AValueSRC, GetStdHandle(AValueDST)); end;
+
+{$endif}

src/sources/fpc-rtl/RTL_DosIO.pas

@@ -0,0 +1,33 @@
+// ---------------------------------------------------------------------------
+// File:   RTL_DosIO.pas
+// Author: Jens Kallup - paule32
+//
+// This file is part of RTL.
+//
+// (c) Copyright 2024 Jens Kallup - paule32
+// only for non-profit usage !!!
+// ---------------------------------------------------------------------------
+{$ifdef windows_header}
+{$mode delphi}
+{$M-}
+type
+    TDosIO = record
+    public
+        class operator < (A: TDosIO; AString: String): Boolean;
+        class operator > (A: TDosIO; AString: String): Boolean;
+    end;
+
+{$endif}
+
+{$ifdef windows_source}
+{$mode delphi}
+{$M-}
+
+class operator TDosIO.<(A: TDosIO; AString: String): Boolean;
+begin
+end;
+class operator TDosIO.>(A: TDosIO; AString: String): Boolean;
+begin
+end;
+
+{$endif}

src/sources/fpc-rtl/RTL_Memory.pas

@@ -9,6 +9,8 @@
 // ---------------------------------------------------------------------------
 {$ifdef windows_header}
 {$mode delphi}
+{$M-}
+type
     TMemory = class(TObject)
     private
         class var     FClassMemory : Pointer;
@@ -29,38 +31,104 @@     TMemory = class(TObject)
         procedure Free;
 
         class function ClassParent: TObject; virtual;
-
-        function ClassName: String; virtual;
+        class function ClassName:    String; virtual;
 
         class property Parent: TObject read GetParent;
-        class property Memory: Pointer read FClassMemory write FClassMemory;
+        //
+        class property Data: Pointer read FClassMemory write FClassMemory;
         class property Size: DWORD read FClassMemSize;
     end;
+
+    TSystem = class(TObject)
+    private
+        class var      FSystemIO: TSystemIO;
+        class var   FClassParent: TObject;
+        class var      FMemClass: TMemory;
+        class var      FCpuClass: TCPU;
+        class var      FVgaClass: TVgaIO;
+        class var      FDosClass: TDosIO;
+        class function GetMemory: TMemory; static;
+    public
+        constructor Create;
+        destructor Destroy;
+
+        class function ClassParent: TObject; virtual;
+        class function ClassName:    String; virtual;
+
+        class property Parent: TObject read FClassParent;
+        //
+        class property cpu: TCPU read FCpuClass;
+        class property mem: TMemory read GetMemory;
+        class property vga: TVgaIO read FVgaClass;
+        class property dos: TDosIO read FDosClass;
+        //
+        class property io : TSystemIO read FSystemIO;
+    end;
 var
+    sys: TSystem;
     mem: TMemory;
 
-procedure InitMemory;
-procedure DoneMemory;
+procedure InitSystem;
+procedure DoneSystem;
 
 {$endif}
 
 {$ifdef windows_source}
 {$mode delphi}
 
-{ TMemory }
+procedure InitSystem;
+begin
+    if sys = nil then
+    begin
+        sys := TSystem.Create;
+    end;
+end;
+procedure DoneSystem;
+begin
+    if sys <> nil then
+    sys.Free;
+end;
+
 
-procedure InitMemory;
+{ TSystem }
+
+constructor TSystem.Create;
 begin
-    if mem = nil then
+    inherited Create;
+    FMemClass := TMemory.Create;
+end;
+destructor TSystem.Destroy;
+begin
+    if FMemClass <> nil then
     begin
-        mem := TMemory.Create;
+        FMemClass.Free;
+        FMemClass := nil;
     end;
+
+    inherited Destroy;
 end;
-procedure DoneMemory;
+
+class function TSystem.GetMemory: TMemory;
 begin
-    if mem <> nil then
-    mem.Free;
+    if FMemClass = nil then
+    FMemClass := TMemory.Create;
+    result := FMemClass;
 end;
+class function TSystem.ClassName: String;
+begin
+    result := 'TSystem';;
+end;
+class function TSystem.ClassParent: TObject;
+begin
+    result := Parent;
+end;
+class function TMemory.GetParent: TObject;
+begin
+    result := FClassParent;
+end;
+
+
+{ TMemory }
 
 constructor TMemory.Create;
 begin
@@ -108,16 +176,12 @@ destructor TMemory.Destroy;
     inherited Destroy;
 end;
 
-class function TMemory.GetParent: TObject;
-begin
-    result := FClassParent;
-end;
 class function TMemory.ClassParent: TObject;
 begin
     result := Parent;
 end;
 
-function TMemory.ClassName: String;
+class function TMemory.ClassName: String;
 begin
     result := 'TMemory';
 end;
@@ -146,7 +210,7 @@ function TMemory.Alloc(ASize: DWORD): Pointer;
 end;
 procedure TMemory.Alloc;
 begin
-    self.Alloc(1024);
+    self.Alloc(512);
 end;
 
 procedure TMemory.Free;