Delphi Kernel Source

ekremkocak · Post by **ekremkocak** » Sat Jul 11, 2015 4:09 am

//------------------------------------------------------------------------------------------------------------//
//               Code By Ekrem KOCAK                                                                          //
//             [email protected]                                                                         //
//                  Kırşehir  2006                                                                           //                                                                                                                                                                                                                   //
//                                                                                                            //
//----------------------------------------------------------------------------------------------------------- //


program CreateKernel;

{$APPTYPE CONSOLE}
uses
  Windows,SysUtils,Classes,Dialogs;


Type
  TMultibootheader= packed record
      magic         :DWORD;
      flags         :DWORD;
      checksum      :DWORD;
      header_addr   :DWORD;
      load_addr     :DWORD;
      load_end_addr :DWORD;
      bss_end_addr  :DWORD;
      entry_addr    :DWORD;
      mode_type     :DWORD;
      width         :DWORD;
      height        :DWORD;
      depth         :DWORD;
  end;

//------------- Kernel Code  Begin --------------------------

procedure Main(); stdcall;forward;

procedure  loader; stdcall;
asm
   cli
   call   main
   hlt
end;

function Screen():PChar; stdcall; //Video bellek bölgesini gösteren işaretçi
begin
  Result:=PChar($B8000);
end;


procedure Cls(); stdcall;
var
 i: integer;
begin
   for i:=0 to 2000 do
   begin
      Screen[i*2]:=#0;
      Screen[i*2-1]:=char(6); //color white
   end;
end;

procedure putpixel(X, Y: integer; text:Char;Color:Byte); stdcall;
var
 address: Word;
begin
    address:= X*2 + Y * 160;
    Screen[address]:= text;
    Screen[address+1]:= char(Color);
end;



procedure WriteLn(X, Y: integer;Text : PCHAR; Color:Byte); stdcall;
var
 address: Word;
 i: integer;
begin

  i:=0;
  repeat
    address:= X*2 + Y * 160;
    Screen[address]:= (text[i]);
    Screen[address+1]:= char(Color);
    inc(x);
    i:=i + 1;
  until text[i] = #0

end;


procedure Main(); stdcall;
var
 Str:pchar;
begin
    Cls();
    str:='Merhaba Dünya';
    WriteLn(1,2,Str,4);
end;

procedure loader_end();
begin
end;
//------------- Kernel Code  End --------------------------


var
 Multibootheader:TMultibootheader;
 MemoryStream:TMemoryStream;
 pFunc:  Pointer;
 dwSize: DWORD;
 fwSize: DWORD;
 pBuff:  Pointer;

 ImageBase        : Integer;
 Entry_addr       : Integer;

begin
   // Project > Options... > Packages Tab > Runtime packages group box > Build witg runtime packages check box  true
   ImageBase := $00400000; // Project > Options... > Linker Tab > Memory sizes group box > Image Base
   Entry_Addr:= DWORD(@loader) - ImageBase ;

   //showmessage(inttohex(entry_addr,8) );
  MemoryStream:=TMemoryStream.Create;
  try
    FillChar(Multibootheader, 48, #0);
    Multibootheader.magic         := ($1BADB002);
    Multibootheader.flags         := (1 shl 16) ;
    Multibootheader.checksum      := DWORD(-($1BADB002 + (1 shl 16)));
    Multibootheader.header_addr   := ($00400000);
    Multibootheader.load_addr     := ($00400000);
    Multibootheader.load_end_addr := ($00000000);
    Multibootheader.bss_end_addr  := ($00000000);
    Multibootheader.entry_addr    := DWORD(ImageBase + Entry_Addr );
    Multibootheader.mode_type     := ($00000000);
    Multibootheader.width         := ($00000000);
    Multibootheader.height        := ($00000000);
    Multibootheader.depth         := ($00000000);

    MemoryStream.Write(Multibootheader, SizeOf(Multibootheader));

    dwSize := Entry_Addr - Sizeof(Multibootheader)  ;
    GetMem(pBuff, dwSize);
    ZeroMemory(pBuff, dwSize);
    MemoryStream.Write(pBuff^, dwSize);
    FreeMem(pBuff, dwSize);

    pFunc := @loader;
    fwSize := DWORD(@loader_end) - DWORD(@loader);

    dwSize :=  $1000 - (fwSize);
    GetMem(pBuff, dwSize);
    ZeroMemory(pBuff, dwSize);
    MemoryStream.Write(pFunc^, fwSize);
    MemoryStream.Write(pBuff^, dwSize);
    FreeMem(pBuff, dwSize);
    
    MemoryStream.SaveToFile('Kernel.bin');
  finally
    MemoryStream.Free;
  end;

end.

ekremkocak · Post by **ekremkocak** » Sat Jul 11, 2015 4:10 am

qemu.exe -kernel kernel.bin

Artlav · Post by **Artlav** » Tue Aug 18, 2015 5:12 pm

That is so cool!
I had to clean up the code to get it working, but it does work.
Also made it more portable - works with FPC now (Compile with -Mdelphi) and every Delphi version.

Code: Select all

//----------------------------------------------------------------------------//
//Code By Ekrem KOCAK
//[email protected]
//Kirsehir 2006
//----------------------------------------------------------------------------//
program create_kernel;
{$APPTYPE CONSOLE}

type
Tmultiboot_hdr=packed record
 magic:cardinal;
 flags:cardinal;
 checksum:cardinal;
 header_addr:cardinal;
 load_addr:cardinal;
 load_end_addr:cardinal;
 bss_end_addr:cardinal;
 entry_addr:cardinal;
 mode_type:cardinal;
 width:cardinal;
 height:cardinal;
 depth:cardinal;
end;

//------------- Kernel Code Begin --------------------------
procedure main;stdcall;forward;

procedure loader;stdcall;
begin
 asm
  cli
  call main
  hlt
 end;
end;

//Video bellek b?lgesini g?steren i?aret?i
function screen:pchar;stdcall;
begin
 result:=pchar($B8000);
end;

procedure cls;stdcall;
var i:integer;
begin
 for i:=0 to 2000 do begin
  screen[i*2]:=#0;
  screen[i*2-1]:=char(6); //color white
 end;
end;

procedure putpixel(x,y:integer;text:char;color:byte);stdcall;
var address:word;
begin
 address:=x*2+y*160;
 Screen[address]:=text;
 Screen[address+1]:=char(Color);
end;

procedure writeln(x,y:integer;text:pchar;color:byte);stdcall;
var address:word;
i:integer;
begin
 i:=0;
 repeat
  address:=x*2+y*160;
  screen[address]:=text[i];
  screen[address+1]:=char(color);
  inc(x);
  i:=i+1;
 until text[i]=#0
end;

procedure main;stdcall;
var str:pchar;
begin
 cls();
 str:='Merhaba Dunya';
 writeln(1,2,Str,4);
end;

procedure loader_end;
begin
end;
//------------- Kernel Code End --------------------------

var
multiboot_hdr:Tmultiboot_hdr;

size,fsize:cardinal;
buf,fnc:pointer;

image_base,image_size:integer;
entry_addr:integer;

f:file;

begin
 assignfile(f,'kernel.bin');
 rewrite(f,1);
 
 //Project > Options... > Packages Tab > Runtime packages group box > Build witg runtime packages check box true
 //Project > Options... > Linker Tab > Memory sizes group box > Image Base
 image_base:=$00400000;
 entry_addr:=cardinal(@loader)-cardinal(image_base);
 size:=entry_addr-sizeof(multiboot_hdr);   
 fsize:=cardinal(@loader_end)-cardinal(@loader);

 image_size:=size+$1000;
 
 fillchar(multiboot_hdr,sizeof(multiboot_hdr),0);
 multiboot_hdr.magic:=($1BADB002);
 multiboot_hdr.flags:=(1 shl 16) ;
 multiboot_hdr.checksum:=cardinal(-multiboot_hdr.magic-multiboot_hdr.flags);
 multiboot_hdr.header_addr:=image_base;
 multiboot_hdr.load_addr:=image_base;
 multiboot_hdr.load_end_addr:=cardinal(image_base+image_size); 
 multiboot_hdr.bss_end_addr:=cardinal(image_base+image_size);
 multiboot_hdr.entry_addr:=cardinal(image_base+entry_addr);
 multiboot_hdr.mode_type:=0;
 multiboot_hdr.width:=0;
 multiboot_hdr.height:=0;
 multiboot_hdr.depth:=0;
 
 blockwrite(f,multiboot_hdr,sizeof(multiboot_hdr));
 
 getmem(buf,size);
 fillchar(buf^,size,0);
 
 blockwrite(f,buf^,size);
 
 freemem(buf);
 
 fnc:=@loader;
 getmem(buf,$1000-fsize);
 fillchar(buf^,$1000-fsize,0);
 
 blockwrite(f,fnc^,fsize);
 blockwrite(f,buf^,$1000-fsize);
 
 freemem(buf);
 
 closefile(f);
end.

ekremkocak · Post by **ekremkocak** » Mon Aug 24, 2015 9:00 am

Delphi 7 ile derlendi... I'm sorry I do not know English

ekremkocak · Post by **ekremkocak** » Mon Aug 24, 2015 9:40 am

Code: Select all

//----------------------------------------------------------------------------//
//Code By Ekrem KOCAK
//[email protected]
//Kirsehir 2006
//----------------------------------------------------------------------------//
program create_kernel;
{$APPTYPE 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;

const
  WIDTH  = 80;
  HEIGHT = 25 ;




type
Tmultiboot_hdr=packed record
magic:cardinal;
flags:cardinal;
checksum:cardinal;
header_addr:cardinal;
load_addr:cardinal;
load_end_addr:cardinal;
bss_end_addr:cardinal;
entry_addr:cardinal;
mode_type:cardinal;
width:cardinal;
height:cardinal;
depth:cardinal;
end;

//------------- Kernel Code Begin --------------------------
procedure main;stdcall;forward;

procedure loader;stdcall;
begin
asm
  cli
  call main
  hlt
end;
end;

{$include Console.inc}

//Video bellek b?lgesini g?steren i?aret?i
function screen:pchar;stdcall;
begin
result:=pchar($B8000);
end;

function Key():PChar;stdcall;
begin
  Result:='#01234567890*-#0qwertyuıopğü#0asdfghjklşi,#0zxcvbnmöç.'
end;


function MakeColor(FG, BG: Byte ):Char;
begin
    result := Char(FG or BG shl 4);
end;


procedure Cls(); stdcall;
var
 i: integer;
begin
  i:=0;
  while i< 80 * 25 * 2 do
  begin
      Screen[i]:=' ';
      Screen[i+1]:= MakeColor(Blue,Blue);
      inc(i,2);
   end;
end;


procedure WriteChar(X, Y: integer; text:Char;Color:Byte); stdcall;
var
 address: Word;
begin
    address:= X*2 + Y * 160;
    Screen[address]:= text;
    Screen[address+1]:=  MakeColor(Color,Blue);
end;


procedure WriteStr(X, Y: integer;Text : PCHAR; Color:Byte);  stdcall;
var
 address: Word;
 i: integer;
begin
  i:=0;
  repeat
    address:= X*2 + Y * 160;
    Screen[address]:= (text[i]);
    Screen[address+1]:= MakeColor(Color,Blue);
    inc(x);
    i:=i + 1;
   until text[i] = #0
end;



function Keyboard():Integer;stdcall;
var
  ScanCode :byte;
  DScanCode:byte;
begin

  while(true) do
  begin
    Scancode := ReadPortB($60);
    if(ScanCode < 100) and (ScanCode <> dScanCode) then
    begin
       case ScanCode of
           28:begin // ENTER
           WriteStr(0,0,'ENTER',White);

           end;
           57:begin // SPACE
           WriteStr(0,0,'SPACE',White);
           end;
           14:begin // BACKSPACE
           WriteStr(0,0,'BACKSPACE',White);
           end;
           else
           begin  // CHAR
             WriteChar(1,1,Key[ScanCode],White);
           end;

       end;
    end; //if
    dScanCode := ScanCode;
  end; //while

end;



procedure Main(); stdcall;
var
str:string[15];
begin
  str:='EKREM KOCAK';
  Cls();
  WriteChar(1,1,char($87),yellow);
  WriteStr(5,5, 'ayhan',White);

  Keyboard();

end;

procedure Loader_End(); begin end;

//------------- Kernel Code End --------------------------

var
multiboot_hdr:Tmultiboot_hdr;

size,fsize:cardinal;
buf,fnc:pointer;

image_base,image_size:integer;
entry_addr:integer;

f:file;

begin
assignfile(f,'kernel.bin');
rewrite(f,1);

//Project > Options... > Packages Tab > Runtime packages group box > Build witg runtime packages check box true
//Project > Options... > Linker Tab > Memory sizes group box > Image Base
image_base:=$00400000;
entry_addr:=cardinal(@loader)-cardinal(image_base);
size:=entry_addr-sizeof(multiboot_hdr);   
fsize:=cardinal(@loader_end)-cardinal(@loader);

image_size:=size+$1000;

fillchar(multiboot_hdr,sizeof(multiboot_hdr),0);
multiboot_hdr.magic:=($1BADB002);
multiboot_hdr.flags:=(1 shl 16) ;
multiboot_hdr.checksum:=cardinal(-multiboot_hdr.magic-multiboot_hdr.flags);
multiboot_hdr.header_addr:=image_base;
multiboot_hdr.load_addr:=image_base;
multiboot_hdr.load_end_addr:=cardinal(image_base+image_size);
multiboot_hdr.bss_end_addr:=cardinal(image_base+image_size);
multiboot_hdr.entry_addr:=cardinal(image_base+entry_addr);
multiboot_hdr.mode_type:=0;
multiboot_hdr.width:=0;
multiboot_hdr.height:=0;
multiboot_hdr.depth:=0;

blockwrite(f,multiboot_hdr,sizeof(multiboot_hdr));

getmem(buf,size);
fillchar(buf^,size,0);

blockwrite(f,buf^,size);

freemem(buf);

fnc:=@loader;
getmem(buf,$1000-fsize);
fillchar(buf^,$1000-fsize,0);

blockwrite(f,fnc^,fsize);
blockwrite(f,buf^,$1000-fsize);

freemem(buf);

closefile(f);
end.

ekremkocak · Post by **ekremkocak** » Mon Aug 24, 2015 9:41 am

Code: Select all

// Console.inc

{$ifndef Console}
{$define Console}

//------------------------------------------------------------------------------------------------------------//
//               Code By Ekrem KOCAK                                                                          //
//             [email protected]                                                                         //
//                  Kırşehir  2006                                                                           //                                                                                                                                                                                                                   //
//                                                                                                            //
//----------------------------------------------------------------------------------------------------------- //

function ReadPortB(port:word):byte; stdcall;
var
  temp : byte ;
asm
     mov dx,port
     in al,dx
     mov temp , al
end;

procedure WritePortB(Port: word; Value: Word);stdcall;
var
  zz:char;
begin
  zz:=char(Value);
asm
      mov dx, port
      mov al, zz
      out dx, al
 end;
end;



{$endif}

OSDev.org

Delphi Kernel Source

Delphi Kernel Source

Re: Delphi Kernel Source

Re: Delphi Kernel Source

Re: Delphi Kernel Source

Re: Delphi Kernel Source

Re: Delphi Kernel Source