Ada miscompilation on mainline
Laurent GUERBY
guerby@acm.org
Fri May 9 23:18:00 GMT 2003
Hi Zack, it looks like the problem I reported
in <http://gcc.gnu.org/ml/gcc/2003-05/msg00609.html>
started to appear with the following patch:
2003-05-05 Zack Weinberg <zack@codesourcery.com>
* rtl.h (STRING_POOL_ADDRESS_P): Rename to DEFERRED_CONSTANT_P.
* varasm.c (struct varasm_status): Add deferred_constants field.
(n_deferred_strings): Delete variable.
(n_deferred_constants): New #define.
(struct constant_descriptor_tree): Kill next and label fields.
(const_hash_table, MAX_HASH_TABLE): Delete.
(const_desc_htab): New static variable.
(const_hash): Rename const_desc_hash, and make it fit the
hashtab.h interface.
(const_desc_eq): New.
(const_hash_1, compare_constant): Const-ify arguments.
(build_constant_desc): Set DEFERRED_CONSTANT_P on all new
SYMBOL_REFs. Clarify comments. Don't set desc->label.
(output_constant_def): Do the lookup/insert using the
hashtab.h interface. Don't muck with n_deferred_constants or
DEFERRED_CONSTANT_P here.
Always call maybe_output_constant_def_contents.
(maybe_output_constant_def_contents): Take a pointer to the
descriptor, not the EXP and RTL separately. Return
immediately if this constant is not deferred. Defer output of
everything, except writable string constants. Update
n_deferred_constants here.
(output_constant_def_contents): Now takes just one argument,
an rtx. Clear DEFERRED_CONSTANT_P here.
(mark_constant_pool): Update for rename of n_deferred_strings.
(mark_constant): Don't clear DEFERRED_CONSTANT_P here.
(init_varasm_status): Clear p->deferred_constants.
(init_varasm_once): Call htab_create_ggc for const_desc_htab.
Here is a somewhat reduced test case, when you compile it with inlining
it you get a link error. If I revert back this change it links.
This problem affects the RTS structure used for representing Ada tasks,
causing miscompilation of some RTS routines and all programs
with tasking fail to link.
I don't know what exactly causes the problem, but commenting out the
Exception_To_Raise component makes it disappear.
Hope this helps,
Laurent
$ gnatmake -O1 -gnatpn -f p
gcc -c -O1 -gnatpn p.adb
gcc -c -O1 -gnatpn q.ads
gnatbind -x p.ali
gnatlink p.ali
./p.o(.text+0x55): In function `_ada_p':
: undefined reference to `.LC0'
collect2: ld returned 1 exit status
gnatlink: cannot call /home/guerby/work/gcc/install/install-20030508T002445/bin/gcc
gnatmake: *** link failed.
$ gcc -S -O1 -gnatpn p.adb
$ cat p.s
.file "p.adb"
.text
.globl _ada_p
.type _ada_p, @function
_ada_p:
pushl %ebp
movl %esp, %ebp
pushl %edi
pushl %esi
pushl %ebx
subl $60, %esp
movl $1216, (%esp)
call __gnat_malloc
movl %eax, %ebx
movl $1, (%eax)
leal 4(%eax), %eax
movl $0, 4(%eax)
movl $0, 16(%eax)
movl $0, 24(%eax)
movl $0, 28(%eax)
movl $0, 32(%eax)
movl $0, 36(%eax)
movl $0, 44(%eax)
leal 56(%ebx), %eax
movl $.LC0, %edx
movl %eax, %esi
movl (%edx), %eax
movl %eax, -44(%ebp)
movl 4(%edx), %eax
movl %eax, -48(%ebp)
cmpl %eax, -44(%ebp)
jg .L61
movl -44(%ebp), %ecx
.L57:
movl %ecx, %edx
subl -44(%ebp), %edx
leal 0(,%edx,8), %eax
subl %edx, %eax
leal (%esi,%eax,8), %eax
movl $0, (%eax)
movl $0, 12(%eax)
movl $0, 16(%eax)
movl $0, 20(%eax)
movl $0, 36(%eax)
movl $0, 44(%eax)
movl $-1, 48(%eax)
movb $0, 52(%eax)
movb $0, 53(%eax)
movb $0, 54(%eax)
cmpl -48(%ebp), %ecx
je .L61
incl %ecx
jmp .L57
.L61:
movl $0, 1124(%ebx)
movl $0, 1128(%ebx)
movl $0, 1132(%ebx)
movl $0, 1148(%ebx)
movl $0, 1152(%ebx)
movb $0, 1156(%ebx)
movb $0, 1157(%ebx)
movb $1, 1158(%ebx)
movb $0, 1159(%ebx)
movb $0, 1160(%ebx)
movb $0, 1161(%ebx)
movb $0, 1162(%ebx)
movb $0, 1163(%ebx)
movl $1, 1164(%ebx)
movl $1, 1168(%ebx)
movl $20, 1172(%ebx)
movl $-1, 1184(%ebx)
movl $0, 1188(%ebx)
movb $0, 1200(%ebx)
movl $0, 1204(%ebx)
leal 1208(%ebx), %eax
movl $1, -40(%ebp)
movl (%ebx), %ecx
movl %ecx, -36(%ebp)
leal -40(%ebp), %edx
movl %eax, %esi
movl (%edx), %eax
movl %eax, -52(%ebp)
movl 4(%edx), %eax
movl %eax, -56(%ebp)
cmpl %eax, -52(%ebp)
jg .L49
movl -52(%ebp), %ebx
.L67:
movl %ebx, %ecx
subl -52(%ebp), %ecx
movl $0, %eax
movl $0, %edx
movl %eax, (%esi,%ecx,8)
movl %edx, 4(%esi,%ecx,8)
cmpl -56(%ebp), %ebx
je .L49
incl %ebx
jmp .L67
.L49:
addl $60, %esp
popl %ebx
popl %esi
popl %edi
popl %ebp
ret
.size _ada_p, .-_ada_p
.ident "GCC: (GNU) 3.4 20030507 (experimental)"
$ cat q.ads
with System;
with Ada.Exceptions;
package Q is
type Ada_Task_Control_Block;
type Task_ID is access all Ada_Task_Control_Block;
type Task_States is
(Unactivated,
Runnable,
Terminated,
Activator_Sleep,
Acceptor_Sleep,
Entry_Caller_Sleep,
Async_Select_Sleep,
Delay_Sleep,
Master_Completion_Sleep,
Master_Phase_2_Sleep,
Interrupt_Server_Idle_Sleep,
Interrupt_Server_Blocked_Interrupt_Sleep,
Timer_Server_Sleep,
AST_Server_Sleep,
Asynchronous_Hold,
Interrupt_Server_Blocked_On_Event_Flag
);
type Call_Modes is
(Simple_Call, Conditional_Call, Asynchronous_Call, Timed_Call);
type Select_Modes is (Simple_Mode, Else_Mode, Terminate_Mode, Delay_Mode);
subtype Delay_Modes is Integer;
type Entry_Call_State is
(Never_Abortable,
Not_Yet_Abortable,
Was_Abortable,
Now_Abortable,
Done,
Cancelled
);
Max_ATC_Nesting : constant Natural := 20;
subtype ATC_Level_Base is Integer range 0 .. Max_ATC_Nesting;
ATC_Level_Infinity : constant ATC_Level_Base := ATC_Level_Base'Last;
subtype ATC_Level is ATC_Level_Base range 0 .. ATC_Level_Base'Last - 1;
subtype ATC_Level_Index is ATC_Level range 1 .. ATC_Level'Last;
Null_Entry : constant := 0;
Max_Entry : constant := Integer'Last;
Interrupt_Entry : constant := -2;
Cancelled_Entry : constant := -1;
type Entry_Index is range Interrupt_Entry .. Max_Entry;
Null_Task_Entry : constant := Null_Entry;
Max_Task_Entry : constant := Max_Entry;
type Task_Entry_Index is new Entry_Index
range Null_Task_Entry .. Max_Task_Entry;
type Access_Address is access all System.Address;
Unspecified_Priority : constant Integer := System.Priority'First - 1;
Priority_Not_Boosted : constant Integer := System.Priority'First - 1;
subtype Rendezvous_Priority is Integer
range Priority_Not_Boosted .. System.Any_Priority'Last;
No_Rendezvous : constant := 0;
Max_Select : constant Integer := Integer'Last;
subtype Select_Index is Integer range No_Rendezvous .. Max_Select;
subtype Positive_Select_Index is
Select_Index range 1 .. Select_Index'Last;
type Accept_Alternative is record
Null_Body : Boolean;
S : Task_Entry_Index;
end record;
type Accept_List is
array (Positive_Select_Index range <>) of Accept_Alternative;
type Accept_List_Access is access constant Accept_List;
type Entry_Call_Record;
type Entry_Call_Link is access all Entry_Call_Record;
type Entry_Queue is record
Head : Entry_Call_Link;
Tail : Entry_Call_Link;
end record;
type Task_Entry_Queue_Array is
array (Task_Entry_Index range <>) of Entry_Queue;
type Entry_Call_Record is record
Self : Task_ID;
Mode : Call_Modes;
State : Entry_Call_State;
pragma Atomic (State);
Uninterpreted_Data : System.Address;
Exception_To_Raise : Ada.Exceptions.Exception_Id;
Prev : Entry_Call_Link;
Next : Entry_Call_Link;
Level : ATC_Level;
E : Entry_Index;
Prio : System.Any_Priority;
Called_Task : Task_ID;
pragma Atomic (Called_Task);
Called_PO : System.Address;
pragma Atomic (Called_PO);
Acceptor_Prev_Call : Entry_Call_Link;
Acceptor_Prev_Priority : Rendezvous_Priority := Priority_Not_Boosted;
Cancellation_Attempted : Boolean := False;
pragma Atomic (Cancellation_Attempted);
Requeue_With_Abort : Boolean := False;
Needs_Requeue : Boolean := False;
end record;
type Entry_Call_Array is array (ATC_Level_Index) of
aliased Entry_Call_Record;
type Activation_Chain is limited private;
type Activation_Chain_Access is access all Activation_Chain;
type Task_Procedure_Access is access procedure (Arg : System.Address);
type Access_Boolean is access all Boolean;
type Common_ATCB is record
State : Task_States;
pragma Atomic (State);
Parent : Task_ID;
Base_Priority : System.Any_Priority;
Current_Priority : System.Any_Priority;
Call : Entry_Call_Link;
Task_Arg : System.Address;
Task_Entry_Point : Task_Procedure_Access;
All_Tasks_Link : Task_ID;
Activation_Link : Task_ID;
Activator : Task_ID;
Wait_Count : Integer;
Elaborated : Access_Boolean;
Activation_Failed : Boolean;
end record;
D_I_Count : constant := 2;
subtype Direct_Index is Integer range 0 .. D_I_Count - 1;
type Direct_Attribute_Array is
array (Direct_Index) of aliased System.Address;
type Direct_Index_Vector is mod 2 ** D_I_Count;
type Task_Serial_Number is mod 2 ** 64;
subtype Master_Level is Integer;
subtype Master_ID is Master_Level;
type Ada_Task_Control_Block (Entry_Num : Task_Entry_Index) is record
Common : Common_ATCB;
Entry_Calls : Entry_Call_Array;
New_Base_Priority : System.Any_Priority;
Global_Task_Lock_Nesting : Natural := 0;
Open_Accepts : Accept_List_Access;
Chosen_Index : Select_Index;
Master_of_Task : Master_Level;
Master_Within : Master_Level;
Alive_Count : Integer := 0;
Awake_Count : Integer := 0;
Aborting : Boolean := False;
pragma Atomic (Aborting);
ATC_Hack : Boolean := False;
pragma Atomic (ATC_Hack);
Callable : Boolean := True;
Dependents_Aborted : Boolean := False;
Interrupt_Entry : Boolean := False;
Pending_Action : Boolean := False;
Pending_Priority_Change : Boolean := False;
Terminate_Alternative : Boolean := False;
ATC_Nesting_Level : ATC_Level := 1;
Deferral_Level : Natural := 1;
Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
Serial_Number : Task_Serial_Number;
Known_Tasks_Index : Integer := -1;
User_State : Integer := 0;
Direct_Attributes : Direct_Attribute_Array;
Is_Defined : Direct_Index_Vector := 0;
Indirect_Attributes : Access_Address;
Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
end record;
pragma Volatile (Ada_Task_Control_Block);
private
Null_Task : constant Task_ID := null;
type Activation_Chain is record
T_ID : Task_ID;
end record;
pragma Volatile (Activation_Chain);
end Q;
$ cat p.adb
with Q; use Q;
procedure P is
Entry_Num : Task_Entry_Index := 1;
XX : Task_Id := new Ada_Task_Control_Block (Entry_num);
begin
null;
end P;
More information about the Gcc
mailing list