* Re: Bold text (in terminal) from Ada?
@ 2022-10-11 8:49 5% ` 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 5%]
* Re: AWS.SMTP.Client secure mode
@ 2021-09-06 9:26 3% ` 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 3%]
* Re: XMLAda & unicode symbols
2021-06-20 17:10 0% ` 196...@googlemail.com
@ 2021-06-21 15:26 4% ` 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 4%]
* Re: XMLAda & unicode symbols
2021-06-19 21:24 6% ` Simon Wright
@ 2021-06-20 17:10 0% ` 196...@googlemail.com
2021-06-21 15:26 4% ` 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 21:24 6% ` Simon Wright
2021-06-20 17:10 0% ` 196...@googlemail.com
0 siblings, 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 6%]
* 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 4% ` 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 4% ` 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 4% ` 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 4% ` 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 4% ` 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 4%]
* 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 4% ` 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 5% ` 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 5%]
* Re: Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?)
2018-08-04 1:37 4% 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 4% 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 4% 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 4%]
* Re: Strange crash on custom iterator
@ 2018-07-02 19:42 3% ` 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 3%]
* Re: "strings are delimited by double quote character", where there's a character variable
2017-12-01 19:09 4% ` 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 4% ` 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 4%]
* Re: send email
@ 2017-07-18 7:48 3% ` 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 3%]
* Re: Can anyone help with GNAT.Perfect_Hash_Generators ? (Possible memory corruption)
@ 2016-09-06 19:24 2% ` 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 2%]
* Re: no code generation for c strings
@ 2016-06-03 17:04 4% ` 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 4%]
* Re: GNAT.Serial_Communication and Streams
2015-11-22 21:54 4% ` 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 4% ` 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 4% ` 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 4%]
* Re: How to append linefeed to unbounded string?
2015-11-15 23:22 4% ` 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 4% How to append linefeed to unbounded string? John Smith
@ 2015-11-15 23:22 4% ` 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 4%]
* How to append linefeed to unbounded string?
@ 2015-11-15 23:16 4% John Smith
2015-11-15 23:22 4% ` 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 4%]
* Re: Exclusive file access
@ 2015-08-29 12:02 4% ` 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 4%]
* Re: Creating an empty file with Ada.Text_IO
@ 2015-08-25 16:45 5% ` 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 5%]
* Re: Creating an empty file with Ada.Text_IO
@ 2015-08-25 8:20 5% ` 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 5%]
* Did I find mamory leak in Generic Image Decoder (GID) ?
@ 2015-02-02 5:50 3% 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 3%]
* Re: How to get nice with GNAT?
@ 2014-11-24 3:05 3% ` 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 3%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
2014-10-22 6:25 3% ` 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 5% ` 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 5%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
2014-10-22 6:25 3% ` Jeffrey Carter
@ 2014-10-22 11:16 4% ` 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 4%]
* Re: Assembling Complex Strings Containing Carriage Returns Prior to Using Ada.Text_IO.Put?
@ 2014-10-22 6:25 3% ` Jeffrey Carter
2014-10-22 17:39 0% ` NiGHTS
2014-10-22 11:16 4% ` 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 3%]
* Re: array of string
@ 2014-10-07 16:49 5% ` 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 5%]
* Re: trimming strings
@ 2014-08-03 21:42 5% ` 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 5%]
* Problems validating XML with XML/Ada
@ 2014-03-22 9:51 4% 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 4%]
* need help learning Ada for a modula-2 programmer
@ 2014-01-28 1:06 4% 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 4%]
* Re: Ada port of the osdev.org bare bones tutorial (mostly done)
@ 2012-06-16 4:29 4% ` 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 4%]
* Re: Software for Rational R1000 series 400?
2012-06-01 8:02 3% 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 3% 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 3%]
* Re: Need some light on using Ada or not
2011-02-21 12:52 3% ` Brian Drummond
2011-02-21 13:44 3% ` Simon Wright
@ 2011-02-22 2:15 2% ` 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 2%]
* Re: Need some light on using Ada or not
2011-02-21 12:52 3% ` Brian Drummond
@ 2011-02-21 13:44 3% ` Simon Wright
2011-02-22 2:15 2% ` 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 3%]
* Re: Need some light on using Ada or not
@ 2011-02-21 12:52 3% ` Brian Drummond
2011-02-21 13:44 3% ` Simon Wright
2011-02-22 2:15 2% ` 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 3%]
* Re: Need some light on using Ada or not
@ 2011-02-20 14:34 3% ` 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 3%]
* 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 4% 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 4% 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 4%]
* Re: Access Type
2010-12-24 17:30 0% ` Robert A Duff
@ 2010-12-24 20:59 3% ` 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 3%]
* Re: Access Type
2010-12-24 16:36 3% Access Type kug1977
@ 2010-12-24 17:30 0% ` Robert A Duff
2010-12-24 20:59 3% ` 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 3% 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 3%]
* Re: Introducing memcache-ada, a memcached client in Ada
@ 2010-12-20 8:25 3% ` 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 3%]
* Re: What about a glob standard method in Ada.Command_Line ?
@ 2010-08-25 8:57 4% ` 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 4%]
* Funny thing with GNAT Socket?
@ 2009-11-12 19:28 5% 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 5%]
* 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 4% ` 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 4% ` 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 4%]
* Re: Weird string I/O problem
@ 2008-12-03 9:16 4% ` 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 4%]
* 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 5% ` 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 5% ` 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 5%]
* Re: Directory Operations
@ 2008-11-04 14:44 5% ` 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 5%]
* Re: OO Style with Ada Containers
@ 2007-11-19 2:24 3% ` 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 3%]
* Re: Tasking issues
@ 2007-08-13 9:22 4% ` 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 4%]
* Alternative Index implementation? (Was: Reading and writing a big file in Ada (GNAT) on Windows XP)
@ 2007-05-04 6:53 5% ` 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 5%]
* 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 5% ` 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 4% ` Ada.Containers.Doubly_Linked_Lists Ludovic Brenta
@ 2007-02-07 18:22 5% ` 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 5%]
* Re: Ada.Containers.Doubly_Linked_Lists
@ 2007-02-07 15:06 4% ` Ludovic Brenta
2007-02-07 18:22 5% ` 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 4%]
* Re: Char type verification
2006-11-15 21:57 4% ` Georg Bauhaus
@ 2006-11-15 23:15 0% ` KE
0 siblings, 0 replies; 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 4% ` 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 4%]
* 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 4% Cursor control question - ncurses and alternatives Dr. Adrian Wrigley
@ 2006-10-13 22:41 4% ` 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 4%]
* Cursor control question - ncurses and alternatives
@ 2006-10-13 16:32 4% Dr. Adrian Wrigley
2006-10-13 22:41 4% ` 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 4%]
* 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 4% ` 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 4% ` 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 4%]
* Re: Character'First, ASCII.NUL and others (Was: Re: TCP/IP Sockets with GNAT.Sockets)
2005-05-04 8:01 6% ` 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 6% ` 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 6%]
* Re: Ada bench : count words
2005-03-23 15:09 4% ` 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 3% ` 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 3%]
* Ada bench : word frequency
@ 2005-03-23 20:39 3% ` 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 3%]
* Re: Ada bench : count words
[not found] ` <00b362390273e6c04844dd4ff1885ee0@netcabo.pt>
@ 2005-03-23 15:09 4% ` 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 4%]
* Re: Ada bench : count words
2005-03-22 1:16 4% ` Ada bench : count words Marius Amado Alves
2005-03-22 10:59 0% ` Dmitry A. Kazakov
@ 2005-03-22 22:27 4% ` 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 4%]
* Re: Ada bench : count words
2005-03-22 17:39 5% ` 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 5% ` 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 5%]
* Re: Ada bench : count words
2005-03-22 12:47 5% ` 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 5% ` 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 5%]
* Re: Ada bench : count words
2005-03-22 1:16 4% ` Ada bench : count words Marius Amado Alves
@ 2005-03-22 10:59 0% ` Dmitry A. Kazakov
2005-03-22 22:27 4% ` 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 4% ` 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 4%]
* XML Strings in Ada
@ 2004-12-08 16:46 4% 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 4%]
* Re: Question about Ada.Unchecked_Conversion
2004-10-29 14:22 5% ` Dmitry A. Kazakov
@ 2004-10-29 15:15 5% ` 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 5%]
* Re: Question about Ada.Unchecked_Conversion
@ 2004-10-29 14:22 5% ` Dmitry A. Kazakov
2004-10-29 15:15 5% ` 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 5%]
* Re: variable lenght strings
@ 2004-10-22 7:38 4% ` 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 4%]
* Re: reading a text file into a string
2004-07-15 19:18 3% ` Nick Roberts
@ 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 3% ` 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 3%]
* Re: reading a text file into a string
@ 2004-07-15 19:18 3% ` Nick Roberts
2004-07-15 20:02 0% ` Nick Roberts
1 sibling, 1 reply; 200+ results
From: Nick Roberts @ 2004-07-15 19:18 UTC (permalink / raw)
On Fri, 16 Jul 2004 03:27:57 +1000, zork <zork@nospam.com> wrote:
> hi, i would like to read a whole text file into a string. I thought of
> using
> an unbounded_string for this:
>
> ----------
> c, char: character;
> text : unbounded_string;
> ...
> -- read in text file
> while not end_of_file ( File ) loop
> Get ( File, c );
> append ( text, c );
> end loop;
> ...
> put ( to_string ( text ) ); -- display content of unbounded_string
>
> -- process text
> for i in 1 .. length ( text ) loop
> char := element ( text, i );
> ...
> end loop;
> -----------
>
> ... is this the general way of going about it? or is there a more
> prefered
> method of reading in a whole text file (into whatever format) for
> processing?
It is usual to read and process information from files a piece at a time.
Quite often a file is read a piece at a time, each piece is interpreted in
some way, and then some structure is built up in memory from the
interpreted pieces. Then, typically, further processing is done using the
whole structure.
It is unusual to read an entire text file into a string in memory.
However, sometimes this may be a quick and convenient technique for
achieving results in a hurry. An unbounded string will generally be the
appropriate data structure to use for this purpose. The problem you do not
address with the code you suggest above -- as another poster has pointed
out -- is that of line breaks. One easy possibility might be to 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. Line breaks are then indicated by the NUL
character, and could be processed as such. This should work provided the
file itself does not contain any NULs.
--
Nick Roberts
^ permalink raw reply [relevance 3%]
* Re: Clause "with and use"
2003-11-06 20:38 4% ` Gautier Write-only
2003-11-06 21:12 0% ` Warren W. Gay VE3WWG
@ 2003-11-07 7:08 0% ` Russ
1 sibling, 0 replies; 200+ results
From: Russ @ 2003-11-07 7:08 UTC (permalink / raw)
Gautier Write-only <gautier@fakeaddress.nil> wrote in message news:<3FAAB12E.C7593B45@fakeaddress.nil>...
> > Hyman Rosen:
>
> [...]
> > > for an example of the latter form. It contains
> > > with ADA.TEXT_IO, ADA.CALENDAR, ADA.CHARACTERS.LATIN_1;
> > > use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
> > >
> > > So upon seeing a with/use pair, I have to read it carefully to
> > > see if the two lists are the same, and if they are not, try to
> > > figure out why that may be.
>
> Warren W. Gay VE3WWG:
> > The other problem is that you don't always want to "use"
> > every with. Consider [...]
>
> It is exactly what the author of the above code wanted,
> not to "use" ADA.CALENDAR. *This* would be a lot clearer if only
>
> with ADA.CALENDAR;
> use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
>
> was sufficient (this is the "implicit 'with'" variant) - or
>
> with ADA.CALENDAR;
> with and use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
>
> And the list can be long in *certain* programs, *not* the
> safety-critical code or whatever "special" code where
> anyway an Ada subset without "use" at all is preferable,
> *but* the "everyday programming" where some general-purpose
> packages for
> - the Text_IO stuff
> - the Floating-point maths
> - GUI stuff
> are obviously better to be "use"-d at the unit level.
> And this is still a *minority* of packages, the other ones,
> specialized, would be of course only "with"ed by normal persons.
>
> All that is a question of style, project, taste, security,
> about the usage of "use", which is already in the language.
> The purpose of the proposal is not to reintroduce "use" or
> changing any style rule, but *only* to make the life
> easier and programs clearer when (and only when) we use
> "use" as a context clause.
> The question of desirability of "use" in such or such context
> or for such or such package is *another* problem - and sorry,
> "use" exists, it won't be removed, but if one wants one can
> avoid it, at worst with a language subset, and it won't hurt
> anybody.
>
> The whole debate has (as expected ;-) shifted from
> "how to make use-as-a-context-clause easier"
> to
> "to use or not to use"
> or even
> "to += or not to +=".
> Please (dear participants) remain on-topic...
I'm with you on this one. Whether it's "with and use," with/use", or
simply "use" (as context clause) implies "with" (my preference), I
just don't see any rational argument against it. Programmers would
still be able to use "with" and "use" exactly as they do now.
You've heard of a "tin ear", but I think it takes a "tin eye" to
insist on repetitive "with" and "use" for things like basic I/O. Try
to imagine how many potential Ada users are turned off by such
clutter.
By the way, I am not the one who introduced "+=" on this thread. I
merely replied to someone else's offhand remark.
^ permalink raw reply [relevance 0%]
* Re: Clause "with and use"
2003-11-06 20:38 4% ` Gautier Write-only
@ 2003-11-06 21:12 0% ` Warren W. Gay VE3WWG
2003-11-07 7:08 0% ` Russ
1 sibling, 0 replies; 200+ results
From: Warren W. Gay VE3WWG @ 2003-11-06 21:12 UTC (permalink / raw)
Gautier Write-only wrote:
>>Hyman Rosen:
> [...]
>
>>>for an example of the latter form. It contains
>>> with ADA.TEXT_IO, ADA.CALENDAR, ADA.CHARACTERS.LATIN_1;
>>> use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
>>>
>>>So upon seeing a with/use pair, I have to read it carefully to
>>>see if the two lists are the same, and if they are not, try to
>>>figure out why that may be.
>
> Warren W. Gay VE3WWG:
>
>>The other problem is that you don't always want to "use"
>>every with. Consider [...]
>
> It is exactly what the author of the above code wanted,
> not to "use" ADA.CALENDAR. *This* would be a lot clearer if only
>
> with ADA.CALENDAR;
> use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
>
> was sufficient (this is the "implicit 'with'" variant) - or
>
> with ADA.CALENDAR;
> with and use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
But as soon as you designate that, someone else will
want another variation of your "with and use" to use
all elements in the path. ;-)
> All that is a question of style, project, taste, security,
> about the usage of "use", which is already in the language.
> The purpose of the proposal is not to reintroduce "use" or
> changing any style rule, but *only* to make the life
> easier and programs clearer when (and only when) we use
> "use" as a context clause.
Well, I think the group has already responded to this
(and more), so I won't repeat my own opinion about
it. ;-)
--
Warren W. Gay VE3WWG
http://home.cogeco.ca/~ve3wwg
^ permalink raw reply [relevance 0%]
* Re: Clause "with and use"
2003-11-06 17:26 0% ` Warren W. Gay VE3WWG
@ 2003-11-06 20:38 4% ` Gautier Write-only
2003-11-06 21:12 0% ` Warren W. Gay VE3WWG
2003-11-07 7:08 0% ` Russ
0 siblings, 2 replies; 200+ results
From: Gautier Write-only @ 2003-11-06 20:38 UTC (permalink / raw)
> Hyman Rosen:
[...]
> > for an example of the latter form. It contains
> > with ADA.TEXT_IO, ADA.CALENDAR, ADA.CHARACTERS.LATIN_1;
> > use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
> >
> > So upon seeing a with/use pair, I have to read it carefully to
> > see if the two lists are the same, and if they are not, try to
> > figure out why that may be.
Warren W. Gay VE3WWG:
> The other problem is that you don't always want to "use"
> every with. Consider [...]
It is exactly what the author of the above code wanted,
not to "use" ADA.CALENDAR. *This* would be a lot clearer if only
with ADA.CALENDAR;
use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
was sufficient (this is the "implicit 'with'" variant) - or
with ADA.CALENDAR;
with and use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
And the list can be long in *certain* programs, *not* the
safety-critical code or whatever "special" code where
anyway an Ada subset without "use" at all is preferable,
*but* the "everyday programming" where some general-purpose
packages for
- the Text_IO stuff
- the Floating-point maths
- GUI stuff
are obviously better to be "use"-d at the unit level.
And this is still a *minority* of packages, the other ones,
specialized, would be of course only "with"ed by normal persons.
All that is a question of style, project, taste, security,
about the usage of "use", which is already in the language.
The purpose of the proposal is not to reintroduce "use" or
changing any style rule, but *only* to make the life
easier and programs clearer when (and only when) we use
"use" as a context clause.
The question of desirability of "use" in such or such context
or for such or such package is *another* problem - and sorry,
"use" exists, it won't be removed, but if one wants one can
avoid it, at worst with a language subset, and it won't hurt
anybody.
The whole debate has (as expected ;-) shifted from
"how to make use-as-a-context-clause easier"
to
"to use or not to use"
or even
"to += or not to +=".
Please (dear participants) remain on-topic...
________________________________________________________
Gautier -- http://www.mysunrise.ch/users/gdm/gsoft.htm
NB: For a direct answer, e-mail address on the Web site!
^ permalink raw reply [relevance 4%]
* Re: Clause "with and use"
2003-11-06 13:03 5% ` Hyman Rosen
2003-11-06 15:35 0% ` Preben Randhol
@ 2003-11-06 17:26 0% ` Warren W. Gay VE3WWG
2003-11-06 20:38 4% ` Gautier Write-only
1 sibling, 1 reply; 200+ results
From: Warren W. Gay VE3WWG @ 2003-11-06 17:26 UTC (permalink / raw)
Hyman Rosen wrote:
> Preben Randhol wrote:
>
>> So what do you relaly mean?
>
> I mean that an Ada program can contain
> with a, b, c, d;
> use a, b, c, d;
> and it may also contain
> with a, b, c, d;
> use a, c, d;
> See <http://www.scism.sbu.ac.uk/law/Section2/chap4/s2c4p4.html>
> for an example of the latter form. It contains
> with ADA.TEXT_IO, ADA.CALENDAR, ADA.CHARACTERS.LATIN_1;
> use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
>
> So upon seeing a with/use pair, I have to read it carefully to
> see if the two lists are the same, and if they are not, try to
> figure out why that may be.
The other problem is that you don't always want to "use"
every with. Consider:
WITH ADA.STRINGS.FIXED;
I may just want:
USE ADA.STRINGS.FIXED;
but not:
USE ADA.STRINGS;
Why? Because ADA.STRINGS.LEFT may conflict with some other
definition I have in my code named LEFT. However, I may
want to use ADA.STRINGS.FIXED.INDEX() for some reason,
perhaps frequently so, that a USE statement makes sense
within the block where it is referenced. Where I need
ADA.STRINGS.LEFT, I can use the fully qualified path
to it.
--
Warren W. Gay VE3WWG
http://home.cogeco.ca/~ve3wwg
^ permalink raw reply [relevance 0%]
* Re: Clause "with and use"
2003-11-06 13:03 5% ` Hyman Rosen
@ 2003-11-06 15:35 0% ` Preben Randhol
2003-11-06 17:26 0% ` Warren W. Gay VE3WWG
1 sibling, 0 replies; 200+ results
From: Preben Randhol @ 2003-11-06 15:35 UTC (permalink / raw)
On 2003-11-06, Hyman Rosen <hyrosen@mail.com> wrote:
> Preben Randhol wrote:
>> So what do you relaly mean?
>
> I mean that an Ada program can contain
> with a, b, c, d;
> use a, b, c, d;
> and it may also contain
> with a, b, c, d;
> use a, c, d;
> See <http://www.scism.sbu.ac.uk/law/Section2/chap4/s2c4p4.html>
> for an example of the latter form. It contains
> with ADA.TEXT_IO, ADA.CALENDAR, ADA.CHARACTERS.LATIN_1;
> use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
>
> So upon seeing a with/use pair, I have to read it carefully to
> see if the two lists are the same, and if they are not, try to
> figure out why that may be.
>
> I was contrasting this with the repetition Ada requires, for
> example, at the end of a function, where you know that the
> repeated name must match the subprogram name, so you don't
> really have to think about it.
>
I still don't understand what you mean. You don't have to "use" anything
you "with". With "use" one do not have to write:
with Ada.Text_IO;
-- ...
Ada.Text_IO.Put_Line ("Some text");
but only:
with Ada.Text_IO; use Ada.Text_IO;
-- ...
Put_Line ("Some text");
however a good rule is to "use" as little as possible.
Preben
--
"Saving keystrokes is the job of the text editor, not the programming
language."
^ permalink raw reply [relevance 0%]
* Re: Clause "with and use"
@ 2003-11-06 13:03 5% ` Hyman Rosen
2003-11-06 15:35 0% ` Preben Randhol
2003-11-06 17:26 0% ` Warren W. Gay VE3WWG
0 siblings, 2 replies; 200+ results
From: Hyman Rosen @ 2003-11-06 13:03 UTC (permalink / raw)
Preben Randhol wrote:
> So what do you relaly mean?
I mean that an Ada program can contain
with a, b, c, d;
use a, b, c, d;
and it may also contain
with a, b, c, d;
use a, c, d;
See <http://www.scism.sbu.ac.uk/law/Section2/chap4/s2c4p4.html>
for an example of the latter form. It contains
with ADA.TEXT_IO, ADA.CALENDAR, ADA.CHARACTERS.LATIN_1;
use ADA.TEXT_IO, ADA.CHARACTERS.LATIN_1;
So upon seeing a with/use pair, I have to read it carefully to
see if the two lists are the same, and if they are not, try to
figure out why that may be.
I was contrasting this with the repetition Ada requires, for
example, at the end of a function, where you know that the
repeated name must match the subprogram name, so you don't
really have to think about it.
^ permalink raw reply [relevance 5%]
* Re: Newbie GNAT question
@ 2003-10-29 16:18 6% ` Martin Krischik
0 siblings, 0 replies; 200+ results
From: Martin Krischik @ 2003-10-29 16:18 UTC (permalink / raw)
sk wrote:
> krischik@users.sourceforge.net:
> > However there is not Free_Arguement_List (...) in
> > Gnat.Os_Lib. But don't despair there is one in
> > AdaCL.OS.Command.
>
> Do you need one ?
>
> declare
> Cmd : constant String := "/bin/ls";
> Args : constant String := Gnat.Os_Lib.Arguement_String_To_List
> ("-al"); Success : Boolean := False;
> begin
> Gnat.Os_Lib.Spawn (Cmd, Args, Success);
>
> -- Check success and continue ...
>
> end;
>
> OR
>
> ....
> Gnat.Os_Lib.Spawn (
> Command => "/bin/ls",
> Args => Gnat.Os_Lib.Argument_String_To_List ("-al"),
> Success => Success
> );
>
> I believe that there is no need for a "Free" in either case :-)
If you like memory leaks or have a special GNAT with full gargage collection
then not.
For anybody else, look closer: Args is an Argument_List:
procedure Spawn
(Program_Name : String;
Args : Argument_List;
Success : out Boolean)
An Argument_List is an of access to string:
type String_Access is access all String;
subtype Argument_List is String_List;
And unlike common belive Gnat.Os_Lib.Spawn will not free the Args ot any of
the strings contained:
begin
-- Copy arguments into a local structure
for K in N_Args'Range loop
N_Args (K) := new String'(Args (K).all);
end loop;
-- Normalize those arguments
Normalize_Arguments (N_Args);
-- Call spawn using the normalized arguments
Spawn (N_Args);
-- Free arguments list
for K in N_Args'Range loop
Free (N_Args (K));
end loop;
end Spawn_Internal;
It makes copy for Normalize_Arguments and frees that copy but not the
original. BTW: it can't since it is "access _all_ String;" - you can
create the Args with strings from the stack.
You can of course use AdaCL.OS.Command:
http://adacl.sourceforge.net/html/______Include__AdaCL-OS-Command__ads.htm
Which does not leak memory and who's Argument_String_To_List is lot more
powerfull:
--
-- Convert a String into an argument list. Unlike the
-- version of GNAT.OS this version strips the double
-- quotes. You will need this if you want to execute
-- command with spaces inside a filename.
--
-- Also you can freely choose the Seperator, Quotation
-- and escape character. This makes it easier to compose
-- commandlines where you need the characters usualy used
-- for this purpouse.
--
function Argument_String_To_List (
-- Argument string. Arguments with spaces should be
-- quoted.
Arg_String : in String;
-- Character seperating Arguments. Other options
-- which might be used here are:
--
-- Ada.Characters.Latin_1.NUL
-- Ada.Characters.Latin_1.LF
Seperator : in Character := Ada.Characters.Latin_1.Space;
-- Character to enclose Arguments. This overwrites
-- the seperator character. Other options
-- which might be used here are:
--
-- Ada.Characters.Latin_1.Apostrophe
Quotation : in Character := Ada.Characters.Latin_1.Quotation;
-- Character to remove special meaning of next
-- character. Other options which might be used here are:
--
-- Ada.Characters.Latin_1.ESC
Escape : in Character := Ada.Characters.Latin_1.Reverse_Solidus)
return
GNAT.OS_Lib.Argument_List_Access;
With Regards
Martin
--
mailto://krischik@users.sourceforge.net
http://www.ada.krischik.com
^ permalink raw reply [relevance 6%]
* Re: array of strings in a function
@ 2003-10-16 14:30 3% ` Robert I. Eachus
0 siblings, 0 replies; 200+ results
From: Robert I. Eachus @ 2003-10-16 14:30 UTC (permalink / raw)
Antonio Martï¿œnez ï¿œlvarez wrote:
> Hello again. I'm the original poster.
>
> What I want to do is a procedure (sorry, not a function) to do something
> like this:
>
> my_AND("Entrada_1", "P2", "Output");
>
> and with this argument, this function have to write this:
>
> entity my_AND is port(
> Entrada_1 : in std_logic;
> P2 : in std_logic;
> Output : out std:logic;
> );
>
> (This is VHDL code, very similar to Ada95).
Now it becomes clear. You need a way to "wrap-up" names passed as
strings and unwrap them into the original strings inside the procedure.
The idea of declaring a procedure with a lot of String parameters all
with default values denoting that the parameter is not used can work.
But it is conceptually ugly. A better way is to define a type:
type Parameter_List is private;
the operations to create a parameter list:
function "+"(Left, Right: String) return Parameter_List;
function "+"(Left: Parameter_List; Right: String) return Parameter_List;
and the operations to access the contents of objects of the type:
function Length(P: Parameter_List) return Integer;
function Contents(P: Parameter_List; Row: Integer) return String;
Now any of the techniques suggested for implementing the Parameter_List
type will work. Let me, in case it isn't obvious say how you should use
the ADT:
procedure my_AND(P: Parameter_List);
begin
my_AND("Entrada_1" + "P2" + "Output");
This call will create Parameter_List with three entries that can be
"unwrapped" inside my_AND.
So how to implement the ADT? You could make Parameter_List an array of
Unbounded_String. Or you could choose a String with markers:
type Parameter_List is String;
function "+"(Left, Right: String) return Parameter_List is
Temp: String(1..Left'Length) := Left -- slide Left if necessary;
begin return Temp & '+' & Right; end "+";
function "+"(Left: Parameter_List; Right: String) return Parameter_List;
begin return Left & '+' & Right; end "+";
function Length(P: Parameter_List) return Integer is
Count: Integer := 0;
begin
for I in P'Range loop
if P(I) = '+' then Count := Count + 1;
end loop;
return Count;
end Length;
function Contents(P: Parameter_List; Row: Integer) is
First: Integer := P'First;
Last: Integer := P'Last;
Count: Integer := 0;
begin
for I in P'Range loop
if P(I) = '+'
then
Count := Count + 1;
if Count = Row - 1
then First := I+1;
elsif Count = Row
then Last := I-1;
return P(First..Last);
end if;
end if;
end loop;
if Count = Row - 1
then return P(First..Last); -- last entry not followed by "+"
else raise Constraint_Error; -- Row number incorrect
end if;
end Contents;
Of course, this would mean that users couldn't have "+" in their name
strings. So you might want to use a marker such as
Ada.Characters.Latin_1.Reserved_128. That can't accidently appear in a
string literal. Or Ada.Characters.Latin1.No_Break_Space. ;-)
--
Robert I. Eachus
"Quality is the Buddha. Quality is scientific reality. Quality is the
goal of Art. It remains to work these concepts into a practical,
down-to-earth context, and for this there is nothing more practical or
down-to-earth than what I have been talking about all along...the repair
of an old motorcycle." -- from Zen and the Art of Motorcycle
Maintenance by Robert Pirsig
^ permalink raw reply [relevance 3%]
* Re: Terminating a task
2003-07-14 23:45 5% ` Matthew Heaney
@ 2003-07-15 22:37 0% ` Robert I. Eachus
0 siblings, 0 replies; 200+ results
From: Robert I. Eachus @ 2003-07-15 22:37 UTC (permalink / raw)
Matthew Heaney wrote:
> Here is a simplified version of the program, which closely follows the
> gcc example:
>
>
> with Ada.Text_IO; use Ada.Text_IO;
> with Ada.Characters.Latin_1; use Ada.Characters;
> with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
>
> procedure WC is
>
> Line : String (1 .. 133);
> Last : Natural;
>
> NL, NW, NC : Integer'Base := 0;
>
> Word : Boolean := False;
>
> begin
>
> while not End_Of_File loop
>
> Get_Line (Line, Last);
>
> NC := NC + Last;
>
> for I in Line'First .. Last loop
> if Line (I) = Latin_1.Space or Line (I) = Latin_1.HT then
> Word := False;
>
> elsif not Word then
> Word := True;
> NW := NW + 1;
>
> end if;
> end loop;
>
> if Last < Line'Last then
> Word := False;
> NL := NL + 1;
> end if;
>
> end loop;
>
> Put ("NL="); Put (NL, Width => 0); New_Line;
> Put ("NW="); Put (NW, Width => 0); New_Line;
> Put ("NC="); Put (NC, Width => 0); New_Line;
>
> end WC;
If you change:
if Last < Line'Last then...
to:
if End_of_Line then
Word := False;
NL := NL + 1;
end if;
maybe that will end the 'discussion' about whether it is possible to
count lines properly in Ada. Oh, you might want to stick:
exit when End_of_File;
after the call to Get_Line. Of course the need to do that or not
depends on the number of lines and characters you want to count for the
implict End_of_Page at the end of the file. Notice that with these
changes your program should work fine even if you set Line to
String(1..10);
--
Robert I. Eachus
�In an ally, considerations of house, clan, planet, race are
insignificant beside two prime questions, which are: 1. Can he shoot? 2.
Will he aim at your enemy?� -- from the Laiden novels by Sharon Lee and
Steve Miller.
^ permalink raw reply [relevance 0%]
* Re: Terminating a task
@ 2003-07-14 23:45 5% ` Matthew Heaney
2003-07-15 22:37 0% ` Robert I. Eachus
0 siblings, 1 reply; 200+ results
From: Matthew Heaney @ 2003-07-14 23:45 UTC (permalink / raw)
Craig Carey <research@ijs.co.nz> wrote in message news:<ubs4hv4eaar8hbmr2vut59ananvsuvra9a@4ax.com>...
>
> PS. The new "Computer Language Shootout" website now has Ada.
>
> http://dada.perl.it/shootout/index.html
>
> My "wc" word count program got eliminated probably since the tester
> could not link in Win32 "_setmode" and "_read". (Ada 95 packages do not
> allow accurate reading from the standard input).
Your word count program got eliminated because it is junk.
I have no idea what you mean about not being able to accurately read
from standard input.
Here is a simplified version of the program, which closely follows the
gcc example:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Latin_1; use Ada.Characters;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure WC is
Line : String (1 .. 133);
Last : Natural;
NL, NW, NC : Integer'Base := 0;
Word : Boolean := False;
begin
while not End_Of_File loop
Get_Line (Line, Last);
NC := NC + Last;
for I in Line'First .. Last loop
if Line (I) = Latin_1.Space or Line (I) = Latin_1.HT then
Word := False;
elsif not Word then
Word := True;
NW := NW + 1;
end if;
end loop;
if Last < Line'Last then
Word := False;
NL := NL + 1;
end if;
end loop;
Put ("NL="); Put (NL, Width => 0); New_Line;
Put ("NW="); Put (NW, Width => 0); New_Line;
Put ("NC="); Put (NC, Width => 0); New_Line;
end WC;
-Matt
^ permalink raw reply [relevance 5%]
* Re: Ideas for Ada 200X
2003-06-18 15:00 4% ` Alexander Kopilovitch
@ 2003-06-19 0:31 0% ` Amir Yantimirov
0 siblings, 0 replies; 200+ results
From: Amir Yantimirov @ 2003-06-19 0:31 UTC (permalink / raw)
aek@vib.usr.pu.ru (Alexander Kopilovitch) wrote in message news:<e2e5731a.0306180700.61b2575f@posting.google.com>...
> Bill Findlay <yaldnifw@blueyonder.co.uk> wrote in message news:<BB13CDB9.3516%yaldnifw@blueyonder.co.uk>...
> >All the proposals so far have their problems:
> >
> > idem (or any new reserved word) but: a new reserved word
> > all but: could be a typo for "p.all"
> > <> but: consider "<> < <>+1"
> > & but: consider "& & &"
> > @ (or # or ? or $ or %) but: wrong associations?
>
> Here is yet another one: use "~" (Ada.Characters.Latin_1.Tilde). "waver",
> but not alone - either double it or use it in conjunction with left-side
> identifier (but do not mix these variants in the same statement; also do not
> mix them with oriiginal left-side identifier). For example:
>
> X := ~~ + A;
>
> X := ~X + A;
>
> X := ~X + ~~; -- illegal
>
> X := ~X + X; -- illegal
>
> X := ~~ + X; -- illegal
>
>
>
> Alexander Kopilovitch aek@vib.usr.pu.ru
> Saint-Petersburg
> Russia
While not omit := at all and use postfix operator in expression:
X# + A;
min ( X#, 0 );
X# + # * 2;
X#.Next;
Er, too C-ish. (Or C#-ish ?) Then so:
idem(X) + A;
min ( idem(X), 0);
idem( X ) + idem * 2;
idem( X ).Next;
?
http://www174.pair.com/yamir/programming/syntax.htm
Amir Yantimirov
^ permalink raw reply [relevance 0%]
* Re: help with Ada95
2003-06-18 3:47 5% help with Ada95 Cephus�
@ 2003-06-18 17:51 0% ` Jeffrey Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2003-06-18 17:51 UTC (permalink / raw)
Cephus� wrote:
> Hey guys I have this book: Ada 95 3rd edition (gold (maybe yellow in color)
> Problem Solving and Program Design by Feldman and Koffman.
>
> They provide all of their code from the book examples and I am trying to use
> a package of theirs dealing with the screen... here is the package spec and
> body. Please tell me what is wrong with it...
>
> Screen.ads:
> -- constants; the number of rows and columns on the terminal
"package Screen is" appears to be missing.
>
> ScreenDepth : CONSTANT Integer := 24;
>
> ScreenWidth : CONSTANT Integer := 80;
>
> -- subtypes giving the ranges of acceptable inputs
>
> -- to the cursor-positioning operation
>
> SUBTYPE Depth IS Integer RANGE 1..ScreenDepth;
>
> SUBTYPE Width IS Integer RANGE 1..ScreenWidth;
>
> PROCEDURE Beep;
>
> -- Pre: None
>
> -- Post: Terminal makes its beep sound once
>
> PROCEDURE ClearScreen;
>
> -- Pre: None
>
> -- Post: Terminal Screen is cleared
>
> PROCEDURE MoveCursor (Column : Width; Row : Depth);
>
> -- Pre: Column and Row have been assigned values
>
> -- Post: Cursor is moved to the given spot on the screen
>
> END Screen;
>
> ----------------------------------------------------------------------------
> -----------------
>
> Screen.adb
"package body Screen is" appears to be missing.
>
> PROCEDURE Beep IS
>
> BEGIN
>
> Ada.Text_IO.Put (Item => Ada.Characters.Latin_1.BEL);
>
> Ada.Text_IO.Flush;
>
> END Beep;
>
> PROCEDURE ClearScreen IS
>
> BEGIN
>
> -- Ada.Text_IO.Put (Item => Ada.Characters.Latin_1.ESC);
>
> -- Ada.Text_IO.Put (Item => "[2J");
>
> -- Ada.Text_IO.Flush;
>
> Ada.TEXT_IO.New_Line(Spacing => 35);
>
> MoveCursor(Row => 1, Column => 1);
>
> END ClearScreen;
>
> PROCEDURE MoveCursor (Column : Width; Row : Depth) IS
>
> BEGIN
>
> Ada.Text_IO.Flush;
>
> Ada.Text_IO.Put (Item => Ada.Characters.Latin_1.ESC);
>
> Ada.Text_IO.Put ("[");
>
> Ada.Integer_Text_IO.Put (Item => Row, Width => 1);
>
> Ada.Text_IO.Put (Item => ';');
>
> Ada.Integer_Text_IO.Put (Item => Column, Width => 1);
>
> Ada.Text_IO.Put (Item => 'f');
>
> END MoveCursor;
>
> END Screen;
Other than those problems marked, which might be cut and paste errors
rather than errors in the code, there does not appear to be anything
wrong with it.
It would help if you told us what error messages you were getting, or
what makes you think there is something wrong with it. It also helps if
you tell us what compiler and version you're using, and on what OS and
version.
--
Jeff Carter
"You tiny-brained wipers of other people's bottoms!"
Monty Python & the Holy Grail
^ permalink raw reply [relevance 0%]
* Re: Ideas for Ada 200X
@ 2003-06-18 15:00 4% ` Alexander Kopilovitch
2003-06-19 0:31 0% ` Amir Yantimirov
0 siblings, 1 reply; 200+ results
From: Alexander Kopilovitch @ 2003-06-18 15:00 UTC (permalink / raw)
Bill Findlay <yaldnifw@blueyonder.co.uk> wrote in message news:<BB13CDB9.3516%yaldnifw@blueyonder.co.uk>...
>All the proposals so far have their problems:
>
> idem (or any new reserved word) but: a new reserved word
> all but: could be a typo for "p.all"
> <> but: consider "<> < <>+1"
> & but: consider "& & &"
> @ (or # or ? or $ or %) but: wrong associations?
Here is yet another one: use "~" (Ada.Characters.Latin_1.Tilde). "waver",
but not alone - either double it or use it in conjunction with left-side
identifier (but do not mix these variants in the same statement; also do not
mix them with oriiginal left-side identifier). For example:
X := ~~ + A;
X := ~X + A;
X := ~X + ~~; -- illegal
X := ~X + X; -- illegal
X := ~~ + X; -- illegal
Alexander Kopilovitch aek@vib.usr.pu.ru
Saint-Petersburg
Russia
^ permalink raw reply [relevance 4%]
* help with Ada95
@ 2003-06-18 3:47 5% Cephus�
2003-06-18 17:51 0% ` Jeffrey Carter
0 siblings, 1 reply; 200+ results
From: Cephus� @ 2003-06-18 3:47 UTC (permalink / raw)
Hey guys I have this book: Ada 95 3rd edition (gold (maybe yellow in color)
Problem Solving and Program Design by Feldman and Koffman.
They provide all of their code from the book examples and I am trying to use
a package of theirs dealing with the screen... here is the package spec and
body. Please tell me what is wrong with it...
Screen.ads:
-- constants; the number of rows and columns on the terminal
ScreenDepth : CONSTANT Integer := 24;
ScreenWidth : CONSTANT Integer := 80;
-- subtypes giving the ranges of acceptable inputs
-- to the cursor-positioning operation
SUBTYPE Depth IS Integer RANGE 1..ScreenDepth;
SUBTYPE Width IS Integer RANGE 1..ScreenWidth;
PROCEDURE Beep;
-- Pre: None
-- Post: Terminal makes its beep sound once
PROCEDURE ClearScreen;
-- Pre: None
-- Post: Terminal Screen is cleared
PROCEDURE MoveCursor (Column : Width; Row : Depth);
-- Pre: Column and Row have been assigned values
-- Post: Cursor is moved to the given spot on the screen
END Screen;
----------------------------------------------------------------------------
-----------------
Screen.adb
PROCEDURE Beep IS
BEGIN
Ada.Text_IO.Put (Item => Ada.Characters.Latin_1.BEL);
Ada.Text_IO.Flush;
END Beep;
PROCEDURE ClearScreen IS
BEGIN
-- Ada.Text_IO.Put (Item => Ada.Characters.Latin_1.ESC);
-- Ada.Text_IO.Put (Item => "[2J");
-- Ada.Text_IO.Flush;
Ada.TEXT_IO.New_Line(Spacing => 35);
MoveCursor(Row => 1, Column => 1);
END ClearScreen;
PROCEDURE MoveCursor (Column : Width; Row : Depth) IS
BEGIN
Ada.Text_IO.Flush;
Ada.Text_IO.Put (Item => Ada.Characters.Latin_1.ESC);
Ada.Text_IO.Put ("[");
Ada.Integer_Text_IO.Put (Item => Row, Width => 1);
Ada.Text_IO.Put (Item => ';');
Ada.Integer_Text_IO.Put (Item => Column, Width => 1);
Ada.Text_IO.Put (Item => 'f');
END MoveCursor;
END Screen;
sorry for the text, I just copied it straight from the compiler
Beau
^ permalink raw reply [relevance 5%]
* Re: Exec shell command with GNAT
2003-01-14 8:58 0% ` Thomas Wolf
@ 2003-01-14 12:15 0% ` David C. Hoos, Sr.
0 siblings, 0 replies; 200+ results
From: David C. Hoos, Sr. @ 2003-01-14 12:15 UTC (permalink / raw)
----- Original Message -----
From: "Thomas Wolf" <t_wolf@angelfire.com>
Newsgroups: comp.lang.ada
To: <comp.lang.ada@ada.eu.org>
Sent: January 14, 2003 2:58 AM
Subject: Re: Exec shell command with GNAT
> david.c.hoos.sr@ada95.com wrote:
> > with Ada.Characters.Latin_1;
> > with System;
> > function Execute_Shell_Command
> > (The_Command : String) return Integer is
> >
> > function Execute
> > (The_Command_Address : System.Address) return Integer;
> > pragma Import (C, Execute, "system");
> > The_Nul_Terminated_Command_String : constant String :=
> > The_Command & Ada.Characters.Latin_1.Nul;
> > begin
> > return Execute (The_Nul_Terminated_Command_String'Address);
> > end Execute_Shell_Command;
>
> Yes, that's it. My own version looks similar:
>
> with Interfaces.C;
>
> function Execute (Command : in String) return Integer
> is
>
> function Run (Command : in Interfaces.C.char_array)
> return Interfaces.C.int;
> pragma Import (C, Run, "system");
>
> begin -- Execute
> return Integer (Run (Interfaces.C.To_C (Item => Command)));
> end Execute;
>
> No fiddling around with addresses needed, and the declaration of "Run"
> doesn't depend on Interfaces.C.int and Integer being the same. Note
> that the Ada standard guarantees that an in-parameter of an array of
> some element_type is passed in a way compatible with an "element_type *"
> in C. (I.e., the address of the first element is passed.)
I agree. I failed to mention that my function was originally written
before Ada95 existed. It's a case of "if it's not broken, don't 'fix'
it."
>
> --
> -----------------------------------------------------------------
> Thomas Wolf e-mail: t_wolf@angelfire.com
>
> _______________________________________________
> comp.lang.ada mailing list
> comp.lang.ada@ada.eu.org
> http://ada.eu.org/mailman/listinfo/comp.lang.ada
>
>
^ permalink raw reply [relevance 0%]
* Re: Exec shell command with GNAT
2003-01-13 17:59 5% ` David C. Hoos
@ 2003-01-14 8:58 0% ` Thomas Wolf
2003-01-14 12:15 0% ` David C. Hoos, Sr.
0 siblings, 1 reply; 200+ results
From: Thomas Wolf @ 2003-01-14 8:58 UTC (permalink / raw)
david.c.hoos.sr@ada95.com wrote:
> with Ada.Characters.Latin_1;
> with System;
> function Execute_Shell_Command
> (The_Command : String) return Integer is
>
> function Execute
> (The_Command_Address : System.Address) return Integer;
> pragma Import (C, Execute, "system");
> The_Nul_Terminated_Command_String : constant String :=
> The_Command & Ada.Characters.Latin_1.Nul;
> begin
> return Execute (The_Nul_Terminated_Command_String'Address);
> end Execute_Shell_Command;
Yes, that's it. My own version looks similar:
with Interfaces.C;
function Execute (Command : in String) return Integer
is
function Run (Command : in Interfaces.C.char_array)
return Interfaces.C.int;
pragma Import (C, Run, "system");
begin -- Execute
return Integer (Run (Interfaces.C.To_C (Item => Command)));
end Execute;
No fiddling around with addresses needed, and the declaration of "Run"
doesn't depend on Interfaces.C.int and Integer being the same. Note
that the Ada standard guarantees that an in-parameter of an array of
some element_type is passed in a way compatible with an "element_type *"
in C. (I.e., the address of the first element is passed.)
--
-----------------------------------------------------------------
Thomas Wolf e-mail: t_wolf@angelfire.com
^ permalink raw reply [relevance 0%]
* Re: Exec shell command with GNAT
@ 2003-01-13 17:59 5% ` David C. Hoos
2003-01-14 8:58 0% ` Thomas Wolf
0 siblings, 1 reply; 200+ results
From: David C. Hoos @ 2003-01-13 17:59 UTC (permalink / raw)
Here's such a function I've been using for some years:
It should be portable across compilers and OSs, as long
as the C-runtime library has the "system" function.
------------------------------------------------------------------------
-- $Source: /usr/local/cvsroot/execute_shell_command.adb,v $
-- $Revision: 1.1 $
-- $Date: 1999/08/11 12:58:58 $
-- $Author: hoosd $
-- $State: Exp $
-- Revision History:
-- $Log: execute_shell_command.adb,v $
-- Revision 1.1 1999/08/11 12:58:58 hoosd
-- Initial checkin
--
--
-- Execute_Shell_Command
-- Purpose:
-- This library-level function is an Ada interface to the "system"
-- command of the C run-time library.
------------------------------------------------------------------------
with Ada.Characters.Latin_1;
with System;
function Execute_Shell_Command
(The_Command : String) return Integer is
function Execute
(The_Command_Address : System.Address) return Integer;
pragma Import (C, Execute, "system");
The_Nul_Terminated_Command_String : constant String :=
The_Command & Ada.Characters.Latin_1.Nul;
begin
return Execute (The_Nul_Terminated_Command_String'Address);
end Execute_Shell_Command;
----- Original Message -----
From: "JuK" <calvinix@caramail.com>
Newsgroups: comp.lang.ada
To: <comp.lang.ada@ada.eu.org>
Sent: Monday, January 13, 2003 10:58 AM
Subject: Exec shell command with GNAT
> Hello
> I want to execute a shell command in my ADA application :
>
> function EXEC_SHELL_COMMAND (COMMAND : in STRING) return EXIT_STATUS ;
>
>
> How Can I do that ?
>
> ( SOLARIS with GNAT 3.14 )
>
> Thank you
> _______________________________________________
> comp.lang.ada mailing list
> comp.lang.ada@ada.eu.org
> http://ada.eu.org/mailman/listinfo/comp.lang.ada
>
^ permalink raw reply [relevance 5%]
* RE: Character Sets (plain text police report)
@ 2002-11-29 20:37 6% ` Robert C. Leif
0 siblings, 0 replies; 200+ results
From: Robert C. Leif @ 2002-11-29 20:37 UTC (permalink / raw)
Oops. My apologies.
Bob Leif
The correct text version is below.
Addendum: The solution is the creation of versions of Ada.Strings.Bounded for 16 and 32 bit characters. The 32 bit Unicode characters allow direct comparison of characters based on their position in Unicode.
-----Original Message-----
From: comp.lang.ada-admin@ada.eu.org [mailto:comp.lang.ada-admin@ada.eu.org] On Behalf Of Warren W. Gay VE3WWG
Sent: Thursday, November 28, 2002 10:09 AM
To: comp.lang.ada@ada.eu.org
Subject: Re: Character Sets (plain text police report)
Hmmm... I guess since Robert Dewar is avoiding this group these
days, we also lost our "plain text" police force ;-)
In case you were not aware of it, you are posting HTML to this
news group. This is generally discouraged so that others who
are not using HTML capable news readers, are still able to make
sense of your posting.
--------------------------------------------------------
Christoph Grein responded to my inquiry by stating that,
" Latin_9.Euro_Sign is a name for a character. The same character in Latin_1 has a different name, it is the Currency_Sign." "So why do you expect this character not to be in the set only because you use a different name for it?" The Euro_Sign and the Currency_Sign have a different representation according to The ISO 8859 Alphabet Soup http://czyborra.com/charsets/iso8859.html
------------------------------------------------
GNAT Latin_9 (ISO-8859-15)includes the following:
-- Summary of Changes from Latin-1 => Latin-9 --
------------------------------------------------
-- 164 Currency => Euro_Sign
-- 166 Broken_Bar => UC_S_Caron
-- 168 Diaeresis => LC_S_Caron
-- 180 Acute => UC_Z_Caron
-- 184 Cedilla => LC_Z_Caron
-- 188 Fraction_One_Quarter => UC_Ligature_OE
-- 189 Fraction_One_Half => LC_Ligature_OE
-- 190 Fraction_Three_Quarters => UC_Y_Diaeresis
Since these are changes, they should not be the same character. Below are the results of an extension of my original program that now tests the characters of Latin_9 from character number 164 through 190 and prints them out. I understand that choice of the Windows font will change their representation. The correct glyphs can be found at The ISO 8859 Alphabet Soup. For anyone interested, I have put my program at the end of this note. I suspect that the best solution would be to introduce UniCode, ISO/IEC 10646, into the Ada standard. The arguments for this are contained in W3C Character Model for the World Wide Web 1.0, W3C Working Draft 30 April 2002 http://www.w3.org/TR/charmod/ "The choice of Unicode was motivated by the fact that Unicode: is the only universal character repertoire available, covers the widest possible range, provides a way of referencing characters independent of the encoding of a resource, is being updated/completed carefully, is widely accepted and implemented by industry." "W3C adopted Unicode as the document character set for HTML in [HTML 4.0]. The same approach was later used for specifications such as XML 1.0 [XML 1.0] and CSS2 [CSS2]. Unicode now serves as a common reference for W3C specifications and applications." "The IETF has adopted some policies on the use of character sets on the Internet (see [RFC 2277])." Bob Leif ------------------------Starting Test----------------------- Latin_9_Diff is ñѪº¿⌐¬½¼¡«»░▒▓│┤╡╢╖╕╣║╗╝╜╛
The Character ñ is in Latin_1 is TRUE. Its position is 164
The Character Ñ is in Latin_1 is TRUE. Its position is 165
The Character ª is in Latin_1 is TRUE. Its position is 166
The Character º is in Latin_1 is TRUE. Its position is 167
The Character ¿ is in Latin_1 is TRUE. Its position is 168
The Character ⌐ is in Latin_1 is TRUE. Its position is 169
The Character ¬ is in Latin_1 is TRUE. Its position is 170
The Character ½ is in Latin_1 is TRUE. Its position is 171
The Character ¼ is in Latin_1 is TRUE. Its position is 172
The Character ¡ is in Latin_1 is TRUE. Its position is 173
The Character « is in Latin_1 is TRUE. Its position is 174
The Character » is in Latin_1 is TRUE. Its position is 175
The Character ░ is in Latin_1 is TRUE. Its position is 176
The Character ▒ is in Latin_1 is TRUE. Its position is 177
The Character ▓ is in Latin_1 is TRUE. Its position is 178
The Character │ is in Latin_1 is TRUE. Its position is 179
The Character ┤ is in Latin_1 is TRUE. Its position is 180
The Character ╡ is in Latin_1 is TRUE. Its position is 181
The Character ╢ is in Latin_1 is TRUE. Its position is 182
The Character ╖ is in Latin_1 is TRUE. Its position is 183
The Character ╕ is in Latin_1 is TRUE. Its position is 184
The Character ╣ is in Latin_1 is TRUE. Its position is 185
The Character ║ is in Latin_1 is TRUE. Its position is 186
The Character ╗ is in Latin_1 is TRUE. Its position is 187
The Character ╝ is in Latin_1 is TRUE. Its position is 188
The Character ╜ is in Latin_1 is TRUE. Its position is 189
The Character ╛ is in Latin_1 is TRUE. Its position is 190 ------------------------Ending Test----------------------- --Robert C. Leif, Ph.D & Ada_Med Copyright all rights reserved. --Main Procedure
--Created 27 November 2002
with Ada.Text_Io;
with Ada.Io_Exceptions;
with Ada.Exceptions;
with Ada.Strings;
with Ada.Strings.Maps;
with Ada.Characters.Latin_1;
with Ada.Characters.Latin_9;
procedure Char_Sets_Test is
------------------Table of Contents-------------
package T_Io renames Ada.Text_Io;
package Str_Maps renames Ada.Strings.Maps;
package Latin_1 renames Ada.Characters.Latin_1;
package Latin_9 renames Ada.Characters.Latin_9;
subtype Character_Set_Type is Str_Maps.Character_Set;
subtype Character_Sequence_Type is Str_Maps.Character_Sequence;
-----------------End Table of Contents-------------
Latin_1_Range : constant Str_Maps.Character_Range
:= (Low => Latin_1.Nul, High => Latin_1.Lc_Y_Diaeresis);
Latin_1_Char_Set : Character_Set_Type
:= Str_Maps.To_Set (Span => Latin_1_Range);
--Standard for Ada '95
-- Latin_9 Differences: Euro_Sign, Uc_S_Caron, Lc_S_Caron, Uc_Z_Caron,
-- Lc_Z_Caron, Uc_Ligature_Oe, Lc_Ligature_Oe, Uc_Y_Diaeresis.
Latin_9_Diff_Latin_1_Super_Range : constant Str_Maps.Character_Range
:= (Low => Latin_9.Euro_Sign, High => Latin_9.Uc_Y_Diaeresis);
Latin_9_Diff_Latin_1_Super_Set : Character_Set_Type
:= Str_Maps.To_Set (Span => Latin_9_Diff_Latin_1_Super_Range);
Latin_9_Diff_Latin_1_Super_String : Character_Sequence_Type
:= Str_Maps.To_Sequence (Latin_9_Diff_Latin_1_Super_Set);
Character_Set_Name : String
:= "Latin_1";
---------------------------------------------
procedure Test_Character_Sets (
Character_Sequence_Var : in Character_Sequence_Type;
Set : in Character_Set_Type ) is
Is_In_Character_Set : Boolean := False;
Char : Character := 'X';
Character_Set_Position : Positive := 164; -- Euro_Sign
begin--Test_Character_Sets
T_Io.Put_Line("Latin_9_Diff is " & Latin_9_Diff_Latin_1_Super_String);
T_Io.Put_Line("");
Test_Chars:
for I in Character_Sequence_Var'range loop
Char:= Character_Sequence_Var(I);
Is_In_Character_Set:= Str_Maps.Is_In(
Element => Char,
Set => Latin_1_Char_Set);
T_Io.Put_Line("The Character " & Char & " is in " & Character_Set_Name
& " is " & Boolean'Image (
Is_In_Character_Set) & ". Its position is "
& Positive'Image(Character_Set_Position));
Character_Set_Position:= Character_Set_Position + 1;
end loop Test_Chars;
end Test_Character_Sets;
---------------------------------------------
begin--Bd_W_Char_Sets_Test
T_Io.Put_Line("----------------------Starting Test---------------------);
Test_Character_Sets (
Character_Sequence_Var => Latin_9_Diff_Latin_1_Super_String,
Set => Latin_1_Char_Set);
---------------------------------------------
T_Io.Put_Line("------------------------Ending Test---------------------);
exception
when A: Ada.Io_Exceptions.Status_Error =>
T_Io.Put_Line("Status_Error in Char_Sets_Test.");
T_Io.Put_Line(Ada.Exceptions.Exception_Information(A));
when O: others =>
T_Io.Put_Line("Others_Error in Char_Sets_Test.");
T_Io.Put_Line(Ada.Exceptions.Exception_Information(O));
end Char_Sets_Test;
^ permalink raw reply [relevance 6%]
* Re: Character Sets
@ 2002-11-28 17:53 6% Robert C. Leif
0 siblings, 0 replies; 200+ results
From: Robert C. Leif @ 2002-11-28 17:53 UTC (permalink / raw)
Christoph Grein responded to my inquiry by stating that,
" Latin_9.Euro_Sign is a name for a character. The same character in Latin_1 has a different name, it is the Currency_Sign."
"So why do you expect this character not to be in the set only because you use a different name for it?"
The Euro_Sign and the Currency_Sign have a different representation according to The ISO 8859 Alphabet Soup http://czyborra.com/charsets/iso8859.html
------------------------------------------------
GNAT Latin_9 (ISO-8859-15)includes the following:
-- Summary of Changes from Latin-1 => Latin-9 --
------------------------------------------------
-- 164 Currency => Euro_Sign
-- 166 Broken_Bar => UC_S_Caron
-- 168 Diaeresis => LC_S_Caron
-- 180 Acute => UC_Z_Caron
-- 184 Cedilla => LC_Z_Caron
-- 188 Fraction_One_Quarter => UC_Ligature_OE
-- 189 Fraction_One_Half => LC_Ligature_OE
-- 190 Fraction_Three_Quarters => UC_Y_Diaeresis
Since these are changes, they should not be the same character.
Below are the results of an extension of my original program that now tests the characters of Latin_9 from character number 164 through 190 and prints them out. I understand that choice of the Windows font will change their representation. The correct glyphs can be found at The ISO 8859 Alphabet Soup. For anyone interested, I have put my program at the end of this note.
I suspect that the best solution would be to introduce UniCode, ISO/IEC 10646, into the Ada standard. The arguments for this are contained in W3C Character Model for the World Wide Web 1.0, W3C Working Draft 30 April 2002
http://www.w3.org/TR/charmod/
"The choice of Unicode was motivated by the fact that Unicode: is the only universal character repertoire available, covers the widest possible range, provides a way of referencing characters independent of the encoding of a resource, is being updated/completed carefully, is widely accepted and implemented by industry."
"W3C adopted Unicode as the document character set for HTML in [HTML 4.0]. The same approach was later used for specifications such as XML 1.0 [XML 1.0] and CSS2 [CSS2]. Unicode now serves as a common reference for W3C specifications and applications."
"The IETF has adopted some policies on the use of character sets on the Internet (see [RFC 2277])."
Bob Leif
------------------------Starting Test-----------------------
Latin_9_Diff is ñѪº¿⌐¬½¼¡«»░▒▓│┤╡╢╖╕╣║╗╝╜╛
The Character ñ is in Latin_1 is TRUE. Its position is 164
The Character Ñ is in Latin_1 is TRUE. Its position is 165
The Character ª is in Latin_1 is TRUE. Its position is 166
The Character º is in Latin_1 is TRUE. Its position is 167
The Character ¿ is in Latin_1 is TRUE. Its position is 168
The Character ⌐ is in Latin_1 is TRUE. Its position is 169
The Character ¬ is in Latin_1 is TRUE. Its position is 170
The Character ½ is in Latin_1 is TRUE. Its position is 171
The Character ¼ is in Latin_1 is TRUE. Its position is 172
The Character ¡ is in Latin_1 is TRUE. Its position is 173
The Character « is in Latin_1 is TRUE. Its position is 174
The Character » is in Latin_1 is TRUE. Its position is 175
The Character ░ is in Latin_1 is TRUE. Its position is 176
The Character ▒ is in Latin_1 is TRUE. Its position is 177
The Character ▓ is in Latin_1 is TRUE. Its position is 178
The Character │ is in Latin_1 is TRUE. Its position is 179
The Character ┤ is in Latin_1 is TRUE. Its position is 180
The Character ╡ is in Latin_1 is TRUE. Its position is 181
The Character ╢ is in Latin_1 is TRUE. Its position is 182
The Character ╖ is in Latin_1 is TRUE. Its position is 183
The Character ╕ is in Latin_1 is TRUE. Its position is 184
The Character ╣ is in Latin_1 is TRUE. Its position is 185
The Character ║ is in Latin_1 is TRUE. Its position is 186
The Character ╗ is in Latin_1 is TRUE. Its position is 187
The Character ╝ is in Latin_1 is TRUE. Its position is 188
The Character ╜ is in Latin_1 is TRUE. Its position is 189
The Character ╛ is in Latin_1 is TRUE. Its position is 190
------------------------Ending Test-----------------------
--Robert C. Leif, Ph.D & Ada_Med Copyright all rights reserved.
--Main Procedure
--Created 27 November 2002
with Ada.Text_Io;
with Ada.Io_Exceptions;
with Ada.Exceptions;
with Ada.Strings;
with Ada.Strings.Maps;
with Ada.Characters.Latin_1;
with Ada.Characters.Latin_9;
procedure Char_Sets_Test is
------------------Table of Contents-------------
package T_Io renames Ada.Text_Io;
package Str_Maps renames Ada.Strings.Maps;
package Latin_1 renames Ada.Characters.Latin_1;
package Latin_9 renames Ada.Characters.Latin_9;
subtype Character_Set_Type is Str_Maps.Character_Set;
subtype Character_Sequence_Type is Str_Maps.Character_Sequence;
-----------------End Table of Contents-------------
Latin_1_Range : constant Str_Maps.Character_Range
:= (Low => Latin_1.Nul, High => Latin_1.Lc_Y_Diaeresis);
Latin_1_Char_Set : Character_Set_Type
:= Str_Maps.To_Set (Span => Latin_1_Range);
--Standard for Ada '95
-- Latin_9 Differences: Euro_Sign, Uc_S_Caron, Lc_S_Caron, Uc_Z_Caron,
-- Lc_Z_Caron, Uc_Ligature_Oe, Lc_Ligature_Oe, Uc_Y_Diaeresis.
Latin_9_Diff_Latin_1_Super_Range : constant Str_Maps.Character_Range
:= (Low => Latin_9.Euro_Sign, High => Latin_9.Uc_Y_Diaeresis);
Latin_9_Diff_Latin_1_Super_Set : Character_Set_Type
:= Str_Maps.To_Set (Span => Latin_9_Diff_Latin_1_Super_Range);
Latin_9_Diff_Latin_1_Super_String : Character_Sequence_Type
:= Str_Maps.To_Sequence (Latin_9_Diff_Latin_1_Super_Set);
Character_Set_Name : String
:= "Latin_1";
---------------------------------------------
procedure Test_Character_Sets (
Character_Sequence_Var : in Character_Sequence_Type;
Set : in Character_Set_Type ) is
Is_In_Character_Set : Boolean := False;
Char : Character := 'X';
Character_Set_Position : Positive := 164; -- Euro_Sign
begin--Test_Character_Sets
T_Io.Put_Line("Latin_9_Diff is " & Latin_9_Diff_Latin_1_Super_String);
T_Io.Put_Line("");
Test_Chars:
for I in Character_Sequence_Var'range loop
Char:= Character_Sequence_Var(I);
Is_In_Character_Set:= Str_Maps.Is_In(
Element => Char,
Set => Latin_1_Char_Set);
T_Io.Put_Line("The Character " & Char & " is in " & Character_Set_Name
& " is " & Boolean'Image (
Is_In_Character_Set) & ". Its position is "
& Positive'Image(Character_Set_Position));
Character_Set_Position:= Character_Set_Position + 1;
end loop Test_Chars;
end Test_Character_Sets;
---------------------------------------------
begin--Bd_W_Char_Sets_Test
T_Io.Put_Line("----------------------Starting Test---------------------);
Test_Character_Sets (
Character_Sequence_Var => Latin_9_Diff_Latin_1_Super_String,
Set => Latin_1_Char_Set);
---------------------------------------------
T_Io.Put_Line("------------------------Ending Test---------------------);
exception
when A: Ada.Io_Exceptions.Status_Error =>
T_Io.Put_Line("Status_Error in Char_Sets_Test.");
T_Io.Put_Line(Ada.Exceptions.Exception_Information(A));
when O: others =>
T_Io.Put_Line("Others_Error in Char_Sets_Test.");
T_Io.Put_Line(Ada.Exceptions.Exception_Information(O));
end Char_Sets_Test;
^ permalink raw reply [relevance 6%]
* Re: Character Sets
@ 2002-11-27 9:00 0% Grein, Christoph
0 siblings, 0 replies; 200+ results
From: Grein, Christoph @ 2002-11-27 9:00 UTC (permalink / raw)
> From: Bob Leif
> I am trying to test if a character is not in the Latin_1 character set.
> I choose the Euro because it is in Latin_9 and not in Latin_1. I tested
> the function Ada.Strings.Maps.Is_In. It returns that the Euro_Sign is in
> the Latin_1 character set. What have I done wrong?
> My test program, which compiled and executed under GNAT 3.15p under
> Windows XP, produced:
> ------------------------Starting Test-----------------------
> Is_In_Character_Set is TRUE
> ------------------------Ending Test-----------------------
> The test program is as follows:
> ---------------------------------------------------------
> with Ada.Text_Io;
> with Ada.Io_Exceptions;
> with Ada.Exceptions;
> with Ada.Strings;
> with Ada.Strings.Maps;
> with Ada.Characters.Latin_1;
> with Ada.Characters.Latin_9;
> procedure Char_Sets_Test is
> ------------------Table of Contents-------------
> package T_Io renames Ada.Text_Io;
> package Str_Maps renames Ada.Strings.Maps;
> package Latin_1 renames Ada.Characters.Latin_1;
> package Latin_9 renames Ada.Characters.Latin_9;
> subtype Character_Set_Type is Str_Maps.Character_Set;
> -----------------End Table of Contents-------------
> Latin_1_Range : constant Str_Maps.Character_Range
> := (Low => Latin_1.Nul, High => Latin_1.Lc_Y_Diaeresis);
This is the full range of type Character, isn't it.
> Latin_1_Char_Set : Character_Set_Type :=
> Str_Maps.To_Set (Span => Latin_1_Range);
So this is the set of all characters.
> --Standard for Ada '95
> Is_In_Character_Set : Boolean := False;
> ---------------------------------------------
> begin--Bd_W_Char_Sets_Test
> T_Io.Put_Line("-----------------------Starting
> Test--------------------);
> ---------------------------------------------
> --Test Character_Sets
> Is_In_Character_Set:=Ada.Strings.Maps.Is_In (
> Element => Latin_9.Euro_Sign,
> Set => Latin_1_Char_Set);
Latin_9.Euro_Sign is a name for a character. The same character in Latin1 has a
different name, it is the Currency_Sign.
So why do you expect this character not to be in the set only because you use a
different name for it?
> T_Io.Put_Line("Is_In_Character_Set is " & Boolean'Image
> (Is_In_Character_Set));
> ---------------------------------------------
> ---------------------------------------------
> T_Io.Put_Line("-----------------------Ending
> Test----------------------);
>
> exception
> when A: Ada.Io_Exceptions.Status_Error =>
> T_io.Put_Line("Status_Error in Char_Sets_Test.");
> T_Io.Put_Line(Ada.Exceptions.Exception_Information(A));
> when O: others =>
> T_Io.Put_Line("Others_Error in Char_Sets_Test.");
> T_Io.Put_Line(Ada.Exceptions.Exception_Information(O));
> end Char_Sets_Test;
>
> _______________________________________________
> comp.lang.ada mailing list
> comp.lang.ada@ada.eu.org
> http://ada.eu.org/mailman/listinfo/comp.lang.ada
^ permalink raw reply [relevance 0%]
* Character Sets
@ 2002-11-26 21:41 6% Robert C. Leif
0 siblings, 0 replies; 200+ results
From: Robert C. Leif @ 2002-11-26 21:41 UTC (permalink / raw)
From: Bob Leif
I am trying to test if a character is not in the Latin_1 character set.
I choose the Euro because it is in Latin_9 and not in Latin_1. I tested
the function Ada.Strings.Maps.Is_In. It returns that the Euro_Sign is in
the Latin_1 character set. What have I done wrong?
My test program, which compiled and executed under GNAT 3.15p under
Windows XP, produced:
------------------------Starting Test-----------------------
Is_In_Character_Set is TRUE
------------------------Ending Test-----------------------
The test program is as follows:
---------------------------------------------------------
with Ada.Text_Io;
with Ada.Io_Exceptions;
with Ada.Exceptions;
with Ada.Strings;
with Ada.Strings.Maps;
with Ada.Characters.Latin_1;
with Ada.Characters.Latin_9;
procedure Char_Sets_Test is
------------------Table of Contents-------------
package T_Io renames Ada.Text_Io;
package Str_Maps renames Ada.Strings.Maps;
package Latin_1 renames Ada.Characters.Latin_1;
package Latin_9 renames Ada.Characters.Latin_9;
subtype Character_Set_Type is Str_Maps.Character_Set;
-----------------End Table of Contents-------------
Latin_1_Range : constant Str_Maps.Character_Range
:= (Low => Latin_1.Nul, High => Latin_1.Lc_Y_Diaeresis);
Latin_1_Char_Set : Character_Set_Type :=
Str_Maps.To_Set (Span => Latin_1_Range);
--Standard for Ada '95
Is_In_Character_Set : Boolean := False;
---------------------------------------------
begin--Bd_W_Char_Sets_Test
T_Io.Put_Line("-----------------------Starting
Test--------------------);
---------------------------------------------
--Test Character_Sets
Is_In_Character_Set:=Ada.Strings.Maps.Is_In (
Element => Latin_9.Euro_Sign,
Set => Latin_1_Char_Set);
T_Io.Put_Line("Is_In_Character_Set is " & Boolean'Image
(Is_In_Character_Set));
---------------------------------------------
---------------------------------------------
T_Io.Put_Line("-----------------------Ending
Test----------------------);
exception
when A: Ada.Io_Exceptions.Status_Error =>
T_io.Put_Line("Status_Error in Char_Sets_Test.");
T_Io.Put_Line(Ada.Exceptions.Exception_Information(A));
when O: others =>
T_Io.Put_Line("Others_Error in Char_Sets_Test.");
T_Io.Put_Line(Ada.Exceptions.Exception_Information(O));
end Char_Sets_Test;
^ permalink raw reply [relevance 6%]
* Re: how to parse words from a string
2002-11-14 13:40 4% ` Sarah Thomas
@ 2002-11-14 14:56 5% ` David C. Hoos
0 siblings, 0 replies; 200+ results
From: David C. Hoos @ 2002-11-14 14:56 UTC (permalink / raw)
----- Original Message -----
From: "Sarah Thomas" <mabes180@aol.com>
Newsgroups: comp.lang.ada
To: <comp.lang.ada@ada.eu.org>
Sent: Thursday, November 14, 2002 7:40 AM
Subject: Re: how to parse words from a string
> Interesting follow ups! thanks for the input and help !
> I have succesfully extracted words from a string.
> I read each line in from the file
> and used find_token, followed by slice, followed by deleting the word
> from the string..and then stored them in a fixed array for now..
> this is just an outline of how i did it.....
>
> loop
> Find_Token(Temp, Ada.Strings.Maps.To_Set(Ada.Characters.Latin_1.HT),
> Ada.Strings.Outside, From, To);
> exit when To = 0;
>
> My_word := To_Unbounded_String(Slice(Temp, From, To));
> Put_line(Output_File,To_String(My_word));
>
> IF (Length(temp) /= To ) then
> Delete(Temp, 1, To + 1);
> else
> Delete(Temp, 1, To);
> end if;
>
> Store_data(Line_Number,Word_Number) := (My_Word);
>
> end loop;
You could have saved the work of repeatedly deleting from the
Temp string by initially setting To := Length (Temp) - 1;.
Then if you make your call to Find_Token like this:
Find_Token(Slice (Temp, To + 1, Length (Temp)),
Ada.Strings.Maps.To_Set(Ada.Characters.Latin_1.HT),
Ada.Strings.Outside, From, To);
you just specify the unprocessed slice of Temp each time you look for a new
token.
I'm sure you realize you could have declared a String of word delimiters to
include
spaces, punctuation marks and other white space characters in the set of
possible
word delimiters, and used that String to initialize a Word_Delimiter_Set --
e.g.:
Word_Delimiter_Set : constant Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps.To_Set
(" ,.;:/!&()" & Ada.Characters.Latin_1.HT & Ada.Characters.Latin_1.FF);
^ permalink raw reply [relevance 5%]
* Re: how to parse words from a string
@ 2002-11-14 13:40 4% ` Sarah Thomas
2002-11-14 14:56 5% ` David C. Hoos
0 siblings, 1 reply; 200+ results
From: Sarah Thomas @ 2002-11-14 13:40 UTC (permalink / raw)
Interesting follow ups! thanks for the input and help !
I have succesfully extracted words from a string.
I read each line in from the file
and used find_token, followed by slice, followed by deleting the word
from the string..and then stored them in a fixed array for now..
this is just an outline of how i did it.....
loop
Find_Token(Temp, Ada.Strings.Maps.To_Set(Ada.Characters.Latin_1.HT),
Ada.Strings.Outside, From, To);
exit when To = 0;
My_word := To_Unbounded_String(Slice(Temp, From, To));
Put_line(Output_File,To_String(My_word));
IF (Length(temp) /= To ) then
Delete(Temp, 1, To + 1);
else
Delete(Temp, 1, To);
end if;
Store_data(Line_Number,Word_Number) := (My_Word);
end loop;
^ permalink raw reply [relevance 4%]
* Re: Thought this was interesting
2002-08-28 7:58 0% ` Thought this was interesting Ole-Hjalmar Kristensen
@ 2002-08-28 9:41 0% ` AG
0 siblings, 0 replies; 200+ results
From: AG @ 2002-08-28 9:41 UTC (permalink / raw)
"Ole-Hjalmar Kristensen" <oleh@vlinux.voxelvision.no> wrote in message
news:7vu1lfbejt.fsf@vlinux.voxelvision.no...
> Hyman Rosen <hyrosen@mail.com> writes:
>
> <snip>
>
> > Apropos of this, if you have access to a Windows system,
> > try running the following simple program there. Make sure
> > to save all important work first! It just prints out a
> > string over and over again. It couldn't do anything bad,
> > could it? Especially not on WinNT or WIn2K, right?
> > Especially if you have no special privileges, right? :-)
> >
> > with text_io; use text_io;
> > with ada.characters.latin_1; use ada.characters.latin_1;
> > procedure crash is
> > begin
> > loop
> > put("Hung up!" & HT & BS & BS & BS & BS & BS & BS);
> > end loop;
> > end;
>
> Bizarre behaviour indeed. What puzzles me is that I attempted briefly
> to write an equivalent C program, and it did not give the same
> results. Any idea of what's so special about text_io?
>
My guess would be [guess - mind you] that it relies on some API
function which is supposed to handle it but does not. Well, of course,
it was not written in our favorite language :-)
^ permalink raw reply [relevance 0%]
* Re: Thought this was interesting
2002-08-27 16:13 5% ` Hyman Rosen
2002-08-27 20:07 0% ` Thought this was interesting (OT) Chad R. Meiners
@ 2002-08-28 7:58 0% ` Ole-Hjalmar Kristensen
2002-08-28 9:41 0% ` AG
1 sibling, 1 reply; 200+ results
From: Ole-Hjalmar Kristensen @ 2002-08-28 7:58 UTC (permalink / raw)
Hyman Rosen <hyrosen@mail.com> writes:
<snip>
> Apropos of this, if you have access to a Windows system,
> try running the following simple program there. Make sure
> to save all important work first! It just prints out a
> string over and over again. It couldn't do anything bad,
> could it? Especially not on WinNT or WIn2K, right?
> Especially if you have no special privileges, right? :-)
>
> with text_io; use text_io;
> with ada.characters.latin_1; use ada.characters.latin_1;
> procedure crash is
> begin
> loop
> put("Hung up!" & HT & BS & BS & BS & BS & BS & BS);
> end loop;
> end;
Bizarre behaviour indeed. What puzzles me is that I attempted briefly
to write an equivalent C program, and it did not give the same
results. Any idea of what's so special about text_io?
^ permalink raw reply [relevance 0%]
* Re: Thought this was interesting (OT)
2002-08-27 16:13 5% ` Hyman Rosen
@ 2002-08-27 20:07 0% ` Chad R. Meiners
2002-08-28 7:58 0% ` Thought this was interesting Ole-Hjalmar Kristensen
1 sibling, 0 replies; 200+ results
From: Chad R. Meiners @ 2002-08-27 20:07 UTC (permalink / raw)
"Hyman Rosen" <hyrosen@mail.com> wrote in message
news:1030464758.505647@master.nyc.kbcfp.com...
> Apropos of this, if you have access to a Windows system,
> try running the following simple program there. Make sure
> to save all important work first! It just prints out a
> string over and over again. It couldn't do anything bad,
> could it? Especially not on WinNT or WIn2K, right?
> Especially if you have no special privileges, right? :-)
>
> with text_io; use text_io;
> with ada.characters.latin_1; use ada.characters.latin_1;
> procedure crash is
> begin
> loop
> put("Hung up!" & HT & BS & BS & BS & BS & BS & BS);
> end loop;
> end;
>
hmm... All I get is some garbage followed by a
raised ADA.IO_EXCEPTIONS.DEVICE_ERROR : s-fileio.adb:987
which although is a rather strange error, it doesn't crash my Win2K system.
:)
-CRM
^ permalink raw reply [relevance 0%]
* Re: Thought this was interesting
@ 2002-08-27 16:13 5% ` Hyman Rosen
2002-08-27 20:07 0% ` Thought this was interesting (OT) Chad R. Meiners
2002-08-28 7:58 0% ` Thought this was interesting Ole-Hjalmar Kristensen
0 siblings, 2 replies; 200+ results
From: Hyman Rosen @ 2002-08-27 16:13 UTC (permalink / raw)
Marin D. Condic wrote:
> Most software is driven by time to market and low-cost provider issues.
> It operates against the "Good/Fast/Cheap - pick two!" problem and "Good"
> is the loser.
There is also the problem of having to develop against
unstable underpinnings. Many programs run in cooperation
with system software which is itself underspecified,
unstable, and buggy. In such a world, even when you do
the best you can, it may still not be enough to produce
"good" software.
Apropos of this, if you have access to a Windows system,
try running the following simple program there. Make sure
to save all important work first! It just prints out a
string over and over again. It couldn't do anything bad,
could it? Especially not on WinNT or WIn2K, right?
Especially if you have no special privileges, right? :-)
with text_io; use text_io;
with ada.characters.latin_1; use ada.characters.latin_1;
procedure crash is
begin
loop
put("Hung up!" & HT & BS & BS & BS & BS & BS & BS);
end loop;
end;
^ permalink raw reply [relevance 5%]
* Re: time-slicing
@ 2002-07-15 19:10 5% ` Jan Prazak
0 siblings, 0 replies; 200+ results
From: Jan Prazak @ 2002-07-15 19:10 UTC (permalink / raw)
I have modified the code a bit, and this two tasks run surprisingly at
the same time. While the main task waits for a key+enter, the second task
is running! Tasks seem to be more complicated than I thought.
-------
with Ada.Text_IO, Ada.Characters.Latin_1;
use Ada.Text_IO, Ada.Characters.Latin_1;
procedure Task_Demo is
task Beep is
entry Shut_Down;
end Beep;
task body Beep is
Break_Loop : Boolean := False;
begin
loop
select
accept Shut_Down
do
Break_Loop := True;
end Shut_Down;
or
Delay 2.0;
Put(BEL);
end select;
exit when Break_Loop;
end loop;
end Beep;
C : Character;
begin
New_Line;
Put("Enter a character: ");
Get(C); Skip_Line;
New_Line;
Beep.Shut_Down;
end Task_Demo;[
^ permalink raw reply [relevance 5%]
* Re: String slicing.
2002-03-17 22:23 4% String slicing Wannabe h4x0r
2002-03-17 22:43 0% ` Jim Rogers
2002-03-18 12:44 4% ` sk
@ 2002-03-18 17:49 4% ` Georg Bauhaus
2 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2002-03-18 17:49 UTC (permalink / raw)
Wannabe h4x0r <chris@dont.spam.me> wrote:
: I've written a type definition as follows...
:
: type wrd_string is new String(1..Ada.Characters.Latin_1.Space);
try 'Pos and/or browse Ada.strings.* functionality.
- georg
^ permalink raw reply [relevance 4%]
* Re: String slicing.
2002-03-17 22:23 4% String slicing Wannabe h4x0r
2002-03-17 22:43 0% ` Jim Rogers
@ 2002-03-18 12:44 4% ` sk
2002-03-18 17:49 4% ` Georg Bauhaus
2 siblings, 0 replies; 200+ results
From: sk @ 2002-03-18 12:44 UTC (permalink / raw)
Hi,
If you are using Gnat, type "gnatpsta" at the command-line and
you will be provided the following :
type Integer is range -(2 ** 31) .. +(2 ** 31 - 1);
subtype Natural is Integer range 0 .. +(2 ** 31 - 1);
subtype Positive is Integer range 1 .. +(2 ** 31 - 1);
...
type String is array (Positive range <>) of Character;
pragma Pack
(String);
So in the simplest terms, a string is a numerically indexed
array of characters.
declare
-- SB, SE --> String_Begins, String_Ends
SB, SE : Natural := 0;
Sample_String : constant String := "Hello Cruel World";
begin
-- Find first ' '
for i in Sample_String'Range loop
if Sample_String (I) = ' ' then
SB := i;
exit;
end if;
end loop;
...
-- Pretend that the second ' ' has been found.
TIO.Put_Line (
"The World is such a " &
Sample_String (SB .. SE) &
" place."
);
end;
In general, unless you are searching for control characters,
specify them in the source or use named characters.
For example,
Html_Tag_Open : constant Character := '<';
Html_Tag_Close : constant Character := '>';
Horizontal_Tab : constant Character :=
Ada.Characters.Latin_1.HT;
Also, you don't need to introduce the heavy-weight
Ada.Strings.xxx unless your application is more
complex than the one above. Even then, I personally
just write small string-searchers within the application
rather than introduce the Ada.Strings.xxx
Hope this helps.
--
-------------------------------------
-- Merge vertically for real address
-------------------------------------
s n p @ t . o
k i e k c c m
-------------------------------------
^ permalink raw reply [relevance 4%]
* Re: String slicing.
2002-03-17 22:23 4% String slicing Wannabe h4x0r
@ 2002-03-17 22:43 0% ` Jim Rogers
2002-03-18 12:44 4% ` sk
2002-03-18 17:49 4% ` Georg Bauhaus
2 siblings, 0 replies; 200+ results
From: Jim Rogers @ 2002-03-17 22:43 UTC (permalink / raw)
The compiler is correct here. The index subtype for strings is
Positive. A character is not a member of the Positive subtype.
My guess from your description is that you want the
capabilities defined in the package Ada.Strings.Fixed.
This package will help you scan a string by words.
Jim Rogers
Wannabe h4x0r wrote:
> I've written a type definition as follows...
>
> type wrd_string is new String(1..Ada.Characters.Latin_1.Space);
>
> Now it says that I'm using incompatible types. Now, shouldn't the
> compiler be smart enough to recognize that I'm using Characters to count
> the characters of an array slice. i.e. a String is nothing more than an
> array of characters.
>
> Basically I'm breaking down a text file into chunks of "words" and
> "sentences" for sorting by Mats Webers "quick_sort" routine in his
> components library. Or rather, I'm learning how to. I can sort by
> character easily enough, now I'm learning to work with slices of Strings.
>
> This is a general pain in the ass for me, as it seems Ada wont let me
> slice and reference pieces of strings using Characters. Dont worry, I am
> reading the manual. Any tips or pointers would be helpful.
>
> Chris
>
^ permalink raw reply [relevance 0%]
* String slicing.
@ 2002-03-17 22:23 4% Wannabe h4x0r
2002-03-17 22:43 0% ` Jim Rogers
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Wannabe h4x0r @ 2002-03-17 22:23 UTC (permalink / raw)
I've written a type definition as follows...
type wrd_string is new String(1..Ada.Characters.Latin_1.Space);
Now it says that I'm using incompatible types. Now, shouldn't the
compiler be smart enough to recognize that I'm using Characters to count
the characters of an array slice. i.e. a String is nothing more than an
array of characters.
Basically I'm breaking down a text file into chunks of "words" and
"sentences" for sorting by Mats Webers "quick_sort" routine in his
components library. Or rather, I'm learning how to. I can sort by
character easily enough, now I'm learning to work with slices of Strings.
This is a general pain in the ass for me, as it seems Ada wont let me
slice and reference pieces of strings using Characters. Dont worry, I am
reading the manual. Any tips or pointers would be helpful.
Chris
^ permalink raw reply [relevance 4%]
* Re: Future with Ada
@ 2002-03-06 16:43 4% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2002-03-06 16:43 UTC (permalink / raw)
Pascal Obry <p.obry@wanadoo.fr> wrote:
: France'Magny-Les-Hameaux'Gabriel-Peri-Street'Zip-78114'(CLA.Pascal.Obry)
Oh, I hadn't realised that the names of French pavement-aligned
vehicle paths have been internationalised to US English!
So Ada.Characters.Latin_1 has been too late? :-) :-) :-)
-georg
^ permalink raw reply [relevance 4%]
* Re: Ada Characters?
2002-02-28 2:28 6% ` Jim Rogers
2002-02-28 2:37 5% ` sk
@ 2002-02-28 22:54 5% ` Jeffrey Carter
2 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2002-02-28 22:54 UTC (permalink / raw)
Wannabe h4x0r wrote:
>
> I'm trying to figure out how to get my Ada program to single out ASCII
> control codes without hosing the output of the rest of the text file.
>
> Basically, I'm doing it like this...
> with Ada.Characters; use Ada.Characters.Handling;
>
> TEXT : string(1..200);
> chk_char: character; -- Check to see if this is a control character.
> chk_result : boolean;
>
> and the code goes like this ...
>
> for l in TEXT'range loop
> chk_char := TEXT(l);
> chk_result := Is_control(chk_char);
> if chk_result is True then
> if <how do I check to see if it's a NL(new line) character?> then
> NEW_LINE;
> else
> NULL;
> end if;
> else
> Put(chk_char); --Put each character individually
> end if;
> end loop;
>
> Anyways, that's the general gist of it.
I don't understand what you're trying to do. How do you fill Text and
how does it get control characters in it? What character do you mean by
NL? No such character is defined in Ada.Characters.Latin_1. Ada.Text_IO
line terminators are not defined by the language and differ from OS to
OS; on some systems a line terminator is a single character while on
others it is a sequence of characters.
--
Jeffrey Carter
^ permalink raw reply [relevance 5%]
* Re: Ada Characters?
2002-02-28 2:28 6% ` Jim Rogers
@ 2002-02-28 2:37 5% ` sk
2002-02-28 22:54 5% ` Jeffrey Carter
2 siblings, 0 replies; 200+ results
From: sk @ 2002-02-28 2:37 UTC (permalink / raw)
Hi,
> if <how do I check to see if it's a NL(new line) character?> then
???
How about looking at the packages Ada.Characters.Latin_1 or ASCII ?
if TEXT(I) = Ada.Characters.Latin_1.NL ...
if TEXT(I) = ASCII.NL ...
or even
if Ada.Text_Io.End_Of_Line (<file>) then ...
These are quick-and-dirty, so the names of constants might be
wrong (NL ?, perhaps CR, cannot remember).
-------------------------------------
-- Merge vertically for real address
-------------------------------------
s n p @ t . o
k i e k c c m
-------------------------------------
^ permalink raw reply [relevance 5%]
* Re: Ada Characters?
@ 2002-02-28 2:28 6% ` Jim Rogers
2002-02-28 2:37 5% ` sk
2002-02-28 22:54 5% ` Jeffrey Carter
2 siblings, 0 replies; 200+ results
From: Jim Rogers @ 2002-02-28 2:28 UTC (permalink / raw)
Wannabe h4x0r wrote:
> I'm trying to figure out how to get my Ada program to single out ASCII
> control codes without hosing the output of the rest of the text file.
>
> Basically, I'm doing it like this...
> with Ada.Characters; use Ada.Characters.Handling;
>
> TEXT : string(1..200);
> chk_char: character; -- Check to see if this is a control character.
> chk_result : boolean;
>
> and the code goes like this ...
>
> for l in TEXT'range loop
> chk_char := TEXT(l);
> chk_result := Is_control(chk_char);
> if chk_result is True then
> if <how do I check to see if it's a NL(new line) character?> then
> NEW_LINE;
> else
> NULL;
> end if;
> else
> Put(chk_char); --Put each character individually
> end if;
> end loop;
with Ada.Characters.Latin_1;
with Ada.Characters.Handling; use Ada.Characters.Handling;
...
for l in TEXT'range loop
chk_char := TEXT(l);
if Is_Control(chk_char) then
if chk_char = Ada.Characters.Latin_1.LF then
Ada.Text_IO.Put(chk_char);
end if;
else
Ada.Text_IO.Put(chk_char);
end if;
end loop;
Jim Rogers
^ permalink raw reply [relevance 6%]
* ACT announces availability of GNAT 3.14p
@ 2002-01-31 2:49 1% Robert Dewar
0 siblings, 0 replies; 200+ results
From: Robert Dewar @ 2002-01-31 2:49 UTC (permalink / raw)
Ada Core Technologies (ACT) has made available at the NYU
site (ftp://cs.nyu.edu/pub/gnat) GNAT 3.14p builds for the
following targets:
MS Windows (NT/2K)
Sparc Solaris (2.5.1 through 2.8)
GNU Linux (Redhat 6.2)
The above are the official platforms, but in practice the
NT version works reasonable well on Win 98 and Win ME and
other versions of GNU Linux including Debian GNU/Linux are
known to be compatible with this version of GNAT.
These are the only public versions that ACT plans to build.
As always, the releases contain the full sources, and we
invite volunteers to create builds for other platforms. We
also draw attention to the availability of source snapshots
for the current development version of GNAT (similar to the
3.15 release, but on GCC 3, rather than GCC 2). The above
public versions are still based on ACT's 2.8.1 GCC version.
These versions are provided without any warranty or
guarantee of any kind, and no support of any kind is
available for these public versions from ACT. They are
provided as a service for use by students, hobbyists and
researchers who need access to a high quality Ada 95
system.
If you need a supported commercial Ada 95 compiler, we
recommend the use of our GNAT Pro product. In particular,
we do not recommend the use of the public version for
formal evaluation purposes. Contact sales@gnat.com
or sales@act-europe.fr for further details on GNAT Pro,
including the availability of evaluation versions.
Robert Dewar
Ada Core Technologies
The following is a list of new features available in 3.14
as compared with 3.13.
GNAT 3.14p NEW FEATURES LIST
============================
Copyright (c) 2001, Ada Core Technologies
This file contains a complete list of new features in
version 3.14p of GNAT. A full description of all GNAT
features can be found in the GNAT User Guide and GNAT
Reference Manual.
NF-314-5827-001 New -u switch for gnatmake
The command gnatmake -u only recompiles the main file when
needed. Gnatmake can now be used as the main and only
interface to the compiler since a single compilation can be
launched with "gnatmake -u -f".
NF-314-6806-001 Source reference pragmas read by gnatchop
The gnatchop utility now recognizes and respects existing
source reference pragmas that it finds in the input file,
so that the output files always properly reflect the
original source file.
NF-314-6813-011 Asis queries to evaluate static expressions
A new set of queries is added to package Asis.Extensions.
These queries allows an ASIS application to evaluate the
value of a discrete static expressions and to get the low
and high bound of a static 'Range attribute. The results
are returned as string images of expression values, The
'Pos value is returned for enumeration expressions. See
specification of Asis.Extensions for more details.
NF-314-7001-006 Better messages on non-visible entities
The warnings for non-visible entities have been improved to
exclude implicit entities, and entities declared in the
private part of GNAT internal units. This results in more
helpful error messages for undefined variables.
NF-314-7008-003 New package GNAT.Sockets
This package provides a high level interface to the sockets
API. Most of the features are implemented. This high
level and portable interface is based on the
GNAT.Sockets.Thin API which is a thin binding to the OS
sockets API.
NF-314-7110-008 New package GNAT.Most_Recent_Exception
This package provides subprograms giving access to the
exception occurrence, or exception occurrence access for
the most recently raised exception. Unlike the routines in
GNAT.Current_Exceptions, these routines do not have to be
called statically from within an exception handler.
NF-314-7207-004 Issue error for bad Source_Reference pragma
The Source_Reference pragma is (and always has been)
required to be the first line of the file. This is now
clearly documented, and a diagnostic is issued if the first
Source_Reference pragma is not the first line in the file.
NF-314-7207-006 Warn when Duration unexpectedly used
A new warning has been added when a universal fixed
expression is interpreted as type Standard.Duration.
Although this is correct according to RM semantics, it is
almost always suspicious and represents an unintended
meaning.
NF-314-7215-008 Improve msg for missing WITH of predef unit
The error message handling for cases of forgotten WITH's of
predefined library routines has been improved.
NF-314-7314-004 Remove useless initialization checks
Initialization procedures for arrays were doing unnecessary
subscript range checks, that have now been suppressed,
since an out of range condition is impossible in this
context.
NF-314-7418-008 New switch for gnatchop to exit on errors
The new -x gnatchop switch causes gnatchop to exit on
detecting parse errors. Now gnatchop also sets the exit
status to indicate errors.
NF-314-7506-010 Improve message for access param comparison
A comparison of an access parameter with null is illegal.
This was always caught by GNAT but with a confusing error
message that complained about the types of the operands.
Now a specific error mesage is given pointing out that it
is not allowed for an access parameter to be null in the
first place.
NF-314-7509-002 Improve warning for possibly null values
The warning for possibly null values has been improved to
be more precise and to catch some previously uncaught
cases.
NF-314-7515-007 Multiple Source_Reference pragmas allowed
It is now permitted for a single file to have more than one
Source_Reference pragma. All pragmas must refer to the
same original file, but the sections referenced need not be
contiguous. This permits correct processing of files with
configuration pragmas that are chopped using gnatchop with
the -c and -r switches.
NF-314-7516-012 Better warning messages for Storage_Error
In some cases, a warning about possible storage error was
posted on the offending statement in a generic template.
Now the message is always on the relevant instantiation
with a pointer to the generic template location.
NF-314-7524-009 GNAT version string is in executable
The executable now contains a string identifying the GNAT
version in the form "GNAT Version: xxx(xxx)" where
xxx(xxx) is the version number. The external name of this
constant is __gnat_version.
NF-314-7530-009 Consistency checking for -gnatE mode
Units compiled with -gnatE and without -gnatE can be mixed
under certain conditions, now properly documented in the
GNAT Users Guide. The binder now checks that the rules for
safe mixing are properly followed.
NF-314-7606-012 Improve equality ambiguity error messages
In the case of ambiguous operands for equality, -gnatf now
gives details on the possible resolutions discovered by the
compiler, making it easy to diagnose the cause of this
error in non-obvious situations.
NF-314-7607-007 Improved control for NT temporary files
Under NT, it is now possible to control where temporary
files are created. First, the TMP environment variable is
checked, and if this is set, it specifies the directory to
be used. If TMP is not set, then c:\temp is used. If both
of these checks fail, then, and only then, is the current
working directory used.
NF-314-7611-007 Warnings for WITH of internal GNAT unit
The only units that should be WITH'ed by application
programs are those that are documented in the RM or in the
GNAT documentation. Any WITH of an internal GNAT
implementation unit not documented in one of these two
locations now generates a warning. This warning can be
controlled individually by use of the -gnatwi/-gnatwI
switches. It is on by default.
NF-314-7614-005 Avoid use of a-types.h in runtime
The use of a-types.h is now avoided in building the runtime
library. This reduces unnecessary symbol table and debug
information
NF-314-7619-008 Access to source related information
A new package GNAT.Source_Info provides some useful utility
subprograms that provide access to source code informations
known at compile time, such as file name, line number and
enclosing entity.
NF-314-7620-002 More flexible source file naming
The Source_File_Name pragma has been enhanced so that it
can provide general pattern driven rules for constructing
file names. The scheme is powerful enough to accomodate
all common schemes for deriving file names from unit name
that we are aware of, and in particular it supports
standard schemes used by other Ada 95 compilers. This
means that for most purposes the large set of
Source_File_Name pragmas can be replaced by two pragmas,
giving pattern rules for bodies and specs.
NF-314-7622-004 New packages for CGI programming
A new package GNAT.CGI provides basic services for CGI
(Common Gateway Interface) programming. A subsidiary
package GNAT.CGI.Cookies provides facilities for dealing
with "cookies" (data kept in Web client software). A third
package GNAT.CGI.Debug provides debugging facilities.
Between them, these packages enable an easy interface for
Web programming from Ada.
NF-314-7626-013 Automatic backtraces during exception
handling
A new package GNAT.Exception_Traces is now available for
platforms on which the backtrace features is implemented.
This provides a feature for enabling automatic output of
backtraces upon exception occurrences. Two options are
available, enabling traces either for every occurrence or
only for occurrences that are not caught by a user defined
handler. The latter is typically useful to get traces when
a task dies because of an unhandled exception.
NF-314-7708-001 New Setenv procedure in GNAT.OS_Lib.
A procedure Setenv has been added in GNAT.OS_Lib. This
procedure can be used to add or remove environment
variables for the current and child process. This is not
yet supported under VMS, but is fully supported for all
other GNAT ports.
NF-314-7709-004 New unit GNAT.AWK (AWK style file parsing)
A new package GNAT.AWK (file g-awk.ads) provides AWK-like
file parsing with an easy interface for parsing one or more
files containing formatted data. The file is viewed as a
database where each record is a line and a field is a data
element in this line.
NF-314-7711-001 New function Paren_Count in GNAT.Regpat
A new function Paren_Count is now provided in GNAT.Regpat
to return the maximum number of parentheses pairs in the
compiled regular-expression.
NF-314-7712-005 Support for honoring gcc -fno-common
The -fno-common gcc command line option is now recognized.
The use of this option causes the allocation of
uninitialized global variables to be moved to the bss
section of the object file, rather than generating them as
common blocks. This solves problems caused by the presence
of a symbol both in a library and in an explicitly linked
object file.
NF-314-7713-002 Improved error message placement
The error message noting that only subtype marks can be
used in a generic array formal are now more accurately
placed and point specifically to the offending construct.
NF-314-7713-003 Front-end inlining
The -gnatN switch enables front-end inlining. In this
compilation mode, the front-end replaces a call to a
subprogram that has an Inline pragma by the expanded body
of the subprogram, provided the body is short enough. This
supplements the inlining performed by the GCC back-end.
NF-314-7717-001 Task_Name pragma provided to set task name
A new pragma Task_Name can be used in a task definition to
specify the name used for a task for debugging purposes and
by Ada.Task_Identification.Image. The argument is the task
name, and can be an expression referencing the task
discriminants, allowing different names to be given to
different instances of the same task type.
NF-314-7718-001 Linker_Options extensions now documented
The documentation (GNAT Reference Manual) has been enhanced
to contain full documentation of the GNAT implementation of
the Linker_Options pragma. GNAT allows multiple arguments,
and also allows the use of ASCII.NUL to separate arguments
in a single string.
NF-314-7718-003 New warning option to detect hiding
New flags -gnatwh/-gnatWH are provided to enable/disable
checking for the case where an inner entity hides an outer
one. This is of course legal, but in some environments
such hiding is discouraged, and this warning option (which
is by default off) can be used to enforce this requirement.
Note that the common case of one character identifiers such
as I,J,K is excluded from consideration.
NF-314-7721-002 Improved range analysis for subtraction
The circuit for range analysis for subtraction has been
enhanced. This eliminates some range checks, and some
additional warnings at compile time for cases where the
result is known to be out of range.
NF-314-7721-003 Implement range analysis 'Length
Range analysis for the Length attribute has been added,
resulting in elimination of some range checks, and also
some additional warnings at compile time for cases where
the result is known to be out of range
NF-314-7722-016 Improved error msg for name conflict
The error message for a conflict between an enumeration
literal and a later declared constant of the same name has
been improved.
NF-314-7723-005 GLIDE xref works even if compile errors
The new switch -gnatQ can be used to force generation of an
ALI file even if there are compile errors. This is most
useful in connection with GLIDE and similar tools, since it
means that cross-reference information is available even
after compiler errors.
NF-314-7723-012 Unreferenced labels generate warnings
In -gnatwu mode, GNAT now diagnoses labels that are not
referenced other than by their initial occurrence.
NF-314-7731-012 New unit GNAT.Dynamic_Tables
A new package GNAT.Dynamic_Tables provides a resizable
one-dimensional array. It is similar to GNAT.Table except
that the table type is a declared type, so that it can be
used in more general contexts.
NF-314-7801-005 Warning for aliased discriminanted objects
GNAT now generates a warning for an assignment to an
aliased discriminated object that is known to generate a
constraint error at run time.
NF-314-7802-002 GLIDE can go to any file in error message
When an error message from the compiler includes several
file:line references, it is now possible to click on any of
them to display the appropriate file, instead of just the
first one.
NF-314-7814-013 x86 stack traceback for foreign threads
Under x86 targets it is possible to get the stack traceback
through a foreign thread. This is true for unhandled
exceptions and for GNAT.Traceback services.
NF-314-7817-001 GNAT now compatible with Solaris 2.8
GNAT is now fully compatible with Solaris 2.8. This
includes proper building and operation of the florist
package (which did need some modifications to be 2.8
compatible).
NF-314-7820-008 Better 'Valid handling for large subtypes
If an object of a discrete type has a larger size than the
base type (e.g. from the use of a component clause in a
record representation clause), then 'Valid will check all
the bits of the object (previously the code simply use part
of the field, which was an allowable implementation
according to the RM, but nevertheless surprising).
NF-314-7821-010 ASIS tutorial is available
A simple hands-on ASIS tutorial is added to the ASIS
distribution. It consists of two parts. One part is based
on the asistant tool and the task is to get the initial
experience with using ASIS queries. Another part is based
on the ASIS application templates and the task is to
implement simple ASIS tools starting from these templates.
For all the tasks full documented solutions are provided.
NF-314-7821-008 ASIS application templates are available
A set of ASIS application templates is added as a part of
the ASIS distribution. This set contains the Ada
components which are the same or very similar for many
ASIS-based tools. These templates may be used as a "quick
start" for ASIS beginners.
NF-314-7822-009 Dynamic elaboration checks improved
Elaboration checks are suppressed for calls to subprograms
in packages to which a pragma Elaborate applies. The cases
of Elaborate_All and Elaborate_Body already suppressed the
check, but checks were not suppressed for Elaborate.
NF-314-7826-009 gnatdll supports binder arguments
Gnatdll now supports the -bargs parameter passing arguments
to the binder. For example, this can be used to build a
DLL with stack tracebacks stored in the exception
occurences (gnatbind -E option).
NF-314-7826-010 pragma Comment restriction removed
The placement of pragma Comment is now unrestricted. This
pragma can appear anywhere within the main unit, including
as the first line of the file.
NF-314-7827-011 Control of warnings for address overlays
The warning switch -gnatwo turns on overlay warnings for
address clauses where implict initialization can cause the
overlaid memory to be clobbered. The swich -gnatwO turns
off these warnings. The warnings have been implemented for
a while. What is new is allowing them to be selectively
turned off (the default is that this warning is enabled).
NF-314-7829-002 Control over validity checking is provided
GNAT now provides a new switch -gnatVx that allows you to
control the level of validity checking. The options are
n/d/f for none/default/full. None means no checking for
invalid data, default (which is the default setting)
provides sufficient checking to meet the requirements of
the RM, and full provides extensive validity checking,
particularly useful when used with Normalize_Scalars.
NF-314-7829-003 New warning for hiding loop variables
A common mistake for those familiar with other languages is
to fail to realize that a for loop implicitly declares the
loop variable, and programmers provide a useless and unused
outer level variable definition with the same name. GNAT
now specifically detects this situation and provides an
explicit warning.
NF-314-7830-008 ASIS Corresponding_Name_Definition_List
The Asis.Expressions.Corresponding_Name_Definition_List
query in ASIS for GNAT is now fully implemented.
NF-314-7830-014 New warning for overlay by access type
The warning for possible unexpected initialization has been
extended to include access types. The warning is generated
if an access type has an address clause causing overlay,
and there is no pragma Import, so that initialization to
null will take place. Note that NF-314-7827-011 gives the
capability of controlling such warnings. Note also that
GNAT 3.13p had a (now corrected error) that caused such
expected initializations to be omitted.
NF-314-7906-017 New package Ada.Interrupts.Signal
A new package Ada.Interrupts.Signal (file a-intsig.ads) has
been created to provide an easier and more portable way of
generating Ada95 interrupts.
NF-314-7910-004 Uniform behavior for Slice subprograms
In packages Ada.Strings.Bounded/Ada.Strings.Unbounded, the
Slice function now returns with the bounds of the slice
expressions, rather than with a lower bound of 1. This was
discussed in the ISO WG9 ARG, and it was agreed that this
was the preferable approach. This change also improves the
efficiency of these two functions.
NF-314-7914-009 Optimization for object declarations
If an object is declared with an unconstrained nominal type
and the expression is a function call, it is in general
necessary to compute the result of the call first and then
copy that result into the object, after deter- mining the
bounds. GNAT now suppresses that copy in many cases. The
copy is still used if the type is controlled, if it is
classwide, or if the object is declared at the library
level.
NF-314-7918-012 Enhanced variant of Spawn in GNAT.OS_Lib
In the package GNAT.OS_Lib, a new Spawn function now
returns the exit status of the executed command as an
Integer value. The existing Spawn procedure only gives a
boolean result.
NF-314-7924-003 Immediate output switch (-gnate) replaced
The immediate output switch -gnate is no longer defined,
reflecting the fact that this is intended only for use in
diagnostic mode following a compiler crash. In those cases
where this is needed, the effect can be obtained by use of
the -gnatdO debug switch. The purpose of this change is to
avoid accidental use of this switch, which disables many
useful error message circuits.
NF-314-7925-003 Protected types visible in entities menu
In addition to subprograms, types and tasks, the entities
menu in GLIDE now includes an entry for protected objects
and types. This is also available in the speedbar panel.
NF-314-7926-006 Allow SPARK annotations in -gnatyc mode
The -gnatyc mode now allows comments starting with --x
where x is any special character in the lower half of the
ASCII range (16#21#..16#2F#,16#3A#..16#3F#). This in
particular allows the --# comments that appear as
annotations in the Praxis SPARK language.
NF-314-7929-004 Value_Size and Object_Size output by -gnatR
The -gnatR switch now outputs Value_Size and Object_Size
separately for types where these two values are different.
If the values are the same, then the output simply lists
this common value as the Size value.
NF-314-7930-001 Value_Size and Object_Size for all types.
The Value_Size and Object_Size can now be separately
specified for composite types (records and arrays). The
meaning is as for scalar types. The Value_Size is used for
unchecked conversion and packing purposes, and the
Object_Size is used for allocation of objects.
NF-314-7930-006 New attribute Standard'Wchar_T_Size
This attribute returns the size of the C type wchar_t,
which may differ from the Ada Wide_Character type. The
attribute is primarily intended for the construction of the
wchar_t type in Interfaces.C.
NF-314-7930-007 Changed children of System to be pure
Many more packages in the System hierarchy have been marked
pure. This change documents that the functions in those
packages are in fact side-effect free, which gives the
compiler more optimization opportunities.
NF-314-7931-001 Additional in-place assignments for
aggregates
Assignments of the form: S (1 .. N) := (others => Expr);
are now performed in place, without generating a temporary
for the aggregate (as long as Expr is independent of S, of
course). In addition, array assignments where the
right-hand side is an aggregate with only an others clause
are performed in place even if the bounds of the array are
non-static.
NF-314-7931-002 Improved handling of enumeration image
tables
The handling of enumeration type image tables (for support
of the Value, Image, and Width attributes for enumeration
types has been improved). The tables are now generated
statically, and are significantly smaller than they were
previously (1-4 bytes overhead per entry instead of 12-15).
NF-314-7931-003 NT Win32Ada binding reformatted for -gnaty
The sources of Win32Ada binding were reformatted to meet
the style requirements for compiling with the -gnaty
switch.
NF-314-8001-002 The -gnatg switch is now fully documented
The -gnatg switch is the GNAT internal implementation
switch. It is intended only for use by GNAT itself. The
documentation now fully describes this switch and explains
why it should not be used by application programs.
NF-314-8004-004 Unchecked_Conversion now fully documented
The GNAT Reference Manual now contains complete
documentation on the approach used by GNAT in handling
unchecked conversions where the sizes of the source and
target types are different.
NF-314-8006-002 Improved output for representation
information
The -gnatR switch now takes an optional parameter which can
have the value 0,1,2. No representation output is
generated in -gnatR0 mode. In -gnatR1 (same as -gnatR),
representation information is generated for arrays and
records. For -gnatR2, representation information for all
user declared types and objects is generated.
NF-314-8010-003 Detect duplicate Value/Object_Size clauses
The appearence of more than one Value_Size or Object_Size
clause for a single entity, which was previously allowed
(with the earlier one being ignored), is now detected as an
error, which seems more appropriate and more consistent
with the treatment of duplicate Size clauses.
NF-314-8010-005 Spell checking in GLIDE
The standard ispell command can now be used to spell check
the comments while editing an Ada source file. The
checking only applies to comments and not to Ada source
code other than comments.
NF-314-8010-012 More flexible GNAT.Threads.Create_Thread
Create_Thread now returns the task id so that this value is
easily known on the client side.
NF-314-8012-002 New warning for unexpected rounding
Warn in cases where the static evaluation rules of Ada as
described in RM 4.9(38) result in different rounding than
would have been obtained at runtime. This rule is a rather
surprising one, and has caused confusion in the past.
NF-314-8014-002 Additional information on unused entities
Warning messages on unused entities (generated by compiling
with -gnatwu) now indicate the kind (variable, function,
etc) of the entity to which the warning applies.
Cross-references are now generated when an entity appears
as a default actual in an instantiation. This inhibits
warnings if the entity is not used explicitly elsewhere,
and is also used by tools that rely on xref information
(e.g. GLIDE).
NF-314-8019-001 Documentation on variant object size
An extensive section has been added to the GNAT Reference
manual describing how GNAT treats the Size attribute when
applied to variant record objects.
NF-314-8022-004 Improved documentation for -gnato switch
More extensive documentation is provided for the -gnato
switch that enables overflow checking, emphasizing that
overflow checking is off by default, and explaining the
rationale behind treating overflow checks differently from
other kinds of range checks.
NF-314-8023-003 Document Size Limit
GNAT enforces a maximum Size of objects of 2**31-1, which
since Size is in bits, corresponds to a size of 256
megabytes. This limit has always been enforced, but it is
now properly documented in the GNAT Reference Manual.
NF-314-8023-005 Improved documentation for GNAT.Task_Lock
The documentation for GNAT.Task_Lock has been enhanced to
make it clear that calling Lock multiple times from the
same task works as expected for nested use of Lock/Unlock.
NF-314-8024-002 C_Pass_By_Copy convention now standardized
The implementation of the C_Pass_By_Copy convention has
been modified to be consistent with the agreed
specification in AI95-00131, which is part of the official
technical corrigendum for Ada 95. For GNAT, the
modification is that now C_Pass_By_Copy is rejected for any
entities other than record types and subtypes. Convention
C can always be used instead for other entities (GNAT used
to treat C_Pass_By_Copy as identical to C for other
entities).
NF-314-8025-009 Documentation of GNAT Library Units
The GNAT Reference Manual now contains complete reference
documentation for all GNAT specific units in the GNAT,
System, Interfaces, and System. This includes several
units that have been present in GNAT, but not previously
documented, including System.Address_Image (to convert
Address values to strings) and Ada.Command_Line.Remove (for
logically removing command line arguments).
NF-314-8028-002 SIGUSR1/SIGUSR2 now handled in GNU/Linux
Using native threads (aka LinuxThreads), it was not
possible to handle the SIGUSR1 and SIGUSR2 signals. This
limitation has now been removed. This change affects all
versions of GNAT for GNU/Linux including Debian GNU/Linux
and also Redhat Linux.
NF-314-8030-011 New style-check for exit of named loop
The -gnatye switch now includes checking for missing exit
labels. It will now cause a warning to be posted if an
exit statement appears which refers to a labeled loop but
the statement does not include the label.
NF-314-8030-014 Improved output from gnatbind -e switch
The output now excludes all output for gnat internal units.
The dependency information for internal units is of
interest only for implementors, and tends to be voluminous
and useless for normal use. A -de debug flag is introduced
to provide the old behavior for system implementors use.
NF-314-8031-012 More extensive misspelling warnings
The error messages for undefined variables now include
additional cases where a suggestion of a possible
misspelling is provided. This message now includes cases
where the entity is in a with'ed package and has explicit
qualification.
NF-314-8031-013 Nested package bodies included in -gnatR
The output from the -gnatR switch now includes declarations
that appear in nested package bodies.
NF-314-8031-019 Clear labeling of output in -gnatR output
The output from the -gnatR switch now makes it clear
whether the unit for which representation information is
listed is a spec or a body.
NF-314-8101-005 Alignment warnings for bad address clauses
It is the program's responsibility to ensure that the value
in an address clause is consistent with (i.e. a multiple
of) the alignment of the object to which it is applied, and
in general this cannot be checked at compile time. However
it is possible to post warnings in some cases where the
value is known at compile time and is clearly wrong, and
this is now done.
NF-314-8104-007 New Glide variable
ada-prj-gnatfind-switches
This variable can be customized to change the default
switches used for gnatfind when you select the menu item
"Show All References". For example this can be used to add
the -a switch, in case you often work with read-only ALI
files.
NF-314-8105-007 New convention Win32 equivalent to Stdcall
The convention Win32 is now recognized as equivalent to
Stdcall or DLL (all three conventions are identical in
effect and considered to be conformant). This eases
porting of code from other compilers that use this
convention name.
NF-314-8106-010 New unit Ada.Exceptions.Is_Null_Occurrence
This GNAT addition to the Ada hierarchy allows a program to
test if an occurrence is the null occurrence
(Null_Occurrence) without enerating an exception. This
capability is not present in the predefined subprograms in
Ada.Exceptions.
NF-314-8106-010 Warnings for useless type conversions
A warning can be generated for type conversions of the form
a(b) where b is a simple entity name which is of type a
(i.e. the conversion has no effect). This warning is
normally off but can be set on by the use of
@code{-gnatwr}.
NF-314-8106-011 Warnings for useless assignments
A warning can be generated for assignments of the form a :=
a; (i.e. assignments of a variable to itself) which are
obviously useless. This warning is normally off but can be
set on by the use of @code{-gnatwr}.
NF-314-8108-006 Warnings for accidental hiding by child
unit
A warning is generated when a child unit in the context of
a parent hides a compilation unit of the same name. For
example, Foo.Ada, if it appears in the context of the body
of Foo, will hide an occurrence of the predefined Ada in
the same context, which can lead to surprising visibility
errors later on.
NF-314-8108-004 Better error messages for bad array
aggregate
If an array aggregate is missing elements (e.g. it has the
index values 1,2,8,9 and is missing 3 .. 7), the error
messages will now give a full list of missing values.
NF-314-8114-002 Named numbers included in -gnatwu check
The warning option -gnatwu (check unreferenced entities)
now includes named numbers, so unreferenced named numbers
will now also cause warnings to be generated.
NF-314-8114-016 Better msg placement for with'ed unit not
found
In some cases, the error message for a WITH that directly
or indirectly lead to a file not found could be placed on a
location other than the WITH statement. It is now always
placed in the most convenient place.
NF-314-8116-001 Support for wide char to string conversions
The library units System.Wch_Con and System.Wch_Cnv provide
a method for converting between wide characters and the
corresponding string representation, using any of the
implemented methods for encoding.
NF-314-8118-003 Backtrace decorators for automatic
backtraces
GNAT.Exception_Traces now includes a backtrace decoration
facility, allowing customization of the way the set of
addresses for a backtrace is output. A typical use of this
feature is to provide a function that returns the symbolic
information associated with each address, as computed by
GNAT.Traceback.Symbolic.
NF-314-8120-006 Improved dead code detection
The warning circuitry for unreachable code has been
improved. Now an IF or CASE statement, all of whose
statement sequence end with some transfer of control is
recognized, and code after such a statement is flagged as
dead code with an appropriate warning.
NF-314-8127-007 Improved parser error messages
Some improvements in parser error messages have been made.
If "|" is used in an expression in an inappropriate manner,
the parser suggests that "or" may have been intended. If a
component is declared in the visible part of a protected
object, the diagnostic reminds that such components can
only be in the private part.
NF-314-8203-008 Default thread library is now LinuxThreads
Under the GNU/Linux operating system, the default tasking
run time is now based on the native LinuxThreads library.
The alternate FSU threads implementation is still available
as an alternative (see file README.TASKING for more
details). This change applies to all versions of GNU
Linux, including Redhat Linux.
NF-314-8205-001 New package Ada.Characters.Wide_Latin_1
This package provides definitions analogous to those in the
RM defined package Ada.Characters.Latin_1 except that the
type of the constants is Wide_Character instead of
Character. The provision of this package is in accordance
with RM (A.3(27)). Note: this package has been available
for some time, but was not properly documented, so from a
formal point of view was not available to application
programs, but now it is a first class citizen which is
fully documented.
NF-314-8213-003 More flexible placing of address clause
Previously when an address clause and Import pragma were
given for a subprogram, the pragma was required to be given
first. There is now no restriction on the ordering.
NF-314-8214-004 Style violations are now warnings not
errors
Style errors resulting from the use of a pragma Style_Check
or the -gnaty flag are now treated as warnings rather than
errors, which means that an object file can be created if
there are no other errors, and that also the compiler will
find semantic problems even if there are syntactic style
errors. If the previous behavior of treating these as
errors is desired, the -gnatwe flag can be used.
NF-314-8218-005 New Elaboration_Checks pragma
A new configuration pragma Elaboration_Checks can be used
to select the RM dynamic model of elaboration or the GNAT
default static model. This may be used in gnat.adc for
partition wide application, or within sources for unit by
unit control. See also feature NF-314-7530-009.
NF-314-8218-009 More efficient memory allocation
The GNAT run-time file a-raise.c can now easily be
recompiled with lock suppression to improve the efficiency
of memory allocation and deallocation if certain conditions
are met. See the comment on NO_LOCK in a-raise.c itself
for details.
NF-314-8220-005 Generic sort packages in GNAT now Pure
The units GNAT.Heap_Sort_G (g-hesorg.ads),
GNAT.Bubble_Sort_G (g-busorg.ads) are now Pure instead of
Preelaborate, allowing them to be with'ed and instantiated
by Pure clients.
NF-314-8220-006 Automatic float control for Float
Input-Output
Floating-point conversion in Text_IO no longer relies on
the floating-point processor being correctly set. This
means that the need for explicit calls to GNAT.Float_Reset
is limited to programs which explicitly use
Long_Long_Float. This feature is especially helpful on NT,
where system services of all kinds seem to reset the
floating-processor into low precision mode.
NF-314-8225-001 Project file capability for gnatmake
The gnatmake utility is now project file aware, and can be
used with the new GNAT Project Files (see new documentation
section in the users guide). It now accepts the new
switches -Pproject, -vPx and -Xname=value.
NF-314-8226-007 Better handling of invalid enum opnds for
Image
The Image function for enumeration types yielded rubbish
strings for abnormal and invalid operands (e.g. created by
unchecked conversions). A validity check (subject to
control by the -gnatV switch) is now performed so that an
exception (Constraint_Error) is raised for an invalid
operand.
NF-314-8230-001 Style check option for ordered subprograms
The -gnatyo switch (ORDERED_SUBPROGRAMS in the VMS version)
activates a style check that subprogram bodies within a
given scope (e.g. a package body) must be in alphabetical
order.
NF-314-8302-004 Project file capability for gnatls
The gnatls utility is now project aware, and can be used
with the new GNAT Project Files (see new documentation
section in the users guide). It now accepts the new
switches -Pproject, -vPx and -Xname=value.
NF-314-8304-001 RPM packages are now provided for GNU/Linux
Under GNU/Linux, GNAT is now provided as either a
compressed tar file as before, or as RPM packages which
means that the installation is simplified on various
versions of GNU/Linux, including Redhat Linux, and Debian
GNU/Linux.
NF-314-8305-003 Better folding of attributes of objects
The Alignment, Size, First, Last, Length, and
Component_Size attributes applied to objects are now
treated as compile time constants if the value can be
determined by the front end.
NF-314-8317-003 Floating-point range checks now catch
NaN's.
In GNAT, Machine_Overflows is False for floating-point
types, which means that operations such as 0.0/0.0 can
generate NaN's. The RM does not require that NaN's be
caught by subsequent range checks, but it is certainly
convenient if this is the case, and GNAT has now been
modified so that NaN's will always fail any range check and
cause Constraint_Error to be raised.
NF-314-8322-016 Program units now distinguished by gnatxref
The cross-reference section of the ali file now
distinguishes between generic and non-generic units, and
between functions, packages and procedures. The gnatxref
utility has been enhanced to take advantage of this new
information and now distinguishes these different kinds of
units in identification of entities.
NF-314-8323-004 Additional documentation on elaboration
issues.
A new section has been added to the users guide, entitled
"Additional Elaboration Order Considerations", which
discusses the issue of elaboration ordering requirements
that are not dictated by the language, but rather arise out
of extra-lingual logic requirements of the program.
NF-314-8328-012 Better handling of max size of variant
record
If a discriminant range is wider than it needs to be (e.g.
we have a Natural discriminant, which is used as the upper
bound of an array whose maximum bound is 10), then GNAT now
uses the maximum array bound in computing the maximum size
of the record, at least in most simple cases. In any case
it is a good idea to use a discriminant range that reflects
the range of actual valid values.
NF-314-8330-008 End positions of constructs now in ali file
The cross-reference information in the ALI file now
includes all labels on END lines, and also marks the end of
specs and bodies of tasks, subprograms, packages, protected
types, blocks, loops, entries and accept bodies. This
information is provided in the output from gnatxref.
NF-314-8407-012 Objects and types distinguished by gnatxref
The cross-reference output output by gnatxref distinguishes
type and object entities (for example an entity is labeled
as an "integer type" or "integer object", rather than
simply being identified as "Type: integer" in both cases).
NF-314-8409-001 Tree output can be forced with -gnatQ
-gnatt
It is now possible to force tree output using a combination
of the -gnatQ and -gnatt switches (it may also be
appropriate to use -gnatq in this context). This allows
the use of ASIS on some illegal programs, though if the
error is severe enough to cause a malformed tree, ASIS may
blow up when presented such a tree.
NF-314-8411-002 Boolean types now distinguished by gnatxref
The cross-reference section of the ali file now
distinguishes between boolean types and other enumeration
types, and the gnatxref utility has been enhanced to take
advantage of this new information and now distinguishes
these types in the entity identification information.
NF-314-8412-006 New option for gnatlink for object list
file
The switch -f for gnatlink forces the generation of a
separate file containing a list of objects for the linker,
even if the threshhold for command line length is not
exceeded. This is useful to get around some cases of
unexpectedly exceeding this limit (e.g. due to system
environment issues that reduce the limit). The switch can
only be used on targets for which linker object list files
are implemented. In addition the limit for generation of
such files on Tru Unix (Alpha) has been reduced to 10_000,
since on some systems the previous limit (30_000) was too
high.
NF-314-8412-010 New file routines in GNAT.OS_Lib
A new routine has been added into GNAT.OS_Lib to rename a
file. All routines dealing with files now have two
implementations: one using the String type and one using
an address to specify the filename. This is a general
clean up to fix inconsistencies.
NF-314-8413-005 Stream size now taken from first subtype
Previously GNAT was using the size of the base type to
determine the number of storage units for use by stream
routines for elementary types. This is now changed to meet
the new recommendations of AI-195, which suggest using the
size of the first subtype. GNAT now uses the size of the
first subtype for this determination.
NF-314-8420-006 New tasking run time under Solaris
Under Solaris Sparc, GNAT now comes with a new tasking run
time based on posix threads (rts-pthread). This run time
has the advantage of being mostly shared across all POSIX
compliant thread implementations, and also provides under
Solaris 8 the semantics of PTHREAD_PRIO_PROTECT and
PTHREAD_PRIO_INHERIT. The predefined Ceiling_Locking
policy for pragma Locking_Policy is used to specify
PTHREAD_PRIO_PROTECT, and a new implementation defined
policy, Inheritance_Locking, can be used to specify the use
of PTHREAD_PRIO_INHERIT.
NF-314-8430-004 Enhanced style checking for references
For cases in which there is a separate body entity
(packages, subprograms, entries, tasks, protected types,
accept statements, subprogram formals), the switch -gnatyr
now checks the casing of the body entity to make sure that
it is the same as that of the spec entity.
NF-314-8509-011 New package GNAT.Expect
This package provides a set of subprograms similar to what
is available with the standard Tcl Expect tool, allowing
you to easily spawn and communicate with an external
process. You can use this package to send commands or
inputs to the process, and compare the output with some
expected regular expression.
NF-314-8514-003 Improved error message for access
discriminants
When declaring a self-referential structure as a limited
record that contains a discriminated component that points
to the enclosing record, a common mistake is to define the
type of the component as having a discriminant with a
general access type, rather than as a proper access
discriminant. This results in an accessibility violation
(RM 3.10.2 (21)). The new message indicates that the error
is in the discriminant declaration itself.
NF-314-8522-001 Solaris programs do not depend on
libthread.so
On the Solaris operating system, for programs that do not
use tasking, the generated executables no longer depend on
libthread.so so that a link can be successfuly completed
without requiring this library to be present.
NF-314-8526-003 Record'Size evaluated at compile time
In the case where the size of a record type is specified
using a size representation attribute clause, the front end
now folds the attribute reference at compile time. The
result is still not a static expression, but the quality of
code is improved, and in addition, representation clauses
(such as component clauses) that require values and types
to be statically known at compile time are permitted in
additional cases as a result of this change.
^ permalink raw reply [relevance 1%]
* Re: How to get an ASCII code ?
2001-10-30 23:19 5% ` Nick Roberts
@ 2001-10-31 14:48 5% ` Marin David Condic
0 siblings, 0 replies; 200+ results
From: Marin David Condic @ 2001-10-31 14:48 UTC (permalink / raw)
That might be answering another FAQ - possibly a separate writeup? However,
your point is taken. I'll a) add a reference to Ada.Characters.Latin_1 at
the end and b) make a mention of it in the text.
If you can phrase a FAQ on that, perhaps you could submit a bit more
detailed explanation to David Boton & contribute to the FAQ?
MDC
--
Marin David Condic
Senior Software Engineer
Pace Micro Technology Americas www.pacemicro.com
Enabling the digital revolution
e-Mail: marin.condic@pacemicro.com
Web: http://www.mcondic.com/
"Nick Roberts" <nickroberts@adaos.worldonline.co.uk> wrote in message
news:9rnclj$uqhpr$1@ID-25716.news.dfncis.de...
> Yes, I think you should add that the standard package
Ada.Characters.Latin_1
> (and maybe other non-standard packages like it) can be used to get control
> characters (and esoteric characters that might not be available on one's
> keyboard).
>
>
^ permalink raw reply [relevance 5%]
* Re: How to get an ASCII code ?
@ 2001-10-30 23:19 5% ` Nick Roberts
2001-10-31 14:48 5% ` Marin David Condic
0 siblings, 1 reply; 200+ results
From: Nick Roberts @ 2001-10-30 23:19 UTC (permalink / raw)
Yes, I think you should add that the standard package Ada.Characters.Latin_1
(and maybe other non-standard packages like it) can be used to get control
characters (and esoteric characters that might not be available on one's
keyboard).
--
Nick Roberts
"Marin David Condic" <dont.bother.mcondic.auntie.spam@[acm.org> wrote in
message news:9rmg8e$ni8$1@nh.pace.co.uk...
> This one comes up a lot. I wrote this for the FAQ & sent it to David.
> Anybody see anything that should be added/changed?
^ permalink raw reply [relevance 5%]
* String manupulation (again) - free software
@ 2001-08-23 12:15 5% Reinert Korsnes
0 siblings, 0 replies; 200+ results
From: Reinert Korsnes @ 2001-08-23 12:15 UTC (permalink / raw)
Hi,
Enclosed is a simple package to split character strings
into substrings consisting of continuous sequences of letters or
groups of characters bounded by Quotation (so "abc def, ghijk"
is one "word"). Not that this may be so interesting, but it could
be useful for me get this improved/criticized. At least I can
learn some Ada from this.....
Below is also a test program for this package.
(package spec not included).
reinert
-----------------------------------------------
-- Author: R.Korsnes, with help from comp.lang.ada :-) 23 August 2001.
with Ada.Text_IO;
use Ada.Text_IO;
with Ada.Integer_Text_IO,Ada.Strings.Fixed,Ada.Strings.Maps;
with Ada.Characters.Latin_1;
use Ada.Characters.Latin_1;
package body Rsplit is
use Ada.Integer_Text_IO;
use Ada.Strings,Ada.Strings.Fixed,Ada.Strings.Maps;
Set : constant Character_Set := To_Set(" ," & HT);
function Number_Of_Words(FS : String) return Integer is
N : Natural := 0;
First : Natural := FS'First;
Last : Natural;
begin
loop
Find_Token(Source => FS(First..FS'Last),
Set => Set,
Test => Ada.Strings.Outside,
First => First,
Last => Last);
exit when Last = 0;
if FS(First) = Quotation then
Last := Index(Source => FS(First+1..FS'Last),
Set => To_Set(Quotation));
end if;
N := N + 1;
First := Last + 1;
end loop;
Return N;
end Number_Of_Words;
function Word(FS : String;Word_Number : Integer) return String is
N : Natural := 0;
First : Natural := FS'First;
Last : Natural;
begin
loop
Find_Token(Source => FS(First..FS'Last),
Set => Set,
Test => Ada.Strings.Outside,
First => First,
Last => Last);
exit when Last = 0;
if FS(First) = Quotation then
Last := Index(Source => FS(First+1..FS'Last),
Set => To_Set(Quotation));
end if;
N := N + 1;
if Word_Number = N then
return FS(First .. Last);
end if;
First := Last+1;
end loop;
Return "";
end Word;
end rsplit;
----------------------------
Test program:
with rsplit;
with Text_IO,Ada.Strings.Fixed,Ada.Strings.Maps,Ada.Characters.Latin_1;
with Ada.Integer_Text_IO;
use Text_IO,Ada.Strings,Ada.Strings.Fixed,Ada.Strings.Maps;
use Ada.Characters.Latin_1;
use Ada.Integer_Text_IO;
procedure rstring is
FS : constant String :=
" This " & Quotation & " is a test"
& Quotation & " to " & Quotation &
"split a string" & Quotation & " ";
C1 : constant String := "123456789012345678901234567890123456";
begin
Put(C1);New_Line;
Put(FS);New_Line;
for I in 1 .. Rsplit.Number_Of_Words(FS) loop
New_Line;
Put(I); Put(" ");Put(" "); Put(Rsplit.Word(FS,I));
end loop;
end rstring;
--
http://home.chello.no/~rkorsnes
^ permalink raw reply [relevance 5%]
* RE: Cannot use NULL as identifier?
@ 2001-06-04 22:48 4% Beard, Frank
0 siblings, 0 replies; 200+ results
From: Beard, Frank @ 2001-06-04 22:48 UTC (permalink / raw)
To: 'comp.lang.ada@ada.eu.org'
-----Original Message-----
From: Robert A Duff [mailto:bobduff@world.std.com]
"Beard, Frank" <beardf@spawar.navy.mil> writes:
>> Well, I saw it referenced somewhere, and Ben
>> confirmed it. I think it was the same reason
>> type Character was expanded from 128 to 256.
>
>Not sure what "it" Ben confirmed...
The extension of ASCII from 128 to 256 characters.
>> In any event, the first 128 characters are
>> never going to change. So, worse case, I'll
>> cut and paste the current ASCII package and
>> paste it into my own "My_ASCII" package and
>> do a library level rename. It will probably
>> have all the character constants I will ever
>> need. Or I could be lazy and make ASCII
>> rename Latin_1.
>
>It is illegal to have a library unit called ASCII.
>(And I'll bet you it will always be illegal.)
Seems like something would have happened by now
if this were true.
>> And, if I turns out that I am wrong, then in
>> twenty years, when it finally goes away, I'll
>> admit you're right. :-)
>
>Package ASCII will never go away, so long as there
>is an Ada standard.
I agree with you. I don't think it will ever go
away either, but the LRM did indicate that it
probably would.
So, I think everyone's concerns were valid.
And if you don't mind using the
Ada.Characters.Latin_1, more power to you.
Frank
^ permalink raw reply [relevance 4%]
* Re: Cannot use NULL as identifier?
2001-05-30 21:45 5% Beard, Frank
@ 2001-05-31 14:53 0% ` John English
0 siblings, 0 replies; 200+ results
From: John English @ 2001-05-31 14:53 UTC (permalink / raw)
"Beard, Frank" wrote:
> Even if [ASCII] does become obsolete, it is a relatively
> simply global substitute to replace "ASCII" with
> "Ada.Characters.Latin_1.Nul", or do a library level rename.
You'd also have to put "with ASCII" in front of the relevant units,
since it would then be a normal package rather than part of Standard.
-----------------------------------------------------------------
John English | mailto:je@brighton.ac.uk
Senior Lecturer | http://www.comp.it.bton.ac.uk/je
Dept. of Computing | ** NON-PROFIT CD FOR CS STUDENTS **
University of Brighton | -- see http://burks.bton.ac.uk
-----------------------------------------------------------------
^ permalink raw reply [relevance 0%]
* Re: Cannot use NULL as identifier?
2001-05-30 13:52 3% ` Marin David Condic
@ 2001-05-31 10:49 0% ` McDoobie
0 siblings, 0 replies; 200+ results
From: McDoobie @ 2001-05-31 10:49 UTC (permalink / raw)
In article <9f2tuk$hbg$1@nh.pace.co.uk>, "Marin David Condic"
<marin.condic.auntie.spam@pacemicro.com> wrote:
> Null is a reserved word in Ada - used as a null statement and as a value
> for access types, etc. You can't use it as an identifier.
>
> What you probably want is ASCII.Nul - notice only one 'l'.
>
> Also, unless you are interfacing to some C/C++ routines, you do not need
> to terminate strings with Nul. You are much better off using the
> attributes
> 'First, 'Last, 'Range, etc. along with the string handling routines
> you'll
> find in Ada.Strings, Ada.Strings.Fixed, Ada.Strings.Bounded,
> Ada.Strings.Unbounded. (My personal favorite is to use
> Ada.Strings.Unbounded for just about everything. It will have some
> speed/space penalties over fixed strings, but you'd really have to have
> an intense application to start noticing the difference.)
>
> BTW, you probably don't want to use the package ASCII since it is
> falling out of vogue and may eventually go away. More appropriately, you
> should use Ada.Characters.Latin_1 which also contains a constant called
> "Nul".
>
> If you have not done so already, you will want to get hold of an Ada95
> Reference Manual (plenty of electronic sources). To really get all the
> benefits of Ada, you'll want to look over all the appendices and at
> least be cognizant of the language defined packages and what they
> contain. That way, when you need a resource (like character constants,
> math routines, string manipulation, etc.) you'll at least have a vague
> memory of what is available and know where to look for more help. I
> repeatedly find myself in there digging up routines to leverage someone
> else's work! :-)
>
> MDC
> --
> Marin David Condic Senior Software Engineer Pace Micro Technology
> Americas www.pacemicro.com Enabling the digital revolution e-Mail:
> marin.condic@pacemicro.com Web: http://www.mcondic.com/
>
Thanks for your reply. I have duly noted the difference between 'NUL' and
'NULL' thanks to the many replies pointing out that goof up. Also, I will be
spending some time exploring the Latin_1 package in detail, as well as
exploring the internals of the Ada system much more thoroughly.
I've recently purchased an Ada textbook, so I should proceed much more
rapidly now.
And yes, I was interfacing with the GNU glibc libraries. glibc 2.2 to be exact.
I wonder if it would make more sense to just put all my glibc interfaces
into an Ada package and then use them that way. However, I'm also
aware that there are Posix bindings already available, and so I'm tempted to
say that it would make more sense to use those instead. However, as I am
relatively inexperienced in the whole OOP paradigm (coming from a C and
x86 ASM background) I cant yet say for sure what the best route would be.
Back to the books I guess. ;->
Thanks again for all the replies.
McDoobie
chris@dont.spam.me
^ permalink raw reply [relevance 0%]
* RE: Cannot use NULL as identifier?
@ 2001-05-30 21:45 5% Beard, Frank
2001-05-31 14:53 0% ` John English
0 siblings, 1 reply; 200+ results
From: Beard, Frank @ 2001-05-30 21:45 UTC (permalink / raw)
To: 'comp.lang.ada@ada.eu.org'
-----Original Message-----
From: Ted Dennison [mailto:dennison@telepath.com]
> 3) The package ASCII is obsolescent, so I wouldn't use
> it in new code if I were you. You should be using
> "Ada.Characters.Latin_1.Nul".
As Ben Brosgol pointed out, ASCII was obsolescent before
the ASCII standard was expanded to include characters 128
through 255. So, the odds of ASCII becoming obsolete are
slim to none. So, I wouldn't worry too much about whether
or not to use ASCII.
Even if it does become obsolete, it is a relatively
simply global substitute to replace "ASCII" with
"Ada.Characters.Latin_1.Nul", or do a library level rename.
Besides "Ada.Characters.Latin_1.Nul" being ugly to look at,
if for nothing else, I will continue to use ASCII to avoid
the lame analogies of Latin to Ada made by some of the C++
hacks ("A dead language for a dead language").
Frank
^ permalink raw reply [relevance 5%]
* Re: Cannot use NULL as identifier?
` (2 preceding siblings ...)
2001-05-30 13:33 5% ` Petter Fryklund
@ 2001-05-30 13:52 3% ` Marin David Condic
2001-05-31 10:49 0% ` McDoobie
3 siblings, 1 reply; 200+ results
From: Marin David Condic @ 2001-05-30 13:52 UTC (permalink / raw)
Null is a reserved word in Ada - used as a null statement and as a value for
access types, etc. You can't use it as an identifier.
What you probably want is ASCII.Nul - notice only one 'l'.
Also, unless you are interfacing to some C/C++ routines, you do not need to
terminate strings with Nul. You are much better off using the attributes
'First, 'Last, 'Range, etc. along with the string handling routines you'll
find in Ada.Strings, Ada.Strings.Fixed, Ada.Strings.Bounded,
Ada.Strings.Unbounded. (My personal favorite is to use Ada.Strings.Unbounded
for just about everything. It will have some speed/space penalties over
fixed strings, but you'd really have to have an intense application to start
noticing the difference.)
BTW, you probably don't want to use the package ASCII since it is falling
out of vogue and may eventually go away. More appropriately, you should use
Ada.Characters.Latin_1 which also contains a constant called "Nul".
If you have not done so already, you will want to get hold of an Ada95
Reference Manual (plenty of electronic sources). To really get all the
benefits of Ada, you'll want to look over all the appendices and at least be
cognizant of the language defined packages and what they contain. That way,
when you need a resource (like character constants, math routines, string
manipulation, etc.) you'll at least have a vague memory of what is available
and know where to look for more help. I repeatedly find myself in there
digging up routines to leverage someone else's work! :-)
MDC
--
Marin David Condic
Senior Software Engineer
Pace Micro Technology Americas www.pacemicro.com
Enabling the digital revolution
e-Mail: marin.condic@pacemicro.com
Web: http://www.mcondic.com/
"McDoobie" <someone@nospam.net> wrote in message
news:Ad6R6.1259$DG1.337725@news1.rdc1.mi.home.com...
> I've written a small program that parses the contents of different
> directories and searches for duplicate files.
>
> I have an assignment that reads
>
> FilePath : constant string := "tesfile.xxx" & ASCII.NULL;
>
> Now, the GNAT compiler on Linux gives me the error
> "reserved word NULL cannot be used as identifier "
>
> Now, I'm using the text_io and gnat.os_lib libraries to compile this, so
> I'm assuming that os_lib makes an allowance for this. However, I could be
> mistaken. I ripped the above code fragement from a website, and the
> website (the Big Book of Linux Ada programming) doesnt appear to indicate
> that theres a problem with this. (Of course I probably overlooked
> something.)
>
> I'm also searching through "Programming in Ada95"(Barnes) trying to find
> info on this error.
>
> Any tips or pointers would be helpful.
>
> Thanks.
>
> McDoobie
> Chris@dont.spam.me
^ permalink raw reply [relevance 3%]
* Re: Cannot use NULL as identifier?
2001-05-30 13:22 4% ` Ted Dennison
2001-05-30 13:32 5% ` Martin Dowie
@ 2001-05-30 13:33 5% ` Petter Fryklund
2001-05-30 13:52 3% ` Marin David Condic
3 siblings, 0 replies; 200+ results
From: Petter Fryklund @ 2001-05-30 13:33 UTC (permalink / raw)
This is perhaps not the best and most efficient solution, but it works:
with Ada.Characters.Latin_1;
...
...
FilePath : constant string := "tesfile.xxx" & Ada.Characters.Latin_1.Nul;
McDoobie wrote in message ...
>I've written a small program that parses the contents of different
>directories and searches for duplicate files.
>
>I have an assignment that reads
>
>FilePath : constant string := "tesfile.xxx" & ASCII.NULL;
>
>Now, the GNAT compiler on Linux gives me the error
>"reserved word NULL cannot be used as identifier "
>
>Now, I'm using the text_io and gnat.os_lib libraries to compile this, so
>I'm assuming that os_lib makes an allowance for this. However, I could be
>mistaken. I ripped the above code fragement from a website, and the
>website (the Big Book of Linux Ada programming) doesnt appear to indicate
>that theres a problem with this. (Of course I probably overlooked
>something.)
>
>I'm also searching through "Programming in Ada95"(Barnes) trying to find
>info on this error.
>
>Any tips or pointers would be helpful.
>
>Thanks.
>
>McDoobie
>Chris@dont.spam.me
^ permalink raw reply [relevance 5%]
* Re: Cannot use NULL as identifier?
2001-05-30 13:22 4% ` Ted Dennison
@ 2001-05-30 13:32 5% ` Martin Dowie
2001-05-30 13:33 5% ` Petter Fryklund
2001-05-30 13:52 3% ` Marin David Condic
3 siblings, 0 replies; 200+ results
From: Martin Dowie @ 2001-05-30 13:32 UTC (permalink / raw)
ASCII is an obsolete package, use Ada.Characters.Latin_1 instead.
The other problem you have is 'NULL' with 2 'L' characters. So what
you need is:
FilePath : constant string := "tesfile.xxx" & Ada.Characters.Latin_1.Nul;
Alternatively, it looks like you're trying to do things in a 'C'-way,
or interface with some 'C' routines, so have a look at Interfaces.C (and
maybe Interfaces.C.Strings) to find routines to create nul-terminated
strings.
Enjoy!
McDoobie <someone@nospam.net> wrote in message
news:Ad6R6.1259$DG1.337725@news1.rdc1.mi.home.com...
> I've written a small program that parses the contents of different
> directories and searches for duplicate files.
>
> I have an assignment that reads
>
> FilePath : constant string := "tesfile.xxx" & ASCII.NULL;
>
> Now, the GNAT compiler on Linux gives me the error
> "reserved word NULL cannot be used as identifier "
>
> Now, I'm using the text_io and gnat.os_lib libraries to compile this, so
> I'm assuming that os_lib makes an allowance for this. However, I could be
> mistaken. I ripped the above code fragement from a website, and the
> website (the Big Book of Linux Ada programming) doesnt appear to indicate
> that theres a problem with this. (Of course I probably overlooked
> something.)
>
> I'm also searching through "Programming in Ada95"(Barnes) trying to find
> info on this error.
>
> Any tips or pointers would be helpful.
>
> Thanks.
>
> McDoobie
> Chris@dont.spam.me
^ permalink raw reply [relevance 5%]
* Re: Cannot use NULL as identifier?
@ 2001-05-30 13:22 4% ` Ted Dennison
2001-05-30 13:32 5% ` Martin Dowie
` (2 subsequent siblings)
3 siblings, 0 replies; 200+ results
From: Ted Dennison @ 2001-05-30 13:22 UTC (permalink / raw)
In article <Ad6R6.1259$DG1.337725@news1.rdc1.mi.home.com>, McDoobie says...
>
>FilePath : constant string := "tesfile.xxx" & ASCII.NULL;
>
>Now, the GNAT compiler on Linux gives me the error
>"reserved word NULL cannot be used as identifier "
OK. There are 3 issues here:
1) "null" is a keyword. It is used for "null" statements, and as a default
value for access objects. You can't create a variable with that name any more
than you can create a variable named "if".
2) The value you are looking for is "ASCII.NUL", not "ASCII.NULL". (A quick
check of the package specification would have told you this.
3) The package ASCII is obsolescent, so I wouldn't use it in new code if I were
you. You should be using "Ada.Characters.Latin_1.Nul".
---
T.E.D. homepage - http://www.telepath.com/dennison/Ted/TED.html
home email - mailto:dennison@telepath.com
^ permalink raw reply [relevance 4%]
* Re: Return value of system call (newbie question)
@ 2001-05-16 16:08 3% ` Jeffrey Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2001-05-16 16:08 UTC (permalink / raw)
Torbj�rn Karfunkel wrote:
>
> I'm executing an external program from within an Ada program by using
>
> function OtterCall(Value : String) return Integer;
> pragma Import(C, OtterCall, "system");
>
> The program that is called upon, Otter, is called with the syntax
>
> otter <input-file> output-file
>
> and the calls look like this (several calls to each are made)
>
> Result := OtterCall(Value =>
> ("/home/toka/otter/otter-3.0.6/source/otter " &
> "<
> /home/toka/exjobb/model_checker/nyare/" &
> ("sat" &
> Natural'Image(K)(2..Natural'Image(K)'Last) & ".in") &
> " >
> /home/toka/exjobb/model_checker/nyare/" &
> ("satresult" &
> Natural'Image(K)(2..Natural'Image(K)'Last) & ".oout")));
>
> Result := OtterCall(Value =>
> ("/home/toka/otter/otter-3.0.6/source/otter " &
> "<
> /home/toka/exjobb/model_checker/nyare/" &
> ("taut" &
> Natural'Image(K)(2..Natural'Image(K)'Last) & ".in") &
> " >
> /home/toka/exjobb/model_checker/nyare/" &
> ("tautresult" &
> Natural'Image(K)(2..Natural'Image(K)'Last) & ".oout")));
>
> Two problems have arisen:
> 1) The first call to otter was executed normally and produced the
> outfile satresult0.oout,
> but the second call, which I thought would produce the outfile
> tautresult0.oout, produced
> an outfile named tautresult0.oout0.oout.
> It seems that some part of the Value string from the previous call
> is appended to the end
> of the next. I solved this problem by appending a sequence of
> blanks to the end of the Value
> strings, but this seems unnecessary. Could anyone give an
> explanation to this behavior?
I suspect this is caused because you are not NUL terminating your
strings. The C "system" function takes a C string (a pointer to the 1st
character of a NUL-terminated string). Pragma Import will take care of
providing the pointer to C, but will not add the NUL.
If we simplify your code a bit:
Program_Path : constant String :=
"/home/toka/otter/otter-3.0.6/source/otter";
File_Path : constant String :=
"/home/toka/exjobb/model_checker/nyare/";
function Image_NLB (Value : Natural) return String is
Image : constant String := Natural'Image (Value);
begin -- Image_NLB
return Image (Image'First + 1 .. Image'Last);
end Image_NLB;
function In_Name (Prefix : String; Number : Natural) return String is
-- null;
begin -- In_Name
return File_Path & Prefix & Image_NLB (Number) & ".in";
end In_Name;
function Out_Name (Prefix : String; Number : Natural) return String is
-- null;
begin -- Out_Name
return File_Path & Prefix & Image_NLB (Number) & ".oout";
end Out_Name;
Result := Ottercall (Program_Path &
" < " &
In_Name ("sat", K) &
" > " &
Out_Name ("satresult", K) &
Ada.Characters.Latin_1.NUL);
This should correct the problem. You could also use
"Interfaces.C.Char_Array" in place of "String" in your specification of
Ottercall, and convert your strings using function Interfaces.C.To_C:
Result := Ottercall (Interfaces.C.To_C (Program_Path &
" < " &
In_Name ("sat", K) &
" > " &
Out_Name ("satresult", K) ) );
--
Jeffrey Carter
^ permalink raw reply [relevance 3%]
* Optimization Question
@ 2001-01-22 0:05 5% dvdeug
0 siblings, 0 replies; 200+ results
From: dvdeug @ 2001-01-22 0:05 UTC (permalink / raw)
I'm trying to write a program similar to the Unix utility strings, as my
copy of strings refuses to run a 17GB file. It seems to work, but it's
about 10x slower than strings, and rough calculations puts running time
on that 17GB file at 10 hours. I'm running the woody Debian version of
GNAT (3.13) on i686-linux-gnu, and I compiled the program with gnatmake
-g -gnatwa -gnatpn -Wall -W -O3 strings.adb. Is there anything I've
missed that speed this program a lot? (It's been run through gcov, so
the numbers up front are execution counts.)
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Sequential_IO;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO;
2 procedure Strings is
1 type Byte is mod 2 ** 8;
package Byte_IO is new Ada.Sequential_IO (Byte);
use Byte_IO;
56710 function String_Charp (A : Character) return Boolean
is
begin
56710 return Is_ISO_646 (A) and then
(Is_Graphic (A) or else A = HT or else A = LF or else A = CR);
end String_Charp;
pragma Inline (String_Charp);
1 Binary_File : File_Type;
1 Letter_Buffer : String (1 .. 4);
subtype Buffer_Size is Integer range 0 .. 4;
1 Letters_Found : Buffer_Size := 0;
1 Current_Char : Byte;
1 Seperating_String : constant String := (LF, NUL);
begin
1 if Argument_Count /= 1 then
###### Set_Exit_Status (1);
###### Ada.Text_IO.Put ("One file name only!");
###### return;
end if;
1 Open (Binary_File, In_File, Argument(1));
56711 loop
56711 Read (Binary_File, Current_Char);
56710 if String_Charp (Character'Val (Current_Char))
then
29610 if Letters_Found < 4 then
8453 Letters_Found := Letters_Found + 1;
8453 Letter_Buffer (Letters_Found) :=
Character'Val (Current_Char);
8453 if Letters_Found = 4 then
916 Ada.Text_IO.Put (Letter_Buffer);
end if;
else
21157 Ada.Text_IO.Put (Character'Val
(Current_Char));
end if;
else
27100 if Letters_Found = 4 then
916 Ada.Text_IO.Put (Seperating_String);
end if;
27100 Letters_Found := 0;
end if;
end loop;
###### Ada.Text_IO.Put ("Invalid end!");
###### Set_Exit_Status (2);
exception
1 when End_Error =>
1 Close (Binary_File);
###### when others =>
###### raise;
end Strings;
--
David Starner - dstarner98@aasaa.ofe.org
Sent via Deja.com
http://www.deja.com/
^ permalink raw reply [relevance 5%]
* Re: ada printing
@ 2000-12-31 11:11 6% rasser
0 siblings, 0 replies; 200+ results
From: rasser @ 2000-12-31 11:11 UTC (permalink / raw)
To: comp.lang.ada
This should work from for Win98, DOSbox or not. Use "LPT1" in "Open"
instead of "PRN" if you like result is the same with only one printer
port.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Latin_1; use Ada.Characters;
procedure Test_Prn is
Outf : File_Type;
begin
Open (Outf, Out_File, "PRN");
Put (Outf, "This is printed on PRN....");
Put (Outf, Latin_1.LF & Latin_1.CR);
Close (Outf);
end Test_Prn;
^ permalink raw reply [relevance 6%]
* Win32.Commdlg.GetOpenFileName problem - Gnat bug?
@ 2000-11-20 5:36 3% Christoph Grein
0 siblings, 0 replies; 200+ results
From: Christoph Grein @ 2000-11-20 5:36 UTC (permalink / raw)
To: comp.lang.ada; +Cc: Christ-Usch.Grein
Hi everyone listening,
I'm having a problem on Win98 with Gnat 3.13.p. I wrote the following
package following an example in AdaPower. Function Get_File_Name opens the
wellknown Open window where to select a file.
Now if I use the function call as a constant (see procedure Test_Gnat_Bug),
everything works, but if I use it as a renames, it produces empty output.
(In Ada95, function calls are objects, which are renamable; in Ada83, they
were not. Renaming saves an extra copy.)
Is this a gnat bug or an inherent win32 feature? I have been struggling with
funny effects for a while, until I found the reason by pure coincidence.
gnatchop here
-----------------------------------------------------------------------------
with Ada.Strings.Unbounded;
package Gnat_Bug is
subtype Unbounded_String is Ada.Strings.Unbounded.Unbounded_String;
function To_Unbounded_String (Item: String) return Unbounded_String
renames Ada.Strings.Unbounded.To_Unbounded_String;
function To_String (Item: Unbounded_String) return String
renames Ada.Strings.Unbounded.To_String;
----------------------------------------------------------------------
type File_Name is record
Extended, Simple: Unbounded_String; -- with and without path
end record;
type Filter_Definition is record
Name, Pattern: Unbounded_String;
end record;
type Filter is array (Positive range <>) of Filter_Definition;
All_Files_Filter: constant Filter_Definition :=
(To_Unbounded_String ("All files"),
To_Unbounded_String ("*.*"));
Default_Filter: constant Filter := (1 => All_Files_Filter);
function Get_File_Name (Purpose : String;
Selectable_Files : Filter := Default_Filter;
Default_Selection: Natural := 0;
Default_Extension: String := "";
Initial_Directory: String := "")
return File_Name;
Failure: exception;
end Gnat_Bug;
with Ada.Characters.Latin_1;
with Ada.Unchecked_Conversion;
with System;
with Interfaces.C;
use Interfaces.C;
with Win32.Commdlg, Win32.WinMain;
package body Gnat_Bug is
function To_LPSTR is
new Ada.Unchecked_Conversion (System.Address, Win32.LPSTR);
function To_LPCSTR is
new Ada.Unchecked_Conversion (System.Address, Win32.LPCSTR);
use type Win32.BOOL;
function To_WinFilter (Given: Filter) return Char_Array is
-- To define a filter for the file names use:
-- {Name & nul & Pattern & nul &} & nul & nul
Result: Unbounded_String;
NUL: Character renames Ada.Characters.Latin_1.NUL;
use type Ada.Strings.Unbounded.Unbounded_String;
begin
for F in Given'Range loop
Result := Result & Given (F).Name & NUL & Given (F).Pattern & NUL;
end loop;
return To_C (To_String (Result) & NUL & NUL);
end To_WinFilter;
function Get_File_Name (Purpose : String;
Selectable_Files : Filter := Default_Filter;
Default_Selection: Natural := 0;
Default_Extension: String := "";
Initial_Directory: String := "")
return File_Name is
tmpOpenFileStruc: aliased Win32.Commdlg.OPENFILENAME;
szFile : Char_Array (0..255) := (others => nul);
szFileTitle : Char_Array (0..255) := (others => nul);
szTitle : constant Char_Array := To_C (Purpose);
szFilter : constant Char_Array :=
To_WinFilter (Selectable_Files);
szDefExt : constant Char_Array := To_C (Default_Extension);
szDirectory : constant Char_Array := To_C (Initial_Directory);
Default: Positive;
Result: Win32.BOOL;
begin
if Default_Selection in Selectable_Files'Range then
Default := Default_Selection;
elsif Default_Selection = 0 then
Default := Selectable_Files'First;
else
Default := Selectable_Files'Last;
end if;
tmpOpenFileStruc.lStructSize := (Win32.Commdlg.OPENFILENAME'Size + 1)/
System.Storage_Unit;
tmpOpenFileStruc.hwndOwner := System.Null_Address;
tmpOpenFileStruc.hInstance := Win32.WinMain.Get_Hinstance;
tmpOpenFileStruc.lpstrFilter := To_LPCSTR (szFilter'Address);
tmpOpenFileStruc.lpstrCustomFilter := null;
tmpOpenFileStruc.nMaxCustFilter := 0;
tmpOpenFileStruc.nFilterIndex := Integer'Pos (Default);
tmpOpenFileStruc.lpstrFile := To_LPSTR (szFile'Address);
tmpOpenFileStruc.nMaxFile := szFile'Length;
tmpOpenFileStruc.lpstrFileTitle := To_LPSTR (szFileTitle'Address);
tmpOpenFileStruc.nMaxFileTitle := szFileTitle'Length;
tmpOpenFileStruc.lpstrInitialDir := To_LPCSTR (szDirectory'Address);
tmpOpenFileStruc.lpstrTitle := To_LPCSTR (szTitle'Address);
tmpOpenFileStruc.nFileOffset := 0;
tmpOpenFileStruc.nFileExtension := 0;
tmpOpenFileStruc.lpstrDefExt := To_LPCSTR (szDefExt'Address);
tmpOpenFileStruc.lCustData := 0;
tmpOpenFileStruc.lpfnHook := null;
tmpOpenFileStruc.lpTemplateName := null;
tmpOpenFileStruc.Flags := 0;
Result := Win32.Commdlg.GetOpenFileName (tmpOpenFileStruc'Unchecked_Access);
if Result = Win32.False then
raise Failure;
-- Use the API call CommDlgExtendedError for more information.
end if;
return (Extended => To_Unbounded_String (To_Ada (szFile)),
Simple => To_Unbounded_String (To_Ada (szFileTitle)));
end Get_File_Name;
end Gnat_Bug;
with Ada.Text_IO;
use Ada.Text_IO;
with Gnat_Bug;
use Gnat_Bug;
procedure Test_Gnat_Bug is
begin
declare -- this works, i.e. prints the file
File_Name: constant Gnat_Bug.File_Name :=
Get_File_Name (Purpose => "Open test with constant",
Default_Selection => 4);
begin
Put_Line ("Open selection extended name => " &
To_String (File_Name.Extended));
Put_Line (" simple name => " &
To_String (File_Name.Simple));
exception
when Failure => Put_Line ("Open Failure");
end;
declare -- this does not work, i.e. produces an empty output
File_Name: Gnat_Bug.File_Name renames
Get_File_Name (Purpose => "Open test with renames",
Default_Selection => 4);
begin
Put_Line ("Open selection extended name => " &
To_String (File_Name.Extended));
Put_Line (" simple name => " &
To_String (File_Name.Simple));
exception
when Failure => Put_Line ("Open Failure");
end;
end Test_Gnat_Bug;
^ permalink raw reply [relevance 3%]
* Re: Escape Sequences in Strings
@ 2000-11-16 0:00 7% ` Ken Garlington
2000-11-16 0:00 5% ` Marin David Condic
2000-11-16 0:00 4% ` Keith Thompson
0 siblings, 2 replies; 200+ results
From: Ken Garlington @ 2000-11-16 0:00 UTC (permalink / raw)
"Tarjei T. Jensen" <tarjei.jensen@kvaerner.com> wrote in message
news:8v0m76$1mt1@news.kvaerner.com...
:
: John English
: >Hey guys, I agree completely, but I wanted to give a *short* answer,
: >not a complete package hierarchy with all the trimmings... and I
: >said it wasn't the way to go anyway... Give us a break!
:
: Perhaps even worse, it may not be what the person wanted to know. It is
more
: likely that he wanted to know about the equivalent of the C escape
characters
: like \n, \r, \a, \t, \oxXX, etc.
Character C_Escape_Sequence Ada_Equivalent
" \" "" or Ada.Characters.Latin_1.Quotation
' \' ' or Ada.Characters.Latin_1.Apostrophe
? \? ? or Ada.Characters.Latin_1.Question
\ \\ \ or Ada.Characters.Latin_1.Reverse_Solidus
BEL \a Ada.Characters.Latin_1.BEL
BS \b Ada.Characters.Latin_1.BS
FF \f Ada.Characters.Latin_1.FF
NL \n Ada.Characters.Latin_1.NL
CR \r Ada.Characters.Latin_1.CR
HT \t Ada.Characters.Latin_1.HT
VT \v Ada.Characters.Latin_1.VT
octal \ddd Character'Val(8#ddd#)
hex \xhh Character'Val(16#hh#)
For Ada83 compilers, ASCII can be used in lieu of Ada.Characters.Latin_1 in
most cases (with Query for Question and Back_Slash for Reverse_Solidus).
^ permalink raw reply [relevance 7%]
* Re: Escape Sequences in Strings
2000-11-16 0:00 7% ` Ken Garlington
@ 2000-11-16 0:00 5% ` Marin David Condic
2000-11-16 0:00 4% ` Keith Thompson
1 sibling, 0 replies; 200+ results
From: Marin David Condic @ 2000-11-16 0:00 UTC (permalink / raw)
Ken Garlington wrote:
> Character C_Escape_Sequence Ada_Equivalent
> " \" "" or Ada.Characters.Latin_1.Quotation
> ' \' ' or Ada.Characters.Latin_1.Apostrophe
> ? \? ? or Ada.Characters.Latin_1.Question
> \ \\ \ or Ada.Characters.Latin_1.Reverse_Solidus
> BEL \a Ada.Characters.Latin_1.BEL
> BS \b Ada.Characters.Latin_1.BS
> FF \f Ada.Characters.Latin_1.FF
> NL \n Ada.Characters.Latin_1.NL
> CR \r Ada.Characters.Latin_1.CR
> HT \t Ada.Characters.Latin_1.HT
> VT \v Ada.Characters.Latin_1.VT
> octal \ddd Character'Val(8#ddd#)
> hex \xhh Character'Val(16#hh#)
And you can even avoid the verbosity (if desired) using a "use" clause as in:
with Ada.Characters.Latin_1 ;
use Ada.Characters.Latin_1 ;
procedure Demo is
Some_String : constant String := "Ring the bell: " & BEL & "New Page:
" & FF ;
begin
null ;
end Demo ;
Its pretty obvious to us Ada Old Timers, but a newbie might see "Ring the
bell: " & Ada.Characters.Latin_1.BEL as so needlessly verbose that they'll run
off telling everyone that Ada sucks because they can't write "Ring the bell:
\a". If it were true, they'd have a point.
Just a small thing - but often something we forget.
MDC
--
======================================================================
Marin David Condic - Quadrus Corporation - http://www.quadruscorp.com/
Send Replies To: m c o n d i c @ q u a d r u s c o r p . c o m
Visit my web site at: http://www.mcondic.com/
"Giving money and power to Government is like giving whiskey
and car keys to teenage boys."
-- P. J. O'Rourke
======================================================================
^ permalink raw reply [relevance 5%]
* Re: Escape Sequences in Strings
2000-11-16 0:00 7% ` Ken Garlington
2000-11-16 0:00 5% ` Marin David Condic
@ 2000-11-16 0:00 4% ` Keith Thompson
1 sibling, 0 replies; 200+ results
From: Keith Thompson @ 2000-11-16 0:00 UTC (permalink / raw)
"Ken Garlington" <Ken.Garlington@computer.org> writes:
[...]
> NL \n Ada.Characters.Latin_1.NL
There is no Ada.Characters.Latin_1.NL. The C '\n' character is most
commonly LF (linefeed). In general, it's whatever acts as a newline
character on the current system. On some systems, the I/O subsystem
has to map '\n' to a CR LF sequence on output, and do the reverse
mapping on input.
--
Keith Thompson (The_Other_Keith) kst@cts.com <http://www.ghoti.net/~kst>
San Diego Supercomputer Center <*> <http://www.sdsc.edu/~kst>
Welcome to the last year of the 20th century.
^ permalink raw reply [relevance 4%]
* Re: Escape Sequences in Strings
@ 2000-11-15 0:00 4% ` Marin David Condic
1 sibling, 0 replies; 200+ results
From: Marin David Condic @ 2000-11-15 0:00 UTC (permalink / raw)
Jean Cohen wrote:
> (by the way, I like the concept of streams in C++.)
>
Ada has streams and stream I/O as well. It works pretty well and I think if
you get familiar enough with Ada to understand "The Ada Way" of doing it,
you'll find it to be a handy feature.
>
> My question is then - How is it possible to use escape sequences (or
> something
> functionally equivalent) in Ada 95?
Escape sequences are just a series of characters in Ada, pretty much as they
are in C/C++. You can include non-printable characters into a string by using
the constants defined in the package Ada.Characters.Latin_1. See Appendix
A.3.3 of the ARM for the full list.
However, you might find it easier to shop around for an existing package to do
all your cursor moving for you. Start cruising around http://www.Adapower.com/
for reusable components and links to other Ada sites. I'm sure someone here
will point you at more than one package to do this job for you.
MDC
--
======================================================================
Marin David Condic - Quadrus Corporation - http://www.quadruscorp.com/
Send Replies To: m c o n d i c @ q u a d r u s c o r p . c o m
Visit my web site at: http://www.mcondic.com/
"Giving money and power to Government is like giving whiskey
and car keys to teenage boys."
-- P. J. O'Rourke
======================================================================
^ permalink raw reply [relevance 4%]
* Re: Case Sensitivity
@ 2000-05-11 0:00 5% ` Ted Dennison
0 siblings, 0 replies; 200+ results
From: Ted Dennison @ 2000-05-11 0:00 UTC (permalink / raw)
In article <958056490.47876@hearts.q-net.net.au>,
"Cameron McShane" <cazza@aceonline.com.au> wrote:
> Hey
>
> I am doing a project for Uni, and am a bit stuck.
>
> We need a menu that needs to be case-'in'sensitive. I am using an
enumerated
> data type for the 3 menu options ie:
>
> type Menu_Options is (buy, read, done)
>
> If the user is to be allowed to enter Buy or BUY or bUy - etc, do I
need to
> make the data type
>
> type Menu_Options is (buy, Buy, bUY, etc
>
> or is there a way of converting user input to all lower case?
Yes.
In the Latin_1 character collating sequence, it just so happens that the
characters 'a' through 'z' all have the same relative position to each
other as the characters 'A' through 'Z'. The lower-case letters have a
larger value than the upper case letters. (See Ada.Characters.Latin_1)
So the traditional manual way to do this would be to find the difference
in the integer position of an upper case character from that of its
lower-case counterpart (eg: 'A' and 'a'). Then you can add that
difference to the integer position of every upper-case letter you
encounter. Then you just need to find the character value for that
resulting integer position. There are predefined attributes that you can
apply to characters to convert between their character value and their
integer position. (This reads pretty complicated, but the code's really
very simple).
But you don't have to do this manually (unless your teacher wants you
to). Take out your handy-dandy Ada LRM (if you don't have one, there's
one online at http://www.adapower.com ) and look through the routines in
the standard Ada library in Appendix A. There are a couple of sets of
packages in there that provide useful routines for doing this kind of
thing. There are packages for doing lots of other neat stuff too, so be
sure to look through them all.
While you're at it, do yourself a favor and read through appendix K
(Language Defined Attributes). There's lots of vital stuff in there to
make your life easier.
--
T.E.D.
http://www.telepath.com/~dennison/Ted/TED.html
Sent via Deja.com http://www.deja.com/
Before you buy.
^ permalink raw reply [relevance 5%]
* Re: storage size pragmas
@ 2000-05-08 0:00 4% ` Ted Dennison
0 siblings, 0 replies; 200+ results
From: Ted Dennison @ 2000-05-08 0:00 UTC (permalink / raw)
In article <20000507181719.23279.00001715@ng-fc1.aol.com>,
anthonygair@aol.comremoveme (ANTHONY GAIR) wrote:
>
> The witch is dead.... it was a storage_error.. no exception was
> produced in fact my ada installation does not think it important to
> tell me about any details such as errors. sorry for wasting everyones
> time but ......as it turns out segmentation faults can be caused by
> bad prXXX er ... not placing storage pragmas in big chogablog largist
> tasks.
I'm sorry if I may have misled you a bit here. One of the things that I
forgot is that Gnat (unlike most Ada compilers) does not default to full
checking. Certian checks that are deemed by the compiler writers to be
more expensive than they are worth are turned off by default, even if
that means it technicly isn't following the Ada standard. (Of course the
standard also allows modes where the checks are turned off).
I'm not ragging on the Gnat folks for choosing to do this. Its just not
the typical choice that other compiler vendors have made, so I had
forgotten that ACT did this.
Also Robert Dewar is correct in pointing out that if the check was in
there, your task would just have died silently instead. *Another* thing
I forgot is that I always put a last-ditch handler in my task bodies to
print out information about task-terminating exceptions. The general
form is the following:
exception
when Error : others =>
-- Try to put one last-ditch message to the screen saying
-- that the {taskname} died
Ada.Text_Io.Put_Line
("{taskname} died with the following exception:" &
Ada.Characters.Latin_1.Cr & Ada.Characters.Latin_1.Lf &
Ada.Exceptions.Exception_Information (Error));
If you don't do this, then typically your indication that a task has
died is that other tasks get Program_Error when attempting to rendezvous
with them. That doesn't exactly make for easy debugging.
--
T.E.D.
http://www.telepath.com/~dennison/Ted/TED.html
Sent via Deja.com http://www.deja.com/
Before you buy.
^ permalink raw reply [relevance 4%]
* Re: not really an Ada question (long answer)
@ 2000-02-17 0:00 2% ` DuckE
0 siblings, 0 replies; 200+ results
From: DuckE @ 2000-02-17 0:00 UTC (permalink / raw)
Windows NT (and Windows 95) prefer "CreateProcess" for creating another
process. I have
attached an example I put together quite a while back for NT.
In this particular example I start up a process to act as a slave to the
calling program. The stdin, stdout, and stderror files are mapped to pipes
used to drive the process.
While this isn't exactly what you asked for, it does give a working example
of the use of "CreateProcess", which is I believe what you need. The code
does rely on the Win32Ada binding.
SteveD
==== Launch.adb ====
WITH Win32;
WITH Win32.WinBase;
WITH Win32.WinNT;
WITH System;
WITH Interfaces.C;
USE Interfaces.C;
WITH Interfaces.C.Strings;
USE Interfaces.C.Strings;
WITH Ada.Text_Io;
WITH NTSntServerProcess;
USE NTSntServerProcess;
PROCEDURE Launch IS
PACKAGE WinBase RENAMES Win32.WinBase;
PACKAGE WinNT RENAMES Win32.WinNT;
PACKAGE Text_Io RENAMES Ada.Text_Io;
USE TYPE Win32.BOOL;
result : Win32.BOOL;
stdInLocHandle : ALIASED WinNT.HANDLE;
stdOutLocHandle : ALIASED WinNT.HANDLE;
stdErrLocHandle : ALIASED WinNT.HANDLE;
inputBuffer : CHAR_ARRAY(0..255);
bytesRead : ALIASED Win32.DWORD;
BEGIN
CreateSubprocessNTS( commandDirNTS => "",
commandLineNTS => "c:\csrc\hello.exe",
workDirNTS => "c:\csrc",
windowNameNTS => "Window name",
stdInNTS => stdInLocHandle,
stdOutNTS => stdOutLocHandle,
stdErrNTS => stdErrLocHandle );
Text_Io.Put_Line( "=== Start of output ===" );
LOOP
result := WinBase.ReadFile( stdOutLocHandle,
inputBuffer(0)'ADDRESS,
Win32.DWORD( 2 ), -- inputBuffer'LENGTH ),
bytesRead'UNCHECKED_ACCESS,
NULL );
EXIT WHEN result <= 0;
Text_Io.Put( To_Ada( inputBuffer )(1..Integer( bytesRead ) ) );
END LOOP;
Text_Io.Put_Line( "=== End of output ===" );
Text_Io.Put_Line( "Result = " & Win32.BOOL'IMAGE( result ) );
CloseFilesNTS( stdOutLocHandle, stdOutLocHandle, stdErrLocHandle );
-- result := WinBase.CloseHandle( stdInProcHandle );
-- result := WinBase.CloseHandle( stdOutProcHandle );
-- result := WinBase.CloseHandle( stdErrProcHandle );
END Launch;
=========== NTSntServerProcess.ads =============
WITH Win32.WinNT;
PACKAGE NTSntServerProcess IS
PACKAGE WinNT RENAMES Win32.WinNT;
-- Creates a separate process such that the standard input, standard
output, and standard
-- error files are redirected to pipes, and returns the file handles
associated with those
-- pipes.
PROCEDURE CreateSubprocessNTS( commandDirNTS : in String;
commandLineNTS : in String;
workDirNTS : in String;
windowNameNTS : in String;
stdInNTS : out WinNT.HANDLE;
stdOutNTS : out WinNT.HANDLE;
stdErrNTS : out WinNT.HANDLE );
PROCEDURE CloseFilesNTS( stdInNTS : in WinNT.HANDLE;
stdOutNTS : in WinNT.HANDLE;
stdErrNTS : in WinNT.HANDLE );
END NTSntServerProcess;
=========== NTSntServerProcess ==============
WITH Win32;
WITH Win32.WinBase;
WITH Win32.WinNT;
WITH System;
WITH Ada.Characters.Latin_1;
WITH Interfaces.C;
USE Interfaces.C;
WITH Interfaces.C.Strings;
USE Interfaces.C.Strings;
WITH Win32.WinNT;
PACKAGE BODY NTSntServerProcess IS
PACKAGE WinBase RENAMES Win32.WinBase;
USE TYPE Win32.BOOL;
-- Creates a separate process such that the standard input, standard
output, and standard
-- error files are redirected to pipes, and returns the file handles
associated with those
-- pipes.
PROCEDURE CreateSubprocessNTS( commandDirNTS : in String;
commandLineNTS : in String;
workDirNTS : in String;
windowNameNTS : in String;
stdInNTS : out WinNT.HANDLE;
stdOutNTS : out WinNT.HANDLE;
stdErrNTS : out WinNT.HANDLE ) IS
result : Win32.BOOL;
commandDir : CHAR_ARRAY := To_C( commandDirNTS );
commandLine : CHAR_ARRAY := To_C( commandLineNTS );
currentDir : CHAR_ARRAY := To_C( workDirNTS );
windowName : CHAR_ARRAY := To_C( windowNameNTS );
startupInfo : ALIASED WinBase.STARTUPINFOA;
processInfo : ALIASED WinBase.PROCESS_INFORMATION;
stdInLocHandle : ALIASED WinNT.HANDLE;
stdOutLocHandle : ALIASED WinNT.HANDLE;
stdErrLocHandle : ALIASED WinNT.HANDLE;
tmpInLocHandle : ALIASED WinNT.HANDLE;
tmpOutLocHandle : ALIASED WinNT.HANDLE;
tmpErrLocHandle : ALIASED WinNT.HANDLE;
stdInProcHandle : ALIASED WinNT.HANDLE;
stdOutProcHandle : ALIASED WinNT.HANDLE;
stdErrProcHandle : ALIASED WinNT.HANDLE;
securityAttrib : ALIASED WinBase.SECURITY_ATTRIBUTES;
BEGIN
securityAttrib.nLength := WinBase.SECURITY_ATTRIBUTES'SIZE/8;
securityAttrib.bInheritHandle := Win32.TRUE;
securityAttrib.lpSecurityDescriptor := NULL;
result := WinBase.CreatePipe( stdInProcHandle'UNCHECKED_ACCESS,
tmpInLocHandle'UNCHECKED_ACCESS,
securityAttrib'UNCHECKED_ACCESS,
0 );
result := WinBase.DuplicateHandle( WinBase.GetCurrentProcess,
tmpInLocHandle,
WinBase.GetCurrentProcess,
stdInLocHandle'UNCHECKED_ACCESS,
0,
Win32.FALSE,
WinNT.DUPLICATE_SAME_ACCESS );
result := WinBase.CloseHandle( tmpInLocHandle );
result := WinBase.CreatePipe( tmpOutLocHandle'UNCHECKED_ACCESS,
stdOutProcHandle'UNCHECKED_ACCESS,
securityAttrib'UNCHECKED_ACCESS,
0 );
result := WinBase.DuplicateHandle( WinBase.GetCurrentProcess,
tmpOutLocHandle,
WinBase.GetCurrentProcess,
stdOutLocHandle'UNCHECKED_ACCESS,
0,
Win32.FALSE,
WinNT.DUPLICATE_SAME_ACCESS );
result := WinBase.CloseHandle( tmpOutLocHandle );
result := WinBase.CreatePipe( tmpErrLocHandle'UNCHECKED_ACCESS,
stdErrProcHandle'UNCHECKED_ACCESS,
securityAttrib'UNCHECKED_ACCESS,
0 );
result := WinBase.DuplicateHandle( WinBase.GetCurrentProcess,
tmpErrLocHandle,
WinBase.GetCurrentProcess,
stdErrLocHandle'UNCHECKED_ACCESS,
0,
Win32.FALSE,
WinNT.DUPLICATE_SAME_ACCESS );
result := WinBase.CloseHandle( tmpErrLocHandle );
startupInfo.cb :=
Win32.DWORD( WinBase.STARTUPINFOA'SIZE/8 );
startupInfo.lpReserved := NULL; --
startupInfo.lpDesktop := NULL;
startupInfo.lpTitle :=
windowName(windowName'FIRST)'UNCHECKED_ACCESS;
startupInfo.dwX := 0;
startupInfo.dwY := 0;
startupInfo.dwXSize := 0;
startupInfo.dwYSize := 0;
startupInfo.dwXCountChars := 0;
startupInfo.dwYCountChars := 0;
startupInfo.dwFillAttribute := 0;
startupInfo.dwFlags := WinBase.STARTF_USESTDHANDLES;
startupInfo.wShowWindow := 0;
startupInfo.cbReserved2 := 0;
startupInfo.lpReserved2 := NULL;
startupInfo.hStdInput := stdInProcHandle;
startupInfo.hStdOutput := stdOutProcHandle;
startupInfo.hStdError := stdErrProcHandle;
result := WinBase.CreateProcess(
NULL, -- LPCTSTR pointer to
name of executable module
commandLine(commandLine'FIRST)'UNCHECKED_ACCESS, -- LPTSTR
pointer to command line string
NULL, --
LPSECURITY_ATTRIBUTES pointer to process security attributes
NULL, -- LPSECURITY_ATTRIBUTES
pointer to thread security attributes
Win32.TRUE, -- BOOL handle inheritance
flag
WinBase.DETACHED_PROCESS, -- DWORD creation flags
NULL, -- LPVOID pointer to new
environment block
currentDir(currentDir'FIRST)'UNCHECKED_ACCESS, -- LPCTSTR pointer
to current directory name
startupInfo'UNCHECKED_ACCESS, -- LPSTARTUPINFO pointer to
STARTUPINFO
processInfo'UNCHECKED_ACCESS -- LPPROCESS_INFORMATION
pointer to PROCESS_INFORMATION
);
result := WinBase.CloseHandle( stdInProcHandle );
result := WinBase.CloseHandle( stdOutProcHandle );
result := WinBase.CloseHandle( stdErrProcHandle );
stdInNTS := stdInLocHandle;
stdOutNTS := stdOutLocHandle;
stdErrNTS := stdErrLocHandle;
END CreateSubprocessNTS;
PROCEDURE CloseFilesNTS( stdInNTS : in WinNT.HANDLE;
stdOutNTS : in WinNT.HANDLE;
stdErrNTS : in WinNT.HANDLE ) IS
result : Win32.BOOL;
BEGIN
-- result := WinBase.CloseHandle( stdInProcHandle );
-- result := WinBase.CloseHandle( stdOutProcHandle );
-- result := WinBase.CloseHandle( stdErrProcHandle );
result := WinBase.CloseHandle( stdInNTS );
result := WinBase.CloseHandle( stdOutNTS );
result := WinBase.CloseHandle( stdErrNTS );
END CloseFilesNTS;
END NTSntServerProcess;
^ permalink raw reply [relevance 2%]
* Re: Announce: OpenToken 2.0 released
2000-01-31 0:00 4% ` Hyman Rosen
@ 2000-02-01 0:00 0% ` Ted Dennison
0 siblings, 0 replies; 200+ results
From: Ted Dennison @ 2000-02-01 0:00 UTC (permalink / raw)
In article <t7n1plq56s.fsf@calumny.jyacc.com>,
Hyman Rosen <hymie@prolifics.com> wrote:
> Ted Dennison <dennison@telepath.com> writes:
> > Release 2.0 of OpenToken has now been placed on the website
>
> From a quick look at opentoken.ads, I see a declaration for an
> EOF_Character, set to Ada.Characters.Latin_1.EOT. Does this mean
> that OpenToken cannot parse binary files that happen to contain
> this character? It's a rather odd choice in any case, given that
> no system that I know of uses EOT as an end-of-file marker.
That's the marker that the OpenToken text feeders agree put on text to
indicate that there is no more text to read. If you have to parse text
which contains an EOT, its a simple matter to change EOF_Character to
something else.
As for parsing binaries; to my knowledge OT has not been used that way
before. However, I see only one real inpediment. EOF_Character is used
in OpenToken:
o In the line comment recognizer (line comments make no sense in
binaries anyway)
o In the Text_IO-based text feeder. Using this feeder also makes no
sense in binaries. You'd want to write one based on Sequential_IO or
something.
o In the End_Of_File token recognizer. This also makes no sense for
binaries, as a sentinel character which can be tokenized clearly won't
do the job.
o By you the user to make sure you don't attempt to read past the
end of the file after a token analysis or parse returns. In this case,
no problem for binaries exists. You just use a different method to
prevent reading past the end of the file.
o In the analyzer to prevent reading past the end of file when
matching a token. This *would* be a problem for you, unless none of your
"binary" tokens span an EOT. My suggestions for working around this
problem are follows:
Modify EOF_Character to be a variable so that it can be set by your
custom text feeder. Set it to some good terminating value normally. This
would be a byte value that cannot be anywhere in a token except at the
end. But when you read the last character from the file, you set it to
that value instead.
A better option with a bit more work would be the following:
Modify the root text_feeder package to have a primitive operation for
returning whether we are at the end of the input. Implement that routine
in your custom text feeder (as well as any others that you may use).
Modify the one line in the Analyzer that checks EOF_Character to intead
call that routine on its text feeder.
Proper binary support is not in OT because it has just never come up
before. But as you can see, it could be modified fairly easily to
support parsing binaries. But using a sentinel character for the end of
file has always seemed like a nice simplification. So what are the uses
of parsing binaries? I kinda thought that binaries are, by their very
nature, already parsed.
--
T.E.D.
http://www.telepath.com/~dennison/Ted/TED.html
Sent via Deja.com http://www.deja.com/
Before you buy.
^ permalink raw reply [relevance 0%]
* Re: Announce: OpenToken 2.0 released
@ 2000-01-31 0:00 4% ` Hyman Rosen
2000-02-01 0:00 0% ` Ted Dennison
0 siblings, 1 reply; 200+ results
From: Hyman Rosen @ 2000-01-31 0:00 UTC (permalink / raw)
Ted Dennison <dennison@telepath.com> writes:
> Release 2.0 of OpenToken has now been placed on the website
From a quick look at opentoken.ads, I see a declaration for an
EOF_Character, set to Ada.Characters.Latin_1.EOT. Does this mean
that OpenToken cannot parse binary files that happen to contain
this character? It's a rather odd choice in any case, given that
no system that I know of uses EOT as an end-of-file marker.
^ permalink raw reply [relevance 4%]
* Re: solaris daemon question
@ 1999-07-28 0:00 5% ` David C. Hoos, Sr.
0 siblings, 0 replies; 200+ results
From: David C. Hoos, Sr. @ 1999-07-28 0:00 UTC (permalink / raw)
darren wilson wrote in message <7nl2l8$cg9$1@Usenet.Logical.NET>...
>I'm trying to write a simple daemon to run on a Sun E3500 running solaris
>2.6. Can anyone tell me how to issue command line unix statements such as
>mv or cp and such from within an ada program? I've been programming in
>ada for a while, but have never done this. Any help is appreciated.
>
Here's an interface to the "system" C library function:
with Ada.Characters.Latin_1;
with System;
function Execute_Shell_Command
(The_Command : String) return Integer is
function Execute
(The_Command_Address : System.Address) return Integer;
pragma Import (C, Execute, "system");
The_Nul_Terminated_Command_String : constant String :=
The_Command & Ada.Characters.Latin_1.Nul;
begin
return Execute (The_Nul_Terminated_Command_String'Address);
end Execute_Shell_Command;
^ permalink raw reply [relevance 5%]
* Re: obsolete ascii? (for language lawyers)
1999-07-03 0:00 3% ` Robert Dewar
@ 1999-07-03 0:00 4% ` Keith Thompson
0 siblings, 0 replies; 200+ results
From: Keith Thompson @ 1999-07-03 0:00 UTC (permalink / raw)
Robert Dewar <robert_dewar@my-deja.com> writes:
> In article <yecemiq75ww.fsf@king.cts.com>,
> Keith Thompson <kst@cts.com> wrote:
>
> > more important reason, however, is to let people know that
> > there's a newer, better way to do the same thing. These are
> > features that are in the language *only* to support legacy
> > code; if the language were being designed from scratch today,
> > they wouldn't be there.
>
> No, you cannot conclude any of the above. All you can conclude
> is that certain people and in particular the design team,
> thought that some of the above were true.
>
> Those of us who disagreed in some cases did not argue strongly,
> because, at least speaking for myself, I did not care if
> features ended up in annex J or not.
Ok, I was making some (possibly invalid) assumptions. I wasn't
closely involved in the design process, so everything I say here is
merely my opinion. In fact, feel free to assume that anything I say
anywhere is merely my opinion.
Note that I tend to be prejudiced in favor of clean, coherent design
over backwards compatibility. I recognize the need for backwards
compatibility, but I tend to grit my teeth a bit when I see features
that seem to exist only for that reason. I don't expect everyone to
share this prejudice.
With that in mind, let's go through Annex J.
J.1 Renamings of Ada 83 Library Units.
I really like the idea of making all the language-defined library
units children of a small number of parent units (Ada, System, and
Interfaces). It avoids polluting the user's namespace, and
(hopefully) encourages vendors and other users to do the same kind of
thing -- like the GNAT.* hierarchy. By adopting a uniform style of
referring to Ada.Text_IO rather than Text_IO, one can avoid having to
worry about the fact that Text_IO has a top-level renaming, but
Wide_Text_IO doesn't. If this feature were in the language for any
reason other than backward compatibility, it wouldn't be limited to
the units that were defined in Ada 83.
(Robert mentions that Unchecked_Conversion is really more a
fundamental feature of the langauge than a library package. Perhaps
it should have been made an attribute. I don't think this is terribly
relevant to the subject at hand, though.)
J.2 Allowed Replacements of Characters
Ada 83 allowed users to use ! for |, : for # (in based literals), and
% for ". There were (barely) good reasons for this at the time; it
would have been better (IMHO) to implement preprocessors for those
rare systems that couldn't use |, #, and ". Ada 95 still allows these
replacements. When someone starts an Obfuscated Ada contest, we'll be
ready.
J.3 Reduced Accuracy Subtypes
I don't think I've ever used these. An accuracy constraint isn't
really a "constraint" in the sense that a range constraint is; it only
affects certain predefined attributes and, indirectly, the behavior of
the predefined I/O packages. A note in the AARM suggests the idea of
replacing this with an attribute definition clause, which I think
would have been cleaner if not for the need for backwards
compatibility.
J.4 The Constrained Attribute
As the AARM says, the Ada 83 definition of this attribute (for
subtypes) was confusing, and the introduction of private subtypes just
makes it worse. I don't have anything to add here.
J.5 ASCII
Yes, Ada.Characters.Latin_1 is more verbose than ASCII, but it also
covers the entire character set that Ada 95 is required to support.
If the language were being designed from scratch, it wouldn't make
sense to have both. If you want to refer to names like BEL directly,
you only have to type
with Ada.Characters.Latin_1;
use Ada.Characters.Latin_1;
once per compilation unit.
J.6 Numeric_Error
I think we can all agree this is obsolete, and is still there only for
backward compatibility reasons. There's no reason to use it in new
code, unless you need strict Ada 83 compatibility (which hardly seems
necessary these days). (For the record, I suggested raising
Constraint_Error rather than Numeric_Error in TeleSoft's compiler, but
I was overruled.)
J.7 At Clauses
I think this is a clear example of a feature for which there's a
better alternative in Ada 95 ("for foo use at expr" replaced by
"for foo'address use expr").
J.7.1 Interrupt Entries
I haven't used these much. I'll take your word for it that the old
form is still useful.
J.8 Mod Clauses
See At Clauses.
J.9 The Storage_Size Attribute
The Storage_Size pragma, which allows a different Storage_Size to be
specified for each task object, makes the 'Storage_Size of a task type
questionably meaningful.
> > I wouldn't use '%' as a string literal delimiter
>
> Neither would I, but not because someone put this feature into
> Annex J, but rather because the reason for this feature (input
> devices lacking the clearer quote sign) have disappeared from
> sight, so it makes no sense to use it (this is true of those
> writing Ada 83 today as well!)
Right, and that's why it's in Annex J, yes?
> > or write a context clause for Text_IO (rather than
> > Ada.Text_IO)
>
> Fine you are welcome to this opinion, but please form it for
> OTHER reasons than the fact that this is in Annex J.
I have.
> > not because I expect any of those
> > features to vanish, but because it's bad style.
>
> No, that's wrong, there is no absolute standard that says it
> is bad style.
There is an absolute standard that defines "bad style" as "what Keith
Thompson doesn't like". 8-)} Isn't style always a matter of opinion?
Hopefully informed opinion, of course. Naturally, everyone should
agree with mine.
--
Keith Thompson (The_Other_Keith) kst@cts.com <http://www.ghoti.net/~kst>
San Diego Supercomputer Center <*> <http://www.sdsc.edu/~kst>
One of the great tragedies of ancient history is that Helen of Troy
lived before the invention of the champagne bottle.
^ permalink raw reply [relevance 4%]
* Re: obsolete ascii? (for language lawyers)
@ 1999-07-03 0:00 3% ` Robert Dewar
1999-07-03 0:00 4% ` Keith Thompson
0 siblings, 1 reply; 200+ results
From: Robert Dewar @ 1999-07-03 0:00 UTC (permalink / raw)
In article <yecemiq75ww.fsf@king.cts.com>,
Keith Thompson <kst@cts.com> wrote:
> more important reason, however, is to let people know that
> there's a newer, better way to do the same thing. These are
> features that are in the language *only* to support legacy
> code; if the language were being designed from scratch today,
> they wouldn't be there.
No, you cannot conclude any of the above. All you can conclude
is that certain people and in particular the design team,
thought that some of the above were true.
Those of us who disagreed in some cases did not argue strongly,
because, at least speaking for myself, I did not care if
features ended up in annex J or not.
For example, I happen to think that the way that Ada 83 maps
interrupts is much cleaner and higher level than the method
in Ada 95 which is deliberately chosen to be lower level and
closer to the way some hardware works (not all hardware
incidentally, most computers in the world, powered by ia32 chips
have hardware that maps very nicely the semantic model of Ada 83
interrupts (although I doubt any Ada implementation has taken
advantage of this).
> I wouldn't use '%' as a string literal delimiter
Neither would I, but not because someone put this feature into
Annex J, but rather because the reason for this feature (input
devices lacking the clearer quote sign) have disappeared from
sight, so it makes no sense to use it (this is true of those
writing Ada 83 today as well!)
> or write a context clause for Text_IO (rather than
> Ada.Text_IO)
Fine you are welcome to this opinion, but please form it for
OTHER reasons than the fact that this is in Annex J. Personally
I see no reason whatever to type the 4 or 8 (use) extra
characters, since there is no possibility of generating any
confusion on the part of the reader by using Text_IO rather
than Ada.Text_IO, and I actually find Unchecked_Conversion
nicer than Ada.Unchecked_Conversion, since this really should
be a fundamental language feature, and I see no reason why the
reader needs the reminder of the fiction that it is a library
package, let alone to need to be reminded of exactly where to
find this bogus library package (bogus because some
implementation magic will always be required for UC!)
> or a handler for Numeric_Error, in new code
Again, no well written Ada 83 code has handlers for
Numeric_Error either, since Ada 83 compilers are encouraged
to treat CE and NE the same, Ada 95 style, and have been for
many many years. Yes, some annoying compilers refused to follow
this implementation advice :-)
> not because I expect any of those
> features to vanish, but because it's bad style.
No, that's wrong, there is no absolute standard that says it
is bad style. Not even the RM says this, it says:
1 This Annex contains descriptions of features of the language
whosefunctionality is largely redundant with other features
defined by thisInternational Standard. Use of these features is
not recommended in newly written programs.
Note here that the RM claims only "largely redundant", not the
much stronger claim from Keith that there is always a newer
and better way of doing things. And it does not say that the
reason for the recommendation is that it is bad style. Indeed
the understanding when the design team presented Annex J was
always that the reason for this recommendation was that these
features might disappear in the future.
So what we are left with is really that *Keith* thinks it is
bad style. Fine, everyone has different stylistic views. The
next time you are deciding whether to write Text_IO or
Ada.Text_IO, it is perfectly appropriate to choose what *you*
think is the right style, if you like you can let yourself
be influenced by the stylistic preferences of Keith or Robert
or anyone else, but you should not accept Keith's claim that
there is some definite higher authority that declares that
using Annex J features is bad style :-)
I actually did worry a bit that people would adopt Keith's
attitude, and you can easily see inflexible management turning
this into a prohibition without sufficient thought. This is why
I worked hard to get pragma Elaborate moved out of Annex J,
since that for *sure* was functionality that is needed (if you
think Elaborate_All replaces it, you have not tried to port
some large legacy programs :-)
At this stage, there is not much left in Annex J (we did work
to pull stuff out!) The remaining items are
package renamings -- use them freely why not?
character replacements -- unnecessary for the most part. A
possible exception is if you are using certain funny European
keyboards (actually some people in WG9 claimed that the bar
replacement was essential).
Reduced accuracy subtypes -- useful for controlling I/O
behavior in some situations (there was an attempt to remove
these completely from the language -- this useful application
was pointed out, and a compromise put them back in, but only in
Annex J.
Constrained attribute on private types. Probably only useful
in legacy code.
ASCII. Very useful, it is an annoying amount of typing to have
to say
with Ada.Characters.Latin_1
and then
Ada.Characters.Latin_1.Bel
instead of simply Ascii.Bel in a unit that needs this
single reference. Furthermore the Latin_1 package puts piles
of junk symbols that are almost certainly of no use into
your name space.
I find the insistence on using Ada.Characters.Latin_1 to be
excessive Ada pedantry, and you should not for a moment be
intimidated into writing all this nonsense unless *YOU*
prefer to write it, and think it makes things clearer.
Numeric_Error, this is only relevant if you are writing code
that is intended to be portable between Ada 95 and Ada 83 (some
people are still in this situation), in which case you should
write
when Constraint_Error | Numeric_Error =>
(and I hope you do not have too many such handlers, code with
lots of explicit Constraint_Error handlers is suspect!)
At clauses. Obsolete indeed, the new address clause is cleaner
and more consistent, but no particular reason to go changing
legacy code. No reason to use this in new code.
Interrupt entries. As mentioned above, a nice feature. One has
to hope that one's compiler implements this nice feature :-)
Mod clauses. Same comments apply as for at clauses.
Storage_Size. I don't really see why this is obsolete. The
alternate pragma form is fine, but in some ways the Ada 83
style is more consistent with other Ada 95 syntax.
> (I wonder how many Ada programmers even know that this:
>
> with Text_IO;
> procedure Obsolesce is
> X : Integer := 16:FF:;
> begin
> Text_IO.Put_Line(%X = % & Integer'Image(X));
> end Obsolesce;
>
> is valid.)
Well the fact is that any competent Ada programmer should have
at least read through the features of the language, and these
features include Annex J. It is certainly possible that you
may meet the % in existing code, and a programmer who knows
the features of Ada including this one, is better off than
one who does not!
> On the other hand, if you have legacy code that uses these
> features, it's not worth going back and changing it
Indeed!
> unless you're doing a major rewrite anyway.
And maybe not even then, don't fix things that are not broken.
In some cases, the fixes may not be completely trivial
(certainly true for the interrupt case for example, and for
reduced accuracy subtypes -- it may be QUITE difficult to
determine if reduced accuracy subtypes have some significant
function -- for example one of our customers was using reduced
accuracy subtypes to define larger epsilon values to be used
in comparison of floating-point values).
Robert Dewar
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
^ permalink raw reply [relevance 3%]
* Re: obsolete ascii? (for language lawyers)
@ 1999-07-02 0:00 4% ` Robert A Duff
2 siblings, 0 replies; 200+ results
From: Robert A Duff @ 1999-07-02 0:00 UTC (permalink / raw)
Peter Hermann <ica2ph@alpha1.csv.ica.uni-stuttgart.de> writes:
> Thanks to John Herro, David C. Hoos, Sr., Ted Dennison.
> I am afraid I did not explain my question precisely enough.
> With Ada95 we have a quite better type character, but
> I can't see any reason why i should not have the possibility
> to directly write down e.g. the bel-character, the ff-character,
> the cr-character, the esc-character etc. etc. as a simple identifier,
You could not write just "BEL" in Ada 83, and you still can't in Ada 95.
You have to say "Ascii.BEL;", or you can "use Ascii;" and then you can
say just "BEL". Same for both Ada 83 and Ada 95. This is good -- I
don't want my namespace cluttered with all those arcane symbols, most of
which I never use. Furthermore, the meaning of these control characters
on I/O is rather non-portable, so they shouldn't be directly visible
everywhere.
You cannot say "with Ascii;" -- the name Ascii is always directly
visible (unless you hide it with something else called Ascii).
> the comfort of which will be removed as soon as the
> 'obsolete' package ascii will be removed!
All compilers are required to support package Ascii and all the other
Obsolescent Features. I doubt if any of the Obsolescent Features will
ever be removed from the language.
> We even cannot write something like character'(bel) or the like.
> Sort of latin1.bel could do it?
In Ada 95, you can also "with Ada.Characters.Latin_1;", and then say
"Latin_1.BEL", and you can also use a use clause, of course.
> Are there better ideas? Or did I miss a given feature?
You seem to be saying that Ada 95 took something away, which is not
True. Package Ascii is still there, and still works exactly the same
way.
- Bob
--
Change robert to bob to get my real email address. Sorry.
^ permalink raw reply [relevance 4%]
* Re: obsolete ascii? (for language lawyers)
@ 1999-07-02 0:00 4% ` Ted Dennison
0 siblings, 0 replies; 200+ results
From: Ted Dennison @ 1999-07-02 0:00 UTC (permalink / raw)
In article <7lih9i$ckb$1@nnrp1.deja.com>,
Ted Dennison <dennison@telepath.com> wrote:
> characters. Is it just that "Characters.Latin_1.BEL" takes up more
> package ASCII renames Characters.Latin_1;
Yikes! Make both those "Ada.Characters.Latin_1".
--
T.E.D.
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
^ permalink raw reply [relevance 4%]
* Re: obsolete ascii? (for language lawyers)
@ 1999-06-29 0:00 4% ` David C. Hoos, Sr.
1999-06-29 0:00 0% ` Ted Dennison
1 sibling, 1 reply; 200+ results
From: David C. Hoos, Sr. @ 1999-06-29 0:00 UTC (permalink / raw)
Peter Hermann wrote in message
<7las7v$5p0$1@infosun2.rus.uni-stuttgart.de>...
>LRM A.1(36) states an obsolete package ASCII.
>
>now look at my example:
>
> with text_io;
>procedure hello is
> bell : character := character'val(7);
> --bell2 : character := bel; -- is not allowed :-(
>begin
> text_io.put_line ("Hallo Welt..." & ascii.bel & bell);
> end hello;
>What is the reason for this degradation?
You would need a use clause for package ASCII, or use dot notation.
>Why then (zum Kuckuck!) is package ascii declared obsolete?
Because a package like Ada.Characters.Latin_1 replaces it, and
extends the range to include 256 characters instead of 128.
^ permalink raw reply [relevance 4%]
* Re: obsolete ascii? (for language lawyers)
1999-06-29 0:00 4% ` David C. Hoos, Sr.
@ 1999-06-29 0:00 0% ` Ted Dennison
0 siblings, 0 replies; 200+ results
From: Ted Dennison @ 1999-06-29 0:00 UTC (permalink / raw)
In article <7lb7ri$2g2@hobbes.crc.com>,
"David C. Hoos, Sr." <david.c.hoos.sr@ada95.com> wrote:
>
> Peter Hermann wrote in message
> <7las7v$5p0$1@infosun2.rus.uni-stuttgart.de>...
> >Why then (zum Kuckuck!) is package ascii declared obsolete?
>
> Because a package like Ada.Characters.Latin_1 replaces it, and
> extends the range to include 256 characters instead of 128.
Also, ASCII is an obsolete American standard, while Latin_1 is an
international standard that fits into the "Unicode" universal
character standard.
--
T.E.D.
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
^ permalink raw reply [relevance 0%]
* Re: DOS/Win95 file names
@ 1999-06-11 0:00 4% ` fluffy_pop
1999-06-11 0:00 0% ` dennison
0 siblings, 1 reply; 200+ results
From: fluffy_pop @ 1999-06-11 0:00 UTC (permalink / raw)
On Fri, 11 Jun 1999 09:03:41 +0200, in comp.lang.ada you wrote:
>...
>Windows... A possibility is to have an explicit
>translation table;
I guess this is what you mean:
DOS Windows
-------------- ---------------
Alt+130 => '�' Alt+0130 => '�'
Alt+233 => '_' Alt+0233 => '�'
FUNCTION ISO ( p_car : character ) RETURN character IS
WITH Ada.Characters.Latin_1; USE Ada.Characters.Latin_1;
ISO_Char : character;
BEGIN
CASE character'pos(p_car) IS
...
WHEN 129 => ISO_Char := lc_u_diaeresis;
WHEN 130 => ISO_Char := lc_e_acute;
WHEN 131 => ISO_Char := lc_a_circumflex;
...
END CASE;
RETURN ISO_Char;
END;
> the best one is to forbid
>accents in filenames: you could add to your exception
>handling such a warning.
I don't want to forbid accents in filenames. Why should I ?
Windows (in all it's glory) accepts accents in filenames, so
why not take advantage of it with my program ? If I'm a user
of the program and I arleady have input filenames that have
accented characters on my HD I don't want to have to change
my files' names before using the program.
If the user is using my program in a DOS window, what he/she
enters (each character) will be the code from the Windows
code page, and if it's in DOS MODE (reboot) it will be from
the DOS 850 code page, right ?
If the above is true, then the function ISO will only have
an effect if the user is in DOS MODE, right ?
So if the two statements above are true, then how come
I have a problem (explained in my first post), since I've
been working in a DOS window all along when playing the
user part and when coding ?
For 0-127 (Ascii) the code is the same:
Alt+63 (DOS) => '?' and Alt+063 (Windows) => '?'.
Is there a chance that something related to this topic
is causing the problem when there's a '?' in the filename ?
Of course it could be my code that is faulty, but I doubt
it since the other validations, in the same procedure,
are working fine (see my first post).
Thanks
Marc
--
What I really am is "fluffy", no "_dong",
no "_puff", no "_woo", no nothing, just plain fluffy.
^ permalink raw reply [relevance 4%]
* Re: DOS/Win95 file names
1999-06-11 0:00 4% ` fluffy_pop
@ 1999-06-11 0:00 0% ` dennison
0 siblings, 0 replies; 200+ results
From: dennison @ 1999-06-11 0:00 UTC (permalink / raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 794 bytes --]
In article <3762f569.682876310@news.dsuper.net>,
fluffy_pop@dsuper.net wrote:
> On Fri, 11 Jun 1999 09:03:41 +0200, in comp.lang.ada you wrote:
>
> >...
> >Windows... A possibility is to have an explicit
> >translation table;
>
> I guess this is what you mean:
> DOS Windows
> -------------- ---------------
> Alt+130 => '�' Alt+0130 => '�'
> Alt+233 => '_' Alt+0233 => '�'
>
> FUNCTION ISO ( p_car : character ) RETURN character IS
> WITH Ada.Characters.Latin_1; USE Ada.Characters.Latin_1;
> ISO_Char : character;
> BEGIN
> CASE character'pos(p_car) IS
Rather than writing this function manually, you should probably look
into using a character mapping from Ada.Strings.Maps.
--
T.E.D.
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
^ permalink raw reply [relevance 0%]
* DOS/Win95 file names
@ 1999-06-10 0:00 4% fluffy_pop
0 siblings, 1 reply; 200+ results
From: fluffy_pop @ 1999-06-10 0:00 UTC (permalink / raw)
Hi,
I'm a student writing a program that must ask the user for a file name
to be either created for writing or opened for reading by the program.
I'm being asked to validate the name format so that it satisfies the
(8.3) DOS requirements (actually it's a hybrid because I'm accepting
characters illegal under DOS but legal under Windows). It's a Ada
console program and I'm working on a Win95 machine.
As it is (my program), when the user enters a file name that contains
an accented character, my handling of the Name_Error Exception occurs
to produce a message that the file is not in the repertory. The file
*is* there. Also, when the file name contains a '?', my program
crashes (when what follows is a Create(F,Out_File,"name") ). That's
because the sweep of the string containing the illegal characters, in
my validation procedure, is not working properly. The name passes
through whithout the illegal character being detected. Everything
else about the validation works fine.
So the value of each character entered in the file name by the user
does not match the value of the characters in the actual Windows/DOS
file names, or the value of my own program's string of illegal
characters (a constant). That string is declared like this:
ILLEGAL_CHAR : CONSTANT string := "*?|\/<>:""";
Now, I'm guessing that the character code that is actually put on my
Ada page ("my_prog.ada") in that string matches the code of the
characters of the real file names, since I'm working under Windows
when I write my program code and the files are created also under
Windows or DOS. Also, I'm assuming that when the user enters let's
say '�', what is put in the string to hold the file name in my program
is determined by the active Windows character table/code. I think
that it matches exactly or very closely the ISO 8859-1 standard, which
in turn fits with Ada.Characters.Latin_1. For my DOS, currently, it's
850 Multilingual (Latin I). I have these tables to look up.
Beyond that I don't know much. I know how to use the DOS Alt+x[xx]
codes, and the Windows(?) Alt+0x[xx] codes for display, but I don't
know the character(s) produced that go just before the numerical code.
I don't know exactly what produces this/these special characters or
what their role is in terms of what part of the system uses them:
hardware and/or OS, and/or my program. Anyway, this might have
nothing to do whith my problem, but I would still like to have some
hint.
Thanks
Marc Galipeau
--
What I really am is "fluffy", no "_dong",
no "_puff", no "_woo", no nothing, just plain fluffy.
^ permalink raw reply [relevance 4%]
* Re: Exception Propagation
@ 1999-06-08 0:00 4% ` dennison
0 siblings, 0 replies; 200+ results
From: dennison @ 1999-06-08 0:00 UTC (permalink / raw)
In article <375CC549.7EDFB885@spam.com>,
spamwithchipsplease@spam.com wrote:
> dennison@telepath.com wrote:
> > That's the behavior I'd expect to see if the exception is occuring
in a
> > task. The whole program doesn't terminate just because one task
dies.
>
> This feature has escaped me, or I have forgot ( RM95 11.4(4) ), I've
> also checked RM83 and found it to be a feature of that language
edition.
> I would rather the exception was propogated aleast this gives the
option
> of deciding whether the program terminates or not.
It wouldn't make much sense for that to happen. That would mean a task
(or the main routine) which had a child task could conveivably raise any
exception at any point in its execution. How would you write code to
handle and recover from that?
If you *do* want one task to raise an exception in another, just raise
the exception in a rendezvous. In that case, *both* tasks get the
exception.
>
> Given the RM specification, I think a mandatory "when others" task
level
> exception handler would be prudent.
That's what we do here, although there are probably situations where
that would be inadvisable. For example, OpenToken puts some extra
diagnotic information in Exception_Message whenever it (manually) raises
an exception. You wouldn't loose that with your exception handler, but
you would have to be smart enough to dump the exception information
somewhere before you leave the handler. Also, there's nothing stopping
some nice compiler vendor from dumping a stack trace for
exception-terminated tasks to stdout. But none of the ones I use are
that nice.
Following is one of my task outer exception handlers. Note that
"Log.Report" is a utility of ours that handles I/O in a task-safe manner
(Text_IO does not). Often task terminations cause cascading errors in
other tasks, which can cause contention for the I/O device. Its annoying
to get I/O exceptions when you should be getting details about the
*real* exception that caused the problem.:
exception
when Error : others =>
Log.Report (Event => "Save_Restore.Data_Dispatcher terminated
due to " &
"unhandled exception." & Ada.Characters.Latin_1.Cr
&
Ada.Characters.Latin_1.Lf &
Ada.Exceptions.Exception_Information (Error),
Severity => Log.Error);
--
T.E.D.
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
^ permalink raw reply [relevance 4%]
* Re: Dos Environment varables
@ 1999-05-24 0:00 5% ` Jeffrey D. Cherry
0 siblings, 0 replies; 200+ results
From: Jeffrey D. Cherry @ 1999-05-24 0:00 UTC (permalink / raw)
To: Al Lively
Al,
The GNAT OS_Lib route is a great way to get environment variables when
you want to port your application accross different platforms. If you
are going to stay with Windows, then using the Win32 API is a good
"portability" alternative, again the condition being that you stay
within the Windows family (95/98/NT). Here is a function that I've used
with the OA compiler. I've used it on Windows 95, 98, and NT without
any problems. Hope it helps.
Regard,
Jeffrey D. Cherry
Logicon Geodynamics
-----
with Ada.Strings.Unbounded;
function Get_Environment_Variable(Name : in string)
return Ada.Strings.Unbounded.Unbounded_String;
-----
with Win32;
with Win32.Winbase;
with Ada.Characters.Latin_1;
function Get_Environment_Variable(Name : in string)
return Ada.Strings.Unbounded.Unbounded_String is
N : string(1 .. Name'length+1) := Name & Ada.Characters.Latin_1.Nul;
B : string(1 .. 2048);
S : Win32.DWORD;
begin -- Get_Environment_Variable
S := Win32.Winbase.GetEnvironmentVariable(Win32.Addr(N),
Win32.Addr(B),
Win32.DWORD(B'length));
if (integer(S) <= 0) then
return Ada.Strings.Unbounded.Null_Unbounded_String;
else
return
Ada.Strings.Unbounded.To_Unbounded_String(B(1..positive(S)));
end if;
end Get_Environment_Variable;
-----
^ permalink raw reply [relevance 5%]
* Re: Terminal IO, and menus
@ 1999-04-01 0:00 3% ` John J Cupak Jr
0 siblings, 0 replies; 200+ results
From: John J Cupak Jr @ 1999-04-01 0:00 UTC (permalink / raw)
To: Heath Isler
[-- Attachment #1: Type: text/plain, Size: 3496 bytes --]
Heath,
I have scoured the 'net for such a package, and other than Feldman's, couldn't
find just what I wanted. I also looked at the VT100/xterm escape sequences and
came up with a series of child packages to handle the different screen
properties. I've attached a screen_files.txt file to this message containing
all the packages - suitable for gnatchop (I checked it). Hope this help you..
and anyone else looking for this.
Yours in Ada95!
John J Cupak Jr, CCP
Heath Isler wrote:
> Hello,
>
> I would like to thank everyone for the input. I have decided to use the
> escape sequences for a ansi terminal since my target platforms are Win9X,
> Dos, Unixes, I don't care at this point if it runs on Win NT since I don't
> have it.
>
> Heath
>
> Matthew Heaney <matthew_heaney@acm.org> wrote in message
> news:m3677if8ks.fsf@mheaney.ni.net...
> > "Heath Isler" <isler@gfherald.infi.net> writes:
> >
> > > My question is is there a way in the stadard packages to Clear the
> Screen
> > > and postition the cursor in a specific location, i.e. Locate_Cursor (x
> =>
> > > 10, y =>15); ? I am plan on using this for menus and data input.
> >
> > No, there's nothing in the Ada predefined packages to do that.
> >
> >
> > > I have also looked through a lot of packages on the net, and some of
> > > them seem to fit my need. I not sure if I should use one of the
> > > Terminal IO or menu packages. Can anyone recommend a package to use?
> >
> > In the GNAT source distribution, the dining philosophers example does
> > terminal I/O using escape sequences.
> >
> >
> > --::::::::::
> > --screen.ads
> > --::::::::::
> > package Screen is
> >
> > -- simple ANSI terminal emulator
> > -- Michael Feldman, The George Washington University
> > -- July, 1995
> >
> > ScreenHeight : constant Integer := 24;
> > ScreenWidth : constant Integer := 80;
> >
> > subtype Height is Integer range 1..ScreenHeight;
> > subtype Width is Integer range 1..ScreenWidth;
> >
> > type Position is record
> > Row : Height := 1;
> > Column: Width := 1;
> > end record;
> >
> > procedure Beep;
> > -- Pre: none
> > -- Post: the terminal beeps once
> >
> > procedure ClearScreen;
> > -- Pre: none
> > -- Post: the terminal screen is cleared
> >
> > procedure MoveCursor (To: in Position);
> > -- Pre: To is defined
> > -- Post: the terminal cursor is moved to the given position
> >
> > end Screen;
> >
> >
> > --::::::::::
> > --screen.adb
> > --::::::::::
> > with Text_IO;
> > package body Screen is
> >
> > -- simple ANSI terminal emulator
> > -- Michael Feldman, The George Washington University
> > -- July, 1995
> >
> > -- These procedures will work correctly only if the actual
> > -- terminal is ANSI compatible. ANSI.SYS on a DOS machine
> > -- will suffice.
> >
> > package Int_IO is new Text_IO.Integer_IO (Num => Integer);
> >
> > procedure Beep is
> > begin
> > Text_IO.Put (Item => ASCII.BEL);
> > end Beep;
> >
> > procedure ClearScreen is
> > begin
> > Text_IO.Put (Item => ASCII.ESC);
> > Text_IO.Put (Item => "[2J");
> > end ClearScreen;
> >
> > procedure MoveCursor (To: in Position) is
> > begin
> > Text_IO.New_Line;
> > Text_IO.Put (Item => ASCII.ESC);
> > Text_IO.Put ("[");
> > Int_IO.Put (Item => To.Row, Width => 1);
> > Text_IO.Put (Item => ';');
> > Int_IO.Put (Item => To.Column, Width => 1);
> > Text_IO.Put (Item => 'f');
> > end MoveCursor;
> >
> > end Screen;
[-- Attachment #2: screen_files.txt --]
[-- Type: text/plain, Size: 9618 bytes --]
----------------------------------------------------------------------
-- The Screen Package (Specification)
--
-- Programmer : John Cupak
-- History : 6Oct97 jcj Created
-- 17Oct97 jcj "Base" types package
-- Description: This package defines the xterm/VT100 size
----------------------------------------------------------------------
package Screen is
Maximum_Rows : constant := 24;
Maximum_Columns : constant := 80;
subtype Rows is Positive range 1..Maximum_Rows;
subtype Columns is Positive range 1..Maximum_Columns;
private
-- Define constant for use by all child packages
-- Command Sequence Introducer (CSI)
-- (provides screen command prefix)
CSI : constant String := ASCII.ESC & "[";
end Screen;
----------------------------------------------------------------------
-- The Screen Attributes Child Package (Specification)
--
-- Programmer : John Cupak
-- History : 17Oct97 jcj Created
-- Description: Changes display attributes of characters
----------------------------------------------------------------------
package Screen.Attributes is
-- Turn off attributes - normal video
procedure Normal;
-- Turn on underlined mode
procedure Underlined;
-- Turn on inverse video mode
procedure Inverse;
-- Turn on highlight video mode
procedure Highlight;
-- Turn on blink mode
procedure Blink;
end Screen.Attributes;
----------------------------------------------------------------------
-- The Screen Colors Child Package (Specification)
--
-- Programmer : John Cupak
-- History : 17Nov97 jcj Created
-- Description: Sets foreground and background color(s)
----------------------------------------------------------------------
package Screen.Colors is
type Color is (Black,
Red,
Green,
Yellow,
Blue,
Magenta,
Cyan,
White,
default); -- Original color
-- Specify internal representations
for Color use (Black => 0,
Red => 1,
Green => 2,
Yellow => 3,
Blue => 4,
Magenta => 5,
Cyan => 6,
White => 7,
default => 9);
procedure Set_Foreground(Choice : in Color := default);
procedure Set_Background(Choice : in Color := default);
end Screen.Colors;
----------------------------------------------------------------------
-- The Screen Cursor Control Child Package (Specification)
--
-- Programmer : John Cupak
-- History : 17Oct97 jcj Created
-- Description: Moves cursor from current position
----------------------------------------------------------------------
package Screen.Cursor is
-- Move cursor "By" times - stop at top
procedure Up (By : in Positive := 1);
-- Move cursor down "By" times - stop at bottom
procedure Down (By : in Positive := 1);
-- Move cursor right "By" times - stop at far right
procedure Right(By : in Positive := 1);
-- Move cursor left "By" times - stop at far left
procedure Left (By : in Positive := 1);
-- Set cursor position - Column=X, Row=Y
procedure Position(Column : Columns;
Row : Rows ); -- Line
-- Set cursor home (1,1)
procedure Home;
end Screen.Cursor;
----------------------------------------------------------------------
-- The Screen Erase Child Package (Specification)
--
-- Programmer : John Cupak
-- History : 17Oct97 jcj Created
-- Description: Erases lines and screens
----------------------------------------------------------------------
package Screen.Erase is
procedure To_End_Of_Line; -- Inclusive
procedure EOF renames To_End_Of_Line;
procedure To_Beginning_Of_Line; -- Inclusive
procedure BOL renames To_Beginning_Of_Line;
procedure Entire_Line; -- Cursor doesn't move
procedure Line renames Entire_Line;
procedure To_End_Of_Screen; -- Inclusive
procedure EOS renames To_End_Of_Screen;
procedure To_Beginning_Of_Screen; -- Inclusive;
procedure BOS renames To_Beginning_Of_Screen;
procedure Entire_Screen; -- Cursor doesn't move
procedure Clear renames Entire_Screen;
end Screen.Erase;
----------------------------------------------------------------------
-- The Screen Graphics Child Package (Specification)
--
-- Programmer : John Cupak
-- History : 17Oct97 jcj Created
-- Description: Sets modes and draws lines
----------------------------------------------------------------------
package Screen.Graphics is
procedure Set_Character_Mode; -- Turn off drawing
procedure Set_Line_Mode; -- Turn on drawing
procedure Corner_UL; -- Draw Upper-Left corner
procedure Corner_UR; -- Draw Upper-Right corner
procedure Corner_LL; -- Draw Lower_Left corner
procedure Corner_LR; -- Draw Lower_Right corner
procedure Tee_Right; -- Vertical line, right connector
procedure Tee_Left; -- Vertical line, left connector
procedure Tee_Up; -- Horizontal line, up connector
procedure Tee_Down; -- Horizontal line, down connector
procedure Cross; -- Intersecting lines
procedure Vertical; -- Vertical line
subtype Position is Positive range 1..5; -- Top to Bottom
procedure Horizontal(Line : in Position := 3);
end Screen.Graphics;
with Ada.Text_IO;
use Ada.Text_IO;
package body Screen.Attributes is
procedure Normal is
begin
Put(CSI & "0m");
end Normal;
procedure Highlight is
begin
Put(CSI & "1m");
end Highlight;
procedure Underlined is
begin
Put(CSI & "4m");
end Underlined;
procedure Blink is
begin
Put(CSI & "5m");
end Blink;
procedure Inverse is
begin
Put(CSI & "7m");
end Inverse;
end Screen.Attributes;
with Ada.Text_IO;
package body Screen.Colors is
package Color_IO is new Ada.Text_IO.Enumeration_IO(Color);
use Ada.Text_IO;
use Color_IO;
procedure Set_Foreground(Choice : in Color := default) is
begin
Put(CSI); -- Control Sequence Introducer
Put("3;"); -- Foreground
Put(Choice); -- specified color
Put('m'); -- Character attribute
end Set_Foreground;
procedure Set_Background(Choice : in Color := default) is
begin
Put(CSI); -- Control Sequence Introducer
Put("4;"); -- Background
Put(Choice); -- Specified color
Put('m'); -- Character attribute
end Set_Background;
end Screen.Colors;
with Ada.Text_IO;
with Ada.Integer_Text_IO;
use Ada.Text_IO;
use Ada.Integer_Text_IO;
package body Screen.Cursor is
procedure Up (By : in Positive := 1) is
begin
Put(CSI);Put(By,0);Put("A");
end Up;
procedure Down (By : in Positive := 1) is
begin
Put(CSI);Put(By,0);Put("B");
end Down;
procedure Right(By : in Positive := 1) is
begin
Put(CSI);Put(By,0);Put("C");
end Right;
procedure Left (By : in Positive := 1) is
begin
Put(CSI);Put(By,0);Put("D");
end Left;
procedure Position(Column : in Columns;
Row : in Rows ) is
begin
Put(Item => CSI);
Put(Item => Row, Width => 0);
Put(Item => ';');
Put(Item => Column, Width => 0);
Put(Item => 'H');
end Position;
procedure Home is
begin
Put(CSI & "H");
end Home;
end Screen.Cursor;
with Ada.Text_IO;
use Ada.Text_IO;
package body Screen.Erase is
procedure To_End_Of_Line is
begin
Put(CSI & "0K");
end To_End_Of_Line;
procedure To_Beginning_Of_Line is
begin
Put(CSI & "1K");
end To_Beginning_Of_Line;
procedure Entire_Line is
begin
Put(CSI & "2K");
end Entire_Line;
procedure To_End_Of_Screen is
begin
Put(CSI & "0J");
end To_End_Of_Screen;
procedure To_Beginning_Of_Screen is
begin
Put(CSI & "1J");
end To_Beginning_Of_Screen;
procedure Entire_Screen is
begin
Put(CSI & "2J" );
end Entire_Screen;
end Screen.Erase;
with Ada.Text_IO;
with Ada.Characters.Latin_1; -- for SI and SO
use Ada.Text_IO;
package body Screen.Graphics is
procedure Set_Character_Mode is
begin
Put(Ada.Characters.Latin_1.SI); -- Shift In
end Set_Character_Mode;
procedure Set_Line_Mode is
begin
Put(Ada.Characters.Latin_1.SO); -- Shift out
end Set_Line_Mode;
-- The following procedures assume that the user
-- has called Set_Line_Mode first.
procedure Corner_UL is
begin
Put('l');
end Corner_UL;
procedure Corner_UR is
begin
Put('k');
end Corner_UR;
procedure Corner_LL is
begin
Put('m');
end Corner_LL;
procedure Corner_LR is
begin
Put('j');
end Corner_LR;
procedure Tee_Right is
begin
Put('t');
end Tee_Right;
procedure Tee_Left is
begin
Put('u');
end Tee_Left;
procedure Tee_Up is
begin
Put('v');
end Tee_Up;
procedure Tee_Down is
begin
Put('w');
end Tee_Down;
procedure Cross is
begin
Put('n');
end Cross;
procedure Vertical is
begin
Put('x');
end Vertical;
procedure Horizontal(Line : in Position := 3) is
begin
-- Convert Line Position value to
-- characters 'o' through 's'
Put(Character'Val(Character'Pos('n') + Line));
end Horizontal;
begin -- Initialization
Put(ASCII.ESC & "(B"); -- Set US char set as G0
Put(ASCII.ESC & ")0"); -- Set line char set as G1
end Screen.Graphics;
[-- Attachment #3: Card for John J Cupak Jr --]
[-- Type: text/x-vcard, Size: 428 bytes --]
begin: vcard
fn: John J Cupak Jr
n: Cupak Jr;John J
org: Raytheon Systems Company
adr: 50 Apple Hill Road;;T3MN35;Tewksbury;MA;01876;USA
email;internet: John_J_Cupak@res.raytheon.com
title: Software Engineering Instructor
tel;work: 978.858.1222
tel;fax: 978.858.4336
x-mozilla-cpt: ;0
x-mozilla-html: TRUE
version: 2.1
end: vcard
^ permalink raw reply [relevance 3%]
* Re: Library Level Question
@ 1999-02-15 0:00 4% ` David C. Hoos, Sr.
0 siblings, 0 replies; 200+ results
From: David C. Hoos, Sr. @ 1999-02-15 0:00 UTC (permalink / raw)
Steve Doiel wrote in message <36c853cb.0@news.pacifier.com>...
>What exactly is meant by Library Level
>
>Section 13.10.2 of the LRM gives the following description:
>
> (22)
> The accessibility level of all library units is called the library level;
>a library-level declaration or entity is one whose accessibility level is
>the library level.
>
>Does this mean unit specifications? Implementations? Either?
>I'm obviously not a language lawyer, but am often able to figure things out
>from the LRM. this has been an exception.
>
>My observation has been that when I try to take the address ('access) of a
>function or procedure that is defined within my main procedure, I get a
>message about the wrong library level. But if I take the address of a
>function or procedure defined inside a package spec or body, the compiler is
>happy.
>
Subprograms declared in packages are at library level, as are subprograms
such as your main program itself. For example, you could call any procedure
eligible to be a main procedure from within any other subprogram, merely by
mentioning the procedure in a context clause (with). But, subprograms
nested within that main-eligible procedure are not visible outside that
procedure, hence are not at library level.
Any subprogram which does not make use of variables external to it can be
defined by itself in a file -- only the body is required, because the
subprogram body exposed at library level is its own specification.
Here's an example:
--
-- File Name: util-execute_shell_command.adb
--
with Ada.Characters.Latin_1;
with System;
function Util.Execute_Shell_Command
(The_Command : String) return Integer is
function Execute
(The_Command_Address : System.Address) return Integer;
pragma Import (C, Execute, "system");
The_Nul_Terminated_Command_String : constant String :=
The_Command & Ada.Characters.Latin_1.Nul;
begin
return Execute (The_Nul_Terminated_Command_String'Address);
end Util.Execute_Shell_Command;
So, a unit that has the context clause
"with Util.Execute_Shell_Command;"
can take the 'Access attribute of the Execute_Shell_Command function,
but not the nested Execute function.
Of course the parent package Util must also be present for this example
to work -- e.g.:
--
-- File: util.ads
-- This specification is the parent for all UTIL specifications.
-- UTIL is the subsystem for utilities.
--
package Util is
pragma Pure (Util);
end Util;
I hope this is both sufficiently "layman's langusge" and clear.
David C. Hoos, Sr.
^ permalink raw reply [relevance 4%]
* Re: Passing a Command to Unix in Ada
@ 1999-02-09 0:00 4% ` David C. Hoos, Sr.
0 siblings, 0 replies; 200+ results
From: David C. Hoos, Sr. @ 1999-02-09 0:00 UTC (permalink / raw)
Robert T. Sagris wrote in message <36BCB222.EF9B4FF7@physics.BLAH.purdue.BLAH.edu>...
>I was wondering if there are any functions similar to the system
>command in C available in Ada. Also I was wondering if there was
>a similar function as rename in Ada.
>
>If you could give a translation for the following lines it would be
>most appreciated. *THIS IS NOT HOMEWORK* I am trying to rewrite a little
>program I wrote in C to Ada but don't no were to look. I have looked
>through Ada, as a Second Language by Cohen and found nothing
>useful for this problem
>
Here is a library function which interfaces to the C library "system" function, followed by a little test program to execute it.
This should serve to illustrate how to interface to _any_ C library function.
Strictly speaking, this technique does not "pass a command to Unix" -- rather it interfaces to the C library. In the case of
Execute_Shell_Command which interfaces to the C "System" command, I gave it the name I did for two reasons, viz.:
1. The name "System" cannot be used in Ada for a
user-defined entity, because it's a language-defined
package.
2. The name Execute_Shell_Command is more descriptive
of what it actually does. In some contexts, a program
which executes a shell command is considered a security
risk, so I make what it's doing more obvious.
---- begin Ada source code ----
with Ada.Characters.Latin_1;
with System;
function Execute_Shell_Command
(The_Command : String) return Integer is
function Execute
(The_Command_Address : System.Address) return Integer;
pragma Import (C, Execute, "system");
The_Nul_Terminated_Command_String : constant String :=
The_Command & Ada.Characters.Latin_1.Nul;
begin
return Execute (The_Nul_Terminated_Command_String'Address);
end Execute_Shell_Command;
with Ada.Command_Line;
with Ada.Text_Io;
with Execute_Shell_Command;
procedure Test_Execute_Shell_Command is
Status : Integer;
begin
Ada.Text_Io.Put_Line
("Program """ & Ada.Command_Line.Command_Name &
""" is executing the shell command """ &
Ada.Command_Line.Argument (1) & """");
Status := Execute_Shell_Command (Ada.Command_Line.Argument (1));
Ada.Text_Io.Put_Line
("Function "" Execute_Shell_Command"" returned" &
Integer'Image (Status));
end Test_Execute_Shell_Command;
---- end Ada source code ----
^ permalink raw reply [relevance 4%]
* Re: Serial Port Programming ??
@ 1999-02-08 0:00 4% ` David C. Hoos, Sr.
0 siblings, 0 replies; 200+ results
From: David C. Hoos, Sr. @ 1999-02-08 0:00 UTC (permalink / raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 11085 bytes --]
Fr�d�ric Besson wrote in message <36BC2987.322E2423@hei.fr>...
>I 'd like to use my serial port to exchange datas with
>an external card.
>But how can I exchange datas with the serial port with Ada?
>My configuration is: PC under Linux.
>
You didn't give full details, but the solution I provide here works for me with gnat-3.11 (set for native-threads RTS), and RedHat
5.2 (2.0.36).
I had this task on my plate anyway, so when I saw your post, I decided to do it now, rather than later.
This is far from being a finished work, but does demonstrate how it's done in Ada.
First, you need to get the florist library which is an Ada95 binding to POSIX, in accordance with the IEEE spec. The library is
available at http://www.cs.fsu.edu/~baker/ftp/pub/PART/FLORIST/
in the file "florist981211.tar.gz"
I had to apply the following patch to get the library to build:
---- begin patch ----
diff -Naur orig/florist-3.12w/posix-implementation.gpb new/florist-3.12w/posix-implementation.gpb
--- orig/florist-3.12w/posix-implementation.gpb Sat Sep 19 07:51:22 1998
+++ new/florist-3.12w/posix-implementation.gpb Mon Feb 8 13:24:56 1999
@@ -436,7 +436,9 @@
end To_Struct_Timeval;
#if HAVE_Leroy_Threads then
+ function getpid return pid_t;
+ pragma Import (C, getpid, getpid_LINKNAME);
begin
- This_Process := Process_ID (getpid);
+ This_Process := getpid;
#end if;
end POSIX.Implementation;
diff -Naur orig/florist-3.12w/posix-unsafe_process_primitives.gpb new/florist-3.12w/posix-unsafe_process_primitives.gpb
--- orig/florist-3.12w/posix-unsafe_process_primitives.gpb Sat Sep 19 07:51:33 1998
+++ new/florist-3.12w/posix-unsafe_process_primitives.gpb Mon Feb 8 13:24:56 1999
@@ -105,9 +105,9 @@
Result := fork;
if Result = -1 then Raise_POSIX_Error; end if;
if Result = 0 then
-# if HAVE_Leroy_Threads then
- This_Process := getpid;
-# end if;
+-- # if HAVE_Leroy_Threads then
+-- This_Process := getpid;
+-- # end if;
-- reset soft links to non-tasking versions of operations
# if HAVE_Soft_Abort_Defer
TSL.Abort_Defer := TSL.Abort_Defer_NT'Access;
--- end patch ---
Then I wrote a small test program which just sends "ATZ" to a modem, and waits for a response, and displays it, then sends "ATI7",
waits for the response, and displays it.
Here is the Ada95 source code for that test program:
---- begin Ada source code ----
with Ada.Calendar;
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Interfaces.C;
with POSIX.C;
with POSIX.IO;
with POSIX.Terminal_Functions;
with System;
procedure Serial is
-- NOTE: This is far from complete. Most of this should be in a separate
-- package, done to a higher level of abstraction, and implementation details
-- should be hidden.
-- This is just "quick and dirty" for proof of concept.
subtype File_Descriptor is POSIX.IO.File_Descriptor;
use type File_Descriptor;
subtype Bit_Rate is POSIX.Terminal_Functions.Baud_Rate;
Serial_File_Descriptor : File_Descriptor;
Characteristics : POSIX.Terminal_functions.Terminal_Characteristics;
Invalid_Command_Line : exception;
Unable_To_Open_Serial_Port : exception;
Invalid_Bit_Rate : exception;
use type POSIX.POSIX_String;
CR : constant POSIX.POSIX_Character := POSIX.POSIX_Character'Val (13);
LF : constant POSIX.POSIX_Character := POSIX.POSIX_Character'Val (10);
Modem_Reset : constant POSIX.POSIX_String := "ATZ" & CR;
Modem_Query : constant POSIX.POSIX_String := "ATI7" & CR;
Modem_Response : POSIX.POSIX_String (1 .. 20480);
Modem_Read_Length : POSIX.IO_Count;
Modem_Write_Length : POSIX.IO_Count;
Rate : Bit_Rate;
Modes : POSIX.Terminal_Functions.Terminal_Modes_Set;
use type POSIX.IO.Open_Option_Set;
function Image
(Modes : POSIX.Terminal_Functions.Terminal_Modes_Set)
return POSIX.POSIX_String is
Result : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.Null_Unbounded_String;
begin
for M in Modes'Range loop
declare
Modes_Image : constant String :=
POSIX.Terminal_Functions.Terminal_Modes'Image (M);
Spacer : constant String
( 1 .. (POSIX.Terminal_Functions.Terminal_Modes'Width -
Modes_Image'Length) + 1) := (others => ' ');
begin
Ada.Strings.Unbounded.Append
(Source => Result,
New_Item => Modes_Image &
Spacer & Boolean'Image
(Modes (M)) & Ada.Characters.Latin_1.LF);
end;
end loop;
return POSIX.To_POSIX_String (Ada.Strings.Unbounded.To_String (Result));
end Image;
procedure Read
(FD : File_Descriptor;
Item : out POSIX.POSIX_String;
Timeout : Duration;
Last : out POSIX.IO_Count)
is
use type POSIX.IO_Count;
begin
Last := POSIX.IO_Count (Item'First - 1);
-- Since the POSIX.IO.Read command will return whenever it reads a
-- CR character in the stream, we keep reading until there is a
-- period of Timeout seconds with no more input, then aborts the
-- blocking POSIX.IO>Read, and returns with the data.
-- This procedure is not robust in such areas as buffer overflow.
loop
select
delay Timeout;
exit;
then abort
POSIX.IO.Read
(File => FD,
Buffer => Item (Natural (Last) + 1 .. Item'Last),
Last => Last);
end select;
end loop;
end Read;
begin
if Ada.Command_Line.Argument_Count /= 3 then
Ada.Exceptions.Raise_Exception
(E => Invalid_Command_Line'Identity,
Message =>
"USAGE: " &
Ada.Command_Line.Command_Name &
" <device-name> <time-to-wait> (sec.) <bit-rate> (bps)");
end if;
declare
Device_Name : constant POSIX.Pathname :=
POSIX.To_POSIX_String (Ada.Command_Line.Argument (1));
Time_To_Wait : constant Duration :=
Duration'Value (Ada.Command_Line.Argument (2));
begin
begin
Rate := Bit_Rate'Value ("B" & Ada.Command_Line.Argument (3));
exception
when Constraint_Error =>
Ada.Exceptions.Raise_Exception
(E => Invalid_Bit_Rate'Identity,
Message =>
"Attempted setting => """ &
Ada.Command_Line.Argument (3) & """");
end;
select
-- We add one second here, so as to give time for the open operation.
delay Time_To_Wait + 1.0;
Ada.Exceptions.Raise_Exception
(E => Unable_To_Open_Serial_Port'Identity,
Message => "Operation timed out");
then abort
Ada.Text_IO.Put_Line
(POSIX.To_String
("Attempting to open """ &
Device_Name &
""" for input and output..."));
Serial_File_Descriptor := POSIX.IO.Open
(Name => Device_Name,
Mode => POSIX.IO.Read_Write,
Options =>
POSIX.IO.Not_Controlling_Terminal
- POSIX.IO.Non_Blocking);
end select;
exception
when E: others =>
Ada.Exceptions.Raise_Exception
(E => Ada.Exceptions.Exception_Identity (E),
Message => Ada.Exceptions.Exception_Information (E) &
POSIX.To_String
("while attempting to open file """ &
Device_Name &
""" for input"));
end;
-- If we get here, the file is open.
Characteristics := POSIX.Terminal_Functions.Get_Terminal_Characteristics
(File => Serial_File_Descriptor);
Modes := POSIX.Terminal_Functions.Terminal_Modes_Of
(Characteristics => Characteristics);
Ada.Text_IO.Put_Line
("Initial modes:" & Ada.Characters.Latin_1.Lf &
POSIX.To_String (Image (Modes)));
POSIX.Terminal_Functions.Define_Output_Baud_Rate
(Characteristics => Characteristics,
Output_Baud_Rate => Rate);
POSIX.Terminal_Functions.Define_Input_Baud_Rate
(Characteristics => Characteristics,
Input_Baud_Rate => Rate);
Modes (POSIX.Terminal_Functions.Canonical_Input) := False;
Modes (POSIX.Terminal_Functions.Map_Cr_To_Lf) := False;
Modes (POSIX.Terminal_Functions.Echo) := False;
POSIX.Terminal_Functions.Define_Terminal_Modes
(Characteristics => Characteristics,
Modes => Modes);
POSIX.Terminal_Functions.Define_Input_Time
(Characteristics => Characteristics,
Input_Time => 1.0);
POSIX.Terminal_Functions.Define_Minimum_Input_Count
(Characteristics => Characteristics,
Minimum_Input_Count => 0);
POSIX.Terminal_Functions.Set_Terminal_Characteristics
(File => Serial_File_Descriptor,
Characteristics => Characteristics,
Masked_Signals => POSIX.All_Signals);
Modes := POSIX.Terminal_Functions.Terminal_Modes_Of
(Characteristics => Characteristics);
Ada.Text_IO.Put_Line
("Operating modes:" & Ada.Characters.Latin_1.Lf &
POSIX.To_String (Image (Modes)));
delay 0.1;
POSIX.IO.Write
(File => Serial_File_Descriptor,
Buffer => Modem_Reset,
Last => Modem_Write_Length);
Ada.Text_IO.Put_Line ("Sent:");
Ada.Text_IO.Put_Line
(POSIX.To_String
(Modem_Reset
(Modem_Reset'First ..
Modem_Reset'First + Natural (Modem_Write_Length) - 1)));
Read
(FD => Serial_File_Descriptor,
Item => Modem_Response,
Last => Modem_Read_Length,
-- Alloww 0.1 sec. + 100 bit times
Timeout => 0.1 + 100.0 / Natural'Value (Ada.Command_Line.Argument (3)));
Ada.Text_IO.Put_Line
(POSIX.To_string
("Received: """ & Modem_Response
(Modem_Response'First ..
Modem_Response'First + Natural (Modem_Read_Length) - 1) &
""""));
POSIX.IO.Write
(File => Serial_File_Descriptor,
Buffer => Modem_Query,
Last => Modem_Write_Length);
Ada.Text_IO.Put_Line ("Sent:");
Ada.Text_IO.Put_Line
(POSIX.To_String
(Modem_Query
(Modem_Query'First ..
Modem_Query'First + Natural (Modem_Write_Length) - 1)));
Read
(FD => Serial_File_Descriptor,
item => Modem_Response,
Last => Modem_Read_Length,
-- Alloww 0.1 sec. + 100 bit times
Timeout => 0.1 + 100.0 / Natural'Value (Ada.Command_Line.Argument (3)));
Ada.Text_IO.Put_Line
(POSIX.To_string
("Received: """ & Modem_Response
(Modem_Response'First ..
Modem_Response'First + Natural (Modem_Read_Length) - 1) &
""""));
exception
when E: others =>
Ada.Text_IO.Put_Line
(Ada.Exceptions.Exception_Information (E));
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
end Serial;
--- end Ada source code ---
The device name to use is the appropriate ones of /dev/ttyS0 (for COM1:) through /dev/ttySn (for COMn+1:)
Hope this helps.
David C. Hoos, Sr.
^ permalink raw reply [relevance 4%]
* Re: "Beep" in DOS-Prog
[not found] <36498748.F6BE2505@NOSPAM_mailcity.com>
@ 1998-11-11 0:00 5% ` John Herro
0 siblings, 0 replies; 200+ results
From: John Herro @ 1998-11-11 0:00 UTC (permalink / raw)
9of7@NOSPAM_mailcity.com> writes:
> Can anybody tell me how to have the
> pc-speaker make a "beep" in an Ada program?
Try this:
with Ada.Text_IO, Ada.Characters.Latin_1; ...
Ada.Text_IO.Put(Ada.Characters.Latin_1.BEL);
- John Herro
http://members.aol.com/AdaTutor
^ permalink raw reply [relevance 5%]
* Re: ISO LATIN_1 in Windows 95 ?
1998-10-08 0:00 4% ` Jacob Sparre Andersen
@ 1998-10-12 0:00 4% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 1998-10-12 0:00 UTC (permalink / raw)
Jacob Sparre Andersen (sparre@meyer.fys.ku.dk) wrote:
: Hans Marqvardsen (hm@ddre.dk) wrote:
: : Is it really the case, that no codepage usable in Windows95
: : corresponds to Ada.Characters.Latin_1 ?
: An annoying, but usable solution would be to rewrite/modify Ada.Text_IO, so
: it translates between the available character encoding and Latin-1. It is a
: bit of work, but you're definitely not the only one who could use it.
I've seen a solution to this problem in the TeX sources
(also in the sources for the accompanying programs tangle and weave).
Georg
^ permalink raw reply [relevance 4%]
* Re: ISO LATIN_1 in Windows 95 ?
1998-10-07 0:00 5% ` Hans Marqvardsen
@ 1998-10-08 0:00 4% ` Jacob Sparre Andersen
1998-10-12 0:00 4% ` Georg Bauhaus
0 siblings, 1 reply; 200+ results
From: Jacob Sparre Andersen @ 1998-10-08 0:00 UTC (permalink / raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 966 bytes --]
Hans Marqvardsen (hm@ddre.dk) wrote:
: Is it really the case, that no codepage usable in Windows95
: corresponds to Ada.Characters.Latin_1 ?
Jerry suggested "ANSI_FIXED_FONT", whatever that is.
: Of course, one might argue, that if so, this is a Windows95 problem,
: not an Ada95 problem. Closing the question without solving the problem.
An annoying, but usable solution would be to rewrite/modify Ada.Text_IO, so
it translates between the available character encoding and Latin-1. It is a
bit of work, but you're definitely not the only one who could use it.
Jacob
----------------------------------------------------------------------------
-- Jacob Sparre Andersen -- E-mail: Jacob.Sparre.Andersen@risoe.dk --
-- National Laboratory Ris� -- Phone.: (+45) 46 77 51 23 --
-- Systems Analysis -- Fax...: (+45) 46 77 51 99 --
----------------------------------------------------------------------------
^ permalink raw reply [relevance 4%]
* Re: ISO LATIN_1 in Windows 95 ?
@ 1998-10-07 0:00 5% ` Hans Marqvardsen
1998-10-08 0:00 4% ` Jacob Sparre Andersen
0 siblings, 1 reply; 200+ results
From: Hans Marqvardsen @ 1998-10-07 0:00 UTC (permalink / raw)
dewarr@my-dejanews.com wrote:
> Well that's not quite right, or at least it is misleading. There is nothing
> in the Ada standard that prescribes the actual appearence of input or output
> characters, so in fact the encoding does not have to be "right" to have a
> conforming compiler. There must be an external representation for every
> Latin-1 character, but what this external representation might look like
> is not part of the standard.
>
> -----------== Posted via Deja News, The Discussion Network ==----------
> http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
Thanks for the clarification.
But isn't it confusing, that the external representation of
for example
Ada.Characters.Latin_1.LC_AE_Diphtong
looks nothing like an AE-diphtong in lower case,
but rather looks like the greek letter mju ?
Is it really the case, that no codepage usable in Windows95
corresponds to Ada.Characters.Latin_1 ?
Of course, one might argue, that if so, this is a Windows95 problem,
not an Ada95 problem. Closing the question without solving the problem.
-- Hans
^ permalink raw reply [relevance 5%]
* Re: ISO LATIN_1 in Windows 95 ?
1998-10-05 0:00 5% ISO LATIN_1 in Windows 95 ? Hans Marqvardsen
1998-10-06 0:00 4% ` Jacob Sparre Andersen
1998-10-06 0:00 0% ` dewarr
@ 1998-10-07 0:00 5% ` Jerry van Dijk
2 siblings, 0 replies; 200+ results
From: Jerry van Dijk @ 1998-10-07 0:00 UTC (permalink / raw)
Hans Marqvardsen (hm@ddre.dk) wrote:
: Does anyone know how to use ISO Latin_1 under Windows95?
: EG so that Put(Character'val(230))
: will in fact print LC_ae_diphtong,
: as defined in Ada.Characters.Latin_1 ?
Hmmm, from memory, ANSI_FIXED_FONT should on the console be
equivalent to LATIN_1.
Jerry.
--
-- Jerry van Dijk | email: jdijk@acm.org
-- Leiden, Holland | member Team-Ada
-- Ada & Win32: http://stad.dsl.nl/~jvandyk
^ permalink raw reply [relevance 5%]
* Re: ISO LATIN_1 in Windows 95 ?
1998-10-05 0:00 5% ISO LATIN_1 in Windows 95 ? Hans Marqvardsen
@ 1998-10-06 0:00 4% ` Jacob Sparre Andersen
1998-10-06 0:00 0% ` dewarr
1998-10-07 0:00 5% ` Jerry van Dijk
2 siblings, 1 reply; 200+ results
From: Jacob Sparre Andersen @ 1998-10-06 0:00 UTC (permalink / raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 1480 bytes --]
Hans Marqvardsen (hm@ddre.dk) wrote:
: Does anyone know how to use ISO Latin_1 under Windows95?
: EG so that Put(Character'val(230))
: will in fact print LC_ae_diphtong,
: as defined in Ada.Characters.Latin_1 ?
Doesn't it do that?
: (Under NT, you can use SetConsoleOutputCP(1252) and the
: font Lucida Console, but neither of these seem available
: in W95)
Ah. So the problem is actually how to get _Windows_95_ to use Latin-1 as
the character encoding in command line windows? I think this question
belongs on "comp.os.ms-windows" or something like that.
You can't have a working Ada compiler on/targeting a system that can't
interpret all of Latin-1 (strictly speaking). The usual solution seems
to be to assume that the character encoding _is_ Latin-1 in such cases.
GNAT has some flags to specify what character encoding is used for the
source files, so you might be able to extract some useful code from the
GNAT sources.
Greetings,
Jacob
PS: I think CP 1252 refers to Unicode BMP - a 16 bit character encoding - so
it is "reasonable" that Windows 95 can't handle it.
----------------------------------------------------------------------------
-- Jacob Sparre Andersen -- E-mail: Jacob.Sparre.Andersen@risoe.dk --
-- National Laboratory Ris� -- Phone.: (+45) 46 77 51 23 --
-- Systems Analysis -- Fax...: (+45) 46 77 51 99 --
----------------------------------------------------------------------------
^ permalink raw reply [relevance 4%]
* Re: ISO LATIN_1 in Windows 95 ?
1998-10-05 0:00 5% ISO LATIN_1 in Windows 95 ? Hans Marqvardsen
1998-10-06 0:00 4% ` Jacob Sparre Andersen
@ 1998-10-06 0:00 0% ` dewarr
1998-10-07 0:00 5% ` Jerry van Dijk
2 siblings, 0 replies; 200+ results
From: dewarr @ 1998-10-06 0:00 UTC (permalink / raw)
In article <3618A5D5.72C@ddre.dk>,
hm@ddre.dk_nospam wrote:
> Does anyone know how to use ISO Latin_1 under Windows95?
>
> EG so that Put(Character'val(230))
> will in fact print LC_ae_diphtong,
> as defined in Ada.Characters.Latin_1 ?
>
> (Under NT, you can use SetConsoleOutputCP(1252) and the
> font Lucida Console, but neither of these seem available
> in W95)
There probably is some answer to this, I don't know what it is. Another
possibility suitable in some circumstances is simply not to use Latin_1,
but instead use one of the PC code pages that includes dipthongs etc.
GNAT fully supports both of the standard PC code pages likely to be
used in this environment (the US one and the European one).
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
^ permalink raw reply [relevance 0%]
* ISO LATIN_1 in Windows 95 ?
@ 1998-10-05 0:00 5% Hans Marqvardsen
1998-10-06 0:00 4% ` Jacob Sparre Andersen
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Hans Marqvardsen @ 1998-10-05 0:00 UTC (permalink / raw)
Does anyone know how to use ISO Latin_1 under Windows95?
EG so that Put(Character'val(230))
will in fact print LC_ae_diphtong,
as defined in Ada.Characters.Latin_1 ?
(Under NT, you can use SetConsoleOutputCP(1252) and the
font Lucida Console, but neither of these seem available
in W95)
--Hans, hm at ddre dot dk
^ permalink raw reply [relevance 5%]
* Re: Ada bindings for MySQL? [long]
@ 1998-09-25 0:00 1% ` Samuel Tardieu
0 siblings, 0 replies; 200+ results
From: Samuel Tardieu @ 1998-09-25 0:00 UTC (permalink / raw)
>>>>> "Jeff" == Jeff Foster <acp59@dial.pipex.com> writes:
Jeff> Does anyone know if there are any Ada bindings for MySQL? In
Jeff> particular, for the GNU Ada 95 compiler.
I happened to write one (a quick and dirty hack) because I needed it
to access an existing database. I make no guarantee at all that it
still works (I'm just extracting a copy from my repository) and I do
not intend to maintain it. However, please report me any error so that
I can fix my local copy just in case it works well enough to be
reused and maybe released.
In fact, I since switched to PostGreSQL (http://www.postgresql.org/)
which proved to be a much more superior database with a clearer
licence (more in the "free software" spirit), and have written a
binding for this one, and intend to release it some time in the
future.
I haven't put a licence explicitely in each file, but you can consider
that this version is put in the public domain, you can do everything
with it, even declare that you are the author and sell it some
zillions :)
Extract what's included after my signature and run it through
gnatchop. Included is a test_mysql program that you can adapt.
For those who don't want to see long messages here, too bad if you
came up to this point, [long] was inserted in the subject :) But I
think it may benefit to many people, so I post it here.
Sam
--
Samuel Tardieu -- sam@ada.eu.org
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C.Strings; use Interfaces.C, Interfaces.C.Strings;
package body Mysql.Base is
use Thin;
-----------------------
-- Local Subprograms --
-----------------------
function TCPON (S : String) return chars_ptr;
-- If the string is not empty, return its C equivalent. Otherwise,
-- return Null_Ptr.
function Current_Field_Length (Conn : access Mysql_Connection)
return Natural;
-- Length of current field
procedure FCPINN (C : in out chars_ptr);
-- Free it if it is not Null_Ptr
procedure Raise_Mysql_Exception (Conn : access Mysql_Connection);
pragma No_Return (Raise_Mysql_Exception);
-- Raise an exception with the right error string
procedure Raise_Mysql_Exception (Message : in String := "");
pragma No_Return (Raise_Mysql_Exception);
-- Raise an exception with the corresponding message
function Error_String (Mysql : Mysql_Access) return String;
-- Return the error string corresponding to the last error
procedure Free is
new Ada.Unchecked_Deallocation (Thin.Mysql, Mysql_Access);
-----------------
-- Advance_Row --
-----------------
procedure Advance_Row (Conn : access Mysql_Connection) is
begin
Conn.Current_Row := Conn.Current_Row + 1;
Conn.Current_Field := -1;
if Conn.Current_Row >= Conn.Num_Rows then
raise Constraint_Error;
end if;
Conn.Row := Mysql_Fetch_Row (Conn.Result);
Conn.Lengths := Mysql_Fetch_Lengths (Conn.Result);
end Advance_Row;
-------------------
-- Affected_Rows --
-------------------
function Affected_Rows (Conn : access Mysql_Connection) return Natural is
begin
return Natural (Conn.Connection.Affected_Rows);
end Affected_Rows;
-------------
-- Connect --
-------------
procedure Connect (Conn : access Mysql_Connection;
Host : in String := "";
User : in String := "";
Password : in String := "")
is
C_Host : chars_ptr := TCPON (Host);
C_User : chars_ptr := TCPON (User);
C_Password : chars_ptr := TCPON (Password);
Success : Boolean;
begin
Success :=
Mysql_Connect (Conn.Connection, C_Host, C_User, C_Password) /= null;
FCPINN (C_Host);
FCPINN (C_User);
FCPINN (C_Password);
if not Success then
Raise_Mysql_Exception (Conn);
end if;
Conn.Connected := True;
end Connect;
---------------------
-- Create_Database --
---------------------
procedure Create_Database (Conn : access Mysql_Connection;
Base : in String)
is
C_Base : chars_ptr := New_String (Base);
Success : Boolean;
begin
Success := Mysql_Create_Db (Conn.Connection, C_Base) = 0;
Free (C_Base);
if not Success then
Raise_Mysql_Exception (Conn);
end if;
end Create_Database;
--------------------------
-- Current_Field_Length --
--------------------------
function Current_Field_Length (Conn : access Mysql_Connection)
return Natural
is
begin
return Natural (Conn.Lengths (Conn.Current_Field));
end Current_Field_Length;
------------------------
-- Current_Field_Type --
------------------------
function Current_Field_Type (Conn : access Mysql_Connection)
return Thin.Mysql_Field
is
begin
return Conn.Result.Fields (Conn.Current_Field);
end Current_Field_Type;
-------------------
-- Drop_Database --
-------------------
procedure Drop_Database (Conn : access Mysql_Connection;
Base : in String)
is
C_Base : chars_ptr := New_String (Base);
Success : Boolean;
begin
Success := Mysql_Drop_Db (Conn.Connection, C_Base) = 0;
Free (C_Base);
if not Success then
Raise_Mysql_Exception (Conn);
end if;
end Drop_Database;
------------------
-- Error_String --
------------------
function Error_String (Mysql : Mysql_Access) return String is
begin
return To_Ada (Mysql.Net_Field.Last_Error);
end Error_String;
--------------
-- Finalize --
--------------
procedure Finalize (O : in out Mysql_Connection) is
begin
Free_Result (O'Access);
if O.Connected then
Mysql_Close (O.Connection);
O.Connected := False;
end if;
Free (O.Connection);
end Finalize;
------------
-- FCPINN --
------------
procedure FCPINN (C : in out chars_ptr) is
begin
if C /= Null_Ptr then
Free (C);
end if;
end FCPINN;
-----------------
-- Field_Count --
-----------------
function Field_Count (Conn : access Mysql_Connection) return Natural is
begin
return Conn.Num_Fields;
end Field_Count;
-----------------
-- Free_Result --
-----------------
procedure Free_Result (Conn : access Mysql_Connection) is
begin
if Conn.Result /= null then
Mysql_Free_Result (Conn.Result);
Conn.Result := null;
end if;
end Free_Result;
---------------------
-- Get_Client_Info --
---------------------
function Get_Client_Info return String is
begin
return Value (Mysql_Get_Client_Info);
end Get_Client_Info;
-------------------
-- Get_Host_Info --
-------------------
function Get_Host_Info (Conn : access Mysql_Connection) return String is
begin
return Value (Mysql_Get_Host_Info (Conn.Connection));
end Get_Host_Info;
--------------------
-- Get_Proto_Info --
--------------------
function Get_Proto_Info (Conn : access Mysql_Connection) return Natural is
begin
return Natural (Mysql_Get_Proto_Info (Conn.Connection));
end Get_Proto_Info;
---------------------
-- Get_Server_Info --
---------------------
function Get_Server_Info (Conn : access Mysql_Connection) return String is
begin
return Value (Mysql_Get_Server_Info (Conn.Connection));
end Get_Server_Info;
----------------
-- Initialize --
----------------
procedure Initialize (O : in out Mysql_Connection) is
begin
O.Connection := new Thin.Mysql;
end Initialize;
---------------
-- Insert_Id --
---------------
function Insert_Id (Conn : access Mysql_Connection) return Natural is
begin
return Natural (Conn.Connection.Insert_Id);
end Insert_Id;
----------------
-- Next_Field --
----------------
function Next_Field (Conn : access Mysql_Connection)
return Char_Subarray_Access
is
begin
if Conn.Current_Row = -1 then
raise Constraint_Error;
end if;
Conn.Current_Field := Conn.Current_Field + 1;
if Conn.Current_Field >= Conn.Num_Fields then
raise Constraint_Error;
end if;
return Conn.Row (Conn.Current_Field);
end Next_Field;
--------------------------
-- Next_Field_As_String --
--------------------------
function Next_Field_As_String (Conn : access Mysql_Connection)
return String
is
Current_Field : constant Char_Subarray_Access := Next_Field (Conn);
Field_Length : constant Natural :=
Current_Field_Length (Conn);
Result : String (1 .. Field_Length);
begin
for I in Result'Range loop
Result (I) := Character'Val (char'Pos (Current_Field (size_t (I))));
end loop;
return Result;
end Next_Field_As_String;
-----------
-- Query --
-----------
procedure Query
(Conn : access Mysql_Connection;
Query : in String;
Result_On_Server : in Boolean := False)
is
begin
if Conn.Result /= null then
Free_Result (Conn);
end if;
Conn.Num_Rows := 0;
Conn.Current_Row := -1;
if
Mysql_Real_Query (Conn.Connection, Query'Address, Query'Length) /= 0
then
Raise_Mysql_Exception (Conn);
end if;
if Result_On_Server then
Conn.Result := Mysql_Use_Result (Conn.Connection);
else
Conn.Result := Mysql_Store_Result (Conn.Connection);
end if;
if Conn.Result = null then
Conn.Num_Rows := 0;
Conn.Num_Fields := 0;
else
Conn.Num_Rows := Natural (Conn.Result.Row_Count);
Conn.Num_Fields := Natural (Conn.Result.Field_Count);
end if;
end Query;
-----------
-- Query --
-----------
function Query
(Conn : access Mysql_Connection;
Query : String;
Result_On_Server : Boolean := False)
return Natural
is
begin
Base.Query (Conn, Query, Result_On_Server);
return Row_Count (Conn);
end Query;
---------------------------
-- Raise_Mysql_Exception --
---------------------------
procedure Raise_Mysql_Exception (Message : in String := "") is
begin
Raise_Exception (Mysql_Error'Identity, Message);
end Raise_Mysql_Exception;
---------------------------
-- Raise_Mysql_Exception --
---------------------------
procedure Raise_Mysql_Exception (Conn : access Mysql_Connection) is
begin
Raise_Mysql_Exception (Error_String (Conn.Connection));
end Raise_Mysql_Exception;
---------------
-- Row_Count --
---------------
function Row_Count (Conn : access Mysql_Connection) return Natural is
begin
return Conn.Num_Rows;
end Row_Count;
---------------------
-- Select_Database --
---------------------
procedure Select_Database (Conn : access Mysql_Connection;
Database : in String)
is
C_Database : chars_ptr := New_String (Database);
Ok : Boolean;
begin
Ok := Mysql_Select_Db (Conn.Connection, C_Database) = 0;
Free (C_Database);
if not Ok then
Raise_Mysql_Exception (Conn);
end if;
end Select_Database;
--------------
-- Shutdown --
--------------
procedure Shutdown (Conn : access Mysql_Connection) is
begin
if Mysql_Shutdown (Conn.Connection) /= 0 then
Raise_Mysql_Exception (Conn);
end if;
end Shutdown;
-----------
-- TCPON --
-----------
function TCPON (S : String) return chars_ptr is
begin
if S = "" then
return Null_Ptr;
else
return New_String (S);
end if;
end TCPON;
end Mysql.Base;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Ada.Finalization;
with Mysql.Thin;
package Mysql.Base is
type Mysql_Connection is
new Ada.Finalization.Limited_Controlled with private;
-- A mySQL connection with the database
Mysql_Error : exception;
procedure Connect (Conn : access Mysql_Connection;
Host : in String := "";
User : in String := "";
Password : in String := "");
-- Connect onto a database. If host is not specified, then localhost
-- is assumed. An exception is raised when it is not possible to connect
-- to the database.
function Get_Client_Info return String;
-- Return client information
function Get_Server_Info (Conn : access Mysql_Connection) return String;
-- Return server information
function Get_Host_Info (Conn : access Mysql_Connection) return String;
-- Return host information
function Get_Proto_Info (Conn : access Mysql_Connection) return Natural;
-- Return protocol information
procedure Select_Database (Conn : access Mysql_Connection;
Database : in String);
-- Select the current database
procedure Query
(Conn : access Mysql_Connection;
Query : in String;
Result_On_Server : in Boolean := False);
-- Perform a query
function Query
(Conn : access Mysql_Connection;
Query : String;
Result_On_Server : Boolean := False)
return Natural;
-- Perform a query and return the number of rows returned by the server.
-- If Result_On_Server is True, then the results will not be downloaded.
function Row_Count (Conn : access Mysql_Connection) return Natural;
pragma Inline (Row_Count);
-- Return the number of rows returned by the latest query
function Field_Count (Conn : access Mysql_Connection) return Natural;
pragma Inline (Field_Count);
-- Return the number of fields returned by the latest query
function Insert_Id (Conn : access Mysql_Connection) return Natural;
-- In case of auto-increment variable, return the latest one that has
-- been automatically inserted by the last command.
procedure Free_Result (Conn : access Mysql_Connection);
-- Free the result once it is of no more use
function Affected_Rows (Conn : access Mysql_Connection) return Natural;
-- Return the number of rows affected by the last UPDATE, DELETE or INSERT
-- command. If the whole table has been erased, then it returns 0 due to
-- MySQL optimizations.
procedure Advance_Row (Conn : access Mysql_Connection);
-- Advance by one row in the result set. Raise Constraint_Error if there
-- are no more rows.
function Next_Field (Conn : access Mysql_Connection)
return Thin.Char_Subarray_Access;
-- Return the next field. Raise Constraint_Error if there are no more
-- fields in the row.
function Next_Field_As_String (Conn : access Mysql_Connection)
return String;
-- Return a string representing the next field
function Current_Field_Type (Conn : access Mysql_Connection)
return Thin.Mysql_Field;
-- Return the type of the current field
procedure Create_Database (Conn : access Mysql_Connection;
Base : in String);
-- Create a new database
procedure Drop_Database (Conn : access Mysql_Connection;
Base : in String);
-- Remove a database
procedure Shutdown (Conn : access Mysql_Connection);
-- Shutdown the MySQL server
private
type Mysql_Connection is new Ada.Finalization.Limited_Controlled with record
Connection : Thin.Mysql_Access;
Connected : Boolean := False;
Result : Thin.Mysql_Res_Access;
Num_Rows : Natural;
Num_Fields : Natural;
Row : Thin.Mysql_Row;
Current_Row : Integer;
Current_Field : Integer;
Lengths : Thin.Unsigned_Array_Access;
end record;
procedure Initialize (O : in out Mysql_Connection);
procedure Finalize (O : in out Mysql_Connection);
pragma Inline (Affected_Rows);
pragma Inline (Free_Result);
pragma Inline (Get_Client_Info);
pragma Inline (Get_Host_Info);
pragma Inline (Get_Proto_Info);
pragma Inline (Get_Server_Info);
pragma Inline (Insert_Id);
end Mysql.Base;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
package body Mysql.Insert is
use Mysql.Base;
------------
-- Insert --
------------
procedure Insert (Conn : access Mysql_Connection;
Table : in String;
S : in Struct;
Fields : in String := "")
is
begin
if Fields = "" then
Query (Conn, "INSERT INTO " & Table & " VALUES (" &
Write (S) & ")");
else
Query (Conn, "INSERT INTO " & Table & "(" & Fields & ") VALUES (" &
Write (S) & ")");
end if;
end Insert;
end Mysql.Insert;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Mysql.Base;
generic
type Struct is private;
with function Write (S : Struct) return String;
-- Write must return a comma separated string of values
package Mysql.Insert is
procedure Insert (Conn : access Base.Mysql_Connection;
Table : in String;
S : in Struct;
Fields : in String := "");
-- Insert a struct into a table. If no value is given for Fields, then
-- all the fields will be used.
end Mysql.Insert;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Ada.Exceptions; use Ada.Exceptions;
with Mysql.Types; use Mysql.Types;
package body Mysql.Shortcuts is
use Mysql.Base;
-----------------
-- Short_Query --
-----------------
function Short_Query (Db : access Base.Mysql_Connection;
Query : String)
return String
is
begin
if Base.Query (Db, Query) /= 1 then
Raise_Exception (Constraint_Error'Identity,
"Not exactly one row returned for Short_Query");
end if;
if Field_Count (Db) /= 1 then
Raise_Exception (Constraint_Error'Identity,
"Not exactly one column returned for Short_Query");
end if;
Advance_Row (Db);
return Fetch_Field (Db);
end Short_Query;
-----------------
-- Short_Query --
-----------------
function Short_Query (Db : access Base.Mysql_Connection;
Query : String)
return Integer
is
begin
return Integer'Value (Short_Query (Db, Query));
end Short_Query;
-----------------
-- Short_Query --
-----------------
function Short_Query (Db : access Base.Mysql_Connection;
Query : String)
return Float
is
begin
return Float'Value (Short_Query (Db, Query));
end Short_Query;
end Mysql.Shortcuts;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Mysql.Base;
package Mysql.Shortcuts is
function Short_Query (Db : access Base.Mysql_Connection;
Query : String)
return String;
-- Execute a query for which the result will only be one string. If this
-- is not the case, Constraint_Error will be raised.
function Short_Query (Db : access Base.Mysql_Connection;
Query : String)
return Integer;
-- Similar function for integer types
function Short_Query (Db : access Base.Mysql_Connection;
Query : String)
return Float;
-- Similar function for floating point types
end Mysql.Shortcuts;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
package body Mysql.Struct is
use Mysql.Base;
--------------
-- Read_All --
--------------
function Read_All (Conn : access Mysql_Connection) return Struct_Array is
Rows : constant Natural := Row_Count (Conn);
Result : Struct_Array (1 .. Rows);
begin
for I in Result'Range loop
Advance_Row (Conn);
Result (I) := Read (Conn);
end loop;
return Result;
end Read_All;
--------------
-- Read_All --
--------------
function Read_All
(Conn : access Mysql_Connection;
Query : String)
return Struct_Array is
begin
Base.Query (Conn, Query);
return Read_All (Conn);
end Read_All;
end Mysql.Struct;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Mysql.Base;
generic
type Struct is private;
type Struct_Array is array (Positive range <>) of Struct;
with function Read (Conn : access Base.Mysql_Connection) return Struct;
-- Read will return a struct using Mysql.Types functions
package Mysql.Struct is
function Read_All (Conn : access Base.Mysql_Connection)
return Struct_Array;
-- Read all the results from the previous query
function Read_All (Conn : access Base.Mysql_Connection;
Query : String)
return Struct_Array;
-- Perform the query and read the results
end Mysql.Struct;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Interfaces.C.Strings; use Interfaces.C, Interfaces.C.Strings;
with System;
package Mysql.Thin is
pragma Preelaborate;
type Used_Mem;
type Used_Mem_Access is access Used_Mem;
pragma Convention (C, Used_Mem_Access);
type Used_Mem is record
Next : Used_Mem_Access;
Left : unsigned;
Size : unsigned;
end record;
pragma Convention (C, Used_Mem);
type Error_Handler_Type is access procedure;
pragma Convention (C, Error_Handler_Type);
type Mem_Root is record
Free : Used_Mem;
Used : Used_Mem;
Min_Malloc : unsigned;
Block_Size : unsigned;
Error_Handler : Error_Handler_Type;
end record;
pragma Convention (C, Mem_Root);
Mysql_Errmsg_Size : constant := 200;
type My_Bool is new char;
type Socket is new int;
type Net is record
Fd : Socket;
Fcntl : int;
Buff : chars_ptr;
Buff_End : chars_ptr;
Write_Pos : chars_ptr;
Last_Error : char_array (1 .. Mysql_Errmsg_Size);
Last_Errno : unsigned;
Max_Packet : unsigned;
Timeout : unsigned;
Pkt_Nr : unsigned;
Error : My_Bool;
Return_Errno : My_Bool;
end record;
pragma Convention (C, Net);
type Field_Types is (Field_Type_Decimal, Field_Type_Tiny,
Field_Type_Short, Field_Type_Long,
Field_Type_Float, Field_Type_Double,
Field_Type_Null, Field_Type_Timestamp,
Field_Type_Longlong, Field_Type_Int24,
Field_Type_Date, Field_Type_Time,
Field_Type_Datetime,
Field_Type_Enum,
Field_Type_Set,
Field_Type_Tiny_Blob,
Field_Type_Medium_Blob,
Field_Type_Long_Blob,
Field_Type_Blob,
Field_Type_Var_String,
Field_Type_String);
for Field_Types use (Field_Type_Decimal => 0,
Field_Type_Tiny => 1,
Field_Type_Short => 2,
Field_Type_Long => 3,
Field_Type_Float => 4,
Field_Type_Double => 5,
Field_Type_Null => 6,
Field_Type_Timestamp => 7,
Field_Type_Longlong => 8,
Field_Type_Int24 => 9,
Field_Type_Date => 10,
Field_Type_Time => 11,
Field_Type_Datetime => 12,
Field_Type_Enum => 247,
Field_Type_Set => 248,
Field_Type_Tiny_Blob => 249,
Field_Type_Medium_Blob => 250,
Field_Type_Long_Blob => 251,
Field_Type_Blob => 252,
Field_Type_Var_String => 253,
Field_Type_String => 254);
for Field_Types'Size use int'Size;
pragma Convention (C, Field_Types);
type Mysql_Field is record
Name : chars_ptr;
Table : chars_ptr;
Def : chars_ptr;
Typ : Field_Types;
Length : unsigned;
Max_Length : unsigned;
Flags : unsigned;
Decimals : unsigned;
end record;
pragma Convention (C, Mysql_Field);
type Mysql_Field_Access is access Mysql_Field;
pragma Convention (C, Mysql_Field_Access);
type Mysql_Field_Array is array (0 .. 65536) of Mysql_Field;
pragma Convention (C, Mysql_Field_Array);
type Mysql_Field_Array_Access is access Mysql_Field_Array;
pragma Convention (C, Mysql_Field_Array_Access);
subtype Char_Subarray is char_array (1 .. 65535);
type Char_Subarray_Access is access Char_Subarray;
pragma Convention (C, Char_Subarray_Access);
type Byte_Access_Array is array (0 .. 65535) of Char_Subarray_Access;
pragma Convention (C, Byte_Access_Array);
type Mysql_Row is access Byte_Access_Array;
pragma Convention (C, Mysql_Row);
type Mysql_Field_Offset is new unsigned;
type Mysql_Rows;
type Mysql_Rows_Access is access Mysql_Rows;
pragma Convention (C, Mysql_Rows_Access);
type Mysql_Rows is record
Next : Mysql_Rows_Access;
Data : Mysql_Row;
end record;
pragma Convention (C, Mysql_Rows);
type Mysql_Row_Offset is access Mysql_Rows;
pragma Convention (C, Mysql_Row_Offset);
type Mysql_Data is record
Rows : unsigned;
Fields : unsigned;
Data : Mysql_Rows;
Alloc : Mem_Root;
end record;
pragma Convention (C, Mysql_Data);
type Mysql_Data_Access is access Mysql_Data;
pragma Convention (C, Mysql_Data_Access);
type Mysql_Status is (Mysql_Status_Ready, Mysql_Status_Get_Result,
Mysql_Status_Use_Result);
for Mysql_Status'Size use int'Size;
pragma Convention (C, Mysql_Status);
type Mysql is record
Net_Field : Net;
Host : chars_ptr;
User : chars_ptr;
Passwd : chars_ptr;
Unix_Socket : chars_ptr;
Server_Version : chars_ptr;
Host_Info : chars_ptr;
Info : chars_ptr;
Db : chars_ptr;
Port : unsigned;
Client_Flag : unsigned;
Server_Capabilities : unsigned;
Protocol_Version : unsigned;
Field_Count : unsigned;
Thread_Id : unsigned_long;
Affected_Rows : unsigned_long;
Insert_Id : unsigned_long;
Extra_Info : unsigned_long;
Status : Mysql_Status;
Fields : Mysql_Field_Array_Access;
Field_Alloc : Mem_Root;
Free_Me : My_Bool;
Reconnect : My_Bool;
end record;
pragma Convention (C, Mysql);
type Mysql_Access is access Mysql;
pragma Convention (C, Mysql_Access);
type Unsigned_Array is array (0 .. 65535) of unsigned;
pragma Convention (C, Unsigned_Array);
type Unsigned_Array_Access is access Unsigned_Array;
pragma Convention (C, Unsigned_Array_Access);
type Mysql_Res is record
Row_Count : unsigned_long;
Field_Count : unsigned;
Current_Field : unsigned;
Fields : Mysql_Field_Array_Access;
Data : Mysql_Data_Access;
Data_Cursor : Mysql_Rows_Access;
Field_Alloc : Mem_Root;
Row : Mysql_Row;
Current_Row : Mysql_Row;
Lengths : Unsigned_Array_Access;
Handle : Mysql_Access;
Eof : My_Bool;
end record;
pragma Convention (C, Mysql_Res);
type Mysql_Res_Access is access Mysql_Res;
pragma Convention (C, Mysql_Res_Access);
function Mysql_Connect (Mysql : Mysql_Access;
Host : chars_ptr;
User : chars_ptr;
Passwd : chars_ptr)
return Mysql_Access;
pragma Import (C, Mysql_Connect, "mysql_connect");
function Mysql_Real_Connect (Mysql : Mysql_Access;
Host : chars_ptr;
User : chars_ptr;
Passwd : chars_ptr;
Port : unsigned;
Unix_Socket : chars_ptr;
Clientflag : unsigned)
return Mysql_Access;
pragma Import (C, Mysql_Real_Connect, "mysql_real_connect");
procedure Mysql_Close (Sock : in Mysql_Access);
pragma Import (C, Mysql_Close, "mysql_close");
function Mysql_Select_Db (Mysql : Mysql_Access;
Db : chars_ptr)
return int;
pragma Import (C, Mysql_Select_Db, "mysql_select_db");
function Mysql_Query (Mysql : Mysql_Access;
Q : chars_ptr)
return int;
pragma Import (C, Mysql_Query, "mysql_query");
function Mysql_Real_Query (Mysql : Mysql_Access;
Q : System.Address;
Length : unsigned)
return int;
pragma Import (C, Mysql_Real_Query, "mysql_real_query");
function Mysql_Create_Db (Mysql : Mysql_Access;
Db : chars_ptr)
return int;
pragma Import (C, Mysql_Create_Db, "mysql_create_db");
function Mysql_Drop_Db (Mysql : Mysql_Access;
Db : chars_ptr)
return int;
pragma Import (C, Mysql_Drop_Db, "mysql_drop_db");
function Mysql_Shutdown (Mysql : Mysql_Access) return int;
pragma Import (C, Mysql_Shutdown, "mysql_shutdown");
function Mysql_Dump_Debug_Info (Mysql : Mysql_Access) return int;
pragma Import (C, Mysql_Dump_Debug_Info, "mysql_dump_debug_info");
function Mysql_Refresh (Mysql : Mysql_Access;
Refresh_Options : unsigned)
return int;
pragma Import (C, Mysql_Refresh, "mysql_refresh");
function Mysql_Kill (Mysql : Mysql_Access;
Pid : unsigned_long)
return int;
pragma Import (C, Mysql_Kill, "mysql_kill");
function Mysql_Stat (Mysql : Mysql_Access) return chars_ptr;
pragma Import (C, Mysql_Stat, "mysql_stat");
function Mysql_Get_Server_Info (Mysql : Mysql_Access) return chars_ptr;
pragma Import (C, Mysql_Get_Server_Info, "mysql_get_server_info");
function Mysql_Get_Client_Info return chars_ptr;
pragma Import (C, Mysql_Get_Client_Info, "mysql_get_client_info");
function Mysql_Get_Host_Info (Mysql : Mysql_Access) return chars_ptr;
pragma Import (C, Mysql_Get_Host_Info, "mysql_get_host_info");
function Mysql_Get_Proto_Info (Mysql : Mysql_Access) return unsigned;
pragma Import (C, Mysql_Get_Proto_Info, "mysql_get_proto_info");
function Mysql_List_Dbs (Mysql : Mysql_Access;
Wild : chars_ptr)
return Mysql_Res_Access;
pragma Import (C, Mysql_List_Dbs, "mysql_list_dbs");
function Mysql_List_Tables (Mysql : Mysql_Access;
Wild : chars_ptr)
return Mysql_Res_Access;
pragma Import (C, Mysql_List_Tables, "mysql_list_tables");
function Mysql_List_Fields (Mysql : Mysql_Access;
Table : chars_ptr;
Wild : chars_ptr)
return Mysql_Res_Access;
pragma Import (C, Mysql_List_Fields, "mysql_list_fields");
function Mysql_List_Processes (Mysql : Mysql_Access)
return Mysql_Res_Access;
pragma Import (C, Mysql_List_Processes, "mysql_list_processes");
function Mysql_Store_Result (Mysql : Mysql_Access) return Mysql_Res_Access;
pragma Import (C, Mysql_Store_Result, "mysql_store_result");
function Mysql_Use_Result (Mysql : Mysql_Access) return Mysql_Res_Access;
pragma Import (C, Mysql_Use_Result, "mysql_use_result");
procedure Mysql_Free_Result (Result : in Mysql_Res_Access);
pragma Import (C, Mysql_Free_Result, "mysql_free_result");
procedure Mysql_Data_Seek (Mysql : in Mysql_Res_Access;
Offset : in unsigned);
pragma Import (C, Mysql_Data_Seek, "mysql_data_seek");
function Mysql_Row_Seek (Mysql : Mysql_Res_Access;
Offset : unsigned)
return Mysql_Row_Offset;
pragma Import (C, Mysql_Row_Seek, "mysql_row_seek");
function Mysql_Field_Seek (Mysql : Mysql_Res_Access;
Offset : Mysql_Field_Offset)
return Mysql_Field_Offset;
pragma Import (C, Mysql_Field_Seek, "mysql_field_seek");
function Mysql_Fetch_Row (Mysql : Mysql_Res_Access) return Mysql_Row;
pragma Import (C, Mysql_Fetch_Row, "mysql_fetch_row");
function Mysql_Fetch_Lengths (Mysql : Mysql_Res_Access)
return Unsigned_Array_Access;
pragma Import (C, Mysql_Fetch_Lengths, "mysql_fetch_lengths");
function Mysql_Fetch_Field (Handle : Mysql_Res_Access)
return Mysql_Field_Access;
pragma Import (C, Mysql_Fetch_Field, "mysql_fetch_field");
function Mysql_Escape_String (To : System.Address;
From : System.Address;
Length : unsigned)
return unsigned;
pragma Import (C, Mysql_Escape_String, "mysql_escape_string");
procedure Mysql_Debug (Debug : in chars_ptr);
pragma Import (C, Mysql_Debug, "mysql_debug");
pragma Linker_Options ("-lmysqlclient");
pragma Linker_Options ("-lpthread");
pragma Linker_Options ("-lm");
end Mysql.Thin;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Strings.Fixed; use Ada.Strings, Ada.Strings.Fixed;
with Ada.Unchecked_Conversion;
with Interfaces.C; use Interfaces.C;
package body Mysql.Types is
use Ada.Calendar, Ada.Streams, Mysql.Base, Mysql.Thin;
function Field_Type (Conn : access Base.Mysql_Connection)
return Field_Types;
pragma Inline (Field_Type);
-- Return the type of the current field
function Escape_Duration (D : Duration) return String;
-- Return a duration without quotes
function To_Duration (S : String) return Duration;
-- Read a string of form [-]HH:MM:SS and get a duration from it
function To_Time (S : String) return Time;
-- Read a string of form YYYY-MM-DD[[ -]HH:MM:SS] and get a time from it
------------
-- Escape --
------------
function Escape (S : String) return String is
Result : String (1 .. S'Length * 2 + 2);
Last : Natural := 1;
begin
Result (1) := Quotation;
for I in S'Range loop
case S (I) is
when Ada.Characters.Latin_1.NUL =>
Last := Last + 2;
Result (Last - 1 .. Last) := "\0";
when LF =>
Last := Last + 2;
Result (Last - 1 .. Last) := "\n";
when HT =>
Last := Last + 2;
Result (Last - 1 .. Last) := "\t";
when CR =>
Last := Last + 2;
Result (Last - 1 .. Last) := "\r";
when BS =>
Last := Last + 2;
Result (Last - 1 .. Last) := "\b";
when Apostrophe | Quotation | Reverse_Solidus =>
Last := Last + 2;
Result (Last - 1) := '\';
Result (Last) := S (I);
when others =>
Last := Last + 1;
Result (Last) := S (I);
end case;
end loop;
Last := Last + 1;
Result (Last) := Quotation;
return Result (1 .. Last);
end Escape;
------------
-- Escape --
------------
function Escape (S : access String) return String is
begin
return Escape (S.all);
end Escape;
------------
-- Escape --
------------
function Escape (I : Integer) return String is
begin
return Trim (Integer'Image (I), Side => Left);
end Escape;
------------
-- Escape --
------------
function Escape (T : Time) return String is
T_Year : Year_Number;
T_Month : Month_Number;
T_Day : Day_Number;
Seconds : Day_Duration;
function To_Duration is
new Ada.Unchecked_Conversion (Time, Duration);
begin
Split (Date => T, Year => T_Year, Month => T_Month, Day => T_Day,
Seconds => Seconds);
return """" & Escape (T_Year) & "-" & Escape (T_Month) & "-" &
Escape (T_Day) & " " & Escape_Duration (Seconds) & """";
end Escape;
------------
-- Escape --
------------
function Escape (F : Float) return String is
begin
return Trim (Float'Image (F), Side => Left);
end Escape;
------------
-- Escape --
------------
function Escape (S : Stream_Element_Array) return String is
Result : String (1 .. S'Length);
Index : Positive := 1;
begin
for I in S'Range loop
Result (Index) := Character'Val (Stream_Element'Pos (S (I)));
Index := Index + 1;
end loop;
return Result;
end Escape;
------------
-- Escape --
------------
function Escape (D : Duration) return String is
begin
return """" & Escape_Duration (D) & """";
end Escape;
---------------------
-- Escape_Duration --
---------------------
function Escape_Duration (D : Duration) return String is
H : constant Integer := Integer (abs D) / 3600;
M : constant Natural := (Integer (abs D) - H * 3600) / 60;
S : constant Natural := (Integer (abs D) - H * 3600 - M * 60);
begin
if D < 0.0 then
return "-" & Escape (H) & ":" & Escape (M) & ":" & Escape (S);
else
return Escape (H) & ":" & Escape (M) & ":" & Escape (S);
end if;
end Escape_Duration;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Integer
is
Str : constant String := Next_Field_As_String (Conn);
begin
pragma Assert
(Field_Type (Conn) = Field_Type_Tiny or else
Field_Type (Conn) = Field_Type_Short or else
Field_Type (Conn) = Field_Type_Long);
return Integer'Value (Str);
end Fetch_Field;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return String
is
Str : constant String := Next_Field_As_String (Conn);
begin
pragma Assert
(Field_Type (Conn) = Field_Type_String or else
Field_Type (Conn) = Field_Type_Var_String);
return Str;
end Fetch_Field;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Stream_Element_Array
is
Str : constant String := Next_Field_As_String (Conn);
Result : Stream_Element_Array (1 .. Str'Length);
Index : Stream_Element_Offset := 1;
begin
pragma Assert
(Field_Type (Conn) = Field_Type_Tiny_Blob or else
Field_Type (Conn) = Field_Type_Medium_Blob or else
Field_Type (Conn) = Field_Type_Long_Blob or else
Field_Type (Conn) = Field_Type_Blob or else
Field_Type (Conn) = Field_Type_String or else
Field_Type (Conn) = Field_Type_Var_String);
for I in Str'Range loop
Result (Index) := Stream_Element'Val (Character'Pos (Str (I)));
Index := Index + 1;
end loop;
return Result;
end Fetch_Field;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return String_Access
is
begin
return new String'(Fetch_Field (Conn));
end Fetch_Field;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Time
is
Str : constant String := Next_Field_As_String (Conn);
Typ : constant Field_Types := Field_Type (Conn);
begin
-- ??? Wrong
if Typ = Field_Type_Timestamp then
declare
function To_Time is
new Ada.Unchecked_Conversion (Duration, Time);
begin
return To_Time (Duration (Integer'Value (Str)));
end;
else
return To_Time (Str);
end if;
end Fetch_Field;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Duration
is
Str : constant String := Next_Field_As_String (Conn);
Typ : constant Field_Types := Field_Type (Conn);
begin
if Typ = Field_Type_Timestamp then
return Duration (Integer'Value (Str));
end if;
pragma Assert (Typ = Field_Type_Time);
return To_Duration (Str);
end Fetch_Field;
-----------------
-- Fetch_Field --
-----------------
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Float
is
Str : constant String := Next_Field_As_String (Conn);
begin
pragma Assert
(Field_Type (Conn) = Field_Type_Float or else
Field_Type (Conn) = Field_Type_Double);
return Float'Value (Str);
end Fetch_Field;
----------------
-- Field_Type --
----------------
function Field_Type (Conn : access Base.Mysql_Connection)
return Field_Types
is
begin
return Current_Field_Type (Conn) .Typ;
end Field_Type;
-----------------
-- To_Duration --
-----------------
function To_Duration (S : String) return Duration is
H : constant Integer := Integer'Value (S (S'First .. S'Last - 6));
M : constant Natural := Natural'Value (S (S'Last - 4 .. S'Last - 3));
E : constant Natural := Natural'Value (S (S'Last - 1 .. S'Last));
begin
if H < 0 then
return Duration (H * 3600 - M * 60 - E);
else
return Duration (H * 3600 + M * 60 + E);
end if;
end To_Duration;
-------------
-- To_Time --
-------------
function To_Time (S : String) return Time is
Year : constant Year_Number :=
Year_Number'Value (S (S'First .. S'First + 3));
Month : constant Month_Number :=
Month_Number'Value (S (S'First + 5 .. S'First + 6));
Day : constant Day_Number :=
Day_Number'Value (S (S'First + 8 .. S'First + 9));
Result : constant Time := Time_Of (Year, Month, Day);
begin
if S'Length < 11 then
return Result;
else
return Result + To_Duration (S (S'First + 11 .. S'Last));
end if;
end To_Time;
end Mysql.Types;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Ada.Calendar;
with Ada.Streams;
with Ada.Unchecked_Deallocation;
with Mysql.Base;
with Mysql.Thin;
package Mysql.Types is
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Integer;
-- Fetch an integral field
function Fetch_Field (Conn : access Base.Mysql_Connection)
return String;
-- Return a string field
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Ada.Calendar.Time;
-- Return a date-like field
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Float;
-- Return a floating point field
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Duration;
-- Return a duration
type String_Access is access String;
procedure Free is
new Ada.Unchecked_Deallocation (String, String_Access);
function Fetch_Field (Conn : access Base.Mysql_Connection)
return String_Access;
-- Return a pointer on string that will have to be freed later by the
-- user using the Free procedure provided above.
function Fetch_Field (Conn : access Base.Mysql_Connection)
return Ada.Streams.Stream_Element_Array;
-- Return an opaque structure corresponding to the field
function Escape (S : String) return String;
-- Escape a string according to mySQL specification (i.e. the string is
-- guaranteed not to contain any null character, is surrounded by "",
-- and has all the special characters escaped).
function Escape (S : access String) return String;
-- Similar function for access-to-string types
function Escape (I : Integer) return String;
-- Similar function for integer types
function Escape (T : Ada.Calendar.Time) return String;
-- Similar function for time types
function Escape (D : Duration) return String;
-- Similar function for duration
function Escape (F : Float) return String;
-- Similar function for floating point types
function Escape (S : Ada.Streams.Stream_Element_Array) return String;
-- Similar function for opaque streams
end Mysql.Types;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
package Mysql is
pragma Pure;
end Mysql;
--
-- $ProjectHeader: Mysql 0.20 Fri, 25 Sep 1998 17:41:02 +0200 sam $
--
with Ada.Calendar; use Ada.Calendar;
with Ada.Text_IO; use Ada.Text_IO;
with Mysql.Base; use Mysql.Base;
with Mysql.Insert;
with Mysql.Thin; use Mysql.Thin;
with Mysql.Types; use Mysql.Types;
with Mysql.Struct;
procedure Test_Mysql is
Db : aliased Mysql_Connection;
Ada_Db_Name : constant String := "ada_mysql_test";
type Integer_Array is array (Positive range <>) of Integer;
package Mysql_Integer is new Mysql.Struct
(Struct => Integer,
Struct_Array => Integer_Array,
Read => Fetch_Field);
use Mysql_Integer;
type Struct is record
Name : String (1 .. 10);
Surn : String (1 .. 10);
Value : Integer;
D : Time;
T : Time;
end record;
function Write (S : Struct) return String;
package Mysql_Insert is new Mysql.Insert
(Struct => Struct,
Write => Write);
-----------
-- Write --
-----------
function Write (S : Struct) return String is
begin
return Escape (S.Name) & "," & Escape (S.Surn) & "," &
Escape (S.Value) & "," & Escape (S.D) & "," &
Escape (S.T);
end Write;
begin
Put_Line ("Escaped string: " & Escape ("ABC""D'E'G["00"]`H"));
Put_Line ("Escape date: " & Escape (Clock));
Put_Line (Get_Client_Info);
Connect (Db'Access);
Put_Line (Get_Server_Info (Db'Access));
Put_Line (Get_Host_Info (Db'Access));
Put_Line (Natural'Image (Get_Proto_Info (Db'Access)));
begin
Drop_Database (Db'Access, Ada_Db_Name);
Put_Line ("Removing old database");
exception
when Mysql_Error =>
Put_Line ("Database not existing yet");
end;
Create_Database (Db'Access, Ada_Db_Name);
Select_Database (Db'Access, Ada_Db_Name);
Query (Db'Access,
"CREATE TABLE adatest (name char(10), surn char(10), " &
"value int, d date, t time)");
Mysql_Insert.Insert (Db'Access, "adatest",
(Name => "Samuel ",
Surn => "sam ",
Value => 132,
D | T => Clock));
for I in 1 .. Query (Db'Access,
"select * from adatest")
loop
Put_Line ("--- Row" & Positive'Image (I));
Advance_Row (Db'Access);
for J in 1 .. Field_Count (Db'Access) loop
Put_Line (" " & Next_Field_As_String (Db'Access));
end loop;
end loop;
declare
Result : constant Integer_Array :=
Read_All (Db'Access, "select value from adatest");
begin
Put_Line ("### Number of answers:" & Natural'Image (Result'Length));
for I in Result'Range loop
Put_Line (" " & Integer'Image (Result (I)));
end loop;
end;
Put_Line ("Removing test database");
Drop_Database (Db'Access, Ada_Db_Name);
end Test_Mysql;
^ permalink raw reply [relevance 1%]
* Re: Software landmines (loops)
@ 1998-09-18 0:00 4% ` Robert I. Eachus
0 siblings, 0 replies; 200+ results
From: Robert I. Eachus @ 1998-09-18 0:00 UTC (permalink / raw)
In article <m3pvcv6cr5.fsf@mheaney.ni.net> Matthew Heaney <matthew_heaney@acm.org> writes:
> I have a string that was padded on the right with blanks. What I need
> to do is strip off the blanks, and return the index of the last
> non-blank character.
> Let's analyze this problem first using Dijkstra's predicate transformer,
> and then using Ada...
Not to disagree with Matt, because he is trying to give an example
of how to reason about a problem, but there is a better approach:
Ada.Strings.Fixed.Trim(S,Right)'Last
Of course, you probably want to use the value returned from Trim
instead of just the index of the last non-blank character.
(Technically, if you want to insure that the value returned for a null
string is zero, you need to do:
function Last_Non_Blank_Index(S: String) return Natural is
Temp : constant Natural := Ada.Strings.Fixed.Trim(S,Right)'Last;
begin
if Temp = S'First then return 0; else return Temp; end if;
end Last_Non_Blank_Index;
but the convention of returning 0 in this case was not part of the
original problem statement:
> I have a string that was padded on the right with blanks. What I
> need to do is strip off the blanks, and return the index of the
> last non-blank character.
Why bring this up? Because when doing ANY kind of engineering,
the first approach to try should be to ask, "Is there something in the
standard catalog that is available off-the-shelf?" It is so easy and
enjoyable to solve these problems in Ada, that we often lose sight of
how much grief using the library function will save later. For
example:
If you need to truncate from both ends? Change "Right" to "Both".
If you need to truncate spaces and horizontal tabs from both ends,
and commas and periods from the right:
with Ada.Strings.Maps, Ada.Characters.Latin_1;
use Ada.Strings.Maps, Ada.Characters.Latin_1;
...
Ada.Strings.Fixed.Trim(S, To_Set(Space & HT),
To_Set(Space & HT & Comma & Full_Stop);
-- Although I would probably declare the Character_Sets as
-- constants in some package.
--
Robert I. Eachus
with Standard_Disclaimer;
use Standard_Disclaimer;
function Message (Text: in Clever_Ideas) return Better_Ideas is...
^ permalink raw reply [relevance 4%]
* Re: UNICODE - non-Asian
@ 1998-05-23 0:00 4% ` Robert Dewar
0 siblings, 0 replies; 200+ results
From: Robert Dewar @ 1998-05-23 0:00 UTC (permalink / raw)
Robert Eachus quotes from the standard
ISO/IEC 8859-1:1998 Latin 1 (Yes, that is 1998!)
ISO/IEC 8859-2:1987 Latin 2
ISO/IEC 8859-3:1988 Latin 3
ISO/IEC 8859-4:1988 Latin 4
ISO/IEC 8859-5:1988 Latin/Cyrillic
ISO/IEC 8859-6:1987 Latin/Arabic
ISO/IEC 8859-7:1987 Latin/Greek
ISO/IEC 8859-8:1988 Latin/Hebrew
ISO/IEC 8859-9:1989 Latin 5
ISO/IEC 8859-10:1992 Latin 6
Note that in practice an Ada compiler that supports Latin-1 can be used
perfectly well for any of these subparts of the standard. In response
to some input command you type in Latin/Arabic as 8-bit codes, and it
gets stored internally as some gobbledygook Latin-1 stuff. But since you
write your character and string literals with the same translation, everything
is fine.
There are only two problems in practice:
The package Ada.Characters.Latin_1 is of limited use, e.g. its idea of
what a letter is is not useful. Of course you can write your own, or
perhaps your vendor wlil supply an analogous package.
You can't use everything you think are letters in identifiers, and upper/lower
case equivalence may be peculiar (for example it may make two "letters" that
are quite distinct to you, be treated as the same in identifiers).
It may be that the vendor supplies non-standard modes in which other codes
than Latin-1 are recognized for identifiers, in which case you can write
(potentially non-portable) code taking advantage of this.
In the absence of such special non-standard modes, or if you are concerned
about writing portable code, then you can simply stick to the lower half
of the ISO definition, which is the same in most parts.
In GNAT, we have not bothered to provide alternatives to the Latin_1
packages in the runtime, no one, not even a user of the public version,
has ever suggested that they wanted this, so the demand is close to zero.
We do provide non-standard modes for identifiers:
@item 1
Latin-1 identifiers
@item 2
Latin-2 letters allowed in identifiers
@item 3
Latin-3 letters allowed in identifiers
@item 4
Latin-4 letters allowed in identifiers
@item p
IBM PC letters (code page 437) allowed in identifiers
@item 8
IBM PC letters (code page 850) allowed in identifiers
@item f
Full upper-half codes allowed in identifiers
@item n
No upper-half codes allowed in identifiers
@item w
Wide-character codes allowed in identifiers
@end table
I put in the Latin-1/2/3/4 one day when I had nothing else I felt like
doing. I doubt that other than Latin-1 have ever been used.
I also put in page 437 PC stuff. A user commented that page 850 would
be useful in Europe and supplied the tables, so I put that in. But I
don't know if either have been used.
The full upper-half option is useful in China, and has been used at
least once there.
THe no-upper half option is useful for ensuring portability.
The wide characters option is useful in Japan and has been used at
least a little bit there.
If anyone wants to supply additional tables for identifiers (see
csets.adb in the GNAT compiler sources), or additional alternative
packages for Ada.Characters.Latin_1, we could certainly include them.
I don't think this is the most urgent missing feature in GNAT :-)
By the way, I want to report that Markus Kuhn supplied the information
and a start towards the coding for recognizing UTF-8 in GNAT, and I have
just completed that coding, so GNAT will now fully support UTF-8, thanks
Markus for this contribution!
Robert Dewar
Ada Core Technologies
^ permalink raw reply [relevance 4%]
* Re: [Q] Operating System Command Interface
@ 1998-05-05 0:00 5% ` David C. Hoos, Sr.
0 siblings, 0 replies; 200+ results
From: David C. Hoos, Sr. @ 1998-05-05 0:00 UTC (permalink / raw)
You're right, but the solution is simple. I use the following library
function:
with Ada.Characters.Latin_1;
with System;
function Execute_Shell_Command
(The_Command : String) return Integer is
function Execute
(The_Command_Address : System.Address) return Integer;
pragma Import (C, Execute, "system");
The_Nul_Terminated_Command_String : constant String :=
The_Command & Ada.Characters.Latin_1.Nul;
begin
return Execute (The_Nul_Terminated_Command_String'Address);
end Execute_Shell_Command;
David C. Hoos, Sr.
John McCabe wrote in message <6ims5j$1vo@gcsin3.geccs.gecm.com>...
>Am I right in thinking that, as standard, Ada has no direct perating
>system command interface akin to the C "System" call?
>
>--
>Best Regards
>John McCabe
>
>=====================================================================
>Any opinions expressed are mine and based on my own experience. They
> should in no way be taken as the opinion of anyone I am currently
> working with, or of the company I am currently working for.
> If you have a problem with anything I say, SPEAK TO ME!
> (remove "nospam." to reply by e-mail)
>=====================================================================
>
>
^ permalink raw reply [relevance 5%]
* Re: Clear screen command?
@ 1998-03-05 0:00 5% ` Markus Kuhn
0 siblings, 0 replies; 200+ results
From: Markus Kuhn @ 1998-03-05 0:00 UTC (permalink / raw)
To clear a screen on any ISO 6429 compatible terminal (that's
everything claiming to be VT100 or ANSI or xterm compatible),
just use procedures such as
-- warning: the following code is untested
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
procedure Clear_Screen is
begin
put(ESC & "[2J");
end;
procedure Goto_XY(Row, Column: Natural) is
begin
put(ESC & "[");
put(Row);
put(';');
put(Column);
put('H');
end;
For all the VT100/ISO 6429 commands, see for instance
http://www.fh-jena.de/~gmueller/Kurs_halle/esc_vt100.html
Completing the above into a nice ISO6429 package for controlling
text terminals is left as a small exercise to the reader.
Hope this helped ...
Markus
--
Markus G. Kuhn, Security Group, Computer Lab, Cambridge University, UK
email: mkuhn at acm.org, home page: <http://www.cl.cam.ac.uk/~mgk25/>
^ permalink raw reply [relevance 5%]
* Re: How do I insert a carriage return into a multi-line text box (ObjectAda)?
@ 1997-09-12 0:00 4% ` Anonymous
0 siblings, 0 replies; 200+ results
From: Anonymous @ 1997-09-12 0:00 UTC (permalink / raw)
<3416D21B.3366@cacd.rockwell.com>
On Thu, 11 Sep 1997 13:10:11 -0400, John Cupak {73739}
<jcj@swl.msd.ray.com> wrote:
> Meyer Jeffrey D wrote:
> >
> > I am writing an application that is using a multi-line text box for a
> > status/output window. I cannot, however, insert a carriage return
> > character to advance the cursor to the next line for a new status
> > output. I can insert an ASCII code 13 (carriage return character), but
> > instead of performing a CR, a vertical bar (signifying a non-printable
> > character) is inserted into the text box.
> >
> > Does anybody know if it possible to use a multi-line tet box in this
> > fashion, or do I need to wait for a version of ObjectAda that lets me
> > use OCX controls (such as a Rich Text Box)?
> >
> > Thanks in advance,
> > Jeff Meyer
>
> Jeff,
>
> You should be able to concatenate the ASCII.NL character, as follows:
>
> Message : constant String :=
> "Are you REALLY sure you want to delete the file?" &
> ASCII.NL &
> "Select YES or NO button, below.";
Except that NL is not defined in ASCII nor in Ada.Characters.Latin_1, so
this should not compile.
Jeff Carter PGP:1024/440FBE21
My real e-mail address: ( carter @ innocon . com )
"I fart in your general direction."
Monty Python & the Holy Grail
Posted with Spam Hater - see
http://www.compulink.co.uk/~net-services/spam/
^ permalink raw reply [relevance 4%]
* Re: Text control characters
1997-09-10 0:00 5% Text control characters John Woodruff
@ 1997-09-11 0:00 0% ` Anonymous
0 siblings, 0 replies; 200+ results
From: Anonymous @ 1997-09-11 0:00 UTC (permalink / raw)
On 10 Sep 1997 10:24:35 -0700, woodruff@tanana.llnl.gov (John Woodruff)
wrote:
..
> Example:
> output : constant string := "line 1 " & <*what goes here?*> & "line 2";
>
> -- I want the result of
> Ada.Text_IO.Put (output) ;
> -- to be
> line 1
> line 2
>
> Partial answer: if I use
>
> ada.characters.latin_1.CR & ada.characters.latin_1.LF
>
> this works on some operating system. Is there a standard-compliant way
> to solve the problem in general?
The definition of a line terminator is outside the Ada language
definition, being platform dependent. I don't remember of the POSIX-Ada
bindings address this, and don't have them available to check. One could
do
generic -- Multi_Line_String_Handler
Max_Line : Positive;
package Multi_Line_String_Handler is
subtype Line is String (1 .. Max_Line);
type Multi_Line_String is array (Positive range <>) of Line;
procedure Put (Item : in Multi_Line_String);
end Multi_Line_String_Handler;
package MLS is new Multi_Line_String_Handler (Max_Line => 6);
Output : constant MLS.Multi_Line_String := ("line 1", "line 2");
..
Put (Item => Output);
and be platform independent.
Jeff Carter PGP:1024/440FBE21
My real e-mail address: ( carter @ innocon . com )
"English bed-wetting types."
Monty Python & the Holy Grail
Posted with Spam Hater - see
http://www.compulink.co.uk/~net-services/spam/
^ permalink raw reply [relevance 0%]
* Text control characters
@ 1997-09-10 0:00 5% John Woodruff
1997-09-11 0:00 0% ` Anonymous
0 siblings, 1 reply; 200+ results
From: John Woodruff @ 1997-09-10 0:00 UTC (permalink / raw)
By coincidence, Jeff Meyer asked a question on this forum that is a
topic I have been puzzling. He wants a multi-line text box; I want
multiple lines in a string constant. Maybe one answer fits all ...
I can construct some function that returns a string. I wish to compose
such functions in a way to make a textual report, and deliver that
report as a string. I wish I could format the string into lines in a
way to make it relatively easy to read.
The caller of this function may very well choose to Ada.Text_IO.Put the
string into a file, or perhaps might use the string in some other way.
How can I construct a string so that Put will produce line_terminators
in the output?
Example:
output : constant string := "line 1 " & <*what goes here?*> & "line 2";
-- I want the result of
Ada.Text_IO.Put (output) ;
-- to be
line 1
line 2
Partial answer: if I use
ada.characters.latin_1.CR & ada.characters.latin_1.LF
this works on some operating system. Is there a standard-compliant way
to solve the problem in general?
--
John Woodruff N I F \ ^ /
Lawrence Livermore National Lab =====---- < 0 >
510 422 4661 / v \
^ permalink raw reply [relevance 5%]
* Re: Clear Screen
@ 1997-03-05 0:00 5% ` Keith Thompson
0 siblings, 0 replies; 200+ results
From: Keith Thompson @ 1997-03-05 0:00 UTC (permalink / raw)
In <dewar.857447446@merv> dewar@merv.cs.nyu.edu (Robert Dewar) writes:
> <<This will also make any other declarations within Ada.Characters visible.
> (It happens that the only such declaration is the child package
> Ada.Characters.Handling, and that only if you "with" it.)>>
>
> And that presumably is what you want, if you with it, or are you recommending
> that the single use clause be replaced by two of your renamings in this case?
> :-)
The original discussion mentioned only Ada.Characters.Latin_1. A use
clause for Ada.Characters makes Latin_1 directly visible, but it can
have other side effects (especially if the implementation provides other
children of Ada.Characters, like GNAT's Wide_Latin_1).
One argument in favor of the renames, in this particular case, is that
the name Latin_1 is far less ambiguous than Handling.
As I said, I'm not recommending anything, just pointing out alternatives.
--
Keith Thompson (The_Other_Keith) kst@sd.aonix.com <http://www.aonix.com> <*>
TeleSo^H^H^H^H^H^H Alsy^H^H^H^H Thomson Softw^H^H^H^H^H^H^H^H^H^H^H^H^H Aonix
10251 Vista Sorrento Parkway, Suite 300, San Diego, CA, USA, 92121-2706
"Humor is such a subjective thing." -- Cartagia
^ permalink raw reply [relevance 5%]
Results 1-200 of ~300 next (older) | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
1997-02-22 0:00 Clear Screen Tom Moran
1997-02-24 0:00 ` Jean-Etienne Doucet
1997-02-25 0:00 ` Robert Dewar
1997-02-26 0:00 ` Geert Bosch
1997-02-27 0:00 ` Robert Dewar
1997-02-28 0:00 ` Norman H. Cohen
1997-03-03 0:00 ` Keith Thompson
1997-03-03 0:00 ` Robert Dewar
1997-03-05 0:00 5% ` Keith Thompson
1997-09-10 0:00 5% Text control characters John Woodruff
1997-09-11 0:00 0% ` Anonymous
1997-09-11 0:00 How do I insert a carriage return into a multi-line text box (ObjectAda)? John Cupak {73739}
1997-09-12 0:00 4% ` Anonymous
1998-03-04 0:00 Clear screen command? Jeremy Mlazovsky
1998-03-05 0:00 ` Tarjei Tj�stheim Jensen
1998-03-05 0:00 5% ` Markus Kuhn
1998-05-05 0:00 [Q] Operating System Command Interface John McCabe
1998-05-05 0:00 5% ` David C. Hoos, Sr.
1998-05-20 0:00 UNICODE - non-Asian William A Whitaker
1998-05-20 0:00 ` Robert Dewar
1998-05-22 0:00 ` Robert I. Eachus
1998-05-23 0:00 4% ` Robert Dewar
1998-08-08 0:00 Why C++ is successful Jeffrey C. Dege
[not found] ` <35f51e53.48044143@ <m3af4mq7f4 <35EDC648.76F03F32@draper.com>
1998-09-03 0:00 ` Software landmines (loops) Patrick Doyle
1998-09-03 0:00 ` Tim McDermott
1998-09-04 0:00 ` Matthew Heaney
1998-09-08 0:00 ` Tim McDermott
1998-09-17 0:00 ` Matthew Heaney
1998-09-18 0:00 4% ` Robert I. Eachus
1998-09-25 0:00 Ada bindings for MySQL? Jeff Foster
1998-09-25 0:00 1% ` Ada bindings for MySQL? [long] Samuel Tardieu
1998-10-05 0:00 5% ISO LATIN_1 in Windows 95 ? Hans Marqvardsen
1998-10-06 0:00 4% ` Jacob Sparre Andersen
1998-10-06 0:00 ` dewarr
1998-10-07 0:00 5% ` Hans Marqvardsen
1998-10-08 0:00 4% ` Jacob Sparre Andersen
1998-10-12 0:00 4% ` Georg Bauhaus
1998-10-06 0:00 0% ` dewarr
1998-10-07 0:00 5% ` Jerry van Dijk
[not found] <36498748.F6BE2505@NOSPAM_mailcity.com>
1998-11-11 0:00 5% ` "Beep" in DOS-Prog John Herro
1999-02-06 0:00 Passing a Command to Unix in Ada Robert T. Sagris
1999-02-09 0:00 4% ` David C. Hoos, Sr.
1999-02-06 0:00 Serial Port Programming ?? Fr�d�ric Besson
1999-02-08 0:00 4% ` David C. Hoos, Sr.
1999-02-15 0:00 Library Level Question Steve Doiel
1999-02-15 0:00 4% ` David C. Hoos, Sr.
1999-03-30 0:00 Terminal IO, and menus Heath Isler
1999-03-31 0:00 ` Matthew Heaney
1999-04-01 0:00 ` Heath Isler
1999-04-01 0:00 3% ` John J Cupak Jr
1999-05-21 0:00 Dos Environment varables Al Lively
1999-05-21 0:00 ` Gautier
1999-05-21 0:00 ` Al Lively
1999-05-24 0:00 5% ` Jeffrey D. Cherry
1999-06-07 0:00 Exception Propagation Decker, Christian R
1999-06-07 0:00 ` dennison
1999-06-08 0:00 ` Glen
1999-06-08 0:00 4% ` dennison
1999-06-10 0:00 4% DOS/Win95 file names fluffy_pop
1999-06-11 0:00 ` Gautier
1999-06-11 0:00 4% ` fluffy_pop
1999-06-11 0:00 0% ` dennison
1999-06-29 0:00 obsolete ascii? (for language lawyers) Peter Hermann
1999-06-29 0:00 4% ` David C. Hoos, Sr.
1999-06-29 0:00 0% ` Ted Dennison
1999-07-02 0:00 ` Peter Hermann
1999-07-02 0:00 ` Ted Dennison
1999-07-02 0:00 4% ` Ted Dennison
1999-07-02 0:00 ` Robert Dewar
1999-07-02 0:00 ` Keith Thompson
1999-07-03 0:00 3% ` Robert Dewar
1999-07-03 0:00 4% ` Keith Thompson
1999-07-02 0:00 4% ` Robert A Duff
1999-07-27 0:00 solaris daemon question darren wilson
1999-07-28 0:00 5% ` David C. Hoos, Sr.
2000-01-27 0:00 Announce: OpenToken 2.0 released Ted Dennison
2000-01-31 0:00 4% ` Hyman Rosen
2000-02-01 0:00 0% ` Ted Dennison
2000-02-15 0:00 not really an Ada question Ehud Lamm
2000-02-17 0:00 2% ` not really an Ada question (long answer) DuckE
2000-05-07 0:00 storage size pragmas Ted Dennison
2000-05-07 0:00 ` ANTHONY GAIR
2000-05-08 0:00 4% ` Ted Dennison
2000-05-11 0:00 Case Sensitivity Cameron McShane
2000-05-11 0:00 5% ` Ted Dennison
2000-11-15 0:00 Escape Sequences in Strings Jean Cohen
2000-11-15 0:00 4% ` Marin David Condic
2000-11-15 0:00 ` John English
2000-11-15 0:00 ` Robert Dewar
2000-11-15 0:00 ` Ehud Lamm
2000-11-16 0:00 ` John English
2000-11-16 0:00 ` Tarjei T. Jensen
2000-11-16 0:00 7% ` Ken Garlington
2000-11-16 0:00 5% ` Marin David Condic
2000-11-16 0:00 4% ` Keith Thompson
2000-11-20 5:36 3% Win32.Commdlg.GetOpenFileName problem - Gnat bug? Christoph Grein
2000-12-31 11:11 6% ada printing rasser
2001-01-22 0:05 5% Optimization Question dvdeug
2001-05-16 10:08 Return value of system call (newbie question) Torbjörn Karfunkel
2001-05-16 16:08 3% ` Jeffrey Carter
2001-05-30 13:04 Cannot use NULL as identifier? McDoobie
2001-05-30 13:22 4% ` Ted Dennison
2001-05-30 13:32 5% ` Martin Dowie
2001-05-30 13:33 5% ` Petter Fryklund
2001-05-30 13:52 3% ` Marin David Condic
2001-05-31 10:49 0% ` McDoobie
2001-05-30 21:45 5% Beard, Frank
2001-05-31 14:53 0% ` John English
2001-06-04 22:48 4% Beard, Frank
2001-08-23 12:15 5% String manupulation (again) - free software Reinert Korsnes
2001-10-30 12:59 How to get an ASCII code ? Apokrif
2001-10-30 14:22 ` Matthew Heaney
2001-10-30 15:16 ` Marin David Condic
2001-10-30 23:19 5% ` Nick Roberts
2001-10-31 14:48 5% ` Marin David Condic
2002-01-31 2:49 1% ACT announces availability of GNAT 3.14p Robert Dewar
2002-02-28 2:07 Ada Characters? Wannabe h4x0r
2002-02-28 2:28 6% ` Jim Rogers
2002-02-28 2:37 5% ` sk
2002-02-28 22:54 5% ` Jeffrey Carter
2002-03-06 6:05 Future with Ada Christoph Grein
2002-03-06 9:24 ` Pascal Obry
2002-03-06 16:43 4% ` Georg Bauhaus
2002-03-17 22:23 4% String slicing Wannabe h4x0r
2002-03-17 22:43 0% ` Jim Rogers
2002-03-18 12:44 4% ` sk
2002-03-18 17:49 4% ` Georg Bauhaus
2002-07-15 11:25 gnat: time-slicing Jan Prazak
2002-07-15 13:07 ` time-slicing David C. Hoos
2002-07-15 19:10 5% ` time-slicing Jan Prazak
2002-08-23 19:10 Thought this was interesting Darren New
2002-08-25 3:27 ` tmoran
2002-08-26 14:01 ` Marin D. Condic
2002-08-27 16:13 5% ` Hyman Rosen
2002-08-27 20:07 0% ` Thought this was interesting (OT) Chad R. Meiners
2002-08-28 7:58 0% ` Thought this was interesting Ole-Hjalmar Kristensen
2002-08-28 9:41 0% ` AG
2002-11-12 19:33 how to parse words from a string Sarah Thomas
2002-11-14 2:10 ` Chad R. Meiners
2002-11-14 2:40 ` Caffeine Junky
2002-11-14 3:09 ` sk
2002-11-14 5:31 ` Dennis Lee Bieber
2002-11-14 13:40 4% ` Sarah Thomas
2002-11-14 14:56 5% ` David C. Hoos
2002-11-26 21:41 6% Character Sets Robert C. Leif
2002-11-27 9:00 0% Grein, Christoph
2002-11-28 17:53 6% Robert C. Leif
2002-11-28 18:08 Character Sets (plain text police report) Warren W. Gay VE3WWG
2002-11-29 20:37 6% ` Robert C. Leif
2003-01-13 16:58 Exec shell command with GNAT JuK
2003-01-13 17:59 5% ` David C. Hoos
2003-01-14 8:58 0% ` Thomas Wolf
2003-01-14 12:15 0% ` David C. Hoos, Sr.
2003-06-09 18:15 Ideas for Ada 200X Stephen Leake
2003-06-10 10:18 ` Preben Randhol
2003-06-11 0:40 ` Russ
2003-06-12 0:42 ` Richard Riehle
2003-06-12 19:16 ` Russ
2003-06-13 7:24 ` Vinzent Hoefler
2003-06-14 2:12 ` Steve
2003-06-15 17:05 ` Richard Riehle
2003-06-16 17:16 ` Tarjei T. Jensen
2003-06-16 17:46 ` Bill Findlay
2003-06-16 18:19 ` Vinzent Hoefler
2003-06-16 18:40 ` Bill Findlay
2003-06-18 15:00 4% ` Alexander Kopilovitch
2003-06-19 0:31 0% ` Amir Yantimirov
2003-06-18 3:47 5% help with Ada95 Cephus�
2003-06-18 17:51 0% ` Jeffrey Carter
2003-07-12 14:03 Terminating a task kat-Zygfryd
2003-07-12 14:37 ` kat-Zygfryd
2003-07-14 9:34 ` Craig Carey
2003-07-14 23:45 5% ` Matthew Heaney
2003-07-15 22:37 0% ` Robert I. Eachus
2003-10-14 20:54 array of strings in a function Antonio Martínez
2003-10-15 11:49 ` Antonio Martínez Álvarez
2003-10-16 14:30 3% ` Robert I. Eachus
2003-10-24 20:18 Newbie GNAT question David Gressett
2003-10-26 15:09 ` sk
2003-10-27 15:53 ` Martin Krischik
2003-10-28 14:08 ` sk
2003-10-29 16:18 6% ` Martin Krischik
2003-10-31 21:02 Clause "with and use" Gautier Write-only
2003-11-01 7:09 ` Russ
2003-11-01 10:29 ` Pascal Obry
2003-11-01 13:24 ` Gautier Write-only
2003-11-01 22:12 ` Pascal Obry
2003-11-02 10:45 ` Stephane Richard
2003-11-03 5:59 ` Russ
2003-11-03 14:32 ` Preben Randhol
2003-11-03 22:11 ` Gautier Write-only
2003-11-04 10:58 ` Preben Randhol
2003-11-04 13:16 ` Hyman Rosen
2003-11-06 10:55 ` Preben Randhol
2003-11-06 13:03 5% ` Hyman Rosen
2003-11-06 15:35 0% ` Preben Randhol
2003-11-06 17:26 0% ` Warren W. Gay VE3WWG
2003-11-06 20:38 4% ` Gautier Write-only
2003-11-06 21:12 0% ` Warren W. Gay VE3WWG
2003-11-07 7:08 0% ` Russ
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 3% ` Nick Roberts
2004-07-15 19:18 3% ` Nick Roberts
2004-07-15 20:02 0% ` Nick Roberts
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 4% ` Martin Krischik
2004-10-29 12:46 Question about Ada.Unchecked_Conversion Eric Jacoboni
2004-10-29 14:22 5% ` Dmitry A. Kazakov
2004-10-29 15:15 5% ` Nick Roberts
2004-12-08 16:46 4% 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 4% ` 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 5% ` 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 4% ` Marius Amado Alves
2005-03-30 16:08 0% ` Andre
2005-03-22 22:27 4% ` Dmitry A. Kazakov
2005-03-22 16:30 Marius Amado Alves
2005-03-22 16:41 ` Tapio Kelloniemi
2005-03-22 17:39 5% ` 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 3% ` Ada bench : word frequency Marius Amado Alves
2005-03-23 21:26 ` Isaac Gouy
2005-03-24 1:24 3% ` Marius Amado Alves
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 6% ` 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
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 4% ` 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 4% Cursor control question - ncurses and alternatives Dr. Adrian Wrigley
2006-10-13 22:41 4% ` 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-15 22:00 Char type verification KE
2006-11-15 21:57 4% ` Georg Bauhaus
2006-11-15 23:15 0% ` KE
2007-02-07 14:52 Ada.Containers.Doubly_Linked_Lists Carroll, Andrew
2007-02-07 15:06 4% ` Ada.Containers.Doubly_Linked_Lists Ludovic Brenta
2007-02-07 18:22 5% ` 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 5% ` 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 4% ` Dmitry A. Kazakov
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 3% ` Matthew Heaney
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 5% ` Dmitry A. Kazakov
2008-11-26 5:52 Weird string I/O problem Jerry
2008-12-01 19:47 5% ` 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 4% ` 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 4% ` Jeffrey R. Carter
2009-06-03 15:49 0% ` Tomek Wałkuski
2009-06-03 19:07 0% ` sjw
2009-11-12 19:28 5% Funny thing with GNAT Socket? mockturtle
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 4% ` Georg Bauhaus
2010-12-20 0:43 Introducing memcache-ada, a memcached client in Ada R Tyler Croy
2010-12-20 8:25 3% ` Thomas Løcke
2010-12-24 16:36 3% Access Type kug1977
2010-12-24 17:30 0% ` Robert A Duff
2010-12-24 20:59 3% ` kug1977
2011-01-10 13:44 4% 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 3% ` 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 3% ` Brian Drummond
2011-02-21 13:44 3% ` Simon Wright
2011-02-22 2:15 2% ` Shark8
2012-06-01 8:02 3% 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 4% ` anon
2014-01-28 1:06 4% need help learning Ada for a modula-2 programmer agent
2014-03-22 9:51 4% Problems validating XML with XML/Ada mockturtle
2014-08-02 13:10 trimming strings agent
2014-08-02 17:22 ` mockturtle
2014-08-03 21:42 5% ` agent
2014-10-03 23:29 array of string Stribor40
2014-10-07 16:49 5% ` 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 5% ` NiGHTS
2014-10-22 6:25 3% ` Jeffrey Carter
2014-10-22 17:39 0% ` NiGHTS
2014-10-22 11:16 4% ` 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 3% ` brbarkstrom
2015-02-02 5:50 3% Did I find mamory leak in Generic Image Decoder (GID) ? reinkor
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 5% ` Maciej Sobczak
2015-08-25 15:26 ` Maciej Sobczak
2015-08-25 16:45 5% ` 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 4% ` Dmitry A. Kazakov
2015-11-15 23:16 4% How to append linefeed to unbounded string? John Smith
2015-11-15 23:22 4% ` 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 4% ` 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 4% ` 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 2% ` Natasha Kerensikova
2017-06-28 9:25 send email Distant Worlds
2017-07-18 7:48 3% ` 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 4% ` Shark8
2017-12-05 21:45 0% ` Keith Thompson
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 3% ` Simon Wright
2018-08-04 1:37 4% 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
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 5% ` 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 4% ` 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 21:24 6% ` Simon Wright
2021-06-20 17:10 0% ` 196...@googlemail.com
2021-06-21 15:26 4% ` Simon Wright
2021-09-05 3:20 AWS.SMTP.Client secure mode philip...@gmail.com
2021-09-06 9:26 3% ` Björn Lundin
2022-10-11 8:06 Bold text (in terminal) from Ada? reinert
2022-10-11 8:49 5% ` Niklas Holsti
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox