Merge branch 'vendor/GDB'
[dragonfly.git] / contrib / gdb-7 / gdb / ada-tasks.c
1 /* Copyright (C) 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005,
2    2007, 2008, 2009, 2010, 2011 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 zero 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         return 0;
322       known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
323
324       /* FIXME: brobecker 2003-03-05: Here would be a much better place
325          to attach the ada-tasks observers, instead of doing this
326          unconditionaly in _initialize_tasks.  This would avoid an
327          unecessary notification when the inferior does not use tasking
328          or as long as the user does not use the ada-tasks commands.
329          Unfortunately, this is not possible for the moment: the current
330          code resets ada__tasks_check_symbol_table back to 1 whenever
331          symbols for a new program are being loaded.  If we place the
332          observers intialization here, we will end up adding new observers
333          everytime we do the check for Ada tasking-related symbols
334          above.  This would currently have benign effects, but is still
335          undesirable.  The cleanest approach is probably to create a new
336          observer to notify us when the user is debugging a new program.
337          We would then reset ada__tasks_check_symbol_table back to 1
338          during the notification, but also detach all observers.
339          BTW: observers are probably not reentrant, so detaching during
340          a notification may not be the safest thing to do...  Sigh...
341          But creating the new observer would be a good idea in any case,
342          since this allow us to make ada__tasks_check_symbol_table
343          static, which is a good bonus.  */
344       ada_tasks_check_symbol_table = 0;
345     }
346
347   return known_tasks_addr;
348 }
349
350 /* Get from the debugging information the type description of all types
351    related to the Ada Task Control Block that will be needed in order to
352    read the list of known tasks in the Ada runtime.  Also return the
353    associated ATCB_FIELDNOS.
354
355    Error handling:  Any data missing from the debugging info will cause
356    an error to be raised, and none of the return values to be set.
357    Users of this function can depend on the fact that all or none of the
358    return values will be set.  */
359
360 static void
361 get_tcb_types_info (struct type **atcb_type,
362                     struct type **atcb_common_type,
363                     struct type **atcb_ll_type,
364                     struct type **atcb_call_type,
365                     struct tcb_fieldnos *atcb_fieldnos)
366 {
367   struct type *type;
368   struct type *common_type;
369   struct type *ll_type;
370   struct type *call_type;
371   struct tcb_fieldnos fieldnos;
372
373   const char *atcb_name = "system__tasking__ada_task_control_block___XVE";
374   const char *atcb_name_fixed = "system__tasking__ada_task_control_block";
375   const char *common_atcb_name = "system__tasking__common_atcb";
376   const char *private_data_name = "system__task_primitives__private_data";
377   const char *entry_call_record_name = "system__tasking__entry_call_record";
378
379   /* ATCB symbols may be found in several compilation units.  As we
380      are only interested in one instance, use standard (literal,
381      C-like) lookups to get the first match.  */
382
383   struct symbol *atcb_sym =
384     lookup_symbol_in_language (atcb_name, NULL, VAR_DOMAIN,
385                                language_c, NULL);
386   const struct symbol *common_atcb_sym =
387     lookup_symbol_in_language (common_atcb_name, NULL, VAR_DOMAIN,
388                                language_c, NULL);
389   const struct symbol *private_data_sym =
390     lookup_symbol_in_language (private_data_name, NULL, VAR_DOMAIN,
391                                language_c, NULL);
392   const struct symbol *entry_call_record_sym =
393     lookup_symbol_in_language (entry_call_record_name, NULL, VAR_DOMAIN,
394                                language_c, NULL);
395
396   if (atcb_sym == NULL || atcb_sym->type == NULL)
397     {
398       /* In Ravenscar run-time libs, the  ATCB does not have a dynamic
399          size, so the symbol name differs.  */
400       atcb_sym = lookup_symbol_in_language (atcb_name_fixed, NULL, VAR_DOMAIN,
401                                             language_c, NULL);
402
403       if (atcb_sym == NULL || atcb_sym->type == NULL)
404         error (_("Cannot find Ada_Task_Control_Block type. Aborting"));
405
406       type = atcb_sym->type;
407     }
408   else
409     {
410       /* Get a static representation of the type record
411          Ada_Task_Control_Block.  */
412       type = atcb_sym->type;
413       type = ada_template_to_fixed_record_type_1 (type, NULL, 0, NULL, 0);
414     }
415
416   if (common_atcb_sym == NULL || common_atcb_sym->type == NULL)
417     error (_("Cannot find Common_ATCB type. Aborting"));
418   if (private_data_sym == NULL || private_data_sym->type == NULL)
419     error (_("Cannot find Private_Data type. Aborting"));
420   if (entry_call_record_sym == NULL || entry_call_record_sym->type == NULL)
421     error (_("Cannot find Entry_Call_Record type. Aborting"));
422
423   /* Get the type for Ada_Task_Control_Block.Common.  */
424   common_type = common_atcb_sym->type;
425
426   /* Get the type for Ada_Task_Control_Bloc.Common.Call.LL.  */
427   ll_type = private_data_sym->type;
428
429   /* Get the type for Common_ATCB.Call.all.  */
430   call_type = entry_call_record_sym->type;
431
432   /* Get the field indices.  */
433   fieldnos.common = ada_get_field_index (type, "common", 0);
434   fieldnos.entry_calls = ada_get_field_index (type, "entry_calls", 1);
435   fieldnos.atc_nesting_level =
436     ada_get_field_index (type, "atc_nesting_level", 1);
437   fieldnos.state = ada_get_field_index (common_type, "state", 0);
438   fieldnos.parent = ada_get_field_index (common_type, "parent", 1);
439   fieldnos.priority = ada_get_field_index (common_type, "base_priority", 0);
440   fieldnos.image = ada_get_field_index (common_type, "task_image", 1);
441   fieldnos.image_len = ada_get_field_index (common_type, "task_image_len", 1);
442   fieldnos.call = ada_get_field_index (common_type, "call", 1);
443   fieldnos.ll = ada_get_field_index (common_type, "ll", 0);
444   fieldnos.ll_thread = ada_get_field_index (ll_type, "thread", 0);
445   fieldnos.ll_lwp = ada_get_field_index (ll_type, "lwp", 1);
446   fieldnos.call_self = ada_get_field_index (call_type, "self", 0);
447
448   /* On certain platforms such as x86-windows, the "lwp" field has been
449      named "thread_id".  This field will likely be renamed in the future,
450      but we need to support both possibilities to avoid an unnecessary
451      dependency on a recent compiler.  We therefore try locating the
452      "thread_id" field in place of the "lwp" field if we did not find
453      the latter.  */
454   if (fieldnos.ll_lwp < 0)
455     fieldnos.ll_lwp = ada_get_field_index (ll_type, "thread_id", 1);
456
457   /* Set all the out parameters all at once, now that we are certain
458      that there are no potential error() anymore.  */
459   *atcb_type = type;
460   *atcb_common_type = common_type;
461   *atcb_ll_type = ll_type;
462   *atcb_call_type = call_type;
463   *atcb_fieldnos = fieldnos;
464 }
465
466 /* Build the PTID of the task from its COMMON_VALUE, which is the "Common"
467    component of its ATCB record.  This PTID needs to match the PTID used
468    by the thread layer.  */
469
470 static ptid_t
471 ptid_from_atcb_common (struct value *common_value)
472 {
473   long thread = 0;
474   CORE_ADDR lwp = 0;
475   struct value *ll_value;
476   ptid_t ptid;
477
478   ll_value = value_field (common_value, fieldno.ll);
479
480   if (fieldno.ll_lwp >= 0)
481     lwp = value_as_address (value_field (ll_value, fieldno.ll_lwp));
482   thread = value_as_long (value_field (ll_value, fieldno.ll_thread));
483
484   ptid = target_get_ada_task_ptid (lwp, thread);
485
486   return ptid;
487 }
488
489 /* Read the ATCB data of a given task given its TASK_ID (which is in practice
490    the address of its assocated ATCB record), and store the result inside
491    TASK_INFO.  */
492
493 static void
494 read_atcb (CORE_ADDR task_id, struct ada_task_info *task_info)
495 {
496   struct value *tcb_value;
497   struct value *common_value;
498   struct value *atc_nesting_level_value;
499   struct value *entry_calls_value;
500   struct value *entry_calls_value_element;
501   int called_task_fieldno = -1;
502   const char ravenscar_task_name[] = "Ravenscar task";
503
504   if (atcb_type == NULL)
505     get_tcb_types_info (&atcb_type, &atcb_common_type, &atcb_ll_type,
506                         &atcb_call_type, &fieldno);
507
508   tcb_value = value_from_contents_and_address (atcb_type, NULL, task_id);
509   common_value = value_field (tcb_value, fieldno.common);
510
511   /* Fill in the task_id.  */
512
513   task_info->task_id = task_id;
514
515   /* Compute the name of the task.
516
517      Depending on the GNAT version used, the task image is either a fat
518      string, or a thin array of characters.  Older versions of GNAT used
519      to use fat strings, and therefore did not need an extra field in
520      the ATCB to store the string length.  For efficiency reasons, newer
521      versions of GNAT replaced the fat string by a static buffer, but this
522      also required the addition of a new field named "Image_Len" containing
523      the length of the task name.  The method used to extract the task name
524      is selected depending on the existence of this field.
525
526      In some run-time libs (e.g. Ravenscar), the name is not in the ATCB;
527      we may want to get it from the first user frame of the stack.  For now,
528      we just give a dummy name.  */
529
530   if (fieldno.image_len == -1)
531     {
532       if (fieldno.image >= 0)
533         read_fat_string_value (task_info->name,
534                                value_field (common_value, fieldno.image),
535                                sizeof (task_info->name) - 1);
536       else
537         strcpy (task_info->name, ravenscar_task_name);
538     }
539   else
540     {
541       int len = value_as_long (value_field (common_value, fieldno.image_len));
542
543       value_as_string (task_info->name,
544                        value_field (common_value, fieldno.image), len);
545     }
546
547   /* Compute the task state and priority.  */
548
549   task_info->state = value_as_long (value_field (common_value, fieldno.state));
550   task_info->priority =
551     value_as_long (value_field (common_value, fieldno.priority));
552
553   /* If the ATCB contains some information about the parent task,
554      then compute it as well.  Otherwise, zero.  */
555
556   if (fieldno.parent >= 0)
557     task_info->parent =
558       value_as_address (value_field (common_value, fieldno.parent));
559   else
560     task_info->parent = 0;
561   
562
563   /* If the ATCB contains some information about entry calls, then
564      compute the "called_task" as well.  Otherwise, zero.  */
565
566   if (fieldno.atc_nesting_level > 0 && fieldno.entry_calls > 0) 
567     {
568       /* Let My_ATCB be the Ada task control block of a task calling the
569          entry of another task; then the Task_Id of the called task is
570          in My_ATCB.Entry_Calls (My_ATCB.ATC_Nesting_Level).Called_Task.  */
571       atc_nesting_level_value = value_field (tcb_value,
572                                              fieldno.atc_nesting_level);
573       entry_calls_value =
574         ada_coerce_to_simple_array_ptr (value_field (tcb_value,
575                                                      fieldno.entry_calls));
576       entry_calls_value_element =
577         value_subscript (entry_calls_value,
578                          value_as_long (atc_nesting_level_value));
579       called_task_fieldno =
580         ada_get_field_index (value_type (entry_calls_value_element),
581                              "called_task", 0);
582       task_info->called_task =
583         value_as_address (value_field (entry_calls_value_element,
584                                        called_task_fieldno));
585     }
586   else
587     {
588       task_info->called_task = 0;
589     }
590
591   /* If the ATCB cotnains some information about RV callers,
592      then compute the "caller_task".  Otherwise, zero.  */
593
594   task_info->caller_task = 0;
595   if (fieldno.call >= 0)
596     {
597       /* Get the ID of the caller task from Common_ATCB.Call.all.Self.
598          If Common_ATCB.Call is null, then there is no caller.  */
599       const CORE_ADDR call =
600         value_as_address (value_field (common_value, fieldno.call));
601       struct value *call_val;
602
603       if (call != 0)
604         {
605           call_val =
606             value_from_contents_and_address (atcb_call_type, NULL, call);
607           task_info->caller_task =
608             value_as_address (value_field (call_val, fieldno.call_self));
609         }
610     }
611
612   /* And finally, compute the task ptid.  Note that there are situations
613      where this cannot be determined:
614        - The task is no longer alive - the ptid is irrelevant;
615        - We are debugging a core file - the thread is not always
616          completely preserved for us to link back a task to its
617          underlying thread.  Since we do not support task switching
618          when debugging core files anyway, we don't need to compute
619          that task ptid.
620      In either case, we don't need that ptid, and it is just good enough
621      to set it to null_ptid.  */
622
623   if (target_has_execution && ada_task_is_alive (task_info))
624     task_info->ptid = ptid_from_atcb_common (common_value);
625   else
626     task_info->ptid = null_ptid;
627 }
628
629 /* Read the ATCB info of the given task (identified by TASK_ID), and
630    add the result to the TASK_LIST.  */
631
632 static void
633 add_ada_task (CORE_ADDR task_id)
634 {
635   struct ada_task_info task_info;
636
637   read_atcb (task_id, &task_info);
638   VEC_safe_push (ada_task_info_s, task_list, &task_info);
639 }
640
641 /* Read the Known_Tasks array from the inferior memory, and store
642    it in TASK_LIST.  Return non-zero upon success.  */
643
644 static int
645 read_known_tasks_array (void)
646 {
647   const int target_ptr_byte =
648     gdbarch_ptr_bit (target_gdbarch) / TARGET_CHAR_BIT;
649   const CORE_ADDR known_tasks_addr = get_known_tasks_addr ();
650   const int known_tasks_size = target_ptr_byte * MAX_NUMBER_OF_KNOWN_TASKS;
651   gdb_byte *known_tasks = alloca (known_tasks_size);
652   int i;
653
654   /* Step 1: Clear the current list, if necessary.  */
655   VEC_truncate (ada_task_info_s, task_list, 0);
656
657   /* If the application does not use task, then no more needs to be done.
658      It is important to have the task list cleared (see above) before we
659      return, as we don't want a stale task list to be used...  This can
660      happen for instance when debugging a non-multitasking program after
661      having debugged a multitasking one.  */
662   if (known_tasks_addr == 0)
663     return 0;
664
665   /* Step 2: Build a new list by reading the ATCBs from the Known_Tasks
666      array in the Ada runtime.  */
667   read_memory (known_tasks_addr, known_tasks, known_tasks_size);
668   for (i = 0; i < MAX_NUMBER_OF_KNOWN_TASKS; i++)
669     {
670       struct type *data_ptr_type =
671         builtin_type (target_gdbarch)->builtin_data_ptr;
672       CORE_ADDR task_id =
673         extract_typed_address (known_tasks + i * target_ptr_byte,
674                                data_ptr_type);
675
676       if (task_id != 0)
677         add_ada_task (task_id);
678     }
679
680   /* Step 3: Unset stale_task_list_p, to avoid re-reading the Known_Tasks
681      array unless needed.  Then report a success.  */
682   stale_task_list_p = 0;
683
684   return 1;
685 }
686
687 /* Builds the task_list by reading the Known_Tasks array from
688    the inferior.  Prints an appropriate message and returns non-zero
689    if it failed to build this list.  */
690
691 int
692 ada_build_task_list (int warn_if_null)
693 {
694   if (!target_has_stack)
695     error (_("Cannot inspect Ada tasks when program is not running"));
696
697   if (stale_task_list_p)
698     read_known_tasks_array ();
699
700   if (task_list == NULL)
701     {
702       if (warn_if_null)
703         printf_filtered (_("Your application does not use any Ada tasks.\n"));
704       return 0;
705     }
706
707   return 1;
708 }
709
710 /* Print a one-line description of the task whose number is TASKNO.
711    The formatting should fit the "info tasks" array.  */
712
713 static void
714 short_task_info (int taskno)
715 {
716   const struct ada_task_info *const task_info =
717     VEC_index (ada_task_info_s, task_list, taskno - 1);
718   int active_task_p;
719
720   gdb_assert (task_info != NULL);
721
722   /* Print a star if this task is the current task (or the task currently
723      selected).  */
724
725   active_task_p = ptid_equal (task_info->ptid, inferior_ptid);
726   if (active_task_p)
727     printf_filtered ("*");
728   else
729     printf_filtered (" ");
730
731   /* Print the task number.  */
732   printf_filtered ("%3d", taskno);
733
734   /* Print the Task ID.  */
735   printf_filtered (" %9lx", (long) task_info->task_id);
736
737   /* Print the Task ID of the task parent.  */
738   printf_filtered (" %4d", get_task_number_from_id (task_info->parent));
739
740   /* Print the base priority of the task.  */
741   printf_filtered (" %3d", task_info->priority);
742
743   /* Print the task current state.  */
744   if (task_info->caller_task)
745     printf_filtered (_(" Accepting RV with %-4d"),
746                      get_task_number_from_id (task_info->caller_task));
747   else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
748     printf_filtered (_(" Waiting on RV with %-3d"),
749                      get_task_number_from_id (task_info->called_task));
750   else
751     printf_filtered (" %-22s", _(task_states[task_info->state]));
752
753   /* Finally, print the task name.  */
754   if (task_info->name[0] != '\0')
755     printf_filtered (" %s\n", task_info->name);
756   else
757     printf_filtered (_(" <no name>\n"));
758 }
759
760 /* Print a list containing a short description of all Ada tasks.  */
761 /* FIXME: Shouldn't we be using ui_out???  */
762
763 static void
764 info_tasks (int from_tty)
765 {
766   int taskno;
767   const int nb_tasks = VEC_length (ada_task_info_s, task_list);
768
769   printf_filtered (_("  ID       TID P-ID Pri State                  Name\n"));
770   
771   for (taskno = 1; taskno <= nb_tasks; taskno++)
772     short_task_info (taskno);
773 }
774
775 /* Print a detailed description of the Ada task whose ID is TASKNO_STR.  */
776
777 static void
778 info_task (char *taskno_str, int from_tty)
779 {
780   const int taskno = value_as_long (parse_and_eval (taskno_str));
781   struct ada_task_info *task_info;
782   int parent_taskno = 0;
783
784   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, task_list))
785     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
786              "see the IDs of currently known tasks"), taskno);
787   task_info = VEC_index (ada_task_info_s, task_list, taskno - 1);
788
789   /* Print the Ada task ID.  */
790   printf_filtered (_("Ada Task: %s\n"),
791                    paddress (target_gdbarch, task_info->task_id));
792
793   /* Print the name of the task.  */
794   if (task_info->name[0] != '\0')
795     printf_filtered (_("Name: %s\n"), task_info->name);
796   else
797     printf_filtered (_("<no name>\n"));
798
799   /* Print the TID and LWP.  */
800   printf_filtered (_("Thread: %#lx\n"), ptid_get_tid (task_info->ptid));
801   printf_filtered (_("LWP: %#lx\n"), ptid_get_lwp (task_info->ptid));
802
803   /* Print who is the parent (if any).  */
804   if (task_info->parent != 0)
805     parent_taskno = get_task_number_from_id (task_info->parent);
806   if (parent_taskno)
807     {
808       struct ada_task_info *parent =
809         VEC_index (ada_task_info_s, task_list, parent_taskno - 1);
810
811       printf_filtered (_("Parent: %d"), parent_taskno);
812       if (parent->name[0] != '\0')
813         printf_filtered (" (%s)", parent->name);
814       printf_filtered ("\n");
815     }
816   else
817     printf_filtered (_("No parent\n"));
818
819   /* Print the base priority.  */
820   printf_filtered (_("Base Priority: %d\n"), task_info->priority);
821
822   /* print the task current state.  */
823   {
824     int target_taskno = 0;
825
826     if (task_info->caller_task)
827       {
828         target_taskno = get_task_number_from_id (task_info->caller_task);
829         printf_filtered (_("State: Accepting rendezvous with %d"),
830                          target_taskno);
831       }
832     else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
833       {
834         target_taskno = get_task_number_from_id (task_info->called_task);
835         printf_filtered (_("State: Waiting on task %d's entry"),
836                          target_taskno);
837       }
838     else
839       printf_filtered (_("State: %s"), _(long_task_states[task_info->state]));
840
841     if (target_taskno)
842       {
843         struct ada_task_info *target_task_info =
844           VEC_index (ada_task_info_s, task_list, target_taskno - 1);
845
846         if (target_task_info->name[0] != '\0')
847           printf_filtered (" (%s)", target_task_info->name);
848       }
849
850     printf_filtered ("\n");
851   }
852 }
853
854 /* If ARG is empty or null, then print a list of all Ada tasks.
855    Otherwise, print detailed information about the task whose ID
856    is ARG.
857    
858    Does nothing if the program doesn't use Ada tasking.  */
859
860 static void
861 info_tasks_command (char *arg, int from_tty)
862 {
863   const int task_list_built = ada_build_task_list (1);
864
865   if (!task_list_built)
866     return;
867
868   if (arg == NULL || *arg == '\0')
869     info_tasks (from_tty);
870   else
871     info_task (arg, from_tty);
872 }
873
874 /* Print a message telling the user id of the current task.
875    This function assumes that tasking is in use in the inferior.  */
876
877 static void
878 display_current_task_id (void)
879 {
880   const int current_task = ada_get_task_number (inferior_ptid);
881
882   if (current_task == 0)
883     printf_filtered (_("[Current task is unknown]\n"));
884   else
885     printf_filtered (_("[Current task is %d]\n"), current_task);
886 }
887
888 /* Parse and evaluate TIDSTR into a task id, and try to switch to
889    that task.  Print an error message if the task switch failed.  */
890
891 static void
892 task_command_1 (char *taskno_str, int from_tty)
893 {
894   const int taskno = value_as_long (parse_and_eval (taskno_str));
895   struct ada_task_info *task_info;
896
897   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, task_list))
898     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
899              "see the IDs of currently known tasks"), taskno);
900   task_info = VEC_index (ada_task_info_s, task_list, taskno - 1);
901
902   if (!ada_task_is_alive (task_info))
903     error (_("Cannot switch to task %d: Task is no longer running"), taskno);
904    
905   /* On some platforms, the thread list is not updated until the user
906      performs a thread-related operation (by using the "info threads"
907      command, for instance).  So this thread list may not be up to date
908      when the user attempts this task switch.  Since we cannot switch
909      to the thread associated to our task if GDB does not know about
910      that thread, we need to make sure that any new threads gets added
911      to the thread list.  */
912   target_find_new_threads ();
913
914   /* Verify that the ptid of the task we want to switch to is valid
915      (in other words, a ptid that GDB knows about).  Otherwise, we will
916      cause an assertion failure later on, when we try to determine
917      the ptid associated thread_info data.  We should normally never
918      encounter such an error, but the wrong ptid can actually easily be
919      computed if target_get_ada_task_ptid has not been implemented for
920      our target (yet).  Rather than cause an assertion error in that case,
921      it's nicer for the user to just refuse to perform the task switch.  */
922   if (!find_thread_ptid (task_info->ptid))
923     error (_("Unable to compute thread ID for task %d.\n"
924              "Cannot switch to this task."),
925            taskno);
926
927   switch_to_thread (task_info->ptid);
928   ada_find_printable_frame (get_selected_frame (NULL));
929   printf_filtered (_("[Switching to task %d]\n"), taskno);
930   print_stack_frame (get_selected_frame (NULL),
931                      frame_relative_level (get_selected_frame (NULL)), 1);
932 }
933
934
935 /* Print the ID of the current task if TASKNO_STR is empty or NULL.
936    Otherwise, switch to the task indicated by TASKNO_STR.  */
937
938 static void
939 task_command (char *taskno_str, int from_tty)
940 {
941   const int task_list_built = ada_build_task_list (1);
942
943   if (!task_list_built)
944     return;
945
946   if (taskno_str == NULL || taskno_str[0] == '\0')
947     display_current_task_id ();
948   else
949     {
950       /* Task switching in core files doesn't work, either because:
951            1. Thread support is not implemented with core files
952            2. Thread support is implemented, but the thread IDs created
953               after having read the core file are not the same as the ones
954               that were used during the program life, before the crash.
955               As a consequence, there is no longer a way for the debugger
956               to find the associated thead ID of any given Ada task.
957          So, instead of attempting a task switch without giving the user
958          any clue as to what might have happened, just error-out with
959          a message explaining that this feature is not supported.  */
960       if (!target_has_execution)
961         error (_("\
962 Task switching not supported when debugging from core files\n\
963 (use thread support instead)"));
964       task_command_1 (taskno_str, from_tty);
965     }
966 }
967
968 /* Indicate that the task list may have changed, so invalidate the cache.  */
969
970 static void
971 ada_task_list_changed (void)
972 {
973   stale_task_list_p = 1;  
974 }
975
976 /* The 'normal_stop' observer notification callback.  */
977
978 static void
979 ada_normal_stop_observer (struct bpstats *unused_args, int unused_args2)
980 {
981   /* The inferior has been resumed, and just stopped. This means that
982      our task_list needs to be recomputed before it can be used again.  */
983   ada_task_list_changed ();
984 }
985
986 /* A routine to be called when the objfiles have changed.  */
987
988 static void
989 ada_new_objfile_observer (struct objfile *objfile)
990 {
991   /* Invalidate all cached data that were extracted from an objfile.  */
992
993   atcb_type = NULL;
994   atcb_common_type = NULL;
995   atcb_ll_type = NULL;
996   atcb_call_type = NULL;
997
998   ada_tasks_check_symbol_table = 1;
999 }
1000
1001 /* Provide a prototype to silence -Wmissing-prototypes.  */
1002 extern initialize_file_ftype _initialize_tasks;
1003
1004 void
1005 _initialize_tasks (void)
1006 {
1007   /* Attach various observers.  */
1008   observer_attach_normal_stop (ada_normal_stop_observer);
1009   observer_attach_new_objfile (ada_new_objfile_observer);
1010
1011   /* Some new commands provided by this module.  */
1012   add_info ("tasks", info_tasks_command,
1013             _("Provide information about all known Ada tasks"));
1014   add_cmd ("task", class_run, task_command,
1015            _("Use this command to switch between Ada tasks.\n\
1016 Without argument, this command simply prints the current task ID"),
1017            &cmdlist);
1018 }
1019