Import gdb 7.3 into vendor branch
[dragonfly.git] / contrib / gdb-7 / gdb / ada-tasks.c
CommitLineData
5796c8dc 1/* Copyright (C) 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005,
c50c785c 2 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5796c8dc
SS
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
c50c785c 32/* The maximum number of tasks known to the Ada runtime. */
5796c8dc
SS
33static const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
34
35enum 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. */
58static 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. */
80static 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
104struct 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
c50c785c 129 the associated tcb_fieldnos. For efficiency reasons, these are made
5796c8dc
SS
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
135static struct type *atcb_type = NULL;
136static struct type *atcb_common_type = NULL;
137static struct type *atcb_ll_type = NULL;
138static struct type *atcb_call_type = NULL;
139static 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. */
143static 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. */
152typedef struct ada_task_info ada_task_info_s;
153DEF_VEC_O(ada_task_info_s);
154static 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. */
158static 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
163int
164ada_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
178static int
179get_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
198int
199valid_task_id (int task_num)
200{
cf7f2e2d 201 ada_build_task_list (0);
5796c8dc
SS
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
209static int
210ada_task_is_alive (struct ada_task_info *task_info)
211{
212 return (task_info->state != Terminated);
213}
214
c50c785c
JM
215/* Call the ITERATOR function once for each Ada task that hasn't been
216 terminated yet. */
217
218void
219iterate_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
5796c8dc
SS
236/* Extract the contents of the value as a string whose length is LENGTH,
237 and store the result in DEST. */
238
239static void
240value_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
251static void
252read_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
c50c785c 303 the Ada Runtime. Return zero if the array could not be found,
5796c8dc
SS
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
c50c785c 308 call. Subsequent calls will simply return this cached address. */
5796c8dc
SS
309
310static CORE_ADDR
311get_known_tasks_addr (void)
312{
313 static CORE_ADDR known_tasks_addr = 0;
314
315 if (ada_tasks_check_symbol_table)
316 {
5796c8dc
SS
317 struct minimal_symbol *msym;
318
319 msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
c50c785c
JM
320 if (msym == NULL)
321 return 0;
322 known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
5796c8dc
SS
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
c50c785c 326 unconditionaly in _initialize_tasks. This would avoid an
5796c8dc
SS
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
c50c785c 331 symbols for a new program are being loaded. If we place the
5796c8dc
SS
332 observers intialization here, we will end up adding new observers
333 everytime we do the check for Ada tasking-related symbols
c50c785c
JM
334 above. This would currently have benign effects, but is still
335 undesirable. The cleanest approach is probably to create a new
5796c8dc
SS
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
c50c785c 340 a notification may not be the safest thing to do... Sigh...
5796c8dc
SS
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
360static void
361get_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
c50c785c
JM
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
5796c8dc 383 struct symbol *atcb_sym =
c50c785c
JM
384 lookup_symbol_in_language (atcb_name, NULL, VAR_DOMAIN,
385 language_c, NULL);
5796c8dc 386 const struct symbol *common_atcb_sym =
c50c785c
JM
387 lookup_symbol_in_language (common_atcb_name, NULL, VAR_DOMAIN,
388 language_c, NULL);
5796c8dc 389 const struct symbol *private_data_sym =
c50c785c
JM
390 lookup_symbol_in_language (private_data_name, NULL, VAR_DOMAIN,
391 language_c, NULL);
5796c8dc 392 const struct symbol *entry_call_record_sym =
c50c785c
JM
393 lookup_symbol_in_language (entry_call_record_name, NULL, VAR_DOMAIN,
394 language_c, NULL);
5796c8dc
SS
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. */
c50c785c
JM
400 atcb_sym = lookup_symbol_in_language (atcb_name_fixed, NULL, VAR_DOMAIN,
401 language_c, NULL);
5796c8dc
SS
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
470static ptid_t
471ptid_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
493static void
494read_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
c50c785c 520 the ATCB to store the string length. For efficiency reasons, newer
5796c8dc
SS
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
c50c785c 523 the length of the task name. The method used to extract the task name
5796c8dc
SS
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;
c50c785c 527 we may want to get it from the first user frame of the stack. For now,
5796c8dc
SS
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
c50c785c
JM
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))
5796c8dc
SS
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
632static void
633add_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
644static int
645read_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
691int
692ada_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
713static void
714short_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. */
c50c785c 761/* FIXME: Shouldn't we be using ui_out??? */
5796c8dc
SS
762
763static void
764info_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
777static void
778info_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
860static void
861info_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
877static void
878display_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
891static void
892task_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
cf7f2e2d
JM
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
5796c8dc
SS
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
938static void
939task_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 (_("\
962Task 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
970static void
971ada_task_list_changed (void)
972{
973 stale_task_list_p = 1;
974}
975
976/* The 'normal_stop' observer notification callback. */
977
978static void
979ada_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
988static void
989ada_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. */
1002extern initialize_file_ftype _initialize_tasks;
1003
1004void
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\
1016Without argument, this command simply prints the current task ID"),
1017 &cmdlist);
1018}
1019