OSDev.org

The Place to Start for Operating System Developers
It is currently Thu Mar 28, 2024 7:34 am

All times are UTC - 6 hours




Post new topic Reply to topic  [ 6 posts ] 
Author Message
 Post subject: Delphi Kernel Source
PostPosted: Sat Jul 11, 2015 4:09 am 
Offline

Joined: Sat Feb 21, 2015 10:39 am
Posts: 20
Code:
//------------------------------------------------------------------------------------------------------------//
//               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.


Last edited by ekremkocak on Mon Aug 24, 2015 10:10 am, edited 3 times in total.

Top
 Profile  
 
 Post subject: Re: Delphi Kernel Source
PostPosted: Sat Jul 11, 2015 4:10 am 
Offline

Joined: Sat Feb 21, 2015 10:39 am
Posts: 20
qemu.exe -kernel kernel.bin


Top
 Profile  
 
 Post subject: Re: Delphi Kernel Source
PostPosted: Tue Aug 18, 2015 5:12 pm 
Offline
Member
Member
User avatar

Joined: Fri Aug 21, 2009 5:54 am
Posts: 178
Location: Moscow, Russia
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:
//----------------------------------------------------------------------------//
//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.


Top
 Profile  
 
 Post subject: Re: Delphi Kernel Source
PostPosted: Mon Aug 24, 2015 9:00 am 
Offline

Joined: Sat Feb 21, 2015 10:39 am
Posts: 20
Delphi 7 ile derlendi... I'm sorry I do not know English


Top
 Profile  
 
 Post subject: Re: Delphi Kernel Source
PostPosted: Mon Aug 24, 2015 9:40 am 
Offline

Joined: Sat Feb 21, 2015 10:39 am
Posts: 20
Code:
//----------------------------------------------------------------------------//
//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.


Last edited by ekremkocak on Mon Aug 24, 2015 10:10 am, edited 1 time in total.

Top
 Profile  
 
 Post subject: Re: Delphi Kernel Source
PostPosted: Mon Aug 24, 2015 9:41 am 
Offline

Joined: Sat Feb 21, 2015 10:39 am
Posts: 20
Code:
// 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}


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 6 posts ] 

All times are UTC - 6 hours


Who is online

Users browsing this forum: DotBot [Bot] and 26 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group