[Ada] Add ada-tasks.c:iterate_over_live_ada_tasks
[external/binutils.git] / gdb / ada-tasks.c
1 /* Copyright (C) 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005,
2    2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3
4    This file is part of GDB.
5
6    This program is free software; you can redistribute it and/or modify
7    it under the terms of the GNU General Public License as published by
8    the Free Software Foundation; either version 3 of the License, or
9    (at your option) any later version.
10
11    This program is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14    GNU General Public License for more details.
15
16    You should have received a copy of the GNU General Public License
17    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
18
19 #include "defs.h"
20 #include "observer.h"
21 #include "gdbcmd.h"
22 #include "target.h"
23 #include "ada-lang.h"
24 #include "gdbcore.h"
25 #include "inferior.h"
26 #include "gdbthread.h"
27
28 /* The name of the array in the GNAT runtime where the Ada Task Control
29    Block of each task is stored.  */
30 #define KNOWN_TASKS_NAME "system__tasking__debug__known_tasks"
31
32 /* The maximum number of tasks known to the Ada runtime */
33 static const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
34
35 enum task_states
36 {
37   Unactivated,
38   Runnable,
39   Terminated,
40   Activator_Sleep,
41   Acceptor_Sleep,
42   Entry_Caller_Sleep,
43   Async_Select_Sleep,
44   Delay_Sleep,
45   Master_Completion_Sleep,
46   Master_Phase_2_Sleep,
47   Interrupt_Server_Idle_Sleep,
48   Interrupt_Server_Blocked_Interrupt_Sleep,
49   Timer_Server_Sleep,
50   AST_Server_Sleep,
51   Asynchronous_Hold,
52   Interrupt_Server_Blocked_On_Event_Flag,
53   Activating,
54   Acceptor_Delay_Sleep
55 };
56
57 /* A short description corresponding to each possible task state.  */
58 static const char *task_states[] = {
59   N_("Unactivated"),
60   N_("Runnable"),
61   N_("Terminated"),
62   N_("Child Activation Wait"),
63   N_("Accept or Select Term"),
64   N_("Waiting on entry call"),
65   N_("Async Select Wait"),
66   N_("Delay Sleep"),
67   N_("Child Termination Wait"),
68   N_("Wait Child in Term Alt"),
69   "",
70   "",
71   "",
72   "",
73   N_("Asynchronous Hold"),
74   "",
75   N_("Activating"),
76   N_("Selective Wait")
77 };
78
79 /* A longer description corresponding to each possible task state.  */
80 static const char *long_task_states[] = {
81   N_("Unactivated"),
82   N_("Runnable"),
83   N_("Terminated"),
84   N_("Waiting for child activation"),
85   N_("Blocked in accept or select with terminate"),
86   N_("Waiting on entry call"),
87   N_("Asynchronous Selective Wait"),
88   N_("Delay Sleep"),
89   N_("Waiting for children termination"),
90   N_("Waiting for children in terminate alternative"),
91   "",
92   "",
93   "",
94   "",
95   N_("Asynchronous Hold"),
96   "",
97   N_("Activating"),
98   N_("Blocked in selective wait statement")
99 };
100
101 /* The index of certain important fields in the Ada Task Control Block
102    record and sub-records.  */
103
104 struct tcb_fieldnos
105 {
106   /* Fields in record Ada_Task_Control_Block.  */
107   int common;
108   int entry_calls;
109   int atc_nesting_level;
110
111   /* Fields in record Common_ATCB.  */
112   int state;
113   int parent;
114   int priority;
115   int image;
116   int image_len;     /* This field may be missing.  */
117   int call;
118   int ll;
119
120   /* Fields in Task_Primitives.Private_Data.  */
121   int ll_thread;
122   int ll_lwp;        /* This field may be missing.  */
123
124   /* Fields in Common_ATCB.Call.all.  */
125   int call_self;
126 };
127
128 /* The type description for the ATCB record and subrecords, and
129    the associated tcb_fieldnos. For efficiency reasons, these are made
130    static globals so that we can compute them only once the first time
131    and reuse them later.  Set to NULL if the types haven't been computed
132    yet, or if they may be obsolete (for instance after having loaded
133    a new binary).  */
134
135 static struct type *atcb_type = NULL;
136 static struct type *atcb_common_type = NULL;
137 static struct type *atcb_ll_type = NULL;
138 static struct type *atcb_call_type = NULL;
139 static struct tcb_fieldnos fieldno;
140
141 /* Set to 1 when the cached address of System.Tasking.Debug.Known_Tasks
142    might be stale and so needs to be recomputed.  */
143 static int ada_tasks_check_symbol_table = 1;
144
145 /* The list of Ada tasks.
146  
147    Note: To each task we associate a number that the user can use to
148    reference it - this number is printed beside each task in the tasks
149    info listing displayed by "info tasks".  This number is equal to
150    its index in the vector + 1.  Reciprocally, to compute the index
151    of a task in the vector, we need to substract 1 from its number.  */
152 typedef struct ada_task_info ada_task_info_s;
153 DEF_VEC_O(ada_task_info_s);
154 static VEC(ada_task_info_s) *task_list = NULL;
155
156 /* When non-zero, this flag indicates that the current task_list
157    is obsolete, and should be recomputed before it is accessed.  */
158 static int stale_task_list_p = 1;
159
160 /* Return the task number of the task whose ptid is PTID, or zero
161    if the task could not be found.  */
162
163 int
164 ada_get_task_number (ptid_t ptid)
165 {
166   int i;
167
168   for (i=0; i < VEC_length (ada_task_info_s, task_list); i++)
169     if (ptid_equal (VEC_index (ada_task_info_s, task_list, i)->ptid, ptid))
170       return i + 1;
171
172   return 0;  /* No matching task found.  */
173 }
174
175 /* Return the task number of the task that matches TASK_ID, or zero
176    if the task could not be found.  */
177  
178 static int
179 get_task_number_from_id (CORE_ADDR task_id)
180 {
181   int i;
182
183   for (i = 0; i < VEC_length (ada_task_info_s, task_list); i++)
184     {
185       struct ada_task_info *task_info =
186         VEC_index (ada_task_info_s, task_list, i);
187
188       if (task_info->task_id == task_id)
189         return i + 1;
190     }
191
192   /* Task not found.  Return 0.  */
193   return 0;
194 }
195
196 /* Return non-zero if TASK_NUM is a valid task number.  */
197
198 int
199 valid_task_id (int task_num)
200 {
201   ada_build_task_list (0);
202   return (task_num > 0
203           && task_num <= VEC_length (ada_task_info_s, task_list));
204 }
205
206 /* Return non-zero iff the task STATE corresponds to a non-terminated
207    task state.  */
208
209 static int
210 ada_task_is_alive (struct ada_task_info *task_info)
211 {
212   return (task_info->state != Terminated);
213 }
214
215 /* Call the ITERATOR function once for each Ada task that hasn't been
216    terminated yet.  */
217
218 void
219 iterate_over_live_ada_tasks (ada_task_list_iterator_ftype *iterator)
220 {
221   int i, nb_tasks;
222   struct ada_task_info *task;
223
224   ada_build_task_list (0);
225   nb_tasks = VEC_length (ada_task_info_s, task_list);
226
227   for (i = 0; i < nb_tasks; i++)
228     {
229       task = VEC_index (ada_task_info_s, task_list, i);
230       if (!ada_task_is_alive (task))
231         continue;
232       iterator (task);
233     }
234 }
235
236 /* Extract the contents of the value as a string whose length is LENGTH,
237    and store the result in DEST.  */
238
239 static void
240 value_as_string (char *dest, struct value *val, int length)
241 {
242   memcpy (dest, value_contents (val), length);
243   dest[length] = '\0';
244 }
245
246 /* Extract the string image from the fat string corresponding to VAL,
247    and store it in DEST.  If the string length is greater than MAX_LEN,
248    then truncate the result to the first MAX_LEN characters of the fat
249    string.  */
250
251 static void
252 read_fat_string_value (char *dest, struct value *val, int max_len)
253 {
254   struct value *array_val;
255   struct value *bounds_val;
256   int len;
257
258   /* The following variables are made static to avoid recomputing them
259      each time this function is called.  */
260   static int initialize_fieldnos = 1;
261   static int array_fieldno;
262   static int bounds_fieldno;
263   static int upper_bound_fieldno;
264
265   /* Get the index of the fields that we will need to read in order
266      to extract the string from the fat string.  */
267   if (initialize_fieldnos)
268     {
269       struct type *type = value_type (val);
270       struct type *bounds_type;
271
272       array_fieldno = ada_get_field_index (type, "P_ARRAY", 0);
273       bounds_fieldno = ada_get_field_index (type, "P_BOUNDS", 0);
274
275       bounds_type = TYPE_FIELD_TYPE (type, bounds_fieldno);
276       if (TYPE_CODE (bounds_type) == TYPE_CODE_PTR)
277         bounds_type = TYPE_TARGET_TYPE (bounds_type);
278       if (TYPE_CODE (bounds_type) != TYPE_CODE_STRUCT)
279         error (_("Unknown task name format. Aborting"));
280       upper_bound_fieldno = ada_get_field_index (bounds_type, "UB0", 0);
281
282       initialize_fieldnos = 0;
283     }
284
285   /* Get the size of the task image by checking the value of the bounds.
286      The lower bound is always 1, so we only need to read the upper bound.  */
287   bounds_val = value_ind (value_field (val, bounds_fieldno));
288   len = value_as_long (value_field (bounds_val, upper_bound_fieldno));
289
290   /* Make sure that we do not read more than max_len characters...  */
291   if (len > max_len)
292     len = max_len;
293
294   /* Extract LEN characters from the fat string.  */
295   array_val = value_ind (value_field (val, array_fieldno));
296   read_memory (value_address (array_val), dest, len);
297
298   /* Add the NUL character to close the string.  */
299   dest[len] = '\0';
300 }
301
302 /* Return the address of the Known_Tasks array maintained in
303    the Ada Runtime.  Return NULL if the array could not be found,
304    meaning that the inferior program probably does not use tasking.
305
306    In order to provide a fast response time, this function caches
307    the Known_Tasks array address after the lookup during the first
308    call. Subsequent calls will simply return this cached address.  */
309
310 static CORE_ADDR
311 get_known_tasks_addr (void)
312 {
313   static CORE_ADDR known_tasks_addr = 0;
314
315   if (ada_tasks_check_symbol_table)
316     {
317       struct minimal_symbol *msym;
318
319       msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
320       if (msym != NULL)
321         known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
322       else
323         {
324           if (target_lookup_symbol (KNOWN_TASKS_NAME, &known_tasks_addr) != 0)
325             return 0;
326         }
327
328       /* FIXME: brobecker 2003-03-05: Here would be a much better place
329          to attach the ada-tasks observers, instead of doing this
330          unconditionaly in _initialize_tasks. This would avoid an
331          unecessary notification when the inferior does not use tasking
332          or as long as the user does not use the ada-tasks commands.
333          Unfortunately, this is not possible for the moment: the current
334          code resets ada__tasks_check_symbol_table back to 1 whenever
335          symbols for a new program are being loaded. If we place the
336          observers intialization here, we will end up adding new observers
337          everytime we do the check for Ada tasking-related symbols
338          above. This would currently have benign effects, but is still
339          undesirable. The cleanest approach is probably to create a new
340          observer to notify us when the user is debugging a new program.
341          We would then reset ada__tasks_check_symbol_table back to 1
342          during the notification, but also detach all observers.
343          BTW: observers are probably not reentrant, so detaching during
344          a notification may not be the safest thing to do... Sigh...
345          But creating the new observer would be a good idea in any case,
346          since this allow us to make ada__tasks_check_symbol_table
347          static, which is a good bonus.  */
348       ada_tasks_check_symbol_table = 0;
349     }
350
351   return known_tasks_addr;
352 }
353
354 /* Get from the debugging information the type description of all types
355    related to the Ada Task Control Block that will be needed in order to
356    read the list of known tasks in the Ada runtime.  Also return the
357    associated ATCB_FIELDNOS.
358
359    Error handling:  Any data missing from the debugging info will cause
360    an error to be raised, and none of the return values to be set.
361    Users of this function can depend on the fact that all or none of the
362    return values will be set.  */
363
364 static void
365 get_tcb_types_info (struct type **atcb_type,
366                     struct type **atcb_common_type,
367                     struct type **atcb_ll_type,
368                     struct type **atcb_call_type,
369                     struct tcb_fieldnos *atcb_fieldnos)
370 {
371   struct type *type;
372   struct type *common_type;
373   struct type *ll_type;
374   struct type *call_type;
375   struct tcb_fieldnos fieldnos;
376
377   const char *atcb_name = "system__tasking__ada_task_control_block___XVE";
378   const char *atcb_name_fixed = "system__tasking__ada_task_control_block";
379   const char *common_atcb_name = "system__tasking__common_atcb";
380   const char *private_data_name = "system__task_primitives__private_data";
381   const char *entry_call_record_name = "system__tasking__entry_call_record";
382
383   struct symbol *atcb_sym =
384     lookup_symbol (atcb_name, NULL, VAR_DOMAIN, NULL);
385   const struct symbol *common_atcb_sym =
386     lookup_symbol (common_atcb_name, NULL, VAR_DOMAIN, NULL);
387   const struct symbol *private_data_sym =
388     lookup_symbol (private_data_name, NULL, VAR_DOMAIN, NULL);
389   const struct symbol *entry_call_record_sym =
390     lookup_symbol (entry_call_record_name, NULL, VAR_DOMAIN, NULL);
391
392   if (atcb_sym == NULL || atcb_sym->type == NULL)
393     {
394       /* In Ravenscar run-time libs, the  ATCB does not have a dynamic
395          size, so the symbol name differs.  */
396       atcb_sym = lookup_symbol (atcb_name_fixed, NULL, VAR_DOMAIN, NULL);
397
398       if (atcb_sym == NULL || atcb_sym->type == NULL)
399         error (_("Cannot find Ada_Task_Control_Block type. Aborting"));
400
401       type = atcb_sym->type;
402     }
403   else
404     {
405       /* Get a static representation of the type record
406          Ada_Task_Control_Block.  */
407       type = atcb_sym->type;
408       type = ada_template_to_fixed_record_type_1 (type, NULL, 0, NULL, 0);
409     }
410
411   if (common_atcb_sym == NULL || common_atcb_sym->type == NULL)
412     error (_("Cannot find Common_ATCB type. Aborting"));
413   if (private_data_sym == NULL || private_data_sym->type == NULL)
414     error (_("Cannot find Private_Data type. Aborting"));
415   if (entry_call_record_sym == NULL || entry_call_record_sym->type == NULL)
416     error (_("Cannot find Entry_Call_Record type. Aborting"));
417
418   /* Get the type for Ada_Task_Control_Block.Common.  */
419   common_type = common_atcb_sym->type;
420
421   /* Get the type for Ada_Task_Control_Bloc.Common.Call.LL.  */
422   ll_type = private_data_sym->type;
423
424   /* Get the type for Common_ATCB.Call.all.  */
425   call_type = entry_call_record_sym->type;
426
427   /* Get the field indices.  */
428   fieldnos.common = ada_get_field_index (type, "common", 0);
429   fieldnos.entry_calls = ada_get_field_index (type, "entry_calls", 1);
430   fieldnos.atc_nesting_level =
431     ada_get_field_index (type, "atc_nesting_level", 1);
432   fieldnos.state = ada_get_field_index (common_type, "state", 0);
433   fieldnos.parent = ada_get_field_index (common_type, "parent", 1);
434   fieldnos.priority = ada_get_field_index (common_type, "base_priority", 0);
435   fieldnos.image = ada_get_field_index (common_type, "task_image", 1);
436   fieldnos.image_len = ada_get_field_index (common_type, "task_image_len", 1);
437   fieldnos.call = ada_get_field_index (common_type, "call", 1);
438   fieldnos.ll = ada_get_field_index (common_type, "ll", 0);
439   fieldnos.ll_thread = ada_get_field_index (ll_type, "thread", 0);
440   fieldnos.ll_lwp = ada_get_field_index (ll_type, "lwp", 1);
441   fieldnos.call_self = ada_get_field_index (call_type, "self", 0);
442
443   /* On certain platforms such as x86-windows, the "lwp" field has been
444      named "thread_id".  This field will likely be renamed in the future,
445      but we need to support both possibilities to avoid an unnecessary
446      dependency on a recent compiler.  We therefore try locating the
447      "thread_id" field in place of the "lwp" field if we did not find
448      the latter.  */
449   if (fieldnos.ll_lwp < 0)
450     fieldnos.ll_lwp = ada_get_field_index (ll_type, "thread_id", 1);
451
452   /* Set all the out parameters all at once, now that we are certain
453      that there are no potential error() anymore.  */
454   *atcb_type = type;
455   *atcb_common_type = common_type;
456   *atcb_ll_type = ll_type;
457   *atcb_call_type = call_type;
458   *atcb_fieldnos = fieldnos;
459 }
460
461 /* Build the PTID of the task from its COMMON_VALUE, which is the "Common"
462    component of its ATCB record.  This PTID needs to match the PTID used
463    by the thread layer.  */
464
465 static ptid_t
466 ptid_from_atcb_common (struct value *common_value)
467 {
468   long thread = 0;
469   CORE_ADDR lwp = 0;
470   struct value *ll_value;
471   ptid_t ptid;
472
473   ll_value = value_field (common_value, fieldno.ll);
474
475   if (fieldno.ll_lwp >= 0)
476     lwp = value_as_address (value_field (ll_value, fieldno.ll_lwp));
477   thread = value_as_long (value_field (ll_value, fieldno.ll_thread));
478
479   ptid = target_get_ada_task_ptid (lwp, thread);
480
481   return ptid;
482 }
483
484 /* Read the ATCB data of a given task given its TASK_ID (which is in practice
485    the address of its assocated ATCB record), and store the result inside
486    TASK_INFO.  */
487
488 static void
489 read_atcb (CORE_ADDR task_id, struct ada_task_info *task_info)
490 {
491   struct value *tcb_value;
492   struct value *common_value;
493   struct value *atc_nesting_level_value;
494   struct value *entry_calls_value;
495   struct value *entry_calls_value_element;
496   int called_task_fieldno = -1;
497   const char ravenscar_task_name[] = "Ravenscar task";
498
499   if (atcb_type == NULL)
500     get_tcb_types_info (&atcb_type, &atcb_common_type, &atcb_ll_type,
501                         &atcb_call_type, &fieldno);
502
503   tcb_value = value_from_contents_and_address (atcb_type, NULL, task_id);
504   common_value = value_field (tcb_value, fieldno.common);
505
506   /* Fill in the task_id.  */
507
508   task_info->task_id = task_id;
509
510   /* Compute the name of the task.
511
512      Depending on the GNAT version used, the task image is either a fat
513      string, or a thin array of characters.  Older versions of GNAT used
514      to use fat strings, and therefore did not need an extra field in
515      the ATCB to store the string length. For efficiency reasons, newer
516      versions of GNAT replaced the fat string by a static buffer, but this
517      also required the addition of a new field named "Image_Len" containing
518      the length of the task name. The method used to extract the task name
519      is selected depending on the existence of this field.
520
521      In some run-time libs (e.g. Ravenscar), the name is not in the ATCB;
522      we may want to get it from the first user frame of the stack. For now,
523      we just give a dummy name.  */
524
525   if (fieldno.image_len == -1)
526     {
527       if (fieldno.image >= 0)
528         read_fat_string_value (task_info->name,
529                                value_field (common_value, fieldno.image),
530                                sizeof (task_info->name) - 1);
531       else
532         strcpy (task_info->name, ravenscar_task_name);
533     }
534   else
535     {
536       int len = value_as_long (value_field (common_value, fieldno.image_len));
537
538       value_as_string (task_info->name,
539                        value_field (common_value, fieldno.image), len);
540     }
541
542   /* Compute the task state and priority.  */
543
544   task_info->state = value_as_long (value_field (common_value, fieldno.state));
545   task_info->priority =
546     value_as_long (value_field (common_value, fieldno.priority));
547
548   /* If the ATCB contains some information about the parent task,
549      then compute it as well.  Otherwise, zero.  */
550
551   if (fieldno.parent >= 0)
552     task_info->parent =
553       value_as_address (value_field (common_value, fieldno.parent));
554   else
555     task_info->parent = 0;
556   
557
558   /* If the ATCB contains some information about entry calls, then
559      compute the "called_task" as well.  Otherwise, zero.  */
560
561   if (fieldno.atc_nesting_level > 0 && fieldno.entry_calls > 0) 
562     {
563       /* Let My_ATCB be the Ada task control block of a task calling the
564          entry of another task; then the Task_Id of the called task is
565          in My_ATCB.Entry_Calls (My_ATCB.ATC_Nesting_Level).Called_Task.  */
566       atc_nesting_level_value = value_field (tcb_value,
567                                              fieldno.atc_nesting_level);
568       entry_calls_value =
569         ada_coerce_to_simple_array_ptr (value_field (tcb_value,
570                                                      fieldno.entry_calls));
571       entry_calls_value_element =
572         value_subscript (entry_calls_value,
573                          value_as_long (atc_nesting_level_value));
574       called_task_fieldno =
575         ada_get_field_index (value_type (entry_calls_value_element),
576                              "called_task", 0);
577       task_info->called_task =
578         value_as_address (value_field (entry_calls_value_element,
579                                        called_task_fieldno));
580     }
581   else
582     {
583       task_info->called_task = 0;
584     }
585
586   /* If the ATCB cotnains some information about RV callers,
587      then compute the "caller_task".  Otherwise, zero.  */
588
589   task_info->caller_task = 0;
590   if (fieldno.call >= 0)
591     {
592       /* Get the ID of the caller task from Common_ATCB.Call.all.Self.
593          If Common_ATCB.Call is null, then there is no caller.  */
594       const CORE_ADDR call =
595         value_as_address (value_field (common_value, fieldno.call));
596       struct value *call_val;
597
598       if (call != 0)
599         {
600           call_val =
601             value_from_contents_and_address (atcb_call_type, NULL, call);
602           task_info->caller_task =
603             value_as_address (value_field (call_val, fieldno.call_self));
604         }
605     }
606
607   /* And finally, compute the task ptid.  Note that there are situations
608      where this cannot be determined:
609        - The task is no longer alive - the ptid is irrelevant;
610        - We are debugging a core file - the thread is not always
611          completely preserved for us to link back a task to its
612          underlying thread.  Since we do not support task switching
613          when debugging core files anyway, we don't need to compute
614          that task ptid.
615      In either case, we don't need that ptid, and it is just good enough
616      to set it to null_ptid.  */
617
618   if (target_has_execution && ada_task_is_alive (task_info))
619     task_info->ptid = ptid_from_atcb_common (common_value);
620   else
621     task_info->ptid = null_ptid;
622 }
623
624 /* Read the ATCB info of the given task (identified by TASK_ID), and
625    add the result to the TASK_LIST.  */
626
627 static void
628 add_ada_task (CORE_ADDR task_id)
629 {
630   struct ada_task_info task_info;
631
632   read_atcb (task_id, &task_info);
633   VEC_safe_push (ada_task_info_s, task_list, &task_info);
634 }
635
636 /* Read the Known_Tasks array from the inferior memory, and store
637    it in TASK_LIST.  Return non-zero upon success.  */
638
639 static int
640 read_known_tasks_array (void)
641 {
642   const int target_ptr_byte =
643     gdbarch_ptr_bit (target_gdbarch) / TARGET_CHAR_BIT;
644   const CORE_ADDR known_tasks_addr = get_known_tasks_addr ();
645   const int known_tasks_size = target_ptr_byte * MAX_NUMBER_OF_KNOWN_TASKS;
646   gdb_byte *known_tasks = alloca (known_tasks_size);
647   int i;
648
649   /* Step 1: Clear the current list, if necessary.  */
650   VEC_truncate (ada_task_info_s, task_list, 0);
651
652   /* If the application does not use task, then no more needs to be done.
653      It is important to have the task list cleared (see above) before we
654      return, as we don't want a stale task list to be used...  This can
655      happen for instance when debugging a non-multitasking program after
656      having debugged a multitasking one.  */
657   if (known_tasks_addr == 0)
658     return 0;
659
660   /* Step 2: Build a new list by reading the ATCBs from the Known_Tasks
661      array in the Ada runtime.  */
662   read_memory (known_tasks_addr, known_tasks, known_tasks_size);
663   for (i = 0; i < MAX_NUMBER_OF_KNOWN_TASKS; i++)
664     {
665       struct type *data_ptr_type =
666         builtin_type (target_gdbarch)->builtin_data_ptr;
667       CORE_ADDR task_id =
668         extract_typed_address (known_tasks + i * target_ptr_byte,
669                                data_ptr_type);
670
671       if (task_id != 0)
672         add_ada_task (task_id);
673     }
674
675   /* Step 3: Unset stale_task_list_p, to avoid re-reading the Known_Tasks
676      array unless needed.  Then report a success.  */
677   stale_task_list_p = 0;
678
679   return 1;
680 }
681
682 /* Builds the task_list by reading the Known_Tasks array from
683    the inferior.  Prints an appropriate message and returns non-zero
684    if it failed to build this list.  */
685
686 int
687 ada_build_task_list (int warn_if_null)
688 {
689   if (!target_has_stack)
690     error (_("Cannot inspect Ada tasks when program is not running"));
691
692   if (stale_task_list_p)
693     read_known_tasks_array ();
694
695   if (task_list == NULL)
696     {
697       if (warn_if_null)
698         printf_filtered (_("Your application does not use any Ada tasks.\n"));
699       return 0;
700     }
701
702   return 1;
703 }
704
705 /* Print a one-line description of the task whose number is TASKNO.
706    The formatting should fit the "info tasks" array.  */
707
708 static void
709 short_task_info (int taskno)
710 {
711   const struct ada_task_info *const task_info =
712     VEC_index (ada_task_info_s, task_list, taskno - 1);
713   int active_task_p;
714
715   gdb_assert (task_info != NULL);
716
717   /* Print a star if this task is the current task (or the task currently
718      selected).  */
719
720   active_task_p = ptid_equal (task_info->ptid, inferior_ptid);
721   if (active_task_p)
722     printf_filtered ("*");
723   else
724     printf_filtered (" ");
725
726   /* Print the task number.  */
727   printf_filtered ("%3d", taskno);
728
729   /* Print the Task ID.  */
730   printf_filtered (" %9lx", (long) task_info->task_id);
731
732   /* Print the Task ID of the task parent.  */
733   printf_filtered (" %4d", get_task_number_from_id (task_info->parent));
734
735   /* Print the base priority of the task.  */
736   printf_filtered (" %3d", task_info->priority);
737
738   /* Print the task current state.  */
739   if (task_info->caller_task)
740     printf_filtered (_(" Accepting RV with %-4d"),
741                      get_task_number_from_id (task_info->caller_task));
742   else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
743     printf_filtered (_(" Waiting on RV with %-3d"),
744                      get_task_number_from_id (task_info->called_task));
745   else
746     printf_filtered (" %-22s", _(task_states[task_info->state]));
747
748   /* Finally, print the task name.  */
749   if (task_info->name[0] != '\0')
750     printf_filtered (" %s\n", task_info->name);
751   else
752     printf_filtered (_(" <no name>\n"));
753 }
754
755 /* Print a list containing a short description of all Ada tasks.  */
756 /* FIXME: Shouldn't we be using ui_out??? */
757
758 static void
759 info_tasks (int from_tty)
760 {
761   int taskno;
762   const int nb_tasks = VEC_length (ada_task_info_s, task_list);
763
764   printf_filtered (_("  ID       TID P-ID Pri State                  Name\n"));
765   
766   for (taskno = 1; taskno <= nb_tasks; taskno++)
767     short_task_info (taskno);
768 }
769
770 /* Print a detailed description of the Ada task whose ID is TASKNO_STR.  */
771
772 static void
773 info_task (char *taskno_str, int from_tty)
774 {
775   const int taskno = value_as_long (parse_and_eval (taskno_str));
776   struct ada_task_info *task_info;
777   int parent_taskno = 0;
778
779   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, task_list))
780     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
781              "see the IDs of currently known tasks"), taskno);
782   task_info = VEC_index (ada_task_info_s, task_list, taskno - 1);
783
784   /* Print the Ada task ID.  */
785   printf_filtered (_("Ada Task: %s\n"),
786                    paddress (target_gdbarch, task_info->task_id));
787
788   /* Print the name of the task.  */
789   if (task_info->name[0] != '\0')
790     printf_filtered (_("Name: %s\n"), task_info->name);
791   else
792     printf_filtered (_("<no name>\n"));
793
794   /* Print the TID and LWP.  */
795   printf_filtered (_("Thread: %#lx\n"), ptid_get_tid (task_info->ptid));
796   printf_filtered (_("LWP: %#lx\n"), ptid_get_lwp (task_info->ptid));
797
798   /* Print who is the parent (if any).  */
799   if (task_info->parent != 0)
800     parent_taskno = get_task_number_from_id (task_info->parent);
801   if (parent_taskno)
802     {
803       struct ada_task_info *parent =
804         VEC_index (ada_task_info_s, task_list, parent_taskno - 1);
805
806       printf_filtered (_("Parent: %d"), parent_taskno);
807       if (parent->name[0] != '\0')
808         printf_filtered (" (%s)", parent->name);
809       printf_filtered ("\n");
810     }
811   else
812     printf_filtered (_("No parent\n"));
813
814   /* Print the base priority.  */
815   printf_filtered (_("Base Priority: %d\n"), task_info->priority);
816
817   /* print the task current state.  */
818   {
819     int target_taskno = 0;
820
821     if (task_info->caller_task)
822       {
823         target_taskno = get_task_number_from_id (task_info->caller_task);
824         printf_filtered (_("State: Accepting rendezvous with %d"),
825                          target_taskno);
826       }
827     else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
828       {
829         target_taskno = get_task_number_from_id (task_info->called_task);
830         printf_filtered (_("State: Waiting on task %d's entry"),
831                          target_taskno);
832       }
833     else
834       printf_filtered (_("State: %s"), _(long_task_states[task_info->state]));
835
836     if (target_taskno)
837       {
838         struct ada_task_info *target_task_info =
839           VEC_index (ada_task_info_s, task_list, target_taskno - 1);
840
841         if (target_task_info->name[0] != '\0')
842           printf_filtered (" (%s)", target_task_info->name);
843       }
844
845     printf_filtered ("\n");
846   }
847 }
848
849 /* If ARG is empty or null, then print a list of all Ada tasks.
850    Otherwise, print detailed information about the task whose ID
851    is ARG.
852    
853    Does nothing if the program doesn't use Ada tasking.  */
854
855 static void
856 info_tasks_command (char *arg, int from_tty)
857 {
858   const int task_list_built = ada_build_task_list (1);
859
860   if (!task_list_built)
861     return;
862
863   if (arg == NULL || *arg == '\0')
864     info_tasks (from_tty);
865   else
866     info_task (arg, from_tty);
867 }
868
869 /* Print a message telling the user id of the current task.
870    This function assumes that tasking is in use in the inferior.  */
871
872 static void
873 display_current_task_id (void)
874 {
875   const int current_task = ada_get_task_number (inferior_ptid);
876
877   if (current_task == 0)
878     printf_filtered (_("[Current task is unknown]\n"));
879   else
880     printf_filtered (_("[Current task is %d]\n"), current_task);
881 }
882
883 /* Parse and evaluate TIDSTR into a task id, and try to switch to
884    that task.  Print an error message if the task switch failed.  */
885
886 static void
887 task_command_1 (char *taskno_str, int from_tty)
888 {
889   const int taskno = value_as_long (parse_and_eval (taskno_str));
890   struct ada_task_info *task_info;
891
892   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, task_list))
893     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
894              "see the IDs of currently known tasks"), taskno);
895   task_info = VEC_index (ada_task_info_s, task_list, taskno - 1);
896
897   if (!ada_task_is_alive (task_info))
898     error (_("Cannot switch to task %d: Task is no longer running"), taskno);
899    
900   /* On some platforms, the thread list is not updated until the user
901      performs a thread-related operation (by using the "info threads"
902      command, for instance).  So this thread list may not be up to date
903      when the user attempts this task switch.  Since we cannot switch
904      to the thread associated to our task if GDB does not know about
905      that thread, we need to make sure that any new threads gets added
906      to the thread list.  */
907   target_find_new_threads ();
908
909   /* Verify that the ptid of the task we want to switch to is valid
910      (in other words, a ptid that GDB knows about).  Otherwise, we will
911      cause an assertion failure later on, when we try to determine
912      the ptid associated thread_info data.  We should normally never
913      encounter such an error, but the wrong ptid can actually easily be
914      computed if target_get_ada_task_ptid has not been implemented for
915      our target (yet).  Rather than cause an assertion error in that case,
916      it's nicer for the user to just refuse to perform the task switch.  */
917   if (!find_thread_ptid (task_info->ptid))
918     error (_("Unable to compute thread ID for task %d.\n"
919              "Cannot switch to this task."),
920            taskno);
921
922   switch_to_thread (task_info->ptid);
923   ada_find_printable_frame (get_selected_frame (NULL));
924   printf_filtered (_("[Switching to task %d]\n"), taskno);
925   print_stack_frame (get_selected_frame (NULL),
926                      frame_relative_level (get_selected_frame (NULL)), 1);
927 }
928
929
930 /* Print the ID of the current task if TASKNO_STR is empty or NULL.
931    Otherwise, switch to the task indicated by TASKNO_STR.  */
932
933 static void
934 task_command (char *taskno_str, int from_tty)
935 {
936   const int task_list_built = ada_build_task_list (1);
937
938   if (!task_list_built)
939     return;
940
941   if (taskno_str == NULL || taskno_str[0] == '\0')
942     display_current_task_id ();
943   else
944     {
945       /* Task switching in core files doesn't work, either because:
946            1. Thread support is not implemented with core files
947            2. Thread support is implemented, but the thread IDs created
948               after having read the core file are not the same as the ones
949               that were used during the program life, before the crash.
950               As a consequence, there is no longer a way for the debugger
951               to find the associated thead ID of any given Ada task.
952          So, instead of attempting a task switch without giving the user
953          any clue as to what might have happened, just error-out with
954          a message explaining that this feature is not supported.  */
955       if (!target_has_execution)
956         error (_("\
957 Task switching not supported when debugging from core files\n\
958 (use thread support instead)"));
959       task_command_1 (taskno_str, from_tty);
960     }
961 }
962
963 /* Indicate that the task list may have changed, so invalidate the cache.  */
964
965 static void
966 ada_task_list_changed (void)
967 {
968   stale_task_list_p = 1;  
969 }
970
971 /* The 'normal_stop' observer notification callback.  */
972
973 static void
974 ada_normal_stop_observer (struct bpstats *unused_args, int unused_args2)
975 {
976   /* The inferior has been resumed, and just stopped. This means that
977      our task_list needs to be recomputed before it can be used again.  */
978   ada_task_list_changed ();
979 }
980
981 /* A routine to be called when the objfiles have changed.  */
982
983 static void
984 ada_new_objfile_observer (struct objfile *objfile)
985 {
986   /* Invalidate all cached data that were extracted from an objfile.  */
987
988   atcb_type = NULL;
989   atcb_common_type = NULL;
990   atcb_ll_type = NULL;
991   atcb_call_type = NULL;
992
993   ada_tasks_check_symbol_table = 1;
994 }
995
996 /* Provide a prototype to silence -Wmissing-prototypes.  */
997 extern initialize_file_ftype _initialize_tasks;
998
999 void
1000 _initialize_tasks (void)
1001 {
1002   /* Attach various observers.  */
1003   observer_attach_normal_stop (ada_normal_stop_observer);
1004   observer_attach_new_objfile (ada_new_objfile_observer);
1005
1006   /* Some new commands provided by this module.  */
1007   add_info ("tasks", info_tasks_command,
1008             _("Provide information about all known Ada tasks"));
1009   add_cmd ("task", class_run, task_command,
1010            _("Use this command to switch between Ada tasks.\n\
1011 Without argument, this command simply prints the current task ID"),
1012            &cmdlist);
1013 }
1014