* Re: Unifont static compiled and stack size...
@ 2023-08-14 15:10 1% ` Micah Waddoups
0 siblings, 0 replies; 200+ results
From: Micah Waddoups @ 2023-08-14 15:10 UTC (permalink / raw)
On Monday, August 14, 2023 at 4:06:39 AM UTC-6, Jeffrey R.Carter wrote:
> On 2023-08-13 18:16, Micah Waddoups wrote:
> > I tried to compile the Unifont hex file, converted with a script into variable Ada code, but it went on forever, gradually blowing up my memory. I used an .ads file and aimed for a static build, but I suspect I would have hit the stack size limit for executables if I succeeded
> As I understand it, the file in question is for code points 0 .. 16#FFFF#, with
> a maximum of 32 bytes per code point. A straightforward representation of this is
>
> package Unifont is
> type Byte is mod 2 ** 8 with Size => 8;
>
> type Line is array (1 .. 2) of Byte with Size => 16;
>
> type Bitmap is array (1 .. 16) of Line with Size => 256;
>
> function Width_8 (Map : in Bitmap) return Boolean is
> (for all L of Map => L (2) = 0);
>
> type Code_Point is mod 16#FFFF# + 1;
>
> type Font_Map is array (Code_Point) of Bitmap with Size => 2 ** 24;
>
> Font : constant Font_Map := (others => (others => (others => 0) ) );
> end Unifont;
>
> Font will occupy 2 MB.
>
> We can test this with
>
> with Ada.Text_IO;
> with Unifont;
>
> procedure Unifont_Test is
> -- Empty
> begin -- Unifont_Test
> Ada.Text_IO.Put_Line (Item => Unifont.Font (0) (1) (1)'Image);
> end Unifont_Test;
>
> and see what happens:
>
> $ gnatmake -m -j0 -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont_test.adb
> x86_64-linux-gnu-gcc-12 -c -gnat12 -gnatan -gnato2 -O2 -fstack-check
> unifont_test.adb
> x86_64-linux-gnu-gcc-12 -c -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont.ads
> x86_64-linux-gnu-gnatbind-12 -x unifont_test.ali
> x86_64-linux-gnu-gnatlink-12 unifont_test.ali -O2 -fstack-check
> $ ./unifont_test
> 0
>
> so this representation seems to be workable. It should be trivial to write a
> program to read the file and produce the real array aggregate for Font.
>
> --
> Jeff Carter
> "I wave my private parts at your aunties."
> Monty Python & the Holy Grail
> 13
Thank you all for replying while I was working away from home.
Jeff, you missed a digit - it's five F's 16#FFFFF# because that is as high as Unifont goes in my copy of the hex file. Of course the technique should be able to go higher if that changes, but Unicode is pretty exhaustive as it is and Unifont is meant to keep up with every version and addition to the Unicode code points, so I sincerely hope for no trouble for a while yet. I checked, and it seem my system has about 8 megabytes as the stack size limit, so with the ranges left empty it is not 32 megabytes, but still pretty big. Good looking code, by the way. Very easy to read. Mine is appended, but it was really a quick hack of a job with too little sleep. I probably should have done a Z Shell script (maybe take 20 seconds?), but I thought the two second efficiency of writing a compiled composer was worth it ...somehow...
Niklas, I think you have the most actionable suggestions for me to test. Thank you.
Dmitry, Thank you for trying to understand. Since both methods of rendering fonts made available by GTK, I consider it GTK providing it. I don't want any more imports than I can provide easily with a static compile or as accompanying dynamic modules (reason hereafter mentioned), and Licensing needs to be the most permissive possible. The idea is to be able to create a shell or a variety of other programs using my library as a very focused kind of interface that supports more characters and more languages that my other most available options, so the font is important, even if I'm just drawing to the Linux frame buffer. I meant a transfer of code from one platform to another. Sometimes in a graphical window that acts like a text interface window, sometimes on the linux frame buffer, and in the extreme case some times on the text console without any particular font support. The main collection of code is supposed to support all that with very limited modification to say transfer from Linux to macOS or MS Windows? I hope this s answered your questions.
Oh, and to all, I have already abandon the idea of using Boolean with Pack, since it no longer seems to work and was a bit *too* verbose
pragma Ada_2012;
pragma Wide_Character_Encoding (UTF8);
with Ada.Text_IO;
use Ada.Text_IO;
procedure Unifont_Hex_To_Ada is
Target_Name: String := "./src/unifont.ads";
Source_Name: String := "unifont_all-15.0.06.hex";
Target: aliased File_Type;
Source: aliased File_Type;
Buffer: aliased String (1 .. 96) := (others=>' ');
Index, F: Positive := 1;
Previous, Current, Length, L: Natural := 0;
Finished: aliased Boolean:= False;
subtype Hex_Character is Character range '0' .. 'f'
with Static_Predicate=> (Hex_Character in '0' .. '9') or (Hex_Character in 'A' .. 'F') or (Hex_Character in 'a' .. 'f');
type Byte is mod 2 **8;
type Bit is mod 8;
--type Bytes is array (Natural range <>) of aliased Byte;
Bit_X: Bit := 0;
Byte_X: Byte := 0;
function Find (Item: Character)
return Natural
is
begin
for
N in Buffer'Range
loop
if Item = Buffer(N)
then return N;
end if;
end loop;
return 0;
end Find;
function Enum return Natural
is
First: Positive := 1;
Last: Natural := Integer'Max ((Find (':') -1), 0);
begin
return R: Natural
do
R := Natural'Value ("16#" &Buffer (First..Last) &'#');
end return;
end Enum;
procedure Next_Byte
is
S: String renames Buffer (F .. L);
begin
loop
if
(Index in S'Range) and (Index +1 in S'Range)
then
exit;
else
Index := S'First;
if
(Index in S'Range) and (Index +1 in S'Range)
then
exit;
else
raise Program_Error with "Next_Byte-> Somehow there are no Hex codes in string... line " &Current'Img &", string => " & S;
end if;
end if;
end loop;
if
S (Index) in Hex_Character
and
S (Index +1) in Hex_Character
then
Byte_X := Byte'Value ("16#" &S (Index..Index +1) &"#");
Bit_X := 0;
Index := Index +2;
end if;
end Next_Byte;
procedure Next_Line
is
begin
for
N in Buffer'First .. Length
loop
Buffer (N):= ' ';
end loop;
begin
Get_Line (Source, Buffer, Length);
exception
when others => null;
end;
if
Length < 32
then
Put_Line (Standard_Error, "empty or incomplete line at code point " &Natural'Image (Enum) &" (" &Current'Img &" + 1)");
else
Previous:= Current;
Current:= Enum;
if
((Previous + 1) = Current)
or else (Current = 0)
then
F:= Find (':') +1;
L:= Length;
Next_Byte;
else
F:= Find (':') +1;
L:= Length;
Next_Byte;
Put_Line (Standard_Error, " Missing character range in Source: " &Previous'Img &" .. " &Current'Img);
end if;
end if;
end Next_Line;
subtype Index_Type is Natural range 0 .. 16#FFFFF#;
subtype Y_Type is Integer range 1 .. 16;
subtype X_Type is Integer range 1 .. 16;
type Size_Type is
record
Y: aliased Y_Type:= Y_Type'First;
X: aliased X_Type:= X_Type'First;
end record;
type Size_Set_Type is array (Index_Type) of aliased Size_Type;
type Size_Set_Access is access all Size_Set_Type;
function Dot return String is
begin
if
1 = ((Byte_X / 2 **(7 - Natural(Bit_X))) and 1)
then
if
Bit_X = Bit'Last
then
Next_Byte;
else
Bit_X := Bit_X +1;
end if;
return "True";
else
if
Bit_X = Bit'Last
then
Next_Byte;
else
Bit_X := Bit_X +1;
end if;
return "False";
end if;
end Dot;
Cache_Size: Size_Set_Access := new Size_Set_Type'(others => (16, 8));
Size: Size_Set_Type renames Cache_Size.all;
begin
begin
Open (Source, In_File, Source_Name);
exception
when others =>
raise Status_Error with " Source File not found: " &Source_Name;
end;
begin
Create (Target, Out_File, Target_Name);
exception
when others =>
Open (Target, Out_File, Target_Name);
end;
begin
Put_Line (Target, "pragma Ada_2012;");
Put_Line (Target, "pragma Wide_Character_Encoding (UTF8);");
New_Line (Target, 2);
--Put_Line (Target, "with ada.unchecked_conversion;");
--New_Line (Target, 2);
Put_Line (Target, "package Unifont is");
Put_Line (Target, "subtype Index_Type is Wide_Wide_Character range Wide_Wide_Character'Val (0) .. Wide_Wide_Character'Val (16#FFFFF#);");
Put_Line (Target, "subtype Y_Type is Integer range 1 .. 16;");
Put_Line (Target, "subtype X_Type is Integer range 1 .. 16;");
Put_Line (Target, "type Size_Type is record Y: aliased Y_Type := 1; X: aliased X_Type := 1; end record;");
Put_Line (Target, "type Size_Set_Type is array (Index_Type) of aliased Size_Type;");
Put_Line (Target, "type Glyph_Type is array (Y_Type, X_Type) of Boolean");
Put_Line (Target, "with Pack, Size=> 256;");
Put_Line (Target, "type Glyph_Set_Type is array (Index_Type) of aliased Glyph_Type;");
Put_Line (Target, "Glyph: constant Glyph_Set_Type :=");
Put (Target, "(");
loop
exit when End_Of_File (Source);
Next_Line; -- Load Next Line and extract Code Point index
if
Length > 64
then
Size (Current) := (16, 16);
Put_Line (Target, "Wide_Wide_Character'Val (" &Integer'Image(Current) &") =>");
Put (Target, "(");
for Y in 1 .. 16
loop
Put_Line (Target, Y'Img &" =>");
Put (Target, "(");
for X in 1 .. 16
loop
if
X < 16
then
Put (Target, Dot &", ");
else
Put (Target, Dot &")");
end if;
end loop;
if
Y < 16
then
Put_Line (Target, ",");
else
Put_Line (Target, "),");
end if;
end loop;
elsif
Length > 32
then
Put_Line (Target, "Wide_Wide_Character'Val (" &Integer'Image(Current) &") =>");
Put (Target, "(");
for Y in 1 .. 16
loop
Put_Line (Target, Y'Img &" =>");
Put (Target, "(");
for X in 1 .. 8
loop
Put (Target, Dot &", ");
end loop;
for X in 9 .. 16
loop
if
X < 16
then
Put (Target, "False, ");
else
Put (Target, "False)");
end if;
end loop;
if
Y < 16
then
Put_Line (Target, ",");
else
Put_Line (Target, "),");
end if;
end loop;
end if;
end loop;
Close (Source);
Put_Line (Target, "others => (others => (others => False)));");
New_Line (Target);
Put_Line (Target, "Size: constant Size_Set_Type :=");
Put (Target, "(");
for N in Index_Type'Range
loop
Put (Target, "Wide_Wide_Character'Val (" &Integer'Image(N) &") =>");
Put (Target, "(" &Integer'Image(Size(N).Y) &", " &Integer'Image(Size(N).X) &")");
if
N < Index_Type'Last
then
Put_Line (Target, ",");
else
Put_Line (Target, ");");
end if;
end loop;
Put_Line (Target, "end Unifont;");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Close (Target);
end;
end Unifont_Hex_To_Ada;
^ permalink raw reply [relevance 1%]
* Re: Ada interface to Excel file
@ 2023-04-20 19:08 1% ` Gautier write-only address
0 siblings, 0 replies; 200+ results
From: Gautier write-only address @ 2023-04-20 19:08 UTC (permalink / raw)
The simplest way by far is to generate the Ada sources
from within Excel by using VBA (a BASIC with a strong Ada flavour,
but still a BASIC) which is part of Excel.
From Excel, you activate VBA with the Alt-F11 shortcut.
You have "modules" which are just editor files and visible from
everywhere else (you have like implicit "with"'s and "use"'s); you
have functions called "Function" and procedures called "Sub".
You can associate a button in the Excel sheet to a Sub.
You declare each variable with "Dim x As Type".
You can also forget to declare variables, with funny outcomes.
The behavious of the type system around parameter passing is also funny.
You find below a few examples.
Now, if you already have your CSV-to-Ada generator, you can export a CSV; that's also easy with VBA.
G.
[somewhere (some module)]
Sub Generate_for_Production()
Dim anchor As String ' VBA String is Ada's Unbounded_String
' File handles
Dim fh_ada_spec As Integer
Dim fh_ada_body As Integer
...
Open ThisWorkbook.Path & "\src\" & pkg_name & _
".ads" For Output As #fh_ada_spec
...
For Each ws In Worksheets ' Scan all worksheets
For Each r In ws.UsedRange.Rows ' Scan all used rows
anchor = r.Cells(1, 1).Value
If anchor <> "" Then
...
End If
Next r
Next ws
...
Close #fh_ada_spec
End Sub
[somewhere else (perhaps another module)]
Print #fh, "with Ada.Calendar;"
Print #fh, "with Ada.Unchecked_Conversion;"
Print #fh, "with Interfaces;"
Print #fh,
Print #fh, "package " & name & " is"
[somewhere else]
If simple_record Then
Print #fh_ada_spec, " -- Simple record."
Print #fh_ada_spec,
Print #fh_ada_spec, " type Xyz is record -- " & paragraph
Else
Print #fh_ada_spec, " type Xyz is new " & parent_name & _
"Abc with record -- " & paragraph
End If
[somewhere else]
For i = min_row_offset To max_row_offset
' Convert name in cell to Ada name
field = Ada_Name(r.Cells(i, 3).Value)
If field = "" Then
Exit For
End If
amount = r.Cells(i, 6).Value
...
Print #fh_ada_body, " for index in 1 .. " & amount & " loop"
Print #fh_ada_body, " declare"
^ permalink raw reply [relevance 1%]
* Re: Unchecked_Deallocation with tagged types
2022-04-16 3:44 2% ` Thomas
@ 2022-04-16 8:09 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2022-04-16 8:09 UTC (permalink / raw)
On 2022-04-16 05:44, Thomas wrote:
> In article <s5h0o5$1piu$1@gioia.aioe.org>,
> "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote:
>
>> On 2021-04-18 11:09, Jeffrey R. Carter wrote:
>>> On 4/18/21 10:46 AM, Gautier write-only address wrote:
>>>> Side note: did anyone already suggest a new keyword: unchecked_free
>>>> and a special statement:
>>>>
>>>> unchecked_free Some_Pointer;
>>>
>>> For every access variable P, there could exist the attribute procedure
>>>
>>> P'Free;
>>
>> I like the idea of attaching it to a variable rather than to type.
>
> why?
Because operations apply to objects not to
the types of.
> if it had to be made, i would say it could not be less than sth like:
> T'Unchecked_Free (P)
This does as little sense as T'Image did.
>> I remember the claim that originally making it a generic procedure with
>> an indigestible name was meant as barrier for lazy programmers.
>
> not only that:
> i agree J-P. Rosen (he didn't said exactly that),
> it's fine to be able to search for the "Unchecked" keyword, to look at
> parts of code with some known risk (afaik):
> Ada.Unchecked_Deallocation, Ada.Unchecked_Conversion, Unchecked_Access.
You can search for "Free" as easily.
Furthermore, the way unchecked stuff breaks the program is such that the
actual problem is almost never located at the place where you call
something unchecked. The error is usually triggered in a different place.
>> Plus
>> some considerations regarding garbage collection lurked in the subconscious.
>
> could you explain, please ? :-)
You allocate objects at will and the language per magic wand frees them
for you someway someday. This anything that works in a non-magical way
(read: deterministic, predictable, explicit) is so outrageous that must
be highlighted as "unchecked." (:-))
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Unchecked_Deallocation with tagged types
@ 2022-04-16 3:44 2% ` Thomas
2022-04-16 8:09 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Thomas @ 2022-04-16 3:44 UTC (permalink / raw)
In article <s5h0o5$1piu$1@gioia.aioe.org>,
"Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote:
> On 2021-04-18 11:09, Jeffrey R. Carter wrote:
> > On 4/18/21 10:46 AM, Gautier write-only address wrote:
> >> Side note: did anyone already suggest a new keyword: unchecked_free
> >> and a special statement:
> >>
> >> unchecked_free Some_Pointer;
> >
> > For every access variable P, there could exist the attribute procedure
> >
> > P'Free;
>
> I like the idea of attaching it to a variable rather than to type.
why?
if it had to be made, i would say it could not be less than sth like:
T'Unchecked_Free (P)
>
> -------------
> I remember the claim that originally making it a generic procedure with
> an indigestible name was meant as barrier for lazy programmers.
not only that:
i agree J-P. Rosen (he didn't said exactly that),
it's fine to be able to search for the "Unchecked" keyword, to look at
parts of code with some known risk (afaik):
Ada.Unchecked_Deallocation, Ada.Unchecked_Conversion, Unchecked_Access.
> Plus
> some considerations regarding garbage collection lurked in the subconscious.
could you explain, please ? :-)
--
RAPID maintainer
http://savannah.nongnu.org/projects/rapid/
^ permalink raw reply [relevance 2%]
* Re: array from static predicate on enumerated type
@ 2021-03-17 15:08 1% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2021-03-17 15:08 UTC (permalink / raw)
On Tuesday, March 16, 2021 at 10:05:31 PM UTC-6, Matt Borchers wrote:
> So, I understand why holey arrays are problematic and I'm not asking for holey arrays here.
> I was looking for elegant solution around the fact that Ada intentionally does not provide a reasonable answer to 'First, 'Last, etc. when used on enumerated sub-types with a Predicate.
As I attempted to explain up-thread, the issue you are looking at *IS* the issue with holey arrays.
> In my cases, I have a lot of small (less than 5 rows and columns) multi-dimensional static data. It appears instantiating a Map and populating it at program start-up is the recommended solution. However, it sure seems to me that a static constant array of data is ideal because loading the Map cannot be guaranteed correct by the compiler whereas a table would be.
Since you want holes, you could use the abstraction to your benefit:
Subtype Letters is Character range 'A'..'Z';
Subtype Curved is Letters
with Static_Predicate => Curved in 'B' | 'C' | 'D' | 'G' | 'J';
Type Curved_2 is ('B', 'C', 'D', 'G', 'J')
with Size => Letters'Size;
For Curved_2 use (
'B' => Character'Pos( 'B' ),
'C' => Character'Pos( 'C' ),
'D' => Character'Pos( 'D' ),
'G' => Character'Pos( 'G' ),
'J' => Character'Pos( 'J' )
);
--------------
--Private/Body part
Actual_Map : Constant Array (Curved_2) of Integer;
-- In Body
Function Do_Map(C : Character) return Integer is
Function Convert is new Ada.Unchecked_Conversion(
Source => Character,
Target => Curved_2
);
Begin
Return (if C in Curved then Actual_Map(Convert(C))
--ELSIF other_condition then Another_Map(Another_Convert(C))
else raise Constraint_Error with "Invalid Index: '"& C &"'.");
End Do_Map;
An array might be "ideal", but only if the thing you're indexing by is contiguous, otherwise you literally ARE asking for a slice with holes.
Another option you might have is this:
Table : Array (Character range 'A'..'Z') of Integer:= (Others => 12);
K : Integer := 7
with Address => Table('K')'Address;
>
> It feels like an unfinished addition or incomplete feature to actively prevent 'First, 'Last, etc. from returning something reasonable about the sub-type in question. Return SOMETHING, even if it pertains to the parent type, and let the programmer decide how it can be useful to them. Using my LETTERS and CURVED_LETTERS example, I still don't see why the following would be problematic:
>
> A <= LETTERS'First
> K <= LETTERS'Last
> 11 <= LETTERS'Length
> 1 <= LETTERS'Pos(B)
> 10 <= LETTERS'Pos(J)
>
> B <= CURVED_LETTERS'First
> J <= CURVED_LETTERS'Last
> 5 <= CURVED_LETTERS'Length
> 0 <= CURVED_LETTERS'Pos(B)
> 4 <= CURVED_LETTERS'Pos(J)
>
> I didn't address 'Succ and 'Pred, but these also seem reasonable.
Read my post upthread, then Randy's, and you'll see that the absence of these features is tied to the holy-array/-slice problem.
Think about how difficult it would be to define multidimensional slices, which by their nature must be holey, and in a manner conducive to "efficiency" (in the C programmer's meaning).
> Again, I don't know the inner workings of the compiler, but these responses (above) for CURVED_LETTERS seem like reasonable values related to the sub-type that the compiler could handle easily allowing programmers who might want to write:
>
> type ARR(CURVED_LETTERS) of BOOLEAN;
>
> but for strict legality purposes have to suffice with:
>
> type ARR(CURVED_LETTERS'Pos(CURVED_LETTERS'First)..CURVED_LETTERS'Pos(CURVED_LETTERS'Last)) of BOOLEAN;
>
> It sure is ugly and some of you will surely yell, but we can do this now with a regular enumerated type and so it should be consistent for an enumerated sub-type. At least creating an array from this type can be do-able with access to these attributes and it can also be verified correct by the compiler.
Do you want such an array to hold 256 bits? One for each character with a CONSTRAINT_ERROR on bad indexing? (Meaning some sort of automatically generated function that is invisibly integrated into this object.)
Or are you wanting an array with holey indexes, collapsed spacewise, so that it's only 5 bits?
These are the questions which must be answered to even start to consider the issues at hand.
^ permalink raw reply [relevance 1%]
* Re: converting pointer to value
@ 2021-03-04 16:55 3% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2021-03-04 16:55 UTC (permalink / raw)
On Thursday, March 4, 2021 at 8:59:48 AM UTC-7, björn lundin wrote:
> this code looks like
>
> type SQLSMALLINT is range -(2 ** 15) .. +(2 ** 15) - 1;
> for SQLSMALLINT'Size use 16;
>
> type SQLRETURN is new SQLSMALLINT;
>
>
> how to get the Pvalue as an SQLRETURN?
Ok, in Ada the creation of a new type, even if only deriving it via NEW, makes a type which is incompatible with the old type.
Thus you can say TYPE TEMPERATURE IS NEW INTEGER; and TYPE SPEED IS NEW INTEGER; and values of these types are NOT interchangeable even though both have the same internal representation and properties that INTEGER does. The way that you can use these different types together is by casting; given X : SPEED := 3; you can say Y : TEMPERATURE := SPEED(X); -- which works because they have the same internal representation if they did not have the same representation you would have to use UNCHECKED_CONVERSION.
An example where you might need differing representations is modeling the x86 -- you could have something like:
Type Integer_Register is new Integer; -- IIRC, AX is 16-bits, divided into bytes AH and AL.
Type HL_Byte_Register is record
High, Low : Interfaces.Unsigned_8;
end record;
AX : Integer_Register:= 16#EF10#;
...
Declare
Function Convert is new Ada.Unchecked_Conversion(Integer_Register, HL_Byte_Register);
Function Convert is new Ada.Unchecked_Conversion(HL_Byte_Register, Integer_Register);
Temp : HL_Byte_Register := convert( AX );
Begin
-- Stuff w/ bytes.
AX:= Convert( Temp );
End;
In the code you present, SQLRETURN derives from SQLSMALLINT, so you can say SQLSMALLINT( Return_Value )... yes, I know this isn't pvalue as sqlreturn, we'll get there.
>
> function SQLParamData (StatementHandle : SQLHSTMT;
> pValue : access SQLPOINTER)
> return SQLRETURN;
>
So this returns a number, of the same representation that the 16-bit SQLSMALLINT has.
> so I get back the column in pValue.
> pValue is declared as
> Pvalue : aliased Sqlpointer;
...
> type SQLPOINTER is private;
....
> private
> type SQLPOINTER is new System.Storage_Elements.Integer_Address;
And here we have SQLPOINTER, which is private, but which is something of the same representation that Integer_Address has; let's assume that the ADDRESS type is implementation-defined, and a private type.
What does this mean?
It means that we don't know what the size of ADDRESS (and thus SQLPOINTER) actually is, but assuming you're on a 32- or 64-bit machine it's likely 2 to 4 times as large as the 16-bit SQLSMALLINT-- which is a good indication that a simple UNCHECKED_CONVERSION is the wrong answer.
Try looking at the operations which have SQLPOINTER as a parameter/result.
^ permalink raw reply [relevance 3%]
* Re: Record initialisation question
2021-01-15 18:15 3% ` Shark8
@ 2021-01-16 10:28 0% ` DrPi
0 siblings, 0 replies; 200+ results
From: DrPi @ 2021-01-16 10:28 UTC (permalink / raw)
Le 15/01/2021 à 19:15, Shark8 a écrit :
> On Friday, January 15, 2021 at 12:50:41 AM UTC-7, DrPi wrote:
>> Unchecked_Conversion is not compatible with no elaboration code.
> I find that surprising.
> Ada.Unchecked_Conversion is defined by the LRM as a compiler-intrinsic, with the Pure pragma*:
>
> generic
> type Source(<>) is limited private;
> type Target(<>) is limited private;
> function Ada.Unchecked_Conversion(S : Source) return Target
> with Convention => Intrinsic;
> pragma Pure(Ada.Unchecked_Conversion);
>
> The GNAT source has, as its last three lines:
> pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion);
> pragma Pure (Ada.Unchecked_Conversion);
> pragma Import (Intrinsic, Ada.Unchecked_Conversion);
>
> So, if you are generating elaboration-code, then GNAT is broken.
>
> * IIUC, this (Intrinsic+Pure) should make it essentially equivalent to C's bitwise reinterpretation-cast, and [IIRC] should qualify for 'static function call'.
>
I made new tests.
You are right, Unchecked_Conversion() is not the culprit.
When I tried it, I got 'violation of restriction "No_Elaboration_Code"'
due to other statements but didn't realized it.
^ permalink raw reply [relevance 0%]
* Re: Record initialisation question
2021-01-15 7:50 0% ` DrPi
@ 2021-01-15 18:15 3% ` Shark8
2021-01-16 10:28 0% ` DrPi
0 siblings, 1 reply; 200+ results
From: Shark8 @ 2021-01-15 18:15 UTC (permalink / raw)
On Friday, January 15, 2021 at 12:50:41 AM UTC-7, DrPi wrote:
> Unchecked_Conversion is not compatible with no elaboration code.
I find that surprising.
Ada.Unchecked_Conversion is defined by the LRM as a compiler-intrinsic, with the Pure pragma*:
generic
type Source(<>) is limited private;
type Target(<>) is limited private;
function Ada.Unchecked_Conversion(S : Source) return Target
with Convention => Intrinsic;
pragma Pure(Ada.Unchecked_Conversion);
The GNAT source has, as its last three lines:
pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion);
pragma Pure (Ada.Unchecked_Conversion);
pragma Import (Intrinsic, Ada.Unchecked_Conversion);
So, if you are generating elaboration-code, then GNAT is broken.
* IIUC, this (Intrinsic+Pure) should make it essentially equivalent to C's bitwise reinterpretation-cast, and [IIRC] should qualify for 'static function call'.
^ permalink raw reply [relevance 3%]
* Re: Record initialisation question
2021-01-14 16:53 2% ` Shark8
@ 2021-01-15 7:50 0% ` DrPi
2021-01-15 18:15 3% ` Shark8
0 siblings, 1 reply; 200+ results
From: DrPi @ 2021-01-15 7:50 UTC (permalink / raw)
Le 14/01/2021 à 17:53, Shark8 a écrit :
> Another option, which IIUC should work within the constraints, being Pure:
>
> With
> Ada.Unchecked_Conversion,
> System;
>
> Package Example with Pure is
>
> Type Address_Stub is null record
> with Size => Standard'Address_Size, Warnings => Off;
> Function Convert(Input : System.Address) return Address_Stub;
>
> Type Stub is null record with Size => 8, Warnings => Off;
> Type Static_Record is record
> Reserved_1 : Stub;
> X, Y : Integer;
> Self : Address_Stub;
> end record;
>
> Generic
> Location : System.Address;
> Package Based is
>
> Function Create( X, Y : Integer ) return Static_Record;
> Private
> Function Create( X, Y : Integer ) return Static_Record is
> (Self => Convert( Location ), Reserved_1 => (null record),
> X => X, Y => Y
> );
> End Based;
>
>
> Private
> Use System, Ada;
>
> Function Address_Conversion is new Unchecked_Conversion(
> Source => Address,
> Target => Address_Stub
> );
> Function Convert(Input : System.Address) return Address_Stub
> renames Address_Conversion;
> End Example;
>
> -- Usage should be something like:
> Object_Address : Constant System.Address := (<>);
> Package Object_Basis is new Example.Based( Object_Address );
> Object : Example.Static_Record := Object_Basis.Create( Params => <> );
> For Object'Address use Object'Address;
>
> Sorry but I haven't done much in the way of microcontrolers, so this is best-guess on my part. The restrictions of Pure *should* comport with the restrictions you have though, again IIUC.
>
Unchecked_Conversion is not compatible with no elaboration code.
^ permalink raw reply [relevance 0%]
* Re: Record initialisation question
@ 2021-01-14 16:53 2% ` Shark8
2021-01-15 7:50 0% ` DrPi
0 siblings, 1 reply; 200+ results
From: Shark8 @ 2021-01-14 16:53 UTC (permalink / raw)
Another option, which IIUC should work within the constraints, being Pure:
With
Ada.Unchecked_Conversion,
System;
Package Example with Pure is
Type Address_Stub is null record
with Size => Standard'Address_Size, Warnings => Off;
Function Convert(Input : System.Address) return Address_Stub;
Type Stub is null record with Size => 8, Warnings => Off;
Type Static_Record is record
Reserved_1 : Stub;
X, Y : Integer;
Self : Address_Stub;
end record;
Generic
Location : System.Address;
Package Based is
Function Create( X, Y : Integer ) return Static_Record;
Private
Function Create( X, Y : Integer ) return Static_Record is
(Self => Convert( Location ), Reserved_1 => (null record),
X => X, Y => Y
);
End Based;
Private
Use System, Ada;
Function Address_Conversion is new Unchecked_Conversion(
Source => Address,
Target => Address_Stub
);
Function Convert(Input : System.Address) return Address_Stub
renames Address_Conversion;
End Example;
-- Usage should be something like:
Object_Address : Constant System.Address := (<>);
Package Object_Basis is new Example.Based( Object_Address );
Object : Example.Static_Record := Object_Basis.Create( Params => <> );
For Object'Address use Object'Address;
Sorry but I haven't done much in the way of microcontrolers, so this is best-guess on my part. The restrictions of Pure *should* comport with the restrictions you have though, again IIUC.
^ permalink raw reply [relevance 2%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? Luke A. Guest
` (2 preceding siblings ...)
2020-09-19 14:08 0% ` erchetan33
@ 2020-09-28 11:36 0% ` yhumina stir
3 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
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
3 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-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
3 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-09-03 10:32 0% ` c+
2020-09-13 13:36 0% ` patelchetan1111992
` (2 subsequent siblings)
3 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%]
* How can I get this data into the .data section of the binary?
@ 2020-06-16 11:31 1% Luke A. Guest
2020-09-03 10:32 0% ` c+
` (3 more replies)
0 siblings, 4 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: Array Index: substitute integer with enumeration
@ 2020-06-09 17:25 2% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2020-06-09 17:25 UTC (permalink / raw)
On Thursday, June 4, 2020 at 10:54:57 AM UTC-6, hreba wrote:
> Just as an example, let's assume there is a general geometry package
> which requires a function from the client which transforms cartesian
> coordinates into a client-specific coordinate system:
>
> type Point is array (range 1..3) of Float;
>
> type Transform_T is access Function (p: Point) return Point;
You don't need accesses in any of your program-facing compilation-units; you *might* for the library-facing interfaces. The type Point can also be modeled differently for the program-facing side and the library-facing side. — That is, you can do everything you need to interface the library in the private-section and/or body (body would arguably be preferable, because if you discard the library's usage, you've constrained the library only to the body and thus only have one thing to change.
Using coordinates + enumerations you could, perhaps, use:
Type Point is record
r, phi, theta: Interfaces.IEEE_Float_32;
End Record
with Size => Interfaces.IEEE_Float_32*3;
and then in your library interfacing part, have:
Type Library_Point is Array(1..3) of Interfaces.IEEE_Float_32
with Convention => Fortran, Size => Interfaces.IEEE_Float_32*3;
Pragma Assert( Point'Size = Library_Point'Size,
"Point-type sizes must match." );
-- Imported functions.
-- To_Cartesian and To_Spherical, etc.
Function Convert( Input : Point ) return Library_Point is
-- Isolating the Unchecked Conversion.
Function Cvt is new Ada.Unchecked_Conversion(Point, Library_Point);
Begin
Return Result : constant Library_Point := To_Cartesian( Cvt(Input) );
End Convert;
Function Convert( Input : Library_Point ) return Point is
-- Isolating the Unchecked Conversion.
Function Cvt is new Ada.Unchecked_Conversion(Library_Point, Point);
Begin
Return Result : constant Library_Point := To_Spherical( Cvt(Input) );
End Convert;
and take your conversion functions
To_Cartesian and To_Spherical and passing their accesses to the imported functions that need them.
TL;DR — Make the interface you want to present to your program first then, in the body, do all your interfacing and library-importing.
> My questions are now:
>
> 1. Does the initialization of pc involve any copying at run time?
IIRC, parameters are passed as reference for arrays and records; so if that's what you're using to model a point, it shouldn't for functions. Initialization, especially with aggregates, is a different matter and one I'm less sure on. (I seem to recall someone, Lucretia?, doing some work with GNAT and coming to the conclusion that if there was an "Others" in the aggregate there would be a loop generated, which might have copying.)
> 2. If so, how can it be avoided?
Usually by things like shown: isolate your critical functions, and then (a) present an interface for the rest of the program to use while (b) ensuring those critical functions behave as you want. (This might take a little more expertise on the subject, as it sounds like you could be messing with embedded and my experience there is extremely limited.)
^ permalink raw reply [relevance 2%]
* Re: Put the access value
@ 2020-04-15 7:20 2% ` briot.emmanuel
0 siblings, 0 replies; 200+ results
From: briot.emmanuel @ 2020-04-15 7:20 UTC (permalink / raw)
The approach I tend to use is using `System.Address_Image`:
El : Buffer_Pointer := LastBuffer;
...
if El /= null then
Ada.Text_IO.Put_Line (System.Address_Image (El.all'Address));
end if;
or if this is for slightly longer term
function Convert is new Ada.Unchecked_Conversion
(Buffer_Pointer, System.Address);
Ada.Text_IO.Put_Line (System.Address_Image (Convert (El));
This is really just for quick debugging, and the code is never (really, I swear) committed... Otherwise, I would go to the trouble of creating an `Image` function and use that
^ permalink raw reply [relevance 2%]
* Re: GNATCOLL-Mmap example
@ 2020-01-28 18:53 2% ` Bob Goddard
0 siblings, 0 replies; 200+ results
From: Bob Goddard @ 2020-01-28 18:53 UTC (permalink / raw)
On Tuesday, 28 January 2020 08:25:25 UTC, Dmitry A. Kazakov wrote:
> On 2020-01-25 22:52, Bob Goddard wrote:
>
> > I need to map the RPi's GPIO memory addresses so that I can do what I need to do.
>
> See files under:
>
> /sys/class/gpio
>
> You can use standard Ada I/O to read and set GPIO pins. E.g.
>
> /sys/class/gpio/gpio/XXX/value
This was the way I started, but could not get it to read anything. It just blocks trying to read a single character. My c code works fine using the wiringPi libs.
Stephen Leake:
Mmap is used to read more than just disk files. Opening /dev/mem, or even /dev/gpiomem, is just another file.
Regardless, I got it to work. The moral of the story, is never assume example code in the library source works, or even can compile. I got it running a couple of days ago, and have since spent time banging my head against a wall.
This works, both with System.Mmap & GNATCOLL.Mmap...
with Ada.Unchecked_Conversion;
with Ada.Text_IO;
with GNATCOLL.Mmap; use GNATCOLL.Mmap;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;
procedure Mmaptest is
package Mmap renames GNATCOLL.Mmap;
File : Mmap.Mapped_File;
Reg : Mmap.Mapped_Region;
Str : Mmap.Str_Access;
Offs : Mmap.File_Size := 0;
Page : constant Mmap.File_Size := Mmap.File_Size (Mmap.Get_Page_Size);
begin
File := Mmap.Open_Write ("/tmp/file_on_disk");
while Offs < Mmap.Length (File) loop
Mmap.Read (File, Reg, Offs, Length => Page, Mutable => False);
Str := Mmap.Data (Reg);
Ada.Strings.Unbounded.Text_IO.Put (Ada.Strings.Unbounded.To_Unbounded_String (
Str (Integer (Offs - Mmap.Offset (Reg)) + 1 .. Mmap.Last (Reg)))
);
Offs := Offs + Page; -- Mmap.File_Size (Mmap.Last (Reg));
end loop;
Mmap.Free (Reg);
if Reg /= Mmap.Invalid_Mapped_Region then
Ada.Text_IO.Put_Line ("Mapped region still valid");
end if;
Mmap.Close (File);
if File /= Mmap.Invalid_Mapped_File then
Ada.Text_IO.Put_Line ("Mapped file still valid");
end if;
end Mmaptest;
^ permalink raw reply [relevance 2%]
* Re: Creating several types from a base type and conversion
@ 2020-01-24 15:54 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2020-01-24 15:54 UTC (permalink / raw)
Optikos <ZUERCHER_Andreas@outlook.com> writes:
> Instead of depending on a big-language solution of a very-feature-rich
> compiler, there is a common industrial practice in both Ada and other
> languages that I mentioned in my 2 replies: use 2 different packages
> with same-named identifiers (especially functions or procedures) to
> link in either the little-endian implementation or big-endian
> implementation
An alternative approach (which I've now abandoned in favour of the GNAT
Scalar_Storage_Order) was, given e.g.
type SNTP_Timestamp is delta 2.0 ** (-32) range -2.0 ** 31 .. 2.0 ** 31;
for SNTP_Timestamp'Size use 64;
subtype Timestamp_Slice is Ada.Streams.Stream_Element_Array (1 .. 8);
to provide conversion functions like
function To_Timestamp_Slice
(T : SNTP_Timestamp) return Timestamp_Slice is
function Convert
is new Ada.Unchecked_Conversion (SNTP_Timestamp,
Timestamp_Slice);
Tmp : constant Timestamp_Slice := Convert (T);
begin
if Big_Endian then
return Tmp;
else
return (1 => Tmp (8),
2 => Tmp (7),
3 => Tmp (6),
4 => Tmp (5),
5 => Tmp (4),
6 => Tmp (3),
7 => Tmp (2),
8 => Tmp (1));
end if;
end To_Timestamp_Slice;
(Big_Endian was a compile-time constant; GNAT is clever enough not to
generate any object code for the "other" branch).
It got a bit more interesting where there were bit fields involved; the
two branches can declare appropriately-represented derived types and use
type conversion between base and derived type to get the compiler to do
the hard work. See e.g. [1] starting at line 43.
[1] https://sourceforge.net/p/coldframe/adasntp/code/ci/Rel_20070311/tree/SNTP.impl/sntp_support.adb
^ permalink raw reply [relevance 2%]
* Re: Creating several types from a base type and conversion
2020-01-18 12:16 2% ` Simon Wright
2020-01-18 12:49 0% ` Ken Roberts
@ 2020-01-18 14:17 0% ` Optikos
1 sibling, 0 replies; 200+ results
From: Optikos @ 2020-01-18 14:17 UTC (permalink / raw)
On Saturday, January 18, 2020 at 6:16:20 AM UTC-6, Simon Wright wrote:
> Ken Roberts writes:
>
> > So the next question is how to convert between CharWord/BaseWord?
>
> Possibly using Ada.Unchecked_Conversion. Hidden inside a function with a
> helpful-in-six-months name.
>
> It takes very little time to compile code nowadays, I'd strongly suggest
> you start with the basics (e.g. BaseWord) and build up from there,
> checking as you go (there are a _lot_ of syntax errors in your example
> code).
>
> You can't say
>
> type DataWord is new BaseWord with record
> Upper : array 00 .. 8#77777# of Boolean;
> Lower : array 00 .. 8#77777# of Boolean;
> end record;
>
> because BaseWord isn't a tagged type, and even if it was you don't want
> to add extra information, you're looking for an alternative view.
> And that's not the syntax for an array declaration.
> And you can't declare an anonymous array in a record.
> And that's two large arrays (I think you're aiming for representations).
>
> ----------
>
> I was wondering whether an Unchecked Union (ARM B.3.3[1]) might serve,
> but (30) says "The use of an unchecked union to obtain the effect of an
> unchecked conversion results in erroneous execution".
>
> [1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3-3.html
The Unchecked_ series are better focused on the situation that BaseWord, DataWord, InstructionWord, and CharWord are originating in another language, say, C, but that is ostensibly not the case here.
More proper in Ada, would be to have multiple conversion functions that take the already-extant FooWord as a parameter and return an extracted/converted BarWord as return value (or a procedure that takes the already-extant FooWord as an in parameter and the to-be-extracted/to-be-converted BarWord as an out parameter). Then that conversion/extraction subroutine is merely performing garden-variety safe/not-unchecked reading of FooWord and is merely performing garden-variety safe/not-unchecked writing of BarWord.
You would have a plethora of such FooWord to BarWord conversion/extraction subroutines—one for each origin-to-destination pairing in your app-domain, such as {ExtractCharWordFromDataWord, EmbedCharWordIntoDataWord, ExtractDataWordFromInstructionWordOpcode, EmbedDataWordIntoInstructionWordOpcode, ExtractDataWordFromInstructionWordImmediate, EmbedDataWordIntoInstructionWordImmediate, …} (assuming that immediates in the machine code are located at the same offset-from-beginning-of-instruction in all machine instructions, otherwise ExtractDataWordFromImmediateForSuchandsuchOpcode and EmbedDataWordIntoImmediateForSuchandsuchOpcode for each different format of suchandsuch opcodes in the instruction-set) and so forth.
In modern Ada, for efficiency and perhaps succinct/readable beauty, you might want to consider the extended return statement if choosing the design above that is based on functions (instead of the out parameter to a procedure, which is available in all eras of Ada, but perhaps naturally leading to slightly more verbose/less-lucid invocations at points of usage, due to being statements instead of expressions).
https://www.adaic.org/resources/add_content/standards/05rm/html/RM-6-5.html#S0170
^ permalink raw reply [relevance 0%]
* Re: Creating several types from a base type and conversion
2020-01-18 12:16 2% ` Simon Wright
@ 2020-01-18 12:49 0% ` Ken Roberts
2020-01-18 14:17 0% ` Optikos
1 sibling, 0 replies; 200+ results
From: Ken Roberts @ 2020-01-18 12:49 UTC (permalink / raw)
On Saturday, January 18, 2020 at 4:16:20 AM UTC-8, Simon Wright wrote:
> Ken Roberts <snip> writes:
>
> > So the next question is how to convert between CharWord/BaseWord?
>
> Possibly using Ada.Unchecked_Conversion. Hidden inside a function with a
> helpful-in-six-months name.
>
> It takes very little time to compile code nowadays, I'd strongly suggest
> you start with the basics (e.g. BaseWord) and build up from there,
> checking as you go (there are a _lot_ of syntax errors in your example
> code).
>
> You can't say
>
> type DataWord is new BaseWord with record
> Upper : array 00 .. 8#77777# of Boolean;
> Lower : array 00 .. 8#77777# of Boolean;
> end record;
>
> because BaseWord isn't a tagged type, and even if it was you don't want
> to add extra information, you're looking for an alternative view.
> And that's not the syntax for an array declaration.
> And you can't declare an anonymous array in a record.
> And that's two large arrays (I think you're aiming for representations).
>
> ----------
>
> I was wondering whether an Unchecked Union (ARM B.3.3[1]) might serve,
> but (30) says "The use of an unchecked union to obtain the effect of an
> unchecked conversion results in erroneous execution".
>
> [1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3-3.html
Don't know about the syntax errors - gnatmake seems to like it. But
then, the example is in a package spec with no body yet. Still working
on the basics first. Just now getting serious about Ada, I'm sure I'll
run into a lot of learning curve on these little details.
The concept is emulating a 30-bit computer from olden days.
It was my understanding that a boolean array would be better than an
integer in order to do some of the bit manipulations that the old
computer was designed for.
One example:
ADD LP : L[Y*(Q)]+(A) -> A
Take the logical product of Y and Q register, then add A register,
place results in A register.
(LP being boolean AND of 2 registers)
I think I tried doing tagged records and subtypes, but kept getting
errors like 'Bits already mapped' when trying to extend the BaseWord
(30 bit) into a data word ( 2 separate 15-bit fields) and instruction
word (5 separate bit-mapped fields) while still being able to easily
convert between BaseWord and others (think pulling next instruction from memory array, then pulling data from arbitrary location in memory array).
Functionally, it would be relatively easy to just ignore the hardware
aspect of the emulation, but I'm trying to set it up so I can emulate
the hardware later as a learning tool to how this old computer
actually did things (like 1's complement subtractive addition). The
real fun will be programming the timing (1MHz clock split into 4
phases, with interesting interrupt handling).
I know - _very_ ambitious project for a beginner in the language (not
to programming), but I figure might as well have an interesting
project to work on while learning rather than the basic "Hello World"
style that seems to be prevalent.
^ permalink raw reply [relevance 0%]
* Re: Creating several types from a base type and conversion
@ 2020-01-18 12:16 2% ` Simon Wright
2020-01-18 12:49 0% ` Ken Roberts
2020-01-18 14:17 0% ` Optikos
1 sibling, 2 replies; 200+ results
From: Simon Wright @ 2020-01-18 12:16 UTC (permalink / raw)
Ken Roberts <alisonken1@gmail.com> writes:
> So the next question is how to convert between CharWord/BaseWord?
Possibly using Ada.Unchecked_Conversion. Hidden inside a function with a
helpful-in-six-months name.
It takes very little time to compile code nowadays, I'd strongly suggest
you start with the basics (e.g. BaseWord) and build up from there,
checking as you go (there are a _lot_ of syntax errors in your example
code).
You can't say
type DataWord is new BaseWord with record
Upper : array 00 .. 8#77777# of Boolean;
Lower : array 00 .. 8#77777# of Boolean;
end record;
because BaseWord isn't a tagged type, and even if it was you don't want
to add extra information, you're looking for an alternative view.
And that's not the syntax for an array declaration.
And you can't declare an anonymous array in a record.
And that's two large arrays (I think you're aiming for representations).
----------
I was wondering whether an Unchecked Union (ARM B.3.3[1]) might serve,
but (30) says "The use of an unchecked union to obtain the effect of an
unchecked conversion results in erroneous execution".
[1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3-3.html
^ permalink raw reply [relevance 2%]
* Is this actually possible?
@ 2019-12-11 16:43 2% Lucretia
0 siblings, 0 replies; 200+ results
From: Lucretia @ 2019-12-11 16:43 UTC (permalink / raw)
Hi,
I was thinking about extensible records recently (not tagged types), and thought to try to export a tagged type to C, not C++. It compiles, but the results aren't quite right, so wondering if it's possible or not.
The idea is to export an array of tagged types as a C array to either a function or a variable / struct element. i.e.
struct Blah {
My_Array *Array;
};
or in this case (Array below):
#include <stdio.h>
typedef struct {
int One;
float Two;
} Packet;
void Dump (int First, int Last, Packet *Array) {
printf ("Dump (%d .. %d)\n", First, Last);
printf ("Array => %p\n", Array);
for (int I = First; I < Last + 1; I++) {
printf ("\tOne => %d\n", Array[I].One);
printf ("\tTwo => %f\n", Array[I].Two);
}
}
So, I tried a few things, including Holders, which I never knew existed, but this is where I am currently:
with Interfaces.C;
-- with Ada.Containers.Bounded_Holders;
with System;
package Datums is
package C renames Interfaces.C;
-- Force a size, we kind of want a variant like array of records, but with unknown element types, but always of
-- the same number and size of elements.
type Root_Packet is abstract tagged null record with
Size => C.int'Size + C.C_float'Size;
-- package Root_Holders is new Ada.Containers.Bounded_Holders (Element_Type => Root_Packet'Class);
type Storage_Element is mod 2 ** System.Storage_Unit with
Convention => C;
type Storage_Array is array (Positive range <>) of Storage_Element with
Convention => C;
type Root_Holder is
record
Data : Storage_Array (1 .. Root_Packet'Max_Size_In_Storage_Elements);
end record with
Convention => C;
type Packet_Array is array (C.size_t range <>) of aliased Root_Holder with -- Root_Holders.Holder with
Convention => C;
type Packet_Array_Ptr is access all Packet_Array with
Convention => C;
type Packet_1 is new Root_Packet with
record
One : C.int;
Two : C.C_float;
end record with
Convention => C;
type Packet_2 is new Root_Packet with
record
Banana : C.int;
Mango : C.C_float;
end record with
Convention => C;
end Datums;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with System.Address_Image;
with Datums; use Datums;
procedure Testing is
-- use Root_Holders;
function To_Holder is new Ada.Unchecked_Conversion (Source => Packet_1, Target => Root_Holder);
function To_Holder is new Ada.Unchecked_Conversion (Source => Packet_2, Target => Root_Holder);
A : aliased Packet_Array := (1 => To_Holder (Packet_1'(One => 10, Two => 3.14)),
2 => To_Holder (Packet_2'(Banana => 50, Mango => 4.5)));
procedure Dump (First, Last : in C.int; Data : in Packet_Array_Ptr) with
Convention => C,
Import => True,
External_Name => "Dump";
begin
Put_Line ("A'Address => " & System.Address_Image (A'Address));
Dump (C.int (A'First), C.int (A'Last), A'Unchecked_Access);
end Testing;
project T is
for Source_Dirs use (".");
for Languages use ("C", "Ada");
for Main use ("testing.adb");
package Compiler is
for Default_Switches ("Ada") use ("-g");
for Default_Switches ("C") use ("-g");
end Compiler;
end T;
^ permalink raw reply [relevance 2%]
* Re: Ada x <whatever> Datagram Sockets
2019-02-08 20:35 2% ` Rego, P.
@ 2019-02-08 21:38 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2019-02-08 21:38 UTC (permalink / raw)
On 2019-02-08 21:35, Rego, P. wrote:
>> What the OP needs to do is
>>
>> 1. Get Length, the length of the data.
>> 2. Create C : Interfaces.C.char_array (1 .. Length)
>> 3. Transfer the data into C
>> 4. Use Interfaces.C.To_Ada (C) to transform C into an Ada String
>
> Simple enough, would you know how transfer the data into this C? I am trying in this path
>
> loop
> -- Receive and print message from client Ping
> Channel := SOCKETS.Stream (Socket, Address);
>
> Text_IO.Put_Line (Integer'Image (Channel'Size));
>
> declare
> Channel_Size : Integer := Integer (Channel'Size);
> type Buffer_Type is new Interfaces.C.char_array (1 .. Interfaces.C.size_t (Channel_Size));
> type Stream_Buffer_Type is new String (1 .. Integer (Channel_Size));
>
> function Copy_Arr is new Ada.Unchecked_Conversion (Buffer_Type, Stream_Buffer_Type);
>
> --Buffer : Buffer_Type;
> Stream_Buffer : Stream_Buffer_Type;
>
> begin
> --Buffer := String'Input (Channel);
>
> --!!!! Stream_Buffer := Stream_Buffer_Type (String'Input (Channel));
> end;
> end loop;
declare
Packet : Stream_Element_Array (1..Max_Size);
Last : Stream_Element_Offset;
From : Sock_Addr_Type;
loop
Receive_Socket (Socket, Packet, Last, From); -- UDP from anyone
declare
Text : String (1..Natural (Last));
begin
for Index in 1..Last loop
Text (Integer (Index)) := Character'Val (Packet (Index));
end loop;
Put_Line (Image (From) & ">|" & Text & "|");
end;
end loop;
For UDP there is no need to have packet length because packet=frame.
For TCP, you read the header first which usually determine the length.
Then you read the length stream elements. After that you start to decode.
P.S. It is good practice to keep framing (packet I/O) separate from
payload encoding/decoding.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Ada x <whatever> Datagram Sockets
@ 2019-02-08 20:35 2% ` Rego, P.
2019-02-08 21:38 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Rego, P. @ 2019-02-08 20:35 UTC (permalink / raw)
> What the OP needs to do is
>
> 1. Get Length, the length of the data.
> 2. Create C : Interfaces.C.char_array (1 .. Length)
> 3. Transfer the data into C
> 4. Use Interfaces.C.To_Ada (C) to transform C into an Ada String
Simple enough, would you know how transfer the data into this C? I am trying in this path
loop
-- Receive and print message from client Ping
Channel := SOCKETS.Stream (Socket, Address);
Text_IO.Put_Line (Integer'Image (Channel'Size));
declare
Channel_Size : Integer := Integer (Channel'Size);
type Buffer_Type is new Interfaces.C.char_array (1 .. Interfaces.C.size_t (Channel_Size));
type Stream_Buffer_Type is new String (1 .. Integer (Channel_Size));
function Copy_Arr is new Ada.Unchecked_Conversion (Buffer_Type, Stream_Buffer_Type);
--Buffer : Buffer_Type;
Stream_Buffer : Stream_Buffer_Type;
begin
--Buffer := String'Input (Channel);
--!!!! Stream_Buffer := Stream_Buffer_Type (String'Input (Channel));
end;
end loop;
^ permalink raw reply [relevance 2%]
* Re: Problem with Position of the enumeration Type
2019-01-23 12:08 2% ` Luis Ladron de Guevara Moreno
@ 2019-01-24 8:06 0% ` AdaMagica
0 siblings, 0 replies; 200+ results
From: AdaMagica @ 2019-01-24 8:06 UTC (permalink / raw)
Am Mittwoch, 23. Januar 2019 13:08:34 UTC+1 schrieb Luis Ladron de Guevara Moreno:
> El miércoles, 23 de enero de 2019, 11:33:36 (UTC+1), AdaMagica escribió:
> > See RM 13.4(11/3)ff:
> > NOTES
> > 14 Unchecked_Conversion may be used to query the internal codes used for
> > an enumeration type. The attributes of the type, such as Succ, Pred, and Pos, are unaffected by the enumeration_representation_clauserepresentation_clause.
> >
> > Some questions on your code:
> >
> > Position : Integer; -- Why is this Integer and not Natural?
> >
> > for I in E_Test'Base loop -- Why do you use 'Base here?
>
> I wrote a Integer as an example, i could add Natural also, for this example there are not difference.
It does make a difference. Ada has subtypes just for this purpose: If you know that the values of an object of some type belong only to some subtype, you indicate this in the declaration.
This is the very idea of stong typing.
> I'm using 'Range to go through all the positions in enumeration.
No, you used 'Base.
For a enum type E, these are always the same:
for V in E loop
for V in E'Range loop
For an enum type that is not derived, E'Base is the same as E. For types derived from E, there might be a difference.
> I tried to use Ada.Unchecked_Conversion and i got obtain the values for the position. but as you told me, if i use 'post (), the number of the list start in 0.
Yes, this is what the RM prescribes.
^ permalink raw reply [relevance 0%]
* Re: Problem with Position of the enumeration Type
@ 2019-01-23 12:08 2% ` Luis Ladron de Guevara Moreno
2019-01-24 8:06 0% ` AdaMagica
0 siblings, 1 reply; 200+ results
From: Luis Ladron de Guevara Moreno @ 2019-01-23 12:08 UTC (permalink / raw)
El miércoles, 23 de enero de 2019, 11:33:36 (UTC+1), AdaMagica escribió:
> See RM 13.4(11/3)ff:
> NOTES
> 14 Unchecked_Conversion may be used to query the internal codes used for
> an enumeration type. The attributes of the type, such as Succ, Pred, and Pos, are unaffected by the enumeration_representation_clauserepresentation_clause.
>
> Some questions on your code:
>
> Position : Integer; -- Why is this Integer and not Natural?
>
> for I in E_Test'Base loop -- Why do you use 'Base here?
I wrote a Integer as an example, i could add Natural also, for this example there are not difference.
I'm using 'Range to go through all the positions in enumeration.
I tried to use Ada.Unchecked_Conversion and i got obtain the values for the position. but as you told me, if i use 'post (), the number of the list start in 0.
^ permalink raw reply [relevance 2%]
* Re: Examining individual bytes of an integer
2018-10-14 19:55 0% ` Jeffrey R. Carter
@ 2018-10-14 21:28 0% ` Niklas Holsti
0 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2018-10-14 21:28 UTC (permalink / raw)
On 18-10-14 22:55 , Jeffrey R. Carter wrote:
> On 10/14/2018 09:15 PM, Henrik Härkönen wrote:
>>
>> type Byte is mod 256;
>> type Word is mod 2 ** 32;
>>
>> type E2 is array(1 .. 4) of Byte;
>> function Convert_To_E2 is new Ada.Unchecked_Conversion (Source
>> => Word,
>> Target =>
>> E2);
>>
>> function Convert_To_Word is new Ada.Unchecked_Conversion (Source
>> => E2,
>> Target
>> => Word);
>
> Unchecked_Conversion is the Ada Way.
Or Interfaces.Unsigned_xx and shifts.
> Often it is a good idea to specify
> the sizes of all the types involved to ensure that the conversion is
> between equal-sized hunks of memory.
Yes, but GNAT normally gives a warning if the sizes differ.
> However, with the array, you don't know which index corresponds to which
> byte of the integer. You can examine the bytes of several values to
> determine this, but on a different platform or with a different compiler
> the correspondence may be different.
Yes: endianness (or a perverse array index order, see below).
> Usually the lowest index
> corresponds to the lowest address, but that is not guaranteed by the
> language.
Not guaranteed, but implied by the "Implementation advice":
- RM 13.3(11): X'address denotes the address of the first of the storage
elements allocated to X.
- RM 13.3(14): For an array X, X'Address should point at the first
component of the array [...].
Combining those two, it seems that the first element of an array should
start at the first storage element (= lowest address) allocated to the
array.
By reasonable induction :-) the second, third, etc. array elements
follow in increasing address order. But not _guaranteed_, I agree.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: Examining individual bytes of an integer
2018-10-14 19:15 3% Examining individual bytes of an integer Henrik Härkönen
2018-10-14 19:55 0% ` Jeffrey R. Carter
@ 2018-10-14 21:04 0% ` Niklas Holsti
1 sibling, 0 replies; 200+ results
From: Niklas Holsti @ 2018-10-14 21:04 UTC (permalink / raw)
On 18-10-14 22:15 , Henrik Härkönen wrote:
> I'd like to examine individual bytes of larger (in bit size)
> integer type. In C would probably move byte pointer etc. Also
> I'd need to have a way to construct the integer from individual bytes.
>
> Would this be "the Ada-way", the Unchecked_Conversion?
It depends... for this particular case, I would say "no", for the
endianness reasons that Jeffrey described.
I would use the unsigned (modular) integer types in the predefined
package Interfaces, such as Interfaces.Unsigned_32, which come with
shift and rotate operations.
For example, to extract the most significant octet of a 32-bit unsigned
integer with value 435343, I would do (assuming "use Interfaces"):
Z : Unsigned_32 := 435343;
MS_Octet : constant Unsigned_32 := Shift_Right (Z, 24);
To compose an unsigned 32-bit integer from the octets 77, 88, 99, and
22, listed in big-endian order, I would do:
Z : Unsigned_32 :=
Shift_Left (77, 24)
or Shift_Left (88, 16)
or Shift_Left (99, 8)
or 22;
(If you need lots of such expressions, you could define an "&" operator
to make that look like 77 & 88 & 99 & 22.)
Using a record type with named octet components (and a Bit_Order clause)
is ok, too, but then one needs some Unchecked_Conversions.
If you really want to inspect the structure of integers in memory,
address by address, then I think the only way is the same as in C: make
an octet pointer to the memory representation and read octet by octet.
(But note that the Storage_Unit for some strange machines may not be 8
bits.)
(I have become very sensitive to endianness problems because my daily
work involves writing Ada programs targeted to big-endian SPARC
machines, but tested initially on little-endian PCs.)
> ---8<---
>
> procedure Main is
>
> type Byte is mod 256;
> type Word is mod 2 ** 32;
>
> type E2 is array(1 .. 4) of Byte;
>
> Z: Word;
> Y: E2;
>
> function Convert_To_E2 is new Ada.Unchecked_Conversion (Source => Word,
> Target => E2);
>
> function Convert_To_Word is new Ada.Unchecked_Conversion (Source => E2,
> Target => Word);
>
> begin
> Y := Convert_To_E2(Word(435343));
> Z := Convert_To_Word(Y);
> end Main;
>
> --->8---
>
> At least that looks nice and neat, I could also use record with
> assigned names to bytes if necessary.
>
> -Henrik
>
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: Examining individual bytes of an integer
2018-10-14 19:15 3% Examining individual bytes of an integer Henrik Härkönen
@ 2018-10-14 19:55 0% ` Jeffrey R. Carter
2018-10-14 21:28 0% ` Niklas Holsti
2018-10-14 21:04 0% ` Niklas Holsti
1 sibling, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2018-10-14 19:55 UTC (permalink / raw)
On 10/14/2018 09:15 PM, Henrik Härkönen wrote:
>
> type Byte is mod 256;
> type Word is mod 2 ** 32;
>
> type E2 is array(1 .. 4) of Byte;
>
> function Convert_To_E2 is new Ada.Unchecked_Conversion (Source => Word,
> Target => E2);
>
> function Convert_To_Word is new Ada.Unchecked_Conversion (Source => E2,
> Target => Word);
Unchecked_Conversion is the Ada Way. Often it is a good idea to specify the
sizes of all the types involved to ensure that the conversion is between
equal-sized hunks of memory.
However, with the array, you don't know which index corresponds to which byte of
the integer. You can examine the bytes of several values to determine this, but
on a different platform or with a different compiler the correspondence may be
different. Usually the lowest index corresponds to the lowest address, but that
is not guaranteed by the language.
(Similar concerns arise when using a packed array of Boolean to access
individual bits.)
> At least that looks nice and neat, I could also use record with assigned names to bytes if necessary.
Yes. With a record, you have the ability to use representation clauses to
indicate which record field corresponds to which memory address. Combined with
System.Default_Bit_Order, this allows you to portably determine the role of each
byte in the integer.
--
Jeff Carter
"What's the amount of the insult?"
Never Give a Sucker an Even Break
104
^ permalink raw reply [relevance 0%]
* Examining individual bytes of an integer
@ 2018-10-14 19:15 3% Henrik Härkönen
2018-10-14 19:55 0% ` Jeffrey R. Carter
2018-10-14 21:04 0% ` Niklas Holsti
0 siblings, 2 replies; 200+ results
From: Henrik Härkönen @ 2018-10-14 19:15 UTC (permalink / raw)
I'd like to examine individual bytes of larger (in bit size) integer type. In C would probably move byte pointer etc. Also I'd need to have a way to construct the integer from individual bytes.
Would this be "the Ada-way", the Unchecked_Conversion?
---8<---
procedure Main is
type Byte is mod 256;
type Word is mod 2 ** 32;
type E2 is array(1 .. 4) of Byte;
Z: Word;
Y: E2;
function Convert_To_E2 is new Ada.Unchecked_Conversion (Source => Word,
Target => E2);
function Convert_To_Word is new Ada.Unchecked_Conversion (Source => E2,
Target => Word);
begin
Y := Convert_To_E2(Word(435343));
Z := Convert_To_Word(Y);
end Main;
--->8---
At least that looks nice and neat, I could also use record with assigned names to bytes if necessary.
-Henrik
^ permalink raw reply [relevance 3%]
* Re: file descriptor of a serial port
@ 2018-08-20 15:41 2% ` jan.de.kruyf
0 siblings, 0 replies; 200+ results
From: jan.de.kruyf @ 2018-08-20 15:41 UTC (permalink / raw)
On Monday, August 20, 2018 at 5:17:15 PM UTC+2, björn lundin wrote:
> On 2018-08-20 15:56, jan.....com wrote:
>
> > I tried to construct a child package of GNAT.Serial_Communications but the compiler does not like that, since it does not
> >actually compile that package.
>
> Do you actually 'with' that new child package?
> Otherwise it is strange that it is not compiled.
>
>
>
> --
> --
> Björn
Björn,
this is what I get on building of
package body Gnat.Serial_Communications.Baud is
.
.
procedure Get_Divisor (Port : Serial_Port)
is
function Toint is new Ada.Unchecked_Conversion -- line 53
(Source => Port_Data, Target => Integer);
begin
.
.
gprbuild -Paupdi.gpr
Compile
[Ada] g-secoba.adb
g-secoba.adb:53:17: premature use of incomplete type
g-secoba.adb:53:17: instantiation abandoned
g-secoba.adb:57:33: "toint" is undefined
gprbuild: *** compilation phase failed
---------------------
And now I do get the compilers problem. the Port_Data type is only spelled out in the body of Gnat.Serial_Communications as an integer. So I cannot see it in the child.
Pity. So I will have to construct a hand crafted Serial_Communications package.
Thanks for your help.
j.
^ permalink raw reply [relevance 2%]
* Re: Simple hash or pseudo-random function
2018-07-17 6:09 2% ` Jeffrey R. Carter
@ 2018-07-18 13:38 0% ` gautier_niouzes
0 siblings, 0 replies; 200+ results
From: gautier_niouzes @ 2018-07-18 13:38 UTC (permalink / raw)
Am Dienstag, 17. Juli 2018 08:09:10 UTC+2 schrieb Jeffrey R. Carter:
> Another possibility would be to try (calling your 64-bit type U64)
>
> subtype S8 is String (1 .. 8);
>
> function To_S8 is new Ada.Unchecked_Conversion (Source => U64, Target => S8);
>
> Ada.Strings.Hash (To_S8 (N) );
>
> If Hash is a decent hash function ("It should be unlikely for similar strings to
> return the same value.") then it might be sufficiently random.
Brillant, works as expected (after a few adjustments on the final range to be really uniform).
Looking at GNAT's s-strhas.adb :
H := 0;
for J in Key'Range loop
H := Char_Type'Pos (Key (J))
+ Shift_Left (H, 6) + Shift_Left (H, 16) - H;
end loop;
I guess it is "random" enough on small changes of Key (Key'First .. Key'Last - 1) or on small changes (+1 or -1) of N if U64's are stored as little-endian.
^ permalink raw reply [relevance 0%]
* Re: Simple hash or pseudo-random function
@ 2018-07-17 6:09 2% ` Jeffrey R. Carter
2018-07-18 13:38 0% ` gautier_niouzes
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2018-07-17 6:09 UTC (permalink / raw)
On 07/16/2018 11:14 PM, gautier_niouzes@hotmail.com wrote:
>
> The 64-bit value is the *input* and the output is a function of that input only.
> e.g.
> 10562032 gives always 211
> 31375393 gives always 31
> 85232830 gives always 172
> NB: the input codes can appear in a different order, so a pseudo-random *sequence* cannot be used.
>
> I've tested different RNG's by initializing them with the input code and using only the first pseudo-random value using that seed. The good news is that they seem uniformly distributed even with successive seed values, but they are not random enough when seeds are similar. I'll check Marius' solution, or a hash function like CRC.
That makes things clearer. I would have suggested what you tried. Perhaps you
could modify it a bit so that, for a value N, you discard the 1st N rem M values
from the RNG before generating the output for N, and see if that improves the
randomness of the results. M should be small enough that this is fast enough for
your requirements but large enough to be significantly different from what
you've already tried.
Another possibility would be to try (calling your 64-bit type U64)
subtype S8 is String (1 .. 8);
function To_S8 is new Ada.Unchecked_Conversion (Source => U64, Target => S8);
Ada.Strings.Hash (To_S8 (N) );
If Hash is a decent hash function ("It should be unlikely for similar strings to
return the same value.") then it might be sufficiently random.
--
Jeff Carter
"What's the amount of the insult?"
Never Give a Sucker an Even Break
104
^ permalink raw reply [relevance 2%]
* Re: Strange crash on custom iterator
@ 2018-07-02 19:42 1% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2018-07-02 19:42 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 450 bytes --]
Luke A. Guest <laguest@archeia.com> writes:
> Simon Wright <> wrote:
>
>>> You don't need to make it tagged, to pass it by reference. It is enough
>>> to make the formal parameter aliased.
>>
>> Yes, that works (except you have to make the container you're iterating
>> over aliased too).
>
> I had to make the iterate for nation take “aliased in out” and make the
> array aliased, but it still does in the same place.
This worked for me ..
[-- Attachment #2: gnatchop-me --]
[-- Type: text/plain, Size: 9880 bytes --]
-- Copyright 2018, Luke A. Guest
-- License TBD.
with Ada.Characters.Latin_1;
with Ada.Text_IO; use Ada.Text_IO;
with UCA.Encoding;
with UCA.Iterators;
procedure Test is
package L1 renames Ada.Characters.Latin_1;
package Octet_IO is new Ada.Text_IO.Modular_IO (UCA.Octets);
use Octet_IO;
-- D : UCA.Octets := Character'Pos ('Q');
-- A : UCA.Unicode_String := UCA.To_Array (D);
-- A2 : UCA.Unicode_String := UCA.Unicode_String'(1, 0, 0, 0, 0, 0, 1, 0);
-- D2 : UCA.Octets := UCA.To_Octet (A2);
-- package OA_IO is new Ada.Text_IO.Integer_IO (Num => UCA.Bits);
use UCA.Encoding;
A : aliased UCA.Unicode_String :=
+("ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ" & L1.LF &
"Hello, world" & L1.LF &
"Sîne klâwen durh die wolken sint geslagen," & L1.LF &
"Τη γλώσσα μου έδωσαν ελληνική" & L1.LF &
"मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती." & L1.LF &
"میں کانچ کھا سکتا ہوں اور مجھے تکلیف نہیں ہوتی");
B : aliased UCA.Unicode_String :=
(225, 154, 160, 225, 155, 135, 225, 154, 187, 225, 155, 171, 225, 155, 146, 225, 155, 166, 225,
154, 166, 225, 155, 171, 225, 154, 160, 225, 154, 177, 225, 154, 169, 225, 154, 160, 225, 154,
162, 225, 154, 177, 225, 155, 171, 225, 154, 160, 225, 155, 129, 225, 154, 177, 225, 154, 170,
225, 155, 171, 225, 154, 183, 225, 155, 150, 225, 154, 187, 225, 154, 185, 225, 155, 166, 225,
155, 154, 225, 154, 179, 225, 154, 162, 225, 155, 151,
10,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100,
10,
83, 195, 174, 110, 101, 32, 107, 108, 195, 162, 119, 101, 110, 32, 100, 117, 114, 104, 32, 100,
105, 101, 32, 119, 111, 108, 107, 101, 110, 32, 115, 105, 110, 116, 32, 103, 101, 115, 108, 97,
103, 101, 110, 44,
10,
206, 164, 206, 183, 32, 206, 179, 206, 187, 207, 142, 207, 131, 207, 131, 206, 177, 32, 206, 188,
206, 191, 207, 133, 32, 206, 173, 206, 180, 207, 137, 207, 131, 206, 177, 206, 189, 32, 206, 181,
206, 187, 206, 187, 206, 183, 206, 189, 206, 185, 206, 186, 206, 174,
10,
224, 164, 174, 224, 165, 136, 224, 164, 130, 32, 224, 164, 149, 224, 164, 190, 224, 164, 129, 224,
164, 154, 32, 224, 164, 150, 224, 164, 190, 32, 224, 164, 184, 224, 164, 149, 224, 164, 164, 224,
164, 190, 32, 224, 164, 185, 224, 165, 130, 224, 164, 129, 32, 224, 164, 148, 224, 164, 176, 32,
224, 164, 174, 224, 165, 129, 224, 164, 157, 224, 165, 135, 32, 224, 164, 137, 224, 164, 184, 224,
164, 184, 224, 165, 135, 32, 224, 164, 149, 224, 165, 139, 224, 164, 136, 32, 224, 164, 154, 224,
165, 139, 224, 164, 159, 32, 224, 164, 168, 224, 164, 185, 224, 165, 128, 224, 164, 130, 32, 224,
164, 170, 224, 164, 185, 224, 165, 129, 224, 164, 130, 224, 164, 154, 224, 164, 164, 224, 165, 128, 46,
10,
217, 133, 219, 140, 218, 186, 32, 218, 169, 216, 167, 217, 134, 218, 134, 32, 218, 169, 218, 190,
216, 167, 32, 216, 179, 218, 169, 216, 170, 216, 167, 32, 219, 129, 217, 136, 218, 186, 32, 216,
167, 217, 136, 216, 177, 32, 217, 133, 216, 172, 218, 190, 219, 146, 32, 216, 170, 218, 169, 217,
132, 219, 140, 217, 129, 32, 217, 134, 219, 129, 219, 140, 218, 186, 32, 219, 129, 217, 136, 216,
170, 219, 140);
begin
-- Put_Line ("A => " & To_UTF_8_String (A));
Put_Line ("A => " & L1.LF & String (+A));
Put_Line ("A => ");
Put ('(');
for E of A loop
Put (Item => E, Base => 2);
Put (", ");
end loop;
Put (')');
New_Line;
Put_Line ("B => " & L1.LF & String (+B));
Put_Line ("A (Iterated) => ");
for I in UCA.Iterators.Iterate (A) loop
Put (UCA.Iterators.Element (I)); -- ERROR! Dies in Element, Data has nothing gdb => p position - $1 = (data => (), index => 1)
end loop;
New_Line;
end Test;
with Ada.Strings.UTF_Encoding;
with Ada.Unchecked_Conversion;
package UCA is
use Ada.Strings.UTF_Encoding;
type Octets is mod 2 ** 8 with
Size => 8;
type Unicode_String is array (Positive range <>) of Octets with
Pack => True;
type Unicode_String_Access is access all Unicode_String;
-- This should match Wide_Wide_Character in size.
type Code_Points is mod 2 ** 32 with
Static_Predicate => Code_Points in 0 .. 16#0000_D7FF# or Code_Points in 16#0000_E000# .. 16#0010_FFFF#,
Size => 32;
private
type Bits is range 0 .. 1 with
Size => 1;
type Bit_Range is range 0 .. Octets'Size - 1;
end UCA;
with Ada.Finalization;
with Ada.Iterator_Interfaces;
private with System.Address_To_Access_Conversions;
package UCA.Iterators is
---------------------------------------------------------------------------------------------------------------------
-- Iteration over code points.
---------------------------------------------------------------------------------------------------------------------
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
function Has_Element (Position : in Cursor) return Boolean;
function Element (Position : in Cursor) return Octets;
package Code_Point_Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);
function Iterate (Container : aliased in Unicode_String) return Code_Point_Iterators.Forward_Iterator'Class;
function Iterate (Container : aliased in Unicode_String; Start : in Cursor) return
Code_Point_Iterators.Forward_Iterator'Class;
---------------------------------------------------------------------------------------------------------------------
-- Iteration over grapheme clusters.
---------------------------------------------------------------------------------------------------------------------
private
use Ada.Finalization;
package Convert is new System.Address_To_Access_Conversions (Unicode_String);
type Cursor is
record
Data : Convert.Object_Pointer := null;
Index : Positive := Positive'Last;
end record;
type Code_Point_Iterator is new Limited_Controlled and Code_Point_Iterators.Forward_Iterator with
record
Data : Convert.Object_Pointer := null;
end record;
overriding
function First (Object : in Code_Point_Iterator) return Cursor;
overriding
function Next (Object : in Code_Point_Iterator; Position : Cursor) return Cursor;
end UCA.Iterators;
with Ada.Text_IO; use Ada.Text_IO;
package body UCA.Iterators is
package Octet_IO is new Ada.Text_IO.Modular_IO (UCA.Octets);
use Octet_IO;
use type Convert.Object_Pointer;
function Has_Element (Position : in Cursor) return Boolean is
begin
return Position.Index in Position.Data'Range;
end Has_Element;
function Element (Position : in Cursor) return Octets is
begin
if Position.Data = null then
raise Constraint_Error with "Fuck!";
end if;
Put ("<< Element - " & Positive'Image (Position.Index) & " - ");
Put (Position.Data (Position.Index));
Put_Line (" >>");
return Position.Data (Position.Index);
end Element;
function Iterate (Container : aliased in Unicode_String) return Code_Point_Iterators.Forward_Iterator'Class is
begin
Put_Line ("<< iterate >>");
return I : Code_Point_Iterator := (Limited_Controlled with
Data => Convert.To_Pointer (Container'Address)) do
if I.Data = null then
Put_Line ("Data => null");
else
Put_Line ("Data => not null - Length: " & Positive'Image (I.Data'Length));
end if;
null;
end return;
end Iterate;
function Iterate (Container : aliased in Unicode_String; Start : in Cursor) return
Code_Point_Iterators.Forward_Iterator'Class is
begin
Put_Line ("<< iterate >>");
return I : Code_Point_Iterator := (Limited_Controlled with
Data => Convert.To_Pointer (Container'Address)) do
if I.Data = null then
Put_Line ("Data => null");
else
Put_Line ("Data => not null");
end if;
null;
end return;
end Iterate;
---------------------------------------------------------------------------------------------------------------------
-- Iteration over grapheme clusters.
---------------------------------------------------------------------------------------------------------------------
overriding
function First (Object : in Code_Point_Iterator) return Cursor is
begin
return (Data => Object.Data, Index => Positive'First);
end First;
overriding
function Next (Object : in Code_Point_Iterator; Position : Cursor) return Cursor is
begin
return (Data => Object.Data, Index => Position.Index + 1);
end Next;
end UCA.Iterators;
-- Copyright © 2018, Luke A. Guest
with Ada.Unchecked_Conversion;
package body UCA.Encoding is
function To_Unicode_String (Str : in String) return Unicode_String is
Result : Unicode_String (1 .. Str'Length) with
Address => Str'Address;
begin
return Result;
end To_Unicode_String;
function To_String (Str : in Unicode_String) return String is
Result : String (1 .. Str'Length) with
Address => Str'Address;
begin
return Result;
end To_String;
end UCA.Encoding;
package UCA.Encoding is
use Ada.Strings.UTF_Encoding;
function To_Unicode_String (Str : in String) return Unicode_String;
function To_String (Str : in Unicode_String) return String;
function "+" (Str : in String) return Unicode_String renames To_Unicode_String;
function "+" (Str : in Unicode_String) return String renames To_String;
end UCA.Encoding;
^ permalink raw reply [relevance 1%]
* Re: AI12-0218: What is the portable representation clause for processing IETF packets on little-endian machines?
2018-05-12 7:08 2% ` Simon Wright
@ 2018-05-12 7:53 0% ` Jeffrey R. Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2018-05-12 7:53 UTC (permalink / raw)
On 05/12/2018 09:08 AM, Simon Wright wrote:
>
> I saw the example. I stand by my statement that it's confusing.
I agree that the terminology is not intuitive.
>
> Not quite the same, but I think I showed upthread a conversion that does
> this:
>
> function To_Fixed_32_16 (S : Four_Byte_Slice) return Fixed_32_16 is
> function Convert is new Ada.Unchecked_Conversion (Four_Byte_Slice,
> Fixed_32_16);
> begin
> if Big_Endian then
> return Convert (S);
> else
> return Convert ((1 => S (4),
> 2 => S (3),
> 3 => S (2),
> 4 => S (1)));
> end if;
> end To_Fixed_32_16;
For the case where it does swapping, I don't see that this is very different
from my version, at least if the intention is to go from Integer to Integer,
which is what I thought you were asking. I used change-of-representation to get
the swapping and this does the swapping itself, and this hides one of the
unchecked conversions. My version was intended to allow conversion in both
directions, while this seems to only go one way. I used Ada 83 to show that such
change-of-representation was in the language then, and you're using a more
recent version.
--
Jeff Carter
"Death awaits you all, with nasty, big, pointy teeth!"
Monty Python & the Holy Grail
20
^ permalink raw reply [relevance 0%]
* Re: AI12-0218: What is the portable representation clause for processing IETF packets on little-endian machines?
@ 2018-05-12 7:08 2% ` Simon Wright
2018-05-12 7:53 0% ` Jeffrey R. Carter
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2018-05-12 7:08 UTC (permalink / raw)
"Jeffrey R. Carter" <spam.jrcarter.not@spam.not.acm.org> writes:
> On 05/11/2018 11:39 PM, Simon Wright wrote:
>>
>> whereas Ada2012 says
>>
>> "To convert a record from one representation to another, two
>> record types with a common ancestor type need to be declared,
>> with no inherited subprograms."
>>
>> which seems to require _three_ types.
>
> The example in 13.6 shows this with only 2 types. This is because a
> type is defined to be its own ancestor (ARM 3.4.1).
I saw the example. I stand by my statement that it's confusing.
Perhaps there needs to be a way to mark a language usage as
domain-specific rather than natural; in English, I am not my own
ancestor (or descendant).
>> But in any case your code doesn't answer my question: what
>> representation trick could convert between
>>
>> type T is record
>> J : Integer;
>> end T;
>>
>> and
>>
>> type BE_T is new T;
>> for BE_T use record
>> ?????
>> end record;
>
> I was showing how to use records with representations to get the
> compiler to do byte swapping for you. There's no way to use them to
> change the byte order of an integer type directly.
Not quite the same, but I think I showed upthread a conversion that does
this:
function To_Fixed_32_16 (S : Four_Byte_Slice) return Fixed_32_16 is
function Convert is new Ada.Unchecked_Conversion (Four_Byte_Slice,
Fixed_32_16);
begin
if Big_Endian then
return Convert (S);
else
return Convert ((1 => S (4),
2 => S (3),
3 => S (2),
4 => S (1)));
end if;
end To_Fixed_32_16;
Of course, in C you'd use ntohl(), but we'd have to wrap something like
the above in a generic.
^ permalink raw reply [relevance 2%]
* Re: AI12-0218: What is the portable representation clause for processing IETF packets on little-endian machines?
@ 2018-05-11 7:55 2% ` Simon Wright
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2018-05-11 7:55 UTC (permalink / raw)
"Dan'l Miller" <optikos@verizon.net> writes:
> Still, standard Ada has no good Ada-esque solution to heterogenous
> endianness at the perimeter of a system, other than writing C-esque
> pointer-arithmetic code with the various unchecked_ constructs (which
> even C programmers don't generally do; they utilize
> conditionally-compiled macros that correctly type-cast
> meticulously*-laid-out structs-of-bitfields onto that packet's header
> or IC register's word.
I've used (effectively) conditionally-compiled sections of code for
this.
From an SNTP implementation: in BE, the first 32 bits of a packet are
-- 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
-- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-- |LI | VN |Mode | Stratum | Poll | Precision |
-- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
and looking just at the top (first) byte, the package spec contains
type Leap_Indicator is (No_Warning,
Last_Minute_Has_61_Seconds,
Last_Minute_Has_59_Seconds,
Alarm_Condition);
type Version is range 3 .. 4;
type Mode is (Reserved,
Symmetric_Active,
Symmetric_Passive,
Client,
Server,
Broadcast,
Reserved_For_NTP_Control_Message,
Reserved_For_Private_Use);
type Status is record
LI : Leap_Indicator;
VN : Version;
M : Mode;
end record;
in native layout (nowadays I'd be a lot more specific about
sizes). Conversions:
function To_Stream_Element (S : Status) return Ada.Streams.Stream_Element;
function To_Status (S : Ada.Streams.Stream_Element) return Status;
In the body,
Big_Endian : constant Boolean
:= System."=" (System.Default_Bit_Order, System.High_Order_First);
and
function To_Status (S : Ada.Streams.Stream_Element) return Status is
begin
-- these two sections are conditionally compiled (by GNAT,
-- anyway) because Big_Endian is constant.
if Big_Endian then
declare
-- create a BE type with BE representation
type Host_Status is record
LI : Leap_Indicator;
VN : Version;
M : Mode;
end record;
for Host_Status use record
LI at 0 range 0 .. 1;
VN at 0 range 2 .. 4;
M at 0 range 5 .. 7;
end record;
for Host_Status'Size use 8;
function Convert
is new Ada.Unchecked_Conversion (Ada.Streams.Stream_Element,
Host_Status);
V : constant Host_Status := Convert (S);
begin
-- let the compiler convert from BE representation to host
return (LI => V.LI, VN => V.VN, M => V.M);
end;
else
declare
-- create an LE type with LE representation
type Host_Status is record
LI : Leap_Indicator;
VN : Version;
M : Mode;
end record;
for Host_Status use record
LI at 0 range 6 .. 7;
VN at 0 range 3 .. 5;
M at 0 range 0 .. 2;
end record;
for Host_Status'Size use 8;
function Convert
is new Ada.Unchecked_Conversion (Ada.Streams.Stream_Element,
Host_Status);
V : constant Host_Status := Convert (S);
begin
-- let the compiler convert from LE representation to host
return (LI => V.LI, VN => V.VN, M => V.M);
end;
end if;
end To_Status;
No denying it's a lot of work. Much easier for 2-, 4-, 8-byte objects:
type SNTP_Timestamp is delta 2.0 ** (-32) range -2.0 ** 31 .. 2.0 ** 31;
for SNTP_Timestamp'Size use 64;
subtype Timestamp_Slice is Ada.Streams.Stream_Element_Array (1 .. 8);
function To_SNTP_Timestamp (T : Timestamp_Slice) return SNTP_Timestamp is
function Convert is new Ada.Unchecked_Conversion (Timestamp_Slice,
SNTP_Timestamp);
begin
if Big_Endian then
return Convert (T);
else
return Convert ((1 => T (8),
2 => T (7),
3 => T (6),
4 => T (5),
5 => T (4),
6 => T (3),
7 => T (2),
8 => T (1)));
end if;
end To_SNTP_Timestamp;
^ permalink raw reply [relevance 2%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 22:32 0% ` Randy Brukardt
2017-10-11 23:03 0% ` Victor Porton
@ 2017-10-29 14:50 0% ` David Thompson
1 sibling, 0 replies; 200+ results
From: David Thompson @ 2017-10-29 14:50 UTC (permalink / raw)
On Wed, 11 Oct 2017 17:32:35 -0500, "Randy Brukardt"
<randy@rrsoftware.com> wrote:
> "Victor Porton" <porton@narod.ru> wrote in message
> news:orm3qe$1r0c$1@gioia.aioe.org...
> > What is the right way to convert between C "void*" pointer and an access
> > to
> > a tagged or class-wide type?
>
> I doubt that there is a *right* way, there just are several possibilities.
>
> > Ada.Unchecked_Conversion seems to be what I need, but the access type may
> > be
> > "fat" and thus have another format than void*.
>
> Right, but not very likely. I'd expect this to work in most cases.
>
> But our solution in the Claw libraries was simply to use the appropriate
> C-convention access type in the interface definitions and avoid making any
> conversions at all. I believe that on the C side, void* and <anything-else>*
> have to use the same representation, so C convention should work properly
> for any pointer type.
>
The C standard doesn't require that (now or ever). It requires that
- void* and [signed|unsigned] char* (each with or without qualifers =
const, void) must have the same representation, probably because in
K&R1 C, before C89 introduced void, char* was used for many things
that void* (or qualified void*) is now used for.
- pointers to all structs must do the same, as must all unions, mostly
because you can 'forward declare' a struct or union and point to it
before its contents (and thus size/alignment) are known. Notably this
is NOT required for enums, probably because enum types themselves are
not required to have the same representation, and _are_ required to be
fully defined before use -- although enum _literals_ in C are all type
'signed int' regardless of the enum type; this is different in C++.
Except for those, pointer types are allowed to differ.
Nowadays most hardware is byte-addressed, so in practice all data
pointers _are_ the same. Code (function) pointers are sometimes
different, but not often, and never in POSIX. It wouldn't surprise me
if every Ada implementation/target that _has_ C interop pairs to a C
implementation with at least all data pointer types the same.
However, last century I worked on one system with a pretty strong
preference for word addressing, and it did have void* char* different
from int* float* struct* etc, and when I looked at the code generated
it had shifts to convert back and forth all over the place.
^ permalink raw reply [relevance 0%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 23:03 0% ` Victor Porton
@ 2017-10-12 7:57 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-10-12 7:57 UTC (permalink / raw)
On 12/10/2017 01:03, Victor Porton wrote:
> Randy Brukardt wrote:
>
>> "Victor Porton" <porton@narod.ru> wrote in message
>> news:orm3qe$1r0c$1@gioia.aioe.org...
>>> What is the right way to convert between C "void*" pointer and an access
>>> to
>>> a tagged or class-wide type?
>>
>> I doubt that there is a *right* way, there just are several possibilities.
>>
>>> Ada.Unchecked_Conversion seems to be what I need, but the access type may
>>> be
>>> "fat" and thus have another format than void*.
>>
>> Right, but not very likely. I'd expect this to work in most cases.
>>
>> But our solution in the Claw libraries was simply to use the appropriate
>> C-convention access type in the interface definitions and avoid making any
>> conversions at all. I believe that on the C side, void* and
>> <anything-else>* have to use the same representation, so C convention
>> should work properly for any pointer type.
>>
>> That is, if the C interface contains a void* parameter, we just used an
>> appropriate C convention access type in its place in the Ada parameter
>> definition. (Using overloading if we needed multiple such pointers - but
>> that was very rare.) There's no counterpart to void* in Ada anyway, so one
>> has to do something like that in the interfacing definitions.
>
> "- What is your solution for Windows printing problems? - Do not print."
>
> I NEED to convert between access to tagged records (and access to class-wide
> types) and C void* pointers.
>
> I need this because it is C's way to pass objects by using void* and I need
> to pass Ada objects to C functions (not just C objects).
What Randy says is that in many cases you can pass an Ada access type
where void * is expected:
type T is tagged whatever ...;
--
-- void c_foo (void * userdata);
--
type T_Ptr is access all T['Class];
pragma Convention (C, T_Ptr);
procedure Set_Callback (..., User_Data : T_Ptr);
pragma Import (C, Set_Callback, "...");
This is the most safe and clean way to pass pointers to Ada objects
through C library, assuming that C does not touch the object.
In other cases you can simply declare it System.Address and use
Access_To_Address conversion or the Address pragma/aspect or fake pool
allocator new. Whatever you like.
System.Address is frowned at because it not guaranteed to work
everywhere, but chances are high that if that does not work nothing else
would either. So I would not worry too much about it.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 23:12 3% ` Victor Porton
@ 2017-10-12 1:01 1% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-10-12 1:01 UTC (permalink / raw)
Victor Porton wrote:
> Victor Porton wrote:
>
>> Victor Porton wrote:
>>
>>> What is the right way to convert between C "void*" pointer and an access
>>> to a tagged or class-wide type?
>>>
>>> Ada.Unchecked_Conversion seems to be what I need, but the access type
>>> may be "fat" and thus have another format than void*.
>>>
>>> I caught myself doing such unchecked conversions, but now I feel I did
>>> an error.
>>>
>>> For example, let
>>>
>>> type X_Type is abstract tagged null record;
>>>
>>> How to store X_Type'Class pointer in "void*" and convert them back and
>>> forth?
>>
>> It seems I've found a right solution of my problem. (Check if Ada RM
>> warrants that it works with every compiler!)
>>
>> Well, why it is not a standard package?! Why I need to invent something
>> "smart" every time I need to code?
>
> The package body was with a bug. Here there is corrected code:
[snip] (see code above in the thread)
Now I will prove that it works without errors with every conforming
compilers.
The below will describe how my package Convert_Void works. If in doubt,
consult the package source code.
First I should formulate the problem exactly:
Having an Ada object (we can restrict to tagged and class-wide types and
benefit from the fact that such objects 'Address "should produce a useful
result" (RM 13.3.16)), we need to transform it to C void pointer and pass to
C code; the C code should be able to call Ada code (e.g. through subprogram
access) and pass the pointer back and the Ada code should be able to work
with the original Ada object.
In other words, we need to define two functions: To_Pointer which converts
all access values for a certain type (tagged or class-wide, at least) into
void pointers and To_Access which converts void pointers obtained by
To_Pointer back into the original access value.
In other words, we need two mutually inverse bijections between every set of
values of 'Unchecked_Access of values of a type (tagged or class-wide, at
least) and a subset of C void pointers.
We also need map null access to NULL pointer and vice versa.
We will use chars_ptr from Interfaces.C.Strings to represent void pointers.
It is valid because C11, 6.2.5, 28 (draft N1548): "A pointer to void shall
have the same representation and alignment requirements as a pointer to a
character type."
This problem is solved in my generic package Convert_Void:
-- "with" and "use" skipped
generic
type Object(<>) is limited private;
package Convert_Void is
package Address_Conversions is new
System.Address_To_Access_Conversions(Object);
subtype Object_Pointer is Address_Conversions.Object_Pointer;
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr;
end Convert_Void;
We define in Convert_Void body:
type My_Char_Pointer is access all char with Convention=>C;
package Char_Address_Conversions is new
System.Address_To_Access_Conversions(char);
One of the steps of implementing the functions To_Pointer and To_Access is
to convert between chars_ptr and My_Char_Pointer. This is trivially done
with Ada.Unchecked_Conversion because they are by definition the same C type
char* and thus have the same representation.
So our task is reduced to conversion between My_Char_Pointer an Ada object
access.
We do this conversion (in both directions) like:
Char_Address_Conversions.To_Pointer(Address_Conversions.To_Address(...))
Address_Conversions.To_Pointer(Char_Address_Conversions.To_Address(...))
The thing to prove is that this is an injective function from object
pointers to My_Char_Pointer values and that backward conversion is really
its inversion.
But it is just my understanding of "The To_Pointer and To_Address
subprograms convert back and forth between values of types Object_Pointer
and Address." (RM 13.7.2 5/2)
That null access are mapped into NULL pointers and vice versa is left as an
exercise to the reader.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 1%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 22:58 3% ` Victor Porton
@ 2017-10-11 23:12 3% ` Victor Porton
2017-10-12 1:01 1% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-10-11 23:12 UTC (permalink / raw)
Victor Porton wrote:
> Victor Porton wrote:
>
>> What is the right way to convert between C "void*" pointer and an access
>> to a tagged or class-wide type?
>>
>> Ada.Unchecked_Conversion seems to be what I need, but the access type may
>> be "fat" and thus have another format than void*.
>>
>> I caught myself doing such unchecked conversions, but now I feel I did an
>> error.
>>
>> For example, let
>>
>> type X_Type is abstract tagged null record;
>>
>> How to store X_Type'Class pointer in "void*" and convert them back and
>> forth?
>
> It seems I've found a right solution of my problem. (Check if Ada RM
> warrants that it works with every compiler!)
>
> Well, why it is not a standard package?! Why I need to invent something
> "smart" every time I need to code?
The package body was with a bug. Here there is corrected code:
with System.Address_To_Access_Conversions;
with Interfaces.C.Strings; use Interfaces.C.Strings;
-- C11, 6.2.5, 28 (draft N1548):
-- A pointer to void shall have the same representation and alignment requirements as a pointer to a character type.
-- So we can use chars_ptr to mean void pointer in C.
generic
type Object(<>) is limited private;
package Convert_Void is
package Address_Conversions is new System.Address_To_Access_Conversions(Object);
subtype Object_Pointer is Address_Conversions.Object_Pointer;
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr;
end Convert_Void;
with Ada.Unchecked_Conversion;
package body Convert_Void is
type My_Char_Pointer is access all char with Convention=>C;
function From_My_Char_Pointer is new Ada.Unchecked_Conversion(My_Char_Pointer, chars_ptr);
function From_Chars_Ptr is new Ada.Unchecked_Conversion(chars_ptr, My_Char_Pointer);
package Char_Address_Conversions is new System.Address_To_Access_Conversions(char);
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer is
P: constant My_Char_Pointer := From_Chars_Ptr(Void_Pointer);
A: constant System.Address :=
Char_Address_Conversions.To_Address(Char_Address_Conversions.Object_Pointer(P));
begin
return Address_Conversions.To_Pointer(A);
end;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr is
A: constant System.Address := Address_Conversions.To_Address(Pointer);
P: constant My_Char_Pointer :=
My_Char_Pointer(Char_Address_Conversions.To_Pointer(A));
begin
return From_My_Char_Pointer(P);
end;
end Convert_Void;
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 22:32 0% ` Randy Brukardt
@ 2017-10-11 23:03 0% ` Victor Porton
2017-10-12 7:57 0% ` Dmitry A. Kazakov
2017-10-29 14:50 0% ` David Thompson
1 sibling, 1 reply; 200+ results
From: Victor Porton @ 2017-10-11 23:03 UTC (permalink / raw)
Randy Brukardt wrote:
> "Victor Porton" <porton@narod.ru> wrote in message
> news:orm3qe$1r0c$1@gioia.aioe.org...
>> What is the right way to convert between C "void*" pointer and an access
>> to
>> a tagged or class-wide type?
>
> I doubt that there is a *right* way, there just are several possibilities.
>
>> Ada.Unchecked_Conversion seems to be what I need, but the access type may
>> be
>> "fat" and thus have another format than void*.
>
> Right, but not very likely. I'd expect this to work in most cases.
>
> But our solution in the Claw libraries was simply to use the appropriate
> C-convention access type in the interface definitions and avoid making any
> conversions at all. I believe that on the C side, void* and
> <anything-else>* have to use the same representation, so C convention
> should work properly for any pointer type.
>
> That is, if the C interface contains a void* parameter, we just used an
> appropriate C convention access type in its place in the Ada parameter
> definition. (Using overloading if we needed multiple such pointers - but
> that was very rare.) There's no counterpart to void* in Ada anyway, so one
> has to do something like that in the interfacing definitions.
"- What is your solution for Windows printing problems? - Do not print."
I NEED to convert between access to tagged records (and access to class-wide
types) and C void* pointers.
I need this because it is C's way to pass objects by using void* and I need
to pass Ada objects to C functions (not just C objects).
See my other message where I developed a package which is likely to work
with every Ada compiler (or hopefully even with every conforming Ada
compiler possible).
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 21:52 2% Convert between C "void*" pointer and an access Victor Porton
2017-10-11 22:32 0% ` Randy Brukardt
@ 2017-10-11 22:58 3% ` Victor Porton
2017-10-11 23:12 3% ` Victor Porton
1 sibling, 1 reply; 200+ results
From: Victor Porton @ 2017-10-11 22:58 UTC (permalink / raw)
Victor Porton wrote:
> What is the right way to convert between C "void*" pointer and an access
> to a tagged or class-wide type?
>
> Ada.Unchecked_Conversion seems to be what I need, but the access type may
> be "fat" and thus have another format than void*.
>
> I caught myself doing such unchecked conversions, but now I feel I did an
> error.
>
> For example, let
>
> type X_Type is abstract tagged null record;
>
> How to store X_Type'Class pointer in "void*" and convert them back and
> forth?
It seems I've found a right solution of my problem. (Check if Ada RM
warrants that it works with every compiler!)
Well, why it is not a standard package?! Why I need to invent something
"smart" every time I need to code?
with System.Address_To_Access_Conversions;
with Interfaces.C.Strings; use Interfaces.C.Strings;
-- C11, 6.2.5, 28 (draft N1548):
-- A pointer to void shall have the same representation and alignment requirements as a pointer to a character type.
-- So we can use chars_ptr to mean void pointer in C.
generic
type Object(<>) is limited private;
package Convert_Void is
package Address_Conversions is new System.Address_To_Access_Conversions(Object);
subtype Object_Pointer is Address_Conversions.Object_Pointer;
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr;
end Convert_Void;
with Ada.Unchecked_Conversion;
package body Convert_Void is
type My_Char_Pointer is access all char with Convention=>C;
function From_My_Char_Pointer is new Ada.Unchecked_Conversion(My_Char_Pointer, chars_ptr);
function From_Chars_Ptr is new Ada.Unchecked_Conversion(chars_ptr, My_Char_Pointer);
package Char_Address_Conversions is new System.Address_To_Access_Conversions(char);
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer is
begin
return Address_Conversions.To_Pointer(From_Chars_Ptr(Void_Pointer)'Address);
end;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr is
A: constant System.Address := Address_Conversions.To_Address(Pointer);
P: constant My_Char_Pointer :=
My_Char_Pointer(Char_Address_Conversions.To_Pointer(A));
begin
return From_My_Char_Pointer(P);
end;
end Convert_Void;
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 21:52 2% Convert between C "void*" pointer and an access Victor Porton
@ 2017-10-11 22:32 0% ` Randy Brukardt
2017-10-11 23:03 0% ` Victor Porton
2017-10-29 14:50 0% ` David Thompson
2017-10-11 22:58 3% ` Victor Porton
1 sibling, 2 replies; 200+ results
From: Randy Brukardt @ 2017-10-11 22:32 UTC (permalink / raw)
"Victor Porton" <porton@narod.ru> wrote in message
news:orm3qe$1r0c$1@gioia.aioe.org...
> What is the right way to convert between C "void*" pointer and an access
> to
> a tagged or class-wide type?
I doubt that there is a *right* way, there just are several possibilities.
> Ada.Unchecked_Conversion seems to be what I need, but the access type may
> be
> "fat" and thus have another format than void*.
Right, but not very likely. I'd expect this to work in most cases.
But our solution in the Claw libraries was simply to use the appropriate
C-convention access type in the interface definitions and avoid making any
conversions at all. I believe that on the C side, void* and <anything-else>*
have to use the same representation, so C convention should work properly
for any pointer type.
That is, if the C interface contains a void* parameter, we just used an
appropriate C convention access type in its place in the Ada parameter
definition. (Using overloading if we needed multiple such pointers - but
that was very rare.) There's no counterpart to void* in Ada anyway, so one
has to do something like that in the interfacing definitions.
Randy.
^ permalink raw reply [relevance 0%]
* Convert between C "void*" pointer and an access
@ 2017-10-11 21:52 2% Victor Porton
2017-10-11 22:32 0% ` Randy Brukardt
2017-10-11 22:58 3% ` Victor Porton
0 siblings, 2 replies; 200+ results
From: Victor Porton @ 2017-10-11 21:52 UTC (permalink / raw)
What is the right way to convert between C "void*" pointer and an access to
a tagged or class-wide type?
Ada.Unchecked_Conversion seems to be what I need, but the access type may be
"fat" and thus have another format than void*.
I caught myself doing such unchecked conversions, but now I feel I did an
error.
For example, let
type X_Type is abstract tagged null record;
How to store X_Type'Class pointer in "void*" and convert them back and
forth?
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 2%]
* Re: use Ada.Text_IO in main() or Package?
@ 2017-09-14 9:49 2% ` gautier_niouzes
0 siblings, 0 replies; 200+ results
From: gautier_niouzes @ 2017-09-14 9:49 UTC (permalink / raw)
Le jeudi 14 septembre 2017 11:37:41 UTC+2, Mace Ayres a écrit :
> Tks. It does make sense. I haven't been programming much in last decades, never really go into OOP much, but I can see this is going to avoid a lot of issues, and enforces some rigor.
Actually it is just a question of what is depending on what.
Instead of Structures, you can take Ada.Text_IO itself as an example.
In the guts of package Ada.Text_IO, the GNAT run-time library has a package body file: a-textio.adb) with the following lines:
with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.File_IO;
with System.CRTL;
with System.WCh_Cnv; use System.WCh_Cnv;
with System.WCh_Con; use System.WCh_Con;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
It makes sense they are there and not expected to be in any Main() or any other referencing Ada.Text_IO.
I've never used System.File_IO for instance and would not: it is GNAT only and unknown in other Ada systems. And there is no need for that.
G.
^ permalink raw reply [relevance 2%]
* Re: win32 interfacing check (SetClipboardData)
@ 2017-08-31 1:41 2% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2017-08-31 1:41 UTC (permalink / raw)
> On 29/08/2017 22:28, Xavier Petit wrote:
>> Hi, I would like to know if this win32 code is "correct" from your PoV or
>> could be written in a better way, especially this block :
>>
>> declare
>> Tmp : Wide_String (1 .. Source'Length + 1) with Address => AMem;
>> begin
>> Tmp := Source & Wide_Character'First;
>> end;
>
> It looks OK.
For me, using an address clause for anything other than interfacing to
hardware is wrong. We certainly didn't do anything like this in Claw when
implementing the clipboard operations. We used instances of
Unchecked_Conversion to get a pointer of the right type, and then assigned
into that. (Nowdays, I might use an instance of
Address_to_Access_Conversions.)
The code that converts a String parameter into a value in the clipboard list
looks like:
procedure Append_Copy(Item : in String;
List : in out Representation_List_Type;
Kind : in Text_Kinds := Text) is
use type Claw.Win32.HGlobal;
Mem : Claw.Win32.HGlobal;
subtype C_String_Type is Interfaces.C.Char_Array(0 .. Item'length);
type Target_Pointer is access all C_String_Type;
function Convert is new Ada.Unchecked_Conversion
(Source => Claw.Win32.HGlobal,
Target => Target_Pointer);
N : Interfaces.C.Size_T;
begin
Mem := Claw.Low_Level.Miscellaneous.Global_Alloc (
Claw.Low_Level.Miscellaneous.GMEM_FIXED,
DWord(C_String_Type'Length*(Interfaces.C.Char'Size/8)));
if Mem = Claw.Win32.NULL_HGLOBAL then
Claw.Raise_Windows_Error;
end if;
Interfaces.C.To_C(Item, Convert(Mem).all, N);
Append((Handle => Mem, Format => Text_Kind_Format(Kind),
Delayed_Renderer => null), List);
end Append_Copy;
"Append" here adds "Mem" to the Representation_List, giving ownership of the
handle to the List.
A Wide_String version would work the same way, using the appropriate
Interfaces.C types.
Note that we were trying for maximum portability (to any sane Ada 95
compiler for Windows); there's no real need to use the Interfaces.C types on
GNAT (if that's all you care about).
Randy.
^ permalink raw reply [relevance 2%]
* Re: Strict aliasing, is it OK?
2017-07-04 21:41 0% ` Simon Wright
@ 2017-07-04 23:39 0% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-07-04 23:39 UTC (permalink / raw)
Simon Wright wrote:
> Victor Porton <porton@narod.ru> writes:
>
>> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>>
>> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return
>> My_Dummy_Access
>> with Import, Convention=>C,
>> External_Name=>"raptor_parser_get_description";
>>
>> function Get_Description (Parser: Parser_Type) return
>> RDF.Raptor.Syntaxes.Syntax_Description_Type is
>> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access,
>> RDF.Raptor.Syntaxes.Syntax_Description_Type);
>
> (I _wish_ you could use shorter lines!)
>
> Is an "RDF.Raptor.Syntaxes.Syntax_Description_Type" actually an "access
> constant RDF.Auxiliary.Dummy_Record"? If so, why not just declare
> C_Raptor_Parser_Get_Description as returning a
> RDF.Raptor.Syntaxes.Syntax_Description_Type? And if not, what are you
> doing returning an unchecked conversion of one to the other?
Yes, I already found that this can be simplified (and updated my code at
GitHub).
But my question about my old code remains valid. Is that old code erroneous
or isn't?
By the way,
type Syntax_Description_Type is access constant Syntax_Description_Record
with Convention => C;
This isn't `access constant RDF.Auxiliary.Dummy_Record` but is memory
compatible with it.
> Your code as it stands is equivalent to
>
> function C_Raptor_Parser_Get_Description
> (Parser : Handle_Type)
> return RDF.Raptor.Syntaxes.Syntax_Description_Type
> with
> Import,
> Convention => C,
> External_Name => "raptor_parser_get_description";
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 17:49 2% Strict aliasing, is it OK? Victor Porton
` (2 preceding siblings ...)
2017-07-04 18:15 0% ` Niklas Holsti
@ 2017-07-04 21:41 0% ` Simon Wright
2017-07-04 23:39 0% ` Victor Porton
3 siblings, 1 reply; 200+ results
From: Simon Wright @ 2017-07-04 21:41 UTC (permalink / raw)
Victor Porton <porton@narod.ru> writes:
> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>
> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return My_Dummy_Access
> with Import, Convention=>C, External_Name=>"raptor_parser_get_description";
>
> function Get_Description (Parser: Parser_Type) return RDF.Raptor.Syntaxes.Syntax_Description_Type is
> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access, RDF.Raptor.Syntaxes.Syntax_Description_Type);
(I _wish_ you could use shorter lines!)
Is an "RDF.Raptor.Syntaxes.Syntax_Description_Type" actually an "access
constant RDF.Auxiliary.Dummy_Record"? If so, why not just declare
C_Raptor_Parser_Get_Description as returning a
RDF.Raptor.Syntaxes.Syntax_Description_Type? And if not, what are you
doing returning an unchecked conversion of one to the other?
Your code as it stands is equivalent to
function C_Raptor_Parser_Get_Description
(Parser : Handle_Type)
return RDF.Raptor.Syntaxes.Syntax_Description_Type
with
Import,
Convention => C,
External_Name => "raptor_parser_get_description";
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 19:29 0% ` Niklas Holsti
@ 2017-07-04 20:11 0% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-07-04 20:11 UTC (permalink / raw)
Niklas Holsti wrote:
> On 17-07-04 21:30 , Victor Porton wrote:
>> Niklas Holsti wrote:
>>
>>> On 17-07-04 20:49 , Victor Porton wrote:
>>>> I've started an ambitious open source project:
>>>>
>>
https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
>>>>
>>>> I am going to implement it in Ada.
>>>>
>>>> Note the file
>>>>
>>>> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
>>>>
>>>> Here is an extract from my code:
>>>>
>>>> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>>>>
>>>> function C_Raptor_Parser_Get_Description (Parser: Handle_Type)
>>>> return My_Dummy_Access
>>>> with Import, Convention=>C,
>>>> External_Name=>"raptor_parser_get_description";
>>>>
>>>> function Get_Description (Parser: Parser_Type) return
>>>> RDF.Raptor.Syntaxes.Syntax_Description_Type is
>>>> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access,
>>>> RDF.Raptor.Syntaxes.Syntax_Description_Type);
>>>> begin
>>>> return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser))
>>>> );
>>>> end;
>>>>
>>>>
>>>> When I compile this:
>>>>
>>>> $ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012
>>>> rdf-raptor-parser.adb) rdf-raptor-parser.adb:132:07: warning: possible
>>>> aliasing problem for type "Syntax_Description_Type"
>>>> rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch
>>>> for references rdf-raptor-parser.adb:132:07: warning: or use "pragma
>>>> No_Strict_Aliasing (Syntax_Description_Type);"
>>>>
>>>> I am not sure if it is OK to insert pragma No_Strict_Aliasing into my
>>>> code.
>>>>
>>>> GNAT Users Guide is cryptic.
>>>
>>> To me the GNAT UG
>>> (https://gcc.gnu.org/onlinedocs/gcc-7.1.0/gnat_ugn.pdf#f3) seems very
>>> clear.
>>>
>>>> The only thing I understood for sure is that sometimes strict
>>>> aliasing may cause a trouble.
>>>
>>> The question is whether your program uses Unchecked_Conversion (or some
>>> other unchecked tricks) to make a variable of type "access SomeType"
>>> point to an object that is not of the type "SomeType".
>>>
>>> Your instances of Unchecked_Conversion make GNAT suspect that your
>>> program might do such things. GNAT is warning you that your program
>>> would then violate the assumptions that underlie some of GNAT's code
>>> optimizations when the "strict aliasing" option is on, which means that
>>> the optimized code might not behave in the way you expect. The User
>>> Guide has an example of such unexpected behaviour.
>>>
>>>> I am not sure if this is a case
>>>> with my code. My code looks quite innocent, so I feel my idea will not
>>>> be broken by the compiler, but I am not sure. Please help.
>>>
>>> Just ask yourself if, in your program, an "access SomeType" always
>>> points to "SomeType". If so, you should be ok. If not, or if you are
>>> unsure, it is safer to use the pragma or compiler option that GNAT
>>> suggests; your program is then more likely to work as you want it to.
>>
>> I posted because I need help.
>
> I tried to help.
>
>> Please you answer the question:
>>
>> if, in your program, an "access SomeType" always points to "SomeType"?
>
> It is impossible to answer based on the code you show, because it
> depends on what your program _does_ with the Unchecked_Conversion
> instances.
>
> Note that your imported "C" functions that return access values can also
> lead to violation of the strict aliasing assumption, but again depending
> on how they are used.
>
>> Well, I do understand an example of wrong behavior in UG.
>
> Good.
>
>> but I don't know
>> whether my code is also an example of wrong behavior.
>
> The code you show does not have wrong behaviour, because it is just
> function declarations. Wrong behaviour (with respect to the strict
> aliasing rule) _may_ happen when you use those functions, but it depends
> on _how_ you use them.
>
> As I said, if you cannot answer the question, just follow GNAT's
> suggestion.
I do unchecked conversions (in both directions) between Handle_Type and
My_Dummy_Access.
Everytime I refer to Handle_Type, it is real Handle_Type.
But there is several Handle_Type (defined in different packages). Let us
denote them Handle_Type1, Handle_Type2, Handle_Type3, ...
When I refer to My_Dummy_Access it may be any one of Handle_Type1,
Handle_Type2, Handle_Type3, ...
But I never convert Handle_TypeN into Handle_TypeM for N/=M.
I also never use My_Dummy_Access to anything except to convert it into
Handle_TypeX.
Question: Are these restrictions enough for the compiler to the right thing
(that is not something counterintuitive)?
What is the right fix for the warning? Shall I add pragma
No_Strict_Aliasing?
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 18:30 0% ` Victor Porton
@ 2017-07-04 19:29 0% ` Niklas Holsti
2017-07-04 20:11 0% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Niklas Holsti @ 2017-07-04 19:29 UTC (permalink / raw)
On 17-07-04 21:30 , Victor Porton wrote:
> Niklas Holsti wrote:
>
>> On 17-07-04 20:49 , Victor Porton wrote:
>>> I've started an ambitious open source project:
>>>
> https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
>>>
>>> I am going to implement it in Ada.
>>>
>>> Note the file
>>>
>>> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
>>>
>>> Here is an extract from my code:
>>>
>>> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>>>
>>> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return
>>> My_Dummy_Access
>>> with Import, Convention=>C,
>>> External_Name=>"raptor_parser_get_description";
>>>
>>> function Get_Description (Parser: Parser_Type) return
>>> RDF.Raptor.Syntaxes.Syntax_Description_Type is
>>> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access,
>>> RDF.Raptor.Syntaxes.Syntax_Description_Type);
>>> begin
>>> return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser)) );
>>> end;
>>>
>>>
>>> When I compile this:
>>>
>>> $ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012
>>> rdf-raptor-parser.adb) rdf-raptor-parser.adb:132:07: warning: possible
>>> aliasing problem for type "Syntax_Description_Type"
>>> rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch
>>> for references rdf-raptor-parser.adb:132:07: warning: or use "pragma
>>> No_Strict_Aliasing (Syntax_Description_Type);"
>>>
>>> I am not sure if it is OK to insert pragma No_Strict_Aliasing into my
>>> code.
>>>
>>> GNAT Users Guide is cryptic.
>>
>> To me the GNAT UG
>> (https://gcc.gnu.org/onlinedocs/gcc-7.1.0/gnat_ugn.pdf#f3) seems very
>> clear.
>>
>>> The only thing I understood for sure is that sometimes strict
>>> aliasing may cause a trouble.
>>
>> The question is whether your program uses Unchecked_Conversion (or some
>> other unchecked tricks) to make a variable of type "access SomeType"
>> point to an object that is not of the type "SomeType".
>>
>> Your instances of Unchecked_Conversion make GNAT suspect that your
>> program might do such things. GNAT is warning you that your program
>> would then violate the assumptions that underlie some of GNAT's code
>> optimizations when the "strict aliasing" option is on, which means that
>> the optimized code might not behave in the way you expect. The User
>> Guide has an example of such unexpected behaviour.
>>
>>> I am not sure if this is a case
>>> with my code. My code looks quite innocent, so I feel my idea will not be
>>> broken by the compiler, but I am not sure. Please help.
>>
>> Just ask yourself if, in your program, an "access SomeType" always
>> points to "SomeType". If so, you should be ok. If not, or if you are
>> unsure, it is safer to use the pragma or compiler option that GNAT
>> suggests; your program is then more likely to work as you want it to.
>
> I posted because I need help.
I tried to help.
> Please you answer the question:
>
> if, in your program, an "access SomeType" always points to "SomeType"?
It is impossible to answer based on the code you show, because it
depends on what your program _does_ with the Unchecked_Conversion instances.
Note that your imported "C" functions that return access values can also
lead to violation of the strict aliasing assumption, but again depending
on how they are used.
> Well, I do understand an example of wrong behavior in UG.
Good.
> but I don't know
> whether my code is also an example of wrong behavior.
The code you show does not have wrong behaviour, because it is just
function declarations. Wrong behaviour (with respect to the strict
aliasing rule) _may_ happen when you use those functions, but it depends
on _how_ you use them.
As I said, if you cannot answer the question, just follow GNAT's suggestion.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 18:15 0% ` Niklas Holsti
@ 2017-07-04 18:30 0% ` Victor Porton
2017-07-04 19:29 0% ` Niklas Holsti
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-07-04 18:30 UTC (permalink / raw)
Niklas Holsti wrote:
> On 17-07-04 20:49 , Victor Porton wrote:
>> I've started an ambitious open source project:
>>
https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
>>
>> I am going to implement it in Ada.
>>
>> Note the file
>>
>> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
>>
>> Here is an extract from my code:
>>
>> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>>
>> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return
>> My_Dummy_Access
>> with Import, Convention=>C,
>> External_Name=>"raptor_parser_get_description";
>>
>> function Get_Description (Parser: Parser_Type) return
>> RDF.Raptor.Syntaxes.Syntax_Description_Type is
>> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access,
>> RDF.Raptor.Syntaxes.Syntax_Description_Type);
>> begin
>> return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser)) );
>> end;
>>
>>
>> When I compile this:
>>
>> $ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012
>> rdf-raptor-parser.adb) rdf-raptor-parser.adb:132:07: warning: possible
>> aliasing problem for type "Syntax_Description_Type"
>> rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch
>> for references rdf-raptor-parser.adb:132:07: warning: or use "pragma
>> No_Strict_Aliasing (Syntax_Description_Type);"
>>
>> I am not sure if it is OK to insert pragma No_Strict_Aliasing into my
>> code.
>>
>> GNAT Users Guide is cryptic.
>
> To me the GNAT UG
> (https://gcc.gnu.org/onlinedocs/gcc-7.1.0/gnat_ugn.pdf#f3) seems very
> clear.
>
>> The only thing I understood for sure is that sometimes strict
>> aliasing may cause a trouble.
>
> The question is whether your program uses Unchecked_Conversion (or some
> other unchecked tricks) to make a variable of type "access SomeType"
> point to an object that is not of the type "SomeType".
>
> Your instances of Unchecked_Conversion make GNAT suspect that your
> program might do such things. GNAT is warning you that your program
> would then violate the assumptions that underlie some of GNAT's code
> optimizations when the "strict aliasing" option is on, which means that
> the optimized code might not behave in the way you expect. The User
> Guide has an example of such unexpected behaviour.
>
>> I am not sure if this is a case
>> with my code. My code looks quite innocent, so I feel my idea will not be
>> broken by the compiler, but I am not sure. Please help.
>
> Just ask yourself if, in your program, an "access SomeType" always
> points to "SomeType". If so, you should be ok. If not, or if you are
> unsure, it is safer to use the pragma or compiler option that GNAT
> suggests; your program is then more likely to work as you want it to.
I posted because I need help.
Please you answer the question:
if, in your program, an "access SomeType" always points to "SomeType"?
Well, I do understand an example of wrong behavior in UG, but I don't know
whether my code is also an example of wrong behavior.
Please help!
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 17:49 2% Strict aliasing, is it OK? Victor Porton
2017-07-04 17:50 0% ` Victor Porton
2017-07-04 18:06 0% ` Victor Porton
@ 2017-07-04 18:15 0% ` Niklas Holsti
2017-07-04 18:30 0% ` Victor Porton
2017-07-04 21:41 0% ` Simon Wright
3 siblings, 1 reply; 200+ results
From: Niklas Holsti @ 2017-07-04 18:15 UTC (permalink / raw)
On 17-07-04 20:49 , Victor Porton wrote:
> I've started an ambitious open source project:
> https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
>
> I am going to implement it in Ada.
>
> Note the file
>
> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
>
> Here is an extract from my code:
>
> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>
> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return My_Dummy_Access
> with Import, Convention=>C, External_Name=>"raptor_parser_get_description";
>
> function Get_Description (Parser: Parser_Type) return RDF.Raptor.Syntaxes.Syntax_Description_Type is
> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access, RDF.Raptor.Syntaxes.Syntax_Description_Type);
> begin
> return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser)) );
> end;
>
>
> When I compile this:
>
> $ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012 rdf-raptor-parser.adb)
> rdf-raptor-parser.adb:132:07: warning: possible aliasing problem for type "Syntax_Description_Type"
> rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch for references
> rdf-raptor-parser.adb:132:07: warning: or use "pragma No_Strict_Aliasing (Syntax_Description_Type);"
>
> I am not sure if it is OK to insert pragma No_Strict_Aliasing into my code.
>
> GNAT Users Guide is cryptic.
To me the GNAT UG
(https://gcc.gnu.org/onlinedocs/gcc-7.1.0/gnat_ugn.pdf#f3) seems very clear.
> The only thing I understood for sure is that sometimes strict
> aliasing may cause a trouble.
The question is whether your program uses Unchecked_Conversion (or some
other unchecked tricks) to make a variable of type "access SomeType"
point to an object that is not of the type "SomeType".
Your instances of Unchecked_Conversion make GNAT suspect that your
program might do such things. GNAT is warning you that your program
would then violate the assumptions that underlie some of GNAT's code
optimizations when the "strict aliasing" option is on, which means that
the optimized code might not behave in the way you expect. The User
Guide has an example of such unexpected behaviour.
> I am not sure if this is a case
> with my code. My code looks quite innocent, so I feel my idea will not be
> broken by the compiler, but I am not sure. Please help.
Just ask yourself if, in your program, an "access SomeType" always
points to "SomeType". If so, you should be ok. If not, or if you are
unsure, it is safer to use the pragma or compiler option that GNAT
suggests; your program is then more likely to work as you want it to.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 17:49 2% Strict aliasing, is it OK? Victor Porton
2017-07-04 17:50 0% ` Victor Porton
@ 2017-07-04 18:06 0% ` Victor Porton
2017-07-04 18:15 0% ` Niklas Holsti
2017-07-04 21:41 0% ` Simon Wright
3 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-07-04 18:06 UTC (permalink / raw)
Victor Porton wrote:
> I've started an ambitious open source project:
> https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
>
> I am going to implement it in Ada.
>
> Note the file
>
> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
>
> Here is an extract from my code:
>
> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>
> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return
> My_Dummy_Access
> with Import, Convention=>C,
> External_Name=>"raptor_parser_get_description";
>
> function Get_Description (Parser: Parser_Type) return
> RDF.Raptor.Syntaxes.Syntax_Description_Type is
> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access,
> RDF.Raptor.Syntaxes.Syntax_Description_Type);
> begin
> return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser)) );
> end;
I've added (bug fix)
with Convention=>C
after
type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record
> When I compile this:
>
> $ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012
> rdf-raptor-parser.adb) rdf-raptor-parser.adb:132:07: warning: possible
> aliasing problem for type "Syntax_Description_Type"
> rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch for
> references rdf-raptor-parser.adb:132:07: warning: or use "pragma
> No_Strict_Aliasing (Syntax_Description_Type);"
>
> I am not sure if it is OK to insert pragma No_Strict_Aliasing into my
> code.
>
> GNAT Users Guide is cryptic. The only thing I understood for sure is that
> sometimes strict aliasing may cause a trouble. I am not sure if this is a
> case with my code. My code looks quite innocent, so I feel my idea will
> not be broken by the compiler, but I am not sure. Please help.
>
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Strict aliasing, is it OK?
2017-07-04 17:49 2% Strict aliasing, is it OK? Victor Porton
@ 2017-07-04 17:50 0% ` Victor Porton
2017-07-04 18:06 0% ` Victor Porton
` (2 subsequent siblings)
3 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-07-04 17:50 UTC (permalink / raw)
Victor Porton wrote:
> I've started an ambitious open source project:
> https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
>
> I am going to implement it in Ada.
>
> Note the file
>
> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
>
> Here is an extract from my code:
>
> type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
>
> function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return
> My_Dummy_Access
> with Import, Convention=>C,
> External_Name=>"raptor_parser_get_description";
>
> function Get_Description (Parser: Parser_Type) return
> RDF.Raptor.Syntaxes.Syntax_Description_Type is
> function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access,
> RDF.Raptor.Syntaxes.Syntax_Description_Type);
> begin
> return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser)) );
> end;
>
>
> When I compile this:
>
> $ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012
> rdf-raptor-parser.adb) rdf-raptor-parser.adb:132:07: warning: possible
> aliasing problem for type "Syntax_Description_Type"
> rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch for
> references rdf-raptor-parser.adb:132:07: warning: or use "pragma
> No_Strict_Aliasing (Syntax_Description_Type);"
>
> I am not sure if it is OK to insert pragma No_Strict_Aliasing into my
> code.
>
> GNAT Users Guide is cryptic. The only thing I understood for sure is that
> sometimes strict aliasing may cause a trouble. I am not sure if this is a
> case with my code. My code looks quite innocent, so I feel my idea will
> not be broken by the compiler, but I am not sure. Please help.
Note that "handles" in my code a "C" conventions accesses to C records.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Strict aliasing, is it OK?
@ 2017-07-04 17:49 2% Victor Porton
2017-07-04 17:50 0% ` Victor Porton
` (3 more replies)
0 siblings, 4 replies; 200+ results
From: Victor Porton @ 2017-07-04 17:49 UTC (permalink / raw)
I've started an ambitious open source project:
https://en.wikiversity.org/wiki/Automatic_transformation_of_XML_namespaces
I am going to implement it in Ada.
Note the file
https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-raptor-parser.adb
Here is an extract from my code:
type My_Dummy_Access is access constant RDF.Auxiliary.Dummy_Record;
function C_Raptor_Parser_Get_Description (Parser: Handle_Type) return My_Dummy_Access
with Import, Convention=>C, External_Name=>"raptor_parser_get_description";
function Get_Description (Parser: Parser_Type) return RDF.Raptor.Syntaxes.Syntax_Description_Type is
function Conv is new Ada.Unchecked_Conversion(My_Dummy_Access, RDF.Raptor.Syntaxes.Syntax_Description_Type);
begin
return Conv( C_Raptor_Parser_Get_Description(Get_Handle(Parser)) );
end;
When I compile this:
$ (cd src && gnatgcc -gnatf -c -fPIC -g -O2 -gnat2012 rdf-raptor-parser.adb)
rdf-raptor-parser.adb:132:07: warning: possible aliasing problem for type "Syntax_Description_Type"
rdf-raptor-parser.adb:132:07: warning: use -fno-strict-aliasing switch for references
rdf-raptor-parser.adb:132:07: warning: or use "pragma No_Strict_Aliasing (Syntax_Description_Type);"
I am not sure if it is OK to insert pragma No_Strict_Aliasing into my code.
GNAT Users Guide is cryptic. The only thing I understood for sure is that
sometimes strict aliasing may cause a trouble. I am not sure if this is a case
with my code. My code looks quite innocent, so I feel my idea will not be
broken by the compiler, but I am not sure. Please help.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 2%]
* Re: Mixing Ada code with similar licenses
[not found] ` <o9ve6p$2pq$1@dont-email.me>
@ 2017-03-26 20:57 0% ` Jere
0 siblings, 0 replies; 200+ results
From: Jere @ 2017-03-26 20:57 UTC (permalink / raw)
On Friday, March 10, 2017 at 6:54:44 PM UTC-5, Jeffrey R. Carter wrote:
> On 03/10/2017 10:20 PM, Jere wrote:
> >
> > In ada it would be something like (Rober's Impl)
> > procedure Clear_BSS is
> > -- Suppress checking pointers from being zero (trust us)
> > -- results in much better code
> > pragma Suppress (Access_Check);
> > type Int_Ptr is access all Integer_Address;
> > function To_Access is
> > new Ada.Unchecked_Conversion (Integer_Address, Int_Ptr);
> > BSS_Start : Integer_Address := To_Integer (LD_BSS_Start'Address);
> > BSS_End : constant Integer_Address := To_Integer (LD_BSS_End'Address);
> > Src : Int_Ptr;
> > begin
> > while BSS_Start < BSS_End
> > loop
> > Src := To_Access (BSS_Start);
> > Src.all := 0; -- clear
> > BSS_Start := BSS_Start + 4;
> > end loop;
> > end Clear_BSS;
> >
> > I would ideally just want to use that function with others, but implement my startup sequence that calls it a bit different. My question is would that ada function (and the other two I mentioned above) fall under the regular GPL (no exception).
>
> If you copy his code, then his license applies and your code that includes the
> copied code is pure GPL.
>
> However, if you can come up with a different (hopefully better) implementation,
> then you get to choose the license. I might implement Clear_BSS as something like
>
> procedure Clear_BSS is
> Start : constant Integer_Address := To_Integer (BSS_Start_Address);
> Stop : constant Integer_Address := to_Integer (BSS_Stop_Address);
>
> BSS : Integer_Address := Start;
> begin -- Clear_BSS
> Clear_All : loop
> exit Clear_All when BSS >= Stop;
>
> Clear_One : declare
> To_Clear : Integer_Address;
> for To_Clear'Address use To_Address (BSS);
> pragma Import (Ada, To_Clear); -- Suppress any initialization.
> begin -- Clear_One
> To_Clear := 0;
> end Clear_One;
>
> BSS := BSS + 4;
> end loop Clear_All;
> end Clear_BSS;
>
> which looks to me like it does the same thing, but seems clearer. (I have no
> objection to you using this with a license at least as permissive as the GPL +
> exception.)
>
> If you can do similar things to the other 2 subprograms, then you don't need to
> make your code pure GPL.
>
> --
> Jeff Carter
> "Violence is the last refuge of the incompetent."
> Foundation
> 151
Thank you! I'll mess around with this method as well. This does raise a
question for me though: In function, both procedures do the same thing
(Use Integer_Address to loop through the addresses and convert to another
type to do the assignment). I can see the style differences, but wondered
where the line was. One could argue they do the same thing (I personally
can see the difference, but was trying to think from a outside perspective).
Also, how much of a method really is licensable? If someone wrote the
function :
function Add_Numbers(A,B : in Integer) return Integer is
begin
return A+B;
end Add_Numbers;
And stuck a pure GPL license on it, would any of my code that added two
numbers be under pure GPL from then on. Common sense tells me "no" but
then legal matters don't always work with common sense. In the same vein,
the BSS_Clear function of Robert's is simply a "loop through a pointer
and set each element to 0" function, which isn't ground breaking as well.
At what point is the method actually licenseable?
Note that I am not necessarily asking you directly Jeffery. This is a
general musing. I'm just musing along with my response to your post.
Again, thank you for the idea above.
^ permalink raw reply [relevance 0%]
* Re: Bug in Ada - Latin 1 is not a subset of UTF-8
@ 2016-10-21 12:28 1% ` G.B.
0 siblings, 0 replies; 200+ results
From: G.B. @ 2016-10-21 12:28 UTC (permalink / raw)
On 20.10.16 09:36, Dmitry A. Kazakov wrote:
> On 20/10/2016 02:31, Randy Brukardt wrote:
>> "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message
>> news:nu4nee$18le$1@gioia.aioe.org...
>> ...
>>> Numeric character is a constraint expressible in Ada:
>>>
>>> subtype Numeric is Character range '0'..'9';
>>>
>>> Numeric string constraint is not expressible, but it still a constraint.
>>
>> It's expressible as a predicate, though; that's the entire point of
>> predicates (to act like user-defined constraints):
>>
>> subtype Numeric_String is String
>> with Dynamic_Predicate => (for all E of Numeric_String => E in
>> Numeric);
>>
>> It's not 100% as good as a constraint (as modifications of individual
>> components won't be checked), but it almost always will do the job.
>
> Not nice. Is there a reason why, apart from premature optimization?
I think you can add an aspect to the component type
and have that checked on assignment to a component.
The aspect could somehow be different from the
constraint, also just repeating it appears to loop infinitely
with current GNATs.
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=78066
Anyway, a little inconvenience for starters:
subtype My_Utf_8_String is String
-- or, when not String, some array of any component type
-- suitable as a byte sequence item type
with Dynamic_Predicate => Is_Well_Formed (My_Utf_8_String);
Bom: constant String := String'(Character'Val (16#EF#),
Character'Val (16#BB#),
Character'Val (16#BF#));
function Has_Bom (U8: String) return Boolean is
(U8'Length >= 3
and then U8 (U8'First .. U8'First + 2) = Bom);
function "abs" is new Ada.Unchecked_Conversion
(Character, Interfaces.Unsigned_8);
function Is_Well_Formed (U8 : String) return Boolean is
-- `U8` has permissible bit patterns for all bytes. (No Table 3.7
-- support.)
((if U8'Length > 0 then
(if Has_Bom (U8)
then
Is_Well_Formed (U8 (U8'First + 3 .. U8'Last))
else
(for all J in U8'Range =>
(case abs U8 (J) is
when 2#0_0000000# .. 2#0_1111111# =>
-- ASCII compatibility
True,
when 2#10_000000# .. 2#10_111111# =>
-- is a following byte
(if J > U8'First then
(abs U8 (J - 1)
in 2#110_00000# .. 2#110_11111#
or abs U8 (J - 1)
in 2#1110_0000# .. 2#1110_1111#
or abs U8 (J - 1)
in 2#11110_000# .. 2#11110_111#)
else
False
),
when 2#110_00000# .. 2#110_11111# =>
(if J < U8'Last then
(abs U8 (J + 1)
in 2#10_000000# .. 2#10_111111#)
else
False),
when 2#1110_0000# .. 2#1110_1111# =>
(if J + 1 < U8'Last then
(for all K in J + 1 .. J + 2 =>
abs U8 (K)
in 2#10_000000# .. 2#10_111111#)
else
False
),
when 2#11110_000# .. 2#11110_111# =>
(if J + 2 < U8'Last then
(for all K in J + 1 .. J + 3 =>
abs U8 (K)
in 2#10_000000# .. 2#10_111111#)
else
False
),
when 2#11111_000# .. 2#11111_111# =>
-- not in Table 3.6 (UTF-8 Bit Distribution)
False
)
)
)
-- String of length 0:
else True));
Test_Bom : constant My_Utf_8_String := Bom & "ABC";
Test_US : constant My_Utf_8_String := "ABC";
Test_GR : constant My_Utf_8_String := "ΑΒΓ";
Test_RU : constant My_Utf_8_String := "АБГ";
Test_Xx : constant My_Utf_8_String :=
('A', Character'Val (16#E4#), 'E');
^ permalink raw reply [relevance 1%]
* GNAVI,GWindows.Common_Controls.On_Notify - how to return value?
@ 2016-08-13 9:27 1% George J
0 siblings, 0 replies; 200+ results
From: George J @ 2016-08-13 9:27 UTC (permalink / raw)
Hi all! Today I've got troubles with WM_NOTIFY message in Gwindows. I have a listview and i want to realize custom draw method (put progressbar in the cell and change font color) like in this little example (copied from codeproject examples):
-----------------------------
static LRESULT CALLBACK
MainWinProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
switch(uMsg) {
case WM_NOTIFY:
{
NMHDR* pHdr = (NMHDR*) lParam;
if(pHdr->idFrom == ID_LISTVIEW && pHdr->code == NM_CUSTOMDRAW)
{
NMLVCUSTOMDRAW* pcd = (NMLVCUSTOMDRAW*) lParam;
TCHAR buffer[16];
LVITEM item;
switch(pcd->nmcd.dwDrawStage) {
case CDDS_PREPAINT:
/* Tell the control we are interested in per-item notifications.
* (We need it just to tell the control we want per-subitem
* notifications.) */
return CDRF_DODEFAULT | CDRF_NOTIFYITEMDRAW;// ^*^ Problem here!
.....etc
---------------------------------------------
I made overriding On_Notify method to listview (like in 24 tutorial example GWindows) :
-------------------------------------------
type NMHDR is
record
HWND_From : Win32.Windef.HWND;
ID_From : Win32.UINT_PTR;
Code : Win32.UINT;
end record;
pragma Convention(C_PASS_BY_COPY,NMHDR);
type LPNMHDR is access all NMHDR;
-- ... and other declarations
NM_FIRST : constant := 0;
NM_CUSTOMDRAW : constant := NM_FIRST-12;
function To_LPNMHDR is new Ada.Unchecked_Conversion(GWindows.Types.Lresult,LPNMHDR);
-- On_Notify --
overriding procedure On_Notify
(Window : in out X_List_View_Type;
Message : in GWindows.Base.Pointer_To_Notification;
Control : in GWindows.Base.Pointer_To_Base_Window_Class;
Return_Value : in out GWindows.Types.Lresult)
is
PNMHDR : LPNMHDR := To_LPNMHDR(Return_Value);
begin
case Message.Code is
when NM_CUSTOMDRAW =>
null;-- ^*^ i can't understand, how can i return CDRF_DODEFAULT here
when others =>
null;
end case;
end On_Notify;
--------------------------------------------
Can smb explain some mechanizm of On_Notify? I've explored GWindows sources and didn't find neither registering class, nor wndProc and really can't understand how to realize those C example. Thanks!
^ permalink raw reply [relevance 1%]
* Re: Generic formals and Aspects
@ 2016-07-19 18:00 3% ` olivermkellogg
0 siblings, 0 replies; 200+ results
From: olivermkellogg @ 2016-07-19 18:00 UTC (permalink / raw)
On Tuesday, July 19, 2016 at 6:05:12 PM UTC+2, Shark8 wrote:
> Try the following:
>
>
> ------ SPEC ------
> generic
> type Discrete_Type is (<>); -- CANDIDATE
>
> package Big_Endian_Integer_Buffer is
>
> function Get return Discrete_Type;
> procedure Set (Value : Discrete_Type);
>
> Private
> type Internal is new Discrete_Type
> with Static_Predicate => Internal'Size in 16 | 32 | 64;
>
> Size_In_Bytes : constant Positive := Internal'Size / 8;
>
> type Buffer_Type is array (1 .. Size_In_Bytes) of Interfaces.Unsigned_8
> with Component_Size => 8;
>
> Buffer : Buffer_Type := (others => 0);
> end Big_Endian_Integer_Buffer;
>
>
> ------ BODY ------
> package body Big_Endian_Integer_Buffer is
>
> function Get return Discrete_Type is
> Result : Discrete_Type
> with Import, Address => Buffer'Address;
> begin
> Return Discrete_Type(Result);
> End Get;
>
> procedure Set (Value : Discrete_Type) is
> Temp : Internal
> with Import, Address => Buffer'Address;
> begin
> Temp := Internal(Value);
> End Set;
>
> end Big_Endian_Integer_Buffer;
Interesting.
Using your modified spec with the following test program:
-- File: beib_test.adb
with Interfaces;
with Big_Endian_Integer_Buffer;
procedure BEIB_Test is
package Pass is new Big_Endian_Integer_Buffer (Interfaces.Unsigned_64);
type RGB_T is mod 2 ** 24 with Size => 24;
package Fail is new Big_Endian_Integer_Buffer (RGB_T);
P : Interfaces.Unsigned_64;
F : RGB_T;
begin
P := Pass.Get;
F := Fail.Get;
end BEIB_Test;
I get the following message from GNAT:
beib_test.ads:6:04: instantiation error at big_endian_integer_buffer.ads:16
beib_test.ads:6:04: expression is not predicate-static (RM 3.2.4(16-22))
[...]
Line 6 is at the Pass instantiation. (The same error happens at the Fail instantiation.)
Hmm, too bad... I would have preferred getting a compile time error.
That said, after changing Static_Predicate to Dynamic_Predicate in the spec, the test program builds okay.
However, it runs without failure. (I would have expected a failure on the Fail instantiation.)
For completeness, here is the generic body that I am using:
-- File: big_endian_integer_buffer.adb
with System, Ada.Unchecked_Conversion;
package body Big_Endian_Integer_Buffer is
use type System.Bit_Order;
function Get return Discrete_Type is
function To_Discrete is new Ada.Unchecked_Conversion
(Buffer_Type, Discrete_Type);
begin
if System.Default_Bit_Order = System.High_Order_First then
return To_Discrete (Buffer);
end if;
declare
Native_Buf : Buffer_Type;
begin
for I in 1 .. Size_In_Bytes loop
Native_Buf (I) := Buffer (Size_In_Bytes - I + 1);
end loop;
return To_Discrete (Native_Buf);
end;
end Get;
procedure Set (Value : Discrete_Type) is
function To_Buffer is new Ada.Unchecked_Conversion
(Discrete_Type, Buffer_Type);
begin
if System.Default_Bit_Order = System.High_Order_First then
Buffer := To_Buffer (Value);
return;
end if;
declare
Native_Buf : constant Buffer_Type := To_Buffer (Value);
begin
for I in 1 .. Size_In_Bytes loop
Buffer (I) := Native_Buf (Size_In_Bytes - I + 1);
end loop;
end;
end Set;
end Big_Endian_Integer_Buffer;
^ permalink raw reply [relevance 3%]
* Did I find mamory leak in Generic Image Decoder (GID) ?
@ 2015-02-02 5:50 1% 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 1%]
* Re: Can't compile FOSDEM 2014 Ada Task Pools demo on Debian jessie
@ 2015-01-19 20:44 14% ` Ludovic Brenta
0 siblings, 0 replies; 200+ results
From: Ludovic Brenta @ 2015-01-19 20:44 UTC (permalink / raw)
Dirk Heinrichs writes on comp.lang.ada:
> I'm trying to compile the Ada Task Pools demo from FOSDEM 2014[1] on Debian
> jessie, but I'm getting the following error:
>
> % gprbuild -P fosdem2013.gpr
> gnatgcc -c -gnat2012 -g -O0 -gnatafoy -gnatVa -gnatwa fosdem2013.adb
> xcb_value_list_g.ads:14:04: size clause not allowed for variable length type
> gprbuild: *** compilation phase failed
>
> Did I miss anything?
My fault. Here is a patch which I forgot to commit and publish in my
tarball. Note that this error appeared in gnat-4.9 and did not exist
(IIRC) in gnat-4.8.
Revision: e9679c7bae046fc7d9d85a0cf69cf5a81428746a
Parent: e334b694201e321a33be72323aace48b614594b1
Author: Ludovic Brenta
Date: 2014-12-28T11:28:10
Branch: org.ludovic-brenta.xcb
Changelog:
* Add a binding to the Expose event.
* xcb.gpr: correct the Library_Name.
* xcb_value_list_g.ads: remove rep clause for Mask_T as it is
incompatible with gnat-4.9.
Changes against parent e334b694201e321a33be72323aace48b614594b1
patched xcb.ads
patched xcb.gpr
patched xcb_value_list_g.adb
patched xcb_value_list_g.ads
============================================================
--- xcb.ads c57578058fb5f90962b1cd37d86bc3a7479479d7
+++ xcb.ads 7cdc0398c04aeae7863c15bb0d2b7f2c43d421cb
@@ -304,6 +304,12 @@ package XCB is
State : Interfaces.Unsigned_16;
Same_Screen : Interfaces.Unsigned_8;
Pad_Button : Interfaces.Unsigned_8;
+ when Expose =>
+ Expose_Event_Window : XCB.Window.T;
+ Expose_X, Expose_Y : Interfaces.Unsigned_16;
+ Expose_Width, Expose_Height : Interfaces.Unsigned_16;
+ Count : Interfaces.Unsigned_16;
+ Expose_Pad : Interfaces.Unsigned_16;
when Configure_Notify =>
Configure_Event_Window : XCB.Window.T;
Configured_Window : XCB.Window.T;
============================================================
--- xcb.gpr 7bdc5629c63c21fab02656b3b6f22ab507a0029c
+++ xcb.gpr 3620ab57cbb97f6d1879b5d68b2af8e05670343f
@@ -1,7 +1,7 @@ library project XCB is
library project XCB is
for Source_Dirs use (".");
for Library_ALI_Dir use "lib";
- for Library_Name use "libxadabinding.so.0";
+ for Library_Name use "xadabinding.so.0";
for Library_Kind use "dynamic";
for Library_Dir use "lib";
for Object_Dir use ".o";
============================================================
--- xcb_value_list_g.adb 788761105d54168635193747918c0f7eabbe386f
+++ xcb_value_list_g.adb abf12bb134098f2962dd9123162fa02d44f51c5c
@@ -5,7 +5,8 @@ package body XCB_Value_List_G is
function Mask_Of (Values : in T) return Interfaces.Unsigned_32 is
Result : Mask_T := (others => False);
Last_Key : Key_T := Key_T'First;
- function To_Integer is new Ada.Unchecked_Conversion (Mask_T, Interfaces.Unsigned_32);
+ function To_Integer is
+ new Ada.Unchecked_Conversion (Mask_T, Interfaces.Unsigned_32);
begin
for K in Values'Range loop
pragma Assert (K = Values'First or else Values (K).Key > Last_Key);
============================================================
--- xcb_value_list_g.ads f00a24a7d141e65c285fdf4a20bbd1405fca9db7
+++ xcb_value_list_g.ads 5b6dbb60d2d16adfe87a88dcb481fc0b32886b7b
@@ -8,10 +8,9 @@ package XCB_Value_List_G is
Value : Interfaces.Unsigned_32;
end record;
type T is array (Positive range <>) of Key_Value_Pair_T;
-
+
type Mask_T is array (Key_T) of Boolean;
pragma Pack (Mask_T);
- for Mask_T'Size use 32;
pragma Warnings (Off, Mask_T); -- unused bits
function Mask_Of (Values : in T) return Interfaces.Unsigned_32;
^ permalink raw reply [relevance 14%]
* Debugging Audio Issue using Windows 7?
@ 2014-10-02 13:56 3% dd24fan
0 siblings, 0 replies; 200+ results
From: dd24fan @ 2014-10-02 13:56 UTC (permalink / raw)
Looking for some guidance on what to do with an application on Windows 7 playing audio sounds on 2 devices (Realtek onboard & Soundblaster Z). Currently with legacy API all sounds come through the Realtek device only.
In Windows XP the application used to play sounds on the onboard and an older Sound Blaster card when software was triggered by a hardware input.
Windows 7 has Core Audio APIs now but I'm not sure how to integrate it with legacy API so that I can play certain sounds to the Realtek and Sound Blaster like in XP.
I'm using ObjectAda 8.2.2 (can't upgrade due to contractual issues) and there is a directory (..\ObjectAda\win32ada\binding\win32) that has the winapi, winapiconstants, win32.mmsystem, etc ada code.
Our application code then uses pragma Elaborates to reference the files (see example below)
with Ada.Unchecked_Conversion;
with Winapi;
with Winapiconstants;
with Unchecked_Conversion;
with System;
with Win32.Mmsystem;
with Idirectsound;
with Idirectsoundbuffer;
with Vc;
with Cwavesoundread;
pragma Elaborate(Winapi);
pragma Elaborate(Winapiconstants);
pragma Elaborate(Unchecked_Conversion);
pragma Elaborate(System);
pragma Elaborate(Win32.Mmsystem);
pragma Elaborate(Idirectsound);
pragma Elaborate(Idirectsoundbuffer);
pragma Elaborate(Vc);
pragma Elaborate(Cwavesoundread);
pragma Elaborate(Interfaces.C);
I guess my question would be is there a way to modify existing code without having to re-write all of it to the new Windows 7 Core Audio API?
Any help is greatly appreciated.
-Davelin
^ permalink raw reply [relevance 3%]
* Interfacing enums with C
@ 2014-08-17 19:02 2% Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2014-08-17 19:02 UTC (permalink / raw)
Let in C code are defined:
typedef enum { A=1, B=2 } option_type;
void f(option_type option);
Let we also have
type Option_Type is (A, B);
for Option_Type'Size use Interfaces.C.unsigned'Size;
for Option_Type use (A=>1, B=>2);
X: Option_Type := A;
Which of the following code is correct (accordingly RM)?
-- First code
declare
procedure F (Option: Option_Type)
with Import, Convention=>C, External_Name=>"f";
begin
F(X);
end;
or
-- Second code
declare
procedure F (Option: Interfaces.C.unsigned)
with Import, Convention=>C, External_Name=>"f";
function Conv is new Ada.Unchecked_Conversion(Option_Type, Interfaces.C.unsigned);
begin
F(Conv(X));
end;
I think both first and second Ada fragments are correct but am not sure.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 2%]
* Re: Rough proposal to make some generic types static
2014-07-21 20:44 3% Rough proposal to make some generic types static Victor Porton
@ 2014-07-21 20:54 0% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2014-07-21 20:54 UTC (permalink / raw)
Victor Porton wrote:
> What in the RM signifies that Enum_Type (below) is not a static scalar
> type?
I've found: RM 4.9 26/3:
"A static scalar subtype is an unconstrained scalar subtype whose type is
not a descendant of a formal type, or ..."
Why this rule? Can it be relaxed?
> We should work on an amendment for a future version of Ada to make
> Enum_Type static.
>
> Is it difficult to implement this?
>
> Rationale is that the below code is useful in practice.
>
> gnatmake -q -c -gnatc -u
> -P/home/porton/Projects/redland-bindings/ada/test.gpr -XRUNTIME=full
> -XMODE=Install rdf-auxilary.adb rdf-auxilary.adb:7:25: non-static
> expression used for modular type bound rdf-auxilary.adb:7:38: size
> attribute is only static for static scalar type (RM 4.9(7,8))
>
> -- rdf.ads
> package RDF is
> end RDF;
>
> -- rdf-auxilary.ads
> with Interfaces.C;
>
> package RDF.Auxilary is
>
> generic
> type Enum_Type is (<>);
> package Convert_Enum is
> function To_C(Argument: Enum_Type) return Interfaces.C.int;
> function From_C(Argument: Interfaces.C.int) return Enum_Type;
> end;
>
> end RDF.Auxilary;
>
> -- rdf-auxilary.adb
> with Ada.Unchecked_Conversion;
>
> package body RDF.Auxilary is
>
> package body Convert_Enum is
>
> type Small is mod 2**(Enum_Type'Size);
>
> function To_C_Internal is
> new Ada.Unchecked_Conversion (Source => Enum_Type, Target =>
> Small);
>
> function From_C_Internal is
> new Ada.Unchecked_Conversion (Source => Small, Target =>
> Enum_Type);
>
> function To_C(Argument: Enum_Type) return Interfaces.C.int is
> begin
> return Interfaces.C.int(To_C_Internal(Argument));
> end;
>
> function From_C(Argument: Interfaces.C.int) return Enum_Type is
> begin
> return From_C_Internal(Small(Argument));
> end;
>
> end;
>
> end RDF.Auxilary;
>
>
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Rough proposal to make some generic types static
@ 2014-07-21 20:44 3% Victor Porton
2014-07-21 20:54 0% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2014-07-21 20:44 UTC (permalink / raw)
What in the RM signifies that Enum_Type (below) is not a static scalar
type?
We should work on an amendment for a future version of Ada to make
Enum_Type static.
Is it difficult to implement this?
Rationale is that the below code is useful in practice.
gnatmake -q -c -gnatc -u -P/home/porton/Projects/redland-bindings/ada/test.gpr -XRUNTIME=full -XMODE=Install rdf-auxilary.adb
rdf-auxilary.adb:7:25: non-static expression used for modular type bound
rdf-auxilary.adb:7:38: size attribute is only static for static scalar type (RM 4.9(7,8))
-- rdf.ads
package RDF is
end RDF;
-- rdf-auxilary.ads
with Interfaces.C;
package RDF.Auxilary is
generic
type Enum_Type is (<>);
package Convert_Enum is
function To_C(Argument: Enum_Type) return Interfaces.C.int;
function From_C(Argument: Interfaces.C.int) return Enum_Type;
end;
end RDF.Auxilary;
-- rdf-auxilary.adb
with Ada.Unchecked_Conversion;
package body RDF.Auxilary is
package body Convert_Enum is
type Small is mod 2**(Enum_Type'Size);
function To_C_Internal is
new Ada.Unchecked_Conversion (Source => Enum_Type, Target => Small);
function From_C_Internal is
new Ada.Unchecked_Conversion (Source => Small, Target => Enum_Type);
function To_C(Argument: Enum_Type) return Interfaces.C.int is
begin
return Interfaces.C.int(To_C_Internal(Argument));
end;
function From_C(Argument: Interfaces.C.int) return Enum_Type is
begin
return From_C_Internal(Small(Argument));
end;
end;
end RDF.Auxilary;
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: 'Size hack for enumerated types
2014-07-05 22:23 0% ` Victor Porton
@ 2014-07-06 16:25 0% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2014-07-06 16:25 UTC (permalink / raw)
Victor Porton wrote:
> Victor Porton wrote:
>
>> I tried to implement it in a memory savvy way. But GNAT does not compile
>> it. It would be good if a future version of Ada supported it.
>>
>> -- rds.ads
>> package RDF is
>> end RDF;
>>
>> -- rdf-auxilary.ads
>> with Interfaces.C;
>>
>> package RDF.Auxilary is
>>
>> generic
>> type Enum_Type is range <>;
>> package Convert_Enum is
>> function To_C(Argument: Enum_Type) return Interfaces.C.int;
>> function From_C(Argument: Interfaces.C.int) return Enum_Type;
>> end;
>>
>> end RDF.Auxilary;
>>
>> -- rdf-auxilary.adb
>> with Ada.Unchecked_Conversion;
>>
>> package body RDF.Auxilary is
>>
>> package body Convert_Enum is
>>
>> type Small is mod 2**(Enum_Type'Size);
>
> Sorry, need also multiply with byte size in bits. BTW, how to get it?
>
>> function To_C_Internal is
>> new Ada.Unchecked_Conversion (Source => Enum_Type, Target =>
>> Small);
>>
>> function From_C_Internal is
>> new Ada.Unchecked_Conversion (Source => Small, Target =>
>> Enum_Type);
>>
>> function To_C(Argument: Enum_Type) return Interfaces.C.int is
>> begin
>> return Interfaces.C.int(To_C_Internal(Argument));
>> end;
>>
>> function From_C(Argument: Interfaces.C.int) return Enum_Type is
>> begin
>> return From_C_Internal(Small(Argument));
>> end;
>>
>> end;
>>
>> end RDF.Auxilary;
>>
>> gnatmake -q -c -gnatc -u -P/home/porton/Projects/redland-
>> bindings/ada/test.gpr -XRUNTIME=full -XMODE=Install rdf-auxilary.adb
>> rdf-auxilary.adb:7:25: non-static expression used for modular type bound
>> rdf-auxilary.adb:7:38: size attribute is only static for static scalar
>> type (RM 4.9(7,8))
>> gnatmake:
>> "/home/porton/Projects/redland-bindings/ada/src/rdf-auxilary.adb"
>> compilation error
I think this can be made manually (without generics) (explicitly declaring a
`Small` type for every enumeration in question), but I better do it with
'Size hack, not spending time on manually programming what should be doable
with generics.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: 'Size hack for enumerated types
2014-07-05 22:18 3% ` Victor Porton
@ 2014-07-05 22:23 0% ` Victor Porton
2014-07-06 16:25 0% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2014-07-05 22:23 UTC (permalink / raw)
Victor Porton wrote:
> I tried to implement it in a memory savvy way. But GNAT does not compile
> it. It would be good if a future version of Ada supported it.
>
> -- rds.ads
> package RDF is
> end RDF;
>
> -- rdf-auxilary.ads
> with Interfaces.C;
>
> package RDF.Auxilary is
>
> generic
> type Enum_Type is range <>;
> package Convert_Enum is
> function To_C(Argument: Enum_Type) return Interfaces.C.int;
> function From_C(Argument: Interfaces.C.int) return Enum_Type;
> end;
>
> end RDF.Auxilary;
>
> -- rdf-auxilary.adb
> with Ada.Unchecked_Conversion;
>
> package body RDF.Auxilary is
>
> package body Convert_Enum is
>
> type Small is mod 2**(Enum_Type'Size);
Sorry, need also multiply with byte size in bits. BTW, how to get it?
> function To_C_Internal is
> new Ada.Unchecked_Conversion (Source => Enum_Type, Target =>
> Small);
>
> function From_C_Internal is
> new Ada.Unchecked_Conversion (Source => Small, Target =>
> Enum_Type);
>
> function To_C(Argument: Enum_Type) return Interfaces.C.int is
> begin
> return Interfaces.C.int(To_C_Internal(Argument));
> end;
>
> function From_C(Argument: Interfaces.C.int) return Enum_Type is
> begin
> return From_C_Internal(Small(Argument));
> end;
>
> end;
>
> end RDF.Auxilary;
>
> gnatmake -q -c -gnatc -u -P/home/porton/Projects/redland-
> bindings/ada/test.gpr -XRUNTIME=full -XMODE=Install rdf-auxilary.adb
> rdf-auxilary.adb:7:25: non-static expression used for modular type bound
> rdf-auxilary.adb:7:38: size attribute is only static for static scalar
> type (RM 4.9(7,8))
> gnatmake:
> "/home/porton/Projects/redland-bindings/ada/src/rdf-auxilary.adb"
> compilation error
>
>
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: 'Size hack for enumerated types
@ 2014-07-05 22:18 3% ` Victor Porton
2014-07-05 22:23 0% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2014-07-05 22:18 UTC (permalink / raw)
I tried to implement it in a memory savvy way. But GNAT does not compile it.
It would be good if a future version of Ada supported it.
-- rds.ads
package RDF is
end RDF;
-- rdf-auxilary.ads
with Interfaces.C;
package RDF.Auxilary is
generic
type Enum_Type is range <>;
package Convert_Enum is
function To_C(Argument: Enum_Type) return Interfaces.C.int;
function From_C(Argument: Interfaces.C.int) return Enum_Type;
end;
end RDF.Auxilary;
-- rdf-auxilary.adb
with Ada.Unchecked_Conversion;
package body RDF.Auxilary is
package body Convert_Enum is
type Small is mod 2**(Enum_Type'Size);
function To_C_Internal is
new Ada.Unchecked_Conversion (Source => Enum_Type, Target => Small);
function From_C_Internal is
new Ada.Unchecked_Conversion (Source => Small, Target => Enum_Type);
function To_C(Argument: Enum_Type) return Interfaces.C.int is
begin
return Interfaces.C.int(To_C_Internal(Argument));
end;
function From_C(Argument: Interfaces.C.int) return Enum_Type is
begin
return From_C_Internal(Small(Argument));
end;
end;
end RDF.Auxilary;
gnatmake -q -c -gnatc -u -P/home/porton/Projects/redland-
bindings/ada/test.gpr -XRUNTIME=full -XMODE=Install rdf-auxilary.adb
rdf-auxilary.adb:7:25: non-static expression used for modular type bound
rdf-auxilary.adb:7:38: size attribute is only static for static scalar type
(RM 4.9(7,8))
gnatmake: "/home/porton/Projects/redland-bindings/ada/src/rdf-auxilary.adb"
compilation error
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: GNAT 4.8 atomic access to 64-bit objects
2013-11-16 10:08 0% ` Georg Bauhaus
@ 2013-11-16 12:02 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2013-11-16 12:02 UTC (permalink / raw)
On Sat, 16 Nov 2013 11:08:00 +0100, Georg Bauhaus wrote:
> On 15.11.13 22:33, Dmitry A. Kazakov wrote:
>
>> Try this:
>>
>> with Interfaces;
>> with Ada.Unchecked_Conversion;
>> with Ada.Text_IO;
>>
>> procedure Test is
>> type T is mod 2**64;
>> type Atomic_T is new Interfaces.IEEE_Float_64;
>> ...
>> end Test;
>>
>> The code generated looks horrific.
>
> Maybe according to
> http://stackoverflow.com/questions/15843159/are-32-bit-software-builds-typically-64-bit-optimized
> simply wanting movq is not "mode compatible"; however,
> if there are MMX registers in the CPU you are targetting,
> the following may be a valid way to get movq nevertheless,
> albeit using a 64 bit signedinteger.
> The program was translated in 32 bit GNU/Linux, using GNAT GPL 2012.
> It uses compiler intrinsics in ways adapted from GNAT.SSE.
>
> with Ada.Text_IO;
> with GNAT.SSE;
>
> procedure Atoms is
> use GNAT.SSE;
>
> type m64 is array (0 .. 0) of Integer64;
> for m64'Alignment use 8;
> pragma Machine_Attribute (m64, "vector_type");
> pragma Machine_Attribute (m64, "may_alias");
>
> function ia32_psllq (Left : m64; Right : m64) return m64;
> pragma Import (Intrinsic, ia32_psllq, "__builtin_ia32_psllq");
>
> X : Integer64;
> F : m64;
> for X'Address use F'Address;
> begin
> X := 123;
> F := ia32_psllq (F, m64'(0 => 1));
> Ada.Text_IO.Put_Line (Integer64'Image (X)); -- 246
> end Atoms;
With the -mmmx switch, it indeed uses movq in order to load the register.
In the test example I wrote, atomic load becomes;
movq
psllq
movq to another location (through Unchecked_Conversion)
Atomic store is the reverse.
Surprisingly (at least to me), this is about ten times faster than using
the floating point trick. I.e.
Load + Increment + Store
using psllq needs 16ns, using IEEE 64 it does 168ns, on i7-2700K 3.5GHz
It would be nice to get rid of psllq, which is a waste.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: GNAT 4.8 atomic access to 64-bit objects
2013-11-15 21:33 3% ` Dmitry A. Kazakov
@ 2013-11-16 10:08 0% ` Georg Bauhaus
2013-11-16 12:02 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Georg Bauhaus @ 2013-11-16 10:08 UTC (permalink / raw)
On 15.11.13 22:33, Dmitry A. Kazakov wrote:
> Try this:
>
> with Interfaces;
> with Ada.Unchecked_Conversion;
> with Ada.Text_IO;
>
> procedure Test is
> type T is mod 2**64;
> type Atomic_T is new Interfaces.IEEE_Float_64;
> ...
> end Test;
>
> The code generated looks horrific.
>
Maybe according to
http://stackoverflow.com/questions/15843159/are-32-bit-software-builds-typically-64-bit-optimized
simply wanting movq is not "mode compatible"; however,
if there are MMX registers in the CPU you are targetting,
the following may be a valid way to get movq nevertheless,
albeit using a 64 bit signedinteger.
The program was translated in 32 bit GNU/Linux, using GNAT GPL 2012.
It uses compiler intrinsics in ways adapted from GNAT.SSE.
with Ada.Text_IO;
with GNAT.SSE;
procedure Atoms is
use GNAT.SSE;
type m64 is array (0 .. 0) of Integer64;
for m64'Alignment use 8;
pragma Machine_Attribute (m64, "vector_type");
pragma Machine_Attribute (m64, "may_alias");
function ia32_psllq (Left : m64; Right : m64) return m64;
pragma Import (Intrinsic, ia32_psllq, "__builtin_ia32_psllq");
X : Integer64;
F : m64;
for X'Address use F'Address;
begin
X := 123;
F := ia32_psllq (F, m64'(0 => 1));
Ada.Text_IO.Put_Line (Integer64'Image (X)); -- 246
end Atoms;
^ permalink raw reply [relevance 0%]
* Re: GNAT 4.8 atomic access to 64-bit objects
@ 2013-11-15 21:33 3% ` Dmitry A. Kazakov
2013-11-16 10:08 0% ` Georg Bauhaus
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2013-11-15 21:33 UTC (permalink / raw)
On Fri, 15 Nov 2013 20:25:28 +0100, Georg Bauhaus wrote:
> On 15.11.13 09:44, Dmitry A. Kazakov wrote:
>> On Thu, 14 Nov 2013 21:34:26 +0100, Ludovic Brenta wrote:
>
>>> I'd suggest you use 64-bit floating-point registers instead; i386
>>> processors have them, I think. That has been a useful trick for a
>>> decade or so :)
>>
>> Using unchecked union or unchecked conversion?
>
> FTR, a different 32 bit implementation (Ada 95) does not support a binary
> modulus of 64, and also, while Unchecked_Conversion passes the value 42
> from an integer register to a FPT register and back as 42, idly trying
> type Fake is new Long_Float;
> pragma Atomic (Fake);
> gives
> LRM:C.6(10), Indivisible read/update not supported for given subtype, pragma Atomic ignored
Try this:
with Interfaces;
with Ada.Unchecked_Conversion;
with Ada.Text_IO;
procedure Test is
type T is mod 2**64;
type Atomic_T is new Interfaces.IEEE_Float_64;
function Load is new Ada.Unchecked_Conversion (Atomic_T, T);
function Store is new Ada.Unchecked_Conversion (T, Atomic_T);
X : Atomic_T;
pragma Atomic (X);
begin
X := Store (123);
Ada.Text_IO.Put_Line (T'Image (Load (X)));
X := Store (Load (X) + 1);
Ada.Text_IO.Put_Line (T'Image (Load (X)));
end Test;
The code generated looks horrific.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: GNAT Allocation of a very large record
2013-08-14 3:50 2% GNAT Allocation of a very large record hyunghwan.chung
@ 2013-08-14 19:32 0% ` Per Sandberg
0 siblings, 0 replies; 200+ results
From: Per Sandberg @ 2013-08-14 19:32 UTC (permalink / raw)
Tried 4 different GCC:s and one failed:
gcc 4.4.7 20120313 (Red Hat 4.4.7-3) (GCC) x86 ok
gcc 4.6.3 20120306 (Red Hat 4.6.3-2) (GCC) x86_64 ok
gcc 4.7.3 20130318 for GNAT Pro 7.2.0w (20130317) (GCC) x86_64 ok
gcc 4.4.5 (Debian 4.4.5-8) arm (raspberry-pi) fail
It seems as there is a bug in your particular instance of GCC as well
as the GCC for the pi.
/Per
On Tue, 13 Aug 2013 20:50:21 -0700 (PDT)
hyunghwan.chung@gmail.com wrote:
> Hi,
>
> The program at the bottom of this message, when compiled with GNAT
> 4.6 on Ubuntu12/x86_64, seems to corrupt memory, ending up with a
> malloc error message.
>
> $ ./x1
> 1. Kind: POINTER_OBJECT Size: 10
> x1: malloc.c:2451: sYSMALLOc: Assertion `(old_top == (((mbinptr)
> (((char *) &((av)->bins[((1) - 1) * 2])) - __builtin_offsetof (struct
> malloc_chunk, fd)))) && old_size == 0) || ((unsigned long) (old_size)
> >= (unsigned long)((((__builtin_offsetof (struct malloc_chunk,
> >fd_nextsize))+((2 * (sizeof(size_t))) - 1)) & ~((2 *
> >(sizeof(size_t))) - 1))) && ((old_top)->size & 0x1) && ((unsigned
> >long)old_end & pagemask) == 0)' failed. ^C
>
> On some other platforms (i.e. debian/armv5tel, gcc/gnat 4.4.5), just
> segmentation fault.
>
> I expect an output like this, meaning that the second call to 'new'
> should raise an exception like storage_error.
>
> $ ./x1
> 1. Kind: POINTER_OBJECT Size: 10
> 2. Allocation Failed
>
> You'd get the result like above if you changed the upper bound of the
> range of Pointer_Obje
ct_Size from Storage_Count'Last to
> (OBJECT_DATA_BYTES / (Object_Pointer'Max_Size_In_Storage_Elements *
> System.Storage_Unit)).
>
> The new upper bound has been defined so that
> Pointer_Object_Record'Size don't exceed 2 ** 63 - 1 (System.Max_Int).
> On an 32-bit platform, the upper bound seems to be able to reach
> OBJECT_DATA_BYTES / Object_Pointer'Max_Size_In_Storage_Elements. With
> this upper bound on the 32-bit platform, Pointer_Object_Record'Size
> may go beyond 2 ^ 31 - 1 but
> Pointer_Object_Record'Max_Size_In_Storage_Elements falls below 2 ^ 31
> - 1.
>
> Anyway, when the upper bound is set to Storage_Count'Last,
> Pointer_Object_Record'Max_Size_In_Storage_Elements and
> Pointer_Object_Record'Size seem to wrap around to an undesired value
>
> The problem is that neither Constraint_Error nor Storage_Error is
> raised when the size of a record is very large. I'd like to have a
> graceful way to catch a ridiculously large size given to the function
> and handle the exception properly without ending up with segmentation
> fault or something similar.
>
> Is it a bug of the GNU Ada compiler or am i doing anything wrong?
>
> Thanks,
> Hyung-Hwan
>
> -------------------------------------------------------------------------------
> with Ada.Text_IO;
> with System;
> with Ada.Unchecked_Conversion;
>
> procedure X1 is
>
> type Storage_Element is mod 2 ** System.Storage_Unit;
> for Storage_Element'Size use System.Storage_Unit;
> type Storage_Offset is range -(2 ** (System.Word_Size -
> 1)) .. +(2 ** (System.Word_Size - 1)) - 1; subtype Storage_Count is
> Storage_Offset range 0 .. Storage_Offset'Last;
>
> subtype Object_Byte is Storage_Element;
> subtype Object_Character is Wide_Character;
> subtype Object_String is Wide_String;
>
> type Object_Kind is (Pointer_Object, Character_Object,
> Byte_Object); for Object_Kind use (Pointer_Object => 0,
> Character_Object => 1, Byte_Object => 2);
>
> type Object_Record;
> type Object_Pointer is access all Object_Record;
>
> type Byte_Array is array (Storage_Count range <>) of
> Object_Byte; type Character_Array is array (Storage_Count range <>)
> of Object_Character; type Pointer_Array is array (Storage_Count range
> <>) of Object_Pointer;
>
> type Object_Record (Kind: Object_Kind; Size: Storage_Count)
> is record Flags: Standard.Integer range 0 .. 3;-- := 0;
> Extra: Standard.Integer range 0 .. 1;-- := 0;
> Unit: Standard.Integer range 0 .. 4;-- := 0;
> Class: Object_Pointer;-- := null;
>
> case Kind is
> when Pointer_Object =>
> Pointer_Slot: Pointer_Array (1 ..
> Size);-- := (Others => null); when Character_Object =>
> Character_Slot: Character_Array (0 ..
> Size);-- := (Others => Object_Character'Val(0)); when Byte_Object =>
> Byte_Slot: Byte_Array (1 ..
> Size);-- := (Others => 0); end case;
> end record;
> for Object_Record use record
> Kind at 0 range 0 .. 7;
> Flags at 1 range 0 .. 2;
> Extra at 1 range 3 .. 3;
> Unit at 1 range 4 .. 7;
> end record;
>
> subtype Empty_Object_Record is Object_Record (Byte_Object, 0);
> -- the number of bytes in an object header. this is fixed in
> size OBJECT_HEADER_BYTES: constant Storage_Count :=
> Empty_Object_Record'Max_Size_In_Storage_Elements; -- the largest
> number of bytes that an object can hold after the header
> OBJECT_DATA_BYTES: constant Storage_Count := Storage_Count'Last -
> OBJECT_HEADER_BYTES;
>
> subtype Pointer_Object_Size is Storage_Count range
> Storage_Count'First .. (OBJECT_DATA_BYTES /
> (Object_Pointer'Max_Size_In_Storage_Elements * System.Storage_Unit));
> -- Storage_Count'First .. Storage_Count'Last;
>
> procedure Alloc_Pointer_Object (Size: in Pointer_Object_Size;
> Result: out Object_Pointer) is subtype Pointer_Object_Record is
> Object_Record (Pointer_Object, Size); type Pointer_Object_Pointer is
> access Pointer_Object_Record; function To_Object_Pointer is new
> Ada.Unchecked_Conversion (Pointer_Object_Pointer, Object_Pointer);
> Ptr: Pointer_Object_Pointer; begin
> --Ada.Text_IO.Put_Line
> (Pointer_Object_Record'Size'Img); --Ada.Text_IO.Put_Line
> (Pointer_Object_Record'Max_Size_In_Storage_Elements'Img); Ptr := new
> Pointer_Object_Record'( Kind => Pointer_Object,
> Size => Size,
> Flags => 0,
> Extra => 0,
> Unit => 0,
> Class => null,
> Pointer_Slot => (others=>null)
> );
>
> Result := To_Object_Pointer (Ptr);
> exception
> when others =>
> Result := null;
> end Alloc_Pointer_Object;
>
>
> ObjPtr: Object_Pointer;
> begin
>
> Alloc_Pointer_Object (10, ObjPtr);
> if ObjPtr = null then
> Ada.Text_IO.Put_Line ("1. Allocation Failed");
> else
> Ada.Text_IO.Put_Line ("1. Kind: " &
> Object_Kind'Image(ObjPtr.Kind) & " Size: " &
> Storage_Count'Image(ObjPtr.Size)); end if;
>
> Alloc_Pointer_Object (Pointer_Object_Size'Last, ObjPtr);
> if ObjPtr = null then
> Ada.Text_IO.Put_Line ("2. Allocation Failed");
> else
> Ada.Text_IO.Put_Line ("2. Kind: " &
> Object_Kind'Image(ObjPtr.Kind) & " Size: " &
> Storage_Count'Image(ObjPtr.Size)); end if;
>
> end X1;
^ permalink raw reply [relevance 0%]
* GNAT Allocation of a very large record
@ 2013-08-14 3:50 2% hyunghwan.chung
2013-08-14 19:32 0% ` Per Sandberg
0 siblings, 1 reply; 200+ results
From: hyunghwan.chung @ 2013-08-14 3:50 UTC (permalink / raw)
Hi,
The program at the bottom of this message, when compiled with GNAT 4.6 on Ubuntu12/x86_64, seems to corrupt memory, ending up with a malloc error message.
$ ./x1
1. Kind: POINTER_OBJECT Size: 10
x1: malloc.c:2451: sYSMALLOc: Assertion `(old_top == (((mbinptr) (((char *) &((av)->bins[((1) - 1) * 2])) - __builtin_offsetof (struct malloc_chunk, fd)))) && old_size == 0) || ((unsigned long) (old_size) >= (unsigned long)((((__builtin_offsetof (struct malloc_chunk, fd_nextsize))+((2 * (sizeof(size_t))) - 1)) & ~((2 * (sizeof(size_t))) - 1))) && ((old_top)->size & 0x1) && ((unsigned long)old_end & pagemask) == 0)' failed.
^C
On some other platforms (i.e. debian/armv5tel, gcc/gnat 4.4.5), just segmentation fault.
I expect an output like this, meaning that the second call to 'new' should raise an exception like storage_error.
$ ./x1
1. Kind: POINTER_OBJECT Size: 10
2. Allocation Failed
You'd get the result like above if you changed the upper bound of the range of Pointer_Object_Size from Storage_Count'Last to (OBJECT_DATA_BYTES / (Object_Pointer'Max_Size_In_Storage_Elements * System.Storage_Unit)).
The new upper bound has been defined so that Pointer_Object_Record'Size don't exceed 2 ** 63 - 1 (System.Max_Int). On an 32-bit platform, the upper bound seems to be able to reach OBJECT_DATA_BYTES / Object_Pointer'Max_Size_In_Storage_Elements. With this upper bound on the 32-bit platform, Pointer_Object_Record'Size may go beyond 2 ^ 31 - 1 but Pointer_Object_Record'Max_Size_In_Storage_Elements falls below 2 ^ 31 - 1.
Anyway, when the upper bound is set to Storage_Count'Last, Pointer_Object_Record'Max_Size_In_Storage_Elements and Pointer_Object_Record'Size seem to wrap around to an undesired value
The problem is that neither Constraint_Error nor Storage_Error is raised when the size of a record is very large. I'd like to have a graceful way to catch a ridiculously large size given to the function and handle the exception properly without ending up with segmentation fault or something similar.
Is it a bug of the GNU Ada compiler or am i doing anything wrong?
Thanks,
Hyung-Hwan
-------------------------------------------------------------------------------
with Ada.Text_IO;
with System;
with Ada.Unchecked_Conversion;
procedure X1 is
type Storage_Element is mod 2 ** System.Storage_Unit;
for Storage_Element'Size use System.Storage_Unit;
type Storage_Offset is range -(2 ** (System.Word_Size - 1)) .. +(2 ** (System.Word_Size - 1)) - 1;
subtype Storage_Count is Storage_Offset range 0 .. Storage_Offset'Last;
subtype Object_Byte is Storage_Element;
subtype Object_Character is Wide_Character;
subtype Object_String is Wide_String;
type Object_Kind is (Pointer_Object, Character_Object, Byte_Object);
for Object_Kind use (Pointer_Object => 0, Character_Object => 1, Byte_Object => 2);
type Object_Record;
type Object_Pointer is access all Object_Record;
type Byte_Array is array (Storage_Count range <>) of Object_Byte;
type Character_Array is array (Storage_Count range <>) of Object_Character;
type Pointer_Array is array (Storage_Count range <>) of Object_Pointer;
type Object_Record (Kind: Object_Kind; Size: Storage_Count) is record
Flags: Standard.Integer range 0 .. 3;-- := 0;
Extra: Standard.Integer range 0 .. 1;-- := 0;
Unit: Standard.Integer range 0 .. 4;-- := 0;
Class: Object_Pointer;-- := null;
case Kind is
when Pointer_Object =>
Pointer_Slot: Pointer_Array (1 .. Size);-- := (Others => null);
when Character_Object =>
Character_Slot: Character_Array (0 .. Size);-- := (Others => Object_Character'Val(0));
when Byte_Object =>
Byte_Slot: Byte_Array (1 .. Size);-- := (Others => 0);
end case;
end record;
for Object_Record use record
Kind at 0 range 0 .. 7;
Flags at 1 range 0 .. 2;
Extra at 1 range 3 .. 3;
Unit at 1 range 4 .. 7;
end record;
subtype Empty_Object_Record is Object_Record (Byte_Object, 0);
-- the number of bytes in an object header. this is fixed in size
OBJECT_HEADER_BYTES: constant Storage_Count := Empty_Object_Record'Max_Size_In_Storage_Elements;
-- the largest number of bytes that an object can hold after the header
OBJECT_DATA_BYTES: constant Storage_Count := Storage_Count'Last - OBJECT_HEADER_BYTES;
subtype Pointer_Object_Size is Storage_Count range
Storage_Count'First .. (OBJECT_DATA_BYTES / (Object_Pointer'Max_Size_In_Storage_Elements * System.Storage_Unit));
-- Storage_Count'First .. Storage_Count'Last;
procedure Alloc_Pointer_Object (Size: in Pointer_Object_Size; Result: out Object_Pointer) is
subtype Pointer_Object_Record is Object_Record (Pointer_Object, Size);
type Pointer_Object_Pointer is access Pointer_Object_Record;
function To_Object_Pointer is new Ada.Unchecked_Conversion (Pointer_Object_Pointer, Object_Pointer);
Ptr: Pointer_Object_Pointer;
begin
--Ada.Text_IO.Put_Line (Pointer_Object_Record'Size'Img);
--Ada.Text_IO.Put_Line (Pointer_Object_Record'Max_Size_In_Storage_Elements'Img);
Ptr := new Pointer_Object_Record'(
Kind => Pointer_Object,
Size => Size,
Flags => 0,
Extra => 0,
Unit => 0,
Class => null,
Pointer_Slot => (others=>null)
);
Result := To_Object_Pointer (Ptr);
exception
when others =>
Result := null;
end Alloc_Pointer_Object;
ObjPtr: Object_Pointer;
begin
Alloc_Pointer_Object (10, ObjPtr);
if ObjPtr = null then
Ada.Text_IO.Put_Line ("1. Allocation Failed");
else
Ada.Text_IO.Put_Line ("1. Kind: " & Object_Kind'Image(ObjPtr.Kind) & " Size: " & Storage_Count'Image(ObjPtr.Size));
end if;
Alloc_Pointer_Object (Pointer_Object_Size'Last, ObjPtr);
if ObjPtr = null then
Ada.Text_IO.Put_Line ("2. Allocation Failed");
else
Ada.Text_IO.Put_Line ("2. Kind: " & Object_Kind'Image(ObjPtr.Kind) & " Size: " & Storage_Count'Image(ObjPtr.Size));
end if;
end X1;
^ permalink raw reply [relevance 2%]
* Generic access type convention and aliasing
@ 2013-05-06 0:20 1% Yannick Duchêne (Hibou57)
0 siblings, 0 replies; 200+ results
From: Yannick Duchêne (Hibou57) @ 2013-05-06 0:20 UTC (permalink / raw)
Hi people,
Things are working as expected, but I still wonder and welcome other's
feeling on the topic.
I have a generic memory allocator, which is instantiated with a
constrained object type (objects of an average size ranging from 10 to 20
KB) and an access type to that object type. The object type is typically
an array type with fixed bounds (statically known constraints).
generic
Element_Type is private;
Element_Access is access Element_Type;
package Allocators
…
end;
In the generic declaration, I'm not allowed to express the requirement on
the access type to use the C convention.
Element_Access is access Element_Type
with Convention => C;
-- Not allowed: generic types can't specify
-- a representation clause.
An allocator returns the allocation result in a discriminated record
looking like this:
type Result_Type (Allocated : Boolean := False) is
record
case Allocated is
when False =>
null;
when True =>
Element : Element_Access
with Convention => C;
end case;
end record;
I'm not allowed to add a representation requirement to the generic access
parameter type, but GNAT let me specify the C convention for a variable
(*) of that type in the record type.
I don't want the variable in the record to be simply of type
`Element_Access` as‑is, and so even if the type is fully constrained and
there is no unavoidable technical needs for storing any constraint data at
the address designated by the access variable; I prefer it to be explicit,
so the `Convention => C`.
Do you believe it's enough to be safe? Is it enough for preventing any
compiler to believe there may be constraints data stored at the address
designated by the access type, and so even if the generic parameter does
not enforce it?
Or should I also give the C convention to each access types used to
instantiate this generic? That's an option, but I don't like it: there is
no way to enforce it, so it is not safe to me; too much easy to forget
without any way to make the compiler flag it.
(*) A variable which I would enjoy to force to be a constant after record
initialization, but I can't; another story.
The second question I optionally wonder about. I initially created the
access variable value using `Ada.Unchecked_Conversion` applied to a
numeric type (as indeed, the result I retrieve is numeric, because it may
be an error status instead of an address, depending on the range the
result belongs to). But GNAT did not enjoyed this and complained the
resulting access type returned by the unchecked conversion, may present
aliasing problem. The memory is allocated with `mmap` using `MAP_PRIVATE`,
so there is no risk of aliasing (except in case of nasty OS failure), but
I could not make GNAT understand it (*). I worked around it using a
two‑instructions assembly procedure to do the conversion from the numeric
type to the access type (to an access variable with convention C). I don't
really expect there exist a way to tell GNAT the access does not present
aliasing issues, but still worth to ask for it if ever on the contrary
there exist a way to tell it.
(*) It just stop complaining if I added `pragma No_Strict_Aliasing
(Element_Access)`, but that's not a way to tell it there is no risk of
aliasing with that access type: the contrary.
--
“Syntactic sugar causes cancer of the semi-colons.” [1]
“Structured Programming supports the law of the excluded muddle.” [1]
[1]: Epigrams on Programming — Alan J. — P. Yale University
^ permalink raw reply [relevance 1%]
* Re: GNAT not generating any code for sub‑program: known bug?
@ 2013-04-28 7:14 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2013-04-28 7:14 UTC (permalink / raw)
"Yannick Duchêne (Hibou57)" <yannick_duchene@yahoo.fr> writes:
> Here is:
> http://www.les-ziboux.rasama.org/download/2013-04-28-cla-gnat-bug.zip
The code is
function Syscall
(Number : Positive;
Handle : Natural;
Address : System.Address;
Size : Natural)
return Integer
is
Result : Integer;
begin
System.Machine_Code.Asm
(Template => "int $0x80",
Outputs => Integer'Asm_Output ("=a", Result),
Inputs =>
(Positive'Asm_Input ("a", Number),
Natural'Asm_Input ("b", Handle),
System.Address'Asm_Input ("c", Address),
Natural'Asm_Input ("d", Size)),
Volatile => False);
return Result;
end;
and I think that the problem is that Template actually has to use the
inputs and outputs! So, while optimising, the compiler says
"int $0x80" doesn't use any of the inputs, so I can ignore them
"int $0x80" doesn't write to any of the outputs, so I can ignore them
Result isn't changed, so it's undefined
Therefore I don't need to do anything.
The assembler generated by GNAT GPL 2012 is different but equally
ineffective:
.globl _library__write
_library__write:
LFB3:
pushq %rbp
LCFI0:
movq %rsp, %rbp
LCFI1:
leave
LCFI2:
ret
LFE3:
I think that you have to write the template to show how the parameters
are set up and returned. Here's one I wrote earlier:
with Ada.Unchecked_Conversion;
with System.Machine_Code;
separate (BC.Support.High_Resolution_Time)
function Clock return Time is
type Half is (Low, High);
type Low_High is array (Half) of Interfaces.Unsigned_32;
Lower, Upper : Interfaces.Unsigned_32;
function To_Time is new Ada.Unchecked_Conversion (Low_High, Time);
begin
System.Machine_Code.Asm
("rdtsc" & ASCII.LF & ASCII.HT &
"movl %%eax, %0"& ASCII.LF & ASCII.HT &
"movl %%edx, %1",
Outputs => (Interfaces.Unsigned_32'Asm_Output ("=g", Lower),
Interfaces.Unsigned_32'Asm_Output ("=g", Upper)),
Clobber => "eax, edx",
Volatile => True);
return To_Time ((Low => Lower, High => Upper));
end Clock;
By the way, this doesn't actually work as intended on kit such as the
Macbook Pro (more than one core? advanced power management?), presumably
because the core's clock is slowed down or stopped. Fortunately,
Ada.Calendar.Clock's resolution is 1 microsecond, good enough for most
purposes.
^ permalink raw reply [relevance 2%]
* Re: Tasking troubles, unexpected termination.
@ 2012-10-31 2:17 1% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2012-10-31 2:17 UTC (permalink / raw)
Here's the updated code:
---- Scheduling.adb ------------------------------------------
with
Ada.Text_IO,
Ada.Calendar,
Ada.Containers.Indefinite_Vectors,
Ada.Task_Termination,
Ada.Task_Identification,
Task_Debugging;
Procedure Scheduling is
-- Introduce shorthand so convert Strings to access strings.
Function "+" (Item : String) Return Not Null Access String is
( New String'(Item) );
-- Forward declare the Notification type; indicate it has discriminants.
Type Notification(<>);
-- Declare Handle for Notifications.
Type Notification_Handle is Not Null Access Notification;
Type Notification( Message : Not Null Access String;
Expiry : Not Null Access Ada.Calendar.Time
) is null record;
-- Declare the Timing-task.
Task Type Timing ( Resolution : Not Null Access Duration ) is
Entry Add( Event : Notification_Handle );
end Timing;
-- Implementation for the timing-task.
Task body Timing is
-- Package for showing Duration.
Package Decimal_Display is new Ada.Text_IO.Fixed_IO( Duration );
-- Internal package, defining Vectors holding notification handles.
Package Notification_Vector is New Ada.Containers.Indefinite_Vectors
( Index_Type => Positive, Element_Type => Notification_Handle );
Use Notification_Vector;
-- Handle expired messages.
Procedure Handle_Expiration( List : in out Vector ) is
Use Ada.Calendar, Ada.Text_IO;
Length : Positive:= Positive(List.Length);
Now : Time:= Clock;
-- We flag everything to be deleted, as tampering with the cursor is
-- not good.
Type Deletion_Flags is Array(1..Length) of Boolean;
Deletion_Marks : Deletion_Flags:= (Others => False);
procedure Execute(Position : Cursor) is
Item : Constant Notification_Handle:= Element(position);
Index : Constant Positive:= Positive( To_Index(position) );
begin
Deletion_Marks(Index):= Now >= Item.Expiry.All;
--
Ada.Text_IO.Put( ASCII.HT & "Exipration: " );
Decimal_Display.Put( Item.Expiry.All - Now, Fore => 2, Aft => 3 );
Ada.Text_IO.New_Line;
end Execute;
begin
-- Iterate through the vector's elements; old-style iterator.
List.Reverse_Iterate( Process => Execute'Access );
-- Delete flagged elements; iteration bckwards to preserve indicies.
For Index in reverse Deletion_Marks'Range loop
if Deletion_Marks(Index) then
Put_Line( "Message: " & List(Index).Message.All);
List.Delete( Index );
end if;
end loop;
-- Render a report on the new length, if it was altered.
declare
Post_op_length : Natural:= Natural(List.Length);
begin
if Length /= post_op_length then
Put_Line( "Deleted items; New Length:" & post_op_length'Img);
end if;
end;
end Handle_Expiration;
-- Declare a Vector to hold all the nofifications.
Notification_List : Vector:= Empty_Vector;
Use Ada.Task_Termination, Task_Debugging, Ada.Containers, Ada.Calendar;
-- Mark the start-time.
Start : Time:= Clock;
-- Function Elapsed Return String is
-- ( Duration'Image(Clock - Start)(1..7) );
Function Elapsed Return Duration is
( Clock - Start );
begin
-- Set our debugging-handler for this task.
Ada.Task_Termination.Set_Specific_Handler(
T => Ada.Task_Identification.Current_Task,
Handler => Debug.Termination'Access );
-- When there are no items in our internal vector, then we need can only
-- accept Add or terminate the task.
-- When we add an item, then we can either add another item or when the
-- time expires iterate the vector and handling Notifications as needed.
loop
select
accept Add( Event : Notification_Handle ) do
Notification_List.Append( Event );
end add;
while not Notification_List.Is_Empty loop
Ada.Text_IO.Put( "Elapsed:" );
Decimal_Display.Put( Elapsed, Fore => 2, Aft => 3 );
Ada.Text_IO.New_Line;
Handle_Expiration( List => Notification_List );
select
accept Add( Event : Notification_Handle ) do
Notification_List.Append( Event );
Ada.Text_IO.Put_Line( "New Length: " & Notification_List.Length'Img );
Ada.Text_IO.Put( ASCII.HT & "Exipration: " );
Decimal_Display.Put( Event.Expiry.All - Clock, Fore => 2, Aft => 3 );
Ada.Text_IO.New_Line;
end add;
or
delay Timing.Resolution.All;
end select;
end loop;
Ada.Text_IO.Put_Line( "EMPTY." );
or
terminate;
end select;
end loop;
end Timing;
K : Timing( Resolution => New Duration'(2.0) ); -- 2 second resolution.
Now : Ada.Calendar.Time:= Ada.Calendar.Clock;
begin
For Index in 1..10 loop
declare
Use Ada.Calendar;
Item : Notification(
Message => + ("DD"&Positive'Image(Index)),
-- Expire at Now and 3*Index seconds.
Expiry => New Time'( Now + Duration(Index) )
);
begin
K.Add( Event => New Notification'(Item) );
end;
end loop;
-- Add an element in the past... it should immediately be operated on.
K.Add( Event => New Notification'(
Message => + ("Last."),
Expiry => New Ada.Calendar.Time'( Now )
)
);
end Scheduling;
---- Task_Debugging.ads ----------------------------------------------
-- The following are not strictly nessacary, but used in this example for
-- debugging purposes.
With
System.Address_To_Access_Conversions,
Ada.Unchecked_Conversion,
Ada.Exceptions.Traceback,
Ada.Task_Identification,
Ada.Task_Termination;
Package Task_Debugging is
Pragma Elaborate_Body;
Protected Type Debugging is
-- Termination debugging function.
procedure Termination(
Cause : Ada.Task_Termination.Cause_Of_Termination;
T : Ada.Task_Identification.Task_Id;
X : Ada.Exceptions.Exception_Occurrence);
End Debugging;
-- Debug, an instance of our debugging object.
Debug : Debugging;
End Task_Debugging;
---- Task_Debugging.adb ----------------------------------------------
With Ada.Text_IO;
Package Body Task_Debugging is
Protected body Debugging is
-- Termination debugging function.
procedure Termination(
Cause : Ada.Task_Termination.Cause_Of_Termination;
T : Ada.Task_Identification.Task_Id;
X : Ada.Exceptions.Exception_Occurrence) is
Use Ada.Text_IO, Ada.Task_Termination, Ada.Exceptions;
begin
Put_Line("Termination: "& Cause'Img);
case Cause is
When Normal | Abnormal => Null;
When Unhandled_Exception =>
Put_Line( Exception_Name(X)&": "&Exception_Message(X) );
end case;
end Termination;
end Debugging;
End Task_Debugging;
---------------------------------------------------------------------------
I've fixed the original problems (first the "tampering", and second a constraint_error) but there's still something strange going on. The discriminants for notifications seem to be being ignored (or rather the latest one being used).
Here's the output:
C:\Programming\Projects\Scheduler>scheduling.exe
Elapsed: 0.000
Exipration: 0.984
New Length: 2
Exipration: 1.983
Elapsed: 0.002
Exipration: 1.982
Exipration: 1.982
New Length: 3
Exipration: 2.981
Elapsed: 0.004
Exipration: 2.980
Exipration: 2.980
Exipration: 2.980
[...]
Message: Last.
Deleted items; New Length: 10
Elapsed: 2.047
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Exipration: 7.938
Elapsed: 4.051
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Exipration: 5.933
Elapsed: 6.061
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Exipration: 3.923
Elapsed: 8.086
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Exipration: 1.898
Elapsed:10.106
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Exipration: -0.122
Message: DD 10
Message: DD 9
Message: DD 8
Message: DD 7
Message: DD 6
Message: DD 5
Message: DD 4
Message: DD 3
Message: DD 2
Message: DD 1
Deleted items; New Length: 0
EMPTY.
Termination: NORMAL
As you can see, instead of each element being different they're all tagged as having the same expiration.
^ permalink raw reply [relevance 1%]
* Re: ANN: AdaTutor on the Web - done
@ 2012-09-29 10:22 3% ` AdaMagica
0 siblings, 0 replies; 200+ results
From: AdaMagica @ 2012-09-29 10:22 UTC (permalink / raw)
This text in the tutorial about UC is nonsense:
<quote>
One use of Ada.Unchecked_Conversion might be to allow us to and two Integers. (Ada 95 allows us to and two objects of a modular type, but not two Integers.) Some Ada compilers come with a package that enables us to and two Integers, but many compilers have no such package. Suppose that types Integer and Boolean occupy the same amount of storage. If our program says with Ada.Unchecked_Conversion; we could write
function Int_To_Bool is new Ada.Unchecked_Conversion(Integer, Boolean);
function Bool_To_Int is new Ada.Unchecked_Conversion(Boolean, Integer);
function "and"(Left, Right : in Integer) return Integer is
begin
return Bool_To_Int(Int_To_Bool(Left) and Int_To_Bool(Right));
end "and";
</quote>
Integer and Boolean have never the same size. Boolean'Size = 1. "and" will pick either the MSB or the LSB of Left and Right, depending on compiler resp. hardware.
(Ada83 was a bit unclear about the meaning of 'Size, there are differences in the behaviour of compilers. Ada95 fixed that - in a way that some find awkward.)
UC between Integer and Natural might work or include a multiplication/division by 2 because Natural'Size=Integer'Size-1. I have been bitten by UC between objects of types with different sizes when porting some legacy Ada83 code to a different hardware and compiler. Be careful: Stand-along objects of subtype Natural and of Integer have of course the same size - what matters for UC is the subtype's size, which is given by 'Size - this is why GNAT has an attribute 'Object_Size.
^ permalink raw reply [relevance 3%]
* Re: Endianness and Record Specification
@ 2012-09-21 22:18 3% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2012-09-21 22:18 UTC (permalink / raw)
awdorrin <awdorrin@gmail.com> writes:
> At first I was thinking I could do:
>
> if Standard'Default_Bit_Order = 1 then
> -- defined Little endian rec spec
> else
> -- define Bit endian rec spec
> end if;
>
> But, the compiler doesn't let me do that... :-)
>
> I would think I should be able to somehow use the Default_Bit_Order to
> define some sort of relative byte position, depending on the system
> endianness, but I'm drawing a blank and hoping someone might have a
> quick example they could provide.
The way I've approached this is to declare an unrepresented type for the
main program to use, and then make a local, derived, represented type
inside a bit-order-dependent conditional.
Below, the type Local_Status is very local, but it works with a wider
scope, and may lead to improved performance by avoiding
packing/unpacking.
This assumes it's OK to have the conversion only at the edges of the
program.
Big_Endian : constant Boolean
:= System."=" (System.Default_Bit_Order, System.High_Order_First);
function To_Stream_Element (S : Status) return Ada.Streams.Stream_Element
is
type Local_Status is record
LI : Leap_Indicator;
VN : Version;
M : Mode;
end record;
V : constant Local_Status := (LI => S.LI, VN => S.VN, M => S.M);
begin
if Big_Endian then
declare
type Host_Status is new Local_Status;
for Host_Status use record
LI at 0 range 0 .. 1;
VN at 0 range 2 .. 4;
M at 0 range 5 .. 7;
end record;
for Host_Status'Size use 8;
function Convert
is new Ada.Unchecked_Conversion (Host_Status,
Ada.Streams.Stream_Element);
begin
return Convert (Host_Status (V));
end;
else
declare
type Host_Status is new Local_Status;
for Host_Status use record
LI at 0 range 6 .. 7;
VN at 0 range 3 .. 5;
M at 0 range 0 .. 2;
end record;
for Host_Status'Size use 8;
function Convert
is new Ada.Unchecked_Conversion (Host_Status,
Ada.Streams.Stream_Element);
begin
return Convert (Host_Status (V));
end;
end if;
end To_Stream_Element;
function To_Status (S : Ada.Streams.Stream_Element) return Status
is
begin
if Big_Endian then
declare
type Host_Status is record
LI : Leap_Indicator;
VN : Version;
M : Mode;
end record;
for Host_Status use record
LI at 0 range 0 .. 1;
VN at 0 range 2 .. 4;
M at 0 range 5 .. 7;
end record;
for Host_Status'Size use 8;
function Convert
is new Ada.Unchecked_Conversion (Ada.Streams.Stream_Element,
Host_Status);
V : constant Host_Status := Convert (S);
begin
return (LI => V.LI, VN => V.VN, M => V.M);
end;
else
declare
type Host_Status is record
LI : Leap_Indicator;
VN : Version;
M : Mode;
end record;
for Host_Status use record
LI at 0 range 6 .. 7;
VN at 0 range 3 .. 5;
M at 0 range 0 .. 2;
end record;
for Host_Status'Size use 8;
function Convert
is new Ada.Unchecked_Conversion (Ada.Streams.Stream_Element,
Host_Status);
V : constant Host_Status := Convert (S);
begin
return (LI => V.LI, VN => V.VN, M => V.M);
end;
end if;
end To_Status;
^ permalink raw reply [relevance 3%]
* Re: Ada.Locales pseudo-string types
@ 2012-08-07 5:57 3% ` Jeffrey R. Carter
2012-08-07 15:46 0% ` Adam Beneschan
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2012-08-07 5:57 UTC (permalink / raw)
This works:
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
procedure Weird_Output is
type Weird is array (Positive range 1 .. 3) of Character range 'A' .. 'Z';
subtype Weird_Image is String (1 .. 3);
function Image is new Ada.Unchecked_Conversion (Source => Weird, Target => Weird_Image);
C : constant Weird := "ABC";
begin -- Weird_Output
Ada.Text_IO.Put_Line (Item => Image (C) );
end Weird_Output;
^ permalink raw reply [relevance 3%]
* Re: Ada.Locales pseudo-string types
2012-08-07 5:57 3% ` Jeffrey R. Carter
@ 2012-08-07 15:46 0% ` Adam Beneschan
0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2012-08-07 15:46 UTC (permalink / raw)
On Monday, August 6, 2012 10:57:33 PM UTC-7, Jeffrey R. Carter wrote:
> This works:
>
> with Ada.Text_IO;
> with Ada.Unchecked_Conversion;
>
> procedure Weird_Output is
> type Weird is array (Positive range 1 .. 3) of Character range 'A' .. 'Z';
>
> subtype Weird_Image is String (1 .. 3);
>
> function Image is new Ada.Unchecked_Conversion (Source => Weird, Target => Weird_Image);
>
> C : constant Weird := "ABC";
> begin -- Weird_Output
> Ada.Text_IO.Put_Line (Item => Image (C) );
> end Weird_Output;
Blecch. Using Unchecked_Conversion seems like a good solution--if it's buried in the implementation of a To_String function in the body of Ada.Locales as I proposed. Making users use it is just icky.
-- Adam
^ permalink raw reply [relevance 0%]
* Re: GNAT (GCC) Profile Guided Compilation
2012-07-18 10:01 2% ` Georg Bauhaus
@ 2012-07-18 17:36 0% ` Keean Schupke
0 siblings, 0 replies; 200+ results
From: Keean Schupke @ 2012-07-18 17:36 UTC (permalink / raw)
On Wednesday, 18 July 2012 11:01:11 UTC+1, Georg Bauhaus wrote:
> On 15.07.12 10:27, Keean Schupke wrote:
> > function F(N : Node, V : Value) return Boolean is begin (
> > return (N.Enum = Const) or else ((N.Enum = V) = (N.Number = 0));
> > )
> >
> > B : constant Boolean = F(N1, V)
> > and then F(N2, V)
> > and then F(N3, V)
> > and then F(N4, V);
> >
>
> FWIW, I have two observations after playing with the above function:
>
> Using different ways of supplying the variables to F and to functions
> like it, two things seemed to have noticeable influence:
>
> 1) making the Node record limited (good)
> 2) supplying the values, not the record, to F (possibly good)
>
> The results have varied a lot with everything (CPU, compiler, switches, ...),
> and I haven't checked the indirections for correctness; in any case,
> plain F (record components) did well.
>
> with System;
> package News_23.Choice is
>
> function F (N : Node; V : Value) return Boolean;
> function FA (N : Node; V : Value) return Boolean;
> function FP1 (p : System.Address; V : Value) return Boolean;
> function FP2 (p : System.Address; V : Value) return Boolean;
> function FP3 (p : System.Address; V : Value) return Boolean;
> function F_3_Args (Enum : Value;
> Number : Numeric;
> V : Value) return Boolean;
> private
> Const : constant Value := Two;
> end News_23.choice;
>
> with System.Address_To_Access_Conversions, System.Storage_Elements;
> with Ada.Unchecked_Conversion;
> package body News_23.Choice is
>
> use System.Storage_Elements;
> Enum_Offset : constant := 4 * Storage_Element'Size;
> Number_Offset : constant := 8 * Storage_Element'Size;
>
> function F(N : Node; V : Value) return Boolean is begin
> return (N.Enum = Const) or else ((N.Enum = V) = (N.Number = 0));
> end;
>
> package Value_P is new System.Address_To_Access_Conversions
> (Object => Value);
> package Numeric_P is new System.Address_To_Access_Conversions
> (Object => Numeric);
>
> function FA(N : Node; V : Value) return Boolean is
> begin
> declare
> -- Enm : Value_P.Object_Pointer renames Value_P.To_Pointer (N'Address +
> N.Enum'Position);
> -- Num : Numeric_P.Object_Pointer renames Numeric_P.To_Pointer (N'Address +
> N.Number'Position);
> Enm : Value_P.Object_Pointer renames Value_P.To_Pointer (N'Address +
> Enum_Offset);
> Num : Numeric_P.Object_Pointer renames Numeric_P.To_Pointer (N'Address +
> Number_Offset);
> begin
> return (Enm.all = Const) or else ((Enm.all = V) = (Num.all = 0));
> end;
> end FA;
>
> function FP1 (P : System.Address; V : Value) return Boolean is
> Enm : Value;
> pragma Import (Ada, Enm);
> for Enm'Address use P + Enum_Offset;
> Num : Numeric;
> pragma Import (Ada, Num);
> for Num'Address use P + Number_Offset;
> begin
> pragma Inspection_Point (P);
> return (Enm = Const) or else ((Enm = V) = (Num = 0));
> end FP1;
>
> function FP2 (P : System.Address; V : Value) return Boolean is
> Enm : Value;
> pragma Import (Ada, Enm);
> for Enm'Address use To_Address (To_Integer (P) + Enum_Offset);
> Num : Numeric;
> pragma Import (Ada, Num);
> for Num'Address use To_Address (To_Integer (P) + Number_Offset);
> begin
> pragma Inspection_Point (P);
> return (Enm = Const) or else ((Enm = V) = (Num = 0));
> end FP2;
>
> type Adr is mod 2**Standard'Address_Size;
> function To_N is new Ada.Unchecked_Conversion (System.Address, Adr);
> function To_Adr is new Ada.Unchecked_Conversion (Adr, System.Address);
>
> function FP3 (P : System.Address; V : Value) return Boolean is
> Enm : Value;
> pragma Import (Ada, Enm);
> for Enm'Address use To_Adr (To_N (P) + Enum_Offset);
> Num : Numeric;
> pragma Import (Ada, Num);
> for Num'Address use To_Adr (To_N (P) + Number_Offset);
> begin
> pragma Inspection_Point (P);
> return (Enm = Const) or else ((Enm = V) = (Num = 0));
> end FP3;
>
> function F_3_Args(Enum : Value; Number : Numeric ; V : Value) return
> Boolean is begin
> return (Enum = Const) or else ((Enum = V) = (Number = 0));
> end F_3_Args;
>
> end News_23.Choice;
I think if you use -O3 -gnatn (and pragma Inline(X)) the function will be inlined. Does it still make a difference then?
Cheers,
Keean.
^ permalink raw reply [relevance 0%]
* Re: GNAT (GCC) Profile Guided Compilation
@ 2012-07-18 10:01 2% ` Georg Bauhaus
2012-07-18 17:36 0% ` Keean Schupke
0 siblings, 1 reply; 200+ results
From: Georg Bauhaus @ 2012-07-18 10:01 UTC (permalink / raw)
On 15.07.12 10:27, Keean Schupke wrote:
> function F(N : Node, V : Value) return Boolean is begin (
> return (N.Enum = Const) or else ((N.Enum = V) = (N.Number = 0));
> )
>
> B : constant Boolean = F(N1, V)
> and then F(N2, V)
> and then F(N3, V)
> and then F(N4, V);
>
FWIW, I have two observations after playing with the above function:
Using different ways of supplying the variables to F and to functions
like it, two things seemed to have noticeable influence:
1) making the Node record limited (good)
2) supplying the values, not the record, to F (possibly good)
The results have varied a lot with everything (CPU, compiler, switches, ...),
and I haven't checked the indirections for correctness; in any case,
plain F (record components) did well.
with System;
package News_23.Choice is
function F (N : Node; V : Value) return Boolean;
function FA (N : Node; V : Value) return Boolean;
function FP1 (p : System.Address; V : Value) return Boolean;
function FP2 (p : System.Address; V : Value) return Boolean;
function FP3 (p : System.Address; V : Value) return Boolean;
function F_3_Args (Enum : Value;
Number : Numeric;
V : Value) return Boolean;
private
Const : constant Value := Two;
end News_23.choice;
with System.Address_To_Access_Conversions, System.Storage_Elements;
with Ada.Unchecked_Conversion;
package body News_23.Choice is
use System.Storage_Elements;
Enum_Offset : constant := 4 * Storage_Element'Size;
Number_Offset : constant := 8 * Storage_Element'Size;
function F(N : Node; V : Value) return Boolean is begin
return (N.Enum = Const) or else ((N.Enum = V) = (N.Number = 0));
end;
package Value_P is new System.Address_To_Access_Conversions
(Object => Value);
package Numeric_P is new System.Address_To_Access_Conversions
(Object => Numeric);
function FA(N : Node; V : Value) return Boolean is
begin
declare
-- Enm : Value_P.Object_Pointer renames Value_P.To_Pointer (N'Address +
N.Enum'Position);
-- Num : Numeric_P.Object_Pointer renames Numeric_P.To_Pointer (N'Address +
N.Number'Position);
Enm : Value_P.Object_Pointer renames Value_P.To_Pointer (N'Address +
Enum_Offset);
Num : Numeric_P.Object_Pointer renames Numeric_P.To_Pointer (N'Address +
Number_Offset);
begin
return (Enm.all = Const) or else ((Enm.all = V) = (Num.all = 0));
end;
end FA;
function FP1 (P : System.Address; V : Value) return Boolean is
Enm : Value;
pragma Import (Ada, Enm);
for Enm'Address use P + Enum_Offset;
Num : Numeric;
pragma Import (Ada, Num);
for Num'Address use P + Number_Offset;
begin
pragma Inspection_Point (P);
return (Enm = Const) or else ((Enm = V) = (Num = 0));
end FP1;
function FP2 (P : System.Address; V : Value) return Boolean is
Enm : Value;
pragma Import (Ada, Enm);
for Enm'Address use To_Address (To_Integer (P) + Enum_Offset);
Num : Numeric;
pragma Import (Ada, Num);
for Num'Address use To_Address (To_Integer (P) + Number_Offset);
begin
pragma Inspection_Point (P);
return (Enm = Const) or else ((Enm = V) = (Num = 0));
end FP2;
type Adr is mod 2**Standard'Address_Size;
function To_N is new Ada.Unchecked_Conversion (System.Address, Adr);
function To_Adr is new Ada.Unchecked_Conversion (Adr, System.Address);
function FP3 (P : System.Address; V : Value) return Boolean is
Enm : Value;
pragma Import (Ada, Enm);
for Enm'Address use To_Adr (To_N (P) + Enum_Offset);
Num : Numeric;
pragma Import (Ada, Num);
for Num'Address use To_Adr (To_N (P) + Number_Offset);
begin
pragma Inspection_Point (P);
return (Enm = Const) or else ((Enm = V) = (Num = 0));
end FP3;
function F_3_Args(Enum : Value; Number : Numeric ; V : Value) return
Boolean is begin
return (Enum = Const) or else ((Enum = V) = (Number = 0));
end F_3_Args;
end News_23.Choice;
^ permalink raw reply [relevance 2%]
* Re: condition true or false? -> (-1 < sizeof("test"))
@ 2012-05-22 10:29 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2012-05-22 10:29 UTC (permalink / raw)
On 22.05.12 03:45, glen herrmannsfeldt wrote:
> I don't know how ADA treats signed values, or how its bitwise
> operators work. This is still posted to the ADA group, though.
A feature of Ada (a lady's first name; some older book's
have capitals in titles) is that you would not normally have
to worry; you still can if you like, or must.
First, one cannot store signed (unsigned) values in places whose
type is unsigned (signed) unless using force such as explicit
type conversion, or Unchecked_Conversion. Different types,
no implicit conversions, as mentioned in the thread.
As needed, one selects from the three kinds of types that
have logical operations, Boolean, modular, and packed array
of Boolean.
Some redundant assertions in the following.
with Interfaces; -- for unsigned modular "hardware" types
with Ada.Unchecked_Conversion;
procedure Bops is
-- modular types with modular arithmetic and Boolean ops:
type U8 is mod 2**8;
pragma Assert (U8'Pred (0) = -1);
pragma Assert (U8'Succ (U8'Last) = 0);
X8 : U8 := 2#1111_1111#;
--X9 : U8 := 2#1111_1111_1#; -- compiler rejects, value not in range
X1 : U8 := -1; -- modular arithmetic
X0 : U8 := not 0; -- has Boolean ops
pragma Assert (X0 = X1);
pragma Assert (X1 = 2#1111_1111#);
-- convert from signed:
type S8 is range -128 .. 127;
for S8'Size use 8;
function To_U8 is new Ada.Unchecked_Conversion (S8, U8);
I8 : S8 := -1; -- a negative signed value
--XI : U8 := U8 (I8); -- type conv will raise! value out of range
XU : U8 := To_U8 (I8); -- o.K., not checked
pragma Assert (XU = 8#377#);
-- unsinged_N "hardware types" when supported by the compiler;
-- includes shifting operations and such, is modular
use type Interfaces.Unsigned_64; -- import "+" for literals
U64 : Interfaces.Unsigned_64 := 16#FFFF_FFFF_FFFF_0000# + 2#101#;
-- types for convenient access to individual bits
type Bitvec is array (Natural range <>) of Boolean;
pragma Pack (Bitvec); -- guaranteed
subtype Bitvec_8 is Bitvec (0 .. 7);
Y : Bitvec (0 .. 11) := (5 => True, others => False);
pragma Assert (Y(5) and not Y(11));
Z : Bitvec_8;
Toggle : constant Bitvec_8 := (others => True);
begin
Y (11) := True;
Z := Y(8 - 6 + 1 .. 8) & Y(10 .. 11) xor Toggle;
pragma Assert (Z = (True, True, False, True,
True, True, True, False));
end Bops;
-- Georg
^ permalink raw reply [relevance 2%]
* Re: Dispatching callback handed over to C
2012-04-05 9:13 2% ` Natasha Kerensikova
@ 2012-04-05 21:06 0% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2012-04-05 21:06 UTC (permalink / raw)
Your code looks OK to me. (But I didn't try to compiler or use it, so there
may be something I missed.)
Randy.
"Natasha Kerensikova" <lithiumcat@gmail.com> wrote in message
news:slrnjnqoga.1lme.lithiumcat@sigil.instinctive.eu...
> On 2012-04-04, Randy Brukardt <randy@rrsoftware.com> wrote:
>> For instance, that's how we find the Ada object in Claw; we
>> unchecked-convert access-to-class-wide to a DWord in Windows, and then
>> when
>> we need to use it, we unchecked-convert back. If I needed to make this
>> totally portable and had sufficient control over the API, I'd replace the
>> DWord by a locally-declared modular type of which I could control the
>> size
>> to match the target. But there is little point in going further than
>> that.
>>
>> System.Address is the wrong type to use for a "bucket-of-bits". I agree
>> that
>> it would be nice to be able to directly put the access-to-class-wide in
>> the
>> C convention record (and most compilers will in fact allow this, after
>> giving some warnings), but it doesn't seem to make that much difference.
>
> So for my binding, what about something like :
>
> type Opaque_Data is null record;
> pragma Convention (C, Opaque_Data);
>
> type Opaque_Pointer is access all Opaque_Data;
> pragma Convention (C, Opaque_Pointer);
>
> type Callback_Access is access all Event_Callback'Class;
> pragma Convention (C, Callback_Access);
>
> procedure Set_C_Callback (<various arguments>;
> Data : Opaque_Pointer);
> pragma Import (C, Set_C_Callback, "set_callback");
>
>
> procedure Called_From_C (<various arguments>;
> Data : Opaque_Pointer)
> is
> package To_Ada is new Ada.Unchecked_Conversion
> (Source => Opaque_Pointer, Target => Callback_Access);
>
> Callback : Callback_Access := To_Ada (Data);
> begin
> Callback.all.Handle (<...>);
> end Called_From_C;
>
> pragma Convention (C, Called_From_C);
>
>
> procedure Set_Callback (<various arguments>;
> Callback : in out Event_Callback'Class)
> is
> package To_C is new Ada.Unchecked_Conversion
> (Source => Callback_Access, Target => Opaque_Pointer);
> begin
> Set_C_Callback (<...>, To_C (Callback'Access));
> end Set_Callback;
>
> As far as I cen tell, Opaque_Pointer refers only to types compatibles
> with C, so the imports goes well and without warning, while
> Opaque_Pointer and Callback_Access, being both access types with the
> same convention, ensures they can be safely (in terms of keeping the
> bit pattern intact, of course not type-safety) converted back and forth.
>
> Or is there some trap in the above code that I'm missing?
>
>
> Thanks for your help,
> Natasha
^ permalink raw reply [relevance 0%]
* Re: Dispatching callback handed over to C
@ 2012-04-05 9:13 2% ` Natasha Kerensikova
2012-04-05 21:06 0% ` Randy Brukardt
0 siblings, 1 reply; 200+ results
From: Natasha Kerensikova @ 2012-04-05 9:13 UTC (permalink / raw)
On 2012-04-04, Randy Brukardt <randy@rrsoftware.com> wrote:
> For instance, that's how we find the Ada object in Claw; we
> unchecked-convert access-to-class-wide to a DWord in Windows, and then when
> we need to use it, we unchecked-convert back. If I needed to make this
> totally portable and had sufficient control over the API, I'd replace the
> DWord by a locally-declared modular type of which I could control the size
> to match the target. But there is little point in going further than that.
>
> System.Address is the wrong type to use for a "bucket-of-bits". I agree that
> it would be nice to be able to directly put the access-to-class-wide in the
> C convention record (and most compilers will in fact allow this, after
> giving some warnings), but it doesn't seem to make that much difference.
So for my binding, what about something like :
type Opaque_Data is null record;
pragma Convention (C, Opaque_Data);
type Opaque_Pointer is access all Opaque_Data;
pragma Convention (C, Opaque_Pointer);
type Callback_Access is access all Event_Callback'Class;
pragma Convention (C, Callback_Access);
procedure Set_C_Callback (<various arguments>;
Data : Opaque_Pointer);
pragma Import (C, Set_C_Callback, "set_callback");
procedure Called_From_C (<various arguments>;
Data : Opaque_Pointer)
is
package To_Ada is new Ada.Unchecked_Conversion
(Source => Opaque_Pointer, Target => Callback_Access);
Callback : Callback_Access := To_Ada (Data);
begin
Callback.all.Handle (<...>);
end Called_From_C;
pragma Convention (C, Called_From_C);
procedure Set_Callback (<various arguments>;
Callback : in out Event_Callback'Class)
is
package To_C is new Ada.Unchecked_Conversion
(Source => Callback_Access, Target => Opaque_Pointer);
begin
Set_C_Callback (<...>, To_C (Callback'Access));
end Set_Callback;
As far as I cen tell, Opaque_Pointer refers only to types compatibles
with C, so the imports goes well and without warning, while
Opaque_Pointer and Callback_Access, being both access types with the
same convention, ensures they can be safely (in terms of keeping the
bit pattern intact, of course not type-safety) converted back and forth.
Or is there some trap in the above code that I'm missing?
Thanks for your help,
Natasha
^ permalink raw reply [relevance 2%]
* Re: xor
[not found] ` <tdadna1MV6uj5O7SnZ2dnUVZ_jidnZ2d@earthlink.com>
@ 2012-03-28 21:48 1% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2012-03-28 21:48 UTC (permalink / raw)
On 28.03.12 22:49, Dennis Lee Bieber wrote:
> On Wed, 28 Mar 2012 18:36:28 +0100, Michael Moeller<mic2@t-online.de>
> declaimed the following in comp.lang.ada:
>
>
>> I see. Alas, none of my books or manuals even mentions binary file I/O.
>
> Maybe because anything that is NOT derived from Text_IO is
> considered to be Binary.
(Or, maybe, because prior to Unix, the somewhat simplistic
distinction "r"/"b" wasn't that popular? Structured files
being offered by the operating systems, IINM.)
In any case, traditional Ada I/O (other than Text_IO) is
focusing on types:
Let an object be of some type T. If you want that object
to be input or output, instantiate an I/O module for
type T, and there you go, inputting and outputting objects
of type T using subprograms from the instance.
For I/O of a mix of types ("binary" I/O), streams come in handy.
Again, the mechanism focuses on types: every type is associated
with two pairs of functions:
T'Read T'Write
T'Input T'Output
Roughly speaking, the first pair writes bare data (representations),
the second pair adds more "administrative" information about the
type T. There is a guarantee about what they do. When a program
outputs an object of type T using one function, then the corresponding
function can input the object of type T, and vice versa.
(I guess that this is some form of idempotence, however, I should
leave this to the mathematicians.)
The above functions' profiles consist of a pointer to an object of
some stream type, and an object of type T, to be read, or written.
Somewhat internally, every stream type has two (primitive) subprograms
again called Read and Write. These can implement the data transmission
layer of the streaming functions mentioned above; they operate in
terms of Storage_Element_Array. That's the binary layer, so to speak.
They are similar to Unix's read(2) and write(2) calls.
Subprograms taking Storage_Element_Array parameters operate at the
same level as subprograms related to "sequence of bytes" in the
C sense (I would say so). You can use these when implementing your
own streaming functions, or when you have data suitable for a "cast",
so that the bits are re-interpreted as Storage_Element_Array
(through an instance of Ada.Unchecked_Conversion).
If it interests you, there is
http://www.adaic.org/learn/materials/
Ada 95 material is fine, too, insofar as recent changes to the
language are mostly non-destructive.
^ permalink raw reply [relevance 1%]
* Re: Any leap year issues caused by Ada yesterday?
@ 2012-03-06 17:59 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2012-03-06 17:59 UTC (permalink / raw)
"Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> writes:
> On Tue, 06 Mar 2012 16:46:35 +0000, Simon Wright wrote:
>
>> "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> writes:
>>
>>> Under VxWorks you can read the TSC without assembly, there is a library
>>> function for that (pentiumTscGet64).
>>>
>>> type Timestamp is new Unsigned_64;
>>> procedure pentiumTscGet64 (Clock : out Timestamp);
>>> pragma Import (C, pentiumTscGet64, "pentiumTscGet64");
>>>
>>> should do the work.
>>
>> Not sure if there was an equivalent for PPC.
>
> AFAIK, PPC has a high resolution real time counter, which is better
> designed than Intel's TSC.
Yes, the Time Base.
Ours was a 32-bit implementation, so you get to read the lower and upper
halves of the timebase separately, which would cause problems at
rollover. So read the TB using an internal Clock like this
function Clock return Time is
type Half is (High, Low);
type High_Low is array (Half) of Interfaces.Unsigned_32;
Upper, Lower, Upper_Again : Interfaces.Unsigned_32;
function To_Time is new Ada.Unchecked_Conversion (High_Low, Time);
use type Interfaces.Unsigned_32;
begin
loop
System.Machine_Code.Asm
("mftbu %0" & ASCII.LF & ASCII.HT &
"mftb %1" & ASCII.LF & ASCII.HT &
"mftbu %2",
Outputs =>
(Interfaces.Unsigned_32'Asm_Output ("=r", Upper),
Interfaces.Unsigned_32'Asm_Output ("=r", Lower),
Interfaces.Unsigned_32'Asm_Output ("=r", Upper_Again)),
Volatile => True);
exit when Upper_Again = Upper;
end loop;
return To_Time ((High => Upper, Low => Lower));
end Clock;
The timebase ran off the same crystal as the decrementer, so all were
internally sync'd. Internally, our synchronised time was
(Ada.Calendar.Clock (at last clock interrupt, of course) + high-res time
since last clock interrupt). We added the external sync offset on
sending a time off-board, and subtracted it on receiving one.
(I've never used VxWorks on x86).
^ permalink raw reply [relevance 2%]
* Re: Representation clauses for base-64 encoding
@ 2011-12-22 22:18 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2011-12-22 22:18 UTC (permalink / raw)
On 22.12.11 17:00, Natasha Kerensikova wrote:
> However here representation is not used as a notion, only as a tool:
> using explicit shifts and masks, it is possible to write portable Ada
> that performs the correct split of 3 octets on any platform.
>
> The previous argument was that representation clauses allow more
> readable code, which I'm inclined to believe. But is it really necessary
> to give up portability for the sake of readability?
There is middle ground, I think, insofar as it is possible
to extract bits in Ada without thinking about shifts and masks,
or logical operations.
Given a stream chopped into octets, the goal is to extract slices
of 6 consecutive bits and represent these using the characters
from a Base 64 encoding table. Leave the how-to of extraction to
the compiler, just say which bits. This does not use representation
clauses for extraction, and not shifts or mask either. Without claiming
originality, completeness, enough subtypes, portability of bit indexing
of bits in a single octet, or sufficient code quality, the following might
illustrate the convenience of arrays of packed Booleans (guaranteed by
the LRM to have desirable properties):
package B64 is
--
-- prints characters representing sequences of octets in
-- base 64 encoding. The octets come in via `Add`.
--
pragma Elaborate_Body(B64);
type Repertoire is ( 'A', 'B', 'C', 'D', 'E', 'F', 'G',
'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q',
'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a',
'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k',
'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u',
'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4',
'5', '6', '7', '8', '9', '+', '/' );
for Repertoire'Size use 6;
Pad : constant Character := '=';
subtype Bit_Index is Natural range 0..23;
type Bit_String is array(Bit_Index range <>) of Boolean;
pragma Pack(Bit_String);
subtype Octet is Bit_String(Bit_Index range 0..7);
procedure Add(Bits : Octet);
-- Take 6 bits and write a corresponding Base 64 character.
-- Uses bits from this `Bits`, and bits from last time `Add`
-- was called; saves bits for later use.
procedure Finish;
-- handle any left over bits and finish output
end B64;
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
package body B64 is
subtype Base_64_Digit is Bit_String(Bit_Index range 0..5);
subtype Word is Bit_String(Bit_Index range 0..15);
function To_B64 is new Ada.Unchecked_Conversion(
Base_64_Digit, Repertoire);
procedure Write_64(C : Repertoire) is
Position : Natural;
begin
case C is
when 'A'..'Z' =>
Position := Character'Pos('A') + Repertoire'Pos(C);
when 'a'..'z' =>
Position := Character'Pos('a')
+ (Repertoire'Pos(C) - Repertoire'Pos('a'));
when '0'..'9' =>
Position := Character'Pos('0')
+ (Repertoire'Pos(C) - Repertoire'Pos('0'));
when '+' =>
Position := Character'Pos('+');
when '/' =>
Position := Character'Pos('/');
end case;
Ada.Text_IO.Put(Character'Val(Position));
end Write_64;
--
-- state information
--
type Selection is mod 4;
-- one of the four groups of 6 bits in a full bit string
Scratch : Word := (others => False);
-- buffer storing left over bits for future use
Position_In_Group : Selection := Selection'First;
procedure Add(Bits : Octet) is
Six_Pack : Base_64_Digit;
-- six bits ready to be processed
begin
case Position_In_Group is
when 0 =>
Six_Pack := Base_64_Digit(Bits(2..7));
Write_64(To_B64(Six_Pack));
Scratch(8..15) := Bits;
Position_In_Group := Selection'Succ(Position_In_Group);
when 1 =>
Scratch(4..7) := Bits(4..7);
Six_Pack := Base_64_Digit(Scratch(4..9));
Write_64(To_B64(Six_Pack));
Scratch(8..15) := Bits;
Position_In_Group := Selection'Succ(Position_In_Group);
when 2 =>
-- 4 bits left in `Scratch` plus 8 from `Bits`
-- is worth two output characters
Scratch(6..7) := Bits(6..7);
Six_Pack := Base_64_Digit(Scratch(6..11));
Write_64(To_B64(Six_Pack));
Position_In_Group := Selection'Succ(Position_In_Group);
Six_Pack := Base_64_Digit(Bits(0..5));
Write_64(To_B64(Six_Pack));
Scratch(8..15) := (others => False);
Position_In_Group := Selection'Succ(Position_In_Group);
when 3 =>
-- this won't happen, see comment on case `2`
raise Program_Error;
end case;
end Add;
procedure Finish is
begin
Ada.Text_IO.Put("NOT DONE");
Ada.Text_IO.Flush;
end Finish;
end B64;
^ permalink raw reply [relevance 2%]
* Re: Representation clauses for base-64 encoding
2011-12-22 9:41 2% Representation clauses for base-64 encoding Natasha Kerensikova
@ 2011-12-22 11:20 0% ` Niklas Holsti
1 sibling, 0 replies; 200+ results
From: Niklas Holsti @ 2011-12-22 11:20 UTC (permalink / raw)
On 11-12-22 11:41 , Natasha Kerensikova wrote:
> Hello,
>
> the recent discussion about representation clauses vs explicit shifting
> made me wonder about what is the Right Way of performing base-64
> encoding (rfc 1421).
>
> My first thoughts were along the following lines:
>
> type Octet is mod 256;
> -- or Character or Storage_Element or Stream_Element
> -- or whatever 8-bit type relevant for the appliication
>
> for Octet'Size use 8;
> for Octet'Component_Size use 8;
> for Octet'Bit_Order use System.Low_Order_First;
The compiler should reject that Bit_Order clause, because Octet is not a
record type (RM 13.5.3(4)).
What did you want to achieve with that clause?
>
> type Base_64_Digit is mod 64;
>
> for Base_64_Digit'Size use 6;
> for Base_64_Digit'Component_Size use 6;
> for Base_64_Digit'Bit_Order use System.Low_Order_First;
Same comment and question as above, for Octet.
>
> type Octet_Block is array (1 .. 3) of Octet;
> pragma Pack (Octet_Block);
I would add the following, to check that packing is effective:
for Octet_Block'Size use 24;
>
> type Base_64_Block is array (1 .. 4) of Base_64_Digit;
> pragma Pack (Base_64_Block);
Same comment as for Octet_Block.
> function Split_Base_64 is new Ada.Unchecked_Conversion
> (Source => Octet_Block, Target => Base_64_Block);
>
> function Merge_Base_64 is new Ada.Unchecked_Conversion
> (Source => Base_64_Block, Target => Octet_Block);
>
>
> However, if I understand 13.3(73) correctly, conforming compilers don't
> have to support such arrays (unless 6 and 8 are both factor or multiple
> of word size, but I guess there are not many 2-bit or 24-bit platforms
> around).
Right (I assume you meant *12*-bit or 24-bit).
>
> It seems a more portable but uglier way of doing it is using record:
> instead of arrays:
>
> type Octet_Block is record
> P, Q, R : Octet;
> end record;
Here you might want to specify Octet_Block'Bit_Order.
>
> for Octet_Block use record
> P at 0 range 0 .. 7;
> Q at 0 range 8 .. 15;
> R at 0 range 16 .. 23;
> end record;
>
> type Base_64_Block is record
> A, B, C, D : Base_64_Digit;
> end record;
Ditto Base_64_Block'Bit_Order.
>
> for Base_64_Block use record
> A at 0 range 0 .. 5;
> B at 0 range 6 .. 11;
> C at 0 range 12 .. 17;
> D at 0 range 18 .. 23;
> end record;
>
> Though I guess it might not work so well in 16-bit platforms.
Maybe. It depends on the default bit-ordering and on the size of the
"largest machine scalar", whatever that is -- that depends on what the
compiler writer considers "convenient and efficient" (RM 13.3(8.1/2)).
>
> So is there a better way of doing it?
Do you expect that all the octet-strings to be encoded have a number of
octets that is a multiple of 3, and conversely that all the base-64
strings to be decoded have a length that is a multiple of 4? If not, I
think that using 24-bit encoding/decoding buffers as in your example can
be cumbersome, in addition to the portability problems.
An alternative is to make the array types Octet_Block and Base_64_Block
long enough to hold the longest possible input/output strings (but still
be definite), specify their Component_Sizes as 8 and 6 bits (hoping that
the compiler accepts this), and apply Unchecked_Conversions on the
entire arrays. But I would be afraid of problems at the ends of strings
that only partially fill the last word.
For these reasons, I would definitely choose a shifting method.
I would use an Interfaces.Unsigned_16 or _32 as a buffer that contains
some number of bits in its least-significant end. Initially the buffer
is empty (zero bits) and cleared to all bits zero.
To encode a string of 8-bit groups into a string of 6-bit groups
(omitting the "padding" digits that base-64 sometimes requires):
while (there are 8-bit groups left) loop
-- Invariant: buffer contains less than 6 bits.
inset the next 8-bit group into the buffer by
left-shifting the buffer for 8 positions and
or'ing in the next 8-bit group;
while (the buffer contains at least 6 bits) loop
output the most significant 6 bits of the buffer
and remove them from the buffer;
end loop;
end loop;
output any bits (at most 5) left over in the buffer;
Similar code can be used to decode a string of 6-bit groups into a
string of 8-bit groups.
> Is it acceptable to handle
> portability with different bodies for a spec that only contains the
> Split_Base_64 and Merge_Base_64 functions?
I would accept it, but I still consider the shifting method better and
safer.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Representation clauses for base-64 encoding
@ 2011-12-22 9:41 2% Natasha Kerensikova
2011-12-22 11:20 0% ` Niklas Holsti
0 siblings, 2 replies; 200+ results
From: Natasha Kerensikova @ 2011-12-22 9:41 UTC (permalink / raw)
Hello,
the recent discussion about representation clauses vs explicit shifting
made me wonder about what is the Right Way of performing base-64
encoding (rfc 1421).
My first thoughts were along the following lines:
type Octet is mod 256;
-- or Character or Storage_Element or Stream_Element
-- or whatever 8-bit type relevant for the appliication
for Octet'Size use 8;
for Octet'Component_Size use 8;
for Octet'Bit_Order use System.Low_Order_First;
type Base_64_Digit is mod 64;
for Base_64_Digit'Size use 6;
for Base_64_Digit'Component_Size use 6;
for Base_64_Digit'Bit_Order use System.Low_Order_First;
type Octet_Block is array (1 .. 3) of Octet;
pragma Pack (Octet_Block);
type Base_64_Block is array (1 .. 4) of Base_64_Digit;
pragma Pack (Base_64_Block);
function Split_Base_64 is new Ada.Unchecked_Conversion
(Source => Octet_Block, Target => Base_64_Block);
function Merge_Base_64 is new Ada.Unchecked_Conversion
(Source => Base_64_Block, Target => Octet_Block);
However, if I understand 13.3(73) correctly, conforming compilers don't
have to support such arrays (unless 6 and 8 are both factor or multiple
of word size, but I guess there are not many 2-bit or 24-bit platforms
around).
It seems a more portable but uglier way of doing it is using record:
instead of arrays:
type Octet_Block is record
P, Q, R : Octet;
end record;
for Octet_Block use record
P at 0 range 0 .. 7;
Q at 0 range 8 .. 15;
R at 0 range 16 .. 23;
end record;
type Base_64_Block is record
A, B, C, D : Base_64_Digit;
end record;
for Base_64_Block use record
A at 0 range 0 .. 5;
B at 0 range 6 .. 11;
C at 0 range 12 .. 17;
D at 0 range 18 .. 23;
end record;
Though I guess it might not work so well in 16-bit platforms.
So is there a better way of doing it? Is it acceptable to handle
portability with different bodies for a spec that only contains the
Split_Base_64 and Merge_Base_64 functions?
Or is there some things I'm missing that makes even that non-portable or
even incorrect?
Thanks in advance for sharing your wisdom,
Natasha
^ permalink raw reply [relevance 2%]
* Re: Does Ada support endiannes?
@ 2011-12-15 13:01 2% ` Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2011-12-15 13:01 UTC (permalink / raw)
Gerd <GerdM.O@t-online.de> writes:
> The problem space requires integers (signed), so using unsigned is not
> the right option.
>
> Could you please explain: What do you think how the data send from 68k
> to x86 will be converted from one data layout to the other? Will it
> happen "magically" on the wire? I think, conversion must be done
> explicit either on one side or on the other side, and this requires
> some code.
>
> Currently I use the htonl ntohl functions for it, which (as stated
> above) is not a good choice as it limits the allowed values to
> unsigned.
Some code I wrote -- not quite the same problem -- which handles 8-byte
signed quantities and conversion to/from wire format, and works just
fine on i386, x86_64, powerpc, is
type SNTP_Timestamp is delta 2.0 ** (-32) range -2.0 ** 31 .. 2.0 ** 31;
for SNTP_Timestamp'Size use 64;
subtype Timestamp_Slice is Ada.Streams.Stream_Element_Array (1 .. 8);
function To_Timestamp_Slice
(T : SNTP_Timestamp) return Timestamp_Slice is
function Convert
is new Ada.Unchecked_Conversion (SNTP_Timestamp,
Timestamp_Slice);
Tmp : constant Timestamp_Slice := Convert (T);
begin
if Big_Endian then
return Tmp;
else
return (1 => Tmp (8),
2 => Tmp (7),
3 => Tmp (6),
4 => Tmp (5),
5 => Tmp (4),
6 => Tmp (3),
7 => Tmp (2),
8 => Tmp (1));
end if;
end To_Timestamp_Slice;
function To_SNTP_Timestamp (T : Timestamp_Slice) return SNTP_Timestamp is
function Convert is new Ada.Unchecked_Conversion (Timestamp_Slice,
SNTP_Timestamp);
begin
if Big_Endian then
return Convert (T);
else
return Convert ((1 => T (8),
2 => T (7),
3 => T (6),
4 => T (5),
5 => T (4),
6 => T (3),
7 => T (2),
8 => T (1)));
end if;
end To_SNTP_Timestamp;
No real possibility of validation of this data type at the conversion
level, of course.
I think the chance of using wierd machines where this doesn't work is
pretty low.
And don't forget you can come a cropper because of compiler changes:
previous to Ada 2005, GNAT's representation of Ada.Calendar.Time used
the Unix epoch, so a conversion based on that seemed a pretty safe bet.
^ permalink raw reply [relevance 2%]
* Re: Interfaces.Shift_Left
2011-12-12 23:34 2% ` Interfaces.Shift_Left Simon Wright
@ 2011-12-13 1:36 0% ` Adam Beneschan
0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2011-12-13 1:36 UTC (permalink / raw)
On Dec 12, 3:34 pm, Simon Wright <si...@pushface.org> wrote:
> awdorrin <awdor...@gmail.com> writes:
> > Cur_Word := (Cur_Word OR Shift_Left( Unsigned_32(Data),
> > Bits_To_Shift));
> > INT_PTR.all := Integer_32(Cur_Word);
>
> > I understand that the result from the shift_left is a negative number,
> > so it is being seen by Ada as a large positive number ( > (2^31-1))
> > which is why I'm getting the Constraint error;
>
> > Maybe its my history with C that is confusing me, but shouldn't there
> > be an easy way to cast the value back to a negative Integer_32 from an
> > Unsigned_32?
>
> Ada doesn't have an easy way to do what you ask; one way you can do it
> is by instantiating Ada.Unchecked_Conversion, which is deliberately
> obvious so that reviewers know that they have to take more care than
> usual.
In fact, I think most C casts are, in essence, "unchecked
conversions". In Ada, however, type conversions (specifically, value
conversions) are more strictly defined, and it's defined so that the
result of a type conversion has the same *value* as the operand, with
allowance for rounding. So the idea of a type conversion whose
operand is a positive number and whose result is a negative number is
not how Ada does things.
-- Adam
^ permalink raw reply [relevance 0%]
* Re: Interfaces.Shift_Left
@ 2011-12-12 23:34 2% ` Simon Wright
2011-12-13 1:36 0% ` Interfaces.Shift_Left Adam Beneschan
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2011-12-12 23:34 UTC (permalink / raw)
awdorrin <awdorrin@gmail.com> writes:
> Cur_Word := (Cur_Word OR Shift_Left( Unsigned_32(Data),
> Bits_To_Shift));
> INT_PTR.all := Integer_32(Cur_Word);
>
> I understand that the result from the shift_left is a negative number,
> so it is being seen by Ada as a large positive number ( > (2^31-1))
> which is why I'm getting the Constraint error;
>
> Maybe its my history with C that is confusing me, but shouldn't there
> be an easy way to cast the value back to a negative Integer_32 from an
> Unsigned_32?
Ada doesn't have an easy way to do what you ask; one way you can do it
is by instantiating Ada.Unchecked_Conversion, which is deliberately
obvious so that reviewers know that they have to take more care than
usual.
It'd be much easier if Data was Unsigned_32 to start with, and if
instead of INT_PTR you had an Unsigned_32_Ptr.
^ permalink raw reply [relevance 2%]
* Re: Does Ada support endiannes?
@ 2011-12-12 19:23 3% ` Jeffrey Carter
1 sibling, 0 replies; 200+ results
From: Jeffrey Carter @ 2011-12-12 19:23 UTC (permalink / raw)
On 12/12/2011 05:44 AM, Gerd wrote:
>
> Any suggestion on how to convert, others that "/" and "mod"?
Let's presume you're on a little-ending machine. Then you can write something like
type Byte is mod 2 ** 8;
for Byte'Size use 8;
type Native is record
MSB : Byte;
MSB_1 : Byte;
LSB_1 : Byte;
LSB : Byte;
end record;
for Native use record
MSB at 3 range 0 .. 7;
MSB_1 at 2 range 0 .. 7;
LSB_1 at 1 range 0 .. 7;
LSB at 0 range 0 .. 7;
end record;
for Native'Size use 32;
function From_Native is new Ada.Unchecked_Conversion
(Source => Native, Target => Interfaces.Integer_32);
function To_Native is new Ada.Unchecked_Conversion
(Source => Interfaces.Integer_32, Target => Native);
type Foreign is new Native;
for Foreign use record
MSB at 0 range 0 .. 7;
MSB_1 at 1 range 0 .. 7;
LSB_1 at 2 range 0 .. 7;
LSB at 3 range 0 .. 7;
end record;
for Foreign'Size use 32;
function From_Foreign is new Ada.Unchecked_Conversion
(Source => Foreign, Target => Interfaces.Integer_32);
function To_Foreign is new Ada.Unchecked_Conversion
(Source => Interfaces.Integer_32, Target => Foreign);
Now, if you have something in big-endian format in Value, you can convert it to
little-ending by
From_Native (Native (To_Foreign (Value) ) )
which you would probably want to encapsulate
function Foreign_To_Native (Value : in Interfaces.Integer_32)
return Interfaces.Integer_32 is
-- null;
begin -- Foreign_To_Native
return From_Native (Native (To_Foreign (Value) ) );
end Foreign_To_Native;
You could also read your foreign value byte by byte, putting the bytes into the
appropriate fields of a Native, then unchecked-convert that to an integer.
--
Jeff Carter
"Pray that there's intelligent life somewhere up in
space, 'cause there's bugger all down here on earth."
Monty Python's Meaning of Life
61
--- Posted via news://freenews.netfront.net/ - Complaints to news@netfront.net ---
^ permalink raw reply [relevance 3%]
* Re: Stream_Element_Array
2011-09-14 8:31 2% ` Stream_Element_Array Simon Wright
@ 2011-09-16 11:17 3% ` anon
1 sibling, 0 replies; 200+ results
From: anon @ 2011-09-16 11:17 UTC (permalink / raw)
One way is to use Ada Union, the other more flexible way is to use
"Ada.Unchecked_Conversion".
In using the ada.Unchecked_Conversion you can convert the record
"Message_Header" to a array of Unsigned_8 or another record which
defines length as 2 Unsigned_8 elements. Then use the new converted
8-bit array or record in your Stream Element routine.
In <edfcce02-7d80-4186-a281-c8a4983a3efd@p25g2000pri.googlegroups.com>, Alexander Korolev <antonovkablog@gmail.com> writes:
>I have a Type
>
>type Message_Header is
> record
> -- Components -- 8 bit
> Length : Unsigned_16; -- 16 bit (MSB)
> -- other components -- 8 bit
> end record;
>
>How I could split the Lenght component on two subsequent
>Stream_Element ( 8-bit)?
>
>Command: Stream_Element_Array (1 .. 64);
>
>Thanks
^ permalink raw reply [relevance 3%]
* Re: Stream_Element_Array
2011-09-14 9:09 0% ` Stream_Element_Array Alexander Korolev
@ 2011-09-14 9:40 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2011-09-14 9:40 UTC (permalink / raw)
On Wed, 14 Sep 2011 02:09:15 -0700 (PDT), Alexander Korolev wrote:
> On Sep 14, 12:31�pm, Simon Wright <si...@pushface.org> wrote:
>> Alexander Korolev <antonovkab...@gmail.com> writes:
>>> I have a Type
>>
>>> type Message_Header is
>>> � � record
>>> � � � �-- Components � � � � � � � � �-- � 8 bit
>>> � � � �Length � �: Unsigned_16; � �-- 16 bit �(MSB)
>>> � � � �-- other components � � � � �-- � 8 bit
>>> � � end record;
>>
>>> How I could split the Lenght component on two subsequent
>>> Stream_Element ( 8-bit)?
>>
>>> Command: Stream_Element_Array (1 .. 64);
>>
>> I think the best way is using unchecked conversion. Below adds the
>> complication of converting to network byte order if not already so:
>>
>> � �subtype Two_Byte_Slice is Ada.Streams.Stream_Element_Array (1 .. 2);
>>
>> � �Big_Endian : constant Boolean
>> � � �:= System."=" (System.Default_Bit_Order, System.High_Order_First);
>>
>> � �function To_Two_Byte_Slice (S : Unsigned_16) return Two_Byte_Slice is
>> � � � function Convert is new Ada.Unchecked_Conversion (Unsigned_16,
>> � � � � � � � � � � � � � � � � � � � � � � � � � � � � Two_Byte_Slice);
>> � � � Tmp : constant Two_Byte_Slice := Convert (S);
>> � �begin
>> � � � if Big_Endian then
>> � � � � �return Tmp;
>> � � � else
>> � � � � �return (1 => Tmp (2),
>> � � � � � � � � �2 => Tmp (1));
>> � � � end if;
>> � �end To_Two_Byte_Slice;
>>
>> � �Command (11 .. 12) := To_Two_Byte_Slice (42);
>
> Thanks Simon
> I'll try your code anyway.
> -- I thought I might made the issue more complex
> The Unsigned_16 came from transformation of the Header_Type component
> by Interfaces.Unsigned_16 (Last).
> It means I have Last: Stream_Element_Count (8 bit) set correctly.
> -- (Note For Per: I can not send the lenth to target stream because
> the whole
> -- message (stream_element_array) assembled needs further computation
> over + one transformation
> -- (staffing - something like replace 111 with 444 + 555 if 111
> occures in some components of the message including
> -- the letgh ) after the computation as an external dev requirement
Here is the pattern I am using:
Put (Destination : in out Stream_Element_Array;
Index : in out Stream_Element_Offset;
Data : <the data type>
);
Get (Source : Stream_Element_Array;
Index : in out Stream_Element_Offset;
Data : out <the data type>
);
Index indicates the position to start at. It is advanced after the put/get
elements of the buffer.
You fill the output buffer using consequent calls to Put. Then send its
filled slice Buffer (Buffer'First..Index - 1) to the hardware.
The opposite direction works similarly. You take data from the input buffer
with consequent calls to Get.
Get and Put for composite types are implemented in terms of Get and Put of
integral types. Note that their representations need not to correspond to
the hardware layouts. You are free to use Ada types best suitable to the
application.
P.S. Do not use representation clauses or unchecked conversion, I *do* mean
it:
-- Little endian implementation of Get for Unsigned_16
procedure Get
( Source : Stream_Element_Array;
Index : in out Stream_Element_Offset;
Data : out Unsigned_16
) is
begin
Data := Stream_Element'Pos (Source (Index)) +
Stream_Element'Pos (Source (Index + 1));
Index := Index + 2;
end Get;
P.P.S. Stream element might be not the best choice if you are communicating
with the external world. You could also consider taking Unsigned_8 and an
array built upon it, because in most cases the hardware talks in octets.
That does not change the pattern, of course.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Stream_Element_Array
2011-09-14 8:31 2% ` Stream_Element_Array Simon Wright
@ 2011-09-14 9:09 0% ` Alexander Korolev
2011-09-14 9:40 0% ` Stream_Element_Array Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Alexander Korolev @ 2011-09-14 9:09 UTC (permalink / raw)
On Sep 14, 12:31 pm, Simon Wright <si...@pushface.org> wrote:
> Alexander Korolev <antonovkab...@gmail.com> writes:
> > I have a Type
>
> > type Message_Header is
> > record
> > -- Components -- 8 bit
> > Length : Unsigned_16; -- 16 bit (MSB)
> > -- other components -- 8 bit
> > end record;
>
> > How I could split the Lenght component on two subsequent
> > Stream_Element ( 8-bit)?
>
> > Command: Stream_Element_Array (1 .. 64);
>
> I think the best way is using unchecked conversion. Below adds the
> complication of converting to network byte order if not already so:
>
> subtype Two_Byte_Slice is Ada.Streams.Stream_Element_Array (1 .. 2);
>
> Big_Endian : constant Boolean
> := System."=" (System.Default_Bit_Order, System.High_Order_First);
>
> function To_Two_Byte_Slice (S : Unsigned_16) return Two_Byte_Slice is
> function Convert is new Ada.Unchecked_Conversion (Unsigned_16,
> Two_Byte_Slice);
> Tmp : constant Two_Byte_Slice := Convert (S);
> begin
> if Big_Endian then
> return Tmp;
> else
> return (1 => Tmp (2),
> 2 => Tmp (1));
> end if;
> end To_Two_Byte_Slice;
>
> Command (11 .. 12) := To_Two_Byte_Slice (42);
Thanks Simon
I'll try your code anyway.
-- I thought I might made the issue more complex
The Unsigned_16 came from transformation of the Header_Type component
by Interfaces.Unsigned_16 (Last).
It means I have Last: Stream_Element_Count (8 bit) set correctly.
-- (Note For Per: I can not send the lenth to target stream because
the whole
-- message (stream_element_array) assembled needs further computation
over + one transformation
-- (staffing - something like replace 111 with 444 + 555 if 111
occures in some components of the message including
-- the letgh ) after the computation as an external dev requirement
^ permalink raw reply [relevance 0%]
* Re: Stream_Element_Array
@ 2011-09-14 8:31 2% ` Simon Wright
2011-09-14 9:09 0% ` Stream_Element_Array Alexander Korolev
2011-09-16 11:17 3% ` Stream_Element_Array anon
1 sibling, 1 reply; 200+ results
From: Simon Wright @ 2011-09-14 8:31 UTC (permalink / raw)
Alexander Korolev <antonovkablog@gmail.com> writes:
> I have a Type
>
> type Message_Header is
> record
> -- Components -- 8 bit
> Length : Unsigned_16; -- 16 bit (MSB)
> -- other components -- 8 bit
> end record;
>
> How I could split the Lenght component on two subsequent
> Stream_Element ( 8-bit)?
>
> Command: Stream_Element_Array (1 .. 64);
I think the best way is using unchecked conversion. Below adds the
complication of converting to network byte order if not already so:
subtype Two_Byte_Slice is Ada.Streams.Stream_Element_Array (1 .. 2);
Big_Endian : constant Boolean
:= System."=" (System.Default_Bit_Order, System.High_Order_First);
function To_Two_Byte_Slice (S : Unsigned_16) return Two_Byte_Slice is
function Convert is new Ada.Unchecked_Conversion (Unsigned_16,
Two_Byte_Slice);
Tmp : constant Two_Byte_Slice := Convert (S);
begin
if Big_Endian then
return Tmp;
else
return (1 => Tmp (2),
2 => Tmp (1));
end if;
end To_Two_Byte_Slice;
Command (11 .. 12) := To_Two_Byte_Slice (42);
^ permalink raw reply [relevance 2%]
* Re: acceess problem
2011-07-26 15:57 2% ` Gautier write-only
@ 2011-07-26 17:43 0% ` Adam Beneschan
0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2011-07-26 17:43 UTC (permalink / raw)
On Jul 26, 8:57 am, Gautier write-only <gautier_niou...@hotmail.com>
wrote:
> On 25 juil, 10:27, Simon Wright <si...@pushface.org> wrote:
>
> > Replace 'Access with 'Unchecked_Access or, if that doesn't work, with
> > the (GNAT-special) 'Unrestricted_Access.
>
> Unless 'Unrestricted_Access has been inbetween added to the language,
> there is a way to have it in a pure Ada form:
>
> function Cvt is new
> Ada.Unchecked_Conversion(System.Address,DoublePtr);
> -- This method is functionally identical as GNAT's
> Unrestricted_Access
> -- but has no type safety (cf GNAT Docs)
> pragma No_Strict_Aliasing(DoublePtr); -- recommended by GNAT 2005
>
> procedure Vertex (v: Double_vector_3D) is
> begin
> Vertex3dv(Cvt(v(0)'Address));
> end Vertex;
>
> ^this is an excerpt from an existing GL binding (why reinvent it?)...http://globe3d.svn.sourceforge.net/viewvc/globe3d/bindings/gl.adb?rev...
Although I don't like this approach, if you're going to convert an
Address to an access object, surely it's better to use
System.Address_To_Access_Conversions, which is designed for this sort
of conversion, than to use Unchecked_Conversion, which assumes that a
System.Address and the access object you're converting to have the
same format, which isn't always the case. There's no point in using
"pure Ada" if it results in code that compiles on another system but
doesn't work properly.
-- Adam
^ permalink raw reply [relevance 0%]
* Re: acceess problem
@ 2011-07-26 15:57 2% ` Gautier write-only
2011-07-26 17:43 0% ` Adam Beneschan
0 siblings, 1 reply; 200+ results
From: Gautier write-only @ 2011-07-26 15:57 UTC (permalink / raw)
On 25 juil, 10:27, Simon Wright <si...@pushface.org> wrote:
> Replace 'Access with 'Unchecked_Access or, if that doesn't work, with
> the (GNAT-special) 'Unrestricted_Access.
Unless 'Unrestricted_Access has been inbetween added to the language,
there is a way to have it in a pure Ada form:
function Cvt is new
Ada.Unchecked_Conversion(System.Address,DoublePtr);
-- This method is functionally identical as GNAT's
Unrestricted_Access
-- but has no type safety (cf GNAT Docs)
pragma No_Strict_Aliasing(DoublePtr); -- recommended by GNAT 2005
procedure Vertex (v: Double_vector_3D) is
begin
Vertex3dv(Cvt(v(0)'Address));
end Vertex;
^this is an excerpt from an existing GL binding (why reinvent it?)...
http://globe3d.svn.sourceforge.net/viewvc/globe3d/bindings/gl.adb?revision=152&view=markup
______________________________________________________________________________
Gautier's Ada programming -- http://gautiersblog.blogspot.com/search/label/Ada
NB: follow the above link for a valid e-mail address
^ permalink raw reply [relevance 2%]
* Re: A hole in Ada type safety
2011-04-30 16:16 0% ` Florian Weimer
@ 2011-05-14 23:47 0% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2011-05-14 23:47 UTC (permalink / raw)
AdaMagica: Some times a programmer may need a only a few checks
suppressed instead of all checks as with the RM Unchecked_Conversion
function. Then there's the idea of creating your own function just
like some here will say create your own version of an Integer instead
of using the one defined in the Standard package. Now, I have one
simple designed Unchecked_Conversion function that work for any Ada 83
compiler, and a second version that works for any Ada 95 compiler for
all types used in that version of the language. Include a
"unconstrained discriminant limited private" type.
Florian Weimer: My design converts all types and I did not need to use
aliased or tag type to add the discriminant-dependent feature. Just
play with it a little and you will see the answer.
Note: One thing. Any and all Unchecked_Conversion function just like
Machine_Code Insertions adds a safety risk to the party. Plus, the
conversion functions are easier to hide in a large scale project.
This all started because of an answer that "Robert Duff" gave about about
AARM-3.7.2(4,4.a), which refers to AI83_00585 and "Erroneous Execution".
In looking at that Ada Issue I see only a compiler design error not an
"Erroneous Execution" error. The fix is for the compiler to add either
two or three checks in the elaborate code depending how the compiler
evaluate the equation, which means no "Erroneous Execution". But in
15 plus years GNAT has not correct this compiler identifiable error which
makes me think how many more "Erroneous Execution" has GNAT and other
Ada venders skip fixing making the language less secure.
Also, I knew that Adam and Randy were just talk!!! Makes me think that
they are waiting for someone to create an example of the "extended return
statement" so, they can learn how to use it. Because in looking at the
AIs for 95 and 2005 and the ACVC 3.0 there is no example of an "extended
return statement" for any "unconstrained discriminant limited private"
except for those that call a function. But that not always possible.
In <87tydfbtp3.fsf@mid.deneb.enyo.de>, Florian Weimer <fw@deneb.enyo.de> writes:
>* Robert A. Duff:
>
>> Florian Weimer <fw@deneb.enyo.de> writes:
>>
>>> I don't know if this is a new observation---I couldn't find
>>> documentation for it.
>>
>> It's not new. It is documented in AARM-3.7.2(4,4.a),
>> which dates back to Ada 83 days.
>
>Ah. I didn't realize that call to Convert was already erroneous.
>
>It does not seem possible to extend the restrictions on 'Access
>prefixes to to subprogram parameters (due to the way controlled types
>are implemented, for example).
>
>>> Our implementation lacks the full power of Ada.Unchecked_Conversion
>>> because it does not supported limited or unconstrained types. However,
>>> it is sufficient to break type safety.
>>
>> Yes. Anything that is erroneous necessarily breaks type safety.
>> If you look up "erroneous execution" in the index, you'll find
>> them all.
>
>My concern was that this was not explicitly labeled as erroneous. 8-)
>
>> Your comment, "This note shows that a combination of safe-looking
>> language features can be used to undermine type safety, too."
>> is the key point. It is indeed unfortunate when "safe-looking"
>> features can be erroneous.
>
>And once there is something like this in the language, it is difficult
>to decide if a new addition (such as aliased parameters) make things
>worse or not.
^ permalink raw reply [relevance 0%]
* Re: A hole in Ada type safety
2011-05-12 0:51 0% ` Randy Brukardt
@ 2011-05-13 0:47 0% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2011-05-13 0:47 UTC (permalink / raw)
--
-- May be this program will help explain the problem.
--
-- Plus,
-- RM 13.9 (12) -- say the function can copy "by reference, if the
-- Source type is not a by-copy type." In Ada 2005, the definition
-- of Source type for the Unchecked_Conversion is still a "limited
-- private" which is a "Limited Type, and all Limited types (RM 7.5)
-- are now a by-copy type. So, Unchecked_Conversion must now use
-- only "by-copy" type of copying. This suggest that the RM 13.9 (12)
-- paragraph may be in Error an needs to be update at least for Ada
-- 2012. And corrected in 2005.
--
-- RM 7.5 ( 1.b/2 ), Suggest that the copying "Limited Types" by
-- reference was for Ada 95. That changes for Ada 2005.
--
-- This may also explain what Robert Dewar was taking about in
-- AI95-00318-02.
--
--
-- Testing the Generic Unchecked_Conversion function.
-- By copying and renaming the function to Ada05_Conversion.
--
with Interfaces ;
with Text_IO ;
--
procedure Test_UC is
use Interfaces ;
--
package Byte_IO is new Text_IO.Modular_IO ( Unsigned_8 ) ;
package U32_IO is new Text_IO.Modular_IO ( Unsigned_32 ) ;
--
type Boolean_Array is array ( Natural range <> ) of Boolean ;
pragma Pack ( Boolean_Array ) ;
--
-- Limited type: must copy by "by-copy type"
--
type Record_Type is limited record
Flags : Boolean_Array ( 0 .. 31 ) ;
end record ;
pragma Pack ( Record_Type ) ;
-- ------------------ --
-- Ada05_Conversion --
-- ------------------ --
generic
type Source (<>) is limited private ;
type Target (<>) is limited private ;
function Ada05_Conversion ( S : Source ) return Target ;
function Ada05_Conversion ( S : Source ) return Target is
pragma Suppress ( All_Checks ) ;
begin
-- Compiling Error messages:
-- (Ada 2005) cannot copy object of a limited type
-- (RM-2005 6.5(5.5/2))
-- consider switching to return of access type
--
-- Additional References for reasoning:
-- RM 7.5 Limited Types ( 1/2, 1.a, 1.b/2 )
--
return Target ( S ) ;
end Ada05_Conversion ;
--
function To_Byte is new Ada05_Conversion
( Source => Unsigned_8, Target => Character ) ;
function To_Unsigned_32 is new Ada05_Conversion
( Source => Record_Type, Target => Unsigned_32 ) ;
C : Character := 'c' ;
S : Unsigned_8 := 16#41# ; -- 'A'
R0 : Record_Type ;
R1 : Unsigned_32 ;
begin
--
-- Copy a simple unsigned_8 to character
--
C := To_Byte ( S ) ; -- Perform conversion
--
-- Should display:
-- Test 1: C := 'A'
--
Text_IO.Put ( "Test 1: " ) ;
Text_IO.Put ( "C := '" ) ;
Text_IO.Put ( C ) ;
Text_IO.Put ( ''' ) ;
Text_IO.New_Line ;
--
R0.Flags ( 28 .. 31 ) := ( others => True ) ;
R0.Flags ( 00 .. 27 ) := ( others => False ) ;
--
-- Copy a limited record to a Unsigned_32
--
R1 := To_Unsigned_32 ( R0 ) ; -- Perform conversion
--
-- Should display:
-- Test 2: R0 := 2#11110000000000000000000000000000#
--
Text_IO.Put ( "Test 2: " ) ;
Text_IO.Put ( "R0 := " ) ;
U32_IO.Put ( R1, base => 2 ) ;
Text_IO.New_Line ;
end Test_UC ;
In <iqfaud$ggn$1@munin.nbi.dk>, "Randy Brukardt" <randy@rrsoftware.com> writes:
><anon@att.net> wrote in message news:iqes6i$18g$1@speranza.aioe.org...
>> The RM 13.9 (3) defines the Unchecked_Conversion function with
>>
>> pragma Convention ( Intrinsic, Ada.Unchecked_Conversion ) ;
>>
>> Intrinsic is built-in" and RM C.1 ( 10 ) implies inlining to reduce
>> overhead of this function and RM 13.8 ( 15 ) helps reduces the code
>> to that of an inline Machine Code Insertions.
>>
>>
>> Proof basically come from RM 6.3.1 ( 4 ), RM 13.9 ( 15 ) and
>> C.1 ( 10 ).
>>
>> RM 6.3.1 Conformance Rules
>>
>> 4 "The Intrinsic calling convention represents subprograms that
>> are ``built in'' to the compiler." ...
>>
>> RM 13.9 Unchecked Type Conversions
>>
>> 15 The implementation should not generate unnecessary run-time
>> checks to ensure that the representation of S is a
>> representation of the target type. It should take advantage of
>> the permission to return by reference when possible.
>> Restrictions on unchecked conversions should be avoided unless
>> required by the target environment.
>>
>> RM C.1 Access to Machine Operations
>>
>> 10 "The implementation should ensure that little or no overhead
>> is associated with calling intrinsic and machine-code
>> subprograms"
>>
>>
>>
>> Associative RMs
>>
>> RM 13.8 Machine Code Insertions
>>
>> 11 "(17) Intrinsic subprograms (see 6.3.1, ``Conformance Rules'')
>> can also be used to achieve machine code insertions." ...
>>
>> RM C.1 Access to Machine Operations
>>
>> 6 "The implementation shall document the overhead associated
>> with calling machine-code or intrinsic subprograms, as
>> compared to a fully-inlined call, and to a regular
>> out-of-line call."
>>
>>
>>
>> Now in Ada 2005, RM 7.5 (1/2) states that a routine can not just copy
>> a "limited private" object. RM 6.5 (5.1/2, 5.c/2 ) states that if
>> the target is limited the function "must produce a ""new"" object"
>> instead of just copying the object.
>>
>> Aka the "Unchecked_Conversion" which is a generic function is no
>> longer just an inlined expression that is just a type conversions
>> with all checks being disable. The function must now return a "new"
>> object RM 6.5 (5.5/2, 5.c/2 ), by first requesting an new object
>> from the Target's storage pool and then copying the Source data to
>> that new object. So, in Ada 2005 the "Unchecked_Conversion" must be
>> handled as a true generic function with a true return, instead of a
>> built-in inline expression.
>>
>> But GNAT still just performs a simple copy. So, is GNAT or the RM
>> or is the generic "Unchecked_Conversion" function in error?
>
>You, of course. :-) Your language-lawyering skills need some work.
>
>13.9(12) (an implementation permission) says that an implementation can
>return the result of an unchecked_conversion "by reference". Especially note
>the second sentence of that rule, which explains the intent.
>
> Randy.
>
>
>
>
>
>
^ permalink raw reply [relevance 0%]
* Re: A hole in Ada type safety
2011-05-11 20:39 3% ` anon
2011-05-12 0:51 0% ` Randy Brukardt
@ 2011-05-12 5:51 3% ` AdaMagica
1 sibling, 0 replies; 200+ results
From: AdaMagica @ 2011-05-12 5:51 UTC (permalink / raw)
Randy has already given the answer.
Let me add a further remark (but note, I'm no language lawyer):
You argue about the return statement. But there is no return statement
involved in the RM with Unchecked_Conversion, it's just compiler magic
that is being performed. (Being intrinsic, Unchecked_Conversion need
not be implemented in Ada. In fact, I think there is no code at all,
it just takes the bit pattern as is and reinterpretes it.)
Run the following test program:
package UC is
type LP1 is limited private;
procedure Set (X: out LP1; to: Integer);
type LP2 is limited private;
private
type LP1 is limited record
I: Integer := 1234;
end record;
type LP2 is limited record
I: Integer := Integer'First;
end record;
end UC;
package body UC is
procedure Set (X: out LP1; to: Integer) is
begin
X.I := to;
end Set;
end UC;
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
with UC;
procedure Test_UC is
function LP1_LP2 is new Ada.Unchecked_Conversion (UC.LP1, UC.LP2);
function LP2_I is new Ada.Unchecked_Conversion (UC.LP2, Integer);
X: UC.LP1;
Y: constant UC.LP2 := LP1_LP2 (X); -- new object built in
place
Z: UC.LP2 renames LP1_LP2 (X); -- read-only view
begin
-- expected result
Ada.Text_IO.Put_Line (Integer'Image (LP2_I (Y)) & Integer'Image
(LP2_I (Z))); -- 1234 1234
UC.Set (X, -100);
Ada.Text_IO.Put_Line (Integer'Image (LP2_I (Y)) & Integer'Image
(LP2_I (Z))); -- 1234-100
end Test_UC;
^ permalink raw reply [relevance 3%]
* Re: A hole in Ada type safety
2011-05-11 20:39 3% ` anon
@ 2011-05-12 0:51 0% ` Randy Brukardt
2011-05-13 0:47 0% ` anon
2011-05-12 5:51 3% ` AdaMagica
1 sibling, 1 reply; 200+ results
From: Randy Brukardt @ 2011-05-12 0:51 UTC (permalink / raw)
<anon@att.net> wrote in message news:iqes6i$18g$1@speranza.aioe.org...
> The RM 13.9 (3) defines the Unchecked_Conversion function with
>
> pragma Convention ( Intrinsic, Ada.Unchecked_Conversion ) ;
>
> Intrinsic is built-in" and RM C.1 ( 10 ) implies inlining to reduce
> overhead of this function and RM 13.8 ( 15 ) helps reduces the code
> to that of an inline Machine Code Insertions.
>
>
> Proof basically come from RM 6.3.1 ( 4 ), RM 13.9 ( 15 ) and
> C.1 ( 10 ).
>
> RM 6.3.1 Conformance Rules
>
> 4 "The Intrinsic calling convention represents subprograms that
> are ``built in'' to the compiler." ...
>
> RM 13.9 Unchecked Type Conversions
>
> 15 The implementation should not generate unnecessary run-time
> checks to ensure that the representation of S is a
> representation of the target type. It should take advantage of
> the permission to return by reference when possible.
> Restrictions on unchecked conversions should be avoided unless
> required by the target environment.
>
> RM C.1 Access to Machine Operations
>
> 10 "The implementation should ensure that little or no overhead
> is associated with calling intrinsic and machine-code
> subprograms"
>
>
>
> Associative RMs
>
> RM 13.8 Machine Code Insertions
>
> 11 "(17) Intrinsic subprograms (see 6.3.1, ``Conformance Rules'')
> can also be used to achieve machine code insertions." ...
>
> RM C.1 Access to Machine Operations
>
> 6 "The implementation shall document the overhead associated
> with calling machine-code or intrinsic subprograms, as
> compared to a fully-inlined call, and to a regular
> out-of-line call."
>
>
>
> Now in Ada 2005, RM 7.5 (1/2) states that a routine can not just copy
> a "limited private" object. RM 6.5 (5.1/2, 5.c/2 ) states that if
> the target is limited the function "must produce a ""new"" object"
> instead of just copying the object.
>
> Aka the "Unchecked_Conversion" which is a generic function is no
> longer just an inlined expression that is just a type conversions
> with all checks being disable. The function must now return a "new"
> object RM 6.5 (5.5/2, 5.c/2 ), by first requesting an new object
> from the Target's storage pool and then copying the Source data to
> that new object. So, in Ada 2005 the "Unchecked_Conversion" must be
> handled as a true generic function with a true return, instead of a
> built-in inline expression.
>
> But GNAT still just performs a simple copy. So, is GNAT or the RM
> or is the generic "Unchecked_Conversion" function in error?
You, of course. :-) Your language-lawyering skills need some work.
13.9(12) (an implementation permission) says that an implementation can
return the result of an unchecked_conversion "by reference". Especially note
the second sentence of that rule, which explains the intent.
Randy.
^ permalink raw reply [relevance 0%]
* Re: A hole in Ada type safety
@ 2011-05-11 20:39 3% ` anon
2011-05-12 0:51 0% ` Randy Brukardt
2011-05-12 5:51 3% ` AdaMagica
0 siblings, 2 replies; 200+ results
From: anon @ 2011-05-11 20:39 UTC (permalink / raw)
The RM 13.9 (3) defines the Unchecked_Conversion function with
pragma Convention ( Intrinsic, Ada.Unchecked_Conversion ) ;
Intrinsic is built-in" and RM C.1 ( 10 ) implies inlining to reduce
overhead of this function and RM 13.8 ( 15 ) helps reduces the code
to that of an inline Machine Code Insertions.
Proof basically come from RM 6.3.1 ( 4 ), RM 13.9 ( 15 ) and
C.1 ( 10 ).
RM 6.3.1 Conformance Rules
4 "The Intrinsic calling convention represents subprograms that
are ``built in'' to the compiler." ...
RM 13.9 Unchecked Type Conversions
15 The implementation should not generate unnecessary run-time
checks to ensure that the representation of S is a
representation of the target type. It should take advantage of
the permission to return by reference when possible.
Restrictions on unchecked conversions should be avoided unless
required by the target environment.
RM C.1 Access to Machine Operations
10 "The implementation should ensure that little or no overhead
is associated with calling intrinsic and machine-code
subprograms"
Associative RMs
RM 13.8 Machine Code Insertions
11 "(17) Intrinsic subprograms (see 6.3.1, ``Conformance Rules'')
can also be used to achieve machine code insertions." ...
RM C.1 Access to Machine Operations
6 "The implementation shall document the overhead associated
with calling machine-code or intrinsic subprograms, as
compared to a fully-inlined call, and to a regular
out-of-line call."
Now in Ada 2005, RM 7.5 (1/2) states that a routine can not just copy
a "limited private" object. RM 6.5 (5.1/2, 5.c/2 ) states that if
the target is limited the function "must produce a ""new"" object"
instead of just copying the object.
Aka the "Unchecked_Conversion" which is a generic function is no
longer just an inlined expression that is just a type conversions
with all checks being disable. The function must now return a "new"
object RM 6.5 (5.5/2, 5.c/2 ), by first requesting an new object
from the Target's storage pool and then copying the Source data to
that new object. So, in Ada 2005 the "Unchecked_Conversion" must be
handled as a true generic function with a true return, instead of a
built-in inline expression.
But GNAT still just performs a simple copy. So, is GNAT or the RM
or is the generic "Unchecked_Conversion" function in error?
In <715a5498-095c-4e61-8a09-8510c19b2553@s16g2000prf.googlegroups.com>, Adam Beneschan <adam@irvine.com> writes:
>On May 9, 11:27=A0pm, a...@att.net wrote:
>> Better look again!
>>
>> Even though a compiler emulates the "Unchecked_Conversion" with a built-i=
>n
>> "pragma inline" being enforced. =A0The function still must be able to be
>> written in Ada.
>
>No, it doesn't. Show me a rule in the RM that says it does. You
>can't. There isn't one.
>
> -- Adam
^ permalink raw reply [relevance 3%]
* Re: A hole in Ada type safety
@ 2011-05-08 20:24 3% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2011-05-08 20:24 UTC (permalink / raw)
Your two programs has pointed out a puzzle in the RM-2005. And that is
does the definition of the standard Generic package Unchecked_Conversion
violate the RM (6.5/(5.5/2).
generic
type Source(<>) is limited private;
type Target(<>) is limited private;
function Ada.Unchecked_Conversion(S : Source) return Target;
pragma Convention(Intrinsic, Ada.Unchecked_Conversion);
pragma Pure(Ada.Unchecked_Conversion);
And when you compile the RM Ada 95 specification and body version of
the Unchecked_Conversion using Ada 2005 compiler you get the following
errors:
(Ada 2005) cannot copy object of a limited type (RM-2005 6.5(5.5/2))
return by reference not permitted in Ada 2005
consider switching to return of access type
But that suggest the RM standard generic Unchecked_Conversion is obsolete
in its current version or is in error. And yes, I know that mostly the
compiler emulates the Unchecked_Conversion body, but that not always an
option.
Now, since one reason the extended return statement was created was to
handle "Limited Private" type the simple and return aggregate statements
are out.
And, using a simple design of the extended return statement causes semantic
error in Ada 95/2005 because any reference to an unconstrained Target is
not valid. Such as:
return Result : Target do -- not valid, must be initialized
-- in this form (Discriminant)
Result := Target ( Object_Access.all ) ;
end return ;
So, how does one use this extended return statement to return a
"Unconstrained Discriminated Limited Private" object for this type of
generic function? Or is the Unchecked_Conversion generic function a
violation of the RM 2005 rules?
In <87pqntscwj.fsf@mid.deneb.enyo.de>, Florian Weimer <fw@deneb.enyo.de> writes:
>* Dmitry A. Kazakov:
>
>> Then a built-in access-to-component type might be a better solution. It
>> would eliminate a need for components to be aliased. Since the offset is
>> statically known (or a function that calculates it is), it need not to be
>> kept anywhere.
>
>You'd still have the safety hazard with the reference to the outer
>record. There are is some impact on encapsulation which has to be
>considered. And it's not going to help with the original problem (a
>safer replacement for discriminants with defaults).
>
>> OK, but you need to create the first reference somehow.
>
>Uhm, I had imagined you'd use an allocator for that. The whole thing
>is meant to be a bit similar to access values.
>
>>>> IMO weak references are quite useless if do not support notifications (when
>>>> the last strong reference is removed). I.e. you need a list of weak
>>>> reference holders.
>>>
>>> I think they are supposed to be used for parent pointers in trees, for
>>> instance, to avoid the cycle issue. Not so much for finalization.
>>
>> I rather use: parent-->child is a plain pointer, child-->parent is a
>> strong reference.
>
>Dereferencing a weak pointer incurs a run-time check and operations on
>the counters (if reference counting is used), and the parent pointer
>is only needed for some traversal operations, so weak pointers upwards
>seem the way to go.
>
>> The most interesting cases for weak references are in the first line
>> finalization notification. E.g. cached objects.
>
>You would get that with controlled types.
>
>I don't think weak references work for caches if you have reference
>counts and precise finalization because the last reference to the
>cached object goes away too soon. There are different types of
>references (sometimes called "weak", too) which are cleared by the
>memory manager if it cannot satisfy an allocation request, but this
>raises awkward concurrency issues, and this wouldn't actually need
>references, you'd just have to register those special references with
>the memory manager.
>
>> I think that the issue is too varying and complex to have it
>> built-in. I would prefer if Ada provided mechanisms for
>> implementation of such stuff at the library level. E.g. user-defined
>> access types with primitive referencing, dereferencing, finalization
>> operations. Classes of access types etc.
>
>A pure library implementation would make certain optimizations
>difficult or impossible: for example, link-time replacement of
>tasking-safe counter implementations when there is no tasking, or
>avoidance of repeated counter operations on the same object. It also
>requires a lot of mechanics, adding more complexity to the language
>than a built-in facility.
^ permalink raw reply [relevance 3%]
* Re: A hole in Ada type safety
2011-04-30 11:56 0% ` Robert A Duff
@ 2011-04-30 16:16 0% ` Florian Weimer
2011-05-14 23:47 0% ` anon
0 siblings, 1 reply; 200+ results
From: Florian Weimer @ 2011-04-30 16:16 UTC (permalink / raw)
* Robert A. Duff:
> Florian Weimer <fw@deneb.enyo.de> writes:
>
>> I don't know if this is a new observation---I couldn't find
>> documentation for it.
>
> It's not new. It is documented in AARM-3.7.2(4,4.a),
> which dates back to Ada 83 days.
Ah. I didn't realize that call to Convert was already erroneous.
It does not seem possible to extend the restrictions on 'Access
prefixes to to subprogram parameters (due to the way controlled types
are implemented, for example).
>> Our implementation lacks the full power of Ada.Unchecked_Conversion
>> because it does not supported limited or unconstrained types. However,
>> it is sufficient to break type safety.
>
> Yes. Anything that is erroneous necessarily breaks type safety.
> If you look up "erroneous execution" in the index, you'll find
> them all.
My concern was that this was not explicitly labeled as erroneous. 8-)
> Your comment, "This note shows that a combination of safe-looking
> language features can be used to undermine type safety, too."
> is the key point. It is indeed unfortunate when "safe-looking"
> features can be erroneous.
And once there is something like this in the language, it is difficult
to decide if a new addition (such as aliased parameters) make things
worse or not.
^ permalink raw reply [relevance 0%]
* Re: A hole in Ada type safety
2011-04-30 8:41 3% A hole in Ada type safety Florian Weimer
@ 2011-04-30 11:56 0% ` Robert A Duff
2011-04-30 16:16 0% ` Florian Weimer
2 siblings, 1 reply; 200+ results
From: Robert A Duff @ 2011-04-30 11:56 UTC (permalink / raw)
Florian Weimer <fw@deneb.enyo.de> writes:
> I don't know if this is a new observation---I couldn't find
> documentation for it.
It's not new. It is documented in AARM-3.7.2(4,4.a),
which dates back to Ada 83 days.
> When the inner function Convert is called, the discriminant Sel of M
> has the value Target_Field, thus the component M.T can be
> dereferenced. The assignment statement in Convert changes the
> discriminant and the value. But the source value S is still reachable
> as an object of type Target because the parameter T aliases the
> component M.T, so the return statement executes without raising an
> exception.
Well, the program exhibits erroneous (i.e. unpredictable) behavior,
so anything could happen. The above description is likely to happen.
> Our implementation lacks the full power of Ada.Unchecked_Conversion
> because it does not supported limited or unconstrained types. However,
> it is sufficient to break type safety.
Yes. Anything that is erroneous necessarily breaks type safety.
If you look up "erroneous execution" in the index, you'll find
them all.
Your comment, "This note shows that a combination of safe-looking
language features can be used to undermine type safety, too."
is the key point. It is indeed unfortunate when "safe-looking"
features can be erroneous.
- Bob
^ permalink raw reply [relevance 0%]
* A hole in Ada type safety
@ 2011-04-30 8:41 3% Florian Weimer
2011-04-30 11:56 0% ` Robert A Duff
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Florian Weimer @ 2011-04-30 8:41 UTC (permalink / raw)
I don't know if this is a new observation---I couldn't find
documentation for it. I plan to incorporate feedback into
<http://www.enyo.de/fw/notes/ada-type-safety.html>.
The standard way to show that type safety has been broken in a
language is to implement a cast function Conversion from any type
Source to any type Target:
generic
type Source is private;
type Target is private;
function Conversion (S : Source) return Target;
This generic function can be used like Ada.Unchecked_Conversion:
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Conversion;
procedure Convert_Test is
type Integer_Access is access all Integer;
J : aliased Integer;
J_Access : Integer_Access := J'Access;
function Convert is new Conversion (Integer_Access, Integer);
function Unchecked_Convert is new Ada.Unchecked_Conversion
(Integer_Access, Integer);
begin
Ada.Text_IO.Put_Line (Integer'Image (Convert (J_Access)));
Ada.Text_IO.Put_Line (Integer'Image (Unchecked_Convert (J_Access)));
end Convert_Test;
How can we implement Conversion? It turns out that discriminant
records with defaults combined with aliasing do the trick:
function Conversion (S : Source) return Target is
type Source_Wrapper is tagged record
S : Source;
end record;
type Target_Wrapper is tagged record
T : Target;
end record;
type Selector is (Source_Field, Target_Field);
type Magic (Sel : Selector := Target_Field) is record
case Sel is
when Source_Field =>
S : Source_Wrapper;
when Target_Field =>
T : Target_Wrapper;
end case;
end record;
M : Magic;
function Convert (T : Target_Wrapper) return Target is
begin
M := (Sel => Source_Field, S => (S => S));
return T.T;
end Convert;
begin
return Convert (M.T);
end Conversion;
When the inner function Convert is called, the discriminant Sel of M
has the value Target_Field, thus the component M.T can be
dereferenced. The assignment statement in Convert changes the
discriminant and the value. But the source value S is still reachable
as an object of type Target because the parameter T aliases the
component M.T, so the return statement executes without raising an
exception.
The two tagged records are used to force that the inner Convert
function receives its parameter by reference. Without them, an
implementation would be free to pass the discriminant record Magic by
copy, and aliasing would not occur.
Our implementation lacks the full power of Ada.Unchecked_Conversion
because it does not supported limited or unconstrained types. However,
it is sufficient to break type safety.
^ permalink raw reply [relevance 3%]
* Re: Fun with C
2011-04-17 7:17 3% ` Georg Bauhaus
2011-04-17 8:29 0% ` Martin
@ 2011-04-17 18:19 0% ` George P.
1 sibling, 0 replies; 200+ results
From: George P. @ 2011-04-17 18:19 UTC (permalink / raw)
On Apr 17, 3:17 am, Georg Bauhaus <rm.dash-bauh...@futureapps.de>
wrote:
> On 4/16/11 11:12 PM, Ludovic Brenta wrote:
>
> > "Nasser M. Abbasi"<n...@12000.org> writes:
> >> $ gcc -Wall t.c
> >> $ ./a.out
> >> R = 33554416
>
> > So R = 2**25 - 16, the correct answer is -16, so the actual result is
> > the correct one except for bit 24, which is 1 when it should be zero.
>
> > Out of curiosity, is this actual result a predictable consequence of the
> > language definition, or is it undefined behavior?
>
> Why, it is the same in Ada.
>
> with Ada.Text_IO; use Ada.Text_IO;
> with Ada.Unchecked_Conversion;
>
> procedure Conv is
>
> type UInt is mod 2**32;
> type Int is range -2**31 .. 2**31 -1;
>
> function To_UInt is new Ada.Unchecked_Conversion(Int, UInt);
> N: UInt := 128;
> I: Int := -2048;
> R : Int;
> begin
> R := Int(To_UInt(I) / N);
> Put_Line ("R =" & Int'Image(R));
> end;
Not exactly, here you have at least freedom and understanding what is
being cast to what. As I mentioned I have no problem C# giving
compile error, screeming - tell me exactly what to do here. BTW, it
defaults result to a long int, complaining about assigning it to int.
Not to mentioned that negative integer number may be larger then
unsigned. I am now looking at the rest the code to see where else
could be the same type of cr..p.
George
^ permalink raw reply [relevance 0%]
* Re: Fun with C
2011-04-17 7:17 3% ` Georg Bauhaus
@ 2011-04-17 8:40 2% ` Georg Bauhaus
1 sibling, 0 replies; 200+ results
From: Georg Bauhaus @ 2011-04-17 8:40 UTC (permalink / raw)
On 4/16/11 11:12 PM, Ludovic Brenta wrote:
> Out of curiosity, is this actual result a predictable consequence of the
> language definition, or is it undefined behavior?
C's definitions of what happens to arithmetic operands look
like an interesting exercise in making definitions (work).
The standard seems to land the resulting rules somewhere
between Ada types and the effect of Ada.Unchecked_Conversion.
It is not unchecked conversion, I think.
C's rules do not assume a specific bit representation of
arithmetic types, IINM. An interesting consequence is
that the C99 Rationale lists specific circumstances in which
a result "must be dubbed _questionably signed_". But,
"(...) of course, _all of these ambiguities can be avoided
by a judicous use of casts_."
-- C99 Rationale, �6.3.1.1
A difference between C and Ada here will be the difference
between *can* and *must*, as in "can be avoided using casts"
and "must be stated using conversions". Consider programmers
shouting
I can!
or
I must!
If the first means "I can do it!" and latter means "It forces me
to do that...", this puts humans in two opposing camps. Guess who
will be considered to have the more positive attitude. :-)
(Placement in this or that group will not be based on a consistent
set of facts, of course, but with such a set, we we'd have much
less to shout at each other...)
^ permalink raw reply [relevance 2%]
* Re: Fun with C
2011-04-17 7:17 3% ` Georg Bauhaus
@ 2011-04-17 8:29 0% ` Martin
2011-04-17 18:19 0% ` George P.
1 sibling, 0 replies; 200+ results
From: Martin @ 2011-04-17 8:29 UTC (permalink / raw)
On Apr 17, 8:17 am, Georg Bauhaus <rm.dash-bauh...@futureapps.de>
wrote:
> On 4/16/11 11:12 PM, Ludovic Brenta wrote:
>
> > "Nasser M. Abbasi"<n...@12000.org> writes:
> >> $ gcc -Wall t.c
> >> $ ./a.out
> >> R = 33554416
>
> > So R = 2**25 - 16, the correct answer is -16, so the actual result is
> > the correct one except for bit 24, which is 1 when it should be zero.
>
> > Out of curiosity, is this actual result a predictable consequence of the
> > language definition, or is it undefined behavior?
>
> Why, it is the same in Ada.
>
> with Ada.Text_IO; use Ada.Text_IO;
> with Ada.Unchecked_Conversion;
>
> procedure Conv is
>
> type UInt is mod 2**32;
> type Int is range -2**31 .. 2**31 -1;
>
> function To_UInt is new Ada.Unchecked_Conversion(Int, UInt);
> N: UInt := 128;
> I: Int := -2048;
> R : Int;
> begin
> R := Int(To_UInt(I) / N);
> Put_Line ("R =" & Int'Image(R));
> end;
Yes, the Ada version is _much_ more obvious and understandable
But I suspect the _intent_ is of the original code is (probably):
with Ada.Text_IO; use Ada.Text_IO;
procedure Conv is
type UInt is mod 2**32;
type Int is range -2**31 .. 2**31 -1;
N: UInt := 128;
I: Int := -2048;
R : Int;
begin
R := I / Int (N);
Put_Line ("R =" & Int'Image(R));
end;
-- Martin
^ permalink raw reply [relevance 0%]
* Re: Fun with C
@ 2011-04-17 7:17 3% ` Georg Bauhaus
2011-04-17 8:29 0% ` Martin
2011-04-17 18:19 0% ` George P.
2011-04-17 8:40 2% ` Georg Bauhaus
1 sibling, 2 replies; 200+ results
From: Georg Bauhaus @ 2011-04-17 7:17 UTC (permalink / raw)
On 4/16/11 11:12 PM, Ludovic Brenta wrote:
> "Nasser M. Abbasi"<nma@12000.org> writes:
>> $ gcc -Wall t.c
>> $ ./a.out
>> R = 33554416
>
> So R = 2**25 - 16, the correct answer is -16, so the actual result is
> the correct one except for bit 24, which is 1 when it should be zero.
>
> Out of curiosity, is this actual result a predictable consequence of the
> language definition, or is it undefined behavior?
Why, it is the same in Ada.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
procedure Conv is
type UInt is mod 2**32;
type Int is range -2**31 .. 2**31 -1;
function To_UInt is new Ada.Unchecked_Conversion(Int, UInt);
N: UInt := 128;
I: Int := -2048;
R : Int;
begin
R := Int(To_UInt(I) / N);
Put_Line ("R =" & Int'Image(R));
end;
^ permalink raw reply [relevance 3%]
* Re: GNAT.Serial_Communications
2011-04-15 18:01 3% ` GNAT.Serial_Communications Jeffrey Carter
@ 2011-04-16 10:21 0% ` tonyg
0 siblings, 0 replies; 200+ results
From: tonyg @ 2011-04-16 10:21 UTC (permalink / raw)
On Apr 15, 7:01 pm, Jeffrey Carter
<spam.jrcarter....@spam.not.acm.org> wrote:
> On 04/15/2011 09:32 AM, tonyg wrote:
>
> > for count in
> > 1..Ada.Streams.Stream_Element_Offset(The_String'Length) loop
> > Return_Value(count) :=
> > character'pos(The_String(Integer(count)));
>
> You assume that The_String'First = 1, which will not be the case if you pass a
> slice with a different lower bound. However, that will cause Constraint_Error
> (unless you have turned off this check), which does not seem to be the problem.
>
> > Return Return_Value(1..The_String'Length);
>
> I see no reason for the slice.
>
> You should be able to replace the body of String_To_Stream with a simple
> Unchecked_Conversion:
>
> with Ada.Streams;
> with Ada.Text_IO;
> with Ada.Unchecked_Conversion;
>
> procedure Stream_Convert is
> subtype String3 is String (1 .. 3);
>
> From : constant String3 := "abc";
>
> subtype Stream3 is Ada.Streams.Stream_Element_Array (1 .. From'Length);
>
> function To_Stream is new Ada.Unchecked_Conversion (Source => String3,
> Target => Stream3);
>
> To : Stream3;
> begin -- Stream_Convert
> To := To_Stream (From);
>
> Output : for I in To'range loop
> Ada.Text_IO.Put (Item => To (I)'Img);
> end loop Output;
> end Stream_Convert;
>
> --
> Jeff Carter
> "Unix and C are the ultimate computer viruses."
> Richard Gabriel
> 99
I did that because I got a bit paranoid with the way ada handles
strings after finding out something new in the way its handles them. I
used to think that a slice's indexes changed when it went through a
procedure or functions paramaters but came unstuck by it. Thanks for
the code, I'll give it a try once I get this naughty serial port
sorted.
^ permalink raw reply [relevance 0%]
* Re: GNAT.Serial_Communications
@ 2011-04-15 18:01 3% ` Jeffrey Carter
2011-04-16 10:21 0% ` GNAT.Serial_Communications tonyg
0 siblings, 1 reply; 200+ results
From: Jeffrey Carter @ 2011-04-15 18:01 UTC (permalink / raw)
On 04/15/2011 09:32 AM, tonyg wrote:
> for count in
> 1..Ada.Streams.Stream_Element_Offset(The_String'Length) loop
> Return_Value(count) :=
> character'pos(The_String(Integer(count)));
You assume that The_String'First = 1, which will not be the case if you pass a
slice with a different lower bound. However, that will cause Constraint_Error
(unless you have turned off this check), which does not seem to be the problem.
> Return Return_Value(1..The_String'Length);
I see no reason for the slice.
You should be able to replace the body of String_To_Stream with a simple
Unchecked_Conversion:
with Ada.Streams;
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
procedure Stream_Convert is
subtype String3 is String (1 .. 3);
From : constant String3 := "abc";
subtype Stream3 is Ada.Streams.Stream_Element_Array (1 .. From'Length);
function To_Stream is new Ada.Unchecked_Conversion (Source => String3,
Target => Stream3);
To : Stream3;
begin -- Stream_Convert
To := To_Stream (From);
Output : for I in To'range loop
Ada.Text_IO.Put (Item => To (I)'Img);
end loop Output;
end Stream_Convert;
--
Jeff Carter
"Unix and C are the ultimate computer viruses."
Richard Gabriel
99
^ permalink raw reply [relevance 3%]
* Re: Help with low level Ada
2011-03-17 17:55 2% ` Jeffrey Carter
@ 2011-03-17 19:30 0% ` Syntax Issues
0 siblings, 0 replies; 200+ results
From: Syntax Issues @ 2011-03-17 19:30 UTC (permalink / raw)
On Mar 17, 1:55 pm, Jeffrey Carter
<spam.jrcarter....@spam.not.acm.org> wrote:
> On 03/17/2011 07:31 AM, Syntax Issues wrote:
>
>
>
>
>
>
>
>
>
> > unsigned ColorNormalize (vec3_t rgb){
> > unsigned c;
> > float max;
> > ...
> > ((byte *)&c)[0] = rgb[0] * max;
> > ((byte *)&c)[1] = rgb[1] * max;
> > ((byte *)&c)[2] = rgb[2] * max;
> > ((byte *)&c)[3] = 255;
> > return c;
> > }
> > function Normalize
> > (Red_Green_Blue : in Vector_Color)
> > return Integer_Color
> > is
> > Result : Integer_Color := 0;
> > Maximum : Float_4 := 0.0;
> > begin
> > ...
> > return
> > -- ???!!??!?!? Byte(Red_Green_Blue(1) * Maximum) +
> > -- ???!!??!?!? Byte(Red_Green_Blue(2) * Maximum) +
> > -- ???!!??!?!? Byte(Red_Green_Blue(3) * Maximum);
> > end Normalize;
>
> First, I'd probably do something like
>
> type Color_ID is (Red, Blue, Green);
>
> subtype Natural_Float_4 is Float_4 range 0.0 .. Float_4'Last;
>
> type Vector_Color is array (Color_ID) of Natural_Float_4;
>
> so I can say Red_Green_Blue (Red). (I presume that the components of
> Vector_Color cannot be negative; better to make that clear in the code and
> enforced by the language.)
>
> One approach to this is
>
> type Byte is mod 2 ** 8;
>
> type Color_Bytes is record
> Red : Byte;
> Green : Byte;
> Blue : Byte;
> Unused : Byte;
> end record;
> for Color_Bytes use
> Red at 0 range 0 .. 7;
> Green at 1 range 0 .. 7;
> Blue at 2 range 0 .. 7;
> Unused at 3 range 0 .. 7;
> end record;
> for Color_Bytes'Size use Integer_Color'Size;
>
> You may need to change the representation clause to get the components in the
> right places.
>
> function Convert is new Ada.Unchecked_Conversion
> (Source => Color_Bytes, Target => Integer_Color);
>
> Result := Color_Bytes'(Red => Byte (Red_Green_Blue (Red) * Maximum),
> Green => Byte (Red_Green_Blue (Green) * Maximum),
> Blue => Byte (Red_Green_Blue (Blue) * Maximum),
> Unused => Byte'Last);
>
> return Convert (Result);
>
> You missed out the assignment of 255 to the 4th byte.
>
> Another way is to use an array of 4 Bytes that you unchecked convert to the
> result type.
>
> Finally, if you use a modular type from package Interfaces you can shift the
> products into their correct positions and "or" them together. And you can always
> imitate that by multiplying by a power of 2 and adding them together:
>
> Result := Integer_Color (Red_Green_Blue (Red) * Maximum) * 2 ** 0 +
> Integer_Color (Red_Green_Blue (Green) * Maximum) * 2 ** 8 +
> Integer_Color (Red_Green_Blue (Blue) * Maximum) * 2 ** 16 +
> 255 * 2 ** 24;
>
> The compiler will often replace these by shifts.
>
> > float AngleMod (float angle){
> > return (360.0/65536) * ((int)(angle * (65536/360.0))& 65535);
> > }
> > function Mod_Angle
> > (Angle : in Float_4)
> > return Float_4
> > is
> > begin
> > return (360.0 / 65536.0) * (Integer_4_Signed(Angle * (65536.0 /
> > 360.0)) ---???!?!?!& 65535);
> > end Mod_Angle;
>
> Bitwise "and" is defined for all modular types. The only wrinkle is what happens
> if Angle is negative. If that's not allowed (see Natural_Float_4 above), then
> it's fairly easy:
>
> type Integer_4_Unsigned is mod Integer_4_Signed'Size;
>
> return (360.0 / 65536.0) *
> Float_4 (Integer_4_Unsigned (Angle * (65536.0 / 360.0) ) and 65535);
>
> Otherwise, you need to do some unchecked converting between signed and modular
> types of the same size:
>
> function Convert is new Ada.Unchecked_Conversion
> (Source => Integer_4_Signed, Target => Integer_4_Unsigned);
>
> return (360.0 / 65536.0) *
> Float_4 (Convert (Integer_4_Signed (Angle * (65536.0 / 360.0) ) ) and
> 65535);
>
> (I presume that Integer_4_Signed is 4 bytes from its name, so the result of
> "and"ing that with 65535 will always be non-negative. In that case, there's no
> need to convert back to signed before converting to Float_4.)
>
> > int NearestPowerOfTwo (int number, qboolean roundDown){
> > int n = 1;
> > if (number<= 0)
> > return 1;
> > while (n< number)
> > n<<= 1;
> > if (roundDown){
> > if (n> number)
> > n>>= 1;
> > }
> > return n;
> > }
>
> Shift operations are defined for the modular types defined in package
> Interfaces. As mentioned above, the same effect can often be obtained with
> multiplication and division by powers of 2, and the compiler will often replace
> them with shifts:
>
> while N < Number loop
> N := 2 * N;
> end loop;
>
> if Round_Down and N > Number then
> N := N / 2;
> end if;
>
> You could also use the Log function from Ada.Numerics.Generic_Elementary_Functions:
>
> type Big is digits 15;
>
> package Math is new Ada.Numerics.Generic_Elementary_Functions
> (Float_Type => Big);
>
> N := 2 ** Integer (Math.Log (Big (Number), 2.0) );
>
> if N < Number then
> N := 2 * N;
> end if;
>
> if Round_Down and N > Number then
> N := N / 2;
> end if;
>
> --
> Jeff Carter
> "We use a large, vibrating egg."
> Annie Hall
> 44
Excellent, I really appreciate the help.
^ permalink raw reply [relevance 0%]
* Re: Help with low level Ada
@ 2011-03-17 17:55 2% ` Jeffrey Carter
2011-03-17 19:30 0% ` Syntax Issues
0 siblings, 1 reply; 200+ results
From: Jeffrey Carter @ 2011-03-17 17:55 UTC (permalink / raw)
On 03/17/2011 07:31 AM, Syntax Issues wrote:
> unsigned ColorNormalize (vec3_t rgb){
> unsigned c;
> float max;
> ...
> ((byte *)&c)[0] = rgb[0] * max;
> ((byte *)&c)[1] = rgb[1] * max;
> ((byte *)&c)[2] = rgb[2] * max;
> ((byte *)&c)[3] = 255;
> return c;
> }
> function Normalize
> (Red_Green_Blue : in Vector_Color)
> return Integer_Color
> is
> Result : Integer_Color := 0;
> Maximum : Float_4 := 0.0;
> begin
> ...
> return
> -- ???!!??!?!? Byte(Red_Green_Blue(1) * Maximum) +
> -- ???!!??!?!? Byte(Red_Green_Blue(2) * Maximum) +
> -- ???!!??!?!? Byte(Red_Green_Blue(3) * Maximum);
> end Normalize;
First, I'd probably do something like
type Color_ID is (Red, Blue, Green);
subtype Natural_Float_4 is Float_4 range 0.0 .. Float_4'Last;
type Vector_Color is array (Color_ID) of Natural_Float_4;
so I can say Red_Green_Blue (Red). (I presume that the components of
Vector_Color cannot be negative; better to make that clear in the code and
enforced by the language.)
One approach to this is
type Byte is mod 2 ** 8;
type Color_Bytes is record
Red : Byte;
Green : Byte;
Blue : Byte;
Unused : Byte;
end record;
for Color_Bytes use
Red at 0 range 0 .. 7;
Green at 1 range 0 .. 7;
Blue at 2 range 0 .. 7;
Unused at 3 range 0 .. 7;
end record;
for Color_Bytes'Size use Integer_Color'Size;
You may need to change the representation clause to get the components in the
right places.
function Convert is new Ada.Unchecked_Conversion
(Source => Color_Bytes, Target => Integer_Color);
Result := Color_Bytes'(Red => Byte (Red_Green_Blue (Red) * Maximum),
Green => Byte (Red_Green_Blue (Green) * Maximum),
Blue => Byte (Red_Green_Blue (Blue) * Maximum),
Unused => Byte'Last);
return Convert (Result);
You missed out the assignment of 255 to the 4th byte.
Another way is to use an array of 4 Bytes that you unchecked convert to the
result type.
Finally, if you use a modular type from package Interfaces you can shift the
products into their correct positions and "or" them together. And you can always
imitate that by multiplying by a power of 2 and adding them together:
Result := Integer_Color (Red_Green_Blue (Red) * Maximum) * 2 ** 0 +
Integer_Color (Red_Green_Blue (Green) * Maximum) * 2 ** 8 +
Integer_Color (Red_Green_Blue (Blue) * Maximum) * 2 ** 16 +
255 * 2 ** 24;
The compiler will often replace these by shifts.
> float AngleMod (float angle){
> return (360.0/65536) * ((int)(angle * (65536/360.0))& 65535);
> }
> function Mod_Angle
> (Angle : in Float_4)
> return Float_4
> is
> begin
> return (360.0 / 65536.0) * (Integer_4_Signed(Angle * (65536.0 /
> 360.0)) ---???!?!?!& 65535);
> end Mod_Angle;
Bitwise "and" is defined for all modular types. The only wrinkle is what happens
if Angle is negative. If that's not allowed (see Natural_Float_4 above), then
it's fairly easy:
type Integer_4_Unsigned is mod Integer_4_Signed'Size;
return (360.0 / 65536.0) *
Float_4 (Integer_4_Unsigned (Angle * (65536.0 / 360.0) ) and 65535);
Otherwise, you need to do some unchecked converting between signed and modular
types of the same size:
function Convert is new Ada.Unchecked_Conversion
(Source => Integer_4_Signed, Target => Integer_4_Unsigned);
return (360.0 / 65536.0) *
Float_4 (Convert (Integer_4_Signed (Angle * (65536.0 / 360.0) ) ) and
65535);
(I presume that Integer_4_Signed is 4 bytes from its name, so the result of
"and"ing that with 65535 will always be non-negative. In that case, there's no
need to convert back to signed before converting to Float_4.)
> int NearestPowerOfTwo (int number, qboolean roundDown){
> int n = 1;
> if (number<= 0)
> return 1;
> while (n< number)
> n<<= 1;
> if (roundDown){
> if (n> number)
> n>>= 1;
> }
> return n;
> }
Shift operations are defined for the modular types defined in package
Interfaces. As mentioned above, the same effect can often be obtained with
multiplication and division by powers of 2, and the compiler will often replace
them with shifts:
while N < Number loop
N := 2 * N;
end loop;
if Round_Down and N > Number then
N := N / 2;
end if;
You could also use the Log function from Ada.Numerics.Generic_Elementary_Functions:
type Big is digits 15;
package Math is new Ada.Numerics.Generic_Elementary_Functions
(Float_Type => Big);
N := 2 ** Integer (Math.Log (Big (Number), 2.0) );
if N < Number then
N := 2 * N;
end if;
if Round_Down and N > Number then
N := N / 2;
end if;
--
Jeff Carter
"We use a large, vibrating egg."
Annie Hall
44
^ permalink raw reply [relevance 2%]
* Re: Adress => Access: types for unchecked conversion have different sizes
2011-03-12 15:08 2% Adress => Access: types for unchecked conversion have different sizes Martin Krischik
2011-03-12 17:00 0% ` Edward Fish
@ 2011-03-13 3:32 0% ` Randy Brukardt
1 sibling, 0 replies; 200+ results
From: Randy Brukardt @ 2011-03-13 3:32 UTC (permalink / raw)
"Martin Krischik" <krischik@users.sourceforge.net> wrote in message
news:op.vr8kbsndz25lew@macpro-eth1.krischik.com...
...
> The code in question is:
>
> {{{
> declare
> subtype Path_String is String (1 .. Filename_Len);
> type Path_String_Access is access Path_String;
As someone else noted, this is a pool-specific access type. It should never
point at anything other than memory created by an allocator. (Janus/Ada
actually checks that; you'd get Constraint_Error if you tried to dereference
the result of the code below.) If you need to point it at something else,
you need to use a general access type (that is, "access all").
> function Address_To_Access is new
> Ada.Unchecked_Conversion
> (Source => Address,
> Target => Path_String_Access);
>
> Path_Access : constant Path_String_Access :=
> Address_To_Access (Filename_Addr);
>
> begin
> Last := Filename_Len;
> Name (1 .. Last) := Path_Access.all;
> end;
> }}}
...
> And I wonder if some `for Address use` magic would not be more appropriate
> here.
No, that is a lousy way to handle this sort of problem, as is this code.
(This appears to be an old Ada 83 design, completely inappropriate in modern
Ada -- and a lousy idea in Ada 83, too.). Ada has package
Address_to_Access_Conversions for this sort of problem. (That package also
has an annoyance: it declares a new access type for each instance, forcing
some extra conversions if you intend to use a type declared elsewhere.)
Lastly, access to unconstrained is rarely the right thing in such code; it
might work on some compiler some of the time, but will not work in general.
(Note that Annex B does not require such things to work for interfacing, and
using addresses is very similar to interfacing.)
Randy.
^ permalink raw reply [relevance 0%]
* Re: Adress => Access: types for unchecked conversion have different sizes
2011-03-12 15:08 2% Adress => Access: types for unchecked conversion have different sizes Martin Krischik
@ 2011-03-12 17:00 0% ` Edward Fish
2011-03-13 3:32 0% ` Randy Brukardt
1 sibling, 0 replies; 200+ results
From: Edward Fish @ 2011-03-12 17:00 UTC (permalink / raw)
On Mar 12, 8:08 am, "Martin Krischik" <krisc...@users.sourceforge.net>
wrote:
> Hello,
>
> I currently have another go at building GNAT for MAx OS X. the current
> error message I am looking at is:
>
> {{{
> /Volumes/Daten/Developer/MacPorts/dports/lang/gnat-gcc/work/build/./gcc/xgcc
> -B/Volumes/Daten/Developer/MacPorts/dports/lang/gnat-gcc/work/build/./gcc/
> -B/opt/local/x86_64-apple-darwin10/bin/
> -B/opt/local/x86_64-apple-darwin10/lib/ -isystem
> /opt/local/x86_64-apple-darwin10/include -isystem
> /opt/local/x86_64-apple-darwin10/sys-include -c -g -O2 -m32 -fPIC
> -pipe -W -Wall -gnatpg -m32 a-direct.adb -o a-direct.o
> a-direct.adb:676:13: warning: types for unchecked conversion have
> different sizes
>
> }}}
>
> The code in question is:
>
> {{{
> declare
> subtype Path_String is String (1 .. Filename_Len);
> type Path_String_Access is access Path_String;
>
> function Address_To_Access is new
> Ada.Unchecked_Conversion
> (Source => Address,
> Target => Path_String_Access);
>
> Path_Access : constant Path_String_Access :=
> Address_To_Access (Filename_Addr);
>
> begin
> Last := Filename_Len;
> Name (1 .. Last) := Path_Access.all;
> end;
>
> }}}
>
> Strange. Anybody got an idea what went wrong here?
>
> And I wonder if some `for Address use` magic would not be more appropriate
> here.
>
> Regards
>
> Martin
> --
> Martin Krischik
> mailto://krisc...@users.sourceforge.nethttps://sourceforge.net/users/krischik
You could try adding ALL to Path_String_Access; IIRC Access w/o the
ALL is a
fat-pointer (keeping info about the object) whereas the Access ALL is
a thin-
pointer (an address) in GNAT.
^ permalink raw reply [relevance 0%]
* Adress => Access: types for unchecked conversion have different sizes
@ 2011-03-12 15:08 2% Martin Krischik
2011-03-12 17:00 0% ` Edward Fish
2011-03-13 3:32 0% ` Randy Brukardt
0 siblings, 2 replies; 200+ results
From: Martin Krischik @ 2011-03-12 15:08 UTC (permalink / raw)
Hello,
I currently have another go at building GNAT for MAx OS X. the current
error message I am looking at is:
{{{
/Volumes/Daten/Developer/MacPorts/dports/lang/gnat-gcc/work/build/./gcc/xgcc
-B/Volumes/Daten/Developer/MacPorts/dports/lang/gnat-gcc/work/build/./gcc/
-B/opt/local/x86_64-apple-darwin10/bin/
-B/opt/local/x86_64-apple-darwin10/lib/ -isystem
/opt/local/x86_64-apple-darwin10/include -isystem
/opt/local/x86_64-apple-darwin10/sys-include -c -g -O2 -m32 -fPIC
-pipe -W -Wall -gnatpg -m32 a-direct.adb -o a-direct.o
a-direct.adb:676:13: warning: types for unchecked conversion have
different sizes
}}}
The code in question is:
{{{
declare
subtype Path_String is String (1 .. Filename_Len);
type Path_String_Access is access Path_String;
function Address_To_Access is new
Ada.Unchecked_Conversion
(Source => Address,
Target => Path_String_Access);
Path_Access : constant Path_String_Access :=
Address_To_Access (Filename_Addr);
begin
Last := Filename_Len;
Name (1 .. Last) := Path_Access.all;
end;
}}}
Strange. Anybody got an idea what went wrong here?
And I wonder if some `for Address use` magic would not be more appropriate
here.
Regards
Martin
--
Martin Krischik
mailto://krischik@users.sourceforge.net
https://sourceforge.net/users/krischik
^ permalink raw reply [relevance 2%]
* Re: bit numbers in packed arrays of Boolean
2010-08-31 11:14 2% bit numbers in packed arrays of Boolean Stephen Leake
@ 2010-08-31 12:34 0% ` Niklas Holsti
0 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2010-08-31 12:34 UTC (permalink / raw)
Stephen Leake wrote:
> I was pleasantly surprised to discover that given this code compiled
> with GNAT 6.2.1 for an Intel processor:
>
> subtype Bit_Index_16_Type is Integer range 0 .. 15;
> type Bit_Array_16_Type is array (Bit_Index_16_Type) of Boolean;
> pragma Pack (Bit_Array_16_Type);
> for Bit_Array_16_Type'Size use 16;
>
> function To_Bit_Array is new Ada.Unchecked_Conversion
> (Source => Interfaces.Unsigned_16,
> Target => Bit_Array_16_Type);
>
> Word : constant Interfaces.Unsigned_16 := 2#1000_0000_0000_0000#;
> Bits : constant Bit_Array_16_Type := To_Bit_Array (Word);
>
> the index of Bit_Array_Type indexes the bits of Unsigned_16 in
> little-endian order. That is, Bits (15) = 1 (most significant bit), Bits
> (0) = 0 (least significant bit).
>
> LRM 13.9(5) says Bit_Array_16_Type and Unsigned_16 have the same
> representation,
Well, not quite, as I understand that point in the LRM. It says that
(under several conditions) the *value* of the object Bits has the same
representation as the *value* of the object Word.
It makes no sense to say that (or even to ask if) the two types
Bit_Array_16_Type and Unsigned_16 have the same representation, because
their value-sets are disjoint, so we cannot ask if they represent "the
same value" in the same way.
> but it does not specifically address the index order.
Right. So we do not know at which index in Bits a given bit from Word
ends up. I believe they could even be in some scrambled order, not
necessarily 0 .. 15 or 15 .. 0.
> Is this bit order required by some other clause?
I believe not. This is one reason why, when I need to access specific
bits in a word, I prefer to use Unsigned_xx types and their masking and
shifting operations, not packed arrays. I use packed arrays only when
the index order does not matter (or when portability does not matter,
which is basically never).
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* bit numbers in packed arrays of Boolean
@ 2010-08-31 11:14 2% Stephen Leake
2010-08-31 12:34 0% ` Niklas Holsti
0 siblings, 1 reply; 200+ results
From: Stephen Leake @ 2010-08-31 11:14 UTC (permalink / raw)
I was pleasantly surprised to discover that given this code compiled
with GNAT 6.2.1 for an Intel processor:
subtype Bit_Index_16_Type is Integer range 0 .. 15;
type Bit_Array_16_Type is array (Bit_Index_16_Type) of Boolean;
pragma Pack (Bit_Array_16_Type);
for Bit_Array_16_Type'Size use 16;
function To_Bit_Array is new Ada.Unchecked_Conversion
(Source => Interfaces.Unsigned_16,
Target => Bit_Array_16_Type);
Word : constant Interfaces.Unsigned_16 := 2#1000_0000_0000_0000#;
Bits : constant Bit_Array_16_Type := To_Bit_Array (Word);
the index of Bit_Array_Type indexes the bits of Unsigned_16 in
little-endian order. That is, Bits (15) = 1 (most significant bit), Bits
(0) = 0 (least significant bit).
LRM 13.9(5) says Bit_Array_16_Type and Unsigned_16 have the same
representation, but it does not specifically address the index order.
Is this bit order required by some other clause? Do other compilers
follow it?
I don't have access to GNAT for a big-endian processor; can anyone
confirm what happens there?
Ideally, there would be a way to force the other bit order, as
'Bit_Order does for records.
--
-- Stephe
^ permalink raw reply [relevance 2%]
* Re: S-expression I/O in Ada
@ 2010-08-17 19:00 2% ` Jeffrey Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey Carter @ 2010-08-17 19:00 UTC (permalink / raw)
On 08/17/2010 10:01 AM, Natasha Kerensikova wrote:
>
> Even though I'm much more used to C than to Ada, I have the feeling it's
> horribly ugly and that using access types all over the place like I did
> is extremely poor. Yet I just can't find out exactly how it's wrong, nor
> how to get it right.
I would agree. Access types and values should not appear in the visible part of
a package specification if at all possible.
> Would any other you be kind enough to have a look at it, and point me
> where I did wrong and explain me how wrong it is, be it on high-level
> package design to low-level implementation choice and anything in
> between including code style.
It seemed to me that you could implement this without any access types or
values, so I gave it a shot. The following has been compiled:
private with Ada.Containers.Indefinite_Vectors;
private with Ada.Containers.Vectors;
package S_Expressions is
type Atom is private;
function To_Atom (Value : in String) return Atom;
function To_String (Value : in Atom) return String;
generic -- Object_Conversions
type Element (<>) is limited private;
package Object_Conversions is
function To_Atom (Value : in Element) return Atom;
function To_Object (Value : in Atom) return Element;
end Object_Conversions;
type S_Expression (<>) is tagged private; -- An Atom or a list of S_Expression.
function Make (Item : in Atom) return S_Expression;
function Is_Atom (Expression : in S_Expression) return Boolean;
Not_An_Atom : exception;
function To_Atom (Expression : in S_Expression) return Atom;
-- Raises Not_An_Atom if not Is_Atom (Expression);
Empty_List : constant S_Expression;
Not_A_List : exception;
function Append (Onto : in S_Expression; Value : in S_Expression) return
S_Expression;
-- Returns a list consisting of the exisiting list Onto with Value appended
to it.
-- Raises Not_A_List if Is_Atom (Onto);
procedure Iterate
(Over : in S_Expression; Process : not null access procedure (Expression
: in S_Expression; Continue : in out Boolean) );
-- Passes each element of Over to Process in turn, with Continue => True.
-- Returns immediately if Process sets Continue to False; remaining elements
will not be processed.
-- Raises Not_A_List if Is_Atom (Over).
private -- S_Expressions
Byte_Size : constant := 8;
type Byte_Value is mod 2 ** Byte_Size;
package Byte_Lists is new Ada.Containers.Vectors (Index_Type => Positive,
Element_Type => Byte_Value);
type Atom is record
Value : Byte_Lists.Vector;
end record;
type Root is tagged null record;
package Lists is new Ada.Containers.Indefinite_Vectors (Index_Type =>
Positive, Element_Type => Root'Class);
type S_Expression (Is_Atom : Boolean) is new Root with record
case Is_Atom is
when False =>
List : Lists.Vector;
when True =>
Value : Atom;
end case;
end record;
Empty_List : constant S_Expression := (Is_Atom => False, List =>
Lists.Empty_Vector);
end S_Expressions;
with Ada.Unchecked_Conversion;
package body S_Expressions is
function To_Atom (Value : in String) return Atom is
Result : Atom;
begin -- To_Atom
All_Characters : for I in Value'range loop
Result.Value.Append (New_Item => Character'Pos (Value (I) ) );
end loop All_Characters;
return Result;
end To_Atom;
function To_String (Value : in Atom) return String is
Result : String (Value.Value.First_Index .. Value.Value.Last_Index);
begin -- To_String
All_Bytes : for I in Result'range loop
Result (I) := Character'Val (Value.Value.Element (I) );
end loop All_Bytes;
return Result;
end To_String;
package body Object_Conversions is
type Byte_List is array (Positive range <>) of Byte_Value;
function To_Atom (Value : in Element) return Atom is
Num_Bytes : constant Positive := (Value'Size + Byte_Size - 1) / Byte_Size;
subtype Element_List is Byte_List (1 .. Num_Bytes);
function Convert is new Ada.Unchecked_Conversion (Source => Element,
Target => Element_List);
Byte : Element_List renames Convert (Value);
Result : Atom;
begin -- To_Atom
All_Bytes : for I in Byte'range loop
Result.Value.Append (New_Item => Byte (I) );
end loop All_Bytes;
return Result;
end To_Atom;
function To_Object (Value : in Atom) return Element is
subtype Element_List is Byte_List (Value.Value.First_Index ..
Value.Value.Last_Index);
function Convert is new Ada.Unchecked_Conversion (Source =>
Element_List, Target => Element);
Byte : Element_List;
begin -- To_Object
All_Bytes : for I in Byte'range loop
Byte (I) := Value.Value.Element (I);
end loop All_Bytes;
return Convert (Byte);
end To_Object;
end Object_Conversions;
function Make (Item : in Atom) return S_Expression is
-- null;
begin -- Make
return S_Expression'(Is_Atom => True, Value => Item);
end Make;
function Is_Atom (Expression : in S_Expression) return Boolean is
-- null;
begin -- Is_Atom
return Expression.Is_Atom;
end Is_Atom;
function To_Atom (Expression : in S_Expression) return Atom is
-- null;
begin -- To_Atom
if not Expression.Is_Atom then
raise Not_An_Atom;
end if;
return Expression.Value;
end To_Atom;
function Append (Onto : in S_Expression; Value : in S_Expression) return
S_Expression is
Result : S_Expression (Is_Atom => False);
begin -- Append
if Onto.Is_Atom then
raise Not_A_List;
end if;
Result.List := Onto.List;
Result.List.Append (New_Item => Value);
return Result;
end Append;
procedure Iterate
(Over : in S_Expression; Process : not null access procedure (Expression
: in S_Expression; Continue : in out Boolean) )
is
Continue : Boolean := True;
begin -- Iterate
if Over.Is_Atom then
raise Not_A_List;
end if;
All_Expressions : for I in Over.List.First_Index .. Over.List.Last_Index loop
Process (Expression => S_Expression (Over.List.Element (I) ), Continue
=> Continue);
exit All_Expressions when not Continue;
end loop All_Expressions;
end Iterate;
end S_Expressions;
I think this includes all necessary functionality to build and process
S-expressions, though you might have some additional operations you might like
to add. Reading it might prove instructional, whether you like this approach or not.
--
Jeff Carter
"I'm a lumberjack and I'm OK."
Monty Python's Flying Circus
54
--- news://freenews.netfront.net/ - complaints: news@netfront.net ---
^ permalink raw reply [relevance 2%]
* Re: What is the best way to convert Integer to Short_Short_Integer?
2010-06-11 1:17 3% What is the best way to convert Integer to Short_Short_Integer? Adrian Hoe
@ 2010-06-11 2:21 0% ` Adrian Hoe
0 siblings, 0 replies; 200+ results
From: Adrian Hoe @ 2010-06-11 2:21 UTC (permalink / raw)
On Jun 11, 9:17 am, Adrian Hoe <aby...@gmail.com> wrote:
> Hi,
>
> Perhaps I have overlook the repository. What is the best (safest) way
> to convert an Integer to Short_Short_Integer?
>
> 1. Using Ada.Unchecked_Conversion raises warning types of unchecked
> conversion have different size.
>
> 2. Using a custom function such as:
>
> function To_Short_Short_Integer ( I : Integer ) return
> SHort_Short_Integer
> is
> function Convert_To_Short_Short_Integer is new
> Ada.Unchecked_Conversion ( Integer, Short_Short_Integer ) ;
> begin
> If I >= Short_Short_Integer'First and I <= Short_Short_Integer'Last
> then
> return Convert_To_Short_Short_Integer ( I );
> else
> raise Range_Error;
> end if;
> end To_Short_Short_Integer;
>
> Again, the Unchecked_Conversion will raise the same warning in (1).
>
> Is (2) the best (safest) way to do the conversion? Is there any better
> method?
>
> Thanks.
> --
> Adrian Hoe
Sorry, I forgot to convert Short_Short_Integer'First and
Short_Short_Integer'Last to Integer.
--
Adrian Hoe
^ permalink raw reply [relevance 0%]
* What is the best way to convert Integer to Short_Short_Integer?
@ 2010-06-11 1:17 3% Adrian Hoe
2010-06-11 2:21 0% ` Adrian Hoe
0 siblings, 1 reply; 200+ results
From: Adrian Hoe @ 2010-06-11 1:17 UTC (permalink / raw)
Hi,
Perhaps I have overlook the repository. What is the best (safest) way
to convert an Integer to Short_Short_Integer?
1. Using Ada.Unchecked_Conversion raises warning types of unchecked
conversion have different size.
2. Using a custom function such as:
function To_Short_Short_Integer ( I : Integer ) return
SHort_Short_Integer
is
function Convert_To_Short_Short_Integer is new
Ada.Unchecked_Conversion ( Integer, Short_Short_Integer ) ;
begin
If I >= Short_Short_Integer'First and I <= Short_Short_Integer'Last
then
return Convert_To_Short_Short_Integer ( I );
else
raise Range_Error;
end if;
end To_Short_Short_Integer;
Again, the Unchecked_Conversion will raise the same warning in (1).
Is (2) the best (safest) way to do the conversion? Is there any better
method?
Thanks.
--
Adrian Hoe
^ permalink raw reply [relevance 3%]
* Re: How to access this package written in C?
2010-04-23 12:58 1% ` resander
@ 2010-04-23 14:15 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2010-04-23 14:15 UTC (permalink / raw)
On Fri, 23 Apr 2010 05:58:05 -0700 (PDT), resander wrote:
> It may help if I give some background info, so just briefly the
> program (with guidb as the main entry routine) moves record data to/
> from GUI dialogs and to and from SQL databases via ODBC.
There is GNADE ODBC, Ada bindings to ODBC. So you can drop C/C++
altogether.
> for record
> code : integer; bcode : character;
> ccode : character; third : integer;
> descr : String(1..10); price : float;
> by:
> prod : PRODUCT;
> a: System.Address;
> function Conv is new Ada.Unchecked_Conversion (
> Source => System.Address,
> Target => Integer);
> ...
> a := prod'Address;
> put( "Prodrecord address: " );
> s := conv ( a ) ;
> put(s);
> new_line;
>
> a := prod.code'Address;
> put( " code field address: " );
> s := conv ( a ) ;
> put(s);
> new_lin
> ...
> Q1.
> Addresses are not negative.
Never use Unchecked_Conversion unless you exactly know what you are
doing... Address is modular, when bit-wise converted to a *signed* integer
the result is expectedly surprising.
> How do I output a System.Address?
The example above in legal Ada:
with Ada.Text_IO; use Ada.Text_IO;
with System.Storage_Elements; use System.Storage_Elements;
with Interfaces.C; use Interfaces.C;
procedure Test_Fields is
type Product is record
Code : int; -- Use only C-compatible types when you communicate
Bcode : char; -- to C
Ccode : char;
Third : int;
Descr : char_array (1..10);
Price : c_float;
end record;
pragma Convention (C, Product);
P : aliased Product;
begin
Put_Line ("P'Address:" & Integer_Address'Image (To_Integer
(P'Address)));
Put_Line ("P.Code'Address:" & Integer_Address'Image (To_Integer
(P.Code'Address)));
Put_Line ("P.Descr'Address:" & Integer_Address'Image (To_Integer
(P.Descr'Address)));
end Test_Fields;
gives:
P'Address: 38207168
P.Code'Address: 38207168
P.Descr'Address: 38207180
> Dmitri:
> Many thanks for showing how to code the generic Get routine. I have
> never used generics or interfaced to C before and it was so long time
> ago I used Ada (where is my walking stick?) so I don't understand it
> well enough.
Ada generic is roughly what C++ calls template.
> Q2.
> What is the effect of aliased in 'Data : aliased Data_Type;'?
>
> Data is a local variable. I am confused by the aliased keyword, but it
> would seem guidb copies the record into this and then the record value
> is copied once more into final location (X:Product). If so, one copy
> operation is redundant.
"aliased" means "dear compiler, I plan to take pointers (access type) to
this thing." The compiler will reject Data'Access otherwise, because
without your hint it is free to allocate it in a way that Data would have
no valid machine address at all.
> Q3.
> The wrapper:
> procedure getprod (p:out PRODUCT;res:out int) is
> begin
> result = guidb ( 0 , addrin(p)??? ) ;
> end
>
> hides the details of calling the C function and returns data to the
> record variable in the calling program if the address carried by the
> formal parameter can be obtained inside the wrapper. Using p'Address
> for the second actual parameter of guidb would probably just give the
> address of the formal (will check when I know how to output a
> System.Address).
> Is it possible to obtain the memory address of the record variable via
> formal parameter p?
In general case no, because see above. However if you declare PRODUCT a
"limited type" it will be passed by reference. You also [worse] can
procedure getprod (p: access PRODUCT; ...);
BTW, your concern about copying records is absolutely ungrounded.
Especially because you are using ODBC + a relational DBMS! These are so
extraordinary slow, that you will note no difference even if you did
hundreds of copies.
> Q4.
> Would it be easier to implement this if the wrapper was changed to:
>
> procedure getprod (p: in System.Address; res:out int) is
> begin
> result = guidb ( 0 , what goes here??? ) ;
> end
>
> with user calling it as:
>
> getprod ( recordvar'Address , result );
The preferences are as follows:
in out >> access >>>>>>>>>>> address
> Q5.
> Host language event handler procedures are stored as an array of
> procedure addresses which is local to guidb. A procedure is called
> indirectly via this array. This was designed for C/C++, but it would
> be nice to use the same or similar mechanism for Ada.
> Is this going to be possible?
Yes, it is possible, you can have an array of access-to-procedure type. But
an OO way is preferable.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: How to access this package written in C?
@ 2010-04-23 12:58 1% ` resander
2010-04-23 14:15 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: resander @ 2010-04-23 12:58 UTC (permalink / raw)
On Apr 22, 10:12 pm, Keith Thompson <ks...@mib.org> wrote:
> resander <kresan...@gmail.com> writes:
> > I am working on software that manipulates SQL databases via a GUI. It
> > is written in C or C++ without classes and compiled on Linux. Would
> > also want it to run on Windows eventually. This software has
> > essentially one entry procedure:
>
> > int guidb ( int appno , int recaddress ); // in C
>
> > which returns an outcome as an int, takes an int appno which specifies
> > application and an address of a record in recaddress. The latter is
> > used for passing the memory address of any recordtype variable and is
> > cast to a byte address inside guidb.
>
> [...]
>
> As others have mentioned, this is bad C.
>
> There is no guarantee that an int can hold the value of an address,
> and there are common systems (including Linux systems) where it
> can't. Worse, you're not likely to get a warning if you convert
> a pointer to int, even if there's a loss of information.
>
> The right type for this parameter is void* (which is roughly
> analogous to Ada's System.Address).
>
> --
> Keith Thompson (The_Other_Keith) ks...@mib.org <http://www.ghoti.net/~kst>
> Nokia
> "We must do something. This is something. Therefore, we must do this."
> -- Antony Jay and Jonathan Lynn, "Yes Minister"
Thank you all for your concerns about using an int for passing an
address. The interface actually uses a void * (could also be char * as
that is what is needed), but I changed it for the post because I
thought an all-int interface would be easier to handle at the Ada-to-C
boundary. That seems to have backfired!
It may help if I give some background info, so just briefly the
program (with guidb as the main entry routine) moves record data to/
from GUI dialogs and to and from SQL databases via ODBC. A record in
host language may be passed in or in-and-out. The guidb is not
compiled with host language units and would exist as a dll, shared
object or a static library. It uses a record memory address, record
length and field offsets and field types/length in order to access a
record and move the record around. This information is held in tables
local to guidb. The record length and field data are passed accross
via another entry point:
void givefldinfo ( int recordtypeid , -- key
int recordlength ,
int numflds ,
int fldoffsets[] ,
int typeinfo[] );
The givefldinfo is called for each record type by initialisation
routines that are generated automatically from design-time or
repository information. They are compiled and linked with the host
application and called behind the scenes.
Usually GUI events are handled internally, but may also be handled by
event procedures in the host language. Host language handlers have
signatures ( bool valin ),( int valin ), ( char valin[] ) and
( RECORDTP * valinout ). There are four additional entry points, one
for each event handler signature to get the proc address across from
host language. These are called in a manner similar to givefldinfo.
I am on Linux and installed Ada GPS yesterday. Experimented a bit and
found that X.fld'Position gave me the field offsets and X'Size the
record size. I also tried getting the address of a record and its
fields using X'Address and X.fld'Address, but they all came out
negative.
Prodrecord address: -1079352648
code field address: -1079352648
bcode field address: -1079352644
ccode field address: -1079352643
third field address: -1079352640
descr field address: -1079352636
price field address: -1079352624
for record
code : integer; bcode : character;
ccode : character; third : integer;
descr : String(1..10); price : float;
by:
prod : PRODUCT;
a: System.Address;
function Conv is new Ada.Unchecked_Conversion (
Source => System.Address,
Target => Integer);
...
a := prod'Address;
put( "Prodrecord address: " );
s := conv ( a ) ;
put(s);
new_line;
a := prod.code'Address;
put( " code field address: " );
s := conv ( a ) ;
put(s);
new_lin
...
Q1.
Addresses are not negative. How do I output a System.Address?
Dmitri:
Many thanks for showing how to code the generic Get routine. I have
never used generics or interfaced to C before and it was so long time
ago I used Ada (where is my walking stick?) so I don't understand it
well enough.
Q2.
What is the effect of aliased in 'Data : aliased Data_Type;'?
Data is a local variable. I am confused by the aliased keyword, but it
would seem guidb copies the record into this and then the record value
is copied once more into final location (X:Product). If so, one copy
operation is redundant.
Q3.
The wrapper:
procedure getprod (p:out PRODUCT;res:out int) is
begin
result = guidb ( 0 , addrin(p)??? ) ;
end
hides the details of calling the C function and returns data to the
record variable in the calling program if the address carried by the
formal parameter can be obtained inside the wrapper. Using p'Address
for the second actual parameter of guidb would probably just give the
address of the formal (will check when I know how to output a
System.Address).
Is it possible to obtain the memory address of the record variable via
formal parameter p?
Q4.
Would it be easier to implement this if the wrapper was changed to:
procedure getprod (p: in System.Address; res:out int) is
begin
result = guidb ( 0 , what goes here??? ) ;
end
with user calling it as:
getprod ( recordvar'Address , result );
Q5.
Host language event handler procedures are stored as an array of
procedure addresses which is local to guidb. A procedure is called
indirectly via this array. This was designed for C/C++, but it would
be nice to use the same or similar mechanism for Ada.
Is this going to be possible?
I think interfacing to Ada can be done, but my knowledge about this is
still very limited. Your help would be most appreciated.
Regards
Ken
^ permalink raw reply [relevance 1%]
* Re: Having a problem building with win32ada
2010-03-09 21:00 2% ` John McCabe
@ 2010-03-09 21:37 0% ` John McCabe
0 siblings, 0 replies; 200+ results
From: John McCabe @ 2010-03-09 21:37 UTC (permalink / raw)
John McCabe <john@nospam.assen.demon.co.uk.nospam> wrote:
Couple of corrections....
1) I've put Unchecked_Conversion where it should be
Unchecked_Deallocation. Replace:
> procedure Free is new
> Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIINCAPS,
> Win32.Mmsystem.MIDIINCAPS);
> procedure Free is new
> Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIOUTCAPS,
> Win32.Mmsystem.MIDIOUTCAPS);
With
procedure Free is new
Ada.Unchecked_Deallocation(Win32.Mmsystem.MIDIINCAPS,
Win32.Mmsystem.LPMIDIINCAPS);
procedure Free is new
Ada.Unchecked_Deallocation(Win32.Mmsystem.MIDIOUTCAPS,
Win32.Mmsystem.LPMIDIOUTCAPS);
2) In face, the replacing with aliased Win32.Mmsystem.MIDIINCAPS etc
and use of Unchecked_Access DOESN'T WORK. It stops the file open from
failing, but the calls to midiIn/OutGetDevCaps return MMRESULT value
11 whish is Invalid Parameter.
Ah well.
I've done some more searching, and it looks to me like basically the
Win32Ada binding that AdaCore are allowing people to download are a
minimum of 11 years old. Apparently the last intermetrics version
(3.0) was released in 1999. The win32-mmsystem.ads has an Intermetrics
copyright date of 1995.
This is rather unfortunate. I'd hope this would be very useful for
what I wanted to do but, to be honest, it looks like the idea is
doomed as I really don't want to have to re-create a whole set of
Win32 Ada bindings based on the existing MinGW versions of these files
(that also appear to be out of date compared to the definitions of the
types you can find on Microsoft's website).
Disappointing.
John
^ permalink raw reply [relevance 0%]
* Re: Having a problem building with win32ada
@ 2010-03-09 21:00 2% ` John McCabe
2010-03-09 21:37 0% ` John McCabe
0 siblings, 1 reply; 200+ results
From: John McCabe @ 2010-03-09 21:00 UTC (permalink / raw)
Guys
Thought I might as well add it to this thread, but I'm now having a
slight problem running with Win32Ada.
The basis of the code I'm using is in my "please review my code"
thread.
Essentially I've got the code shown below the double dashed line
(well, that's most of it).
When I run it, the Read_And_Print_Patches call _before_ outputting the
output device information is fine, but the same call _after_
outputting the output device information fails. Sometimes it just
prints the "1" prior to the Ada.Text_IO.Open call, and sometimes I get
PROGRAM_ERROR EXCEPTION_ACCESS_VIOLATION.
Now, if I change the declarations of Midi_In_Caps and Midi_Out_Caps
to:
Midi_In_Caps : aliased Win32.Mmsystem.MIDIINCAPS;
Midi_Out_Caps : aliased Win32.Mmsystem.MIDIOUTCAPS;
and use 'Unchecked_Access in the calls to midiInGetDevCaps and
midiOutGetDevCaps for those objects (and dispose of the Free calls) it
seems to work ok. That sounds like some memory isn't being allocated
properly somehow. I can't see that I'm doing anything wrong but if you
can please let me know.
One thing I noticed though is that in mmsystem.h (in the
i686-pc-mingw32 folder) the declaration of MIDIINCAPS (well,
MIDIINCAPSA as it's non-Unicode) is:
typedef struct tagMIDIINCAPSA {
WORD wMid;
WORD wPid;
MMVERSION vDriverVersion;
CHAR szPname[MAXPNAMELEN];
DWORD dwSupport;
} MIDIINCAPSA,*PMIDIINCAPSA,*LPMIDIINCAPSA;
However in win32-mmsystem.ads, the corresponding definition is:
type MIDIINCAPSA is -- mmsystem.h:835
record
wMid : Win32.WORD; -- mmsystem.h:836
wPid : Win32.WORD; -- mmsystem.h:837
vDriverVersion : MMVERSION; -- mmsystem.h:838
szPname : Win32.CHAR_Array (0 .. 31); -- mmsystem.h:839
end record;
Now call me stupid if you like, but does it not look like there's
something missing there? (i.e. the dwSupport field).
If anyone can be bothered to check this out and see what they think
your comments would be appreciated, especially if you can spot that
I've done something stupid.
Do you think this is a bug that AdaCore should know about if they
don't already?
Obviously I could go down the route of not using dynamic memory
because, as I mentioned, it seems to work that way, but I don't like
not knowing why it didn't work the other way!
=================================
-- File: MidiDevs.adb
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
use type Interfaces.C.Unsigned;
with Win32.Mmsystem;
use type Win32.Mmsystem.MMRESULT;
with TestFileRead;
procedure MidiDevs is
Num_Input_Devices : Win32.UINT;
Num_Output_Devices : Win32.UINT;
res : Win32.Mmsystem.MMRESULT;
Midi_In_Caps : Win32.Mmsystem.LPMIDIINCAPS;
Midi_Out_Caps : Win32.Mmsystem.LPMIDIOUTCAPS;
procedure Free is new
Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIINCAPS,
Win32.Mmsystem.MIDIINCAPS);
procedure Free is new
Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIOUTCAPS,
Win32.Mmsystem.MIDIOUTCAPS);
package UINT_Text_IO is new
Ada.Text_IO.Modular_IO(Win32.UINT);
package MM_Text_IO is new
Ada.Text_IO.Modular_IO(Win32.Mmsystem.MMRESULT);
begin
Num_Input_Devices := Win32.Mmsystem.midiInGetNumDevs;
Num_Output_Devices := Win32.Mmsystem.midiOutGetNumDevs;
Ada.Text_IO.Put("There are ");
UINT_Text_IO.Put(Num_Input_Devices, 0);
Ada.Text_IO.Put(" input devices available, and ");
UINT_Text_IO.Put(Num_Output_Devices, 0);
Ada.Text_IO.Put_Line(" output devices available.");
Midi_In_Caps := new Win32.Mmsystem.MIDIINCAPS;
Midi_Out_Caps := new Win32.Mmsystem.MIDIOUTCAPS;
if Num_Input_Devices > 0
then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put("The ");
UINT_Text_IO.Put(Num_Input_Devices, 0);
Ada.Text_IO.Put_Line(" input devices are:");
Ada.Text_IO.New_Line;
for Device_ID in Win32.UINT range 0..(Num_Input_Devices - 1)
loop
res := Win32.Mmsystem.midiInGetDevCaps(Device_ID,
Midi_In_Caps,
Win32.Mmsystem.MIDIINCAPS'size
* Win32.BYTE'size);
UINT_Text_IO.Put(Device_ID, 0);
Ada.Text_IO.Put(") ");
if res = Win32.Mmsystem.MMSYSERR_NOERROR
then
Ada.Text_IO.Put("szPname = ");
Ada.Text_IO.Put_Line(Interfaces.C.To_Ada(Win32.To_C(Midi_In_Caps.szPname)));
else
Ada.Text_IO.Put("Query Failed. Returned ");
MM_Text_IO.Put(res, 0);
end if;
Ada.Text_IO.New_Line;
end loop;
end if;
-- Try reading in the file
TestFileRead.Read_And_Print_Patches;
Ada.Text_IO.New_Line;
if Num_Output_Devices > 0
then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put("The ");
UINT_Text_IO.Put(Num_Output_Devices, 0);
Ada.Text_IO.Put_Line(" output devices are:");
Ada.Text_IO.New_Line;
for Device_ID in Win32.UINT range 0..(Num_Output_Devices - 1)
loop
res := Win32.Mmsystem.midiOutGetDevCaps(Device_ID,
Midi_Out_Caps,
Win32.Mmsystem.MIDIOUTCAPS'size
* Win32.BYTE'size);
UINT_Text_IO.Put(Device_ID, 0);
Ada.Text_IO.Put(") ");
if res = Win32.Mmsystem.MMSYSERR_NOERROR
then
Ada.Text_IO.Put("szPname = ");
Ada.Text_IO.Put_Line(Interfaces.C.To_Ada(Win32.To_C(Midi_Out_Caps.szPname)));
else
Ada.Text_IO.Put("Query Failed. Returned ");
MM_Text_IO.Put(res, 0);
end if;
Ada.Text_IO.New_Line;
end loop;
end if;
-- Try reading in the file
TestFileRead.Read_And_Print_Patches;
Ada.Text_IO.New_Line;
Free(Midi_In_Caps);
Free(Midi_Out_Caps);
end MidiDevs;
===================
=================================
-- File: TestFileRead.ads
package TestFileRead is
procedure Read_And_Print_Patches;
end TestFileRead;
===================
=================================
-- File: TestFileRead.adb
with Ada.Text_IO;
package body TestFileRead is
----------------------------
-- Read_And_Print_Patches --
----------------------------
procedure Read_And_Print_Patches is
Input_File : Ada.Text_IO.File_Type;
begin
Ada.Text_IO.Put_Line("1");
-- Note: You need a file that exists
Ada.Text_IO.Open(SysEx_File,
Ada.Text_IO.In_File,
"FILENAME.TXT");
Ada.Text_IO.Put_Line("2");
Ada.Text_IO.Close(Input_File);
Ada.Text_IO.Put_Line("3");
end Read_And_Print_Patches;
end TestFileRead;
===========
^ permalink raw reply [relevance 2%]
* Re: Tricks Of The Trade: How To Compile Large Program On Two Very Different Compilers
[not found] ` <4fbfba1f-65ac-43d5-8328-61dcf075a1b1@13g2000prl.googlegroups.com>
@ 2009-11-05 18:21 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2009-11-05 18:21 UTC (permalink / raw)
ChristopherL schrieb:
> Does Ada have anything similar to the following C preprocessor
> directives:
>
> #ifdef TABLE_SIZE
> --Add Code Here
> #elif TABLE_SIZE < 50
> --Add Code Here
> #endif
>
I had hesitated to mention a preprocessor. You can use
M4, or cpp. However, dead code elimination is another
option, stays within the language and insofar seems more
manageable (cases don't get lost accross units
when they are in types, not #conditionals, for example.)
(To seems more manageable to me at least, I have lost hair
in missing #else, missing code, missing test cases, and
similar features of conditional program text.
The separate directories solution (as long as the number
of decisions is small) is no less checkable, and, I think,
no more prone to errors than placing the code between
preprocessor conditionals.)
Small example that reduces the need for conditional
text to one constant. It can be replaced using
a preprocessor (or script or human) that needs not
support conditionals. Dead code elimination may work:
package Control is
type Capacity is range 1 .. 8_000;
type Table_Size is (Small, Big);
for Table_Size use (Small => 10, Big => 1000);
for Table_Size'Size use Capacity'Size;
Mode : constant Table_Size := Small; -- <- adjust per system
procedure Start;
end Control;
with Interfaces;
with Ada.Unchecked_Conversion;
package body Control is
function To_Capacity is new Ada.Unchecked_Conversion
(Table_Size, Capacity);
package Small_System is
procedure Run;
private
Last : constant Capacity := To_Capacity (Small);
Data_Store : array (Capacity range 1 .. Last) of Interfaces.Unsigned_8;
end Small_System;
package Big_System is
procedure Run;
private
Last : constant Capacity := To_Capacity (Big);
Data_Store : array (Capacity range 1 .. Last) of Interfaces.Unsigned_8;
-- ... other differences
end Big_System;
procedure Start is
begin
case Mode is
when Small =>
Small_System.Run;
when Big =>
Big_System.Run;
end case;
end;
package body Small_System is separate;
package body Big_System is separate;
end Control;
^ permalink raw reply [relevance 2%]
* Re: Performance of the Streams 'Read and 'Write
@ 2009-11-02 22:19 3% ` Gautier write-only
0 siblings, 0 replies; 200+ results
From: Gautier write-only @ 2009-11-02 22:19 UTC (permalink / raw)
Here is the ultimate test ;-), with Jeff's overlay idea and the
unchecked_conversion as well.
G.
-- Usage: test_stream_performance <big_file>
-- Produces .tmp files that are copies of <big_file>.
--
-- Example of output with GNAT GPL 2008 / Win32:
--
-- xxx'Write / xxx'Read (Stream attributes)......... 9.282530042
seconds
-- Workarounds with Stream_Element_Array buffer:
-- copy........................................... 0.444120412
seconds
-- overlay (read), unchecked_conversion (write)... 0.156874407
seconds
-- overlay........................................ 0.150155676
seconds
-- Factor (Copy) 20.900930898
-- Factor (Overlay) 61.819374993
-- Buffer size in bits..... 8192
-- SE Buffer size in bits.. 8192
-- File size in megabytes..... 2.46367E+01
with Ada.Calendar; use Ada.Calendar;
with Ada.Text_IO;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
procedure Test_Stream_Performance is
f_in, f_out: Ada.Streams.Stream_IO.File_Type;
buffer_size, SE_buffer_size: Natural:= 0;
-- To check if buffers are binary compatible (same packing)
type Buffer is array(Natural range <>) of Unsigned_8;
------------------------------------------------
-- 1) Stream attributes - xxx'Read, xxx'Write --
------------------------------------------------
-- NB: usually we would just have: Buffer'Read(Stream(f_in), b);
-- Here we care about end of file.
--
procedure Read_Attribute( b: out Buffer; last_read: out Natural ) is
idx: constant Positive_Count:= Index(f_in);
siz: constant Positive_Count:= Size(f_in);
begin
if End_Of_File(f_in) then
last_read:= b'First-1;
else
last_read:= Natural'Min(b'First+Natural(siz-idx),b'Last);
Buffer'Read(Stream(f_in), b(b'First .. last_read));
end if;
end Read_Attribute;
procedure Write_Attribute( b: in Buffer ) is
begin
if buffer_size = 0 then
buffer_size:= b'size; -- just for stats
end if;
Buffer'Write(Stream(f_out), b);
end Write_Attribute;
---------------------------------------------
-- 2) The Stream_Element_Array workarounds --
---------------------------------------------
procedure Read_SE_Copy( b: out Buffer; last_read: out Natural ) is
use Ada.Streams;
First : constant Stream_Element_Offset:= Stream_Element_Offset
(b'First);
Last : Stream_Element_Offset:= Stream_Element_Offset
(b'Last);
SE_Buffer : Stream_Element_Array (First..Last);
begin
Read(Stream(f_in).all, SE_Buffer, Last);
for i in First..Last loop
b(Natural(i)):= Unsigned_8(SE_Buffer(i));
end loop;
last_read:= Natural(last);
end Read_SE_Copy;
procedure Write_SE_Copy( b: in Buffer ) is
use Ada.Streams;
First : constant Stream_Element_Offset:= Stream_Element_Offset
(b'First);
Last : constant Stream_Element_Offset:= Stream_Element_Offset
(b'Last);
SE_Buffer : Stream_Element_Array (First..Last);
begin
if SE_buffer_size = 0 then
SE_buffer_size:= SE_Buffer'size; -- just for stats
end if;
for i in SE_Buffer'Range loop
SE_Buffer(i):= Stream_Element(b(Natural(i)));
end loop;
Write(Stream(f_out).all, SE_Buffer);
end Write_SE_Copy;
-- Overlay idea by Jeff Carter
procedure Read_SE_Overlay( b: out Buffer; last_read: out Natural )
is
use Ada.Streams;
Last: Stream_Element_Offset;
SE_Buffer : Stream_Element_Array (1..b'Length);
for SE_Buffer'Address use b'Address;
begin
Read(Stream(f_in).all, SE_Buffer, Last);
last_read:= b'First + Natural(Last) - 1;
end Read_SE_Overlay;
procedure Write_SE_Overlay( b: in Buffer ) is
use Ada.Streams;
SE_Buffer : Stream_Element_Array (1..b'Length);
for SE_Buffer'Address use b'Address;
begin
Write(Stream(f_out).all, SE_Buffer);
end Write_SE_Overlay;
-- Using Unchecked_Conversion
procedure Write_SE_UC( b: in Buffer ) is
subtype My_SEA is Ada.Streams.Stream_Element_Array(1..b'Length);
function To_SEA is new Ada.Unchecked_Conversion(Buffer, My_SEA);
use Ada.Streams;
begin
Write(Stream(f_out).all, To_SEA(b));
end Write_SE_UC;
----------
-- Test --
----------
function name return String is
begin
return Argument(1);
end;
generic
label: String;
with procedure Read( b: out Buffer; last_read: out Natural );
with procedure Write( b: in Buffer );
procedure Test;
procedure Test is
b: Buffer(1..1024);
l: Natural;
begin
Open(f_in, In_File, name);
Create(f_out, Out_File, name & "_$$$_" & label & ".tmp");
while not End_of_File(f_in) loop
Read(b,l);
Write(b(1..l));
end loop;
Close(f_out);
Close(f_in);
end;
procedure Test_Attribute is new Test("Attribute", Read_Attribute,
Write_Attribute);
procedure Test_SE_Copy is new Test("SE_Copy", Read_SE_Copy,
Write_SE_Copy);
procedure Test_SE_Overlay is new Test("SE_Overlay", Read_SE_Overlay,
Write_SE_Overlay);
procedure Test_SE_UC is new Test("SE_UC", Read_SE_Overlay,
Write_SE_UC);
T0, T1, T2, T3, T4: Time;
use Ada.Text_IO;
begin
if Argument_Count=0 then
Put_Line(" Usage: test_stream_performance <big_file>");
Put_Line(" Produces .tmp files that are copies of <big_file>.");
return;
end if;
T0:= Clock;
Test_Attribute;
T1:= Clock;
Test_SE_Copy;
T2:= Clock;
Test_SE_Overlay;
T3:= Clock;
Test_SE_UC;
T4:= Clock;
Put_Line("xxx'Write / xxx'Read (Stream attributes)........." &
Duration'Image(T1-T0) & " seconds");
Put_Line("Workarounds with Stream_Element_Array buffer:");
Put_Line(" copy..........................................." &
Duration'Image(T2-T1) & " seconds");
Put_Line(" overlay (read), unchecked_conversion (write)..." &
Duration'Image(T4-T3) & " seconds");
Put_Line(" overlay........................................" &
Duration'Image(T3-T2) & " seconds");
Put_Line("Factor (Copy) " & Duration'Image((T1-T0)/(T2-T1)));
Put_Line("Factor (Overlay)" & Duration'Image((T1-T0)/(T3-T2)));
New_Line;
Put_Line("Buffer size in bits....." & Integer'Image(buffer_size));
Put_Line("SE Buffer size in bits.." & Integer'Image
(SE_buffer_size));
New_Line;
Open(f_in, In_File, name);
Put_Line("File size in megabytes....." & Float'Image(Float(Size
(f_in))/(1024.0*1024.0)));
Close(f_in);
end;
^ permalink raw reply [relevance 3%]
* Re: Gem 39 - compiler specific?
@ 2009-09-02 23:20 2% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2009-09-02 23:20 UTC (permalink / raw)
"Maciej Sobczak" <see.my.homepage@gmail.com> wrote in message
news:9e0bbbcd-260f-48ed-8043-d6280c633e85@h3g2000yqa.googlegroups.com...
> Consider:
>
> http://www.adacore.com/2008/06/09/gem-39/
>
> The example code performs Unchecked_Conversion between addresses of
> two different array types.
> As far as I understand, there is no standard provision for arrays to
> occupy contiguous memory space (and not even for the alignment of
> their components) and such a conversion relies heavily on the
> assumption that arrays can be "overlaid" by plain address
> reinterpretation.
>
> Still, this technique is quite attractive. What is the chance (in
> practice) to hit the compiler that does not get it "right"?
This is horrible code; it should never be written in Ada 95 or newer! The
problem is that System.Address is not necessarily the same as a general
access type, so this Unchecked_Conversion may not work (or may not even
compile) on another implementation. (It won't on at least some versions of
Janus/Ada, for instance.)
Ada 95 provides System.Address_to_Access_Conversions for this purpose, so at
the very least the writer of the Rock (it surely isn't a "Gem"!!!) should
have used it:
procedure Write_Buffer
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Buffer) is
Item_Size : constant Stream_Element_Offset :=
Buffer'Object_Size / Stream_Element'Size;
subtype SEA is Stream_Element_Array (1..Item_Size);
package A2A is new System.Address_to_Access_Conversions (SEA);
begin
Ada.Streams.Write (Stream.all, A2A.To_Pointer (Item'Address).all);
end Write_Buffer;
(As an aside, this technique could not work in Janus/Ada if Buffer was an
unconstrained array: 'Address of an unconstrained array points at the array
descriptor, not the data. (That's in fact true for all objects in Janus/Ada:
there is a static part and an optional dynamic part, and all operations like
'Address and 'Size point at the static part. That was decided long before
Ada 95 came around and tried to change these definitions; it's not practical
to change in Janus/Ada as address clauses could not be made to work - among
other things - if the static part is ignored.)
IMHO, using System.Address is for anything other than address clauses is
*always* wrong in Ada 95: there are always ways to use general access types
in order to deal with any "pointer" type issue. But we don't even need to do
*that* here - you can directly used Unchecked_Conversion to directly convert
between the array types:
procedure Write_Buffer
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Buffer) is
Item_Size : constant Stream_Element_Offset :=
Buffer'Object_Size / Stream_Element'Size;
subtype SEA is Stream_Element_Array (1..Item_Size);
function To_SEA is new Ada.Unchecked_Conversion (Source => Buffer,
Target => SEA);
begin
Ada.Streams.Write (Stream.all, To_SEA (Item));
end Write_Buffer;
And now there is no use of Address or access types at all (other than for
the stream, of course). Any decent compiler will compile this conversion
into nothing: No code is needed or should be generated for it. (Janus/Ada
can do this, and it is pretty dumb. Indeed, it can does this precisely
because this example needs to work cheaply, as it is the way the majority of
user-defined stream attributes ought to be written.)
Randy.
^ permalink raw reply [relevance 2%]
* Re: Q: Line_IO
@ 2009-08-31 23:56 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2009-08-31 23:56 UTC (permalink / raw)
Dmitry A. Kazakov wrote:
> You could try not to concatenate:
>
> Stream_IO.Write (Stdout, To_Bytes (Item));
> Stream_IO.Write (Stdout, To_Bytes (Separator_Sequence));
>
> , which should be faster when Item is large.
Yes, though according to some measurements that have been made
in the recent past, "&" is faster for "normal" sized lines.
Other sizes did not produce stable results (on my machine at least).
A test case is in
<4a7bebaa$0$30224$9b4e6d93@newsspool1.arcor-online.net>
However, the two calls are more general, so perhaps they
should replace the concatenation. And they seem to make
using 'Address be simpler, below---
> Then there is a crazy way to convert congruent types without
> Unchecked_Conversion. I cannot tell whether it is actually faster:
Since 'Address is used for reading anyway, and since, yes,
it is faster, it could replace the unchecked conversion.
Is there a risk with function parameters, not objects of
"better known" storage places?
New version below. If you want to see the difference between
Unchecked_Conversion and 'Address, rename either Print_1 (old)
to Put_Line or Print_2 (new, 'Address) to the same.
> P.S. The superimposed object shall not have initializers.
Does this apply to String parameters?
generic
Separator_Sequence : in String; -- ends a line
package Line_IO is
pragma Elaborate_Body;
--
-- High(er) speed reading and writing of lines via Stream I/O.
-- Made with Unix pipes in mind.
--
-- Assumptions:
-- - Lines are separated by a sequence of characters.
-- - Characters and stream elements can be used interchangeably.
-- - Lines are not longer than internal buffer size.
--
-- I/O exceptions are propagated
procedure Put_Line(Item : String);
function Get_Line return String;
end Line_IO;
with Ada.Streams.Stream_IO;
with Ada.Unchecked_Conversion;
package body Line_IO is
use Ada.Streams;
Stdout : Stream_IO.File_Type;
Stdin : Stream_IO.File_Type;
-- writing
procedure Print_1 (Item : String) is
subtype Index is Stream_Element_Offset range
Stream_Element_Offset(Item'First)
.. Stream_Element_Offset(Item'Last + Separator_Sequence'Length);
subtype XString is String (Item'First
.. Item'Last + Separator_Sequence'Length);
subtype XBytes is Stream_Element_Array (Index);
function To_Bytes is new Ada.Unchecked_Conversion
(Source => XString,
Target => XBytes);
begin
Stream_IO.Write (Stdout, To_Bytes (Item & Separator_Sequence));
end Print_1;
-- Alternative:
-- - call Stream_IO.Write twice, once for the string, then for the
-- line separator (terminator)
-- - specify 'Address, not unchecked_conversion is needed then
-- We need the separator as a Stream_Element_Array. (Can we
-- use 'Address on a generic formal object? If so, then
-- again, no Unchecked_Conversion is needed (advantage?))
subtype Sep_String is String(Separator_Sequence'Range);
subtype Sep_Bytes is Stream_Element_Array
(Stream_Element_Offset(Separator_Sequence'First)
.. Stream_Element_Offset(Separator_Sequence'Last));
function To_Bytes is new Ada.Unchecked_Conversion
(Source => Sep_String,
Target => Sep_Bytes);
Separator_Bytes : constant Stream_Element_Array :=
To_Bytes(Separator_Sequence);
procedure Print_2 (Item : String) is
subtype Index is Stream_Element_Offset range
Stream_Element_Offset(Item'First)
.. Stream_Element_Offset(Item'Last);
subtype XBytes is Stream_Element_Array (Index);
Item_Bytes: XBytes;
for Item_Bytes'Address use Item'Address;
begin
Stream_IO.Write (Stdout, Item_Bytes);
Stream_IO.Write (Stdout, Separator_Bytes);
end Print_2;
procedure Put_Line (Item : String) renames Print_2;
-- ----------------
-- reading
-- ----------------
-- Types etc., status variables, and the buffer. `Buffer` is at the
-- same time an array of Character and and array of Stream_Element
-- called `Bytes`. They share the same address. This setup makes the
-- storage at the address either a String (when selecting result
-- characters) or a Stream_Element_Array (when reading input bytes).
BUFSIZ: constant := 8_192;
pragma Assert(Character'Size = Stream_Element'Size);
SL : constant Natural := Separator_Sequence'Length;
subtype Extended_Buffer_Index is Positive range 1 .. BUFSIZ + SL;
subtype Buffer_Index is Extended_Buffer_Index
range Extended_Buffer_Index'First .. Extended_Buffer_Index'Last - SL;
subtype Extended_Bytes_Index is Stream_Element_Offset
range 1 .. Stream_Element_Offset(Extended_Buffer_Index'Last);
subtype Bytes_Index is Extended_Bytes_Index
range Extended_Bytes_Index'First
.. (Extended_Bytes_Index'Last - Stream_Element_Offset(SL));
subtype Buffer_Data is String(Extended_Buffer_Index);
subtype Buffer_Bytes is Stream_Element_Array(Extended_Bytes_Index);
Buffer : Buffer_Data;
Bytes : Buffer_Bytes;
for Bytes'Address use Buffer'Address;
Position : Natural; -- start of next substring
Last : Natural; -- last valid character in buffer
function Get_Line return String is
procedure Reload;
-- move remaining characters to the start of `Buffer` and
-- fill the following bytes if possible
-- post: Position in 0 .. 1, and 0 should mean end of file
-- Last is 0 or else the index of the last valid element in
Buffer
procedure Reload is
Remaining : constant Natural := Buffer_Index'Last - Position + 1;
Last_Index : Stream_Element_Offset;
begin
Buffer(1 .. Remaining) := Buffer(Position .. Buffer_Index'Last);
Stream_IO.Read(Stdin,
Item => Bytes(Stream_Element_Offset(Remaining) + 1 ..
Bytes_Index'Last),
Last => Last_Index);
Last := Natural(Last_Index);
Buffer(Last + 1 .. Last + SL) := Separator_Sequence;
Position := Boolean'Pos(Last_Index > 0
and then Buffer(1) /= ASCII.EOT -- ^D
and then Buffer(1) /= ASCII.SUB); -- ^Z
end Reload;
function Sep_Index return Natural;
-- position of next Separator_Sequence
pragma Inline(Sep_Index);
function Sep_Index return Natural is
K : Natural := Position;
begin
pragma Assert(K >= Buffer'First);
pragma Assert(Buffer(Buffer_Index'Last + 1 .. Buffer'Last)
= Separator_Sequence);
while Buffer(K) /= Separator_Sequence(1) loop
K := K + 1;
end loop;
return K;
end Sep_Index;
Next_Separator : Natural;
begin -- Get_Line
pragma Assert(Position = 0 or else Position in Extended_Buffer_Index);
pragma Assert(Last = 0 or else Last in Buffer_Index);
if Position = 0 then
raise Stream_IO.End_Error;
end if;
Next_Separator := Sep_Index;
if Next_Separator > Buffer_Index'Last then
-- must be sentinel
Reload;
return Get_Line;
end if;
if Next_Separator <= Last then
declare
Limit : constant Natural := Natural'Max(0, Next_Separator - SL);
-- there was trouble (Print) when Integer Limit could be
negative
-- (for 2-char SL and Next_Separator = 1)
Result : constant String := Buffer(Position .. Limit);
begin
Position := Limit + SL + 1;
return Result;
end;
else
-- the separator is among the characters beyond `Last`
declare
Limit : constant Positive := Last;
Result : constant String := Buffer(Position .. Limit);
begin
-- -- makes the spurious line go away
-- -- But make sure that it isn't cause by Put_Line!
if Position > Last then
raise Stream_IO.End_Error;
end if;
Position := 0; -- next call will raise End_Error
return Result;
end;
end if;
raise Program_Error;
end Get_Line;
begin
-- (see <ILmdnWHx29q5VMrZnZ2dnUVZ_sednZ2d@megapath.net> for names
-- of standard I/O streams when using Janus Ada on Windows.)
Stream_IO.Open (Stdout,
Mode => Stream_IO.Out_File,
Name => "/dev/stdout");
Stream_IO.Open (Stdin,
Mode => Stream_IO.In_File,
Name => "/dev/stdin");
-- make sure there is no line separator in `Buffer` other than the
sentinel
Buffer := Buffer_Data'(others => ASCII.NUL);
Buffer(Buffer_Index'Last + 1 .. Buffer'Last) := Separator_Sequence;
Position := Buffer_Index'Last + 1; -- See also
`Getline.Reload.Remaining`
Last := 0;
end Line_IO;
^ permalink raw reply [relevance 2%]
* Re: Q: Line_IO
[not found] <4a9b045a$0$31875$9b4e6d93@newsspool3.arcor-online.net>
@ 2009-08-31 8:28 0% ` Martin
1 sibling, 0 replies; 200+ results
From: Martin @ 2009-08-31 8:28 UTC (permalink / raw)
On Aug 30, 11:59 pm, Georg Bauhaus <see.reply...@maps.futureapps.de>
wrote:
> Text_IO seems fairly slow when just reading lines of text.
> Here are two alternative I/O subprograms for Line I/O, in plain Ada,
> based on Stream_IO. They seem to run significantly faster.
>
> However, there is one glitch and I can't find the cause:
> output always has one more line at the end, an empty one.
> Why? If you have got a minute to look at this, you will
> also help us with getting faster programs at the Shootout.
> These read lines by the megabyte.
>
> generic
> Separator_Sequence : in String; -- ends a line
> package Line_IO is
>
> pragma Elaborate_Body;
>
> --
> -- High(er) speed reading and writing of lines via Stream I/O.
> -- Made with Unix pipes in mind.
> --
> -- Assumptions:
> -- - Lines are separated by a sequence of characters.
> -- - Characters and stream elements can be used interchangeably.
> -- - Lines are not longer than internal buffer size.
> --
> -- I/O exceptions are propagated
>
> procedure Print(Item : String);
>
> function Getline return String;
>
> end Line_IO;
>
> with Ada.Streams.Stream_IO;
> with Ada.Unchecked_Conversion;
>
> package body Line_IO is
>
> use Ada.Streams;
>
> Stdout : Stream_IO.File_Type;
> Stdin : Stream_IO.File_Type;
>
> -- writing
>
> procedure Print (Item : String) is
>
> subtype Index is Stream_Element_Offset range
> Stream_Element_Offset(Item'First)
> .. Stream_Element_Offset(Item'Last + Separator_Sequence'Length);
> subtype XString is String (Item'First
> .. Item'Last + Separator_Sequence'Length);
> subtype XBytes is Stream_Element_Array (Index);
> function To_Bytes is new Ada.Unchecked_Conversion
> (Source => XString,
> Target => XBytes);
> begin
> Stream_IO.Write (Stdout, To_Bytes (Item & Separator_Sequence));
> end Print;
>
> -- ----------------
> -- reading
> -- ----------------
> -- Types etc., status variables, and the buffer. `Buffer` is at the
> -- same time an array of Character and and array of Stream_Element
> -- called `Bytes`. They share the same address. This setup makes the
> -- storage at the address either a String (when selecting result
> -- characters) or a Stream_Element_Array (when reading input bytes).
>
> BUFSIZ: constant := 8_192;
> pragma Assert(Character'Size = Stream_Element'Size);
>
> SL : constant Natural := Separator_Sequence'Length;
>
> subtype Extended_Buffer_Index is Positive range 1 .. BUFSIZ + SL;
> subtype Buffer_Index is Extended_Buffer_Index
> range Extended_Buffer_Index'First .. Extended_Buffer_Index'Last - SL;
> subtype Extended_Bytes_Index is Stream_Element_Offset
> range 1 .. Stream_Element_Offset(Extended_Buffer_Index'Last);
> subtype Bytes_Index is Extended_Bytes_Index
> range Extended_Bytes_Index'First
> .. (Extended_Bytes_Index'Last - Stream_Element_Offset(SL));
>
> subtype Buffer_Data is String(Extended_Buffer_Index);
> subtype Buffer_Bytes is Stream_Element_Array(Extended_Bytes_Index);
>
> Buffer : Buffer_Data;
> Bytes : Buffer_Bytes;
> for Bytes'Address use Buffer'Address;
>
> Position : Natural; -- start of next substring
> Last : Natural; -- last valid character in buffer
>
> function Getline return String is
>
> procedure Reload;
> -- move remaining characters to the start of `Buffer` and
> -- fill the following bytes if possible
> -- post: Position in 0 .. 1, and 0 should mean end of file
> -- Last is 0 or else the index of the last valid element in
> Buffer
>
> procedure Reload is
> Remaining : constant Natural := Buffer_Index'Last - Position + 1;
> Last_Index : Stream_Element_Offset;
> begin
> Buffer(1 .. Remaining) := Buffer(Position .. Buffer_Index'Last);
>
> Stream_IO.Read(Stdin,
> Item => Bytes(Stream_Element_Offset(Remaining) + 1 ..
> Bytes_Index'Last),
> Last => Last_Index);
> Last := Natural(Last_Index);
> Buffer(Last + 1 .. Last + SL) := Separator_Sequence;
>
> Position := Boolean'Pos(Last_Index > 0
> and then Buffer(1) /= ASCII.EOT -- ^D
> and then Buffer(1) /= ASCII.SUB); -- ^Z
>
> end Reload;
>
> function Sep_Index return Natural;
> -- position of next Separator_Sequence
> pragma Inline(Sep_Index);
>
> function Sep_Index return Natural is
> K : Natural := Position;
> begin
> pragma Assert(K >= Buffer'First);
> pragma Assert(Buffer(Buffer_Index'Last + 1 .. Buffer'Last)
> = Separator_Sequence);
>
> while Buffer(K) /= Separator_Sequence(1) loop
> K := K + 1;
> end loop;
>
> return K;
> end Sep_Index;
>
> Next_Separator : Natural;
> begin -- Getline
> pragma Assert(Position = 0 or else Position in Extended_Buffer_Index);
> pragma Assert(Last = 0 or else Last in Buffer_Index);
>
> if Position = 0 then
> raise Stream_IO.End_Error;
> end if;
>
> Next_Separator := Sep_Index;
>
> if Next_Separator > Buffer_Index'Last then
> -- must be sentinel
> Reload;
> return Getline;
> end if;
>
> if Next_Separator <= Last then
> declare
> Limit : constant Natural := Natural'Max(0, Next_Separator - SL);
> -- there was trouble (Print) when Integer Limit could be
> negative
> -- (for 2-char SL and Next_Separator = 1)
> Result : constant String := Buffer(Position .. Limit);
> begin
> Position := Limit + SL + 1;
> return Result;
> end;
> else
> -- the separator is among the characters beyond `Last`
> declare
> Limit : constant Positive := Last;
> Result : constant String := Buffer(Position .. Limit);
> begin
> Position := 0; -- next call will raise End_Error
> return Result;
> end;
> end if;
>
> raise Program_Error;
> end Getline;
>
> begin
> -- (see <ILmdnWHx29q5VMrZnZ2dnUVZ_sedn...@megapath.net> for names
> -- of standard I/O streams when using Janus Ada on Windows.)
>
> Stream_IO.Open (Stdout,
> Mode => Stream_IO.Out_File,
> Name => "/dev/stdout");
> Stream_IO.Open (Stdin,
> Mode => Stream_IO.In_File,
> Name => "/dev/stdin");
>
> -- make sure there is no line separator in `Buffer` other than the
> sentinel
> Buffer := Buffer_Data'(others => ASCII.NUL);
> Buffer(Buffer_Index'Last + 1 .. Buffer'Last) := Separator_Sequence;
> Position := Buffer_Index'Last + 1; -- See also
> `Getline.Reload.Remaining`
> Last := 0;
> end Line_IO;
>
> --
> -- A small test program.
> --
> with Line_IO;
> with Ada.Text_IO;
>
> procedure Test_Line_IO is
> Want_Text_IO : constant Boolean := False;
>
> -- pick the correct one for your input files
> UnixLF : constant String := String'(1 => ASCII.LF);
> MacCR : constant String := String'(1 => ASCII.CR);
> OS2CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF);
>
> package LIO is new Line_IO(Separator_Sequence => UnixLF);
>
> begin
> if Want_Text_IO then
> loop
> declare
> A_Line : constant String := Ada.Text_IO.Get_Line;
> begin
> LIO.Print(A_Line);
> null;
> pragma Inspection_Point(A_Line);
> end;
> end loop;
> else
> loop
> declare
> A_Line : constant String := LIO.Getline;
> begin
> LIO.Print(A_Line);
> null;
> pragma Inspection_Point(A_Line);
> end;
> end loop;
> end if;
>
> end Test_Line_IO;
Nice one...I'll try these out on Win23 and see what happens :-)
But surely "Put_Line" and "Get_Line" are preferable subprogram
names?...
Cheers
-- Martin
^ permalink raw reply [relevance 0%]
* Re: Generalized serialization for enumeration types
@ 2009-08-26 11:17 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2009-08-26 11:17 UTC (permalink / raw)
xorque schrieb:
> Hello.
>
> I'm designing a package that uses a lot of similar but distinct
> enumeration types.
>
> At some point, those types need to be encoded to be sent over
> the wire. The encoding rules are simple:
>
> The enumeration values are converted to unsigned 32 bit
> integers with the first value as 0 and increasing sequentially
> with each new value. The 32 bit value is packed into big-endian
> byte order.
>
> The problem is: With so many enumeration types, I now have about 300
> lines of almost identical procedures (to be used as stream attributes)
> that just call a procedure that packs Unsigned_32 values into
> Storage_Element arrays.
Not exactly the same solution, but there doesn't seem to be
a problem with a generic and Seuqential_IO; I might well
have misunderstood.
There is a #Gem at AdaCors's web site explaining how
to use different representations for types derived from
e.g. enum types, if that is any help.
package Enums is
type Color is (Red, Green, Blue);
type Smell is (Good, Neutral, Bad);
private
for Smell use (Good => 14, Neutral => 23, Bad => 100);
for Smell'size use 32;
for Color'size use 32;
end Enums;
generic
type E is (<>);
procedure EG(extension : String);
with Ada.Sequential_IO;
with Interfaces; use Interfaces;
with Ada.Unchecked_Conversion;
procedure EG(extension : String) is
package My_IO is new Ada.Sequential_IO(Unsigned_32);
function To_Unsigned_32 is new Ada.Unchecked_Conversion
(Source => E, Target => Unsigned_32);
F : My_IO.File_Type;
begin
My_IO.Create(F, My_IO.Out_File, "run." & extension);
for K in E loop
My_IO.Write(F, Item => To_Unsigned_32 (K));
end loop;
end EG;
with Enums, EG;
procedure Run is
use Enums;
procedure Color_Out is new EG(Color);
procedure Smell_Out is new EG(Smell);
begin
Color_Out("rgb");
Smell_Out("snf");
end Run;
^ permalink raw reply [relevance 2%]
* Error: "could not understand bounds information on packed array"
@ 2009-05-29 0:55 2% Dennis Hoppe
0 siblings, 0 replies; 200+ results
From: Dennis Hoppe @ 2009-05-29 0:55 UTC (permalink / raw)
Hi,
I am getting the following error message while executing my program:
Execution terminated by unhandled exception
Exception name: STORAGE_ERROR
Message: stack overflow
By use of gdb, I am getting some more useful information like
Program received signal EXC_BAD_ACCESS, Could not access memory.
Reason: KERN_PROTECTION_FAILURE at address: 0x00007fff5f3fffd0
0x0000000100027cde in my_procedure (input_a=warning: could not
understand bounds information on packed array
can't unpack array
, input_b=warning: could not understand bounds information on packed
array can't unpack array
, input_c=can't unpack array
, input_d=can't unpack array
, input_e=0, output=) at my_package.adb:143
143 procedure myprocedure (input_a : in Bit_Field;
I am using the following data types ...
type Word is mod 2**64;
for Word'Size use 64;
pragma Volatile(Word);
type Bit is new Natural range 0 .. 1;
type Bit_Number is new Natural range 0 .. Word'Size - 1;
type Bit_Field is array (Bit_Number) of Boolean;
for Bit_Field'Component_Size use 1;
... and conversions ...
function To_Bit_Field is
new Ada.Unchecked_Conversion (Source => Word, Target => Bit_Field);
function To_Word is
new Ada.Unchecked_Conversion (Source => Bit_Field, Target => Word);
Snippet:
procedure my_procedure
(input_a : in Bit_Field;
input_b : in Bit_Field;
input_c : in out Bit_Field;
input_d : in out Bit_Field;
index : in Natural;
output : in out Word_Vector.Vector) is
begin
if index = Bit_Field'Length then
Word_Vector.Append (output, To_Word(input_c));
else
-- do something
-- recursive call
my_procedure(input_a, input_b, input_c, input_d, index+1, output);
end if;
end my_procedure;
Currently, I am appending exactly eight elements to the vector. So, no
Storage_Error could be raised based on too much elements.
The procedure, which causes the error is recursive. A new Word will be
constructed bitwise and in the end, the Word will be appended to a vector.
First, I thought, the error may be raised due to the unchecked
conversions (cf. "can't unpack array"). However, I am using the
unchecked conversion just once in the termination clause. Uncommenting
the conversion does not help.
Then, I am stumbled upon "EXC_BAD_ACCESS, Could not access memory".
Additionally, the error message differs from time to time (if I compile
with or without optimization, with or without -fstack-check):
Program received signal EXC_BAD_ACCESS, Could not access memory.
Reason: KERN_PROTECTION_FAILURE at address: 0x00007fff5f3fffe0
0x00007fff82d91b28 in szone_malloc ()
(gdb) backtrace
#0 0x00007fff82d91b28 in szone_malloc ()
#1 0x00007fff82d91aef in malloc_zone_malloc ()
#2 0x00007fff82d91a80 in malloc ()
#3 0x000000010006da5f in __gnat_malloc ()
#4 0x0000000100025f48 in word_vector.insert (container=, before=0,
new_item=16, count=<value temporarily unavailable, due to
optimizations>) at a-convec.adb:829
#5 0x0000000100026488 in word_vector.append (container=,
new_item=9223654062804208200, count=1598043600) at a-convec.adb:316
This may be caused in the termination clause, where I try to append the
new Word to a vector. It is interesting, that call #5 and #4 has another
value for "new_item", although insert is called in the body of append.
At the moment, I am wondering, if my computer has some memory issues.
I know, the problem is hard to understand. I would like to provide a
minimal code snippet to demonstrate the failure, but the whole program
is very complex. I tried to take the parameters given by the debugger --
recovered by means of backtracing -- directly as input to the procedure.
But no error occurs at all, if I call the problematic procedure solely.
Best regards,
Dennis Hoppe
^ permalink raw reply [relevance 2%]
* Re: Conversion from floating point to signed 16 bits
2009-05-19 20:06 2% ` Ludovic Brenta
@ 2009-05-19 22:08 0% ` Olivier Scalbert
0 siblings, 0 replies; 200+ results
From: Olivier Scalbert @ 2009-05-19 22:08 UTC (permalink / raw)
Ludovic Brenta wrote:
> On May 19, 8:51 pm, Olivier Scalbert <olivier.scalb...@algosyn.com>
> wrote:
> Your requirements seem a bit strange to me. Could you please explaun
> why you need the integer to be signed? Ada has direct support for
> fixed-point types (RM 3.5.9). They would work like this:
>
> 0.0 => 2#0000_0000_0000_0000#
> 0.25 => 2#0100_0000_0000_0000#
> 0.5 => 2#1000_0000_0000_0000#
> 0.75 => 2#1100_0000_0000_0000#
> 1.0-2.0**(-16) => 2#1111_1111_1111_1111#
>
> If you interpret the 16 bits as an unsigned integer, you get
>
> 0
> 16384
> 32768
> 49152
> 65535
>
> If you interpret these same 16 bits as a signed integer, due to two's
> complement you get
>
> 0
> 16384
> -32768
> -16384
> -1
>
> Here is my program using this feature:
>
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Ada.Text_IO;
> procedure Conversion is
> type Analog_Value is delta 2.0 ** (-16) range 0.0 .. 1.0; -- fixed-
> point
> for Analog_Value'Size use 16;
>
> function "+" is
> new Ada.Unchecked_Conversion (Source => Analog_Value,
> Target => Interfaces.Integer_16);
>
> procedure Put (S16 : in Interfaces.Integer_16) is
> begin
> Ada.Text_IO.Put_Line (Interfaces.Integer_16'Image (S16));
> end Put;
>
> begin
> Put (+0.0);
> Put (+0.25);
> Put (+0.5);
> Put (+0.75);
> Put (+(1.0 - Analog_Value'Small));
> end Conversion;
>
> I am aware that my program does not address the exact requirement you
> expressed but I'm curious to know what the high-level requirement is,
> i.e. why you need the conversion in your example.
>
> --
> Ludovic Brenta.
Hi Ludovic,
The purpose of this conversion is in fact to convert a set of
Analog_Value, representing an sound wave (normalized to [0.0, 1.0]) to a
snd (or au) audio sound file. This file format is very simple to manage.
Specs can be found there:
http://www.opengroup.org/public/pubs/external/auformat.html
Inside the specs, you can find:
"All of the linear formats are signed integers, centered at zero."
That is why, I need this strange requirement !
The sound wave is generated by mathematical functions and saved as an
als file (see a previous post - I do not know how to link to it!).
Then the file is normalized after fetching the min/max and converted
with the maximum of dynamic to a snd file.
So, no rocket science here!
;-)
Olivier
^ permalink raw reply [relevance 0%]
* Re: Conversion from floating point to signed 16 bits
@ 2009-05-19 20:06 2% ` Ludovic Brenta
2009-05-19 22:08 0% ` Olivier Scalbert
0 siblings, 1 reply; 200+ results
From: Ludovic Brenta @ 2009-05-19 20:06 UTC (permalink / raw)
On May 19, 8:51 pm, Olivier Scalbert <olivier.scalb...@algosyn.com>
wrote:
> Hello,
>
> My problem:
> I need to convert an "analogic" value which can vary from 0.0 to 1.0
> into a "discrete" value which is a signed 16 bits integer.
>
> My implementation:
> -----------------------------
> with Ada.Text_IO;
>
> procedure convert is
> type Analog_Value is digits 10 range 0.0 .. 1.0;
> type Signed_16 is range -32768 .. 32767;
> type Unsigned_16 is range 0 .. 65535;
>
> function Cv(Value: Analog_Value) return Signed_16 is
> U16: Unsigned_16;
> begin
> U16 := Unsigned_16(65535.0 * Value);
> return Signed_16(U16 - 32768);
> end Cv;
>
> procedure Put(S16: Signed_16) is
> begin
> Ada.Text_IO.Put_Line(Signed_16'image(S16));
> end put;
> begin
> Put(Cv(0.00)); -- Must be -32768
> Put(Cv(0.25)); -- Must be -16384
> Put(Cv(0.50)); -- Must be 0
> Put(Cv(0.75)); -- Must be 16383
> Put(Cv(1.00)); -- Must be 32767
> end convert;
> -----------------------------
>
> My question:
> Is there an other way to do this in Ada (Representation ? Other parts of
> Ada I do not know ?)
>
> My thanks:
> Thank you very much !
> ;-)
Your requirements seem a bit strange to me. Could you please explaun
why you need the integer to be signed? Ada has direct support for
fixed-point types (RM 3.5.9). They would work like this:
0.0 => 2#0000_0000_0000_0000#
0.25 => 2#0100_0000_0000_0000#
0.5 => 2#1000_0000_0000_0000#
0.75 => 2#1100_0000_0000_0000#
1.0-2.0**(-16) => 2#1111_1111_1111_1111#
If you interpret the 16 bits as an unsigned integer, you get
0
16384
32768
49152
65535
If you interpret these same 16 bits as a signed integer, due to two's
complement you get
0
16384
-32768
-16384
-1
Here is my program using this feature:
with Ada.Unchecked_Conversion;
with Interfaces;
with Ada.Text_IO;
procedure Conversion is
type Analog_Value is delta 2.0 ** (-16) range 0.0 .. 1.0; -- fixed-
point
for Analog_Value'Size use 16;
function "+" is
new Ada.Unchecked_Conversion (Source => Analog_Value,
Target => Interfaces.Integer_16);
procedure Put (S16 : in Interfaces.Integer_16) is
begin
Ada.Text_IO.Put_Line (Interfaces.Integer_16'Image (S16));
end Put;
begin
Put (+0.0);
Put (+0.25);
Put (+0.5);
Put (+0.75);
Put (+(1.0 - Analog_Value'Small));
end Conversion;
I am aware that my program does not address the exact requirement you
expressed but I'm curious to know what the high-level requirement is,
i.e. why you need the conversion in your example.
--
Ludovic Brenta.
^ permalink raw reply [relevance 2%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
2009-05-19 7:47 3% ` Petter
@ 2009-05-19 8:04 0% ` christoph.grein
0 siblings, 0 replies; 200+ results
From: christoph.grein @ 2009-05-19 8:04 UTC (permalink / raw)
On May 19, 9:47 am, Petter <petter_frykl...@hotmail.com> wrote:
> For scalar types Checked_Conversion is a good idea:
>
> generic
> type Source is (<>);
> type Target is (<>);
>
> function Checked_Conversion (S : Source) return Target;
>
> with Ada.Unchecked_Conversion;
> function Checked_Conversion (S : Source) return Target is
> function "+" is new Ada.Unchecked_Conversion (Source => Source,
> Target => Target);
Be careful, a lot can get wrong if the sizes of Source and Target are
different. The 'Valid attribute is not enough.
^ permalink raw reply [relevance 0%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
@ 2009-05-19 7:47 3% ` Petter
2009-05-19 8:04 0% ` christoph.grein
0 siblings, 1 reply; 200+ results
From: Petter @ 2009-05-19 7:47 UTC (permalink / raw)
For scalar types Checked_Conversion is a good idea:
generic
type Source is (<>);
type Target is (<>);
function Checked_Conversion (S : Source) return Target;
with Ada.Unchecked_Conversion;
function Checked_Conversion (S : Source) return Target is
function "+" is new Ada.Unchecked_Conversion (Source => Source,
Target => Target);
begin
declare
Return_Value : Target := + S;
begin
if not Return_Value'Valid then
raise Constraint_Error;
end if;
return Return_Value;
end;
end Checked_Conversion;
^ permalink raw reply [relevance 3%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
2009-05-18 20:53 0% ` Georg Bauhaus
2009-05-18 21:12 0% ` convergence82
@ 2009-05-18 21:24 0% ` Adam Beneschan
1 sibling, 1 reply; 200+ results
From: Adam Beneschan @ 2009-05-18 21:24 UTC (permalink / raw)
On May 18, 1:53 pm, Georg Bauhaus <rm.tsoh.plus-
bug.bauh...@maps.futureapps.de> wrote:
> convergence82 wrote:
> > Thanks. I'm looking at a Ada.Unchecked_Conversion function that
> > converts from Data_Array_1 to Data_Array_2:
> > type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
> > Num_Types.Mod_8;
> > type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
>
> Uhm, converting is what instances of Unchecked_Conversion
> do *not* do, in some (paradoxical) sense.
> To convert X of type T to X of type D, write D(X).
> An instance of Unchecked_Conversion will just leave
> the bits unchanged. The programmer should then know the
> meaning of the "converted" data. An Ada array, however,
> is a bit more than a sequence of storage cells,
> when it includes bounds an other properties of the
> corresponding array type. Hence, arrays of different
> type may be stored differenty.
This may be true in theory but I doubt that it is true in practice.
Both array types are constrained; therefore, the representation of the
array is almost certain to be just the eight data elements strung
together. I doubt that any existing or future Ada compiler is going
to do things any differently, or store the bounds anywhere in the
array data. Therefore, Unchecked_Conversion is most likely going to
work. It's a poor idea to use it, though, since a regular Ada type
conversion is legal and is 100% guaranteed to be portable (as opposed
to only 99.9999% guaranteed for Unchecked_Conversion).
A case like this is harder:
type Enum_Type is (E0, E1, E2, E3, E4, E5, E6, E7);
type Data_Array_1 is array (Enum_Type) of Num_Types.Mod_8;
type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
Now an Ada type conversion won't work, and the only way to convert
from one array type to another is to use a FOR loop or an abomination
like
(1=>A(E0), 2=>A(E1), 3=>A(E2), ...)
-- Adam
^ permalink raw reply [relevance 0%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
2009-05-18 20:53 0% ` Georg Bauhaus
@ 2009-05-18 21:12 0% ` convergence82
2009-05-18 21:24 0% ` Adam Beneschan
1 sibling, 0 replies; 200+ results
From: convergence82 @ 2009-05-18 21:12 UTC (permalink / raw)
On May 18, 4:53 pm, Georg Bauhaus <rm.tsoh.plus-
bug.bauh...@maps.futureapps.de> wrote:
> convergence82 wrote:
> > Thanks. I'm looking at a Ada.Unchecked_Conversion function that
> > converts from Data_Array_1 to Data_Array_2:
> > type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
> > Num_Types.Mod_8;
> > type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
>
> Uhm, converting is what instances of Unchecked_Conversion
> do *not* do, in some (paradoxical) sense.
> To convert X of type T to X of type D, write D(X).
> An instance of Unchecked_Conversion will just leave
> the bits unchanged. The programmer should then know the
> meaning of the "converted" data. An Ada array, however,
> is a bit more than a sequence of storage cells,
> when it includes bounds an other properties of the
> corresponding array type. Hence, arrays of different
> type may be stored differenty.
>
> In addition, if you choose "Integer range 1 .. 8" for
> the index type (as per Bob's suggestion) the normal
> representation of values of type integer may be
> different from that of values of type Mod_4.
> I imagine that even the instructions generated for indexing
> may be different, e.g. indicating different register word
> sizes for smaller or larger types. So Unchecked_Conversion
> may yield unexpected results.
>
> You can think of Ada arrays as tables where the keys
> are values taken from the Index type. The keys will
> not be strings, though, but either numbers, or letters,
> or enumeration literals. Maybe this helps to see why
> one array is not like the other.
>
> > type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
> > Num_Types.Mod_8;
> > type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
>
> > I would think that the way the array is indexed is (integer, mod_4, or
> > whatever) wouldn't matter (it's the datatype of the elements of the
> > array that matter).
>
> No, that's not true for Ada arrays. Imagine
> some book pages numbered i, ii, iii, iv, ...
> while some others are numbered 1, 2, 3, 4, ...
> Book printers will carefully observe this difference:
> preface, TOC, etc. numbered i, ii, ... and then
> the book's "proper text", numbered 1, 2, ...
> This difference can be mapped to arrays index types,
> reducing the risk of mixing the sequences of book
> pages.
>
> > So, will the convert function really in effect DO NOTHING but copy the
> > data over?
>
> It shouldn't have to copy at all, that's the point :-)
Thanks you guys! Maybe one of the reasons for this awkward use of
Unchecked_Conversion is plain ole "cut-n-paste". There must be 200+
data types being converted (or more), for the project I am on. So, I
WILL read your posts more thoroughly in the next day or so.
But for now, thanks for the input,
Steph
PS. Continued debate is welcome, of course!
^ permalink raw reply [relevance 0%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
2009-05-18 19:58 2% ` convergence82
2009-05-18 20:50 0% ` Adam Beneschan
@ 2009-05-18 20:53 0% ` Georg Bauhaus
2009-05-18 21:12 0% ` convergence82
2009-05-18 21:24 0% ` Adam Beneschan
1 sibling, 2 replies; 200+ results
From: Georg Bauhaus @ 2009-05-18 20:53 UTC (permalink / raw)
convergence82 wrote:
> Thanks. I'm looking at a Ada.Unchecked_Conversion function that
> converts from Data_Array_1 to Data_Array_2:
> type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
> Num_Types.Mod_8;
> type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
Uhm, converting is what instances of Unchecked_Conversion
do *not* do, in some (paradoxical) sense.
To convert X of type T to X of type D, write D(X).
An instance of Unchecked_Conversion will just leave
the bits unchanged. The programmer should then know the
meaning of the "converted" data. An Ada array, however,
is a bit more than a sequence of storage cells,
when it includes bounds an other properties of the
corresponding array type. Hence, arrays of different
type may be stored differenty.
In addition, if you choose "Integer range 1 .. 8" for
the index type (as per Bob's suggestion) the normal
representation of values of type integer may be
different from that of values of type Mod_4.
I imagine that even the instructions generated for indexing
may be different, e.g. indicating different register word
sizes for smaller or larger types. So Unchecked_Conversion
may yield unexpected results.
You can think of Ada arrays as tables where the keys
are values taken from the Index type. The keys will
not be strings, though, but either numbers, or letters,
or enumeration literals. Maybe this helps to see why
one array is not like the other.
> type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
> Num_Types.Mod_8;
> type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
>
> I would think that the way the array is indexed is (integer, mod_4, or
> whatever) wouldn't matter (it's the datatype of the elements of the
> array that matter).
No, that's not true for Ada arrays. Imagine
some book pages numbered i, ii, iii, iv, ...
while some others are numbered 1, 2, 3, 4, ...
Book printers will carefully observe this difference:
preface, TOC, etc. numbered i, ii, ... and then
the book's "proper text", numbered 1, 2, ...
This difference can be mapped to arrays index types,
reducing the risk of mixing the sequences of book
pages.
> So, will the convert function really in effect DO NOTHING but copy the
> data over?
It shouldn't have to copy at all, that's the point :-)
^ permalink raw reply [relevance 0%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
2009-05-18 19:58 2% ` convergence82
@ 2009-05-18 20:50 0% ` Adam Beneschan
2009-05-18 20:53 0% ` Georg Bauhaus
1 sibling, 0 replies; 200+ results
From: Adam Beneschan @ 2009-05-18 20:50 UTC (permalink / raw)
On May 18, 12:58 pm, convergence82 <tiami...@gmail.com> wrote:
> Thanks. I'm looking at a Ada.Unchecked_Conversion function that
> converts from Data_Array_1 to Data_Array_2:
>
> type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
> Num_Types.Mod_8;
> type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
>
> I would think that the way the array is indexed is (integer, mod_4, or
> whatever) wouldn't matter (it's the datatype of the elements of the
> array that matter).
>
> So, will the convert function really in effect DO NOTHING but copy the
> data over?
Yes. In this case, though, a normal type conversion should work.
There's no reason to use Unchecked_Conversion.
-- Adam
^ permalink raw reply [relevance 0%]
* Re: (Num_Types.Mod_4 range 1..8) ------->why not (1..8)?
@ 2009-05-18 19:58 2% ` convergence82
2009-05-18 20:50 0% ` Adam Beneschan
2009-05-18 20:53 0% ` Georg Bauhaus
0 siblings, 2 replies; 200+ results
From: convergence82 @ 2009-05-18 19:58 UTC (permalink / raw)
On May 18, 3:36 pm, Georg Bauhaus <rm.tsoh.plus-
bug.bauh...@maps.futureapps.de> wrote:
> convergence82 wrote:
> > type Data_Array is array (Num_Types.Mod_4 range 1..8) of
> > Num_Types.Mod_8;
>
> > what's the difference between this and:
>
> > type Data_Array is array (1..8) of Num_Types.Mod_8;
>
> > ?
>
> Mod_4 range 1 .. 8 denotes a range of values in type Mod_4.
> The index range will be taken from type Mod_4.
> 1 .. 8 without the Mod_4 denotes a range of numbers from
> a "less specific" index type, determined by the rules of
> the language -- probably Integer. The details are found in
> and linked from RM 3.6.
Thanks. I'm looking at a Ada.Unchecked_Conversion function that
converts from Data_Array_1 to Data_Array_2:
type Data_Array_1 is array (Num_Types.Mod_4 range 1..8) of
Num_Types.Mod_8;
type Data_Array_2 is array (1..8) of Num_Types.Mod_8;
I would think that the way the array is indexed is (integer, mod_4, or
whatever) wouldn't matter (it's the datatype of the elements of the
array that matter).
So, will the convert function really in effect DO NOTHING but copy the
data over?
Steph
^ permalink raw reply [relevance 2%]
* Re: GNAT on WinXP: System.OS_Lib.Spawn raises Program_Error
2009-05-04 0:22 2% ` anon
@ 2009-05-04 1:21 0% ` Ed Falis
0 siblings, 0 replies; 200+ results
From: Ed Falis @ 2009-05-04 1:21 UTC (permalink / raw)
On Sun, 03 May 2009 20:22:14 -0400, anon <anon@anon.org> wrote:
> General comments should be taken with a gain of salt. If you check,
> most of
> the GNAT packages and programs, you will see 100s of comments that are
> not
> valid or useful. Like, "Is this correct" or "need comment here". Then
> other
> places where comments could be useful there is only code.
None of us are perfect, eh? There is an ongoing process of improving
comments. The one I quoted is not ambiguous. But you're correct that I
was wrong about the warning being generated in this case.
>
> What is needed is another documentation file, called may be "GNAT
> extension
> to Ada 2005 specification", where the documentation would explain the
> extra
> packages with each package routine, and including the package
> limitations,
> if any.
It's called the GNAT Reference Manual, which does not document
System.OS_Lib as part of the GNAT public library. Generally, it refers to
the source specifications for details.
>
> The following example show that the "System.OS.LIB" could be set as a
> non-portable internal system file that generates warning and forces a
> programmer to use "GNAT.OS_LIB". But in Ada 2005 version, Adacore
> decided not too. Which allows the programmer to choose to use
> "GNAT.OS_LIB" (Ada 95 specs) or "System.OS_LIB" (Ada 2005 specs). Just
> like some programmers choose to use "Text_IO" instead of "Ada.Text_IO",
> or "Unchecked_Conversion" instead of "Ada.Unchecked_Conversion".
The unqualified names of the standard library packages are "deprecated"
but retained for backward compatibility. As far as System.OS_Lib goes,
I'll be asking tomorrow why we allow its use without generating a
warning. Seems like an oversight to me rather than a decision, but as you
point out in your example, this lack of a warning appears to be related to
package renamings.
- Ed
^ permalink raw reply [relevance 0%]
* Re: GNAT on WinXP: System.OS_Lib.Spawn raises Program_Error
@ 2009-05-04 0:22 2% ` anon
2009-05-04 1:21 0% ` Ed Falis
0 siblings, 1 reply; 200+ results
From: anon @ 2009-05-04 0:22 UTC (permalink / raw)
General comments should be taken with a gain of salt. If you check, most of
the GNAT packages and programs, you will see 100s of comments that are not
valid or useful. Like, "Is this correct" or "need comment here". Then other
places where comments could be useful there is only code.
What is needed is another documentation file, called may be "GNAT extension
to Ada 2005 specification", where the documentation would explain the extra
packages with each package routine, and including the package limitations,
if any.
The following example show that the "System.OS.LIB" could be set as a
non-portable internal system file that generates warning and forces a
programmer to use "GNAT.OS_LIB". But in Ada 2005 version, Adacore
decided not too. Which allows the programmer to choose to use
"GNAT.OS_LIB" (Ada 95 specs) or "System.OS_LIB" (Ada 2005 specs). Just
like some programmers choose to use "Text_IO" instead of "Ada.Text_IO",
or "Unchecked_Conversion" instead of "Ada.Unchecked_Conversion".
The following two/three files will show how to bypass the non-portable
error. We all know that the attribute Image is an internal routine and if
you include those files that contains those routine the compiler will
generate a non-portable compiler warning. But if you rename those system
files you can access those routines with no generated warnings after
compiling the renaming file.
-- compiler order
gnat compile Img_Bool
gnat make test1
--
-- Test1.ads
--
with Ada.Text_IO ;
use Ada.Text_IO ;
-- System file that defines Image routine for Boolean
-- "Image" attribute and will give a non-portable
-- warning message, if use
-- with System.Img_Bool ;
-- use System.Img_Bool ;
-- package that refined system file System.Img_Bool
-- No warning or error message, if pre-compiled
-- version is used.
with Img_Bool ;
use Img_Bool ;
procedure test1 is
Success : Boolean := True ;
begin -- test1
Put ( "Image Value of 'Success' := " ) ;
Put ( Image_Boolean ( Success ) ) ;
New_Line ( 2 ) ;
Put_Line ( "Built-in Image Value of 'Success' := "
& Boolean'Image ( Success ) ) ;
end test1 ;
--
-- Img_Bool.ads : Rename internal GNAT package "System.Img_Bool"
-- Compiling this file like most packages that include
-- GNAT internal system files will generate a warning.
-- With or without the body file.
--
-- Using this file after it has been compiled will
-- prevent the compiler from generating a non-portable
-- warning message and gives direct access to a GNAT
-- internal system file routine.
--
with System.Img_Bool ;
package Img_Bool renames System.Img_Bool ;
--
-- Img_Bool.adb : Not really needed. Used just to match the
-- design of "GNAT.OS_LIB", under Ada 2005.
--
-- Do not use, if compiling pre GNAT 2005.
--
pragma No_Body ;
In <op.utcvihzv5afhvo@naropa>, "Ed Falis" <falis@verizon.net> writes:
>On Sat, 02 May 2009 19:20:05 -0400, anon <anon@anon.org> wrote:
>
>> Ed.
>>
>> If that was correct, then using "System.OS_LIB" would generated a
>> compiler WARNING, but no error or warning is given. So, that package
>> is usable as is.
>
>Ah, I see. The unit does not get a warning because its interface is
>"fixed" for use by the renaming. Still, the current header comments
>contain:
>
>-- Note: this package is in the System hierarchy so that it can be
>directly
>-- be used by other predefined packages. User access to this package is
>via
>-- a renaming of this package in GNAT.OS_Lib (file g-os_lib.ads).
^ permalink raw reply [relevance 2%]
* GNAT.Sockets writing data to nowhere...
@ 2009-03-01 1:32 2% xorquewasp
0 siblings, 0 replies; 200+ results
From: xorquewasp @ 2009-03-01 1:32 UTC (permalink / raw)
I've been trying, for a couple of frustrating hours now, to write a
very
simple Ada TCP/IP client that connects to an SMTP server and
delivers a message.
Apparently, data I'm writing to the socket is disappearing into a
void.
I can connect to localhost:25 and conduct an SMTP session using
netcat, so the problem isn't one of configuration.
Here's what I have right now:
-- smtp.ads
package SMTP is
procedure Send_Mail
(Server_Address : in String;
Server_Port : in Natural;
Server_User : in String;
Server_Pass : in String;
Sender : in String;
Recipient : in String;
Data : in String);
end SMTP;
-- smtp.adb
with GNAT.Sockets;
with Ada.Streams;
with Ada.Unchecked_Conversion;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
package body SMTP is
package Sockets renames GNAT.Sockets;
package UB_Strings renames Ada.Strings.Unbounded;
package Streams renames Ada.Streams;
package Text_IO renames Ada.Text_IO;
use type Streams.Stream_Element_Offset;
--
-- Write Data to Socket.
--
procedure Socket_Write
(Socket : Sockets.Socket_Type;
Data : in String)
is
subtype Source is String (Data'First .. Data'Last);
subtype Target is Streams.Stream_Element_Array
(Streams.Stream_Element_Offset (Data'First) ..
Streams.Stream_Element_Offset (Data'Last));
function Convert is new Ada.Unchecked_Conversion (Source, Target);
Buffer : constant Streams.Stream_Element_Array := Convert (Data);
Wrote : Streams.Stream_Element_Offset;
begin
Sockets.Send_Socket
(Socket => Socket,
Item => Buffer,
Last => Wrote);
pragma Assert (Wrote = Buffer'Last);
end Socket_Write;
--
-- Read data from Socket, return in Data
--
procedure Socket_Read
(Socket : Sockets.Socket_Type;
Data : out UB_Strings.Unbounded_String)
is
Temp_Buffer : Streams.Stream_Element_Array (1 .. 256);
Temp_Last : Streams.Stream_Element_Offset;
begin
loop
Sockets.Receive_Socket (Socket, Temp_Buffer, Temp_Last);
declare
subtype Source is Streams.Stream_Element_Array
(Streams.Stream_Element_Offset (Temp_Buffer'First) ..
Temp_Last);
subtype Target is String
(Natural (Temp_Buffer'First) .. Natural (Temp_Last));
function Convert is new Ada.Unchecked_Conversion (Source,
Target);
begin
UB_Strings.Append (Data,
Convert (Temp_Buffer (Temp_Buffer'First .. Temp_Last)));
end;
exit when Temp_Last < Temp_Buffer'Last;
end loop;
end Socket_Read;
--
-- Connect to server at Server_Address:Server_Port, return
connection in Socket.
--
procedure Connect_To_Server
(Server_Address : in String;
Server_Port : in Natural;
Socket : out Sockets.Socket_Type)
is
Address : Sockets.Sock_Addr_Type;
begin
Address.Port := Sockets.Port_Type (Server_Port);
Address.Addr := Sockets.Addresses
(Sockets.Get_Host_By_Name (Server_Address), 1);
Sockets.Create_Socket (Socket);
Sockets.Connect_Socket (Socket, Address);
end Connect_To_Server;
--
-- Send mail Data to Recipient, from Sender, via
Server_Address:Server_Port,
-- authenticating as Server_User with Server_Pass.
--
procedure Send_Mail
(Server_Address : in String;
Server_Port : in Natural;
Server_User : in String;
Server_Pass : in String;
Sender : in String;
Recipient : in String;
Data : in String)
is
Socket : Sockets.Socket_Type;
Input_Buffer : UB_Strings.Unbounded_String;
begin
pragma Assert (Server_User /= "");
pragma Assert (Server_Pass /= "");
pragma Assert (Sender /= "");
pragma Assert (Recipient /= "");
pragma Assert (Data /= "");
Connect_To_Server (Server_Address, Server_Port, Socket);
Socket_Read (Socket, Input_Buffer);
Text_IO.Put_Line ("-- read " & UB_Strings.To_String
(Input_Buffer));
Socket_Write (Socket, "HELO " & Sockets.Host_Name);
Text_IO.Put_Line ("-- wrote");
Socket_Read (Socket, Input_Buffer);
Text_IO.Put_Line ("-- read " & UB_Strings.To_String
(Input_Buffer));
end Send_Mail;
end SMTP;
-- smtp_client.adb
with SMTP;
procedure smtp_client is
begin
SMTP.Send_Mail
(Server_Address => "127.0.0.1",
Server_Port => 25,
Server_User => "me",
Server_Pass => "mypass",
Sender => "me@localhost",
Recipient => "me@localhost",
Data => "hello");
end smtp_client;
Here's a trace of the system calls:
22630 smtp_client CALL socket(0x2,0x1,0)
22630 smtp_client RET socket 3
22630 smtp_client CALL setsockopt(0x3,0xffff,0x800,0xbfbfe7d0,0x4)
22630 smtp_client RET setsockopt 0
22630 smtp_client CALL connect(0x3,0xbfbfe800,0x10)
22630 smtp_client RET connect 0
22630 smtp_client CALL recvfrom(0x3,0xbfbfe710,0x100,0,0,0)
22630 smtp_client GIO fd 3 read 34 bytes
"220 pxrma.lambda78.c7.info ESMTP\r
"
22630 smtp_client RET recvfrom 34/0x22
22630 smtp_client CALL write(0x1,0xbfbfe790,0x2b)
22630 smtp_client GIO fd 1 wrote 43 bytes
"-- read 220 pxrma.lambda78.c7.info ESMTP\r
"
22630 smtp_client RET write 43/0x2b
22630 smtp_client CALL __sysctl
(0xbfbfe7b8,0x2,0xbfbfe7e4,0xbfbfe7d4,0,0)
22630 smtp_client RET __sysctl 0
22630 smtp_client CALL sendto(0x3,0xbfbfe7b0,0x1b,0,0,0)
22630 smtp_client GIO fd 3 wrote 27 bytes
"HELO pxrma.lambda78.c7.info"
22630 smtp_client RET sendto 27/0x1b
22630 smtp_client CALL write(0x1,0xbfbfe7b0,0x9)
22630 smtp_client GIO fd 1 wrote 9 bytes
"-- wrote
"
22630 smtp_client RET write 9
22630 smtp_client CALL recvfrom(0x3,0xbfbfe710,0x100,0,0,0)
22630 smtp_client RET recvfrom -1 errno 4 Interrupted system call
22630 smtp_client PSIG SIGINT SIG_DFL
Note that Ada believes it has written data (the sendto() call returns
27 bytes written). The server (Postfix, configured to dump the entire
conversation to the log) never sees the HELO message.
The response never comes (obviously) and I interrupt the recvfrom()
call with ^C.
Platform is FreeBSD 6.4, x86. GNAT FSF 4.3.2.
Any ideas what I'm doing wrong?
^ permalink raw reply [relevance 2%]
* Exceptions (was Re: How do I go about creating a minimal GNAT runtime?)
@ 2009-02-10 2:34 1% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2009-02-10 2:34 UTC (permalink / raw)
To compile and execute a simple program that uses a raise statement
such as in the following code:
--
-- Sample code
--
procedure test is
begin
raise Program_Error ;
end test ;
you will need the following list of packages in your "rts/adainclude" and
the *.ali stored in "rts/adalib". You will also need to build the
"libgnat.a" by using the "ar r <list of object files>" command and store
in the "rts/adalib" dir.
a-except.adb -- Ada.Exceptions Edited to conform to RM.
a-except.ads Simpler design. That removes
most Import/Exports except for
exports for the RChecks
routines.
Rchecks routines defined in
body and are rewritten to use
Raise_Exception instead of
GNAT's complex algorithm.
a-unccon.ads -- Ada.Unchecked_Conversion
ada.ads -- Ada
s-secsta.adb -- System.Secondary_Stack Compiler uses this package for
s-secsta.ads functions that return a string
value. Also requires
System.Storage_Elements.
s-memory.adb -- System.Memory This is a test environmental
s-memory.ads package that simulates a heap
Needs a true hardware memory
management. That can handle
static and virtual system.
s-stalib.adb -- System.Standard_Library Defines standard Exceptions
s-stalib.ads and storage. Basically copied
from GNAT.
s-stoele.adb -- System.Storage_Elements
s-stoele.ads
system.ads -- System GNAT compiler based.
--
-- Extra packages use for output of exception message
--
g-io.adb -- GNAT.IO use for Put/Put_Line/New_Line
g-io.ads connects to Video_IO
gnat.ads -- GNAT
video_io.adb -- Video_IO Text/Graphic SAGA device driver
video_io.ads
The reason you must rewrite "Ada.Exceptions" is that it uses multiple
c-to-os functions, which some are defined in:
System.CRTL -- defines C RTL ( not used in an Ada only OS )
System.Memory -- defines C memory functions. ( Needs be defined
Ada to CPU Memory routines first )
-- In other words a complete memory management system
-- is needs to make this package fully functional, but
-- it can be simulate by using a large array of bytes.
--
cio.c -- defines C RTS to OS for I/O operations. Must be
-- converted to a complete sub-system. In my example
-- I used a modified "GNAT.IO" and the "Video_IO"
-- device driver.
Then there the "System.Soft_Links" package. Do you really need
it. In most cases, for the core of the kernel the answer is No!
Now there are some binder variables are procedures that needs to be
define in Ada, they are normally found in "Initialize.c", "init.c",
"finalize.c". In my example I create a package called "gnat_library"
to store these in Ada routines and variables.
#
#
#
rm test
gnat compile gnat_library.adb --RTS=rts
#
gnat compile test.adb --RTS=rts
gnat bind test.ali --RTS=rts
#
# To make the routine executable, must move the "function main" to
# the beginning of the ada_main package before compiling.
#
gnat compile b~test.adb --RTS=rts -gnatA -gnatWb -gnatiw -gnatws
#
# gnatlink test.ali gnat_library.o -n -v -v --RTS=rts
#
# Problem: Adds all gcc libraries and includes host Ada Library Path
# and in some case will cause linker to stop processing. So
# it still better to use the "gcc" program.
#
gcc b~test.o gnat_library.o ./test.o text_io.o video_io.o --RTS=rts \
-o test -L./ -L/example/ada/gnat/rts/adalib/ \
/example/ada/gnat/rts/adalib/libgnat.a
#
#
#
In <eb511600-6446-4bad-b859-0d7444416a4c@d36g2000prf.googlegroups.com>, Lucretia <lucretia9@lycos.co.uk> writes:
>Hi (again),
>
>It's been a while, but I'm coming back to my Ada kernel again. I've
>been messing with my helo_world_kernel which I built using no runtime
>(see http://www.archeia.com for more info).
>
>Having just spoken to Ludovic on #Ada, he pointed out that the gnat
>tools can use a basic cross tool set, like the ones I have built
>myself (again, see the above link). My toolset comprises of a gnat1
>compiler and a gnatbind for my targets. I found that it does work
>using the --GCC and --GNATBIND flags, and I need to make sure the
>cross tools and the host tools are of the same GCC version otherwise
>GNAT throws up ALI format errors.
>
>The thing is, I've been trying to enable exceptions, but keep coming
>across big problems in that the runtime requires features that are
>being restricted, such as returning aggregates and assigning
>composites, returning unconstrained objects which requires the
>secondary stack. So, what I really need to know is, how do I create a
>runtime which is restricted in this way for bare hw access?
>
>Thanks,
>Luke.
^ permalink raw reply [relevance 1%]
* Re: cannot generate code for file a-excach.adb (subunit)
2009-01-27 14:21 2% cannot generate code for file a-excach.adb (subunit) Lucretia
@ 2009-01-27 14:38 0% ` xavier grave
0 siblings, 0 replies; 200+ results
From: xavier grave @ 2009-01-27 14:38 UTC (permalink / raw)
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
You need to include excach.adb source file but it is part of the
Ada.Exceptions package and is compiled when you compile a-except.adb
so you don't need to compile it.
As far as I remember...
xavier
Lucretia a �crit :
> Hi,
>
> In my attempts to enable exceptions in my test kernel, I've come
> across a problem when building up my configurable runtime.
>
> x86_64-unknown-elf-gcc -fno-pic -c -nostdinc -I. -ffunction-sections -
> fdata-sections -gnato -gnatE -m32 -g2 -gnatf -gnatu -gnatv -gnatpg a-
> excach.adb
>
> GNAT 4.3.0
> Copyright 1992-2007, Free Software Foundation, Inc.
>
> Unit name File name Time
> stamp
> --------- ---------
> ----------
>
> Ada (spec) ada.ads
> 20070406091342
> Ada.Exceptions (spec) a-except.ads
> 20070606104609
> Ada.Exceptions (body) a-except.adb
> 20071213102130
> Ada.Exceptions.Call_Chain (body) a-excach.adb
> 20051115140645
> Ada.Unchecked_Conversion (spec) a-unccon.ads
> 20070406091342
> System (spec) system.ads
> 20090127135815
> System.Exceptions (spec) s-except.ads
> 20070912115821
> System.Parameters (spec) s-parame.ads
> 20090127133535
> System.Soft_Links (spec) s-soflin.ads
> 20071213103411
> System.Stack_Checking (spec) s-stache.ads
> 20070912115821
> System.Standard_Library (spec) s-stalib.ads
> 20070912115821
> System.Storage_Elements (spec) s-stoele.ads
> 20070912115821
> System.Traceback (spec) s-traceb.ads
> 20070912115821
> System.Traceback_Entries (spec) s-traent.ads
> 20070912115821
> System.Wch_Con (spec) s-wchcon.ads
> 20071213102052
> System.Wch_Stw (spec) s-wchstw.ads
> 20071213102130
>
> cannot generate code for file a-excach.adb (subunit)
> to check subunit for errors, use -gnatc
>
> Compiling: a-excach.adb (source file time stamp: 2005-11-15 14:06:45)
> 76 lines: No errors
> make: *** [a-excach.o] Error 1
>
> Compiling it with -gnatc returns no errors. I'm confused as to why it
> won't compile properly.
>
> Thanks,
> Luke.
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org
iEYEARECAAYFAkl/HIMACgkQVIZi0A5BZF54lACfc5F2dF6qW6WJarlqrDDI19cE
/3QAn03PIsifQjamX13o50FCBZmpy00R
=sx51
-----END PGP SIGNATURE-----
^ permalink raw reply [relevance 0%]
* cannot generate code for file a-excach.adb (subunit)
@ 2009-01-27 14:21 2% Lucretia
2009-01-27 14:38 0% ` xavier grave
0 siblings, 1 reply; 200+ results
From: Lucretia @ 2009-01-27 14:21 UTC (permalink / raw)
Hi,
In my attempts to enable exceptions in my test kernel, I've come
across a problem when building up my configurable runtime.
x86_64-unknown-elf-gcc -fno-pic -c -nostdinc -I. -ffunction-sections -
fdata-sections -gnato -gnatE -m32 -g2 -gnatf -gnatu -gnatv -gnatpg a-
excach.adb
GNAT 4.3.0
Copyright 1992-2007, Free Software Foundation, Inc.
Unit name File name Time
stamp
--------- ---------
----------
Ada (spec) ada.ads
20070406091342
Ada.Exceptions (spec) a-except.ads
20070606104609
Ada.Exceptions (body) a-except.adb
20071213102130
Ada.Exceptions.Call_Chain (body) a-excach.adb
20051115140645
Ada.Unchecked_Conversion (spec) a-unccon.ads
20070406091342
System (spec) system.ads
20090127135815
System.Exceptions (spec) s-except.ads
20070912115821
System.Parameters (spec) s-parame.ads
20090127133535
System.Soft_Links (spec) s-soflin.ads
20071213103411
System.Stack_Checking (spec) s-stache.ads
20070912115821
System.Standard_Library (spec) s-stalib.ads
20070912115821
System.Storage_Elements (spec) s-stoele.ads
20070912115821
System.Traceback (spec) s-traceb.ads
20070912115821
System.Traceback_Entries (spec) s-traent.ads
20070912115821
System.Wch_Con (spec) s-wchcon.ads
20071213102052
System.Wch_Stw (spec) s-wchstw.ads
20071213102130
cannot generate code for file a-excach.adb (subunit)
to check subunit for errors, use -gnatc
Compiling: a-excach.adb (source file time stamp: 2005-11-15 14:06:45)
76 lines: No errors
make: *** [a-excach.o] Error 1
Compiling it with -gnatc returns no errors. I'm confused as to why it
won't compile properly.
Thanks,
Luke.
^ permalink raw reply [relevance 2%]
* Re: Restarting Tread: Why isn't this program working with Unchecked_Converstion
2009-01-16 15:11 2% ` Ludovic Brenta
@ 2009-01-16 16:23 3% ` Martin
0 siblings, 0 replies; 200+ results
From: Martin @ 2009-01-16 16:23 UTC (permalink / raw)
On Jan 16, 3:11 pm, Ludovic Brenta <ludo...@ludovic-brenta.org> wrote:
> On Jan 16, 3:11 pm, ChristopherL <clusard...@aol.com> wrote:
>
>
>
> > Thanks Adam, yours is a working solution, see below.
>
> > Thanks everyone,
> > Chris L.
>
> > On Jan 15, 6:27 pm, Adam Beneschan <a...@irvine.com> wrote:
>
> > > I think you'll have to force the compiler to work with 8-bit types
> > > instead of 10-bit types. Since you can't put a 'Size clause on a
> > > subtype of Integer, you'll need to declare new types:
>
> > > type Short_Integer1 is range 0 .. (2**8)-1; --not (2**10)-1
> > > for Short_Integer1'Size use 8;
>
> > > type Short_Integer2 is range -(2**7) .. (2**7)-1;
> > > for Short_Integer2'Size use 8;
>
> > > Or, if Short_Integer2 *has* to be a subtype, then declare a new type
> > > with a different name, force its size to be 8, and do a type
> > > conversion from that new type to Short_Integer2 afterwards.
>
> > with Unchecked_Conversion;
>
> > with Integer_Text_IO ;
>
> > procedure test is
> > type Short_integer1 is range 0.. ((2 ** 8) - 1);
> > for Short_Integer1'Size use 8;
>
> > subtype Short_integer2 is Integer range -(2 ** 7)..((2 ** 7) - 1);
>
> > type Short_Integer3 is range -(2**7) .. (2**7)-1;
> > for Short_Integer3'Size use 8;
>
> > subtype A_Float is Float;
>
> > subtype A_Natural is Natural range 0..((2 ** 8) - 1);
> > -- The next line of code (if used) gives compilation error message:
> > -- A_NATURAL does not denote a first subtype
> > -- for A_Natural'Size use Short_integer1'Size;
>
> > Size_Of_Float : integer := Float'Size; --32 bits long
>
> > Size_Of_short_integer: integer := Short_integer1'Size;--10 bits
> > long
> > Size_Of_short_int: integer := Short_integer2'Size;--10 bits long
>
> > Size_Of_Natural: integer := A_Natural'Size; --8 bits long
>
> > Arg : A_Float;
> > Result3 : Short_integer2;
> > Result2 : Short_integer3;
> > Result1 : Short_integer1;
>
> > function Get_Bits2 is new Unchecked_Conversion (Source =>
> > Short_integer1, Target => Short_integer3);
>
> > Begin
>
> > Arg := 200.0;
>
> > Result1 := Short_integer1(Arg); -- Result1 becomes 200
> > Result2 := Get_Bits2 (Result1);
> > Result3 := Short_integer2(Result2);
> > Integer_Text_IO.Put ( Result3 ) ;
> > End test;
>
> OK, you've managed to change the floating-point value 200.0 into an
> integer value of -56. The bit representations of these two values are
> different. (That's because the explicit type conversion of Arg from
> type Float to type Short_integer1 changes the representation to
> preserve the value).
>
> I'm curious to understand: why did you do that?
>
> PS. I think you can simplify your code into:
>
> declare
> type Unsigned_8 is mod 2 ** 8;
> for Unsigned_8'Size use 8;
> type Signed_8 is range - 2**7 .. 2**7 - 1;
> for Signed_8'Size use 8;
> function To_Signed_8 is new Ada.Unchecked_Conversion (Unsigned_8,
> Signed_8);
>
> Arg : Float := 200.0;
> Result : Signed_8 := To_Signed_8 (Unsigned_8 (Arg));
> begin
> Ada.Text_IO.Put (Signed_8'Image (Result));
> end;
>
> --
> Ludovic Brenta.
Or using nothing but pre-defined standard types:
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Interfaces;
procedure Test is
function To_Integer_8 is
new Ada.Unchecked_Conversion (Source => Interfaces.Unsigned_8,
Target => Interfaces.Integer_8);
Arg : Float := 200.0;
Result : Interfaces.Integer_8 := To_Integer_8
(Interfaces.Unsigned_8 (Arg));
begin
Ada.Text_IO.Put (Interfaces.Integer_8'Image (Result));
end Test;
^ permalink raw reply [relevance 3%]
* Re: Restarting Tread: Why isn't this program working with Unchecked_Converstion
[not found] ` <9069fcf7-4257-4439-ad4a-8d7c8c17f5cf@v5g2000pre.googlegroups.com>
@ 2009-01-16 15:11 2% ` Ludovic Brenta
2009-01-16 16:23 3% ` Martin
0 siblings, 1 reply; 200+ results
From: Ludovic Brenta @ 2009-01-16 15:11 UTC (permalink / raw)
On Jan 16, 3:11 pm, ChristopherL <clusard...@aol.com> wrote:
> Thanks Adam, yours is a working solution, see below.
>
> Thanks everyone,
> Chris L.
>
> On Jan 15, 6:27 pm, Adam Beneschan <a...@irvine.com> wrote:
>
>
>
> > I think you'll have to force the compiler to work with 8-bit types
> > instead of 10-bit types. Since you can't put a 'Size clause on a
> > subtype of Integer, you'll need to declare new types:
>
> > type Short_Integer1 is range 0 .. (2**8)-1; --not (2**10)-1
> > for Short_Integer1'Size use 8;
>
> > type Short_Integer2 is range -(2**7) .. (2**7)-1;
> > for Short_Integer2'Size use 8;
>
> > Or, if Short_Integer2 *has* to be a subtype, then declare a new type
> > with a different name, force its size to be 8, and do a type
> > conversion from that new type to Short_Integer2 afterwards.
>
> with Unchecked_Conversion;
>
> with Integer_Text_IO ;
>
> procedure test is
> type Short_integer1 is range 0.. ((2 ** 8) - 1);
> for Short_Integer1'Size use 8;
>
> subtype Short_integer2 is Integer range -(2 ** 7)..((2 ** 7) - 1);
>
> type Short_Integer3 is range -(2**7) .. (2**7)-1;
> for Short_Integer3'Size use 8;
>
> subtype A_Float is Float;
>
> subtype A_Natural is Natural range 0..((2 ** 8) - 1);
> -- The next line of code (if used) gives compilation error message:
> -- A_NATURAL does not denote a first subtype
> -- for A_Natural'Size use Short_integer1'Size;
>
> Size_Of_Float : integer := Float'Size; --32 bits long
>
> Size_Of_short_integer: integer := Short_integer1'Size;--10 bits
> long
> Size_Of_short_int: integer := Short_integer2'Size;--10 bits long
>
> Size_Of_Natural: integer := A_Natural'Size; --8 bits long
>
> Arg : A_Float;
> Result3 : Short_integer2;
> Result2 : Short_integer3;
> Result1 : Short_integer1;
>
> function Get_Bits2 is new Unchecked_Conversion (Source =>
> Short_integer1, Target => Short_integer3);
>
> Begin
>
> Arg := 200.0;
>
> Result1 := Short_integer1(Arg); -- Result1 becomes 200
> Result2 := Get_Bits2 (Result1);
> Result3 := Short_integer2(Result2);
> Integer_Text_IO.Put ( Result3 ) ;
> End test;
OK, you've managed to change the floating-point value 200.0 into an
integer value of -56. The bit representations of these two values are
different. (That's because the explicit type conversion of Arg from
type Float to type Short_integer1 changes the representation to
preserve the value).
I'm curious to understand: why did you do that?
PS. I think you can simplify your code into:
declare
type Unsigned_8 is mod 2 ** 8;
for Unsigned_8'Size use 8;
type Signed_8 is range - 2**7 .. 2**7 - 1;
for Signed_8'Size use 8;
function To_Signed_8 is new Ada.Unchecked_Conversion (Unsigned_8,
Signed_8);
Arg : Float := 200.0;
Result : Signed_8 := To_Signed_8 (Unsigned_8 (Arg));
begin
Ada.Text_IO.Put (Signed_8'Image (Result));
end;
--
Ludovic Brenta.
^ permalink raw reply [relevance 2%]
* Re: How to put 200.0 (is float variable of 32 bits) into an integer sub-type of 10 bits (complete program included)
[not found] ` <97231951-54a0-4df7-bb73-04261b34287f@e6g2000vbe.googlegroups.com>
@ 2009-01-16 3:17 3% ` Steve D
0 siblings, 0 replies; 200+ results
From: Steve D @ 2009-01-16 3:17 UTC (permalink / raw)
"ChristopherL" <clusardi2k@aol.com> wrote in message
news:97231951-54a0-4df7-bb73-04261b34287f@e6g2000vbe.googlegroups.com...
> If it is not possible to do what I want.
>
> Can someone modify the below program to show me how to set a high
> order bit of a
> 10 number number, and also maintain all other bits.
>
> procedure test2 is
>
> subtype Short_integer1 is INTEGER range -(2 ** 7)..((2 ** 7) - 1);
>
> arg:float;
> Result:Short_integer1;
>
> begin
>
> arg := 200.0
>
> if (arg > 128.0) then
>
> arg := arg - 128.0;
> --Result := ?;
>
> else
>
> Result := Short_integer1(arg);
>
> end if;
>
> end test2;
>
> In this example I would like Result to have a bit representation such
> as:
>
> 10 0100 1000
>
> If you have a simplier algorithm (implemented) please share it with
> me.
>
> Thanks,
> Chris L.
>
>
See if this does what you want:
with Interfaces;
use Interfaces;
with Ada.Unchecked_Conversion;
with Ada.Text_IO;
with Ada.Float_Text_IO;
procedure TestSteve is
subtype Short_Integer is Integer range -128..127;
package Short_Io is new Ada.Text_Io.Integer_IO( Short_Integer );
package Unsigned_8_Io is new Ada.Text_Io.Modular_IO( Unsigned_8 );
function Float_To_Short_Integer( value : float ) return Short_Integer is
function Conv is new Ada.Unchecked_Conversion( Unsigned_8,
Short_Integer );
begin
return Conv( Unsigned_8( value ) );
end Float_To_Short_Integer;
procedure TestValue( value : float ) is
result : Short_Integer;
function Conv is new Ada.Unchecked_Conversion( Short_Integer, Unsigned_8 );
begin
result := Float_To_Short_Integer( value );
Ada.Float_Text_IO.Put( value, 3, 1, 0 );
Ada.Text_IO.Put( " => ");
Short_IO.Put( Float_To_Short_Integer( value ) );
Ada.Text_IO.Put( " => ");
Unsigned_8_IO.Put( Conv( Float_To_Short_Integer( value ) ), 4, 2 );
Ada.Text_IO.New_Line;
end TestValue;
begin
TestValue( 0.0 );
TestValue( 127.0);
TestValue( 200.5 );
end TestSteve;
Output:
0.0 => 0 => 2#0#
127.0 => 127 => 2#1111111#
200.5 => -55 => 2#11001001#
Regards,
Steve
^ permalink raw reply [relevance 3%]
* Re: Restarting Tread: Why isn't this program working with
[not found] <83d19cd8-71ca-43c1-a3eb-05832290e565@r36g2000prf.googlegroups.com>
@ 2009-01-16 1:37 3% ` anon
[not found] ` <40239b21-b265-467f-9b27-5890fb2f4c67@w1g2000prm.googlegroups.com>
1 sibling, 0 replies; 200+ results
From: anon @ 2009-01-16 1:37 UTC (permalink / raw)
--
-- Three different versions. All version use 8-bits instead of 7-bits
-- because integer version of 200.0 may not fit in a 7-bit code.
-- use declare blocks to separate versions.
--
with Ada.Integer_Text_IO ;
with Ada.Float_Text_IO ;
with Ada.Text_IO ;
use Ada.Text_IO ;
with Ada.Unchecked_Conversion;
with Interfaces ;
use Interfaces ;
procedure test2 is
subtype Short_integer1 is INTEGER range -(2 ** 7)..((2 ** 7) - 1);
subtype A_Float is Float;
subtype Short_integer2 is Integer range 0.. ((2 ** 8) - 1);
subtype A_Natural is Natural range 0..((2 ** 8) - 1);
--FYI1
Size_Of_Float : integer := Float'Size; -- 32
Size_Of_short_int: integer := Short_integer1'Size; -- 10 !!!!!!! Size is 10
--FYI2
Size_Of_short_integer: integer := Short_integer2'Size; -- 8
Size_Of_Natural: integer := A_Natural'Size; -- 8
Arg : A_Float;
Result : Short_integer1;
Begin
-- will cause error due to integer version of 200 is
-- greater than 2**7
begin
Arg := 200.0;
Result := Short_integer1(Arg);
exception
when Constraint_Error =>
Put_Line ( "Constraint_Error using Short_integer1" ) ;
end ;
-- using files
declare
Temp_String : String ( 1..10 ) ;
Temp : Integer ;
Last : Positive ;
Result2 : Short_integer2;
begin
Arg := 200.0;
Ada.Float_Text_IO.Put ( Temp_String, Arg, Aft => 0, Exp => 0 ) ;
Ada.Integer_Text_IO.Get ( Temp_String, Temp, Last ) ;
Result2 := Short_integer2(Temp);
Put_Line ( "Temp :=> " & Temp_String ) ;
Put ( "Result from file :=> " ) ;
Ada.Integer_Text_IO.Put ( Result2 ) ;
New_Line ;
exception
when Constraint_Error =>
Put_Line ( "Constraint_Error using Files" ) ;
Put_Line ( "Temp :=> " & Temp_String ) ;
end ;
-- Works but the number may be greater than 7 bits code.
declare
function To_Integer is new Ada.Unchecked_Conversion
( Float, Integer ) ;
Temp : Integer ;
begin
Arg := 200.0;
Temp := To_Integer ( Arg ) ;
Put ( "Result :=> " ) ;
Ada.Integer_Text_IO.Put ( Temp ) ;
new_line ;
exception
when Constraint_Error =>
Put_Line ( "Constraint_Error using Unchecked_Conversion" ) ;
end ;
-- Works but the number may be greater than 7 bits code, so using 8
declare
type Irec is array ( 0..3 ) of Unsigned_8 ;
function To_Integer is new Ada.Unchecked_Conversion
( Float, Irec ) ;
Temp : Irec ;
begin
Arg := 200.0;
Temp := To_Integer ( Arg ) ;
Put ( "Result :=> " ) ;
for index in IRec'range loop
Ada.Integer_Text_IO.Put ( Integer ( Temp ( index ) ), 8, 16 );
end loop ;
new_line ;
exception
when Constraint_Error =>
Put_Line ( "Constraint_Error using Unchecked_Conversion" ) ;
end ;
End test2;
In <83d19cd8-71ca-43c1-a3eb-05832290e565@r36g2000prf.googlegroups.com>, ChristopherL <clusardi2k@aol.com> writes:
>I'm restarting the tread [How to put 200 into an integer sub-type of
>16 bits (code included)] with a new subject because the last was too
>long!
>
>How can I be getting the below error message with
>"Unchecked_Conversion".
>
>Isn't Unchecked_conversion just suppose to copy bits?
>
>I want to copy bits from an Ada float to a user defined short integer
>maintaining the same bit representation.
>
>Arg:Float; -- From this with a value of 200
>subtype Short_integer is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
>Result: Short_integer; --to this, and I want to round Arg
>
>The definitions of Arg and Result2 can not chanage.
>
>Chris L.
>
>with Unchecked_Conversion;
>
>procedure test is
> subtype Short_integer1 is Natural range 0.. ((2 ** 10) - 1);
> subtype Short_integer2 is Integer range -(2 ** 7)..((2 ** 7) - 1);
>
> subtype A_Float is Float;
>
> subtype A_Natural is Natural range 0..((2 ** 8) - 1);
> -- The next line of code (if used) gives compilation error message:
> -- A_NATURAL does not denote a first subtype
> -- for A_Natural'Size use Short_integer1'Size;
>
> Size_Of_Float : integer :=3D Float'Size; --32 bits long
>
> Size_Of_short_integer: integer :=3D Short_integer1'Size;--10 bits
>long
> Size_Of_short_int: integer :=3D Short_integer2'Size;--10 bits long
>
> Size_Of_Natural: integer :=3D A_Natural'Size; --8 bits long
>
> Arg : A_Float;
> Result2 : Short_integer2;
> Result1 : Short_integer1;
>
> function Get_Bits is new Unchecked_Conversion (Source =3D>
> Short_integer1, Target =3D> Short_integer2);
>
>Begin
>
>Arg :=3D 200.0;
>
>Result1 :=3D Short_integer1(Arg + 0.5); -- Result1 becomes 201
>Result2 :=3D Get_Bits (Result1);
>
>End test;
>
>-- Error Message
>+++ Program started at 01/15/09 12:14:02
>
>Unhandled exception:
>
>CONSTRAINT_ERROR raised in MAIN
>
>Range_Check_Failed
>
>Exception raised at code address: 0x413516
>+++ Program completed with exit code 1 at 01/15/09 12:14:02
>+++
>---------------------------------------------------------------------------=
>=AD-----------------------------------
^ permalink raw reply [relevance 3%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
[not found] ` <1a2b31ac-cf6b-44e3-85b7-04594460db87@d36g2000prf.googlegroups.com>
@ 2009-01-15 12:40 2% ` Stuart
0 siblings, 0 replies; 200+ results
From: Stuart @ 2009-01-15 12:40 UTC (permalink / raw)
"ChristopherL" <clusardi2k@aol.com> wrote in message
news:1a2b31ac-cf6b-44e3-85b7-04594460db87@d36g2000prf.googlegroups.com...
<snip>
> So, what is the proper way to store a number (never being greater
> than 200.5) in a 8 bit short number as outlined above?
then
"Stuart" <stuart@0.0> wrote in message
news:496f03e2$1_1@glkas0286.greenlnk.net...
> OK - there is no 'proper' way, there are several ways, each of which has
> advantages and disadvantages.
<snip>
To add to what I wrote before, and depending on what you are trying to
achieve, you might find the following Ada code of interest:
with Ada.Unchecked_Conversion;
procedure ada_main is
type Flt is digits 7 range -1000.0 .. 1000.0; -- !!! or whatever!
-- The condition we need to allow the range 0.0..200.0 to be stored with
-- most precision in 8 bits is:
-- 255 * small > 200.0 - small/2
-- => 255.5 * small > 200.0
-- => small > 200.0 / 255.5
Fxd_Small : constant := 0.782778865;
-- !!! There seem to be some issues with GNAT debugger using an
expression here!
type Fxd is delta Fxd_Small range 0.0 .. 200.0;
for Fxd'small use Fxd_Small;
for Fxd'size use 8;
type Int is mod 256; -- In case you really want the underlying 'integer'
representation
for Int'size use 8;
function to_Int is new Ada.Unchecked_Conversion(Source => Fxd, Target =>
Int);
-- Create some volatile variables to force code to be generated.
X : Flt;
pragma volatile(X);
Y : Fxd;
for Y'size use 8;
pragma volatile(Y);
Z : Int;
for Z'size use 8;
pragma volatile(Z);
begin
X := 200.0;
Y := Fxd(X); -- 199.6086
-- Note: Read up about model numbers !!!
-- This is the closest model number to 200.0 for Fxd.
Z := to_Int(Y); -- 255
end ada_main;
Regards
Stuart
^ permalink raw reply [relevance 2%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
[not found] ` <fc154f52-7168-447a-bcd3-6ece9066ebf7@r37g2000prr.googlegroups.com>
@ 2009-01-15 10:29 2% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2009-01-15 10:29 UTC (permalink / raw)
ChristopherL schrieb:
> On Jan 14, 12:41 pm, Adam Beneschan <a...@irvine.com> wrote:
>> Which
>> bits do you want to copy?
>
> The ones containing the mantissa.
OK, here is some code to extract the exponent.
BTW, consider giving the reference when you
quote from Wikipedia.
In this case the "general info" seems to have been pasted from
http://en.wikipedia.org/wiki/Floating_point#Internal_representation
with Interfaces;
with Ada.Unchecked_Conversion, Ada.Text_IO;
procedure Th is
use Ada;
Arg: Float;
pragma Assert(Float'Size = 32);
The_Bits : Interfaces.Unsigned_32;
function Just_The_Bits is
new Unchecked_Conversion (Source => Float,
Target => Interfaces.Unsigned_32);
Result: Interfaces.Unsigned_8;
package Bit_IO_8 is new Text_IO.Modular_IO (Interfaces.Unsigned_8);
package Bit_IO_32 is new Text_IO.Modular_IO (Interfaces.Unsigned_32);
begin
Arg := 200.0;
The_Bits := Just_The_Bits(Arg);
Text_IO.Put("starting from float ");
Bit_IO_32.Put(The_Bits, Base => 2);
Text_IO.Put_Line(" of bit size" & Natural'Image(Float'Size) & ",");
Text_IO.Put_Line("for " & Float'Image(Arg) & ", bits 24 .. 31 give");
The_Bits := Interfaces.Shift_Right(The_Bits, 23);
Result := Interfaces.Unsigned_8(The_Bits);
declare
use type Interfaces.Unsigned_8;
begin
Bit_IO_8.Default_Width := 0;
Text_IO.Put("decimal "); Bit_IO_8.Put(Result);
Text_IO.Put(", that's "); Bit_IO_8.Put(Result - 127);
Text_IO.Put_Line(" without bias");
Text_IO.Put("binary "); Bit_IO_8.Put(Result, Base => 2);
Text_IO.Put(", or "); Bit_IO_8.Put(Result - 127, Base => 2);
Text_IO.Put_Line(" without bias.");
end;
end Th;
^ permalink raw reply [relevance 2%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
2009-01-15 6:53 3% ` Michael Bode
@ 2009-01-15 8:57 0% ` Martin
0 siblings, 0 replies; 200+ results
From: Martin @ 2009-01-15 8:57 UTC (permalink / raw)
On Jan 15, 6:53 am, Michael Bode <m.g.b...@web.de> wrote:
> ChristopherL <clusard...@aol.com> writes:
> > The size of floating point number is 32 bits on my system, and my
> > float will
> > always be positive.
>
> > General information about floating point numbers in general:
>
> > Floating-point numbers are typically packed into a computer datum as
> > the sign bit, the exponent field, and the significand (mantissa).
>
> > Mantissa Exponent Value
> > 71 0 71
> > 71 1 710
> > 71 2 7100
> > 71 -1 7.1
> > 2 2 200
>
> > For example, it was shown above that π, rounded to 24 bits of
> > precision, has:
>
> > sign = 0 ; e = 1 ; s = 110010010000111111011011 (including the hidden
> > bit)
> > The sum of the exponent bias (127) and the exponent (1) is 128, so
> > this is represented in single precision format as
>
> > 0 10000000 10010010000111111011011 (excluding the hidden bit).
>
> > So, what is the proper way to store a number (never being greater
> > than
> > 200.5) in a 8 bit short number as outlined above?
>
> Try compressing it with gzip? Your question is how to store 4 bytes in
> 1 byte. The answer is, you don't. You use 4 8-bit numbers to store 1
> 32-bit number. In Ada you can do it like this:
>
> with Ada.Unchecked_Conversion;
> with Ada.Text_Io;
>
> procedure Convert is
> type SByte is range -128 .. 127;
> for SByte'Size use 8;
> type Float_Bytes is array (0 .. 3) of SByte;
>
> Arg : Float := 200.5;
> Result : Float_Bytes;
>
> function To_Bytes is new Ada.Unchecked_Conversion (Source => Float,
> Target => Float_Bytes);
> begin
> Result := To_Bytes (Arg);
> for I in Result'Range loop
> Ada.Text_Io.Put (Sbyte'Image (Result(I)) & " ");
> end loop;
> Ada.Text_Io.New_Line;
> end Convert;
>
> Output:
>
> 0 -128 72 67
For the insanely paranoid, you might want to add:
pragma Assert (Float'Size = 32);
^ permalink raw reply [relevance 0%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
[not found] ` <3625f980-4406-4f51-b494-dd4a48cab840@p36g2000prp.googlegroups.com>
@ 2009-01-15 6:53 3% ` Michael Bode
2009-01-15 8:57 0% ` Martin
0 siblings, 1 reply; 200+ results
From: Michael Bode @ 2009-01-15 6:53 UTC (permalink / raw)
ChristopherL <clusardi2k@aol.com> writes:
> The size of floating point number is 32 bits on my system, and my
> float will
> always be positive.
>
> General information about floating point numbers in general:
>
> Floating-point numbers are typically packed into a computer datum as
> the sign bit, the exponent field, and the significand (mantissa).
>
> Mantissa Exponent Value
> 71 0 71
> 71 1 710
> 71 2 7100
> 71 -1 7.1
> 2 2 200
>
> For example, it was shown above that π, rounded to 24 bits of
> precision, has:
>
> sign = 0 ; e = 1 ; s = 110010010000111111011011 (including the hidden
> bit)
> The sum of the exponent bias (127) and the exponent (1) is 128, so
> this is represented in single precision format as
>
> 0 10000000 10010010000111111011011 (excluding the hidden bit).
>
> So, what is the proper way to store a number (never being greater
> than
> 200.5) in a 8 bit short number as outlined above?
Try compressing it with gzip? Your question is how to store 4 bytes in
1 byte. The answer is, you don't. You use 4 8-bit numbers to store 1
32-bit number. In Ada you can do it like this:
with Ada.Unchecked_Conversion;
with Ada.Text_Io;
procedure Convert is
type SByte is range -128 .. 127;
for SByte'Size use 8;
type Float_Bytes is array (0 .. 3) of SByte;
Arg : Float := 200.5;
Result : Float_Bytes;
function To_Bytes is new Ada.Unchecked_Conversion (Source => Float,
Target => Float_Bytes);
begin
Result := To_Bytes (Arg);
for I in Result'Range loop
Ada.Text_Io.Put (Sbyte'Image (Result(I)) & " ");
end loop;
Ada.Text_Io.New_Line;
end Convert;
Output:
0 -128 72 67
^ permalink raw reply [relevance 3%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
[not found] ` <139961e9-bae6-4e60-8ff7-4f4779b27481@z6g2000pre.googlegroups.com>
@ 2009-01-14 21:32 0% ` sjw
1 sibling, 0 replies; 200+ results
From: sjw @ 2009-01-14 21:32 UTC (permalink / raw)
On Jan 14, 8:13 pm, ChristopherL <clusard...@aol.com> wrote:
> On Jan 14, 8:08 am, Adam Beneschan <a...@irvine.com> wrote:
>
>
>
> > On Jan 14, 6:59 am, ChristopherL <clusard...@aol.com> wrote:
>
> > > Hello again,
>
> > > Trying twice, I seem not to be able to get the "Unchecked_Conversion"
> > > to compile. See below, and explain this to me.
>
> > > Thanks,
> > > Chris L.
>
> > > -- Program (1) --
>
> > > with Ada.Unchecked_Conversion;
>
> > > procedure test is
> > > subtype Shrt is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
> > > Result:Shrt;
>
> > > Arg:Float;
>
> > > function To_Bits is new
> > > Ada.Unchecked_Conversion (Source => Float, Target => Shrt);
>
> > > Begin
> > > Arg := 200.0;
>
> > > Result := To_Bits(Arg + 0.5); -- crude round then type conversion
> > > End test;
>
> > > -- Error Message Received
>
> > > 210 Ada.Unchecked_Conversion (Source => Float, Target =>
> > > Shrt);
>
> > > *** 387E-0: Identifier ADA is not directly visible
>
> > > 236 Result := To_Bits( Arg + 0.5 )
>
> > > *** 387E-0: Identifier TO_BITS is not directly visible
>
> > > ==================================================================
>
> > > -- Program (2) --
>
> > > with Unchecked_Conversion;
>
> > > procedure test is
> > > subtype Shrt is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
> > > Result:Shrt;
>
> > > Arg:Float;
>
> > > function To_Bits is new
> > > Unchecked_Conversion (Source => Float, Target => Shrt);
>
> > > Begin
> > > Arg := 200.0;
>
> > > Result := To_Bits(Arg + 0.5); -- crude round then type conversion
> > > End test;
>
> > (1) The error messages don't make any sense to me. If you say "with
> > Ada.Unchecked_Conversion", then Ada and Ada.Unchecked_Conversion
> > should both be visible and you shouldn't be getting "not directly
> > visible" errors. You did include the "with" statement in your source
> > file, right, rather than putting it in another source? I'd check your
> > compiler manual here; maybe you didn't configure things properly and
> > you need to do something special in order to access the Ada standard
> > library. I'm just guessing here. I have no idea what compiler you're
> > using.
>
> > (2) Even if you get past that, your program will not work as
> > intended. Unchecked_Conversion simply copies bit representations from
> > one type to another. A floating-point type will contain bits in a
> > floating-point format, and that format won't look like an integer
> > format. If Float is an IEEE-standard 32-bit float, the representation
> > of 200.0 looks like
>
> > 01000011010010000000000000000000
>
> > If you convert this to Shrt, which is probably 8 bits, the language
> > doesn't really tell you what happens when you Unchecked_Conversion a
> > 32-bit value to an 8-bit value. But most likely you'll either get the
> > upper 8 bits (01000011) or the lower 8 bits (00000000), neither of
> > which is what you want.
>
> > You need a regular type conversion to convert the float to an integer,
> > not an Unchecked_Conversion.
>
> > (3) You still haven't been clear on what you want to do, but it now
> > looks like you're trying to take an 8-bit integer in the range 0..255
> > and convert it to an 8-bit Shrt (in the range -128..127) with the same
> > bit representation. Did I guess right? If that's the case, it might
> > be helpful to do this the simple way:
>
> > type Signed_Short is range -128 .. 127;
> > -- more readable than "Shrt", which could be mistaken for
> > -- "shirt", or some other word with four letters
> > for Signed_Short'Size use 8;
>
> > type Unsigned_Short is range 0 .. 255;
> > for Unsigned_Short'Size use 8;
>
> > Arg : Float;
> > Unsigned_Result : Unsigned_Short;
> > Result : Signed_Short;
> > begin
> > Arg := 200.0;
> > Unsigned_Result := Unsigned_Short (Arg + 0.5);
> > -- will raise exception if Arg is out of the range 0.0 ..
> > 255.0,
> > -- after rounding
>
> > if Unsigned_Result >= 128
> > then Result := Signed_Short (Integer(Unsigned_Result) - 256)
> > else Result := Signed_Short (Unsigned_Result);
> > end if;
>
> > (You may have to convert to "Integer" before subtracting 256 because
> > otherwise Ada may try to use 8-bit integers to do the arithmetic and
> > then
> > things will be out of range.)
>
> > Or maybe you don't need the Unsigned_Short type:
>
> > if Arg >= 128.0
> > then Result := Signed_Short (Arg + 0.5 - 256.0)
> > else Result := Signed_Short (Arg + 0.5);
> > end if;
>
> > Or you can use Unchecked_Conversion if you want:
>
> > function To_Signed_Short is new Unchecked_Conversion
> > (Source => Unsigned_Short, Target => Signed_Short);
> > ...
> > begin
> > ...
> > Unsigned_Result := Unsigned_Short (Arg + 0.5);
> > Result := To_Signed_Short (Unsigned_Result);
>
> > This seems to be what you want... copying bits from an unsigned
> > integer to a signed integer. Not copying bits from a float to an
> > integer---that is not at all what you're trying to accomplish.
>
> I want to copy bits from an Ada float to a user defined short integer
> maintaining the same
> bit representation.
>
> Arg:Float; -- From this with a value of 200
> subtype Short_integer is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
> Result: Short_integer; --to this, and I want to round Arg
Chris,
Never mind the rounding; tell us what you need the value in Result to
be for Arg = 200?
It clearly can't be 200, because that's outside the range you've
specified.
Note that the numeric range you've specified for Short_Integer will
fit into 8 bits, but because you've made it a subtype of Integer,
variables will occupy the same space as an Integer (32 bits usually;
it will be at least 16 bits).
It'd also help to know what compiler you're using.
^ permalink raw reply [relevance 0%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
2009-01-14 16:08 3% ` Adam Beneschan
@ 2009-01-14 21:17 0% ` sjw
[not found] ` <139961e9-bae6-4e60-8ff7-4f4779b27481@z6g2000pre.googlegroups.com>
1 sibling, 0 replies; 200+ results
From: sjw @ 2009-01-14 21:17 UTC (permalink / raw)
On Jan 14, 4:08 pm, Adam Beneschan <a...@irvine.com> wrote:
> On Jan 14, 6:59 am, ChristopherL <clusard...@aol.com> wrote:
>
> > with Ada.Unchecked_Conversion;
>
> > procedure test is
> > subtype Shrt is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
> > Result:Shrt;
>
> > Arg:Float;
>
> > function To_Bits is new
> > Ada.Unchecked_Conversion (Source => Float, Target => Shrt);
>
> > Begin
> > Arg := 200.0;
>
> > Result := To_Bits(Arg + 0.5); -- crude round then type conversion
> > End test;
>
> > -- Error Message Received
>
> > 210 Ada.Unchecked_Conversion (Source => Float, Target =>
> > Shrt);
>
> > *** 387E-0: Identifier ADA is not directly visible
>
> > 236 Result := To_Bits( Arg + 0.5 )
>
> > *** 387E-0: Identifier TO_BITS is not directly visible
> (1) The error messages don't make any sense to me. If you say "with
> Ada.Unchecked_Conversion", then Ada and Ada.Unchecked_Conversion
> should both be visible and you shouldn't be getting "not directly
> visible" errors.
The error messages in OP's listing appear to refer to lines 210 and
236; there aren't nearly that many lines in the quoted code...perhaps
they come from different places?
^ permalink raw reply [relevance 0%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
[not found] ` <f4894476-851e-493f-93a2-168976bd97fb@s1g2000prg.googlegroups.com>
@ 2009-01-14 16:08 3% ` Adam Beneschan
2009-01-14 21:17 0% ` sjw
[not found] ` <139961e9-bae6-4e60-8ff7-4f4779b27481@z6g2000pre.googlegroups.com>
0 siblings, 2 replies; 200+ results
From: Adam Beneschan @ 2009-01-14 16:08 UTC (permalink / raw)
On Jan 14, 6:59 am, ChristopherL <clusard...@aol.com> wrote:
> Hello again,
>
> Trying twice, I seem not to be able to get the "Unchecked_Conversion"
> to compile. See below, and explain this to me.
>
> Thanks,
> Chris L.
>
> -- Program (1) --
>
> with Ada.Unchecked_Conversion;
>
> procedure test is
> subtype Shrt is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
> Result:Shrt;
>
> Arg:Float;
>
> function To_Bits is new
> Ada.Unchecked_Conversion (Source => Float, Target => Shrt);
>
> Begin
> Arg := 200.0;
>
> Result := To_Bits(Arg + 0.5); -- crude round then type conversion
> End test;
>
> -- Error Message Received
>
> 210 Ada.Unchecked_Conversion (Source => Float, Target =>
> Shrt);
>
> *** 387E-0: Identifier ADA is not directly visible
>
> 236 Result := To_Bits( Arg + 0.5 )
>
> *** 387E-0: Identifier TO_BITS is not directly visible
>
> ==================================================================
>
> -- Program (2) --
>
> with Unchecked_Conversion;
>
> procedure test is
> subtype Shrt is Integer range -(2 ** 7) .. ((2 ** 7) - 1 );
> Result:Shrt;
>
> Arg:Float;
>
> function To_Bits is new
> Unchecked_Conversion (Source => Float, Target => Shrt);
>
> Begin
> Arg := 200.0;
>
> Result := To_Bits(Arg + 0.5); -- crude round then type conversion
> End test;
(1) The error messages don't make any sense to me. If you say "with
Ada.Unchecked_Conversion", then Ada and Ada.Unchecked_Conversion
should both be visible and you shouldn't be getting "not directly
visible" errors. You did include the "with" statement in your source
file, right, rather than putting it in another source? I'd check your
compiler manual here; maybe you didn't configure things properly and
you need to do something special in order to access the Ada standard
library. I'm just guessing here. I have no idea what compiler you're
using.
(2) Even if you get past that, your program will not work as
intended. Unchecked_Conversion simply copies bit representations from
one type to another. A floating-point type will contain bits in a
floating-point format, and that format won't look like an integer
format. If Float is an IEEE-standard 32-bit float, the representation
of 200.0 looks like
01000011010010000000000000000000
If you convert this to Shrt, which is probably 8 bits, the language
doesn't really tell you what happens when you Unchecked_Conversion a
32-bit value to an 8-bit value. But most likely you'll either get the
upper 8 bits (01000011) or the lower 8 bits (00000000), neither of
which is what you want.
You need a regular type conversion to convert the float to an integer,
not an Unchecked_Conversion.
(3) You still haven't been clear on what you want to do, but it now
looks like you're trying to take an 8-bit integer in the range 0..255
and convert it to an 8-bit Shrt (in the range -128..127) with the same
bit representation. Did I guess right? If that's the case, it might
be helpful to do this the simple way:
type Signed_Short is range -128 .. 127;
-- more readable than "Shrt", which could be mistaken for
-- "shirt", or some other word with four letters
for Signed_Short'Size use 8;
type Unsigned_Short is range 0 .. 255;
for Unsigned_Short'Size use 8;
Arg : Float;
Unsigned_Result : Unsigned_Short;
Result : Signed_Short;
begin
Arg := 200.0;
Unsigned_Result := Unsigned_Short (Arg + 0.5);
-- will raise exception if Arg is out of the range 0.0 ..
255.0,
-- after rounding
if Unsigned_Result >= 128
then Result := Signed_Short (Integer(Unsigned_Result) - 256)
else Result := Signed_Short (Unsigned_Result);
end if;
(You may have to convert to "Integer" before subtracting 256 because
otherwise Ada may try to use 8-bit integers to do the arithmetic and
then
things will be out of range.)
Or maybe you don't need the Unsigned_Short type:
if Arg >= 128.0
then Result := Signed_Short (Arg + 0.5 - 256.0)
else Result := Signed_Short (Arg + 0.5);
end if;
Or you can use Unchecked_Conversion if you want:
function To_Signed_Short is new Unchecked_Conversion
(Source => Unsigned_Short, Target => Signed_Short);
...
begin
...
Unsigned_Result := Unsigned_Short (Arg + 0.5);
Result := To_Signed_Short (Unsigned_Result);
This seems to be what you want... copying bits from an unsigned
integer to a signed integer. Not copying bits from a float to an
integer---that is not at all what you're trying to accomplish.
Hope this gives you some idea of how this language works. It's quite
simple, really.
-- Adam
^ permalink raw reply [relevance 3%]
* Re: How to put 200 into an integer sub-type of 16 bits (code included)
[not found] ` <3d3719f4-355c-4094-9902-495d612d46fe@n33g2000pri.googlegroups.com>
@ 2009-01-14 9:06 2% ` Ludovic Brenta
1 sibling, 0 replies; 200+ results
From: Ludovic Brenta @ 2009-01-14 9:06 UTC (permalink / raw)
ChristopherL wrote on comp.lang.ada:
> What I want to do is this. I have a variable holding the base 10 value
> 200. It has a certain bit representation. If the variable was an
> integer of 16 bits it's representation would be something such as
> 0000000011001000. For give me if I'm wrong. Anyway, what I'd like to
> do is put that exact bit representation in another variable of a
> different type.
>
> How do I proceed?
The way to do it is with Unchecked_Conversion, as your example shows.
Beware, however, that interpreting the bit representation in another
type will probably yield a different value.
Size_Of_Float : constant := Float'Size;
type Modular_Type_With_Same_Size_As_Float is mod 2 **
Size_Of_Float;
for Modular_Type_With_Same_Size_As_Float'Size use Float'Size;
Two_Hundred : constant Modular_Type_With_Same_Size_As_Float := 200;
function To_Float is new Ada.Unchecked_Conversion
(Modular_Type_With_Same_Size_As_Float, Float);
F : constant Float := To_Float (Two_Hundred);
You can substitute any type you want for Float. The bit representation
of F will be the same as the bit representation of Two_Hundred, but
the value of F is *not* going to be 200. It is even possible that the
bit pattern is illegal for a Float (or your chosen type); you would
then get a Constraint_Error. Is that what you want?
--
Ludovic Brenta.
^ permalink raw reply [relevance 2%]
* Re: Making a Inet_Addr_Type out of octects (GNAT.Sockets)
@ 2008-10-08 10:28 2% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2008-10-08 10:28 UTC (permalink / raw)
--
-- A.adb -- a simple test program that converts 4 8-bit words (Octets)
-- into GNAT.Sockets.Inet_Addr_Type variable and prints results.
--
with Ada.Text_IO ;
use Ada.Text_IO ;
with Ada.Unchecked_Conversion ;
with GNAT.Sockets ;
use GNAT.Sockets ;
procedure a is
subtype Inet_Addr_Comp_Type is Natural range 0 .. 255;
type Inet_Addr_VN_Type is array (Natural range <>) of Inet_Addr_Comp_Type;
subtype Inet_Addr_V4_Type is Inet_Addr_VN_Type (1 .. 4);
subtype Inet_Addr_V6_Type is Inet_Addr_VN_Type (1 .. 16);
type Inet_Addr_Type (Family : Family_Type := Family_Inet) is record
case Family is
when Family_Inet =>
Sin_V4 : Inet_Addr_V4_Type := (others => 0);
when Family_Inet6 =>
Sin_V6 : Inet_Addr_V6_Type := (others => 0);
end case;
end record;
function To_Gnat is new Ada.Unchecked_Conversion
( Inet_Addr_Type, GNAT.Sockets.Inet_Addr_Type ) ;
newip : Inet_Addr_Type ;
sysip : GNAT.Sockets.Inet_Addr_Type ;
begin -- a
-- Set 'newip' to 127.0.0.1
newip.Sin_V4 ( 1 ) := 16#7F# ;
newip.Sin_V4 ( 2 ) := 16#00# ;
newip.Sin_V4 ( 3 ) := 16#00# ;
newip.Sin_V4 ( 4 ) := 16#01# ;
sysip := To_Gnat ( newip );
Put_Line ( Image ( sysip ) ) ;
end a ;
In <910108d9-03a0-4e35-86d2-572501a82906@z6g2000pre.googlegroups.com>, mockturtle <framefritti@gmail.com> writes:
>Dear.all,
>a very simple (almost silly) question whose answer, I fear, is
>"no."...
>
>I have 4 octects (read by a received packet) which rappresent
>an IP address and I want to convert them into a Inet_Addr_Type
>(using GNAT.Sockets). Of course I could convert the 4 octects
>into a string to be given to function Inet_Addr_Type, but it seems
>a bit "convoluted" (it sounds like the joke about the mathematician's
>algorithm to make a pot of hot water :-). My question is: there
>is a function which allows me to do such a conversion in a
>more direct way? I looked at g-sockets, searching for
>"Inet_Addr_Type", but I could not find anything.
>
>Thank you in advance.
^ permalink raw reply [relevance 2%]
* Re: Warning when compiling s-interr.adb runtime file with -gnatc
2008-09-25 22:17 2% Warning when compiling s-interr.adb runtime file with -gnatc David Sauvage
@ 2008-09-26 0:47 0% ` Adam Beneschan
0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2008-09-26 0:47 UTC (permalink / raw)
On Sep 25, 3:17 pm, David Sauvage <sauvage.da...@gmail.com> wrote:
> When compiling s-interr.adb runtime file with -gnatc [1] produce a
> warning [2]. This warning is not raise when compiling wihtout -gnatc.
>
> Does the target and source types [3] really have different sizes ? or
> may be it's a problem on gnat ?
>
> [1]
> -gnatc Check syntax and semantics only (no code generation)
>
> [2]
> $ gcc-4.3 -c -gnatpg -nostdinc -nostdlib -g -gnatc -I- -gnatA /usr/lib/
> gcc/i486-linux-gnu/4.3.2/rts-native/adainclude/s-interr.adb -I/usr/lib/
> gcc/i486-linux-gnu/4.3.2/rts-native/adainclude/
> s-interr.adb:569:07: warning: types for unchecked conversion have
> different sizes
>
> [3]
> s-interr.ads
> type Parameterless_Handler is access protected procedure;
> s-interr.adb
> 564 type Fat_Ptr is record
> 565 Object_Addr : System.Address;
> 566 Handler_Addr : System.Address;
> 567 end record;
> 568
> 569 function To_Fat_Ptr is new Ada.Unchecked_Conversion
> 570 (Parameterless_Handler, Fat_Ptr);
>
I get the same warning with similar type declarations, but if I don't
use -gnatc and have my program output the 'Size of both types, it says
64 for both. Strange...
-- Adam
^ permalink raw reply [relevance 0%]
* Warning when compiling s-interr.adb runtime file with -gnatc
@ 2008-09-25 22:17 2% David Sauvage
2008-09-26 0:47 0% ` Adam Beneschan
0 siblings, 1 reply; 200+ results
From: David Sauvage @ 2008-09-25 22:17 UTC (permalink / raw)
When compiling s-interr.adb runtime file with -gnatc [1] produce a
warning [2]. This warning is not raise when compiling wihtout -gnatc.
Does the target and source types [3] really have different sizes ? or
may be it's a problem on gnat ?
[1]
-gnatc Check syntax and semantics only (no code generation)
[2]
$ gcc-4.3 -c -gnatpg -nostdinc -nostdlib -g -gnatc -I- -gnatA /usr/lib/
gcc/i486-linux-gnu/4.3.2/rts-native/adainclude/s-interr.adb -I/usr/lib/
gcc/i486-linux-gnu/4.3.2/rts-native/adainclude/
s-interr.adb:569:07: warning: types for unchecked conversion have
different sizes
[3]
s-interr.ads
type Parameterless_Handler is access protected procedure;
s-interr.adb
564 type Fat_Ptr is record
565 Object_Addr : System.Address;
566 Handler_Addr : System.Address;
567 end record;
568
569 function To_Fat_Ptr is new Ada.Unchecked_Conversion
570 (Parameterless_Handler, Fat_Ptr);
Ubuntu Intrepid x86
libgnat-4.3 (4.3.2-1ubuntu1)
^ permalink raw reply [relevance 2%]
* Re: Structure of the multitasking server
@ 2008-09-23 9:25 1% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2008-09-23 9:25 UTC (permalink / raw)
--
-- A Server and a Client that shows how to use
-- GNAT.Sockets.Check_Selection as a controller for
-- multiple port server. And can be alter to allow multiple
-- services type of server.
--
-- In C, they call this type of server a Super-Server Class
-- of servers.
--
-- ------------------------------------------------------------ --
-- Multi-Tasking Server that allows Multi-Service to be handled --
-- ------------------------------------------------------------ --
with Ada.Text_IO ;
with GNAT.Sockets ;
with System ;
use Ada.Text_IO ;
use GNAT.Sockets ;
procedure testserver is
-- ------------------- --
-- Server Task Types --
-- ------------------- --
--
-- TCP Task
--
task tcp_hello is
entry Initialize ;
entry Acknowledge ;
end tcp_hello ;
--
-- UDP Task
--
task udp_hello is
entry Initialize ;
entry Acknowledge ;
end udp_hello ;
Server_Error : exception ;
tcp_Socket : Socket_Type ;
udp_Socket : Socket_Type ;
-- ------------------------------------------------------------------------ --
---- TCP/IP Controller Task ----
---- ----
---- dispatches server task to handle tcp/ip services. ----
---- ----
-- ------------------------------------------------------------------------ --
task Controller is
entry Initialize_Controller ;
end Controller ;
task body Controller is
Selector : Selector_Type ;
Server_Status : Selector_Status ;
-- Exception_Fds is not use in Ada 95
-- and is optional Ada 2005 GNAT.Sockets
Read_Fds : Socket_Set_Type ;
Write_Fds : Socket_Set_Type ;
begin -- Controller
--
-- Set up controller variables
--
Create_Selector ( Selector ) ;
Empty ( Read_Fds ) ;
Empty ( Write_Fds ) ;
Accept Initialize_Controller ;
--
-- Set up and active Server
--
Put_Line ( "Controller: Server Dispatching Loop" ) ;
loop
-- Insure Fds value,
Empty ( Read_Fds ) ;
Empty ( Write_Fds ) ;
Set ( Read_Fds, tcp_Socket ) ;
Set ( Read_Fds, udp_Socket ) ;
--
-- Excute the TCP/IP "Select" routine. This routine is blocked
-- until a connecion is made. In this part it is identical to
-- TCP/IP "Accept".
--
-- Also, Exception_Fds is not use in Ada 95 and is optional
-- Ada 2005 GNAT.Sockets
--
Check_Selector ( Selector,
Read_Fds,
Write_Fds,
Server_Status ) ;
-- call a server to handle job using Signalling Fds
if Is_Set ( Read_Fds, tcp_Socket ) then
tcp_hello.Acknowledge ;
elsif Is_Set ( Read_Fds, udp_Socket ) then
udp_hello.Acknowledge ;
else
raise Socket_Error ;
end if ;
end loop ;
exception
when Socket_Error =>
-- need to signal servers to shutdown because
-- dispatcher has stopped
raise ;
end Controller ;
-- ------------------------------------------------------------------------ --
---- TCP/IP Server Tasks ----
---- ----
---- Both tasks are similar. They both send a message to a client ----
---- Differences: ----
---- 1) Transport protocols: One uses TCP, the other uses UDP ----
---- 2) Message and message length ----
---- ----
---- Excution of these two servers will cause the "netstat" program ----
---- to add the following info to the "netstat" socket report ----
---- ----
---- IP Address protocol port ----
---- 127.0.0.1 tcp 54321 ----
---- 127.0.0.1 udp 54321 ----
---- ----
-- ------------------------------------------------------------------------ --
task body tcp_hello is
Port : constant Port_Type := 54321 ;
Address : Sock_Addr_Type ;
Channel : Stream_Access ;
Client : Socket_Type ;
hello_string : String ( 1..25 ) := "TCP Server: Hello, World!" ;
begin -- Tcp_hello
Create_Socket ( tcp_Socket, Family_Inet, Socket_Stream ) ;
--
-- Address.Addr := Any_Inet_Addr ;
Address.Addr := Inet_Addr ( "127.0.0.1" ) ; -- Limited access
Address.Port := Port ;
--
Bind_Socket ( tcp_Socket, Address ) ;
--
Listen_Socket ( tcp_Socket, 4 ) ;
Accept Initialize ;
--
-- Main Server processing routine
--
Put_Line ( "TCP: Active the Server loop" ) ;
loop
accept Acknowledge ;
-- ------------------------ --
-- Do server services job --
-- ------------------------ --
--
-- Because of Check_Selector, no wait for Accept_Socket
-- used to obtain connected socket ( Client ) address
-- for the tcp protocol.
--
Accept_Socket ( tcp_Socket, Client, Address ) ;
Channel := Stream ( Client ) ;
String'Write ( Channel, hello_string ) ;
Close_Socket ( Client ) ;
end loop ;
--
-- for security, close socket if exception occured
--
exception
when others =>
Put_Line ( "TCP: Exception" ) ;
Close_Socket ( tcp_Socket ) ;
raise ;
end tcp_hello ;
--
-- UDP Task
--
task body udp_hello is
Port : constant Port_Type := 54321 ;
Address : Sock_Addr_Type ;
Channel_Input : Stream_Access ;
Channel_Output : Stream_Access ;
Temp : Character ;
hello_string : String := "UDP Server: Repeat Hello, World!" ;
begin -- udp_hello
Create_Socket ( udp_Socket, Family_Inet, Socket_Datagram ) ;
--
-- Address.Addr := Any_Inet_Addr ;
Address.Addr := Inet_Addr ( "127.0.0.1" ) ;
Address.Port := Port ;
--
Bind_Socket ( udp_Socket, Address ) ;
Accept Initialize ;
--
-- Main Server processing routine
--
Put_Line ( "UDP: Active the Server loop" ) ;
loop
accept Acknowledge ;
-- ------------------------ --
-- Do server services job --
-- ------------------------ --
-- Accept from any Address and Port
Address.Addr := Any_Inet_Addr ;
Address.Port := Any_Port ;
Channel_Input := Stream ( udp_Socket, Address ) ;
Character'Read ( Channel_Input, Temp ) ;
-- Open an output channel
Address := Get_Address ( Channel_Input ) ;
Channel_Output := Stream ( udp_Socket, Address ) ;
String'Write ( Channel_Output, hello_string ) ;
end loop ;
--
-- for security, close socket if exception occured
--
exception
when others =>
Put_Line ( "UDP: Exception" ) ;
Close_Socket ( udp_Socket ) ;
raise ;
end udp_hello ;
-- ------------------------ --
---- Server Initiaizer ----
-- ------------------------ --
begin
-- Initialize each server service task
tcp_hello.Initialize ;
udp_hello.Initialize ;
-- Startup network controller
Controller.Initialize_Controller ;
--
-- Handle all exceptions
--
exception
when Socket_Error =>
raise ;
when others =>
raise ;
end testserver ;
-- ----------------------------------------------------- --
-- Non-Tasking Client that test the Multi-Service Server --
-- ----------------------------------------------------- --
with Ada.Command_Line ;
with Ada.Text_IO ;
with Ada.Unchecked_Conversion ;
with GNAT.Sockets ;
use Ada.Command_Line ;
use Ada.Text_IO ;
use GNAT.Sockets ;
procedure testclient is
localhost : constant Inet_Addr_Type := Inet_Addr ( "127.0.0.1" ) ;
localport : constant Port_Type := 54321 ;
--
Address : Sock_Addr_Type ;
Channel : Stream_Access ;
Socket : Socket_Type ;
--
tcp_Buffer : String ( 1..25 ) ;
udp_Buffer : String ( 1..32 ) ;
begin -- Daytime0
--
Address.Addr := localhost ;
Address.Port := localport ;
--
if Argument ( 1 ) = "-T" then
Put_Line ( "Protocol: TCP" ) ;
--
Create_Socket ( Socket, Family_Inet, Socket_Stream ) ;
Connect_Socket ( Socket, Address ) ;
--
Channel := Stream ( Socket ) ;
String'Read ( Channel, tcp_Buffer ) ;
--
Close_Socket ( Socket ) ;
--
Put ( "Server Data => " ) ;
Put ( tcp_Buffer ) ;
Put ( " <= " ) ;
New_Line ;
elsif Argument ( 1 ) = "-U" then
Put_Line ( "Protocol: UDP" ) ;
--
Create_Socket ( Socket, Family_Inet, Socket_Datagram ) ;
Channel := Stream ( Socket, Address ) ;
-- Allows server to obtain client address by send a dummy character
Character'Write ( Channel, Ascii.nul ) ;
--
Channel := Stream ( Socket, Address ) ;
String'Read ( Channel, udp_Buffer ) ;
--
Close_Socket ( Socket ) ;
--
Put ( "Server Data => " ) ;
Put ( udp_Buffer ) ;
Put ( " <= " ) ;
New_Line ;
else
Put_Line ( Standard_Error, "usage: testclient [-DT]" ) ;
Put_Line ( Standard_Error, "-T: tcp" ) ;
Put_Line ( Standard_Error, "-U: udp" ) ;
New_Line ;
end if ;
end testclient ;
^ permalink raw reply [relevance 1%]
* Re: Adding offset to 'Address
2008-09-13 6:21 3% ` tmoran
@ 2008-09-17 9:15 0% ` Kim Rostgaard Christensen
0 siblings, 0 replies; 200+ results
From: Kim Rostgaard Christensen @ 2008-09-17 9:15 UTC (permalink / raw)
tmoran@acm.org wrote:
>> Raw_Bytes : access Unsigned_Char
>> for Ethernet_Header'Address use Raw_Bytes.all'Address;
>>
>> and additionally need something like:
>> for IP_Packet'Address use Raw_Bytes.all'Address + Ethernet_Header'Size;
>
> It's not clear to me exactly what problem you are trying to get past.
The problem was basically to perform arithmethics on system addresses
> How about something like:
>
> with Ada.Unchecked_Conversion,
> Interfaces.C;
> procedure Eiptest is
> type Ethernet_Header_Type is new Integer; -- or whatever
> type IP_Packet_Type is array (1 .. 5) of Integer; -- "
>
> type R_Type is record
> Ethernet_Header: Ethernet_Header_Type;
> IP_Packet: IP_Packet_Type;
> Other_Stuff : Integer;
> end record;
> for R_Type use record
> Ethernet_Header at 0 range 0 .. 31;
> IP_Packet at 4 range 0 .. 159;
> Other_Stuff at 30 range 0 .. 31;
> end record;
>
> type Lpvoid is access all Interfaces.C.Char;
> type R_Ptr_Type is access all R_Type;
>
> function Convert is new Ada.Unchecked_Conversion
> (Source => Lpvoid, Target => R_Ptr_Type);
>
> procedure Process(Raw_Bytes: in Lpvoid) is
> R_Ptr : constant R_Ptr_Type := Convert(Raw_Bytes);
> This_IP_Packet: IP_Packet_Type renames R_Ptr.IP_Packet;
> begin
> null; -- do something with This_IP_Packet
> end Process;
>
> Buffer : Interfaces.C.Char_Array(1 .. 100);
>
> begin
> Process(Buffer(1)'access);
> end Eiptest;
This is a nice approch, I will try it out.
- Kim
^ permalink raw reply [relevance 0%]
* Re: Adding offset to 'Address
@ 2008-09-13 6:21 3% ` tmoran
2008-09-17 9:15 0% ` Kim Rostgaard Christensen
0 siblings, 1 reply; 200+ results
From: tmoran @ 2008-09-13 6:21 UTC (permalink / raw)
> Raw_Bytes : access Unsigned_Char
> for Ethernet_Header'Address use Raw_Bytes.all'Address;
>
>and additionally need something like:
> for IP_Packet'Address use Raw_Bytes.all'Address + Ethernet_Header'Size;
It's not clear to me exactly what problem you are trying to get past.
How about something like:
with Ada.Unchecked_Conversion,
Interfaces.C;
procedure Eiptest is
type Ethernet_Header_Type is new Integer; -- or whatever
type IP_Packet_Type is array (1 .. 5) of Integer; -- "
type R_Type is record
Ethernet_Header: Ethernet_Header_Type;
IP_Packet: IP_Packet_Type;
Other_Stuff : Integer;
end record;
for R_Type use record
Ethernet_Header at 0 range 0 .. 31;
IP_Packet at 4 range 0 .. 159;
Other_Stuff at 30 range 0 .. 31;
end record;
type Lpvoid is access all Interfaces.C.Char;
type R_Ptr_Type is access all R_Type;
function Convert is new Ada.Unchecked_Conversion
(Source => Lpvoid, Target => R_Ptr_Type);
procedure Process(Raw_Bytes: in Lpvoid) is
R_Ptr : constant R_Ptr_Type := Convert(Raw_Bytes);
This_IP_Packet: IP_Packet_Type renames R_Ptr.IP_Packet;
begin
null; -- do something with This_IP_Packet
end Process;
Buffer : Interfaces.C.Char_Array(1 .. 100);
begin
Process(Buffer(1)'access);
end Eiptest;
^ permalink raw reply [relevance 3%]
* Re: Controlling endian-ness?
@ 2008-08-05 3:10 2% ` Steve
0 siblings, 0 replies; 200+ results
From: Steve @ 2008-08-05 3:10 UTC (permalink / raw)
"Peter C. Chapin" <pcc482719@gmail.com> wrote in message
news:4897b7f5$0$19705$4d3efbfe@news.sover.net...
> I'm trying to read/write 32 bit quantities from/to a binary file. The file
> has a format defined by a specification that is outside my control. Some
> of the quantities are stored in the file in big endian order. However, my
> machine is a little endian machine. The file in question also contains
> various values that are most naturally represented with different data
> types. Thus I'm looking at Stream_IO as a way to deal with it.
>
> As an experiment I wrote a small program that defines a 32 bit unsigned
> integer type and then overrides the 'Write attribute to write the value in
> big endian form. Here is what I have:
>
> with Ada.Streams; use Ada.Streams;
> with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
> with Interfaces; use Interfaces;
>
> procedure Stream_Check is
> pragma Assert(Stream_Element'Size = 8);
>
> type Word is mod 2**32;
> procedure Word_Write
> (Stream : access Root_Stream_Type'Class; Item : in Word);
> for Word'Size use 32;
> for Word'Write use Word_Write;
>
> procedure Word_Write
> (Stream : access Root_Stream_Type'Class; Item : in Word) is
> Buffer : Stream_Element_Array(0..3);
> Workspace : Unsigned_32 := Unsigned_32(Word); -- ERROR HERE!
> begin
> Buffer(0) :=
> Stream_Element(Shift_Right((Workspace and 16#FF000000#), 24));
> Buffer(1) :=
> Stream_Element(Shift_Right((Workspace and 16#00FF0000#), 16));
> Buffer(2) :=
> Stream_Element(Shift_Right((Workspace and 16#0000FF00#), 8));
> Buffer(3) :=
> Stream_Element(Shift_Right((Workspace and 16#000000FF#), 0));
> Write(Stream.all, Buffer);
> end Word_Write;
>
> Output_File : File_Type;
> Stream_Pointer : Stream_Access;
>
> W : Word := 16#0000FFFF#;
> begin
> Create(Output_File, Out_File, "test.bin");
> Stream_Pointer := Stream(Output_File);
> Word'Write(Stream_Pointer, W);
> Close(Output_File);
> end Stream_Check;
>
> I'm using GNAT GPL 2008. It produces an error on the indicated line
> saying, "invalid use of subtype mark in expression or call." Apparently it
> doesn't like me trying to convert a Word to an Unsigned_32, but I don't
> understand why (am I doing that conversion right?).
>
> I want to use Unsigned_32 so that I can use Shift_Right. I can't override
> the 'Write attribute for Unsigned_32 directly because it's in a different
> package (right?).
>
> Overall I have a feeling that there is probably a much better way to do
> this.
>
> Peter
I don't know if this will be useful to you, but here is the technique I used
for reversing the byte order on a 32 bit integer. Actually I was going for
"network byte order" of a float (s_float is a 32 bit float, u_long is a
32bit unsigned integer).
TYPE aByte IS MOD 256;
FOR aByte'SIZE USE 8;
TYPE aByteArray IS ARRAY( Positive RANGE <> ) OF aByte;
FUNCTION nltohf( value : u_long ) RETURN s_float IS
TYPE aFourBytes IS NEW aByteArray(1..4);
FUNCTION Conv IS
NEW Ada.Unchecked_Conversion( aFourBytes, s_float );
FUNCTION Conv IS
NEW Ada.Unchecked_Conversion( u_long, aFourBytes );
temp : aFourBytes := Conv( value );
BEGIN
RETURN Conv( aFourBytes'( temp(4), temp(3), temp(2), temp(1) ) );
END nltohf;
It isn't endian neutral (or particularly pretty), but it got the job done.
Regards,
Steve
^ permalink raw reply [relevance 2%]
* Re: Bit operations in Ada (endianness)
2008-05-24 15:36 0% ` Simon Wright
@ 2008-06-02 13:27 0% ` Dennis Hoppe
0 siblings, 0 replies; 200+ results
From: Dennis Hoppe @ 2008-06-02 13:27 UTC (permalink / raw)
Hi,
I have another question regarding litte and big-endian. Is there
any way to declare, that the type
type Bit_Field is array (Bit_Number) of Boolean;
is represented by litte or big-endian? Bit_Number is a generic
paremeter (mod <>). I figured out to set the endianness to
record types, but it does not work for the above array type.
I also wonder, if I can query the operating system via Ada,
which endianness it uses.
Thank you in advance,
Dennis Hoppe
Simon Wright wrote:
> Ludovic Brenta <ludovic@ludovic-brenta.org> writes:
>
>> Another alternative is Unchecked_Conversion:
>>
>> type Bit_Number is range 0 .. 31;
>> type Bit_Field is array (Bit_Number) of Boolean;
>> pragma Pack (Bit_Field);
>> function To_Bit_Field is
>> new Ada.Unchecked_Conversion (Source => Interfaces.Unsigned_32,
>> Target => Bit_Field);
>
> Whether this does what you want may depend on whether the machine is
> big-endian (eg, SPARC, PowerPC etc) or not (Intel etc).
^ permalink raw reply [relevance 0%]
* Re: Bit operations in Ada
2008-05-23 22:08 3% ` Ludovic Brenta
@ 2008-05-24 15:36 0% ` Simon Wright
2008-06-02 13:27 0% ` Bit operations in Ada (endianness) Dennis Hoppe
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2008-05-24 15:36 UTC (permalink / raw)
Ludovic Brenta <ludovic@ludovic-brenta.org> writes:
> Another alternative is Unchecked_Conversion:
>
> type Bit_Number is range 0 .. 31;
> type Bit_Field is array (Bit_Number) of Boolean;
> pragma Pack (Bit_Field);
> function To_Bit_Field is
> new Ada.Unchecked_Conversion (Source => Interfaces.Unsigned_32,
> Target => Bit_Field);
Whether this does what you want may depend on whether the machine is
big-endian (eg, SPARC, PowerPC etc) or not (Intel etc).
^ permalink raw reply [relevance 0%]
* Re: Bit operations in Ada (Thank you)
@ 2008-05-24 9:40 2% ` Dennis Hoppe
0 siblings, 0 replies; 200+ results
From: Dennis Hoppe @ 2008-05-24 9:40 UTC (permalink / raw)
Robert A Duff wrote:
> I'm curious why you want to do all these things on the same type.
> You say, "My objective is...", but what's the higher-level objective?
The higher-level objective is to get involved in cryptoanalysis.
> Anyway, I would use Unchecked_Conversion between a modular type and a
> packed array of Boolean, as suggested by Ludovic Brenta.
> Possibly wrapped in useful functions.
>
> Instead of pragma Pack, I would use
> "for Bit_Field'Component_Size use 1;".
> They both do the same thing, but conceptually, "pack" means
> "I want small things, so whole-object operations are faster,
> at the expense of per-component operations", whereas the
> Component_Size clause means "I depend on the exact bit size
> for correctness".
>
> - Bob
Many thanks for your detailed explanation of possible solutions,
Ludovic. I would like to also thank the "rest of the group". I stumbled
upon Ada.Unchecked_Conversion, but wasn't sure, if this is the way to
enforce some behaviour in Ada. I guess, I wil give this solution a try
and replace the pack pragma with your approach, Bob.
Best regards,
Dennis
^ permalink raw reply [relevance 2%]
* Re: Bit operations in Ada
@ 2008-05-23 22:08 3% ` Ludovic Brenta
2008-05-24 15:36 0% ` Simon Wright
1 sibling, 1 reply; 200+ results
From: Ludovic Brenta @ 2008-05-23 22:08 UTC (permalink / raw)
Dennis Hoppe <dennis.hoppe@hoppinet.de> writes:
> Hello,
>
> I'm new to Ada and bitwise operations is a new challenge in this
> realm. My objective is to manipulate some bit strings in Ada,
> especially:
>
> a) addition/subtraction mod 2**n,
> b) change bits directly (e.g, via array access)
> c) shift operations
> d) rotate operations
> e) and, xor, not, or
>
> I started with an array of booleans of size 2**n, that provides neat
> access to individual bits by means of an index. Unfortunately,
> addition/subtraction mod 2**n is not supported, but essential for me.
>
> Next, I tried modular types (mod 2**n), but ended up with not having
> direct access to individual bits. My last attempt was to use
> Interfaces.Unsinged_n. It is a solid package that simplifies the usage
> of bitwise operations for me by adding shift and rotate
> operations. Addition modulo n works well, but I have to dispense with
> direct bit access, too.
>
> So, what is coming next? Should I go with Interfaces.Unsinged_n and
> provide a suitable function that converts the used type into an array
> of boolean? Maybe, I'm ought to use directly an array of boolean and
> try to convert the array into an Unsigned_n; if required to add two
> bit-strings.
IIUC, modular types such as Interfaces.Unsigned_n provide all
operations you need except for direct bit access.
Solution 1:
You can access bits using "and", "or", "not", "**" and "=" like so:
declare
A : Interfaces.Unsigned_32 := 2#00000000000000000000000000000000#;
use type Interfaces.Unsigned_32;
Is_Bit_8_Set : Boolean;
begin
A := A or 2 ** 5; -- Set bit 5 to 1
Is_Bit_8_Set := A and 2 ** 8 /= 0; -- read bit 8
end;
Solution 2:
If this is too difficult or error-prone, you could wrap that into
inlined subprograms like so:
type Bit_Number is range 0 .. 31;
procedure Set (Bit : in Bit_Number;
In_Value : in out Interfaces.Unsigned_32;
To : in Boolean) is
use type Interfaces.Unsigned_32;
begin
if To = True then
In_Value := In_Value or 2 ** Bit;
else
In_Value := In_Value and not 2 ** Bit;
end if;
end Set;
function Is_Set (Bit : in Bit_Number;
In_Value : in Interfaces.Unsigned_32) return Boolean is
use type Interfaces.Unsigned_32;
begin
return In_Value and 2 ** Bit /= 0;
end Is_Set;
Solution 3:
Another alternative is Unchecked_Conversion:
type Bit_Number is range 0 .. 31;
type Bit_Field is array (Bit_Number) of Boolean;
pragma Pack (Bit_Field);
function To_Bit_Field is
new Ada.Unchecked_Conversion (Source => Interfaces.Unsigned_32,
Target => Bit_Field);
function To_Unsigned_32 is
new Ada.Unchecked_Conversion (Source => Bit_Field,
Target => Interfaces.Unsigned_32);
procedure Set (Bit : in Bit_Number;
In_Value : in out Interfaces.Unsigned_32;
To : in Boolean) is
Field : Bit_Field := To_Bit_Field (In_Value);
begin
Field (Bit) := To;
In_Value := To_Unsigned_32 (Field);
end Set;
HTH
--
Ludovic Brenta.
^ permalink raw reply [relevance 3%]
* Re: How to check a Float for NaN
2008-05-06 18:45 2% ` Wiljan Derks
@ 2008-05-06 22:18 0% ` Adam Beneschan
0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2008-05-06 22:18 UTC (permalink / raw)
On May 6, 11:45 am, "Wiljan Derks" <Wiljan.De...@gmail.com> wrote:
> The following code works fine for us:
>
> type Ieee_Short_Real is
> record
> Mantisse_Sign : Integer range 0 .. 1;
> Exponent : Integer range 0 .. 2 ** 8 - 1;
> Mantisse : Integer range 0 .. 2 ** 23 - 1;
> end record;
>
> for Ieee_Short_Real use
> record
> Mantisse_Sign at 0 range 31 .. 31;
> Exponent at 0 range 23 .. 30;
> Mantisse at 0 range 0 .. 22;
> end record;
>
> function Valid_Real (Number : Float) return Boolean is
> function To_Ieee_Short_Real is
> new Ada.Unchecked_Conversion (Float, Ieee_Short_Real);
> begin
> return To_Ieee_Short_Real (Number).Exponent /= 255;
> end Valid_Real;
It might make sense to use modular types instead of signed integer
types for Mantisse_Sign, Exponent, and Mantisse (or Mantissa, if you
want to use English); then you can use "and", "or", and "not"
operations to test bits. Actually, I'd probably define a couple
constants here:
Exponent_Size : constant := 8;
Mantissa_Size : constant := 23;
type Exponent_Type is mod 2 ** Exponent_Size;
type Mantissa_Type is mod 2 ** Mantissa_Size;
type Mantissa_Sign_Type is mod 2;
Using constants makes it easy to re-implement this for 64- and 80-bit
floats.
type Ieee_Short_Real is
record
Mantissa_Sign : Mantissa_Sign_Type;
Exponent : Exponent_Type;
Mantissa : Mantissa_Type;
end record;
(I've omitted the rep clause because I think the one above might work
only for big-endian and not little-endian machines or vice versa, and
I don't feel like figuring it out because I have a cold and my head
hurts enough already.)
Then, if X is the result of the Unchecked_Conversion:
Number is a valid float if X.Exponent /= Exponent_Type'Last
Number is an infinity if X.Exponent = Exponent_Type'Last and
X.Mantissa = 0
Number is a qNaN if X.Exponent = Exponent_Type'Last and
(X.Mantissa and 2**(Mantissa_Size-1) /= 0)
Number is a sNaN if X.Exponent = Exponent_Type'Last and X.Mantissa /=
0 and
(X.Mantissa and 2**(Mantissa_Size-1) = 0)
On the Pentium, Number is a "real indefinite" if
X.Exponent = Exponent_Type'Last and
X.Mantissa = 2**(Mantissa_Size-1)
Number is a denormal if X.Exponent = 0 and X.Mantissa /= 0
Hope this helps someone (and I hope I didn't screw up and get
something wrong),
-- Adam
^ permalink raw reply [relevance 0%]
* Re: How to check a Float for NaN
@ 2008-05-06 18:45 2% ` Wiljan Derks
2008-05-06 22:18 0% ` Adam Beneschan
0 siblings, 1 reply; 200+ results
From: Wiljan Derks @ 2008-05-06 18:45 UTC (permalink / raw)
The following code works fine for us:
type Ieee_Short_Real is
record
Mantisse_Sign : Integer range 0 .. 1;
Exponent : Integer range 0 .. 2 ** 8 - 1;
Mantisse : Integer range 0 .. 2 ** 23 - 1;
end record;
for Ieee_Short_Real use
record
Mantisse_Sign at 0 range 31 .. 31;
Exponent at 0 range 23 .. 30;
Mantisse at 0 range 0 .. 22;
end record;
function Valid_Real (Number : Float) return Boolean is
function To_Ieee_Short_Real is
new Ada.Unchecked_Conversion (Float, Ieee_Short_Real);
begin
return To_Ieee_Short_Real (Number).Exponent /= 255;
end Valid_Real;
Wiljan
^ permalink raw reply [relevance 2%]
* Re: updating a hardware cursor with assembly and ada
@ 2008-03-07 19:01 2% ` cl1
0 siblings, 0 replies; 200+ results
From: cl1 @ 2008-03-07 19:01 UTC (permalink / raw)
Okay I have updated the Update_Cursor method with the following
implementation, However I am getting the error:
i386-elf-gcc -fno-pic -c -nostdinc -ffunction-sections -fdata-sections
-I. -gnato -gnatp -gnatE vga.adb
vga.adb:3:06: "System.Machine_Code" is not a predefined library unit
I know the error message means there is no System.Machine_Code that it
can find. What i don't know is if there is a flag, or something i can
do to get access to it. I'm really lost at this point, because there
is no way i can implement that package with my current knowledge.
with System;
with Interfaces;
with System.Machine_Code;
package body Vga is
...
-----------------------------------------------------------------------------
procedure Update_Cursor (Console : Video_Console) is
use Interfaces;
use System.Machine_Code;
Data : Unsigned_16 := Console.Column * 80 + Console.Row;
OutB : String := "outb 140x3D4, 14" & NL & "outb %0, 0x3D5";
Part1 : Unsigned_8 :=
Ada.Unchecked_Conversion(Shift_Right(Data));
Part2 : Unsigned_8 := Ada.Unchecked_Conversion(Data);
begin
Asm (Template => "outb 14, 0x3D4" & NL
& "outb %0, 0x3D5" & NL
& "outb 15, 0x3D4" & NL
& "outb %1, ox3D5",
Input => (Unsigned_8'Asm_Input(Part1),
Unsigned_8'Asm_Input(Part2));
end Update_Cursor;
-----------------------------------------------------------------------------
...
end Vga;
^ permalink raw reply [relevance 2%]
* Re: Is it really Ok to assert that the Ada syntax is a context-free grammar ?
@ 2008-02-25 21:47 2% ` Samuel Tardieu
0 siblings, 0 replies; 200+ results
From: Samuel Tardieu @ 2008-02-25 21:47 UTC (permalink / raw)
>>>>> "Simon" == Simon Wright <simon.j.wright@mac.com> writes:
>> reinterpret_cast <X>(Y) copies a bit pattern.
Simon> No idea what this does! sounds evil
It is an Ada.Unchecked_Conversion of Y's type into X.
Sam
--
Samuel Tardieu -- sam@rfc1149.net -- http://www.rfc1149.net/
^ permalink raw reply [relevance 2%]
* Re: Is it really Ok to assert that the Ada syntax is a context-free grammar ?
@ 2008-02-20 20:51 2% ` Robert A Duff
0 siblings, 0 replies; 200+ results
From: Robert A Duff @ 2008-02-20 20:51 UTC (permalink / raw)
Hibou57 <yannick_duchene@yahoo.fr> writes:
> On 20 f�v, 11:34, Ludovic Brenta <ludo...@ludovic-brenta.org> wrote:
>> Jeffrey is correct; it is not a "type cast", it is a "type conversion"
>> and there is no such thing as "Ada.Unchecked_Cast". Yes, this is nit-
>> picking; why would we choose Ada if we didn't care about details and
>> wording?
>
> Ok, forgive me for the english mistake : I use either type cast or
> type conversion to mean the same thing. I will take care in the futur.
I think there's nothing wrong with using informal terms when talking
about Ada, so long as the meaning is clear from context. For example,
I sometimes use "pointer" to mean "access type" or "access value", and I
don't see anything wrong with that. (And some Ada folks lecture me
about it. ;-))
The problem with "type cast" is that in the Ada context, it could mean
two different things -- a type_conversion (which is well-defined
according to the high-level semantics) or an "unchecked conversion"
(i.e. an instance of Ada.Unchecked_Conversion, which is defined
in terms of bit-level representation). The difference is important!
> But I'm still not sure about the assertion that it is context free
> (while, Ok, the AEM does not tell it is LR(1))
The grammar given in the Ada RM under "Syntax" is a context free
grammar. It is, however, ambiguous, and therefore not LR(1).
You noted the biggest ambiguity -- X(Y) could mean various things.
There are a few others (e.g. .all can be implicit in some cases, and
subprogram calls with no parameters don't get empty parens). The full
power of semantic analysis is required to disambiguate these things, in
the general case.
- Bob
^ permalink raw reply [relevance 2%]
* Re: Real Time IO routines
2007-10-27 10:18 0% ` Dmitry A. Kazakov
@ 2007-10-27 20:15 0% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2007-10-27 20:15 UTC (permalink / raw)
Ada Purist never and I mean NEVER uses IMAGE attribute, in the body of
a program. They create a package or sub-package that performs the IO
functions with the use of the IMAGE attribute.
IMAGE attribute is the last thing a programmer should use. to print a value.
It is normally use for DEBUGGING ONLY! A programmer should always create
a routine or better yet a package that uses an algorithm to prints the value
without the use of attributes.
Mostly programs that are created by newbees use IMAGE attribute.
And as for my code! It answer the person question without adding extra
code that might confuse him. Plus, the "Ada.Real_Time" package uses:
type Time is new Duration;
which is in private section. So I know what to convert the value to.
In <ddn82trtef34$.n1ulcxn4se96.dlg@40tude.net>, "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> writes:
>On Sat, 27 Oct 2007 08:56:42 GMT, anon wrote:
>
>> function To_Duration is new Ada.Unchecked_Conversion
> ( Time, Duration ) ;
>
>That is a bad idea. You don't know what is the internal representation of
>Time. The intended effect can be achieved legally:
>
>with Ada.Real_Time; use Ada.Real_Time;
>with Ada.Text_IO; use Ada.Text_IO;
>
>procedure Test is
> function Image (T : Time) return String is
> Seconds : Seconds_Count;
> Fraction : Time_Span;
> begin
> Split (T, Seconds, Fraction);
> declare
> After : constant String :=
> Duration'Image (To_Duration (Fraction));
> begin
> return Seconds_Count'Image (Seconds) & After (2..After'Last);
> end;
> end Image;
>begin
> delay 0.5;
> Put_Line (Image (Clock) & "s since the epoch");
> delay 0.5;
> Put_Line (Image (Clock) & "s since the epoch");
>end Test;
>
>--------------------
>However it is quite useless to output absolute time values involving an
>unknown epoch. Unfortunately there is no portable way I know of to convert
>Real_Time.Time to UTC.
>
>--
>Regards,
>Dmitry A. Kazakov
>http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Real Time IO routines
2007-10-27 8:56 3% ` anon
@ 2007-10-27 10:18 0% ` Dmitry A. Kazakov
2007-10-27 20:15 0% ` anon
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2007-10-27 10:18 UTC (permalink / raw)
On Sat, 27 Oct 2007 08:56:42 GMT, anon wrote:
> function To_Duration is new Ada.Unchecked_Conversion
( Time, Duration ) ;
That is a bad idea. You don't know what is the internal representation of
Time. The intended effect can be achieved legally:
with Ada.Real_Time; use Ada.Real_Time;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test is
function Image (T : Time) return String is
Seconds : Seconds_Count;
Fraction : Time_Span;
begin
Split (T, Seconds, Fraction);
declare
After : constant String :=
Duration'Image (To_Duration (Fraction));
begin
return Seconds_Count'Image (Seconds) & After (2..After'Last);
end;
end Image;
begin
delay 0.5;
Put_Line (Image (Clock) & "s since the epoch");
delay 0.5;
Put_Line (Image (Clock) & "s since the epoch");
end Test;
--------------------
However it is quite useless to output absolute time values involving an
unknown epoch. Unfortunately there is no portable way I know of to convert
Real_Time.Time to UTC.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Real Time IO routines
@ 2007-10-27 8:56 3% ` anon
2007-10-27 10:18 0% ` Dmitry A. Kazakov
1 sibling, 1 reply; 200+ results
From: anon @ 2007-10-27 8:56 UTC (permalink / raw)
--
-- Simple answer is to build a IO package and use Unchecked_Conversion
--
with Ada.Real_Time ;
with Ada.Text_IO ;
--
--
--
use Ada.Real_Time ;
use Ada.Text_IO ;
with Ada.Unchecked_Conversion ;
procedure z is
--
-- I/O Time ( Duration ) type.
--
package D_IO is new Ada.Text_IO.Fixed_IO ( Duration ) ;
--
-- convert Ada.Real_Time private Time to a local type.
--
function To_Duration is new Ada.Unchecked_Conversion
( Time, Duration ) ;
Time_Value : Time ;
begin
Time_Value := Clock ;
Put ( "Time := " ) ;
D_IO.Put ( To_Duration ( Time_Value ) ) ;
New_Line ;
end z ;
In <1193410739.367181.96050@50g2000hsm.googlegroups.com>, andrew <andrew.carroll@okstate.edu> writes:
>Hello,
>
>Is there a put or put_line procedure to output the value of variables
>declared as the Time type defined in the Real_Time package?
>
^ permalink raw reply [relevance 3%]
* Re: Real Time IO routines
@ 2007-10-26 20:29 2% ` Ludovic Brenta
0 siblings, 0 replies; 200+ results
From: Ludovic Brenta @ 2007-10-26 20:29 UTC (permalink / raw)
andrew writes:
> On Oct 26, 1:36 pm, Ludovic Brenta <ludo...@ludovic-brenta.org> wrote:
>> andrew writes:
>> > Time_Unit is defined as a constant := 10#1.0#E-9, is Time_Unit then
>> > a "real literal"? How can I convert a "real literal" to a scalar
>> > type (maybe that's a contradiction?)?
>>
>> Real literals are of the type universal_real which (a) is scalar and
>> (b) converts implicitly to any other floating-point type. Does that
>> answer your question?
>>
>> --
>> Ludovic Brenta.
>
> To Ludovic: Ahh, so if I had to define a universal_real I could
> output it using something like integer'image(it)?
No, because Integer is not a floating-point type. You would use
Float'Image instead. In light of what follows, I forgot to mention
that universal_real also converts to any fixed-point type implicitly.
> To AV: I don't really know why it's necessary yet; sometimes my
> subconcious mind works faster than my concious mind and I just have to
> go with it. I can say though that:
>
> -- Time and Time_Span are represented in 64-bit Duration value in
> -- in nanoseconds. For example, 1 second and 1 nanosecond is
> -- represented as the stored integer 1_000_000_001.
>
> So if a duration is represented as the stored INTEGER ... then I could
> maybe use integer'image(duration), maybe?
No; Time and Time_Span are fixed-point types, not integer types. You
should do:
Nanosecond : constant := 1.0E-9; -- there's your universal_real :)
type My_Fixed_Time is
delta Nanosecond range 0.0 .. (2 ** 64 - 1) * Nanosecond;
for My_Fixed_Time'Size use 64;
function To_My_Fixed_Time is
new Ada.Unchecked_Conversion (Source => Time; Target => My_Fixed_Time);
T : Time;
Image : constant String := My_Fixed_Time'Image (To_My_Fixed_Time (T));
(I just made that up; didn't try to compile it so caveat emptor).
> what does this mean: type DURATION is delta implementation_defined
> range implementation_defined;?
> Is delta? what's delta?
A fixed-point type. See ARM 3.5.9.
--
Ludovic Brenta.
^ permalink raw reply [relevance 2%]
* Re: Base64-Encoding
2007-10-19 6:59 0% ` Base64-Encoding Stefan Bellon
@ 2007-10-19 19:40 2% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2007-10-19 19:40 UTC (permalink / raw)
In my last post I answer about ENDIAN.
Now for two algorithms to convert data to Base64:
-- --------------------------------------------------------
-- Base64.ads
--
--
-- For conversion -- The use of a 4 byte array is faster since the CPUs
-- of today normally use 8-bits (quarter word) and
-- actually have quarter word storage instructions.
--
--
-- The usage of packed record requires extra
-- code to be added to perform the record packing
-- which will require more cpu cycles.
--
-- Exception would be if your working on a older
-- system like the 1108 9-bit "Univac" (now called
-- "Unisys" ) of the 1970s which had 3-bits, 6-bits
-- and 9-bits access instructions.
--
package Base64 is
-- -------------------------- --
-- TYPE: Base 64 Basics Types --
-- -------------------------- --
--
-- build the 6 bit
--
type Bit_6 is mod 2 ** 6 ;
--
-- Base_64 String Array
--
type Base64_String is new String ( 1..4 ) ;
-- --------------------------------------- --
-- TYPE: Base 64 Basics using 4 byte array --
-- --------------------------------------- --
--
-- packed Bit_6 into 4 bytes
--
type Base64_Array is array ( 0 .. 3 ) of Bit_6 ;
-- ----------------------------------------- --
-- TYPE: Base 64 Basics using 3 byte records --
-- ----------------------------------------- --
--
-- packed Bit_6 into 3 bytes
--
-- ------------------------------ --
-- TYPE: Base 64 Conversion Types --
-- ------------------------------ --
--
-- Base_64_Descriptor is used in converting 8 bit
-- characters to 6 bits ;
--
type Base_64_Descriptor is record
Value_3 : Bit_6 ;
Value_2 : Bit_6 ;
Value_1 : Bit_6 ;
Value_0 : Bit_6 ;
end record ;
--
-- insure 3 byte usage for Character_Descriptor ;
--
pragma pack ( Base_64_Descriptor ) ;
-- ------------------------------- --
-- TYPE: Data Conversion Functions --
-- ------------------------------- --
--
-- 4 byte version
--
function Coding ( B_String : Base64_String )
return Base64_Array ;
function Coding ( B_Array : Base64_Array )
return Base64_String ;
--
-- 3 byte version
--
function Coding ( B_String : Base64_String )
return Base_64_Descriptor ;
function Coding ( B_Array : Base_64_Descriptor )
return Base64_String ;
--
-- Obtain conversion character
--
function Base64_Character ( C : Character ) return Character ;
end Base64 ;
-- --------------------------------------------------------
-- Base64.adb
--
with Interfaces ;
use Interfaces ;
with Ada.Unchecked_Conversion ;
package body Base64 is
--
-- Base_64 Character Set ;
--
Characters : array ( Character range ASCII.Nul .. '?' ) of
Character :=
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
"abcdefghijklmnopqrstuvwxyz" &
"0123456789+/" ;
-- ------------------------------ --
-- TYPE: Base 64 Conversion Types --
-- ------------------------------ --
--
-- Character_Descriptor is used in converting 8 bit
-- characters to 6 bits ;
--
type Character_Descriptor is record
unused : Unsigned_8 range 0..3 ;
Value : Bit_6 ;
end record ;
--
-- set bit order
--
for Character_Descriptor use record
unused at 0 range 6..7 ;
Value at 0 range 0..5 ;
end record ;
--
-- insure 1 byte usage for Character_Descriptor ;
--
pragma pack ( Character_Descriptor ) ;
-- ------------------------------- --
-- TYPE: Data Conversion Functions --
-- ------------------------------- --
function Char_8_To_Char_6 is new Ada.Unchecked_Conversion
( Character, Character_Descriptor ) ;
function Char_6_To_Char_8 is new Ada.Unchecked_Conversion
( Character_Descriptor, Character ) ;
-- -------------- --
-- 4 byte version --
-- -------------- --
function Coding ( B_String : Base64_String ) return Base64_Array is
Temp : Base64_Array ;
Work : Character_Descriptor ;
begin -- Coding
Work := Char_8_To_Char_6 ( B_String ( 4 ) ) ;
Temp ( 3 ) := Work.Value ;
Work := Char_8_To_Char_6 ( B_String ( 3 ) ) ;
Temp ( 2 ) := Work.Value ;
Work := Char_8_To_Char_6 ( B_String ( 2 ) ) ;
Temp ( 1 ) := Work.Value ;
Work := Char_8_To_Char_6 ( B_String ( 1 ) ) ;
Temp ( 0 ) := Work.Value ;
return Temp ;
end Coding ;
function Coding ( B_Array : Base64_Array ) return Base64_String is
Temp : Base64_String ;
Work : Character_Descriptor ;
begin -- Coding
Work.unused := 0 ; -- to insure value of conversion ;
Work.Value := B_Array ( 3 ) ;
Temp ( 4 ) := Char_6_To_Char_8 ( Work ) ;
Work.Value := B_Array ( 2 ) ;
Temp ( 3 ) := Char_6_To_Char_8 ( Work ) ;
Work.Value := B_Array ( 1 ) ;
Temp ( 2 ) := Char_6_To_Char_8 ( Work ) ;
Work.Value := B_Array ( 0 ) ;
Temp ( 1 ) := Char_6_To_Char_8 ( Work ) ;
return Temp ;
end Coding ;
-- -------------- --
-- 3 byte version --
-- -------------- --
function Coding ( B_String : Base64_String )
return Base_64_Descriptor is
Temp : Base_64_Descriptor ;
Work : Character_Descriptor ;
begin -- Coding
Work := Char_8_To_Char_6 ( B_String ( 4 ) ) ;
Temp.Value_3 := Work.Value ;
Work := Char_8_To_Char_6 ( B_String ( 3 ) ) ;
Temp.Value_2 := Work.Value ;
Work := Char_8_To_Char_6 ( B_String ( 2 ) ) ;
Temp.Value_1 := Work.Value ;
Work := Char_8_To_Char_6 ( B_String ( 1 ) ) ;
Temp.Value_0 := Work.Value ;
return Temp ;
end Coding ;
function Coding ( B_Array : Base_64_Descriptor )
return Base64_String is
Temp : Base64_String ;
Work : Character_Descriptor ;
begin -- Coding
Work.unused := 0 ; -- to insure value of conversion ;
Work.Value := B_Array.Value_3 ;
Temp ( 4 ) := Char_6_To_Char_8 ( Work ) ;
Work.Value := B_Array.Value_2 ;
Temp ( 3 ) := Char_6_To_Char_8 ( Work ) ;
Work.Value := B_Array.Value_1 ;
Temp ( 2 ) := Char_6_To_Char_8 ( Work ) ;
Work.Value := B_Array.Value_0 ;
Temp ( 1 ) := Char_6_To_Char_8 ( Work ) ;
return Temp ;
end Coding ;
--
-- Obtain conversion 8-bit character
--
function Base64_Character ( C : Character ) return Character is
begin -- Base64_Character
return Characters ( C ) ;
end Base64_Character ;
end Base64 ;
-- --------------------------------------------------------
-- Test64.adb -- Test program
--
with Base64 ;
with Ada.Text_IO ;
with Ada.Integer_Text_IO ;
use Ada.Text_IO ;
use Ada.Integer_Text_IO ;
procedure test64 is
a : Base64.Base64_String := "1234";
b : Base64.Base_64_Descriptor ;
c : Base64.base_64_Descriptor := ( 10, 20, 30, 40 ) ;
d : Base64.base64_Array := ( 00, 01, 02, 03 ) ;
e : Base64.Base64_String ;
f : Base64.base64_Array ;
begin
--
-- Test using 4 byte array
--
Put ( d'size ) ;
New_Line ;
Put ( e'size ) ;
New_Line ;
e := Base64.Coding ( d ) ;
f := Base64.Coding ( e ) ;
Put ( "Data : " ) ;
Put ( Base64.Base64_Character ( e ( 1 ) ) ) ;
Put ( Base64.Base64_Character ( e ( 2 ) ) ) ;
Put ( Base64.Base64_Character ( e ( 3 ) ) ) ;
Put ( Base64.Base64_Character ( e ( 4 ) ) ) ;
New_Line ;
b := Base64.Coding ( a ) ;
Put ( a'size ) ;
New_Line ;
Put ( b'size ) ; -- 24 aka 3 byte pack record
New_Line ;
--
-- Test using packed 3 byte record
--
a := Base64.Coding ( c ) ;
Put ( "Data : " ) ;
Put ( Base64.Base64_Character ( a ( 1 ) ) ) ;
Put ( Base64.Base64_Character ( a ( 2 ) ) ) ;
Put ( Base64.Base64_Character ( a ( 3 ) ) ) ;
Put ( Base64.Base64_Character ( a ( 4 ) ) ) ;
New_Line ;
end Test64 ;
In <20071019085934.7c1a525f@cube.tz.axivion.com>, Stefan Bellon <sbellon@sbellon.de> writes:
>On Fr, 19 Okt, anon wrote:
>
>> function To_Base64 is new Ada.Unchecked_Conversion
>> ( Source => Unsigned_8,
>> Target => base64_descriptor ) ;
>>
>> function From_Base64 is new Ada.Unchecked_Conversion
>> ( Target => Unsigned_8,
>> Source => base64_descriptor ) ;
>
>But this only converts one whole byte (aka Unsigned_8) into a Six_Bits
>by ignoring the two top-bits. This does not help with my original idea
>of overlaying a packed array of 6-bit elements over an array of 8-bit
>characters and then looping over the 6-bit elements to do the
>conversion in a simple loop, character by character.
>
>> In 2001 Tom Moran created a Ada BASE64 package which is archived at
>>
>> http://www.adapower.com/index.php?Command=Class&ClassID=Algorithms&CID=257
>>
>> have a look at it. I a quick look it kind of suggest that the endian
>> for Six_Bits is not important.
>
>Yes, I know this package. But it handles three bytes in the original in
>one go and always encodes three bytes into four 6-bits.
>
>As I mentioned in my first posting, I am aware of the solutions to do
>the actual conversion that exist (and already have been discussed a
>few times here in the group). I was just wondering whether my idea
>of overlaying the two arrays could be easily "fixed" so that it works.
>
>But thanks for your ideas!
>
>--
>Stefan Bellon
^ permalink raw reply [relevance 2%]
* Re: Base64-Encoding
2007-10-19 2:43 3% ` Base64-Encoding anon
2007-10-19 4:33 0% ` Base64-Encoding anon
@ 2007-10-19 6:59 0% ` Stefan Bellon
2007-10-19 19:40 2% ` Base64-Encoding anon
1 sibling, 1 reply; 200+ results
From: Stefan Bellon @ 2007-10-19 6:59 UTC (permalink / raw)
On Fr, 19 Okt, anon wrote:
> function To_Base64 is new Ada.Unchecked_Conversion
> ( Source => Unsigned_8,
> Target => base64_descriptor ) ;
>
> function From_Base64 is new Ada.Unchecked_Conversion
> ( Target => Unsigned_8,
> Source => base64_descriptor ) ;
But this only converts one whole byte (aka Unsigned_8) into a Six_Bits
by ignoring the two top-bits. This does not help with my original idea
of overlaying a packed array of 6-bit elements over an array of 8-bit
characters and then looping over the 6-bit elements to do the
conversion in a simple loop, character by character.
> In 2001 Tom Moran created a Ada BASE64 package which is archived at
>
> http://www.adapower.com/index.php?Command=Class&ClassID=Algorithms&CID=257
>
> have a look at it. I a quick look it kind of suggest that the endian
> for Six_Bits is not important.
Yes, I know this package. But it handles three bytes in the original in
one go and always encodes three bytes into four 6-bits.
As I mentioned in my first posting, I am aware of the solutions to do
the actual conversion that exist (and already have been discussed a
few times here in the group). I was just wondering whether my idea
of overlaying the two arrays could be easily "fixed" so that it works.
But thanks for your ideas!
--
Stefan Bellon
^ permalink raw reply [relevance 0%]
* Re: Base64-Encoding
2007-10-19 2:43 3% ` Base64-Encoding anon
@ 2007-10-19 4:33 0% ` anon
2007-10-19 6:59 0% ` Base64-Encoding Stefan Bellon
1 sibling, 0 replies; 200+ results
From: anon @ 2007-10-19 4:33 UTC (permalink / raw)
that should say
type Six_Bits is new Integer mod 2**6 ; -- or use range 0 .. 63 ;
In <eRURi.236438$ax1.167125@bgtnsc05-news.ops.worldnet.att.net>, anon@anon.org (anon) writes:
>with Interfaces ;
>use Interfaces ;
>with System ;
>use System ;
>with Ada.Unchecked_Conversion ;
>
>package b64 is
>
> --
> -- Uses the system default on endian
> --
>
> type Six_Bits is new Integer range mod 2**6 ; -- or use 0 .. 63 ;
>
>
> --
> -- base64_descriptor is a record that insures the endian is set
> -- by the program ( in this case "little-endian format" ) in
> -- architectures that have switchable endianness.
> -- Such as ARM, PowerPC (but not the PPC970/G5), DEC Alpha, SPARC V9,
> -- MIPS, PA-RISC and IA64
> --
> type base64_descriptor is record
> Unused : Unsigned_8 range 0..3 ;
> Bit_5 : Unsigned_8 range 0..1 ;
> Bit_4 : Unsigned_8 range 0..1 ;
> Bit_3 : Unsigned_8 range 0..1 ;
> Bit_2 : Unsigned_8 range 0..1 ;
> Bit_1 : Unsigned_8 range 0..1 ;
> Bit_0 : Unsigned_8 range 0..1 ;
> end record ;
> --
> -- set bit order
> --
> for base64_descriptor use record
> Unused at 0 range 6..7 ;
> Bit_5 at 0 range 5..5 ;
> Bit_4 at 0 range 4..4 ;
> Bit_3 at 0 range 3..3 ;
> Bit_2 at 0 range 2..2 ;
> Bit_1 at 0 range 1..1 ;
> Bit_0 at 0 range 0..0 ;
> end record ;
>
> --
> -- or you could use the following statement which
> -- forces endian to little-endian format
> --
> for base64_descriptor'Bit_Order use Low_Order_First ;
>
> --
> -- insure 1 byte usage for base64_descriptor ;
> --
> pragma pack ( base64_descriptor ) ;
>
>
>
> function To_Base64 is new Ada.Unchecked_Conversion
> ( Source => Unsigned_8,
> Target => base64_descriptor ) ;
>
> function From_Base64 is new Ada.Unchecked_Conversion
> ( Target => Unsigned_8,
> Source => base64_descriptor ) ;
>
>
>end ;
>
>In 2001 Tom Moran created a Ada BASE64 package which is archived at
>
>http://www.adapower.com/index.php?Command=Class&ClassID=Algorithms&CID=257
>
>have a look at it. I a quick look it kind of suggest that the endian for
>Six_Bits is not important.
>
>
>In <20071015161229.3f439230@cube.tz.axivion.com>, Stefan Bellon <sbellon@sbellon.de> writes:
>>Hi all,
>>
>>I've been looking through the previous postings of the group and found
>>two major threads where this topic has already been discussed. But the
>>proposed solutions were all different to what I was thinking about. I
>>have thought about the following:
>>
>>
>>package body Base64 is
>>
>> type Six_Bits is mod 2**6;
>> for Six_Bits'Size use 6;
>>
>> type Six_Bits_Array is array (Natural range <>) of Six_Bits;
>> for Six_Bits_Array'Alignment use 1; -- To overlay over String type.
>> for Six_Bits_Array'Component_Size use Six_Bits'Size;
>> pragma Pack (Six_Bits_Array);
>>
>> Base64_Chars : constant array (Six_Bits) of Character :=
>> "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
>>
>> function Encode
>> (Data : in String)
>> return String
>> is
>> Padded_Length : constant Natural := ((Data'Length + 2) / 3) * 3;
>> -- Pad input data to 3-Byte boundary.
>>
>> Base64_Length : constant Natural := Padded_Length / 3 * 4;
>> -- Number of six-bit tokens necessary (including padding).
>>
>> Six_Bits_Length : constant Natural := (Data'Length * 4 + 2) / 3;
>> -- Number of six-bit tokens necessary (without padding).
>>
>> Padded_Data : String (1 .. Padded_Length) := (others => ASCII.NUL);
>> -- Padded input data.
>>
>> Base64_Data : Six_Bits_Array (1 .. Base64_Length);
>> for Base64_Data'Address use Padded_Data'Address;
>> -- Overlay array of six-bit tokens over the padded input data.
>>
>> Result : String (1 .. Base64_Length) := (others => '=');
>> -- Output buffer, initialized with '=' tokens for unfilled
>> -- end-markers.
>> begin
>> Padded_Data (1 .. Data'Length) := Data;
>> -- Initialize data into padded-data (can't be done with aggregate
>> -- in elaboration part, sadly).
>>
>> -- Do the actual encoding ...
>> for I in 1 .. Six_Bits_Length loop
>> Result (I) := Base64_Chars (Base64_Data (I));
>> end loop;
>>
>> return Result;
>> end Encode;
>>
>>end Base64;
>>
>>
>>However it looks like this solution has a problem with endianness, in a
>>way that the wrong 6 bits of the Bytes are used in the conversion.
>>
>>Is there an easy way to fix this (as I think the rest would be pretty
>>neat) or is this way of trying to do it, doomed to fail anyway?
>>
>>--
>>Stefan Bellon
>
^ permalink raw reply [relevance 0%]
* Re: Base64-Encoding
@ 2007-10-19 2:43 3% ` anon
2007-10-19 4:33 0% ` Base64-Encoding anon
2007-10-19 6:59 0% ` Base64-Encoding Stefan Bellon
0 siblings, 2 replies; 200+ results
From: anon @ 2007-10-19 2:43 UTC (permalink / raw)
with Interfaces ;
use Interfaces ;
with System ;
use System ;
with Ada.Unchecked_Conversion ;
package b64 is
--
-- Uses the system default on endian
--
type Six_Bits is new Integer range mod 2**6 ; -- or use 0 .. 63 ;
--
-- base64_descriptor is a record that insures the endian is set
-- by the program ( in this case "little-endian format" ) in
-- architectures that have switchable endianness.
-- Such as ARM, PowerPC (but not the PPC970/G5), DEC Alpha, SPARC V9,
-- MIPS, PA-RISC and IA64
--
type base64_descriptor is record
Unused : Unsigned_8 range 0..3 ;
Bit_5 : Unsigned_8 range 0..1 ;
Bit_4 : Unsigned_8 range 0..1 ;
Bit_3 : Unsigned_8 range 0..1 ;
Bit_2 : Unsigned_8 range 0..1 ;
Bit_1 : Unsigned_8 range 0..1 ;
Bit_0 : Unsigned_8 range 0..1 ;
end record ;
--
-- set bit order
--
for base64_descriptor use record
Unused at 0 range 6..7 ;
Bit_5 at 0 range 5..5 ;
Bit_4 at 0 range 4..4 ;
Bit_3 at 0 range 3..3 ;
Bit_2 at 0 range 2..2 ;
Bit_1 at 0 range 1..1 ;
Bit_0 at 0 range 0..0 ;
end record ;
--
-- or you could use the following statement which
-- forces endian to little-endian format
--
for base64_descriptor'Bit_Order use Low_Order_First ;
--
-- insure 1 byte usage for base64_descriptor ;
--
pragma pack ( base64_descriptor ) ;
function To_Base64 is new Ada.Unchecked_Conversion
( Source => Unsigned_8,
Target => base64_descriptor ) ;
function From_Base64 is new Ada.Unchecked_Conversion
( Target => Unsigned_8,
Source => base64_descriptor ) ;
end ;
In 2001 Tom Moran created a Ada BASE64 package which is archived at
http://www.adapower.com/index.php?Command=Class&ClassID=Algorithms&CID=257
have a look at it. I a quick look it kind of suggest that the endian for
Six_Bits is not important.
In <20071015161229.3f439230@cube.tz.axivion.com>, Stefan Bellon <sbellon@sbellon.de> writes:
>Hi all,
>
>I've been looking through the previous postings of the group and found
>two major threads where this topic has already been discussed. But the
>proposed solutions were all different to what I was thinking about. I
>have thought about the following:
>
>
>package body Base64 is
>
> type Six_Bits is mod 2**6;
> for Six_Bits'Size use 6;
>
> type Six_Bits_Array is array (Natural range <>) of Six_Bits;
> for Six_Bits_Array'Alignment use 1; -- To overlay over String type.
> for Six_Bits_Array'Component_Size use Six_Bits'Size;
> pragma Pack (Six_Bits_Array);
>
> Base64_Chars : constant array (Six_Bits) of Character :=
> "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
>
> function Encode
> (Data : in String)
> return String
> is
> Padded_Length : constant Natural := ((Data'Length + 2) / 3) * 3;
> -- Pad input data to 3-Byte boundary.
>
> Base64_Length : constant Natural := Padded_Length / 3 * 4;
> -- Number of six-bit tokens necessary (including padding).
>
> Six_Bits_Length : constant Natural := (Data'Length * 4 + 2) / 3;
> -- Number of six-bit tokens necessary (without padding).
>
> Padded_Data : String (1 .. Padded_Length) := (others => ASCII.NUL);
> -- Padded input data.
>
> Base64_Data : Six_Bits_Array (1 .. Base64_Length);
> for Base64_Data'Address use Padded_Data'Address;
> -- Overlay array of six-bit tokens over the padded input data.
>
> Result : String (1 .. Base64_Length) := (others => '=');
> -- Output buffer, initialized with '=' tokens for unfilled
> -- end-markers.
> begin
> Padded_Data (1 .. Data'Length) := Data;
> -- Initialize data into padded-data (can't be done with aggregate
> -- in elaboration part, sadly).
>
> -- Do the actual encoding ...
> for I in 1 .. Six_Bits_Length loop
> Result (I) := Base64_Chars (Base64_Data (I));
> end loop;
>
> return Result;
> end Encode;
>
>end Base64;
>
>
>However it looks like this solution has a problem with endianness, in a
>way that the wrong 6 bits of the Bytes are used in the conversion.
>
>Is there an easy way to fix this (as I think the rest would be pretty
>neat) or is this way of trying to do it, doomed to fail anyway?
>
>--
>Stefan Bellon
^ permalink raw reply [relevance 3%]
* Re: urgent question - generics
@ 2007-09-04 0:38 2% ` anon
0 siblings, 0 replies; 200+ results
From: anon @ 2007-09-04 0:38 UTC (permalink / raw)
-- A more complete answer since your through with your test. And yes
-- you can copy and paste this code into a a file and use the gnat
-- system to compile/bind/link and then excute the program.
--
-- In most cases there are a number of ways to create code. Some are
-- more direct or aids the compiler to help you while others are more
-- indirect or toward the system performance and code usage. I did have
-- seven ways of answering the question but the other 3 were too
-- complex for a beginner. Even one use the generic package
-- caled "System.Address_To_Access_Conversions"
--
-- But in true Generic the function should be able to handle all
-- types of calls both Ada and non-Ada procedure.
--
-- In GNAT both Access and Address are the same but with other
-- system where memory is protected or even using seperate
-- memories this may not be the case.
--
with Ada.text_IO ;
with System ;
--
-- see function_3, might be too complex.
--
with Ada.Unchecked_Conversion ;
procedure zzero is
--
-- This allows all types of procedures both Ada and external
-- with or without parameters. Creates a static procedure
-- design effect.
--
function function_0 ( func : System.Address ; Data : Float )
return float is
procedure tst ;
pragma Import ( Ada, tst ) ;
for tst'address use func ;
begin -- function_0
tst ;
return Data * 2.0 ;
end function_0 ;
------------------------------------------------------------------------------
-- The Probability the answer that she ask for: --
-- --
-- type proc_access is access procedure ; -- is the generic statement --
-- -- that she needed. --
-- --
-- tst.all ; -- statement to call set --
-- -- procedure --
-- --
------------------------------------------------------------------------------
--
-- This version allows only procedures that are Ada without
-- parameters.
--
type proc_access is access procedure ;
function function_1 ( tst : proc_access ; Data : Float )
return float is
begin -- function_1
tst.all ;
return Data * 2.0 ;
end function_1 ;
--
-- This version allows only procedures that are Ada without
-- parameters. Creates a static procedure design effect for
-- calling procedure.
--
type func_access is access procedure ;
function function_2 ( func : func_access ; Data : Float )
return float is
procedure tst ;
pragma Import ( Ada, tst ) ;
for tst'address use func.all'address ;
begin -- function_2
tst ;
return Data * 2.0 ;
end function_2 ;
--
-- This version allows only procedures that are Ada without
-- parameters. And also use another Generic package to
-- convert the addressing schemes that creates a static
-- procedure design effect. But shows that both can be used
-- in the same package.
--
type procedure_access is access procedure ;
function function_3 ( func : procedure_access ; Data : Float )
return float is
-- --------------------------------------- --
-- use for calling method version two only --
-- --------------------------------------- --
--
-- limit this conversion function to function_3 usage only
--
function PA_To_A is new Ada.Unchecked_Conversion
( Source => procedure_access,
Target => System.Address ) ;
procedure tst ;
pragma Import ( Ada, tst ) ;
for tst'address use PA_To_A ( func ) ;
begin -- function_3
--
-- simple dynamic call version method 1
--
func.all ;
--
-- simple static call version method 2
--
tst ;
return Data * 2.0 ;
end function_3 ;
-- ---------- --
-- Test: Proc --
-- ---------- --
procedure test is
begin -- test
Ada.Text_IO.Put_Line ( "Testing" ) ;
end test ;
Result : Float ;
begin
Result := function_0 ( test'address, 0.5 ) ;
--
Result := function_1 ( test'access, 0.7 ) ;
Result := function_2 ( test'access, 0.9 ) ;
--
Result := function_3 ( test'access, 0.1 ) ;
end zzero ;
In <1188837355.753212.161150@r34g2000hsd.googlegroups.com>, shoshanister@gmail.com writes:
>On Sep 3, 4:01 pm, a...@anon.org (anon) wrote:
>> In <1188819393.588005.23...@r34g2000hsd.googlegroups.com>, shoshanis...@gmail.com writes:
>>
>> >Hi, First, I'm a female.
>>
>> Sorry about calling you a guy, it is an easy mistake to make on the net.
>>
>> >Please don't post any more answers or such.
>>
>> If you look here I will always answer a question with code if
>> possible! Its just the way I am. I even jump of people here for not
>> posting code. Because in a test my code or anyone else code is
>> not going to help, unless you understand it! And the only way is to
>> see the code.
>>
>> >I understand according to what you wrote that I probably did not fully
>> >understand the generics mechanism. In this case, even if you will
>> >answer my question, it will not help me because my exam starts in an
>> >hour.
>> >I posted the question here, after trying to figure things out by my
>> >self, and I had no intention to insult any one of you or to take
>> >advantage of you.
>>
>> No insult or advantage of taken!
>>
>> >In a way, I'm not worried of not passing the exam. The worse thing
>> >that can happen is that I will take the course again, and gain my
>> >knowledge from the teacher as well as from the books, because studying
>> >ADA by your self is not simple.
>>
>> Actually, installing a free GNAT Ada version and starting to program
>> is the BEST way to learn. Teachers only have time to give you an
>> brief understand of any language. In the US that less than 45 hours
>> spanning 15 weeks. Outside programming is the only way to gain a
>> deeper understanding. And asking question with an expectation of an
>> answer is the second best way to gain a direction for that deeper
>> understand.
>>
>> Plus, in my many years experience if a person just say read a section
>> or chapter than they also do not understand the problem or the
>> language. Even my professor would not do that, they would give an
>> example (like I did) and then assign someone an extra assignment that
>> would include the example as a small part of the whole project.
>>
>> The only thing was their projects, either homework or extra
>> assignments were too simple for me, (bored me to death). I actually
>> had to expand them to make the worth my time. My Ada professor
>> use most of my work in Ada to teach his other classes at two
>> universities and wrote a number of text books using my classwork
>> that were used in both Europe and US universities.
>>
>> What I did for my first Ada assignment after modifying it, was
>> rated at doctoral level programming. I even had to have permission
>> from 3 universities and their computer systems to fully execute the
>> assignment.
>>
>> >Thanks a lot for your help.
>> >I hope that some day I will be able to join this group as an equal
>> >member and not just a student.
>>
>> I kind of believe that 50+ % of this group is students.
>
>Hi, Thanks for your kind response.
>I just came back from the exam. It was not very difficult but I can't
>say it was easy. I don't believe I passed, but it's ok. I don't mind
>attending the course again, Ada is a nice and very powerful language,
>and I wouldn't mind getting to know it better.
>I'm going to get some rest now. Thanks :)
>
^ permalink raw reply [relevance 2%]
* Re: Byte streams
@ 2007-08-03 5:34 2% ` Jeffrey R. Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2007-08-03 5:34 UTC (permalink / raw)
shaunpatterson@gmail.com wrote:
>
> I've written a socket functions to send and receive data in C and then
> created a spec in Ada so I could use those same functions:
>
> -- C functions --
>
> unsigned char *readBytes (const unsigned int numBytes);
> void sendBytes (unsigned char *data, const unsigned int numBytes);
>
>
> --- Ada side
> type Byte is mod 256;
> for Byte'Size use 8;
>
> type ByteStream is array (Integer range <>) of Byte;
>
>
> function readBytes (numBytes : Integer) return System.Address;
> pragma import (C, readBytes, "readBytes");
Integer? What would Readbytes (-7) mean?
> procedure sendBytes (data : ByteStream; numBytes : Integer);
> pragma import (C, sendBytes, "sendBytes");
For a direct translation, you should use the types in Interfaces.C and
Interfaces.C.Strings (ARM B.3[.1]):
function Read_Bytes (Num_Bytes : in Interfaces.C.Unsigned)
return Interfaces.C.Strings.Chars_Ptr;
procedure Send_Bytes (Data : in Interfaces.C.Char_Array;
Num_Bytes : in Interfaces.C.Unsigned);
More in the spirit rather than the letter of what the C is trying to
say, you probably want to use System.Storage_Elements.Storage_Array:
procedure Send_Bytes
(Data : in System.Storage_Elements.Storage_Array;
Num_Bytes : in Interfaces.C.Unsigned);
You send data by creating a subtype of
System.Storage_Elements.Storage_Array with a length equal to the value
you'll pass to Num_Bytes, and instantiating Ada.Unchecked_Conversion
with this subtype as the target.
> type IntegerPtr is access all Integer;
> function to_IntegerPtr is new Unchecked_Conversion
> (source => System.Address, target =>
> IntegerPtr);
>
> --- this works...and I can do all the conversions I need using an
> unchecked_conversion
This is highly compiler dependent. There is no guarantee that a
System.Address and a C pointer are the same size, much less the same
representation. There is no guarantee that a System.Address and an
access value are the same size, much less the same representation. There
are compilers where these things aren't and this won't work.
For situations where you must convert between System.Address and access
values, there's System.Address_To_Access_Conversions, but this isn't one
of those cases.
Reading is a little more complicated:
with System;
type Value is ...
type Value_Ptr is access all Value;
pragma Convention (C, Value_Ptr);
The pragma Convention is important; it tells the compiler to use the
same representation as C. That may be different from Ada's default
representation.
function Get (Num_Bytes : in Interfaces.C.Unsigned :=
Value'Size / System.Storage_Unit)
return Value_Ptr;
This is a way to do it at the low level (streams are another, and
perhaps better, way). But Ada is usually about hiding the low level. You
shouldn't want your application declaring access types and imported
functions and doing unchecked conversions all over the place.
generic -- Socket_IF
type Value (<>) is private;
package Socket_IF is
procedure Send (Data : in Value);
function Read return Value;
end Socket_IF;
with Ada.Unchecked_Conversion;
with Interfaces.C;
with System.Storage_Elements;
package Body Socket_IF is
subtype Unsigned is Interfaces.C.Unsigned;
use type Unsigned;
Num_Bytes : constant Unsigned := Value'Size / System.Storage_Unit;
procedure Send (Data : in Value) is
subtype List is
System.Storage_Elements.Storage_Array (1 .. Num_Bytes);
function To_List is new Ada.Unchecked_Conversion
(Source => Value, Target => List);
procedure C_Send (Data : in List; Size : in Unsigned);
pragma Import (C, C_Send, ...);
begin -- Send
C_Send (Data => To_List (Data), Size => Num_Bytes);
end Send;
function Read return Value is
type Value_Ptr is access all Value;
pragma Convention (C, Value_Ptr);
function C_Read (Size : in Unsigned) return Value_Ptr;
pragma Import (C, C_Read, ...);
begin -- Read
return C_Read (Num_Bytes).all;
end Read;
end Socket_IF;
I haven't tested this, but it might even work.
Now your application only has to instantiate Socket_IF for each type of
interest, and call the resulting Send and Read operations. Much
replication of code is eliminated, and you only have to get this right once.
Something similar for the streams approach is left as an exercise for
the reader.
--
Jeff Carter
"We call your door-opening request a silly thing."
Monty Python & the Holy Grail
17
^ permalink raw reply [relevance 2%]
* Re: Pure, Storage_Size and Unchecked_Conversion
2007-07-10 1:35 0% ` Randy Brukardt
@ 2007-07-10 8:30 0% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2007-07-10 8:30 UTC (permalink / raw)
Randy Brukardt wrote:
> "Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> wrote in message
>> function F2 is new Ada.Unchecked_Conversion (Integer, T); -- NG
>>
>> Why does compiler make an error at F2?
>
> You've gotten a whole bunch of answers, but I think the correct one has not
> be provided:
> it is a compiler bug and there should not be an error at F2.
>
> I'd suggest that you (and others as well) should ask the people at AdaCore
> about what appear to be compiler bugs (especially in things changed by the
> Amendment, which are highly likely to be buggy as they are new) rather than
> confusing many with examples that seem to show non-existent limitations of
> Ada (as opposed to a particular compiler).
Thanks for pointing this out. I'm sure that the suspicion
of a bug has now turned into much more certainty and somewhat
better understanding of the language. A paradigmatic demonstration
of the value of support if that is within reach for an Ada 2005 compiler.
^ permalink raw reply [relevance 0%]
* Re: Pure, Storage_Size and Unchecked_Conversion
2007-07-08 0:24 3% Pure, Storage_Size and Unchecked_Conversion Y.Tomino
2007-07-08 9:49 0% ` Georg Bauhaus
2007-07-08 16:08 0% ` Martin Krischik
@ 2007-07-10 1:35 0% ` Randy Brukardt
2007-07-10 8:30 0% ` Georg Bauhaus
2 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2007-07-10 1:35 UTC (permalink / raw)
"Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> wrote in message
news:1183854255.792142.110150@i38g2000prf.googlegroups.com...
...
> Ada.Unchecked_Conversion is pure generic function.
> I think the condition of F1 and F2 is the same.
> but, I saw this message:
>
> pure_ss_unc.ads:7:58: named access types not allowed in pure unit
>
> function F1 (X : Integer) return T; -- OK
> function F2 is new Ada.Unchecked_Conversion (Integer, T); -- NG
>
> Why does compiler make an error at F2?
You've gotten a whole bunch of answers, but I think the correct one has not
be provided:
it is a compiler bug and there should not be an error at F2.
I'd suggest that you (and others as well) should ask the people at AdaCore
about what appear to be compiler bugs (especially in things changed by the
Amendment, which are highly likely to be buggy as they are new) rather than
confusing many with examples that seem to show non-existent limitations of
Ada (as opposed to a particular compiler). OTOH, if you don't have an
AdaCore contract, you won't get a timely answer from them, but I'd have to
say that you get what you pay for in that case...
Randy.
^ permalink raw reply [relevance 0%]
* Re: Pure, Storage_Size and Unchecked_Conversion
2007-07-09 13:31 2% ` Y.Tomino
@ 2007-07-09 21:31 0% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2007-07-09 21:31 UTC (permalink / raw)
On Mon, 2007-07-09 at 06:31 -0700, Y.Tomino wrote:
> Generic functions like Ada.Unchecked_Conversion
> (or my generic function I tested *1) are disallowed.
>
> What is different ?
Maybe that is it, the generic formal pointer types (to
which the 'Storage_Size does not apply, then?)
The code below compile using GNAT GPL 2007.
The issue might be a question for your friendly Ada support
team...
package PP is
pragma pure(PP);
type Ptr is access Integer;
for Ptr'Storage_Size use 0;
generic
type T is private;
function G(X : Ptr) return Ptr;
-- (Note: Ptr is not a generic formal here)
end PP;
with PP;
function F2 is new PP.G(Integer);
pragma pure(F2);
package body PP is
function G(X : Ptr) return Ptr is
begin
return X;
end G;
end PP;
> *1
> generic type T is private; type A is access T;
> function G (X : A) return A;
> pragma Pure (G); --OK
>
> function G (X : A) return A is begin return X; end G;
>
> with G;
> package P is
> pragma Pure (P);
> type A is access Integer; for A'Storage_Size use 0; --OK
> function F1 (X : A) return A; --OK
> function F2 is new G (A); --NG
> end P;
^ permalink raw reply [relevance 0%]
* Re: Pure, Storage_Size and Unchecked_Conversion
2007-07-08 16:08 0% ` Martin Krischik
@ 2007-07-09 13:31 2% ` Y.Tomino
2007-07-09 21:31 0% ` Georg Bauhaus
0 siblings, 1 reply; 200+ results
From: Y.Tomino @ 2007-07-09 13:31 UTC (permalink / raw)
On Jul 9, 1:08 am, Martin Krischik <krisc...@users.sourceforge.net>
wrote:
> You are aware that this will only work on 32 bit system while 64 bit is the
> future. It does - of course - not mean that you can't do it. You just have
> to do it right.
Don't mind. :-)
> It's one of the definitions of a pure unit: no named access types. It you
> read the Distributed System Annex then you will see why it has to be that
> way.
Thank you. I read it.
I understood access to class wide types is prohibited in remote
packages,
but I could not find description that normal access types were
prohibited (in pure packages).
Actually, Usual functions having access types like F1 are OK.
Generic functions like Ada.Unchecked_Conversion
(or my generic function I tested *1) are disallowed.
What is different ?
*1
generic type T is private; type A is access T;
function G (X : A) return A;
pragma Pure (G); --OK
function G (X : A) return A is begin return X; end G;
with G;
package P is
pragma Pure (P);
type A is access Integer; for A'Storage_Size use 0; --OK
function F1 (X : A) return A; --OK
function F2 is new G (A); --NG
end P;
--
YT http://panathenaia.halfmoon.jp/alang/ada.html
^ permalink raw reply [relevance 2%]
* Re: Pure, Storage_Size and Unchecked_Conversion
2007-07-08 0:24 3% Pure, Storage_Size and Unchecked_Conversion Y.Tomino
2007-07-08 9:49 0% ` Georg Bauhaus
@ 2007-07-08 16:08 0% ` Martin Krischik
2007-07-09 13:31 2% ` Y.Tomino
2007-07-10 1:35 0% ` Randy Brukardt
2 siblings, 1 reply; 200+ results
From: Martin Krischik @ 2007-07-08 16:08 UTC (permalink / raw)
Y.Tomino wrote:
> Hi.
> I compiled the package like this with gcc 4.2.
>
> with Ada.Unchecked_Conversion;
> package Pure_SS_Unc is
> pragma Pure;
> type T is access Integer;
> for T'Storage_Size use 0;
> function F1 (X : Integer) return T;
> function F2 is new Ada.Unchecked_Conversion (Integer, T);
> end Pure_SS_Unc;
You are aware that this will only work on 32 bit system while 64 bit is the
future. It does - of course - not mean that you can't do it. You just have
to do it right.
Read:
http://en.wikibooks.org/wiki/Ada_Programming/Types/access#Where_is_void.2A.3F
In short: don't use the predefined integer - use your own:
type void is mod System.Memory_Size;
for void'Size use System.Word_Size;
> pure_ss_unc.ads:7:58: named access types not allowed in pure unit
It's one of the definitions of a pure unit: no named access types. It you
read the Distributed System Annex then you will see why it has to be that
way.
Martin
--
mailto://krischik@users.sourceforge.net
Ada programming at: http://ada.krischik.com
^ permalink raw reply [relevance 0%]
* Re: Pure, Storage_Size and Unchecked_Conversion
2007-07-08 0:24 3% Pure, Storage_Size and Unchecked_Conversion Y.Tomino
@ 2007-07-08 9:49 0% ` Georg Bauhaus
2007-07-08 16:08 0% ` Martin Krischik
2007-07-10 1:35 0% ` Randy Brukardt
2 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2007-07-08 9:49 UTC (permalink / raw)
On Sat, 2007-07-07 at 17:24 -0700, Y.Tomino wrote:
> with Ada.Unchecked_Conversion;
> package Pure_SS_Unc is
> pragma Pure;
> type T is access Integer;
> for T'Storage_Size use 0;
> function F1 (X : Integer) return T;
> function F2 is new Ada.Unchecked_Conversion (Integer, T);
> end Pure_SS_Unc;
>
> [...]
> pure_ss_unc.ads:7:58: named access types not allowed in pure unit
The message should really apply to the declaration of T.
T is a named access type. If you remove all lines referring
to U_C, the compiler might say something like
GNAT 4.1.2 (Ubuntu 4.1.2-0ubuntu4)
Copyright 1992-2005 Free Software Foundation, Inc.
Compiling: pure_ss_unc.ads (source file time stamp: 2007-07-08 09:44:14)
4. type T is access Integer;
|
>>> named access type not allowed in pure unit
8 lines: 1 error
Just guessing what your package is supposed to achieve,
have you considered using System.Address_To_Access_Conversions?
^ permalink raw reply [relevance 0%]
* Pure, Storage_Size and Unchecked_Conversion
@ 2007-07-08 0:24 3% Y.Tomino
2007-07-08 9:49 0% ` Georg Bauhaus
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Y.Tomino @ 2007-07-08 0:24 UTC (permalink / raw)
Hi.
I compiled the package like this with gcc 4.2.
with Ada.Unchecked_Conversion;
package Pure_SS_Unc is
pragma Pure;
type T is access Integer;
for T'Storage_Size use 0;
function F1 (X : Integer) return T;
function F2 is new Ada.Unchecked_Conversion (Integer, T);
end Pure_SS_Unc;
Ada.Unchecked_Conversion is pure generic function.
I think the condition of F1 and F2 is the same.
but, I saw this message:
pure_ss_unc.ads:7:58: named access types not allowed in pure unit
function F1 (X : Integer) return T; -- OK
function F2 is new Ada.Unchecked_Conversion (Integer, T); -- NG
Why does compiler make an error at F2?
--
YT http://panathenaia.halfmoon.jp/alang/ada.html
^ permalink raw reply [relevance 3%]
* Re: String literals and wide_string literals - how?
2007-04-21 9:41 0% ` Simon Wright
@ 2007-04-22 1:00 0% ` Robert A Duff
1 sibling, 0 replies; 200+ results
From: Robert A Duff @ 2007-04-22 1:00 UTC (permalink / raw)
"Jeffrey R. Carter" <jrcarter@acm.org> writes:
> Robert A Duff wrote:
>> type Bit is ('0', '1');
>> type Bit_String is array (Positive range <>) of Bit;
>> pragma Pack(Bit_String);
>> X: constant Bit_String := "01011110";
>> Bit is a character type, and Bit_String is a string type.
>> X can fit in 8 bits, by the way.
>
> for Bit'Size use 1;
Bit'Size is 1 by default, so I suppose:
pragma Assert(Bit'Size = 1);
would be a better way to express this, in case you care.
> for Bit_String'Component_Size use Bit'Size;
>
> subtype Byte_String is Bit_String (1 .. 8);
>
> Y : constant Byte_String := "00001111";
> pragma Assert (Y'Size = Y'Length);
Y'Size might well be 32 on some implementations.
But that's OK -- Byte_String'Size should be 8.
> type Byte is mod 2 ** 8;
> for Byte'Size use 8;
>
> function To_Byte is new Ada.Unchecked_Conversion
> (Source => Byte_String, Target => Byte);
>
> Z : constant Byte := To_Byte (Y);
>
> What is Z and 1?
0 or 1, depending on the implementation.
I'm not sure what your point is, here. Unchecked_Conversion depends on
implementation choices (in this case, based on endianness), and is
therefore implementation defined. So?
Types Bit and Bit_String above have well-defined portable semantics.
Patient: "Doc, It hurts when I Unchecked_Convert."
Doctor: "So don't do that." ;-)
- Bob
^ permalink raw reply [relevance 0%]
* Re: String literals and wide_string literals - how?
@ 2007-04-21 9:41 0% ` Simon Wright
2007-04-22 1:00 0% ` Robert A Duff
1 sibling, 0 replies; 200+ results
From: Simon Wright @ 2007-04-21 9:41 UTC (permalink / raw)
"Jeffrey R. Carter" <jrcarter@acm.org> writes:
> Robert A Duff wrote:
>>
>> type Bit is ('0', '1');
>> type Bit_String is array (Positive range <>) of Bit;
>> pragma Pack(Bit_String);
>> X: constant Bit_String := "01011110";
>>
>> Bit is a character type, and Bit_String is a string type.
>>
>> X can fit in 8 bits, by the way.
>
> for Bit'Size use 1;
> for Bit_String'Component_Size use Bit'Size;
>
> subtype Byte_String is Bit_String (1 .. 8);
>
> Y : constant Byte_String := "00001111";
> pragma Assert (Y'Size = Y'Length);
>
> type Byte is mod 2 ** 8;
> for Byte'Size use 8;
>
> function To_Byte is new Ada.Unchecked_Conversion
> (Source => Byte_String, Target => Byte);
>
> Z : constant Byte := To_Byte (Y);
>
> What is Z and 1?
Well, on a PowerPC Z is 2#00001111# but I suspect you'd get a
different answer on a little-endian machine ..
^ permalink raw reply [relevance 0%]
Results 1-200 of ~500 next (older) | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2007-04-20 10:07 String literals and wide_string literals - how? Gerd
2007-04-20 14:55 ` Robert A Duff
2007-04-20 22:09 ` Jeffrey R. Carter
2007-04-21 9:41 0% ` Simon Wright
2007-04-22 1:00 0% ` Robert A Duff
2007-07-08 0:24 3% Pure, Storage_Size and Unchecked_Conversion Y.Tomino
2007-07-08 9:49 0% ` Georg Bauhaus
2007-07-08 16:08 0% ` Martin Krischik
2007-07-09 13:31 2% ` Y.Tomino
2007-07-09 21:31 0% ` Georg Bauhaus
2007-07-10 1:35 0% ` Randy Brukardt
2007-07-10 8:30 0% ` Georg Bauhaus
2007-08-02 19:21 Byte streams shaunpatterson
2007-08-03 5:34 2% ` Jeffrey R. Carter
2007-09-03 8:47 urgent question - generics shoshanister
2007-09-03 16:35 ` shoshanister
2007-09-04 0:38 2% ` anon
2007-10-15 14:12 Base64-Encoding Stefan Bellon
2007-10-19 2:43 3% ` Base64-Encoding anon
2007-10-19 4:33 0% ` Base64-Encoding anon
2007-10-19 6:59 0% ` Base64-Encoding Stefan Bellon
2007-10-19 19:40 2% ` Base64-Encoding anon
2007-10-26 14:58 Real Time IO routines andrew
2007-10-26 16:43 ` Anh Vo
2007-10-26 16:53 ` andrew
2007-10-26 17:04 ` Anh Vo
2007-10-26 17:21 ` andrew
2007-10-26 18:36 ` Ludovic Brenta
2007-10-26 20:00 ` andrew
2007-10-26 20:29 2% ` Ludovic Brenta
2007-10-27 8:56 3% ` anon
2007-10-27 10:18 0% ` Dmitry A. Kazakov
2007-10-27 20:15 0% ` anon
2008-02-20 0:47 Is it really Ok to assert that the Ada syntax is a context-free grammar ? Hibou57
2008-02-20 2:06 ` Jeffrey R. Carter
2008-02-20 10:05 ` Martin Krischik
2008-02-20 10:34 ` Ludovic Brenta
2008-02-20 14:22 ` Hibou57
2008-02-20 20:51 2% ` Robert A Duff
2008-02-21 19:24 ` Martin Krischik
2008-02-22 20:17 ` Simon Wright
2008-02-25 21:47 2% ` Samuel Tardieu
2008-03-06 17:07 updating a hardware cursor with assembly and ada cl1
2008-03-07 19:01 2% ` cl1
2008-04-30 10:27 How to check a Float for NaN Jerry
2008-05-05 18:23 ` Martin Krischik
2008-05-05 20:49 ` Adam Beneschan
2008-05-06 18:09 ` Jerry
2008-05-06 18:45 2% ` Wiljan Derks
2008-05-06 22:18 0% ` Adam Beneschan
2008-05-23 21:19 Bit operations in Ada Dennis Hoppe
2008-05-23 22:08 3% ` Ludovic Brenta
2008-05-24 15:36 0% ` Simon Wright
2008-06-02 13:27 0% ` Bit operations in Ada (endianness) Dennis Hoppe
2008-05-23 22:38 ` Bit operations in Ada Robert A Duff
2008-05-24 9:40 2% ` Bit operations in Ada (Thank you) Dennis Hoppe
2008-08-05 2:16 Controlling endian-ness? Peter C. Chapin
2008-08-05 3:10 2% ` Steve
2008-09-12 15:23 Adding offset to 'Address Adam Beneschan
2008-09-13 6:21 3% ` tmoran
2008-09-17 9:15 0% ` Kim Rostgaard Christensen
2008-09-19 12:21 Structure of the multitasking server Maciej Sobczak
2008-09-22 13:05 ` Maciej Sobczak
2008-09-23 9:25 1% ` anon
2008-09-25 22:17 2% Warning when compiling s-interr.adb runtime file with -gnatc David Sauvage
2008-09-26 0:47 0% ` Adam Beneschan
2008-10-07 19:43 Making a Inet_Addr_Type out of octects (GNAT.Sockets) mockturtle
2008-10-08 10:28 2% ` anon
[not found] <407ae64d-3cb3-4310-b59e-f1bbae9910a5@t39g2000prh.googlegroups.com>
2009-01-14 1:33 ` How to put 200 into an integer sub-type of 16 bits (code included) Brian Drummond
[not found] ` <3d3719f4-355c-4094-9902-495d612d46fe@n33g2000pri.googlegroups.com>
2009-01-14 9:06 2% ` Ludovic Brenta
2009-01-14 12:53 ` Brian Drummond
[not found] ` <f4894476-851e-493f-93a2-168976bd97fb@s1g2000prg.googlegroups.com>
2009-01-14 16:08 3% ` Adam Beneschan
2009-01-14 21:17 0% ` sjw
[not found] ` <139961e9-bae6-4e60-8ff7-4f4779b27481@z6g2000pre.googlegroups.com>
2009-01-14 20:41 ` Adam Beneschan
[not found] ` <3625f980-4406-4f51-b494-dd4a48cab840@p36g2000prp.googlegroups.com>
2009-01-15 6:53 3% ` Michael Bode
2009-01-15 8:57 0% ` Martin
[not found] ` <fc154f52-7168-447a-bcd3-6ece9066ebf7@r37g2000prr.googlegroups.com>
2009-01-15 10:29 2% ` Georg Bauhaus
[not found] ` <1a2b31ac-cf6b-44e3-85b7-04594460db87@d36g2000prf.googlegroups.com>
2009-01-15 12:40 2% ` Stuart
2009-01-14 21:32 0% ` sjw
2009-01-14 21:09 ` sjw
2009-01-15 14:44 ` Brian Drummond
[not found] ` <3f1f2f67-5d69-4baf-8e8c-0d2b5f68475f@p36g2000prp.googlegroups.com>
[not found] ` <8e64f509-f6fe-4d86-ae1a-fe0b1c88555a@v5g2000pre.googlegroups.com>
2009-01-15 17:09 ` How to put 200.0 (is float variable of 32 bits) into an integer sub-type of 10 bits (complete program included) christoph.grein
2009-01-15 17:17 ` Adam Beneschan
2009-01-15 17:29 ` Georg Bauhaus
[not found] ` <97231951-54a0-4df7-bb73-04261b34287f@e6g2000vbe.googlegroups.com>
2009-01-16 3:17 3% ` Steve D
[not found] <83d19cd8-71ca-43c1-a3eb-05832290e565@r36g2000prf.googlegroups.com>
2009-01-16 1:37 3% ` Restarting Tread: Why isn't this program working with anon
[not found] ` <40239b21-b265-467f-9b27-5890fb2f4c67@w1g2000prm.googlegroups.com>
2009-01-16 2:27 ` Restarting Tread: Why isn't this program working with Unchecked_Converstion Adam Beneschan
[not found] ` <9069fcf7-4257-4439-ad4a-8d7c8c17f5cf@v5g2000pre.googlegroups.com>
2009-01-16 15:11 2% ` Ludovic Brenta
2009-01-16 16:23 3% ` Martin
2009-01-24 20:47 How do I go about creating a minimal GNAT runtime? Lucretia
2009-02-10 2:34 1% ` Exceptions (was Re: How do I go about creating a minimal GNAT runtime?) anon
2009-01-27 14:21 2% cannot generate code for file a-excach.adb (subunit) Lucretia
2009-01-27 14:38 0% ` xavier grave
2009-03-01 1:32 2% GNAT.Sockets writing data to nowhere xorquewasp
2009-05-01 21:39 GNAT on WinXP: System.OS_Lib.Spawn raises Program_Error daniel.wengelin
2009-05-03 13:24 ` Ed Falis
2009-05-04 0:22 2% ` anon
2009-05-04 1:21 0% ` Ed Falis
2009-05-18 19:19 (Num_Types.Mod_4 range 1..8) ------->why not (1..8)? convergence82
2009-05-18 19:36 ` Georg Bauhaus
2009-05-18 19:58 2% ` convergence82
2009-05-18 20:50 0% ` Adam Beneschan
2009-05-18 20:53 0% ` Georg Bauhaus
2009-05-18 21:12 0% ` convergence82
2009-05-18 21:24 0% ` Adam Beneschan
2009-05-19 6:26 ` christoph.grein
2009-05-19 7:47 3% ` Petter
2009-05-19 8:04 0% ` christoph.grein
2009-05-19 18:51 Conversion from floating point to signed 16 bits Olivier Scalbert
2009-05-19 20:06 2% ` Ludovic Brenta
2009-05-19 22:08 0% ` Olivier Scalbert
2009-05-29 0:55 2% Error: "could not understand bounds information on packed array" Dennis Hoppe
2009-08-26 10:22 Generalized serialization for enumeration types xorque
2009-08-26 11:17 2% ` Georg Bauhaus
[not found] <4a9b045a$0$31875$9b4e6d93@newsspool3.arcor-online.net>
2009-08-31 8:28 0% ` Q: Line_IO Martin
2009-08-31 18:39 ` Dmitry A. Kazakov
2009-08-31 23:56 2% ` Georg Bauhaus
2009-09-02 20:38 Gem 39 - compiler specific? Maciej Sobczak
2009-09-02 23:20 2% ` Randy Brukardt
2009-10-29 23:29 Performance of the Streams 'Read and 'Write Gautier write-only
2009-10-30 13:40 ` Gautier write-only
2009-11-02 22:19 3% ` Gautier write-only
[not found] <81734679-bcfc-4d52-b5c2-104f0d75b592@i12g2000prg.googlegroups.com>
[not found] ` <687d5205-3e93-4b10-8d5d-e31d20e19e08@2g2000prl.googlegroups.com>
2009-11-05 10:02 ` Tricks Of The Trade: How To Compile Large Program On Two Very Different Compilers Niklas Holsti
[not found] ` <b813c43f-5973-43ee-aa79-9fb90d6d077c@r24g2000prf.googlegroups.com>
2009-11-05 15:31 ` Georg Bauhaus
[not found] ` <1dac1c79-6cfe-46da-a5cf-7b0dd4b95775@z4g2000prh.googlegroups.com>
[not found] ` <4fbfba1f-65ac-43d5-8328-61dcf075a1b1@13g2000prl.googlegroups.com>
2009-11-05 18:21 2% ` Georg Bauhaus
2010-03-05 11:41 Having a problem building with win32ada John McCabe
2010-03-09 21:00 2% ` John McCabe
2010-03-09 21:37 0% ` John McCabe
2010-04-21 16:43 How to access this package written in C? resander
2010-04-22 21:12 ` Keith Thompson
2010-04-23 12:58 1% ` resander
2010-04-23 14:15 0% ` Dmitry A. Kazakov
2010-06-11 1:17 3% What is the best way to convert Integer to Short_Short_Integer? Adrian Hoe
2010-06-11 2:21 0% ` Adrian Hoe
2010-08-01 12:17 S-expression I/O in Ada Natacha Kerensikova
2010-08-17 17:01 ` Natasha Kerensikova
2010-08-17 19:00 2% ` Jeffrey Carter
2010-08-31 11:14 2% bit numbers in packed arrays of Boolean Stephen Leake
2010-08-31 12:34 0% ` Niklas Holsti
2011-03-12 15:08 2% Adress => Access: types for unchecked conversion have different sizes Martin Krischik
2011-03-12 17:00 0% ` Edward Fish
2011-03-13 3:32 0% ` Randy Brukardt
2011-03-17 14:31 Help with low level Ada Syntax Issues
2011-03-17 17:55 2% ` Jeffrey Carter
2011-03-17 19:30 0% ` Syntax Issues
2011-04-11 10:26 GNAT.Serial_Communications tonyg
2011-04-11 11:11 ` GNAT.Serial_Communications Brian Drummond
2011-04-13 7:49 ` GNAT.Serial_Communications tonyg
2011-04-13 14:12 ` GNAT.Serial_Communications Alex Mentis
2011-04-13 21:12 ` GNAT.Serial_Communications tonyg
2011-04-14 17:52 ` GNAT.Serial_Communications Chris Moore
2011-04-15 13:58 ` GNAT.Serial_Communications tonyg
2011-04-15 16:32 ` GNAT.Serial_Communications tonyg
2011-04-15 18:01 3% ` GNAT.Serial_Communications Jeffrey Carter
2011-04-16 10:21 0% ` GNAT.Serial_Communications tonyg
2011-04-16 17:02 Fun with C George P.
2011-04-16 20:04 ` Nasser M. Abbasi
2011-04-16 21:12 ` Ludovic Brenta
2011-04-17 7:17 3% ` Georg Bauhaus
2011-04-17 8:29 0% ` Martin
2011-04-17 18:19 0% ` George P.
2011-04-17 8:40 2% ` Georg Bauhaus
2011-04-30 8:41 3% A hole in Ada type safety Florian Weimer
2011-04-30 11:56 0% ` Robert A Duff
2011-04-30 16:16 0% ` Florian Weimer
2011-05-14 23:47 0% ` anon
2011-05-08 10:30 ` Florian Weimer
2011-05-08 20:24 3% ` anon
2011-05-08 21:11 ` Simon Wright
2011-05-10 6:27 ` anon
2011-05-10 14:39 ` Adam Beneschan
2011-05-11 20:39 3% ` anon
2011-05-12 0:51 0% ` Randy Brukardt
2011-05-13 0:47 0% ` anon
2011-05-12 5:51 3% ` AdaMagica
2011-07-24 15:59 acceess problem ldries46
2011-07-24 17:27 ` Simon Wright
2011-07-25 6:57 ` ldries46
2011-07-25 8:27 ` Simon Wright
2011-07-26 15:57 2% ` Gautier write-only
2011-07-26 17:43 0% ` Adam Beneschan
2011-09-14 3:13 Stream_Element_Array Alexander Korolev
2011-09-14 8:31 2% ` Stream_Element_Array Simon Wright
2011-09-14 9:09 0% ` Stream_Element_Array Alexander Korolev
2011-09-14 9:40 0% ` Stream_Element_Array Dmitry A. Kazakov
2011-09-16 11:17 3% ` Stream_Element_Array anon
2011-12-12 8:57 Does Ada support endiannes? Gerd
2011-12-12 11:27 ` Dmitry A. Kazakov
2011-12-12 12:44 ` Gerd
2011-12-12 19:23 3% ` Jeffrey Carter
2011-12-13 14:19 ` Gautier write-only
2011-12-14 16:16 ` Gerd
2011-12-14 20:16 ` Gautier write-only
2011-12-15 11:27 ` Gerd
2011-12-15 13:01 2% ` Simon Wright
2011-12-12 22:30 Interfaces.Shift_Left awdorrin
2011-12-12 23:34 2% ` Interfaces.Shift_Left Simon Wright
2011-12-13 1:36 0% ` Interfaces.Shift_Left Adam Beneschan
2011-12-22 9:41 2% Representation clauses for base-64 encoding Natasha Kerensikova
2011-12-22 11:20 0% ` Niklas Holsti
2011-12-22 11:37 ` Georg Bauhaus
2011-12-22 12:24 ` Niklas Holsti
2011-12-22 15:09 ` Georg Bauhaus
2011-12-22 16:00 ` Natasha Kerensikova
2011-12-22 22:18 2% ` Georg Bauhaus
2012-03-01 13:06 Any leap year issues caused by Ada yesterday? Georg Bauhaus
2012-03-05 11:07 ` tonyg
2012-03-05 15:59 ` Shark8
2012-03-05 18:03 ` Dmitry A. Kazakov
2012-03-05 18:30 ` Simon Wright
2012-03-05 20:17 ` Dmitry A. Kazakov
2012-03-05 20:56 ` Simon Wright
2012-03-06 8:47 ` Dmitry A. Kazakov
2012-03-06 9:20 ` Simon Wright
2012-03-06 10:07 ` Dmitry A. Kazakov
2012-03-06 16:46 ` Simon Wright
2012-03-06 17:37 ` Dmitry A. Kazakov
2012-03-06 17:59 2% ` Simon Wright
2012-03-27 19:44 xor Dmitry A. Kazakov
2012-03-27 21:16 ` xor Michael Moeller
2012-03-27 22:03 ` xor Georg Bauhaus
2012-03-27 23:50 ` xor Michael Moeller
[not found] ` <bbedne9wdofZyu_SnZ2dnUVZ_hydnZ2d@earthlink.com>
2012-03-28 12:18 ` xor Michael Moeller
2012-03-28 14:07 ` xor Dmitry A. Kazakov
2012-03-28 16:16 ` xor Michael Moeller
2012-03-28 16:08 ` xor Dmitry A. Kazakov
2012-03-28 17:36 ` xor Michael Moeller
[not found] ` <tdadna1MV6uj5O7SnZ2dnUVZ_jidnZ2d@earthlink.com>
2012-03-28 21:48 1% ` xor Georg Bauhaus
2012-04-03 7:19 Dispatching callback handed over to C Natasha Kerensikova
2012-04-03 9:37 ` Maciej Sobczak
2012-04-03 12:02 ` Natasha Kerensikova
2012-04-03 14:42 ` Maciej Sobczak
2012-04-03 20:20 ` Randy Brukardt
2012-04-04 11:34 ` Maciej Sobczak
2012-04-04 19:16 ` Randy Brukardt
2012-04-05 9:13 2% ` Natasha Kerensikova
2012-04-05 21:06 0% ` Randy Brukardt
[not found] <95634f38f6ee0d116da523fdc2c9f5ca@dizum.com>
2012-05-21 15:28 ` condition true or false? -> (-1 < sizeof("test")) Nomen Nescio
2012-05-22 1:45 ` glen herrmannsfeldt
2012-05-22 10:29 2% ` Georg Bauhaus
2012-06-29 9:17 GNAT (GCC) Profile Guided Compilation Keean Schupke
2012-06-29 14:14 ` gautier_niouzes
2012-06-29 15:05 ` gautier_niouzes
2012-06-29 17:03 ` Keean Schupke
2012-07-01 17:45 ` Georg Bauhaus
2012-07-01 22:57 ` Keean Schupke
2012-07-02 17:15 ` Georg Bauhaus
2012-07-02 17:26 ` Keean Schupke
2012-07-02 23:48 ` Keean Schupke
2012-07-04 10:38 ` Georg Bauhaus
2012-07-04 10:57 ` Keean Schupke
2012-07-04 12:38 ` Georg Bauhaus
2012-07-14 20:17 ` Keean Schupke
2012-07-14 20:43 ` Niklas Holsti
2012-07-14 22:32 ` Keean Schupke
2012-07-14 23:40 ` Keean Schupke
2012-07-15 7:15 ` Niklas Holsti
2012-07-15 8:27 ` Keean Schupke
2012-07-18 10:01 2% ` Georg Bauhaus
2012-07-18 17:36 0% ` Keean Schupke
2012-08-06 16:45 Ada.Locales pseudo-string types Marius Amado-Alves
2012-08-07 5:57 3% ` Jeffrey R. Carter
2012-08-07 15:46 0% ` Adam Beneschan
2012-09-21 18:16 Endianness and Record Specification awdorrin
2012-09-21 22:18 3% ` Simon Wright
2012-09-29 5:50 ANN: AdaTutor on the Web - done Zhu Qun-Ying
2012-09-29 10:22 3% ` AdaMagica
2012-10-30 22:03 Tasking troubles, unexpected termination Shark8
2012-10-30 23:01 ` Adam Beneschan
2012-10-31 1:05 ` Anh Vo
2012-10-31 2:17 1% ` Shark8
2013-04-27 21:08 GNAT not generating any code for sub‑program: known bug? Yannick Duchêne (Hibou57)
2013-04-27 22:22 ` Yannick Duchêne (Hibou57)
2013-04-28 7:14 2% ` Simon Wright
2013-05-06 0:20 1% Generic access type convention and aliasing Yannick Duchêne (Hibou57)
2013-08-14 3:50 2% GNAT Allocation of a very large record hyunghwan.chung
2013-08-14 19:32 0% ` Per Sandberg
2013-11-14 15:57 GNAT 4.8 atomic access to 64-bit objects Dmitry A. Kazakov
2013-11-14 20:34 ` Ludovic Brenta
2013-11-15 8:44 ` Dmitry A. Kazakov
2013-11-15 19:25 ` Georg Bauhaus
2013-11-15 21:33 3% ` Dmitry A. Kazakov
2013-11-16 10:08 0% ` Georg Bauhaus
2013-11-16 12:02 0% ` Dmitry A. Kazakov
2014-07-05 20:32 'Size hack for enumerated types Victor Porton
2014-07-05 21:47 ` Simon Wright
2014-07-05 22:11 ` Victor Porton
2014-07-05 22:18 3% ` Victor Porton
2014-07-05 22:23 0% ` Victor Porton
2014-07-06 16:25 0% ` Victor Porton
2014-07-21 20:44 3% Rough proposal to make some generic types static Victor Porton
2014-07-21 20:54 0% ` Victor Porton
2014-08-17 19:02 2% Interfacing enums with C Victor Porton
2014-10-02 13:56 3% Debugging Audio Issue using Windows 7? dd24fan
2014-10-17 13:17 Generic formals and Aspects Simon Wright
2016-07-19 15:49 ` olivermkellogg
2016-07-19 16:05 ` Shark8
2016-07-19 18:00 3% ` olivermkellogg
2015-01-18 10:02 Can't compile FOSDEM 2014 Ada Task Pools demo on Debian jessie Dirk Heinrichs
2015-01-19 20:44 14% ` Ludovic Brenta
2015-02-02 5:50 1% Did I find mamory leak in Generic Image Decoder (GID) ? reinkor
2016-08-13 9:27 1% GNAVI,GWindows.Common_Controls.On_Notify - how to return value? George J
2016-10-17 20:18 Bug in Ada - Latin 1 is not a subset of UTF-8 Lucretia
2016-10-17 23:25 ` G.B.
2016-10-18 7:41 ` Dmitry A. Kazakov
2016-10-18 8:23 ` G.B.
2016-10-18 8:45 ` Dmitry A. Kazakov
2016-10-20 0:31 ` Randy Brukardt
2016-10-20 7:36 ` Dmitry A. Kazakov
2016-10-21 12:28 1% ` G.B.
[not found] <ce508a3d-bd0f-4ecc-953e-5b624c072b3c@googlegroups.com>
[not found] ` <o9v343$pf5$1@dont-email.me>
[not found] ` <86633a07-9a12-4419-ad09-b519e4f279a5@googlegroups.com>
[not found] ` <o9ve6p$2pq$1@dont-email.me>
2017-03-26 20:57 0% ` Mixing Ada code with similar licenses Jere
2017-07-04 17:49 2% Strict aliasing, is it OK? Victor Porton
2017-07-04 17:50 0% ` Victor Porton
2017-07-04 18:06 0% ` Victor Porton
2017-07-04 18:15 0% ` Niklas Holsti
2017-07-04 18:30 0% ` Victor Porton
2017-07-04 19:29 0% ` Niklas Holsti
2017-07-04 20:11 0% ` Victor Porton
2017-07-04 21:41 0% ` Simon Wright
2017-07-04 23:39 0% ` Victor Porton
2017-08-29 20:28 win32 interfacing check (SetClipboardData) Xavier Petit
2017-08-30 16:04 ` Dmitry A. Kazakov
2017-08-31 1:41 2% ` Randy Brukardt
2017-09-14 5:09 use Ada.Text_IO in main() or Package? Mace Ayres
2017-09-14 6:21 ` gautier_niouzes
2017-09-14 6:47 ` Mace Ayres
2017-09-14 7:13 ` gautier_niouzes
2017-09-14 9:37 ` Mace Ayres
2017-09-14 9:49 2% ` gautier_niouzes
2017-10-11 21:52 2% Convert between C "void*" pointer and an access Victor Porton
2017-10-11 22:32 0% ` Randy Brukardt
2017-10-11 23:03 0% ` Victor Porton
2017-10-12 7:57 0% ` Dmitry A. Kazakov
2017-10-29 14:50 0% ` David Thompson
2017-10-11 22:58 3% ` Victor Porton
2017-10-11 23:12 3% ` Victor Porton
2017-10-12 1:01 1% ` Victor Porton
2018-05-10 17:45 AI12-0218: What is the portable representation clause for processing IETF packets on little-endian machines? Dan'l Miller
2018-05-10 19:24 ` Dan'l Miller
2018-05-10 20:32 ` Paul Rubin
2018-05-10 22:24 ` Dan'l Miller
2018-05-10 22:44 ` Niklas Holsti
2018-05-11 2:38 ` Dan'l Miller
2018-05-11 7:55 2% ` Simon Wright
2018-05-11 12:11 ` Lucretia
2018-05-11 13:49 ` Simon Wright
2018-05-11 16:11 ` Jeffrey R. Carter
2018-05-11 16:48 ` Simon Wright
2018-05-11 19:08 ` Jeffrey R. Carter
2018-05-11 21:39 ` Simon Wright
2018-05-11 21:56 ` Jeffrey R. Carter
2018-05-12 7:08 2% ` Simon Wright
2018-05-12 7:53 0% ` Jeffrey R. Carter
2018-06-30 10:48 Strange crash on custom iterator Lucretia
2018-06-30 11:32 ` Simon Wright
2018-06-30 12:02 ` Lucretia
2018-06-30 14:25 ` Simon Wright
2018-06-30 14:33 ` Lucretia
2018-06-30 19:25 ` Simon Wright
2018-06-30 19:36 ` Luke A. Guest
2018-07-01 18:06 ` Jacob Sparre Andersen
2018-07-01 19:59 ` Simon Wright
2018-07-02 17:43 ` Luke A. Guest
2018-07-02 19:42 1% ` Simon Wright
2018-07-16 8:20 Simple hash or pseudo-random function gautier_niouzes
2018-07-16 17:17 ` Jeffrey R. Carter
2018-07-16 21:14 ` gautier_niouzes
2018-07-17 6:09 2% ` Jeffrey R. Carter
2018-07-18 13:38 0% ` gautier_niouzes
2018-08-20 13:56 file descriptor of a serial port jan.de.kruyf
2018-08-20 15:17 ` Björn Lundin
2018-08-20 15:41 2% ` jan.de.kruyf
2018-10-14 19:15 3% Examining individual bytes of an integer Henrik Härkönen
2018-10-14 19:55 0% ` Jeffrey R. Carter
2018-10-14 21:28 0% ` Niklas Holsti
2018-10-14 21:04 0% ` Niklas Holsti
2019-01-23 10:05 Problem with Position of the enumeration Type Luis Ladron de Guevara Moreno
2019-01-23 10:33 ` AdaMagica
2019-01-23 12:08 2% ` Luis Ladron de Guevara Moreno
2019-01-24 8:06 0% ` AdaMagica
2019-02-06 23:10 Ada x <whatever> Datagram Sockets Rego, P.
2019-02-07 0:42 ` Jere
2019-02-07 5:28 ` Rego, P.
2019-02-07 6:00 ` Egil H H
2019-02-07 6:41 ` Rego, P.
2019-02-07 11:47 ` Jere
2019-02-07 18:00 ` Jeffrey R. Carter
2019-02-08 20:35 2% ` Rego, P.
2019-02-08 21:38 0% ` Dmitry A. Kazakov
2019-12-11 16:43 2% Is this actually possible? Lucretia
2020-01-18 7:32 Creating several types from a base type and conversion Ken Roberts
2020-01-18 12:16 2% ` Simon Wright
2020-01-18 12:49 0% ` Ken Roberts
2020-01-18 14:17 0% ` Optikos
2020-01-23 21:39 ` Optikos
2020-01-24 15:54 2% ` Simon Wright
2020-01-25 21:52 GNATCOLL-Mmap example Bob Goddard
2020-01-28 8:25 ` Dmitry A. Kazakov
2020-01-28 18:53 2% ` Bob Goddard
2020-04-14 7:15 Put the access value ldries46
2020-04-14 11:05 ` Jeffrey R. Carter
2020-04-14 12:09 ` ldries46
2020-04-15 7:20 2% ` briot.emmanuel
2020-06-04 16:54 Array Index: substitute integer with enumeration hreba
2020-06-09 17:25 2% ` Shark8
2020-06-16 11:31 1% How can I get this data into the .data section of the binary? 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-01-09 9:30 Record initialisation question DrPi
2021-01-09 15:44 ` Niklas Holsti
2021-01-10 16:53 ` DrPi
2021-01-10 19:30 ` Niklas Holsti
2021-01-10 21:27 ` DrPi
2021-01-10 22:14 ` Niklas Holsti
2021-01-11 17:46 ` DrPi
2021-01-11 20:58 ` Niklas Holsti
2021-01-14 13:07 ` DrPi
2021-01-14 14:27 ` Niklas Holsti
2021-01-14 16:53 2% ` Shark8
2021-01-15 7:50 0% ` DrPi
2021-01-15 18:15 3% ` Shark8
2021-01-16 10:28 0% ` DrPi
2021-03-04 15:59 converting pointer to value Björn Lundin
2021-03-04 16:55 3% ` Shark8
2021-03-12 20:49 array from static predicate on enumerated type Matt Borchers
2021-03-12 22:41 ` Dmitry A. Kazakov
2021-03-13 2:06 ` Matt Borchers
2021-03-13 8:04 ` Dmitry A. Kazakov
2021-03-15 14:11 ` Matt Borchers
2021-03-15 17:48 ` Shark8
2021-03-15 20:25 ` Dmitry A. Kazakov
2021-03-16 13:27 ` Shark8
2021-03-16 14:25 ` Dmitry A. Kazakov
2021-03-17 4:05 ` Matt Borchers
2021-03-17 15:08 1% ` Shark8
2021-04-17 21:45 Unchecked_Deallocation with tagged types DrPi
2021-04-18 8:21 ` Dmitry A. Kazakov
2021-04-18 8:46 ` Gautier write-only address
2021-04-18 9:09 ` Jeffrey R. Carter
2021-04-18 10:13 ` Dmitry A. Kazakov
2022-04-16 3:44 2% ` Thomas
2022-04-16 8:09 0% ` Dmitry A. Kazakov
2023-04-19 17:36 Ada interface to Excel file AdaMagica
2023-04-20 19:08 1% ` Gautier write-only address
2023-08-13 16:16 Unifont static compiled and stack size Micah Waddoups
2023-08-14 10:06 ` Jeffrey R.Carter
2023-08-14 15:10 1% ` Micah Waddoups
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox