Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base: 46060e0a74
...
compare: 0d71181422
Checking mergeability… Don't worry, you can still create the pull request.
  • 6 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
Showing with 250 additions and 156 deletions.
  1. +39 −38 bare_bones.gpr
  2. +54 −1 gnat.adc
  3. +2 −2 gnat.gpr
  4. +45 −12 makefile
  5. +110 −103 src/bare_bones.adb
View
77 bare_bones.gpr
@@ -1,4 +1,4 @@
--- -*- Mode: Ada -*-
+-- -*- Mode: GPR -*-
-- Filename : bare_bones.gpr
-- Description : GNAT make project file for the kernel.
-- Author : Luke A. Guest
@@ -14,7 +14,7 @@ project Bare_Bones is
Bug : Bug_Name := external ("Bug");
Board : Board_Name := external ("Board");
Arch : Arch_Name := "none";
-
+
case Board is
when "pc" =>
Arch := "i386";
@@ -37,88 +37,89 @@ project Bare_Bones is
package Builder is
Basic_Switches :=
- ("-gnat2005", "-x", "-a", "-gnatg", "-gnatec=../gnat.adc", "-gnaty-I",
- "-gnaty+d");
-
+ ("-gnat05", "-x", "-a", "-gnatg", "-gnatec=../gnat.adc", "-gnaty-I",
+ "-gnaty+d");
+ --, "-fstack-check");
+
Builder_Build_Switches := ("");
Builder_Bug_Switches := ("");
Builder_Board_Switches := ("");
-
+
case Build is
when "debug" =>
Builder_Build_Switches := ("-g", "-O0");
when "release" =>
Builder_Build_Switches := ("-O2");
end case;
-
+
case Bug is
when "bug" =>
Builder_Bug_Switches := ("-gnatd.n");
when "clean" =>
Builder_Bug_Switches := ("");
end case;
-
+
case Board is
when "pc" =>
- Builder_Board_Switches := ("-m32", "-march=i386");
-
+ Builder_Board_Switches := ("-m32", "-march=i386");
+
when "rpi" =>
- Builder_Board_Switches :=
- ("-march=armv6zk", "-mfpu=vfp", "-mfloat-abi=hard", "-marm",
+ Builder_Board_Switches :=
+ ("-march=armv6zk", "-mfpu=vfp", "-mfloat-abi=hard", "-marm",
"-mcpu=arm1176jzf-s", "-mtune=arm1176jzf-s");
end case;
-
+
for Default_Switches ("Ada") use
- Basic_Switches & Builder_Build_Switches &
- Builder_Bug_Switches & Builder_Board_Switches;
+ Basic_Switches & Builder_Build_Switches &
+ Builder_Bug_Switches & Builder_Board_Switches;
end Builder;
package Compiler is
Basic_Switches := ("-ffunction-sections", "-fdata-sections");
-
+
Compiler_Build_Switches := ("");
Compiler_Bug_Switches := ("");
Compiler_Board_Switches := ("");
-
+
case Build is
when "debug" =>
Compiler_Build_Switches := ("-g", "-O0", "-g3", "-ggdb");
when "release" =>
Compiler_Build_Switches := ("-O2");
end case;
-
+
case Bug is
when "bug" =>
Compiler_Bug_Switches := ("-v");
when "clean" =>
Compiler_Bug_Switches := ("");
end case;
-
+
case Board is
when "pc" =>
- Compiler_Board_Switches := ("");
+ Compiler_Board_Switches := ("");
when "rpi" =>
- Compiler_Board_Switches := ("");
+ Compiler_Board_Switches := ("");
end case;
-
+
for Default_Switches ("Ada") use
- Basic_Switches & Compiler_Build_Switches & Compiler_Bug_Switches &
- Compiler_Board_Switches;
+ Basic_Switches & Compiler_Build_Switches & Compiler_Bug_Switches &
+ Compiler_Board_Switches;
end Compiler;
--- package Binder is
--- for Default_Switches ("Ada") use ("-m32");
--- end Binder;
+ package Binder is
+ for Default_Switches ("Ada") use ("-r");
+ end Binder;
package Linker is
Basic_Switches :=
- ("-static", "-nostartfiles", "-nodefaultlibs",
- "-T../src/" & Board & "/linker.ld");
-
+ ("-static", "-nostartfiles", "-nodefaultlibs",
+ "-T../src/" & Board & "/linker.ld");
+
Linker_Build_Switches := ("");
Linker_Bug_Switches := ("");
Linker_Board_Switches := ("");
-
+
case Build is
when "debug" =>
Linker_Build_Switches := ("");
@@ -126,23 +127,23 @@ project Bare_Bones is
-- To reduce size of final binary, strip out unused sections.
Linker_Build_Switches := ("-Wl,--gc-sections");
end case;
-
+
case Bug is
when "bug" =>
Linker_Bug_Switches := ("-v");
when "clean" =>
Linker_Bug_Switches := ("");
end case;
-
+
case Board is
when "pc" =>
- Linker_Board_Switches := ("");
+ Linker_Board_Switches := ("");
when "rpi" =>
- Linker_Board_Switches := ("");
+ Linker_Board_Switches := ("");
end case;
-
+
for Default_Switches ("Ada") use
- Basic_Switches & Linker_Build_Switches & Linker_Bug_Switches &
- Linker_Board_Switches;
+ Basic_Switches & Linker_Build_Switches & Linker_Bug_Switches &
+ Linker_Board_Switches;
end Linker;
end Bare_Bones;
View
55 gnat.adc
@@ -4,11 +4,12 @@
-- Author : Luke A. Guest
-- Created On : Thu Jun 14 12:04:52 2012
-- Licence : See LICENCE in the root directory.
+-- pragma Restrictions (No_Obsolescent_Features);
pragma Discard_Names;
pragma Restrictions (No_Enumeration_Maps);
pragma Normalize_Scalars;
pragma Restrictions (No_Exception_Propagation);
--- pragma Restrictions (No_Exception_Registration);
+pragma Restrictions (No_Exception_Registration);
-- pragma Restrictions (No_Exception_Handlers);
pragma Restrictions (No_Finalization);
pragma Restrictions (No_Tasking);
@@ -19,3 +20,55 @@ pragma Restrictions (No_Allocators);
pragma Restrictions (No_Dispatch);
pragma Restrictions (No_Implicit_Dynamic_Code);
pragma Restrictions (No_Secondary_Stack);
+
+-- The following were suggested by gnatbind -r
+pragma Restrictions (Simple_Barriers);
+pragma Restrictions (No_Abort_Statements);
+-- pragma Restrictions (No_Access_Subprograms);
+pragma Restrictions (No_Asynchronous_Control); -- Ada95 only?
+pragma Restrictions (No_Calendar);
+pragma Restrictions (No_Default_Stream_Attributes);
+pragma Restrictions (No_Dispatching_Calls);
+pragma Restrictions (No_Dynamic_Attachment);
+pragma Restrictions (No_Dynamic_Priorities);
+pragma Restrictions (No_Entry_Calls_In_Elaboration_Code);
+pragma Restrictions (No_Entry_Queue);
+pragma Restrictions (No_Fixed_Point);
+pragma Restrictions (No_Io);
+pragma Restrictions (No_Implicit_Heap_Allocations);
+pragma Restrictions (No_Initialize_Scalars);
+pragma Restrictions (No_Local_Allocators);
+pragma Restrictions (No_Local_Timing_Events);
+pragma Restrictions (No_Local_Protected_Objects);
+pragma Restrictions (No_Nested_Finalization);
+pragma Restrictions (No_Protected_Type_Allocators);
+pragma Restrictions (No_Relative_Delay);
+pragma Restrictions (No_Requeue_Statements);
+pragma Restrictions (No_Select_Statements);
+pragma Restrictions (No_Specific_Termination_Handlers);
+pragma Restrictions (No_Stream_Optimizations);
+pragma Restrictions (No_Streams);
+pragma Restrictions (No_Task_Allocators);
+pragma Restrictions (No_Task_Attributes_Package);
+pragma Restrictions (No_Task_Hierarchy);
+pragma Restrictions (No_Task_Termination);
+pragma Restrictions (No_Terminate_Alternatives);
+pragma Restrictions (No_Unchecked_Access);
+pragma Restrictions (No_Unchecked_Deallocation);
+pragma Restrictions (Static_Priorities);
+pragma Restrictions (Static_Storage_Size);
+pragma Restrictions (Immediate_Reclamation);
+pragma Restrictions (No_Wide_Characters);
+pragma Restrictions (Max_Protected_Entries => 0);
+pragma Restrictions (Max_Select_Alternatives => 0);
+pragma Restrictions (Max_Task_Entries => 0);
+pragma Restrictions (Max_Tasks => 0);
+pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
+
+-- pragma Restrictions (No_Floating_Point);
+pragma Restrictions (No_Standard_Storage_Pools);
+
+
+-- I'm not sure about this one, needs to be tested fully with data with
+-- initialisers to be certain.
+pragma Restrictions (No_Default_Initialization);
View
4 gnat.gpr
@@ -22,8 +22,8 @@ library project gnat is
for Object_Dir use "obj"; --"rts/boards/" & Arch & "/adalib";
package Builder is
- Basic_Switches := ("-gnat2005", "-O0", "-g3", "-x", "-a", "-gnatg",
- "-gnatec=../gnat.adc");
+ Basic_Switches := ("-gnat05", "-O0", "-g3", "-x", "-a", "-gnatg",
+ "-gnatec=../gnat.adc", "-gnatd.n");
case Board is
when "pc" =>
View
57 makefile
@@ -4,7 +4,12 @@
# Author : Luke A. Guest
# Created On : Thu Jun 14 11:59:53 2012
# Licence : See LICENCE in the root directory.
-ARCH = i386
+
+###############################################################################
+# These variables should be edited depending on the platform you are building
+# for bare bones for.
+###############################################################################
+BOARD = pc
BUILD = debug
#BUILD = release
@@ -13,40 +18,68 @@ BUILD = debug
#BUG = bug
BUG = clean
+###############################################################################
+# Everything after here should not be touched.
+###############################################################################
PWD = $(shell pwd)
-RTS_DIR = $(PWD)/rts/boards/$(ARCH)
-ifeq ($(ARCH),i386)
GNATMAKE = gnatmake
AS = as
-ASFLAGS = --32 -march=i386
-OBJS = obj/startup.o \
- obj/multiboot.o
-BOARD = pc
+###############################################################################
+# Platform specific.
+###############################################################################
+ifeq ($(BOARD),pc)
+ARCH = i386
+TOOL_PREFIX =
-OUTDIR = disk/boot/
+AS_FLAGS = --32 -march=$(ARCH)
-.PHONY: obj/multiboot.o obj/console.o
+AS_OBJS = obj/startup.o
+ADA_OBJS = obj/multiboot.o
+OUTDIR = disk/boot/
+else
+ifeq ($(BOARD),rpi)
+ARCH = arm
+TOOL_PREFIX = arm-none-eabi-
+
+AS_FLAGS = -march=armv6zk -mfpu=vfp -mfloat-abi=hard -marm \
+ -mcpu=arm1176jzf-s -mtune=arm1176jzf-s
+endif
endif
+###############################################################################
+# Force make not to try to build these objects as gnatmake and the project
+# file does this for us.
+###############################################################################
+.PHONY: $(ADA_OBJS)
+
+OBJS = $(AS_OBJS) $(ADA_OBJS)
+RTS_DIR = $(PWD)/rts/boards/$(ARCH)
+
+###############################################################################
+# Debug specific flags.
+###############################################################################
ifeq ($(BUILD),debug)
-ASFLAGS += -g
+AS_FLAGS += -g
else
ifeq ($(BUILD),release)
endif
endif
+###############################################################################
+# Rules.
+###############################################################################
all: $(OUTDIR)bare_bones
$(OUTDIR)bare_bones: $(OBJS) src/bare_bones.adb
- $(GNATMAKE) --RTS=$(RTS_DIR) \
+ $(TOOL_PREFIX)$(GNATMAKE) --RTS=$(RTS_DIR) \
-XBoard=$(BOARD) -XBuild=$(BUILD) -XBug=$(BUG) \
-Pbare_bones.gpr
obj/startup.o: src/$(BOARD)/startup.s
- $(AS) $(ASFLAGS) src/$(BOARD)/startup.s -o obj/startup.o
+ $(AS) $(AS_FLAGS) src/$(BOARD)/startup.s -o obj/startup.o
# This will start qemu, but then stop the emulation, press ctrl+alt+shift+f2
# to get to the console, press c to continue once GDB has been configured. For
View
213 src/bare_bones.adb
@@ -4,149 +4,154 @@
-- Author : Luke A. Guest
-- Created On : Thu Jun 14 11:59:53 2012
-- Licence : See LICENCE in the root directory.
-with Console; use Console;
-with Multiboot; use Multiboot;
-with System.Address_To_Access_Conversions;
-with Ada.Unchecked_Conversion;
+pragma Restrictions (No_Obsolescent_Features);
+-- with Console; use Console;
+-- with Multiboot; use Multiboot;
+-- with System.Address_To_Access_Conversions;
+-- with Ada.Unchecked_Conversion;
-use type Multiboot.Magic_Values;
+-- use type Multiboot.Magic_Values;
procedure Bare_Bones is
- Line : Screen_Height_Range := Screen_Height_Range'First;
+ -- Line : Screen_Height_Range := Screen_Height_Range'First;
begin
- Clear;
+ null;
+ -- Clear;
- Put ("Hello, bare bones in Ada",
- Screen_Width_Range'First,
- Line);
+ -- Put ("Hello, bare bones in Ada",
+ -- Screen_Width_Range'First,
+ -- Line);
+
+ -- Line := Line + 1;
- Line := Line + 1;
+ -- if Magic = Magic_Value then
+ -- Put ("Magic numbers match!", Screen_Width_Range'First, Line);
+ -- else
+ -- Put ("Magic numbers don't match!", Screen_Width_Range'First, Line);
- if Magic = Magic_Value then
- Put ("Magic numbers match!", Screen_Width_Range'First, Line);
- else
- Put ("Magic numbers don't match!", Screen_Width_Range'First, Line);
+ -- raise Program_Error;
+ -- end if;
- raise Program_Error;
- end if;
+ -- Line := Line + 1;
- Line := Line + 1;
+ -- if Info.Flags.Memory then
+ -- Put ("Memory info present", Screen_Width_Range'First, Line);
- if Info.Flags.Memory then
- Put ("Memory info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.Boot_Device then
+ -- Put ("Boot device info present", Screen_Width_Range'First, Line);
- if Info.Flags.Boot_Device then
- Put ("Boot device info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.Command_Line then
+ -- Put ("Command line info present", Screen_Width_Range'First, Line);
- if Info.Flags.Command_Line then
- Put ("Command line info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.Modules then
+ -- Put ("Modules info present", Screen_Width_Range'First, Line);
- if Info.Flags.Modules then
- Put ("Modules info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
- Line := Line + 1;
+ -- if Info.Modules.Count = 2 then
+ -- declare
+ -- type My_Modules_Array is new Modules_Array
+ -- (1 .. Natural (Info.Modules.Count));
+ -- type My_Modules_Array_Access is access all My_Modules_Array;
- if Info.Modules.Count = 2 then
- declare
- type My_Modules_Array is new Modules_Array
- (1 .. Natural (Info.Modules.Count));
- type My_Modules_Array_Access is access all My_Modules_Array;
+ -- -- My_Modules : aliased Modules_Array
+ -- -- (1 .. Natural (Info.Modules.Count));
+ -- -- pragma Unreferenced (My_Modules);
- -- My_Modules : aliased Modules_Array
- -- (1 .. Natural (Info.Modules.Count));
- -- pragma Unreferenced (My_Modules);
+ -- package To_Modules is new System.Address_To_Access_Conversions
+ -- (Object => My_Modules_Array_Access);
- package To_Modules is new System.Address_To_Access_Conversions
- (Object => My_Modules_Array_Access);
+ -- function Conv is new Ada.Unchecked_Conversion
+ -- (Source => To_Modules.Object_Pointer,
+ -- Target => My_Modules_Array_Access);
- function Conv is new Ada.Unchecked_Conversion
- (Source => To_Modules.Object_Pointer,
- Target => My_Modules_Array_Access);
+ -- Modules : constant My_Modules_Array_Access :=
+ -- Conv (To_Modules.To_Pointer
+ -- (Info.Modules.First));
- Modules : constant My_Modules_Array_Access :=
- Conv (To_Modules.To_Pointer
- (Info.Modules.First));
+ -- M : Multiboot.Modules;
+ -- pragma Unreferenced (M);
+ -- begin
+ -- Put ("2 modules loaded is correct",
+ -- Screen_Width_Range'First, Line);
- M : Multiboot.Modules;
- pragma Unreferenced (M);
- begin
- Put ("2 modules loaded is correct",
- Screen_Width_Range'First, Line);
+ -- for I in 1 .. Info.Modules.Count loop
+ -- M := Modules (Natural (I));
+ -- end loop;
- for I in 1 .. Info.Modules.Count loop
- M := Modules (Natural (I));
- end loop;
+ -- Line := Line + 1;
+ -- end;
+ -- end if;
+ -- end if;
- Line := Line + 1;
- end;
- end if;
- end if;
+ -- if Info.Flags.Symbol_Table then
+ -- Put ("Symbol table info present", Screen_Width_Range'First, Line);
- if Info.Flags.Symbol_Table then
- Put ("Symbol table info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.Section_Header_Table then
+ -- Put ("Section header table info present",
+ -- Screen_Width_Range'First, Line);
- if Info.Flags.Section_Header_Table then
- Put ("Section header table info present",
- Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.BIOS_Memory_Map then
+ -- Put ("BIOS memory map info present", Screen_Width_Range'First, Line);
- if Info.Flags.BIOS_Memory_Map then
- Put ("BIOS memory map info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
- Line := Line + 1;
+ -- declare
+ -- Map : Memory_Map_Entry_Access := Multiboot.First_Memory_Map_Entry;
+ -- begin
+ -- while Map /= null loop
+ -- Map := Multiboot.Next_Memory_Map_Entry (Map);
+ -- end loop;
+ -- end;
+ -- end if;
- declare
- Map : Memory_Map_Entry_Access := Multiboot.First_Memory_Map_Entry;
- begin
- while Map /= null loop
- Map := Multiboot.Next_Memory_Map_Entry (Map);
- end loop;
- end;
- end if;
+ -- if Info.Flags.Drives then
+ -- Put ("Drives info present", Screen_Width_Range'First, Line);
- if Info.Flags.Drives then
- Put ("Drives info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.ROM_Configuration then
+ -- Put ("ROM configuration info present",
+ -- Screen_Width_Range'First, Line);
- if Info.Flags.ROM_Configuration then
- Put ("ROM configuration info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.Boot_Loader then
+ -- Put ("Boot loader info present", Screen_Width_Range'First, Line);
- if Info.Flags.Boot_Loader then
- Put ("Boot loader info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.APM_Table then
+ -- Put ("APM table info present", Screen_Width_Range'First, Line);
- if Info.Flags.APM_Table then
- Put ("APM table info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- if Info.Flags.Graphics_Table then
+ -- Put ("Graphics table info present", Screen_Width_Range'First, Line);
- if Info.Flags.Graphics_Table then
- Put ("Graphics table info present", Screen_Width_Range'First, Line);
+ -- Line := Line + 1;
+ -- end if;
- Line := Line + 1;
- end if;
+ -- raise Constraint_Error;
-- raise Console.TE;
-- raise Constraint_Error;
@@ -156,8 +161,10 @@ begin
-- Screen_Height_Range'First + 1);
-- exception
-- when Constraint_Error =>
--- Put ("Constraint Error caught", 1, 2);
- -- when Console.TE =>
+-- Put ("Constraint Error caught", 1, 15);
+-- when Program_Error =>
+-- null;
+ -- when Console.TE =>
-- Put ("TE caught", 1, 2);
end Bare_Bones;
pragma No_Return (Bare_Bones);

No commit comments for this range

Something went wrong with that request. Please try again.