Ada Bare Bones: Difference between revisions

From OSDev.wiki
Jump to navigation Jump to search
[unchecked revision][unchecked revision]
Content added Content deleted
Line 49: Line 49:
done
done
</source>
</source>


===Exception handling===

I have based my knowledge of this kind of work on GNAT's High Integrity Edition manual, in which is hints that at this level of work, a programmer should be able to declare their own exceptions and be able to raise them. I have had it confirmed via a [http://gcc.gnu.org/bugzilla/show_bug.cgi?id=53684 bug I filed] that this is not the case. Any attempt to do this requests that a package from the RTS called Ada.Exceptions be present, I have experimented by creating a version of this package:

<source lang="ada">
with System;

package Ada.Exceptions is
pragma Preelaborate (Exceptions);

type Exception_Id is private;
pragma Preelaborable_Initialization (Exception_Id);

Null_Id : constant Exception_Id;

procedure Raise_Exception
(E : Exception_Id;
Message : String := "");
pragma No_Return (Raise_Exception);
private
type Exception_Id is new Natural;

Null_Id : constant Exception_Id := Exception_Id'First;
end Ada.Exceptions;

with GNAT.Source_Info;
with Last_Chance_Handler;

package body Ada.Exceptions is
procedure Raise_Exception
(E : Exception_Id;
Message : String := "") is
pragma Unreferenced (E);
pragma Unreferenced (Message);
File : String := GNAT.Source_Info.File;
Line : Positive := GNAT.Source_Info.Line;
Source_Location : String := GNAT.Source_Info.Source_Location;
Enclosing_Entity : String := GNAT.Source_Info.Enclosing_Entity;
pragma Unreferenced (File, Line, Source_Location, Enclosing_Entity);
begin
Last_Chance_Handler (System.Null_Address, 0);

loop
null;
end loop;
end Raise_Exception;
end Ada.Exceptions;
</source>

This seemed to work until I tried to catch the exception inside bare_bones.adb at which point the compiler threw up a number of warnings, resulting in a compile failure:

<pre>
bare_bones.adb:23:17: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:23:17: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:30:07: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:30:07: warning: Last_Chance_Handler will be called on exception
bare_bones.adb:33:17: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:33:17: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:38:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:38:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:44:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:44:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:50:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:50:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:56:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:56:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:61:42: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:61:42: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:86:21: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:86:21: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:86:30: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:86:30: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:86:39: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:86:39: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:89:26: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:89:26: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:97:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:97:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:104:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:104:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:110:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:110:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:124:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:124:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:130:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:130:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:136:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:136:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:142:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:142:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:148:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:148:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:151:04: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:151:04: warning: Last_Chance_Handler will be called on exception
bare_bones.adb:160:04: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:160:04: warning: this handler can never be entered, and has been removed
bare_bones.adb:160:09: violation of restriction "No_Exception_Propagation" at ../gnat.adc:10
gnatmake: "/home/laguest/src/mine/bare_bones/src/bare_bones.adb" compilation error
make: *** [disk/boot/bare_bones] Error 4
</pre>

So the net effect of this is to not bother with this package and only use the language defined exceptions for bare metal programming.


==Files==
==Files==

Revision as of 15:15, 17 June 2012

Difficulty level

Medium
Kernel Designs
Models
Other Concepts

In this tutorial we will compile a simple Ada kernel and boot it.

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

Preface

This tutorial is based on my multiboot kernel which I developed some time ago (originating from 2000!!) and placed on my site [1] and will also be the basis for my own kernel TAMP.

One of the first things people ask on the Ada IRC channel on Freenode is "Can Ada be used for OS development?" to which the answer is a resounding yes. But there are 2 problems:

  1. The people asking this question are new to Ada, and
  2. GNAT is not the easiest compiler to build.

Therefore these users don't understand what it takes to get the compiler into a useable state.

As you may have seen from other bare bones tutorials on this site, they state that you must have a compiler built which can handle ELF files, the usual way is by building GCC which targets i386-elf or some other similar architecture. The problem here is that GNAT will not build for these targets out of the box without messing with it's makefile. You have to do this as the makefile builds the RTS and then the gnat tools (gnatmake, gnatbind, et al) which must all be built to have a working compiler - even though we will be replacing the RTS with our own cut down version.

For this tutorial, we will use the system GNAT compiler to build for a PC i386. GNAT is part of GCC. Later I will show how to build an arm-elf compiler and tools. My OS is Debian testing 64-bit with GNAT 4.6.

GNAT and the Ada runtime system (RTS)

For this kernel we will be configuring a zero footprint RTS profile. This basically means, we have a compiler, tools and not much else.

Directory structure

We need a place to structure this kernel,

mkdir -p bare_bones/src/pc
cd bare_bones
mkdir -p rts/boards/i386/adalib
mkdir -p rts/boards/i386/adainclude
mkdir -p rts/src
mkdir -p obj

RTS files to copy

You will need to copy the following files from your compiler's RTS directory into rts/src and then create symbolic links from them to rts/boards/<arch>/adainclude where your arch is i386 or arm, etc.

N.B: You need to modify the location where these files are copied from, I've just used the location from my machine, which is most likely different to yours.

for f in "ada.ads" "a-unccon.ads" "a-uncdea.ads" "gnat.ads" "g-souinf.ads" "interfac.ads" "s-atacco.adb" "s-atacco.ads" "s-maccod.ads" "s-stoele.adb" "s-stoele.ads"
do
cp /usr/lib/gcc/x86_64-linux-gnu/4.6/adainclude/$f rts/src/
ln -s `pwd`/rts/src/$f `pwd`/rts/boards/i386/adainclude/$f
done


Exception handling

I have based my knowledge of this kind of work on GNAT's High Integrity Edition manual, in which is hints that at this level of work, a programmer should be able to declare their own exceptions and be able to raise them. I have had it confirmed via a bug I filed that this is not the case. Any attempt to do this requests that a package from the RTS called Ada.Exceptions be present, I have experimented by creating a version of this package:

with System;

package Ada.Exceptions is
   pragma Preelaborate (Exceptions);

   type Exception_Id is private;
   pragma Preelaborable_Initialization (Exception_Id);

   Null_Id : constant Exception_Id;

   procedure Raise_Exception
     (E       : Exception_Id;
      Message : String := "");
   pragma No_Return (Raise_Exception);
private
   type Exception_Id is new Natural;

   Null_Id : constant Exception_Id := Exception_Id'First;
end Ada.Exceptions;

with GNAT.Source_Info;
with Last_Chance_Handler;

package body Ada.Exceptions is
   procedure Raise_Exception
     (E       : Exception_Id;
      Message : String := "") is
      pragma Unreferenced (E);
      pragma Unreferenced (Message);
      File             : String := GNAT.Source_Info.File;
      Line             : Positive := GNAT.Source_Info.Line;
      Source_Location  : String := GNAT.Source_Info.Source_Location;
      Enclosing_Entity : String := GNAT.Source_Info.Enclosing_Entity;
      pragma Unreferenced (File, Line, Source_Location, Enclosing_Entity);
   begin
      Last_Chance_Handler (System.Null_Address, 0);

      loop
         null;
      end loop;
   end Raise_Exception;
end Ada.Exceptions;

This seemed to work until I tried to catch the exception inside bare_bones.adb at which point the compiler threw up a number of warnings, resulting in a compile failure:

