* Re: Bold text (in terminal) from Ada?
@ 2022-10-11 8:49 3% ` Niklas Holsti
0 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2022-10-11 8:49 UTC (permalink / raw)
On 2022-10-11 11:06, reinert wrote:
> Any simple way to print out bold text from an Ada program?
> In case, how?
>
> Assume linux.
>
> reinert
Print the corresponding ANSI control sequence to turn on bold mode
before you print the text, then print the ANSI control sequence to turn
off bold mode.
See https://www.linux.org/threads/ansi-codes-and-colorized-terminals.11706/.
Example:
with Ada.Characters.Latin_1;
with Ada.Text_IO;
procedure Be_Bold
is
use Ada.Characters, Ada.Text_IO;
begin
Put ("This is a very ");
-- Bold mode:
Put (Latin_1.ESC); Put ("[1m");
Put ("bold");
-- Normal mode:
Put (Latin_1.ESC); Put ("[0m");
Put_Line (" program.");
end Be_Bold;
^ permalink raw reply [relevance 3%]
* Re: GtkAda and €
2021-09-11 17:46 2% ` Manuel Gomez
@ 2021-09-12 7:04 0% ` AdaMagica
0 siblings, 0 replies; 200+ results
From: AdaMagica @ 2021-09-12 7:04 UTC (permalink / raw)
Manuel Gomez schrieb am Samstag, 11. September 2021 um 19:46:52 UTC+2:
> When converting to UTF8, can you specify that you are using Latin-9
> (ISO-8859-15), instead of Latin-1? Latin-9 is equivalent to Latin-1 plus
> the Euro sign, instead of the generic currency sign, since Latin-1
> predates the Euro.
>
> In that case, it would be:
>
> Euro_Sign : constant Character := Character'Val (164);
>
> This is from Ada.Characters.Latin_9, provided by GNAT (not in the
> standard). Not sure, buy maybe you could type the Euro sign in the
> source code with the keyboard, since the representation is the same.
In Gnat Studio, you can set the encoding (from the file's context menu
choose "Properties...") to Latin_9. Then the character 164 is displayed as €
in the Ada source file. You can even use the € key on the keyboard. That
does not help, however, since Unicode is based on Latin_1, and when this
is transformed to UTF8, the currency character appears on the GtkAda GUI.
> Another option is to use ASCII only (with some encoding for umlauts and
> Euro sign) and then apply localization for the strings that must be
> "translated" to proper German.
I indeed use Character 164 as a placeholder in the Ada source code. When
transforming to UTF8, I search for this character first, transform the head
string, insert the Euro sequence and transform the tail string recursively.
This works.
^ permalink raw reply [relevance 0%]
* Re: GtkAda and €
@ 2021-09-11 17:46 2% ` Manuel Gomez
2021-09-12 7:04 0% ` AdaMagica
0 siblings, 1 reply; 200+ results
From: Manuel Gomez @ 2021-09-11 17:46 UTC (permalink / raw)
Am 11/9/21 um 15:51 schrieb AdaMagica:
> Being German, I need umlauts and € together in strings to write them to some labels.
> Using Character'Val (16#E2#) & Character'Val (16#82#) & Character'Val (16#AC#)
> complicates things, since umlauts are above 255 and need transformation to UTF8,
> whereas the euro sequence above is already in UTF8 and must not again be transformed.
>
> What a mess!
>
When converting to UTF8, can you specify that you are using Latin-9
(ISO-8859-15), instead of Latin-1? Latin-9 is equivalent to Latin-1 plus
the Euro sign, instead of the generic currency sign, since Latin-1
predates the Euro.
In that case, it would be:
Euro_Sign : constant Character := Character'Val (164);
This is from Ada.Characters.Latin_9, provided by GNAT (not in the
standard). Not sure, buy maybe you could type the Euro sign in the
source code with the keyboard, since the representation is the same.
Another option is to use ASCII only (with some encoding for umlauts and
Euro sign) and then apply localization for the strings that must be
"translated" to proper German.
^ permalink raw reply [relevance 2%]
* Re: AWS.SMTP.Client secure mode
@ 2021-09-06 9:26 2% ` Björn Lundin
0 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2021-09-06 9:26 UTC (permalink / raw)
Den 2021-09-05 kl. 05:20, skrev philip...@gmail.com:
>
> Has anyone ever got secure and authenticated AWS.SMTP.Client working? And if so, how did you do it?
>
Yes.
I use Amazon as mailer - like this. Shortened version so it might not
compile. I think you need the Ada.Directories.Set_Directory statement
just as I need it.
in the directory I set , I have the cert.pem I'd like to use
procedure Mail_Saldo is
Subject : constant String := "Some Subject";
use AWS;
SMTP_Server_Name : constant String :=
"email-smtp.eu-north-1.amazonaws.com";
Status : SMTP.Status;
begin
Ada.Directories.Set_Directory(/where/is/my/cet/sslcert");
declare
Auth : aliased constant SMTP.Authentication.Plain.Credential :=
SMTP.Authentication.Plain.Initialize
("AKFCAWS_IS_A_MAILSERVERT", "BOYbIsome-chars-from-amazomFDWW");
SMTP_Server : SMTP.Receiver := SMTP.Client.Initialize
(SMTP_Server_Name,
Port => 465,
Secure => True,
Credential => Auth'Unchecked_Access);
use Ada.Characters.Latin_1;
Msg : constant String := "Some MEssage";
Receivers : constant SMTP.Recipients := (
SMTP.E_Mail("A Mail Address",
"a.mail.address@gmail.com"),
-- SMTP.E_Mail("Another Mail Addresss",
"another.mail.address@gmail.co"));
begin
SMTP.Client.Send(Server => SMTP_Server,
From => SMTP.E_Mail ("A sender",
"Sender@gmail.com"),
To => Receivers,
Subject => Subject,
Message => Msg,
Status => Status);
end;
if not SMTP.Is_Ok (Status) then
Log (Me & "Mail_Saldo", "Can't send message: " &
SMTP.Status_Message (Status));
end if;
end Mail_Saldo;
---------------------------------
cert.pem looks like
sslcert $ cat cert.pem
-----BEGIN RSA PRIVATE KEY-----
....
-----END RSA PRIVATE KEY-----
-----BEGIN CERTIFICATE-----
...........
-----END CERTIFICATE-----
--
Björn
^ permalink raw reply [relevance 2%]
* Re: XMLAda & unicode symbols
2021-06-20 18:16 0% ` Dmitry A. Kazakov
@ 2021-06-21 19:40 0% ` 196...@googlemail.com
0 siblings, 0 replies; 200+ results
From: 196...@googlemail.com @ 2021-06-21 19:40 UTC (permalink / raw)
On Sunday, 20 June 2021 at 19:16:57 UTC+1, Dmitry A. Kazakov wrote:
> On 2021-06-20 19:58, 196...@googlemail.com wrote:
> > On Sunday, 20 June 2021 at 18:23:35 UTC+1, Dmitry A. Kazakov wrote:
> >> On 2021-06-20 19:02, 196...@googlemail.com wrote:
> >>> On Saturday, 19 June 2021 at 20:53:49 UTC+1, Jeffrey R. Carter wrote:
> >>>> On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
> >>>>> I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
> >>>>>
> >>>>> I have:
> >>>>> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
> >>>> The degree symbol is part of Latin-1, so why not include it directly in your string?
> >>>>
> >>>> S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
> >>>
> >>> Unfortunately, when XMLAda comes to exporting the DOM tree, it crashed with:
> >>> raised UNICODE.CES.INVALID_ENCODING : unicode-ces-utf8.adb:258
> >> Maybe it expects UTF-8, as most third party Ada libraries do. In that
> >> case use:
> >>
> >> Character'Val (16#C2#) & Character'Val (16#B0#)
> >
> > That's the degree symbol, what I really need is the degree centigrade symbol which is U+2103.
> >
> > Having Character'Val (16#21#) & Character'Val (16#03#) fails at runtime.
> >
> > I'm sure it's easy enough, and when I get it, I'll be banging my head against the desk.
> Why do you use XMLAda? SVG is a text file, I would write directly. It is
> the reverse, rendering SVG image, that is difficult to write from scratch.
>
> And why do you want to create SVG files?
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
I am using XML/Ada as I wish to do it "properly", it's the way you learn.
As for SVG, I am graphing temps, humidity & pressure, and when you zoom in, it still looks sharp. The previous system I coded in C, used png's which were screwed up when Google screwed up and forced HDPI settings on chrome users. THE svg's will also contain code to highlight etc points.
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-20 17:10 0% ` 196...@googlemail.com
@ 2021-06-21 15:26 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2021-06-21 15:26 UTC (permalink / raw)
"196...@googlemail.com" <1963bib@googlemail.com> writes:
> Asking for the degree sign, was probably a slight mistake. There is
> Degree_Celsius and also Degree_Fahrenheit for those who have not yet
> embraced metric. These are the "correct" symbols.
You might equally have meant angular degrees.
> Both of these exist in Unicode.Names.Letterlike_Symbols, and probably
> elsewhere,but trying to shoehorn these in seems impossible.
A scan through XML/Ada shows that the only uses of Unicode_Char are in
the SAX subset. I don't see any way in the DOM subset of XML/Ada of
using them - someone please prove me wrong!
You could build a Unicode_Char to UTF_8_String converter using
Ada.Strings.UTF_Encoding.Wide_Wide_Strings, ARM 4.11(30)
http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-A-4-11.html#p30
> I just wish XMLAda could just accept whatever we throw at it, and if
> we need to convert it, then let us do so outside of it.
That is *exactly* what you have to do (convert outside, not throw any
old sequence of octets and 32-bit values somehow mashed together at
it). It wants a utf-8-encoded string (though XML/Ada doesn't seem to say
so - RFC 3076 implies it, 7303 (8.1) recommends it).
OK, Text_IO might not prove the point to you, but what about this?
with Ada.Characters.Latin_1;
with DOM.Core.Documents;
with DOM.Core.Elements;
with DOM.Core.Nodes;
with DOM.Core;
with Unicode.CES;
with Unicode.Encodings;
procedure Utf is
Impl : DOM.Core.DOM_Implementation;
Doc : DOM.Core.Document;
Dummy, Element : DOM.Core.Node;
Fifty_Degrees_Latin1 : constant String
:= "50" & Ada.Characters.Latin_1.Degree_Sign;
Fifty_Degrees_UTF8 : constant Unicode.CES.Byte_Sequence
:= Unicode.Encodings.Convert
(Fifty_Degrees_Latin1,
From => Unicode.Encodings.Get_By_Name ("iso-8859-15"),
To => Unicode.Encodings.Get_By_Name ("utf-8"));
begin
Doc := DOM.Core.Create_Document (Impl);
Element := DOM.Core.Documents.Create_Element (Doc, "utf");
DOM.Core.Elements.Set_Attribute (Element, "temp", Fifty_Degrees_UTF8);
Dummy := DOM.Core.Nodes.Append_Child (Doc, Element);
DOM.Core.Nodes.Print (Doc);
end Utf;
^ permalink raw reply [relevance 2%]
* Re: XMLAda & unicode symbols
2021-06-20 17:02 0% ` 196...@googlemail.com
2021-06-20 17:23 0% ` Dmitry A. Kazakov
@ 2021-06-20 18:21 0% ` Jeffrey R. Carter
1 sibling, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2021-06-20 18:21 UTC (permalink / raw)
On 6/20/21 7:02 PM, 196...@googlemail.com wrote:
> On Saturday, 19 June 2021 at 20:53:49 UTC+1, Jeffrey R. Carter wrote:
>> On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
>>> I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
>>>
>>> I have:
>>> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
>> The degree symbol is part of Latin-1, so why not include it directly in your string?
>>
>> S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
>>
>> --
>> Jeff Carter
>> "I would never want to belong to any club that
>> would have someone like me for a member."
>> Annie Hall
>> 41
>
> Unfortunately, when XMLAda comes to exporting the DOM tree, it crashed with:
> raised UNICODE.CES.INVALID_ENCODING : unicode-ces-utf8.adb:258
I would call that an error in XMLAda. Anything that uses String should accept
any String.
The exception name indicates that XMLAda is probably misusing String to hold
encoded Unicode text, probably with UTF-8 encoding. Any use of String as
anything other than its intended use, as a sequence of Latin-1 characters, is a
mistake.
--
Jeff Carter
"Help! Help! I'm being repressed!"
Monty Python & the Holy Grail
67
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-20 17:58 0% ` 196...@googlemail.com
@ 2021-06-20 18:16 0% ` Dmitry A. Kazakov
2021-06-21 19:40 0% ` 196...@googlemail.com
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2021-06-20 18:16 UTC (permalink / raw)
On 2021-06-20 19:58, 196...@googlemail.com wrote:
> On Sunday, 20 June 2021 at 18:23:35 UTC+1, Dmitry A. Kazakov wrote:
>> On 2021-06-20 19:02, 196...@googlemail.com wrote:
>>> On Saturday, 19 June 2021 at 20:53:49 UTC+1, Jeffrey R. Carter wrote:
>>>> On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
>>>>> I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
>>>>>
>>>>> I have:
>>>>> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
>>>> The degree symbol is part of Latin-1, so why not include it directly in your string?
>>>>
>>>> S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
>>>
>>> Unfortunately, when XMLAda comes to exporting the DOM tree, it crashed with:
>>> raised UNICODE.CES.INVALID_ENCODING : unicode-ces-utf8.adb:258
>> Maybe it expects UTF-8, as most third party Ada libraries do. In that
>> case use:
>>
>> Character'Val (16#C2#) & Character'Val (16#B0#)
>
> That's the degree symbol, what I really need is the degree centigrade symbol which is U+2103.
>
> Having Character'Val (16#21#) & Character'Val (16#03#) fails at runtime.
>
> I'm sure it's easy enough, and when I get it, I'll be banging my head against the desk.
Why do you use XMLAda? SVG is a text file, I would write directly. It is
the reverse, rendering SVG image, that is difficult to write from scratch.
And why do you want to create SVG files?
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-20 17:23 0% ` Dmitry A. Kazakov
@ 2021-06-20 17:58 0% ` 196...@googlemail.com
2021-06-20 18:16 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: 196...@googlemail.com @ 2021-06-20 17:58 UTC (permalink / raw)
On Sunday, 20 June 2021 at 18:23:35 UTC+1, Dmitry A. Kazakov wrote:
> On 2021-06-20 19:02, 196...@googlemail.com wrote:
> > On Saturday, 19 June 2021 at 20:53:49 UTC+1, Jeffrey R. Carter wrote:
> >> On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
> >>> I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
> >>>
> >>> I have:
> >>> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
> >> The degree symbol is part of Latin-1, so why not include it directly in your string?
> >>
> >> S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
> >
> > Unfortunately, when XMLAda comes to exporting the DOM tree, it crashed with:
> > raised UNICODE.CES.INVALID_ENCODING : unicode-ces-utf8.adb:258
> Maybe it expects UTF-8, as most third party Ada libraries do. In that
> case use:
>
> Character'Val (16#C2#) & Character'Val (16#B0#)
That's the degree symbol, what I really need is the degree centigrade symbol which is U+2103.
Having Character'Val (16#21#) & Character'Val (16#03#) fails at runtime.
I'm sure it's easy enough, and when I get it, I'll be banging my head against the desk.
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-20 17:02 0% ` 196...@googlemail.com
@ 2021-06-20 17:23 0% ` Dmitry A. Kazakov
2021-06-20 17:58 0% ` 196...@googlemail.com
2021-06-20 18:21 0% ` Jeffrey R. Carter
1 sibling, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2021-06-20 17:23 UTC (permalink / raw)
On 2021-06-20 19:02, 196...@googlemail.com wrote:
> On Saturday, 19 June 2021 at 20:53:49 UTC+1, Jeffrey R. Carter wrote:
>> On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
>>> I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
>>>
>>> I have:
>>> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
>> The degree symbol is part of Latin-1, so why not include it directly in your string?
>>
>> S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
>
> Unfortunately, when XMLAda comes to exporting the DOM tree, it crashed with:
> raised UNICODE.CES.INVALID_ENCODING : unicode-ces-utf8.adb:258
Maybe it expects UTF-8, as most third party Ada libraries do. In that
case use:
Character'Val (16#C2#) & Character'Val (16#B0#)
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-19 21:24 3% ` Simon Wright
@ 2021-06-20 17:10 0% ` 196...@googlemail.com
2021-06-21 15:26 2% ` Simon Wright
0 siblings, 1 reply; 200+ results
From: 196...@googlemail.com @ 2021-06-20 17:10 UTC (permalink / raw)
On Saturday, 19 June 2021 at 22:24:47 UTC+1, Simon Wright wrote:
> "196...@googlemail.com" <196...@googlemail.com> writes:
>
> > I'm creating SVG files with XMLAda and I need to have a degree symbol
> > within some text.
> >
> > I have:
> > procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
> > Text_Node : DOM.Core.Element;
> > Text : DOM.Core.Text;
> > begin
> > Text_Node := DOM.Core.Documents.Create_Element (LDocument, "text");
> > DOM.Core.Elements.Set_Attribute (Text_Node, "x", X_Pos);
> > DOM.Core.Elements.Set_Attribute (Text_Node, "y", Y_Pos);
> > DOM.Core.Elements.Set_Attribute (Text_Node, "class", "def-maroon");
> > DOM.Core.Elements.Set_Attribute (Text_Node, "text-anchor", "left");
> > Text_Node := DOM.Core.Nodes.Append_Child (Root_Node, Text_Node);
> > Text := DOM.Core.Documents.Create_Text_Node (LDocument, Min_Max_Str);
> > Text := DOM.Core.Nodes.Append_Child (Text_Node, Text);
> > end Add_Min_Max;
> >
> > and I just pass a string in. The degree symbol is unicode 00B0 and you
> > would then normally have it as �B0, except if I do, then XMLAda
> > changes that initial '&' to '&' and so what is then coded is
> > '&#00B0' and it fails to display properly.
> >
> > Nor can I apply Unicode.Names.Latin_1_Supplement.Degree_Sign to the
> > string, since, well, strict typing...
> >
> > To me it seems like XMLAda is being far too eager and is not willing
> > to just publish what I enter.
> >
> > I raised a call on the github repository, but it was closed saying
> > basically use the unicode name, which fails.
> Set_Attribute takes a Dom_String, which is a subtype of
> Unicode.CES.Byte_Sequence, which is a subtype of String. The question
> is, what encoding? I suspect it's utf-8, so we need to encode
> Ada.Characters.Latin_1.Degree_Sign in utf-8, & this code using XML/Ada
> support seems to do the trick:
>
> with Ada.Characters.Latin_1;
> with Ada.Text_IO;
> with Unicode.CES;
> with Unicode.Encodings;
> procedure Conversion is
> Fifty_Degrees_Latin1 : constant String
> := "50" & Ada.Characters.Latin_1.Degree_Sign;
> Fifty_Degrees_UTF8 : constant Unicode.CES.Byte_Sequence
> := "50"
> & Unicode.Encodings.Convert
> ((1 => Ada.Characters.Latin_1.Degree_Sign),
> From => Unicode.Encodings.Get_By_Name ("iso-8859-15"),
> To => Unicode.Encodings.Get_By_Name ("utf-8"));
> begin
> Ada.Text_IO.Put_Line (Fifty_Degrees_Latin1);
> Ada.Text_IO.Put_Line (Fifty_Degrees_UTF8);
> end Conversion;
>
> (note that Convert's From and To parameters are the default). On this
> Mac (Terminal displays utf-8 text) the first line is garbage, the second
> fine.
>
> I'm So Wildly Impressed (maybe "cast down" would be more accurate) by
> all that subtyping in our wondrously safe language.
>
> I also agree with you that suggesting you use a Unicode_Char
> (Wide_Wide_Character) without saying *how* is less helpful than it could
> be.
Asking for the degree sign, was probably a slight mistake. There is Degree_Celsius and also Degree_Fahrenheit for those who have not yet embraced metric. These are the "correct" symbols.
Both of these exist in Unicode.Names.Letterlike_Symbols, and probably elsewhere,but trying to shoehorn these in seems impossible.
I just wish XMLAda could just accept whatever we throw at it, and if we need to convert it, then let us do so outside of it.
Using Text_IO is fine, but not where XMLAda is concerned.
B
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-19 19:53 2% ` Jeffrey R. Carter
@ 2021-06-20 17:02 0% ` 196...@googlemail.com
2021-06-20 17:23 0% ` Dmitry A. Kazakov
2021-06-20 18:21 0% ` Jeffrey R. Carter
0 siblings, 2 replies; 200+ results
From: 196...@googlemail.com @ 2021-06-20 17:02 UTC (permalink / raw)
On Saturday, 19 June 2021 at 20:53:49 UTC+1, Jeffrey R. Carter wrote:
> On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
> > I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
> >
> > I have:
> > procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
> The degree symbol is part of Latin-1, so why not include it directly in your string?
>
> S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
>
> --
> Jeff Carter
> "I would never want to belong to any club that
> would have someone like me for a member."
> Annie Hall
> 41
Unfortunately, when XMLAda comes to exporting the DOM tree, it crashed with:
raised UNICODE.CES.INVALID_ENCODING : unicode-ces-utf8.adb:258
^ permalink raw reply [relevance 0%]
* Re: XMLAda & unicode symbols
2021-06-19 19:53 2% ` Jeffrey R. Carter
@ 2021-06-19 21:24 3% ` Simon Wright
2021-06-20 17:10 0% ` 196...@googlemail.com
1 sibling, 1 reply; 200+ results
From: Simon Wright @ 2021-06-19 21:24 UTC (permalink / raw)
"196...@googlemail.com" <1963bib@googlemail.com> writes:
> I'm creating SVG files with XMLAda and I need to have a degree symbol
> within some text.
>
> I have:
> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
> Text_Node : DOM.Core.Element;
> Text : DOM.Core.Text;
> begin
> Text_Node := DOM.Core.Documents.Create_Element (LDocument, "text");
> DOM.Core.Elements.Set_Attribute (Text_Node, "x", X_Pos);
> DOM.Core.Elements.Set_Attribute (Text_Node, "y", Y_Pos);
> DOM.Core.Elements.Set_Attribute (Text_Node, "class", "def-maroon");
> DOM.Core.Elements.Set_Attribute (Text_Node, "text-anchor", "left");
> Text_Node := DOM.Core.Nodes.Append_Child (Root_Node, Text_Node);
> Text := DOM.Core.Documents.Create_Text_Node (LDocument, Min_Max_Str);
> Text := DOM.Core.Nodes.Append_Child (Text_Node, Text);
> end Add_Min_Max;
>
> and I just pass a string in. The degree symbol is unicode 00B0 and you
> would then normally have it as �B0, except if I do, then XMLAda
> changes that initial '&' to '&' and so what is then coded is
> '&#00B0' and it fails to display properly.
>
> Nor can I apply Unicode.Names.Latin_1_Supplement.Degree_Sign to the
> string, since, well, strict typing...
>
> To me it seems like XMLAda is being far too eager and is not willing
> to just publish what I enter.
>
> I raised a call on the github repository, but it was closed saying
> basically use the unicode name, which fails.
Set_Attribute takes a Dom_String, which is a subtype of
Unicode.CES.Byte_Sequence, which is a subtype of String. The question
is, what encoding? I suspect it's utf-8, so we need to encode
Ada.Characters.Latin_1.Degree_Sign in utf-8, & this code using XML/Ada
support seems to do the trick:
with Ada.Characters.Latin_1;
with Ada.Text_IO;
with Unicode.CES;
with Unicode.Encodings;
procedure Conversion is
Fifty_Degrees_Latin1 : constant String
:= "50" & Ada.Characters.Latin_1.Degree_Sign;
Fifty_Degrees_UTF8 : constant Unicode.CES.Byte_Sequence
:= "50"
& Unicode.Encodings.Convert
((1 => Ada.Characters.Latin_1.Degree_Sign),
From => Unicode.Encodings.Get_By_Name ("iso-8859-15"),
To => Unicode.Encodings.Get_By_Name ("utf-8"));
begin
Ada.Text_IO.Put_Line (Fifty_Degrees_Latin1);
Ada.Text_IO.Put_Line (Fifty_Degrees_UTF8);
end Conversion;
(note that Convert's From and To parameters are the default). On this
Mac (Terminal displays utf-8 text) the first line is garbage, the second
fine.
I'm So Wildly Impressed (maybe "cast down" would be more accurate) by
all that subtyping in our wondrously safe language.
I also agree with you that suggesting you use a Unicode_Char
(Wide_Wide_Character) without saying *how* is less helpful than it could
be.
^ permalink raw reply [relevance 3%]
* Re: XMLAda & unicode symbols
@ 2021-06-19 19:53 2% ` Jeffrey R. Carter
2021-06-20 17:02 0% ` 196...@googlemail.com
2021-06-19 21:24 3% ` Simon Wright
1 sibling, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2021-06-19 19:53 UTC (permalink / raw)
On 6/19/21 8:28 PM, 196...@googlemail.com wrote:
> I'm creating SVG files with XMLAda and I need to have a degree symbol within some text.
>
> I have:
> procedure Add_Min_Max (Min_Max_Str : String; X_Pos : String; Y_Pos : String) is
The degree symbol is part of Latin-1, so why not include it directly in your string?
S : constant String := "50" & Ada.Characters.Handling.Latin_1.Degree_Sign;
--
Jeff Carter
"I would never want to belong to any club that
would have someone like me for a member."
Annie Hall
41
^ permalink raw reply [relevance 2%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
` (3 preceding siblings ...)
2020-09-19 14:08 0% ` erchetan33
@ 2020-09-28 11:36 0% ` yhumina stir
4 siblings, 0 replies; 200+ results
From: yhumina stir @ 2020-09-28 11:36 UTC (permalink / raw)
On Tuesday, 16 June 2020 at 17:02:13 UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
` (2 preceding siblings ...)
2020-09-13 13:36 0% ` patelchetan1111992
@ 2020-09-19 14:08 0% ` erchetan33
2020-09-28 11:36 0% ` yhumina stir
4 siblings, 0 replies; 200+ results
From: erchetan33 @ 2020-09-19 14:08 UTC (permalink / raw)
On Tuesday, June 16, 2020 at 5:02:13 PM UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
2020-06-16 14:14 2% ` Niklas Holsti
2020-09-03 10:32 0% ` c+
@ 2020-09-13 13:36 0% ` patelchetan1111992
2020-09-19 14:08 0% ` erchetan33
2020-09-28 11:36 0% ` yhumina stir
4 siblings, 0 replies; 200+ results
From: patelchetan1111992 @ 2020-09-13 13:36 UTC (permalink / raw)
On Tuesday, June 16, 2020 at 5:02:13 PM UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
2020-06-16 14:14 2% ` Niklas Holsti
@ 2020-09-03 10:32 0% ` c+
2020-09-13 13:36 0% ` patelchetan1111992
` (2 subsequent siblings)
4 siblings, 0 replies; 200+ results
From: c+ @ 2020-09-03 10:32 UTC (permalink / raw)
On Tuesday, 16 June 2020 17:02:13 UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 15:43 0% ` Luke A. Guest
@ 2020-06-16 16:11 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-06-16 16:11 UTC (permalink / raw)
On 16/06/2020 17:43, Luke A. Guest wrote:
> On 16/06/2020 16:21, Dmitry A. Kazakov wrote:
>> On 16/06/2020 16:42, Luke A. Guest wrote:
>>> On 16/06/2020 15:25, Dmitry A. Kazakov wrote:
>>>> On 16/06/2020 16:14, Niklas Holsti wrote:
>>>
>>>>> I have no idea if this will help you -- the types in our case were
>>>>> much simpler -- but you might try it with a small subset of your
>>>>> package:
>>>>>
>>>>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>>>>> (True, (NUL, NUL, NUL, NUL));
>>>>>
>>>>> (assuming "use Ada.Characters.Latin_1").
>>>>
>>>> That is interesting. Was there the "others =>" part?
>>>>
>>>> I can imagine that with "others => NUL" a static zeroed section were
>>>> used with other parts written upon it during start.
>>>>
>>>> P.S. I hope more people now see why compile-time subprograms are
>>>> necessary.
>>>>
>>>
>>> I don't think Ada needs compile-time subprograms, it just needs to
>>> recognise actual static data which can be generated at compile time,
>>
>> Without calling subprograms? That is not possible in 99% of use cases.
>
> Course it is. The compiler will translate the code into data.
Consider an array filled with Fibonacci numbers or a parser's tokens
table or a constant instance of Ada.Containers.Vectors. It is a big
issue for small embedded systems with instant booting time requirement.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 15:21 0% ` Dmitry A. Kazakov
@ 2020-06-16 15:43 0% ` Luke A. Guest
2020-06-16 16:11 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Luke A. Guest @ 2020-06-16 15:43 UTC (permalink / raw)
On 16/06/2020 16:21, Dmitry A. Kazakov wrote:
> On 16/06/2020 16:42, Luke A. Guest wrote:
>> On 16/06/2020 15:25, Dmitry A. Kazakov wrote:
>>> On 16/06/2020 16:14, Niklas Holsti wrote:
>>
>>>> I have no idea if this will help you -- the types in our case were
>>>> much simpler -- but you might try it with a small subset of your
>>>> package:
>>>>
>>>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>>>> (True, (NUL, NUL, NUL, NUL));
>>>>
>>>> (assuming "use Ada.Characters.Latin_1").
>>>
>>> That is interesting. Was there the "others =>" part?
>>>
>>> I can imagine that with "others => NUL" a static zeroed section were
>>> used with other parts written upon it during start.
>>>
>>> P.S. I hope more people now see why compile-time subprograms are
>>> necessary.
>>>
>>
>> I don't think Ada needs compile-time subprograms, it just needs to
>> recognise actual static data which can be generated at compile time,
>
> Without calling subprograms? That is not possible in 99% of use cases.
Course it is. The compiler will translate the code into data.
> Note also that initialization of shared sections using run-time code is
> simply not possible as you must run the code exactly once.
>
>> also the static_predicate could be evaluated by the compiler at runtime
>> too.
>
> And the predicate's terms were only literals?
>
Yup.
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 14:42 0% ` Luke A. Guest
@ 2020-06-16 15:21 0% ` Dmitry A. Kazakov
2020-06-16 15:43 0% ` Luke A. Guest
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2020-06-16 15:21 UTC (permalink / raw)
On 16/06/2020 16:42, Luke A. Guest wrote:
> On 16/06/2020 15:25, Dmitry A. Kazakov wrote:
>> On 16/06/2020 16:14, Niklas Holsti wrote:
>
>>> I have no idea if this will help you -- the types in our case were
>>> much simpler -- but you might try it with a small subset of your package:
>>>
>>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>>> (True, (NUL, NUL, NUL, NUL));
>>>
>>> (assuming "use Ada.Characters.Latin_1").
>>
>> That is interesting. Was there the "others =>" part?
>>
>> I can imagine that with "others => NUL" a static zeroed section were
>> used with other parts written upon it during start.
>>
>> P.S. I hope more people now see why compile-time subprograms are necessary.
>>
>
> I don't think Ada needs compile-time subprograms, it just needs to
> recognise actual static data which can be generated at compile time,
Without calling subprograms? That is not possible in 99% of use cases.
Note also that initialization of shared sections using run-time code is
simply not possible as you must run the code exactly once.
> also the static_predicate could be evaluated by the compiler at runtime
> too.
And the predicate's terms were only literals?
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 14:25 0% ` Dmitry A. Kazakov
2020-06-16 14:32 0% ` Niklas Holsti
@ 2020-06-16 14:42 0% ` Luke A. Guest
2020-06-16 15:21 0% ` Dmitry A. Kazakov
1 sibling, 1 reply; 200+ results
From: Luke A. Guest @ 2020-06-16 14:42 UTC (permalink / raw)
On 16/06/2020 15:25, Dmitry A. Kazakov wrote:
> On 16/06/2020 16:14, Niklas Holsti wrote:
>> I have no idea if this will help you -- the types in our case were
>> much simpler -- but you might try it with a small subset of your package:
>>
>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>> (True, (NUL, NUL, NUL, NUL));
>>
>> (assuming "use Ada.Characters.Latin_1").
>
> That is interesting. Was there the "others =>" part?
>
> I can imagine that with "others => NUL" a static zeroed section were
> used with other parts written upon it during start.
>
> P.S. I hope more people now see why compile-time subprograms are necessary.
>
I don't think Ada needs compile-time subprograms, it just needs to
recognise actual static data which can be generated at compile time,
also the static_predicate could be evaluated by the compiler at runtime
too.
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 14:14 2% ` Niklas Holsti
2020-06-16 14:25 0% ` Dmitry A. Kazakov
@ 2020-06-16 14:40 0% ` Luke A. Guest
1 sibling, 0 replies; 200+ results
From: Luke A. Guest @ 2020-06-16 14:40 UTC (permalink / raw)
On 16/06/2020 15:14, Niklas Holsti wrote:
> On 2020-06-16 14:31, Luke A. Guest wrote:
>> Hi,
>>
>> I'm trying to get some static data tables into the data section rather
>> than be elaborated at runtime. I can see no reason why this particular
>> set of types, records and aggregates cannot go into the data section.
>
> [snip]
>
>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>> Pixel_Format_Names'(Planar => True,
>> Planar_Format => Planar_Pixels'
>> (others => Ada.Characters.Latin_1.NUL));
Strangely enough, with preelaborate, that's the only one which gets put
into rodata:
Disassembly of section
.rodata.sdl__video__pixel_formats__pixel_format_unknown:
0000000000000000 <sdl__video__pixel_formats__pixel_format_unknown>:
sdl__video__pixel_formats__pixel_format_unknown : constant
0: 00 00 add %al,(%rax)
...
Disassembly of section .bss.sdl__video__pixel_formats__A44s:
0000000000000000 <sdl__video__pixel_formats__A44s>:
0: 00 00 add %al,(%rax)
...
Disassembly of section
.bss.sdl__video__pixel_formats__pixel_format_index_1_lsb:
0000000000000000 <sdl__video__pixel_formats__pixel_format_index_1_lsb>:
sdl__video__pixel_formats__pixel_format_index_1_lsb : constant
0: 00 00 add %al,(%rax)
> Several years ago we had a problem like this, with a large constant
> array that we wanted to have only once in RAM. This was with the XGC Ada
> compiler, but there we found a work-around: using positional rather than
> named association for the large array aggregate.
>
> I have no idea if this will help you -- the types in our case were much
> simpler -- but you might try it with a small subset of your package:
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> (True, (NUL, NUL, NUL, NUL));
>
> (assuming "use Ada.Characters.Latin_1").
>
Nope, that doesn't work.
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 14:25 0% ` Dmitry A. Kazakov
@ 2020-06-16 14:32 0% ` Niklas Holsti
2020-06-16 14:42 0% ` Luke A. Guest
1 sibling, 0 replies; 200+ results
From: Niklas Holsti @ 2020-06-16 14:32 UTC (permalink / raw)
On 2020-06-16 17:25, Dmitry A. Kazakov wrote:
> On 16/06/2020 16:14, Niklas Holsti wrote:
>> On 2020-06-16 14:31, Luke A. Guest wrote:
>
>>> I'm trying to get some static data tables into the data section rather
>>> than be elaborated at runtime. I can see no reason why this particular
>>> set of types, records and aggregates cannot go into the data section.
>>
>> [snip]
>>
>>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>>> Pixel_Format_Names'(Planar => True,
>>> Planar_Format => Planar_Pixels'
>>> (others => Ada.Characters.Latin_1.NUL));
>>
>> Several years ago we had a problem like this, with a large constant
>> array that we wanted to have only once in RAM. This was with the XGC
>> Ada compiler, but there we found a work-around: using positional
>> rather than named association for the large array aggregate.
>>
>> I have no idea if this will help you -- the types in our case were
>> much simpler -- but you might try it with a small subset of your package:
>>
>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>> (True, (NUL, NUL, NUL, NUL));
>>
>> (assuming "use Ada.Characters.Latin_1").
>
> That is interesting. Was there the "others =>" part?
I don't remember for sure, but I think not.
As I said, the types were much simpler. IIRC, the array elements were
System.Address, and the index was an integer range. The array mapped the
identifiers of the (many!) commandable/settable program "parameters" to
their memory locations.
--
Niklas Holsti
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 14:14 2% ` Niklas Holsti
@ 2020-06-16 14:25 0% ` Dmitry A. Kazakov
2020-06-16 14:32 0% ` Niklas Holsti
2020-06-16 14:42 0% ` Luke A. Guest
2020-06-16 14:40 0% ` Luke A. Guest
1 sibling, 2 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-06-16 14:25 UTC (permalink / raw)
On 16/06/2020 16:14, Niklas Holsti wrote:
> On 2020-06-16 14:31, Luke A. Guest wrote:
>> I'm trying to get some static data tables into the data section rather
>> than be elaborated at runtime. I can see no reason why this particular
>> set of types, records and aggregates cannot go into the data section.
>
> [snip]
>
>> Pixel_Format_Unknown : constant Pixel_Format_Names :=
>> Pixel_Format_Names'(Planar => True,
>> Planar_Format => Planar_Pixels'
>> (others => Ada.Characters.Latin_1.NUL));
>
> Several years ago we had a problem like this, with a large constant
> array that we wanted to have only once in RAM. This was with the XGC Ada
> compiler, but there we found a work-around: using positional rather than
> named association for the large array aggregate.
>
> I have no idea if this will help you -- the types in our case were much
> simpler -- but you might try it with a small subset of your package:
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> (True, (NUL, NUL, NUL, NUL));
>
> (assuming "use Ada.Characters.Latin_1").
That is interesting. Was there the "others =>" part?
I can imagine that with "others => NUL" a static zeroed section were
used with other parts written upon it during start.
P.S. I hope more people now see why compile-time subprograms are necessary.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
@ 2020-06-16 14:14 2% ` Niklas Holsti
2020-06-16 14:25 0% ` Dmitry A. Kazakov
2020-06-16 14:40 0% ` Luke A. Guest
2020-09-03 10:32 0% ` c+
` (3 subsequent siblings)
4 siblings, 2 replies; 200+ results
From: Niklas Holsti @ 2020-06-16 14:14 UTC (permalink / raw)
On 2020-06-16 14:31, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
[snip]
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
Several years ago we had a problem like this, with a large constant
array that we wanted to have only once in RAM. This was with the XGC Ada
compiler, but there we found a work-around: using positional rather than
named association for the large array aggregate.
I have no idea if this will help you -- the types in our case were much
simpler -- but you might try it with a small subset of your package:
Pixel_Format_Unknown : constant Pixel_Format_Names :=
(True, (NUL, NUL, NUL, NUL));
(assuming "use Ada.Characters.Latin_1").
--
Niklas Holsti
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 2%]
* How can I get this data into the .data section of the binary?
@ 2020-06-16 11:31 1% Luke A. Guest
2020-06-16 14:14 2% ` Niklas Holsti
` (4 more replies)
0 siblings, 5 replies; 200+ results
From: Luke A. Guest @ 2020-06-16 11:31 UTC (permalink / raw)
Hi,
I'm trying to get some static data tables into the data section rather
than be elaborated at runtime. I can see no reason why this particular
set of types, records and aggregates cannot go into the data section.
I've searched for use of pragma Static_Elaboration_Desired, but there is
very little information.
Here's the full modified source from SDL minus the header:
pragma Restrictions (No_Implicit_Loops);
with Ada.Characters.Latin_1;
with Ada.Unchecked_Conversion;
with Interfaces;
with Interfaces.C;
with SDL.Video.Palettes;
package SDL.Video.Pixel_Formats is
package C renames Interfaces.C;
type Pixel_Types is
(Unknown,
Index_1,
Index_4,
Index_8,
Packed_8,
Packed_16,
Packed_32,
Array_U8,
Array_U16,
Array_U32,
Array_F16,
Array_F32) with
Convention => C;
pragma Static_Elaboration_Desired (Pixel_Types);
-- Bitmap pixel order, high bit -> low bit.
type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
Convention => C;
pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
-- Packed component order, high bit -> low bit.
type Packed_Component_Order is
(None,
XRGB,
RGBX,
ARGB,
RGBA,
XBGR,
BGRX,
ABGR,
BGRA) with
Convention => C;
pragma Static_Elaboration_Desired (Packed_Component_Order);
-- Array component order, low byte -> high byte.
type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
pragma Static_Elaboration_Desired (Array_Component_Order);
-- Describe how the components are laid out in bit form.
type Packed_Component_Layout is
(None,
Bits_332,
Bits_4444,
Bits_1555,
Bits_5551,
Bits_565,
Bits_8888,
Bits_2101010,
Bits_1010102) with
Convention => C;
pragma Static_Elaboration_Desired (Packed_Component_Layout);
type Bits_Per_Pixels is range 0 .. 32 with
Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
| 24 | 32,
Convention => C;
pragma Static_Elaboration_Desired (Bits_Per_Pixels);
Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
type Bytes_Per_Pixels is range 0 .. 4 with
Convention => C;
pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
Bytes_Per_Pixels'First;
-- 29 28 24 20 16 8 0
-- 000 1 ptpt popo llll bibibibi bybybyby
--
-- or
--
-- 24 16 8 0
-- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
type Index_Order_Padding is range 0 .. 1 with
Convention => C;
pragma Static_Elaboration_Desired (Index_Order_Padding);
type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
record
case Pixel_Type is
when Index_1 | Index_4 | Index_8 =>
Indexed_Order : Bitmap_Pixel_Order;
Indexed_Pad : Index_Order_Padding;
when Packed_8 | Packed_16 | Packed_32 =>
Packed_Order : Packed_Component_Order;
when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
Array_Order : Array_Component_Order;
when others =>
null;
end case;
end record with
Unchecked_Union => True,
Convention => C,
Size => 4;
pragma Warnings (Off, "no component clause given");
for Pixel_Orders use
record
Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
max size required but it causes a bit set bug!
Indexed_Pad at 0 range 3 .. 3;
Packed_Order at 0 range 0 .. 3;
Array_Order at 0 range 0 .. 3;
end record;
pragma Static_Elaboration_Desired (Pixel_Orders);
pragma Warnings (On, "no component clause given");
type Planar_Pixels is
record
A : Character;
B : Character;
C : Character;
D : Character;
end record with
Size => 32,
Convention => C;
for Planar_Pixels use
record
A at 0 range 0 .. 7;
B at 0 range 8 .. 15;
C at 0 range 16 .. 23;
D at 0 range 24 .. 31;
end record;
pragma Static_Elaboration_Desired (Planar_Pixels);
type Non_Planar_Pixel_Padding is range 0 .. 7 with
Convention => C;
pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
type Non_Planar_Pixels is
record
Bytes_Per_Pixel : Bytes_Per_Pixels;
Bits_Per_Pixel : Bits_Per_Pixels;
Layout : Packed_Component_Layout;
Pixel_Order : Pixel_Orders;
Pixel_Type : Pixel_Types;
Flag : Boolean;
Padding : Non_Planar_Pixel_Padding;
end record with
Size => 32,
Convention => C;
for Non_Planar_Pixels use
record
Bytes_Per_Pixel at 0 range 0 .. 7;
Bits_Per_Pixel at 0 range 8 .. 15;
Layout at 0 range 16 .. 19;
Pixel_Order at 0 range 20 .. 23;
Pixel_Type at 0 range 24 .. 27;
Flag at 0 range 28 .. 28;
Padding at 0 range 29 .. 31;
end record;
pragma Static_Elaboration_Desired (Non_Planar_Pixels);
type Pixel_Format_Names (Planar : Boolean := False) is
record
case Planar is
when True =>
Planar_Format : Planar_Pixels;
when False =>
Non_Planar_Format : Non_Planar_Pixels;
end case;
end record with
Unchecked_Union => True,
Size => 32,
Convention => C;
pragma Static_Elaboration_Desired (Pixel_Format_Names);
Pixel_Format_Unknown : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(others => Ada.Characters.Latin_1.NUL));
pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_1,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_1,
Indexed_Order => Little_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 1,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_1,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_1,
Indexed_Order => Big_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 1,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_4,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_4,
Indexed_Order => Little_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 4,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_4,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_4,
Indexed_Order => Big_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 4,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
Pixel_Format_Index_8 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_8,
Indexed_Order => None,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 8,
Bytes_Per_Pixel => 1));
pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_8,
Packed_Order => XRGB),
Layout => Bits_332,
Bits_Per_Pixel => 8,
Bytes_Per_Pixel => 1));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XRGB),
Layout => Bits_4444,
Bits_Per_Pixel => 12,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XRGB),
Layout => Bits_1555,
Bits_Per_Pixel => 15,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XBGR),
Layout => Bits_1555,
Bits_Per_Pixel => 15,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ARGB),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => RGBA),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ABGR),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => BGRA),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ARGB),
Layout => Bits_1555,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => RGBA),
Layout => Bits_5551,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ABGR),
Layout => Bits_1555,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => BGRA),
Layout => Bits_5551,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XRGB),
Layout => Bits_565,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XBGR),
Layout => Bits_565,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Array_U8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Array_U8,
Array_Order => RGB),
Layout => None,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 3));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Array_U8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Array_U8,
Array_Order => BGR),
Layout => None,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 3));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => XRGB),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => RGBX),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => XBGR),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => BGRX),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => ARGB),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => RGBA),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => ABGR),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => BGRA),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => ARGB),
Layout => Bits_2101010,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
Pixel_Format_YV_12 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'Y',
B => 'V',
C => '1',
D => '2'));
pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
Pixel_Format_IYUV : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'I',
B => 'Y',
C => 'U',
D => 'V'));
pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'Y',
B => 'U',
C => 'Y',
D => '2'));
pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
Pixel_Format_UYVY : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'U',
B => 'Y',
C => 'V',
D => 'Y'));
pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
Pixel_Format_YVYU : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'Y',
B => 'V',
C => 'Y',
D => 'U'));
pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
type Colour_Mask is mod 2 ** 32 with
Convention => C;
type Private_Pixel_Format is private;
type Pixel_Format is
record
Format : Pixel_Format_Names;
Palette : Palettes.Palette_Access;
Bits : Bits_Per_Pixels;
Bytes : Bytes_Per_Pixels;
Padding : Interfaces.Unsigned_16;
Red_Mask : Colour_Mask;
Green_Mask : Colour_Mask;
Blue_Mask : Colour_Mask;
Alpha_Mask : Colour_Mask;
-- This is mainly padding to make sure the record size matches
what is expected from C.
Private_Part : Private_Pixel_Format;
end record with
Convention => C;
-- TODO: Possibly change this to a controlled type.
type Pixel_Format_Access is access all Pixel_Format with
Convention => C;
function Create (Format : in Pixel_Format_Names) return
Pixel_Format_Access with
Import => True,
Convention => C,
External_Name => "SDL_AllocFormat";
procedure Free (Format : in Pixel_Format_Access) with
Import => True,
Convention => C,
External_Name => "SDL_FreeFormat";
function Image (Format : in Pixel_Format_Names) return String;
-- Import => True,
-- Convention => C,
-- External_Name => "SDL_GetPixelFormatName";
procedure To_Components
(Pixel : in Interfaces.Unsigned_32;
Format : in Pixel_Format_Access;
Red : out Palettes.Colour_Component;
Green : out Palettes.Colour_Component;
Blue : out Palettes.Colour_Component) with
Import => True,
Convention => C,
External_Name => "SDL_GetRGB";
procedure To_Components
(Pixel : in Interfaces.Unsigned_32;
Format : in Pixel_Format_Access;
Red : out Palettes.Colour_Component;
Green : out Palettes.Colour_Component;
Blue : out Palettes.Colour_Component;
Alpha : out Palettes.Colour_Component) with
Import => True,
Convention => C,
External_Name => "SDL_GetRGBA";
function To_Pixel
(Format : in Pixel_Format_Access;
Red : in Palettes.Colour_Component;
Green : in Palettes.Colour_Component;
Blue : in Palettes.Colour_Component) return
Interfaces.Unsigned_32 with
Import => True,
Convention => C,
External_Name => "SDL_MapRGB";
function To_Pixel
(Format : in Pixel_Format_Access;
Red : in Palettes.Colour_Component;
Green : in Palettes.Colour_Component;
Blue : in Palettes.Colour_Component;
Alpha : in Palettes.Colour_Component) return
Interfaces.Unsigned_32 with
Import => True,
Convention => C,
External_Name => "SDL_MapRGBA";
function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
Pixel_Format_Access) return Palettes.Colour with
Inline => True;
function To_Pixel (Colour : in Palettes.Colour; Format : in
Pixel_Format_Access) return Interfaces.Unsigned_32 with
Inline => True;
function To_Name
(Bits : in Bits_Per_Pixels;
Red_Mask : in Colour_Mask;
Green_Mask : in Colour_Mask;
Blue_Mask : in Colour_Mask;
Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
Import => True,
Convention => C,
External_Name => "SDL_MasksToPixelFormatEnum";
function To_Masks
(Format : in Pixel_Format_Names;
Bits : out Bits_Per_Pixels;
Red_Mask : out Colour_Mask;
Green_Mask : out Colour_Mask;
Blue_Mask : out Colour_Mask;
Alpha_Mask : out Colour_Mask) return Boolean with
Inline => True;
-- Gamma
type Gamma_Value is mod 2 ** 16 with
Convention => C;
type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
Convention => C;
procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
Import => True,
Convention => C,
External_Name => "SDL_CalculateGammaRamp";
private
-- The following fields are defined as "internal use" in the SDL docs.
type Private_Pixel_Format is
record
Rred_Loss : Interfaces.Unsigned_8;
Green_Loss : Interfaces.Unsigned_8;
Blue_Loss : Interfaces.Unsigned_8;
Alpha_Loss : Interfaces.Unsigned_8;
Red_Shift : Interfaces.Unsigned_8;
Green_Shift : Interfaces.Unsigned_8;
Blue_Shift : Interfaces.Unsigned_8;
Alpha_Shift : Interfaces.Unsigned_8;
Ref_Count : C.int;
Next : Pixel_Format_Access;
end record with
Convention => C;
end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 1%]
* Re: How do I resolve SPARK warning "procedure [...] has no effect for output procedure
@ 2020-03-26 0:45 2% ` digitig
0 siblings, 0 replies; 200+ results
From: digitig @ 2020-03-26 0:45 UTC (permalink / raw)
On Wednesday, March 25, 2020 at 11:38:06 PM UTC, Anh Vo wrote:
> Would you mind to post the source code and the warning message. So, every one is at the page.
Ok, here's a simplified thing that gives the same issue:
Suppose I've got a naive error logging procedure (to isolate the use of Standard_Error, which Spark doesn't like and I don't know how to get at the underlying file in Ada yet):
with Ada.Text_IO; use Ada.Text_IO;
package body Logging is
procedure Log_Error(Message: String) with SPARK_Mode => Off is
begin
Put_Line(Standard_Error, Message);
end Log_Error;
end Logging;
As you can see, SPARK is turned off for that. Then I have (simplified) :
with Logging; use Logging;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
package body Utils is
procedure Error_Header is
begin
Log_Error
("This is the standard header I want for the Standard_Error output" &
LF);
end Error_Header;
end Utils;
When I run SPARK examiner (from within GPS) I Get the warning I'd like to clear:
warning: subprogram "Error_Header" has no effect.
^ permalink raw reply [relevance 2%]
* Re: Making the same mistake as the broken C interface to fortran
2019-07-02 20:57 0% ` Simon Wright
@ 2019-07-03 7:06 0% ` Chris M Moore
0 siblings, 0 replies; 200+ results
From: Chris M Moore @ 2019-07-03 7:06 UTC (permalink / raw)
On 02/07/2019 21:57, Simon Wright wrote:
> Chris M Moore <zmower@ntlworld.com> writes:
>
>> Read this interesting article today:
>>
>> https://lwn.net/SubscriberLink/791393/41d57555202e8cdb/
>>
>> Synopsis: C interfaces to Fortran makes some assumptions about how to
>> call fortran ABIs (I don't need to pass the hidden length parameter if
>> its a character*1) but now Gfortran has optimisations which assume a
>> different calling convention (Thou shalt pass the hidden length).
>>
>> There are work arounds (compile fortran with
>> ‑fno‑optimize‑sibling‑calls) but it seems that the proper fix is to
>> pass the hidden length parameter.
>>
>> I had a quick look at the LAPACK bindings and they both seem to use
>> Ada characters. :/
>
> The code generated with Convention=Fortran should abide by the ABI, and
> if that says to pass a hidden length parameter then that's what should
> happen.
>
> I don't know enough x86_64 (or thumb) assembler to be at all sure, but
> it looks to me as though no length parameter gets passed.
>
Hi Simon,
So the question is do we break the API or not? We could make the
bindings thicker and thus slower. Or break the typing and force client
software to change. The software engineer in me says the former but I'm
not a user of this API so I doubt my views count for much.
--
sig pending (since 1995)
^ permalink raw reply [relevance 0%]
* Re: Making the same mistake as the broken C interface to fortran
2019-06-24 23:33 2% Making the same mistake as the broken C interface to fortran Chris M Moore
@ 2019-07-02 20:57 0% ` Simon Wright
2019-07-03 7:06 0% ` Chris M Moore
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2019-07-02 20:57 UTC (permalink / raw)
Chris M Moore <zmower@ntlworld.com> writes:
> Read this interesting article today:
>
> https://lwn.net/SubscriberLink/791393/41d57555202e8cdb/
>
> Synopsis: C interfaces to Fortran makes some assumptions about how to
> call fortran ABIs (I don't need to pass the hidden length parameter if
> its a character*1) but now Gfortran has optimisations which assume a
> different calling convention (Thou shalt pass the hidden length).
>
> There are work arounds (compile fortran with
> ‑fno‑optimize‑sibling‑calls) but it seems that the proper fix is to
> pass the hidden length parameter.
>
> I had a quick look at the LAPACK bindings and they both seem to use
> Ada characters. :/
The code generated with Convention=Fortran should abide by the ABI, and
if that says to pass a hidden length parameter then that's what should
happen.
I don't know enough x86_64 (or thumb) assembler to be at all sure, but
it looks to me as though no length parameter gets passed.
^ permalink raw reply [relevance 0%]
* Making the same mistake as the broken C interface to fortran
@ 2019-06-24 23:33 2% Chris M Moore
2019-07-02 20:57 0% ` Simon Wright
0 siblings, 1 reply; 200+ results
From: Chris M Moore @ 2019-06-24 23:33 UTC (permalink / raw)
Hi,
Read this interesting article today:
https://lwn.net/SubscriberLink/791393/41d57555202e8cdb/
Synopsis: C interfaces to Fortran makes some assumptions about how to
call fortran ABIs (I don't need to pass the hidden length parameter if
its a character*1) but now Gfortran has optimisations which assume a
different calling convention (Thou shalt pass the hidden length).
There are work arounds (compile fortran with
‑fno‑optimize‑sibling‑calls) but it seems that the proper fix is to pass
the hidden length parameter.
I had a quick look at the LAPACK bindings and they both seem to use Ada
characters. :/
--
sig pending (since 1995)
^ permalink raw reply [relevance 2%]
* Re: gnat_regpat and unexpected handling of alnum and unicode needed
@ 2019-02-17 12:50 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2019-02-17 12:50 UTC (permalink / raw)
19.krause.70@googlemail.com writes:
> The expression [[:alnum:]] matches the underscore in gnat_regpat but
> not in egrep. It feels much more natural to don't match the underscore
> like egrep does. And I think it is more posix compliant.
>
> Question is why?
Because, at s-regpat.adb:2325, we find
function Is_Alnum (C : Character) return Boolean is
begin
return Is_Alphanumeric (C) or else C = '_';
end Is_Alnum;
(Is_Alphanumeric is in Ada.Characters.Handling), presumably because the
author liked using underscores in identifiers.
> How do I handle unicode strings with gnat_regpat, because [[:alpha:]]
> seems to match only ascii a-zA-Z.
What GNAT does with -gnatW8 is to read UTF-8 from the source file and,
in the case of characters, convert then to the internal Latin-1
(approximately) character. So your 'ö' is converted to the single
character with value 246, LC_O_Diaeresis.
I tried just letters, and got
fööbär Matched regexp3 ^[[:alpha:]]+$!
No idea what's going on here!
^ permalink raw reply [relevance 2%]
* Re: windows-1251 to utf-8
@ 2018-10-31 20:58 2% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2018-10-31 20:58 UTC (permalink / raw)
>Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message
>news:prcn4v$d30$1@gioia.aioe.org...
> On 2018-10-31 16:28, eduardsapotski@gmail.com wrote:
>> Let's make it easier. For example:
>>
>> ------------------------------------------------------------------
>>
>> with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
>> with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
>>
>> with AWS.Client; use AWS.Client;
>> with AWS.Messages; use AWS.Messages;
>> with AWS.Response; use AWS.Response;
>>
>> procedure Main is
>>
>> HTML_Result : Unbounded_String;
>> Request_Header_List : Header_List;
>>
>> begin
>>
>> Request_Header_List.Add(Name => "User-Agent", Value => "Mozilla/5.0
>> (X11; Linux x86_64; rv:56.0) Gecko/20100101 Firefox/56.0");
>>
>> HTML_Result := Message_Body(Get(URL => "http://www.sql.ru/", Headers
>> => Request_Header_List));
>>
>> Put_Line(HTML_Result);
>>
>> end Main;
>>
>> ------------------------------------------------------------------
>>
>> My linux terminal (default UTF-8) show:
>> https://photos.app.goo.gl/EPgwKoiFSuwkJvgSA
>>
>> If set encoding in terminal Windows-1251 - all is well:
>> https://photos.app.goo.gl/goN5g7uofD8rYLP79
>>
>> Are there standard ways to solve this problem?
>
> What problem? The page uses the content charset=windows-1251. It is legal.
>
> Your program is illegal as it prints the body using Put_Line. Ada standard
> requires Character be Latin-1. The only case when your program would be
> correct is when charset=ISO-8859-1.
>
> You must convert the page body according to the encoding specified by the
> charset key into a string containing UTF-8 octets and use
> Streams.Stream_IO to write these octets as-is. The conversion for the case
> of windows-1251 I described earlier. Create a table Character'Pos
> 0..255 -> Code_Point and use it for each "character" of HTML_Result.
>
> P.S. GNAT Text_IO ignores Latin-1, but that is between GNAT and the
> underlying OS.
>
> P.P.S. Technically AWS also ignores Ada standard. But that is an
> established practice. Since there is no better way.
Right. Probably the easiest way to do this (using just Ada functions) would
be to:
(A) Use Ada.Characters to convert the To_String of the unbounded string to
a Wide_String, and then store that in a Wide_Unbounded_String (or is that a
Unbounded_Wide_String?)
(B) Use Ada.Strings.Wide_Maps to create a character conversion map (the
conversions were described by another reply);
(C) Use Ada.Strings.Wide_Unbounded.Translate to apply the mapping from (B)
to your Wide_Unbounded_String.
(D) Use Ada.Strings.UTF_Encoding.Wide_Strings.Encode to convert
To_Wide_String to your translated Wide_Unbounded_String, presumably storing
the result into a Unbounded_String.
You potentially could skip (D) if Wide_Text_IO works when sent to
Standard_Output (I'd expect that on Windows, no idea on Linux). In that
case, use Wide_Text_IO.Put to send your result.
In any case, this shows why Unicode exists, and why anything these days that
uses non-standard encodings is evil. There's really no short-cut to recoding
such things, and that makes them maddening.
Randy.
^ permalink raw reply [relevance 2%]
* Re: Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?)
2018-08-04 1:37 3% Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?) Hazz
2018-08-04 1:59 0% ` Lucretia
@ 2018-08-04 9:07 0% ` Jeffrey R. Carter
1 sibling, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2018-08-04 9:07 UTC (permalink / raw)
On 08/04/2018 03:37 AM, Hazz wrote:
>
> How can I do this in Ada? I tried using Ada.Characters.Latin_1 ESC characters, but it just prints plaintext.
That should work (and it appears from your later post that it did). You could
look at pkg PragmARC.ANSI_TTY_Control
https://github.com/jrcarter/PragmARC
It doesn't do colors, since at the time it was developed (c. 1990) colors
weren't very portable, and this is not used much these days, but it should serve
as a guide for how to do it.
--
Jeff Carter
"The time has come to act, and act fast. I'm leaving."
Blazing Saddles
36
^ permalink raw reply [relevance 0%]
* Re: Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?)
2018-08-04 1:37 3% Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?) Hazz
@ 2018-08-04 1:59 0% ` Lucretia
2018-08-04 9:07 0% ` Jeffrey R. Carter
1 sibling, 0 replies; 200+ results
From: Lucretia @ 2018-08-04 1:59 UTC (permalink / raw)
On Saturday, 4 August 2018 02:37:39 UTC+1, Hazz wrote:
> Hello,
>
> I'm pretty new to Ada.
>
> Can we print coloured text to the terminal?
>
> Other languages permit the use of ANSI escape sequences, i.e. in Python (for example) I'd write
>
> print("\033[93mHowdy!\033[0m")
>
> And "Howdy!" appears in orange on my screen.
>
> How can I do this in Ada? I tried using Ada.Characters.Latin_1 ESC characters, but it just prints plaintext.
https://github.com/search?utf8=%E2%9C%93&q=ansi++language%3AAda&type=Repositories&ref=advsearch&l=Ada&l=
^ permalink raw reply [relevance 0%]
* Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?)
@ 2018-08-04 1:37 3% Hazz
2018-08-04 1:59 0% ` Lucretia
2018-08-04 9:07 0% ` Jeffrey R. Carter
0 siblings, 2 replies; 200+ results
From: Hazz @ 2018-08-04 1:37 UTC (permalink / raw)
Hello,
I'm pretty new to Ada.
Can we print coloured text to the terminal?
Other languages permit the use of ANSI escape sequences, i.e. in Python (for example) I'd write
print("\033[93mHowdy!\033[0m")
And "Howdy!" appears in orange on my screen.
How can I do this in Ada? I tried using Ada.Characters.Latin_1 ESC characters, but it just prints plaintext.
^ permalink raw reply [relevance 3%]
* Re: Strange crash on custom iterator
@ 2018-07-02 19:42 1% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2018-07-02 19:42 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 450 bytes --]
Luke A. Guest <laguest@archeia.com> writes:
> Simon Wright <> wrote:
>
>>> You don't need to make it tagged, to pass it by reference. It is enough
>>> to make the formal parameter aliased.
>>
>> Yes, that works (except you have to make the container you're iterating
>> over aliased too).
>
> I had to make the iterate for nation take “aliased in out” and make the
> array aliased, but it still does in the same place.
This worked for me ..
[-- Attachment #2: gnatchop-me --]
[-- Type: text/plain, Size: 9880 bytes --]
-- Copyright 2018, Luke A. Guest
-- License TBD.
with Ada.Characters.Latin_1;
with Ada.Text_IO; use Ada.Text_IO;
with UCA.Encoding;
with UCA.Iterators;
procedure Test is
package L1 renames Ada.Characters.Latin_1;
package Octet_IO is new Ada.Text_IO.Modular_IO (UCA.Octets);
use Octet_IO;
-- D : UCA.Octets := Character'Pos ('Q');
-- A : UCA.Unicode_String := UCA.To_Array (D);
-- A2 : UCA.Unicode_String := UCA.Unicode_String'(1, 0, 0, 0, 0, 0, 1, 0);
-- D2 : UCA.Octets := UCA.To_Octet (A2);
-- package OA_IO is new Ada.Text_IO.Integer_IO (Num => UCA.Bits);
use UCA.Encoding;
A : aliased UCA.Unicode_String :=
+("ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ" & L1.LF &
"Hello, world" & L1.LF &
"Sîne klâwen durh die wolken sint geslagen," & L1.LF &
"Τη γλώσσα μου έδωσαν ελληνική" & L1.LF &
"मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती." & L1.LF &
"میں کانچ کھا سکتا ہوں اور مجھے تکلیف نہیں ہوتی");
B : aliased UCA.Unicode_String :=
(225, 154, 160, 225, 155, 135, 225, 154, 187, 225, 155, 171, 225, 155, 146, 225, 155, 166, 225,
154, 166, 225, 155, 171, 225, 154, 160, 225, 154, 177, 225, 154, 169, 225, 154, 160, 225, 154,
162, 225, 154, 177, 225, 155, 171, 225, 154, 160, 225, 155, 129, 225, 154, 177, 225, 154, 170,
225, 155, 171, 225, 154, 183, 225, 155, 150, 225, 154, 187, 225, 154, 185, 225, 155, 166, 225,
155, 154, 225, 154, 179, 225, 154, 162, 225, 155, 151,
10,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100,
10,
83, 195, 174, 110, 101, 32, 107, 108, 195, 162, 119, 101, 110, 32, 100, 117, 114, 104, 32, 100,
105, 101, 32, 119, 111, 108, 107, 101, 110, 32, 115, 105, 110, 116, 32, 103, 101, 115, 108, 97,
103, 101, 110, 44,
10,
206, 164, 206, 183, 32, 206, 179, 206, 187, 207, 142, 207, 131, 207, 131, 206, 177, 32, 206, 188,
206, 191, 207, 133, 32, 206, 173, 206, 180, 207, 137, 207, 131, 206, 177, 206, 189, 32, 206, 181,
206, 187, 206, 187, 206, 183, 206, 189, 206, 185, 206, 186, 206, 174,
10,
224, 164, 174, 224, 165, 136, 224, 164, 130, 32, 224, 164, 149, 224, 164, 190, 224, 164, 129, 224,
164, 154, 32, 224, 164, 150, 224, 164, 190, 32, 224, 164, 184, 224, 164, 149, 224, 164, 164, 224,
164, 190, 32, 224, 164, 185, 224, 165, 130, 224, 164, 129, 32, 224, 164, 148, 224, 164, 176, 32,
224, 164, 174, 224, 165, 129, 224, 164, 157, 224, 165, 135, 32, 224, 164, 137, 224, 164, 184, 224,
164, 184, 224, 165, 135, 32, 224, 164, 149, 224, 165, 139, 224, 164, 136, 32, 224, 164, 154, 224,
165, 139, 224, 164, 159, 32, 224, 164, 168, 224, 164, 185, 224, 165, 128, 224, 164, 130, 32, 224,
164, 170, 224, 164, 185, 224, 165, 129, 224, 164, 130, 224, 164, 154, 224, 164, 164, 224, 165, 128, 46,
10,
217, 133, 219, 140, 218, 186, 32, 218, 169, 216, 167, 217, 134, 218, 134, 32, 218, 169, 218, 190,
216, 167, 32, 216, 179, 218, 169, 216, 170, 216, 167, 32, 219, 129, 217, 136, 218, 186, 32, 216,
167, 217, 136, 216, 177, 32, 217, 133, 216, 172, 218, 190, 219, 146, 32, 216, 170, 218, 169, 217,
132, 219, 140, 217, 129, 32, 217, 134, 219, 129, 219, 140, 218, 186, 32, 219, 129, 217, 136, 216,
170, 219, 140);
begin
-- Put_Line ("A => " & To_UTF_8_String (A));
Put_Line ("A => " & L1.LF & String (+A));
Put_Line ("A => ");
Put ('(');
for E of A loop
Put (Item => E, Base => 2);
Put (", ");
end loop;
Put (')');
New_Line;
Put_Line ("B => " & L1.LF & String (+B));
Put_Line ("A (Iterated) => ");
for I in UCA.Iterators.Iterate (A) loop
Put (UCA.Iterators.Element (I)); -- ERROR! Dies in Element, Data has nothing gdb => p position - $1 = (data => (), index => 1)
end loop;
New_Line;
end Test;
with Ada.Strings.UTF_Encoding;
with Ada.Unchecked_Conversion;
package UCA is
use Ada.Strings.UTF_Encoding;
type Octets is mod 2 ** 8 with
Size => 8;
type Unicode_String is array (Positive range <>) of Octets with
Pack => True;
type Unicode_String_Access is access all Unicode_String;
-- This should match Wide_Wide_Character in size.
type Code_Points is mod 2 ** 32 with
Static_Predicate => Code_Points in 0 .. 16#0000_D7FF# or Code_Points in 16#0000_E000# .. 16#0010_FFFF#,
Size => 32;
private
type Bits is range 0 .. 1 with
Size => 1;
type Bit_Range is range 0 .. Octets'Size - 1;
end UCA;
with Ada.Finalization;
with Ada.Iterator_Interfaces;
private with System.Address_To_Access_Conversions;
package UCA.Iterators is
---------------------------------------------------------------------------------------------------------------------
-- Iteration over code points.
---------------------------------------------------------------------------------------------------------------------
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
function Has_Element (Position : in Cursor) return Boolean;
function Element (Position : in Cursor) return Octets;
package Code_Point_Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);
function Iterate (Container : aliased in Unicode_String) return Code_Point_Iterators.Forward_Iterator'Class;
function Iterate (Container : aliased in Unicode_String; Start : in Cursor) return
Code_Point_Iterators.Forward_Iterator'Class;
---------------------------------------------------------------------------------------------------------------------
-- Iteration over grapheme clusters.
---------------------------------------------------------------------------------------------------------------------
private
use Ada.Finalization;
package Convert is new System.Address_To_Access_Conversions (Unicode_String);
type Cursor is
record
Data : Convert.Object_Pointer := null;
Index : Positive := Positive'Last;
end record;
type Code_Point_Iterator is new Limited_Controlled and Code_Point_Iterators.Forward_Iterator with
record
Data : Convert.Object_Pointer := null;
end record;
overriding
function First (Object : in Code_Point_Iterator) return Cursor;
overriding
function Next (Object : in Code_Point_Iterator; Position : Cursor) return Cursor;
end UCA.Iterators;
with Ada.Text_IO; use Ada.Text_IO;
package body UCA.Iterators is
package Octet_IO is new Ada.Text_IO.Modular_IO (UCA.Octets);
use Octet_IO;
use type Convert.Object_Pointer;
function Has_Element (Position : in Cursor) return Boolean is
begin
return Position.Index in Position.Data'Range;
end Has_Element;
function Element (Position : in Cursor) return Octets is
begin
if Position.Data = null then
raise Constraint_Error with "Fuck!";
end if;
Put ("<< Element - " & Positive'Image (Position.Index) & " - ");
Put (Position.Data (Position.Index));
Put_Line (" >>");
return Position.Data (Position.Index);
end Element;
function Iterate (Container : aliased in Unicode_String) return Code_Point_Iterators.Forward_Iterator'Class is
begin
Put_Line ("<< iterate >>");
return I : Code_Point_Iterator := (Limited_Controlled with
Data => Convert.To_Pointer (Container'Address)) do
if I.Data = null then
Put_Line ("Data => null");
else
Put_Line ("Data => not null - Length: " & Positive'Image (I.Data'Length));
end if;
null;
end return;
end Iterate;
function Iterate (Container : aliased in Unicode_String; Start : in Cursor) return
Code_Point_Iterators.Forward_Iterator'Class is
begin
Put_Line ("<< iterate >>");
return I : Code_Point_Iterator := (Limited_Controlled with
Data => Convert.To_Pointer (Container'Address)) do
if I.Data = null then
Put_Line ("Data => null");
else
Put_Line ("Data => not null");
end if;
null;
end return;
end Iterate;
---------------------------------------------------------------------------------------------------------------------
-- Iteration over grapheme clusters.
---------------------------------------------------------------------------------------------------------------------
overriding
function First (Object : in Code_Point_Iterator) return Cursor is
begin
return (Data => Object.Data, Index => Positive'First);
end First;
overriding
function Next (Object : in Code_Point_Iterator; Position : Cursor) return Cursor is
begin
return (Data => Object.Data, Index => Position.Index + 1);
end Next;
end UCA.Iterators;
-- Copyright © 2018, Luke A. Guest
with Ada.Unchecked_Conversion;
package body UCA.Encoding is
function To_Unicode_String (Str : in String) return Unicode_String is
Result : Unicode_String (1 .. Str'Length) with
Address => Str'Address;
begin
return Result;
end To_Unicode_String;
function To_String (Str : in Unicode_String) return String is
Result : String (1 .. Str'Length) with
Address => Str'Address;
begin
return Result;
end To_String;
end UCA.Encoding;
package UCA.Encoding is
use Ada.Strings.UTF_Encoding;
function To_Unicode_String (Str : in String) return Unicode_String;
function To_String (Str : in Unicode_String) return String;
function "+" (Str : in String) return Unicode_String renames To_Unicode_String;
function "+" (Str : in Unicode_String) return String renames To_String;
end UCA.Encoding;
^ permalink raw reply [relevance 1%]
* Re: The extension of Is_Basic to unicode (about AI12-0260-1)
2018-04-11 22:20 2% ` Randy Brukardt
@ 2018-04-11 23:57 0% ` ytomino
0 siblings, 0 replies; 200+ results
From: ytomino @ 2018-04-11 23:57 UTC (permalink / raw)
On Thursday, April 12, 2018 at 7:20:28 AM UTC+9, Randy Brukardt wrote:
> "J-P. Rosen" <rosen@adalog.fr> wrote in message
> news:palsmv$g18$1@gioia.aioe.org...
> > Le 11/04/2018 à 16:32, Dan'l Miller a écrit :
> >>> True if Item is a basic letter. A basic letter is a character that
> >>> is in one of the ranges 'A'..'Z' and 'a'..'z', or that is one of
> >>> the following: 'Æ', 'æ', 'Ğ', 'ğ', 'Ş', 'ş', or 'ß'.
> >> If this Ada-specific definition of this is-basic/base-Latin-letter
> >> property is the official normative list, then it seems rather
> >> arbitrary and capricious, not conforming to Unicode or to linguistic
> >> reality.
> >>
> >> In Unicode-speak's terminology/jargon, the definition of base
> >> character at https://definedterm.com/a/definition/160575 would admit
> >> quite a few more, [...]
> > The above Is_Basic is about Character, and is defined only when using
> > Latin-1. Unicode is a different standard.
>
> Moreover, its definition is historical -- it was defined this way for Ada
> 95, and whether or not that would be the correct definition had it been
> defined in 2018 is irrelevant. Changing the definition would potentially
> silently break programs that use it. There are a number of things in
> Ada.Characters.Handling that aren't correct for Unicode purposes, one of
> them is even called out by the third note in A.3.2.
>
> Randy.
Thanks for your detailed description.
If Character.Handling.Is_Basic can not be changed because compatibility, still more, this *overloading* will create new problem for the future.
For example, on rewriting some applications from Character to Wide_Character, it may be imagined that two meanings of Is_Basic will confuse.
Or, they makes hard to use "use clause", or use as a generic formal subprogram.
Excuse me for repeating, should new function name be used for new definition?
function Is_Base (Item : Wide_Character) return Boolean; -- according with Unicode
function Is_Basic (Item : Wide_Character) return Boolean is (Is_Base (Item) and Is_Letter (Item)); -- for compatibility
^ permalink raw reply [relevance 0%]
* Re: The extension of Is_Basic to unicode (about AI12-0260-1)
@ 2018-04-11 22:20 2% ` Randy Brukardt
2018-04-11 23:57 0% ` ytomino
0 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2018-04-11 22:20 UTC (permalink / raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 1284 bytes --]
"J-P. Rosen" <rosen@adalog.fr> wrote in message
news:palsmv$g18$1@gioia.aioe.org...
> Le 11/04/2018 à 16:32, Dan'l Miller a écrit :
>>> True if Item is a basic letter. A basic letter is a character that
>>> is in one of the ranges 'A'..'Z' and 'a'..'z', or that is one of
>>> the following: 'Æ', 'æ', 'Ð', 'ð', 'Þ', 'þ', or 'ß'.
>> If this Ada-specific definition of this is-basic/base-Latin-letter
>> property is the official normative list, then it seems rather
>> arbitrary and capricious, not conforming to Unicode or to linguistic
>> reality.
>>
>> In Unicode-speak's terminology/jargon, the definition of base
>> character at https://definedterm.com/a/definition/160575 would admit
>> quite a few more, [...]
> The above Is_Basic is about Character, and is defined only when using
> Latin-1. Unicode is a different standard.
Moreover, its definition is historical -- it was defined this way for Ada
95, and whether or not that would be the correct definition had it been
defined in 2018 is irrelevant. Changing the definition would potentially
silently break programs that use it. There are a number of things in
Ada.Characters.Handling that aren't correct for Unicode purposes, one of
them is even called out by the third note in A.3.2.
Randy.
^ permalink raw reply [relevance 2%]
* Re: CONSTRAINT ERROR? access check failed
@ 2018-03-01 13:45 2% ` Björn Lundin
0 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2018-03-01 13:45 UTC (permalink / raw)
On 2018-03-01 13:44, Mehdi Saada wrote:
> Those are the two last things I would like you people to review. First, I can't get out of that loop, even with the exit INNER; after "Rentrez vos commandes". It starts it again.
>
seems strange, since you do exit INNNER.
Are you sure that not something else is happening,
like all this is in a procedure that you call again?
> INNER : loop
...
> Put_Line ("Rentrer maintenant vos commandes"); exit INNER;
> exception when others => Put_Line ("ERREUR");
> end;
> end loop INNER;
>
> Then, could you tell what you think of that subprogram that is meant to purge a STRING from non graphic characters (those that make the program crash) ?
I'm likely gettting bashed for using unbounded string like this,
but I'd do like this
function Let_Only_Graphic_Characters (Input_String : in String) return
String is
use Ada.Strings.Unbounded;
use Ada.Characters.Handling;
Tmp : Unbounded_String;
begin
for i in Input_String'range loop
if Is_Graphic(Input_String(i)) then
Append(Tmp, Input_String(i));
end if;
end loop;
return To_String(Tmp);
end Let_Only_Graphic_Characters;
or with 'for of' loop
function Let_Only_Graphic_Characters (Input_String : in String) return
String is
use Ada.Strings.Unbounded;
use Ada.Characters.Handling;
Tmp : Unbounded_String;
begin
for C of Input_String loop
if Is_Graphic(C) then
Append(Tmp, C);
end if;
end loop;
return To_String(Tmp);
end Let_Only_Graphic_Characters;
--
--
Björn
^ permalink raw reply [relevance 2%]
* Re: "strings are delimited by double quote character", where there's a character variable
2017-12-01 19:09 2% ` Shark8
@ 2017-12-05 21:45 0% ` Keith Thompson
0 siblings, 0 replies; 200+ results
From: Keith Thompson @ 2017-12-05 21:45 UTC (permalink / raw)
Shark8 <onewingedshark@gmail.com> writes:
> On Friday, December 1, 2017 at 8:08:41 AM UTC-7, Mehdi Saada wrote:
>> I got a a Character variable gnat says it is a String, while
>> functions taking it as parameter take only Characters. Mentions of
>> the variable in the procedure:
>> C: Character := ''; -- strings are delimited by double quote character
>> while C /= '' loop
>> Get(C); PUSH(C);
>> end loop;
>> while (C /= '') loop -- same here
>> Get(C);
>> PUSH(C);
>> end loop;
>
> The character you are using is referred to in Ada as "Apostrophe" (See
> Package Ada.Characters.Latin_1) the character referred to as a
> double-quote character is "Quotation". -- Respectively, these are
> Character'(''') and Character'('"').
It's not an apostrophe, it's a syntax error, and it doesn't refer to any
character value.
''' -- apostrophe character
'' -- syntax error
"" -- empty string
"'" -- string containing a single apostrophe
--
Keith Thompson (The_Other_Keith) kst-u@mib.org <http://www.ghoti.net/~kst>
Working, but not speaking, for JetHead Development, Inc.
"We must do something. This is something. Therefore, we must do this."
-- Antony Jay and Jonathan Lynn, "Yes Minister"
^ permalink raw reply [relevance 0%]
* Re: "strings are delimited by double quote character", where there's a character variable
@ 2017-12-01 19:09 2% ` Shark8
2017-12-05 21:45 0% ` Keith Thompson
0 siblings, 1 reply; 200+ results
From: Shark8 @ 2017-12-01 19:09 UTC (permalink / raw)
On Friday, December 1, 2017 at 8:08:41 AM UTC-7, Mehdi Saada wrote:
> I got a a Character variable gnat says it is a String, while functions taking it as parameter take only Characters. Mentions of the variable in the procedure:
> C: Character := ''; -- strings are delimited by double quote character
> while C /= '' loop
> Get(C); PUSH(C);
> end loop;
> while (C /= '') loop -- same here
> Get(C);
> PUSH(C);
> end loop;
The character you are using is referred to in Ada as "Apostrophe" (See Package Ada.Characters.Latin_1) the character referred to as a double-quote character is "Quotation". -- Respectively, these are Character'(''') and Character'('"').
String and Character are two separate types, though related, and are therefore not interchangeable. / A String is an array of Character, and thus can be specified via aggregate as ('H', 'e', 'l', 'l', 'o')... this would be rather tedious and so there exists a bit of syntactic sugar to specify a String: these are the Quotation delimiters and result in the previous value also being representable as "Hello".
^ permalink raw reply [relevance 2%]
* Re: send email
@ 2017-07-18 7:48 2% ` Björn Lundin
0 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2017-07-18 7:48 UTC (permalink / raw)
On 2017-06-28 11:25, Distant Worlds wrote:
>
>
> /********************************************************************/
>
> raised PROGRAM_ERROR : finalize/adjust raised exception
>
> /********************************************************************/
>
> CentOS 6.9 Ada GNAT 2017
>
>
>>> :((
>
>
I got this running fine seding mails from Amazon.
I _think_ you need a Credential parameter in the Initialize if you say
Secure => True
And I could not point out the path to the cert, had to make that current
directory. But that may have changed now.
procedure Mail_Saldo(Saldo, Old : Balances.Balance_Type) is
T : Calendar2.Time_Type := Calendar2.Clock;
Subject : constant String := "BetBot Saldo Report";
use AWS;
SMTP_Server_Name : constant String :=
"email-smtp.eu-west-1.amazonaws.com";
Status : SMTP.Status;
begin
Ada.Directories.Set_Directory(Ada.Environment_Variables.Value("BOT_CONFIG")
& "/sslcert");
declare
Auth : aliased constant SMTP.Authentication.Plain.Credential :=
SMTP.Authentication.Plain.Initialize
("AKESJZDQQ2DDNB58SKQ",
"SOME scrabled string");
SMTP_Server : SMTP.Receiver := SMTP.Client.Initialize
(SMTP_Server_Name,
Port => 2465,
Secure => True,
Credential => Auth'Unchecked_Access);
use Ada.Characters.Latin_1;
Today : Fixed_Type := Saldo.Balance + abs(Saldo.Exposure);
Yesterday : Fixed_Type := Old.Balance + abs(Old.Exposure);
Msg : constant String :=
"some MSG sent from: " & GNAT.Sockets.Host_Name ;
Receivers : constant SMTP.Recipients := (
An array of the receivers
);
begin
SMTP.Client.Send(Server => SMTP_Server,
From => SMTP.E_Mail ("someone",
"someone@someone.com"),
To => Receivers,
Subject => Subject,
Message => Msg,
Status => Status);
end;
if not SMTP.Is_Ok (Status) then
Log (Me & "Mail_Saldo", "Can't send message: " &
SMTP.Status_Message (Status));
end if;
end Mail_Saldo;
--
--
Björn
^ permalink raw reply [relevance 2%]
* Re: Question on bounded / unbounded strings
2016-09-14 19:39 1% ` Jeffrey R. Carter
@ 2016-09-17 16:35 1% ` Arie van Wingerden
0 siblings, 0 replies; 200+ results
From: Arie van Wingerden @ 2016-09-17 16:35 UTC (permalink / raw)
Thx for the extensive review! I'll look into it.
"Jeffrey R. Carter" schreef in bericht news:nrc923$nth$1@dont-email.me...
On 09/14/2016 05:57 AM, Arie van Wingerden wrote:
>
> Path : string := ASF.Translate(AEV.Value("Path"),
> ASMC.Lower_Case_Map);
> Match : string := ASF.Translate(ATIO.Get_Line, ASMC.Lower_Case_Map);
You might want to look at pkg Ada.Characters.Handling, particularly the
functions To_Lower.
Ada is case insensitive, and many of us will run your code through a
formatter
to make it look like the code we're familiar with, converting identifiers to
Initial_Caps, and changing CamelCase into difficult to read things like
Findmatch. The recommended practice for Ada is to
> procedure FindMatch (Match : in string; Path : in string; StartPos : in
> positive; Len : in natural) is
> EndPos : positive;
> begin
> if Len > 0 then -- Ignore case of an unnecessary semi colon
This test is unnecessary. If Len = 0, Endpos = Startpos - 1, and Startpos ..
Endpos is a null range. Any array sliced with a null range yields a
zero-length
slice; in the case of String, the null string (""). Index will always return
0
if Source is null and Pattern is not.
> EndPos := StartPos + Len - 1;
> if ASF.Index(Source => Path(StartPos .. EndPos), Pattern =>
> Match) >
> 0 then
> ATIO.Put_Line(Path(StartPos .. EndPos));
> end if;
> end if;
> end FindMatch;
>
> procedure Match_Path (Match : in string; Path : in string) is
> StartPos : positive := 1;
> Len : natural := 0;
> begin
> for I in Path'Range loop
> if Path(I) = ';' then
You can use index to find semi-colons in Path
Index (Path, ";")
> FindMatch(Match, Path, StartPos, Len);
Note that you're passing Path and Startpos to Findmatch, which uses Startpos
as
an index into Path. The first time you do this, Startpos = 1. In other
words,
you're assuming that 1 is a valid index for Path. While this may always be
true
for this program, if you need to do something similar in another situation,
you
might reuse this code, but pass a value for Path for which it is not true.
It
would be better to initialize Startpos to Path'First.
Rather than calculate Endpos and slice Path in Findmatch, why not pass the
slice
of Path
procedure Findmatch (Match : in String; Path : in String);
Findmatch (Match => Match, Path => Path (Startpos .. Startpos + Len -
1) );
? As noted above, passing a null string for Path will not be a problem.
If Path doesn't contain ';', your program does nothing. If Path doesn't end
with
';', the part of Path from the last semi-colon to the end won't be checked.
What
should it do if Match is null?
I suspect this could be implemented more simply and clearly (and correctly)
using Index for the ';' as well as for Match.
--
Jeff Carter
"Since I strongly believe that overpopulation is by
far the greatest problem in the world, this [Soylent
Green] would be my only message movie."
Charleton Heston
123
^ permalink raw reply [relevance 1%]
* Re: Question on bounded / unbounded strings
@ 2016-09-14 19:39 1% ` Jeffrey R. Carter
2016-09-17 16:35 1% ` Arie van Wingerden
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2016-09-14 19:39 UTC (permalink / raw)
On 09/14/2016 05:57 AM, Arie van Wingerden wrote:
>
> Path : string := ASF.Translate(AEV.Value("Path"), ASMC.Lower_Case_Map);
> Match : string := ASF.Translate(ATIO.Get_Line, ASMC.Lower_Case_Map);
You might want to look at pkg Ada.Characters.Handling, particularly the
functions To_Lower.
Ada is case insensitive, and many of us will run your code through a formatter
to make it look like the code we're familiar with, converting identifiers to
Initial_Caps, and changing CamelCase into difficult to read things like
Findmatch. The recommended practice for Ada is to
> procedure FindMatch (Match : in string; Path : in string; StartPos : in
> positive; Len : in natural) is
> EndPos : positive;
> begin
> if Len > 0 then -- Ignore case of an unnecessary semi colon
This test is unnecessary. If Len = 0, Endpos = Startpos - 1, and Startpos ..
Endpos is a null range. Any array sliced with a null range yields a zero-length
slice; in the case of String, the null string (""). Index will always return 0
if Source is null and Pattern is not.
> EndPos := StartPos + Len - 1;
> if ASF.Index(Source => Path(StartPos .. EndPos), Pattern => Match) >
> 0 then
> ATIO.Put_Line(Path(StartPos .. EndPos));
> end if;
> end if;
> end FindMatch;
>
> procedure Match_Path (Match : in string; Path : in string) is
> StartPos : positive := 1;
> Len : natural := 0;
> begin
> for I in Path'Range loop
> if Path(I) = ';' then
You can use index to find semi-colons in Path
Index (Path, ";")
> FindMatch(Match, Path, StartPos, Len);
Note that you're passing Path and Startpos to Findmatch, which uses Startpos as
an index into Path. The first time you do this, Startpos = 1. In other words,
you're assuming that 1 is a valid index for Path. While this may always be true
for this program, if you need to do something similar in another situation, you
might reuse this code, but pass a value for Path for which it is not true. It
would be better to initialize Startpos to Path'First.
Rather than calculate Endpos and slice Path in Findmatch, why not pass the slice
of Path
procedure Findmatch (Match : in String; Path : in String);
Findmatch (Match => Match, Path => Path (Startpos .. Startpos + Len - 1) );
? As noted above, passing a null string for Path will not be a problem.
If Path doesn't contain ';', your program does nothing. If Path doesn't end with
';', the part of Path from the last semi-colon to the end won't be checked. What
should it do if Match is null?
I suspect this could be implemented more simply and clearly (and correctly)
using Index for the ';' as well as for Match.
--
Jeff Carter
"Since I strongly believe that overpopulation is by
far the greatest problem in the world, this [Soylent
Green] would be my only message movie."
Charleton Heston
123
^ permalink raw reply [relevance 1%]
* Re: Can anyone help with GNAT.Perfect_Hash_Generators ? (Possible memory corruption)
@ 2016-09-06 19:24 1% ` Natasha Kerensikova
0 siblings, 0 replies; 200+ results
From: Natasha Kerensikova @ 2016-09-06 19:24 UTC (permalink / raw)
Hello,
On 2016-09-05, Stephen Leake <stephen_leake@stephe-leake.org> wrote:
> Please post the code that shows the problem; it's very hard to say
> anything useful otherwise. If the code is large, please try to reduce
> it to a minimal set that shows the problem.
It took me that long to make the minimal reproducer. Maybe it's obvious
only to me because of my heavy C background, but memory corruption that
depends on seemingly unrelated can take weeks to reproduce reliably.
I thought I would post anyway, in hope of anyone sharing general hints
for that kind of problem, that might be worth trying even without
further detail on my particular instance of the problem.
>> Now one of the reasons I like Ada so much is that under normal
>> circumstances it's impossible to corrupt memory, especially in a way
>> that depends on what other code is compiled besides it.
>
> Yes; you should get an exception or compilation error before
> corrupting memory.
>
> However, some of the GNAT packages are implemented in C, so they don't
> have that level of protection. But AdaCore is very careful in
> implementing those packages, and guarantees them for paying customers,
> so you should expect them to work.
The problem is in a package that seems written in Ada.
>> So is there anybody who can help with it? Or give me any clue?
>> Should I offer the verbose log, the source code, some other info?
>
> the log and the source code would be helpful.
OK so now for the reproducer and the current details on my particular
problem. Everything relevant is available at
http://users.instinctive.eu/nat/phg/
All the Ada files are library-level procedures, without any dependency
except Ada.Characters.Latin_1 and GNAT.Perfect_Hash_Generators. I
compiled them with FSF GNAT 4.9.3, 5.4.0 and 6.2.0, each with -O0 and
-O3, under FreeBSD 10.3-RELEASE on a 64-bit intel platform. The result
was exactly the same in all these conditions.
For each phg?.adb, the corresponding phg?.txt is the output of the
compiled binary, which contains only traces from
GNAT.Perfect_Hash_Generators.
phg1.adb is my first attempt at a minimal reproducer, this is exactly
the sequence of calls when the problem happens. But this minimal code
works perfectly, so it's not very useful except as a control.
After a long series of simple code that works and big code that doesn't,
I managed to isolate the trigger: it came from my having the keys not as
a set of separate strings, but a substrings of a concatenated big string
(that's how it is stored in my big code). That's in phg2.adb, the big
string and the offsets of the slices inside it. At least on my machines,
it reliably reproduce the memory corruption issue.
As I mentioned in the previous post, when comparing phg1.txt and
phg2.txt one can see that the sequence of inserted keys are identical,
and then the Initial Key Tables are identical too. But immediately after
the initial key table dump, one can see the 35 vs 36 different classes
of first-character. It's easy to compute programmatically than to see
with the eyes, but there are really only 35 different leading
characters. Then much later, one can find the Reduced Keys Table for
positions (1, 2, 3, 4), where item #67 is "http" when it works and a
bunch NUL when it doesn't.
Following the realization that the big-superstring was the trigger, I
suspected that the corruption came from the fact that all keys came from
a single object. So I tried with one object per key, created from the
big superstring, before feeding them to GNAT.Perfect_Hash_Generators.
That's phg3.adb, and indeed, it does work (phg3.txt is exactly identical
to phg1.txt)
But then I realized (and made more obvious in phg3.adb source) that not
only was I creating a new object for each key, but I was also changing
the index values. So I made phg4.adb, with independent objects having
the same indices as the substrings. And it also triggers the problem
(phg4.txt is exactly identical to phg4.txt).
So at this my conclusion is that GNAT.Perfect_Hash_Generators somehow
works fine with 1-based string, but has trouble dealing with strings
with larger indices. The "http://" that gets corrupted is the slice
Values (130 .. 136). It is larger than my usual indices, but that's
still very small for a (32-bit on my platform) Positive.
And with this, I have reached the limit of my investigative powers.
The only other potentially useful thing I found is in the source code of
GNAT.Perfect_Hash_Generators (g-pehage.adb), the argument to the Insert
procedure is copied in the internal state using `new String'(S)` but I
have no idea what it does to indices or why it would change anything
later on.
At least now I have a reproducer and a workaround, but I would still be
very interested in understanding how such a silent corruption can happen
in pure Ada code. If only to ensure I never craft myself into a similar
situation.
Hoping some can help,
Natasha
^ permalink raw reply [relevance 1%]
* Re: no code generation for c strings
@ 2016-06-03 17:04 2% ` Lucretia
0 siblings, 0 replies; 200+ results
From: Lucretia @ 2016-06-03 17:04 UTC (permalink / raw)
On Friday, 3 June 2016 17:30:14 UTC+1, Simon Wright wrote:
> "Dmitry A. Kazakov" writes:
>
> > On 03/06/2016 10:14, Luke A. Guest wrote:
> >
> >> What I would like to have is have the compiler recognise that I've declared
> >> a static char_array and just not generate a call to the secondary stack to
> >> allocate a new string. Is this actually possible? -O2/3 still generate the
> >> call.
> >>
> >> S : constant char_array := to_c ("hello" & nul);
> >
> > S : constant char_array := "hello" & char'val (0);
>
> GCC 6.1.0:
>
> with Interfaces.C;
> package Char_Arrays is
> use type Interfaces.C.char;
> use type Interfaces.C.char_array;
> S : constant Interfaces.C.char_array :=
> "hello" & Interfaces.C.char'Val (0);
> end Char_Arrays;
>
> generates (x86_64-apple-darwin15)
>
> .globl _char_arrays__s
> .const
> .align 3
> _char_arrays__s:
> .ascii "hello\0"
> .space 2
> .globl _char_arrays_E
> .data
> .align 1
> _char_arrays_E:
> .space 2
> .subsections_via_symbols
>
> & similar for arm-eabi.
Interesting, I tried this and dumped the asm, similar there, but as soon as you add more code, it just gets confusing, because it never references the actual label for the string anywhere.
with Interfaces.C;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Text_Io; use Ada.Text_Io;
procedure C_Str is
package C renames Interfaces.C;
use type Interfaces.C.char;
use type Interfaces.C.char_array;
-- S1 : constant Interfaces.C.char_array := Interfaces.C.To_C ("hello" & Nul, Append_Nul => False);
-- S2 : constant C.char_array := C.To_C ("hello");
S3 : constant C.char_array := "hello" & C.char'Val (0);
begin
-- Put_Line (C.To_Ada (S3));
null;
end C_Str;
gnatmake -gnatG c_str.adb -cargs -S
gcc -c -gnatG -S c_str.adb
Source recreated from tree for C_Str (body)
-------------------------------------------
with ada;
with ada;
with ada.ada__characters;
with interfaces;
with interfaces.interfaces__c;
with ada.ada__characters.ada__characters__latin_1;
use ada.ada__characters.ada__characters__latin_1;
with ada.ada__text_io;
use ada.ada__text_io;
procedure c_str is
c___XRP_interfaces__c___XE : _renaming_type;
package c renames interfaces.interfaces__c;
use type interfaces.interfaces__c.interfaces__c__char;
use type interfaces.interfaces__c.interfaces__c__char_array;
subtype c_str__Ts3S is interfaces__c__char_array (0 .. 5);
s3 : constant interfaces__c__char_array (0 .. 5) := "hello["00"]";
begin
null;
return;
end c_str;
gnatmake: "c_str.ali" WARNING: ALI or object file not found after compile
gnatmake: "c_str.adb" compilation error
.file "c_str.adb"
.text
.globl _ada_c_str
.type _ada_c_str, @function
_ada_c_str:
.LFB1:
.cfi_startproc
pushq %rbp
.cfi_def_cfa_offset 16
.cfi_offset 6, -16
movq %rsp, %rbp
.cfi_def_cfa_register 6
nop
nop
popq %rbp
.cfi_def_cfa 7, 8
ret
.cfi_endproc
.LFE1:
.size _ada_c_str, .-_ada_c_str
.section .rodata
.align 8
.type s3.3058, @object
.size s3.3058, 8
s3.3058:
.string "hello"
.zero 2
.ident "GCC: (GNU) 4.9.2"
.section .note.GNU-stack,"",@progbits
^ permalink raw reply [relevance 2%]
* Re: GNAT.Serial_Communication and Streams
2015-11-22 21:54 2% ` Jeffrey R. Carter
2015-11-24 1:29 0% ` Randy Brukardt
@ 2015-11-24 8:28 0% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2015-11-24 8:28 UTC (permalink / raw)
On Sun, 22 Nov 2015 14:54:04 -0700, Jeffrey R. Carter wrote:
> What about
>
> procedure Send (Cmd : in String) is
> Local : constant String := Cmd & Ada.Characters.Latin_1.LF;
> Output : constant Ada.Streams.Stream_Element_Array (1 .. Local'Length);
> pragma Import (Ada, Output);
> for Output'Address use Local'Address;
> begin -- Send
> GNAT.Serial_Communication.Write (P, Output)?
> end Send;
If you wanted optimize it, then Cmd and LF should be written in separate
calls rather than making a local copies.
A case when a copying makes sense is in a packet-oriented protocol. Which
is not the case here since streams are used. Maybe it is still
packet-oriented because of the USB device class, but then interfacing it
through a stream is inappropriate.
P.S. I don't see anything wrong with the original code. Stream attributes
not to be trusted in general. An explicit conversion is clearer and
cleaner, IMO.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: GNAT.Serial_Communication and Streams
2015-11-22 21:54 2% ` Jeffrey R. Carter
@ 2015-11-24 1:29 0% ` Randy Brukardt
2015-11-24 8:28 0% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Randy Brukardt @ 2015-11-24 1:29 UTC (permalink / raw)
"Jeffrey R. Carter" <spam.jrcarter.not@spam.not.acm.org> wrote in message
news:n2tddf$eue$1@dont-email.me...
...
> What about
>
> procedure Send (Cmd : in String) is
> Local : constant String := Cmd & Ada.Characters.Latin_1.LF;
> Output : constant Ada.Streams.Stream_Element_Array (1 .. Local'Length);
> pragma Import (Ada, Output);
> for Output'Address use Local'Address;
> begin -- Send
> GNAT.Serial_Communication.Write (P, Output)?
> end Send;
>
> ?
Probably works on GNAT, but it's not portable Ada code. For one thing, it
assumes that Implementation Advice 13.3(14) is followed (Janus/Ada does not
follow that advice - after all, it is just advice, not a requirement). It
also assumes that Local is not optimized at all (there is advice that Output
not be optimized, but that doesn't apply to Local, and like all advice, it
can be ignored).
Might not matter in this case (which is clearly GNAT-specific), but
generally this is a pattern to avoid.
Randy.
^ permalink raw reply [relevance 0%]
* Re: GNAT.Serial_Communication and Streams
@ 2015-11-22 21:54 2% ` Jeffrey R. Carter
2015-11-24 1:29 0% ` Randy Brukardt
2015-11-24 8:28 0% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: Jeffrey R. Carter @ 2015-11-22 21:54 UTC (permalink / raw)
On 11/22/2015 02:40 PM, rrr.eee.27@gmail.com wrote:
> procedure Send_Command (Cmd : String)
> is
> Output_Max_Length : constant Ada.Streams.Stream_Element_Offset := 50;
> Output : Ada.Streams.Stream_Element_Array (1 .. Output_Max_Length);
> begin
> for I in 1 .. Cmd'Length loop
> Output (Ada.Streams.Stream_Element_Offset(I)) := Character'Pos(Cmd (Cmd'First + I - 1));
> end loop;
> Output (Cmd'Length+1) := Character'Pos(ASCII.LF);
What happens when Cmd'Length > 49?
> GNAT.Serial_Communication.Write (P, Output(1..Cmd'Length+1));
> end Send_Command;
>
>
> That works but feels completely strange to me. I'm sure that I'm missing something here. There must be an easier way to fill the output buffer with a standard string.
What about
procedure Send (Cmd : in String) is
Local : constant String := Cmd & Ada.Characters.Latin_1.LF;
Output : constant Ada.Streams.Stream_Element_Array (1 .. Local'Length);
pragma Import (Ada, Output);
for Output'Address use Local'Address;
begin -- Send
GNAT.Serial_Communication.Write (P, Output)?
end Send;
?
--
Jeff Carter
"When danger reared its ugly head, he bravely
turned his tail and fled."
Monty Python and the Holy Grail
60
^ permalink raw reply [relevance 2%]
* Re: How to append linefeed to unbounded string?
2015-11-15 23:22 2% ` Jeffrey R. Carter
@ 2015-11-15 23:25 0% ` John Smith
0 siblings, 0 replies; 200+ results
From: John Smith @ 2015-11-15 23:25 UTC (permalink / raw)
On Sunday, November 15, 2015 at 6:22:50 PM UTC-5, Jeffrey R. Carter wrote:
> On 11/15/2015 04:16 PM, John Smith wrote:
> >
> > This is what I'm doing:
> > Ada.Strings.Unbounded.Append(Result,
> > Ada.Strings.Unbounded.To_Unbounded_String(
> > Ada.Characters.Latin_1.LF));
>
> To_Unbounded_String takes a String, not a Character. I'm not sure why you're
> getting a msg about it expecting Integer.
>
> There is an Append that takes a Character, as you noted, so you can do
>
> Ada.Strings.Unbounded.Append (Result, Ada.Characters.Latin_1.LF);
>
> --
> Jeff Carter
> "Apart from the sanitation, the medicine, education, wine,
> public order, irrigation, roads, the fresh water system,
> and public health, what have the Romans ever done for us?"
> Monty Python's Life of Brian
> 80
*facepalm*
You're right! I misread the documentation and hence this error!
It works now.
^ permalink raw reply [relevance 0%]
* Re: How to append linefeed to unbounded string?
2015-11-15 23:16 2% How to append linefeed to unbounded string? John Smith
@ 2015-11-15 23:22 2% ` Jeffrey R. Carter
2015-11-15 23:25 0% ` John Smith
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2015-11-15 23:22 UTC (permalink / raw)
On 11/15/2015 04:16 PM, John Smith wrote:
>
> This is what I'm doing:
> Ada.Strings.Unbounded.Append(Result,
> Ada.Strings.Unbounded.To_Unbounded_String(
> Ada.Characters.Latin_1.LF));
To_Unbounded_String takes a String, not a Character. I'm not sure why you're
getting a msg about it expecting Integer.
There is an Append that takes a Character, as you noted, so you can do
Ada.Strings.Unbounded.Append (Result, Ada.Characters.Latin_1.LF);
--
Jeff Carter
"Apart from the sanitation, the medicine, education, wine,
public order, irrigation, roads, the fresh water system,
and public health, what have the Romans ever done for us?"
Monty Python's Life of Brian
80
^ permalink raw reply [relevance 2%]
* How to append linefeed to unbounded string?
@ 2015-11-15 23:16 2% John Smith
2015-11-15 23:22 2% ` Jeffrey R. Carter
0 siblings, 1 reply; 200+ results
From: John Smith @ 2015-11-15 23:16 UTC (permalink / raw)
Hello,
This is what I'm doing:
Ada.Strings.Unbounded.Append(Result,
Ada.Strings.Unbounded.To_Unbounded_String(
Ada.Characters.Latin_1.LF));
And this is the error that I'm getting:
$ gnatmake -g ada_in_string.adb
gcc -c -g ada_in_string.adb
ada_in_string.adb:16:61: no candidate interpretations match the actuals:
ada_in_string.adb:16:104: expected type "Standard.Integer"
ada_in_string.adb:16:104: found type "Standard.Character"
ada_in_string.adb:16:104: ==> in call to "To_Unbounded_String" at
a-strunb.ads:97
ada_in_string.adb:16:104: ==> in call to "To_Unbounded_String" at
a-strunb.ads:94
gnatmake: "ada_in_string.adb" compilation error
What threw me for a loop is that when I look at the Append procedure
documentation, it turns out that it should be able to take an input of a
Character type.
Not sure why I'm getting this error...
^ permalink raw reply [relevance 2%]
* Re: Exclusive file access
@ 2015-08-29 12:02 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2015-08-29 12:02 UTC (permalink / raw)
On Sat, 29 Aug 2015 10:31:56 +0200, Pascal Obry wrote:
> Le samedi 29 août 2015 à 09:05 +0200, Dmitry A. Kazakov a écrit :
>> I doubt that. Windows "non-ascii" file names are UTF-16. The only
>> consistent way to have them would be Wide_Wide_Text_IO with names in
>> Wide_Wide_String internally recoded to UTF-16. Does GNAT this? I
>> didn't
>> look at the implementation, but I bet it does not. Then how would you
>> do
>> I/O if the content is not Wide_Wide_String?
>
> I bet you meant Wide_ instead of Wide_Wide_ above. Right?
No, I meant Wide_Wide_String.
Ada's Wide_String is legally UCS-2. Windows is UTF-16. The only full
Unicode string type is Wide_Wide_String. For an Indo-European language
there is no difference, of course.
Under Linux most applications simply ignore Ada standard and use String
encoded in UTF-8. I suppose that under Linux GNAT calmly passes String file
names as-is, i.e. as UTF-8 [*]. A conformant, but totally useless
implementation would assume names in Latin-1 and recode them into UTF-8
before passing to Linux.
GNAT under Windows is non-conformant either. I doubt it recodes UCS-2
Wide_String into UTF-16. Thus an application that uses Wide_String names
should recode names into UTF-16 first. I.e. same mess as under Linux.
A properly designed Text_IO (Unicode aware) should have used
Wide_Wide_String and/or an UTF-8 encoded string type for all file names
everywhere.
That is why I use GIO instead of Ada standard library. GIO is UTF-8 on both
Windows and Linux, which makes the applications using it portable.
------------------------------------------------------------
* Here is a program illustrating non-conformity of Linux GNAT:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
procedure Test_Latin is
File : File_Type;
begin
Create (File, Out_File, "" & LC_A_Diaeresis);
Close (File);
end Test_Latin;
The created file name is garbage, instead of "ä" (a-umlaut).
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Creating an empty file with Ada.Text_IO
@ 2015-08-25 16:45 2% ` G.B.
0 siblings, 0 replies; 200+ results
From: G.B. @ 2015-08-25 16:45 UTC (permalink / raw)
On 25.08.15 17:26, Maciej Sobczak wrote:
>
>> procedure Write_String_To_File (File_Name : in String; S : in String) is
>> A : Ada.Streams.Stream_Element_Array (1 .. S'Length);
>> F : Ada.Streams.Stream_IO.File_Type;
>> begin
>> -- convert S to stream elements
>> for I in S'Range loop
>> A (Ada.Streams.Stream_Element_Offset (I)) :=
>> Ada.Streams.Stream_Element (Character'Pos (S (I)));
>> end loop;
>
> Before anybody uses it in a rocket - there is no provision above that S'First will be 1 and the indices might not be compatible in the above assignment.
>
> Correct version is:
>
> for I in S'Range loop
> A (Ada.Streams.Stream_Element_Offset (I - S'First + 1)) :=
> Ada.Streams.Stream_Element (Character'Pos (S (I)));
> end loop;
>
> And there are actually several ways to write it.
> Now this procedure can write String slices that do not begin at index 1.
>
> (Frankly, this part of Ada is inherently error-prone. I stumble on it repeatedly.)
>
subtypes seem helpful. If S can be made of a constraint subtype,
too, then an unchecked conversion should work, too. (Does, using GNAT).
with Ada.Characters.Latin_1;
with Ada.Streams.Stream_IO;
procedure Test is
subtype S_E_Offset is Ada.Streams.Stream_Element_Offset;
use type S_E_Offset;
-- static assert:
Is_Positive_in_S_E_Offset : constant array (Boolean) of Integer :=
(
S_E_Offset'First > S_E_Offset (Positive'First) => 123,
S_E_Offset'Last >= S_E_Offset (Positive'Last) => 123
);
procedure Write_String_To_File (File_Name : in String; S : in String) is
subtype Index is S_E_Offset
range S_E_Offset (S'First) .. S_E_Offset (S'Last);
A : Ada.Streams.Stream_Element_Array (Index);
F : Ada.Streams.Stream_IO.File_Type;
begin
-- convert S to stream elements
for I in S'Range loop
A (S_E_Offset (I)) :=
Ada.Streams.Stream_Element (Character'Pos (S (I)));
end loop;
-- create a stream file and write the content (which might be empty)
Ada.Streams.Stream_IO.Create (F, Ada.Streams.Stream_IO.Out_File,
File_Name);
Ada.Streams.Stream_IO.Write (F, A);
Ada.Streams.Stream_IO.Close (F);
end Write_String_To_File;
begin
-- empty file:
Write_String_To_File ("file1.txt", "");
-- file with one, non-terminated line:
Write_String_To_File ("file2.txt",
String'(22 => 'a',
23 => 'b',
24 => 'c'));
-- file with "one line and a half":
Write_String_To_File ("file3.txt",
"abc" & Ada.Characters.Latin_1.LF & "xyz");
end Test;
^ permalink raw reply [relevance 2%]
* Re: Creating an empty file with Ada.Text_IO
@ 2015-08-25 8:20 3% ` Maciej Sobczak
0 siblings, 1 reply; 200+ results
From: Maciej Sobczak @ 2015-08-25 8:20 UTC (permalink / raw)
> > What are the recommended ways of:
> > a) creating empty files
> > b) writing a non-terminated line to (or generally at the end of) the file
>
> Stream I/O.
Right. For those who might be looking for the same in the future:
with Ada.Characters.Latin_1;
with Ada.Streams.Stream_IO;
procedure Test is
procedure Write_String_To_File (File_Name : in String; S : in String) is
A : Ada.Streams.Stream_Element_Array (1 .. S'Length);
F : Ada.Streams.Stream_IO.File_Type;
begin
-- convert S to stream elements
for I in S'Range loop
A (Ada.Streams.Stream_Element_Offset (I)) :=
Ada.Streams.Stream_Element (Character'Pos (S (I)));
end loop;
-- create a stream file and write the content (which might be empty)
Ada.Streams.Stream_IO.Create (F, Ada.Streams.Stream_IO.Out_File, File_Name);
Ada.Streams.Stream_IO.Write (F, A);
Ada.Streams.Stream_IO.Close (F);
end Write_String_To_File;
begin
-- empty file:
Write_String_To_File ("file1.txt", "");
-- file with one, non-terminated line:
Write_String_To_File ("file2.txt", "abc");
-- file with "one line and a half":
Write_String_To_File ("file3.txt",
"abc" & Ada.Characters.Latin_1.LF & "xyz");
end Test;
The above is, of course, platform-specific in the sense that some compatibility between characters and stream elements is assumed. This works everywhere.
Having fun with platform-specific newline variants is left as an exercise to the reader. ;-)
--
Maciej Sobczak * http://www.inspirel.com
^ permalink raw reply [relevance 3%]
* How to check if letters are in a string?
@ 2015-07-18 9:00 2% Trish Cayetano
0 siblings, 0 replies; 200+ results
From: Trish Cayetano @ 2015-07-18 9:00 UTC (permalink / raw)
Hi,
How do you check if (exact number of) letters are in a string?
1. This example should PASS because every letter is found in the string
LETTERS: HID
STRING: HIDDEN
2. This example should FAIL because the letters contain 2 N's but the string only has 1 N.
LETTERS: NINE
STRING: HIDDEN
Pangram doesn't seem to be a solution... because it considers #2 above as PASS.
This is because pangrams check for AT LEAST one letter (this means, it considers a pangram even if the letter is a duplicate)
Is there another way how to check if (exact number of) letters are in a string?
Thank you very much!
====
Here is the sample code:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Characters.Handling; use Ada.Characters.Handling;
procedure main is
function ispangram(txt: String) return Boolean is
lowtxt : String := To_Lower(txt);
letset,txtset : Character_Set;
begin
letset := To_Set("nine");
txtset := To_Set(lowtxt);
return (letset-txtset)=Null_Set;
end ispangram;
begin
put_line(Boolean'Image(ispangram("hidden")));
end main;
============================================
OUTPUT:
C:\Users\a0284014\Desktop\ada\pangram\obj\main
TRUE
[2015-07-18 16:52:42] process terminated successfully, elapsed time: 00.37s
^ permalink raw reply [relevance 2%]
* Re: Parsing Ada?
@ 2015-06-03 11:04 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2015-06-03 11:04 UTC (permalink / raw)
Stephen Leake <stephen_leake@stephe-leake.org> writes:
> Note that ASIS does not produce a parse tree either; it just gives you
> structured access to the source. ASIS code tends to feel like a
> recursive descent parser (at least, for the tools I've written in
> ASIS).
You might find ASIS2XML[1] helpful (it doesn't attempt to retain
comments, and really only retains textual information (that is, it
retains the name in an entity reference but not the links to the
referenced entity). Also, could do some cleanup of compound identifiers
- it retains the ASIS structure; so "with Ada.Characters.Handling;"
becomes
<with_clause>
<selected_component>
<selected_component>
<identifier>Ada</identifier>
<identifier>Characters</identifier>
</selected_component>
<identifier>Handling</identifier>
</selected_component>
</with_clause>
Also Avatox[2].
The ASIS GPL 2014 source distribution contains a tool gnat2xml which
doesn't appear to be installed automatically. I didn't like the schema
very much, can't remember why now!
You'd probably use xslt to work with the generated XML.
[1] https://sourceforge.net/projects/asis2xml/
[2] Original site unavailable. See the ASIS GPL 2014 distro,
tools/gnat2xml for READMEs; I have a copy of avatox-1.8.tgz if you
want.
^ permalink raw reply [relevance 2%]
* Interesting containers problem.
@ 2015-04-17 13:42 2% Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2015-04-17 13:42 UTC (permalink / raw)
Ok, so let's say we have a type for Identifiers:
SubType Identifier is String
with Dynamic_Predicate => Is_Valid( Identifier )
or else raise Parse_Error with "Invalid identifier: """ & Identifier & '"';
--...
-- ACH is a rename for Ada.Characters.Handling.
Function Is_Valid( Input: String ) return Boolean is
( Input'Length in Positive and then
ACH.Is_Letter(Input(Input'First)) and then
ACH.Is_Alphanumeric(Input(Input'Last)) and then
(for all Ch of Input => Ch = '_' or ACH.Is_Alphanumeric(Ch)) and then
(for all Index in Input'First..Positive'Pred(Input'Last) =>
(if Input(Index) = '_' then Input(Index+1) /= '_')
)
);
And a few types for types:
Type Data_Type is ( Integer, Float, Fixed );
Type Variable_Data( Type_Value : Data_Type ) is
case Type_Value is
when Integer => Integer_Value : Standard.Integer;
when Float => Float_Value : Standard.Float;
when Fixed => Fixed_Value : Fixed_Type; -- Defined elsewhere.
end case;
end record;
Now we can define a Symbol-table using the standard containers simply with this:
Package Symbol_Table is
new Ada.Containers.Indefinite_Ordered_Maps(
Key_Type => Identifier,
Element_Type => Variable_Data,
"<" => Ada.Strings.Less_Case_Insensitive,
"=" => "="
);
And that's all well and good; however, there is one limitation here that is revealed when you need nesting scopes -- there is, apparently, no way to define an Element_Type to feed to Indefinite_Ordered_Maps which is an instance of Indefinite_Ordered_Maps.Maps or an instance of Variable_Data (by way of a variant record; even one which is forward declared).
What would be the proper way to handle this sort of situation?
^ permalink raw reply [relevance 2%]
* Re: GNAT bug in the GNAT GPL 2014 compiler?
2015-03-25 7:35 3% ` gorgelo
2015-03-25 8:39 0% ` Simon Wright
@ 2015-03-25 8:41 21% ` Georg Bauhaus
1 sibling, 0 replies; 200+ results
From: Georg Bauhaus @ 2015-03-25 8:41 UTC (permalink / raw)
On 25.03.15 08:35, gorgelo@hotmail.com wrote:
> Den tisdag 24 mars 2015 kl. 22:56:36 UTC+1 skrev Anh Vo:
>> On Tuesday, March 24, 2015 at 12:19:30 PM UTC-7, gor...@hotmail.com wrote:
>>>
>>> The compilation error is: amock-main_application.adb:170:61: missing "with Ada.Characters;"
>>>
>>> That file contains "with Ada.Characters.Conversions;" among the with-statements. Why does the compiler complain? If one comments out the line 170, the code compiles just fine.
>>>
>> Line 170 looks perfectly fine. Could you post the exact compilation error message. I am curious about this also.
>>
>> Anh Vo
>
> Here is the exact compilation error message:
>
> joakimstrandberg$ gprbuild -P amock.gpr
> gcc -c -gnat12 amock-main_application.adb
> amock-main_application.adb:170:61: missing "with Ada.Characters;"
> gprbuild: *** compilation phase failed
>
> It's not only the package Ada.Characters that the compiler complains about. It does not allow usage of Ada.Text_IO nor Ada.Wide_Text_IO. It seems that any usage of a subprogram in any of the child packages of the Ada package is forbidden in the body of the Amock.Main_Application package. I can't imagine it can be anything but a GNAT compiler bug. I am hoping to be proven wrong and that I've done some obvious mistake.
FWIW, the compiler accepts line 170 if the prefix "Standard" is
added to the expression assigned. Not sure what is going on,
but I'd suspect same naming overload.
diff --git a/source_files/amock-main_application.adb b/source_files/amock-main_application.adb
index 8cda6f5..93784b1 100644
--- a/source_files/amock-main_application.adb
+++ b/source_files/amock-main_application.adb
@@ -167,7 +167,7 @@ package body Amock.Main_Application is
Input_Package : Asis.Compilation_Unit;
Input_Package_Declaration : Asis.Declaration;
- Input_Package_Name_As_Wide_String : Wide_String := Ada.Characters.Conversions.To_Wide_String (Input_Package_Name);
+ Input_Package_Name_As_Wide_String : Wide_String := Standard.Ada.Characters.Conversions.To_Wide_String (Input_Package_Name);
begin
Asis.Implementation.Initialize ("-ws");
Asis.Ada_Environments.Associate (My_Context, "My Asis Context", "-C1 .amock/command_line.adt");
^ permalink raw reply related [relevance 21%]
* Re: GNAT bug in the GNAT GPL 2014 compiler?
2015-03-25 7:35 3% ` gorgelo
@ 2015-03-25 8:39 0% ` Simon Wright
2015-03-25 8:41 21% ` Georg Bauhaus
1 sibling, 0 replies; 200+ results
From: Simon Wright @ 2015-03-25 8:39 UTC (permalink / raw)
gorgelo@hotmail.com writes:
> Den tisdag 24 mars 2015 kl. 22:56:36 UTC+1 skrev Anh Vo:
>> On Tuesday, March 24, 2015 at 12:19:30 PM UTC-7, gor...@hotmail.com wrote:
>> >
>> > The compilation error is: amock-main_application.adb:170:61:
>> > missing "with Ada.Characters;"
>> >
>> > That file contains "with Ada.Characters.Conversions;" among the
>> > with-statements. Why does the compiler complain? If one comments
>> > out the line 170, the code compiles just fine.
>> >
>> Line 170 looks perfectly fine. Could you post the exact compilation
>> error message. I am curious about this also.
>>
>> Anh Vo
>
> Here is the exact compilation error message:
>
> joakimstrandberg$ gprbuild -P amock.gpr
> gcc -c -gnat12 amock-main_application.adb
> amock-main_application.adb:170:61: missing "with Ada.Characters;"
> gprbuild: *** compilation phase failed
>
> It's not only the package Ada.Characters that the compiler complains
> about. It does not allow usage of Ada.Text_IO nor Ada.Wide_Text_IO. It
> seems that any usage of a subprogram in any of the child packages of
> the Ada package is forbidden in the body of the Amock.Main_Application
> package. I can't imagine it can be anything but a GNAT compiler bug. I
> am hoping to be proven wrong and that I've done some obvious mistake.
I get the same behaviour with GCC 4.9.1 (I would have tried GCC 5.0.0
also but I don't have ASIS built for it).
Compiling with -gnatwa (all standard warnings) and commenting out the
"not referenced" packages and using pragma Unreferenced on the Control
parameters of Pre and Post made the error go away. Not much help for
your full code, of course.
Looks like a compiler bug to me.
^ permalink raw reply [relevance 0%]
* Re: GNAT bug in the GNAT GPL 2014 compiler?
2015-03-24 21:56 0% ` Anh Vo
@ 2015-03-25 7:35 3% ` gorgelo
2015-03-25 8:39 0% ` Simon Wright
2015-03-25 8:41 21% ` Georg Bauhaus
0 siblings, 2 replies; 200+ results
From: gorgelo @ 2015-03-25 7:35 UTC (permalink / raw)
Den tisdag 24 mars 2015 kl. 22:56:36 UTC+1 skrev Anh Vo:
> On Tuesday, March 24, 2015 at 12:19:30 PM UTC-7, gor...@hotmail.com wrote:
> >
> > The compilation error is: amock-main_application.adb:170:61: missing "with Ada.Characters;"
> >
> > That file contains "with Ada.Characters.Conversions;" among the with-statements. Why does the compiler complain? If one comments out the line 170, the code compiles just fine.
> >
> Line 170 looks perfectly fine. Could you post the exact compilation error message. I am curious about this also.
>
> Anh Vo
Here is the exact compilation error message:
joakimstrandberg$ gprbuild -P amock.gpr
gcc -c -gnat12 amock-main_application.adb
amock-main_application.adb:170:61: missing "with Ada.Characters;"
gprbuild: *** compilation phase failed
It's not only the package Ada.Characters that the compiler complains about. It does not allow usage of Ada.Text_IO nor Ada.Wide_Text_IO. It seems that any usage of a subprogram in any of the child packages of the Ada package is forbidden in the body of the Amock.Main_Application package. I can't imagine it can be anything but a GNAT compiler bug. I am hoping to be proven wrong and that I've done some obvious mistake.
Joakim Strandberg
^ permalink raw reply [relevance 3%]
* Re: GNAT bug in the GNAT GPL 2014 compiler?
2015-03-24 19:19 2% GNAT bug in the GNAT GPL 2014 compiler? gorgelo
@ 2015-03-24 21:56 0% ` Anh Vo
2015-03-25 7:35 3% ` gorgelo
0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2015-03-24 21:56 UTC (permalink / raw)
On Tuesday, March 24, 2015 at 12:19:30 PM UTC-7, gor...@hotmail.com wrote:
>
> The compilation error is: amock-main_application.adb:170:61: missing "with Ada.Characters;"
>
> That file contains "with Ada.Characters.Conversions;" among the with-statements. Why does the compiler complain? If one comments out the line 170, the code compiles just fine.
>
Line 170 looks perfectly fine. Could you post the exact compilation error message. I am curious about this also.
Anh Vo
^ permalink raw reply [relevance 0%]
* GNAT bug in the GNAT GPL 2014 compiler?
@ 2015-03-24 19:19 2% gorgelo
2015-03-24 21:56 0% ` Anh Vo
0 siblings, 1 reply; 200+ results
From: gorgelo @ 2015-03-24 19:19 UTC (permalink / raw)
Dear all,
I wasn't going to share the code for the mock code generator I've been working on before completion, but I've run in to some strange compilation error and would like to get a second opinion about it. The code that doesn't compile can be found at github:
https://github.com/joakim-strandberg/amock
amock depends upon ASIS (GNAT GPL 2014) and:
https://github.com/joakim-strandberg/aida
The compilation error is: amock-main_application.adb:170:61: missing "with Ada.Characters;"
That file contains "with Ada.Characters.Conversions;" among the with-statements. Why does the compiler complain? If one comments out the line 170, the code compiles just fine.
When writing the code for amock I've refrained from using access types in anticipation for the coming release of SPARK GPL in May 2015. I think it will be cool to be able to formally verify code that contains tagged types (Of course, I don't know if SPARK GPL 2015 will support it, maybe that functionality will only exist in a PRO version). Anyways, amock has been written in anticipation of it.
Best regards,
Joakim Strandberg
^ permalink raw reply [relevance 2%]
* Re: Convert a Wide_String (or a Wide_Character) to an Integer.
@ 2015-02-10 21:38 2% ` Jeffrey Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2015-02-10 21:38 UTC (permalink / raw)
On 02/10/2015 02:16 PM, lomoscompany@gmail.com wrote:
> Why does it have to be so damn complicated?
It isn't.
> How does one convert a Wide_String into a normal String? Or, in my case, a Wide_Character to a Character.
The package Ada.Characters.Conversions defines functions To_Character, which
convert a [Wide_]Wide_Character to Character. There are also similar To_String
functions. See ARM A.3.4:
http://www.adaic.org/resources/add_content/standards/12rm/html/RM-A-3-4.html
Anyone using Ada should be familiar with the contents of ARM Annex A, which
defines the standard library.
> -- NEED TO RETURN AN INTEGER CREATED FROM A SINGLE CHARACTER IN A WIDE
> -- STRING HERE
To convert a single character to an integer value presumes that the character is
a digit. That can be converted more simply with
Character'Pos (Char) - Character'Pos ('0')
Presuming that the digits are contiguous beginning with '0' for Wide_Character,
this would work with Wide_Character'Pos as well.
--
Jeff Carter
"Spam! Spam! Spam! Spam! Spam! Spam! Spam! Spam!"
Monty Python's Flying Circus
53
^ permalink raw reply [relevance 2%]
* Did I find mamory leak in Generic Image Decoder (GID) ?
@ 2015-02-02 5:50 2% reinkor
0 siblings, 0 replies; 200+ results
From: reinkor @ 2015-02-02 5:50 UTC (permalink / raw)
Dear All,
I tried out GID (Generic Image Decoder) from
http://sourceforge.net/projects/gen-img-dec/
The point was to read jpeg-images from my Ada program
"wrapped" in a function:
function read_jpg(cfile_jpg : String) return image1.imgc_t;
The source code is below. However, this function seems to eat memory
during (say 200) repeated calls to it (large images, 2000x1800 pixels each).
I did something very very stupid ?
reinert
----------------------------------------------------------------------
Here is the actual code:
with Ada.Streams.Stream_IO;
use Ada.Streams.Stream_IO;
with Ada.Characters.Latin_1;
with Interfaces.C;
with Interfaces.C.Strings;
with system;
with Ada.Unchecked_Conversion;
with Interfaces;
with GID;
with Ada.Calendar;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Text_IO; use Text_IO;
package body file_handling3 is
package Int_Io is new Text_IO.Integer_Io (Integer);
use Int_Io;
use Interfaces;
type Byte_Array is array(Integer range <>) of Unsigned_8;
type p_Byte_Array is access Byte_Array;
procedure Dispose is new Ada.Unchecked_Deallocation(Byte_Array, p_Byte_Array);
img_buf: p_Byte_Array := null;
procedure Free_buf is new Ada.Unchecked_Deallocation(Object => Byte_Array, Name => p_Byte_Array);
procedure Load_raw_image(
image : in out GID.Image_descriptor;
buffer: in out p_Byte_Array;
next_frame: out Ada.Calendar.Day_Duration
)
is
subtype Primary_color_range is Unsigned_8;
image_width : constant Positive:= GID.Pixel_Width(image);
image_height: constant Positive:= GID.Pixel_height(image);
idx: Natural;
--
procedure Set_X_Y (x, y: Natural) is
begin
idx:= 3 * (x + image_width * (image_height - 1 - y));
end Set_X_Y;
--
procedure Put_Pixel (
red, green, blue : Primary_color_range;
alpha : Primary_color_range
)
is
pragma Warnings(off, alpha); -- alpha is just ignored
begin
buffer(idx..idx+2):= (red, green, blue);
idx:= idx + 3;
-- ^ GID requires us to look to next pixel on the right for next time.
end Put_Pixel;
stars: Natural:= 0;
procedure Feedback(percents: Natural) is
so_far: constant Natural:= percents / 5;
begin
for i in stars+1..so_far loop
Put( Standard_Error, '*');
end loop;
stars:= so_far;
end Feedback;
procedure Load_image is
new GID.Load_image_contents(
Primary_color_range, Set_X_Y,
Put_Pixel, Feedback, GID.fast
);
begin
Dispose(buffer);
buffer:= new Byte_Array(0..3 * image_width * image_height - 1);
Load_image(image, next_frame);
end Load_raw_image;
function read_jpg(cfile_jpg : String) return image1.imgc_t is
f: Ada.Streams.Stream_IO.File_Type;
i: GID.Image_descriptor;
name : String := cfile_jpg;
up_name: constant String:= To_Upper(name);
next_frame, current_frame: Ada.Calendar.Day_Duration:= 0.0;
isx,isy : Integer;
begin
Open(f, In_File, name);
GID.Load_image_header(
i,
Stream(f).all,
try_tga =>
name'Length >= 4 and then
up_name(up_name'Last-3..up_name'Last) = ".TGA"
);
Load_raw_image(i, img_buf, next_frame);
Close(f);
isx := GID.Pixel_Width(i);
isy := GID.Pixel_Height(i);
New_line;
Put(" isx,isy: ");Put(Integer'Image(isx));Put(Integer'Image(isy));
New_line;
declare
img1 : image1.imgc_t(1..isx,1..isy) := (others => (others => image1.Black));
Index : Positive;
begin
Index := img_buf'First;
for j in img1'Range (2) loop
for i in img1'Range (1) loop
img1(i,isy - j + 1).red := image1.Short_I(img_buf (Index + 0));
img1(i,isy - j + 1).green := image1.Short_I(img_buf (Index + 1));
img1(i,isy - j + 1).blue := image1.Short_I(img_buf (Index + 2));
Index := Index + 3;
end loop;
end loop;
Free_buf(img_buf);
return img1;
end;
end read_jpg;
end file_handling3;
^ permalink raw reply [relevance 2%]
* Re: How to get nice with GNAT?
@ 2014-11-24 3:05 1% ` brbarkstrom
0 siblings, 0 replies; 200+ results
From: brbarkstrom @ 2014-11-24 3:05 UTC (permalink / raw)
On Sunday, November 23, 2014 3:49:38 PM UTC-5, Jeffrey Carter wrote:
> On 11/23/2014 10:41 AM, brbarkstrom wrote:
> >
> > I'm working in GNAT GPL, so my suggestion may not work with every
> > compiler.
> >
> > On the other hand, in my code, the if following the exception in the
> > procedure is picked up and executed properly. The code doesn't act
> > like the program has to fail if any exception is raised.
>
> I don't think you're talking about exceptions. I took this program:
>
> with Ada.Text_IO;
> procedure Boolean_Exception is
> procedure Test (OK : out Boolean) is
> -- empty declarative part
> begin -- Test
> OK := False;
>
> raise Constraint_Error;
> end Test;
>
> OK : Boolean := True;
> begin -- Boolean_Exception
> Test (OK => OK);
> Ada.Text_IO.Put_Line (Item => "No exception");
> exception -- Boolean_Exception
> when others =>
> Ada.Text_IO.Put_Line (Item => Boolean'Image (OK) );
> end Boolean_Exception;
>
> compiled with GNAT 4.6 on Linux, and got:
>
> $ gnatmake -gnatwa -gnatano -O2 -fstack-check boolean_exception.adb
> gcc-4.6 -c -gnatwa -gnatano -O2 -fstack-check boolean_exception.adb
> boolean_exception.adb:6:10: warning: assignment to pass-by-copy formal may have
> no effect
> boolean_exception.adb:6:10: warning: "raise" statement may result in abnormal
> return (RM 6.4.1(17))
> gnatbind -x boolean_exception.ali
> gnatlink boolean_exception.ali -O2 -fstack-check
> $ ./boolean_exception
> TRUE
>
> What you're talking about doesn't work with GNAT.
>
> --
> Jeff Carter
> "This school was here before you came,
> and it'll be here before you go."
> Horse Feathers
> 48
Here's a rather long response to your post:
I don't think you'll get a sensible response when you try to set
Test(OK => True); or Test(OK => False) when the specification of
the procedure Test has OK as an "out" variable. It doesn't make
sense try to set this value as input to a variable that emerges from the procedure (Test).
Here's a slight rewriting of the code you provided:
with Ada.Text_IO;
procedure exception_handling_0 is
procedure test (OK : out Boolean) is
-- empty declarative part
begin -- test
OK := False;
raise Constraint_Error;
end test;
OK : Boolean := True;
begin -- exception_handling_0
test (OK => OK);
Ada.Text_IO.Put_Line (Item => "No exception");
exception
when others =>
Ada.Text_IO.Put_Line (Item => Boolean'Image (OK) );
end exception_handling_0;
The GNAT GPL GPS tool on my Ubuntu 14.04 LTS system returns the
two warnings:
7.10 warning: assignment to pass-by-copy formal may have no effect
7.10 warning: "raise" statement may result in abnormal return
(RM 6.4.1(17))
In other words, a programmer shouldn't expect a variable input to
an "out" variable in the interface specification to have any relation
to whatever is generated in the procedure that is called. Secondly,
an exception raised in the procedure test may result in an abnormal
return. This is hardly a clean piece of code.
When I run it, the output from the code does something that seems
to me to be an abnormal return. It returns the output "TRUE".
The output claims that "the process terminated successfully, ...".
It certainly isn't the expected behavior in a reasonable reading of the
procedure text. Rather it suggests that the compiler completely ignored
whatever went on in the procedure.
Putting the same code into a Windows XP installation of GNAT GPL 2014 with GPS
produces exactly the same warnings, compilation, and output.
In the original source code I provided, I used the following specification
file (called Common_Defs.ads):
with Ada.Characters.Latin_1;
with Ada.Strings;
with Ada.Strings.Bounded;
with Ada.Numerics;
with Ada.Numerics.generic_elementary_functions;
package Common_Defs is
------------------------------------------------------------------------------
-- Generic Packages
------------------------------------------------------------------------------
subtype real is long_float;
package Usr_Math is new
Ada.Numerics.generic_elementary_functions(real);
Std_Vstring_Length : constant := 256;
package VString is new
Ada.Strings.Bounded.Generic_Bounded_Length(Std_Vstring_Length);
Long_Vstring_Lngth : constant := 5000;
package Long_Vstring is new
Ada.Strings.Bounded.Generic_Bounded_Length(Long_Vstring_Lngth);
------------------------------------------------------------------------------
-- Constant
------------------------------------------------------------------------------
TAB : constant Character := Ada.Characters.Latin_1.HT;
end Common_Defs;
Then, I created the source code
with Ada.Text_IO;
with Common_Defs; use Common_Defs;
procedure Test_Exception is
-- Local Procedure Specification
procedure Test (I : in Natural;
OK : out Boolean;
Err_Msg : out Vstring.Bounded_String);
-- Variables
I : Natural := 20;
Test_OK : Boolean;
Err_Msg : Vstring.Bounded_String;
-- Local Procedure Body
procedure Test (I : in Natural;
OK : out Boolean;
Err_Msg : out Vstring.Bounded_String) is
Max_I : Natural := 10;
I_Out_Of_Range : exception;
begin -- Test
OK := False;
Err_Msg := Vstring.To_Bounded_String("procedure Test was not initialized when this message was created.");
if I <= Max_I then
OK := True;
Err_Msg := Vstring.To_Bounded_String("In procedure Test, I as input : ");
Err_Msg := Vstring.Append(Err_Msg, Natural'image(I));
Err_Msg := Vstring.Append(Err_Msg, " was less than or equal to ");
Err_Msg := Vstring.Append(Err_Msg, Natural'image(Max_I));
else
raise I_Out_Of_Range;
end if;
exception
when I_Out_Of_Range =>
Err_Msg := Vstring.To_Bounded_String("In procedure Test, I as input : ");
Err_Msg := Vstring.Append(Err_Msg, Natural'image(I));
Err_Msg := Vstring.Append(Err_Msg, " was greater than ");
Err_Msg := Vstring.Append(Err_Msg, Natural'image(Max_I));
Err_Msg := Vstring.Append(Err_Msg, " which raises the constraint 'I_Out_Of_Range'.");
when others =>
Err_Msg := Vstring.To_Bounded_String("In procedure Test, something unexpected happened.");
end Test;
begin -- Test_Exception
Test (I => 25,
OK => Test_OK,
Err_Msg => Err_Msg);
if Test_OK then
Ada.Text_IO.Put_Line(Vstring.To_String(Err_Msg));
else
Ada.Text_IO.Put_Line(Vstring.To_String(Err_Msg));
end if;
end Test_Exception;
On Windows, this compiles without warnings. After compilation, binding, and linking, it
runs and outputs the message
"In procedure Test, I as input : 25 was greater than 10 which raises the constraint 'I_Out_Of_Range'." It is clear that the initial setting of
OK and Err_Msg in the procedure have been changed as a result of the
operations during execution.
The behavior on the Ubuntu Linux 64-bit installation of GNAT GPL is identical.
My conclusions:
1. One should not call a procedure to input an "out" variable as declared in the spec and
expect it to return values from the interior of the procedure. In this code, the exception is not one of the system exceptions.
Rather, it is one declared normally in accord with the RM (11.1). An exception handler follows the
specification in RM (11.2), where the Examples at the end of this definition show an approach
that the code I've provided follows.
2. The handled sequence of statements allow variables set as "out" in the procedure specification
to appear as legitimate values (even using the "pass-by-copy" rule). Thus, these "out" variables
can guide procedure actions for the calling procedure even when the called
procedure throws an exception.
Bruce B.
^ permalink raw reply [relevance 1%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
2014-10-22 6:25 2% ` Jeffrey Carter
@ 2014-10-22 17:39 0% ` NiGHTS
0 siblings, 0 replies; 200+ results
From: NiGHTS @ 2014-10-22 17:39 UTC (permalink / raw)
On Wednesday, October 22, 2014 2:25:25 AM UTC-4, Jeffrey Carter wrote:
> On 10/21/2014 10:57 PM, NiGHTS wrote:
>
> >
>
> > Complex_String : Ada.Strings.Unbounded.Unbounded_String;
>
> > EOL : String := ASCII.CR'Img;
>
>
>
> I presume you're using GNAT; this gives you the image of the enumeration value
>
> CR; I suspect you want the enumeration value (character) itself. Try using
>
>
>
> EOL : constant Character := Ada.Characters.Latin_1.CR;
>
>
>
> 'Img is a non-standard, vendor-dependent attribute; you should not use it in
>
> production code if you have any interest in portability. ASCII is an obsolete
>
> unit and should not be used.
>
>
>
> What system uses CR for line terminators these days? I suspect the result will
>
> not be what you expect, which is why a better approach would be to actually
>
> convert this to Ada and simply use a series of Put_Line statements, rather than
>
> trying to copy the mistakes of C in Ada.
>
>
>
> > The searches I performed on Google seem to be void of any hints on how to get this working. I can't imagine that I am the only one with this requirement in Ada.
>
>
>
> That's because this is not the Ada Way.
>
>
>
> --
>
> Jeff Carter
>
> "We call your door-opening request a silly thing."
>
> Monty Python & the Holy Grail
>
> 17
Do keep in mind that the strategy of buffering output before sending it to screen is not "old", its "smart". I did consider what you suggested for this particular project, but then I realized that rewriting the code in question to use Put_Line would actually make the code both less readable and far less efficient, both things which are not the Ada way.
While using Put_Line is safer in its portability, its avoidance in this particular instance is comparable to favoring "goto" for a specific section of code after determining the alternative as being more complex or otherwise less desirable.
Thank you for your response.
^ permalink raw reply [relevance 0%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
@ 2014-10-22 17:16 3% ` NiGHTS
0 siblings, 0 replies; 200+ results
From: NiGHTS @ 2014-10-22 17:16 UTC (permalink / raw)
On Wednesday, October 22, 2014 2:20:35 AM UTC-4, mockturtle wrote:
> On Wednesday, October 22, 2014 7:57:39 AM UTC+2, NiGHTS wrote:
>
> > I am converting some code from C to Ada which involves building a complex string containing '\n' characters which would eventually be displayed on the standard output console using the printf() function.
>
> >
>
> >
>
> >
>
> > I tried to copy the same strategy of building the string in Ada like this:
>
> >
>
> >
>
> >
>
> >
>
> >
>
> > Complex_String : Ada.Strings.Unbounded.Unbounded_String;
>
> >
>
> > EOL : String := ASCII.CR'Img;
>
> >
>
> >
>
> >
>
> > ...
>
> >
>
> >
>
> >
>
> > Ada.Strings.Unbounded.Append (Complex_String,
>
> >
>
> > "Menu Title" & EOL &
>
> >
>
> > "-------------------------------------" & EOL
>
> >
>
> > );
>
> >
>
> >
>
> >
>
> > ...
>
> >
>
> >
>
> >
>
> > Ada.Text_Io.Put (
>
> >
>
> > Ada.Strings.Unbounded.To_String( Complex_String ) );
>
> >
>
> > Instead of breaking the line in the places where EOL has been inserted, it seems to show the letters "CR" in its place.
>
> >
>
> > The searches I performed on Google seem to be void of any hints on how to get this working. I can't imagine that I am the only one with this requirement in Ada.
>
> >
>
> > Thanks in advance for your advice.
>
>
>
> Do not use 'Img (that, by the way, I guess it is a GNAT extension). Just do this
>
>
>
> EOL : String := "" & ASCII.CR;
>
>
>
> or this
>
>
>
> EOL : String(1..1) := (1 => ASCII.CR);
>
>
>
> These funny syntaxes are necessary if you want EOL to be a string, since CR is a character.
>
>
>
> I think that in your case this would work too
>
>
>
> EOL : constant Character := ASCII.CR;
Thank you for your help. This is the version that eventually worked for me:
EOL : String(1..2) := (1 => Ada.Characters.Latin_1.CR, 2 => Ada.Characters.Latin_1.LF) ;
^ permalink raw reply [relevance 3%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
2014-10-22 6:25 2% ` Jeffrey Carter
@ 2014-10-22 11:16 2% ` Björn Lundin
2 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2014-10-22 11:16 UTC (permalink / raw)
On 2014-10-22 07:57, NiGHTS wrote:
> I am converting some code from C to Ada which involves building a complex string containing '\n' characters which would eventually be displayed on the standard output console using the printf() function.
>
> I tried to copy the same strategy of building the string in Ada like this:
>
>
> Complex_String : Ada.Strings.Unbounded.Unbounded_String;
> EOL : String := ASCII.CR'Img;
>
> ...
>
> Ada.Strings.Unbounded.Append (Complex_String,
> "Menu Title" & EOL &
> "-------------------------------------" & EOL
> );
>
> ...
>
> Ada.Text_Io.Put (
> Ada.Strings.Unbounded.To_String( Complex_String ) );
>
I use
EOL : constant Character := Ada.Characters.Latin_1.LF;
successfully on unix and on windows, with gnat.
As many pointed out, you want Line_Feed, not Carriage_Return
--
Björn
^ permalink raw reply [relevance 2%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
@ 2014-10-22 6:25 2% ` Jeffrey Carter
2014-10-22 17:39 0% ` NiGHTS
2014-10-22 11:16 2% ` Björn Lundin
2 siblings, 1 reply; 200+ results
From: Jeffrey Carter @ 2014-10-22 6:25 UTC (permalink / raw)
On 10/21/2014 10:57 PM, NiGHTS wrote:
>
> Complex_String : Ada.Strings.Unbounded.Unbounded_String;
> EOL : String := ASCII.CR'Img;
I presume you're using GNAT; this gives you the image of the enumeration value
CR; I suspect you want the enumeration value (character) itself. Try using
EOL : constant Character := Ada.Characters.Latin_1.CR;
'Img is a non-standard, vendor-dependent attribute; you should not use it in
production code if you have any interest in portability. ASCII is an obsolete
unit and should not be used.
What system uses CR for line terminators these days? I suspect the result will
not be what you expect, which is why a better approach would be to actually
convert this to Ada and simply use a series of Put_Line statements, rather than
trying to copy the mistakes of C in Ada.
> The searches I performed on Google seem to be void of any hints on how to get this working. I can't imagine that I am the only one with this requirement in Ada.
That's because this is not the Ada Way.
--
Jeff Carter
"We call your door-opening request a silly thing."
Monty Python & the Holy Grail
17
^ permalink raw reply [relevance 2%]
* Re: array of string
@ 2014-10-07 16:49 3% ` brbarkstrom
0 siblings, 0 replies; 200+ results
From: brbarkstrom @ 2014-10-07 16:49 UTC (permalink / raw)
On Friday, October 3, 2014 7:29:15 PM UTC-4, Stribor40 wrote:
> is there way to declare array of strings to contain something like this..
>
>
>
> a(1)="london"
>
> a(2)""toronto"
>
>
>
> how would i create this?
Constantly. It's a habit now. One advantage is the Bounded_Strings
library in the ARM. It has functions for appending strings, extracting slices,
obtaining single characters, and so on. I've created a package I call
Common_Defs.ads that lets me have a moderately long string (256 characters)
and a very long one (5000 characters). Note also that the Bounded_String
library throws an exception if you try to stuff too many characters into
the string. That provides a reasonable way to filter out strings that could
cause buffer overflows in Web page text inputs.
Here's the code:
with Ada.Characters.Latin_1;
with Ada.Strings;
with Ada.Strings.Bounded;
with Ada.Numerics;
with Ada.Numerics.generic_elementary_functions;
package Common_Defs is
------------------------------------------------------------------------------
-- Generic Packages
------------------------------------------------------------------------------
subtype real is long_float;
package Usr_Math is new
Ada.Numerics.generic_elementary_functions(real);
Std_Vstring_Length : constant := 256;
package VString is new
Ada.Strings.Bounded.Generic_Bounded_Length(Std_Vstring_Length);
Long_Vstring_Lngth : constant := 5000;
package Long_Vstring is new
Ada.Strings.Bounded.Generic_Bounded_Length(Long_Vstring_Lngth);
------------------------------------------------------------------------------
-- Constant
------------------------------------------------------------------------------
TAB : constant Character := Ada.Characters.Latin_1.HT;
end Common_Defs;
This package spec lets me create long_floats and bring along the appropriate
math functions in one fell swoop. If using the compiler default on long_floats
worries you, you can define the numerical type you want and embed it in this
kind of spec. The reason for having the TAB character is if you want to
create TAB-delimited text files that you can feed into spreadsheets. If you
do the usual
with Common_Defs; use Common_Defs;
then you can just use Put(TAB) (or Put(Output_File, TAB)) in Text_IO
interactions.
Bruce B.
^ permalink raw reply [relevance 3%]
* Re: A bad counterintuitive behaviour of Ada about OO
@ 2014-08-08 19:34 2% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2014-08-08 19:34 UTC (permalink / raw)
On 08-Aug-14 05:20, Dmitry A. Kazakov wrote:
> And they [subtypes] break in-operations. As an example consider:
>
> X : Integer := -1;
>
> Now substitute Positive for Integer.
That's going the wrong way.
You're narrowing the set when you move to the subtype, so obviously not
all values will be present; this is a Good Thing.
For example, we can enforce consistency [and correctness] in a DB with
subtypes:
Subtype Digit is Character range '0'..'9';
-- The following is a string, of length 9, that has ONLY digits.
Subtype Social_Security_Number is String(1..9)
with Dynamic_Predicate =>
(for all C of Social_Security_Number => C in Digit);
-- The following function cannot have an invalid invalid SSN parameter.
Procedure Save( SSN : Social_Security_Number; ID: User_ID);
Function Load(ID: User_ID) return Social_Security_Number;
And this is good because we *don't* want any string in the DB's SSN
field, we only want strings which are SSNs.
Likewise, we may want Ada-like identifiers, say in a mapping:
-- Validation rules:
-- #1 - Identifier cannot be the empty-string.
-- #2 - Identifier must contain only alphanumeric characters +
underscore.
-- #3 - Identifier cannot begin with a digit.
-- #4 - Identifier cannot begin or end with an underscore.
-- #5 - Identifier cannot have two consecutive underscores.
Function Valid_Identifier(Input : String) return Boolean;
-- A string containing an identifier.
Subtype Identifier is String
with Dynamic_Predicate => Valid_Identifier( Identifier )
or else raise Constraint_Error;
-- This package defines a mapping of a name to a type; both of these
-- are instances of Identifier.
Package Attribute_List is new Ada.Containers.Indefinite_Ordered_Maps(
Key_Type => Identifier,
Element_Type => Identifier
);
-- ...in body.
Function Valid_Identifier(Input : String) return Boolean is
Subtype Internal_Range is Natural range
Input'First+1..Input'Last-1;
First : Character renames Input(Input'First);
Last : Character renames Input(Input'Last);
Use Ada.Characters.Handling;
Begin
-- Initialize w/ conformance to rule #1.
Return Result : Boolean:= Input'Length in Positive do
-- Rule 2
Result:= Result and
(For all C of Input => Is_Alphanumeric(C) OR C = '_');
-- Rule 3
Result:= Result and not Is_Decimal_Digit(First);
-- Rule 4
Result:= Result and First /= '_' and Last /= '_';
-- Rule 5
Result:= Result and
(for all Index in Internal_Range =>
(if Input(Index) = '_' then Input(Index+1) /= '_')
);
end return;
End Valid_Identifier;
And this is good.
We *don't* want to substitute STRING for Social_Security_Number or
Identifier as the values that STRING can take are outside what we want
to deal with... and if we had to deal with validation at every
subprogram-call or function-return then Ada would be little better than PHP.
> Subsetting means nothing to subtyping and both very little to
substitutability. All three are different things.
Ridiculous; as shown above subtyping *is* the subsetting of the valid
values: Social_Security_Number in particular has only 10**9 values
rather than the Σ(n=0..Positive'Last) 256**n values that the STRING type
would have.
>
> Huh, great mathematical problems are about fighting constraints. E.g.
> solving x**n + y**n = z**n in real numbers vs. in natural ones. No big
> deal? Same applies to programming, it is mostly about working around
> constraints.
...that's the most idiotic thing I've *ever* heard you say.
Constraints are fundamental for mathematical proofs; they are essential
for making robust programs. (HINT: definitions are often constraints.)
^ permalink raw reply [relevance 2%]
* Re: trimming strings
@ 2014-08-03 21:42 3% ` agent
0 siblings, 0 replies; 200+ results
From: agent @ 2014-08-03 21:42 UTC (permalink / raw)
On Sat, 2 Aug 2014 10:22:26 -0700 (PDT), mockturtle
<framefritti@gmail.com> wrote:
>On Saturday, August 2, 2014 3:10:16 PM UTC+2, ag...@drrob1.com wrote:
>> I am having a very difficult time understanding something. I am
>>
>> trying to do this using gnat on Ubuntu 14.04 system:
>>
>> with Ada.Strings; use Ada.Strings;
>> with Ada.Strings.Fixed; use Ada.Strings.Fixed;
>>
>> subtype string255fixedtype is string (1.255);
>> inbuf : string255fixedtype;
>>
>> BEGIN
>>
>> inbuf := Get_Line;
>> inbuf := trim(inbuf,both);
>>
>> -- this does not work, error is both is not visible
>>
>> No combination of ada.strings.fixed.both, or ada.strings.both got it
>> to be visible.
>
>
>As others said, a complete example would help us to help you. Anyway, I am going to do a wild guessing: did you maybe declared another "both" in your code? I do not have a compiler at hand and I cannot check, but if I remember correctly in this case you get a "non visible" error because the two symbols hide each other.
>
>Riccardo
I am, after all, a newbie in Ada. I was wondering what the
non-visible error meant, as I was getting that also. Now I know it
means that identifiers are clashing in different packages.
I'm guessing that it is the use statements that make the symbols
clash?
I also don't have string processing down.
> one of these being likely that an array of 255 characters
> is to receive a string object that may not have that many
> due to trimming.
> That's definitely an error (and assigning a string with a known length to Get_Line won't work either).
> But those won't cause errors at compile time. They will result in exceptions at run time.
> -- Adam
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters; use Ada.Characters;
with Ada.Characters.Conversions; use Ada.Characters.Conversions;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
---------------------------
Procedure trimtest is
Subtype String255FixedType is String(1..255);
str : String255Fixedtype;
STRLEN : Natural;
BEGIN
Put(" Enter line: ");
Get_Line(Str,StrLen);
Str := TRIM(Str,Side => Both);
-- Str := Ada.Strings.Fixed.TRIM(str,side => Ada.Strings.both);
Put_Line(" Line is: " & Str(1..StrLen) & " with length of " &
Natural'image(StrLen) );
End trimtest;
This simple procedure compiles, but does give me an exception at
run-time after I call trim. I don't understand how to avoid this. I
am used to more flexible strings that are null terminated.
How do I avoid a constraint_error exception at run-time?
Thanks
^ permalink raw reply [relevance 3%]
* Re: Weird error with Dynamic_Predicate
2014-05-12 19:47 2% Weird error with Dynamic_Predicate mockturtle
2014-05-12 21:01 0% ` Adam Beneschan
@ 2014-05-13 4:59 2% ` Shark8
1 sibling, 0 replies; 200+ results
From: Shark8 @ 2014-05-13 4:59 UTC (permalink / raw)
On 12-May-14 13:47, mockturtle wrote:
> Any ideas?
-- Identifier:
Type Identifier is new String
with Dynamic_Predicate =>
Validate_Identifier_String( String(Identifier) )
or Validate_Qualified_Identifier_String( String(Identifier) );
-- Typecasting is desired so that the predicate doesn't depend on
-- the input checking the predicate and thereby infinite-looping.
-- ...
-- Ensures conformance of identifiers.
--
-- EBNF:
-- identifier ::= identifier_letter {[ "_" ] ( identifier_letter |
digit )}
-- identifier_letter ::= upper_case_letter | lower_case_letter
-- digit ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
Function Validate_Identifier_String ( Input : String ) return Boolean;
-- body
Function Validate_Identifier_String ( Input : String ) return
Boolean is
Use Ada.Characters.Handling;
Head : Character renames Input(Input'First);
Function Underscore_Alphanumeric(C : Character) return Boolean is
( C = '_' or else Is_Alphanumeric(C) );
Subtype Tail is Positive Range Input'First+1..Input'Last;
Begin
Return Result : Boolean := True do
-- Ensure that Input's first character is a letter.
-- (Implicit: that there is a first character.)
-- (Implicit: that there is a last character.)
Result:= Result
and then Input'Length in Positive
and then Is_Letter(Head);
-- All subsequent characters must be underscor or alphanumeric;
-- also, there can be no double underscore.
For Index in Tail loop
Exit when not Result;
declare
C : Character renames Input(Index);
begin
Result := Result and Underscore_Alphanumeric( C ) and
(if C = '_' then Input(Index-1) /= '_');
end;
end loop;
-- The last character cannot be an underscore.
Result:= Result and Input(Input'Last) /= '_';
End return;
End Validate_Identifier_String;
--------
Validate_Qualified_Identifier_String would take its input and, upon
detection of '.' pass the two substrings to Validate_Identifier_String
since both would have to be valid identifiers.
^ permalink raw reply [relevance 2%]
* Re: Weird error with Dynamic_Predicate
2014-05-12 19:47 2% Weird error with Dynamic_Predicate mockturtle
@ 2014-05-12 21:01 0% ` Adam Beneschan
2014-05-13 4:59 2% ` Shark8
1 sibling, 0 replies; 200+ results
From: Adam Beneschan @ 2014-05-12 21:01 UTC (permalink / raw)
For what it's worth, here's the smallest reduced example I can come up with that gives the same error message:
package Prova is
type Identifier_Name is new String with Dynamic_Predicate => true;
function Extract_Namespace (Nome : Identifier_Name)
return Identifier_Name;
end Prova;
package body Prova is
function Extract_Namespace (Nome : Identifier_Name)
return Identifier_Name
is
Idx : Natural := Ada.Strings.Fixed.Index (String (Nome), ".");
begin
return "ns";
end Extract_Namespace;
end Prova;
This is with GCC 4.5.4 (20120510).
-- Adam
On Monday, May 12, 2014 12:47:41 PM UTC-7, mockturtle wrote:
> Dear all,
>
> I am experiencing an error that is making me crazy and I was wondering if someone can help.
>
>
>
> Some background: I want to define a type that represents an "identifier." The identifier can assume two forms:
>
> - qualified (es. namespace.foo)
>
> - not qualified (es. foo)
>
>
>
> The two components (namespace and name) have the usual syntax (letters, digits and underscore). Note that there are at most two components. I want to use the aspect Dynamic_Predicate to enforce (and document) the right syntax.
>
>
>
> You can find prova.ads and prova.adb at the end of this message. I am using GPS 5.2.1 (20130102) and when I try to compile I get the obscure message
>
>
>
> 29:32 error: conversion to incomplete type
>
> 29:32 confused by earlier errors, bailing out
>
>
>
> on >> prova.ads <<. If I try to do "check semantic" on prova.ads and prova.adb, everything is fine.
>
>
>
>
>
> Any ideas? Is it a compiler bug or am I doing something wrong? Updating the compiler in this moment it would be a little pain for me (for several reasons), so I would like to be sure that I am not doing some subtle error before trying the update path.
>
>
>
> Thank you in advance
>
>
>
> Riccardo
>
>
>
>
>
>
>
> --- prova.ads ---
>
> with Ada.Characters.Handling; use Ada.Characters.Handling;
>
> with Ada.Strings.Fixed;
>
>
>
> package Prova is
>
> type Identifier_Name is new
>
> String
>
> with Dynamic_Predicate =>
>
> ((for all I in Identifier_Name'Range =>
>
> Is_Alphanumeric (Identifier_Name (I))
>
> or Identifier_Name (I) = '_'
>
> or Identifier_Name (I) = '.')
>
> and
>
> (not (Identifier_Name (Identifier_Name'First) in '0' .. '9'))
>
> and
>
> (Identifier_Name (Identifier_Name'First) /= '.')
>
> and
>
> Ada.Strings.Fixed.Count (String (Identifier_Name), ".") <= 1);
>
>
>
> function Is_Qualified (Item : Identifier_Name) return Boolean
>
> is (Ada.Strings.Fixed.Count (String (Item), ".") = 1);
>
>
>
> subtype Namespace_Identifier is Identifier_Name
>
> with Dynamic_Predicate => not Is_Qualified (Namespace_Identifier);
>
>
>
> subtype Full_Identifier is Identifier_Name
>
> with Dynamic_Predicate => Is_Qualified (Full_Identifier);
>
>
>
>
>
> function Extract_Namespace (Nome : Full_Identifier)
>
> return Namespace_Identifier;
>
>
>
> end Prova;
>
>
>
> --- prova.adb ---
>
>
>
> package body Prova is
>
>
>
>
>
> -----------------------
>
> -- Extract_Namespace --
>
> -----------------------
>
>
>
> function Extract_Namespace (Nome : Full_Identifier)
>
> return Namespace_Identifier
>
> is
>
> Idx : Natural := Ada.Strings.Fixed.Index (String (Nome), ".");
>
> begin
>
> return Namespace_Identifier (Nome (Nome'First .. Idx - 1));
>
> end Extract_Namespace;
>
>
>
> end Prova;
>
> ----
^ permalink raw reply [relevance 0%]
* Weird error with Dynamic_Predicate
@ 2014-05-12 19:47 2% mockturtle
2014-05-12 21:01 0% ` Adam Beneschan
2014-05-13 4:59 2% ` Shark8
0 siblings, 2 replies; 200+ results
From: mockturtle @ 2014-05-12 19:47 UTC (permalink / raw)
Dear all,
I am experiencing an error that is making me crazy and I was wondering if someone can help.
Some background: I want to define a type that represents an "identifier." The identifier can assume two forms:
- qualified (es. namespace.foo)
- not qualified (es. foo)
The two components (namespace and name) have the usual syntax (letters, digits and underscore). Note that there are at most two components. I want to use the aspect Dynamic_Predicate to enforce (and document) the right syntax.
You can find prova.ads and prova.adb at the end of this message. I am using GPS 5.2.1 (20130102) and when I try to compile I get the obscure message
29:32 error: conversion to incomplete type
29:32 confused by earlier errors, bailing out
on >> prova.ads <<. If I try to do "check semantic" on prova.ads and prova.adb, everything is fine.
Any ideas? Is it a compiler bug or am I doing something wrong? Updating the compiler in this moment it would be a little pain for me (for several reasons), so I would like to be sure that I am not doing some subtle error before trying the update path.
Thank you in advance
Riccardo
--- prova.ads ---
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Fixed;
package Prova is
type Identifier_Name is new
String
with Dynamic_Predicate =>
((for all I in Identifier_Name'Range =>
Is_Alphanumeric (Identifier_Name (I))
or Identifier_Name (I) = '_'
or Identifier_Name (I) = '.')
and
(not (Identifier_Name (Identifier_Name'First) in '0' .. '9'))
and
(Identifier_Name (Identifier_Name'First) /= '.')
and
Ada.Strings.Fixed.Count (String (Identifier_Name), ".") <= 1);
function Is_Qualified (Item : Identifier_Name) return Boolean
is (Ada.Strings.Fixed.Count (String (Item), ".") = 1);
subtype Namespace_Identifier is Identifier_Name
with Dynamic_Predicate => not Is_Qualified (Namespace_Identifier);
subtype Full_Identifier is Identifier_Name
with Dynamic_Predicate => Is_Qualified (Full_Identifier);
function Extract_Namespace (Nome : Full_Identifier)
return Namespace_Identifier;
end Prova;
--- prova.adb ---
package body Prova is
-----------------------
-- Extract_Namespace --
-----------------------
function Extract_Namespace (Nome : Full_Identifier)
return Namespace_Identifier
is
Idx : Natural := Ada.Strings.Fixed.Index (String (Nome), ".");
begin
return Namespace_Identifier (Nome (Nome'First .. Idx - 1));
end Extract_Namespace;
end Prova;
----
^ permalink raw reply [relevance 2%]
* Re: gnatmake error I don't understand
@ 2014-04-04 0:44 3% ` agent
0 siblings, 0 replies; 200+ results
From: agent @ 2014-04-04 0:44 UTC (permalink / raw)
I forgot 1 thing. My tokenizea.adb routine has this line that I use
stolen from Modula-2:
function CAP(Item : Character) return Character renames
Ada.Characters.Handling.To_Upper;
function CAP(Item : String) return String renames
Ada.Characters.Handling.To_Upper;
So I with and use tokenizea because of the CAP function that I like
from Modula-2.
--rob solomon
^ permalink raw reply [relevance 3%]
* Problems validating XML with XML/Ada
@ 2014-03-22 9:51 2% mockturtle
0 siblings, 0 replies; 200+ results
From: mockturtle @ 2014-03-22 9:51 UTC (permalink / raw)
Dear all,
I am writing a procedure that should read a configuration file in XML format. I would like to validate the file content against a grammar, so I followed the online documentation at http://docs.adacore.com/xmlada-docs/ but I am experiencing difficulties and now I am stuck.
At the end of this message you can find a (self-consistent, compilable) excerpt of my code. I get "No DTD defined for this document" at line 81 (the call to Parse, see also the embedded stack trace); however, I set the grammar with Set_Grammar, so why is it searching for a DTD? Moreover, a Debug_Dump of the grammar returned by Parse_Scheme gives
Parsed location:
Parsed location:
that looks a bit too terse...
Thank you in advance for any help
Riccardo
-----------------------------------
with Input_Sources.Strings; use Input_Sources.Strings;
with Unicode.CES.Utf8;
with DOM.Readers;
with Schema.Schema_Readers; use Schema.Schema_Readers;
with Schema.Validators; use Schema.Validators;
with Schema.Dom_Readers;
with Ada.Characters.Latin_1; use Ada.Characters;
with Sax.Readers;
with DOM.Core.Nodes;
procedure Prova is
function Parse_Scheme (Str : String)
return Schema.Validators.XML_Grammar
is
Input : String_Input;
Parser : Schema_Reader;
begin
Open (Str => Str,
Encoding => Unicode.CES.Utf8.Utf8_Encoding,
Input => Input);
Parser.Parse (Input);
Close (Input);
return Get_Grammar (Parser);
end Parse_Scheme;
CRLF : constant String := Latin_1.CR & Latin_1.LF;
My_Scheme : constant String :=
"<?xml version=""1.0""?>" & CRLF
& "<xs:schema xmlns:xs=""http://www.w3.org/2001/XMLSchema"">" & CRLF
& " <xs:element name=""config"">" & CRLF
& " <xs:complexType>" & CRLF
& " <xs:sequence>" & CRLF
& " <xs:element name=""dir-pair"" type=""pair-descr"" maxOccurs=""unbounded""/>" & CRLF
& " </xs:sequence>" & CRLF
& " </xs:complexType>" & CRLF
& " </xs:element>" & CRLF
& " <xs:complexType name=""keyfield"">" & CRLF
& " <xs:simpleContent>" & CRLF
& " <xs:extension base=""xs:string"">" & CRLF
& " <xs:attribute name=""encrypted"" type=""xs:boolean"" default=""false""/>" & CRLF
& " </xs:extension>" & CRLF
& " </xs:simpleContent>" & CRLF
& " </xs:complexType>" & CRLF
& " <xs:complexType name=""pair-descr"">" & CRLF
& " <xs:sequence>" & CRLF
& " <xs:element name=""clearfile"" type=""xs:string""/>" & CRLF
& " <xs:element name=""cypherfile"" type=""xs:string""/>" & CRLF
& " <xs:element name=""key"" type=""keyfield""/>" & CRLF
& " </xs:sequence>" & CRLF
& " </xs:complexType>" & CRLF
& "</xs:schema>" & CRLF;
Grammar : constant XML_Grammar := Parse_Scheme (My_Scheme);
Data : constant String :=
"<?xml version=""1.0""?>" & CRLF
& "<config>" & CRLF
& " <dir-pair>" & CRLF
& " <clearfile>/tmp/pippo.txt</clearfile>" & CRLF
& " <cypherfile>/dropbox/pippo.txt.enc</cypherfile>" & CRLF
& " <key>123456789</key>" & CRLF
& " </dir-pair>" & CRLF
& "</config>" & CRLF;
Input : String_Input;
Reader : Schema.Dom_Readers.Tree_Reader;
begin
Open (Str => Data,
Encoding => Unicode.CES.Utf8.Utf8_Encoding,
Input => Input);
Reader.Set_Grammar (Grammar);
Reader.Set_Feature (Sax.Readers.Validation_Feature, True);
Reader.Parse (Input); -- 2:8: No DTD defined
-- sax/sax-readers.adb:6108
-- sax/sax-readers.adb:979
-- sax/sax-readers.adb:4892
-- sax/sax-readers.adb:5949
-- schema/schema-readers.adb:1128
-- prova.adb:81
Close (Input);
end Prova;
-------------------------------------------------
^ permalink raw reply [relevance 2%]
* Re: character literals
@ 2014-02-12 15:53 2% ` Robert A Duff
0 siblings, 0 replies; 200+ results
From: Robert A Duff @ 2014-02-12 15:53 UTC (permalink / raw)
adambeneschan@gmail.com writes:
> On Tuesday, February 11, 2014 2:27:57 PM UTC-8, ag...@drrob1.com wrote:
>> I have been having a difficulty in my code with character literals.
>>
>> For example
>>
>> IF ch in '0' .. '9' THEN
Note to OP: If you have questions about an error message, it's best to
cut&paste the exact complete compilable code that caused the error,
along with the exact text of the error message.
The above is legal given the right declaration of ch, but you
didn't show that; there are all sorts of reasons the above could
be illegal.
Also look at Ada.Characters.Handling. You can call the Is_Digit function.
> Finally, the language does have one special rule:
>
> for I in 0 .. 9 loop
>
> The literals 0 and 9 could be resolved to any integer type, which
> would make this ambiguous since there are normally multiple integer
> types visible in the program (Integer, Long_Integer, Short_Integer,
> maybe types in Interfaces if you "use" that packaged). But the
> language rules decree that the type will be Integer in that case.
> This is a situation where some programmers might recommend making the
> type Integer explicit.
Like me. I think the special-case for Integer is a kludge, so I
would write:
for I in Some_Type range 0 .. 9 loop
One exception: If I want to say "do this 5 times", I might write:
for I in 1 .. 5 loop
and there are no references to I in the loop, so its type is irrelevant.
On the other hand, if the type is clear from the bounds, as in
for I in 1 .. Some_Array'Last - 1 loop
I wouldn't put the type in.
- Bob
^ permalink raw reply [relevance 2%]
* need help learning Ada for a modula-2 programmer
@ 2014-01-28 1:06 3% agent
0 siblings, 0 replies; 200+ results
From: agent @ 2014-01-28 1:06 UTC (permalink / raw)
The following code does not compile. I don't understand why.
The string processing fails to compile, saying "prefix of image must
be a type"
and
"move is undefined"
I don't yet understand string processing with Ada
--rob
with Ada.Calendar; use Ada.Calendar;
Package timliba is
-- REVISION HISTORY
-- ----------------
-- 6 Oct 13 -- Converted to gm2. And changed its name.
-- 19 Jan 14 -- Converted to Ada.
SubType String10Type is String(1..10);
TYPE DAYNAMESType is ARRAY (1..7) OF String10Type;
TYPE MONTHNAMESType is ARRAY (1..12) OF String10Type;
Type DateTimeType is RECORD
SystemTime: Time;
month,day,year,hours,minutes,seconds : Natural;
ElapsedSec : Duration;
END Record;
DateTime: DateTimeType;
DAYNAMES : Constant DayNamesType := ("Sunday ","Monday
","Tuesday ","Wednesday ", "Thursday ","Friday ","Saturday ");
MONTHNAMES : Constant MonthNamesType := ("January ","February
","March ","April ","May ",
"June ","July ","August ","September ","October
","November ","December ");
PROCEDURE TIME2MDY(M,D,Y : Out Natural);
-- System Time To Month, Day, and Year Conversion.
Procedure GetDateTime(DateTime: Out DateTimeType);
-- DateTimeType is my record time type containing everything.
Function JULIAN(M,D,Y : Natural) return Natural;
PROCEDURE GREGORIAN(Juldate : Natural; M,D,Y : OUT Natural);
END timliba;
-- with environa; use environa;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Characters; use Ada.Characters;
with Ada.Characters.Conversions; use Ada.Characters.Conversions;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Calendar; use Ada.Calendar;
Package body timliba is
-- REVISION HISTORY
-- ----------------
-- 14 Apr 92 -- Created JULIAN and GREGORIAN procs, which are
accurate beyond 3/1/2100.
-- 25 Jul 93 -- Changed GREG2JUL and JUL2GREG limits to those imposed
by the
-- algorithm, ie, only years <2100 are now allowed.
-- 25 Jul 94 -- Changed limits of allowed years to 1700 from 1900.
-- 10 Nov 02 -- Converted to SBM2 Win v4.
-- 17 May 03 -- First Win32 version.
-- 26 May 03 -- Adjusted algorithm for Julian fcn so year has a
pivot.
-- 6 Oct 13 -- Converted to gm2.
-- 19 Jan 14 -- Converted to Ada.
SubType String255 is String(1..255);
K,IDX,PTR,c,RETCOD : Natural;
CH : CHARacter;
FLAG,FLAG2,FLAG3,FLAG4,FLAG5,EOFFLG : BOOLEAN;
-- PROMPT,NAMDFT,TYPDFT,INFNAM,OUTFNAM,
-- TMPBUF,NUMBUF,DRVPATH,INBUF,TOKEN : BUFTYP;
-- TKNSTATE : FSATYP;
I,J : INTEGER;
TYPE ADIPMType is ARRAY (0..11) OF INTEGER;
-- This is a typed constant that represents the difference btwn the
last day
-- of the previous month and 30, assuming each month was 30 days
long.
-- The variable name is an acronym of Accumulated Days In Previous
Months.
ADIPM : CONSTant ADIPMType := (0,1,-1,0,0,1,1,2,3,3,4,4);
FUDGEFACTOR : CONSTant LONG_FLOAT := 5.0;
-- These are declared in the spec file
-- Type DateTimeType is RECORD
-- SystemTime: Time;
-- month,day,year,hours,minutes,seconds : Natural;
-- ElapsedSec : Duration;
-- END Record;
PROCEDURE TIME2MDY(M,D,Y : Out Natural) is
-- *********************************** TIME2MDY
*************************
-- System Time To Month, Day, and Year Conversion.
Systime : Time;
BEGIN
Systime := Clock;
M := Month(Systime);
D := Day(Systime);
Y := Year(Systime);
END TIME2MDY;
Procedure GetDateTime(DateTime : Out DateTimeType) is
CardSec : Natural;
BEGIN
DateTime.SystemTime := Clock;
Split(DateTime.SystemTime,DateTime.year,DateTime.month,DateTime.day,DateTime.ElapsedSec);
CardSec := Natural(DateTime.ElapsedSec+0.5);
DateTime.hours := CardSec / 3600;
CardSec := CardSec - DateTime.hours * 3600;
DateTime.minutes := CardSec / 60;
DateTime.seconds := CardSec MOD 60;
END GetDateTime;
PROCEDURE MDY2STR(M,D,Y : Natural; MDYSTR : Out String255) is
-- ***************************** MDY2STR
*********************************
-- Month Day Year Cardinals To String.
DateSepChar : constant character := '/';
MSTR,DSTR,YSTR : String(1..2);
IntermedStr : String(1..10);
m0,d0,y0 : Natural;
BEGIN
m0 := M;
d0 := D;
y0 := Y;
IntermedStr := m0'Image & DateSepChar & d0'Image & DateSepChar &
y0'Image;
-- DSTR := D'Image;
-- YSTR := Y'Image;
-- MDYSTR := To255(IntermedStr);
Move(IntermedStr,MDYstr);
END MDY2STR;
Function JULIAN(M,D,Y : Natural) return Natural is
M0,D0,Y0 : Natural;
Juldate : Natural;
BEGIN
IF Y < 30 THEN
Y0 := Y + 2000 - 1;
ELSIF Y < 100 THEN
Y0 := Y + 1900 - 1;
ELSE
Y0 := Y - 1;
END IF;
IF (M < 1) OR (M > 12) OR (D < 1) OR (D > 31) OR (Y < 1700) OR (Y >
2500) THEN
-- Month, Day or Year is out of range
Juldate := 0;
RETURN(Juldate);
END IF;
M0 := M - 1;
Juldate := Y0 * 365 -- Number of days in previous normal years
+ Y0 / 4 -- Number of possible leap days
- Y0 / 100 -- Subtract all century years
+ Y0 / 400 -- Add back the true leap century years
+ ADIPM(M0) + M0 * 30 + D;
IF ((( Y MOD 4 = 0) AND ( Y MOD 100 /= 0)) OR ( Y MOD 400 = 0)) AND
-- 123 3 3 32 2 21
(M >
2) THEN
Juldate := Juldate + 1;
END IF;
RETURN Juldate;
END JULIAN;
PROCEDURE GREGORIAN(Juldate : Natural; M,D,Y : OUT Natural) is
Y0,M0,D0,L,JD : Natural;
BEGIN
Y0 := Juldate / 365;
M0 := 1;
D0 := 1;
WHILE JULIAN(M0,D0,Y0) > Juldate LOOP Y0 := Y0 - 1; END Loop;
M0 := 12;
WHILE JULIAN(M0,D0,Y0) > Juldate Loop M0 := M0 - 1; END Loop;
WHILE JULIAN(M0,D0,Y0) < Juldate Loop D0 := D0 + 1; END Loop;
M := M0;
D := D0;
Y := Y0;
END GREGORIAN;
END timliba;
^ permalink raw reply [relevance 3%]
* Re: Q: Localizing type and package references
2014-01-06 1:29 0% ` Jeffrey Carter
@ 2014-01-06 8:05 0% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2014-01-06 8:05 UTC (permalink / raw)
Jeffrey Carter <spam.jrcarter.not@spam.not.acm.org> writes:
> On 01/05/2014 04:55 PM, b.mcguinness747@gmail.com wrote:
>>
>> --------------------------------------------------------------------------------
>> -- Types - Declarations of data types and related packages
>> --------------------------------------------------------------------------------
>> with Ada.Characters;
>> with Ada.Characters.Wide_Latin_1;
>> with Ada.Strings;
>> with Ada.Strings.Wide_Maps;
>> with Ada.Strings.Wide_Unbounded;
>> with Ada.Wide_Characters;
>> with Ada.Wide_Characters.Handling;
>> with Ada.Wide_Text_IO;
>> with Ada.Wide_Text_IO.Text_Streams;
>>
>> package Types is
>> package Chars renames Ada.Characters.Wide_Latin_1;
>> package Char_Handling renames Ada.Wide_Characters.Handling;
>> package Char_IO renames Ada.Wide_Text_IO;
>> package Char_Maps renames Ada.Strings.Wide_Maps;
>> package Char_Streams renames Ada.Wide_Text_IO.Text_Streams;
>> package Char_Strings renames Ada.Strings.Wide_Unbounded;
>>
>> subtype Char is Wide_Character;
>> subtype Char_String is Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
>> end Types;
>>
>> and then tried referencing this from the main program file with:
>>
>> with Types;
>> use Types;
>>
>> with Char_Strings;
>>
>> but the compiler (Gnat 4.6) complains that there is no file called
>> char_strings.ads. I am not sure if I have made a simple mistake that
>> can be easily corrected to make this work, or if there is a different
>> approach that I should be trying.
>
> You can only with a library-level package, one not declared in
> anything else. Char_Strings is declared in package types, so it's not
> library level and can't be withed.
So, you can either reclare package Chars etc at library level: for
example, in char_strings.ads,
with Ada.Strings.Wide_Unbounded;
package Char_Strings renames Ada.Strings.Wide_Unbounded;
or you can change your main program file to say
with Types;
use Types;
use Types.Chars;
use Types.Char_Handling;
...
or perhaps
with Types;
use Types;
procedure Main is
use Chars;
use Char_Handling;
...
^ permalink raw reply [relevance 0%]
* Re: Q: Localizing type and package references
2014-01-05 23:55 3% Q: Localizing type and package references b.mcguinness747
@ 2014-01-06 1:29 0% ` Jeffrey Carter
2014-01-06 8:05 0% ` Simon Wright
0 siblings, 1 reply; 200+ results
From: Jeffrey Carter @ 2014-01-06 1:29 UTC (permalink / raw)
On 01/05/2014 04:55 PM, b.mcguinness747@gmail.com wrote:
>
> --------------------------------------------------------------------------------
> -- Types - Declarations of data types and related packages
> --------------------------------------------------------------------------------
> with Ada.Characters;
> with Ada.Characters.Wide_Latin_1;
> with Ada.Strings;
> with Ada.Strings.Wide_Maps;
> with Ada.Strings.Wide_Unbounded;
> with Ada.Wide_Characters;
> with Ada.Wide_Characters.Handling;
> with Ada.Wide_Text_IO;
> with Ada.Wide_Text_IO.Text_Streams;
>
> package Types is
> package Chars renames Ada.Characters.Wide_Latin_1;
> package Char_Handling renames Ada.Wide_Characters.Handling;
> package Char_IO renames Ada.Wide_Text_IO;
> package Char_Maps renames Ada.Strings.Wide_Maps;
> package Char_Streams renames Ada.Wide_Text_IO.Text_Streams;
> package Char_Strings renames Ada.Strings.Wide_Unbounded;
>
> subtype Char is Wide_Character;
> subtype Char_String is Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
> end Types;
>
> and then tried referencing this from the main program file with:
>
> with Types;
> use Types;
>
> with Char_Strings;
>
> but the compiler (Gnat 4.6) complains that there is no file called
> char_strings.ads. I am not sure if I have made a simple mistake that
> can be easily corrected to make this work, or if there is a different
> approach that I should be trying.
You can only with a library-level package, one not declared in anything else.
Char_Strings is declared in package types, so it's not library level and can't
be withed.
--
Jeff Carter
"Spam! Spam! Spam! Spam! Spam! Spam! Spam! Spam!"
Monty Python's Flying Circus
53
^ permalink raw reply [relevance 0%]
* Q: Localizing type and package references
@ 2014-01-05 23:55 3% b.mcguinness747
2014-01-06 1:29 0% ` Jeffrey Carter
0 siblings, 1 reply; 200+ results
From: b.mcguinness747 @ 2014-01-05 23:55 UTC (permalink / raw)
I want to write an Ada program using the Wide_Character type, but I might
want to move to Wide_Wide_Character later on. So I want to localize all
references to Wide_Character and the associated standard Ada packages to
a single file that I can easily update. If I was working in C++, I would
use typedefs to create pseudonyms and put these in a header file that I could
#include from various source files. So I have tried to do something similar
in Ada. I created the file types.ads:
--------------------------------------------------------------------------------
-- Types - Declarations of data types and related packages
--------------------------------------------------------------------------------
with Ada.Characters;
with Ada.Characters.Wide_Latin_1;
with Ada.Strings;
with Ada.Strings.Wide_Maps;
with Ada.Strings.Wide_Unbounded;
with Ada.Wide_Characters;
with Ada.Wide_Characters.Handling;
with Ada.Wide_Text_IO;
with Ada.Wide_Text_IO.Text_Streams;
package Types is
package Chars renames Ada.Characters.Wide_Latin_1;
package Char_Handling renames Ada.Wide_Characters.Handling;
package Char_IO renames Ada.Wide_Text_IO;
package Char_Maps renames Ada.Strings.Wide_Maps;
package Char_Streams renames Ada.Wide_Text_IO.Text_Streams;
package Char_Strings renames Ada.Strings.Wide_Unbounded;
subtype Char is Wide_Character;
subtype Char_String is Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
end Types;
and then tried referencing this from the main program file with:
with Types;
use Types;
with Char_Strings;
but the compiler (Gnat 4.6) complains that there is no file called
char_strings.ads. I am not sure if I have made a simple mistake that
can be easily corrected to make this work, or if there is a different
approach that I should be trying.
Help would be appreciated.
Thanks.
--- Brian
^ permalink raw reply [relevance 3%]
* Re: Bootstrapping a null procedure. Seriously?!
@ 2013-03-13 4:34 1% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2013-03-13 4:34 UTC (permalink / raw)
To compile a barebone Ada program you must not use "gnatmake"
or "gnat make" because it auto execute the Ada binder "gnatbind"
and the "gnat linker". Gnat's binder and linker can not be used
because they creates an os bound program. And they also adds a
number of simple routines that may not be required for your
program.
Any and all subunits and libraries that requires elaboration must
be done manually first, within the main program. Normally this job
is handled by the Gnat binder. The elaboration code can be in cased
within a procedure or function that is called by the main program.
Also, you can not use the standard "raise" statement or the
standard exception handlers. For exceptions to work, Gnat
compiler requires a number of System packages be load as well
as "Ada.Exceptions".
# --
# -- Makefile
# --
gnat compile testnulmain.adb
#
# use -nostdinclib to remove most of gcc standard libraries
# but os startup code is included from "libc".
# additional libraries files, if included must be added to
# the command line.
#
# To reduce code to the basic user created only code use the
# -T <file> command. The file defines ".text", ".data",
# ".rodata", and ".bss" setions and then discard all other
# sections.
#
# Note: use -o testnulmain.exe for all microsoft based os(s)
# gcc only support ".com" files with the -T <file> option
#
gcc -nostdinclib -o testnulmain testnulmain.o
--
-- testnulmain.ads
--
procedure testnulmain ;
--
-- Required by linker
--
pragma Export ( Ada, testnulmain, "main" ) ;
--
-- testnulmain.adb
--
-- Can include "Stand-Alone" Ada packages, like Ada.Characters,
-- Ada.Interfaces, or System. Actually any Ada library that
-- does not require direct or indirect OS linking can be used.
--
with System ;
procedure TestNulMain is
--
-- In this example System.o is not needed to link file
--
TestVar : System.Address := System.Null_Address ;
begin
-- preform elaboration here first
null ;
end TestNulMain ;
In <19d330ec-9b61-414e-abc3-e25a8c786b81@googlegroups.com>, Diogenes <phathax0r@gmail.com> writes:
>I've been doing some binder experiments with this little gem....
>
>procedure nullmain is
>
>begin
>
> null;
>
>end nullmain;
>
>
>Been doing it to see just how many packages from the runtime have to be lin=
>ked in order for the the thing to DO NOTHING!
>
>40 packages are pulled in.
>
>By most measures of good software design, this is WRONG.
>
>So here's the question...
>
>Do I need to have different a-finali.ads/.adb packages and the correspondin=
>g crt1.o implementations for every possible variation on the runtime I coul=
>d ever want? I mean, seriously, it's pulling in system.string_opts; does an=
>yone see strings in the above code?
>
>Of course I realize this is partly due to package dependency issues, howeve=
>r I SHOULD be able to write my own a-finali.ads that does nothing but make =
>a _start symbol for the system linker, right?
>
>Tips?
>
^ permalink raw reply [relevance 1%]
* Re: string and wide string usage
2013-03-07 14:20 3% ` ytomino
2013-03-07 17:14 0% ` Dmitry A. Kazakov
@ 2013-03-07 23:53 2% ` Randy Brukardt
1 sibling, 0 replies; 200+ results
From: Randy Brukardt @ 2013-03-07 23:53 UTC (permalink / raw)
"ytomino" <aghia05@gmail.com> wrote in message
news:5e5e7e80-7d69-47e1-9550-19e2e0a211a9@googlegroups.com...
> On Thursday, March 7, 2013 8:12:01 PM UTC+9, Ali Bendriss wrote:
>> I've got some problem with some string in example:
>> a base 64 encoded string
>> V2luZG93c8KgNyBQcm9mZXNzaW9ubmVsIE4=
>> wich decode to 'Windows\xa07 Professionnel N' in utf-8
>> every thing is working if I feed directly the database, but if want to
>> apply Ada.Characters.Handling.To_Lower on the string before feeding the
>> database postgres is not happy
>> 'ERROR: invalid byte sequence for encoding "UTF8": 0xe2 0xa0 0x37'
>> it's not really a big deal, but I would like to understand where the
>> problem is. Do I have to use wide string ?
>
> Because functions in Ada.Characters.Handling take not UTF-8 but Latin-1.
Right. The proper thing to do (for Ada 2012) is to use
Ada.Characters.Wide_Handling (or Wide_Wide_Handling) to do the case
conversion, after converting the UTF-8 into a Wide_String (or
Wide_Wide_String).
If you're trying to do this in an older version of Ada, you'll have to find
some library somewhere to do the job.
But I want to caution you that "converting to lower case" is not a great
idea if you plan to support arbitrary Unicode strings. Such conversions are
somewhat ambiguous, and tend to make strings appear similar that are
different (and sometimes the reverse happens as well). Usually, the best
plan is to store the strings unmodified and use Equal_Case_Insensitive to
compare them (this uses the most accurate comparison defined by Unicode, and
has the advantage of being guarenteed not to change in future character set
standards, which is NOT true of conversion to lower case).
There is a nice example of this problem in the next chapter of the Ada 2012
Rationale (although you'll have to wait untiil May to see it, unless you get
the Ada User Journal).
I realize you may have no choice given the design of your database might not
be in your control, and it might not matter if you don't plan to have Greek
and Turkish characters in your data (to mention two of the most common where
convert to lower case and Equal_Case_Insensitive give different answers for
Wide_Strings).
Randy.
^ permalink raw reply [relevance 2%]
* Re: string and wide string usage
2013-03-07 14:20 3% ` ytomino
@ 2013-03-07 17:14 0% ` Dmitry A. Kazakov
2013-03-07 23:53 2% ` Randy Brukardt
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2013-03-07 17:14 UTC (permalink / raw)
On Thu, 7 Mar 2013 06:20:05 -0800 (PST), ytomino wrote:
> On Thursday, March 7, 2013 8:12:01 PM UTC+9, Ali Bendriss wrote:
>> I've got some problem with some string in example:
>> a base 64 encoded string
>> V2luZG93c8KgNyBQcm9mZXNzaW9ubmVsIE4=
>> wich decode to 'Windows\xa07 Professionnel N' in utf-8
>> every thing is working if I feed directly the database, but if want to
>> apply Ada.Characters.Handling.To_Lower on the string before feeding the
>> database postgres is not happy
>> 'ERROR: invalid byte sequence for encoding "UTF8": 0xe2 0xa0 0x37'
>> it's not really a big deal, but I would like to understand where the
>> problem is. Do I have to use wide string ?
>
> Because functions in Ada.Characters.Handling take not UTF-8 but Latin-1.
> You have to
> 1. convert UTF-8 String to Wide_Wide_String, process UTF-32 and restore it to UTF-8.
> (Ada.Characters.Conversion also take Latin-1. You have to use GNAT.Encode_String/Decode_String or Ada.Strings.UTF_Encoding for converting.)
> 2. search a external library to process UTF-8 directly.
Provided the base 64 encodes an UTF-8 string, which you wanted to convert
to lower case UTF-8 string using the Unicode lower case mapping, then you
can use
function To_Lowercase (Value : String) return String;
from
http://www.dmitry-kazakov.de/ada/strings_edit.htm#7.6
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: string and wide string usage
2013-03-07 11:12 2% string and wide string usage Ali Bendriss
@ 2013-03-07 14:20 3% ` ytomino
2013-03-07 17:14 0% ` Dmitry A. Kazakov
2013-03-07 23:53 2% ` Randy Brukardt
0 siblings, 2 replies; 200+ results
From: ytomino @ 2013-03-07 14:20 UTC (permalink / raw)
On Thursday, March 7, 2013 8:12:01 PM UTC+9, Ali Bendriss wrote:
> I've got some problem with some string in example:
> a base 64 encoded string
> V2luZG93c8KgNyBQcm9mZXNzaW9ubmVsIE4=
> wich decode to 'Windows\xa07 Professionnel N' in utf-8
> every thing is working if I feed directly the database, but if want to
> apply Ada.Characters.Handling.To_Lower on the string before feeding the
> database postgres is not happy
> 'ERROR: invalid byte sequence for encoding "UTF8": 0xe2 0xa0 0x37'
> it's not really a big deal, but I would like to understand where the
> problem is. Do I have to use wide string ?
Because functions in Ada.Characters.Handling take not UTF-8 but Latin-1.
You have to
1. convert UTF-8 String to Wide_Wide_String, process UTF-32 and restore it to UTF-8.
(Ada.Characters.Conversion also take Latin-1. You have to use GNAT.Encode_String/Decode_String or Ada.Strings.UTF_Encoding for converting.)
2. search a external library to process UTF-8 directly.
^ permalink raw reply [relevance 3%]
* string and wide string usage
@ 2013-03-07 11:12 2% Ali Bendriss
2013-03-07 14:20 3% ` ytomino
0 siblings, 1 reply; 200+ results
From: Ali Bendriss @ 2013-03-07 11:12 UTC (permalink / raw)
Hello,
I've got a small program that read some value from an ldap server and
copy them in a posgres database.
the function reading the ldap value return an unbounded_string, then I
use to_string to feed postgres (using gnatcoll).
I've got some problem with some string in example:
a base 64 encoded string
V2luZG93c8KgNyBQcm9mZXNzaW9ubmVsIE4=
wich decode to 'Windows\xa07 Professionnel N' in utf-8
every thing is working if I feed directly the database, but if want to
apply Ada.Characters.Handling.To_Lower on the string before feeding the
database postgres is not happy
'ERROR: invalid byte sequence for encoding "UTF8": 0xe2 0xa0 0x37'
it's not really a big deal, but I would like to understand where the
problem is. Do I have to use wide string ?
thanks,
Ali
^ permalink raw reply [relevance 2%]
* Re: Sockets Example Sought
@ 2012-11-28 4:43 2% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2012-11-28 4:43 UTC (permalink / raw)
--
-- TCP/IP Echo Service Daemon, based on RFC 342 and RFC 862
-- Normally, a Sender program that accepts a word or quoted
-- sentence from command line is transmitted to the server and
-- the return message is displayed.
--
-- This Daemon was tested using "Ada Dual TCP/IP Stacks" using
-- IPv6 and Linux IPv4,
--
--
-- Protocol: TCP
-- Protocol: UDP not setup at this time.
--
-- Usage: Listener
--
-- Tester: Telnet <hostname> -port 7
-- Example: Telnet 127.0.0.1 7
--
-- While telnet operational every character including control
-- characters will be echoed
--
with Ada.Characters.Latin_9 ;
with Ada.Exceptions ;
with Ada.Text_IO ;
with GNAT.Sockets ; -- GNAT to reg OS
-- with Sockets ; -- Ada TCP/IP Stacks
use Ada.Characters.Latin_9 ;
use Ada.Exceptions ;
use Ada.Text_IO ;
use GNAT.Sockets ;
-- use Sockets ; -- Ada TCP/IP Stacks
procedure Listener is
--
-- Operational options
--
-- Set to True to use IPv6, But some GNAT.Socket packages, are
-- not setup to handle IPv6 yet. One way to check is to look at
-- the body for the "Bind" function. Because the "Bind" function
-- raises a exception, if IPv6 is use, for those packages that
-- are IPv4 only.
--
IP_V6 : constant Boolean := False ;
--
-- Displays a logging message if True
--
LOGGING : constant Boolean := False ;
task type Echo is
entry Start ( Incoming : Socket_Type ) ;
end Echo ;
type Echo_Access is access Echo ;
type Sock_Addr_Access is access all Sock_Addr_Type ;
--
-- Echo -- the main processthat preforms the echo operation
-- -- one problem is there is no recovery of memory use
-- by this task once the task ends.
--
task body Echo is
Data : Character ;
Channel : Stream_Access ;
Socket : Socket_Type ;
begin
accept Start ( Incoming : Socket_Type ) do
Socket := Incoming ;
end Start ;
Channel := Stream ( Socket ) ;
loop
Data := Character ' Input ( Channel ) ;
exit when Data = ASCII.Nul ;
Character ' Output ( Channel, Data ) ;
end loop ;
Close_Socket ( Socket ) ;
exception
when Socket_Error =>
Put_Line ( "Connection closed" ) ;
Close_Socket ( Socket ) ;
end Echo ;
--
Accepting_Socket : Socket_Type ;
Incoming_Socket : Socket_Type ;
Address : Sock_Addr_Access ;
Dummy : Echo_Access ;
TCP_Error : exception ;
begin
--
-- Create Socket and sets stacks. With error checking to insure
-- stacks is valid because some system only have IPv4 and other
-- have remove IPv4. If both stacks are installed and GNAT
-- allows both, then use IPv6.
--
if IP_V6 then
begin
--
-- set IPv6
--
Create_Socket ( Accepting_Socket, Family_Inet6, Socket_Stream ) ;
Address := new Sock_Addr_Type ( Family_Inet6 );
exception
when Socket_Error =>
Put_Line ( "Error: IP version 6 is not supported" ) ;
raise TCP_Error ;
end ;
else
begin
--
-- set Default IPv4
--
Create_Socket ( Accepting_Socket ) ;
Address := new Sock_Addr_Type ;
exception
when Socket_Error =>
Put_Line ( "Error: IP version 4 is not supported" ) ;
raise TCP_Error ;
end ;
end if ;
--
-- Address.Addr is current host can be localhost
-- Address.Port is 7 based on RFC 342 update RFC 862
--
Address.all.Addr := Addresses ( Get_Host_By_Name ( Host_Name ), 1 ) ;
Address.all.Port := 7 ;
--
-- Bind Address to socket
--
Bind_Socket ( Accepting_Socket, Address.all ) ;
--
-- Set stacks to receive connect events
--
Listen_Socket ( Accepting_Socket ) ;
--
-- Handle connections
--
loop
--
-- Wait until client request connect then accept connection
--
Accept_Socket ( Accepting_Socket,
Incoming_Socket, Address.all ) ;
--
-- Log message, if required
--
if LOGGING then
Put ( "Received From: " ) ;
Put ( Image ( Address.all ) ) ;
end if ;
--
-- Create a single usage task to handle daemon process
-- task will die once connection is ended. In this design
-- there is a possible memory leak because once the task
-- dies there is no memory recover of the dead task.
--
Dummy := new Echo ;
Dummy.Start ( Incoming_Socket ) ;
end loop ;
exception
when TCP_Error =>
Put_Line ( "Error: Server was not initialized" ) ;
when others =>
Put_Line ( "Error: Server is beening shutdown" ) ;
Shutdown_Socket ( Accepting_Socket, Shut_Read_Write ) ;
end Listener ;
In <2012112311175432190-rblove@airmailnet>, Robert Love <rblove@airmail.net> writes:
>Does anyone have an example of a multi-client server in Ada they care
>to share? It should use the Gnat.Sockets package. I've seen samples
>but they don't seem complete, or at least my understanding isn't
>complete<grin>.
>
>Thanks in advance.
>
>
^ permalink raw reply [relevance 2%]
* Re: Child packages named Ada illegal?
2012-10-31 18:41 3% ` Marius Amado-Alves
2012-10-31 19:39 3% ` Shark8
@ 2012-11-01 9:27 0% ` AdaMagica
1 sibling, 0 replies; 200+ results
From: AdaMagica @ 2012-11-01 9:27 UTC (permalink / raw)
On Wednesday, October 31, 2012 7:41:12 PM UTC+1, Marius Amado-Alves wrote:
> I had boobed with the packages file names with all the renaming and copying. And I was writing "with Standard.Ada...." GNAT does not allow that. But we can with Ada.Characters and use Standard.Ada.Characters.
GNAT does allow this, but then Standard is a package that you defined like so:
package Standard is
....
end Standard;
This is of course very bad because it hides the name of the predefined package Standard. Thus, if you haven't defined such a package Standard, GNAT refused a with clause beginning with Standard.
(Visibility rules in context clauses are a bit different from the rest of source code.)
^ permalink raw reply [relevance 0%]
* Re: Child packages named Ada illegal?
2012-10-31 18:41 3% ` Marius Amado-Alves
@ 2012-10-31 19:39 3% ` Shark8
2012-11-01 9:27 0% ` AdaMagica
1 sibling, 0 replies; 200+ results
From: Shark8 @ 2012-10-31 19:39 UTC (permalink / raw)
> package body AA.Languages.Ada is
> ...
> function Non_Alphanum_To_Underscore (From : Character) return Character is
> (if Ada.Characters.Handling.Is_Alphanumeric (From) then From else '_');
> ...
> end;
One option would be to put package renaming inside the AA or Languages package; thus:
with Ada.Characters;
Package AA.Language is
...
package Internal_Characters Renames Ada.Characters;
End AA.Language;
would allow you to refer to Ada.Characters via the Internal_Characters name.
^ permalink raw reply [relevance 3%]
* Re: Child packages named Ada illegal?
2012-10-31 18:16 2% ` Adam Beneschan
@ 2012-10-31 18:41 3% ` Marius Amado-Alves
2012-10-31 19:39 3% ` Shark8
2012-11-01 9:27 0% ` AdaMagica
0 siblings, 2 replies; 200+ results
From: Marius Amado-Alves @ 2012-10-31 18:41 UTC (permalink / raw)
>> ... The Standard.Ada trick doesn't work.
>
> Hmmm ... interesting, it should work.
Sorry, it does work. Sorry.
/*
I had boobed with the packages file names with all the renaming and copying. And I was writing "with Standard.Ada...." GNAT does not allow that. But we can with Ada.Characters and use Standard.Ada.Characters.
I had never wrote Standard.Ada... before. Sometimes I write Standard.Integer and such, but for some reason Standard.Ada looked strange to me.
*/
^ permalink raw reply [relevance 3%]
* Re: Child packages named Ada illegal?
2012-10-31 17:59 3% ` Marius Amado-Alves
@ 2012-10-31 18:16 2% ` Adam Beneschan
2012-10-31 18:41 3% ` Marius Amado-Alves
0 siblings, 1 reply; 200+ results
From: Adam Beneschan @ 2012-10-31 18:16 UTC (permalink / raw)
On Wednesday, October 31, 2012 10:59:26 AM UTC-7, Marius Amado-Alves wrote:
> Thanks. The package is as follows (the entire thing is at sourceforge.net/projects/aalibrary/). GNAT shouts <<missing "with Ada.Characters;">> at line "(if Ada...);". The fix is to rename the package AA.Languages.Ada_Language. The Standard.Ada trick doesn't work.
Hmmm ... interesting, it should work. I'm using an earlier version of GNAT that doesn't support Ada 2012 syntax, so I had to rewrite the function to try your example. But it worked fine (inside AA.Languages.Ada) when I referred to Standard.Ada.Characters.Handling.Is_Alphanumeric. So maybe this is a recently introduced bug?
-- Adam
> with Ada.Characters.Handling;
> ...
> package body AA.Languages.Ada is
> ...
> function Non_Alphanum_To_Underscore (From : Character) return Character is
> (if Ada.Characters.Handling.Is_Alphanumeric (From) then From else '_');
> ...
> end;
^ permalink raw reply [relevance 2%]
* Re: Child packages named Ada illegal?
@ 2012-10-31 17:59 3% ` Marius Amado-Alves
2012-10-31 18:16 2% ` Adam Beneschan
0 siblings, 1 reply; 200+ results
From: Marius Amado-Alves @ 2012-10-31 17:59 UTC (permalink / raw)
Thanks. The package is as follows (the entire thing is at sourceforge.net/projects/aalibrary/). GNAT shouts <<missing "with Ada.Characters;">> at line "(if Ada...);". The fix is to rename the package AA.Languages.Ada_Language. The Standard.Ada trick doesn't work.
with Ada.Characters.Handling;
...
package body AA.Languages.Ada is
...
function Non_Alphanum_To_Underscore (From : Character) return Character is
(if Ada.Characters.Handling.Is_Alphanumeric (From) then From else '_');
...
end;
^ permalink raw reply [relevance 3%]
* Re: Help writing first daemon Heres a Server
@ 2012-09-09 7:26 2% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2012-09-09 7:26 UTC (permalink / raw)
--
-- TCP/IP Echo Service Daemon, based on RFC 342 and RFC 862
-- Normally, a Sender program that accepts a word or quoted
-- sentence from command line is transmitted to the server and
-- the return message is displayed.
--
-- This Daemon was tested using "Ada Dual TCP/IP Stacks" using
-- IPv6 and Linux IPv4,
--
--
-- Protocol: TCP
-- Protocol: UDP not setup at this time.
--
-- Usage: Listener
--
-- Tester: Telnet <hostname> -port 7
-- Example: Telnet 127.0.0.1 7
--
-- While telnet operational every character including control
-- characters will be echoed
--
with Ada.Characters.Latin_9 ;
with Ada.Exceptions ;
with Ada.Text_IO ;
with GNAT.Sockets ; -- GNAT to reg OS
-- with Sockets ; -- Ada TCP/IP Stacks
use Ada.Characters.Latin_9 ;
use Ada.Exceptions ;
use Ada.Text_IO ;
use GNAT.Sockets ;
-- use Sockets ; -- Ada TCP/IP Stacks
procedure Listener is
--
-- Operational options
--
-- Set to True to use IPv6, But some GNAT.Socket packages, are
-- not setup to handle IPv6 yet. One way to check is to look at
-- the body for the "Bind" function. Because the "Bind" function
-- raises a exception, if IPv6 is use, for those packages that
-- are IPv4 only.
--
IP_V6 : constant Boolean := False ;
--
-- Displays a logging message if True
--
LOGGING : constant Boolean := False ;
task type Echo is
entry Start ( Incoming : Socket_Type ) ;
end Echo ;
type Echo_Access is access Echo ;
type Sock_Addr_Access is access all Sock_Addr_Type ;
--
-- Echo -- the main processthat preforms the echo operation
-- -- one problem is there is no recovery of memory use
-- by this task once the task ends.
--
task body Echo is
Data : Character ;
Channel : Stream_Access ;
Socket : Socket_Type ;
begin
accept Start ( Incoming : Socket_Type ) do
Socket := Incoming ;
end Start ;
Channel := Stream ( Socket ) ;
loop
Data := Character ' Input ( Channel ) ;
exit when Data = ASCII.Nul ;
Character ' Output ( Channel, Data ) ;
end loop ;
Close_Socket ( Socket ) ;
exception
when Socket_Error =>
Put_Line ( "Connection closed" ) ;
Close_Socket ( Socket ) ;
end Echo ;
--
Accepting_Socket : Socket_Type ;
Incoming_Socket : Socket_Type ;
Address : Sock_Addr_Access ;
Dummy : Echo_Access ;
TCP_Error : exception ;
begin
--
-- Create Socket and sets stacks. With error checking to insure
-- stacks is valid because some system only have IPv4 and other
-- have remove IPv4. If both stacks are installed and GNAT
-- allows both, then use IPv6.
--
if IP_V6 then
begin
--
-- set IPv6
--
Create_Socket ( Accepting_Socket, Family_Inet6, Socket_Stream ) ;
Address := new Sock_Addr_Type ( Family_Inet6 );
exception
when Socket_Error =>
Put_Line ( "Error: IP version 6 is not supported" ) ;
raise TCP_Error ;
end ;
else
begin
--
-- set Default IPv4
--
Create_Socket ( Accepting_Socket ) ;
Address := new Sock_Addr_Type ;
exception
when Socket_Error =>
Put_Line ( "Error: IP version 4 is not supported" ) ;
raise TCP_Error ;
end ;
end if ;
--
-- Address.Addr is current host can be localhost
-- Address.Port is 7 based on RFC 342 update RFC 862
--
Address.all.Addr := Addresses ( Get_Host_By_Name ( Host_Name ), 1 ) ;
Address.all.Port := 7 ;
--
-- Bind Address to socket
--
Bind_Socket ( Accepting_Socket, Address.all ) ;
--
-- Set stacks to receive connect events
--
Listen_Socket ( Accepting_Socket ) ;
--
-- Handle connections
--
loop
--
-- Wait until client request connect then accept connection
--
Accept_Socket ( Accepting_Socket,
Incoming_Socket, Address.all ) ;
--
-- Log message, if required
--
if LOGGING then
Put ( "Received From: " ) ;
Put ( Image ( Address.all ) ) ;
end if ;
--
-- Create a single usage task to handle daemon process
-- task will die once connection is ended. In this design
-- there is a possible memory leak because once the task
-- dies there is no memory recover of the dead task.
--
Dummy := new Echo ;
Dummy.Start ( Incoming_Socket ) ;
end loop ;
exception
when TCP_Error =>
Put_Line ( "Error: Server was not initialized" ) ;
when others =>
Put_Line ( "Error: Server is beening shutdown" ) ;
Shutdown_Socket ( Accepting_Socket, Shut_Read_Write ) ;
end Listener ;
In <3b3a796d-50e0-4304-9f8d-295fb2ed0e82@googlegroups.com>, Patrick <patrick@spellingbeewinnars.org> writes:
>
>Hi Everyone
>
>I am setting out to write my first daemon. There seems to be a lot of optio=
>ns for inter-process communication on posix systems. I am planning on desig=
>ning a scientific instrument control server that will control ports, like t=
>he serial port, based on signals it is sent. It will also collect data from=
> instruments and store the data(I was thinking in a postgresql database).
>
>I just need signals passed on one machine so yaml4 seems like overkill. I w=
>as thinking that I could write many little commands, with each command spec=
>ific to an instrument it is designed to control and the daemon as more gene=
>ral infrastructure(basically middleware), so it wouldn't really be a parent=
>/child relationship. I'm guessing plain old pipes are out.
>
>Does FIFO/names pipes sound reasonable for this sort of thing? I am concern=
>ed that with many commands acting on the daemon there will be too much over=
>head with these commands creating file handlers.
>
>I am also going to control instruments over Ethernet anyways so would inves=
>ting time in socket programming solve two problems by making it a socket ba=
>sed server? Once the socket is set up by the daemon, the smaller "satellite=
>" commands would not need as much overhead to connect to a port as they wou=
>ld to create a file handler, would they?
>
>Lastly, this will be done in Ada where ever possible, is there an Ada orien=
>ted way to do this sort of thing?
>
>Thanks for reading-Patrick
^ permalink raw reply [relevance 2%]
* Re: Ada "library only" compiler ?
@ 2012-07-21 16:47 1% ` Niklas Holsti
0 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2012-07-21 16:47 UTC (permalink / raw)
On 12-07-21 02:30 , Patrick wrote:
> Hi Niklas
>
> ...
>
> So just to clarify, I am not advocating an Ada interpreter, it's just
> that Lua's developers are quite resistant to implementing more then
> the tiniest set of standard libraries. Lua and all the standard
> libraries are less then 18K lines of code and they are determined to
> keep it that way. Lua programmers are supposed to rely on C.
Lua is explicitely meant to be an "extension language", to make some
application "scriptable". The heavy application functions are meant to
be implemented in C (or whatever the host application language is), with
calls from and to Lua code to add flexibility.
I don't think that C libraries can be used easily to extend "Lua the
language" with more language features.
Ada is not meant to be an extension language, but to be a full language
in which one can implement entire applications.
So I don't quite understand why you are using Lua as a comparison.
Perhaps we can approach this in another way, by asking you why you would
prefer to use Ada rather than Lua? Which features of Ada are absent from
Lua, or are better than the corresponding features in Lua? We can then
discuss if and how these features could be implemented in the same way
that Lua is currently implemented.
> Ada is huge
That is debatable. But even if you consider "Ada the language" to be
huge, this just means that an Ada compiler has a lot to do, so the
compilers are "huge" and hard to write. This is in harmony with the
goals of the Ada language: to allow lots of compile-time checking. The
generated code is not necessarily huge.
> and I am not proposing some sort of limit like this but I
> do think that a strategic retreat might be in order, at least for
> some of us and Lua is an example of this. There are not really that
> many libraries and bindings relative to C. If someone had a small Ada
> compiler that they knew had to be supplemented with C that might
> offer a little more clarity of purpose and perhaps leaning on C for
> library support is the better way to go for some people and a toolset
> tailor made for this might be good. Again I don't mean to bash Ada, I
> do like it a lot.
Which parts of "Ada the language" would you omit and replace by "library
support"?
Historically, some Ada developers avoided the tasking features and
instead used some non-Ada real-time kernel. Instead of creating
tasks/threads with the Ada "task" keyword, they would call a kernel
function to create the thread at run-time, providing some ordinary Ada
subprogram as the "main function" of the thread. This can be seen as an
example of replacing Ada language features with libraries (and, I regret
to say, this practice still goes on in some places).
It is not so clear what other language features could profitably be
replaced in this way. At the moment, only the fixed-point types come to
my mind. An Ada program could avoid the Ada fixed-point types and
instead call some fixed-point library, much like some Ada programs now
use libraries for unbounded numbers ("bignums"). It seems to me that
removing fixed-point types from Ada would simplify the compilers -- but
probably not by much.
> So for instance it looks like Ada has a library to retrieve command
> line arguments.
Yes, Ada.Command_Line, a standard predefined package.
> However it looks to be just thin wrapper over ARGV and ARGC.
The services of Ada.Command_Line are similar to ARGV/ARGC, yes. This was
a natural minimum level to provide. However, Ada.Command_Line can be
implemented on systems that have a different method to access
command-line parameters.
> If someone wanted to use something a little higher up like
> getopts, they could rework ARGV/ARGC out this part of their C
> boilerplate code.
An Ada program can certainly use the getopt() library function, although
it may have to provide a C "main" function to do so (and how that is
done depends on the Ada compiler).
> At the moment the Ada binding is there whether or
> not you use it.
So? The package Ada.Command_Line is unlikely to be linked into your Ada
program if you don't use it explicitly. And the mere existence of this
package is a trivial burden on the compiler. And I would bet that the
code in this package is of trivial size.
> I am assuming there will be many more examples of
> this.
Examples of what, exactly?
If you look at the rest of the Ada predefined standard library packages,
they either provide substantial functionality that is not standard in C
(e.g. Ada.Calendar, Ada.Strings.Unbounded, Ada.Containers.*), or they
are simple wrappers (e.g. Ada.Characters.Handling) for C or POSIX
functions. The former can mostly be implemented in Ada itself, in a
portable way; the latter can be implemented by calling system functions
or libraries, in C or other languages. So I don't believe that the
library packages are a significant obstacle to making Ada available on
more devices, in particular since one can just say "sorry, my compiler
does not (yet) support package X".
> However also as an example of my ignorance, I tried this to see if I
> could generate ASM from gnat: gnatmake -S first_procedure.adb
>
> It calls GCC right away: gcc -c -S first_procedure.adb gnatmake:
> "first_procedure.ali" WARNING: ALI or object file not found after
> compile gnatmake: "first_procedure.adb" compilation erro
GCC does not mean "GNU C Compiler", it means "GNU Compiler Collection"
or "GNU Compiler Caller". The "gcc" program is a driver that parses the
arguments and then calls the real compiler programs according to the
chosen or deduced source language. The program "gnat1" is the real GNAT
Ada compiler and gcc will call it eventually. (The program "cc1" is the
real GNU C compiler.)
> It looks like GNAT does not generate it's own ASM but relies on GCC
> for this, so the idea of reworking GNAT into an Ada to ASM converter
> is certainly false, they must interact with an internal
> representation.
Your understanding of how GNAT and GCC work is a bit confused.
The principle is that the GNU compilers are separated into a "front end"
part, distinct for each language, and a "back end" part that is distinct
for each target processor. The front end for language X translates the X
source code into the GCC internal representation; the back end for
processor P translates the internal representation into
assembly-language source code for P. The assembler for P then translates
the assembly-language source code into binary machine code for P.
The Ada-specific part of GNAT is in the front end, which (as I
understand it) is the "gnat1" program. But perhaps I should not say
more, since I really don't know the details.
> So at best it would be an Ada to GCC IR converter and
> then other then a simpler to understand compiler, i guess the
> proposal really doesn't offer much.
The core of GNAT is already an Ada-to-GCC-IR converter.
But the main point is that much of what an Ada compiler does, and most
of what is due to the "hugeness" of Ada, does not depend on the target
processor. When an Ada compiler sees "I+J", where I and J are some
integer variables, it does not immediately decide to use a specific ADD
instruction from the target processor's instruction set. Instead, after
many checks on the legality of the expression, and after deciding which
function called "+" is meant, the expression "I+J" is translated into
the compiler's intermediate language and passed to the back end, which
chooses the instructions. It may well be that the instructions chosen to
compute I+J are quite different when the expression is used in a
statement like K:=I+J, and when it is used in an expression like
K:=Some_Array(I+J).
To conclude, if the goal is to make Ada available on some device D that
is supported by the GCC back-end, then:
- most of the Ada-specific work is already done in GNAT, and
- most of the D-specific work is already done in GCC.
What is left to do is to take care of the details (where the devil is,
of course), and implement the run-time support for Ada on device D. As
can be seen from the AVR-Ada example, the compiler can be useful even
with rudimentary run-time support.
If performance is not important, an alternative is to choose some
virtual machine V, add support for that virtual machine to the GCC
back-end, and port GNAT into an Ada-to-V compiler. The run-time system
could then be written once, for V, and the V simulator could probably be
written in a fairly portable way, to run on several devices with small
adaptations. This was the JGNAT route (GNAT ported to compile Ada into
byte code for the Java Virtual Machine). I'm not sure if JGNAT is still
with us; it seems it had few users.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 1%]
* Re: Ada port of the osdev.org bare bones tutorial (mostly done)
@ 2012-06-16 4:29 2% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2012-06-16 4:29 UTC (permalink / raw)
Try this:
--
-- This pragma allows exceptions to be handled by routines or by
-- the catch all Last_Chance_Hander.
--
pragma Restrictions ( No_Exception_Registration ) ;
--
-- These pragmas stops exceptions on many fronts.
--
-- pragma Restrictions ( No_Exceptions ) ;
-- pragma Restrictions ( No_Exception_Handlers ) ;
-- pragma Restrictions ( No_Exception_Propagation ) ;
----------------------------------------------------------------------
-- Last_Chance_Handler: Displays a Exception Termination Message. --
-- Shutdowns run-time-system. --
-- Halts processor. --
----------------------------------------------------------------------
-----------------------------------------------------------------
-- compile/bind/link with "--RTS=x86" for x86 Bare Bones --
-- Run-Time System. --
-----------------------------------------------------------------
with Ada.Characters.Latin_1 ; -- for ESC character
-- with Ada.Text_IO ; -- Must have full exception
-- working to use
with System ;
with System.IO ;
procedure Teste is
use Ada.Characters.Latin_1 ;
-- use Ada.Text_IO ;
use System ;
use IO ;
Hello_Error : exception ;
begin
--
-- Clear Screen and Display Title message using
-- VT100 / VT52 ANSI escape sequences
--
-- Works on most OSs including Linux.
--
Put ( ESC & "[2J" ) ; -- clear screen
Put ( ESC & "[12;30H" ) ; -- set screen location
Put ( ESC & "[31;40;01m" ) ; -- set text color to Red/Black
Put ( "Bare Bone: " ) ;
Put ( ESC & "[37;40;00m" ) ; -- reset color
Put_Line ( "Hello" ) ;
New_Line ;
--
-- Without a Exception handler the following will cause
-- the last chance handler to be executed, directly.
--
raise Hello_Error ;
-- raise Program_Error ;
-- Exception Handler:
--
-- The first two handlers will raise another exception that
-- will be handled by the Last_Chance_Handler.
--
-- The third handler will not propagate the exception.
-- In turn, the Last_Chance_Hander will not be executed.
--
--
exception
--
when Hello_Error =>
Put_Line ( "Exception Error: Hello" ) ;
raise ;
--
when Program_Error =>
Put_Line ( "Exception Error: Program" ) ;
raise ;
--
when others =>
Put_Line ( "Exception Error: All Others" ) ;
end Teste ;
Lucretia <laguest9000@googlemail.com> wrote in
news:1ca9d254-a12a-4ec3-a4f9-081722fab147@googlegroups.com:
> I've also posted a bug to GCC's bug tracker as I'm lead to believe
> it's possible to declare and use your own exceptions with local
> exception handling, but it's failing.
>
> I don't know if AdaCore people still read this, but it would be
> interesting to know if it is possible or not and if it is can I get a
> patch?
>
> Luke.
>
^ permalink raw reply [relevance 2%]
* Re: Software for Rational R1000 series 400?
2012-06-01 8:02 2% Software for Rational R1000 series 400? Jacob Sparre Andersen
@ 2012-06-01 19:51 0% ` erlo
0 siblings, 0 replies; 200+ results
From: erlo @ 2012-06-01 19:51 UTC (permalink / raw)
On 06/01/2012 10:02 AM, Jacob Sparre Andersen wrote:
> The Danish Computing History Association (DDHF) has received a Rational
> R1000 series 400 from Terma.
>
> I was invited to assist in opening the crate and inspect the hardware
> and documentation yesterday.
>
> Apparently the disks in the machine have been erased before the machine
> left Terma, so DDHF is looking for a source for the operating system
> software for the R1000/400. Since the disks in the machine seem to be
> plain SCSI disks, we hope that a raw disk copy will be enough to get it
> up and running again.
>
> Please contact me or Poul-Henning Kamp ("phk"&
> Ada.Characters.Latin_1.Commercial_At& "phk.freebsd.dk"), if you have
> any information regarding software for the Rational R1000 series 400.
>
> There will (soon) be photos of the machine on<http://datamuseum.dk/>.
>
> Greetings,
>
> Jacob
The disks are SCSI, as you guessed. The R1000 will nly work with a few
disk types, one of the types is Fujitsu. This is due to some hard coded
disk geometry things in the machines disk controller, as far as I remember.
You will need a tape with DFS, which is diagnostics and microcode. The
you will need the environment itself. These things might be hard to get,
even Rational didn't have the installation tapes back in 2003....
Try IBM, they bought Rational at some point and have been able to locate
machines and spares.
/Erlo
^ permalink raw reply [relevance 0%]
* Software for Rational R1000 series 400?
@ 2012-06-01 8:02 2% Jacob Sparre Andersen
2012-06-01 19:51 0% ` erlo
0 siblings, 1 reply; 200+ results
From: Jacob Sparre Andersen @ 2012-06-01 8:02 UTC (permalink / raw)
The Danish Computing History Association (DDHF) has received a Rational
R1000 series 400 from Terma.
I was invited to assist in opening the crate and inspect the hardware
and documentation yesterday.
Apparently the disks in the machine have been erased before the machine
left Terma, so DDHF is looking for a source for the operating system
software for the R1000/400. Since the disks in the machine seem to be
plain SCSI disks, we hope that a raw disk copy will be enough to get it
up and running again.
Please contact me or Poul-Henning Kamp ("phk" &
Ada.Characters.Latin_1.Commercial_At & "phk.freebsd.dk"), if you have
any information regarding software for the Rational R1000 series 400.
There will (soon) be photos of the machine on <http://datamuseum.dk/>.
Greetings,
Jacob
--
"Hungh. You see! More bear. Yellow snow is always dead give-away."
^ permalink raw reply [relevance 2%]
* Re: Checking to see if a string is a letter
2012-04-05 17:12 0% ` deuteros
@ 2012-04-05 17:24 0% ` Martin Dowie
0 siblings, 0 replies; 200+ results
From: Martin Dowie @ 2012-04-05 17:24 UTC (permalink / raw)
deuteros <deuteros@xrs.net> wrote:
> On Tue 03 Apr 2012 04:26:40a, Simon Wright <simon@pushface.org> wrote in
> news:m2k41xi5kv.fsf@pushface.org:
>
>> deuteros <deuteros@xrs.net> writes:
>>
>>> On Tue 03 Apr 2012 01:15:27a, Jeffrey Carter
>>> <spam.jrcarter.not@spam.not.acm.org> wrote in
>>> news:jle13q$ale$1@tornado.tornevall.net:
>>>
>>>> What do you mean by "contains a single letter"?
>>>
>>> I mean the string contains a single letter and nothing more. For
>>> example:
>>>
>>> a - Legal
>>> A - Legal
>>> aa - Illegal
>>> a1 - Illegal
>>
>> Then for a start the length of the string needs to be 1.
>>
>> If it is, the first (and only!) character needs to be a lower- or
>> upper-case letter. There are (at least) three ways of doing this:
>>
>> * declare an array of Boolean indexed by Character, with the elements
>> indexed by letters set to True and the others to False, and index by
>> the character to be tested;
>>
>> * declare two subtypes of character ("Character range 'a' .. 'z'", for
>> instance) and check whether the character to be tested is 'in' either
>> of the subtypes;
>>
>> * use the standard library, Ada.Characters.Handling.Is_Letter (probably
>> the easiest for you!)
>
> Alright, here's my function:
>
> function isVariable(token: in String) return Boolean is
> ParserException : Exception;
> begin
> if(token'Length = 1) then
> return (Is_Letter(token(1)));
> end if;
>
> raise ParserException with ("Not a letter : " & token);
>
> end isVariable;
>
> But I'm getting this warning:
>
> warning: index for "token" may assume lower bound of 1
> warning: suggested replacement: "token'First + -1"
See http://www.ada-auth.org/standards/12rm/html/RM-3-6-3.html to see how
String is defined.
From this you can see that token may not have a value at "token (1)",
perhaps it is indexed by 10..20.
If you know that all the strings you'll ever pass to this function will
start with an index = 1, then you could add a "pragma Assert (tokenFirst =
1);" at the start of the declarative part. An exception will then be raised
if this isn't true (assuming the correct compiler switches are selected).
NB: ParserException is declared locally, so isn't visible to any subprogram
that could attempt to catch it...you'd need to use "when others =>".
HTH
-- Martin
--
-- Sent from my iPad
^ permalink raw reply [relevance 0%]
* Re: Checking to see if a string is a letter
2012-04-03 8:26 2% ` Simon Wright
2012-04-03 12:56 0% ` deuteros
2012-04-03 13:46 0% ` Dmitry A. Kazakov
@ 2012-04-05 17:12 0% ` deuteros
2012-04-05 17:24 0% ` Martin Dowie
2 siblings, 1 reply; 200+ results
From: deuteros @ 2012-04-05 17:12 UTC (permalink / raw)
On Tue 03 Apr 2012 04:26:40a, Simon Wright <simon@pushface.org> wrote in
news:m2k41xi5kv.fsf@pushface.org:
> deuteros <deuteros@xrs.net> writes:
>
>> On Tue 03 Apr 2012 01:15:27a, Jeffrey Carter
>> <spam.jrcarter.not@spam.not.acm.org> wrote in
>> news:jle13q$ale$1@tornado.tornevall.net:
>>
>>> What do you mean by "contains a single letter"?
>>
>> I mean the string contains a single letter and nothing more. For
>> example:
>>
>> a - Legal
>> A - Legal
>> aa - Illegal
>> a1 - Illegal
>
> Then for a start the length of the string needs to be 1.
>
> If it is, the first (and only!) character needs to be a lower- or
> upper-case letter. There are (at least) three ways of doing this:
>
> * declare an array of Boolean indexed by Character, with the elements
> indexed by letters set to True and the others to False, and index by
> the character to be tested;
>
> * declare two subtypes of character ("Character range 'a' .. 'z'", for
> instance) and check whether the character to be tested is 'in' either
> of the subtypes;
>
> * use the standard library, Ada.Characters.Handling.Is_Letter (probably
> the easiest for you!)
Alright, here's my function:
function isVariable(token: in String) return Boolean is
ParserException : Exception;
begin
if(token'Length = 1) then
return (Is_Letter(token(1)));
end if;
raise ParserException with ("Not a letter : " & token);
end isVariable;
But I'm getting this warning:
warning: index for "token" may assume lower bound of 1
warning: suggested replacement: "token'First + -1"
^ permalink raw reply [relevance 0%]
* Re: Checking to see if a string is a letter
2012-04-03 8:26 2% ` Simon Wright
@ 2012-04-03 20:40 2% ` Jeffrey Carter
1 sibling, 0 replies; 200+ results
From: Jeffrey Carter @ 2012-04-03 20:40 UTC (permalink / raw)
On 04/02/2012 11:07 PM, deuteros wrote:
>
> I mean the string contains a single letter and nothing more. For example:
>
> a - Legal
> A - Legal
> aa - Illegal
> a1 - Illegal
Then you'd probably start by checking 'Length for the String to be sure it's 1.
Then you'd check that the single Character in the String is a letter, probably
using an operation in Ada.Characters.Handling.
--
Jeff Carter
"I fart in your general direction."
Monty Python & the Holy Grail
05
^ permalink raw reply [relevance 2%]
* Re: Checking to see if a string is a letter
2012-04-03 8:26 2% ` Simon Wright
2012-04-03 12:56 0% ` deuteros
@ 2012-04-03 13:46 0% ` Dmitry A. Kazakov
2012-04-05 17:12 0% ` deuteros
2 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2012-04-03 13:46 UTC (permalink / raw)
On Tue, 03 Apr 2012 09:26:40 +0100, Simon Wright wrote:
> * use the standard library, Ada.Characters.Handling.Is_Letter (probably
> the easiest for you!)
Ada.Wide_Wide_Characters.Handling.Is_Letter for Unicode.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Checking to see if a string is a letter
2012-04-03 8:26 2% ` Simon Wright
@ 2012-04-03 12:56 0% ` deuteros
2012-04-03 13:46 0% ` Dmitry A. Kazakov
2012-04-05 17:12 0% ` deuteros
2 siblings, 0 replies; 200+ results
From: deuteros @ 2012-04-03 12:56 UTC (permalink / raw)
On Tue 03 Apr 2012 04:26:40a, Simon Wright <simon@pushface.org> wrote in
news:m2k41xi5kv.fsf@pushface.org:
> deuteros <deuteros@xrs.net> writes:
>
>> On Tue 03 Apr 2012 01:15:27a, Jeffrey Carter
>> <spam.jrcarter.not@spam.not.acm.org> wrote in
>> news:jle13q$ale$1@tornado.tornevall.net:
>>
>>> What do you mean by "contains a single letter"?
>>
>> I mean the string contains a single letter and nothing more. For
>> example:
>>
>> a - Legal
>> A - Legal
>> aa - Illegal
>> a1 - Illegal
>
> Then for a start the length of the string needs to be 1.
>
> If it is, the first (and only!) character needs to be a lower- or
> upper-case letter. There are (at least) three ways of doing this:
>
> * declare an array of Boolean indexed by Character, with the elements
> indexed by letters set to True and the others to False, and index by
> the character to be tested;
>
> * declare two subtypes of character ("Character range 'a' .. 'z'", for
> instance) and check whether the character to be tested is 'in' either
> of the subtypes;
>
> * use the standard library, Ada.Characters.Handling.Is_Letter (probably
> the easiest for you!)
Thanks. I'll check out that library.
^ permalink raw reply [relevance 0%]
* Re: Checking to see if a string is a letter
@ 2012-04-03 8:26 2% ` Simon Wright
2012-04-03 12:56 0% ` deuteros
` (2 more replies)
2012-04-03 20:40 2% ` Jeffrey Carter
1 sibling, 3 replies; 200+ results
From: Simon Wright @ 2012-04-03 8:26 UTC (permalink / raw)
deuteros <deuteros@xrs.net> writes:
> On Tue 03 Apr 2012 01:15:27a, Jeffrey Carter
> <spam.jrcarter.not@spam.not.acm.org> wrote in
> news:jle13q$ale$1@tornado.tornevall.net:
>
>> What do you mean by "contains a single letter"?
>
> I mean the string contains a single letter and nothing more. For
> example:
>
> a - Legal
> A - Legal
> aa - Illegal
> a1 - Illegal
Then for a start the length of the string needs to be 1.
If it is, the first (and only!) character needs to be a lower- or
upper-case letter. There are (at least) three ways of doing this:
* declare an array of Boolean indexed by Character, with the elements
indexed by letters set to True and the others to False, and index by
the character to be tested;
* declare two subtypes of character ("Character range 'a' .. 'z'", for
instance) and check whether the character to be tested is 'in' either
of the subtypes;
* use the standard library, Ada.Characters.Handling.Is_Letter (probably
the easiest for you!)
^ permalink raw reply [relevance 2%]
* Re: Need Help On Ada95 Problem
@ 2012-02-12 19:40 3% ` Will
0 siblings, 0 replies; 200+ results
From: Will @ 2012-02-12 19:40 UTC (permalink / raw)
Here Is The Solution and it does work so all of you can understand. I
am fairly new to Ada95 so I have not been introduced to Arrays and
Case and all that stuff but I do understand the solutions here. I did
use the ASCII table and if you view it and go through this by hand you
will understand why it works. The solutions are as follows:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
procedure hw4 is
function Encrypt(PIN : String) return String is
-- Convert the 4-digit PIN to the corresponding 4-letter code.
-- Assume PIN'Length is 4 and that all the characters in PIN are
digits.
-- Example: Encrypt("9537") = "ELVI"
-- FILL IN FOUR MORE TEST CASES.
--Test Case 1: Encrypt("6789") = "TINE"
--Test Case 2: Encrypt("5432") = "LAVO"
--Test Case 3: Encrypt("0926") = "UEOT"
--Test Case 4: Encrypt("7359") = "IVLE"
letterWheel : string := "UROVALTINE";
password : string := PIN;
counter : integer := 1;
number : Character := '0';
AdaIsHard : integer :=0 ;
begin
while counter <= 4 loop
number:= password(counter);
AdaIsHard := (Character'Pos(number)- 47);
password(counter):= letterWheel(AdaIsHard);
counter := counter + 1;
end loop;
return password;
end Encrypt;
^ permalink raw reply [relevance 3%]
* Re: Why no Ada.Wide_Directories?
2011-10-18 15:02 3% ` Adam Beneschan
@ 2011-10-18 22:54 3% ` ytomino
0 siblings, 0 replies; 200+ results
From: ytomino @ 2011-10-18 22:54 UTC (permalink / raw)
On Oct 19, 12:02 am, Adam Beneschan <a...@irvine.com> wrote:
> I think we have a terminology problem.
OK, sorry that my point of the argument was not put in order well.
Do confirming.
> Latin-1 is a set of characters (a subset of the full Unicode character set).
Yes.
And it's also used as name of encoding. (ISO 8859-1, like Yannick
calls)
> So I get
> confused when people talk about Latin-1 versus UTF-8 strings as if
> they were mutually exclusive. They're not, the way I understand the
> terms. You can have a string composed of Latin-1 characters that's
> represented using UTF-8 encoding; and the bits in that string would be
> different from a string of the same Latin-1 characters using the
> "regular" encoding, if any character in the string is in the 16#80#..
> 16#FF# range.
Yes.
"Latin-1 as character set" is not exclusive with Unicode (UCS-2 or
UCS-4).
"Latin-1 as encoding" is exclusive with UTF-8.
And then, I (we?) talked about "Latin-1 as encoding".
> On the other hand, I was confused by your statement
> "Ada.Character.Handling.To_Upper breaks UTF-8". I don't even see a
> way for this to make sense. Ada.Characters.Handling works on
> character types, and a character type is an enumeration type; but a
> UTF-8 "character" can't be an enumeration type at all, since it's a
> variable-length sequence of 8-bit bytes. I'm not quite sure what you
> meant here.
Ada.Characters and Ada.Strings are defined to work with "Latin-1 as
encoding" in String type.
Some subprograms (like To_Upper) in these will replace upper half
characters (16#80#..) to meaningless values in String holding UTF-8,
if we invoke these with UTF-8 String. (Equal_Case_Insensitive does not
replace characters, but returns meaningless value if parameters have
upper half characters encoded as UTF-8.)
Of course, Ada.Wide_Wide_Characters.Handling.To_Upper
(UTF_Encoding.Wide_Wide_Strings.Decode (any UTF-8 encoded string))
works fine.
> As to having utilities such as versions of Ada.Strings.Unbounded or
> Ada.Strings.Fixed that work directly on UTF-8-encoded strings (and
> versions of Ada.Characters that operate on single UTF-8-encoded
> characters): it's certainly possible to write a package like that, and
> anyone is free to do so, but I just don't think they'd be widely used
> enough to add to the Standard. I could be wrong.
I throught the standard library is going to be separated UTF-8 from
Latin-1, when read about UTF-8 mode of Form parameter that Randy says.
Latin-1 is not familiar for me usually, so I has wanted UTF-8 versions
of Ada.Characters. Sorry that my personal wish was mixed.
But it's certain that the standard library has some lacks for handling
non-ASCII file names.
By the way...
I probably will confuse you more :-)
Do you know that single code-point is NOT single letter for display?
Unicode has "composed character". The cases is existing that plural
code-points represent single real letter.
(refer http://www.unicode.org/reports/tr15/tr15-33.html)
In addition, Unicode has "variation selector", This is a decorator for
previous letter (possible to mix with composed character).
(refer http://www.unicode.org/Public/UNIDATA/StandardizedVariants.html)
Therefore, the difficulty of handling Wide_Wide_String is similar to
the difficulty of handling encoded (UTF-8 or other format) string, in
fact.
^ permalink raw reply [relevance 3%]
* Re: Why no Ada.Wide_Directories?
@ 2011-10-18 15:02 3% ` Adam Beneschan
2011-10-18 22:54 3% ` ytomino
0 siblings, 1 reply; 200+ results
From: Adam Beneschan @ 2011-10-18 15:02 UTC (permalink / raw)
On Oct 17, 7:32 pm, ytomino <aghi...@gmail.com> wrote:
>
> I'm not confused. Your misreading.
I think we have a terminology problem. To me, Latin-1 is a set of
characters (a subset of the full Unicode character set). So I get
confused when people talk about Latin-1 versus UTF-8 strings as if
they were mutually exclusive. They're not, the way I understand the
terms. You can have a string composed of Latin-1 characters that's
represented using UTF-8 encoding; and the bits in that string would be
different from a string of the same Latin-1 characters using the
"regular" encoding, if any character in the string is in the 16#80#..
16#FF# range.
However, everyone else seems to be using "Latin-1" to talk about the
*representation* in addition to the subset of characters that's being
represented---in particular, the representation in which each symbol
is represented as one 8-bit byte. And I guess we don't really have a
good term to describe that representation. I think UCS-1 is best, but
it doesn't seem to be commonly used. So I guess I'll have to learn to
live with the misuse of the term "Latin-1" to refer to a
representation (encoding)---just as we older programmers have learned
to live with the terms "Julian Date" and "Gregorian Date" to mean a
dates in year/day-of-year form and in year/month/day form despite the
fact that this has nothing to do with the Julian or Gregorian
calendar. OK, then. I apologize for assuming that this was a sign of
your misunderstanding.
On the other hand, I was confused by your statement
"Ada.Character.Handling.To_Upper breaks UTF-8". I don't even see a
way for this to make sense. Ada.Characters.Handling works on
character types, and a character type is an enumeration type; but a
UTF-8 "character" can't be an enumeration type at all, since it's a
variable-length sequence of 8-bit bytes. I'm not quite sure what you
meant here.
As to having utilities such as versions of Ada.Strings.Unbounded or
Ada.Strings.Fixed that work directly on UTF-8-encoded strings (and
versions of Ada.Characters that operate on single UTF-8-encoded
characters): it's certainly possible to write a package like that, and
anyone is free to do so, but I just don't think they'd be widely used
enough to add to the Standard. I could be wrong.
-- Adam
^ permalink raw reply [relevance 3%]
* Re: Why no Ada.Wide_Directories?
2011-10-17 23:47 2% ` ytomino
@ 2011-10-18 8:01 0% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2011-10-18 8:01 UTC (permalink / raw)
On Mon, 17 Oct 2011 16:47:49 -0700 (PDT), ytomino wrote:
> But other libraries in the standard are explicitly defined as Latin-1.
> It's certain that Ada.Character.Handling.To_Upper breaks UTF-8.
> So we can not use almost subprograms in Ada.Characters and Ada.Strings
> for handling file names.
Right, it is lot more than just Ada.Directories. I have implemented UTF-8
versions of Ada.Strings.Handling and Ada.Strings.Maps: sets and maps of
characters, case conversions, character characterization, superscript and
subscript integer I/O.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Why no Ada.Wide_Directories?
@ 2011-10-17 23:47 2% ` ytomino
2011-10-18 8:01 0% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: ytomino @ 2011-10-17 23:47 UTC (permalink / raw)
On Oct 18, 6:33 am, "Randy Brukardt" <ra...@rrsoftware.com> wrote:
>
> Say what?
>
> Ada.Strings.Encoding (new in Ada 2012) uses a subtype of String to store
> UTF-8 encoded strings. As such, I'd find it pretty surprising if doing so
> was "a violation of the standard".
>
> The intent has always been that Open, Ada.Directories, etc. take UTF-8
> strings as an option. Presumably the implementation would use a Form to
> specify that the file names in UTF-8 form rather than Latin-1. (I wasn't
> able to find a reference for this in a quick search, but I know it has been
> talked about on several occasions.)
>
> One of the primary reasons that Ada.Strings.Encoding uses a subtype of
> String rather than a separate type is so that it can be passed to Open and
> the like.
>
> It's probably true that we should standardize on the Form needed to use
> UTF-8 strings in these contexts, or at least come up with Implementation
> Advice on that point.
>
> Randy.
Good news. Thanks for letting know.
My worry is decreased a little.
However, even if that is right, Form parameters are missing for many
subprograms.
Probably, All subprograms in Ada.Directories,
Ada.Directories.Hierarchical_File_Names, Ada.Command_Line,
Ada.Environment_Variables and other subprograms having Name parameter
or returning a file name should have Form parameter.
(For example, I do Open (X, Form => "UTF-8"). Which does Name (X)
returns UTF-8 or Latin-1?)
Moreover, in the future, we will always use I/O subprograms as UTF-8
mode if what you say is realized.
But other libraries in the standard are explicitly defined as Latin-1.
It's certain that Ada.Character.Handling.To_Upper breaks UTF-8.
So we can not use almost subprograms in Ada.Characters and Ada.Strings
for handling file names.
(For example, Ada.Directories.Name_Case_Equivalence returns
Case_Insensitive. We can not use Ada.Strings.Equal_Case_Insensitive to
compare two file names.)
It means standard libraries are separated UTF-8 from Latin-1.
It's not reasonable.
I wish it be solved.
^ permalink raw reply [relevance 2%]
* Re: Need some light on using Ada or not
2011-02-21 12:52 2% ` Brian Drummond
2011-02-21 13:44 2% ` Simon Wright
@ 2011-02-22 2:15 1% ` Shark8
1 sibling, 0 replies; 200+ results
From: Shark8 @ 2011-02-22 2:15 UTC (permalink / raw)
On Feb 21, 4:52 am, Brian Drummond <brian_drumm...@btconnect.com>
wrote:
>
> As this is my first experiment with tasking, comments are welcome (and I'd be
> interested to see your version). If people think this is worth submitting to the
> shootout, I'll go ahead.
>
> - Brian
I used arrays for the most part, and then expanded it out to a
recursive-definition for the trees which would be too large for
the stack during creation.
It may be going against the spirit of the competition, but nothing
there said that we couldn't use arrays as binary-trees.
-- Package B_Tree
-- by Joey Fish
Package B_Tree is
-- Contest rules state:
-- define a tree node class and methods, a tree node record and
procedures,
-- or an algebraic data type and functions.
--
-- B_Tree is the definition of such a record and procedures.
Type Binary_Tree is Private;
Function Build_Tree (Item : Integer; Depth : Natural) Return
Binary_Tree;
Function Subtree (Tree : Binary_Tree; Left : Boolean) Return
Binary_Tree;
Function Item_Check (This : Binary_Tree) Return Integer;
Procedure Free (Tree : In Out Binary_Tree);
Private
Type Node_Data;
Type Data_Access is Access Node_Data;
SubType Not_Null_Data_Access is Not Null Data_Access;
Function Empty Return Not_Null_Data_Access;
Type Binary_Tree( Extension : Boolean:= False ) is Record
Data : Not_Null_Data_Access:= Empty;
End Record;
End B_Tree;
--- B_Trees body
with
Ada.Text_IO,
--Ada.Numerics.Generic_Elementary_Functions,
Unchecked_Deallocation;
Package Body B_Tree is
-- In some cases the allocataion of the array is too large, so we
can split
-- that off into another tree, for that we have Tree_Array, which
is a
-- Boolean-indexed array. {The Index is also shorthand for Is_left
on such.}
Type Tree_Array is Array (Boolean) of Binary_Tree;
-- For trees of up to 2**17 items we store the nodes as a simple
array.
Type Integer_Array is Array (Positive Range <>) of Integer;
Type Access_Integers is Access Integer_Array;
Type Node_Data(Extended : Boolean:= False) is Record
Case Extended is
When False => A : Not Null Access_Integers;
When True => B : Tree_Array;
end Case;
End Record;
-- Returns the Empty List's Data.
Function Empty Return Not_Null_Data_Access is
begin
Return New Node_Data'( A => New Integer_Array'(2..1 => 0),
Others => <> );
end Empty;
-- We'll need an integer-version of logrithm in base-2
Function lg( X : In Positive ) Return Natural is
--------------------------------------------
-- Base-2 Log with a jump-table for the --
-- range 1..2**17-1 and a recursive call --
-- for all values greater. --
--------------------------------------------
begin
Case X Is
When 2**00..2**01-1 => Return 0;
When 2**01..2**02-1 => Return 1;
When 2**02..2**03-1 => Return 2;
When 2**03..2**04-1 => Return 3;
When 2**04..2**05-1 => Return 4;
When 2**05..2**06-1 => Return 5;
When 2**06..2**07-1 => Return 6;
When 2**07..2**08-1 => Return 7;
When 2**08..2**09-1 => Return 8;
When 2**09..2**10-1 => Return 9;
When 2**10..2**11-1 => Return 10;
When 2**11..2**12-1 => Return 11;
When 2**12..2**13-1 => Return 12;
When 2**13..2**14-1 => Return 13;
When 2**14..2**15-1 => Return 14;
When 2**15..2**16-1 => Return 15;
When 2**16..2**17-1 => Return 16;
When Others => Return 16 + lg( X / 2**16 );
End Case;
end lg;
Function Build_Tree (Item : Integer; Depth : Natural) Return
Binary_Tree is
-- Now we need a function to allow the calculation of a node's
value
-- given that node's index.
Function Value( Index : Positive ) Return Integer is
Level : Integer:= lg( Index );
-- Note: That is the same as
-- Integer( Float'Truncation( Log( Float(Index),2.0 ) ) );
-- but without the Integer -> Float & Float -> Integer conversions.
begin
Return (-2**(1+Level)) + 1 + Index;
end;
Begin
If Depth < 17 then
Return Result : Binary_Tree do
Result.Data:= New Node_Data'
( A => New Integer_Array'(1..2**Depth-1 => <>), Others => <> );
For Index in Result.Data.A.All'Range Loop
Result.Data.All.A.All( Index ):= Value(Index) + Item;
End Loop;
End Return;
else
Return Result : Binary_Tree do
Result.Data:= New Node_Data'
( B =>
(True => Build_Tree(-1,Depth-1), False =>
Build_Tree(0,Depth-1)),
Extended => True );
End Return;
end if;
End Build_Tree;
Function Subtree (Tree : Binary_Tree; Left : Boolean) Return
Binary_Tree is
Begin
if Tree.Data.Extended then
-- If it is a large enough tree, then we already have it
split.
Return Tree.Data.B(Left);
else
-- If not then we just need to calculate the middle and
return the
-- proper half [excluding the first (root) node.
Declare
Data : Integer_Array Renames Tree.Data.All.A.All;
Data_Length : Natural:= Data'Length;
Mid_Point : Positive:= (Data_Length/2) + 1;
SubType LeftTree is Positive Range
Positive'Succ(1)..Mid_Point;
SubType RightTree is Positive Range
Positive'Succ(Mid_Point)..Data_Length;
Begin
Return Result : Binary_Tree Do
if Left then
Result.Data:= New Node_Data'
( A => New Integer_Array'( Data(LeftTree) ),
Others => <> );
else
Result.Data:= New Node_Data'
( A => New Integer_Array'( Data(RightTree) ),
Others => <> );
end if;
End Return;
End;
end if;
End Subtree;
Function Check_Sum( Data: In Integer_Array ) Return Integer is
Depth : Natural:= lg(Data'Length);
SubType Internal_Nodes is Positive Range 1..2**Depth-1;
begin
Return Result : Integer:= 0 do
For Index in Internal_Nodes Loop
Declare
Left : Positive:= 2*Index;
Right : Positive:= Left+1;
Begin
If Index mod 2 = 1 then
Result:= Result - Right + Left;
else
Result:= Result + Right - Left;
end if;
End;
End Loop;
End Return;
end Check_Sum;
Function Item_Check (This : Binary_Tree) Return Integer is
-- For large trees this function calls itself recursively until
the
-- smaller format is encountered; otherwise, for small trees, it
acts as
-- a pass-througn to Check_Sum.
Begin
If This.Data.Extended then
Declare
Begin
Return Result: Integer:= -1 do
Result:= Result
+ Item_Check( This.Data.B(False) )
- Item_Check( This.Data.B(True ) );
End Return;
End;
else
Declare
Data : Integer_Array Renames This.Data.All.A.All;
Begin
Return Check_Sum( Data );
End;
end if;
End Item_Check;
Procedure Free (Tree : In Out Binary_Tree) is
procedure Deallocate is new
Unchecked_Deallocation(Integer_Array, Access_Integers);
procedure Deallocate is new
Unchecked_Deallocation(Node_Data, Data_Access);
Procedure Recursive_Free (Tree : In Out Binary_Tree) is
begin
if Tree.Data.All.Extended then
Recursive_Free( Tree.Data.B(True ) );
Recursive_Free( Tree.Data.B(False) );
Declare
Data : Data_Access;
For Data'Address Use Tree.Data'Address;
Pragma Import( Ada, Data );
Begin
Deallocate(Data);
End;
else
Declare
Data : Data_Access;
For Data'Address Use Tree.Data.All.A'Address;
Pragma Import( Ada, Data );
Begin
Deallocate( Data );
Data:= Empty;
End;
end if;
end Recursive_Free;
begin
Recursive_Free( Tree );
Tree.Data:= Empty;
end Free;
Begin
Null;
End B_Tree;
-- BinaryTrees.adb
-- by Jim Rogers
-- modified by Joey Fish
With
B_Tree,
Ada.Text_Io,
Ada.Real_Time,
Ada.Command_Line,
Ada.Characters.Latin_1,
;
Use
B_Tree,
Ada.Text_Io,
Ada.Command_Line,
Ada.Integer_Text_Io,
Ada.Characters.Latin_1
;
procedure BinaryTrees is
--Depths
Min_Depth : Constant Positive := 4;
Max_Depth : Positive;
Stretch_Depth: Positive;
N : Natural := 1;
-- Trees
Stretch_Tree,
Long_Lived_Tree : Binary_Tree;
Check,
Sum : Integer;
Depth : Natural;
Iterations : Positive;
Package Fn is New
Ada.Numerics.Generic_Elementary_Functions( Float );
Function Value( Index : Positive ) Return Integer is
Level : Integer:=
Integer( Float'Truncation( Fn.Log( Float(Index),2.0 ) ) );
begin
Return (-2**(1+Level)) + 1 + Index;
end;
begin
-- For Index in 1..2**3-1 loop
-- Put_Line( Value(Index)'img );
-- end loop;
-- Declare
-- -- allocate new memory:
-- Short_Lived_Tree_1: Binary_Tree:= Build_Tree(0, 20);
-- Begin
-- Sum:= Item_Check (Short_Lived_Tree_1);
-- -- Check := Check + Sum;
-- -- Free( Short_Lived_Tree_1 );
-- Put(Check'Img);
-- End;
if Argument_Count > 0 then
N := Positive'Value(Argument(1));
end if;
Max_Depth := Positive'Max(Min_Depth + 2, N);
Stretch_Depth := Max_Depth + 1;
Stretch_Tree := Build_Tree(0, Stretch_Depth);
Check:= Item_Check(Stretch_Tree);
Put("stretch tree of depth ");
Put(Item => Stretch_Depth, Width => 1);
Put(Ht & " check: ");
Put(Item => Check, Width => 1);
New_Line;
Long_Lived_Tree := Build_Tree(0, Max_Depth);
Depth := Min_Depth;
while Depth <= Max_Depth loop
Iterations := 2**(Max_Depth - Depth + Min_Depth);
Check := 0;
for I in 1..Iterations loop
Declare
Short_Lived_Tree_1: Binary_Tree:= Build_Tree(I, Depth);
Begin
Sum:= Item_Check (Short_Lived_Tree_1);
Check := Check + Sum;
Free( Short_Lived_Tree_1 );
End;
Declare
Short_Lived_Tree_2: Binary_Tree:= Build_Tree(-I, Depth);
Begin
Sum:= Item_Check (Short_Lived_Tree_2);
Check := Check + Sum;
Free( Short_Lived_Tree_2 );
End;
end loop;
Put(Item => Iterations * 2, Width => 0);
Put(Ht & " trees of depth ");
Put(Item => Depth, Width => 0);
Put(Ht & " check: ");
Put(Item => Check, Width => 0);
New_Line;
Depth := Depth + 2;
end loop;
Put("long lived tree of depth ");
Put(Item => Max_Depth, Width => 0);
Put(Ht & " check: ");
check:= Item_Check(Long_Lived_Tree);
Put(Item => Check, Width => 0);
New_Line;
end BinaryTrees;
^ permalink raw reply [relevance 1%]
* Re: Need some light on using Ada or not
2011-02-21 12:52 2% ` Brian Drummond
@ 2011-02-21 13:44 2% ` Simon Wright
2011-02-22 2:15 1% ` Shark8
1 sibling, 0 replies; 200+ results
From: Simon Wright @ 2011-02-21 13:44 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 367 bytes --]
Brian Drummond <brian_drummond@btconnect.com> writes:
> As this is my first experiment with tasking, comments are welcome (and
> I'd be interested to see your version).
See end.
> If people think this is worth submitting to the shootout, I'll go
> ahead.
I think it definitely is: the only Ada code for binary-trees is
single-threaded, so looks needlessly poor.
[-- Attachment #2: simple multi-thread version of binary trees benchmark --]
[-- Type: text/plain, Size: 5283 bytes --]
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Modified by Simon Wright
----------------------------------------------------------------
with Tree_Nodes; use Tree_Nodes;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with System;
procedure Binarytrees is
Min_Depth : constant Positive := 4;
N : Natural := 1;
Stretch_Tree : Tree_Node;
Long_Lived_Tree : Tree_Node;
Max_Depth : Positive;
Stretch_Depth : Positive;
task type Check_Tree is
pragma Priority (System.Default_Priority - 1);
entry Start (Iterations : Positive; Depth : Positive);
entry Sum (Result : out Integer);
end Check_Tree;
task body Check_Tree is
Iterations : Positive;
Depth : Positive;
Tree : Tree_Node;
Check : Integer := 0;
begin
accept Start (Iterations : Positive; Depth : Positive) do
Check_Tree.Iterations := Iterations;
Check_Tree.Depth := Depth;
end Start;
for J in 1 .. Iterations loop
Tree := Bottom_Up_Tree (J, Depth);
Check := Check + Item_Check (Tree);
Delete_Tree (Tree);
Tree := Bottom_Up_Tree (-J, Depth);
Check := Check + Item_Check (Tree);
Delete_Tree (Tree);
end loop;
accept Sum (Result : out Integer) do
Result := Check;
end Sum;
end Check_Tree;
begin
if Argument_Count > 0 then
N := Positive'Value (Argument (1));
end if;
Max_Depth := Positive'Max (Min_Depth + 2, N);
Stretch_Depth := Max_Depth + 1;
Stretch_Tree := Bottom_Up_Tree (0, Stretch_Depth);
Put ("stretch tree of depth ");
Put (Item => Stretch_Depth, Width => 1);
Put (Ht & " check: ");
Put (Item => Item_Check (Stretch_Tree), Width => 1);
New_Line;
Delete_Tree (Stretch_Tree);
Long_Lived_Tree := Bottom_Up_Tree (0, Max_Depth);
declare
subtype Check_Trees_Array_Range
is Natural range 0 .. (Max_Depth - Min_Depth) / 2;
Check_Trees : array (Check_Trees_Array_Range) of Check_Tree;
function Depth (For_Entry : Check_Trees_Array_Range) return Natural
is
begin
return For_Entry * 2 + Min_Depth;
end Depth;
function Iterations (For_Entry : Check_Trees_Array_Range) return Positive
is
begin
return 2 ** (Max_Depth - Depth (For_Entry) + Min_Depth);
end Iterations;
begin
for D in Check_Trees'Range loop
Check_Trees (D).Start (Iterations => Iterations (D),
Depth => Depth (D));
end loop;
for D in Check_Trees'Range loop
Put (Item => Iterations (D) * 2, Width => 0);
Put (Ht & " trees of depth ");
Put (Item => Depth (D), Width => 0);
declare
Check : Integer;
begin
Check_Trees (D).Sum (Result => Check);
Put (Ht & " check: ");
Put (Item => Check, Width => 0);
end;
New_Line;
end loop;
end;
Put ("long lived tree of depth ");
Put (Item => Max_Depth, Width => 0);
Put (Ht & " check: ");
Put (Item => Item_Check (Long_Lived_Tree), Width => 0);
New_Line;
Delete_Tree (Long_Lived_Tree);
end BinaryTrees;
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Modified by Simon Wright
----------------------------------------------------------------
with Ada.Unchecked_Deallocation;
package body Tree_Nodes is
function Bottom_Up_Tree (Item : Integer; Depth : Natural) return Tree_Node
is
begin
if Depth > 0 then
return new Node'(Bottom_Up_Tree (2 * Item - 1, Depth - 1),
Bottom_Up_Tree (2 * Item, Depth - 1),
Item);
else
return new Node'(null, null, Item);
end if;
end Bottom_Up_Tree;
function Item_Check (This : Tree_Node) return Integer
is
begin
if This.Left = null then
return This.Item;
else
return This.Item + Item_Check (This.Left) - Item_Check (This.Right);
end if;
end Item_Check;
procedure Delete_Tree (This : in out Tree_Node)
is
procedure Free is new Ada.Unchecked_Deallocation (Node, Tree_Node);
begin
if This /= null then
Delete_Tree (This.Left);
Delete_Tree (This.Right);
Free (This);
end if;
end Delete_Tree;
end Tree_Nodes;
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Modified by Simon Wright
----------------------------------------------------------------
package Tree_Nodes is
type Tree_Node is private;
function Bottom_Up_Tree (Item : Integer; Depth : Natural) return Tree_Node;
function Item_Check (This : Tree_Node) return Integer;
procedure Delete_Tree (This : in out Tree_Node);
private
type Node;
type Tree_Node is access Node;
type Node is record
Left : Tree_Node;
Right : Tree_Node;
Item : Integer := 0;
end record;
end Tree_Nodes;
^ permalink raw reply [relevance 2%]
* Re: Need some light on using Ada or not
@ 2011-02-21 12:52 2% ` Brian Drummond
2011-02-21 13:44 2% ` Simon Wright
2011-02-22 2:15 1% ` Shark8
0 siblings, 2 replies; 200+ results
From: Brian Drummond @ 2011-02-21 12:52 UTC (permalink / raw)
On Sun, 20 Feb 2011 22:47:05 +0000, Simon Wright <simon@pushface.org> wrote:
>Brian Drummond <brian_drummond@btconnect.com> writes:
>
>> the 100% overhead (on this test case) imposed by the pthread library
>> (which I think is how Gnat implements its tasking)
>
>Here (Mac OS X, GCC 4.6.0 x86_64 experimental), I tried modifying the
>Ada code to use the same tasking (threading) structure as the C GNU GCC
>#5 version. Result (I only checked with parameter 16):
>
>C: real 5.1 user 9.0
>GNAT (orig): real 6.0 user 5.8
>GNAT (mod): real 5.3 user 9.4
>
>(the 'user' value, which is what time(1) reports, is apparently the
>total CPU time, while the 'real' time is the elapsed time; this machine
>has 2 cores, both it seems running at about 90% in the test).
So again, there is an overhead (maybe 80%) imposed by tasking, and significant
improvements won't appear until >2 processors.
I can't be sure I'm reading the C correctly, but it looks as if it's creating a
new pthread (task) for each depth step, similar to my first attempt.
I have now decoupled the number of tasks from the problem, to simplify
experiments with different numbers of tasks, and improve load balancing.
It runs approx. 4x as fast with 4 or 8 tasks as it does with 1 task (on a 4-core
machine!), therefore only about 2x as fast as it does without tasking.
As this is my first experiment with tasking, comments are welcome (and I'd be
interested to see your version). If people think this is worth submitting to the
shootout, I'll go ahead.
- Brian
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Tasking experiment : Brian Drummond
----------------------------------------------------------------
with Treenodes; use Treenodes;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Integer_Text_Io; use Ada.Integer_Text_Io;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
procedure Binarytrees_tasking is
-- Change "CPUs" to control number of tasks created
CPUs : constant Positive := 8;
BlockSize : Positive;
Min_Depth : constant Positive := 4;
N : Natural := 1;
Stretch_Tree : TreeNode;
Long_Lived_Tree : TreeNode;
Max_Depth : Positive;
Stretch_Depth : Positive;
Iteration : Positive;
Iterations : Positive;
Sum : Integer;
Check : Integer;
Depth : Natural;
task type check_this_depth is
entry Start(Iteration, Size : Positive; To_Depth :in Natural);
entry Complete(Result : out Integer);
end check_this_depth;
task body check_this_depth is
Check : Integer;
Sum : Integer;
Depth : Natural;
First : Positive;
Last : Positive;
Short_Lived_Tree_1 : TreeNode;
Short_Lived_Tree_2 : TreeNode;
begin
loop
select
accept Start(Iteration, Size : Positive; To_Depth :in Natural) do
First := Iteration;
Last := Iteration + Size - 1;
Depth := To_Depth;
end Start;
Check := 0;
for I in First .. Last loop
Short_Lived_Tree_1 := Bottom_Up_Tree(Item => I, Depth => Depth);
Short_Lived_Tree_2 := Bottom_Up_Tree(Item =>-I, Depth => Depth);
Item_Check(Short_Lived_Tree_1, Sum);
Check := Check + Sum;
Item_Check(Short_Lived_Tree_2, Sum);
Check := Check + Sum;
end loop;
accept Complete(Result : out Integer) do
Result := Check;
end Complete;
or
Terminate;
end select;
end loop;
end check_this_depth;
subtype Task_Count is positive range 1 .. CPUs;
Tasks : array (Task_Count) of check_this_depth;
begin
if Argument_Count > 0 then
N := Positive'Value(Argument(1));
end if;
Max_Depth := Positive'Max(Min_Depth + 2, N);
Stretch_Depth := Max_Depth + 1;
Stretch_Tree := Bottom_Up_Tree(0, Stretch_Depth);
Item_Check(Stretch_Tree, Check);
Put("stretch tree of depth ");
Put(Item => Stretch_Depth, Width => 1);
Put(Ht & " check: ");
Put(Item => Check, Width => 1);
New_Line;
Long_Lived_Tree := Bottom_Up_Tree(0, Max_Depth);
Depth := Min_Depth;
while Depth <= Max_Depth loop
Iterations := 2**(Max_Depth - Depth + Min_Depth);
Check := 0;
-- Setup tasking parameters for reasonable task granularity
-- Too large and we can't balance CPU loads
-- Too small and we waste time in task switches
-- Not very critical - anything more complex is probably a waste of effort
BlockSize := 2**10;
if Iterations < BlockSize * CPUs then
BlockSize := 1;
end if;
-- Check that Iterations is a multiple of Blocksize * CPUs
-- Error out otherwise (dealing with remainder is trivial but tedious)
Pragma Assert(Iterations mod( BlockSize * CPUs) = 0,
"Iteration count not supported!");
-- for I in 1..Iterations loop
Iteration := 1;
while Iteration <= Iterations loop
for j in Task_Count loop
Tasks(j).Start(Iteration, Blocksize, Depth);
Iteration := Iteration + BlockSize;
end loop;
for j in Task_Count loop
Tasks(j).Complete(Sum);
Check := Check + Sum;
end loop;
end loop;
Put(Item => Iterations * 2, Width => 0);
Put(Ht & " trees of depth ");
Put(Item => Depth, Width => 0);
Put(Ht & " check: ");
Put(Item => Check, Width => 0);
New_Line;
Depth := Depth + 2;
end loop;
Put("long lived tree of depth ");
Put(Item => Max_Depth, Width => 0);
Put(Ht & " check: ");
Item_Check(Long_Lived_Tree, Check);
Put(Item => Check, Width => 0);
New_Line;
end BinaryTrees_tasking;
^ permalink raw reply [relevance 2%]
* Re: Need some light on using Ada or not
@ 2011-02-20 14:34 2% ` Brian Drummond
0 siblings, 1 reply; 200+ results
From: Brian Drummond @ 2011-02-20 14:34 UTC (permalink / raw)
On Sat, 19 Feb 2011 18:25:44 +0000, Brian Drummond
<brian_drummond@btconnect.com> wrote:
>On Sat, 19 Feb 2011 15:36:45 +0100, Georg Bauhaus
><rm-host.bauhaus@maps.futureapps.de> wrote:
>
>>On 2/19/11 2:07 PM, Brian Drummond wrote:
>>> On 18 Feb 2011 22:52:38 GMT, "Luis P. Mendes"<luislupeXXX@gmailXXX.com> wrote:
>>
>>>> I have some questions, however, that I'd like to be answered:
>>>> 1. If Ada is more type safe and restricted than C++, how can it be
>>>> significantly slower?
>>> Two possible reasons; both come down to the relative number of people developing
>>> for both languages.
[using tasking for the binary_trees benchmark, which currently uses a single
task...]
>>I vaguely remember that it has been tried before, but so far there
>>is no better solution.
>I have broken down and finally started to learn Ada's tasking. So far I have
>gone from 56s (CPU) 56s (elapsed) with one task, to 120s (CPU), 64s(elapsed)
>with multiple tasks (on a smallish 2-core laptop)...
>
>Disappointing.
>
>(If anybody's interested, I am using 9 tasks, one per "Depth" value in the main
>while loop.
Further odd results. I re-structured the tasking so that I could modify the
number of tasks, from 1, 2, 4, etc. The "CPU" utilisation remains virtually
identical, at 2 minutes; the elapsed time is 2 minutes with 1 task, or 1 minute
with 2 or more (on a 2-core laptop. I'll report on a 4-core later).
Moving from GCC4.5.0 (FSF) to Adacore Libre 2010 makes no significant
difference. (OpenSuse 11.3, 64-bit, 2-core laptop)
Doubling the CPU time with a single task is suspicious, so I tried the following
experiment : source code below - main program only. For the rest, and the
original version, see
http://shootout.alioth.debian.org/u64q/performance.php?test=binarytrees
I removed virtually the entire body of the program into a single task.
This change alone doubles the "CPU" time. There appears to be a 100% penalty
associated simply with running the original program from within a second task.
Anyone see what I'm doing wrong?
Any pitfalls to using tasking that I may have missed?
I suspect storage [de]allocation since that's under stress in this test, and
other benchmarks (e.g. Mandelbrot) don't see this penalty.
Should the task have its own separate storage pool, to avoid difficulties
synchronising with the main pool (even though the main program no longer uses
it?
----------------------------------------------------------------
-- BinaryTrees experimental version
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Tasking experiment: Brian Drummond
----------------------------------------------------------------
with Treenodes; use Treenodes;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Integer_Text_Io; use Ada.Integer_Text_Io;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
procedure Binarytrees_tasktest is
N : Natural := 1;
task the_work is
entry Start(Count :in Natural);
entry Complete;
end the_work;
task body the_work is
Min_Depth : constant Positive := 4;
Stretch_Tree : TreeNode;
Long_Lived_Tree : TreeNode;
Short_Lived_Tree_1 : TreeNode;
Short_Lived_Tree_2 : TreeNode;
Max_Depth : Positive;
Stretch_Depth : Positive;
Check : Integer;
Sum : Integer;
Depth : Natural;
Iterations : Positive;
begin
accept Start(Count :in Natural) do
N := Count;
end Start;
Max_Depth := Positive'Max(Min_Depth + 2, N);
Stretch_Depth := Max_Depth + 1;
Stretch_Tree := Bottom_Up_Tree(0, Stretch_Depth);
Item_Check(Stretch_Tree, Check);
Put("stretch tree of depth ");
Put(Item => Stretch_Depth, Width => 1);
Put(Ht & " check: ");
Put(Item => Check, Width => 1);
New_Line;
Long_Lived_Tree := Bottom_Up_Tree(0, Max_Depth);
Depth := Min_Depth;
while Depth <= Max_Depth loop
Iterations := 2**(Max_Depth - Depth + Min_Depth);
Check := 0;
for I in 1..Iterations loop
Short_Lived_Tree_1 := Bottom_Up_Tree(Item => I, Depth => Depth);
Short_Lived_Tree_2 := Bottom_Up_Tree(Item =>-I, Depth => Depth);
Item_Check(Short_Lived_Tree_1, Sum);
Check := check + Sum;
Item_Check(Short_Lived_Tree_2, Sum);
Check := Check + Sum;
end loop;
Put(Item => Iterations * 2, Width => 0);
Put(Ht & " trees of depth ");
Put(Item => Depth, Width => 0);
Put(Ht & " check: ");
Put(Item => Check, Width => 0);
New_Line;
Depth := Depth + 2;
end loop;
Put("long lived tree of depth ");
Put(Item => Max_Depth, Width => 0);
Put(Ht & " check: ");
Item_Check(Long_Lived_Tree, Check);
Put(Item => Check, Width => 0);
New_Line;
accept Complete;
end the_work;
begin
if Argument_Count > 0 then
N := Positive'Value(Argument(1));
end if;
the_work.start(N);
the_work.complete;
end BinaryTrees_tasktest;
------------------------------------------------------
^ permalink raw reply [relevance 2%]
* Re: GPS 4.4.1. ADA 95: Calling ASCII codes for ESC and display row colum control
2011-01-10 14:19 0% ` Dmitry A. Kazakov
@ 2011-01-10 19:29 0% ` Michael A
0 siblings, 0 replies; 200+ results
From: Michael A @ 2011-01-10 19:29 UTC (permalink / raw)
On Jan 10, 9:19 am, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:
> On Mon, 10 Jan 2011 05:44:19 -0800 (PST), Michael A wrote:
> > I know this topic was disucssed in the 90's on the forum and is an old
> > question, but. I am trying to control the display row,col for terminal
> > output of my ADA 95 simple program. I have tried several ways but to
> > no avail:
>
> > -- keep out put of a loop at line 20 column 20
>
> > put (ASCII.ESC & "[" & "20" & ";" & "20" & "H") ;
>
> > put (ASCII.ESC&"[20;20H") ;
> > put (ada.Characters.latin_1.ESC&"20"&";"&"20H");
>
> > put (Character'val (91) & "20;20H" );
>
> > I get the literal out put on the screen " <-20;20H " but not keeping
> > the output on line 20, col 20.
>
> > I do get put(ascii.bel); to ring the bell OK.
>
> What makes you think that GPS' run-panel emulates VT100?
>
> And, is it the GPS GUI where your output goes?
>
> Anyway GPS is GTK-based. Presumably, it uses the GTK text buffer object
> where the program standard output goes. So you should look here:
>
> http://www.adacore.com/wp-content/files/auto_update/gtkada-docs/gtkad...
>
> to learn for how to control it and its view:
>
> http://www.adacore.com/wp-content/files/auto_update/gtkada-docs/gtkad...
>
> If you mean something else, like console output, then depending on the OS
> and the terminal emulator you might need different control sequences. If
> you want to use the VT100 ones, you should get a VT100 emulator.
>
> BTW, Windows' cmd.exe does not emulate VT100.
>
> --
> Regards,
> Dmitry A. Kazakovhttp://www.dmitry-kazakov.de- Hide quoted text -
>
> - Show quoted text -
Thanks. My output is not to the GPS GUI but to a Windows command
window. I suspected the controls could be different in different
enviornments. I will check out your recommendations.
Tks
^ permalink raw reply [relevance 0%]
* Re: GPS 4.4.1. ADA 95: Calling ASCII codes for ESC and display row colum control
2011-01-10 13:44 2% GPS 4.4.1. ADA 95: Calling ASCII codes for ESC and display row colum control Michael A
@ 2011-01-10 14:19 0% ` Dmitry A. Kazakov
2011-01-10 19:29 0% ` Michael A
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2011-01-10 14:19 UTC (permalink / raw)
On Mon, 10 Jan 2011 05:44:19 -0800 (PST), Michael A wrote:
> I know this topic was disucssed in the 90's on the forum and is an old
> question, but. I am trying to control the display row,col for terminal
> output of my ADA 95 simple program. I have tried several ways but to
> no avail:
>
> -- keep out put of a loop at line 20 column 20
>
> put (ASCII.ESC & "[" & "20" & ";" & "20" & "H") ;
>
> put (ASCII.ESC&"[20;20H") ;
> put (ada.Characters.latin_1.ESC&"20"&";"&"20H");
>
> put (Character'val (91) & "20;20H" );
>
> I get the literal out put on the screen " <-20;20H " but not keeping
> the output on line 20, col 20.
>
> I do get put(ascii.bel); to ring the bell OK.
What makes you think that GPS' run-panel emulates VT100?
And, is it the GPS GUI where your output goes?
Anyway GPS is GTK-based. Presumably, it uses the GTK text buffer object
where the program standard output goes. So you should look here:
http://www.adacore.com/wp-content/files/auto_update/gtkada-docs/gtkada_rm/gtkada_rm/gtk-text_buffer.ads.html
to learn for how to control it and its view:
http://www.adacore.com/wp-content/files/auto_update/gtkada-docs/gtkada_rm/gtkada_rm/gtk-text_view.ads.html
If you mean something else, like console output, then depending on the OS
and the terminal emulator you might need different control sequences. If
you want to use the VT100 ones, you should get a VT100 emulator.
BTW, Windows' cmd.exe does not emulate VT100.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* GPS 4.4.1. ADA 95: Calling ASCII codes for ESC and display row colum control
@ 2011-01-10 13:44 2% Michael A
2011-01-10 14:19 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Michael A @ 2011-01-10 13:44 UTC (permalink / raw)
I know this topic was disucssed in the 90's on the forum and is an old
question, but. I am trying to control the display row,col for terminal
output of my ADA 95 simple program. I have tried several ways but to
no avail:
-- keep out put of a loop at line 20 column 20
put (ASCII.ESC & "[" & "20" & ";" & "20" & "H") ;
put (ASCII.ESC&"[20;20H") ;
put (ada.Characters.latin_1.ESC&"20"&";"&"20H");
put (Character'val (91) & "20;20H" );
I get the literal out put on the screen " <-20;20H " but not keeping
the output on line 20, col 20.
I do get put(ascii.bel); to ring the bell OK.
Thanks
^ permalink raw reply [relevance 2%]
* Re: Access Type
2010-12-24 17:30 0% ` Robert A Duff
@ 2010-12-24 20:59 2% ` kug1977
0 siblings, 0 replies; 200+ results
From: kug1977 @ 2010-12-24 20:59 UTC (permalink / raw)
> > this drives me crazy, because it makes me think that I don't get this
> > access concept in Ada ... hope someone can help here.
>
> Leave out the (1..5), and let the compiler count
> how long it is. You're asking for a bug here --
> you might count wrong.
Good advise. It's a better job for the compile to count. Tend to be
inattentively in programming. That's why I like Ada most of the
time. ;-)
> And you forgot "constant", both on the access type, and on the object.
type t_OFW_Service_Name is array (Positive range <>) of Character;
type t_OFW_Service_Name_Access is access constant
t_OFW_Service_Name;
open_SERVICE_NAME : aliased constant t_OFW_Service_Name := "open" &
Ada.Characters.Latin_1.NUL;
Now, the compiler stops teasing me. Need the array of Character for a
while, but will change it later to an new type of t_ofw_byte.
> > 4. In my Ada-function, I use record-set like this
>
> > type Ci_Args is record
> > Service : t_OFW_Service_Name_Access;
> > end record;
> > Arg : Ci_Args;
>
> > which I fill like this
>
> > Arg.Service := boot_Service_Name'Access;
>
> You might want to use an aggregate to fill it in.
> That way, the compiler will make sure you didn't
> miss any components.
One more thing learned today. I was looking for a construct makes sure
the compiler gets me, if I forget a component. So, that's the way.
> Your type says "range <>", so it's unconstrained.
> Your object says (1..5), so it has an explicit constraint.
> You are not allowed to take 'Access of an object with
> an explicit constraint, and returning an access to
> unconstrained array. Some people think that's a language
> design flaw. They are probably right. You are not the
> first person to be surprised and confused by this rule.
>
> Anyway, the workaround is to remove the constraint,
> which isn't needed anyway. The compiler said
> "declare without bounds", and that's what it means.
> All array objects are constrained in Ada,
> if not explicitly, then by the initial value.
I was thinking, I've to bound the unconstrained array, but never get
it, that the initial value will bound it. Pointers are an obstacle for
most newbies and it takes some time to understand the principle in the
first time. Now I've to learn it the Ada-way ...
> Another thing you need to look out for: If you are
> passing this data to some other language (like C),
> you need to make sure the representations match.
> See pragma Import and Convention. By default, GNAT
> will represent an access-to-String as a fat pointer,
> which won't match the C side.
I will pass this to Openfirmware which is like a 32-bit C. So I use
type Ci_Args is record
Service : t_OFW_Service_Name_Access;
...
end record;
pragma Convention (C, Ci_Args); -- represent CI_Args as a C-
style struct
Arg : Ci_Args;
I hope this will prevent the compiler from using something else than a
32-bit Address
for the Service entry.
Thanks Bob for helping me out. Have nice holidays.
- kug1977
^ permalink raw reply [relevance 2%]
* Re: Access Type
2010-12-24 16:36 2% Access Type kug1977
@ 2010-12-24 17:30 0% ` Robert A Duff
2010-12-24 20:59 2% ` kug1977
0 siblings, 1 reply; 200+ results
From: Robert A Duff @ 2010-12-24 17:30 UTC (permalink / raw)
kug1977 <kug1977@web.de> writes:
> this drives me crazy, because it makes me think that I don't get this
> access concept in Ada ... hope someone can help here.
>
> 1. I've a Ada-function which use a string for calling a service, say
> "open". This strings have to be LATIN1, so I've a type for this
>
> type t_OFW_Service_Name is array (Positive range <>) of
> Character;
You could use String here. Or if you prefer a new type,
you could say:
type t_OFW_Service_Name is new String;
> 2. The calling Ada-function have to use a pointer to this array, to
> call this function, so I use
>
> type t_OFW_Service_Name_Access is access t_OFW_Service_Name;
>
> 3. As this strings are all constant over the live-time of the
> programm, I want them declare as a private constant like this
>
> open_SERVICE_NAME : aliased t_OFW_Service_Name (1 .. 5) :=
> "open" & Ada.Characters.Latin_1.NUL;
Leave out the (1..5), and let the compiler count
how long it is. You're asking for a bug here --
you might count wrong.
And you forgot "constant", both on the access type,
and on the object.
> 4. In my Ada-function, I use record-set like this
>
> type Ci_Args is record
> Service : t_OFW_Service_Name_Access;
> Num_Of_Args : Cell;
> Num_Of_Ret_Vals : Cell;
> Boot_Specifiers : System.Address;
> end record;
> Arg : Ci_Args;
>
> which I fill like this
>
> Arg.Service := boot_Service_Name'Access;
You might want to use an aggregate to fill it in.
That way, the compiler will make sure you didn't
miss any components.
> Compilation failed with the following messages:
>
> - object subtype must statically match designated subtype
> - warning: aliased object has explicit bounds
> - warning: declare without bounds (and with explicit initialization)
> - warning: for use with unconstrained access
>
> Brings me to the following questions.
> - what mean this warnings and errors?
Your type says "range <>", so it's unconstrained.
Your object says (1..5), so it has an explicit constraint.
You are not allowed to take 'Access of an object with
an explicit constraint, and returning an access to
unconstrained array. Some people think that's a language
design flaw. They are probably right. You are not the
first person to be surprised and confused by this rule.
Anyway, the workaround is to remove the constraint,
which isn't needed anyway. The compiler said
"declare without bounds", and that's what it means.
All array objects are constrained in Ada,
if not explicitly, then by the initial value.
Another thing you need to look out for: If you are
passing this data to some other language (like C),
you need to make sure the representations match.
See pragma Import and Convention. By default, GNAT
will represent an access-to-String as a fat pointer,
which won't match the C side.
- Bob
^ permalink raw reply [relevance 0%]
* Access Type
@ 2010-12-24 16:36 2% kug1977
2010-12-24 17:30 0% ` Robert A Duff
0 siblings, 1 reply; 200+ results
From: kug1977 @ 2010-12-24 16:36 UTC (permalink / raw)
Hi,
this drives me crazy, because it makes me think that I don't get this
access concept in Ada ... hope someone can help here.
1. I've a Ada-function which use a string for calling a service, say
"open". This strings have to be LATIN1, so I've a type for this
type t_OFW_Service_Name is array (Positive range <>) of
Character;
2. The calling Ada-function have to use a pointer to this array, to
call this function, so I use
type t_OFW_Service_Name_Access is access t_OFW_Service_Name;
3. As this strings are all constant over the live-time of the
programm, I want them declare as a private constant like this
open_SERVICE_NAME : aliased t_OFW_Service_Name (1 .. 5) :=
"open" & Ada.Characters.Latin_1.NUL;
4. In my Ada-function, I use record-set like this
type Ci_Args is record
Service : t_OFW_Service_Name_Access;
Num_Of_Args : Cell;
Num_Of_Ret_Vals : Cell;
Boot_Specifiers : System.Address;
end record;
Arg : Ci_Args;
which I fill like this
Arg.Service := boot_Service_Name'Access;
Compilation failed with the following messages:
- object subtype must statically match designated subtype
- warning: aliased object has explicit bounds
- warning: declare without bounds (and with explicit initialization)
- warning: for use with unconstrained access
Brings me to the following questions.
- what mean this warnings and errors?
- how can I point to a constant string.
- Is there a easy to read tutorial about Pointers in Ada?
Thanks for your help.
kug1977
^ permalink raw reply [relevance 2%]
* Re: Introducing memcache-ada, a memcached client in Ada
@ 2010-12-20 8:25 2% ` Thomas Løcke
0 siblings, 0 replies; 200+ results
From: Thomas Løcke @ 2010-12-20 8:25 UTC (permalink / raw)
On 2010-12-20 01:43, R Tyler Croy wrote:
>
> My first "real" project in Ada has been a memcached client written in Ada:
> <https://github.com/rtyler/memcache-ada>
>
> Right now it has basic functionality of being able to "get" a key, "set" a
> value, "delete" a value and increment/decrement values.
>
> There's still a few functions unimplemented, but I think it's in a usable state
> right now.
>
> I look forward to any comments or suggestions as to the code
> quality/structure.
Hey,
It looks pretty good to me.
I do though have four suggestions:
1. Declare all the string literals ("STORED", "NOT_FOUND" and such) as
constants in the specification.
2. Get rid of the ASCII.x and use Ada.Characters.Latin_1 instead. The
ASCII package is considered obsolescent. Oh, and perhaps declare the
ASCII.CR & ASCII.LF combo as a CRLF constant also?
3. Take a look at the various search subprograms in Ada.Strings.Fixed
and Ada.Strings.Unbounded. Some of them might be able to replace a loop
here or there.
4. Place your subprograms in alphabetical order. Actually, that might
just be me, but it hurts my eyes seeing Append_CRLF down there at the
bottom. :D
I can't comment on the actual functionality of the program, as I've
never used memcached, but at a quick glance everything looks very neat
and tidy.
As far as I can tell from the repo, you've only been at this since early
November. If this is your first ever Ada project, then I'd say you're a
pretty damn fast learner! I'm only a little jealous.
--
Regards,
Thomas L�cke
Email: tl at ada-dk.org
Web: http:ada-dk.org
IRC nick: ThomasLocke
^ permalink raw reply [relevance 2%]
* Re: how to i get the type of a parameter specification is ASIS
@ 2010-10-25 13:32 2% ` stuart clark
0 siblings, 0 replies; 200+ results
From: stuart clark @ 2010-10-25 13:32 UTC (permalink / raw)
On Oct 25, 10:24 pm, Julian Leyh <jul...@vgai.de> wrote:
> On 25 Okt., 15:12, stuart clark <clark.stuart...@gmail.com> wrote:
>
>
>
> > On Oct 25, 10:07 pm, Julian Leyh <jul...@vgai.de> wrote:
>
> > > On 25 Okt., 13:55, stuart clark <clark.stuart...@gmail.com> wrote:
>
> > > > 1) i am getting the parameter_specification using
>
> > > > params : Asis.Parameter_Specification_List :=
> > > > asis.Declarations.Parameter_Profile
> > > > (element);
>
> > > > 2) from params i am getting the parameter name using
>
> > > > names: asis.Defining_Name_list :=
> > > > asis.declarations.Names(params(i));
>
> > > > 3) i am also getting the parameter mode_kind using
>
> > > > mode_kind : Asis.Mode_Kinds :=
> > > > asis.elements.mode_kind
> > > > (params(i));
>
> > > > it looks like this
>
> > > > param = b : in out float
> > > > name = b
> > > > mode kind = AN_IN_OUT_MODE
>
> > > > but i also want the type of the parameter, eg float.
>
> > > > anybody know how ???
>
> > > from AdaBrowse source:
>
> > > declare
> > > Params : constant Parameter_Specification_List :=
> > > Parameter_Profile (Decl);
> > > begin
> > > for I in Params'Range loop
> > > declare
> > > T : constant Type_Descriptor :=
> > > Type_Of (Declaration_Subtype_Mark (Params (I)));
> > > begin
> > > if T.Attrs = No_Attributes and then
> > > Is_Equal (T.Decl, The_Type)
> > > then
> > > return True;
> > > end if;
> > > end;
> > > end loop;
> > > end;
>
> > thanks but which package is type_descriptor from ???
>
> Oh, sorry... Type_Descriptor and Type_Of are from AdaBrowse... You
> could have a look at the body of Type_Of to find out how they did it.
>
> AdaBrowse:http://home.tiscalinet.ch/t_wolf/tw/ada95/adabrowse/
this works...
declare
x: Asis.Expression :=
asis.declarations.Declaration_Subtype_Mark
(Params (I));
begin
ada.Text_IO.Put_Line("type = " &
ada.characters.Handling.To_String
(asis.Text.Element_Image(x)));
end;
thanks heaps, i've been doing it the dumb way, ie parsing strings
searching/deleting/using :in out etc.
^ permalink raw reply [relevance 2%]
* Re: warning "blah" is an Ada 2005 unit
2010-10-24 4:51 3% warning "blah" is an Ada 2005 unit stuart clark
2010-10-24 5:54 0% ` Anh Vo
@ 2010-10-24 11:30 0% ` anon
1 sibling, 0 replies; 200+ results
From: anon @ 2010-10-24 11:30 UTC (permalink / raw)
In <b6b6497d-76c2-4222-a359-1651ff9172e9@k14g2000pre.googlegroups.com>, stuart clark <clark.stuart.au@gmail.com> writes:
>i have the gpl 2010 compiler and when i with sat
>ada.characters.conversions i get a compiler warning
>ada.characters.conversions is an Ada 2005 unit.
>
>is there some switch which allows me to use 2005 units or is the gpl
>2010 only Ada95 ???
There is no Ada 2010 specs.
Switches:
-gnat83 or statement "pragma Ada_83;" for Ada 83
Default fort all GCC GNAT Ada Compilers
-gnat95 or statement "pragma Ada_95;" for Ada 95
-gnat05 or statement "pragma Ada_05;" or
"pragma Ada_2005;" for Ada 2005
Specs not offically adopted, yet!
-gnat12 or statement "pragma Ada_12;" or
"pragma Ada_2012;" for Ada 2012
^ permalink raw reply [relevance 0%]
* Re: warning "blah" is an Ada 2005 unit
2010-10-24 4:51 3% warning "blah" is an Ada 2005 unit stuart clark
@ 2010-10-24 5:54 0% ` Anh Vo
2010-10-24 11:30 0% ` anon
1 sibling, 0 replies; 200+ results
From: Anh Vo @ 2010-10-24 5:54 UTC (permalink / raw)
On Oct 23, 9:51 pm, stuart clark <clark.stuart...@gmail.com> wrote:
> i have the gpl 2010 compiler and when i with sat
> ada.characters.conversions i get a compiler warning
> ada.characters.conversions is an Ada 2005 unit.
>
> is there some switch which allows me to use 2005 units or is the gpl
> 2010 only Ada95 ???
Use switch -gnat95 for Ada 95 and -gnat05 for Ada 2005.
Anh Vo
^ permalink raw reply [relevance 0%]
* warning "blah" is an Ada 2005 unit
@ 2010-10-24 4:51 3% stuart clark
2010-10-24 5:54 0% ` Anh Vo
2010-10-24 11:30 0% ` anon
0 siblings, 2 replies; 200+ results
From: stuart clark @ 2010-10-24 4:51 UTC (permalink / raw)
i have the gpl 2010 compiler and when i with sat
ada.characters.conversions i get a compiler warning
ada.characters.conversions is an Ada 2005 unit.
is there some switch which allows me to use 2005 units or is the gpl
2010 only Ada95 ???
^ permalink raw reply [relevance 3%]
* Re: Wrong program structure
2010-10-23 21:08 2% Wrong program structure George
@ 2010-10-23 21:16 0% ` Vinzent Hoefler
0 siblings, 0 replies; 200+ results
From: Vinzent Hoefler @ 2010-10-23 21:16 UTC (permalink / raw)
On Sat, 23 Oct 2010 23:08:32 +0200, George <mail2george@gmx-topmail.de> wrote:
> GNAT is complaining about "begin" being used as identifier and a missing
> "begin" for procedure "keywords4". The progam structure is like this:
>
[...]
> begin
> -- Ada.Command_Line.Argument_Count is "0" if
> -- a) Command_Line.Argument_Count is not implemented (Compiler, OS)
> -- b) no arguments given
> if Ada.Command_Line.Argument_Count > 0 then
> for counter in 1..Ada.Command_Line.Argument_Count loop
> declare
> Arg : constant String := Ada.Characters.Handling.To_Upper
> (Ada.Command_Line.Argument(counter));
begin
> -- some commands
end;
> end loop;
> else -- if Argument_Count = 0 print help
> -- some commands
> end if;
> end keywords4;
You are declaring a block, but its "end" is missing.
Vinzent.
--
There is no signature.
^ permalink raw reply [relevance 0%]
* Wrong program structure
@ 2010-10-23 21:08 2% George
2010-10-23 21:16 0% ` Vinzent Hoefler
0 siblings, 1 reply; 200+ results
From: George @ 2010-10-23 21:08 UTC (permalink / raw)
Hi All,
GNAT is complaining about "begin" being used as identifier and a missing
"begin" for procedure "keywords4". The progam structure is like this:
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Characters.Handling;
procedure keywords4 is
procedure Ada83 is
begin
-- some string output
end Ada83;
procedure Ada95 is
begin
-- some string output
end Ada95;
procedure Ada2005 is
begin
-- some string output
end Ada2005;
procedure Attributes is
begin
-- some string output
end Attributes;
procedure Sources is
begin
-- some string output
end Sources;
procedure Author is
begin
-- some string output
end Author;
begin
-- Ada.Command_Line.Argument_Count is "0" if
-- a) Command_Line.Argument_Count is not implemented (Compiler, OS)
-- b) no arguments given
if Ada.Command_Line.Argument_Count > 0 then
for counter in 1..Ada.Command_Line.Argument_Count loop
declare
Arg : constant String := Ada.Characters.Handling.To_Upper
(Ada.Command_Line.Argument(counter));
-- some commands
end loop;
else -- if Argument_Count = 0 print help
-- some commands
end if;
end keywords4;
I nested the procedures Ada83, Ada95, etc. into keywords4 because I can
not have multiple compilation units. I tried defining a package but when
executing the program the runtime library came back with the message that
the code could not be executed.
Maybe I am asking simple questions. Its because I am new to Ada and try
get used to the language.
What is the problem with the above code?
Regards
George
^ permalink raw reply [relevance 2%]
* Re: Problems with String processing
2010-10-23 20:16 3% Problems with String processing George
2010-10-23 20:24 2% ` Niklas Holsti
@ 2010-10-23 20:25 2% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2010-10-23 20:25 UTC (permalink / raw)
On 23 Oct 2010 20:16:53 GMT, George wrote:
> begin
> -- Ada.Command_Line.Argument_Count is "0" if
> -- a) Command_Line.Argument_Count is not implemented (Compiler, OS)
> -- b) no arguments given
> if Ada.Command_Line.Argument_Count > 0 then
> for counter in 1..Ada.Command_Line.Argument_Count loop
declare
Arg : constant String := Ada.Characters.Handling.
To_Upper (Ada.Command_Line.Argument (Counter));
begin
> if Arg = "ADA83" then
> Ada83;
> elsif Arg = "ADA95" then
> Ada95;
> elsif Arg = "ADA2005" then
> Ada2005;
> elsif Arg = "ATTRIBUTES" then
> Attributes;
> elsif Arg = "ALL" then
> Ada83;
> Ada95;
> Ada2005;
> Attributes;
> Sources;
> Author;
> else -- unknown argument
> Ada.Text_IO.put_line("Given Argument is unknown!");
> end if;
end;
> end loop;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Problems with String processing
2010-10-23 20:16 3% Problems with String processing George
@ 2010-10-23 20:24 2% ` Niklas Holsti
2010-10-23 20:25 2% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Niklas Holsti @ 2010-10-23 20:24 UTC (permalink / raw)
George wrote:
> Hi All,
>
> I have some problems with string processing. My program looks like this:
>
> begin
> -- Ada.Command_Line.Argument_Count is "0" if
> -- a) Command_Line.Argument_Count is not implemented (Compiler, OS)
> -- b) no arguments given
> if Ada.Command_Line.Argument_Count > 0 then
> for counter in 1..Ada.Command_Line.Argument_Count loop
> Arg = Ada.Characters.Handling.To_Upper(Ada.Command_Line.Argument
> (counter)); -- this assignment is the problem
Firstly, that isn't an assignment, since you wrote "=". You should write
":=" for an assignment.
Secondly, as you have now learned, the Ada String type is a fixed-length
string. The simplest solution is to declare the Arg variable as a
constant String that is given its value (and length) in the declaration
itself:
declare
Arg : constant String := Ada.Characters.Handling.To_Upper (
Ada.Command_Line.Argument (counter));
begin
> if Arg = "ADA83" then
> Ada83;
> elsif Arg = "ADA95" then
> Ada95;
> elsif Arg = "ADA2005" then
> Ada2005;
> elsif Arg = "ATTRIBUTES" then
> Attributes;
> elsif Arg = "ALL" then
> Ada83;
> Ada95;
> Ada2005;
> Attributes;
> Sources;
> Author;
> else -- unknown argument
> Ada.Text_IO.put_line("Given Argument is unknown!");
> end if;
end;
> end loop;
>
> The assignment Arg = Ada.Characters.Handling.To_Upper
> (Ada.Command_Line.Argument(counter)); will not work due to a CONSTRAINT
> ERROR. The problem is that the command line arguments given are of
> different length. Ada expects the string to match exactly the length of
> the defined variable "Arg" with 10 characters.
>
> How could I solve that problem?
Another solution is to use Ada.Strings.Unbounded.Unbounded_String, which
is the main Ada type for variable-length strings.
HTH,
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 2%]
* Problems with String processing
@ 2010-10-23 20:16 3% George
2010-10-23 20:24 2% ` Niklas Holsti
2010-10-23 20:25 2% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: George @ 2010-10-23 20:16 UTC (permalink / raw)
Hi All,
I have some problems with string processing. My program looks like this:
begin
-- Ada.Command_Line.Argument_Count is "0" if
-- a) Command_Line.Argument_Count is not implemented (Compiler, OS)
-- b) no arguments given
if Ada.Command_Line.Argument_Count > 0 then
for counter in 1..Ada.Command_Line.Argument_Count loop
Arg = Ada.Characters.Handling.To_Upper(Ada.Command_Line.Argument
(counter)); -- this assignment is the problem
if Arg = "ADA83" then
Ada83;
elsif Arg = "ADA95" then
Ada95;
elsif Arg = "ADA2005" then
Ada2005;
elsif Arg = "ATTRIBUTES" then
Attributes;
elsif Arg = "ALL" then
Ada83;
Ada95;
Ada2005;
Attributes;
Sources;
Author;
else -- unknown argument
Ada.Text_IO.put_line("Given Argument is unknown!");
end if;
end loop;
The assignment Arg = Ada.Characters.Handling.To_Upper
(Ada.Command_Line.Argument(counter)); will not work due to a CONSTRAINT
ERROR. The problem is that the command line arguments given are of
different length. Ada expects the string to match exactly the length of
the defined variable "Arg" with 10 characters.
How could I solve that problem?
Regards
George
^ permalink raw reply [relevance 3%]
* Re: What about a glob standard method in Ada.Command_Line ?
@ 2010-08-25 8:57 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2010-08-25 8:57 UTC (permalink / raw)
On 8/25/10 9:55 AM, Dmitry A. Kazakov wrote:
>>> Does the wildcard pattern "R*"
>>
>> In what RE syntax?
>
> It is a wildcard pattern. Wildcards is the most frequently used pattern
> language.
Does "wildcard" include both Latin-xyz character � and UTF-8 �?
Yes. Many Wildcards do. And it can be handled.
See whether or not encoding matters in the following program.
with GNAT.SPITBOL.Patterns; use GNAT.SPITBOL.Patterns;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
procedure Find_Ruecken (Text : String; Result : VString_Var) is
In_UTF_8 : constant String := (Character'Val(16#c3#),
Character'Val(16#bc#));
Ue : Pattern;
begin
Ue := (Any("Rr") & (In_UTF_8 or LC_U_Diaeresis) & "cken") ** Result;
if not Match (Text, Ue) then
raise Constraint_Error;
end if;
end Find_Ruecken;
with GNAT.SPITBOL; use GNAT.SPITBOL;
with Ada.Text_IO;
with Find_Ruecken;
procedure Test_Find_Ruecken is
Found : VString;
begin
Find_Ruecken(Text => "Recken, die R�cken ohne R�ckgrat dr�cken",
Result => Found);
Ada.Text_IO.Put_Line ("Found """ & S(Found) & '"');
end Test_Find_Ruecken;
>> > match "readme"? Does it match "R�cken", when
>>> � is (16#c3#, 16#bc#) (UTF-8)?
>>
>> When the Pattern_Type is properly defined, there are no questions.
>
> How do define it properly? Does it match Latin-1's �, UTF-8's �, UTF-16's
> �, UTF-32's �? Don't you get that it cannot be done without abstracting
> *encoding* away?
When the Pattern_Type is properly defined, there are no questions.
Since I have to process a lot of text file and text streams
of unknown encoding, I'm used to REs that just find "R�cken"
in whatever encoding. That's called programming. Think of Google
or Yahoo or Bing searching the WWW and tons of email ...
There is no such thing as clean external data.
That including file names.
Georg
^ permalink raw reply [relevance 2%]
* Re: S-expression I/O in Ada
@ 2010-08-19 17:59 2% ` Jeffrey Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2010-08-19 17:59 UTC (permalink / raw)
On 08/19/2010 01:09 AM, Natasha Kerensikova wrote:
>
> And now I have just had a look at GNAT FSF (v4.4) implementation, and
> there is a normal array assignment, which I guess triggers an assignment
> of each item, which in our case (record containing a Vector) triggers a
> deep copy. Or am I wrong here?
>
> So it seems a simple Vector.Append call might trigger a copy of the
> entire S-expression, which makes a strong point for the linked-list,
> doesn't it?
Yes, an Append to a Vector might trigger several recursive calls to Vector
assignment. If using a Vector is clearer than using a list, that may offset any
advantage of using a list. Since this is a general, reusable package,
"efficiency" is not a real concern: projects with special requirements usually
shouldn't use general packages and need special versions of such things to meet
their requirements.
> And indeed, your implementation was the first I understood almost
> completely, but I can't tell how much is due to your clarity intend and
> how much is due to having already tried to write one.
Having tried to write one probably helped.
> I'm still wondering which is better between vector and array. I thought
> a vector could be easily be turned into an array, hence my initial
> choice of arrays, but it seems there is no such vector primitive in
> A.18.2. Another tough choice...
Yes, that was a mistake, IMO. An unbounded-array abstraction should have
operations to convert to and from the fixed equivalent, like To_String and
To_Unbounded_String in Ada.Strings.Unbounded (which is a special case of
Vectors; Ada.Characters.Vectors, anyone?).
> Is there any other (perhaps more difficult for a beginner) way to
> address that issue?
That's hardly simple for a beginner. Another way is to use explicit access
values (and types, though some would prefer the more C-like use of anonymous
access types). I prefer to avoid explicit access types and values whenever
possible, and it's clearly possible here.
--
Jeff Carter
"That was the most fun I've ever had without laughing."
Annie Hall
43
--- news://freenews.netfront.net/ - complaints: news@netfront.net ---
^ permalink raw reply [relevance 2%]
* Re: Unbounded String to string
@ 2010-06-29 15:08 3% ` Ludovic Brenta
0 siblings, 0 replies; 200+ results
From: Ludovic Brenta @ 2010-06-29 15:08 UTC (permalink / raw)
tonyg wrote on comp.lang.ada:
> On 29 June, 15:33, Adam Beneschan <a...@irvine.com> wrote:
>> On Jun 29, 7:28 am, tonyg <tonytheg...@googlemail.com> wrote:
>
>>> Hi,
>>> I have an unbounded string from a database I want to turn into a 16
>>> character subtype of string
>>>
>>> i.e. unbounded_string to string(1..16)
>>>
>>> I've been trying to do this most of the afternoon but keep getting
>>> errors
>>>
>>> anyone know how ?
>
>> Declare a subtype to give string(1..16) a name; then call To_String
>> (in Ada.Strings.Unbounded) and convert the function result to your
>> subtype. E.g.:
>>
>> subtype String_Length_16 is string(1..16);
>> V : String_Length_16;
>>
>> V := String_Length_16 (Ada.Strings.Unbounded.To_String (U));
That solution only works if U happens to contain exactly 16
characters, which is probably not the case if the database really
contains unbounded strings (i.e. VARCHAR or similar). So what you
probably need is something more elaborate along the lines of:
function To_String_16 (U : Ada.Strings.Unbounded.Unbounded_String)
return String_16 is
Temp : constant String := Ada.Strings.Unbounded.To_String (U);
Result : String_16;
begin
Ada.Strings.Fixed.Move (Source => Temp, Target => Result, Drop =>
Ada.Strings.Right,
Justify => Ada.Strings.Left, Pad => Ada.Characters.Space);
return Result;
end To_String_16;
(some parameters of Ada.Strings.Fixed.Move have defaults; I spelled
all them out for clarity at the expense of conciseness).
--
Ludovic Brenta.
^ permalink raw reply [relevance 3%]
* Funny thing with GNAT Socket?
@ 2009-11-12 19:28 2% mockturtle
0 siblings, 0 replies; 200+ results
From: mockturtle @ 2009-11-12 19:28 UTC (permalink / raw)
Dear all,
I have a strange problem (which, actually, is a problem only because I
have to use a buggy server) with the following code that sends an HTTP
request to the port 3000 of localhost (server and program run on the
same PC)
-------
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets; use GNAT.Sockets;
with Ada.Streams; use Ada.Streams;
with Ada.Characters.Latin_1;
procedure main is
Sock : Socket_Type;
Server : Sock_Addr_Type := (Family => Family_Inet,
Addr => Inet_Addr("127.0.0.1"),
Port => Port_Type(3000));
Basic_Stream : Stream_Access;
Query : String := "GET /p2p.rb?
stream=pippo&command=join_user&user=127.0.0.1:48946:3 HTTP/1.1";
Crlf : String := Ada.Characters.Latin_1.CR &
Ada.Characters.Latin_1.LF;
Host_name : String := "Host: 127.0.0.1:3000";
begin
Create_Socket (Sock);
Connect_Socket (Sock, Server);
Basic_Stream := Stream (Sock);
String'Write(Basic_Stream, Query);
String'Write(Basic_Stream, Crlf);
String'Write(Basic_Stream, Host_Name);
String'Write(Basic_Stream, Crlf);
String'Write(Basic_Stream, Crlf);
end main;
------
If I compile the code at home and check the traffic with tcpdump, I
can see that each strings is transmited in a packet by itself.
If I compile the code above at work, I see that the strings are
transmitted one char per packet (i.e., first a packet with "G", then a
packet with "E", and so on...) . It seems that the server does not
like this and it closes the connection without replying. However,
sometime (in a random fashion) after sending few single char packets,
it send the remainder of the string in a single packet. In this case
the server replies.
[Yes, the server is buggy since it should not care... Anyway, that is
what I have to use. Before you object, it is just to carry out some
fast-and-dirty tests, so it does not matter much if the system is a
little "brittle".].
We tried several tests. For example, if we use C (I'll have to whash
my keyboard with soap... ;-) or Ruby, each string is sent in a packet
by itself, both at home and at work. I am beginning to think that
this is something in the GNAT library and how it interfaces with BSD
sockets.
Ideas?
My environments:
Work : GPS 4.3.1 and GNAT 4.3.2 (from "About"), Linux 2.6.something
Home: GPS 4.3.1 and GNAT GPL 2009 (20090519), Linux 2.4.26
Thank you in advance.
^ permalink raw reply [relevance 2%]
* Re: Types, packages & objects : the good old naming conventions question (without religious ware)
@ 2009-10-30 0:01 2% ` Robert A Duff
0 siblings, 0 replies; 200+ results
From: Robert A Duff @ 2009-10-30 0:01 UTC (permalink / raw)
Georg Bauhaus <rm.dash-bauhaus@futureapps.de> writes:
>... For example, the role
> can be given as "just any object" of the type. I would not be
> comfortable with such an answer...
In some cases, "just any object" is the right answer.
No need for discomfort.
For example, parameters of general-purpose procedures.
function To_Upper(X: String) return String;
-- Convert X to upper case.
There's nothing interesting to say about X, except that
it's a String. Just any String. Trying to come up with
a meaningful name for X will just generate noise.
In the standard package Ada.Characters.Handling, it's
called Item, which is no more meaningful than X.
In the GNAT front end, there are huge numbers of parameters
declared as:
N : Node_Id
- Bob
^ permalink raw reply [relevance 2%]
* Re: Howto read line from a stream
2009-06-03 15:49 0% ` Tomek Wałkuski
@ 2009-06-03 19:07 0% ` sjw
0 siblings, 0 replies; 200+ results
From: sjw @ 2009-06-03 19:07 UTC (permalink / raw)
On Jun 3, 4:49 pm, Tomek Wałkuski <tomek.walku...@gmail.com> wrote:
> On 1 Cze, 02:05, "Jeffrey R. Carter"<spam.jrcarter....@nospam.acm.org> wrote:
> > I might do something like
>
> > function Get_Line (Channel : in Stream_Access) return String is
> > Char : Character;
> > begin -- Get_Line
> > Character'Read (Channel, Char);
>
> > if Char = Ada.Characters.Latin_1.LF then
> > return String'(1 => Char);
> > else
> > return Char & Get_Line (Channel);
> > end if;
> > end Get_Line;
>
> How to measure which solution (mine or yours) is faster?
Under many modern OSs Ada.Calendar.Clock will give you microsecond
accuracy.
But if you are dealing with character i/o I hardly think it matters!
Jeffrey's solution may take quite a bit of stack, if that's an issue.
^ permalink raw reply [relevance 0%]
* Re: Howto read line from a stream
2009-06-01 0:05 2% ` Jeffrey R. Carter
@ 2009-06-03 15:49 0% ` Tomek Wałkuski
2009-06-03 19:07 0% ` sjw
0 siblings, 1 reply; 200+ results
From: Tomek Wałkuski @ 2009-06-03 15:49 UTC (permalink / raw)
On 1 Cze, 02:05, "Jeffrey R. Carter"
<spam.jrcarter....@nospam.acm.org> wrote:
> I might do something like
>
> function Get_Line (Channel : in Stream_Access) return String is
> Char : Character;
> begin -- Get_Line
> Character'Read (Channel, Char);
>
> if Char = Ada.Characters.Latin_1.LF then
> return String'(1 => Char);
> else
> return Char & Get_Line (Channel);
> end if;
> end Get_Line;
>
How to measure which solution (mine or yours) is faster?
^ permalink raw reply [relevance 0%]
* Re: Howto read line from a stream
@ 2009-06-01 0:05 2% ` Jeffrey R. Carter
2009-06-03 15:49 0% ` Tomek Wałkuski
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2009-06-01 0:05 UTC (permalink / raw)
Tomek Wałkuski wrote:
> I have done so far:
>
> function Read_Line (Channel : in Stream_Access) return String is
> Buffer : String (1 .. 1);
> Result : Unbounded_String;
> begin
> loop
> String'Read (Channel, Buffer);
> Append (Result, Buffer);
> exit when Buffer (1) = ASCII.LF;
> end loop;
> return To_String(Result);
> end Read_Line;
I might do something like
function Get_Line (Channel : in Stream_Access) return String is
Char : Character;
begin -- Get_Line
Character'Read (Channel, Char);
if Char = Ada.Characters.Latin_1.LF then
return String'(1 => Char);
else
return Char & Get_Line (Channel);
end if;
end Get_Line;
This is easily extended if needed to ensure that the terminating LF follows a CR.
--
Jeff Carter
"Have you gone berserk? Can't you see that that man is a ni?"
Blazing Saddles
38
^ permalink raw reply [relevance 2%]
* Re: Weird string I/O problem
@ 2008-12-03 9:16 3% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2008-12-03 9:16 UTC (permalink / raw)
-- Adam.
--
-- The reason I used the "exit when char = CR or char = LF ;"
-- statement was to allow the program to work in both Linux and
-- Windows environment without modification.
-- Also, A.10 (8). states the creator of this implementation
-- can define the terminators or EOL. So, I just used the OS
-- defined in two standard OS.
-- And the reason I forgot the ";", well it was a typo. And those who
-- says they do not make typos is a person that is not trust worthy!
--
-- For christoph.grein
-- Better re-read RM A.10.7. It does not say what you think it does.
--
-- Now A.9(8) should be A.10.8. And it says that it is up to the
-- author's implementation to define the terminators. Normally
-- that is defined by the OS and hardware, but it can be redefined
-- by the author code.
--
-- Full Working Example:
--
-- This version contains the orginal core code that I posted with some
-- extra code on the outside of the core, plus some extra comments.
--
--
-- Build your own input routine. Example:
--
with Ada.Characters.Latin_1 ; -- Needed for control chars.
use Ada.Characters.Latin_1 ;
with Ada.Text_IO ;
use Ada.Text_IO ;
procedure t is
--
-- Is control character codes in a String illegal or is it legal? That
-- is up to the user of this routine. But the code is easy to adapt to
-- the users needs.
--
-- This routine does not handle other control codes except EOL which
-- is defined by either LF or CR/LF. This allows one to insert the
-- BEL control character into the inputed string, then later it can be
-- printed or removed by other routines.
-- Exceptions: 1. Control C is handled by OS.
-- 2. Some characters like BS (8) may be stored in the
-- string while others characters like TAB (9) may
-- be expanded, depending on OS or BIOS.
--
-- Returns String: On EOL or
-- the number of non-expanded keystokes > 79
--
function Get ( P : String ) return String is
char : character ;
input_string : String ( 1..80 ) ;
last : natural ;
procedure Get ( C : out character ) is
begin
loop
Get_Immediate ( C ) ;
exit when C /= NUL ;
end loop ;
Put ( C ) ;
end Get ;
begin
Put ( P ) ;
input_string := ( others => nul ) ;
for index in input_string'Range loop -- limits data size
Get ( char ) ;
-- Traps both LF or CR/LF type of EOL
exit when char = CR or char = LF ;
input_string ( index ) := char ;
Last := Index ;
end loop ;
if char = CR then -- for CR/LF pairing type of OSs
Get ( char ) ;
end if ;
if char = LF or Last = input_string'Last then -- process EOL on screen
New_Line ;
end if ;
-- valid data is input_string ( 1 .. last ) ;
-- with no term control characters like LF or CR
return ( input_string ( 1 .. last ) ) ;
end get ;
begin
Put_Line ( Get ( ">> " ) ) ;
end t ;
In <184a2bfd-4d95-434b-91e0-64c8f869e8b7@r15g2000prh.googlegroups.com>, Adam Beneschan <adam@irvine.com> writes:
>On Dec 1, 11:53 pm, christoph.gr...@eurocopter.com wrote:
>> On 2 Dez., 07:55, a...@anon.org (anon) wrote:
>>
>> > Have you ever learn, you do not give the complete code, because too many
>> > students like to steal code for there grade.
>>
>> > So, you ONLY give enough code for the person to use the code to
>> > build his own. And that's what i did!
>>
>> anon pretending educational intentions presents wrong code. What a
>> nice fellow!
>>
>> for index in input_string'Range loop
>> ... Here get the next char from the input stream.
>> ... Be careful, there might be control characters.
>> ... See Ada.Text_IO for appropriate subprograms.
>> exit when char = CR or char = LF ; -- not all OSes treat end of
>> lines like this
>> this is why there are
>> End_of_Line queries
>> input_string ( index ) := char ;
>> Last := Index ;
>> end loop;
>>
>> This would be the way, I guess.
>
>Also make sure it works when the user enters an empty string. Aside
>from the error of trying to test characters for CR and LF, and the
>issue that it wouldn't even work on an OS that returns *both* CR and
>LF in sequence, when the above code is executed multiple times to
>input multiple lines, there's a nasty bug (in anon's original code)
>that will show up when the input is an empty string.
>
>In other words, even from an educational standpoint, the original code
>seems more useful as a "Can you spot all the errors in this?" exercise
>than as something to help a student get started building his or her
>own. (And yes, I did catch the missing semicolon after "end loop".)
>Kind of reminds me of an old MAD Magazine puzzle where they showed you
>a picture that had everything possible wrong with it (including an
>upside-down sign that said MAD IS NOT FUNNY), and asked "What's wrong
>with this picture"? On the answer page, it simply said "Better you
>should ask, what's RIGHT with this picture"?
>
> -- Adam
>
^ permalink raw reply [relevance 3%]
* Re: Weird string I/O problem
2008-12-02 5:44 0% ` christoph.grein
@ 2008-12-02 6:55 0% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2008-12-02 6:55 UTC (permalink / raw)
Have you ever learn, you do not give the complete code, because too many
students like to steal code for there grade.
So, you ONLY give enough code for the person to use the code to
build his own. And that's what i did!
And what of your answer!
In <6d9d4120-3af9-42c6-b3e9-768418948084@t3g2000yqa.googlegroups.com>, christoph.grein@eurocopter.com writes:
>On 1 Dez., 20:47, a...@anon.org (anon) wrote:
>> --
>> -- Build your own input routine. =A0Example:
>> --
>> with Ada.Characters.Latin_1 ; -- Needed for control chars.
>> use Ada.Characters.Latin_1 ;
>>
>> -- ...
>> =A0 char : character ;
>> =A0 input_string : String ( 1..80 ) ;
>> =A0 last : natural ;
>>
>> -- ...
>>
>> input_string :=3D ( others =3D> nul ) ;
>> for index in input_string'Range loop
>> =A0 Get ( char ) ;
>> =A0 exit when char =3D CR or char =3D LF ;
>
>Does anon ever read the RM? See A.10.7(1..3):
>After skipping any line terminators and any page terminators, reads
>the next character from the
>specified input file and returns the value of this character in the
>out parameter Item.
>
>Also A.9(8): Effect of input (Get) ... of control characters ... is
>not specified.
>
>This tries to do what Get_Line is for - and is wrong!
>
>> =A0 input_string ( index ) :=3D char ;
>> =A0 Last :=3D Index ; =A0
>> end loop
>>
>> =A0 -- valid data is input_string ( 1 .. last ) ; with no term control ch=
>aracters
>>
>> -- ...
^ permalink raw reply [relevance 0%]
* Re: Weird string I/O problem
2008-12-01 19:47 3% ` anon
@ 2008-12-02 5:44 0% ` christoph.grein
2008-12-02 6:55 0% ` anon
0 siblings, 1 reply; 200+ results
From: christoph.grein @ 2008-12-02 5:44 UTC (permalink / raw)
On 1 Dez., 20:47, a...@anon.org (anon) wrote:
> --
> -- Build your own input routine. Example:
> --
> with Ada.Characters.Latin_1 ; -- Needed for control chars.
> use Ada.Characters.Latin_1 ;
>
> -- ...
> char : character ;
> input_string : String ( 1..80 ) ;
> last : natural ;
>
> -- ...
>
> input_string := ( others => nul ) ;
> for index in input_string'Range loop
> Get ( char ) ;
> exit when char = CR or char = LF ;
Does anon ever read the RM? See A.10.7(1..3):
After skipping any line terminators and any page terminators, reads
the next character from the
specified input file and returns the value of this character in the
out parameter Item.
Also A.9(8): Effect of input (Get) ... of control characters ... is
not specified.
This tries to do what Get_Line is for - and is wrong!
> input_string ( index ) := char ;
> Last := Index ;
> end loop
>
> -- valid data is input_string ( 1 .. last ) ; with no term control characters
>
> -- ...
^ permalink raw reply [relevance 0%]
* Re: Weird string I/O problem
@ 2008-12-01 19:47 3% ` anon
2008-12-02 5:44 0% ` christoph.grein
1 sibling, 1 reply; 200+ results
From: anon @ 2008-12-01 19:47 UTC (permalink / raw)
--
-- Build your own input routine. Example:
--
with Ada.Characters.Latin_1 ; -- Needed for control chars.
use Ada.Characters.Latin_1 ;
-- ...
char : character ;
input_string : String ( 1..80 ) ;
last : natural ;
-- ...
input_string := ( others => nul ) ;
for index in input_string'Range loop
Get ( char ) ;
exit when char = CR or char = LF ;
input_string ( index ) := char ;
Last := Index ;
end loop
-- valid data is input_string ( 1 .. last ) ; with no term control characters
-- ...
In <c6f5748b-923f-4077-b33e-a5017309ac46@w39g2000prb.googlegroups.com>, Jerry <lanceboyle@qwest.net> writes:
>The following program misbehaves if the line
>
> Get(A_Float); -- PROBLEMATIC LINE
>
>is present; the call to Get_Line is made but there is no opportunity
>for the user to enter a string--the program continues (I suppose) as
>though the user entered a line terminator, causing the following
>output:
>
> Enter a float: 12.3
> Enter a string: Hello from Get_Line.
> Your string was
> It was 0 long.
>
>However, if the problematic line is commented out, the following
>occurs:
>
> Enter a float: Enter a string: Hello from Get_Line.
> bla bla
> Your string was bla bla
> It was 7 long.
>
>Here is the program:
>
>
>
>with
> Ada.Text_IO,
> Ada.Float_Text_IO,
> Ada.Strings.Unbounded;
>use
> Ada.Text_IO,
> Ada.Float_Text_IO,
> Ada.Strings.Unbounded;
>
>procedure temp1 is
>
> -- Crude Get_Line for unbounded strings.
> procedure Get_Line(An_Unbounded_String : out Unbounded_String) is
> Max_Length : Integer := 256;
> A_String : String(1 .. Max_Length);
> Length : Integer;
> begin
> Put_Line("Hello from Get_Line.");
> Get_Line(A_String, Length);
> An_Unbounded_String := To_Unbounded_String(A_String(1 ..
>Length));
> end Get_Line;
>
> UBS : Unbounded_String;
> A_Float : Float;
>
>begin
> Put("Enter a float: ");
> Get(A_Float); -- PROBLEMATIC LINE
> Put("Enter a string: ");
> Get_Line(UBS);
> Put_Line("Your string was " & To_String(UBS));
> Put_Line("It was" & Length(UBS)'img & " long.");
>end temp1;
>
>
>What is going on here? I am running GNAT 4.3 on OS X 10.4.
>
>Jerry
>
^ permalink raw reply [relevance 3%]
* Re: Directory Operations
@ 2008-11-04 14:44 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2008-11-04 14:44 UTC (permalink / raw)
On Tue, 4 Nov 2008 04:57:17 -0800 (PST), AndreiK wrote:
> On 3 яПНяПНяПНяПН, 19:33, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
> wrote:
>
>> 2. Should you keep it non-Ada, then
>>
>> 2.a. how is this supposed to work?
>> 2.b. Where is the string allocated?
>> 2.c. Who will dispose it? When?
>> 2.d. What happens when called from multiple threads?
>
> Yes I have to keep it in non-Ada, more exact I have to use it in the
> "NI LabVIEW"
> 2.a The LabVIEW calls the functions from DLL.
> 2.b,c LabVIEW allocates the string.
> 2.d --- I don't now
In this case it should be something like this. LabVIEW passes a buffer to
Ada (Path, equivalent to char *), and the length of the buffer (Length).
Then
with Ada.Characters.Latin_1;
with Ada.Directories; use Ada.Directories;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
procedure Pwd (Path : chars_ptr; Length : size_t) is
Result : constant String := Current_Directory &
Ada.Characters.Latin_1.NUL;
begin
if Result'Length > Length then
... -- What do you do when the buffer is too short?
else
Update (Path, 0, Result, False);
end if;
end Pwd;
From C it is called like:
{
char buffer [1024];
pwd (buffer, sizeof (buffer));
...
}
However, you should really refer to LabVIEW documentation regarding the way
it passes strings around. Once you know it, you can interface Ada. The code
above is merely a wild guess about how the interface might look like.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: determining input data type
@ 2008-10-18 18:54 3% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2008-10-18 18:54 UTC (permalink / raw)
--
-- Without knowing what format your data is in it is kind of
-- hard to decide what way is the best. Some ways are easy
-- while others are more complex
--
-- But if the data is a packed buffer string then you could use
-- Ada.Characters.Handling.Is_Digit.
--
-- In this case the best was is to use a loop and search for all
-- valid data where the search routine would find the integer
-- value and no error occurs unless the data is float. Also in this
-- example, only base 10 integers are valid.
--
with Ada.Text_IO ;
use Ada.Text_IO ;
with Ada.Integer_Text_IO ;
use Ada.Integer_Text_IO ;
with Ada.Characters.Handling ;
use Ada.Characters.Handling ;
procedure b is
Data_Error : exception ;
function To_Integer ( Buffer : String ) return Integer is
Index : Natural ;
First : Natural ; -- first valid digit
Last : Natural ; -- Last valid digit
begin -- To_Integer
Index := Buffer'First ;
while Index <= Buffer'Last and then
not is_digit ( Buffer ( Index ) ) loop
Index := Index + 1 ;
end loop ;
First := Index ;
while Index <= Buffer'Last and then
is_digit ( Buffer ( Index ) ) loop
Index := Index + 1 ;
end loop ;
Last := Index - 1 ;
-- check for decimal point aka the number is float
if Index <= Buffer'Last and then
Buffer ( Index ) = '.' then
raise Data_Error ;
end if ;
return Integer'Value ( Buffer ( First..Last ) ) ;
exception
when Data_Error =>
Put_Line ( "Data was invalid -- need to check data source" ) ;
Put_Line ( "Invalid Data element =>" & Buffer ( Index ) ) ;
raise ;
end To_Integer ;
Data : integer ;
begin -- b
Data := To_Integer ( " =123;" ) ;
Put ( "Data => " ) ;
Put ( Data ) ;
New_Line ;
-- Data_Error is raised
Data := To_Integer ( "asv456" ) ;
Put ( "Data => " ) ;
Put ( Data ) ;
New_Line ;
-- Data_Error is raised
Data := To_Integer ( " =789.;" ) ;
Put ( "Data => " ) ;
Put ( Data ) ;
New_Line ;
exception
when Data_Error =>
null ;
end b ;
In <d39e1918-0c74-40b5-860d-f8d93181afd2@p59g2000hsd.googlegroups.com>, jedivaughn <jedivaughn14@gmail.com> writes:
>Hi, How is the best way to determine the type of input. I have the
>input coming in through a string but if the contents of the string is
>an integer then I want to convert it to such. This seems like it
>should be very easy to do but I can't seem to find out how to do it
>any where.
>
>
>Thanks,
>
>John
^ permalink raw reply [relevance 3%]
* Gnade/ODBC example - please help
@ 2008-08-01 12:18 1% azdakiel
0 siblings, 0 replies; 200+ results
From: azdakiel @ 2008-08-01 12:18 UTC (permalink / raw)
Hi,
I'm new here. I also just started my advanture with ADA.
I'm building a portal using AWS (my project for university) and i
need to connect to a MySQL database. I using Gnade/ODBC interface.
There is simple example, in the Gnade User's Guide, how to connect
and get some data from databese. And it works.
And now my problem: This example shows how to pass integer parameter
to the query and get string and float from the database.
I trying to pass to the query string and the boolean (...WHERE NAME =
name AND IsVisible = visible...) and I can't. I have no idea how to
rewrite this example.
Is there anyone who can tell me how to change this example?
---------------=========The Example========------------
with Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
with GNU.DB.SQLCLI; use GNU.DB.SQLCLI;
with GNU.DB.SQLCLI.Bind;
with GNU.DB.SQLCLI.Info; use GNU.DB.SQLCLI.Info;
with GNU.DB.SQLCLI.Info.Debug;
with GNU.DB.SQLCLI.Environment_Attribute;
use GNU.DB.SQLCLI.Environment_Attribute;
with GNU.DB.SQLCLI.Environment_Attribute.Debug;
with GNU.DB.SQLCLI.Connection_Attribute;
use GNU.DB.SQLCLI.Connection_Attribute;
with GNU.DB.SQLCLI.Connection_Attribute.Debug;
use GNU.DB.SQLCLI;
with GNAT.Traceback.Symbolic;
procedure odbc_mysql is
package RIO is new Ada.Text_IO.Float_IO (SQLDOUBLE);
EnvironmentHandle : SQLHENV;
ConnectionHandle : SQLHDBC;
ServerName : constant String := String'("test");
UserName : constant String := String'("test");
Authentication : constant String := String'("test");
Quoting_Character : Character := Character'Val (34);
function QuoteIdentifier (ID : String) return String;
procedure Get_Identifier_Info;
function QuoteIdentifier (ID : String) return String is
begin
return Quoting_Character & ID & Quoting_Character;
end QuoteIdentifier;
pragma Inline (QuoteIdentifier);
procedure Get_Identifier_Info is
QC : constant Driver_Info_String :=
Driver_Info_String (SQLGetInfo
(ConnectionHandle,
SQL_IDENTIFIER_QUOTE_CHAR));
begin
if QC.Value'Length /= 1 then
null;
else
Quoting_Character := QC.Value (QC.Value'First);
end if;
end Get_Identifier_Info;
begin
SQLAllocHandle (SQL_HANDLE_ENV, SQL_NULL_HANDLE,
EnvironmentHandle);
SQLSetEnvAttr (EnvironmentHandle,
Environment_Attribute_ODBC_Version'
(Attribute => SQL_ATTR_ODBC_VERSION,
Value => SQL_OV_ODBC3));
SQLAllocHandle (SQL_HANDLE_DBC, EnvironmentHandle,
ConnectionHandle);
SQLConnect (ConnectionHandle => ConnectionHandle,
ServerName => ServerName,
UserName => UserName,
Authentication => Authentication);
Get_Identifier_Info;
declare
package Double_Binding is new
GNU.DB.SQLCLI.FloatBinding (SQLDOUBLE);
package DB renames Double_Binding;
type ManagerID is new SQLINTEGER;
type ManagerID_Ptr is access all ManagerID;
package ManagerID_Binding is new
GNU.DB.SQLCLI.Bind (ManagerID, ManagerID_Ptr);
package MB renames ManagerID_Binding;
StatementHandle : SQLHSTMT;
Search_Manager : aliased ManagerID := 2;
Len : aliased SQLINTEGER := 0;
Name : aliased String := 20 * '.';
Firstname : aliased String := 20 * '.';
Len_Firstname : aliased SQLINTEGER;
Len_Name : aliased SQLINTEGER;
Len_Salary : aliased SQLINTEGER;
Salary : aliased SQLDOUBLE;
begin
SQLAllocHandle (SQL_HANDLE_STMT, ConnectionHandle,
StatementHandle);
SQLPrepare (StatementHandle,
"SELECT " & QuoteIdentifier ("NAME") & ", " &
QuoteIdentifier ("FIRSTNAME") & ", " &
QuoteIdentifier ("SALARY") &
" FROM " & QuoteIdentifier ("EMPLOYEES") & " " &
"WHERE " & QuoteIdentifier ("MANAGER") & " = ? "
&
"ORDER BY " & QuoteIdentifier ("NAME") & "," &
QuoteIdentifier ("FIRSTNAME"));
MB.SQLBindParameter
(StatementHandle => StatementHandle,
ParameterNumber => 1,
InputOutputType => SQL_PARAM_INPUT,
ValueType => SQL_C_SLONG,
ParameterType => SQL_INTEGER,
ColumnSize => 0,
DecimalDigits => 0,
Value => Search_Manager'Access,
BufferLength => 0,
StrLen_Or_IndPtr => Len'Access);
SQLBindCol
(StatementHandle, 1, Name'Access, Len_Name'Access);
SQLBindCol (StatementHandle, 2, Firstname'Access,
Len_Firstname'Access);
DB.SQLBindCol (StatementHandle, 3, Salary'Access,
Len_Salary'Access);
SQLExecute (StatementHandle);
begin
loop
SQLFetch (StatementHandle);
SQLFixNTS (Name, Len_Name);
SQLFixNTS (Firstname, Len_Firstname);
Put (Name);
Put (", ");
Put (Firstname);
Put (", ");
RIO.Put (Item => Salary, Fore => 5, Aft => 2, Exp => 0);
New_Line;
end loop;
exception
when No_Data =>
null;
end;
end;
SQLCommit (ConnectionHandle);
SQLDisconnect (ConnectionHandle);
SQLFreeHandle (SQL_HANDLE_DBC, ConnectionHandle);
SQLFreeHandle (SQL_HANDLE_ENV, EnvironmentHandle);
end odbc_mysql;
======================================================
Thanks,
Hubert Walter
^ permalink raw reply [relevance 1%]
* Re: Converting Type Characters to type string
@ 2008-03-31 8:54 2% ` Ludovic Brenta
0 siblings, 0 replies; 200+ results
From: Ludovic Brenta @ 2008-03-31 8:54 UTC (permalink / raw)
As a matter of general principle, I always use a for loop when
traversing an array:
procedure Get_Digits (Result : out String; Last : out Natural);
-- Reads at most Result'Length characters from standard input. Stops
-- after the first character that is not a decimal digit.
-- On output, Result (Result'First .. Last) contains the digits from
stdin;
-- Last may be zero, indicating no digits entered (i.e. one character
that
-- is not a digit was read).
procedure Get_Digits (Result : out String; Last : out Natural) is
begin
Last := Result'Last; -- be optimistic
for Index in Result'Range loop
Ada.Text_IO.Get (Result (Index));
if not Ada.Characters.Handling.Is_Digit (Result (Index)) then
Last := Index - 1;
exit;
end if;
end loop;
end Get_Digits;
procedure Test_Get is
Str : String (1 .. 10);
Last : Natural;
begin
Get_Digits (Result => Str, Last => Last);
Ada.Text_IO.Put_Line (Str (1 .. Last));
end Test_Get;
--
Ludovic Brenta.
^ permalink raw reply [relevance 2%]
* Re: Converting Type Characters to type string
@ 2008-03-31 3:04 2% ` george.priv
0 siblings, 1 reply; 200+ results
From: george.priv @ 2008-03-31 3:04 UTC (permalink / raw)
On Mar 30, 7:52 pm, jedivaughn <jedivaugh...@gmail.com> wrote:
> Thanks for the suggestions but I'm not quite sure how I would apply
> these to my program can you give me an example in code?
>
> Thanks for your patience
> John
procedure Test_Get is
Str : String (1 .. 10) := (others => ' ');
Index : Natural := 0;
C : Character;
begin
while index < Str'Last loop
Ada.Text_IO.Get (C);
-- This check can be different according to your needs:
exit when not Ada.Characters.Handling.Is_Digit (C);
Index := Index + 1;
Str (Index) := C;
end loop;
Ada.Text_IO.Put_Line (Str);
end Test_Get;
But I would rather use Get_Line instead of Get to get entire string
and then figure out what to do with it.
George.
^ permalink raw reply [relevance 2%]
* Re: OO Style with Ada Containers
@ 2007-11-19 2:24 2% ` Matthew Heaney
0 siblings, 0 replies; 200+ results
From: Matthew Heaney @ 2007-11-19 2:24 UTC (permalink / raw)
braver <deliverable@gmail.com> writes:
> As you can see, I've managed to do prefix notation everywhere except
> cursors. How do they coexist with prefix notation -- or are they
> replaced by something cooler already, too? :)
No, cursors aren't tagged because an operation can only be primitive for a
single tagged type, and the container type is already tagged.
> I'd appreciate any improvements to the above, which I deduced from ARM
> and Rosetta Stone examples in an hour and then prefix'ised thanks to
> Adam's hint! (Well I've followed Ada since 1987 so the spirit is easy
> to follow...)
The problem with your code is here:
Ngram_Cursor := Ngram_Counts.Find(s);
if not Has_Element(Ngram_Cursor) then
Ngram_Counts.Insert(s, 1);
New_Word_Count := New_Word_Count + 1;
else -- a valid position in Ngram_Pos
Count := Element(Ngram_Cursor);
Ngram_Counts.Replace_Element(Ngram_Cursor, Count+1);
end if;
The issue is that Find duplicates the search that must already be performed by
Insert. You don't want to be doing this if the map has many elements.
The solution is to use the conditional form of Insert, which does an atomic
search-and-insert and reports back the result of the search. If the key is
already in the map, the cursor returned designates the existing key/element
pair (which is not modified); if the key is not in the map, the key/element
pair is inserted and the cursor passed back designates the newly-inserted pair.
What you do here is insert a count of 0 for the word, and then increment the
count. If the word is already in the map, the existing count is increment. If
the word is not already in the map, the count is 0, so it gets incremented to
the value 1 (which is the desired value).
I have included an example program below. Also included is a simple scanner
that returns a lexeme for each whitespace-delimited word on a line of text.
Feel free to write if you have any comments or questions.
Regards,
Matt
--STX
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Scanners; use Scanners;
with Ada.Containers.Indefinite_Hashed_Maps; use Ada.Containers;
with Ada.Strings.Hash_Case_Insensitive;
with Ada.Strings.Equal_Case_Insensitive; use Ada.Strings;
procedure Count_Words is
Line : String (1 .. 256);
Line_Last : Natural;
package Map_Types is new Indefinite_Hashed_Maps
(String,
Natural,
Hash_Case_Insensitive,
Equal_Case_Insensitive);
M : Map_Types.Map;
use Map_Types;
F : File_Type;
begin
Open (F, In_File, Argument (1));
while not End_Of_File (F) loop
Get_Line(F, Line, Line_Last);
declare
procedure Increment_Count
(Word : String;
Count : in out Natural)
is
begin
Count := Count + 1;
end;
S : Scanner := Scan (Line (Line'First .. Line_Last));
C : Map_Types.Cursor;
B : Boolean;
begin
while S.Has_Word loop
M.Insert (S.Word, 0, C, B);
M.Update_Element (C, Increment_Count'Access);
end loop;
end;
end loop;
declare
procedure Process (C : Map_Types.Cursor) is
Word : constant String := Key (C);
Count : constant Natural := Element (C);
begin
Put (Word);
Put (':');
Put (Count, Width => 0);
New_Line;
end Process;
begin
M.Iterate (Process'Access);
end;
end Count_Words;
package Scanners is
pragma Pure;
type Scanner (<>) is tagged limited private;
function Scan (Line : String) return Scanner;
function Has_Word (S : Scanner) return Boolean;
function Word (S : Scanner) return String;
private
type Handle (S : not null access Scanner) is limited null record;
type Scanner (Last : Natural) is tagged limited record
H : Handle (Scanner'Access);
Line : String (1 .. Last);
Word_First : Positive;
Word_Last : Natural;
end record;
end Scanners;
with Ada.Characters.Latin_1; use Ada.Characters;
package body Scanners is
function Is_Whitespace (C : Character) return Boolean is
begin
case C is
when ' ' | Latin_1.HT =>
return True;
when others =>
return False;
end case;
end Is_Whitespace;
procedure Next (S : in out Scanner) is
I : Integer renames S.Word_First;
J : Integer renames S.Word_Last;
begin
I := J + 1;
while I <= S.Last
and then Is_Whitespace (S.Line (I))
loop
I := I + 1;
end loop;
if I > S.Last then
return; -- no more words on this line
end if;
J := I;
while J < S.Last
and then not Is_Whitespace (S.Line (J + 1))
loop
J := J + 1;
end loop;
end Next;
function Scan (Line : String) return Scanner is
begin
return S : Scanner (Line'Length) do
S.Line := Line;
-- S.Word_First := 1;
S.Word_Last := 0;
Next (S);
end return;
end Scan;
function Has_Word (S : Scanner) return Boolean is
begin
return S.Word_First <= S.Word_Last;
end Has_Word;
function Word (S : Scanner) return String is
L : constant Positive := S.Word_Last - S.Word_First + 1;
begin
return Result : String (1 .. L) do
Result := S.Line (S.Word_First .. S.Word_Last);
Next (S.H.S.all);
end return;
end Word;
end Scanners;
^ permalink raw reply [relevance 2%]
* Re: [ranting] Take Command Plugin, Win32Ada and Ada.Directories
@ 2007-11-14 13:15 2% ` Martin Krischik
0 siblings, 0 replies; 200+ results
From: Martin Krischik @ 2007-11-14 13:15 UTC (permalink / raw)
Georg Bauhaus schrieb:
> Martin Krischik wrote:
>
>> Introducing Wide_String but then *not* introducing it for file names was
>> the mistake. If only as an optional features for platforms which support
>> Wide_String (or Wide_Wide_Sting) file names.
>
> package IConv is
>
> -- the missing link to, e.g.
> -- http://www.gnu.org/software/libiconv/
>
> end IConv;
Not very helpful for a plug-in which is supposed to run under Windows.
First a plug-in should have a small memory food print and libgnat.dll is
bad enough as it is.
And then libiconv is a Unix-like tool.
Currently I use Ada.Characters.Conversions - but that won't be all that
useful for UTF8 <-> UTF-16 conventions. Well Win32Ada has some functions
which can do the trick - Only they are Win32 functions and as such a
pain to use.
And
--
mailto://krischik@users.sourceforge.net
Ada programming at: http://ada.krischik.com
^ permalink raw reply [relevance 2%]
* Re: Tasking issues
@ 2007-08-13 9:22 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2007-08-13 9:22 UTC (permalink / raw)
On Sun, 12 Aug 2007 21:39:58 GMT, anon wrote:
> First the 'ABORT' statement is a legal statement. Yes, there are better
> ways to terminate the task, but that would mean a complete overhaul of
> shaunpatterson's program, which could confuse shaunpatterson.
No, it is using abort, which is confusing in a small illustrative program.
There is no need to abort tasks in almost any Ada program.
> Also any statement that is valid in the language is valid in the code. And
> the people who say 'ABORT' statement is bad are just like the guys who
> said that "GOTO" in other languages
Ada has goto, see ARM 5.8.
> or Ada's 'LOOP' statement is bad.
> Since "GOTO' or 'LOOP' statements are a high-level language version of
> the 'JMP' assembly instruction.
Yes, yes. NASA is training astronauts climbing trees, that makes them
closer to the moon. Everything is Turing Complete. Equivalence of programs
proves nothing.
> As for "Get_Line immediately", thats an error, The Ada code can not
> force the operating system or keyboard routine to abort.
Of course it can, on most operating systems you can wait for a
or-combination of events, you can also close the file handle from outside
and that will abort pending I/O etc. It is technically possible, though,
AFAIK, RM does not require Get_Line being abortable. Yet it is to expect in
a decent implementation.
[...]
> Also where is your example of how the code should be written without a
> complete overhaul of shaunpatterson's program. Only simple additions or ]
> changes with some comment for him.
You mean your code or one of the OP? Your code can be rewritten without
aborts and global variables:
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
task Get_Name is
entry Shut_Down;
end Get_Name;
task Print_Something is
entry Shut_Down;
end Print_Something;
task body Get_Name is
Name : String (1..25);
Index : Positive;
Got_It : Boolean;
begin
Get_Line : loop
Index := Name'First;
loop
select
accept Shut_Down;
exit Get_Line;
else
Get_Immediate (Name (Index), Got_It);
end select;
if Got_It then
exit when Name (Index) = CR;
if Index < Name'Last then
Index := Index + 1;
end if;
end if;
end loop;
if Index = Name'Last then
Put_Line ("Input (truncated):" & Name (1..Index - 1));
else
Put_Line ("Input:" & Name (1..Index - 1));
end if;
end loop Get_Line;
end Get_Name;
task body Print_Something is
begin
loop
select
accept Shut_Down;
exit;
else
Put_Line ("blah...");
end select;
end loop ;
end Print_Something;
begin
delay 1.0;
Get_Name.Shut_Down;
Print_Something.Shut_Down;
end Main;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Alternative Index implementation? (Was: Reading and writing a big file in Ada (GNAT) on Windows XP)
@ 2007-05-04 6:53 2% ` Jacob Sparre Andersen
0 siblings, 0 replies; 200+ results
From: Jacob Sparre Andersen @ 2007-05-04 6:53 UTC (permalink / raw)
Simon Wright <simon.j.wright@mac.com> wrote:
> That was me. I could give you my version of Index if you want ..
I would like to have a copy as well.
My demonstration of how you can make a fast implementation of the Unix
command "tail" with POSIX.Memory_Mapping was not very successful, and
I suspect that the sinner may be Index.
Greetings,
Jacob
--
Ada - the programming language still ahead of its time.
-- tail1.adb - show the last ten lines from a named text file
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with POSIX;
with POSIX.IO;
with POSIX.Memory_Mapping;
with System;
with System.Storage_Elements;
procedure Tail is
use POSIX;
use POSIX.IO;
use POSIX.Memory_Mapping;
use System.Storage_Elements;
Text_File : File_Descriptor;
Text_Size : System.Storage_Elements.Storage_Offset;
Text_Address : System.Address;
begin
Text_File := Open (Name => To_POSIX_String (Ada.Command_Line.Argument (1)),
Mode => Read_Only);
Text_Size := Storage_Offset (File_Size (Text_File));
Text_Address := Map_Memory (Length => Text_Size,
Protection => Allow_Read,
Mapping => Map_Shared,
File => Text_File,
Offset => 0);
declare
use Ada.Strings;
use Ada.Strings.Fixed;
package Latin_1 renames Ada.Characters.Latin_1;
Bit_Count : constant Natural :=
Natural (Text_Size) * Storage_Element'Size;
Character_Count : constant Natural :=
Bit_Count / Character'Size;
Text : String (1 .. Character_Count);
for Text'Address use Text_Address;
Last : Natural := Text'Last + 1;
begin
for Lines in 1 .. 10 loop
Last := Index (Source => Text (Text'First .. Last - 1),
Pattern => (1 => Latin_1.LF),
Going => Backward);
exit when Last = 0;
end loop;
declare
POSIX_Text : POSIX_String (Text'Range);
for POSIX_Text'Address use Text'Address;
begin
while Last < Text'Last loop
NONSTANDARD_Write
(File => Standard_Output,
Buffer => POSIX_Text (Last + 1 .. Text'Last),
Last => Last);
end loop;
end;
end;
Unmap_Memory (First => Text_Address,
Length => Text_Size);
Close (File => Text_File);
end Tail;
^ permalink raw reply [relevance 2%]
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW
@ 2007-04-02 14:11 1% ` andrew.carroll
0 siblings, 0 replies; 200+ results
From: andrew.carroll @ 2007-04-02 14:11 UTC (permalink / raw)
All the files are below. The last file in the list, called
tables.txt, is the input file. I've supplied the input file I am
using when I get the errors.
with Ada.Text_IO, Ada.Directories, GNAT.Calendar.Time_IO,
Ada.Characters.Latin_1, Ada.IO_Exceptions,
Ada.Strings.Maps.Constants, Ada.Strings.Fixed,
Ada.Characters.Handling, Ada.Calendar,
schema_types, attribute_types, parser, util, index_types;
use parser, GNAT.Calendar.Time_IO, Ada.Characters.Latin_1,
Ada.Strings.Maps.Constants, Ada.Strings.Fixed,
Ada.Characters.Handling, Ada.Calendar, schema_types, attribute_types,
util;
procedure dbprog is
-- the input file contains the table specifications --
input : Ada.Text_IO.File_Type;
------------------------------------
-- Variables for Processing --
------------------------------------
char : Character;
line : string_ptr;
tablename : string_ptr;
datacols : string_array_ptr;
pkcols : string_array_ptr;
schemas : schema_array_ptr;
sindex : Integer := 1;
tupls : tuple_ptr;
procedure showoptionsmenu is
begin
cls;
pl ("---------------------------------------------------",
True);
pl ("Type one of the following at the prompt:", True);
pl (" ", True);
pl ("~ QUIT ", True);
pl ("1 INSERT DATA", True);
pl ("2 UPDATE DATA", True);
pl ("3 DELETE DATA", True);
pl ("4 SHOW RECORDS", True);
pl ("For help type 'help'", True);
pl ("---------------------------------------------------",
True);
pl (">>", False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
end showoptionsmenu;
function markschema return Integer is
idx : Integer := 0;
begin
--find the schema in schemas.
if schemas'length <= 0 then
return idx;
end if;
loop
idx := idx + 1;
exit when idx > schemas'length
or else Index (To_Upper (schemas
(idx).tablename), tablename.all) > 0;
end loop;
return idx;
end markschema;
procedure getcolumnnamesandvalues is
year : Year_Number;
month : Month_Number;
day : Day_Number;
line : string_ptr := new String'("");
valid : Boolean := False;
begin
--markschema sets sindex to the appropriate index in schemas
--for the table with tablename.
sindex := markschema;
--tables are already loaded and ready to go.
datacols := new string_array (1 .. schemas
(sindex).attributes'length);
for x in 1 .. schemas (sindex).attributes'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) = "DATE" then
while not valid loop
pl
("Enter a YEAR (1901 - 2099) for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Year_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
year := Year_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a MONTH NUMBER for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Month_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
month := Month_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a DAY NUMBER for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Day_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
day := Day_Number'value (line.all);
datacols.all (x) := new String'(Image (Time_Of (year,
month, day), ISO_Date));
valid := False;
else
while not valid loop
pl
("Enter a value for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
"(" &
Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) &
") >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
if To_Upper (line.all) = "TRUE" then
line := new String'("True");
valid := True;
elsif To_Upper (line.all) = "FALSE" then
line := new String'("False");
valid := True;
elsif line.all = "1" then
line := new String'("True");
valid := True;
elsif line.all = "0" then
line := new String'("False");
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
elsif Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) =
"INTEGER"
then
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0 then
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
else --"STRING"
valid := True;
end if;
end loop;
valid := False;
datacols.all (x) := new String'(line.all);
end if;
end loop;
end getcolumnnamesandvalues;
procedure getprimarykeynamesandvalues is
year : Year_Number;
month : Month_Number;
day : Day_Number;
line : string_ptr := new String'("");
valid : Boolean := False;
begin
--markschema sets sindex to the appropriate index in schemas
--for the table with tablename.
sindex := markschema;
pl ("Provide the primary key values to identify the record to
delete.", False, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
--tables are already loaded and ready to go.
pkcols := new string_array (1 .. schemas
(sindex).primary_key_count);
for x in 1 .. schemas (sindex).attributes'length loop
if schemas (sindex).attributes (x).isprimarykey then
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) = "DATE" then
while not valid loop
pl
("Enter a YEAR (1901 - 2099) for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Year_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
year := Year_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a MONTH NUMBER for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Month_Number'
range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
month := Month_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a DAY NUMBER for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Day_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
day := Day_Number'value (line.all);
pkcols.all (x) := new String'(Image (Time_Of
(year, month, day), ISO_Date));
valid := False;
else
while not valid loop
pl
("Enter a value for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
"(" &
Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) &
") >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) =
"BOOLEAN"
then
if To_Upper (line.all) = "TRUE" then
line := new String'("True");
valid := True;
elsif To_Upper (line.all) = "FALSE" then
line := new String'("False");
valid := True;
elsif line.all = "1" then
line := new String'("True");
valid := True;
elsif line.all = "0" then
line := new String'("False");
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
elsif Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) =
"INTEGER"
then
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <=
0
then
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
else --"STRING"
valid := True;
end if;
end loop;
valid := False;
pkcols.all (x) := new String'(line.all);
end if;
end if;
end loop;
end getprimarykeynamesandvalues;
procedure gettablename is
count : Integer := 1;
begin
pl ("Enter the table name in CAPITAL letters >>", False);
tablename := new String'(Ada.Text_IO.Get_Line);
tablename.all := To_Upper (tablename.all);
while not Ada.Directories.Exists (tablename.all) and count < 5
loop
pl ("Enter the table name in CAPITAL letters >>", False);
tablename := new String'(Ada.Text_IO.Get_Line);
tablename.all := To_Upper (tablename.all);
count := count + 1;
end loop;
if count >= 5 then
raise Constraint_Error;
end if;
end gettablename;
procedure getchosenoptiondata is
begin
gettablename;
--we don't do "4" here because it is just a select and we
don't
--need values for it and we already have the attribute names
in
--the schemas(sindex) object for which to SELECT or SHOW the
--data.
if line.all = "1" then
getcolumnnamesandvalues;
elsif line.all = "2" then
getprimarykeynamesandvalues;
pl (" ", True, True);
pl ("Please enter new values for each item. You can enter
the same ", True, True);
pl ("data if you don't want it modified.", True, True);
pl (" ", True, True);
getcolumnnamesandvalues;
elsif line.all = "3" then
getprimarykeynamesandvalues;
end if;
end getchosenoptiondata;
procedure parsechosenoption is
pkattribs : attribute_array_ptr;
newvalues : attribute_array_ptr;
linelength : Integer;
outline : string_ptr;
begin
if line.all = "1" then
-------------------
-- INSERT DATA --
-------------------
newvalues := new attribute_array (1 .. schemas
(sindex).attributes'length);
--fill in the values on the objects and pass that to
insert.
for x in 1 .. newvalues'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
newvalues (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (datacols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
newvalues (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (newvalues (x).all).value,
1,
max_stringlength,
datacols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
newvalues (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (datacols
(x).all));
else -- "DATE"
newvalues (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (datacols (x).all),
year => Year (Value (datacols
(x).all)),
month => Month (Value (datacols
(x).all)),
day => Day (Value (datacols
(x).all)));
end if;
end loop;
insertrec (schemas (sindex).all, newvalues.all);
elsif line.all = "2" then
-------------------
-- UPDATE DATA --
-------------------
pkattribs := new attribute_array (1 .. pkcols'length);
--fill in the values on the objects and pass that to
insert.
for x in 1 .. pkcols'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
pkattribs (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (pkcols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
pkattribs (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (pkattribs (x).all).value,
1,
max_stringlength,
pkcols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
pkattribs (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (pkcols
(x).all));
else -- "DATE"
pkattribs (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (pkcols (x).all),
year => Year (Value (pkcols (x).all)),
month => Month (Value (pkcols
(x).all)),
day => Day (Value (pkcols (x).all)));
end if;
end loop;
newvalues := new attribute_array (1 .. schemas
(sindex).attributes'length);
--fill in the values on the objects and pass that to
insert.
for x in 1 .. newvalues'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
newvalues (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (datacols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
newvalues (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (newvalues (x).all).value,
1,
max_stringlength,
datacols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
newvalues (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (datacols
(x).all));
else -- "DATE"
newvalues (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (datacols (x).all),
year => Year (Value (datacols
(x).all)),
month => Month (Value (datacols
(x).all)),
day => Day (Value (datacols
(x).all)));
end if;
end loop;
updaterec (schemas (sindex).all, pkattribs.all,
newvalues.all);
elsif line.all = "3" then
-------------------
-- DELETE DATA --
-------------------
Ada.Text_IO.Put_Line (Integer'image (sindex));
Ada.Text_IO.Put_Line (tablename.all);
pkattribs := new attribute_array (1 .. pkcols'length);
--fill in the values on the objects and pass that to
delete.
for x in 1 .. pkcols'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
pkattribs (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (pkcols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
pkattribs (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (pkattribs (x).all).value,
1,
max_stringlength,
pkcols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
pkattribs (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (pkcols
(x).all));
else -- "DATE"
pkattribs (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (pkcols (x).all),
year => Year (Value (pkcols (x).all)),
month => Month (Value (pkcols
(x).all)),
day => Day (Value (pkcols (x).all)));
end if;
end loop;
deleterec (schemas (sindex).all, pkattribs.all);
elsif line.all = "4" then
----------------------
-- SELECT RECORDS --
----------------------
linelength := 60;
sindex := markschema;
outline := new String'(1 .. linelength => '-');
pl (outline.all, True, False);
pl (schemas (sindex).tablename, True, False);
pl (outline.all, True, False);
pl ("| ", False, False);
for x in 1 .. schemas (sindex).attributes'length loop
pl (Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both), False, False);
if x < schemas (sindex).attributes'length then
pl (" | ", False, False);
end if;
end loop;
pl (" |", True, False);
pl (outline.all, True, False);
tupls := selectrec (schemas (sindex).all);
if tupls = null then
pl ("No Data", True, False);
else
for y in 1 .. tupls'length loop
newvalues := tupls (y);
for x in 1 .. newvalues'length loop
if Trim (newvalues (x).domain,
Ada.Strings.Both) = "BOOLEAN" then
pl
(Trim
(Boolean'image (booleanattribute
(newvalues (x).all).value),
Ada.Strings.Both),
False,
False);
elsif Trim (newvalues (x).domain,
Ada.Strings.Both) = "STRING" then
pl
(Trim
(stringattribute (newvalues
(x).all).value,
Ada.Strings.Both),
False,
False);
elsif Trim (newvalues (x).domain,
Ada.Strings.Both) = "INTEGER" then
pl
(Trim
(Integer'image (integerattribute
(newvalues (x).all).value),
Ada.Strings.Both),
False,
False);
else -- "DATE"
pl
(Trim
(Image (dateattribute (newvalues
(x).all).value, ISO_Date),
Ada.Strings.Both),
False,
False);
end if;
if x < newvalues'length then
pl (" ", False, False);
end if;
end loop;
pl (" ", True, False);
end loop;
end if;
pl (outline.all, True, False);
pl ("Press Enter >>", False, False);
Ada.Text_IO.Get_Immediate (char);
end if;
sindex := 0;
tablename := null;
datacols := null;
pkcols := null;
tupls := null;
end parsechosenoption;
begin
cls;
pl ("---------------------------------------------------", True);
pl ("Put your table definitions in a file named ", True);
pl ("tables.txt and place the file in the same folder as", True);
pl ("this program (Parser.exe). Type C to continue or.", True);
pl ("~ to quit.", True);
pl ("---------------------------------------------------", True);
pl (">>", False);
Ada.Text_IO.Get (char);
line := new String'(Ada.Text_IO.Get_Line);
if char = ETX or char = Tilde then
raise Ada.IO_Exceptions.End_Error;
end if;
setinputfile ("tables.txt");
schemas := parsetables;
closeinputfile;
showoptionsmenu;
while line.all /= "~" loop
if line.all = "help" or line.all = "HELP" then
pl ("---------------------------------------------------",
True);
pl ("If you want to quit type the tilde '~' character",
True);
pl ("---------------------------------------------------",
True);
pl (">>", False);
line := new String'(Ada.Text_IO.Get_Line);
cls;
elsif line.all = "goodbye" or
line.all = "GOODBYE" or
line.all = "exit" or
line.all = "EXIT" or
line.all = "quit" or
line.all = "QUIT" or
line.all = "q" or
line.all = "Q"
then
line := new String'("~");
else
------------------------
-- output results --
------------------------
getchosenoptiondata;
parsechosenoption;
showoptionsmenu;
end if;
end loop;
cls;
pl ("---------------------------------------------------", True);
pl ("Goodbye!", True);
pl ("---------------------------------------------------", True);
exception
when Ada.IO_Exceptions.End_Error =>
if Ada.Text_IO.Is_Open (input) then
Ada.Text_IO.Close (input);
end if;
cls;
pl ("---------------------------------------------------",
True);
pl ("An error occured while reading data. Possibly a
missing", True);
pl ("semi-colon or other format character. Or, you pressed ",
True);
pl ("CTRL + C. Goodbye!", True);
pl ("---------------------------------------------------",
True);
when Ada.Calendar.Time_Error =>
pl ("A date value was not entered correctly.", True);
pl ("Unfortunately this will cause the program to exit.",
True);
pl ("Your data is safe so long as you don't 'create fresh'.",
True);
pl ("the table when you start the program again.", True);
when Ada.IO_Exceptions.Data_Error =>
if Ada.Text_IO.Is_Open (input) then
Ada.Text_IO.Close (input);
end if;
when Constraint_Error =>
Ada.Text_IO.Put_Line ("You entered the data wrong.");
end dbprog;
with Ada.Text_IO, schema_types, attribute_types;
use schema_types, attribute_types;
package parser is
file : Ada.Text_IO.File_Type;
---------------------------
-- Utility Methods --
---------------------------
procedure setinputfile (filename : String);
procedure closeinputfile;
function parsetables return schema_array_ptr;
function parsetable return schema'class;
function parseattributes return attribute_array_ptr;
function parseattribute return attribute'class;
end parser;
with Ada.Text_IO, Ada.Directories, Ada.Integer_Text_IO,
Ada.Strings.Fixed, Ada.Characters.Latin_1,
Ada.IO_Exceptions, schema_types, attribute_types, util;
use Ada.Strings.Fixed, Ada.Characters.Latin_1, schema_types,
attribute_types, util;
package body parser is
procedure setinputfile (filename : String) is
begin
Ada.Text_IO.Open (file, Ada.Text_IO.In_File, filename);
end setinputfile;
procedure closeinputfile is
begin
if Ada.Text_IO.Is_Open (file) then
Ada.Text_IO.Close (file);
end if;
end closeinputfile;
-----------------------
-- parseTables --
-----------------------
function parsetables return schema_array_ptr is
eof : Boolean := False;
char : Character;
schemas : schema_array_ptr := null;
swap : schema_array_ptr := null;
schemainfo : schema_ptr := null;
i : Integer := 1;
begin
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--at this point we should be ready to read the table name.
swap := new schema_array (1 .. max_tables);
while not eof loop
schemainfo := new schema'class'(parsetable);
pl ("Create the table fresh? [y/Y] >>", False, True);
Ada.Text_IO.Get (char);
swap(i) := new schema(schemainfo.attributes'length);
if char = 'y' or char = 'Y' then
swap (i) := schemainfo;
createtable (swap (i));
else
if Ada.Directories.Exists (schemainfo.tablename) then
swap (i) := loadtable (schemainfo.tablename);
else
pl ("No table exists on disc with name = " &
schemainfo.tablename, True, True);
pl ("You will not be able to query " &
schemainfo.tablename, True, True);
pl (" ", True, False);
end if;
end if;
i := i + 1;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
end if;
end loop;
i := i - 1;
if i < 1 then
schemas := null;
swap := null;
else
schemas := new schema_array (1 .. i);
for x in 1 .. i loop
schemas (x) := swap (x);
end loop;
swap := null;
end if;
return schemas;
end parsetables;
----------------------
-- parseTable --
----------------------
function parsetable return schema'class is
temp : schema_ptr := null;
eof : Boolean := False;
char : Character;
tname : String (1 .. max_tablename_length);
attribs : attribute_array_ptr;
i : Integer := 1;
begin
eatWhite (file, eof);
--at this point we should be ready to read the table name.
--the call to eatwhite might be redundant from the instance
that
--called 'me' but we want to ensure we are in the right
location within
--the file.
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Left_Parenthesis and
not eof
loop
Ada.Text_IO.Get (file, char);
tname (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_tablename_length loop
tname (x) := ' ';
end loop;
--We just read the table name. We are expecting an opening
'('.
--If it's not there then there is a problem with the input
file
--format.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
if char = Left_Parenthesis then
Ada.Text_IO.Get (file, char);
else
Ada.Text_IO.Put_Line(
" Error in input file format: No attributes found. Must have
(<attribute list>)");
end if;
else
raise Ada.IO_Exceptions.End_Error;
end if;
attribs := parseattributes;
if attribs /= null then
temp := new schema (attribs.all'length);
temp.attributes := attribs.all;
temp.tablename := tname;
for x in 1 .. temp.attributes'length loop
if temp.attributes (x).all.isprimarykey then
temp.primary_key_count := temp.primary_key_count +
1;
end if;
end loop;
else
temp := null;
end if;
--at this point we should have read the ')' for the whole
table spec.
--if we peek, we should find a ';'.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
if char = Semicolon then
Ada.Text_IO.Get (file, char);
else
Ada.Text_IO.Put_Line
(" Error in input file format: Missing
closing ';' on table spec.");
temp := null;
end if;
else
Ada.Text_IO.Put_Line
(" Error in input file format: Missing closing
')' on table spec.");
temp := null;
end if;
return temp.all;
end parsetable;
---------------------------
-- parseAttributes --
---------------------------
function parseattributes return attribute_array_ptr is
eof : Boolean := False;
char : Character;
attribs : attribute_array_ptr := null;
swap : attribute_array_ptr := null;
i : Integer := 1;
begin
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--at this point we should be ready to read the attribute name.
if not eof and char /= Right_Parenthesis then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
Ada.Text_IO.Put_Line (" found eof prematurely
or ')' is in wrong place.");
raise Ada.IO_Exceptions.End_Error;
end if;
swap := new attribute_array (1 .. max_columns);
while char /= Right_Parenthesis and char /= Semicolon and not
eof loop
swap (i) := new attribute'class'(parseattribute);
i := i + 1;
eatWhite (file, eof);
if not eof and char /= Right_Parenthesis then
--we are expecting a ')' or a comma.
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
if char /= Comma and char /= Right_Parenthesis and not eof
then
Ada.Text_IO.Put_Line
(" Error in input file: Missing comma
between attributes.");
eof := True;
swap := null;
elsif not eof then
--read the comma or the ')'
Ada.Text_IO.Get (file, char);
end if;
eatWhite (file, eof);
if eof then
Ada.Text_IO.Put_Line ("Missing semi-colon or other
format error.");
raise Ada.IO_Exceptions.End_Error;
end if;
end loop;
i := i - 1;
if i < 1 then
swap := null;
else
attribs := new attribute_array (1 .. i);
for x in 1 .. i loop
attribs (x) := swap (x);
end loop;
swap := null;
end if;
return attribs;
end parseattributes;
--------------------------
-- parseAttribute --
--------------------------
function parseattribute return attribute'class is
temp : attribute_types.attribute_ptr;
eof : Boolean := False;
char : Character;
aname : String (1 .. max_attributename_length);
atype : String (1 .. max_typename_length);
asize : Integer;
isprimarykey : Boolean := False;
i : Integer := 1;
begin
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Left_Parenthesis and
char /= Colon and
not eof
loop
Ada.Text_IO.Get (file, char);
aname (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_attributename_length loop
aname (x) := ' ';
end loop;
--at this point we have the attribute name. Read white space
to
--a parenthesis or an colon.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--the next character should be '(' or ':'
if char = Left_Parenthesis then
Ada.Text_IO.Get (file, char);
eatWhite (file, eof);
i := 1;
--read "primary"
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Right_Parenthesis and
not eof
loop
Ada.Text_IO.Get (file, char);
atype (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_typename_length loop
atype (x) := ' ';
end loop;
if Trim (atype, Ada.Strings.Both) = "PRIMARY" then
isprimarykey := True;
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
i := 1;
--read "key"
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Right_Parenthesis and
not eof
loop
Ada.Text_IO.Get (file, char);
atype (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_typename_length loop
atype (x) := ' ';
end loop;
if Trim (atype, Ada.Strings.Both) = "KEY" then
isprimarykey := True;
else
isprimarykey := False;
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
if char = ')' then
Ada.Text_IO.Get (file, char);
else
Ada.Text_IO.Put_Line
(" Error in input: Missing ')' after
Primary Key designation.");
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
end if;
if char = Colon then
Ada.Text_IO.Get (file, char);
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
i := 1;
--read the type of the attribute into atype variable
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Comma and
char /= Left_Parenthesis and
char /= Right_Parenthesis and
char /= Semicolon and
not eof
loop
Ada.Text_IO.Get (file, char);
atype (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_typename_length loop
atype (x) := ' ';
end loop;
eatWhite (file, eof);
--read the left parenthesis
if not eof and
char = Left_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Get (file, char);
Ada.Text_IO.Look_Ahead (file, char, eof);
elsif not eof and
char /= Left_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Put_Line (" Incorrect syntax:
missing (size) for string.");
elsif eof then
raise Ada.IO_Exceptions.End_Error;
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--read the size of the type of the attribute into atype
variable
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Comma and
char /= Right_Parenthesis and
char /= Left_Parenthesis and
not eof
loop
Ada.Integer_Text_IO.Get (file, asize, 0);
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
--I have to do this temporarily to get this program
--to work. ALL strings are the same length. The reason
--is because there is no way to know how long the string
is
--when serializing it in from a file (see loadtable in
--schema_types) before we serialize it so that we can
--provide a length discriminant to the type defined in
--attribute_types. So, we just make them all the same
--length.
asize := max_stringlength;
eatWhite (file, eof);
--read the right parenthesis
if not eof and
char = Right_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Get (file, char);
Ada.Text_IO.Look_Ahead (file, char, eof);
elsif not eof and
char /= Right_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Put_Line
(" Incorrect syntax: missing (size ~)~
for string.");
elsif eof then
raise Ada.IO_Exceptions.End_Error;
end if;
eatWhite (file, eof);
if Trim (atype, Ada.Strings.Both) = "BOOLEAN" then
temp := new booleanattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
elsif Trim (atype, Ada.Strings.Both) = "STRING" then
temp := new stringattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
elsif Trim (atype, Ada.Strings.Both) = "INTEGER" then
temp := new integerattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
elsif Trim (atype, Ada.Strings.Both) = "DATE" then
temp := new dateattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
else
Ada.Text_IO.Put_Line (" unknown type
specified.");
end if;
--after eating the white space we should be left at the
',' or
--the ')'.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--we leave the comma in the stream so that parseAttributes
can
--pick it up and loop for the next attribute. We leave
the second
--')' for parseAttributes to read to know when to exit the
loop and
--quit parsing attributes.
if char /= Comma and char /= Right_Parenthesis then
Ada.Text_IO.Put_Line(
" Error in input: Missing ')' after Primary Key
designation or ',' between attributes.")
;
temp := null;
end if;
else
Ada.Text_IO.Put_Line
(
" Error in input file: Format not correct, no type
specified for attribute " &
aname);
temp := null;
end if;
return temp.all;
end parseattribute;
begin
null;
end parser;
with Ada.Text_IO, Ada.Characters.Latin_1, Ada.Strings.Fixed,
Ada.Strings.Maps, Ada.IO_Exceptions;
use Ada.Characters.Latin_1;
package util is
type string_ptr is access all String;
type string_array is array (Integer range <>) of string_ptr;
type string_array_ptr is access all string_array;
max_columns : Integer := 5;
max_tables : Integer := 5;
max_tablename_length : Integer := 25;
max_attributename_length : Integer := 25;
max_stringlength : Integer := 255;
max_typename_length : Integer := 7;
max_filename_length : Integer := 45;
max_index_namelength: integer := 50;
procedure cls;
procedure pl (text : in String; newline : in Boolean; setcolumn :
in Boolean := True);
function tokenize (text : in String) return string_array_ptr;
procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in
out Boolean);
end util;
package body Util is
procedure cls is
i : Integer := 1;
begin
while i < 40 loop
Ada.Text_IO.New_Line;
i := i + 1;
end loop;
end cls;
procedure pl (text : in String; newline : in Boolean; setcolumn :
in Boolean := True) is
begin
if newline then
if setcolumn then
Ada.Text_IO.Set_Col (15);
end if;
Ada.Text_IO.Put_Line (text);
elsif setcolumn then
Ada.Text_IO.Set_Col (15);
Ada.Text_IO.Put (text);
else
Ada.Text_IO.Put (text);
end if;
end pl;
function tokenize (text : in String) return string_array_ptr is
temp : string_array_ptr;
first : Integer := 1;
i : Integer := 1;
number_of_commas : Integer := 0;
data : string_ptr;
data2 : string_ptr;
begin
data := new String'(text);
number_of_commas := Ada.Strings.Fixed.Count (data.all,
Ada.Strings.Maps.To_Set (','));
if number_of_commas > max_columns then
pl ("Invalid number of columns specified", True);
raise Ada.IO_Exceptions.Data_Error;
end if;
temp := new string_array (1 .. number_of_commas + 1);
--first will point to the first comma.
first :=
Ada.Strings.Fixed.Index
(data.all,
Ada.Strings.Maps.To_Set (','),
Ada.Strings.Inside,
Ada.Strings.Forward);
while i <= number_of_commas and number_of_commas < max_columns
loop
temp.all (i) := new String'(data.all (1 .. first - 1));
data2 := new String (1 .. data.all'length - first);
data2.all := data.all (first + 1 .. data.all'length);
data := new String'(data2.all);
i := i + 1;
first :=
Ada.Strings.Fixed.Index
(data.all,
Ada.Strings.Maps.To_Set (','),
Ada.Strings.Inside,
Ada.Strings.Forward);
end loop;
temp.all (i) := new String'(data.all);
return temp;
end tokenize;
--------------------
-- eatWhite --
--------------------
procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in
out Boolean) is
char : Character;
begin
Ada.Text_IO.Look_Ahead (fin, char, eof);
while Ada.Text_IO.End_Of_Line (fin) and not
Ada.Text_IO.End_Of_File (fin) loop
Ada.Text_IO.Skip_Line (fin);
end loop;
Ada.Text_IO.Look_Ahead (fin, char, eof);
while (char = Space or char = HT or char = LF or char = CR)
and
not Ada.Text_IO.End_Of_File (fin)
loop
Ada.Text_IO.Get (fin, char);
while Ada.Text_IO.End_Of_Line (fin) and not
Ada.Text_IO.End_Of_File (fin) loop
Ada.Text_IO.Skip_Line (fin);
end loop;
Ada.Text_IO.Look_Ahead (fin, char, eof);
end loop;
end eatWhite;
begin
null;
end Util;
with util, Ada.Calendar, attribute_types, Ada.Streams.Stream_IO;
use util, attribute_types;
package schema_types is
---------------------------------
-- Variable Declarations --
---------------------------------
fin : Ada.Streams.Stream_IO.File_Type;
fout : Ada.Streams.Stream_IO.File_Type;
type schema (number_of_attributes : Integer) is tagged record
tablename : String (1 .. max_tablename_length) := (1 ..
max_tablename_length => ' ');
attributes : attribute_array (1 ..
number_of_attributes);
byte_start : Integer := 0;
byte_end : Integer := 0;
primary_key_count : Integer := 0;
end record;
type schema_ptr is access all schema'class;
type schema_array is array (Integer range <>) of schema_ptr;
type schema_array_ptr is access all schema_array;
type tuple is array (Integer range <>) of attribute_array_ptr;
type tuple_ptr is access all tuple;
procedure createtable (schemainfo : schema_ptr);
function loadtable (sname : String) return schema_ptr;
function findrecord (schemainfo : schema; values :
attribute_array) return Integer;
procedure insertrec (schemainfo : schema; values :
attribute_array);
procedure deleterec (schemainfo : schema; primary_key_values :
attribute_array);
procedure updaterec
(schemainfo : schema;
pkattribs : attribute_array;
values : attribute_array);
function selectrec (schemainfo : schema) return tuple_ptr;
end schema_types;
with Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO,
Ada.Text_IO, Ada.Strings.Fixed,
Ada.Directories, Ada.IO_Exceptions;
use Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO,
Ada.Strings.Fixed;
package body schema_types is
procedure createtable (schemainfo : schema_ptr) is
fout : File_Type;
attribs : attribute_array_ptr;
attribs2 : attribute_array_ptr;
i : Integer := 1;
ii : Integer := 1;
temp : access attribute'class;
begin
if schemainfo = null then
return;
end if;
-- put them in order first
for x in 1 .. schemainfo.attributes'length loop
for y in x + 1 .. schemainfo.attributes'length loop
if schemainfo.attributes (y).name <
schemainfo.attributes (x).name then
temp := schemainfo.attributes
(y);
schemainfo.attributes (y) := schemainfo.attributes
(x);
schemainfo.attributes (x).all := temp.all;
end if;
end loop;
end loop;
attribs := new attribute_array (1 ..
schemainfo.attributes'length);
attribs2 := new attribute_array (1 ..
schemainfo.attributes'length);
for x in 1 .. schemainfo.attributes'length loop
if schemainfo.attributes (x).isprimarykey then
attribs (i) := schemainfo.attributes (x);
i := i + 1;
else
attribs2 (ii) := schemainfo.attributes (x);
ii := ii + 1;
end if;
end loop;
i := i - 1;
ii := ii - 1;
-- the primary_key attributes first
for x in 1 .. i loop
schemainfo.attributes (x) := attribs (x);
end loop;
-- non-primary key attributes next
for x in 1 .. ii loop
schemainfo.attributes (x + i) := attribs2 (x);
end loop;
Create (fout, Out_File, Trim (schemainfo.all.tablename,
Ada.Strings.Both));
--We are writing the number of attributes so that when we load
--the table we can determine the number of attributes to put
--into the new, loading schema.
Integer'write (Stream (fout),
schemainfo.all.attributes'length);
schemainfo.all.byte_start := Integer'val (Index (fout));
--we output it once so that we can capture the file position for
byte_end
schema'output (Stream (fout), schemainfo.all);
--fill in byte_end
schemainfo.all.byte_end := Integer'val (Index (fout));
close(fout);
Open (fout, Out_File, Trim (schemainfo.all.tablename,
Ada.Strings.Both));
Integer'write (Stream (fout),
schemainfo.all.attributes'length);
--now we have byte_start and byte_end
schema'output (Stream (fout), schemainfo.all);
for x in 1 .. schemainfo.all.attributes'length loop
to_disc(fout, schemainfo.all.attributes(x).all);
end loop;
Close (fout);
end createtable;
function loadtable (sname : String) return schema_ptr is
schemainfo : schema_ptr;
fin : File_Type;
length : Integer;
position : integer;
begin
Open (fin, In_File, Trim (sname, Ada.Strings.Both));
Integer'read (Stream (fin), length);
schemainfo := new schema (length);
schemainfo.all := schema'class'input (Stream
(fin));
--mark where we are at in the file to start reading attributes.
position := Integer'val (Index (fin));
for x in 1 .. schemainfo.attributes'length loop
-----------------------------------------------------
-- Old code I plan on removing
-----------------------------------------------------
-- schemainfo.all.attributes (x).all.byte_start :=
position;
--
-- if Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "BOOLEAN" then
-- schemainfo.all.attributes (x) := new
booleanattribute;
-- schemainfo.all.attributes (x).all :=
-- booleanattribute'input (Stream (fin));
-- elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "STRING" then
-- schemainfo.all.attributes (x) :=
new stringattribute;
-- schemainfo.all.attributes (x).all :=
-- stringattribute'input (Stream (fin));
-- elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "INTEGER" then
-- schemainfo.all.attributes (x) :=
new integerattribute;
-- schemainfo.all.attributes (x).all :=
-- integerattribute'input (Stream (fin));
-- else -- "DATE"
-- schemainfo.all.attributes (x) :=
new dateattribute;
-- schemainfo.all.attributes (x).all :=
-- dateattribute'input (Stream (fin));
-- end if;
-- position := Integer'val (Index (fin));
-- schemainfo.all.attributes (x).all.byte_end :=
position;
-- End old code
------------------------------------------------------
-----------------------------------------------------------
-- The code I want to use for dispatching
-----------------------------------------------------------
-- schemainfo.all.attributes (x) := new
attribute'class'(from_disc(fin, schemainfo.all.attributes (x).all));
-----------------------------------------------------------
------------------------------------------------------------
-- Debug code below --
------------------------------------------------------------
-- For some reason some of the attributes on schemainfo come through
-- as "unknown" after the schemainfo was filled in from
'input(stream).
-- It doesn't appear to me that createtable procedure in this package
-- writes the schema object incorrectly so I don't understand why
-- the attributes of the schemainfo object we retrieve with 'input are
-- "unknown". Well, the domain member of the attribute is not one of
-- BOOLEAN, STRING, INTEGER or DATE; that's why it prints it but why
-- isn't the domain member one of those values?
if Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "BOOLEAN" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "STRING" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "INTEGER" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "DATE" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
else
ada.text_io.put_line("unknown");
end if;
end loop;
-- End Debug Code
---------------------------------------------------------------
Close (fin);
return schemainfo;
exception
when Ada.IO_Exceptions.Status_Error =>
Ada.Text_IO.Put_Line ("Status error in loadtable");
return null;
end loadtable;
---------------------
-- INSERT RECORD --
---------------------
procedure insertrec (schemainfo : schema; values :
attribute_array) is
location : Integer := -1;
char : Character;
begin
location := findrecord (schemainfo, values);
--if the record isn't in there it is -1
if location = -1 then
Open (fout, Append_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
for x in 1 .. schemainfo.attributes'length loop
to_disc(fout, values (x).all);
end loop;
Close (fout);
else
pl ("Record already exists with that key", True, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
end if;
end insertrec;
---------------------
-- SELECT RECORD --
---------------------
function selectrec (schemainfo : schema) return tuple_ptr is
temp : attribute_array_ptr;
recs : tuple_ptr;
recs2 : tuple_ptr;
i : Integer := 1;
begin
Open (fin, In_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
Set_Index
(fin,
Ada.Streams.Stream_IO.Count'val
(schemainfo.attributes
(schemainfo.attributes'length).all.byte_end));
temp := new attribute_array (1 ..
schemainfo.attributes'length);
if End_Of_File (fin) then
Close (fin);
return null;
end if;
recs := new tuple (1 .. 1);
while not End_Of_File (fin) loop
for x in 1 .. temp.all'length loop
temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes
(x).all));
end loop;
if i < 2 then
recs (recs'last) := temp;
else
recs2 := new tuple (1 .. recs'length);
for z in 1 .. recs'length loop
recs2 (z) := recs (z);
end loop;
recs := new tuple (1 .. i);
for z in 1 .. recs2'length loop
recs (z) := recs2 (z);
end loop;
recs (recs'last) := temp;
end if;
temp := new attribute_array (1 ..
schemainfo.attributes'length);
i := i + 1;
end loop;
Close (fin);
return recs;
end selectrec;
-------------------
-- FIND RECORD --
-------------------
function findrecord (schemainfo : schema; values :
attribute_array) return Integer is
temp : attribute_array_ptr;
location : Ada.Streams.Stream_IO.Count;
found : Integer := 0;
done : Boolean := False;
comparrisons : Integer := 0;
begin
Open (fin, In_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
Set_Index
(fin,
Ada.Streams.Stream_IO.Count'val
(schemainfo.attributes
(schemainfo.attributes'length).all.byte_end));
temp := new attribute_array (1 ..
schemainfo.attributes'length);
while not End_Of_File (fin) and then not done loop
--mark our current location in the file.
location := Index (fin);
--read the whole line from the file,
for x in 1 .. schemainfo.attributes'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
end loop;
--then compare them.
comparrisons := 0;
found := 0;
for x in 1 .. values'length loop
if schemainfo.attributes (x).isprimarykey then
comparrisons := comparrisons + 1;
if Trim (values (x).domain, Ada.Strings.Both) =
"BOOLEAN" then
if booleanattribute (temp (x).all).value =
booleanattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(boolean'image(booleanattribute(temp(x).all).value
--));
elsif Trim (values (x).domain, Ada.Strings.Both) =
"STRING" then
if stringattribute (temp (x).all).value =
stringattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(stringattribute(temp(x).all).value);
elsif Trim (values (x).domain, Ada.Strings.Both) =
"INTEGER" then
if integerattribute (temp (x).all).value =
integerattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(integer'image(integerattribute(temp(x).all).value
--));
else -- "DATE"
if dateattribute (temp (x).all).value =
dateattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(image(dateattribute(temp(x).all).value,
--iso_date));
end if;
end if;
end loop;
if found = comparrisons and then comparrisons > 0 then
done := True;
end if;
if End_Of_File (fin) then
done := True;
end if;
end loop;
Close (fin);
if found < comparrisons then
return -1;
elsif found = 0 and then comparrisons = 0 then
return -1;
else
return Integer'val (location);
end if;
end findrecord;
---------------------
-- DELETE RECORD --
---------------------
procedure deleterec (schemainfo : schema; primary_key_values :
attribute_array) is
location : Integer;
original_byte_end : Integer := schemainfo.attributes
(schemainfo.attributes'last).byte_end;
temp : attribute_array_ptr;
char : Character;
begin
location := findrecord (schemainfo, primary_key_values);
--If findrecord seeks past the schema info header in the file
and ends
--on the end of file it will return -1. Therefore, no records
to delete
--in the file.
if location = -1 then
pl ("No records to delete with that key", True, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
return;
end if;
Create (fout, Out_File, "swapfile");
Open (fin, In_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
--output the schema header information to the file
Integer'write (Stream (fout), schemainfo.attributes'length);
--I took these out so that we could create a function for
--updating records that returns an rrn. functions do not
--allow out mode parameters and deleterec had an out mode
--parameter because of this next line.
--schemainfo.byte_start := Integer'val (Index (fout));
schema'output (Stream (fout), schemainfo);
--I took these out so that we could create a function for
--updating records that returns an rrn. functions do not
--allow out mode parameters and deleterec had an out mode
--parameter because of this next line.
--schemainfo.byte_end := Integer'val (Index (fout));
for x in 1 .. schemainfo.attributes'length loop
to_disc(fout, schemainfo.attributes(x).all);
end loop;
--set the index on the input file so we skip the header on
input file.
Set_Index (fin, Ada.Streams.Stream_IO.Count'val
(original_byte_end));
temp := new attribute_array (1 ..
schemainfo.attributes'length);
--Read records from one file and insert them into the other
file until
--we get to the location of the record we want to delete.
while Index (fin) < Ada.Streams.Stream_IO.Count'val (location)
loop
for x in 1 .. temp.all'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
to_disc(fin, temp(x).all);
end loop;
end loop;
--do a blank read to move past the line to delete
for x in 1 .. schemainfo.attributes'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
end loop;
--output the rest of the records.
while not End_Of_File (fin) loop
for x in 1 .. temp.all'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
to_disc(fout, temp(x).all);
end loop;
end loop;
Close (fin);
Close (fout);
Ada.Directories.Delete_File (Trim (schemainfo.tablename,
Ada.Strings.Both));
Ada.Directories.Rename ("swapfile", Trim
(schemainfo.tablename, Ada.Strings.Both));
location := findrecord (schemainfo, primary_key_values);
if location >= 1 then
deleterec (schemainfo, primary_key_values);
end if;
end deleterec;
---------------------
-- UPDATE RECORD --
---------------------
procedure updaterec
(schemainfo : schema;
pkattribs : attribute_array;
values : attribute_array)
is
position : Integer := 0;
char : Character;
begin
position := findrecord (schemainfo, pkattribs);
--if the record doesn't exist then insert it
if position < 1 then
pl ("That record doesn't exist in the database.", True,
True);
pl ("Insert it instead (menu item 1).", True, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
elsif position >= 1 then
deleterec (schemainfo, pkattribs);
insertrec (schemainfo, values);
end if;
end updaterec;
begin
null;
end schema_types;
with util, Ada.Calendar, ada.streams.stream_io;
use util, Ada.Calendar, ada.streams.stream_io;
package attribute_types is
-----------------------------------
-- Forwarding Declarations --
-----------------------------------
type attribute is abstract tagged;
type booleanattribute is tagged;
type integerattribute is tagged;
type stringattribute is tagged;
type dateattribute is tagged;
--------------------------------------
-- Attribute Type Declarations --
--------------------------------------
type attribute is abstract tagged record
name : String (1 .. max_attributename_length) :=
(1 .. max_attributename_length => ' ');
domain : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
isprimarykey : Boolean :=
False;
byte_start : Integer := 0;
byte_end : Integer := 0;
end record;
--------------------------------------
-- Basic Pointer Declarations --
--------------------------------------
type attribute_ptr is access attribute'class;
type attribute_array is array (Integer range <>) of access
attribute'class;
type attribute_array_ptr is access all attribute_array;
procedure to_disc (fout: file_type; item: in out attribute) is
abstract;
function from_disc(fout: file_type; item: attribute) return
attribute'class is abstract;
-----------------------------------
-- Extended Attribute Types --
-----------------------------------
type booleanattribute is new attribute with record
value : Boolean := False;
end record;
type booleanattribute_ptr is access all booleanattribute'class;
procedure to_disc (fout: file_type; item: in out
booleanattribute);
function from_disc(fin: file_type; item: booleanattribute) return
attribute'class;
type integerattribute is new attribute with record
value : Integer := 0;
end record;
type integerattribute_ptr is access all integerattribute'class;
procedure to_disc (fout: file_type; item: in out
integerattribute);
function from_disc(fin: file_type; item: integerattribute) return
attribute'class;
type stringattribute is new attribute with record
value : String (1 .. max_stringlength) := (1 ..
max_stringlength => ' ');
end record;
type stringattribute_ptr is access all stringattribute'class;
procedure to_disc (fout: file_type; item: in out stringattribute);
function from_disc(fin: file_type; item: stringattribute) return
attribute'class;
type dateattribute is new attribute with record
year : Year_Number := 1901;
month : Month_Number := 1;
day : Day_Number := 1;
value : Time := Time_Of (1901, 1, 1);
end record;
type dateattribute_ptr is access all dateattribute'class;
procedure to_disc (fout: file_type; item: in out dateattribute);
function from_disc(fin: file_type; item: dateattribute) return
attribute'class;
end attribute_types;
with ada.text_io, util, ada.calendar;
use util, ada.calendar;
package body attribute_types is
procedure to_disc (fout: file_type; item: in out booleanattribute)
is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(booleanattribute'size / 8) - 7;
booleanattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: booleanattribute) return
attribute'class is
temp : access attribute'class;
begin
temp := new booleanattribute;
temp.all := booleanattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
procedure to_disc (fout: file_type; item: in out integerattribute)
is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(integerattribute'size / 8) - 7;
integerattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: integerattribute) return
attribute'class is
temp : access attribute'class;
begin
temp := new integerattribute;
temp.all := integerattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
procedure to_disc (fout: file_type; item: in out stringattribute)
is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(stringattribute'size / 8) - 7;
stringattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: stringattribute) return
attribute'class is
temp: access attribute'class;
begin
temp := new stringattribute;
temp.all := stringattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
procedure to_disc (fout: file_type; item: in out dateattribute) is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(dateattribute'size / 8) - 11;
dateattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: dateattribute) return
attribute'class is
temp: access attribute'class;
begin
temp := new dateattribute;
temp.all := dateattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
begin
null;
end attribute_types;
with Ada.Streams.Stream_IO, util, attribute_types,Ada.Calendar; use
util, attribute_types,Ada.Calendar;
package index_types is
---------------------------------
-- Variable Declarations --
---------------------------------
fin : Ada.Streams.Stream_IO.File_Type;
fout : Ada.Streams.Stream_IO.File_Type;
--------------------------------------------------------
-- THIS FILE IS NOT COMPLETE NOR USED YET!!!
-- IT IS INCLUDED BECAUSE IT IS WITH'D
--------------------------------------------------------
--an index is a file
--it contains the primary key value and file position for the
primary key for a primary index
--the spec sounds like only one attribute will make up a primary
key.
--for a secondary index it contains an attribute and a position.
--The spec says only one attribute.
--primary indexes are named after the table it belongs to
<tablename>_PIDX
--secondary indexes are named after the table it belongs to like
<tablename>_SIDX
--each schema object has a list of index names for a table
--initially the list of index names is empty
--the user adds an index to the table and then the index name goes
into the list of indexes on
--the schema
--the schema information will have to be re-written to the table
file when an index is added.
--This is the same for the secondary indexes
--if a tuple that an index is based on is inserted, deleted or
updated then the index must be
--loaded and re-created.
----on updates we only have to change the index if the index value
is being changed.
--The attributes store the name of an index on itself. When we load
the schema
--we go through each attribute and determine if it is indexed then
load that
--index if it is. This gives us the "type" on the index value,
elleviates the
--need to maintain a list of index names in the schema object,
----what do we load an index into?
--There are two types of indexes: primary and secondary
--** note ** the primary index is just like the secondary; it only
has one entry per item
--because there is only
--one item allowed per entry due to the fact that primary keys are
unique.
--The differences in indexes are:
----if we remove a value from a secondary we must match the rrn to
remove the correct
--item; with a primary key there is only one to remove.
----when finding a record, with a primary index when we find the
value we don't
----have to search a bunch of records for the exact tuple match.
With secondary
----, because there are multiple values that are the same with
different rrn's
----we have to search each rrn and compare values to match the
tuple.
--we don't sort as we read the table, we read the table and then
sort the index file.
type index is abstract tagged record
filename : String (1 .. max_index_namelength);
rrn : Ada.Streams.Stream_IO.Count := 0;
end record;
type index_ptr is access all index;
type index_array is array (Integer range <>) of index_ptr;
type booleanindex is tagged record
key : boolean;
end record;
type integerindex is tagged record
key : integer;
end record;
type stringindex is tagged record
key : string(1..max_stringlength);
end record;
type dateindex is tagged record
key : time;
end record;
end index_types;
*************************
* Contents of the table.txt file
* This file is used by the main procedure dbprog.
* It must be labeled tables.txt and placed in the
* same directory as the executable dbprog.exe
*************************
T3(
ID(PRIMARY KEY):INTEGER
);
T2(
DATA(PRIMARY KEY):STRING(15)
);
T4(
II(PRIMARY KEY):DATE
);
T1(
mine(PRIMARY KEY):BOOLEAN
);
*************************
^ permalink raw reply [relevance 1%]
* Re: Ada.Containers.Doubly_Linked_Lists
2007-02-07 18:22 2% ` Ada.Containers.Doubly_Linked_Lists Jeffrey R. Carter
@ 2007-02-08 13:39 0% ` Stephen Leake
0 siblings, 0 replies; 200+ results
From: Stephen Leake @ 2007-02-08 13:39 UTC (permalink / raw)
"Jeffrey R. Carter" <jrcarter@acm.org> writes:
> Ludovic Brenta wrote:
>> Ada.Characters.Latin_1.HT (for Horizontal Tab).
>
> Or Character'Val (9). Or Character'Succ (Ada.Characters.Latin_1.BS).
> But Latin_1 is the better way.
Or ASCII.HT.
ASCII is labeled "Obsolete", but it will never go away; every Ada
compiler implements it. Maybe I'm just old-fashioned, but I prefer it
over Latin_1 for things like this :).
--
-- Stephe
^ permalink raw reply [relevance 0%]
* Re: Ada.Containers.Doubly_Linked_Lists
2007-02-07 15:06 2% ` Ada.Containers.Doubly_Linked_Lists Ludovic Brenta
@ 2007-02-07 18:22 2% ` Jeffrey R. Carter
2007-02-08 13:39 0% ` Ada.Containers.Doubly_Linked_Lists Stephen Leake
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2007-02-07 18:22 UTC (permalink / raw)
Ludovic Brenta wrote:
>
> Ada.Characters.Latin_1.HT (for Horizontal Tab).
Or Character'Val (9). Or Character'Succ (Ada.Characters.Latin_1.BS). But
Latin_1 is the better way.
--
Jeff Carter
"No one is to stone anyone until I blow this whistle,
do you understand? Even--and I want to make this
absolutely clear--even if they do say, 'Jehovah.'"
Monty Python's Life of Brian
74
^ permalink raw reply [relevance 2%]
* Re: Ada.Containers.Doubly_Linked_Lists
@ 2007-02-07 15:06 2% ` Ludovic Brenta
2007-02-07 18:22 2% ` Ada.Containers.Doubly_Linked_Lists Jeffrey R. Carter
0 siblings, 1 reply; 200+ results
From: Ludovic Brenta @ 2007-02-07 15:06 UTC (permalink / raw)
Carroll, Andrew writes:
> It's been over a year since I've even looked at an Ada program. I
> forgot pretty much everything.
>
> I found a way to output the Count_Type that was different than your way
> but I like yours. I didn't realize that the 'Image "thing" applies to
> all integer types. What is the 'Image "thing" called again...?
An attribute.
> Next question. How do I output a tab character?
> I don't see a constant for that in text_io.
Ada.Characters.Latin_1.HT (for Horizontal Tab).
--
Ludovic Brenta.
^ permalink raw reply [relevance 2%]
* Re: I/O streaming with custom data transport
@ 2006-11-22 9:16 2% ` Maciej Sobczak
0 siblings, 0 replies; 200+ results
From: Maciej Sobczak @ 2006-11-22 9:16 UTC (permalink / raw)
Alex R. Mosteo wrote:
>> I'm looking for something like this in Ada.
>>
>> The basic I/O facilities in the standard library don't seem to provide
>> anything like this.
>> I hoped that Ada.Streams allows this by subclassing Root_Stream_Type and
>> providing some overriding operations, but unfortunately I cannot even
>> find the specification of Root_Stream_Type (looks like there isn't any
>> and this type is just a name placeholder in ARM).
>
> I think you haven't looked right.
Indeed - it's in 13.13.1.
> That's precisely how it's done.
> And you do this just as you say: you extend
> Ada.Streams.Root_Stream_Type and provide the read/write subprograms.
And I actually managed to do this.
Consider the following example of custom stream that for the sake of
presentation is bound to standard IO and just converts characters to
uppercase when writing (the point is that if I can do *this*, I can do
anything else):
-- file my_streams.ads:
with Ada.Streams;
package My_Streams is
use Ada.Streams;
type My_Stream is new Root_Stream_Type with null record;
procedure Read(Stream : in out My_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
procedure Write(Stream : in out My_Stream;
Item : in Stream_Element_Array);
end My_Streams;
-- file my_streams.adb:
with Ada.Text_IO.Text_Streams;
with Ada.Characters.Handling;
package body My_Streams is
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
Std_Stream : Stream_Access := Stream(Current_Output);
procedure Read(Stream : in out My_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset) is
begin
-- forward to standard streams:
Read(Std_Stream.all, Item, Last);
end Read;
procedure Write(Stream : in out My_Stream;
Item : in Stream_Element_Array) is
Item_Uppercase : Stream_Element_Array := Item;
C : Character;
begin
for I in Item_Uppercase'Range loop
C := Character'Val(Item_Uppercase(I));
C := Ada.Characters.Handling.To_Upper(C);
Item_Uppercase(I) := Stream_Element(Character'Pos(C));
end loop;
-- forward to standard streams:
Write(Std_Stream.all, Item_Uppercase);
end Write;
end My_Streams;
-- file hello.adb:
with Ada.Text_IO.Text_Streams;
with My_Streams;
procedure Hello is
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
use My_Streams;
procedure Write_Hello(Stream : in out Stream_Access) is
begin
String'Write(Stream, "Hello");
end Write_Hello;
S1 : Stream_Access := Stream(Current_Output);
S2 : Stream_Access := new My_Stream;
begin
Write_Hello(S1);
New_Line;
Write_Hello(S2);
New_Line;
end Hello;
The result is:
$ ./hello
Hello
HELLO
$
The point here is that the Write_Hello procedure can be reused with
various streams, just like my foo functions in C++ (from initial post).
Is the code above correct? Any traps or problems that I don't see at the
moment?
--
Maciej Sobczak : http://www.msobczak.com/
Programming : http://www.msobczak.com/prog/
^ permalink raw reply [relevance 2%]
* Re: Char type verification
@ 2006-11-16 23:30 1% ` Yves Bailly
0 siblings, 0 replies; 200+ results
From: Yves Bailly @ 2006-11-16 23:30 UTC (permalink / raw)
Jeffrey R. Carter wrote:
>> It was intended as "How do you translate this example to Ada? How would
>> you, as a presumably experienced Ada coder, do it? What hoops would we
>> jump through?
>
> What this example does is output whether the 1st character of the 1st
> command-line argument is in the range 'A' .. 'Z'. In the Ada world, we
> tend to ignore the details of badly designed examples in poorly designed
> languages and simply implement the same functionality. Since there is no
> reason for your conversions and home-grown function, we're not going to
> waste effort translating them.
I'm very sorry Jeffrey, but I'm afraid you're missing the point. The given
example is no more than what it is : an example. There are plenty of ways
to know if a character is upper-case or not (what about the procedure
Is_Upper in the package Ada.Characters.Handling, by the way? did I missed
it in the replies?), and I'm quite sure Koray would have found most of them,
if not all (assuming it's possible).
As I understand it, the real question was : "having a list of contiguous
values of some type, how to know if a given value of that same type is
contained into the list". It's a kind of basic hashing: you can assume
to always be able to map your type's values to integers. So you can
replace "list of contiguous values" by "range of values".
So, here's my modest contribution. Don't bother to say it's overcomplex.
First create a generic package:
--8<-----8<-----8<-----8<-----8<-----8<-----8<---
generic
type T is private;
type H is range <>;
with function Hash(val: in T) return H;
package P is
function Is_In_Range(lower: in T;
upper: in T;
value: in T)
return Boolean;
end P;
--8<-----8<-----8<-----8<-----8<-----8<-----8<---
The body performs the actual check of validity:
--8<-----8<-----8<-----8<-----8<-----8<-----8<---
package body P is
function Is_In_Range(lower: in T;
upper: in T;
value: in T)
return Boolean is
begin
return Hash(value) in Hash(lower)..Hash(upper);
end Is_In_Range;
end P;
--8<-----8<-----8<-----8<-----8<-----8<-----8<---
And now use it in a test program:
--8<-----8<-----8<-----8<-----8<-----8<-----8<---
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with P;
procedure Test is
function To_Natural(c: in Character)
return Natural is
begin
return Natural(Character'Pos(c));
end To_Natural;
package P_Char is new P(T => Character,
H => Natural,
Hash => To_Natural);
c: Character;
begin
c := Argument(1)(1);
Put("Is_Upper('" & c & "') = ");
Put_Line(Boolean'Image(P_Char.Is_In_Range('A', 'Z', c)));
end Test;
--8<-----8<-----8<-----8<-----8<-----8<-----8<---
Isn't Ada delightfull? :-)
Regards,
--
(o< | Yves Bailly : http://kafka-fr.net | -o)
//\ | Linux Dijon : http://www.coagul.org | //\
\_/ | | \_/`
^ permalink raw reply [relevance 1%]
* Re: Char type verification
2006-11-15 21:57 3% ` Georg Bauhaus
@ 2006-11-15 23:15 0% ` KE
0 siblings, 1 reply; 200+ results
From: KE @ 2006-11-15 23:15 UTC (permalink / raw)
Dear George
Many thanks for your detailed answer. I'll most certainly make use of
your advice. However, if you look again, my question was not
- How can I verify whether a character is upper case
Nor was it
- Where, in the library hierarchies of Ada, can I find the character
handling routines
It was intended as "How do you translate this example to Ada? How would
you, as a presumably experienced Ada coder, do it? What hoops would we
jump through?
In other words, I wanted to see some Ada idioms in action to create a
transparent coding of this.
If you believe this simple exercise is not a productive use of your
time, though, I can understand.
Thanks again.
-- KE
Georg Bauhaus wrote:
[snip...]
>
> Or use Ada.Characters.Handling.Is_Upper(c), if you want
> to include characters outside 7bit ASCII.
>
> The C type char, which IIRC might start at -127 or
> at 0, has an implementation defined representation,
> and is a bit vague. The Ada standard frowns upon vague
> things, hence Ada's character type does not have
> theses issues. OTOH, for interfacing with C,
> look at the standard package Interfaces.C.
>
> For more general uses, there are standard packages
> Ada.Strings.Maps, Ada.Strings.Maps.Constants,
> Ada.Characters.Handling, and Ada.Characters.Latin_1.
> There are all kinds of character predicates and
> translation subprograms.
>
> There are variants for Wide_Character, covering
> the BMP of ISO 10646.
>
> Ada 2005, in addition supports Unicode and related
> subprograms.
^ permalink raw reply [relevance 0%]
* Re: Char type verification
@ 2006-11-15 21:57 3% ` Georg Bauhaus
2006-11-15 23:15 0% ` KE
0 siblings, 1 reply; 200+ results
From: Georg Bauhaus @ 2006-11-15 21:57 UTC (permalink / raw)
On Wed, 2006-11-15 at 14:00 -0800, KE wrote:
> Hi
>
> Assume that I have the following C code:
>
> #include <stdio.h>
>
> #define uchar unsigned char
>
>
> static uchar UCASE[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
This is the character range 'A' .. 'Z'.
You can simply write
c in 'A' .. 'Z'
in any Boolean context where c is of type Character.
Or use Ada.Characters.Handling.Is_Upper(c), if you want
to include characters outside 7bit ASCII.
The C type char, which IIRC might start at -127 or
at 0, has an implementation defined representation,
and is a bit vague. The Ada standard frowns upon vague
things, hence Ada's character type does not have
theses issues. OTOH, for interfacing with C,
look at the standard package Interfaces.C.
For more general uses, there are standard packages
Ada.Strings.Maps, Ada.Strings.Maps.Constants,
Ada.Characters.Handling, and Ada.Characters.Latin_1.
There are all kinds of character predicates and
translation subprograms.
There are variants for Wide_Character, covering
the BMP of ISO 10646.
Ada 2005, in addition supports Unicode and related
subprograms.
^ permalink raw reply [relevance 3%]
* Re: Advice Please
2006-11-10 6:52 2% Advice Please laehyung
@ 2006-11-10 9:27 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2006-11-10 9:27 UTC (permalink / raw)
On 9 Nov 2006 22:52:15 -0800, laehyung wrote:
> Advice & comments please.
> my test code is ...
>
> with Ada.Text_IO; use Ada.Text_IO;
>
> with Ada.Characters.Handling;
> use Ada.Characters.Handling;
> with Ada.Unchecked_Conversion;
> with Interfaces; use Interfaces;
> with Interfaces.C;
>
> procedure Test_Str is
>
> ---------------------------------------
> function Conv_U8_To_Char is
> new Ada.Unchecked_Conversion(Source => Unsigned_8,
> Target => Character);
> function Conv_Char_To_U8 is
> new Ada.Unchecked_Conversion(Source => Character,
> Target => Unsigned_8);
>
> ---------------------------------------
>
> function Strhex_To_Ascii_Strbyte (Item : in String) return String is
>
> Strsize : Natural := Item'Length;
> Rtn_Length : Natural := (Strsize)/2;
>
> Str_Val : String(1..Rtn_Length);
>
> Strtemp1 : Unsigned_8;
> Strtemp2 : Unsigned_8;
> C : array(1..Strsize) of Unsigned_8;
>
> begin
>
> for Idx in Item'range loop
> if Is_Hexadecimal_Digit(Item(Idx)) then
> if Is_Digit(Item(Idx)) then
> C(Idx):=
> Unsigned_8(Character'Pos(Item(Idx))-Character'Pos('0'));
> else
> C(Idx):= Unsigned_8(Character'Pos(To_Upper(Item(Idx)))
> -Character'Pos('A')+16#A#);
> end if;
> else
> Put_Line("Program Code contains NON-HexaDecimal character.
> program Break");
> raise Data_Error;
> end if;
> end loop;
>
> for I in 1..Rtn_Length loop
> Strtemp1 := Shift_Left(Unsigned_8(C(2*I-1)),4) and
> Unsigned_8(16#FF#);
> Strtemp2 := Unsigned_8(C(2*I)) and Unsigned_8(16#FF#);
>
> Str_Val(I) := Conv_U8_To_Char( Strtemp1 or Strtemp2 );
>
> end loop;
>
> return Str_Val;
> end Strhex_To_Ascii_Strbyte;
> ---------------------------------------
>
>
> Input_Str : String := "0000002D0F010000002E0F000000000A10A3";
>
> begin
>
> --Put("Output_Str =>");
> Put(Strhex_To_Ascii_Strbyte(Input_Str));
>
> end Test_Str;
>
> ----------------------------------------------------------------
> (my machine is windows XP)
> Compile & Run:
>
> c:\work>gnatmke -O2 -gnatvf test_str
> gcc -c -O2 -gnatvf test_str.adb
>
> GNAT GPL 2006 (20060522-34)
> Copyright 1992-2006, Free Software Foundation, Inc.
>
> Compiling: test_str.adb (source file time stamp: 2006-11-10 05:22:28)
> 68 lines: No errors
> gnatbind -x test_str.ali
> gnatlink test_str.ali
>
> c:\work> test_str > code_test.txt
>
> edit code_test.txt file with hexa code editor(ex. UltraEdit-32)
>
> output data shold be
> 00000000h:00 00 00 2D 0F 01 00 00 00 2E 0F 00 00 00 00 00
> ;...-............
> 00000010h:0A 10 A3 0D 0A ;..?.
No, it should not. I should be (in a binary output mode):
00 00 00 2D 0F 01 00 00 00 2E 0F 00 00 00 00 0A 10 A3
four zeros before the last triplet. Note also that when you write a text
file the OS may translate formatters (like LF and CR). That explains the
effect you've got. 0A was translated into 0D 0A pair.
> but result is
> 00000000h:00 00 00 2D 0F 01 00 00 00 2E 0F 00 00 00 00 0D
> ;...-............
> 00000010h:0A 10 A3 0D 0A ;..?.
>
> the data of address 0Fh is 0D, why?
> How to correct this problem.
There is no problem, your code works.
Admittedly, the code needs much rework both in terms of efficiency and
clarity. Use case statement for character classification or else a
translation map. You don't need the array C, everything can be done in one
pass. You don't need modular arithmetic and masking. Use integer
multiplication and addition. Use 'Val attribute instead of
Unchecked_Conversion. What would be the result for an odd-length string?
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Advice Please
@ 2006-11-10 6:52 2% laehyung
2006-11-10 9:27 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: laehyung @ 2006-11-10 6:52 UTC (permalink / raw)
Advice & comments please.
my test code is ...
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Handling;
use Ada.Characters.Handling;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
with Interfaces.C;
procedure Test_Str is
---------------------------------------
function Conv_U8_To_Char is
new Ada.Unchecked_Conversion(Source => Unsigned_8,
Target => Character);
function Conv_Char_To_U8 is
new Ada.Unchecked_Conversion(Source => Character,
Target => Unsigned_8);
---------------------------------------
function Strhex_To_Ascii_Strbyte (Item : in String) return String is
Strsize : Natural := Item'Length;
Rtn_Length : Natural := (Strsize)/2;
Str_Val : String(1..Rtn_Length);
Strtemp1 : Unsigned_8;
Strtemp2 : Unsigned_8;
C : array(1..Strsize) of Unsigned_8;
begin
for Idx in Item'range loop
if Is_Hexadecimal_Digit(Item(Idx)) then
if Is_Digit(Item(Idx)) then
C(Idx):=
Unsigned_8(Character'Pos(Item(Idx))-Character'Pos('0'));
else
C(Idx):= Unsigned_8(Character'Pos(To_Upper(Item(Idx)))
-Character'Pos('A')+16#A#);
end if;
else
Put_Line("Program Code contains NON-HexaDecimal character.
program Break");
raise Data_Error;
end if;
end loop;
for I in 1..Rtn_Length loop
Strtemp1 := Shift_Left(Unsigned_8(C(2*I-1)),4) and
Unsigned_8(16#FF#);
Strtemp2 := Unsigned_8(C(2*I)) and Unsigned_8(16#FF#);
Str_Val(I) := Conv_U8_To_Char( Strtemp1 or Strtemp2 );
end loop;
return Str_Val;
end Strhex_To_Ascii_Strbyte;
---------------------------------------
Input_Str : String := "0000002D0F010000002E0F000000000A10A3";
begin
--Put("Output_Str =>");
Put(Strhex_To_Ascii_Strbyte(Input_Str));
end Test_Str;
----------------------------------------------------------------
(my machine is windows XP)
Compile & Run:
c:\work>gnatmke -O2 -gnatvf test_str
gcc -c -O2 -gnatvf test_str.adb
GNAT GPL 2006 (20060522-34)
Copyright 1992-2006, Free Software Foundation, Inc.
Compiling: test_str.adb (source file time stamp: 2006-11-10 05:22:28)
68 lines: No errors
gnatbind -x test_str.ali
gnatlink test_str.ali
c:\work> test_str > code_test.txt
edit code_test.txt file with hexa code editor(ex. UltraEdit-32)
output data shold be
00000000h:00 00 00 2D 0F 01 00 00 00 2E 0F 00 00 00 00 00
;...-............
00000010h:0A 10 A3 0D 0A ;..?.
but result is
00000000h:00 00 00 2D 0F 01 00 00 00 2E 0F 00 00 00 00 0D
;...-............
00000010h:0A 10 A3 0D 0A ;..?.
the data of address 0Fh is 0D, why?
How to correct this problem.
^ permalink raw reply [relevance 2%]
* Re: Regular Expressions in Ada 2005?
@ 2006-11-08 21:14 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2006-11-08 21:14 UTC (permalink / raw)
On Wed, 2006-11-08 at 12:53 -0800, matthias.kistler@gmx.de wrote:
> Hi!
>
> Does anybody know, if it's possible to use regular expressions in Ada
> 2005? I come from Perl and I'm very interested in Ada but it's useless
> for me without the possibility of using regular expressions similar to
> Perl.
Ada comes with a rich set of string manipulation packages,
Ada.Strings.*, Ada.Characters.*, Ada.*Text_IO.Editing.
They cover a fair bit of what you would do using Perl's expressions
and translation operators in a sane way.
> I found a GNAT-package providing only a regex-matcher. But I also
> need a replacer. Elsewise it'd be useless for me.
The GNAT packages do provide scanning and replacement. There is a
tutorial in the package specifications.
Example programs:
http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=gnat&id=3
http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=gnat&id=4
#3 uses Unix style regular expressions.
#4 uses SPITBOL regular expressions.
SPITBOL patterns are quite powerful and fast, in fact you
can write an entire program just as a pattern. But don't do
that.
Georg
^ permalink raw reply [relevance 2%]
* Re: New_Page
[not found] <zH%1h.42912$XE5.888@reader1.news.jippii.net>
@ 2006-11-01 12:19 0% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2006-11-01 12:19 UTC (permalink / raw)
On Wed, 2006-11-01 at 13:39 +0200, Tapio Marjomäki wrote:
> Hi,
>
> could somebody tell why the procedure below does not run as expected?
>
> with Ada.Text_IO; use Ada.Text_IO;
> -- with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
> procedure Page is
$ ./page |cat -v
0
New page
^LNew page
^LNew page
^L
I believe the ^L is called a format effector, to be interpreted
by the printer or terminal.
-- Georg
^ permalink raw reply [relevance 0%]
* Re: Cursor control question - ncurses and alternatives
2006-10-13 16:32 2% Cursor control question - ncurses and alternatives Dr. Adrian Wrigley
@ 2006-10-13 22:41 2% ` Björn Persson
0 siblings, 0 replies; 200+ results
From: Björn Persson @ 2006-10-13 22:41 UTC (permalink / raw)
Dr. Adrian Wrigley wrote:
> At the most basic level, I want to move the cursor to the start
> of the line, update the prompt, and move the cursor back to
> where it was. How can I do this?
While there are escape sequences for querying, saving and restoring the
cursor position, I think you'll get the best result if you know what's
in the command buffer so that you can update the entire command line.
That means you'll have to do the line editing yourself. It could look
something like this:
with Text_IO;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
procedure TimDat is
Count : Integer := 1000;
Message : String := "Hello";
Buffer : Unbounded_String;
procedure Update is
begin
Text_IO.Put (ESC & "[2K" & CR & Integer'Image (Count) & " - " &
Message & " > " & To_String(Buffer));
end Update;
task ShowClock;
task body ShowClock is
begin
loop
Count := Count + 1;
Update;
delay 1.0;
end loop;
end ShowClock;
Keypress : Character;
begin
loop
Text_IO.Get_Immediate (Keypress);
case Keypress is
when DEL =>
if Length (Buffer) > 0 then
-- Delete the last character.
Head (Buffer, Length (Buffer) - 1);
Update;
end if;
when ESC =>
-- Handle arrow keys and stuff.
null;
when LF | CR =>
Text_IO.New_Line;
Text_IO.Put_Line ("Command was """ & To_String(Buffer) &
""".");
Head (Buffer, 0); -- reset
Update;
-- and so on for other special characters
when others =>
Append (Buffer, Keypress);
Update;
end case;
end loop;
end TimDat;
There are most likely race conditions in that code, but I'm sure you can
fix that. You'll also need to decide what to do when the command line
gets so long that it wraps. To know whether it wraps you need to find
out how wide the window is.
For advanced line editing you may want to look at the Readline library �
at least for inspiration.
--
Bj�rn Persson PGP key A88682FD
omb jor ers @sv ge.
r o.b n.p son eri nu
^ permalink raw reply [relevance 2%]
* Cursor control question - ncurses and alternatives
@ 2006-10-13 16:32 2% Dr. Adrian Wrigley
2006-10-13 22:41 2% ` Björn Persson
0 siblings, 1 reply; 200+ results
From: Dr. Adrian Wrigley @ 2006-10-13 16:32 UTC (permalink / raw)
Hi!
This should be a fairly simple Ada problem to solve...
I'm trying to build a small, text-based, real-time application,
to run in an xterm under Linux.
I want the user to be prompted to type in a command with a
prompt which shows the time, along with some other dynamic
information.
As the user types in a command, the prompt should continue
updating, until return is pressed. Then the updating stops,
an action is performed, and the prompt appears on another line.
What Ada library is likely to be easiest to use for cursor
control? I hear there is an ncurses binding, but this seems
to have hundreds of calls.
At the most basic level, I want to move the cursor to the start
of the line, update the prompt, and move the cursor back to
where it was. How can I do this?
I have some test code, shown below, to illustrate the problem.
Currently, the cursor moves to the end of the prompt
spontaneously, when it should be at the end of the user's command.
I don't want to take over the xterm with a "full-screen" application,
I just want to enter a series of commands in a scrolling terminal.
Is this a job for ncurses? What function is needed?
Or is there a better way?
Thanks for your suggestions!
--
Adrian
with Text_IO;
with Ada.Characters.Latin_1;
procedure TimDat is
Count : Integer := 1000;
function A return Integer is
begin
Count := Count + 1;
return Count;
end A;
Message : String := "Hello";
CR : constant Character := Ada.Characters.Latin_1.CR;
task ShowClock;
task body ShowClock is
begin
loop
declare
S : String := Integer'Image (A);
begin
Text_IO.Put (CR & S & " - " & Message & " > ");
end;
delay 1.0;
end loop;
end ShowClock;
begin
loop
declare
Command : String := Text_IO.Get_Line (Text_IO.Standard_Input);
begin
Text_IO.Put_Line ("Command was """ & Command & """");
end;
end loop;
end TimDat;
----------------------------------------------------------------
^ permalink raw reply [relevance 2%]
* Re: ANNOUNCE: Avatox 1.0 is now available
2006-09-09 12:21 3% ` Simon Wright
@ 2006-09-11 7:58 0% ` Manuel Collado
0 siblings, 0 replies; 200+ results
From: Manuel Collado @ 2006-09-11 7:58 UTC (permalink / raw)
Simon Wright escribi�:
> Manuel Collado <m.collado@fi.upm.es> writes:
>
>> What puzzles me is that the XML structure (nesting) doesn't follows
>> the lexical Ada source structure. Example from avatox.adb -->
>> avatox.adb.xml:
>>
>> <A_CLAUSE ... startLine="29" endLine="29" startCol="1" endCol="29">
>> <A_WITH_CLAUSE ... startLine="29" endLine="29" startCol="1" endCol="29"/>
>> <AN_EXPRESSION ... startLine="29" endLine="29" startCol="6" endCol="28">
>> <A_SELECTED_COMPONENT ... startLine="29" endLine="29" startCol="6"
>> endCol="28"/>
>> <AN_EXPRESSION ... startLine="29" endLine="29" startCol="6" endCol="19">
>> ....
>>
>> You can see that <A_WITH_CLAUSE> from (29,1) to (29,29) lexically
>> contains <AN_EXPRESSION> from (29,6) to (29,28). But the latest is not
>> nested inside the former. Instead, it appears as a sibling of it.
>
> Marc and I disagree on this one. My approach in asis2xml is to have
>
> <context_clauses>
> <with_clause>
> <selected_component>
> <selected_component>
> <identifier>Ada</identifier>
> <identifier>Characters</identifier>
> </selected_component>
> <identifier>Handling</identifier>
> </selected_component>
> </with_clause>
>
> but it would be just as sensible to have
>
> <clause kind="with_clause">
>
> The XPATH expressions aren't that different:
>
> A_CLAUSE[A_WITH_CLAUSE]
> with_clause
> clause[@kind='with_clause']
>
> It depends what would be most useful. As an example of where user
> input would be good, what about that <selected_component> structure,
> which does follow the lexical structure of the language, but imagine
> the query to find all withs of Ada.Characters.Handling!
Well, the // (descendant) axis of XPATH looks directly for inner nodes,
skipping intermediate levels.
--
Manuel Collado
^ permalink raw reply [relevance 0%]
* Re: ANNOUNCE: Avatox 1.0 is now available
@ 2006-09-09 12:21 3% ` Simon Wright
2006-09-11 7:58 0% ` Manuel Collado
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2006-09-09 12:21 UTC (permalink / raw)
Manuel Collado <m.collado@fi.upm.es> writes:
> What puzzles me is that the XML structure (nesting) doesn't follows
> the lexical Ada source structure. Example from avatox.adb -->
> avatox.adb.xml:
>
> <A_CLAUSE ... startLine="29" endLine="29" startCol="1" endCol="29">
> <A_WITH_CLAUSE ... startLine="29" endLine="29" startCol="1" endCol="29"/>
> <AN_EXPRESSION ... startLine="29" endLine="29" startCol="6" endCol="28">
> <A_SELECTED_COMPONENT ... startLine="29" endLine="29" startCol="6"
> endCol="28"/>
> <AN_EXPRESSION ... startLine="29" endLine="29" startCol="6" endCol="19">
> ....
>
> You can see that <A_WITH_CLAUSE> from (29,1) to (29,29) lexically
> contains <AN_EXPRESSION> from (29,6) to (29,28). But the latest is not
> nested inside the former. Instead, it appears as a sibling of it.
Marc and I disagree on this one. My approach in asis2xml is to have
<context_clauses>
<with_clause>
<selected_component>
<selected_component>
<identifier>Ada</identifier>
<identifier>Characters</identifier>
</selected_component>
<identifier>Handling</identifier>
</selected_component>
</with_clause>
but it would be just as sensible to have
<clause kind="with_clause">
The XPATH expressions aren't that different:
A_CLAUSE[A_WITH_CLAUSE]
with_clause
clause[@kind='with_clause']
It depends what would be most useful. As an example of where user
input would be good, what about that <selected_component> structure,
which does follow the lexical structure of the language, but imagine
the query to find all withs of Ada.Characters.Handling!
^ permalink raw reply [relevance 3%]
* Re: Usage of \ in Ada
2006-08-24 9:53 0% ` Dmitry A. Kazakov
@ 2006-08-24 17:16 0% ` Adam Beneschan
0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2006-08-24 17:16 UTC (permalink / raw)
Dmitry A. Kazakov wrote:
> On Thu, 24 Aug 2006 10:37:21 +0200, Jean-Pierre Rosen wrote:
>
> > Adam Beneschan a écrit :
> >> It's probably to prevent stupid errors. If you have a string literal
> >> with an LF in it, it's far more likely (using a fairly traditional
> >> representation of the source) that you've forgotten a closing quote
> >> than that you intended to put a linefeed in the literal. And if the
> >> language did try to allow a line separator in a string literal (even if
> >> it were represented as something like \n in the representation)
> >
> > And of course, if you really need an LF in a character string, just use
> > Ada.Characters.Latin_1.LF ....
>
> Sure, but that is not the point.
Well, J-P's point is sort of pertinent. The question I was trying to
answer was, what was the reason for Ada not allowing control characters
inside string literals. And whatever reasons the authors might have
had for thinking allowing them was a bad idea, the fact is that it's
relatively easy in Ada to find another way to include such characters
in a string value, simply by using the concatenate operator and
A.C.L.LF or whatever, so there's no pressing need to find a way to
represent them inside string literals. Trying to do the same thing in
C, without using the special escape sequences, is pretty painful.
-- Adam
^ permalink raw reply [relevance 0%]
* Re: Usage of \ in Ada
2006-08-24 8:37 2% ` Jean-Pierre Rosen
@ 2006-08-24 9:53 0% ` Dmitry A. Kazakov
2006-08-24 17:16 0% ` Adam Beneschan
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2006-08-24 9:53 UTC (permalink / raw)
On Thu, 24 Aug 2006 10:37:21 +0200, Jean-Pierre Rosen wrote:
> Adam Beneschan a �crit :
>> It's probably to prevent stupid errors. If you have a string literal
>> with an LF in it, it's far more likely (using a fairly traditional
>> representation of the source) that you've forgotten a closing quote
>> than that you intended to put a linefeed in the literal. And if the
>> language did try to allow a line separator in a string literal (even if
>> it were represented as something like \n in the representation)
>
> And of course, if you really need an LF in a character string, just use
> Ada.Characters.Latin_1.LF ....
Sure, but that is not the point. The problem is which code positions are
illegal (non-graphic_character). Consider it from the position of the
designer of a compiler/parser/scanner. (That was the OP question all about)
The same question arises for the designer of an automated code generator
tool. Which encoding-legal code positions can be safely put into string
literals?
ARM 2.1(17) reads "Every code position of ISO 10646 BMP that is not
reserved for a control function is defined to be a graphic_character by
this International Standard. This includes all code positions other than
0000 - 001F, 007F - 009F, and FFFE - FFFF."
I am not a native English speaker, so it is difficult to me to decipher the
above.
Let S be the set of code positions 0..1F U 7F..9F U FFFE..FFFF.
My question to language lawyers is about the relation between S and
graphic_character:
1. Can some x of S be graphic_character?
(do S and graphic_character intersect)
2. Is any y outside S graphic_character?
(is complement of S a subset of graphic_character)
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Usage of \ in Ada
@ 2006-08-24 8:37 2% ` Jean-Pierre Rosen
2006-08-24 9:53 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Jean-Pierre Rosen @ 2006-08-24 8:37 UTC (permalink / raw)
Adam Beneschan a �crit :
> It's probably to prevent stupid errors. If you have a string literal
> with an LF in it, it's far more likely (using a fairly traditional
> representation of the source) that you've forgotten a closing quote
> than that you intended to put a linefeed in the literal. And if the
> language did try to allow a line separator in a string literal (even if
> it were represented as something like \n in the representation)
And of course, if you really need an LF in a character string, just use
Ada.Characters.Latin_1.LF ....
--
---------------------------------------------------------
J-P. Rosen (rosen@adalog.fr)
Visit Adalog's web site at http://www.adalog.fr
^ permalink raw reply [relevance 2%]
* Re: New to Ada, noticing something strange.
2005-09-29 23:58 2% ` mike.martelli
2005-09-30 0:28 2% ` mike.martelli
@ 2005-09-30 6:06 2% ` Jeffrey R. Carter
1 sibling, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2005-09-30 6:06 UTC (permalink / raw)
mike.martelli@gmail.com wrote:
> charMap: array (Character) of Integer;
You have undefined elements of this array, and may well be referencing them. You
should probably initialize all of them:
type Char_Mapping is array (Character) of Integer;
Char_Map : Char_Mapping :=
('0' => 0, '1' => 1, '2' => 2, ... 'F' => 15, others => -16);
> NumOfArgs, size, carry: Integer := 0;
By making these Integer, you're implying that negative values are meaningful.
These should probably be Natural. Size should probably be Positive.
> size := Length(operand1);
Why are you using a global variable here? Especially since it doesn't seem to be
referenced anywhere else?
> when others => return strChar(1);
when others =>
return Strchar (Strchar'First);
> --converts all lowercase characters to uppercase
Ada.Characters.Handling.To_Upper, as you noted elsewhere.
> if charMap(To_String(operand1)(i)) >= charMap(charBase) then
Here you can be referencing uninitialized values of Charmap, since the program
has no control over the arguments it receives.
> for i in reverse 1 .. ResultSize(operand1,operand2) loop
> digit := AddDigits(To_String(operand1)(i), To_String(operand2)(i));
One of these strings may be shorter than the result of Resultsize, and when you
try to index it with that value (first time through the loop), this should raise
Constraint_Error.
So, what inputs did you run this with, and what output did you obtain?
--
Jeff Carter
"There's no messiah here. There's a mess all right, but no messiah."
Monty Python's Life of Brian
84
^ permalink raw reply [relevance 2%]
* Re: New to Ada, noticing something strange.
2005-09-29 23:58 2% ` mike.martelli
@ 2005-09-30 0:28 2% ` mike.martelli
2005-09-30 6:06 2% ` Jeffrey R. Carter
1 sibling, 0 replies; 200+ results
From: mike.martelli @ 2005-09-30 0:28 UTC (permalink / raw)
Also, I know I could use the To_Upper function in the
Ada.Characters.Handling package. I wasn't using it at first for some
reason, but now am.
^ permalink raw reply [relevance 2%]
* Re: New to Ada, noticing something strange.
@ 2005-09-29 23:58 2% ` mike.martelli
2005-09-30 0:28 2% ` mike.martelli
2005-09-30 6:06 2% ` Jeffrey R. Carter
0 siblings, 2 replies; 200+ results
From: mike.martelli @ 2005-09-29 23:58 UTC (permalink / raw)
Ok, Randy sounds good here is my code. I also tried compiling in on
Laptop with the latest GNAT compilier and I get the same results.
==================================================
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Characters.Handling;
use Ada.Text_IO;
use Ada.Integer_Text_IO;
use Ada.Command_Line;
use Ada.Strings.Unbounded;
procedure BigInts is
base, operand1, operand2: Unbounded_String :=
To_Unbounded_String("");
charMap: array (Character) of Integer;
NumOfArgs, size, carry: Integer := 0;
charBase, digit, charDigit: Character;
procedure PopulateArray is
begin
charMap('0') := 0;
charMap('1') := 1;
charMap('2') := 2;
charMap('3') := 3;
charMap('4') := 4;
charMap('5') := 5;
charMap('6') := 6;
charMap('7') := 7;
charMap('8') := 8;
charMap('9') := 9;
charMap('A') := 10;
charMap('B') := 11;
charMap('C') := 12;
charMap('D') := 13;
charMap('E') := 14;
charMap('F') := 15;
end PopulateArray;
function ResultSize(operand1, operand2: Unbounded_String) return
Integer is
begin
if Length(operand1) > Length(operand2) then
size := Length(operand1);
else
size := Length(operand2);
end if;
return size;
end ResultSize;
function Convert2Character(strChar: String) return Character is
begin
--Put_Line(strChar);
case Integer'Value(strChar) is
when 10 => return 'A';
when 11 => return 'B';
when 12 => return 'C';
when 13 => return 'D';
when 14 => return 'E';
when 15 => return 'F';
when others => return strChar(1);
end case;
end Convert2Character;
function AddDigits(charOp1, charOp2: Character) return Character is
begin
charDigit := Convert2Character(Integer'Image(charMap(charOp1) +
charMap(charOp2) + carry));
Put("Print1: ");
Put(Convert2Character(Integer'Image(charMap(charOp1) +
charMap(charOp2) + carry)));
if (charMap(charOp1) + charMap(charOp2) + carry) >
(charMap(charBase) - 1) then
Put_Line("here1: ");
charDigit := Convert2Character(Integer'Image(charMap(charBase) -
1)); --Set the digit to the highest possible values
carry := (charMap(charOp1) + charMap(charOp2) + carry) -
(charMap(charBase) - 1); --carry is all of the rest
else
Put_Line("here2: ");
carry := 0; --there is no carry
end if;
Put("Digit: ");
Put(charDigit);
New_Line;
Put("Carry: ");
Put(carry);
New_Line;
return charDigit;
end AddDigits;
begin
NumOfArgs := ARGUMENT_COUNT;
if NumOfArgs = 3 then
base := To_Unbounded_String(Argument(1));
operand1 := To_Unbounded_String(Argument(2));
operand2 := To_Unbounded_String(Argument(3));
if not (Integer'Value(To_String(base)) > 1) or not
(Integer'Value(To_String(base)) < 16) then
Put("The base entered is not valid.");
return;
end if;
charBase := Convert2Character(To_String(base));
--converts all lowercase characters to uppercase
for i in 1 .. Length(operand1) loop
case Element(operand1, i) is
when 'a' => Replace_Element(operand1, i, 'A');
when 'b' => Replace_Element(operand1, i, 'B');
when 'c' => Replace_Element(operand1, i, 'C');
when 'd' => Replace_Element(operand1, i, 'D');
when 'e' => Replace_Element(operand1, i, 'E');
when 'f' => Replace_Element(operand1, i, 'F');
when others => Replace_Element(operand1, i, Element(operand1, i));
end case;
end loop;
--converts all lowercase characters to uppercase
for i in 1 .. Length(operand2) loop
case Element(operand2, i) is
when 'a' => Replace_Element(operand2, i, 'A');
when 'b' => Replace_Element(operand2, i, 'B');
when 'c' => Replace_Element(operand2, i, 'C');
when 'd' => Replace_Element(operand2, i, 'D');
when 'e' => Replace_Element(operand2, i, 'E');
when 'f' => Replace_Element(operand2, i, 'F');
when others => Replace_Element(operand2, i, Element(operand2, i));
end case;
end loop;
PopulateArray;
for i in 1 .. Length(operand1) loop
if charMap(To_String(operand1)(i)) >= charMap(charBase) then
Put_Line("Operand 1 is not valid with the base entered");
return;
end if;
end loop;
for i in 1 .. Length(operand2) loop
if charMap(To_String(operand2)(i)) >= charMap(charBase) then
Put_Line("Operand 2 is not valid with the base entered");
return;
end if;
end loop;
for i in reverse 1 .. ResultSize(operand1,operand2) loop
digit := AddDigits(To_String(operand1)(i), To_String(operand2)(i));
Put(digit);
New_Line;
end loop;
--Print final carry digit
Put("Final Carry: ");
Put(carry);
New_Line;
else
Put("Not enough args");
return;
end if;
end BigInts;
^ permalink raw reply [relevance 2%]
* New to Ada, noticing something strange.
@ 2005-09-29 17:20 1% mike.martelli
0 siblings, 1 reply; 200+ results
From: mike.martelli @ 2005-09-29 17:20 UTC (permalink / raw)
Here is an excerpt of my code. Every function works as it should, the
program is set up correct, and the correct values are being passed to
all functions.
The idea of the program is perform arithmetic on arbitrarily long
integers that are inputted as strings using the paper and pencil
approach (digit by digit, from right from right to left, with a carry
digit). The user will enter a base, operand1, and operan2 via command
line arguments. (if you need more explanation let me know).
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Characters.Handling;
use Ada.Text_IO;
use Ada.Integer_Text_IO;
use Ada.Command_Line;
use Ada.Strings.Unbounded;
procedure BigInts is
...
charMap: array (Character) of Integer;
charMap('0') := 0;
charMap('1') := 1;
charMap('2') := 2;
...
charMap('E') := 14;
charMap('F') := 15;
function C2C(strChar: String) return Character is
begin
Put_Line(strChar);
case Integer'Value(strChar) is
when 10 => return 'A';
when 11 => return 'B';
when 12 => return 'C';
when 13 => return 'D';
when 14 => return 'E';
when 15 => return 'F';
when others => return strChar(1);
end case;
end C2C;
function AddDigits(op1, op2: Character) return Character is
begin
charDigit:=C2C(Integer'Image(charMap(op1)+charMap(op2)+carry));
Put("Print1: ");
Put(C2C(Integer'Image(charMap(op1)+charMap(op2)+carry)));
if(charMap(op1)+charMap(op2)+carry)>(charMap(charBase)-1) then
Put_Line("here1: ");
--Set the digit to the highest possible values
charDigit:=C2C(Integer'Image(charMap(charBase)-1));
--carry is all of the rest
carry:=(charMap(op1)+charMap(op2)+carry)-(charMap(charBase)-1);
else
Put_Line("here2: ");
carry:=0; --there is no carry
end if;
Put("Digit: ");
Put(charDigit);
New_Line;
Put("Carry: ");
Put(carry);
New_Line;
return charDigit;
end AddDigits;
...
end BigInts;
(I removed some extra white space so it would align better in the post)
I have some Put()/Put_Line() statements in AddDigits() for debugging
purposes. The problem is in Convert2Character(), nothing was ever
being returned by that function. I added the Put_Line(strChar) to make
sure a correct value was being passed to it. Once I added that
Put_Line() a value was being returned by the function and it was
correct. It seems that a Put_Line() is needed for some reason or it
does not do what it is supposed to do.
^ permalink raw reply [relevance 1%]
* Re: Lower
@ 2005-08-31 17:35 2% ` Frode Tennebø
0 siblings, 0 replies; 200+ results
From: Frode Tennebø @ 2005-08-31 17:35 UTC (permalink / raw)
On Wednesday 31 August 2005 19:07 TC wrote:
> there is a function that make lower of string?
Ada.Characters.Handling.To_Lower
-Frode
--
^ Frode Tenneb� | email: frode@tennebo.com | Frode@IRC ^
| with Standard.Disclaimer; use Standard.Disclaimer; |
^ permalink raw reply [relevance 2%]
* Re: Character set conversion
@ 2005-08-02 9:45 3% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2005-08-02 9:45 UTC (permalink / raw)
On Tue, 02 Aug 2005 03:57:42 -0400, Adaddict wrote:
> I'm looking for an Ada package that could provide me functions to convert
> strings from one to another character set, for example from Windows to
> MSDOS or to Unicode. Does that even exist? I've been looking everywhere
> but haven't found anything.
It is not clear what you actually need.
Windows Unicode = Wide_Character in Ada. So to convert Latin-1 (=Ada
String) to UCS-2 (=Ada Wide_String) you need just To_Wide_String (from
Ada.Characters.Handling.) [ If UTF-8 encoding is what you are looking for,
see http://www.dmitry-kazakov.de/ada/strings_edit.htm ]
As for MS-DOS character set, what do you mean by that, graphical
characters? I'm not sure if they are present in Unicode. Anyway, as others
have noted, Translate might be useful for you.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: ATC, an example please.
@ 2005-07-02 8:18 2% ` Craig Carey
0 siblings, 0 replies; 200+ results
From: Craig Carey @ 2005-07-02 8:18 UTC (permalink / raw)
On 30 Jun 2005 01:44:52 -0700, "e.coli" wrote:
>How [does] ATC work?
>Can you fix this example, please?.
with Ada.Text_IO;
with Ada.Characters.Handling;
with Ada.Exceptions;
procedure ATC_Test is
-- If compile with gnatmake in Windows, use "-gnatP" polling
package Tio renames Ada.Text_IO;
package ACH renames Ada.Characters.Handling;
procedure Put (X : String) renames Tio.Put;
procedure PutL (X : String) renames Tio.Put_Line;
procedure Slave; -- This procedure gets interrupted
procedure Slave is
begin
-- Seeming GNAT 3.15p NT bug: Abort_Defer kills the delay
-- statement (as well as blocking the abort as expected):
-- pragma Abort_Defer;
PutL ("Slave starts");
for Iteration in 1 .. 1_000 loop
Put (".");
delay 0.100;
end loop;
PutL (ASCII.LF & "Slave ends by itself");
end Slave;
task type Keyboard_Task_Type is
entry Got_Quit_Key;
end Keyboard_Task_Type;
type Keyboard_Task_Type_AP is access all Keyboard_Task_Type;
task body Keyboard_Task_Type
is
Ch : Character;
begin
PutL ("Keyboard task starts");
loop
Tio.Get_Immediate (Item => Ch);
Ch := ACH.To_Lower (String'(1 => Ch)) (1);
PutL (" """ & Ch & '"');
if Ch = 'q' then
accept Got_Quit_Key;
exit;
end if;
end loop;
PutL ("Keyboard task ends");
exception
when others => null;
end Keyboard_Task_Type;
task type Interruptible_Task is
entry Start (KT_In : Keyboard_Task_Type_AP);
end Interruptible_Task;
task body Interruptible_Task
is
KT : Keyboard_Task_Type_AP;
begin
PutL ("Interruptible task starts");
accept Start (KT_In : Keyboard_Task_Type_AP) do
KT := KT_In;
end Start;
<<REDO>>
select -- No aborting when not inside a task
KT.all.Got_Quit_Key; -- Now KT maybe becomes unusable
PutL ("Computation aborted");
then abort
PutL ("Starting computation. Press Q to quit");
Slave;
PutL ("Finished computation without abrting");
end select;
-- goto REDO; -- If a loop around the select, then
exception -- a "Tasking_Error" error occurs
when E : others => -- when a terminated KT task is used
PutL ("Interruptible_Task: " & -- GNAT hides error
Ada.Exceptions.Exception_Information (E));
end Interruptible_Task;
begin
declare
KT : aliased Keyboard_Task_Type;
IT : Interruptible_Task;
begin
IT.Start (KT_In => KT'Unchecked_Access);
end; -- First declared is last finalized
PutL ("Main program ends");
end ATC_Test;
% Compiled and run. Only tested in Windows 2003.
$ gnatmake atc_test.adb -gnatP -gnata -gnato -gnatq -O0 -g -gnatf
-gnatU -m -i -gnatwacfHlpru -gnatR3s -gnaty3abcefhiklM79nprt
-bargs -E -p -we -s -static -largs -v -v
$ atc_test.exe
---------------------------------------
Keyboard task starts
Interruptible task starts
Starting computation. Press Q to quit
Slave starts
.............. "y"
........ "q"
Keyboard task ends
Computation aborted
Main program ends
---------------------------------------
Perhaps experts (e.g. Mr Obry) can say why GNAT 3.15p ATC:
(a) only runs inside a task, and/or
(b) what's up with Abort_Defer feature of disabling the delay statement?.
Craig Carey
Auckland
^ permalink raw reply [relevance 2%]
* Re: Character'First, ASCII.NUL and others (Was: Re: TCP/IP Sockets with GNAT.Sockets)
2005-05-04 8:01 3% ` Character'First, ASCII.NUL and others (Was: Re: TCP/IP Sockets with GNAT.Sockets) Adrien Plisson
@ 2005-05-04 13:40 0% ` Poul-Erik Andreasen
0 siblings, 0 replies; 200+ results
From: Poul-Erik Andreasen @ 2005-05-04 13:40 UTC (permalink / raw)
Adrien Plisson wrote:
> Poul-Erik Andreasen wrote:
>
>> When i started developing job i tried with ASCII.NUL
>> things didn't work out(surely for som other reason);
>> they did when i first was using character'first.
>> (also surely for som other reason);
>
> >
>
>> Are there any reason why ASCII.NUL should be better;
>
>
> Character'First do not describe the NUL character. i mean, it is the NUL
> character, but you have to know the implementation details of type
> Character to see that it's first element is the NUL character.
>
> ASCII.NUL states explicitly that you are using the NUL character, that's
> why its use should be better.
>
> anyway, the package ASCII is described in ARM95 J.5, that means it is
> part of "Obsolescent Features". as said in the ARM, "Use of these
> features is not recommended in newly written programs.". so it is better
> than Character'First, but there exists a better way to write this.
>
> the better way is the use of Ada.Characters.Latin_1, which defines a
> constant NUL describing the NUL character. unfortunately, the package
> name is long, so you may have to write a use clause or a rename.
>
> with Ada.Text_IO,
> Ada.Characters.Latin_1;
> procedure Test is
> -- see comments below
> use Ada.Characters.Latin_1;
> package ASCII renames Ada.Characters.Latin_1;
> package Characters renames Ada.Characters.Latin_1;
>
> begin
> Ada.Text_IO.Put( Ada.Characters.Latin_1.NUL ); -- a bit long
>
> Ada.Text_IO.Put( NUL ); -- a bit short, NUL what ?
> -- NUL Character ? not sure...
>
> Ada.Text_IO.Put( ASCII.NUL ); -- not recommended, there is
> -- a risk of confusion
>
> Ada.Text_IO.Put( Characters.NUL ); -- this seems better !
> end Test;
>
> besides all this, when looking at Ada.Characters.Latin_1, we see that
> NUL is defined this way :
>
> NUL : constant Character := Character'Val(0);
>
> so if you just need NUL and want to avoid declarations, you may use
> Character'Val(0), which describes the NUL character better than
> Character'First.
>
point taken
thanks
Poul-Erik Andreasen
^ permalink raw reply [relevance 0%]
* Character'First, ASCII.NUL and others (Was: Re: TCP/IP Sockets with GNAT.Sockets)
@ 2005-05-04 8:01 3% ` Adrien Plisson
2005-05-04 13:40 0% ` Poul-Erik Andreasen
0 siblings, 1 reply; 200+ results
From: Adrien Plisson @ 2005-05-04 8:01 UTC (permalink / raw)
Poul-Erik Andreasen wrote:
> When i started developing job i tried with ASCII.NUL
> things didn't work out(surely for som other reason);
> they did when i first was using character'first.
> (also surely for som other reason);
>
> Are there any reason why ASCII.NUL should be better;
Character'First do not describe the NUL character. i mean, it is the
NUL character, but you have to know the implementation details of type
Character to see that it's first element is the NUL character.
ASCII.NUL states explicitly that you are using the NUL character,
that's why its use should be better.
anyway, the package ASCII is described in ARM95 J.5, that means it is
part of "Obsolescent Features". as said in the ARM, "Use of these
features is not recommended in newly written programs.". so it is
better than Character'First, but there exists a better way to write this.
the better way is the use of Ada.Characters.Latin_1, which defines a
constant NUL describing the NUL character. unfortunately, the package
name is long, so you may have to write a use clause or a rename.
with Ada.Text_IO,
Ada.Characters.Latin_1;
procedure Test is
-- see comments below
use Ada.Characters.Latin_1;
package ASCII renames Ada.Characters.Latin_1;
package Characters renames Ada.Characters.Latin_1;
begin
Ada.Text_IO.Put( Ada.Characters.Latin_1.NUL ); -- a bit long
Ada.Text_IO.Put( NUL ); -- a bit short, NUL what ?
-- NUL Character ? not sure...
Ada.Text_IO.Put( ASCII.NUL ); -- not recommended, there is
-- a risk of confusion
Ada.Text_IO.Put( Characters.NUL ); -- this seems better !
end Test;
besides all this, when looking at Ada.Characters.Latin_1, we see that
NUL is defined this way :
NUL : constant Character := Character'Val(0);
so if you just need NUL and want to avoid declarations, you may use
Character'Val(0), which describes the NUL character better than
Character'First.
--
rien
^ permalink raw reply [relevance 3%]
* Shootout: Word Frequency
@ 2005-04-14 1:28 2% Jeffrey Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2005-04-14 1:28 UTC (permalink / raw)
There have been some postings a solution to this in Ada, but I've only
now had a chance to check out the problem. I see that the Ada solution
is 168 LOC and 111 terminator semicolons. I'd be interested to know how
it compares to this version, which I posted here some time ago in
response to something else (some lines may wrap):
with Ada.Characters.Handling;
with Ada.Text_IO;
with Word_Count_Help;
procedure Word_Count is
use Ada.Characters.Handling;
use Ada.Text_IO;
use Word_Count_Help;
Word : Word_Input.Word;
Result : Word_Search.Result;
Set : Word_Search.Skip_List;
Item : Word_Info;
begin -- Word_Count
All_Words : loop
exit All_Words when End_Of_File;
Word_Input.Get (Word);
Item.Word := +To_Lower (+Word);
Result := Word_Search.Search (Set, Item);
if Result.Found then
Item.Count := Result.Item.Count + 1;
else
Item.Count := 1;
end if;
Word_Search.Insert (List => Set, Item => Item);
end loop All_Words;
Sort_Words : declare
type Context_Info is record
Index : Positive := 1;
List : Word_List (1 .. Word_Search.Length (Set) );
end record;
procedure Word_To_List (Item : in Word_Info; Context : in out
Context_Info; Continue : out Boolean) is
-- null;
begin -- Word_To_List
Continue := True;
Context.List (Context.Index) := Item;
Context.Index := Context.Index + 1;
end Word_To_List;
procedure Set_To_List is new Word_Search.Iterate (Context_Data =>
Context_Info, Action => Word_To_List);
Context : Context_Info;
begin -- Sort_Words
Set_To_List (List => Set, Context => Context);
Sort (Set => Context.List);
Output : for I in Context.List'range loop
Put_Line (Item => +Context.List (I).Word & Integer'Image
(Context.List (I).Count) );
end loop Output;
end Sort_Words;
end Word_Count;
with PragmARC.Assignment;
with PragmARC.Skip_List_Unbounded;
with PragmARC.Sort_Quick_In_Place;
with PragmARC.Word_Input;
package Word_Count_Help is
package Word_Input is new PragmARC.Word_Input;
function "+" (Right : Word_Input.Word) return String renames
Word_Input.V_String.To_String;
function "+" (Right : String) return Word_Input.Word;
type Word_Info is record
Word : Word_Input.Word;
Count : Natural := 0;
end record;
function "<" (Left : Word_Info; Right : Word_Info) return Boolean;
function ">" (Left : Word_Info; Right : Word_Info) return Boolean;
function "=" (Left : Word_Info; Right : Word_Info) return Boolean;
type Word_List is array (Positive range <>) of Word_Info;
procedure Assign is new PragmARC.Assignment (Element => Word_Info);
procedure Sort is new PragmARC.Sort_Quick_In_Place (Element =>
Word_Info, Index => Positive, Sort_Set => Word_List, "<" => ">");
package Word_Search is new PragmARC.Skip_List_Unbounded (Element =>
Word_Info);
end Word_Count_Help;
package body Word_Count_Help is
use type Word_Input.V_String.Bounded_String;
function "+" (Right : String) return Word_Input.Word is
-- null;
begin -- "+"
return Word_Input.V_String.To_Bounded_String (Right);
end "+";
function "<" (Left : Word_Info; Right : Word_Info) return Boolean is
-- null;
begin -- "<"
return Left.Word < Right.Word;
end "<";
function ">" (Left : Word_Info; Right : Word_Info) return Boolean is
-- null;
begin -- ">"
if Left.Count = Right.Count then
return Left.Word < Right.Word;
else
return Left.Count > Right.Count;
end if;
end ">";
function "=" (Left : Word_Info; Right : Word_Info) return Boolean is
-- null;
begin -- "="
return Left.Word = Right.Word;
end "=";
end Word_Count_Help;
which is 115 SLOC and 64 terminator semicolons. It could perhaps be sped
up by not checking End_Of_File and handling End_Error instead.
--
Jeff Carter
"Apart from the sanitation, the medicine, education, wine,
public order, irrigation, roads, the fresh water system,
and public health, what have the Romans ever done for us?"
Monty Python's Life of Brian
80
^ permalink raw reply [relevance 2%]
* Re: Ada bench : count words
2005-03-23 15:09 3% ` Marius Amado Alves
@ 2005-03-30 16:08 0% ` Andre
0 siblings, 0 replies; 200+ results
From: Andre @ 2005-03-30 16:08 UTC (permalink / raw)
Marius Amado Alves wrote:
>> I'll review this tomorrow on the bus to work (I think your program is
>> separating words at buffer end, and it should not).
>
>
> Done. Tmoran, sorry, my first sight was wrong, your algorithm is mostly
> fine. Minor reservations:
> - special statute given to CR; personally I think all characters
> (control or not) should count to total
> - reliance on Stream_Element representing one character; portable across
> all range of environments?
>
> My own program rewritten with Text_Streams attains the same speed as
> yours. The fact that it is structured doesn't hit performance
> significantly. Pragma Inline improves a little bit. Real times (ms) on
> my iBook, for input file repeated 2500 times, all compiled with only -O3:
> C ........................ 600
> Yours, or mine inlined ... 700
> Mine not inlined ......... 750
>
> So we should submit yours, or mine inlined. It will put Ada right after
> the Cs w.r.t. speed. W.r.t. executable file size Ada is much bigger. On
> my iBook:
> C ....... 15k
> Mine .... 423k
> Yours ... 459k
>
> W.r.t. source code size all are similar. Number of significant
> semicolons (Ada), or semicolons + {} blocks + #includes + #defines (C):
> C .............. 27
> Yours .......... 33
> Mine inlined ... 52
>
> My program follows for reference. It accepts the code for EOL as an
> argument. Default = 10 (LF).
>
> -- The Great Computer Language Shootout
> -- http://shootout.alioth.debian.org/
> --
> -- contributed by Guys De Cla
>
> with Ada.Characters.Handling;
> with Ada.Characters.Latin_1;
> with Ada.Command_Line;
> with Ada.Streams;
> with Ada.Streams.Stream_IO;
> with Ada.Strings.Fixed;
> with Ada.Text_IO;
> with Ada.Text_IO.Text_Streams;
>
> procedure Count_Words_Portable is
>
> use Ada.Characters.Handling;
> use Ada.Characters.Latin_1;
> use Ada.Command_Line;
> use Ada.Streams;
> use Ada.Streams.Stream_IO;
> use Ada.Text_IO;
> use Ada.Text_IO.Text_Streams;
>
> Buffer : Stream_Element_Array (1 .. 4096);
> Input_Stream : Ada.Text_IO.Text_Streams.Stream_Access
> := Ada.Text_IO.Text_Streams.Stream (Current_Input);
> EOL_Character_Pos : Stream_Element := Character'Pos (LF);
> Lines : Natural := 0;
> Words : Natural := 0;
> Total : Natural := 0;
> In_Word : Boolean := False;
> N : Stream_Element_Offset;
> Is_Separator : array (Stream_Element) of Boolean :=
> (0 .. 32 | 127 .. 159 => True, others => False);
>
> procedure Begin_Word is
> begin
> Words := Words + 1;
> In_Word := True;
> end;
>
> procedure End_Word is
> begin
> In_Word := False;
> end;
>
> procedure End_Line is
> begin
> Lines := Lines + 1;
> End_Word;
> end;
>
> procedure Count_Words (S : in Stream_Element_Array) is
> begin
> Total := Total + S'Length;
> for I in S'Range loop
> if S (I) = EOL_Character_Pos then
> End_Line;
> else
> if Is_Separator (S (I)) then
> if In_Word then End_Word; end if;
> else
> if not In_Word then Begin_Word; end if;
> end if;
> end if;
> end loop;
> end;
>
> pragma Inline (Begin_Word, End_Word, End_Line, Count_Words);
>
> begin
> begin
> EOL_Character_Pos := Stream_Element'Value (Argument (1));
> exception
> when Constraint_Error => null;
> end;
> Ada.Text_IO.Put_Line ("EOL =>" & Stream_Element'Image
> (EOL_Character_Pos));
>
> loop
> Read (Root_Stream_Type'Class (Input_Stream.all), Buffer, N);
> Count_Words (Buffer (1 .. N));
> exit when N < Buffer'Length;
> end loop;
>
> Ada.Text_IO.Put_Line
> (Natural'Image (Lines) &
> Natural'Image (Words) &
> Natural'Image (Total));
> end;
>
I checked with the Shootout side. The Ada program sent in was rated with
Error. So, maybe you can check why and correct it.
Andr�
^ permalink raw reply [relevance 0%]
* Re: Ada bench : word frequency
@ 2005-03-24 1:24 2% ` Marius Amado Alves
0 siblings, 0 replies; 200+ results
From: Marius Amado Alves @ 2005-03-24 1:24 UTC (permalink / raw)
To: comp.lang.ada
Program fixed. Zero differences with the reference result.
It's two times slower than the GCC C benchmark :-(
(CPU times (user+sys) on my iBook for n=25 repetitions of the input
file: C => 0.75, Ada => 1.45)
However that's already enough to put Ada on the 7th place, after OCaml
and before Eiffel :-)
Program follows.
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Streams;
with Ada.Streams.Stream_IO;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;
procedure Word_Frequency is
use Ada.Characters.Handling;
use Ada.Characters.Latin_1;
use Ada.Command_Line;
use Ada.Streams;
use Ada.Streams.Stream_IO;
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
Buffer : Stream_Element_Array (1 .. 4096);
Input_Stream : Ada.Text_IO.Text_Streams.Stream_Access
:= Ada.Text_IO.Text_Streams.Stream (Current_Input);
N : Stream_Element_Offset;
Is_Separator : array (Stream_Element) of Boolean :=
(Character'Pos ('A') .. Character'Pos ('Z') |
Character'Pos ('a') .. Character'Pos ('z') => False,
others => True);
-- N-ary tree of word counts
-- used to increment the counts in one pass of the input file
-- branches on the letter
-- carries the count
-- very fast
-- but very space consuming
subtype Letter is Stream_Element range
Character'Pos ('a') .. Character'Pos ('z');
type Word is array (Positive range <>) of Letter;
type Tree;
type Tree_Ptr is access Tree;
type Node is
record
Count : Natural := 0;
Subtree : Tree_Ptr := null;
end record;
type Tree is array (Letter) of Node;
procedure Inc (X : in out Integer) is begin X := X + 1; end;
procedure Dec (X : in out Integer) is begin X := X - 1; end;
procedure Inc_Word (Parent : Tree_Ptr; Descendents : Word) is
begin
if Descendents'Length > 0 then
declare
Child_Index : Positive := Descendents'First;
Child : Letter renames Descendents (Child_Index);
begin
if Descendents'Length = 1 then
Inc (Parent (Child).Count);
else
if Parent (Child).Subtree = null then
Parent (Child).Subtree := new Tree;
end if;
Inc_Word
(Parent (Child).Subtree,
Descendents (Child_Index + 1 .. Descendents'Last));
end if;
end;
end if;
end;
-- Binary tree of word counts
-- used for sorting the result by the count (frequency)
-- branches on the word count
-- carries the word form
type Form_Ptr is access Word;
type Binary_Tree;
type Binary_Tree_Ptr is access Binary_Tree;
type Binary_Tree is
record
Form : Form_Ptr;
Count : Natural;
Left, Right : Binary_Tree_Ptr;
end record;
procedure Add_Node (Parent : in out Binary_Tree_Ptr; Form :
Form_Ptr; Count : Natural) is
begin
if Parent = null then
Parent := new Binary_Tree;
Parent.Form := Form;
Parent.Count := Count;
else
if Count < Parent.Count then
Add_Node (Parent.Left, Form, Count);
else
Add_Node (Parent.Right, Form, Count);
end if;
end if;
end;
-- end of binary tree primitives
Root : Tree_Ptr := new Tree;
Btree : Binary_Tree_Ptr := null;
Current_Word : Word (1 .. 1000);
Current_Word_Length : Natural range 0 .. Current_Word'Last := 0;
In_Word : Boolean := False;
procedure Append_To_Word (E : Letter) is
begin
Inc (Current_Word_Length);
Current_Word (Current_Word_Length) := E;
In_Word := True;
end;
procedure End_Word is
begin
if Current_Word_Length > 0 then
Inc_Word (Root, Current_Word (1 .. Current_Word_Length));
end if;
Current_Word_Length := 0;
In_Word := False;
end;
To_Lower : array (Stream_Element) of Letter;
procedure Initialise_To_Lower_Map is
D : Integer := Character'Pos ('a') - Character'Pos ('A');
begin
for I in Character'Pos ('a') .. Character'Pos ('z') loop
To_Lower (Stream_Element (I)) := Letter (I);
To_Lower (Stream_Element (I - D)) := Letter (I);
end loop;
end;
procedure Process (S : Stream_Element_Array) is
begin
for I in S'Range loop
if Is_Separator (S (I)) then
if In_Word then End_Word; end if;
else
Append_To_Word (To_Lower (S (I)));
end if;
end loop;
end;
procedure Populate_Btree (Ntree : Tree_Ptr) is
begin
Inc (Current_Word_Length);
for I in Letter'Range loop
Current_Word (Current_Word_Length) := I;
if Ntree (I).Count > 0 then
Add_Node
(Btree,
Form => new Word'(Current_Word (1 ..
Current_Word_Length)),
Count => Ntree (I).Count);
end if;
if Ntree (I).Subtree /= null then
Populate_Btree (Ntree (I).Subtree);
end if;
end loop;
Dec (Current_Word_Length);
end;
procedure Populate_Btree is
begin
Current_Word_Length := 0;
Populate_Btree (Root);
end;
function To_String (X : Form_Ptr) return String is
S : String (X'Range);
begin
for I in X'Range loop
S (I) := Character'Val (X (I));
end loop;
return S;
end;
subtype String7 is String (1 .. 7);
function Img7 (X : Natural) return String7 is
S : String := Natural'Image (X);
begin
return String' (1 .. 8 - S'Length => ' ') & S (2 .. S'Last);
end;
procedure Dump_Btree (X : Binary_Tree_Ptr := Btree) is
begin
if X /= null then
Dump_Btree (X.Right);
Ada.Text_IO.Put_Line
(Img7 (X.Count) & " " & To_String (X.Form));
Dump_Btree (X.Left);
end if;
end;
begin
Initialise_To_Lower_Map;
loop
Read (Root_Stream_Type'Class (Input_Stream.all), Buffer, N);
Process (Buffer (1 .. N));
exit when N < Buffer'Length;
end loop;
if In_Word then End_Word; end if;
Populate_Btree;
Dump_Btree;
end;
^ permalink raw reply [relevance 2%]
* Ada bench : word frequency
@ 2005-03-23 20:39 2% ` Marius Amado Alves
0 siblings, 1 reply; 200+ results
From: Marius Amado Alves @ 2005-03-23 20:39 UTC (permalink / raw)
To: comp.lang.ada
Here's a shot at the word frequency benchmark. By my calculations, it
is as fast as the GCC C benchmark. I did not compare the output with
the reference output. A line-by-line comparison requires a criterion
for words with the same frequency, which AFAICT is not documented.
Also, my current concept of word separator does not include punctuation
marks. Again, I could not find a reference definition.
The program does not use any external data structures library. It
includes its own specific structures, an n-ary tree keyed by word form,
and a binary tree keyed by word frequency. It increments the counts in
the n-ary tree, then traverses the n-ary tree to populate the binary
tree (to order by count), then dumps the latter.
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Streams;
with Ada.Streams.Stream_IO;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;
procedure Word_Frequency is
use Ada.Characters.Handling;
use Ada.Characters.Latin_1;
use Ada.Command_Line;
use Ada.Streams;
use Ada.Streams.Stream_IO;
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
Buffer : Stream_Element_Array (1 .. 4096);
Input_Stream : Ada.Text_IO.Text_Streams.Stream_Access
:= Ada.Text_IO.Text_Streams.Stream (Current_Input);
N : Stream_Element_Offset;
Is_Separator : array (Stream_Element) of Boolean :=
(0 .. 32 | 127 .. 159 => True, others => False);
-- N-ary tree of word counts
-- used to increment the counts in one pass of the input file
-- branches on the letter
-- carries the count
-- very fast
-- but very space consuming
subtype Letter is Stream_Element range 0 .. 255;
type Word is array (Positive range <>) of Letter;
type Tree;
type Tree_Ptr is access Tree;
type Node is
record
Count : Natural := 0;
Subtree : Tree_Ptr := null;
end record;
type Tree is array (Letter) of Node;
procedure Inc (X : in out Integer) is begin X := X + 1; end;
procedure Dec (X : in out Integer) is begin X := X - 1; end;
procedure Inc_Word (Parent : Tree_Ptr; Descendents : Word) is
begin
if Descendents'Length > 0 then
declare
Child_Index : Positive := Descendents'First;
Child : Letter renames Descendents (Child_Index);
begin
if Descendents'Length = 1 then
Inc (Parent (Child).Count);
else
if Parent (Child).Subtree = null then
Parent (Child).Subtree := new Tree;
end if;
Inc_Word
(Parent (Child).Subtree,
Descendents (Child_Index + 1 .. Descendents'Last));
end if;
end;
end if;
end;
-- Binary tree of word counts
-- used for sorting the result by the count (frequency)
-- branches on the word count
-- carries the word form
type Form_Ptr is access Word;
type Binary_Tree;
type Binary_Tree_Ptr is access Binary_Tree;
type Binary_Tree is
record
Form : Form_Ptr;
Count : Natural;
Left, Right : Binary_Tree_Ptr;
end record;
procedure Add_Node (Parent : in out Binary_Tree_Ptr; Form :
Form_Ptr; Count : Natural) is
begin
if Parent = null then
Parent := new Binary_Tree;
Parent.Form := Form;
Parent.Count := Count;
else
if Count < Parent.Count then
Add_Node (Parent.Left, Form, Count);
else
Add_Node (Parent.Right, Form, Count);
end if;
end if;
end;
-- end of binary tree primitives
Root : Tree_Ptr := new Tree;
Btree : Binary_Tree_Ptr := null;
Current_Word : Word (1 .. 1000);
Current_Word_Length : Natural range 0 .. Current_Word'Last := 0;
In_Word : Boolean := False;
procedure Append_To_Word (E : Stream_Element) is
begin
Inc (Current_Word_Length);
Current_Word (Current_Word_Length) := E;
In_Word := True;
end;
procedure End_Word is
begin
if Current_Word_Length > 0 then
Inc_Word (Root, Current_Word (1 .. Current_Word_Length));
end if;
Current_Word_Length := 0;
In_Word := False;
end;
procedure Process (S : Stream_Element_Array) is
begin
for I in S'Range loop
if Is_Separator (S (I)) then
if In_Word then End_Word; end if;
else
Append_To_Word (S (I));
end if;
end loop;
end;
procedure Populate_Btree (Ntree : Tree_Ptr) is
begin
Inc (Current_Word_Length);
for I in Letter'Range loop
Current_Word (Current_Word_Length) := I;
if Ntree (I).Count > 0 then
Add_Node
(Btree,
Form => new Word'(Current_Word (1 ..
Current_Word_Length)),
Count => Ntree (I).Count);
end if;
if Ntree (I).Subtree /= null then
Populate_Btree (Ntree (I).Subtree);
end if;
end loop;
Dec (Current_Word_Length);
end;
procedure Populate_Btree is
begin
Current_Word_Length := 0;
Populate_Btree (Root);
end;
function To_String (X : Form_Ptr) return String is
S : String (X'Range);
begin
for I in X'Range loop
S (I) := Character'Val (X (I));
end loop;
return S;
end;
procedure Dump_Btree (X : Binary_Tree_Ptr := Btree) is
begin
if X /= null then
Dump_Btree (X.Right);
Ada.Text_IO.Put_Line
(To_String (X.Form) &
Natural'Image (X.Count));
Dump_Btree (X.Left);
end if;
end;
begin
loop
Read (Root_Stream_Type'Class (Input_Stream.all), Buffer, N);
Process (Buffer (1 .. N));
exit when N < Buffer'Length;
end loop;
if In_Word then End_Word; end if;
Populate_Btree;
Dump_Btree;
end;
^ permalink raw reply [relevance 2%]
* Re: Ada bench : count words
[not found] ` <00b362390273e6c04844dd4ff1885ee0@netcabo.pt>
@ 2005-03-23 15:09 3% ` Marius Amado Alves
2005-03-30 16:08 0% ` Andre
0 siblings, 1 reply; 200+ results
From: Marius Amado Alves @ 2005-03-23 15:09 UTC (permalink / raw)
To: comp.lang.ada
> I'll review this tomorrow on the bus to work (I think your program is
> separating words at buffer end, and it should not).
Done. Tmoran, sorry, my first sight was wrong, your algorithm is mostly
fine. Minor reservations:
- special statute given to CR; personally I think all characters
(control or not) should count to total
- reliance on Stream_Element representing one character; portable
across all range of environments?
My own program rewritten with Text_Streams attains the same speed as
yours. The fact that it is structured doesn't hit performance
significantly. Pragma Inline improves a little bit. Real times (ms) on
my iBook, for input file repeated 2500 times, all compiled with only
-O3:
C ........................ 600
Yours, or mine inlined ... 700
Mine not inlined ......... 750
So we should submit yours, or mine inlined. It will put Ada right after
the Cs w.r.t. speed. W.r.t. executable file size Ada is much bigger. On
my iBook:
C ....... 15k
Mine .... 423k
Yours ... 459k
W.r.t. source code size all are similar. Number of significant
semicolons (Ada), or semicolons + {} blocks + #includes + #defines (C):
C .............. 27
Yours .......... 33
Mine inlined ... 52
My program follows for reference. It accepts the code for EOL as an
argument. Default = 10 (LF).
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- contributed by Guys De Cla
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Streams;
with Ada.Streams.Stream_IO;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;
procedure Count_Words_Portable is
use Ada.Characters.Handling;
use Ada.Characters.Latin_1;
use Ada.Command_Line;
use Ada.Streams;
use Ada.Streams.Stream_IO;
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
Buffer : Stream_Element_Array (1 .. 4096);
Input_Stream : Ada.Text_IO.Text_Streams.Stream_Access
:= Ada.Text_IO.Text_Streams.Stream (Current_Input);
EOL_Character_Pos : Stream_Element := Character'Pos (LF);
Lines : Natural := 0;
Words : Natural := 0;
Total : Natural := 0;
In_Word : Boolean := False;
N : Stream_Element_Offset;
Is_Separator : array (Stream_Element) of Boolean :=
(0 .. 32 | 127 .. 159 => True, others => False);
procedure Begin_Word is
begin
Words := Words + 1;
In_Word := True;
end;
procedure End_Word is
begin
In_Word := False;
end;
procedure End_Line is
begin
Lines := Lines + 1;
End_Word;
end;
procedure Count_Words (S : in Stream_Element_Array) is
begin
Total := Total + S'Length;
for I in S'Range loop
if S (I) = EOL_Character_Pos then
End_Line;
else
if Is_Separator (S (I)) then
if In_Word then End_Word; end if;
else
if not In_Word then Begin_Word; end if;
end if;
end if;
end loop;
end;
pragma Inline (Begin_Word, End_Word, End_Line, Count_Words);
begin
begin
EOL_Character_Pos := Stream_Element'Value (Argument (1));
exception
when Constraint_Error => null;
end;
Ada.Text_IO.Put_Line ("EOL =>" & Stream_Element'Image
(EOL_Character_Pos));
loop
Read (Root_Stream_Type'Class (Input_Stream.all), Buffer, N);
Count_Words (Buffer (1 .. N));
exit when N < Buffer'Length;
end loop;
Ada.Text_IO.Put_Line
(Natural'Image (Lines) &
Natural'Image (Words) &
Natural'Image (Total));
end;
^ permalink raw reply [relevance 3%]
* Re: Ada bench : count words
2005-03-22 1:16 3% ` Ada bench : count words Marius Amado Alves
2005-03-22 10:59 0% ` Dmitry A. Kazakov
@ 2005-03-22 22:27 2% ` Dmitry A. Kazakov
2 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2005-03-22 22:27 UTC (permalink / raw)
On Tue, 22 Mar 2005 01:16:09 +0000, Marius Amado Alves wrote:
Here is a FSM/OS_Lib variant, a shameless one, I must admit. Anyway it
narrowly beats:
http://dada.perl.it/shootout/wc.gcc.html
on my FC3 machine. But of course it has no chance against:
http://shootout.alioth.debian.org/great/benchmark.php?test=wc&lang=gcc&id=0&sort=fullcpu,
which uses even dirtier tricks than me! (:-))
----------------------------------------------------
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure Ada_WC is
subtype Buffer_Index is Integer range 1..4099;
type File_Buffer is array (Buffer_Index) of aliased Character;
Buffer : File_Buffer;
Index : Buffer_Index := Buffer_Index'First;
Last : Integer := Buffer_Index'First;
Lines : Natural := 0;
Words : Natural := 0;
Total : Natural := 0;
begin
<<Blank>>
if Index < Last then -- This "if" should be a subprogram,
Index := Index + 1; -- but I don't trust GNAT!
else
Last := Read (Standin, Buffer (1)'Address, 4098); -- 4K! to read
if Last = 0 then
goto Done;
end if;
Total := Total + Last;
Index := Buffer_Index'First;
end if;
case Buffer (Index) is
when ' ' | HT => goto Blank;
when LF => Lines := Lines + 1; goto Blank;
when others => Words := Words + 1;
end case;
<<Word>>
if Index < Last then
Index := Index + 1;
else
Last := Read (Standin, Buffer (1)'Address, 4098);
if Last = 0 then
goto Done;
end if;
Total := Total + Last;
Index := Buffer_Index'First;
end if;
case Buffer (Index) is
when ' ' | HT => goto Blank;
when LF => Lines := Lines + 1; goto Blank;
when others => goto Word;
end case;
<<Done>>
Put_Line
( Natural'Image (Lines)
& Natural'Image (Words)
& Natural'Image (Total)
);
end Ada_WC;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Ada bench : count words
2005-03-22 17:39 3% ` Marius Amado Alves
@ 2005-03-22 18:59 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2005-03-22 18:59 UTC (permalink / raw)
On Tue, 22 Mar 2005 17:39:42 +0000, Marius Amado Alves wrote:
>> Why not use GNAT.OS_Lib.
>
> I'm trying, but the program does not work properly. It seems to
> terminate too early, and the results oscillate between 20 and 49 lines.
> I'll be damned if I understand what's happening.
>
> -- Count words in Ada for the language shootout
> -- by Marius Amado Alves
>
> with Ada.Characters.Handling;
> with Ada.Characters.Latin_1;
> with Ada.Strings.Fixed;
> with Ada.Text_IO;
> with GNAT.OS_Lib;
>
> procedure Count_Words_OS_Lib is
>
> use Ada.Characters.Handling;
> use Ada.Characters.Latin_1;
> use Ada.Text_IO;
>
> Buffer : String (1 .. 4096);
> EOL : String := (1 => LF);
> Lines : Natural := 0;
> Words : Natural := 0;
> Total : Natural := 0;
> In_Word : Boolean := False;
> N : Natural;
>
> function Is_Separator (C : Character) return Boolean is
> begin
> return Is_Control (C) or C = ' ';
> end;
>
> procedure Begin_Word is
> begin
> In_Word := True;
> end;
>
> procedure End_Word is
> begin
> if In_Word then
> Words := Words + 1;
> In_Word := False;
> end if;
> end;
>
> procedure End_Line is
> begin
> Lines := Lines + 1;
> Total := Total + 1;
> End_Word;
> end;
>
> procedure Count_Words (S : in String) is
> begin
> Total := Total + S'Length;
> Lines := Lines + Ada.Strings.Fixed.Count (S, EOL);
> for I in S'Range loop
> if Is_Separator (S (I)) then
> if In_Word then End_Word; end if;
> else
> if not In_Word then Begin_Word; end if;
> end if;
> end loop;
> end;
>
> pragma Inline (Begin_Word, End_Word, End_Line, Count_Words);
>
> begin
> loop
> N := GNAT.OS_Lib.Read
> (GNAT.OS_Lib.Standin,
> Buffer'Address,
Hmm, why not Buffer (Buffer'First)'Address?
> Buffer'Length);
> Count_Words (String (Buffer (1 .. N)));
> exit when N < Buffer'Length;
> end loop;
>
> Ada.Text_IO.Put_Line
> (Natural'Image (Lines) &
> Natural'Image (Words) &
> Natural'Image (Total));
> end;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Ada bench : count words
@ 2005-03-22 17:39 3% ` Marius Amado Alves
2005-03-22 18:59 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Marius Amado Alves @ 2005-03-22 17:39 UTC (permalink / raw)
To: comp.lang.ada
> Why not use GNAT.OS_Lib.
I'm trying, but the program does not work properly. It seems to
terminate too early, and the results oscillate between 20 and 49 lines.
I'll be damned if I understand what's happening.
-- Count words in Ada for the language shootout
-- by Marius Amado Alves
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with GNAT.OS_Lib;
procedure Count_Words_OS_Lib is
use Ada.Characters.Handling;
use Ada.Characters.Latin_1;
use Ada.Text_IO;
Buffer : String (1 .. 4096);
EOL : String := (1 => LF);
Lines : Natural := 0;
Words : Natural := 0;
Total : Natural := 0;
In_Word : Boolean := False;
N : Natural;
function Is_Separator (C : Character) return Boolean is
begin
return Is_Control (C) or C = ' ';
end;
procedure Begin_Word is
begin
In_Word := True;
end;
procedure End_Word is
begin
if In_Word then
Words := Words + 1;
In_Word := False;
end if;
end;
procedure End_Line is
begin
Lines := Lines + 1;
Total := Total + 1;
End_Word;
end;
procedure Count_Words (S : in String) is
begin
Total := Total + S'Length;
Lines := Lines + Ada.Strings.Fixed.Count (S, EOL);
for I in S'Range loop
if Is_Separator (S (I)) then
if In_Word then End_Word; end if;
else
if not In_Word then Begin_Word; end if;
end if;
end loop;
end;
pragma Inline (Begin_Word, End_Word, End_Line, Count_Words);
begin
loop
N := GNAT.OS_Lib.Read
(GNAT.OS_Lib.Standin,
Buffer'Address,
Buffer'Length);
Count_Words (String (Buffer (1 .. N)));
exit when N < Buffer'Length;
end loop;
Ada.Text_IO.Put_Line
(Natural'Image (Lines) &
Natural'Image (Words) &
Natural'Image (Total));
end;
^ permalink raw reply [relevance 3%]
* Re: Ada bench : count words
2005-03-22 12:47 3% ` Marius Amado Alves
@ 2005-03-22 13:08 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2005-03-22 13:08 UTC (permalink / raw)
On Tue, 22 Mar 2005 12:47:51 +0000, Marius Amado Alves wrote:
>>>> Is Text_IO that bad?
>>>
>>> No, if you can solve The Get_Line puzzle :-)
>>
>> What about Get (Item : out Character)?
>
> I tried and was too slow. Anyway I think I cracked the Get_Line puzzle
> (review welcome). So now it reads from standard input as required. But
> it's still 3 to 4 times slower than the C version.
>
> -- Count words in Ada for the language shootout
> -- by Marius Amado Alves
>
> with Ada.Characters.Handling;
> with Ada.Characters.Latin_1;
> with Ada.Text_IO;
>
> procedure Count_Words is
>
> use Ada.Characters.Handling;
> use Ada.Characters.Latin_1;
> use Ada.Text_IO;
>
> Buffer : String (1 .. 4096);
> Lines : Natural := 0;
> Words : Natural := 0;
> Total : Natural := 0;
> In_Word : Boolean := False;
> N : Natural;
>
> function Is_Separator (C : Character) return Boolean is
> begin
> return Is_Control (C) or C = ' ';
> end;
>
> procedure Begin_Word is
> begin
> In_Word := True;
> end;
>
> procedure End_Word is
> begin
> if In_Word then
> Words := Words + 1;
> In_Word := False;
> end if;
> end;
>
> procedure End_Line is
> begin
> Lines := Lines + 1;
> Total := Total + 1;
> End_Word;
> end;
>
> procedure Count_Words (S : in String) is
> begin
> Total := Total + S'Length;
> for I in S'Range loop
> if Is_Separator (S (I)) then
> if In_Word then End_Word; end if;
> else
> if not In_Word then Begin_Word; end if;
> end if;
> end loop;
> end;
>
> begin
> while not End_Of_File loop
Replace End_Of_File with End_Error handling.
> Get_Line (Buffer, N);
Get_Line does one extra line scan. So it will be inherently slower. Then it
would not take any advantage of having Buffer if lines are shorter than 4K.
Once Count_Words is inlined the buffer size does not matter.
BTW, you can safely declare Buffer either 1 or 1G bytes, because hidden
buffering happens anyway in Text_IO. (You only save calls to Get_Line.) Who
knows how large are buffers there? This probably disqualifies Text_IO, as
well as C's getc! It should be raw "read".
> Count_Words (Buffer (1 .. N));
Wouldn't it count buffer ends as word separators for lines longer than 4K?
> if N < Buffer'Length then
> End_Line;
> end if;
> end loop;
>
> Ada.Text_IO.Put_Line
> (Natural'Image (Lines) &
> Natural'Image (Words) &
> Natural'Image (Total));
> end;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Ada bench : count words
@ 2005-03-22 12:47 3% ` Marius Amado Alves
2005-03-22 13:08 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Marius Amado Alves @ 2005-03-22 12:47 UTC (permalink / raw)
To: comp.lang.ada
>>> Is Text_IO that bad?
>>
>> No, if you can solve The Get_Line puzzle :-)
>
> What about Get (Item : out Character)?
I tried and was too slow. Anyway I think I cracked the Get_Line puzzle
(review welcome). So now it reads from standard input as required. But
it's still 3 to 4 times slower than the C version.
-- Count words in Ada for the language shootout
-- by Marius Amado Alves
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Text_IO;
procedure Count_Words is
use Ada.Characters.Handling;
use Ada.Characters.Latin_1;
use Ada.Text_IO;
Buffer : String (1 .. 4096);
Lines : Natural := 0;
Words : Natural := 0;
Total : Natural := 0;
In_Word : Boolean := False;
N : Natural;
function Is_Separator (C : Character) return Boolean is
begin
return Is_Control (C) or C = ' ';
end;
procedure Begin_Word is
begin
In_Word := True;
end;
procedure End_Word is
begin
if In_Word then
Words := Words + 1;
In_Word := False;
end if;
end;
procedure End_Line is
begin
Lines := Lines + 1;
Total := Total + 1;
End_Word;
end;
procedure Count_Words (S : in String) is
begin
Total := Total + S'Length;
for I in S'Range loop
if Is_Separator (S (I)) then
if In_Word then End_Word; end if;
else
if not In_Word then Begin_Word; end if;
end if;
end loop;
end;
begin
while not End_Of_File loop
Get_Line (Buffer, N);
Count_Words (Buffer (1 .. N));
if N < Buffer'Length then
End_Line;
end if;
end loop;
Ada.Text_IO.Put_Line
(Natural'Image (Lines) &
Natural'Image (Words) &
Natural'Image (Total));
end;
^ permalink raw reply [relevance 3%]
* Re: Ada bench : count words
2005-03-22 1:16 3% ` Ada bench : count words Marius Amado Alves
@ 2005-03-22 10:59 0% ` Dmitry A. Kazakov
2005-03-22 22:27 2% ` Dmitry A. Kazakov
2 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2005-03-22 10:59 UTC (permalink / raw)
On Tue, 22 Mar 2005 01:16:09 +0000, Marius Amado Alves wrote:
> I took a shot at the count-words benchmark, a program to count lines,
> words and characters. The Ada program currently published there is
> broken. My program is correct and portable but:
>
> - the speed is circa 1/3 of the GCC C version
>
> - it fails to comply with the requirement that the input be taken from
> standard input. To implement buffering, I have resorted to
> Ada.Direct_IO, which I think cannot apply to standard input.
Is Text_IO that bad?
> Can you help with any of these points? Thanks. The complete program
> follows.
>
> -- Count words in Ada for the language shootout
> -- by Marius Amado Alves
>
> with Ada.Characters.Handling;
> with Ada.Characters.Latin_1;
> with Ada.Command_Line;
> with Ada.Direct_IO;
> with Ada.Strings.Fixed;
> with Ada.Text_IO;
>
> procedure Count_Words is
>
> use Ada.Characters.Handling;
> use Ada.Characters.Latin_1;
> use Ada.Command_Line;
>
> Filename : String := Argument (1);
> Buffer_Size : constant := 4096;
> EOF : Character := FS;
> EOL : String := (1 => LF);
> Lines : Natural := 0;
> Words : Natural := 0;
> Total : Natural := 0;
> In_Word : Boolean := False;
>
> function Is_Separator (C : Character) return Boolean is
> begin
> return Is_Control (C) or C = ' ';
> end;
Why don't you use character map here?
> procedure Start_Word is
> begin
> In_Word := True;
> end;
>
> procedure Finish_Word is
> begin
> Words := Words + 1;
> In_Word := False;
> end;
>
> procedure Process (S : in String) is
> begin
> Lines := Lines + Ada.Strings.Fixed.Count (S, EOL);
Isn't it an extra pass? I think you should do parsing using FSM. Character
classes are: EOL, delimiter, letter. It is either two character map tests
or one case statement. I don't know what is faster. Probably you should
test both.
> for I in S'Range loop
> if Is_Separator (S (I)) then
> if In_Word then Finish_Word; end if;
> else
> if not In_Word then Start_Word; end if;
> end if;
> end loop;
> end;
>
> begin
> declare
> package Character_IO is new Ada.Direct_IO (Character);
> use Character_IO;
> File : File_Type;
> begin
> Open (File, In_File, Filename);
> Total := Natural (Size (File));
> Close (File);
> end;
>
> declare
> subtype Buffer_Type is String (1 .. Buffer_Size);
> package Buffer_IO is new Ada.Direct_IO (Buffer_Type);
> use Buffer_IO;
> File : File_Type;
> S : Buffer_Type;
> begin
> Open (File, In_File, Filename);
> for I in 1 .. Total / Buffer_Size loop
> Read (File, S);
> Process (S);
> end loop;
> Close (File);
> end;
>
> declare
> subtype Rest_Type is String (1 .. Total rem Buffer_Size);
> package Character_IO is new Ada.Direct_IO (Character);
> use Character_IO;
> File : File_Type;
> S : Rest_Type;
> begin
> Open (File, In_File, Filename);
> Set_Index (File, Count (Total - S'Length));
> for I in 1 .. S'Length loop
> Read (File, S (I));
> end loop;
> Close (File);
> Process (S);
> end;
>
> if In_Word then Finish_Word; end if;
>
> Ada.Text_IO.Put_Line
> (Natural'Image (Lines) &
> Natural'Image (Words) &
> Natural'Image (Total));
> end;
P.S. For word frequencies: gcc version uses hash + sort. I wonder if binary
trees could be better here. Or even sorted arrays for simplicity, there is
no item deletion, search is more often than insert... Of course, for tree
node allocation one could use a stack pool instead of heap.
(That's one of the weaknesses of this contest. Actually the method should
have been specified)
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Ada bench : count words
@ 2005-03-22 1:16 3% ` Marius Amado Alves
2005-03-22 10:59 0% ` Dmitry A. Kazakov
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Marius Amado Alves @ 2005-03-22 1:16 UTC (permalink / raw)
To: comp.lang.ada
I took a shot at the count-words benchmark, a program to count lines,
words and characters. The Ada program currently published there is
broken. My program is correct and portable but:
- the speed is circa 1/3 of the GCC C version
- it fails to comply with the requirement that the input be taken from
standard input. To implement buffering, I have resorted to
Ada.Direct_IO, which I think cannot apply to standard input.
Can you help with any of these points? Thanks. The complete program
follows.
-- Count words in Ada for the language shootout
-- by Marius Amado Alves
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Direct_IO;
with Ada.Strings.Fixed;
with Ada.Text_IO;
procedure Count_Words is
use Ada.Characters.Handling;
use Ada.Characters.Latin_1;
use Ada.Command_Line;
Filename : String := Argument (1);
Buffer_Size : constant := 4096;
EOF : Character := FS;
EOL : String := (1 => LF);
Lines : Natural := 0;
Words : Natural := 0;
Total : Natural := 0;
In_Word : Boolean := False;
function Is_Separator (C : Character) return Boolean is
begin
return Is_Control (C) or C = ' ';
end;
procedure Start_Word is
begin
In_Word := True;
end;
procedure Finish_Word is
begin
Words := Words + 1;
In_Word := False;
end;
procedure Process (S : in String) is
begin
Lines := Lines + Ada.Strings.Fixed.Count (S, EOL);
for I in S'Range loop
if Is_Separator (S (I)) then
if In_Word then Finish_Word; end if;
else
if not In_Word then Start_Word; end if;
end if;
end loop;
end;
begin
declare
package Character_IO is new Ada.Direct_IO (Character);
use Character_IO;
File : File_Type;
begin
Open (File, In_File, Filename);
Total := Natural (Size (File));
Close (File);
end;
declare
subtype Buffer_Type is String (1 .. Buffer_Size);
package Buffer_IO is new Ada.Direct_IO (Buffer_Type);
use Buffer_IO;
File : File_Type;
S : Buffer_Type;
begin
Open (File, In_File, Filename);
for I in 1 .. Total / Buffer_Size loop
Read (File, S);
Process (S);
end loop;
Close (File);
end;
declare
subtype Rest_Type is String (1 .. Total rem Buffer_Size);
package Character_IO is new Ada.Direct_IO (Character);
use Character_IO;
File : File_Type;
S : Rest_Type;
begin
Open (File, In_File, Filename);
Set_Index (File, Count (Total - S'Length));
for I in 1 .. S'Length loop
Read (File, S (I));
end loop;
Close (File);
Process (S);
end;
if In_Word then Finish_Word; end if;
Ada.Text_IO.Put_Line
(Natural'Image (Lines) &
Natural'Image (Words) &
Natural'Image (Total));
end;
^ permalink raw reply [relevance 3%]
* XML Strings in Ada
@ 2004-12-08 16:46 2% Robert C. Leif
0 siblings, 0 replies; 200+ results
From: Robert C. Leif @ 2004-12-08 16:46 UTC (permalink / raw)
To: comp.lang.ada
If any one wishes to see and use my code for noncommercial purposes,
please email me. The packages are not yet ready for publication; however, I
have used them on internal projects. Since Packages that are part of the
Ada standard are not allowed to have user defined child libraries, I took a
library generic and made a new generic from it. The Pattern_Pkg Should be a
subset of that in XML with new meaningful abbreviations.
Parenthetically, the use of html formatting would assist in formatting
listings for Comp.Lang.Ada. The sources of my Ada_Utilities will be made
available under one of the new licenses that are derived or in the spirit of
my Software Developers Cooperative License.
Bob Leif
Briefly the beigining of the package specification contains:
with Ada.Strings.Bounded;
with Ada.Strings.Unbounded;
with Pattern_Pkg; --not yet completed.
with Ada.Strings;
with Character_Sets;
with Ada.Characters.Latin_1;
with Strings8_16_32_Pkg;
generic
Max_Bd_Length : Positive;
Min_Bd_Length : Positive:= 1;
Character_Set:Character_Sets.Character_Set_Type:=
Character_Sets.Latin_1_Char_Set;
Pattern:Pattern_Pkg.Pattern_Bd_Type := Pattern_Pkg.Null_Pattern_Bd;
--Had to create to equal Ada.Characters.Latin_1.
--This has to be replaced by the proper Unicode names
--or, at least, the names specified in The Ada95 XML Library
--by Emmanuel Briot Unicode child libraries
--http://libre.act-europe.fr/xmlada/main.html
package Generic_Bd_W_Char_Sets is
Pkg_Name : constant String := "Generic_Bd_W_Char_Sets";
Monitor : Boolean := True;
--Makes visible to all of the instantiations.
--***********************Table of
Contents--*************************
package Unbounded renames Ada.Strings.Unbounded;
subtype String_Unbd is Ada.Strings.Unbounded.Unbounded_String;
subtype Truncation is Ada.Strings.Truncation;
Error : Ada.Strings.Truncation renames Ada.Strings.Error;
subtype Trim_End is Ada.Strings.Trim_End;
Left : Trim_End renames Ada.Strings.Left;
Right : Trim_End renames Ada.Strings.Right;
Both : Trim_End renames Ada.Strings.Both;
subtype Character_Set_Type is Character_Sets.Character_Set_Type;
subtype Case_Type is Character_Sets.Case_Type;
Upper_Case : Case_Type renames Character_Sets.Upper_Case;
Lower_Case : Case_Type renames Character_Sets.Lower_Case;
Both_Cases : Case_Type renames Character_Sets.Both_Cases;
Space : Character renames Ada.Characters.Latin_1.Space;
subtype Pattern_Bd_Type is Pattern_Pkg.Pattern_Bd_Type;
Null_Pattern_Bd: Pattern_Bd_Type renames
Pattern_Pkg.Null_Pattern_Bd;
Subtype Character16_Set_Type is
Strings8_16_32_Pkg.Character16_Set_Type;
Latin_1_16_Char_Set:Character16_Set_Type
renames Strings8_16_32_Pkg.Latin_1_16_Char_Set;
--**************End Table of Contents--*************************
package Generic_Bd_Strings is new
Ada.Strings.Bounded.Generic_Bounded_Length(Max =>
Max_Bd_Length);
use Generic_Bd_Strings;
----------------------------------------------------------------------
subtype Generic_Bd_Type is Generic_Bd_Strings.Bounded_String; --NO
--DO NOT USE FOR Instatiations!
Null_Generic_Bd : Generic_Bd_Type :=
Generic_Bd_Strings.Null_Bounded_String; --NO
--DO NOT USE FOR Instatiations!
subtype Length_Range_Type is Generic_Bd_Strings.Length_Range;
subtype Non_Member_Sequence_Bd_Type is
Character_Sets.Non_Member_Sequence_Bd_Type;
--********************End Table of
Contents--*************************
type Generic_Bd_W_Char_Set_Type is tagged private; --record
-----------------------------------------------------------------------
function Null_Generic_Bd_W_Char_Set return
Generic_Bd_W_Char_Set_Type;
---------------------------------------------------------------
function Img (
Generic_Bd_W_Char_Set : Generic_Bd_W_Char_Set_Type )
return String;
---------------------------------------------------------------
function Img16 (
Generic_Bd_W_Char_Set : Generic_Bd_W_Char_Set_Type;
Not_In_Char : in Wide_Character :=
'?' )
return Wide_String;
--Many more functions and procedures
private
type Generic_Bd_W_Char_Set_Type is tagged
record
Generic_Bd_Part : Generic_Bd_Type := Null_Generic_Bd;
Character_Set_Part : Character_Set_Type := Character_Set;
Min_Bd_Length_Part : Positive := Min_Bd_Length;
Pattern_Part : Pattern_Bd_Type := Null_Pattern_Bd;
--This permits the Character_Set to be specified
--at instantiation and defaults to Latin_1.
end record;
----------------
Message: 5
Date: Tue, 07 Dec 2004 19:41:35 GMT
From: Bj?rn Persson <spam-away@nowhere.nil>
Subject: Re: Experiences of XML parser generators for Ada?
To: comp.lang.ada@ada-france.org
Message-ID: <PHntd.123697$dP1.439213@newsc.telia.net>
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Robert C. Leif wrote:
> I have also created Ada bounded strings that include character sets.
What do you mean with "strings that include character sets"? Do the
strings carry information about which character encoding they're
encoded
in? In that case I'd be interested in looking at your implementation.
--
Bjvrn Persson PGP key A88682FD
omb jor ers @sv ge.
r o.b n.p son eri nu
^ permalink raw reply [relevance 2%]
* Re: Question about Ada.Unchecked_Conversion
2004-10-29 14:22 3% ` Dmitry A. Kazakov
@ 2004-10-29 15:15 3% ` Nick Roberts
1 sibling, 0 replies; 200+ results
From: Nick Roberts @ 2004-10-29 15:15 UTC (permalink / raw)
Eric Jacoboni wrote:
> subtype T_Phrase is String(1..Lg_Max);
>
> type T_S�parateur is (' ', Ht, Lf, ',' ,';', ':', '.', '?', '!');
> for T_S�parateur'Size use Character'Size;
>
> function Char_To_S�parateur is
> new Ada.Unchecked_Conversion(Character, T_S�parateur);
>
> Ma_Phrase : T_Phrase;
>
> What i want to do is simply a test like this, in order to find
> characters that are also separators:
>
> if Char_To_S�parateur(Ma_Phrase(I)) in T_S�parateur then
> ...
> end if;
>
> But this test always fails and i don't understand why. The logic seems
> correct so i suppose it's a misunderstanding of Unchecked_Conversion?
It certainly is a misunderstanding!
Unchecked_Conversion should be used only when you know for sure that
the bit representation of one type will have the meaning you intend
when interpreted as another type. In this case, the bit representation
for type T_S�parateur is likely to be totally different to that of
Standard.Character.
You don't need to use Unchecked_Conversion to convert between one
character type (T_S�parateur) and another (Standard.Character), and
you should not. You need only (and should) use predefined conversion
for this purpose.
However, in order to do the membership test, you do not want to
perform any conversion, because if a value of type Standard.Character
cannot be converted to T_S�parateur, Constraint_Error will be raised.
Instead, for this job, I recommend you use the facilities of the
standard package Ada.Strings.Maps. In this package, there is a type
Character_Set, with the operations you would expect, including
functions which make it easy (usually) to construct a set.
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Strings.Maps; use Ada.Strings.Maps;
...
S�parateurs: constant Character_Set :=
To_Set( HT & LF & Space & ",;:.?!" );
...
for i in Ma_Phrase'Range loop
if Is_In( Ma_Phrase(i), S�parateurs ) then
...
There is another possible method, using an array that maps from
characters to a category (indicating some significance to each
character, in this case, whether it is a separator).
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
...
Est_S�parateur: constant array (Character) of Boolean :=
( Space | HT | LF |
',' | ';' | ':' | '.' | '?' | '!' => True,
others => False );
...
for i in Ma_Phrase'Range loop
if Est_S�parateur( Ma_Phrase(i) ) then
...
This method might be difficult for testing Wide_Characters, because
of the size of the array, and the type Character_Set can provide more
sophisticated functionality sometimes.
--
Nick Roberts
^ permalink raw reply [relevance 3%]
* Re: Question about Ada.Unchecked_Conversion
@ 2004-10-29 14:22 3% ` Dmitry A. Kazakov
2004-10-29 15:15 3% ` Nick Roberts
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2004-10-29 14:22 UTC (permalink / raw)
On Fri, 29 Oct 2004 14:46:54 +0200, Eric Jacoboni wrote:
> There is something i've probably not understood about
> Ada.Unchecked_Conversion behavior, despite readings of Barnes and
> RM95.
>
> To illustrate my pb, let a String in which i want to count
> various separators :
>
> subtype T_Phrase is String(1..Lg_Max);
>
> type T_S�parateur is (' ', Ht, Lf, ',' ,';', ':', '.', '?', '!');
> for T_S�parateur'Size use Character'Size;
>
> function Char_To_S�parateur is
> new Ada.Unchecked_Conversion(Character, T_S�parateur);
>
> Ma_Phrase : T_Phrase;
>
> What i want to do is simply a test like this, in order to find
> characters that are also separators:
>
> if Char_To_S�parateur(Ma_Phrase(I)) in T_S�parateur then
> ...
> end if;
>
> But this test always fails and i don't understand why. The logic seems
> correct so i suppose it's a misunderstanding of Unchecked_Conversion?
The semantics of Unchecked_conversion differs from what you seem to imply.
What you want is probably just:
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
...
Separators : constant Character_Set := To_Set (" .,:!?" & HT & LF);
...
if Is_In (Ma_Phrase (I), Separators) then
...
end if;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: variable lenght strings
@ 2004-10-22 7:38 2% ` Martin Krischik
0 siblings, 0 replies; 200+ results
From: Martin Krischik @ 2004-10-22 7:38 UTC (permalink / raw)
Matthew Heaney wrote:
>
> "Marius Amado Alves" <amado.alves@netcabo.pt> wrote in message
> news:mailman.46.1098398641.10401.comp.lang.ada@ada-france.org...
>>> 1) Is it possible to use Get_Line with Unbounded and/or Bounded
>>> Strings?
>>
>> Not in the standard, but subprograms like those are usually around, e.g.
>> in the GNAT Library, or end up being written in house.
>>
>>> 2) If not, how should usei input be managed when lines length isn't
>>> known a priori?
>>
>> There's a way using the standard Get_Line, explained in AdaPower.
>
> Mario is probably referring to an article I posted to CLA a few years'
> ago, and which is now archived at the adapower website.
>
> The basic idea is this: algorithms that consume input from a stream need
> a
> way a identify when all of the input has been consumed. Typically this is
> done using a special value that you know is outside the range of normal
> values, e.g.
Well, you do not check for End_Of_File and that means your solution will
fail if the last line is not terminated with CR/LF. And if you want to
process files which have been edited by human beings than you have to care
for that case
The following version does work. It hast been tested on hundreds of files
all edited by human beings:
package body
--
-- String IO Routienes. This are used because
-- Ada.Strings.Unbounded.Text_IO and GNAT.IO_Aux both have a suttle
-- little bug.
--
AdaCL.Strings.IO
is
--
-- Shorten some names.
--
package S_U renames Ada.Strings.Unbounded;
package S_Maps renames Ada.Strings.Maps;
package Latin_1 renames Ada.Characters.Latin_1;
package IO renames Ada.Text_IO;
-- Buffer length. Works for any non-zero value, larger values take
-- more stack space, smaller values require more recursion.
BufferSize : constant := 2000;
--
-- Well, there are a lot of Get_Line routines around and GNAT
-- certanly has its onwn, but all those I have seen have suttle bug:
-- When the last line is not terminated with CR/LF and a multiple
-- of buffersize long they will throw and end of file exception.
--
-- This version need recursion!
--
function Get_Line (
-- File to be read.
File : in IO.File_Type)
return
String
is
-- Trace : AdaCL.Trace.Object := AdaCL.Trace.Function_Trace
(AdaCL.Trace.Entity & ':' & AdaCL.Trace.Source);
-- pragma Unreferenced (Trace);
Buffer : String (1 .. BufferSize);
Last : Natural;
begin
IO.Get_Line (
File => File,
Item => Buffer,
Last => Last);
if Last < Buffer'Last then
return Buffer (1 .. Last);
elsif IO.End_Of_File (File) then
return Buffer;
else
return Buffer & Get_Line (File);
end if;
end Get_Line;
--
-- Well, there are a lot of Get_Line routines around and GNAT
-- certanly has its onwn, but all those I have seen have suttle bug:
-- When the last line is not terminated with CR/LF and a multiple
-- of buffersize long they will throw and end of file exception.
--
-- This version uses a loop.
--
function Get_Line (
-- File to be read.
File : in IO.File_Type)
return
S_U.Unbounded_String
is
-- Trace : AdaCL.Trace.Object := AdaCL.Trace.Function_Trace
(AdaCL.Trace.Entity & ':' & AdaCL.Trace.Source);
-- pragma Unreferenced (Trace);
Retval : S_U.Unbounded_String := S_U.Null_Unbounded_String;
Item : String (1 .. BufferSize);
Last : Natural;
begin
GetWholeLine :
loop
IO.Get_Line (
File => File,
Item => Item,
Last => Last);
S_U.Append (
Source => Retval,
New_Item => Item (1 .. Last));
exit GetWholeLine when Last < Item'Last
or IO.End_Of_File (File);
end loop GetWholeLine;
return Retval;
end Get_Line;
--
-- Get Next Word.
--
procedure Get_Word (
-- File to be read.
File : in Ada.Text_IO.File_Type;
-- String into wich the word is to be read
Item : out String;
-- Actual amount of characters read.
Last : out Natural;
-- Word Delimiters
Delimiters : in Ada.Strings.Maps.Character_Set := Word_Delimiters)
is
-- Trace : AdaCL.Trace.Object := AdaCL.Trace.Function_Trace
(AdaCL.Trace.Entity & ':' & AdaCL.Trace.Source);
-- pragma Unreferenced (Trace);
Next_Char : Character := Latin_1.NUL;
begin
Last := Item'First;
Skip_Blanks :
loop
IO.Get (File => File,
Item => Next_Char);
-- AdaCL.Trace.Write (Integer'Image (Character'Pos (Next_Char)) &
"'" & String'(1 => Next_Char) & "'");
exit Skip_Blanks when not S_Maps.Is_In (
Element => Next_Char,
Set => Delimiters);
end loop Skip_Blanks;
Read_Char :
loop
if S_Maps.Is_In (Element => Next_Char,
Set => Delimiters)
then
Last := Natural'Pred (Last);
exit Read_Char;
end if;
-- AdaCL.Trace.Write (Integer'Image (Character'Pos (Next_Char)) &
"'" & String'(1 => Next_Char) & "'");
Item (Last) := Next_Char;
-- AdaCL.Trace.Write (Item (Item'First .. Last));
Last := Natural'Succ (Last);
exit Read_Char when Last = Item'Last;
IO.Get (File => File,
Item => Next_Char);
end loop Read_Char;
end Get_Word;
--
-- Get Next Word.
--
-- This version uses recursion! The actual version is garanteed to work
-- up to words 2000 characters.
--
function Get_Word (
-- File to be read.
File : in IO.File_Type;
-- Word Delimiters
Delimiters : in S_Maps.Character_Set := Word_Delimiters)
return
String
is
-- Trace : AdaCL.Trace.Object := AdaCL.Trace.Function_Trace
(AdaCL.Trace.Entity & ':' & AdaCL.Trace.Source);
-- pragma Unreferenced (Trace);
Buffer : String (1 .. BufferSize);
Last : Natural;
begin
Get_Word (File => File,
Item => Buffer,
Last => Last,
Delimiters => Delimiters);
if Last < Buffer'Last then
return Buffer (1 .. Last);
elsif IO.End_Of_File (File) then
return Buffer;
else
return Buffer & Get_Word (File, Delimiters);
end if;
end Get_Word;
--
-- Get Next Word.
--
-- This version uses a loop. The actual version is garanteed to work
-- up to words 2000 characters.
--
function Get_Word (
-- File to be read.
File : in IO.File_Type;
-- Word Delimiters
Delimiters : in Ada.Strings.Maps.Character_Set := Word_Delimiters)
return
S_U.Unbounded_String
is
-- Trace : AdaCL.Trace.Object := AdaCL.Trace.Function_Trace
(AdaCL.Trace.Entity & ':' & AdaCL.Trace.Source);
-- pragma Unreferenced (Trace);
Retval : S_U.Unbounded_String := S_U.Null_Unbounded_String;
Item : String (1 .. BufferSize);
Last : Natural;
begin
GetWholeLine : loop
Get_Word (File => File,
Item => Item,
Last => Last,
Delimiters => Delimiters);
S_U.Append (Source => Retval,
New_Item => Item (1 .. Last));
exit GetWholeLine when Last < Item'Last
or IO.End_Of_File (File);
end loop GetWholeLine;
return Retval;
end Get_Word;
end AdaCL.Strings.IO;
With Regards
Martin
--
mailto://krischik@users.sourceforge.net
http://www.ada.krischik.com
^ permalink raw reply [relevance 2%]
* Re: Unescape URL Procedure
[not found] <000901c4b365$719e8720$0201a8c0@win>
@ 2004-10-16 10:04 2% ` Marius Amado Alves
0 siblings, 0 replies; 200+ results
From: Marius Amado Alves @ 2004-10-16 10:04 UTC (permalink / raw)
To: comp.lang.ada
> Does anyone know of an Unescape URL procedure for Ada?
My program Decode_HH does something along this line:
-- It transforms any two hexadecimal digits prefixed by '='
-- into the corresponding character (Latin 1).
-- The first hexadecimal digit must be an uppercase letter.
-- It is a filter (uses standard input and output channels).
The program is published in the SDC forum, area Files / Software:
http://www.softdevelcoop.org
You must be a member to enter the Files area. Membership is open to all,
but for your convenience I copy the whole program below.
<<
-- Program Decode_HH
-- Version 1maa (2003-04-01)
-- (C) M�rio Amado Alves
-- ATTENTION: the use of this software is subject to conditions,
-- which the user must know in order to be in a legal state.
-- See bottom of the file.
-- This program restores email-mangled text originally containing Latin 1.
-- It transforms any two hexadecimal digits prefixed by '='
-- into the corresponding character (Latin 1).
-- The first hexadecimal digit must be an uppercase letter.
-- It is a filter (uses standard input and output channels).
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Handling; use Ada.Characters.Handling;
procedure Decode_HH_1maa is
T : String (1 .. 3);
subtype HH_Type is Natural range 0 .. 16#FF#;
package HH_IO is new Ada.Text_IO.Integer_IO (HH_Type);
N : HH_Type;
Dummy_Last: Positive;
Finish : exception;
procedure Get (S : out String) is
begin
for I in S'Range loop
begin
Get_Immediate (S (I));
exception
when End_Error =>
Put (S (S'First .. I - 1));
raise;
end;
end loop;
end;
begin
Get (T (1 .. 3));
loop
if T (1) = '='
and then T (2) in 'A' .. 'F'
and then Is_Hexadecimal_Digit (T (3))
then
HH_IO.Get ("16#" & T (2 .. 3) & "#", N, Dummy_Last);
Put (Character'Val (N));
Get (T (1 .. 3));
else
Put (T (1));
T (1 .. 2) := T (2 .. 3);
begin
Get_Immediate (T (3));
exception
when End_Error =>
Put (T (1 .. 2));
raise;
end;
end if;
end loop;
exception
when End_Error => null;
end;
-- REVISION HISTORY
-- 2003-04-01: version 1maa created and tested
-- CONDITIONS OF USE
-- This software is licensed under the terms of the
-- Software Developers Cooperative License, published at
--
-- groups.yahoo.com/group/softdevelcoop
--
-- In short, it is free for non-commercial use,
-- but royalties are due for use in a business.
-- See the website for details and contact information.
>>
^ permalink raw reply [relevance 2%]
* Re: character matching
@ 2004-08-15 17:21 2% ` Steve
0 siblings, 0 replies; 200+ results
From: Steve @ 2004-08-15 17:21 UTC (permalink / raw)
First have a look at the standard library Ada.Characters.Handling
You'll find goodies such as:
function Is_Alphanumeric (Item : in Character) return Boolean;
Then have alook at Ada.Strings.Maps. There you'll find:
function Is_In (Element : in Character;
Set : in Character_Set)
return Boolean;
I always recommend perusing the standard Ada library headers described in
Annex A of the Ada 95 reference manual. You'll find lots of tools that do
the grunt work for you.
Steve
(The Duck)
"John J" <g_001@hotmail.com> wrote in message
news:uNITc.3402$BA5.883@hydra.nntpserver.com...
> Thanks for the suggestions; however, I'm trying to learn a bit about the
> syntax and capabilities of ADA. Would someone be kind enough to give me
some
> examples of how I can use ADA to character match. ie, different ways I can
> use '*', '&' to successfully recognise words and sentences.
>
> Thanks
>
>
^ permalink raw reply [relevance 2%]
* Re: reading a text file into a string
@ 2004-07-15 20:02 0% ` Nick Roberts
0 siblings, 0 replies; 200+ results
From: Nick Roberts @ 2004-07-15 20:02 UTC (permalink / raw)
On Thu, 15 Jul 2004 20:18:35 +0100, Nick Roberts <nick.roberts@acm.org>
wrote:
> insert:
>
> if End_of_Line(File) then
> Append( text, Ada.Characters.Latin_1.NUL );
> Skip_Line(File);
> end if;
>
> between the Get and the append.
Sorry, I should have said /before/ the Get.
--
Nick Roberts
^ permalink raw reply [relevance 0%]
* Re: reading a text file into a string
@ 2004-07-15 19:57 2% ` Nick Roberts
0 siblings, 0 replies; 200+ results
From: Nick Roberts @ 2004-07-15 19:57 UTC (permalink / raw)
On Thu, 15 Jul 2004 18:49:17 +0100, Marius Amado Alves
<amado.alves@netcabo.pt> wrote:
> Unbounded_String is the right container for this. But note Get
> for characters skips over newlines and relatives (I think!) Do
> you really want to loose that information? If not then consider
> using Get_Immediate or Get_Line. This assuming you are using
> Ada.Text_IO.
I don't suggest using Get_Immediate for this purpose. You could use:
(a) a combination of Get and the End_of_Line function; or
(b) Get_Line.
Option (a) is likely to be slower, but this might not worry you.
If you use option (b), you must either not care about lines which are too
long (or know that none are) or you must write special code to deal with
overlong lines.
Example of option (a):
c, char: character;
text : unbounded_string;
Line_Break: constant Character := Ada.Characters.Latin_1.NUL;
...
-- read in text file
while not End_of_File(File) loop
if End_of_Line(File) then
Append( text, Line_Break );
Skip_Line(File);
end if;
Get( File, c );
Append( text, c );
end loop;
...
-- display content of unbounded_string:
for i in 1..Length(text) loop
if Element(text,i) = Line_Break then
Put_Line;
else
Put( Element(text,i) );
end if;
end loop;
-- process text
for i in 1 .. length ( text ) loop
char := element ( text, i );
...
end loop;
This will work, but it may not be very efficient.
Example of option (b):
with AI302.Containers.Vectors;
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
...
package Line_Vectors is
new AI302.Containers.Vectors(Positive,Unbounded_String);
use Line_Vectors;
...
Text: Line_Vectors.Vector_Type;
Line: String(1..100);
LL: Natural;
...
-- Read in text file:
while not End_of_File(File) loop
Read( File, Line, LL ); -- read line or line segment
Append( Text, To_Unbounded_String(Line(1..LL)) );
end loop;
-- Display content of unbounded_string:
for i in 1..Natural(Length(Text)) loop
Put_Line( To_String( Element(Text,i) ) );
end loop;
...
If a line is in the file which is longer than 100 characters, it will be
broken into two or more lines in the Text variable. Try this yourself.
You can download the AI-302 sample implementation packages from:
http://home.earthlink.net/~matthewjheaney/charles/ai302-20040227.zip
courtesy of Matthew Heaney (thanks Matt).
--
Nick Roberts
^ permalink raw reply [relevance 2%]
Results 1-200 of ~500 next (older) | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2004-07-15 17:27 reading a text file into a string zork
2004-07-15 17:49 ` Marius Amado Alves
2004-07-15 19:57 2% ` Nick Roberts
2004-07-15 19:18 ` Nick Roberts
2004-07-15 20:02 0% ` Nick Roberts
2004-08-13 5:23 character matching John J
2004-08-15 12:36 ` John J
2004-08-15 17:21 2% ` Steve
[not found] <000901c4b365$719e8720$0201a8c0@win>
2004-10-16 10:04 2% ` Unescape URL Procedure Marius Amado Alves
2004-10-21 17:52 variable lenght strings fabio de francesco
2004-10-21 22:42 ` Marius Amado Alves
2004-10-21 23:14 ` Matthew Heaney
2004-10-22 7:38 2% ` Martin Krischik
2004-10-29 12:46 Question about Ada.Unchecked_Conversion Eric Jacoboni
2004-10-29 14:22 3% ` Dmitry A. Kazakov
2004-10-29 15:15 3% ` Nick Roberts
2004-12-08 16:46 2% XML Strings in Ada Robert C. Leif
2005-03-19 16:22 Ada bench Pascal Obry
2005-03-19 16:55 ` Dr. Adrian Wrigley
2005-03-19 21:32 ` Michael Bode
2005-03-20 9:20 ` Pascal Obry
2005-03-21 23:27 ` Georg Bauhaus
2005-03-22 1:16 3% ` Ada bench : count words Marius Amado Alves
2005-03-22 10:59 0% ` Dmitry A. Kazakov
2005-03-22 11:57 ` Marius Amado Alves
2005-03-22 12:17 ` Dmitry A. Kazakov
2005-03-22 12:47 3% ` Marius Amado Alves
2005-03-22 13:08 0% ` Dmitry A. Kazakov
2005-03-22 19:49 ` tmoran
[not found] ` <00b362390273e6c04844dd4ff1885ee0@netcabo.pt>
2005-03-23 15:09 3% ` Marius Amado Alves
2005-03-30 16:08 0% ` Andre
2005-03-22 22:27 2% ` Dmitry A. Kazakov
2005-03-22 16:30 Marius Amado Alves
2005-03-22 16:41 ` Tapio Kelloniemi
2005-03-22 17:39 3% ` Marius Amado Alves
2005-03-22 18:59 0% ` Dmitry A. Kazakov
2005-03-23 19:00 tmoran
2005-03-23 19:54 ` Tapio Kelloniemi
2005-03-23 20:39 2% ` Ada bench : word frequency Marius Amado Alves
2005-03-23 21:26 ` Isaac Gouy
2005-03-24 1:24 2% ` Marius Amado Alves
2005-04-14 1:28 2% Shootout: Word Frequency Jeffrey Carter
2005-05-02 2:42 TCP/IP Sockets with GNAT.Sockets fabio de francesco
2005-05-02 12:11 ` Adrien Plisson
2005-05-02 14:55 ` fabio de francesco
2005-05-02 16:10 ` Adrien Plisson
2005-05-02 17:56 ` Eric Jacoboni
2005-05-02 18:30 ` Poul-Erik Andreasen
2005-05-02 19:10 ` Simon Wright
2005-05-03 13:00 ` Poul-Erik Andreasen
2005-05-04 8:01 3% ` Character'First, ASCII.NUL and others (Was: Re: TCP/IP Sockets with GNAT.Sockets) Adrien Plisson
2005-05-04 13:40 0% ` Poul-Erik Andreasen
2005-06-30 8:44 ATC, an example please e.coli
2005-07-02 8:18 2% ` Craig Carey
2005-08-02 7:57 Character set conversion Adaddict
2005-08-02 9:45 3% ` Dmitry A. Kazakov
2005-08-31 17:07 Lower TC
2005-08-31 17:35 2% ` Lower Frode Tennebø
2005-09-29 17:20 1% New to Ada, noticing something strange mike.martelli
2005-09-29 18:39 ` Jeffrey R. Carter
2005-09-29 19:05 ` mike.martelli
2005-09-29 22:25 ` Randy Brukardt
2005-09-29 23:58 2% ` mike.martelli
2005-09-30 0:28 2% ` mike.martelli
2005-09-30 6:06 2% ` Jeffrey R. Carter
2006-08-17 0:58 ANNOUNCE: Avatox 1.0 is now available Marc A. Criley
2006-08-21 20:59 ` Simon Wright
2006-08-24 0:41 ` Marc A. Criley
2006-08-24 6:03 ` Simon Wright
2006-09-06 23:29 ` Randy Brukardt
2006-09-07 20:46 ` Simon Wright
2006-09-08 2:40 ` Randy Brukardt
2006-09-08 13:40 ` Georg Bauhaus
2006-09-09 8:28 ` Manuel Collado
2006-09-09 12:21 3% ` Simon Wright
2006-09-11 7:58 0% ` Manuel Collado
2006-08-21 8:03 Usage of \ in Ada Jerry
2006-08-21 19:44 ` Jeffrey R. Carter
2006-08-21 20:25 ` Dmitry A. Kazakov
2006-08-22 2:47 ` Jeffrey R. Carter
2006-08-22 7:42 ` Dmitry A. Kazakov
2006-08-22 18:13 ` Adam Beneschan
2006-08-23 8:35 ` Dmitry A. Kazakov
2006-08-23 17:31 ` Adam Beneschan
2006-08-23 20:25 ` Dmitry A. Kazakov
2006-08-24 0:22 ` Adam Beneschan
2006-08-24 8:37 2% ` Jean-Pierre Rosen
2006-08-24 9:53 0% ` Dmitry A. Kazakov
2006-08-24 17:16 0% ` Adam Beneschan
2006-10-13 16:32 2% Cursor control question - ncurses and alternatives Dr. Adrian Wrigley
2006-10-13 22:41 2% ` Björn Persson
[not found] <zH%1h.42912$XE5.888@reader1.news.jippii.net>
2006-11-01 12:19 0% ` New_Page Georg Bauhaus
2006-11-08 20:53 Regular Expressions in Ada 2005? matthias.kistler
2006-11-08 21:14 2% ` Georg Bauhaus
2006-11-10 6:52 2% Advice Please laehyung
2006-11-10 9:27 0% ` Dmitry A. Kazakov
2006-11-15 22:00 Char type verification KE
2006-11-15 21:57 3% ` Georg Bauhaus
2006-11-15 23:15 0% ` KE
2006-11-16 4:48 ` Jeffrey R. Carter
2006-11-16 23:30 1% ` Yves Bailly
2006-11-21 15:11 I/O streaming with custom data transport Maciej Sobczak
2006-11-21 17:51 ` Alex R. Mosteo
2006-11-22 9:16 2% ` Maciej Sobczak
2007-02-07 14:52 Ada.Containers.Doubly_Linked_Lists Carroll, Andrew
2007-02-07 15:06 2% ` Ada.Containers.Doubly_Linked_Lists Ludovic Brenta
2007-02-07 18:22 2% ` Ada.Containers.Doubly_Linked_Lists Jeffrey R. Carter
2007-02-08 13:39 0% ` Ada.Containers.Doubly_Linked_Lists Stephen Leake
2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll
2007-04-02 10:10 ` Stephen Leake
2007-04-02 14:11 1% ` andrew.carroll
2007-04-28 5:03 Reading and writing a big file in Ada (GNAT) on Windows XP Fionn Mac Cumhaill
2007-05-02 7:46 ` george
2007-05-03 6:31 ` Fionn Mac Cumhaill
2007-05-03 20:00 ` Simon Wright
2007-05-04 6:53 2% ` Alternative Index implementation? (Was: Reading and writing a big file in Ada (GNAT) on Windows XP) Jacob Sparre Andersen
2007-08-11 17:03 Tasking issues shaunpatterson
2007-08-12 9:00 ` anon
2007-08-12 9:43 ` Dmitry A. Kazakov
2007-08-12 21:39 ` anon
2007-08-13 9:22 2% ` Dmitry A. Kazakov
2007-11-12 19:53 [ranting] Take Command Plugin, Win32Ada and Ada.Directories Martin Krischik
2007-11-13 8:57 ` Dmitry A. Kazakov
2007-11-13 21:08 ` Pascal Obry
2007-11-14 8:33 ` Dmitry A. Kazakov
2007-11-14 8:56 ` Martin Krischik
2007-11-14 9:31 ` Georg Bauhaus
2007-11-14 13:15 2% ` Martin Krischik
2007-11-14 23:28 OO Style with Ada Containers braver
2007-11-14 23:50 ` Adam Beneschan
2007-11-14 23:59 ` braver
2007-11-15 0:24 ` braver
2007-11-19 2:24 2% ` Matthew Heaney
2008-03-30 21:48 Converting Type Characters to type string Georg Bauhaus
2008-03-30 23:52 ` jedivaughn
2008-03-31 3:04 2% ` george.priv
2008-03-31 4:00 ` tmoran
2008-03-31 8:54 2% ` Ludovic Brenta
2008-08-01 12:18 1% Gnade/ODBC example - please help azdakiel
2008-10-18 0:48 determining input data type jedivaughn
2008-10-18 18:54 3% ` anon
2008-11-03 16:27 Directory Operations andrei.krivoshei
2008-11-03 17:33 ` Dmitry A. Kazakov
2008-11-04 12:57 ` AndreiK
2008-11-04 14:44 2% ` Dmitry A. Kazakov
2008-11-26 5:52 Weird string I/O problem Jerry
2008-12-01 19:47 3% ` anon
2008-12-02 5:44 0% ` christoph.grein
2008-12-02 6:55 0% ` anon
2008-12-02 16:39 ` Adam Beneschan
2008-12-03 9:16 3% ` anon
2009-05-31 10:41 Howto read line from a stream Tomek Walkuski
2009-05-31 11:29 ` Tomek Wałkuski
2009-06-01 0:05 2% ` Jeffrey R. Carter
2009-06-03 15:49 0% ` Tomek Wałkuski
2009-06-03 19:07 0% ` sjw
2009-10-29 17:11 Types, packages & objects : the good old naming conventions question (without religious ware) Hibou57 (Yannick Duchêne)
2009-10-29 18:11 ` Georg Bauhaus
2009-10-30 0:01 2% ` Robert A Duff
2009-11-12 19:28 2% Funny thing with GNAT Socket? mockturtle
2010-06-29 14:28 Unbounded String to string tonyg
2010-06-29 14:33 ` Adam Beneschan
2010-06-29 14:37 ` tonyg
2010-06-29 15:08 3% ` Ludovic Brenta
2010-08-01 12:17 S-expression I/O in Ada Natacha Kerensikova
2010-08-17 17:01 ` Natasha Kerensikova
2010-08-17 19:00 ` Jeffrey Carter
2010-08-18 10:49 ` Natasha Kerensikova
2010-08-18 18:08 ` Jeffrey Carter
2010-08-19 8:09 ` Natasha Kerensikova
2010-08-19 17:59 2% ` Jeffrey Carter
2010-08-21 4:47 What about a glob standard method in Ada.Command_Line ? Yannick Duchêne (Hibou57)
2010-08-21 6:41 ` J-P. Rosen
2010-08-21 9:11 ` Pascal Obry
2010-08-22 19:00 ` J-P. Rosen
2010-08-23 23:06 ` Randy Brukardt
2010-08-24 0:02 ` Yannick Duchêne (Hibou57)
2010-08-24 0:24 ` Adam Beneschan
2010-08-24 10:27 ` Georg Bauhaus
2010-08-24 14:24 ` Dmitry A. Kazakov
2010-08-24 15:42 ` Georg Bauhaus
2010-08-24 16:04 ` Dmitry A. Kazakov
2010-08-24 17:10 ` Georg Bauhaus
2010-08-24 17:41 ` Dmitry A. Kazakov
2010-08-24 21:32 ` Georg Bauhaus
2010-08-25 7:55 ` Dmitry A. Kazakov
2010-08-25 8:57 2% ` Georg Bauhaus
2010-10-23 20:16 3% Problems with String processing George
2010-10-23 20:24 2% ` Niklas Holsti
2010-10-23 20:25 2% ` Dmitry A. Kazakov
2010-10-23 21:08 2% Wrong program structure George
2010-10-23 21:16 0% ` Vinzent Hoefler
2010-10-24 4:51 3% warning "blah" is an Ada 2005 unit stuart clark
2010-10-24 5:54 0% ` Anh Vo
2010-10-24 11:30 0% ` anon
2010-10-25 11:55 how to i get the type of a parameter specification is ASIS stuart clark
2010-10-25 13:07 ` Julian Leyh
2010-10-25 13:12 ` stuart clark
2010-10-25 13:24 ` Julian Leyh
2010-10-25 13:32 2% ` stuart clark
2010-12-20 0:43 Introducing memcache-ada, a memcached client in Ada R Tyler Croy
2010-12-20 8:25 2% ` Thomas Løcke
2010-12-24 16:36 2% Access Type kug1977
2010-12-24 17:30 0% ` Robert A Duff
2010-12-24 20:59 2% ` kug1977
2011-01-10 13:44 2% GPS 4.4.1. ADA 95: Calling ASCII codes for ESC and display row colum control Michael A
2011-01-10 14:19 0% ` Dmitry A. Kazakov
2011-01-10 19:29 0% ` Michael A
2011-02-18 22:52 Need some light on using Ada or not Luis P. Mendes
2011-02-19 13:07 ` Brian Drummond
2011-02-19 14:36 ` Georg Bauhaus
2011-02-19 18:25 ` Brian Drummond
2011-02-20 14:34 2% ` Brian Drummond
2011-02-20 15:45 ` jonathan
2011-02-20 19:49 ` Pascal Obry
2011-02-20 19:57 ` Brian Drummond
2011-02-20 22:47 ` Simon Wright
2011-02-21 12:52 2% ` Brian Drummond
2011-02-21 13:44 2% ` Simon Wright
2011-02-22 2:15 1% ` Shark8
2011-10-14 6:58 Why no Ada.Wide_Directories? Michael Rohan
2011-10-15 1:06 ` ytomino
2011-10-17 21:33 ` Randy Brukardt
2011-10-17 23:47 2% ` ytomino
2011-10-18 1:10 ` Adam Beneschan
2011-10-18 2:32 ` ytomino
2011-10-18 15:02 3% ` Adam Beneschan
2011-10-18 22:54 3% ` ytomino
2011-10-18 8:01 0% ` Dmitry A. Kazakov
2012-02-09 1:03 Need Help On Ada95 Problem Will
2012-02-09 2:01 ` Shark8
2012-02-10 1:36 ` BrianG
2012-02-10 2:22 ` Shark8
2012-02-10 5:32 ` Alex
2012-02-10 15:19 ` Shark8
2012-02-10 20:07 ` Robert A Duff
2012-02-12 19:40 3% ` Will
2012-04-03 2:11 Checking to see is a string is a letter deuteros
2012-04-03 4:18 ` Leo Brewin
2012-04-03 4:52 ` Checking to see if " deuteros
2012-04-03 5:15 ` Jeffrey Carter
2012-04-03 6:07 ` deuteros
2012-04-03 8:26 2% ` Simon Wright
2012-04-03 12:56 0% ` deuteros
2012-04-03 13:46 0% ` Dmitry A. Kazakov
2012-04-05 17:12 0% ` deuteros
2012-04-05 17:24 0% ` Martin Dowie
2012-04-03 20:40 2% ` Jeffrey Carter
2012-06-01 8:02 2% Software for Rational R1000 series 400? Jacob Sparre Andersen
2012-06-01 19:51 0% ` erlo
2012-06-13 20:12 Ada port of the osdev.org bare bones tutorial (mostly done) Lucretia
2012-06-15 12:24 ` Stepan Bujnak
2012-06-15 13:06 ` Lucretia
2012-06-15 13:14 ` Lucretia
2012-06-16 4:29 2% ` anon
2012-07-20 20:05 Ada "library only" compiler ? Patrick
2012-07-20 21:11 ` Niklas Holsti
2012-07-20 23:30 ` Patrick
2012-07-21 16:47 1% ` Niklas Holsti
2012-09-07 22:05 Help writing first daemon Patrick
2012-09-09 7:26 2% ` Help writing first daemon Heres a Server anon
2012-10-31 16:47 Child packages named Ada illegal? Marius Amado-Alves
2012-10-31 17:20 ` Adam Beneschan
2012-10-31 17:59 3% ` Marius Amado-Alves
2012-10-31 18:16 2% ` Adam Beneschan
2012-10-31 18:41 3% ` Marius Amado-Alves
2012-10-31 19:39 3% ` Shark8
2012-11-01 9:27 0% ` AdaMagica
2012-11-23 17:17 Sockets Example Sought Robert Love
2012-11-28 4:43 2% ` anon
2013-03-07 11:12 2% string and wide string usage Ali Bendriss
2013-03-07 14:20 3% ` ytomino
2013-03-07 17:14 0% ` Dmitry A. Kazakov
2013-03-07 23:53 2% ` Randy Brukardt
2013-03-11 10:37 Bootstrapping a null procedure. Seriously?! Diogenes
2013-03-13 4:34 1% ` anon
2014-01-05 23:55 3% Q: Localizing type and package references b.mcguinness747
2014-01-06 1:29 0% ` Jeffrey Carter
2014-01-06 8:05 0% ` Simon Wright
2014-01-28 1:06 3% need help learning Ada for a modula-2 programmer agent
2014-02-11 22:27 character literals agent
2014-02-11 23:56 ` adambeneschan
2014-02-12 15:53 2% ` Robert A Duff
2014-03-22 9:51 2% Problems validating XML with XML/Ada mockturtle
2014-04-04 0:35 gnatmake error I don't understand agent
2014-04-04 0:44 3% ` agent
2014-05-12 19:47 2% Weird error with Dynamic_Predicate mockturtle
2014-05-12 21:01 0% ` Adam Beneschan
2014-05-13 4:59 2% ` Shark8
2014-08-02 13:10 trimming strings agent
2014-08-02 17:22 ` mockturtle
2014-08-03 21:42 3% ` agent
2014-08-05 20:09 A bad counterintuitive behaviour of Ada about OO Victor Porton
2014-08-05 20:59 ` Dmitry A. Kazakov
2014-08-05 21:11 ` Victor Porton
2014-08-06 7:26 ` Dmitry A. Kazakov
2014-08-07 7:41 ` Maciej Sobczak
2014-08-07 8:58 ` J-P. Rosen
2014-08-07 9:40 ` Dmitry A. Kazakov
2014-08-07 11:17 ` J-P. Rosen
2014-08-07 12:28 ` Dmitry A. Kazakov
2014-08-07 13:34 ` J-P. Rosen
2014-08-07 20:29 ` Shark8
2014-08-08 7:49 ` J-P. Rosen
2014-08-08 8:12 ` Shark8
2014-08-08 8:26 ` Dmitry A. Kazakov
2014-08-08 11:10 ` Shark8
2014-08-08 11:20 ` Dmitry A. Kazakov
2014-08-08 19:34 2% ` Shark8
2014-10-03 23:29 array of string Stribor40
2014-10-07 16:49 3% ` brbarkstrom
2014-10-22 5:57 Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put? NiGHTS
2014-10-22 6:20 ` mockturtle
2014-10-22 17:16 3% ` NiGHTS
2014-10-22 6:25 2% ` Jeffrey Carter
2014-10-22 17:39 0% ` NiGHTS
2014-10-22 11:16 2% ` Björn Lundin
2014-11-21 11:41 How to get nice with GNAT? Natasha Kerensikova
2014-11-23 17:41 ` brbarkstrom
2014-11-23 20:49 ` Jeffrey Carter
2014-11-24 3:05 1% ` brbarkstrom
2015-02-02 5:50 2% Did I find mamory leak in Generic Image Decoder (GID) ? reinkor
2015-02-10 21:16 Convert a Wide_String (or a Wide_Character) to an Integer lomoscompany
2015-02-10 21:38 2% ` Jeffrey Carter
2015-03-24 19:19 2% GNAT bug in the GNAT GPL 2014 compiler? gorgelo
2015-03-24 21:56 0% ` Anh Vo
2015-03-25 7:35 3% ` gorgelo
2015-03-25 8:39 0% ` Simon Wright
2015-03-25 8:41 21% ` Georg Bauhaus
2015-04-17 13:42 2% Interesting containers problem Shark8
2015-06-02 11:33 Parsing Ada? Jacob Sparre Andersen
2015-06-03 7:58 ` Stephen Leake
2015-06-03 11:04 2% ` Simon Wright
2015-07-18 9:00 2% How to check if letters are in a string? Trish Cayetano
2015-08-24 14:16 Creating an empty file with Ada.Text_IO Maciej Sobczak
2015-08-24 16:15 ` Dmitry A. Kazakov
2015-08-25 8:20 3% ` Maciej Sobczak
2015-08-25 15:26 ` Maciej Sobczak
2015-08-25 16:45 2% ` G.B.
2015-08-27 13:52 Exclusive file access ahlan
2015-08-28 17:40 ` ahlan
2015-08-29 7:05 ` Dmitry A. Kazakov
2015-08-29 8:31 ` Pascal Obry
2015-08-29 12:02 2% ` Dmitry A. Kazakov
2015-11-15 23:16 2% How to append linefeed to unbounded string? John Smith
2015-11-15 23:22 2% ` Jeffrey R. Carter
2015-11-15 23:25 0% ` John Smith
2015-11-22 21:40 GNAT.Serial_Communication and Streams rrr.eee.27
2015-11-22 21:54 2% ` Jeffrey R. Carter
2015-11-24 1:29 0% ` Randy Brukardt
2015-11-24 8:28 0% ` Dmitry A. Kazakov
2016-06-03 8:14 no code generation for c strings Luke A. Guest
2016-06-03 8:25 ` Dmitry A. Kazakov
2016-06-03 16:30 ` Simon Wright
2016-06-03 17:04 2% ` Lucretia
2016-09-04 19:22 Can anyone help with GNAT.Perfect_Hash_Generators ? (Possible memory corruption) Natasha Kerensikova
2016-09-05 17:18 ` Stephen Leake
2016-09-06 19:24 1% ` Natasha Kerensikova
2016-09-13 8:46 Question on bounded / unbounded strings Arie van Wingerden
2016-09-14 12:57 ` Arie van Wingerden
2016-09-14 19:39 1% ` Jeffrey R. Carter
2016-09-17 16:35 1% ` Arie van Wingerden
2017-06-28 9:25 send email Distant Worlds
2017-07-18 7:48 2% ` Björn Lundin
2017-12-01 15:08 "strings are delimited by double quote character", where there's a character variable Mehdi Saada
2017-12-01 19:09 2% ` Shark8
2017-12-05 21:45 0% ` Keith Thompson
2018-03-01 0:27 CONSTRAINT ERROR? access check failed Mehdi Saada
2018-03-01 8:07 ` Niklas Holsti
2018-03-01 12:44 ` Mehdi Saada
2018-03-01 13:45 2% ` Björn Lundin
2018-04-11 0:52 The extension of Is_Basic to unicode (about AI12-0260-1) ytomino
2018-04-11 14:32 ` Dan'l Miller
2018-04-11 20:54 ` J-P. Rosen
2018-04-11 22:20 2% ` Randy Brukardt
2018-04-11 23:57 0% ` ytomino
2018-06-30 10:48 Strange crash on custom iterator Lucretia
2018-06-30 11:32 ` Simon Wright
2018-06-30 12:02 ` Lucretia
2018-06-30 14:25 ` Simon Wright
2018-06-30 14:33 ` Lucretia
2018-06-30 19:25 ` Simon Wright
2018-06-30 19:36 ` Luke A. Guest
2018-07-01 18:06 ` Jacob Sparre Andersen
2018-07-01 19:59 ` Simon Wright
2018-07-02 17:43 ` Luke A. Guest
2018-07-02 19:42 1% ` Simon Wright
2018-08-04 1:37 3% Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?) Hazz
2018-08-04 1:59 0% ` Lucretia
2018-08-04 9:07 0% ` Jeffrey R. Carter
2018-10-31 2:57 windows-1251 to utf-8 eduardsapotski
2018-10-31 15:28 ` eduardsapotski
2018-10-31 17:01 ` Dmitry A. Kazakov
2018-10-31 20:58 2% ` Randy Brukardt
2019-02-17 11:24 gnat_regpat and unexpected handling of alnum and unicode needed 19.krause.70
2019-02-17 12:50 2% ` Simon Wright
2019-06-24 23:33 2% Making the same mistake as the broken C interface to fortran Chris M Moore
2019-07-02 20:57 0% ` Simon Wright
2019-07-03 7:06 0% ` Chris M Moore
2020-03-25 20:48 How do I resolve SPARK warning "procedure [...] has no effect for output procedure digitig
2020-03-25 23:38 ` Anh Vo
2020-03-26 0:45 2% ` digitig
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
2020-06-16 14:14 2% ` Niklas Holsti
2020-06-16 14:25 0% ` Dmitry A. Kazakov
2020-06-16 14:32 0% ` Niklas Holsti
2020-06-16 14:42 0% ` Luke A. Guest
2020-06-16 15:21 0% ` Dmitry A. Kazakov
2020-06-16 15:43 0% ` Luke A. Guest
2020-06-16 16:11 0% ` Dmitry A. Kazakov
2020-06-16 14:40 0% ` Luke A. Guest
2020-09-03 10:32 0% ` c+
2020-09-13 13:36 0% ` patelchetan1111992
2020-09-19 14:08 0% ` erchetan33
2020-09-28 11:36 0% ` yhumina stir
2021-06-19 18:28 XMLAda & unicode symbols 196...@googlemail.com
2021-06-19 19:53 2% ` Jeffrey R. Carter
2021-06-20 17:02 0% ` 196...@googlemail.com
2021-06-20 17:23 0% ` Dmitry A. Kazakov
2021-06-20 17:58 0% ` 196...@googlemail.com
2021-06-20 18:16 0% ` Dmitry A. Kazakov
2021-06-21 19:40 0% ` 196...@googlemail.com
2021-06-20 18:21 0% ` Jeffrey R. Carter
2021-06-19 21:24 3% ` Simon Wright
2021-06-20 17:10 0% ` 196...@googlemail.com
2021-06-21 15:26 2% ` Simon Wright
2021-09-05 3:20 AWS.SMTP.Client secure mode philip...@gmail.com
2021-09-06 9:26 2% ` Björn Lundin
2021-09-10 17:56 GtkAda and € AdaMagica
2021-09-10 18:53 ` Dmitry A. Kazakov
2021-09-11 9:20 ` AdaMagica
2021-09-11 10:04 ` Dmitry A. Kazakov
2021-09-11 13:26 ` AdaMagica
2021-09-11 13:51 ` AdaMagica
2021-09-11 17:46 2% ` Manuel Gomez
2021-09-12 7:04 0% ` AdaMagica
2022-10-11 8:06 Bold text (in terminal) from Ada? reinert
2022-10-11 8:49 3% ` Niklas Holsti
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox