Conference turris::ada

3872.0. "%ADA-F-PROGRAM_ERROR with a label" by CSC32::V_HAVER () Thu May 15 1997 20:39

The following code produces a program_error at run time.

The code fails if compiled with default optimization.  But will run ok if
compiled /debug/noopt or /noopt.  Haven't had time to test all the other
combinations of optimization.

Code also works if the label is removed.

We reproduced the errors on OpenVMS Alpha V7.0, Ada V3.3-23.

The following code includes the customer's comments.


------------------------------------------------
with System, Condition_Handling, OTS, LIB, Text_IO;
procedure Test_Raise is

  STATUS : Condition_Handling.Cond_value_Type;
  LOCAL_EXCEPTION : exception;
  MAX_STR_LEN : constant := 40;

  ERROR_MSG  : String (1 .. MAX_STR_LEN) := (others => '$');
  PARAM1_MSG : String (1 .. MAX_STR_LEN) := (others => '#');
  LOC_STRING : String (1 .. MAX_STR_LEN) := (others => 'x');
  OUT_STRING : String (1 .. MAX_STR_LEN) := (others => '?');
  subtype Constrained_Type is integer range 0 .. 1000;
  L0   : Constrained_Type := Constrained_Type'first;
  INT1 : Constrained_Type := Constrained_Type'first;

-- At offset 0034, the compiler generates "LDQ R3, 64(R27)01 to initialize R3
-- to point to Condition Handling.

begin -- Test_Raise
-- NOTE!!! Commenting out the label below is an undesirable work-around.
-- The label is used on VAX systems as a way to set a DEBUG breakpoint.
-- The Alpha compiler doesn't generate an entry in the symbol table for these
-- labels, so they are useless on Alpha platforms.
-- NOTE!!! Compiling by: $ ADA/DEBUG/NOOPT TEST_RAISE.ADA" is a work-around
-- that degrades performance.
  <<LABEL_1>>
  L0 := INT1 * 0;

  OTS.CVT_L_TI (
		STATUS => STATUS,
                VARYING_INPUT_VALUE => system.Unsigned_Longword(L0),
                FIXED_LENGTH_RESULTANT_STRING => out_STRING);

-- At offset 02F4, the compiler generates "LDQ Ri, 152(R3)" for the test for
-- elaboration of Condition_Handling.Success.
   if Condition_Handling.Success (STATUS) then
		Text_IO.Put_Line(PARAM1_MSG);
                LOC_STRING := OUT_STRING;
   else
		Text_IO.Put("CVT_L_TI was unsuccessful.");
   end if;

   LIB.SHOW_VM (STATUS => STATUS);

-- At offset 0424, the compiler generates "LDQ R3, 152(R3)" for the test for
-- elaboration of Condition_Handling.Success; this destroys the value of R3.
-- R3 is further modified at offsets 450, 4BC, 4E4, 54C1 and 56C
   if Condition_Handling.Success (STATUS) then
		Text_IO.Put_Line(LOC_STRING);
		LOC_STRING := OUT_STRING;
   else
		Text_IO.Put("SHOW_VM was unsuccessful.");
   end if;

   INT1 := INT1 + INT1;

   if INT1 = L0 then
      PARAM1_MSG := ERROR_MSG;
      raise LOCAL_EXCEPTION;
   end if;

   exception
      when LOCAL_EXCEPTION =>
         OTS.CVT_L_TI (
               STATUS => STATUS,
               VARYING_INPUT_VALUE => System.Unsigned_Longword(L0),
	       FIXED_LENGTH_RESULTANT_STRING => OUT_STRING);

-- At offset 019C, the compiler generates "LDQ Ri, 152(R3)" for the test for
-- elaboration of Condition_Handling.Success.  But since R3 is no longer
-- valid, the value loaded into Rl does not have the low bit set and so this
-- is interpreted as indicating that Condition_Handling.Success is not
-- elaborated and so a PROGRAM_ERROR is generated.
-- During the refinement of this test case, sometimes the value in R3 has been
-- such that the above instruction at offset 019C generates an access violation.
       if Condition_Handling.Success (STATUS) then
          Text_IO.Put_Line(PARAM1_MSG);
          LOC_STRING := OUT_STRING; 
       else
	  Text_IO.Put("CVT L TI was unsuccessful.");
       end if;
end Test_Raise;


> run test_raise
########################################
 9 calls to LIB$GET_VM, 0 calls to LIB$FREE_VM, 2552 bytes still allocated
                                       0
%ADA-F-PROGRAM_ERROR, PROGRAM_ERROR
-ADA-I-EXCRAIPRI, Exception raised prior to PC = 000337DC

$  %TRACE-E-TRACEBACK, symbolic stack dump follows
  image    module    routine             line      rel PC           abs PC
 ADARTL                                     0 0000000000054BB4 000000000032ABB4
                                            0 FFFFFFFF804A7D94 FFFFFFFF804A7D94
----- above condition handler called with exception 00318964:
%ADA-F-PROGRAM_ERROR, PROGRAM_ERROR
-ADA-I-EXCRAIPRI, Exception raised prior to PC = 000337DC
----- end of exception message
                                            0 FFFFFFFF81EEA59C FFFFFFFF81EEA59C
 ADARTL                                     0 000000000003793C 000000000030D93C
 TEST_RAISE  TEST_RAISE  TEST_RAISE        79 00000000000001BC 00000000000337DC
 TEST_RAISE  ADA$ELAB_TEST_RAISE            0 0000000000020128 0000000000030128
 TEST_RAISE                                 0 0000000000023C64 0000000000033C64
                                            0 FFFFFFFF804441D4 FFFFFFFF804441D4
 TEST_RAISE  ADA$ELAB_TEST_RAISE            0 00000000000200E0 00000000000300E0
 ADARTL                                     0 0000000000054D38 000000000032AD38
 ADARTL                                     0 00000000000544B4 000000000032A4B4
 ADARTL                                     0 000000000003F3F0 00000000003153F0
 TEST_RAISE  ADA$ELAB_TEST_RAISE            0 000000000002005C 000000000003005C
 TEST_RAISE                                 0 0000000000023C64 0000000000033C64
 PTHREAD$RTL                                0 000000000003733C 000000000043133C
 PTHREAD$RTL                                0 00000000000385FC 00000000004325FC
                                            0 FFFFFFFF81FE6914 FFFFFFFF81FE6914

Hi, from your description, this sounds like a probable GEM common
code generation issue, that the label is changing global optimizations.

Can you give me a priority on this case (suggestion/spr/cld)?

Charlie

The customer's workarounds at this point are compile /noopt or removing the
label.  Evidentally, these aren't acceptable for his production 
environment.  They don't want to have to remove the labels from their Ada
code because they use the same source for Alpha and VAX, and on the VAX they
can use the labels in debugging.  Also, labels are used extensively in their
application.  Using /noopt in production would negatively affect performance.  
We will be submitting an IPMT case.

This is the same customer, GDE Systems, that received the special
V3.3-24 kit.  Which they have installed, by the way.  It did require that they
install V3.3-23 first, as the adacld.cld is not supplied with 
V3.3-24.

>We will be submitting an IPMT case.

What level?  I always like 3.  I like to know if 1 or 2 beforehand.  ;-)

Charlie

S

I can get the problem to go away by inserting a stub for a null procedure at the
end of the declarative region.  You don't actually have to *call* the
stubbed-out procedure, just have it there.  Like this:

with System, Condition_Handling, OTS, LIB, Text_IO;
procedure Test_Raise is

  STATUS : Condition_Handling.Cond_value_Type;
  LOCAL_EXCEPTION : exception;
  MAX_STR_LEN : constant := 40;

  ERROR_MSG  : String (1 .. MAX_STR_LEN) := (others => '$');
  PARAM1_MSG : String (1 .. MAX_STR_LEN) := (others => '#');
  LOC_STRING : String (1 .. MAX_STR_LEN) := (others => 'x');
  OUT_STRING : String (1 .. MAX_STR_LEN) := (others => '?');
  subtype Constrained_Type is integer range 0 .. 1000;
  L0   : Constrained_Type := Constrained_Type'first;
  INT1 : Constrained_Type := Constrained_Type'first;
  procedure Do_Nothing is separate;--***NEW*** and see body below
begin
  
-- NOTE.  Commenting out the label below allows the program to work.
  <<LABEL_1>>
  L0 := INT1 * 0;

  OTS.CVT_L_TI (
		STATUS => STATUS,
                VARYING_INPUT_VALUE => system.Unsigned_Longword(L0),
                FIXED_LENGTH_RESULTANT_STRING => out_STRING);

   if Condition_Handling.Success (STATUS) then
		Text_IO.Put_Line(PARAM1_MSG);
                LOC_STRING := OUT_STRING;
   else
		Text_IO.Put("CVT_L_TI was unsuccessful.");
   end if;

   LIB.SHOW_VM (STATUS => STATUS);

   if Condition_Handling.Success (STATUS) then
		Text_IO.Put_Line(LOC_STRING);
		LOC_STRING := OUT_STRING;
   else
		Text_IO.Put("SHOW_VM was unsuccessful.");
   end if;

   INT1 := INT1 + INT1;

   if INT1 = L0 then
      PARAM1_MSG := ERROR_MSG;
      raise LOCAL_EXCEPTION;
   end if;

   exception
      when LOCAL_EXCEPTION =>
         OTS.CVT_L_TI (
               STATUS => STATUS,
               VARYING_INPUT_VALUE => System.Unsigned_Longword(L0),
	       FIXED_LENGTH_RESULTANT_STRING => OUT_STRING);

       if Condition_Handling.Success (STATUS) then
          Text_IO.Put_Line(PARAM1_MSG);
          LOC_STRING := OUT_STRING;
       else
	  Text_IO.Put("CVT L TI was unsuccessful.");
       end if;
end Test_Raise;

separate(Test_Raise)--***NEW***
procedure Do_Nothing is
begin null; end;

I can also make the problem go away by compiling this way:

$ ada test_raise /opt=(devel,inline:normal,share:normal)

This should be noticeably better than /opt=none.