bare_bones.adb:23:17: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:23:17: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:30:07: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:30:07: warning: Last_Chance_Handler will be called on exception
bare_bones.adb:33:17: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:33:17: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:38:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:38:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:44:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:44:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:50:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:50:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:56:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:56:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:61:42: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:61:42: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:86:21: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:86:21: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:86:30: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:86:30: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:86:39: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:86:39: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:89:26: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:89:26: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:97:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:97:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:104:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:104:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:110:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:110:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:124:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:124:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:130:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:130:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:136:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:136:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:142:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:142:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:148:20: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:148:20: warning: "Constraint_Error" may call Last_Chance_Handler
bare_bones.adb:151:04: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:151:04: warning: Last_Chance_Handler will be called on exception
bare_bones.adb:160:04: warning: pragma Restrictions (No_Exception_Propagation) in effect
bare_bones.adb:160:04: warning: this handler can never be entered, and has been removed
bare_bones.adb:160:09: violation of restriction "No_Exception_Propagation" at ../gnat.adc:10
gnatmake: "/home/laguest/src/mine/bare_bones/src/bare_bones.adb" compilation error
make: *** [disk/boot/bare_bones] Error 4

So the net effect of this is to not bother with this package and only use the language defined exceptions for bare metal programming.

Files

gnat.adc

This file in the root directory of the build tells GNAT there are some configuration pragmas to apply to the build. These pragmas can also be placed at the start of your custom sytem.ads (see below), but we'll place them here for now.

Note: Do not use pragma No_Run_Time as it is obsolete and has been for a number of years now!

What these do is to tell GNAT how much of the RTS we can use in our kernel, which is not a lot really.

pragma Discard_Names;
pragma Restrictions (No_Enumeration_Maps);
pragma Normalize_Scalars;
pragma Restrictions (No_Exception_Propagation);
pragma Restrictions (No_Finalization);
pragma Restrictions (No_Tasking);
pragma Restrictions (No_Protected_Types);
pragma Restrictions (No_Delay);
pragma Restrictions (No_Recursion);
pragma Restrictions (No_Allocators);
pragma Restrictions (No_Dispatch);
pragma Restrictions (No_Implicit_Dynamic_Code);
pragma Restrictions (No_Secondary_Stack);

By passing the -r flag to the binder (inside the bare_bones.gpr file), the binder will list further restrictions you can apply to enforce further checks.

   package Binder is
      for Default_Switches ("Ada") use ("-r");
   end Binder;

Discard_Names

In Ada, the compiler generates strings for various data types, e.g. enumerations, these strings can then be used in I/O.

type Fruit is (Orange, Banana, Apple);
--  Ada defines the following strings, "Orange", "Banana" and "Apple" in an array.

--  These strings can be accessed using the 'Image attribute, as in
Put (Fruit'Image (Orange));
--  Prints "Orange" to the console.

This pragma tells the compiler not to generate these tables.

Normalize_Scalars

Forces all scalars to be initialised, see the latest GNAT RM:Normalize_Scalars for more information.

No_Exception_Propagation

This forces the compiler to disallow any attempt to raise an exception over a subprogram boundary. All exceptions are caught with the Last_Chance_Handler subprogram. See GNAT RM:No_Exception_Propagation for more information.

The GNAT High Integrity Edition documentation states the folowing:

Exception declarations and raise statements are still permitted under this restriction. A raise statement is compiled into a call of __gnat_last_chance_handler.

I have been unable, thus far, to raise my own exceptions, although I can declare one at library level. On placing a declaration inside console.ads:

   TE : exception;  --  A badly named exception.

and raising inside bare_bones.adb:

   raise Console.TE;
exception
   when Console.TE =>
      Put ("TE caught", 1, 2);

and upon compiling, I get the following:

bare_bones.adb:17:04: construct not allowed in configurable run-time mode
bare_bones.adb:17:04: file a-except.ads not found
bare_bones.adb:17:04: entity "Ada.Exceptions.Raise_Exception" not available
gnatmake: "/home/laguest/src/mine/bare_bones/src/bare_bones.adb" compilation error
make: *** [disk/boot/bare_bones] Error 4

so the compiler is looking for the Ada.Exceptions package which defines the normal language standard exception handling, not the cut down version we are using here. Do the same with one of the language defined exceptions works fine. I will file a bug at FSF for this as I believe it to be incorrect.

No_Finalization

Controlled types cannot be used, see GNAT RM:No_Finalization for more information.

No_Tasking

Turns off tasking, so you cannot define tasks or protected objects or do anything related to tasking, see GNAT RM:No_Tasking for more information.

No_Protected_Types

This is pretty much here for reinforcement of the above restriction. See GNAT RM:No_Protected_Types for more information.

No_Delay

You cannot use delay statements or the calendar package, see GNAT RM:No_Delay for more information.

No_Recursion

Should be self evident, see GNAT RM:No_Recursion for more information.

No_Allocators

You cannot use dynamic memory, see GNAT RM:No_Allocators for more information.

No_Dispatch

You cannot call a subprogram using Ada's object-orientated mechanism, see GNAT RM:No_Dispatch for more information.

No_Implicit_Dynamic_Code

You cannot use nested subprograms or any other features that generate trampolines on the stack, see GNAT RM:No_Implicit_Dynamic_Code for more information.

No_Secondary_Stack

Without a secondary stack, you cannot return unconstrained types, such as strings or variant records, see GNAT RM:No_Secondary_Stack for more information.

What this also means is you cannot use the runtime features 'Image and 'Val on any types, this would be useful for sending debugging info to the console, i.e. means you don't have to write your own code for converting strings to/from numbers.

I believe that it would be a good idea to have a small secondary stack defined in the assembler startup code, but define your own System.Secondary_Stack (s-secsta.ad[sb]) package which provides the correct API. Inside this package in it's executable part, you could then import the secondary stack from the assembly code, this would then be executed on elaboration of the package at the start of the kernel's execution.

system.ads

Every Ada program must have access to the System package, this essentially tells the compiler what kind of hardware we are building for, therefore there will be 1 system.ads file per architecture your kernel supports.

Copy a system.ads from GCC that matches the target you are working with, in our case this is gcc-<version>/gcc/ada/system-linux-x86.ads, name it system.ads and place it into rts/boards/i386/ we need to edit this a bit.

We don't need to change anything from the top as all the integer sizes should be correct. Go to the private part of the spec and change the following values:

  1. Command_Line_Args => False
  2. Configurable_Run_Time => True
  3. Exit_Status_Supported => False
  4. Stack_Check_Probes => False
  5. Suppress_Standard_Library => True
  6. ZCX_By_Default => False
  7. GCC_ZCX_Support => False

For more information on these options, see gcc-<version>/gcc/ada/targparm.ads.

Also, add the following line in the private part of the package:

private

   Run_Time_Name : constant String := "Bare Bones Run Time";

According to targparm.ads, it must be the first thing after the private keyword. It should also show up in error messages in parentheses, but I've not managed to get it to show up thus far. This is useful as it should show you which RTS you are currently using, just in case you configure your build incorrectly.

Last chance handler

When you start to write and compile Ada using this custom environment, the compiler will automatically place calls from the runtime into your final binary (this is what the compiler normally does, but we've restricted it a lot). One of these calls is to Last_Chance_Handler so create 2 new files and place into rts/boards/<arch>/adainclude, as follows.

last_chance_handler.ads

with System;

procedure Last_Chance_Handler
  (Source_Location : System.Address; Line : Integer);
pragma Export (C, Last_Chance_Handler, "__gnat_last_chance_handler");

last_chance_handler.adb

procedure Last_Chance_Handler
  (Source_Location : System.Address; Line : Integer) is
   pragma Unreferenced (Source_Location, Line);
begin
   --  TODO: Add in code to dump the info to serial/screen which
   --  is obviously board specific.
   loop
      null;
   end loop;
end Last_Chance_Handler;

As you can see, the meat of the handler is actualy a null loop at the moment, this is something you need to complete for your OS kernel and also, per platform.

Compiling the runtime

Create a file called gnat.gpr in the root directory and copy the following into it:

library project gnat is
   type Arch_Name is ("i386", "arm");
   type Board_Name is ("pc", "rpi");

   Arch  : Arch_Name  := "i386";
   Board : Board_Name := external ("Board");

   case Board is
      when "pc" =>
         Arch := "i386";
      when "rpi" =>
         Arch  := "arm";
   end case;

   for Source_Dirs use ("rts/boards/" & Arch & "/adainclude");
   for Object_Dir use "obj"; --"rts/boards/" & Arch & "/adalib";

   package Builder is
      Basic_Switches := ("-gnat2005", "-g", "-x", "-a", "-gnatg",
			 "-gnatec=../gnat.adc");

      case Board is
         when "pc" =>
            for Default_Switches ("Ada") use Basic_Switches &
               ("-m32", "-march=i386");
         when "rpi" =>
            for Default_Switches ("Ada") use Basic_Switches &
               ("-march=armv6zk", "-mfpu=vfp", "-mfloat-abi=hard", "-marm",
                "-mcpu=arm1176jzf-s", "-mtune=arm1176jzf-s");
      end case;
   end Builder;

   package Compiler is
      for Default_Switches ("Ada") use ("-O2", "-ffunction-sections", "-fdata-sections");
   end Compiler;

   for Library_Kind use "static";
   for Library_Name use "gnat-4.6";
   for Library_Dir use "rts/boards/" & Arch & "/adalib";
end gnat;

Now compile with the following command:

gnatmake -XBoard=pc -Pgnat.gpr

Inside rts/boards/i386/adainclude/ you should have the RTS sources symbolically linked along with the custom last_chance_hander and system files. Inside rts/boards/i386/adalib/ you should have the libgnat-4.6.a and also *.ali matching the source which are required by GNAT.

startup.s

This is PC specific so place this in the src/pc directory.

GAS

.global startup                         # making entry point visible to linker

# setting up the Multiboot header - see GRUB docs for details
.set ALIGN,    1<<0                     # align loaded modules on page boundaries
.set MEMINFO,  1<<1                     # provide memory map
.set FLAGS,    ALIGN | MEMINFO          # this is the Multiboot 'flag' field
.set MAGIC,    0x1BADB002               # 'magic number' lets bootloader find the header
.set CHECKSUM, -(MAGIC + FLAGS)         # checksum required

.align 4
.long MAGIC
.long FLAGS
.long CHECKSUM

# reserve initial kernel stack space
.set STACKSIZE, 0x4000                  # that is, 16k.
# On my binutils the following line didn't work as the .lcomm instruction takes 2 parameters.
#.lcomm stack, STACKSIZE, 32             # reserve 16k stack on a doubleword boundary
.lcomm stack, STACKSIZE                 # reserve 16k stack
.comm  mbd, 4                           # we will use this in kmain
.comm  magic, 4                         # we will use this in kmain

startup:
    movl  $(stack + STACKSIZE), %esp    # set up the stack
    movl  %eax, magic                   # Multiboot magic number
    movl  %ebx, mbd                     # Multiboot data structure

    call  main                          # call main created by gnatbind

    cli
hang:
    hlt                                 # halt machine should kernel return
    jmp   hang

multiboot.ads

--  TODO

Console

Disclaimer: I wrote this package a long time ago and have reformatted it using my current Ada programming style. I have not gone too far into the code, so it may not be the best implementation of an console.

The following 2 files give you access to the VGA console at 80x25 characters. As they are PC specific, they go into the src/pc directory.

console.ads

with System;

package Console is
   pragma Preelaborate (Console);

   type Background_Colour is
     (Black,
      Blue,
      Green,
      Cyan,
      Red,
      Magenta,
      Brown,
      Light_Grey);

   for Background_Colour use
     (Black      => 16#0#,
      Blue       => 16#1#,
      Green      => 16#2#,
      Cyan       => 16#3#,
      Red        => 16#4#,
      Magenta    => 16#5#,
      Brown      => 16#6#,
      Light_Grey => 16#7#);

   for Background_Colour'Size use 4;

   type Foreground_Colour is
     (Black,
      Blue,
      Green,
      Cyan,
      Red,
      Magenta,
      Brown,
      Light_Grey,
      Dark_Grey,
      Light_Blue,
      Light_Green,
      Light_Cyan,
      Light_Red,
      Light_Magenta,
      Yellow,
      White);

   for Foreground_Colour use
     (Black         => 16#0#,
      Blue          => 16#1#,
      Green         => 16#2#,
      Cyan          => 16#3#,
      Red           => 16#4#,
      Magenta       => 16#5#,
      Brown         => 16#6#,
      Light_Grey    => 16#7#,
      Dark_Grey     => 16#8#,
      Light_Blue    => 16#9#,
      Light_Green   => 16#A#,
      Light_Cyan    => 16#B#,
      Light_Red     => 16#C#,
      Light_Magenta => 16#D#,
      Yellow        => 16#E#,
      White         => 16#F#);

   for Foreground_Colour'Size use 4;

   type Cell_Colour is
      record
         Foreground : Foreground_Colour;
         Background : Background_Colour;
      end record;

   for Cell_Colour use
      record
         Foreground at 0 range 0 .. 3;
         Background at 0 range 4 .. 7;
      end record;

   for Cell_Colour'Size use 8;

   type Cell is
      record
         Char   : Character;
         Colour : Cell_Colour;
      end record;

   for Cell'Size use 16;

   Screen_Width  : constant Natural := 80;
   Screen_Height : constant Natural := 25;

   subtype Screen_Width_Range  is Natural range 1 .. Screen_Width;
   subtype Screen_Height_Range is Natural range 1 .. Screen_Height;

   type Row    is array (Screen_Width_Range)  of Cell;
   type Screen is array (Screen_Height_Range) of Row;

   Video_Memory : Screen;

   for Video_Memory'Address use System'To_Address (16#000B_8000#);

   pragma Import (Ada, Video_Memory);

   procedure Put
     (Char       : in Character;
      X          : in Screen_Width_Range;
      Y          : in Screen_Height_Range;
      Foreground : in Foreground_Colour := White;
      Background : in Background_Colour := Black);

   procedure Put
     (Str        : in String;
      X          : in Screen_Width_Range;
      Y          : in Screen_Height_Range;
      Foreground : in Foreground_Colour := White;
      Background : in Background_Colour := Black);

   procedure Clear (Background : in Background_Colour := Black);
end Console;

console.adb

package body Console is
   procedure Put
     (Char       : in Character;
      X          : in Screen_Width_Range;
      Y          : in Screen_Height_Range;
      Foreground : in Foreground_Colour := White;
      Background : in Background_Colour := Black) is
   begin
      Video_Memory (Y)(X).Char              := Char;
      Video_Memory (Y)(X).Colour.Foreground := Foreground;
      Video_Memory (Y)(X).Colour.Background := Background;
   end Put;

   procedure Put
      (Str        : in String;
       X          : in Screen_Width_Range;
       Y          : in Screen_Height_Range;
       Foreground : in Foreground_Colour := White;
       Background : in Background_Colour := Black) is
   begin
      for Index in Str'First .. Str'Last loop
         Put (Str (Index),
              X + Screen_Width_Range (Index) - 1,
              Y,
              Foreground,
              Background);
      end loop;
   end Put;

   procedure Clear (Background : in Background_Colour := Black) is
   begin
      for X in Screen_Width_Range'First .. Screen_Width_Range'Last loop
         for Y in Screen_Height_Range'First .. Screen_Height_Range'Last loop
            Put (' ', X, Y, Background => Background);
         end loop;
      end loop;
   end Clear;
end Console;

bare_bones.adb

This is platform independent and therefore goes into the src directory.

with Console; use Console;

procedure Bare_Bones is
begin
   Clear;

   Put ("Hello, bare bones in Ada.",
        Screen_Width_Range'First,
        Screen_Height_Range'First);
end Bare_Bones;
pragma No_Return (Bare_Bones);

linker.ld

This is a PC specific script so goes into the src/pc directory.

OUTPUT_FORMAT(elf32-i386)

/* Tell the linker which startup code to use, we do this as there is no way to do this (well not easily) from the GNAT tools. */
STARTUP(startup.o)

ENTRY (startup)

SECTIONS
{
    . = 0x00100000;

    .text :{
        code = .; _code = .; __code = .;
        *(.text)
        *(.rodata)
    }

    .rodata ALIGN (0x1000) : {
        *(.rodata)
    }

    .data ALIGN (0x1000) : {
        data = .; _data = .; __data = .;
        *(.data)
    }

    .bss : {
        sbss = .;
        bss = .; _bss = .; __bss = .;
        *(COMMON)
        *(.bss)
        ebss = .;
    }
    end = .; _end = .; __end = .;
}

makefile

Place this file in the root directory.

ARCH		=	i386
RTS_DIR		=	`pwd`/rts/boards/$(ARCH)

ifeq ($(ARCH),i386)
GNATMAKE	=	gnatmake
AS		=	as
ASFLAGS		=	--32 -march=i386

OBJS		=	obj/startup.o obj/multiboot.o obj/console.o
BOARD		=	pc

.PHONY: obj/multiboot.o obj/console.o

endif

all: bare_bones

bare_bones: $(OBJS) src/bare_bones.adb
	$(GNATMAKE) --RTS=$(RTS_DIR) -XBoard=$(BOARD) -Pbare_bones.gpr

obj/startup.o: src/$(BOARD)/startup.s
	$(AS) $(ASFLAGS) src/$(BOARD)/startup.s -o obj/startup.o

.PHONY: clean

clean:
	-rm obj/* *~ bare_bones

bare_bones.gpr

Place this file in the root directory.

project Bare_Bones is
   type Arch_Name is ("i386", "arm");
   type Board_Name is ("pc", "rpi");

   Arch  : Arch_Name  := "i386";
   Board : Board_Name := external ("Board");

   -- TODO: Add in a case statement that adds an arch dir to source.

   case Board is
      when "pc" =>
         for Source_Dirs use ("src", "src/pc");
      when "rpi" =>
         for Source_Dirs use ("src", "src/rpi");
   end case;

   for Object_Dir use "obj";
   for Exec_Dir use ".";
   for Main use ("bare_bones.adb");

   package Builder is
      Basic_Switches := ("-gnat2005", "-g", "-x", "-a", "-gnatg",
                         "-gnatec=../gnat.adc", "-gnaty-I", "-gnaty+d");

      case Board is
         when "pc" =>
            for Default_Switches ("Ada") use Basic_Switches &
               ("-m32", "-march=i386");
         when "rpi" =>
            for Default_Switches ("Ada") use Basic_Switches &
               ("-march=armv6zk", "-mfpu=vfp", "-mfloat-abi=hard", "-marm",
                "-mcpu=arm1176jzf-s", "-mtune=arm1176jzf-s");
      end case;
   end Builder;

   package Compiler is
      case Board is
         when "pc" =>
            for Default_Switches ("Ada") use
               ("-O0", "-g", "-ggdb", "-ffunction-sections", "-fdata-sections");
         when "rpi" =>
            for Default_Switches ("Ada") use
               ("-O0", "-g", "-ggdb", "-ffunction-sections", "-fdata-sections");

      end case;
   end Compiler;

-- To reduce size of final binary.
   package Linker is
      for Default_Switches ("Ada") use
         ("-Wl,--gc-sections", "-static", "-nostartfiles", "-nodefaultlibs",
          "-T../src/" & Board & "/linker.ld", "-v");
   end Linker;
end Bare_Bones;

Testing

Make sure you have built the RTS above before this next stage otherwise you won't be able to compile the kernel.

make

qemu -kernel bare_bones

On the QEMU window, it should clear the screen, the the cursor won't move so it will be in the middle of the screen, in the top-left corner will be the message "Hello, bare bones in Ada."

Source access

I have created a Git repository on GitHub containing the source above so you don't have to do it by hand if you don't want to.

Future

  1. Implement a Raspberry Pi version.
  2. Implement a secondary stack so we can use 'Image attributes.
  3. Implement a 64-bit version (non EFI).
  4. Implement a (U)EFI version.