The following simple Ada program prints a month in the form:

 SUN MON TUE WED THU FRI SAT
           1   2   3   4   5
   6   7   8   9  10  11  12
  13  14  15  16  17  18  19
  20  21  22  23  24  25  26
  27  28

It uses a simple process which asks the user the number of days in the month and the starting day of the week. The program demonstrates the overloading of packages in Ada, enumerations, types, subtypes, and output.

Here is the algorithm for displaying the month:

Output the heading with the names of the days of the week.
Output the initial blanks.
Set day = the first day input by the user.
loop date in 1 to number_of_days_in_the_month
   output(date)
   if (day = Saturday) then
      insert a new line
      day = Sunday
   else
      day = next day
   end
end loop
   

Here is the program written in Ada:

with text_IO; use text_io;

procedure month is

   subtype month_days is positive range 1..31;
   type week_days is (Sun,Mon,Tue,Wed,Thu,Fri,Sat);
   package positive_io is new integer_io(positive);
   use positive_io;
   package day_io is new enumeration_io(week_days);
   use day_io;
   answer: character;
   firstday: week_days;
   numberofdays: month_days;

   procedure get_number_of_days(nd: out month_days) is
   begin
      put("Enter the number of days in the month: ");
      new_line;
      get(nd);
      skip_line;
   end get_number_of_days;

   procedure get_first_day(fd: out week_days) is
   begin
      put("Enter the first day of the new month: ");
      put("e.g. Sun, Mon, etc.");
      new_line;
      get(fd);
      skip_line;
   end get_first_day;

   procedure display_month(nd: in month_days; fd: in week_days) is
      day: week_days := fd;
      four_blanks: constant string := "    ";
      width : constant integer := 4;
   begin
      for day in week_days loop
         put(' ');
         put(day);
      end loop;
      new_line;
      for blank_days in Mon..fd loop
         put(four_blanks);
      end loop;
      for date in 1..nd loop
         put(date,width);
         if day = Sat then
            day := Sun;
            new_line;
         else
            day := week_days'succ(day);
         end if;
      end loop;
      new_line;
   end display_month;

begin
   loop
      get_number_of_days(numberofdays);
      get_first_day(firstday);
      display_month(numberofdays,firstday);
      put("Do you wish to see another month? "); new_line;
      put("yes(y) or no(n): "); new_line;
      get(answer); skip_line;
      exit when answer = 'n' or answer = 'N';
   end loop;
end month;

You will notice on Line 9, the redefinition of the package enumeration_io to permit the output of the headings, and the input of the first day of the month in an intuitive manner. Also a subtype, month_days, is created on Line 5 of the program which helps ensure proper input by constraining the values allowed in month_days.

The program repeatedly prompts the user for information, and prints the associated month. Here is the programming running:

Enter the number of days in the month:
31
Enter the first day of the new month: e.g. Sun, Mon, etc.
Wed
 SUN MON TUE WED THU FRI SAT
               1   2   3   4
   5   6   7   8   9  10  11
  12  13  14  15  16  17  18
  19  20  21  22  23  24  25
  26  27  28  29  30  31
Do you wish to see another month?
yes(y) or no(n):
n

What happens if the number of days entered by the user is outside the constraints set? The program will raise a constraint error of the form:

raised CONSTRAINT_ERROR : month.adb:19 range check failed

But this can be fixed by modifying the user input routines. Here is how the procedure get_number_of_days() has been fixed.

   procedure get_number_of_days(nd: out month_days) is
      monthlen : month_days;
   begin
      loop
         begin
            put("Enter the number of days in the month: ");
            new_line;
            get(monthlen);
            skip_line;
            if monthlen in 28..31 then
               exit;
            else
               raise constraint_error;
            end if;
         exception
            when others =>
               skip_line;
               put("Bad input. Enter a value between 28-31.");
               new_line;
         end;
      end loop;
      nd := monthlen;
   end get_number_of_days;

On Lines 10-14 there is an if statement which determines if the input is valid. Input outside of the values 28-31 raises a constraint_error, but this time it is dealt with by the procedure on Lines 15-19 (instead of the system). If an exception is raised, then a message is output to the user, and in this case the loop iterates again. If the input is valid, the input loop is exited. This is a good example of how easy it is to deal with various exceptions in Ada. Here is a sample of the program running with invalid input:

Enter the number of days in the month:
42
Bad input. Enter a value between 28-31.
Enter the number of days in the month:

Hi, I just happen to stumble upon these Ada2012 bindings developed by Phaser Cat Games (https://phasercat.com/) during some Google searching.

AdaOgg - AdaOgg - Phaser Cat

VulkAda - VulkAda - Phaser Cat

For VulkAda, there are two blog entries from the author:

1. The VulkAda Project - Phaser Cat
2. The VulkAda Project (II) - Phaser Cat

[UPDATE] For those unfamiliar with OggVorbis and Vulkan, these are descriptions from Wikipedia:

Vorbis is a free and open-source software project headed by the Xiph.Org Foundation. The project produces an audio coding format and software reference encoder/decoder (codec) for lossy audio compression. Vorbis is most commonly used in conjunction with the Ogg container format[10] and it is therefore often referred to as Ogg Vorbis.

Vulkan is a low-overhead, cross-platform API, open standard for 3D graphics and computing. Vulkan targets high-performance real-time 3D graphics applications, such as video games and interactive media, and highly parallelized computing.

2 posts - 2 participants

Read full topic

I just ran alr edit to try something with SPARK and… gps had no SPARK menu! What happened to it?

I wondered if I don’t have the gnatprove crate installed. Neither alr get nor alr toolchain -i seemed to help, and alr show gnatprove gave a very unhelpful error message.

It somehow occurred to me that alr with might work, and sure enough, within moments gnatprove was being added to a project, and SPARK showed up in the gps menu!

But… it does not show up in other projects! Apparently I have to alr with spark in every project I want to use it in.

1. Is that what’s supposed to happen?
2. Is this documented somewhere? I didn’t see it if so.
3. Will it install a new gnatprove bin every time I install it, or is it just installed once, and set up in the projects where we use it?

5 posts - 3 participants

Read full topic

When a GNAT project A depends on project B, is there a simple (*) way to make gprbuild build project B before starting the build of A?
It would be useful when project B generates Ada sources…
Example:

with "code_generation.gpr";

project Main is
  for Source_Dirs use (".", "gen");
  for Object_Dir use "obj";
  for Create_Missing_Dirs use "True";  --  Flips by default the "-p" switch
  for Main use ("main.adb");
end Main;

(*) By “simple” I mean simpler than the way described here:

3 posts - 3 participants

Read full topic

With a basic linked list that really only builds the list and prints it out, let’s add another function to reverse the list. The procedure below works by extracting the head element repeatedly and building it back in reverse.

procedure reverseList(head: in out list) is
   temp: list := null;
   revl: list := null;
begin
   while head /= null loop
      temp := head;
      head := head.next;
      temp.next := revl;
      revl := temp;
   end loop;
   head := revl;
end reverselist;

What is happening here? The list temp holds the extracted item, while revl holds the reversed list. Line 5 loops through the list. Line 6 extracts a node the list (head). Line 7 sets the list head to the next item, and Line 8 adds the extracted node to the reverse list. Finally Line 9 sets the input list pointer to the reversed list. Finally on Line 11, the input list pointer is set to the reversed list.

For something a little more interesting, here’s the recursive version of the procedure:

function reverseListR(head: in list) return list is
   rest: list;
begin
   if head = null or else head.next = null then
      return head;
   end if;
   rest := reverseListR(head.next);
   head.next.next := head;
   head.next := null;
   return rest;
end reverselistR;

I was reading today about a proposal regarding the Rust language’s use of async and await. which are related to colored subprograms. If you’re familiar with them, read on; if not, click the blurred text at bottom for a hopefully-correct explanation.

I naturally wondered how this issue affects Ada. I’m not as familiar with task types as I should be, even though I used them a few years ago, and Ada 2022 brings the new parallel keyword, which I have yet to use. After refreshing my memory:

Is my impression correct that Ada’s approach to concurrency and parallelism circumvents “colored” subprograms altogether? After all, task entries are called just like regular subprograms, and subprograms with parallel blocks are called just like other subprograms.

My apologies if I’m being unclear; please don’t hesitate to correct or scold me if I’m babbling nonsense. I know what I’m trying to say, but I’m not used to talking about these particular issues.

6 posts - 4 participants

Read full topic

Amazingly linked lists in Ada are no different than they are in C, except actually they may be somewhat easier to interpret. You can find out about basic pointers in Ada here (although in Ada they are termed “access values”.

Let’s jump right in and create a linked list, in this case to store a series of words. We will start out with some declarations.

type node;

type list is access node;

type node is record
   word: unbounded_string;
   next: list;
end record;

head: list;

For some people the declaration of node on Line 1 will seem a little odd, but it helps resolve the circularity of the definitions. The declaration on Line 3 refers to node, and the declaration of node (Line 5) refers to list. Line 1 is somewhat of an incomplete declaration as it simply tells the compiler that node is the name of a type of some sort so that the name can be used on Line 3. Nothing else very exciting here – Lines 5-8 declares node to be a record containing the data (word), and the pointer to the next node (next).

Next, we’ll create a procedure buildList() which will create the list, adding one word at a time. There isn’t anything magical here, just a stock-standard list implementation. Remember, lists are LIFO structures, so the last term that gets added is the head of the list.

procedure buildList(head: in out list; aword: in unbounded_string) is
   newNode: list;
begin
   newNode := new node'(word=>aword, next=>null);
   newNode.next := head;
   head := newNode;
end buildList;

On Line 4, the new node is created using new, which takes a free block of memory from the heap and reserves it for use as a node type variable. At the same time it assigns the string (aword), to word, and sets next to null. Lines 5 and 6 insert the new item into the list.

Next, we are going to add a procedure, printList(), to print the list.

procedure printList(head: in list) is
   scanPtr: list;
begin
   scanPtr := head;
   loop
      exit when scanPtr = null;
      put(scanPtr.word);
      scanPtr := scanPtr.next;
      put(" ");
   end loop;
end printList;

The variable scanPtr is a node used to scan the list. Line 5 is the exit strategy for the loop, exiting when the list becomes empty. Line 7 prints the word, and line 8 goes to the next word. Now we need some code to actually run the program.

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.unbounded; use Ada.Strings.unbounded;
with Ada.Strings.unbounded.text_io; use Ada.Strings.unbounded.text_io;

procedure linkedlist is

   -- code from above goes here
   aword: unbounded_string;

begin
   loop
      put("> ");
      get_line(aword);
      exit when aword = "q";
      buildList(head, aword);
   end loop;

   put_line("the list as read :");
   printList(head);
   new_line;

end linkedlist;

Nothing special here. Lines 11-16 provides a loop, prompting the user for words, and building the list until “q” is entered, terminating the input. Here is the programming running:

> the
> cat
> sat
> on
> the
> hat
> q
the list as read :
hat the on sat cat the

On arm-none-eabi-gcc (cortex m0 / stm32f03), I see address values from Attribute'Address that seem to differ between those inserted at compile time and those which should be real. As an example, I look at the address of Hardfault_Handler.

This is my code:

 procedure Hardfault_Handler is
      SP : Address         := Get_Stack_Pointer; -- save sp after handler entry
      PC                 : Address := Get_Program_Counter; -- save current pc
      PC_Offset          : Storage_Offset  := PC - Hardfault_Handler'Address;
      Num_Of_Pushed_Regs : Natural         := 0;
      SP_Calc            : Integer_Address := To_Integer (SP);
      package Thumb_Ins_Pnt is new System.Address_To_Access_Conversions
        (Push_Instruction);
      use Thumb_Ins_Pnt;
      Temp_Ins : Object_Pointer;
   begin
      --loop over program code at start of hardfaulthandler
      for I in 0 .. PC_Offset when (I mod 2 = 0) loop
         Temp_Ins := To_Pointer (Hardfault_Handler'Address + I);
         -- is this a push instruction?
         if Temp_Ins.Mask = PUSH_Ins_Mask then
            -- yes, count number of regs we pushed to stack
            for Bit of Temp_Ins.Regs when Bit = True loop
               Num_Of_Pushed_Regs := Num_Of_Pushed_Regs + 1;
            end loop;
            -- alter back SP to Point before push (+ because stack grows down)
            SP_Calc := SP_Calc + 4 * Integer_Address (Num_Of_Pushed_Regs);

            declare
               Old_Regs : constant Stacked_Registers with
                 Import, Address => To_Address (SP_Calc + Stacked_Reg_Offset);
               Old_PC_Content : constant Thumb_Instruction with
                 Import, Address => Old_Regs.PC;
            begin
               if Old_PC_Content = Break_Point_Instruction then
                  -- Hardfault happend because no Debugger is connected,
                  -- just return
                  return;
               end if;
            end;
         end if;
      end loop;

      Put_Line ("Hard Fault");
      -- fault handling to be done
   end Hardfault_Handler;

Output of objdump:

 08000754 <m0__startup__hardfault_handler>:
   procedure Hardfault_Handler is
 8000754:       b5f8            push    {r3, r4, r5, r6, r7, lr}

   function Get_Stack_Pointer return Address is
      Result : Address;
   begin
      Asm
 8000756:       46ec            mov     ip, sp
   end Get_Stack_Pointer;

   function Get_Program_Counter return Address is
      Result : Address;
   begin
      Asm
 8000758:       467d            mov     r5, pc
      PC_Offset          : Storage_Offset  := PC - Hardfault_Handler'Address;
 800075a:       4e2a            ldr     r6, [pc, #168]  ; (8000804 <m0__startup__hardfault_h
andler+0xb0>)
   end "-";

Here the value for Hardfault_Handler"Address stored @8000804

    8000802:       bdf8            pop     {r3, r4, r5, r6, r7, pc}
 8000804:       08000755        stmdaeq r0, {r0, r2, r4, r6, r8, r9, sl}
 8000808:       08002a88        stmdaeq r0, {r3, r7, r9, fp, sp}
 800080c:       7fffffff        svcvc   0x00ffffff
 8000810:       0000beab        andeq   fp, r0, fp, lsr #29
 8000814:       08002a28        stmdaeq r0, {r3, r5, r9, fp, sp}
 8000818:       08002ad8        stmdaeq r0, {r3, r4, r6, r7, r9, fp, sp}

from inside gdb it looks like this:

also this is my vector table, the addresses are different too. But the reset handler, gets called and runs fine :

 Vector_Table : constant Address_Array :=
     (Sram_Stack_Start, Reset_Handler'Address, NMI_Handler'Address,
      Hardfault_Handler'Address, MemManage_Handler'Address,
      Bus_Fault_Handler'Address, Usage_Fault_Handler'Address, Reserved,
      Reserved, Reserved, Reserved, SVCall_Handler'Address,
      Debug_Handler'Address, Reserved, PendSV_Handler'Address,    
      Systick_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address);
   --Default_Handler'Address);
   pragma Linker_Section (Vector_Table, "_vector_table");

08000000 <m0__startup__vector_table>:
 8000000:       20001000        andcs   r1, r0, r0
 8000004:       080005b1        stmdaeq r0, {r0, r4, r5, r7, r8, sl}
 8000008:       08000699        stmdaeq r0, {r0, r3, r4, r7, r9, sl}
 800000c:       08000755        stmdaeq r0, {r0, r2, r4, r6, r8, r9, sl}
 8000010:       080006b1        stmdaeq r0, {r0, r4, r5, r7, r9, sl}
 8000014:       080006c9        stmdaeq r0, {r0, r3, r6, r7, r9, sl}
 8000018:       080006e1        stmdaeq r0, {r0, r5, r6, r7, r9, sl}
        ...

080005b0 <Reset_Handler>:

   -------------------
   -- Reset_Handler --
   -------------------

   procedure Reset_Handler is
 80005b0:       b570            push    {r4, r5, r6, lr}
      Data_L : Storage_Element with
        Volatile, Import, External_Name => "__data_size";

      Data_Length : constant Storage_Offset := Addr2SO (Data_L'Address);

      Data_Load_Array : Storage_Array (1 .. Data_Length) with
 80005b2:       4c16            ldr     r4, [pc, #88]   ; (800060c <Reset_Handler+0x5c>)
      Bss_L : Storage_Element with
        Volatile, Import, Convention => Asm, External_Name => "__bss_size";

Can someone explain this behavior?

We are considering if Alire should change defaults in regard to dealing with Unicode sources. The details are Feedback on a possible Alire Unicode policy · Discussion #1334 · alire-project/alire · GitHub if you’re interested and want to provide some feedback.

Thanks!

1 post - 1 participant

Read full topic

In Ada 2012, a limited with can be used from one file (for example, User) to import types from another package (for example, Provider), even when that package needs to import the current file. This is useful in cases where you have two mutually dependent types, such as the following, but you have them in two different packages, so you can't just use an incomplete type declaration like this:

    type Point;
    type Line;    -- incomplete types

    type Point is
        record
            L, M, N: access Line;
    end record;

    type Line is
        record
            P, Q, R: access Point;
    end record;

(the above example is from John Barnes' Programming in Ada 2012, section 13.5 Mutually dependent types)

However, my question doesn't even need mutually dependent types. I'm trying to compile some Ada code that was autogenerated using gcc -fdump-ada-spec -C some_c_header.h, which happens to contain some procedures and/or functions that have parameters being passed as access constant (const * in C), and I see no reason this shouldn't work using limited with, as fdump-ada-spec generates for me.

Why can't I use any subtypes from Provider inside a subprogram declaration? Using regular types is fine, but when trying to use subtypes gcc complains they do not exist in that package.

provider.ads

package Provider is

   type Fine_Type is range 0 .. 10_000;
   subtype Bad_Type is Fine_Type;

end Provider;

user.ads:

limited with Provider;

package User is

   procedure Do_It (A : access constant Provider.Bad_Type);

end User;

For completeness, here are stubs for the rest of the files you would need:

user.adb

package body User is

   procedure Do_It (A : access constant Provider.Bad_Type) is
   begin
      null;
   end Do_It;

end User;

limited_with_test.gpr

project limited_with_test is

   for Source_Dirs use ("src");
   for Main use ("main.adb");

   for Exec_Dir use "bin";
   for Object_Dir use "obj";
   for Create_Missing_Dirs use "True";

end limited_with_test;

If you put the sources into a directory called src, you can call gprbuild in the directory containing that directory and the gpr file, and you get:

$ gprbuild
using project file limited_with_test.gpr
Compile
   [Ada]          main.adb
user.ads:5:49: error: "Bad_Type" not declared in "Provider"
gprbuild: *** compilation phase failed