Upgrade GDB from 7.4.1 to 7.6.1 on the vendor branch
[dragonfly.git] / contrib / gdb-7 / gdb / ada-tasks.c
CommitLineData
ef5ccd6c 1/* Copyright (C) 1992-2013 Free Software Foundation, Inc.
5796c8dc
SS
2
3 This file is part of GDB.
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 3 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program. If not, see <http://www.gnu.org/licenses/>. */
17
18#include "defs.h"
19#include "observer.h"
20#include "gdbcmd.h"
21#include "target.h"
22#include "ada-lang.h"
23#include "gdbcore.h"
24#include "inferior.h"
25#include "gdbthread.h"
a45ae5f8
JM
26#include "progspace.h"
27#include "objfiles.h"
5796c8dc
SS
28
29/* The name of the array in the GNAT runtime where the Ada Task Control
30 Block of each task is stored. */
31#define KNOWN_TASKS_NAME "system__tasking__debug__known_tasks"
32
c50c785c 33/* The maximum number of tasks known to the Ada runtime. */
5796c8dc
SS
34static const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
35
a45ae5f8
JM
36/* The name of the variable in the GNAT runtime where the head of a task
37 chain is saved. This is an alternate mechanism to find the list of known
38 tasks. */
39#define KNOWN_TASKS_LIST "system__tasking__debug__first_task"
40
5796c8dc
SS
41enum task_states
42{
43 Unactivated,
44 Runnable,
45 Terminated,
46 Activator_Sleep,
47 Acceptor_Sleep,
48 Entry_Caller_Sleep,
49 Async_Select_Sleep,
50 Delay_Sleep,
51 Master_Completion_Sleep,
52 Master_Phase_2_Sleep,
53 Interrupt_Server_Idle_Sleep,
54 Interrupt_Server_Blocked_Interrupt_Sleep,
55 Timer_Server_Sleep,
56 AST_Server_Sleep,
57 Asynchronous_Hold,
58 Interrupt_Server_Blocked_On_Event_Flag,
59 Activating,
60 Acceptor_Delay_Sleep
61};
62
63/* A short description corresponding to each possible task state. */
64static const char *task_states[] = {
65 N_("Unactivated"),
66 N_("Runnable"),
67 N_("Terminated"),
68 N_("Child Activation Wait"),
69 N_("Accept or Select Term"),
70 N_("Waiting on entry call"),
71 N_("Async Select Wait"),
72 N_("Delay Sleep"),
73 N_("Child Termination Wait"),
74 N_("Wait Child in Term Alt"),
75 "",
76 "",
77 "",
78 "",
79 N_("Asynchronous Hold"),
80 "",
81 N_("Activating"),
82 N_("Selective Wait")
83};
84
85/* A longer description corresponding to each possible task state. */
86static const char *long_task_states[] = {
87 N_("Unactivated"),
88 N_("Runnable"),
89 N_("Terminated"),
90 N_("Waiting for child activation"),
91 N_("Blocked in accept or select with terminate"),
92 N_("Waiting on entry call"),
93 N_("Asynchronous Selective Wait"),
94 N_("Delay Sleep"),
95 N_("Waiting for children termination"),
96 N_("Waiting for children in terminate alternative"),
97 "",
98 "",
99 "",
100 "",
101 N_("Asynchronous Hold"),
102 "",
103 N_("Activating"),
104 N_("Blocked in selective wait statement")
105};
106
107/* The index of certain important fields in the Ada Task Control Block
108 record and sub-records. */
109
a45ae5f8 110struct atcb_fieldnos
5796c8dc
SS
111{
112 /* Fields in record Ada_Task_Control_Block. */
113 int common;
114 int entry_calls;
115 int atc_nesting_level;
116
117 /* Fields in record Common_ATCB. */
118 int state;
119 int parent;
120 int priority;
121 int image;
122 int image_len; /* This field may be missing. */
a45ae5f8 123 int activation_link;
5796c8dc
SS
124 int call;
125 int ll;
126
127 /* Fields in Task_Primitives.Private_Data. */
128 int ll_thread;
129 int ll_lwp; /* This field may be missing. */
130
131 /* Fields in Common_ATCB.Call.all. */
132 int call_self;
133};
134
a45ae5f8 135/* This module's per-program-space data. */
5796c8dc 136
a45ae5f8
JM
137struct ada_tasks_pspace_data
138{
139 /* Nonzero if the data has been initialized. If set to zero,
140 it means that the data has either not been initialized, or
141 has potentially become stale. */
142 int initialized_p;
5796c8dc 143
a45ae5f8
JM
144 /* The ATCB record type. */
145 struct type *atcb_type;
146
147 /* The ATCB "Common" component type. */
148 struct type *atcb_common_type;
149
150 /* The type of the "ll" field, from the atcb_common_type. */
151 struct type *atcb_ll_type;
152
153 /* The type of the "call" field, from the atcb_common_type. */
154 struct type *atcb_call_type;
155
156 /* The index of various fields in the ATCB record and sub-records. */
157 struct atcb_fieldnos atcb_fieldno;
158};
159
160/* Key to our per-program-space data. */
161static const struct program_space_data *ada_tasks_pspace_data_handle;
5796c8dc 162
5796c8dc
SS
163typedef struct ada_task_info ada_task_info_s;
164DEF_VEC_O(ada_task_info_s);
5796c8dc 165
a45ae5f8
JM
166/* The kind of data structure used by the runtime to store the list
167 of Ada tasks. */
168
169enum ada_known_tasks_kind
170{
171 /* Use this value when we haven't determined which kind of structure
172 is being used, or when we need to recompute it.
173
174 We set the value of this enumerate to zero on purpose: This allows
175 us to use this enumerate in a structure where setting all fields
176 to zero will result in this kind being set to unknown. */
177 ADA_TASKS_UNKNOWN = 0,
178
179 /* This value means that we did not find any task list. Unless
180 there is a bug somewhere, this means that the inferior does not
181 use tasking. */
182 ADA_TASKS_NOT_FOUND,
183
184 /* This value means that the task list is stored as an array.
185 This is the usual method, as it causes very little overhead.
186 But this method is not always used, as it does use a certain
187 amount of memory, which might be scarse in certain environments. */
188 ADA_TASKS_ARRAY,
189
190 /* This value means that the task list is stored as a linked list.
191 This has more runtime overhead than the array approach, but
192 also require less memory when the number of tasks is small. */
193 ADA_TASKS_LIST,
194};
195
196/* This module's per-inferior data. */
197
198struct ada_tasks_inferior_data
199{
200 /* The type of data structure used by the runtime to store
201 the list of Ada tasks. The value of this field influences
202 the interpretation of the known_tasks_addr field below:
203 - ADA_TASKS_UNKNOWN: The value of known_tasks_addr hasn't
204 been determined yet;
205 - ADA_TASKS_NOT_FOUND: The program probably does not use tasking
206 and the known_tasks_addr is irrelevant;
207 - ADA_TASKS_ARRAY: The known_tasks is an array;
208 - ADA_TASKS_LIST: The known_tasks is a list. */
209 enum ada_known_tasks_kind known_tasks_kind;
210
211 /* The address of the known_tasks structure. This is where
212 the runtime stores the information for all Ada tasks.
213 The interpretation of this field depends on KNOWN_TASKS_KIND
214 above. */
215 CORE_ADDR known_tasks_addr;
216
ef5ccd6c
JM
217 /* Type of elements of the known task. Usually a pointer. */
218 struct type *known_tasks_element;
219
220 /* Number of elements in the known tasks array. */
221 unsigned int known_tasks_length;
222
a45ae5f8
JM
223 /* When nonzero, this flag indicates that the task_list field
224 below is up to date. When set to zero, the list has either
225 not been initialized, or has potentially become stale. */
226 int task_list_valid_p;
227
228 /* The list of Ada tasks.
229
230 Note: To each task we associate a number that the user can use to
231 reference it - this number is printed beside each task in the tasks
232 info listing displayed by "info tasks". This number is equal to
233 its index in the vector + 1. Reciprocally, to compute the index
234 of a task in the vector, we need to substract 1 from its number. */
235 VEC(ada_task_info_s) *task_list;
236};
237
238/* Key to our per-inferior data. */
239static const struct inferior_data *ada_tasks_inferior_data_handle;
240
241/* Return the ada-tasks module's data for the given program space (PSPACE).
242 If none is found, add a zero'ed one now.
243
244 This function always returns a valid object. */
245
246static struct ada_tasks_pspace_data *
247get_ada_tasks_pspace_data (struct program_space *pspace)
248{
249 struct ada_tasks_pspace_data *data;
250
251 data = program_space_data (pspace, ada_tasks_pspace_data_handle);
252 if (data == NULL)
253 {
254 data = XZALLOC (struct ada_tasks_pspace_data);
255 set_program_space_data (pspace, ada_tasks_pspace_data_handle, data);
256 }
257
258 return data;
259}
260
261/* Return the ada-tasks module's data for the given inferior (INF).
262 If none is found, add a zero'ed one now.
263
264 This function always returns a valid object.
265
266 Note that we could use an observer of the inferior-created event
267 to make sure that the ada-tasks per-inferior data always exists.
268 But we prefered this approach, as it avoids this entirely as long
269 as the user does not use any of the tasking features. This is
270 quite possible, particularly in the case where the inferior does
271 not use tasking. */
272
273static struct ada_tasks_inferior_data *
274get_ada_tasks_inferior_data (struct inferior *inf)
275{
276 struct ada_tasks_inferior_data *data;
277
278 data = inferior_data (inf, ada_tasks_inferior_data_handle);
279 if (data == NULL)
280 {
281 data = XZALLOC (struct ada_tasks_inferior_data);
282 set_inferior_data (inf, ada_tasks_inferior_data_handle, data);
283 }
284
285 return data;
286}
5796c8dc
SS
287
288/* Return the task number of the task whose ptid is PTID, or zero
289 if the task could not be found. */
290
291int
292ada_get_task_number (ptid_t ptid)
293{
294 int i;
a45ae5f8
JM
295 struct inferior *inf = find_inferior_pid (ptid_get_pid (ptid));
296 struct ada_tasks_inferior_data *data;
297
298 gdb_assert (inf != NULL);
299 data = get_ada_tasks_inferior_data (inf);
5796c8dc 300
a45ae5f8
JM
301 for (i = 0; i < VEC_length (ada_task_info_s, data->task_list); i++)
302 if (ptid_equal (VEC_index (ada_task_info_s, data->task_list, i)->ptid,
303 ptid))
5796c8dc
SS
304 return i + 1;
305
306 return 0; /* No matching task found. */
307}
308
a45ae5f8
JM
309/* Return the task number of the task running in inferior INF which
310 matches TASK_ID , or zero if the task could not be found. */
5796c8dc
SS
311
312static int
a45ae5f8 313get_task_number_from_id (CORE_ADDR task_id, struct inferior *inf)
5796c8dc 314{
a45ae5f8 315 struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
5796c8dc
SS
316 int i;
317
a45ae5f8 318 for (i = 0; i < VEC_length (ada_task_info_s, data->task_list); i++)
5796c8dc
SS
319 {
320 struct ada_task_info *task_info =
a45ae5f8 321 VEC_index (ada_task_info_s, data->task_list, i);
5796c8dc
SS
322
323 if (task_info->task_id == task_id)
324 return i + 1;
325 }
326
327 /* Task not found. Return 0. */
328 return 0;
329}
330
331/* Return non-zero if TASK_NUM is a valid task number. */
332
333int
334valid_task_id (int task_num)
335{
a45ae5f8
JM
336 struct ada_tasks_inferior_data *data;
337
338 ada_build_task_list ();
339 data = get_ada_tasks_inferior_data (current_inferior ());
5796c8dc 340 return (task_num > 0
a45ae5f8 341 && task_num <= VEC_length (ada_task_info_s, data->task_list));
5796c8dc
SS
342}
343
344/* Return non-zero iff the task STATE corresponds to a non-terminated
345 task state. */
346
347static int
348ada_task_is_alive (struct ada_task_info *task_info)
349{
350 return (task_info->state != Terminated);
351}
352
c50c785c
JM
353/* Call the ITERATOR function once for each Ada task that hasn't been
354 terminated yet. */
355
356void
357iterate_over_live_ada_tasks (ada_task_list_iterator_ftype *iterator)
358{
359 int i, nb_tasks;
360 struct ada_task_info *task;
a45ae5f8 361 struct ada_tasks_inferior_data *data;
c50c785c 362
a45ae5f8
JM
363 ada_build_task_list ();
364 data = get_ada_tasks_inferior_data (current_inferior ());
365 nb_tasks = VEC_length (ada_task_info_s, data->task_list);
c50c785c
JM
366
367 for (i = 0; i < nb_tasks; i++)
368 {
a45ae5f8 369 task = VEC_index (ada_task_info_s, data->task_list, i);
c50c785c
JM
370 if (!ada_task_is_alive (task))
371 continue;
372 iterator (task);
373 }
374}
375
5796c8dc
SS
376/* Extract the contents of the value as a string whose length is LENGTH,
377 and store the result in DEST. */
378
379static void
380value_as_string (char *dest, struct value *val, int length)
381{
382 memcpy (dest, value_contents (val), length);
383 dest[length] = '\0';
384}
385
386/* Extract the string image from the fat string corresponding to VAL,
387 and store it in DEST. If the string length is greater than MAX_LEN,
388 then truncate the result to the first MAX_LEN characters of the fat
389 string. */
390
391static void
392read_fat_string_value (char *dest, struct value *val, int max_len)
393{
394 struct value *array_val;
395 struct value *bounds_val;
396 int len;
397
398 /* The following variables are made static to avoid recomputing them
399 each time this function is called. */
400 static int initialize_fieldnos = 1;
401 static int array_fieldno;
402 static int bounds_fieldno;
403 static int upper_bound_fieldno;
404
405 /* Get the index of the fields that we will need to read in order
406 to extract the string from the fat string. */
407 if (initialize_fieldnos)
408 {
409 struct type *type = value_type (val);
410 struct type *bounds_type;
411
412 array_fieldno = ada_get_field_index (type, "P_ARRAY", 0);
413 bounds_fieldno = ada_get_field_index (type, "P_BOUNDS", 0);
414
415 bounds_type = TYPE_FIELD_TYPE (type, bounds_fieldno);
416 if (TYPE_CODE (bounds_type) == TYPE_CODE_PTR)
417 bounds_type = TYPE_TARGET_TYPE (bounds_type);
418 if (TYPE_CODE (bounds_type) != TYPE_CODE_STRUCT)
419 error (_("Unknown task name format. Aborting"));
420 upper_bound_fieldno = ada_get_field_index (bounds_type, "UB0", 0);
421
422 initialize_fieldnos = 0;
423 }
424
425 /* Get the size of the task image by checking the value of the bounds.
426 The lower bound is always 1, so we only need to read the upper bound. */
427 bounds_val = value_ind (value_field (val, bounds_fieldno));
428 len = value_as_long (value_field (bounds_val, upper_bound_fieldno));
429
430 /* Make sure that we do not read more than max_len characters... */
431 if (len > max_len)
432 len = max_len;
433
434 /* Extract LEN characters from the fat string. */
435 array_val = value_ind (value_field (val, array_fieldno));
436 read_memory (value_address (array_val), dest, len);
437
438 /* Add the NUL character to close the string. */
439 dest[len] = '\0';
440}
441
5796c8dc
SS
442/* Get from the debugging information the type description of all types
443 related to the Ada Task Control Block that will be needed in order to
444 read the list of known tasks in the Ada runtime. Also return the
445 associated ATCB_FIELDNOS.
446
447 Error handling: Any data missing from the debugging info will cause
448 an error to be raised, and none of the return values to be set.
449 Users of this function can depend on the fact that all or none of the
450 return values will be set. */
451
452static void
a45ae5f8 453get_tcb_types_info (void)
5796c8dc
SS
454{
455 struct type *type;
456 struct type *common_type;
457 struct type *ll_type;
458 struct type *call_type;
a45ae5f8
JM
459 struct atcb_fieldnos fieldnos;
460 struct ada_tasks_pspace_data *pspace_data;
5796c8dc
SS
461
462 const char *atcb_name = "system__tasking__ada_task_control_block___XVE";
463 const char *atcb_name_fixed = "system__tasking__ada_task_control_block";
464 const char *common_atcb_name = "system__tasking__common_atcb";
465 const char *private_data_name = "system__task_primitives__private_data";
466 const char *entry_call_record_name = "system__tasking__entry_call_record";
467
c50c785c
JM
468 /* ATCB symbols may be found in several compilation units. As we
469 are only interested in one instance, use standard (literal,
470 C-like) lookups to get the first match. */
471
5796c8dc 472 struct symbol *atcb_sym =
c50c785c
JM
473 lookup_symbol_in_language (atcb_name, NULL, VAR_DOMAIN,
474 language_c, NULL);
5796c8dc 475 const struct symbol *common_atcb_sym =
c50c785c
JM
476 lookup_symbol_in_language (common_atcb_name, NULL, VAR_DOMAIN,
477 language_c, NULL);
5796c8dc 478 const struct symbol *private_data_sym =
c50c785c
JM
479 lookup_symbol_in_language (private_data_name, NULL, VAR_DOMAIN,
480 language_c, NULL);
5796c8dc 481 const struct symbol *entry_call_record_sym =
c50c785c
JM
482 lookup_symbol_in_language (entry_call_record_name, NULL, VAR_DOMAIN,
483 language_c, NULL);
5796c8dc
SS
484
485 if (atcb_sym == NULL || atcb_sym->type == NULL)
486 {
487 /* In Ravenscar run-time libs, the ATCB does not have a dynamic
488 size, so the symbol name differs. */
c50c785c
JM
489 atcb_sym = lookup_symbol_in_language (atcb_name_fixed, NULL, VAR_DOMAIN,
490 language_c, NULL);
5796c8dc
SS
491
492 if (atcb_sym == NULL || atcb_sym->type == NULL)
493 error (_("Cannot find Ada_Task_Control_Block type. Aborting"));
494
495 type = atcb_sym->type;
496 }
497 else
498 {
499 /* Get a static representation of the type record
500 Ada_Task_Control_Block. */
501 type = atcb_sym->type;
502 type = ada_template_to_fixed_record_type_1 (type, NULL, 0, NULL, 0);
503 }
504
505 if (common_atcb_sym == NULL || common_atcb_sym->type == NULL)
506 error (_("Cannot find Common_ATCB type. Aborting"));
507 if (private_data_sym == NULL || private_data_sym->type == NULL)
508 error (_("Cannot find Private_Data type. Aborting"));
509 if (entry_call_record_sym == NULL || entry_call_record_sym->type == NULL)
510 error (_("Cannot find Entry_Call_Record type. Aborting"));
511
512 /* Get the type for Ada_Task_Control_Block.Common. */
513 common_type = common_atcb_sym->type;
514
515 /* Get the type for Ada_Task_Control_Bloc.Common.Call.LL. */
516 ll_type = private_data_sym->type;
517
518 /* Get the type for Common_ATCB.Call.all. */
519 call_type = entry_call_record_sym->type;
520
521 /* Get the field indices. */
522 fieldnos.common = ada_get_field_index (type, "common", 0);
523 fieldnos.entry_calls = ada_get_field_index (type, "entry_calls", 1);
524 fieldnos.atc_nesting_level =
525 ada_get_field_index (type, "atc_nesting_level", 1);
526 fieldnos.state = ada_get_field_index (common_type, "state", 0);
527 fieldnos.parent = ada_get_field_index (common_type, "parent", 1);
528 fieldnos.priority = ada_get_field_index (common_type, "base_priority", 0);
529 fieldnos.image = ada_get_field_index (common_type, "task_image", 1);
530 fieldnos.image_len = ada_get_field_index (common_type, "task_image_len", 1);
a45ae5f8
JM
531 fieldnos.activation_link = ada_get_field_index (common_type,
532 "activation_link", 1);
5796c8dc
SS
533 fieldnos.call = ada_get_field_index (common_type, "call", 1);
534 fieldnos.ll = ada_get_field_index (common_type, "ll", 0);
535 fieldnos.ll_thread = ada_get_field_index (ll_type, "thread", 0);
536 fieldnos.ll_lwp = ada_get_field_index (ll_type, "lwp", 1);
537 fieldnos.call_self = ada_get_field_index (call_type, "self", 0);
538
539 /* On certain platforms such as x86-windows, the "lwp" field has been
540 named "thread_id". This field will likely be renamed in the future,
541 but we need to support both possibilities to avoid an unnecessary
542 dependency on a recent compiler. We therefore try locating the
543 "thread_id" field in place of the "lwp" field if we did not find
544 the latter. */
545 if (fieldnos.ll_lwp < 0)
546 fieldnos.ll_lwp = ada_get_field_index (ll_type, "thread_id", 1);
547
548 /* Set all the out parameters all at once, now that we are certain
549 that there are no potential error() anymore. */
a45ae5f8
JM
550 pspace_data = get_ada_tasks_pspace_data (current_program_space);
551 pspace_data->initialized_p = 1;
552 pspace_data->atcb_type = type;
553 pspace_data->atcb_common_type = common_type;
554 pspace_data->atcb_ll_type = ll_type;
555 pspace_data->atcb_call_type = call_type;
556 pspace_data->atcb_fieldno = fieldnos;
5796c8dc
SS
557}
558
559/* Build the PTID of the task from its COMMON_VALUE, which is the "Common"
560 component of its ATCB record. This PTID needs to match the PTID used
561 by the thread layer. */
562
563static ptid_t
564ptid_from_atcb_common (struct value *common_value)
565{
566 long thread = 0;
567 CORE_ADDR lwp = 0;
568 struct value *ll_value;
569 ptid_t ptid;
a45ae5f8
JM
570 const struct ada_tasks_pspace_data *pspace_data
571 = get_ada_tasks_pspace_data (current_program_space);
5796c8dc 572
a45ae5f8 573 ll_value = value_field (common_value, pspace_data->atcb_fieldno.ll);
5796c8dc 574
a45ae5f8
JM
575 if (pspace_data->atcb_fieldno.ll_lwp >= 0)
576 lwp = value_as_address (value_field (ll_value,
577 pspace_data->atcb_fieldno.ll_lwp));
578 thread = value_as_long (value_field (ll_value,
579 pspace_data->atcb_fieldno.ll_thread));
5796c8dc
SS
580
581 ptid = target_get_ada_task_ptid (lwp, thread);
582
583 return ptid;
584}
585
586/* Read the ATCB data of a given task given its TASK_ID (which is in practice
587 the address of its assocated ATCB record), and store the result inside
588 TASK_INFO. */
589
590static void
591read_atcb (CORE_ADDR task_id, struct ada_task_info *task_info)
592{
593 struct value *tcb_value;
594 struct value *common_value;
595 struct value *atc_nesting_level_value;
596 struct value *entry_calls_value;
597 struct value *entry_calls_value_element;
598 int called_task_fieldno = -1;
a45ae5f8
JM
599 static const char ravenscar_task_name[] = "Ravenscar task";
600 const struct ada_tasks_pspace_data *pspace_data
601 = get_ada_tasks_pspace_data (current_program_space);
5796c8dc 602
a45ae5f8
JM
603 if (!pspace_data->initialized_p)
604 get_tcb_types_info ();
5796c8dc 605
a45ae5f8
JM
606 tcb_value = value_from_contents_and_address (pspace_data->atcb_type,
607 NULL, task_id);
608 common_value = value_field (tcb_value, pspace_data->atcb_fieldno.common);
5796c8dc
SS
609
610 /* Fill in the task_id. */
611
612 task_info->task_id = task_id;
613
614 /* Compute the name of the task.
615
616 Depending on the GNAT version used, the task image is either a fat
617 string, or a thin array of characters. Older versions of GNAT used
618 to use fat strings, and therefore did not need an extra field in
c50c785c 619 the ATCB to store the string length. For efficiency reasons, newer
5796c8dc
SS
620 versions of GNAT replaced the fat string by a static buffer, but this
621 also required the addition of a new field named "Image_Len" containing
c50c785c 622 the length of the task name. The method used to extract the task name
5796c8dc
SS
623 is selected depending on the existence of this field.
624
625 In some run-time libs (e.g. Ravenscar), the name is not in the ATCB;
c50c785c 626 we may want to get it from the first user frame of the stack. For now,
5796c8dc
SS
627 we just give a dummy name. */
628
a45ae5f8 629 if (pspace_data->atcb_fieldno.image_len == -1)
5796c8dc 630 {
a45ae5f8 631 if (pspace_data->atcb_fieldno.image >= 0)
5796c8dc 632 read_fat_string_value (task_info->name,
a45ae5f8
JM
633 value_field (common_value,
634 pspace_data->atcb_fieldno.image),
5796c8dc
SS
635 sizeof (task_info->name) - 1);
636 else
a45ae5f8
JM
637 {
638 struct minimal_symbol *msym;
639
640 msym = lookup_minimal_symbol_by_pc (task_id);
641 if (msym)
642 {
643 const char *full_name = SYMBOL_LINKAGE_NAME (msym);
644 const char *task_name = full_name;
645 const char *p;
646
647 /* Strip the prefix. */
648 for (p = full_name; *p; p++)
649 if (p[0] == '_' && p[1] == '_')
650 task_name = p + 2;
651
652 /* Copy the task name. */
653 strncpy (task_info->name, task_name, sizeof (task_info->name));
654 task_info->name[sizeof (task_info->name) - 1] = 0;
655 }
656 else
657 {
658 /* No symbol found. Use a default name. */
659 strcpy (task_info->name, ravenscar_task_name);
660 }
661 }
5796c8dc
SS
662 }
663 else
664 {
a45ae5f8
JM
665 int len = value_as_long
666 (value_field (common_value,
667 pspace_data->atcb_fieldno.image_len));
5796c8dc
SS
668
669 value_as_string (task_info->name,
a45ae5f8
JM
670 value_field (common_value,
671 pspace_data->atcb_fieldno.image),
672 len);
5796c8dc
SS
673 }
674
675 /* Compute the task state and priority. */
676
a45ae5f8
JM
677 task_info->state =
678 value_as_long (value_field (common_value,
679 pspace_data->atcb_fieldno.state));
5796c8dc 680 task_info->priority =
a45ae5f8
JM
681 value_as_long (value_field (common_value,
682 pspace_data->atcb_fieldno.priority));
5796c8dc
SS
683
684 /* If the ATCB contains some information about the parent task,
685 then compute it as well. Otherwise, zero. */
686
a45ae5f8 687 if (pspace_data->atcb_fieldno.parent >= 0)
5796c8dc 688 task_info->parent =
a45ae5f8
JM
689 value_as_address (value_field (common_value,
690 pspace_data->atcb_fieldno.parent));
5796c8dc
SS
691 else
692 task_info->parent = 0;
693
694
695 /* If the ATCB contains some information about entry calls, then
696 compute the "called_task" as well. Otherwise, zero. */
697
a45ae5f8
JM
698 if (pspace_data->atcb_fieldno.atc_nesting_level > 0
699 && pspace_data->atcb_fieldno.entry_calls > 0)
5796c8dc
SS
700 {
701 /* Let My_ATCB be the Ada task control block of a task calling the
702 entry of another task; then the Task_Id of the called task is
703 in My_ATCB.Entry_Calls (My_ATCB.ATC_Nesting_Level).Called_Task. */
a45ae5f8
JM
704 atc_nesting_level_value =
705 value_field (tcb_value, pspace_data->atcb_fieldno.atc_nesting_level);
5796c8dc 706 entry_calls_value =
a45ae5f8
JM
707 ada_coerce_to_simple_array_ptr
708 (value_field (tcb_value, pspace_data->atcb_fieldno.entry_calls));
5796c8dc
SS
709 entry_calls_value_element =
710 value_subscript (entry_calls_value,
711 value_as_long (atc_nesting_level_value));
712 called_task_fieldno =
713 ada_get_field_index (value_type (entry_calls_value_element),
714 "called_task", 0);
715 task_info->called_task =
716 value_as_address (value_field (entry_calls_value_element,
717 called_task_fieldno));
718 }
719 else
720 {
721 task_info->called_task = 0;
722 }
723
724 /* If the ATCB cotnains some information about RV callers,
725 then compute the "caller_task". Otherwise, zero. */
726
727 task_info->caller_task = 0;
a45ae5f8 728 if (pspace_data->atcb_fieldno.call >= 0)
5796c8dc
SS
729 {
730 /* Get the ID of the caller task from Common_ATCB.Call.all.Self.
731 If Common_ATCB.Call is null, then there is no caller. */
732 const CORE_ADDR call =
a45ae5f8
JM
733 value_as_address (value_field (common_value,
734 pspace_data->atcb_fieldno.call));
5796c8dc
SS
735 struct value *call_val;
736
737 if (call != 0)
738 {
739 call_val =
a45ae5f8
JM
740 value_from_contents_and_address (pspace_data->atcb_call_type,
741 NULL, call);
5796c8dc 742 task_info->caller_task =
a45ae5f8
JM
743 value_as_address
744 (value_field (call_val, pspace_data->atcb_fieldno.call_self));
5796c8dc
SS
745 }
746 }
747
c50c785c
JM
748 /* And finally, compute the task ptid. Note that there are situations
749 where this cannot be determined:
750 - The task is no longer alive - the ptid is irrelevant;
751 - We are debugging a core file - the thread is not always
752 completely preserved for us to link back a task to its
753 underlying thread. Since we do not support task switching
754 when debugging core files anyway, we don't need to compute
755 that task ptid.
756 In either case, we don't need that ptid, and it is just good enough
757 to set it to null_ptid. */
758
759 if (target_has_execution && ada_task_is_alive (task_info))
5796c8dc
SS
760 task_info->ptid = ptid_from_atcb_common (common_value);
761 else
762 task_info->ptid = null_ptid;
763}
764
765/* Read the ATCB info of the given task (identified by TASK_ID), and
a45ae5f8 766 add the result to the given inferior's TASK_LIST. */
5796c8dc
SS
767
768static void
a45ae5f8 769add_ada_task (CORE_ADDR task_id, struct inferior *inf)
5796c8dc
SS
770{
771 struct ada_task_info task_info;
a45ae5f8 772 struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
5796c8dc
SS
773
774 read_atcb (task_id, &task_info);
a45ae5f8 775 VEC_safe_push (ada_task_info_s, data->task_list, &task_info);
5796c8dc
SS
776}
777
778/* Read the Known_Tasks array from the inferior memory, and store
a45ae5f8 779 it in the current inferior's TASK_LIST. Return non-zero upon success. */
5796c8dc
SS
780
781static int
ef5ccd6c 782read_known_tasks_array (struct ada_tasks_inferior_data *data)
5796c8dc 783{
ef5ccd6c
JM
784 const int target_ptr_byte = TYPE_LENGTH (data->known_tasks_element);
785 const int known_tasks_size = target_ptr_byte * data->known_tasks_length;
5796c8dc
SS
786 gdb_byte *known_tasks = alloca (known_tasks_size);
787 int i;
788
a45ae5f8
JM
789 /* Build a new list by reading the ATCBs from the Known_Tasks array
790 in the Ada runtime. */
ef5ccd6c
JM
791 read_memory (data->known_tasks_addr, known_tasks, known_tasks_size);
792 for (i = 0; i < data->known_tasks_length; i++)
5796c8dc 793 {
5796c8dc
SS
794 CORE_ADDR task_id =
795 extract_typed_address (known_tasks + i * target_ptr_byte,
ef5ccd6c 796 data->known_tasks_element);
5796c8dc
SS
797
798 if (task_id != 0)
a45ae5f8 799 add_ada_task (task_id, current_inferior ());
5796c8dc
SS
800 }
801
5796c8dc
SS
802 return 1;
803}
804
a45ae5f8
JM
805/* Read the known tasks from the inferior memory, and store it in
806 the current inferior's TASK_LIST. Return non-zero upon success. */
5796c8dc 807
a45ae5f8 808static int
ef5ccd6c 809read_known_tasks_list (struct ada_tasks_inferior_data *data)
5796c8dc 810{
ef5ccd6c 811 const int target_ptr_byte = TYPE_LENGTH (data->known_tasks_element);
a45ae5f8 812 gdb_byte *known_tasks = alloca (target_ptr_byte);
a45ae5f8
JM
813 CORE_ADDR task_id;
814 const struct ada_tasks_pspace_data *pspace_data
815 = get_ada_tasks_pspace_data (current_program_space);
816
817 /* Sanity check. */
818 if (pspace_data->atcb_fieldno.activation_link < 0)
819 return 0;
5796c8dc 820
a45ae5f8 821 /* Build a new list by reading the ATCBs. Read head of the list. */
ef5ccd6c
JM
822 read_memory (data->known_tasks_addr, known_tasks, target_ptr_byte);
823 task_id = extract_typed_address (known_tasks, data->known_tasks_element);
a45ae5f8 824 while (task_id != 0)
5796c8dc 825 {
a45ae5f8
JM
826 struct value *tcb_value;
827 struct value *common_value;
828
829 add_ada_task (task_id, current_inferior ());
830
831 /* Read the chain. */
832 tcb_value = value_from_contents_and_address (pspace_data->atcb_type,
833 NULL, task_id);
834 common_value = value_field (tcb_value, pspace_data->atcb_fieldno.common);
835 task_id = value_as_address
836 (value_field (common_value,
837 pspace_data->atcb_fieldno.activation_link));
5796c8dc
SS
838 }
839
840 return 1;
841}
842
ef5ccd6c
JM
843/* Set all fields of the current inferior ada-tasks data pointed by DATA.
844 Do nothing if those fields are already set and still up to date. */
5796c8dc
SS
845
846static void
ef5ccd6c 847ada_tasks_inferior_data_sniffer (struct ada_tasks_inferior_data *data)
5796c8dc 848{
ef5ccd6c
JM
849 struct minimal_symbol *msym;
850 struct symbol *sym;
5796c8dc 851
ef5ccd6c 852 /* Return now if already set. */
a45ae5f8
JM
853 if (data->known_tasks_kind != ADA_TASKS_UNKNOWN)
854 return;
5796c8dc 855
ef5ccd6c
JM
856 /* Try array. */
857
858 msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
859 if (msym != NULL)
a45ae5f8
JM
860 {
861 data->known_tasks_kind = ADA_TASKS_ARRAY;
ef5ccd6c
JM
862 data->known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
863
864 /* Try to get pointer type and array length from the symtab. */
865 sym = lookup_symbol_in_language (KNOWN_TASKS_NAME, NULL, VAR_DOMAIN,
866 language_c, NULL);
867 if (sym != NULL)
868 {
869 /* Validate. */
870 struct type *type = check_typedef (SYMBOL_TYPE (sym));
871 struct type *eltype = NULL;
872 struct type *idxtype = NULL;
873
874 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
875 eltype = check_typedef (TYPE_TARGET_TYPE (type));
876 if (eltype != NULL
877 && TYPE_CODE (eltype) == TYPE_CODE_PTR)
878 idxtype = check_typedef (TYPE_INDEX_TYPE (type));
879 if (idxtype != NULL
880 && !TYPE_LOW_BOUND_UNDEFINED (idxtype)
881 && !TYPE_HIGH_BOUND_UNDEFINED (idxtype))
882 {
883 data->known_tasks_element = eltype;
884 data->known_tasks_length =
885 TYPE_HIGH_BOUND (idxtype) - TYPE_LOW_BOUND (idxtype) + 1;
886 return;
887 }
888 }
889
890 /* Fallback to default values. The runtime may have been stripped (as
891 in some distributions), but it is likely that the executable still
892 contains debug information on the task type (due to implicit with of
893 Ada.Tasking). */
894 data->known_tasks_element =
895 builtin_type (target_gdbarch ())->builtin_data_ptr;
896 data->known_tasks_length = MAX_NUMBER_OF_KNOWN_TASKS;
a45ae5f8
JM
897 return;
898 }
5796c8dc 899
ef5ccd6c
JM
900
901 /* Try list. */
902
903 msym = lookup_minimal_symbol (KNOWN_TASKS_LIST, NULL, NULL);
904 if (msym != NULL)
a45ae5f8
JM
905 {
906 data->known_tasks_kind = ADA_TASKS_LIST;
ef5ccd6c
JM
907 data->known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
908 data->known_tasks_length = 1;
909
910 sym = lookup_symbol_in_language (KNOWN_TASKS_LIST, NULL, VAR_DOMAIN,
911 language_c, NULL);
912 if (sym != NULL && SYMBOL_VALUE_ADDRESS (sym) != 0)
913 {
914 /* Validate. */
915 struct type *type = check_typedef (SYMBOL_TYPE (sym));
916
917 if (TYPE_CODE (type) == TYPE_CODE_PTR)
918 {
919 data->known_tasks_element = type;
920 return;
921 }
922 }
923
924 /* Fallback to default values. */
925 data->known_tasks_element =
926 builtin_type (target_gdbarch ())->builtin_data_ptr;
927 data->known_tasks_length = 1;
a45ae5f8
JM
928 return;
929 }
5796c8dc 930
ef5ccd6c
JM
931 /* Can't find tasks. */
932
a45ae5f8
JM
933 data->known_tasks_kind = ADA_TASKS_NOT_FOUND;
934 data->known_tasks_addr = 0;
935}
5796c8dc 936
a45ae5f8
JM
937/* Read the known tasks from the current inferior's memory, and store it
938 in the current inferior's data TASK_LIST.
939 Return non-zero upon success. */
5796c8dc 940
a45ae5f8
JM
941static int
942read_known_tasks (void)
943{
944 struct ada_tasks_inferior_data *data =
945 get_ada_tasks_inferior_data (current_inferior ());
5796c8dc 946
a45ae5f8
JM
947 /* Step 1: Clear the current list, if necessary. */
948 VEC_truncate (ada_task_info_s, data->task_list, 0);
5796c8dc 949
a45ae5f8
JM
950 /* Step 2: do the real work.
951 If the application does not use task, then no more needs to be done.
952 It is important to have the task list cleared (see above) before we
953 return, as we don't want a stale task list to be used... This can
954 happen for instance when debugging a non-multitasking program after
955 having debugged a multitasking one. */
ef5ccd6c 956 ada_tasks_inferior_data_sniffer (data);
a45ae5f8 957 gdb_assert (data->known_tasks_kind != ADA_TASKS_UNKNOWN);
5796c8dc 958
a45ae5f8
JM
959 switch (data->known_tasks_kind)
960 {
961 case ADA_TASKS_NOT_FOUND: /* Tasking not in use in inferior. */
962 return 0;
963 case ADA_TASKS_ARRAY:
ef5ccd6c 964 return read_known_tasks_array (data);
a45ae5f8 965 case ADA_TASKS_LIST:
ef5ccd6c 966 return read_known_tasks_list (data);
a45ae5f8
JM
967 }
968
969 /* Step 3: Set task_list_valid_p, to avoid re-reading the Known_Tasks
970 array unless needed. Then report a success. */
971 data->task_list_valid_p = 1;
972
973 return 1;
5796c8dc
SS
974}
975
a45ae5f8
JM
976/* Build the task_list by reading the Known_Tasks array from
977 the inferior, and return the number of tasks in that list
978 (zero means that the program is not using tasking at all). */
5796c8dc 979
a45ae5f8
JM
980int
981ada_build_task_list (void)
5796c8dc 982{
a45ae5f8 983 struct ada_tasks_inferior_data *data;
5796c8dc 984
a45ae5f8
JM
985 if (!target_has_stack)
986 error (_("Cannot inspect Ada tasks when program is not running"));
987
988 data = get_ada_tasks_inferior_data (current_inferior ());
989 if (!data->task_list_valid_p)
990 read_known_tasks ();
991
992 return VEC_length (ada_task_info_s, data->task_list);
5796c8dc
SS
993}
994
a45ae5f8
JM
995/* Print a table providing a short description of all Ada tasks
996 running inside inferior INF. If ARG_STR is set, it will be
997 interpreted as a task number, and the table will be limited to
998 that task only. */
999
1000void
1001print_ada_task_info (struct ui_out *uiout,
1002 char *arg_str,
1003 struct inferior *inf)
1004{
1005 struct ada_tasks_inferior_data *data;
1006 int taskno, nb_tasks;
1007 int taskno_arg = 0;
1008 struct cleanup *old_chain;
1009 int nb_columns;
1010
1011 if (ada_build_task_list () == 0)
1012 {
1013 ui_out_message (uiout, 0,
1014 _("Your application does not use any Ada tasks.\n"));
1015 return;
1016 }
1017
1018 if (arg_str != NULL && arg_str[0] != '\0')
1019 taskno_arg = value_as_long (parse_and_eval (arg_str));
1020
1021 if (ui_out_is_mi_like_p (uiout))
1022 /* In GDB/MI mode, we want to provide the thread ID corresponding
1023 to each task. This allows clients to quickly find the thread
1024 associated to any task, which is helpful for commands that
1025 take a --thread argument. However, in order to be able to
1026 provide that thread ID, the thread list must be up to date
1027 first. */
1028 target_find_new_threads ();
1029
1030 data = get_ada_tasks_inferior_data (inf);
1031
1032 /* Compute the number of tasks that are going to be displayed
1033 in the output. If an argument was given, there will be
1034 at most 1 entry. Otherwise, there will be as many entries
1035 as we have tasks. */
1036 if (taskno_arg)
1037 {
1038 if (taskno_arg > 0
1039 && taskno_arg <= VEC_length (ada_task_info_s, data->task_list))
1040 nb_tasks = 1;
1041 else
1042 nb_tasks = 0;
1043 }
1044 else
1045 nb_tasks = VEC_length (ada_task_info_s, data->task_list);
1046
1047 nb_columns = ui_out_is_mi_like_p (uiout) ? 8 : 7;
1048 old_chain = make_cleanup_ui_out_table_begin_end (uiout, nb_columns,
1049 nb_tasks, "tasks");
1050 ui_out_table_header (uiout, 1, ui_left, "current", "");
1051 ui_out_table_header (uiout, 3, ui_right, "id", "ID");
1052 ui_out_table_header (uiout, 9, ui_right, "task-id", "TID");
1053 /* The following column is provided in GDB/MI mode only because
1054 it is only really useful in that mode, and also because it
1055 allows us to keep the CLI output shorter and more compact. */
1056 if (ui_out_is_mi_like_p (uiout))
1057 ui_out_table_header (uiout, 4, ui_right, "thread-id", "");
1058 ui_out_table_header (uiout, 4, ui_right, "parent-id", "P-ID");
1059 ui_out_table_header (uiout, 3, ui_right, "priority", "Pri");
1060 ui_out_table_header (uiout, 22, ui_left, "state", "State");
1061 /* Use ui_noalign for the last column, to prevent the CLI uiout
1062 from printing an extra space at the end of each row. This
1063 is a bit of a hack, but does get the job done. */
1064 ui_out_table_header (uiout, 1, ui_noalign, "name", "Name");
1065 ui_out_table_body (uiout);
1066
1067 for (taskno = 1;
1068 taskno <= VEC_length (ada_task_info_s, data->task_list);
1069 taskno++)
1070 {
1071 const struct ada_task_info *const task_info =
1072 VEC_index (ada_task_info_s, data->task_list, taskno - 1);
1073 int parent_id;
1074 struct cleanup *chain2;
1075
1076 gdb_assert (task_info != NULL);
1077
1078 /* If the user asked for the output to be restricted
1079 to one task only, and this is not the task, skip
1080 to the next one. */
1081 if (taskno_arg && taskno != taskno_arg)
1082 continue;
1083
1084 chain2 = make_cleanup_ui_out_tuple_begin_end (uiout, NULL);
1085
1086 /* Print a star if this task is the current task (or the task
1087 currently selected). */
1088 if (ptid_equal (task_info->ptid, inferior_ptid))
1089 ui_out_field_string (uiout, "current", "*");
1090 else
1091 ui_out_field_skip (uiout, "current");
1092
1093 /* Print the task number. */
1094 ui_out_field_int (uiout, "id", taskno);
1095
1096 /* Print the Task ID. */
1097 ui_out_field_fmt (uiout, "task-id", "%9lx", (long) task_info->task_id);
1098
1099 /* Print the associated Thread ID. */
1100 if (ui_out_is_mi_like_p (uiout))
1101 {
1102 const int thread_id = pid_to_thread_id (task_info->ptid);
1103
1104 if (thread_id != 0)
1105 ui_out_field_int (uiout, "thread-id", thread_id);
1106 else
1107 /* This should never happen unless there is a bug somewhere,
1108 but be resilient when that happens. */
1109 ui_out_field_skip (uiout, "thread-id");
1110 }
1111
1112 /* Print the ID of the parent task. */
1113 parent_id = get_task_number_from_id (task_info->parent, inf);
1114 if (parent_id)
1115 ui_out_field_int (uiout, "parent-id", parent_id);
1116 else
1117 ui_out_field_skip (uiout, "parent-id");
1118
1119 /* Print the base priority of the task. */
1120 ui_out_field_int (uiout, "priority", task_info->priority);
1121
1122 /* Print the task current state. */
1123 if (task_info->caller_task)
1124 ui_out_field_fmt (uiout, "state",
1125 _("Accepting RV with %-4d"),
1126 get_task_number_from_id (task_info->caller_task,
1127 inf));
1128 else if (task_info->state == Entry_Caller_Sleep
1129 && task_info->called_task)
1130 ui_out_field_fmt (uiout, "state",
1131 _("Waiting on RV with %-3d"),
1132 get_task_number_from_id (task_info->called_task,
1133 inf));
1134 else
1135 ui_out_field_string (uiout, "state", task_states[task_info->state]);
1136
1137 /* Finally, print the task name. */
1138 ui_out_field_fmt (uiout, "name",
1139 "%s",
1140 task_info->name[0] != '\0' ? task_info->name
1141 : _("<no name>"));
1142
1143 ui_out_text (uiout, "\n");
1144 do_cleanups (chain2);
1145 }
1146
1147 do_cleanups (old_chain);
1148}
1149
1150/* Print a detailed description of the Ada task whose ID is TASKNO_STR
1151 for the given inferior (INF). */
5796c8dc
SS
1152
1153static void
a45ae5f8 1154info_task (struct ui_out *uiout, char *taskno_str, struct inferior *inf)
5796c8dc
SS
1155{
1156 const int taskno = value_as_long (parse_and_eval (taskno_str));
1157 struct ada_task_info *task_info;
1158 int parent_taskno = 0;
a45ae5f8 1159 struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
5796c8dc 1160
a45ae5f8
JM
1161 if (ada_build_task_list () == 0)
1162 {
1163 ui_out_message (uiout, 0,
1164 _("Your application does not use any Ada tasks.\n"));
1165 return;
1166 }
1167
1168 if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, data->task_list))
5796c8dc
SS
1169 error (_("Task ID %d not known. Use the \"info tasks\" command to\n"
1170 "see the IDs of currently known tasks"), taskno);
a45ae5f8 1171 task_info = VEC_index (ada_task_info_s, data->task_list, taskno - 1);
5796c8dc
SS
1172
1173 /* Print the Ada task ID. */
1174 printf_filtered (_("Ada Task: %s\n"),
ef5ccd6c 1175 paddress (target_gdbarch (), task_info->task_id));
5796c8dc
SS
1176
1177 /* Print the name of the task. */
1178 if (task_info->name[0] != '\0')
1179 printf_filtered (_("Name: %s\n"), task_info->name);
1180 else
1181 printf_filtered (_("<no name>\n"));
1182
1183 /* Print the TID and LWP. */
1184 printf_filtered (_("Thread: %#lx\n"), ptid_get_tid (task_info->ptid));
1185 printf_filtered (_("LWP: %#lx\n"), ptid_get_lwp (task_info->ptid));
1186
1187 /* Print who is the parent (if any). */
1188 if (task_info->parent != 0)
a45ae5f8 1189 parent_taskno = get_task_number_from_id (task_info->parent, inf);
5796c8dc
SS
1190 if (parent_taskno)
1191 {
1192 struct ada_task_info *parent =
a45ae5f8 1193 VEC_index (ada_task_info_s, data->task_list, parent_taskno - 1);
5796c8dc
SS
1194
1195 printf_filtered (_("Parent: %d"), parent_taskno);
1196 if (parent->name[0] != '\0')
1197 printf_filtered (" (%s)", parent->name);
1198 printf_filtered ("\n");
1199 }
1200 else
1201 printf_filtered (_("No parent\n"));
1202
1203 /* Print the base priority. */
1204 printf_filtered (_("Base Priority: %d\n"), task_info->priority);
1205
1206 /* print the task current state. */
1207 {
1208 int target_taskno = 0;
1209
1210 if (task_info->caller_task)
1211 {
a45ae5f8 1212 target_taskno = get_task_number_from_id (task_info->caller_task, inf);
5796c8dc
SS
1213 printf_filtered (_("State: Accepting rendezvous with %d"),
1214 target_taskno);
1215 }
1216 else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
1217 {
a45ae5f8 1218 target_taskno = get_task_number_from_id (task_info->called_task, inf);
5796c8dc
SS
1219 printf_filtered (_("State: Waiting on task %d's entry"),
1220 target_taskno);
1221 }
1222 else
1223 printf_filtered (_("State: %s"), _(long_task_states[task_info->state]));
1224
1225 if (target_taskno)
1226 {
1227 struct ada_task_info *target_task_info =
a45ae5f8 1228 VEC_index (ada_task_info_s, data->task_list, target_taskno - 1);
5796c8dc
SS
1229
1230 if (target_task_info->name[0] != '\0')
1231 printf_filtered (" (%s)", target_task_info->name);
1232 }
1233
1234 printf_filtered ("\n");
1235 }
1236}
1237
1238/* If ARG is empty or null, then print a list of all Ada tasks.
1239 Otherwise, print detailed information about the task whose ID
1240 is ARG.
1241
1242 Does nothing if the program doesn't use Ada tasking. */
1243
1244static void
1245info_tasks_command (char *arg, int from_tty)
1246{
a45ae5f8 1247 struct ui_out *uiout = current_uiout;
5796c8dc
SS
1248
1249 if (arg == NULL || *arg == '\0')
a45ae5f8 1250 print_ada_task_info (uiout, NULL, current_inferior ());
5796c8dc 1251 else
a45ae5f8 1252 info_task (uiout, arg, current_inferior ());
5796c8dc
SS
1253}
1254
1255/* Print a message telling the user id of the current task.
1256 This function assumes that tasking is in use in the inferior. */
1257
1258static void
1259display_current_task_id (void)
1260{
1261 const int current_task = ada_get_task_number (inferior_ptid);
1262
1263 if (current_task == 0)
1264 printf_filtered (_("[Current task is unknown]\n"));
1265 else
1266 printf_filtered (_("[Current task is %d]\n"), current_task);
1267}
1268
1269/* Parse and evaluate TIDSTR into a task id, and try to switch to
1270 that task. Print an error message if the task switch failed. */
1271
1272static void
a45ae5f8 1273task_command_1 (char *taskno_str, int from_tty, struct inferior *inf)
5796c8dc
SS
1274{
1275 const int taskno = value_as_long (parse_and_eval (taskno_str));
1276 struct ada_task_info *task_info;
a45ae5f8 1277 struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
5796c8dc 1278
a45ae5f8 1279 if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, data->task_list))
5796c8dc
SS
1280 error (_("Task ID %d not known. Use the \"info tasks\" command to\n"
1281 "see the IDs of currently known tasks"), taskno);
a45ae5f8 1282 task_info = VEC_index (ada_task_info_s, data->task_list, taskno - 1);
5796c8dc
SS
1283
1284 if (!ada_task_is_alive (task_info))
1285 error (_("Cannot switch to task %d: Task is no longer running"), taskno);
1286
1287 /* On some platforms, the thread list is not updated until the user
1288 performs a thread-related operation (by using the "info threads"
1289 command, for instance). So this thread list may not be up to date
1290 when the user attempts this task switch. Since we cannot switch
1291 to the thread associated to our task if GDB does not know about
1292 that thread, we need to make sure that any new threads gets added
1293 to the thread list. */
1294 target_find_new_threads ();
1295
cf7f2e2d
JM
1296 /* Verify that the ptid of the task we want to switch to is valid
1297 (in other words, a ptid that GDB knows about). Otherwise, we will
1298 cause an assertion failure later on, when we try to determine
1299 the ptid associated thread_info data. We should normally never
1300 encounter such an error, but the wrong ptid can actually easily be
1301 computed if target_get_ada_task_ptid has not been implemented for
1302 our target (yet). Rather than cause an assertion error in that case,
1303 it's nicer for the user to just refuse to perform the task switch. */
1304 if (!find_thread_ptid (task_info->ptid))
1305 error (_("Unable to compute thread ID for task %d.\n"
1306 "Cannot switch to this task."),
1307 taskno);
1308
5796c8dc
SS
1309 switch_to_thread (task_info->ptid);
1310 ada_find_printable_frame (get_selected_frame (NULL));
1311 printf_filtered (_("[Switching to task %d]\n"), taskno);
1312 print_stack_frame (get_selected_frame (NULL),
1313 frame_relative_level (get_selected_frame (NULL)), 1);
1314}
1315
1316
1317/* Print the ID of the current task if TASKNO_STR is empty or NULL.
1318 Otherwise, switch to the task indicated by TASKNO_STR. */
1319
1320static void
1321task_command (char *taskno_str, int from_tty)
1322{
a45ae5f8 1323 struct ui_out *uiout = current_uiout;
5796c8dc 1324
a45ae5f8
JM
1325 if (ada_build_task_list () == 0)
1326 {
1327 ui_out_message (uiout, 0,
1328 _("Your application does not use any Ada tasks.\n"));
1329 return;
1330 }
5796c8dc
SS
1331
1332 if (taskno_str == NULL || taskno_str[0] == '\0')
1333 display_current_task_id ();
1334 else
1335 {
1336 /* Task switching in core files doesn't work, either because:
1337 1. Thread support is not implemented with core files
1338 2. Thread support is implemented, but the thread IDs created
1339 after having read the core file are not the same as the ones
1340 that were used during the program life, before the crash.
1341 As a consequence, there is no longer a way for the debugger
1342 to find the associated thead ID of any given Ada task.
1343 So, instead of attempting a task switch without giving the user
1344 any clue as to what might have happened, just error-out with
1345 a message explaining that this feature is not supported. */
1346 if (!target_has_execution)
1347 error (_("\
1348Task switching not supported when debugging from core files\n\
1349(use thread support instead)"));
a45ae5f8 1350 task_command_1 (taskno_str, from_tty, current_inferior ());
5796c8dc
SS
1351 }
1352}
1353
a45ae5f8
JM
1354/* Indicate that the given inferior's task list may have changed,
1355 so invalidate the cache. */
5796c8dc
SS
1356
1357static void
a45ae5f8 1358ada_task_list_changed (struct inferior *inf)
5796c8dc 1359{
a45ae5f8
JM
1360 struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
1361
1362 data->task_list_valid_p = 0;
1363}
1364
1365/* Invalidate the per-program-space data. */
1366
1367static void
1368ada_tasks_invalidate_pspace_data (struct program_space *pspace)
1369{
1370 get_ada_tasks_pspace_data (pspace)->initialized_p = 0;
1371}
1372
1373/* Invalidate the per-inferior data. */
1374
1375static void
1376ada_tasks_invalidate_inferior_data (struct inferior *inf)
1377{
1378 struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
1379
1380 data->known_tasks_kind = ADA_TASKS_UNKNOWN;
1381 data->task_list_valid_p = 0;
5796c8dc
SS
1382}
1383
1384/* The 'normal_stop' observer notification callback. */
1385
1386static void
1387ada_normal_stop_observer (struct bpstats *unused_args, int unused_args2)
1388{
1389 /* The inferior has been resumed, and just stopped. This means that
1390 our task_list needs to be recomputed before it can be used again. */
a45ae5f8 1391 ada_task_list_changed (current_inferior ());
5796c8dc
SS
1392}
1393
1394/* A routine to be called when the objfiles have changed. */
1395
1396static void
1397ada_new_objfile_observer (struct objfile *objfile)
1398{
a45ae5f8
JM
1399 struct inferior *inf;
1400
1401 /* Invalidate the relevant data in our program-space data. */
1402
1403 if (objfile == NULL)
1404 {
1405 /* All objfiles are being cleared, so we should clear all
1406 our caches for all program spaces. */
1407 struct program_space *pspace;
1408
1409 for (pspace = program_spaces; pspace != NULL; pspace = pspace->next)
1410 ada_tasks_invalidate_pspace_data (pspace);
1411 }
1412 else
1413 {
1414 /* The associated program-space data might have changed after
1415 this objfile was added. Invalidate all cached data. */
1416 ada_tasks_invalidate_pspace_data (objfile->pspace);
1417 }
5796c8dc 1418
a45ae5f8
JM
1419 /* Invalidate the per-inferior cache for all inferiors using
1420 this objfile (or, in other words, for all inferiors who have
1421 the same program-space as the objfile's program space).
1422 If all objfiles are being cleared (OBJFILE is NULL), then
1423 clear the caches for all inferiors. */
5796c8dc 1424
a45ae5f8
JM
1425 for (inf = inferior_list; inf != NULL; inf = inf->next)
1426 if (objfile == NULL || inf->pspace == objfile->pspace)
1427 ada_tasks_invalidate_inferior_data (inf);
5796c8dc
SS
1428}
1429
1430/* Provide a prototype to silence -Wmissing-prototypes. */
1431extern initialize_file_ftype _initialize_tasks;
1432
1433void
1434_initialize_tasks (void)
1435{
a45ae5f8
JM
1436 ada_tasks_pspace_data_handle = register_program_space_data ();
1437 ada_tasks_inferior_data_handle = register_inferior_data ();
1438
5796c8dc
SS
1439 /* Attach various observers. */
1440 observer_attach_normal_stop (ada_normal_stop_observer);
1441 observer_attach_new_objfile (ada_new_objfile_observer);
1442
1443 /* Some new commands provided by this module. */
1444 add_info ("tasks", info_tasks_command,
1445 _("Provide information about all known Ada tasks"));
1446 add_cmd ("task", class_run, task_command,
1447 _("Use this command to switch between Ada tasks.\n\
1448Without argument, this command simply prints the current task ID"),
1449 &cmdlist);
1450}
1451