Re: RISC - largish (code listed)

["Martin Dowie" <martin.dowie@baesystems.com>]

Something like this? Seems _well_ dangerous but also seems to produce very
little code...

Ted Dennison <dennison@telepath.com> wrote in message
news:LWKt6.1865$94.2578@www.newsranger.com...
> That's why if the object is largish I typically use unchecked_conversion
on
> pointers to the object instead. Depending on the smarts of the compiler,
that
> might not generate any code at all.
>
> I don't like "for use at" overlays. For one thing, initializations get
(re)done
> when the overlay happens, which could wipe out important stuff. For
another, the
> aliasing is (generally) given a much wider scope than is achievable with
> unchecked conversion.


-- Unchecked_Accessors Spec:
with System;

generic
   type Object1 (<>) is limited private;
   type Object1_Pointer is access all Object1;
   with function To_Object1_Pointer (Address : System.Address) return
Object1_Pointer;
   with function To_Object1_Address (Obj1_Ptr : Object1_Pointer) return
System.Address;

   type Object2 (<>) is limited private;
   type Object2_Pointer is access all Object2;
   with function To_Object2_Pointer (Address : System.Address) return
Object2_Pointer;
   with function To_Object2_Address (Obj2_Ptr : Object2_Pointer) return
System.Address;
package Unchecked_Accessors is
   function To_Object1_Pointer (Obj2_Ptr : Object2_Pointer) return
Object1_Pointer;
   function To_Object2_Pointer (Obj1_Ptr : Object1_Pointer) return
Object2_Pointer;
   pragma Inline (To_Object1_Pointer);
   pragma Inline (To_Object2_Pointer);
end Unchecked_Accessors;


-- Unchecked_Accessors Body:
package body Unchecked_Accessors is

   function To_Object1_Pointer (Obj2_Ptr : Object2_Pointer) return
Object1_Pointer is
   begin
       return To_Object1_Pointer (Address => To_Object2_Address (Obj2_Ptr =>
Obj2_Ptr));
   end To_Object1_Pointer;

   function To_Object2_Pointer (Obj1_Ptr : Object1_Pointer) return
Object2_Pointer is
   begin
       return To_Object2_Pointer (Address => To_Object1_Address (Obj1_Ptr =>
Obj1_Ptr));
   end To_Object2_Pointer;

end Unchecked_Accessors;


-- Test Harness:
with Ada.Text_IO; use Ada.Text_IO;
with System.Address_To_Access_Conversions;
with Unchecked_Accessors;

procedure Test_Unchecked_Access_Conversion is

  type A_Record (Variant : Boolean := False) is record
    Item1 : Integer;
    case Variant is
      when False =>
        Item2 : Float;
      when True =>
        Item3 : Boolean;
        Item4 : String (1 .. 10);
      end case;
  end record;

  package Record_Conversions is
    new System.Address_To_Access_Conversions (Object => A_Record);

  My_Object : aliased A_Record := (Variant => True,
                                   Item1 => Integer'Last,
                                   Item3 => True,
                                   Item4 => "0123456789");

  type A_String is new String (1 .. My_Object'Size / 8);

  package String_Conversions is
    new System.Address_To_Access_Conversions (Object => A_String);

  package My_Conversions is
    new Unchecked_Accessors (Object1 => A_Record,
                             Object1_Pointer =>
Record_Conversions.Object_Pointer,
                             To_Object1_Pointer =>
Record_Conversions.To_Pointer,
                             To_Object1_Address =>
Record_Conversions.To_Address,

                             Object2 => A_String,
                             Object2_Pointer =>
String_Conversions.Object_Pointer,
                             To_Object2_Pointer =>
String_Conversions.To_Pointer,
                             To_Object2_Address =>
String_Conversions.To_Address);


  My_String_Access : String_Conversions.Object_Pointer;

begin
  My_String_Access := My_Conversions.To_Object2_Pointer (Obj1_Ptr =>
My_Object'Access);
  Put_Line (String (My_String_Access.all));
end Test_Unchecked_Access_Conversion;


Assempler for Unchecked_Accessors:
 .file "unchecked_accessors.adb"
gcc2_compiled.:
___gnu_compiled_ada:
.stabs "W:/Personal/Ada/Utilities/",100,0,0,Ltext0
.stabs "w:/personal/ada/utilit~1/unchecked_accessors.adb",100,0,0,Ltext0
.text
Ltext0:
.stabs "long int:t(0,1)=r(0,1);-2147483648;2147483647;",128,0,0,0
.stabs "unsigned char:t(0,2)=@s8;r(0,2);0;255;",128,0,0,0
.stabs "boolean___XDLU_0__1:t(0,3)=@s8;efalse:0,true:1,;",128,0,1,0
.stabs "character:t(0,4)=@s8;r(0,4);0;255;",128,0,1,0
.stabs "natural___XDLU_0__2147483647:t(0,5)=r(0,1);0;2147483647;",128,0,1,0
.stabs "access_character:t(0,6)=*(0,4)",128,0,1,0
.stabs "integer:t(0,7)=r(0,1);-2147483648;2147483647;",128,0,1,0
.stabs
"exception:T(0,8)=s20not_handled_by_others:(0,3),0,8;c1:(0,4),8,8;c2:(0,4),1
6,8;c3:(0,4),24,8;name_length:(0,5),32,32;full_name:(0,6),64,32;htable_ptr:(
0,6),96,32;import_code:(0,7),128,32;;",128,0,0,0
.stabs "exception:t(0,8)",128,0,1,0
.stabs "long_long_float:t(0,9)=r(0,1);12;0;",128,0,1,0
.globl _unchecked_accessors_E
.data
.stabs "unchecked_accessors_E:G(0,3)",32,0,13,0
_unchecked_accessors_E:
 .byte 0
.text
 .align 4
.stabs
"unchecked_accessors___elabb:F(0,10)=(0,10)",36,0,1,_unchecked_accessors___e
labb
.globl _unchecked_accessors___elabb
_unchecked_accessors___elabb:
.stabn 68,0,1,LM1-_unchecked_accessors___elabb
LM1:
 pushl %ebp
 movl %esp,%ebp
.stabn 68,0,1,LM2-_unchecked_accessors___elabb
LM2:
 movb $1,_unchecked_accessors_E
.stabn 68,0,1,LM3-_unchecked_accessors___elabb
LM3:
L1:
 movl %ebp,%esp
 popl %ebp
 ret
Lscope0:
.stabs "",36,0,0,Lscope0-_unchecked_accessors___elabb
 .text
 .stabs "",100,0,0,Letext
Letext:


Test Results:
?      ??0123456789