Pascal Bare Bones

WAIT! Have you read Getting Started, Beginner Mistakes, and some of the related OS theory?

Difficulty level
Medium

Tools needed to build the project:

• FPC (You'll need the i386 version as that's the architecture we're targeting)
• NASM
• binutils(ld) built for 32-bit elf support

stub.asm

;/////////////////////////////////////////////////////////
;//                                                     //
;//               Freepascal barebone OS                //
;//                      stub.asm                       //
;//                                                     //
;/////////////////////////////////////////////////////////
;//
;//     By:             De Deyn Kim <kimdedeyn@skynet.be>
;//     License:        Public domain
;//
 
;
; Kernel stub
;
 
;
; We are in 32bits protected mode
;
[bits 32]
 
;
; Export entrypoint
;
[global kstart]
 
;
; Import kernel entrypoint
;
[extern kmain]
 
;
; Posible multiboot header flags
;
MULTIBOOT_MODULE_ALIGN          equ     1<<0
MULTIBOOT_MEMORY_MAP            equ     1<<1
MULTIBOOT_GRAPHICS_FIELDS       equ     1<<2
MULTIBOOT_ADDRESS_FIELDS        equ     1<<16
 
;
; Multiboot header defines
;
MULTIBOOT_HEADER_MAGIC          equ     0x1BADB002
MULTIBOOT_HEADER_FLAGS          equ     MULTIBOOT_MODULE_ALIGN | MULTIBOOT_MEMORY_MAP
MULTIBOOT_HEADER_CHECKSUM       equ     -(MULTIBOOT_HEADER_MAGIC + MULTIBOOT_HEADER_FLAGS)
 
;
; Kernel stack size
;
KERNEL_STACKSIZE                equ     0x4000
 
section .text
 
;
; Multiboot header
;
align 4
dd MULTIBOOT_HEADER_MAGIC
dd MULTIBOOT_HEADER_FLAGS
dd MULTIBOOT_HEADER_CHECKSUM
 
;
; Entrypoint
;
kstart:
        mov esp, KERNEL_STACK+KERNEL_STACKSIZE  ;Create kernel stack
        push eax                                ;Multiboot magic number
        push ebx                                ;Multiboot info
        call kmain                              ;Call kernel entrypoint
        cli                                     ;Clear interrupts
        hlt                                     ;Halt machine
 
section .bss
 
;
; Kernel stack location
;
align 32
KERNEL_STACK:
        resb KERNEL_STACKSIZE

kernel.pas

{
/////////////////////////////////////////////////////////
//                                                     //
//               Freepascal barebone OS                //
//                      kernel.pas                     //
//                                                     //
/////////////////////////////////////////////////////////
//
//      By:             De Deyn Kim <kimdedeyn@skynet.be>
//      License:        Public domain
//
}
 
unit kernel;
 
interface
 
uses
        multiboot,
        console;
 
procedure kmain(mbinfo: Pmultiboot_info_t; mbmagic: DWORD); stdcall;
 
implementation
 
procedure kmain(mbinfo: Pmultiboot_info_t; mbmagic: DWORD); stdcall; [public, alias: 'kmain'];
begin
        kclearscreen();
        kwritestr('Freepascal barebone OS booted!');
        xpos := 0;
        ypos += 1;
 
        if (mbmagic <> MULTIBOOT_BOOTLOADER_MAGIC) then
        begin
                kwritestr('Halting system, a multiboot-compliant boot loader needed!');
                asm
                        cli
                        hlt
                end;
        end
        else
        begin
                kwritestr('Booted by a multiboot-compliant boot loader!');
                xpos := 0;
                ypos += 2;
                kwritestr('Multiboot information:');
                xpos := 0;
                ypos += 2;
                kwritestr('                       Lower memory  = ');
                kwriteint(mbinfo^.mem_lower);
                kwritestr('KB');
                xpos := 0;
                ypos += 1;
                kwritestr('                       Higher memory = ');
                kwriteint(mbinfo^.mem_upper);
                kwritestr('KB');
                xpos := 0;
                ypos += 1;
                kwritestr('                       Total memory  = ');
                kwriteint(((mbinfo^.mem_upper + 1000) div 1024) +1);
                kwritestr('MB');
        end;
 
        asm
                @loop:
                jmp @loop
        end;
end;
 
end.

console.pas

{
/////////////////////////////////////////////////////////
//                                                     //
//               Freepascal barebone OS                //
//                       console.pas                   //
//                                                     //
/////////////////////////////////////////////////////////
//
//      By:             De Deyn Kim <kimdedeyn@skynet.be>
//      License:        Public domain
//
}
 
unit console;
 
interface
 
var
        xpos: Integer = 0;
        ypos: Integer = 0;
 
procedure kclearscreen();
procedure kwritechr(c: Char);
procedure kwritestr(s: PChar);
procedure kwriteint(i: Integer);
procedure kwritedword(i: DWORD);
 
implementation
 
var
        vidmem: PChar = PChar($b8000);
 
procedure kclearscreen(); [public, alias: 'kclearscreen'];
var
        i: Integer;
begin
        for i := 0 to 3999 do
                vidmem[i] := #0;
end;
 
procedure kwritechr(c: Char); [public, alias: 'kwritechr'];
var
        offset: Integer;
begin
        if (ypos > 24) then
                ypos := 0;
 
        if (xpos > 79) then
                xpos := 0;
 
        offset := (xpos shl 1) + (ypos * 160);
        vidmem[offset] := c;
        offset += 1;
        vidmem[offset] := #7;
        offset += 1;
 
        xpos := (offset mod 160);
        ypos := (offset - xpos) div 160;
        xpos := xpos shr 1;
end;
 
procedure kwritestr(s: PChar); [public, alias: 'kwritestr'];
var
        offset, i: Integer;
begin
        if (ypos > 24) then
                ypos := 0;
 
        if (xpos > 79) then
                xpos := 0;
 
        offset := (xpos shl 1) + (ypos * 160);
        i := 0;
 
        while (s[i] <> Char($0)) do
        begin
                vidmem[offset] := s[i];
                offset += 1;
                vidmem[offset] := #7;
                offset += 1;
                i += 1;
        end;
 
        xpos := (offset mod 160);
        ypos := (offset - xpos) div 160;
        xpos := xpos shr 1;
end;
 
procedure kwriteint(i: Integer); [public, alias: 'kwriteint'];
var
        buffer: array [0..11] of Char;
        str: PChar;
        digit: DWORD;
        minus: Boolean;
begin
        str := @buffer[11];
        str^ := #0;
 
        if (i < 0) then
        begin
                digit := -i;
                minus := True;
        end
        else
        begin
                digit := i;
                minus := False;
        end;
 
        repeat
                Dec(str);
                str^ := Char((digit mod 10) + Byte('0'));
                digit := digit div 10;
        until (digit = 0);
 
        if (minus) then
        begin
                Dec(str);
                str^ := '-';
        end;
 
        kwritestr(str);
end;
 
procedure kwritedword(i: DWORD); [public, alias: 'kwritedword'];
var
        buffer: array [0..11] of Char;
        str: PChar;
        digit: DWORD;
begin
        for digit := 0 to 10 do
                buffer[digit] := '0';
 
        str := @buffer[11];
        str^ := #0;
 
        digit := i;
        repeat
                Dec(str);
                str^ := Char((digit mod 10) + Byte('0'));
                digit := digit div 10;
        until (digit = 0);
 
        kwritestr(str);
end;
 
end.

multiboot.pas

unit multiboot;
 
interface
 
const
        KERNEL_STACKSIZE = $4000;
 
        MULTIBOOT_BOOTLOADER_MAGIC = $2BADB002;
 
type
        Pelf_section_header_table_t = ^elf_section_header_table_t;
        elf_section_header_table_t = packed record
          num: DWORD;
          size: DWORD;
          addr: DWORD;
          shndx: DWORD;
        end;
 
        Pmultiboot_info_t = ^multiboot_info_t;
        multiboot_info_t = packed record
          flags: DWORD;
          mem_lower: DWORD; { Amount of memory available below 1mb }
          mem_upper: DWORD; { Amount of memory available above 1mb }
          boot_device: DWORD;
          cmdline: DWORD;
          mods_count: DWORD;
          mods_addr: DWORD;
          elf_sec: elf_section_header_table_t;
          mmap_length: DWORD;
          mmap_addr: DWORD;
        end;
 
        Pmodule_t = ^module_t;
        module_t = packed record
          mod_start: DWORD;
          mod_end: DWORD;
          name: DWORD;
          reserved: DWORD;
        end;
 
        Pmemory_map_t = ^memory_map_t;
        memory_map_t = packed record
          size: DWORD;
          { You can declare these two as a single qword if your compiler supports it }
          base_addr_low: DWORD;
          base_addr_high: DWORD;
          { And again, these can be made into one qword variable. }
          length_low: DWORD;
          length_high: DWORD;
          mtype: DWORD;
        end;
 
implementation
 
end.

system.pas

Since fpc-3.2.0 there was added necessary parts (in code block that part was highlighted by comment lines), because without them developer could met error like:

system.pas(18,1) (system)   Parsing implementation of SYSTEM
system.pas(18,1) Fatal: Internal type "TEXCEPTADDR" was not found. Check if you use the correct run time library.
Fatal: Compilation aborted

Valid version of system.pas on 2022/12/29:

unit system;
 
{$MODE FPC}
 
interface
 
  type
    cardinal = 0..$FFFFFFFF;
    hresult = cardinal;
    dword = cardinal;
    integer = longint;
 
    pchar = ^char;
 
    { That part comes from fpc 3.2.0 as nessesary}
    TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet,
    tkMethod, tkSString, tkLString, tkAString, tkWString, tkVariant, tkArray,
    tkRecord, tkInterface, tkClass, tkObject, tkWChar, tkBool, tkInt64, tkQWord,
    tkDynArray, tkInterfaceRaw, tkProcVar, tkUString, tkUChar, tkHelper, tkFile,
    tkClassRef, tkPointer);
 
    jmp_buf = packed record
      rbx, rbp, r12, r13, r14, r15, rsp, rip: QWord;
      {$IFDEF win64}
      rsi, rdi: QWord;
      xmm6, xmm7, xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15: record 
        m1, m2: QWord;
      end;
 
      mxcsr: LongWord;
      fpucw: word;
      padding: word;
      {$ENDIF win64}
    end;
 
    Pjmp_buf = ^jmp_buf;
    PExceptAddr = ^TExceptAddr;
    TExceptAddr = record 
      buf: Pjmp_buf;
      next: PExceptAddr;
      {$IFDEF CPU16}
      frametype: SmallInt;
      {$ELSE CPU16}
      frametype: LongInt;
      {$ENDIF CPU16}
    end;
 
    PGuid = ^TGuid;
    TGuid = packed record
      case Integer of
      1:
      (Data1: DWord;
        Data2: word;
        Data3: word;
        Data4: array [0 .. 7] of byte;
      );
      2:
      (D1: DWord;
        D2: word;
        D3: word;
        D4: array [0 .. 7] of byte;
      );
      3:
      ( { uuid fields according to RFC4122 }
        time_low: DWord; // The low field of the timestamp
        time_mid: word; // The middle field of the timestamp
        time_hi_and_version: word;
        // The high field of the timestamp multiplexed with the version number
        clock_seq_hi_and_reserved: byte;
        // The high field of the clock sequence multiplexed with the variant
        clock_seq_low: byte; // The low field of the clock sequence
        node: array [0 .. 5] of byte; // The spatially unique node identifier
      );
    end;
 
{ --- End of nessesary part --- }
 
implementation
 
end.

Linker script

linker.script

ENTRY(kstart)
SECTIONS
{
  .text  0x100000 :
  {
    text = .; _text = .; __text = .;
    *(.text)
    . = ALIGN(4096);
  }
  .data  :
  {
    data = .; _data = .; __data = .;
    *(.data)
    kimage_text = .;
    LONG(text);
    kimage_data = .;
    LONG(data);
    kimage_bss = .;
    LONG(bss);
    kimage_end = .;
    LONG(end);
    . = ALIGN(4096);
  }
  .bss  :
  {
    bss = .; _bss = .; __bss = .;
    *(.bss)
    . = ALIGN(4096);
  }
  end = .; _end = .; __end = .;
}

Compiling and Linking the modules

Assemble stub.asm with:

nasm -f elf32 stub.asm -o stub.o

• -f elf32 - needed exact under x86_64 systems to make correct object file

The Pascal modules with:

fpc -Aelf -n -O3 -Op3 -Si -Sc -Sg -Xd -CX -XXs -Pi386 -Rintel -Tlinux kernel.pas

• -Aelf - instructs the internal fpc assembler to output an ELF object.;
• -n - ignores fpc.cfg;
• -O3 - perform level 3 optimizations;
• -Op3 - tune code for PentiumPro / P-II / Cyrix 6x86 / K6 (TM);
• -Si - enable C++ style INLINE keyword;
• -Sc - enable C style operators;
• -Sg - enable support for labels;
• -Xd - tells the compiler to forget the standard library path;
• -CX - tells the compiler to create smartlinkable units
• -XXs - tells the compiler to do smartlinking (-XX) and debugging symbols stripping (-Xs)
• -Pi386 - tells the compiler to force i386 mode (actual for x86_64 host systems)
• -Rintel - sets the inline assembly syntax to intel style;
• -Tlinux - specifies that the target operating system is Linux. (Provides a sensible system unit to use)

Then link the whole thing with:

i386-elf-ld --gc-sections -s -Tlinker.script -o kernel.obj stub.o kernel.o multiboot.o system.o console.o

• --gc-sections -s, in combination with -CX -XXs above, eliminates RTTI symbols from resulting binary

In case of trouble linking under x86_64 system try this line:

i686-elf-ld -A elf-386 --gc-sections -s -Tlinker.script -o kernel.obj stub.o kernel.o multiboot.o system.o console.o

Special sutuation: last time after building binutils I've got error

i386-linux-ld --gc-sections -s -Tlinker.script -o kernel.obj stub.o kernel.o multiboot.o console.o system.o
ld: i386 architecture of input file `stub.o' is incompatible with i386:x86-64 output
ld: i386 architecture of input file `kernel.o' is incompatible with i386:x86-64 output
ld: i386 architecture of input file `multiboot.o' is incompatible with i386:x86-64 output
ld: i386 architecture of input file `console.o' is incompatible with i386:x86-64 output
ld: i386 architecture of input file `system.o' is incompatible with i386:x86-64 output
make: *** [Makefile:27: _LD] Error 1

That type of error can encounter if i386-linux-ld have wrong content. In my situation file content edited to:

#!/bin/bash
/full/path/to/compiled/cross/binutils/ld-new -A elf32-i386 $@

makeiso.sh

Also a good option is create a bootable ISO file to make run it with VirtualBox or qemu:

#!/bin/sh
TMPISO=iso
TMPBOOT=${TMPISO}/boot
TMPGRUB=${TMPBOOT}/grub
TMPCFG=${TMPGRUB}/grub.cfg
 
mkdir $TMPISO
mkdir $TMPBOOT
mkdir $TMPGRUB
cp kernel.obj $TMPBOOT/kernel.obj
echo 'set timeout=0'                  > $TMPCFG
echo 'set default =0'                >> $TMPCFG
echo ''                              >> $TMPCFG
echo 'menuentry "Pascal bare" {'     >> $TMPCFG
echo '  multiboot /boot/kernel.obj'  >> $TMPCFG
echo '  boot'                        >> $TMPCFG
echo '}'                             >> $TMPCFG
grub-mkrescue --output=pascal-kernel.iso iso
rm -rf $TMPISO

And simple run:

qemu-system-i386 pascal-kernel.iso

Alternative compiling: Makefile

Accumulating the lines from previous part we can make a Makefile:

# Freepascal BareboneOS 
# Makefile 
# 			2019
# by:		furaidi <iluatitok@gmail.com>
# License:	Public domain
 
NASMPARAMS = -f elf32 -o stub.o
LDPARAMS = -A elf32-i386 --gc-sections -s -Tlinker.script -o kernel.obj
FPCPARAMS = -Aelf -n -O2 -Op3 -Si -Sc -Sg -Xd -CX -XXs -Pi386 -Rintel -Tlinux
TMPISO = iso
TMPBOOT = $(TMPISO)/boot
TMPGRUB = $(TMPBOOT)/grub
TMPCFG  = $(TMPGRUB)/grub.cfg
 
objects = stub.o kernel.o multiboot.o console.o system.o
 
_FPC:
	@echo 'Compile kernel'
	fpc $(FPCPARAMS) kernel.pas
 
_NASM:
	@echo 'Compile stub'
	nasm $(NASMPARAMS) stub.asm
 
_LD:
	@echo 'Link them together'
	i386-linux-ld $(LDPARAMS) $(objects)
 
all: _FPC _NASM _LD
 
install:
	mkdir $(TMPISO)
	mkdir $(TMPBOOT)
	mkdir $(TMPGRUB)
	cp kernel.obj $(TMPBOOT)/kernel.obj
	echo 'set timeout=0'     		 > $(TMPCFG)
	echo 'set default =0'		        >> $(TMPCFG)
	echo ''                      		>> $(TMPCFG)
	echo 'menuentry "Pascal Bare" {'	>> $(TMPCFG)
	echo '  multiboot /boot/kernel.obj'  	>> $(TMPCFG)
	echo '  boot'              		>> $(TMPCFG)
	echo '}'                      		>> $(TMPCFG)
	grub-mkrescue --output=pascal-kernel.iso $(TMPISO)
	rm -rf $(TMPISO)
 
clean:
	rm -rf $(TMPISO)
	rm -f *.o
	rm -f *.ppu

Further Steps

After when bare bones are ready and tested, you'd probably want to go with a few ways separately or combine:

• Add terminal workaround. Pure *nix way like changing terminals, built-in commands, simple user management
• Add graphic interface from start. That is Windows NT family way. You need to add SVGA-like drivers and/or mouse input and everything you need (or thinks so)

Also you may want to adapt *nix libraries such as binutils, make build target for compiling your fpc programs for your new os like i386-myos. From that point you are on your own.

See Also

External Links

• https://github.com/torokernel/torokernel/wiki/Writing-Drivers-In-Freepascal, notes about how to write drivers by using the Frepascal language.
• https://wiki.freepascal.org/System_unit, a tutorial to write a simple system unit