/* ------------------------------------------------------------------------
@NAME : convert_special_char()
@INPUT : transform
@INOUT : string
src
dst
start_sentence
after_colon
@RETURNS :
@DESCRIPTION: Does case conversion on a special character.
@GLOBALS :
@CALLS :
@CALLERS :
@CREATED : 1997/11/25, GPW
@MODIFIED :
-------------------------------------------------------------------------- */
static void
convert_special_char (char transform,
char * string,
int * src,
int * dst,
boolean * start_sentence,
boolean * after_colon)
{
int depth;
boolean done_special;
int cs_end;
int cs_len; /* counting the backslash */
bt_letter letter;
char * repl;
int repl_len;
#ifndef ALLOW_WARNINGS
repl = NULL; /* silence "might be used" */
/* uninitialized" warning */
#endif
/* First, copy just the opening brace */
string[(*dst)++] = string[(*src)++];
/*
* Now loop over characters inside the braces -- stop when we reach
* the matching close brace, or when the string ends.
*/
depth = 1; /* because we're in a special char */
done_special = FALSE;
while (string[*src] != 0 && !done_special)
{
switch (string[*src])
{
case '\\': /* a control sequence */
{
cs_end = *src+1; /* scan over chars of c.s. */
while (isalpha (string[cs_end]))
cs_end++;
/*
* OK, now *src points to the backslash (so src+*1 points to
* first char. of control sequence), and cs_end points to
* character immediately following end of control sequence.
* Thus we analyze [*src+1..cs_end] to determine if the control
* sequence is a foreign letter, and use (cs_end - (*src+1) + 1)
* = (cs_end - *src) as the length of the control sequence.
*/
cs_len = cs_end - *src; /* length of cs, counting backslash */
if (foreign_letter (string, *src+1, cs_end, &letter))
{
if (letter == L_OTHER)
internal_error ("impossible foreign letter");
switch (transform)
{
case 'u':
repl = uc_version[(int) letter];
break;
case 'l':
repl = lc_version[(int) letter];
break;
case 't':
if (*start_sentence || *after_colon)
{
repl = uc_version[(int) letter];
*start_sentence = *after_colon = FALSE;
}
else
{
repl = lc_version[(int) letter];
}
break;
default:
internal_error ("impossible case transform \"%c\"",
transform);
}
repl_len = strlen (repl);
if (repl_len > cs_len)
internal_error
("replacement text longer than original cs");
strncpy (string + *dst, repl, repl_len);
*src = cs_end;
*dst += repl_len;
} /* control sequence is a foreign letter */
else
{
/* not a foreign letter -- just copy the control seq. as is */
strncpy (string + *dst, string + *src, cs_end - *src);
*src += cs_len;
assert (*src == cs_end);
*dst += cs_len;
} /* control sequence not a foreign letter */
break;
} /* case: '\\' */
case '{':
{
string[(*dst)++] = string[(*src)++];
depth++;
break;
}
case '}':
{
string[(*dst)++] = string[(*src)++];
depth--;
if (depth == 0)
done_special = TRUE;
break;
}
default: /* any other character */
{
switch (transform)
{
/*
* Inside special chars, lowercase and title caps are same.
* (At least, that's bibtex's convention. I might change this
* at some point to be a bit smarter.)
*/
case 'l':
case 't':
string[(*dst)++] = tolower (string[(*src)++]);
break;
case 'u':
string[(*dst)++] = toupper (string[(*src)++]);
break;
default:
internal_error ("impossible case transform \"%c\"",
transform);
}
} /* default char */
} /* switch: current char */
} /* while: string or special char not done */
} /* convert_special_char() */
void
display_gdb_prompt (const char *new_prompt)
{
std::string actual_gdb_prompt;
annotate_display_prompt ();
/* Reset the nesting depth used when trace-commands is set. */
reset_command_nest_depth ();
/* Do not call the python hook on an explicit prompt change as
passed to this function, as this forms a secondary/local prompt,
IE, displayed but not set. */
if (! new_prompt)
{
struct ui *ui = current_ui;
if (ui->prompt_state == PROMPTED)
internal_error (__FILE__, __LINE__, _("double prompt"));
else if (ui->prompt_state == PROMPT_BLOCKED)
{
/* This is to trick readline into not trying to display the
prompt. Even though we display the prompt using this
function, readline still tries to do its own display if
we don't call rl_callback_handler_install and
rl_callback_handler_remove (which readline detects
because a global variable is not set). If readline did
that, it could mess up gdb signal handlers for SIGINT.
Readline assumes that between calls to rl_set_signals and
rl_clear_signals gdb doesn't do anything with the signal
handlers. Well, that's not the case, because when the
target executes we change the SIGINT signal handler. If
we allowed readline to display the prompt, the signal
handler change would happen exactly between the calls to
the above two functions. Calling
rl_callback_handler_remove(), does the job. */
if (current_ui->command_editing)
gdb_rl_callback_handler_remove ();
return;
}
else if (ui->prompt_state == PROMPT_NEEDED)
{
/* Display the top level prompt. */
actual_gdb_prompt = top_level_prompt ();
ui->prompt_state = PROMPTED;
}
}
else
actual_gdb_prompt = new_prompt;
if (current_ui->command_editing)
{
gdb_rl_callback_handler_remove ();
gdb_rl_callback_handler_install (actual_gdb_prompt.c_str ());
}
/* new_prompt at this point can be the top of the stack or the one
passed in. It can't be NULL. */
else
{
/* Don't use a _filtered function here. It causes the assumed
character position to be off, since the newline we read from
the user is not accounted for. */
fputs_unfiltered (actual_gdb_prompt.c_str (), gdb_stdout);
gdb_flush (gdb_stdout);
}
}
static void
add_symbol_nonexpandable (struct dictionary *dict, struct symbol *sym)
{
internal_error (__FILE__, __LINE__,
_("dict_add_symbol: non-expandable dictionary"));
}
static LONGEST
frv_linux_sigcontext_reg_addr (struct frame_info *this_frame, int regno,
CORE_ADDR *sc_addr_cache_ptr)
{
struct gdbarch *gdbarch = get_frame_arch (this_frame);
enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
CORE_ADDR sc_addr;
if (sc_addr_cache_ptr && *sc_addr_cache_ptr)
{
sc_addr = *sc_addr_cache_ptr;
}
else
{
CORE_ADDR pc, sp;
gdb_byte buf[4];
int tramp_type;
pc = get_frame_pc (this_frame);
tramp_type = frv_linux_pc_in_sigtramp (gdbarch, pc, 0);
get_frame_register (this_frame, sp_regnum, buf);
sp = extract_unsigned_integer (buf, sizeof buf, byte_order);
if (tramp_type == NORMAL_SIGTRAMP)
{
/* For a normal sigtramp frame, the sigcontext struct starts
at SP + 8. */
sc_addr = sp + 8;
}
else if (tramp_type == RT_SIGTRAMP)
{
/* For a realtime sigtramp frame, SP + 12 contains a pointer
to a ucontext struct. The ucontext struct contains a
sigcontext struct starting 24 bytes in. (The offset of
uc_mcontext within struct ucontext is derived as follows:
stack_t is a 12-byte struct and struct sigcontext is
8-byte aligned. This gives an offset of 8 + 12 + 4 (for
padding) = 24.) */
if (target_read_memory (sp + 12, buf, sizeof buf) != 0)
{
warning (_("Can't read realtime sigtramp frame."));
return 0;
}
sc_addr = extract_unsigned_integer (buf, sizeof buf, byte_order);
sc_addr += 24;
}
else
internal_error (__FILE__, __LINE__, _("not a signal trampoline"));
if (sc_addr_cache_ptr)
*sc_addr_cache_ptr = sc_addr;
}
switch (regno)
{
case psr_regnum :
return sc_addr + 0;
/* sc_addr + 4 has "isr", the Integer Status Register. */
case ccr_regnum :
return sc_addr + 8;
case cccr_regnum :
return sc_addr + 12;
case lr_regnum :
return sc_addr + 16;
case lcr_regnum :
return sc_addr + 20;
case pc_regnum :
return sc_addr + 24;
/* sc_addr + 28 is __status, the exception status.
sc_addr + 32 is syscallno, the syscall number or -1.
sc_addr + 36 is orig_gr8, the original syscall arg #1.
sc_addr + 40 is gner[0].
sc_addr + 44 is gner[1]. */
case iacc0h_regnum :
return sc_addr + 48;
case iacc0l_regnum :
return sc_addr + 52;
default :
if (first_gpr_regnum <= regno && regno <= last_gpr_regnum)
return sc_addr + 56 + 4 * (regno - first_gpr_regnum);
else if (first_fpr_regnum <= regno && regno <= last_fpr_regnum)
return sc_addr + 312 + 4 * (regno - first_fpr_regnum);
else
return -1; /* not saved. */
}
}
static namelist_info *
nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
namelist_info * base, char * base_name)
{
int rep_ctr;
int num;
int nml_carry;
int len;
index_type obj_size;
index_type nelem;
size_t dim_i;
size_t clen;
index_type elem_ctr;
size_t obj_name_len;
void * p ;
char cup;
char * obj_name;
char * ext_name;
char rep_buff[NML_DIGITS];
namelist_info * cmp;
namelist_info * retval = obj->next;
size_t base_name_len;
size_t base_var_name_len;
size_t tot_len;
unit_delim tmp_delim;
/* Set the character to be used to separate values
to a comma or semi-colon. */
char semi_comma =
dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';';
/* Write namelist variable names in upper case. If a derived type,
nothing is output. If a component, base and base_name are set. */
if (obj->type != GFC_DTYPE_DERIVED)
{
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
len = 0;
if (base)
{
len = strlen (base->var_name);
base_name_len = strlen (base_name);
for (dim_i = 0; dim_i < base_name_len; dim_i++)
{
cup = toupper (base_name[dim_i]);
write_character (dtp, &cup, 1, 1);
}
}
clen = strlen (obj->var_name);
for (dim_i = len; dim_i < clen; dim_i++)
{
cup = toupper (obj->var_name[dim_i]);
write_character (dtp, &cup, 1, 1);
}
write_character (dtp, "=", 1, 1);
}
/* Counts the number of data output on a line, including names. */
num = 1;
len = obj->len;
switch (obj->type)
{
case GFC_DTYPE_REAL:
obj_size = size_from_real_kind (len);
break;
case GFC_DTYPE_COMPLEX:
obj_size = size_from_complex_kind (len);
break;
case GFC_DTYPE_CHARACTER:
obj_size = obj->string_length;
break;
default:
obj_size = len;
}
if (obj->var_rank)
obj_size = obj->size;
/* Set the index vector and count the number of elements. */
nelem = 1;
for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++)
{
obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj, dim_i);
nelem = nelem * GFC_DESCRIPTOR_EXTENT (obj, dim_i);
}
/* Main loop to output the data held in the object. */
rep_ctr = 1;
for (elem_ctr = 0; elem_ctr < nelem; elem_ctr++)
{
/* Build the pointer to the data value. The offset is passed by
recursive calls to this function for arrays of derived types.
Is NULL otherwise. */
p = (void *)(obj->mem_pos + elem_ctr * obj_size);
p += offset;
/* Check for repeat counts of intrinsic types. */
if ((elem_ctr < (nelem - 1)) &&
(obj->type != GFC_DTYPE_DERIVED) &&
!memcmp (p, (void*)(p + obj_size ), obj_size ))
{
rep_ctr++;
}
/* Execute a repeated output. Note the flag no_leading_blank that
is used in the functions used to output the intrinsic types. */
else
{
if (rep_ctr > 1)
{
sprintf(rep_buff, " %d*", rep_ctr);
write_character (dtp, rep_buff, 1, strlen (rep_buff));
dtp->u.p.no_leading_blank = 1;
}
num++;
/* Output the data, if an intrinsic type, or recurse into this
routine to treat derived types. */
switch (obj->type)
{
case GFC_DTYPE_INTEGER:
write_integer (dtp, p, len);
break;
case GFC_DTYPE_LOGICAL:
write_logical (dtp, p, len);
break;
case GFC_DTYPE_CHARACTER:
tmp_delim = dtp->u.p.current_unit->delim_status;
if (dtp->u.p.nml_delim == '"')
dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
if (dtp->u.p.nml_delim == '\'')
dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE;
write_character (dtp, p, 1, obj->string_length);
dtp->u.p.current_unit->delim_status = tmp_delim;
break;
case GFC_DTYPE_REAL:
write_real (dtp, p, len);
break;
case GFC_DTYPE_COMPLEX:
dtp->u.p.no_leading_blank = 0;
num++;
write_complex (dtp, p, len, obj_size);
break;
case GFC_DTYPE_DERIVED:
/* To treat a derived type, we need to build two strings:
ext_name = the name, including qualifiers that prepends
component names in the output - passed to
nml_write_obj.
obj_name = the derived type name with no qualifiers but %
appended. This is used to identify the
components. */
/* First ext_name => get length of all possible components */
base_name_len = base_name ? strlen (base_name) : 0;
base_var_name_len = base ? strlen (base->var_name) : 0;
ext_name = (char*)get_mem ( base_name_len
+ base_var_name_len
+ strlen (obj->var_name)
+ obj->var_rank * NML_DIGITS
+ 1);
memcpy (ext_name, base_name, base_name_len);
clen = strlen (obj->var_name + base_var_name_len);
memcpy (ext_name + base_name_len,
obj->var_name + base_var_name_len, clen);
/* Append the qualifier. */
tot_len = base_name_len + clen;
for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++)
{
if (!dim_i)
{
ext_name[tot_len] = '(';
tot_len++;
}
sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx);
tot_len += strlen (ext_name + tot_len);
ext_name[tot_len] = ((int) dim_i == obj->var_rank - 1) ? ')' : ',';
tot_len++;
}
ext_name[tot_len] = '\0';
/* Now obj_name. */
obj_name_len = strlen (obj->var_name) + 1;
obj_name = get_mem (obj_name_len+1);
memcpy (obj_name, obj->var_name, obj_name_len-1);
memcpy (obj_name + obj_name_len-1, "%", 2);
/* Now loop over the components. Update the component pointer
with the return value from nml_write_obj => this loop jumps
past nested derived types. */
for (cmp = obj->next;
cmp && !strncmp (cmp->var_name, obj_name, obj_name_len);
cmp = retval)
{
retval = nml_write_obj (dtp, cmp,
(index_type)(p - obj->mem_pos),
obj, ext_name);
}
free_mem (obj_name);
free_mem (ext_name);
goto obj_loop;
default:
internal_error (&dtp->common, "Bad type for namelist write");
}
/* Reset the leading blank suppression, write a comma (or semi-colon)
and, if 5 values have been output, write a newline and advance
to column 2. Reset the repeat counter. */
dtp->u.p.no_leading_blank = 0;
write_character (dtp, &semi_comma, 1, 1);
if (num > 5)
{
num = 0;
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
}
rep_ctr = 1;
}
/* Cycle through and increment the index vector. */
obj_loop:
nml_carry = 1;
for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++)
{
obj->ls[dim_i].idx += nml_carry ;
nml_carry = 0;
if (obj->ls[dim_i].idx > (ssize_t) GFC_DESCRIPTOR_UBOUND(obj,dim_i))
{
obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
nml_carry = 1;
}
}
}
/* Return a pointer beyond the furthest object accessed. */
return retval;
}
enum mi_cmd_result
mi_cmd_break_insert (char *command, char **argv, int argc)
{
char *address = NULL;
enum bp_type type = REG_BP;
int temp_p = 0;
int thread = -1;
int ignore_count = 0;
char *condition = NULL;
enum gdb_rc rc;
struct gdb_events *old_hooks;
enum opt
{
HARDWARE_OPT, TEMP_OPT /*, REGEXP_OPT */ , CONDITION_OPT,
IGNORE_COUNT_OPT, THREAD_OPT
};
static struct mi_opt opts[] =
{
{"h", HARDWARE_OPT, 0},
{"t", TEMP_OPT, 0},
{"c", CONDITION_OPT, 1},
{"i", IGNORE_COUNT_OPT, 1},
{"p", THREAD_OPT, 1},
0
};
/* Parse arguments. It could be -r or -h or -t, <location> or ``--''
to denote the end of the option list. */
int optind = 0;
char *optarg;
while (1)
{
int opt = mi_getopt ("mi_cmd_break_insert", argc, argv, opts, &optind, &optarg);
if (opt < 0)
break;
switch ((enum opt) opt)
{
case TEMP_OPT:
temp_p = 1;
break;
case HARDWARE_OPT:
type = HW_BP;
break;
#if 0
case REGEXP_OPT:
type = REGEXP_BP;
break;
#endif
case CONDITION_OPT:
condition = optarg;
break;
case IGNORE_COUNT_OPT:
ignore_count = atol (optarg);
break;
case THREAD_OPT:
thread = atol (optarg);
break;
}
}
if (optind >= argc)
error ("mi_cmd_break_insert: Missing <location>");
if (optind < argc - 1)
error ("mi_cmd_break_insert: Garbage following <location>");
address = argv[optind];
/* Now we have what we need, let's insert the breakpoint! */
old_hooks = set_gdb_event_hooks (&breakpoint_hooks);
switch (type)
{
case REG_BP:
rc = gdb_breakpoint (address, condition,
0 /*hardwareflag */ , temp_p,
thread, ignore_count);
break;
case HW_BP:
rc = gdb_breakpoint (address, condition,
1 /*hardwareflag */ , temp_p,
thread, ignore_count);
break;
#if 0
case REGEXP_BP:
if (temp_p)
error ("mi_cmd_break_insert: Unsupported tempoary regexp breakpoint");
else
rbreak_command_wrapper (address, FROM_TTY);
return MI_CMD_DONE;
break;
#endif
default:
internal_error (__FILE__, __LINE__,
"mi_cmd_break_insert: Bad switch.");
}
set_gdb_event_hooks (old_hooks);
if (rc == GDB_RC_FAIL)
return MI_CMD_CAUGHT_ERROR;
else
return MI_CMD_DONE;
}
static void
inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
{
*iqp->exist = (iqp->common.unit >= 0
&& iqp->common.unit <= GFC_INTEGER_4_HUGE);
if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
{
if (!(*iqp->exist))
*iqp->common.iostat = LIBERROR_BAD_UNIT;
*iqp->exist = *iqp->exist
&& (*iqp->common.iostat != LIBERROR_BAD_UNIT);
}
}
if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
*iqp->opened = (u != NULL);
if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
*iqp->number = (u != NULL) ? u->unit_number : -1;
if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
*iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);
if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
&& u != NULL && u->flags.status != STATUS_SCRATCH)
fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.access)
{
case ACCESS_SEQUENTIAL:
p = "SEQUENTIAL";
break;
case ACCESS_DIRECT:
p = "DIRECT";
break;
case ACCESS_STREAM:
p = "STREAM";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad access");
}
cf_strcpy (iqp->access, iqp->access_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
{
if (u == NULL)
p = inquire_sequential (NULL, 0);
else
switch (u->flags.access)
{
case ACCESS_DIRECT:
case ACCESS_STREAM:
p = "NO";
break;
case ACCESS_SEQUENTIAL:
p = "YES";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad access");
}
cf_strcpy (iqp->sequential, iqp->sequential_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
{
if (u == NULL)
p = inquire_direct (NULL, 0);
else
switch (u->flags.access)
{
case ACCESS_SEQUENTIAL:
case ACCESS_STREAM:
p = "NO";
break;
case ACCESS_DIRECT:
p = "YES";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad access");
}
cf_strcpy (iqp->direct, iqp->direct_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.form)
{
case FORM_FORMATTED:
p = "FORMATTED";
break;
case FORM_UNFORMATTED:
p = "UNFORMATTED";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad form");
}
cf_strcpy (iqp->form, iqp->form_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
{
if (u == NULL)
p = inquire_formatted (NULL, 0);
else
switch (u->flags.form)
{
case FORM_FORMATTED:
p = "YES";
break;
case FORM_UNFORMATTED:
p = "NO";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad form");
}
cf_strcpy (iqp->formatted, iqp->formatted_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
{
if (u == NULL)
p = inquire_unformatted (NULL, 0);
else
switch (u->flags.form)
{
case FORM_FORMATTED:
p = "NO";
break;
case FORM_UNFORMATTED:
p = "YES";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad form");
}
cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
*iqp->recl_out = (u != NULL) ? u->recl : 0;
if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
*iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
{
/* This only makes sense in the context of DIRECT access. */
if (u != NULL && u->flags.access == ACCESS_DIRECT)
*iqp->nextrec = u->last_record + 1;
else
*iqp->nextrec = 0;
}
if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.blank)
{
case BLANK_NULL:
p = "NULL";
break;
case BLANK_ZERO:
p = "ZERO";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad blank");
}
cf_strcpy (iqp->blank, iqp->blank_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.pad)
{
case PAD_YES:
p = "YES";
break;
case PAD_NO:
p = "NO";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
}
cf_strcpy (iqp->pad, iqp->pad_len, p);
}
if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
{
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
*iqp->pending = 0;
if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
*iqp->id = 0;
if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.encoding)
{
case ENCODING_DEFAULT:
p = "UNKNOWN";
break;
case ENCODING_UTF8:
p = "UTF-8";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
}
cf_strcpy (iqp->encoding, iqp->encoding_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.decimal)
{
case DECIMAL_POINT:
p = "POINT";
break;
case DECIMAL_COMMA:
p = "COMMA";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
}
cf_strcpy (iqp->decimal, iqp->decimal_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.async)
{
case ASYNC_YES:
p = "YES";
break;
case ASYNC_NO:
p = "NO";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad async");
}
cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.sign)
{
case SIGN_PROCDEFINED:
p = "PROCESSOR_DEFINED";
break;
case SIGN_SUPPRESS:
p = "SUPPRESS";
break;
case SIGN_PLUS:
p = "PLUS";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
}
cf_strcpy (iqp->sign, iqp->sign_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.round)
{
case ROUND_UP:
p = "UP";
break;
case ROUND_DOWN:
p = "DOWN";
break;
case ROUND_ZERO:
p = "ZERO";
break;
case ROUND_NEAREST:
p = "NEAREST";
break;
case ROUND_COMPATIBLE:
p = "COMPATIBLE";
break;
case ROUND_PROCDEFINED:
p = "PROCESSOR_DEFINED";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad round");
}
cf_strcpy (iqp->round, iqp->round_len, p);
}
}
if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
{
if (u == NULL || u->flags.access == ACCESS_DIRECT)
p = undefined;
else
switch (u->flags.position)
{
case POSITION_REWIND:
p = "REWIND";
break;
case POSITION_APPEND:
p = "APPEND";
break;
case POSITION_ASIS:
p = "ASIS";
break;
default:
/* if not direct access, it must be
either REWIND, APPEND, or ASIS.
ASIS seems to be the best default */
p = "ASIS";
break;
}
cf_strcpy (iqp->position, iqp->position_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.action)
{
case ACTION_READ:
p = "READ";
break;
case ACTION_WRITE:
p = "WRITE";
break;
case ACTION_READWRITE:
p = "READWRITE";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad action");
}
cf_strcpy (iqp->action, iqp->action_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
{
p = (u == NULL) ? inquire_read (NULL, 0) :
inquire_read (u->file, u->file_len);
cf_strcpy (iqp->read, iqp->read_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
{
p = (u == NULL) ? inquire_write (NULL, 0) :
inquire_write (u->file, u->file_len);
cf_strcpy (iqp->write, iqp->write_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
{
p = (u == NULL) ? inquire_readwrite (NULL, 0) :
inquire_readwrite (u->file, u->file_len);
cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.delim)
{
case DELIM_NONE:
p = "NONE";
break;
case DELIM_QUOTE:
p = "QUOTE";
break;
case DELIM_APOSTROPHE:
p = "APOSTROPHE";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
}
cf_strcpy (iqp->delim, iqp->delim_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.pad)
{
case PAD_NO:
p = "NO";
break;
case PAD_YES:
p = "YES";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
}
cf_strcpy (iqp->pad, iqp->pad_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.convert)
{
/* big_endian is 0 for little-endian, 1 for big-endian. */
case GFC_CONVERT_NATIVE:
p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
break;
case GFC_CONVERT_SWAP:
p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
}
cf_strcpy (iqp->convert, iqp->convert_len, p);
}
}
static void
write_check_combos (void)
{
int i, n;
index_list_t *q;
FILE *f;
f = fopen("check_combos.c", "w");
fprintf(f, "/* THIS FILE IS AUTOMATICALLY GENERATED BY table */\n\n");
fprintf(f, "#include <stddef.h>\n");
fprintf(f, "#include \"options.h\"\n");
fprintf(f, "#include \"option_seen.h\"\n");
fprintf(f, "#include \"option_names.h\"\n");
fprintf(f, "#include \"opt_actions.h\"\n");
fprintf(f, "#include \"errors.h\"\n");
fprintf(f, "\n");
fprintf(f, "/* replace individual options with combo */\n");
fprintf(f, "static void\n");
fprintf(f, "replace_with_combo (int combo_index)\n");
fprintf(f, "{\n");
fprintf(f, "\tint flag;\n");
fprintf(f, "\tint count = 1;\n");
fprintf(f, "\tFOREACH_OPTION_IN_COMBO(flag,combo_index) {\n");
fprintf(f, "\t\tif (count == 1) {\n");
fprintf(f, "\t\t\treplace_option_seen(flag, combo_index);\n");
fprintf(f, "\t\t} else {\n");
fprintf(f, "\t\t\tset_option_unseen(flag);\n");
fprintf(f, "\t\t}\n");
fprintf(f, "\t\tcount++;\n");
fprintf(f, "\t}\n");
fprintf(f, "}\n\n");
fprintf(f, "static void\n");
fprintf(f, "report_combo_errors (void)\n");
fprintf(f, "{\n");
for (i = 0; i < num_options; i++) {
if (options[i].syntax == combo && !EMPTY(options[i].action)) {
if (find_by_flag(options[i].flag, i))
continue;
fprintf(f, "\tif (option_was_seen(%s)) {\n",
options[i].flag);
if (strcmp(options[i].action, "WARNING") == 0) {
fprintf(f, "\t\twarning(\"%s combination not allowed, replaced with %s\");\n",
options[i].name, list_to_string(options[i].implies));
} else {
fprintf(f, "\t\tparse_error(\"%s\", \"illegal combination\");\n",
options[i].name);
}
fprintf(f, "\t}\n");
}
}
fprintf(f, "}\n\n");
fprintf(f, "extern boolean\n");
fprintf(f, "is_replacement_combo (int combo_index)\n");
fprintf(f, "{\n");
fprintf(f, "\tswitch (combo_index) {\n");
for (i = n = 0; i < num_options; i++) {
if (options[i].syntax == combo && !EMPTY(options[i].action)
&& strcmp(options[i].action, "WARNING") == 0 )
{
if (find_by_flag(options[i].flag, i))
continue;
fprintf(f, "\tcase %s:\n", options[i].flag);
n++;
}
}
if (n)
fprintf(f, "\t\treturn TRUE;\n");
fprintf(f, "\tdefault:\n");
fprintf(f, "\t\treturn FALSE;\n");
fprintf(f, "\t}\n");
fprintf(f, "}\n\n");
fprintf(f, "extern void\n");
fprintf(f, "check_for_combos (void)\n");
fprintf(f, "{\n");
for (i = 0; i < num_options; i++) {
if (options[i].syntax == combo) {
if (find_by_flag(options[i].flag, i))
continue;
q = options[i].combo_list;
if (q == NULL) internal_error("empty combo_list?");
fprintf(f, "\tif (");
if (q->negated) fprintf(f, "!");
fprintf(f, "option_was_seen(%s)",
options[q->info_index].flag);
q = q->next;
while (q != NULL) {
fprintf(f, " && ");
if (q->negated) fprintf(f, "!");
fprintf(f, "option_was_seen(%s)",
options[q->info_index].flag);
q = q->next;
}
fprintf(f, ") {\n");
/* replace in seen array */
fprintf(f, "\t\treplace_with_combo(%s);\n",
options[i].flag);
/* untoggle individual options */
for (q = options[i].combo_list; q != NULL; q = q->next) {
if (options[q->info_index].toggle) {
fprintf(f, "\t\tun%s\n",
options[q->info_index].action);
}
}
fprintf(f, "\t}\n");
}
}
fprintf(f, "\treport_combo_errors();\n");
fprintf(f, "}\n\n");
fclose(f);
}
/*
* Read table from stdin, without assuming options section is sorted.
*/
static void read_table(void)
{
char line[512];
char *option_lines[MAX_OPTIONS];
int option_line_count = 0;
char *p;
int section = 0;
int i = num_options;
int j;
strcpy(options[i].flag, "O_Unrecognized");
options[i].internal = TRUE;
strcpy(options[i].name, "");
options[i].implies = NULL;
i++;
/* Find beginning of OPTIONS section. */
while (get_line(line) != EOF) {
if (EMPTY(line))
continue;
else if (line[0] == '%' && line[1] != '%')
continue;
else if (strcmp(line, "%%% OPTIONS") == 0) {
section = OPTIONS;
break;
}
else {
internal_error("Unexpected line: %s", line);
}
}
/* Read and sort the OPTIONS section. */
if (section != OPTIONS) {
internal_error("OPTIONS section not found");
}
option_line_count = 0;
while (get_line(line) != EOF) {
char* s;
if (EMPTY(line))
continue;
else if (line[0] == '%' && line[1] != '%')
continue;
else if (strncmp(line, "%%% ", 4) == 0) {
if (strcmp(line, "%%% OPTIONS") == 0)
internal_error("OPTIONS section seen twice");
else if (strcmp(line, "%%% COMBINATIONS") == 0) {
section = COMBINATIONS;
break;
}
else {
internal_error("UNKNOWN SECTION: %s", line);
}
}
s = malloc(strlen(line) + 1);
if (s == NULL)
internal_error("memory allocation failed");
strcpy(s, line);
option_lines[option_line_count] = s;
INCREMENT_INDEX(option_line_count, MAX_OPTIONS);
}
qsort(option_lines, option_line_count, sizeof(char*),
reverse_strcmp);
/* Process the option lines */
for (j = 0; j < option_line_count; ++j) {
/* <name> <action> <langs> <phases> <implies> */
p = strtok(option_lines[j], SPACE);
if (*p == 'I') {
options[i].internal = TRUE;
p++;
} else
options[i].internal = FALSE;
if (*p != '-')
internal_error("MISSING - : %s", p);
options[i].syntax =
set_option_name(options[i].name, p, &options[i].num_letters);
if (options[i].syntax == normal
&& strlen(options[i].name) == 2)
options[i].syntax = oneletter;
set_flag_name(&options[i]);
p = strtok(NULL, SPACE);
store_string(options[i].action, p, ";");
if (strncmp(p, "toggle", 6) == 0)
options[i].toggle = TRUE;
else
options[i].toggle = FALSE;
if (!table_for_phase) {
p = strtok(NULL, SPACE);
options[i].languages = create_lang_field(p);
if ( options[i].internal ) {
options[i].languages |=
get_language_mask ( L_internal );
}
p = strtok(NULL, SPACE);
options[i].phases = create_phase_field(p);
}
options[i].implies = create_option_list(&p,i);
options[i].help = create_help_msg(p);
INCREMENT_INDEX(i, MAX_OPTIONS);
}
check_dups();
/* Read and process the COMBINATIONS section */
if (section != COMBINATIONS) {
internal_error("COMBINATIONS section not found");
}
while (get_line(line) != EOF) {
if (EMPTY(line))
continue;
else if (line[0] == '%' && line[1] != '%')
continue;
else if (strncmp(line, "%%% ", 4) == 0) {
internal_error("Unexpected sections line: %s", line);
}
else {
/* <name> <action> <implies> */
if (line[0] != '\"')
internal_error("MISSING \" : %s", line);
p = strtok(line+1, DQUOTE);
set_option_name(options[i].name, p, &options[i].num_letters);
options[i].syntax = combo;
set_flag_name(&options[i]);
p = strtok(NULL, SPACE);
store_string(options[i].action, p, "OKAY");
options[i].implies = create_option_list(&p,i);
options[i].languages = ALL_LANGS;
options[i].phases = ALL_PHASES;
options[i].help = NULL;
INCREMENT_INDEX(i, MAX_OPTIONS);
}
}
num_options = i;
}
/* Handle the given event by calling the procedure associated to the
corresponding file handler. Called by process_event indirectly,
through event_ptr->proc. EVENT_FILE_DESC is file descriptor of the
event in the front of the event queue. */
static void
handle_file_event (event_data data)
{
file_handler *file_ptr;
int mask;
#ifdef HAVE_POLL
int error_mask;
int error_mask_returned;
#endif
int event_file_desc = data.integer;
/* Search the file handler list to find one that matches the fd in
the event. */
for (file_ptr = gdb_notifier.first_file_handler; file_ptr != NULL;
file_ptr = file_ptr->next_file)
{
if (file_ptr->fd == event_file_desc)
{
/* With poll, the ready_mask could have any of three events
set to 1: POLLHUP, POLLERR, POLLNVAL. These events cannot
be used in the requested event mask (events), but they
can be returned in the return mask (revents). We need to
check for those event too, and add them to the mask which
will be passed to the handler. */
/* See if the desired events (mask) match the received
events (ready_mask). */
if (use_poll)
{
#ifdef HAVE_POLL
error_mask = POLLHUP | POLLERR | POLLNVAL;
mask = (file_ptr->ready_mask & file_ptr->mask) |
(file_ptr->ready_mask & error_mask);
error_mask_returned = mask & error_mask;
if (error_mask_returned != 0)
{
/* Work in progress. We may need to tell somebody what
kind of error we had. */
if (error_mask_returned & POLLHUP)
printf_unfiltered (_("Hangup detected on fd %d\n"), file_ptr->fd);
if (error_mask_returned & POLLERR)
printf_unfiltered (_("Error detected on fd %d\n"), file_ptr->fd);
if (error_mask_returned & POLLNVAL)
printf_unfiltered (_("Invalid or non-`poll'able fd %d\n"), file_ptr->fd);
file_ptr->error = 1;
}
else
file_ptr->error = 0;
#else
internal_error (__FILE__, __LINE__,
_("use_poll without HAVE_POLL"));
#endif /* HAVE_POLL */
}
else
{
if (file_ptr->ready_mask & GDB_EXCEPTION)
{
printf_unfiltered (_("Exception condition detected on fd %d\n"), file_ptr->fd);
file_ptr->error = 1;
}
else
file_ptr->error = 0;
mask = file_ptr->ready_mask & file_ptr->mask;
}
/* Clear the received events for next time around. */
file_ptr->ready_mask = 0;
/* If there was a match, then call the handler. */
if (mask != 0)
(*file_ptr->proc) (file_ptr->error, file_ptr->client_data);
break;
}
}
}
/* Called by gdb_do_one_event to wait for new events on the monitored
file descriptors. Queue file events as they are detected by the
poll. If BLOCK and if there are no events, this function will
block in the call to poll. Return -1 if there are no files
descriptors to monitor, otherwise return 0. */
static int
gdb_wait_for_event (int block)
{
file_handler *file_ptr;
gdb_event *file_event_ptr;
int num_found = 0;
int i;
/* Make sure all output is done before getting another event. */
gdb_flush (gdb_stdout);
gdb_flush (gdb_stderr);
if (gdb_notifier.num_fds == 0)
return -1;
if (use_poll)
{
#ifdef HAVE_POLL
int timeout;
if (block)
timeout = gdb_notifier.timeout_valid ? gdb_notifier.poll_timeout : -1;
else
timeout = 0;
num_found = poll (gdb_notifier.poll_fds,
(unsigned long) gdb_notifier.num_fds, timeout);
/* Don't print anything if we get out of poll because of a
signal. */
if (num_found == -1 && errno != EINTR)
perror_with_name (("poll"));
#else
internal_error (__FILE__, __LINE__,
_("use_poll without HAVE_POLL"));
#endif /* HAVE_POLL */
}
else
{
struct timeval select_timeout;
struct timeval *timeout_p;
if (block)
timeout_p = gdb_notifier.timeout_valid
? &gdb_notifier.select_timeout : NULL;
else
{
memset (&select_timeout, 0, sizeof (select_timeout));
timeout_p = &select_timeout;
}
gdb_notifier.ready_masks[0] = gdb_notifier.check_masks[0];
gdb_notifier.ready_masks[1] = gdb_notifier.check_masks[1];
gdb_notifier.ready_masks[2] = gdb_notifier.check_masks[2];
num_found = gdb_select (gdb_notifier.num_fds,
&gdb_notifier.ready_masks[0],
&gdb_notifier.ready_masks[1],
&gdb_notifier.ready_masks[2],
timeout_p);
/* Clear the masks after an error from select. */
if (num_found == -1)
{
FD_ZERO (&gdb_notifier.ready_masks[0]);
FD_ZERO (&gdb_notifier.ready_masks[1]);
FD_ZERO (&gdb_notifier.ready_masks[2]);
/* Dont print anything if we got a signal, let gdb handle
it. */
if (errno != EINTR)
perror_with_name (("select"));
}
}
/* Enqueue all detected file events. */
if (use_poll)
{
#ifdef HAVE_POLL
for (i = 0; (i < gdb_notifier.num_fds) && (num_found > 0); i++)
{
if ((gdb_notifier.poll_fds + i)->revents)
num_found--;
else
continue;
for (file_ptr = gdb_notifier.first_file_handler;
file_ptr != NULL;
file_ptr = file_ptr->next_file)
{
if (file_ptr->fd == (gdb_notifier.poll_fds + i)->fd)
break;
}
if (file_ptr)
{
/* Enqueue an event only if this is still a new event for
this fd. */
if (file_ptr->ready_mask == 0)
{
file_event_ptr = create_file_event (file_ptr->fd);
async_queue_event (file_event_ptr, TAIL);
}
file_ptr->ready_mask = (gdb_notifier.poll_fds + i)->revents;
}
}
#else
internal_error (__FILE__, __LINE__,
_("use_poll without HAVE_POLL"));
#endif /* HAVE_POLL */
}
else
{
for (file_ptr = gdb_notifier.first_file_handler;
(file_ptr != NULL) && (num_found > 0);
file_ptr = file_ptr->next_file)
{
int mask = 0;
if (FD_ISSET (file_ptr->fd, &gdb_notifier.ready_masks[0]))
mask |= GDB_READABLE;
if (FD_ISSET (file_ptr->fd, &gdb_notifier.ready_masks[1]))
mask |= GDB_WRITABLE;
if (FD_ISSET (file_ptr->fd, &gdb_notifier.ready_masks[2]))
mask |= GDB_EXCEPTION;
if (!mask)
continue;
else
num_found--;
/* Enqueue an event only if this is still a new event for
this fd. */
if (file_ptr->ready_mask == 0)
{
file_event_ptr = create_file_event (file_ptr->fd);
async_queue_event (file_event_ptr, TAIL);
}
file_ptr->ready_mask = mask;
}
}
return 0;
}
/* Remove the file descriptor FD from the list of monitored fd's:
i.e. we don't care anymore about events on the FD. */
void
delete_file_handler (int fd)
{
file_handler *file_ptr, *prev_ptr = NULL;
int i;
#ifdef HAVE_POLL
int j;
struct pollfd *new_poll_fds;
#endif
/* Find the entry for the given file. */
for (file_ptr = gdb_notifier.first_file_handler; file_ptr != NULL;
file_ptr = file_ptr->next_file)
{
if (file_ptr->fd == fd)
break;
}
if (file_ptr == NULL)
return;
if (use_poll)
{
#ifdef HAVE_POLL
/* Create a new poll_fds array by copying every fd's information but the
one we want to get rid of. */
new_poll_fds =
(struct pollfd *) xmalloc ((gdb_notifier.num_fds - 1) * sizeof (struct pollfd));
for (i = 0, j = 0; i < gdb_notifier.num_fds; i++)
{
if ((gdb_notifier.poll_fds + i)->fd != fd)
{
(new_poll_fds + j)->fd = (gdb_notifier.poll_fds + i)->fd;
(new_poll_fds + j)->events = (gdb_notifier.poll_fds + i)->events;
(new_poll_fds + j)->revents = (gdb_notifier.poll_fds + i)->revents;
j++;
}
}
xfree (gdb_notifier.poll_fds);
gdb_notifier.poll_fds = new_poll_fds;
gdb_notifier.num_fds--;
#else
internal_error (__FILE__, __LINE__,
_("use_poll without HAVE_POLL"));
#endif /* HAVE_POLL */
}
else
{
if (file_ptr->mask & GDB_READABLE)
FD_CLR (fd, &gdb_notifier.check_masks[0]);
if (file_ptr->mask & GDB_WRITABLE)
FD_CLR (fd, &gdb_notifier.check_masks[1]);
if (file_ptr->mask & GDB_EXCEPTION)
FD_CLR (fd, &gdb_notifier.check_masks[2]);
/* Find current max fd. */
if ((fd + 1) == gdb_notifier.num_fds)
{
gdb_notifier.num_fds--;
for (i = gdb_notifier.num_fds; i; i--)
{
if (FD_ISSET (i - 1, &gdb_notifier.check_masks[0])
|| FD_ISSET (i - 1, &gdb_notifier.check_masks[1])
|| FD_ISSET (i - 1, &gdb_notifier.check_masks[2]))
break;
}
gdb_notifier.num_fds = i;
}
}
/* Deactivate the file descriptor, by clearing its mask,
so that it will not fire again. */
file_ptr->mask = 0;
/* Get rid of the file handler in the file handler list. */
if (file_ptr == gdb_notifier.first_file_handler)
gdb_notifier.first_file_handler = file_ptr->next_file;
else
{
for (prev_ptr = gdb_notifier.first_file_handler;
prev_ptr->next_file != file_ptr;
prev_ptr = prev_ptr->next_file)
;
prev_ptr->next_file = file_ptr->next_file;
}
xfree (file_ptr);
}
/* Add a file handler/descriptor to the list of descriptors we are
interested in.
FD is the file descriptor for the file/stream to be listened to.
For the poll case, MASK is a combination (OR) of
POLLIN, POLLRDNORM, POLLRDBAND, POLLPRI, POLLOUT, POLLWRNORM,
POLLWRBAND: these are the events we are interested in. If any of them
occurs, proc should be called.
For the select case, MASK is a combination of READABLE, WRITABLE, EXCEPTION.
PROC is the procedure that will be called when an event occurs for
FD. CLIENT_DATA is the argument to pass to PROC. */
static void
create_file_handler (int fd, int mask, handler_func * proc, gdb_client_data client_data)
{
file_handler *file_ptr;
/* Do we already have a file handler for this file? (We may be
changing its associated procedure). */
for (file_ptr = gdb_notifier.first_file_handler; file_ptr != NULL;
file_ptr = file_ptr->next_file)
{
if (file_ptr->fd == fd)
break;
}
/* It is a new file descriptor. Add it to the list. Otherwise, just
change the data associated with it. */
if (file_ptr == NULL)
{
file_ptr = (file_handler *) xmalloc (sizeof (file_handler));
file_ptr->fd = fd;
file_ptr->ready_mask = 0;
file_ptr->next_file = gdb_notifier.first_file_handler;
gdb_notifier.first_file_handler = file_ptr;
if (use_poll)
{
#ifdef HAVE_POLL
gdb_notifier.num_fds++;
if (gdb_notifier.poll_fds)
gdb_notifier.poll_fds =
(struct pollfd *) xrealloc (gdb_notifier.poll_fds,
(gdb_notifier.num_fds
* sizeof (struct pollfd)));
else
gdb_notifier.poll_fds =
(struct pollfd *) xmalloc (sizeof (struct pollfd));
(gdb_notifier.poll_fds + gdb_notifier.num_fds - 1)->fd = fd;
(gdb_notifier.poll_fds + gdb_notifier.num_fds - 1)->events = mask;
(gdb_notifier.poll_fds + gdb_notifier.num_fds - 1)->revents = 0;
#else
internal_error (__FILE__, __LINE__,
_("use_poll without HAVE_POLL"));
#endif /* HAVE_POLL */
}
else
{
if (mask & GDB_READABLE)
FD_SET (fd, &gdb_notifier.check_masks[0]);
else
FD_CLR (fd, &gdb_notifier.check_masks[0]);
if (mask & GDB_WRITABLE)
FD_SET (fd, &gdb_notifier.check_masks[1]);
else
FD_CLR (fd, &gdb_notifier.check_masks[1]);
if (mask & GDB_EXCEPTION)
FD_SET (fd, &gdb_notifier.check_masks[2]);
else
FD_CLR (fd, &gdb_notifier.check_masks[2]);
if (gdb_notifier.num_fds <= fd)
gdb_notifier.num_fds = fd + 1;
}
}
file_ptr->proc = proc;
file_ptr->client_data = client_data;
file_ptr->mask = mask;
}
/* ------------------------------------------------------------------------
@NAME : bt_change_case()
@INPUT :
@OUTPUT :
@RETURNS :
@DESCRIPTION: Converts a string (in-place) to either uppercase, lowercase,
or "title capitalization">
@GLOBALS :
@CALLS :
@CALLERS :
@CREATED : 1997/11/25, GPW
@MODIFIED :
-------------------------------------------------------------------------- */
void
bt_change_case (char transform,
char * string,
btshort options)
{
int len;
int depth;
int src, dst; /* indeces into string */
boolean start_sentence;
boolean after_colon;
src = dst = 0;
len = strlen (string);
depth = 0;
start_sentence = TRUE;
after_colon = FALSE;
while (string[src] != 0)
{
switch (string[src])
{
case '{':
/*
* At start of special character? The entire special char.
* will be handled here, as follows:
* - text at any brace-depth within the s.c. is case-mangled;
* punctuation (sentence endings, colons) are ignored
* - control sequences are left alone, unless they are
* one of the "foreign letter" control sequences, in
* which case they're converted to the appropriate string
* according to the uc_version or lc_version tables.
*/
if (depth == 0 && string[src+1] == '\\')
{
convert_special_char (transform, string, &src, &dst,
&start_sentence, &after_colon);
}
/*
* Otherwise, it's just something in braces. This is probably
* a proper noun or something encased in braces to protect it
* from case-mangling, so we do not case-mangle it. However,
* we *do* switch out of start_sentence or after_colon mode if
* we happen to be there (otherwise we'll do the wrong thing
* once we're out of the braces).
*/
else
{
string[dst++] = string[src++];
start_sentence = after_colon = FALSE;
depth++;
}
break;
case '}':
string[dst++] = string[src++];
depth--;
break;
/*
* Sentence-ending punctuation and colons are handled separately
* to allow for exact mimicing of BibTeX's behaviour. I happen
* to think that this behaviour (capitalize first word of sentences
* in a title) is better than BibTeX's, but I want to keep my
* options open for a future goal of perfect compatability.
*/
case '.':
case '?':
case '!':
start_sentence = TRUE;
string[dst++] = string[src++];
break;
case ':':
after_colon = TRUE;
string[dst++] = string[src++];
break;
default:
if (isspace (string[src]))
{
string[dst++] = string[src++];
}
else
{
if (depth == 0)
{
switch (transform)
{
case 'u':
string[dst++] = toupper (string[src++]);
break;
case 'l':
string[dst++] = tolower (string[src++]);
break;
case 't':
if (start_sentence || after_colon)
{
/*
* XXX BibTeX only preserves case of character
* immediately after a colon; I do two things
* differently: first, I pay attention to sentence
* punctuation, and second I force uppercase
* at start of sentence or after a colon.
*/
string[dst++] = toupper (string[src++]);
start_sentence = after_colon = FALSE;
}
else
{
string[dst++] = tolower (string[src++]);
}
break;
default:
internal_error ("impossible case transform \"%c\"",
transform);
}
} /* depth == 0 */
else
{
string[dst++] = string[src++];
}
} /* not blank */
} /* switch on current character */
} /* while not at end of string */
} /* bt_change_case */
static void
stub_gnu_ifunc_resolver_return_stop (struct breakpoint *b)
{
internal_error (__FILE__, __LINE__,
_("elf_gnu_ifunc_resolver_return_stop cannot be reached."));
}
static void
no_get_frame_base (void *baton, unsigned char **start, size_t *length)
{
internal_error (__FILE__, __LINE__,
"Support for DW_OP_fbreg is unimplemented");
}
enum eval_result_type
gdb_eval_agent_expr (struct eval_agent_expr_context *ctx,
struct agent_expr *aexpr,
ULONGEST *rslt)
{
int pc = 0;
#define STACK_MAX 100
ULONGEST stack[STACK_MAX], top;
int sp = 0;
unsigned char op;
int arg;
/* This union is a convenient way to convert representations. For
now, assume a standard architecture where the hardware integer
types have 8, 16, 32, 64 bit types. A more robust solution would
be to import stdint.h from gnulib. */
union
{
union
{
unsigned char bytes[1];
unsigned char val;
} u8;
union
{
unsigned char bytes[2];
unsigned short val;
} u16;
union
{
unsigned char bytes[4];
unsigned int val;
} u32;
union
{
unsigned char bytes[8];
ULONGEST val;
} u64;
} cnv;
if (aexpr->length == 0)
{
ax_debug ("empty agent expression");
return expr_eval_empty_expression;
}
/* Cache the stack top in its own variable. Much of the time we can
operate on this variable, rather than dinking with the stack. It
needs to be copied to the stack when sp changes. */
top = 0;
while (1)
{
op = aexpr->bytes[pc++];
ax_debug ("About to interpret byte 0x%x", op);
switch (op)
{
case gdb_agent_op_add:
top += stack[--sp];
break;
case gdb_agent_op_sub:
top = stack[--sp] - top;
break;
case gdb_agent_op_mul:
top *= stack[--sp];
break;
case gdb_agent_op_div_signed:
if (top == 0)
{
ax_debug ("Attempted to divide by zero");
return expr_eval_divide_by_zero;
}
top = ((LONGEST) stack[--sp]) / ((LONGEST) top);
break;
case gdb_agent_op_div_unsigned:
if (top == 0)
{
ax_debug ("Attempted to divide by zero");
return expr_eval_divide_by_zero;
}
top = stack[--sp] / top;
break;
case gdb_agent_op_rem_signed:
if (top == 0)
{
ax_debug ("Attempted to divide by zero");
return expr_eval_divide_by_zero;
}
top = ((LONGEST) stack[--sp]) % ((LONGEST) top);
break;
case gdb_agent_op_rem_unsigned:
if (top == 0)
{
ax_debug ("Attempted to divide by zero");
return expr_eval_divide_by_zero;
}
top = stack[--sp] % top;
break;
case gdb_agent_op_lsh:
top = stack[--sp] << top;
break;
case gdb_agent_op_rsh_signed:
top = ((LONGEST) stack[--sp]) >> top;
break;
case gdb_agent_op_rsh_unsigned:
top = stack[--sp] >> top;
break;
case gdb_agent_op_trace:
agent_mem_read (ctx, NULL, (CORE_ADDR) stack[--sp],
(ULONGEST) top);
if (--sp >= 0)
top = stack[sp];
break;
case gdb_agent_op_trace_quick:
arg = aexpr->bytes[pc++];
agent_mem_read (ctx, NULL, (CORE_ADDR) top, (ULONGEST) arg);
break;
case gdb_agent_op_log_not:
top = !top;
break;
case gdb_agent_op_bit_and:
top &= stack[--sp];
break;
case gdb_agent_op_bit_or:
top |= stack[--sp];
break;
case gdb_agent_op_bit_xor:
top ^= stack[--sp];
break;
case gdb_agent_op_bit_not:
top = ~top;
break;
case gdb_agent_op_equal:
top = (stack[--sp] == top);
break;
case gdb_agent_op_less_signed:
top = (((LONGEST) stack[--sp]) < ((LONGEST) top));
break;
case gdb_agent_op_less_unsigned:
top = (stack[--sp] < top);
break;
case gdb_agent_op_ext:
arg = aexpr->bytes[pc++];
if (arg < (sizeof (LONGEST) * 8))
{
LONGEST mask = 1 << (arg - 1);
top &= ((LONGEST) 1 << arg) - 1;
top = (top ^ mask) - mask;
}
break;
case gdb_agent_op_ref8:
agent_mem_read (ctx, cnv.u8.bytes, (CORE_ADDR) top, 1);
top = cnv.u8.val;
break;
case gdb_agent_op_ref16:
agent_mem_read (ctx, cnv.u16.bytes, (CORE_ADDR) top, 2);
top = cnv.u16.val;
break;
case gdb_agent_op_ref32:
agent_mem_read (ctx, cnv.u32.bytes, (CORE_ADDR) top, 4);
top = cnv.u32.val;
break;
case gdb_agent_op_ref64:
agent_mem_read (ctx, cnv.u64.bytes, (CORE_ADDR) top, 8);
top = cnv.u64.val;
break;
case gdb_agent_op_if_goto:
if (top)
pc = (aexpr->bytes[pc] << 8) + (aexpr->bytes[pc + 1]);
else
pc += 2;
if (--sp >= 0)
top = stack[sp];
break;
case gdb_agent_op_goto:
pc = (aexpr->bytes[pc] << 8) + (aexpr->bytes[pc + 1]);
break;
case gdb_agent_op_const8:
/* Flush the cached stack top. */
stack[sp++] = top;
top = aexpr->bytes[pc++];
break;
case gdb_agent_op_const16:
/* Flush the cached stack top. */
stack[sp++] = top;
top = aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
break;
case gdb_agent_op_const32:
/* Flush the cached stack top. */
stack[sp++] = top;
top = aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
break;
case gdb_agent_op_const64:
/* Flush the cached stack top. */
stack[sp++] = top;
top = aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
top = (top << 8) + aexpr->bytes[pc++];
break;
case gdb_agent_op_reg:
/* Flush the cached stack top. */
stack[sp++] = top;
arg = aexpr->bytes[pc++];
arg = (arg << 8) + aexpr->bytes[pc++];
{
int regnum = arg;
struct regcache *regcache = ctx->regcache;
switch (register_size (regcache->tdesc, regnum))
{
case 8:
collect_register (regcache, regnum, cnv.u64.bytes);
top = cnv.u64.val;
break;
case 4:
collect_register (regcache, regnum, cnv.u32.bytes);
top = cnv.u32.val;
break;
case 2:
collect_register (regcache, regnum, cnv.u16.bytes);
top = cnv.u16.val;
break;
case 1:
collect_register (regcache, regnum, cnv.u8.bytes);
top = cnv.u8.val;
break;
default:
internal_error (__FILE__, __LINE__,
"unhandled register size");
}
}
break;
case gdb_agent_op_end:
ax_debug ("At end of expression, sp=%d, stack top cache=0x%s",
sp, pulongest (top));
if (rslt)
{
if (sp <= 0)
{
/* This should be an error */
ax_debug ("Stack is empty, nothing to return");
return expr_eval_empty_stack;
}
*rslt = top;
}
return expr_eval_no_error;
case gdb_agent_op_dup:
stack[sp++] = top;
break;
case gdb_agent_op_pop:
if (--sp >= 0)
top = stack[sp];
break;
case gdb_agent_op_pick:
arg = aexpr->bytes[pc++];
stack[sp] = top;
top = stack[sp - arg];
++sp;
break;
case gdb_agent_op_rot:
{
ULONGEST tem = stack[sp - 1];
stack[sp - 1] = stack[sp - 2];
stack[sp - 2] = top;
top = tem;
}
break;
case gdb_agent_op_zero_ext:
arg = aexpr->bytes[pc++];
if (arg < (sizeof (LONGEST) * 8))
top &= ((LONGEST) 1 << arg) - 1;
break;
case gdb_agent_op_swap:
/* Interchange top two stack elements, making sure top gets
copied back onto stack. */
stack[sp] = top;
top = stack[sp - 1];
stack[sp - 1] = stack[sp];
break;
case gdb_agent_op_getv:
/* Flush the cached stack top. */
stack[sp++] = top;
arg = aexpr->bytes[pc++];
arg = (arg << 8) + aexpr->bytes[pc++];
top = agent_get_trace_state_variable_value (arg);
break;
case gdb_agent_op_setv:
arg = aexpr->bytes[pc++];
arg = (arg << 8) + aexpr->bytes[pc++];
agent_set_trace_state_variable_value (arg, top);
/* Note that we leave the value on the stack, for the
benefit of later/enclosing expressions. */
break;
case gdb_agent_op_tracev:
arg = aexpr->bytes[pc++];
arg = (arg << 8) + aexpr->bytes[pc++];
agent_tsv_read (ctx, arg);
break;
case gdb_agent_op_tracenz:
agent_mem_read_string (ctx, NULL, (CORE_ADDR) stack[--sp],
(ULONGEST) top);
if (--sp >= 0)
top = stack[sp];
break;
case gdb_agent_op_printf:
{
int nargs, slen, i;
CORE_ADDR fn = 0, chan = 0;
/* Can't have more args than the entire size of the stack. */
ULONGEST args[STACK_MAX];
char *format;
nargs = aexpr->bytes[pc++];
slen = aexpr->bytes[pc++];
slen = (slen << 8) + aexpr->bytes[pc++];
format = (char *) &(aexpr->bytes[pc]);
pc += slen;
/* Pop function and channel. */
fn = top;
if (--sp >= 0)
top = stack[sp];
chan = top;
if (--sp >= 0)
top = stack[sp];
/* Pop arguments into a dedicated array. */
for (i = 0; i < nargs; ++i)
{
args[i] = top;
if (--sp >= 0)
top = stack[sp];
}
/* A bad format string means something is very wrong; give
up immediately. */
if (format[slen - 1] != '\0')
error (_("Unterminated format string in printf bytecode"));
ax_printf (fn, chan, format, nargs, args);
}
break;
/* GDB never (currently) generates any of these ops. */
case gdb_agent_op_float:
case gdb_agent_op_ref_float:
case gdb_agent_op_ref_double:
case gdb_agent_op_ref_long_double:
case gdb_agent_op_l_to_d:
case gdb_agent_op_d_to_l:
case gdb_agent_op_trace16:
ax_debug ("Agent expression op 0x%x valid, but not handled",
op);
/* If ever GDB generates any of these, we don't have the
option of ignoring. */
return expr_eval_unhandled_opcode;
default:
ax_debug ("Agent expression op 0x%x not recognized", op);
/* Don't struggle on, things will just get worse. */
return expr_eval_unrecognized_opcode;
}
/* Check for stack badness. */
if (sp >= (STACK_MAX - 1))
{
ax_debug ("Expression stack overflow");
return expr_eval_stack_overflow;
}
if (sp < 0)
{
ax_debug ("Expression stack underflow");
return expr_eval_stack_underflow;
}
ax_debug ("Op %s -> sp=%d, top=0x%s",
gdb_agent_op_name (op), sp, phex_nz (top, 0));
}
}
static CORE_ADDR
no_get_tls_address (void *baton, CORE_ADDR offset)
{
internal_error (__FILE__, __LINE__,
"Support for DW_OP_GNU_push_tls_address is unimplemented");
}
static void
inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
if (iqp->common.unit == GFC_INTERNAL_UNIT ||
iqp->common.unit == GFC_INTERNAL_UNIT4 ||
u->internal_unit_kind != 0)
generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
*iqp->exist = (u != NULL) || (iqp->common.unit >= 0);
if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
*iqp->opened = (u != NULL);
if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
*iqp->number = (u != NULL) ? u->unit_number : -1;
if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
*iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);
if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
&& u != NULL && u->flags.status != STATUS_SCRATCH)
{
#if defined(HAVE_TTYNAME_R) || defined(HAVE_TTYNAME)
if (u->unit_number == options.stdin_unit
|| u->unit_number == options.stdout_unit
|| u->unit_number == options.stderr_unit)
{
int err = stream_ttyname (u->s, iqp->name, iqp->name_len);
if (err == 0)
{
gfc_charlen_type tmplen = strlen (iqp->name);
if (iqp->name_len > tmplen)
memset (&iqp->name[tmplen], ' ', iqp->name_len - tmplen);
}
else /* If ttyname does not work, go with the default. */
cf_strcpy (iqp->name, iqp->name_len, u->filename);
}
else
cf_strcpy (iqp->name, iqp->name_len, u->filename);
#elif defined __MINGW32__
if (u->unit_number == options.stdin_unit)
fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$"));
else if (u->unit_number == options.stdout_unit)
fstrcpy (iqp->name, iqp->name_len, "CONOUT$", sizeof("CONOUT$"));
else if (u->unit_number == options.stderr_unit)
fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$"));
else
cf_strcpy (iqp->name, iqp->name_len, u->filename);
#else
cf_strcpy (iqp->name, iqp->name_len, u->filename);
#endif
}
if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.access)
{
case ACCESS_SEQUENTIAL:
p = "SEQUENTIAL";
break;
case ACCESS_DIRECT:
p = "DIRECT";
break;
case ACCESS_STREAM:
p = "STREAM";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad access");
}
cf_strcpy (iqp->access, iqp->access_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
{
if (u == NULL)
p = inquire_sequential (NULL, 0);
else
switch (u->flags.access)
{
case ACCESS_DIRECT:
case ACCESS_STREAM:
p = no;
break;
case ACCESS_SEQUENTIAL:
p = yes;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad access");
}
cf_strcpy (iqp->sequential, iqp->sequential_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
{
if (u == NULL)
p = inquire_direct (NULL, 0);
else
switch (u->flags.access)
{
case ACCESS_SEQUENTIAL:
case ACCESS_STREAM:
p = no;
break;
case ACCESS_DIRECT:
p = yes;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad access");
}
cf_strcpy (iqp->direct, iqp->direct_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.form)
{
case FORM_FORMATTED:
p = "FORMATTED";
break;
case FORM_UNFORMATTED:
p = "UNFORMATTED";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad form");
}
cf_strcpy (iqp->form, iqp->form_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
{
if (u == NULL)
p = inquire_formatted (NULL, 0);
else
switch (u->flags.form)
{
case FORM_FORMATTED:
p = yes;
break;
case FORM_UNFORMATTED:
p = no;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad form");
}
cf_strcpy (iqp->formatted, iqp->formatted_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
{
if (u == NULL)
p = inquire_unformatted (NULL, 0);
else
switch (u->flags.form)
{
case FORM_FORMATTED:
p = no;
break;
case FORM_UNFORMATTED:
p = yes;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad form");
}
cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
*iqp->recl_out = (u != NULL) ? u->recl : 0;
if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
*iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
{
/* This only makes sense in the context of DIRECT access. */
if (u != NULL && u->flags.access == ACCESS_DIRECT)
*iqp->nextrec = u->last_record + 1;
else
*iqp->nextrec = 0;
}
if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.blank)
{
case BLANK_NULL:
p = "NULL";
break;
case BLANK_ZERO:
p = "ZERO";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad blank");
}
cf_strcpy (iqp->blank, iqp->blank_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.pad)
{
case PAD_YES:
p = yes;
break;
case PAD_NO:
p = no;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
}
cf_strcpy (iqp->pad, iqp->pad_len, p);
}
if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
{
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
*iqp->pending = 0;
if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
*iqp->id = 0;
if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.encoding)
{
case ENCODING_DEFAULT:
p = "UNKNOWN";
break;
case ENCODING_UTF8:
p = "UTF-8";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
}
cf_strcpy (iqp->encoding, iqp->encoding_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.decimal)
{
case DECIMAL_POINT:
p = "POINT";
break;
case DECIMAL_COMMA:
p = "COMMA";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
}
cf_strcpy (iqp->decimal, iqp->decimal_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.async)
{
case ASYNC_YES:
p = yes;
break;
case ASYNC_NO:
p = no;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad async");
}
cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.sign)
{
case SIGN_PROCDEFINED:
p = "PROCESSOR_DEFINED";
break;
case SIGN_SUPPRESS:
p = "SUPPRESS";
break;
case SIGN_PLUS:
p = "PLUS";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
}
cf_strcpy (iqp->sign, iqp->sign_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.round)
{
case ROUND_UP:
p = "UP";
break;
case ROUND_DOWN:
p = "DOWN";
break;
case ROUND_ZERO:
p = "ZERO";
break;
case ROUND_NEAREST:
p = "NEAREST";
break;
case ROUND_COMPATIBLE:
p = "COMPATIBLE";
break;
case ROUND_PROCDEFINED:
p = "PROCESSOR_DEFINED";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad round");
}
cf_strcpy (iqp->round, iqp->round_len, p);
}
if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
{
if (u == NULL)
*iqp->size = -1;
else
{
sflush (u->s);
*iqp->size = ssize (u->s);
}
}
if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
{
if (u == NULL)
p = "UNKNOWN";
else
switch (u->flags.access)
{
case ACCESS_SEQUENTIAL:
case ACCESS_DIRECT:
p = no;
break;
case ACCESS_STREAM:
p = yes;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
}
cf_strcpy (iqp->iqstream, iqp->iqstream_len, p);
}
}
if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
{
if (u == NULL || u->flags.access == ACCESS_DIRECT)
p = undefined;
else
{
/* If the position is unspecified, check if we can figure
out whether it's at the beginning or end. */
if (u->flags.position == POSITION_UNSPECIFIED)
{
gfc_offset cur = stell (u->s);
if (cur == 0)
u->flags.position = POSITION_REWIND;
else if (cur != -1 && (ssize (u->s) == cur))
u->flags.position = POSITION_APPEND;
}
switch (u->flags.position)
{
case POSITION_REWIND:
p = "REWIND";
break;
case POSITION_APPEND:
p = "APPEND";
break;
case POSITION_ASIS:
p = "ASIS";
break;
default:
/* If the position has changed and is not rewind or
append, it must be set to a processor-dependent
value. */
p = "UNSPECIFIED";
break;
}
}
cf_strcpy (iqp->position, iqp->position_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.action)
{
case ACTION_READ:
p = "READ";
break;
case ACTION_WRITE:
p = "WRITE";
break;
case ACTION_READWRITE:
p = "READWRITE";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad action");
}
cf_strcpy (iqp->action, iqp->action_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
{
p = (!u || u->flags.action == ACTION_WRITE) ? no : yes;
cf_strcpy (iqp->read, iqp->read_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
{
p = (!u || u->flags.action == ACTION_READ) ? no : yes;
cf_strcpy (iqp->write, iqp->write_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
{
p = (!u || u->flags.action != ACTION_READWRITE) ? no : yes;
cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.delim)
{
case DELIM_NONE:
case DELIM_UNSPECIFIED:
p = "NONE";
break;
case DELIM_QUOTE:
p = "QUOTE";
break;
case DELIM_APOSTROPHE:
p = "APOSTROPHE";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
}
cf_strcpy (iqp->delim, iqp->delim_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
{
if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.pad)
{
case PAD_NO:
p = no;
break;
case PAD_YES:
p = yes;
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
}
cf_strcpy (iqp->pad, iqp->pad_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
{
if (u == NULL)
p = undefined;
else
switch (u->flags.convert)
{
/* big_endian is 0 for little-endian, 1 for big-endian. */
case GFC_CONVERT_NATIVE:
p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
break;
case GFC_CONVERT_SWAP:
p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
break;
default:
internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
}
cf_strcpy (iqp->convert, iqp->convert_len, p);
}
}
static void
execute_cfa_program (unsigned char *insn_ptr, unsigned char *insn_end,
struct frame_info *next_frame,
struct dwarf2_frame_state *fs)
{
CORE_ADDR pc = frame_pc_unwind (next_frame);
int bytes_read;
while (insn_ptr < insn_end && fs->pc <= pc)
{
unsigned char insn = *insn_ptr++;
ULONGEST utmp, reg;
LONGEST offset;
if ((insn & 0xc0) == DW_CFA_advance_loc)
fs->pc += (insn & 0x3f) * fs->code_align;
else if ((insn & 0xc0) == DW_CFA_offset)
{
reg = insn & 0x3f;
insn_ptr = read_uleb128 (insn_ptr, insn_end, &utmp);
offset = utmp * fs->data_align;
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg].how = DWARF2_FRAME_REG_SAVED_OFFSET;
fs->regs.reg[reg].loc.offset = offset;
}
else if ((insn & 0xc0) == DW_CFA_restore)
{
gdb_assert (fs->initial.reg);
reg = insn & 0x3f;
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg] = fs->initial.reg[reg];
}
else
{
switch (insn)
{
case DW_CFA_set_loc:
fs->pc = dwarf2_read_address (insn_ptr, insn_end, &bytes_read);
insn_ptr += bytes_read;
break;
case DW_CFA_advance_loc1:
utmp = extract_unsigned_integer (insn_ptr, 1);
fs->pc += utmp * fs->code_align;
insn_ptr++;
break;
case DW_CFA_advance_loc2:
utmp = extract_unsigned_integer (insn_ptr, 2);
fs->pc += utmp * fs->code_align;
insn_ptr += 2;
break;
case DW_CFA_advance_loc4:
utmp = extract_unsigned_integer (insn_ptr, 4);
fs->pc += utmp * fs->code_align;
insn_ptr += 4;
break;
case DW_CFA_offset_extended:
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
insn_ptr = read_uleb128 (insn_ptr, insn_end, &utmp);
offset = utmp * fs->data_align;
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg].how = DWARF2_FRAME_REG_SAVED_OFFSET;
fs->regs.reg[reg].loc.offset = offset;
break;
case DW_CFA_restore_extended:
gdb_assert (fs->initial.reg);
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg] = fs->initial.reg[reg];
break;
case DW_CFA_undefined:
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg].how = DWARF2_FRAME_REG_UNDEFINED;
break;
case DW_CFA_same_value:
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg].how = DWARF2_FRAME_REG_SAME_VALUE;
break;
case DW_CFA_register:
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
insn_ptr = read_uleb128 (insn_ptr, insn_end, &utmp);
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg].how = DWARF2_FRAME_REG_SAVED_REG;
fs->regs.reg[reg].loc.reg = utmp;
break;
case DW_CFA_remember_state:
{
struct dwarf2_frame_state_reg_info *new_rs;
new_rs = XMALLOC (struct dwarf2_frame_state_reg_info);
*new_rs = fs->regs;
fs->regs.reg = dwarf2_frame_state_copy_regs (&fs->regs);
fs->regs.prev = new_rs;
}
break;
case DW_CFA_restore_state:
{
struct dwarf2_frame_state_reg_info *old_rs = fs->regs.prev;
gdb_assert (old_rs);
xfree (fs->regs.reg);
fs->regs = *old_rs;
xfree (old_rs);
}
break;
case DW_CFA_def_cfa:
insn_ptr = read_uleb128 (insn_ptr, insn_end, &fs->cfa_reg);
insn_ptr = read_uleb128 (insn_ptr, insn_end, &utmp);
fs->cfa_offset = utmp;
fs->cfa_how = CFA_REG_OFFSET;
break;
case DW_CFA_def_cfa_register:
insn_ptr = read_uleb128 (insn_ptr, insn_end, &fs->cfa_reg);
fs->cfa_how = CFA_REG_OFFSET;
break;
case DW_CFA_def_cfa_offset:
insn_ptr = read_uleb128 (insn_ptr, insn_end, &fs->cfa_offset);
/* cfa_how deliberately not set. */
break;
case DW_CFA_nop:
break;
case DW_CFA_def_cfa_expression:
insn_ptr = read_uleb128 (insn_ptr, insn_end, &fs->cfa_exp_len);
fs->cfa_exp = insn_ptr;
fs->cfa_how = CFA_EXP;
insn_ptr += fs->cfa_exp_len;
break;
case DW_CFA_expression:
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
insn_ptr = read_uleb128 (insn_ptr, insn_end, &utmp);
fs->regs.reg[reg].loc.exp = insn_ptr;
fs->regs.reg[reg].exp_len = utmp;
fs->regs.reg[reg].how = DWARF2_FRAME_REG_SAVED_EXP;
insn_ptr += utmp;
break;
case DW_CFA_offset_extended_sf:
insn_ptr = read_uleb128 (insn_ptr, insn_end, ®);
insn_ptr = read_sleb128 (insn_ptr, insn_end, &offset);
offset += fs->data_align;
dwarf2_frame_state_alloc_regs (&fs->regs, reg + 1);
fs->regs.reg[reg].how = DWARF2_FRAME_REG_SAVED_OFFSET;
fs->regs.reg[reg].loc.offset = offset;
break;
case DW_CFA_def_cfa_sf:
insn_ptr = read_uleb128 (insn_ptr, insn_end, &fs->cfa_reg);
insn_ptr = read_sleb128 (insn_ptr, insn_end, &offset);
fs->cfa_offset = offset * fs->data_align;
fs->cfa_how = CFA_REG_OFFSET;
break;
case DW_CFA_def_cfa_offset_sf:
insn_ptr = read_sleb128 (insn_ptr, insn_end, &offset);
fs->cfa_offset = offset * fs->data_align;
/* cfa_how deliberately not set. */
break;
case DW_CFA_GNU_args_size:
/* Ignored. */
insn_ptr = read_uleb128 (insn_ptr, insn_end, &utmp);
break;
default:
internal_error (__FILE__, __LINE__, "Unknown CFI encountered.");
}
}
}
/* Don't allow remember/restore between CIE and FDE programs. */
dwarf2_frame_state_free_regs (fs->regs.prev);
fs->regs.prev = NULL;
}
static struct gdbarch *
mn10300_gdbarch_init (struct gdbarch_info info,
struct gdbarch_list *arches)
{
struct gdbarch *gdbarch;
struct gdbarch_tdep *tdep;
arches = gdbarch_list_lookup_by_info (arches, &info);
if (arches != NULL)
return arches->gdbarch;
tdep = xmalloc (sizeof (struct gdbarch_tdep));
gdbarch = gdbarch_alloc (&info, tdep);
switch (info.bfd_arch_info->mach)
{
case 0:
case bfd_mach_mn10300:
set_gdbarch_register_name (gdbarch, mn10300_generic_register_name);
tdep->am33_mode = 0;
break;
case bfd_mach_am33:
set_gdbarch_register_name (gdbarch, am33_register_name);
tdep->am33_mode = 1;
break;
default:
internal_error (__FILE__, __LINE__,
_("mn10300_gdbarch_init: Unknown mn10300 variant"));
break;
}
/* Registers. */
set_gdbarch_num_regs (gdbarch, E_NUM_REGS);
set_gdbarch_register_type (gdbarch, mn10300_register_type);
set_gdbarch_skip_prologue (gdbarch, mn10300_skip_prologue);
set_gdbarch_read_pc (gdbarch, mn10300_read_pc);
set_gdbarch_write_pc (gdbarch, mn10300_write_pc);
set_gdbarch_pc_regnum (gdbarch, E_PC_REGNUM);
set_gdbarch_sp_regnum (gdbarch, E_SP_REGNUM);
/* Stack unwinding. */
set_gdbarch_inner_than (gdbarch, core_addr_lessthan);
/* Breakpoints. */
set_gdbarch_breakpoint_from_pc (gdbarch, mn10300_breakpoint_from_pc);
/* decr_pc_after_break? */
/* Disassembly. */
set_gdbarch_print_insn (gdbarch, print_insn_mn10300);
/* Stage 2 */
/* MVS Note: at least the first one is deprecated! */
set_gdbarch_deprecated_use_struct_convention (gdbarch,
mn10300_use_struct_convention);
set_gdbarch_store_return_value (gdbarch, mn10300_store_return_value);
set_gdbarch_extract_return_value (gdbarch, mn10300_extract_return_value);
/* Stage 3 -- get target calls working. */
set_gdbarch_push_dummy_call (gdbarch, mn10300_push_dummy_call);
/* set_gdbarch_return_value (store, extract) */
mn10300_frame_unwind_init (gdbarch);
return gdbarch;
}
enum gdb_osabi
gdbarch_lookup_osabi (bfd *abfd)
{
struct gdb_osabi_sniffer *sniffer;
enum gdb_osabi osabi, match;
int match_specific;
/* If we aren't in "auto" mode, return the specified OS ABI. */
if (user_osabi_state == osabi_user)
return user_selected_osabi;
/* If we don't have a binary, just return unknown. The caller may
have other sources the OSABI can be extracted from, e.g., the
target description. */
if (abfd == NULL)
return GDB_OSABI_UNKNOWN;
match = GDB_OSABI_UNKNOWN;
match_specific = 0;
for (sniffer = gdb_osabi_sniffer_list; sniffer != NULL;
sniffer = sniffer->next)
{
if ((sniffer->arch == bfd_arch_unknown /* wildcard */
|| sniffer->arch == bfd_get_arch (abfd))
&& sniffer->flavour == bfd_get_flavour (abfd))
{
osabi = (*sniffer->sniffer) (abfd);
if (osabi < GDB_OSABI_UNKNOWN || osabi >= GDB_OSABI_INVALID)
{
internal_error
(__FILE__, __LINE__,
_("gdbarch_lookup_osabi: invalid OS ABI (%d) from sniffer "
"for architecture %s flavour %d"),
(int) osabi,
bfd_printable_arch_mach (bfd_get_arch (abfd), 0),
(int) bfd_get_flavour (abfd));
}
else if (osabi != GDB_OSABI_UNKNOWN)
{
/* A specific sniffer always overrides a generic sniffer.
Croak on multiple match if the two matches are of the
same class. If the user wishes to continue, we'll use
the first match. */
if (match != GDB_OSABI_UNKNOWN)
{
if ((match_specific && sniffer->arch != bfd_arch_unknown)
|| (!match_specific && sniffer->arch == bfd_arch_unknown))
{
internal_error
(__FILE__, __LINE__,
_("gdbarch_lookup_osabi: multiple %sspecific OS ABI "
"match for architecture %s flavour %d: first "
"match \"%s\", second match \"%s\""),
match_specific ? "" : "non-",
bfd_printable_arch_mach (bfd_get_arch (abfd), 0),
(int) bfd_get_flavour (abfd),
gdbarch_osabi_name (match),
gdbarch_osabi_name (osabi));
}
else if (sniffer->arch != bfd_arch_unknown)
{
match = osabi;
match_specific = 1;
}
}
else
{
match = osabi;
if (sniffer->arch != bfd_arch_unknown)
match_specific = 1;
}
}
}
}
return match;
}
void
store_inferior_registers (int regno)
{
int whatregs = 0;
if (regno == -1)
whatregs = WHATREGS_FLOAT | WHATREGS_GEN | WHATREGS_STACK;
else if (regno >= L0_REGNUM && regno <= I7_REGNUM)
whatregs = WHATREGS_STACK;
else if (regno >= FP0_REGNUM && regno < FP0_REGNUM + 32)
whatregs = WHATREGS_FLOAT;
else if (regno == SP_REGNUM)
whatregs = WHATREGS_STACK | WHATREGS_GEN;
else
whatregs = WHATREGS_GEN;
if (whatregs & WHATREGS_GEN)
{
struct econtext ec; /* general regs */
int retval;
ec.tbr = read_register (TBR_REGNUM);
memcpy (&ec.g1, ®isters[REGISTER_BYTE (G1_REGNUM)],
4 * REGISTER_RAW_SIZE (G1_REGNUM));
ec.psr = read_register (PS_REGNUM);
ec.y = read_register (Y_REGNUM);
ec.pc = read_register (PC_REGNUM);
ec.npc = read_register (NPC_REGNUM);
ec.wim = read_register (WIM_REGNUM);
memcpy (ec.o, ®isters[REGISTER_BYTE (O0_REGNUM)],
8 * REGISTER_RAW_SIZE (O0_REGNUM));
errno = 0;
retval = ptrace (PTRACE_SETREGS, PIDGET (inferior_ptid),
(PTRACE_ARG3_TYPE) & ec, 0);
if (errno)
perror_with_name ("ptrace(PTRACE_SETREGS)");
}
if (whatregs & WHATREGS_STACK)
{
int regoffset;
CORE_ADDR sp;
sp = read_register (SP_REGNUM);
if (regno == -1 || regno == SP_REGNUM)
{
if (!register_valid[L0_REGNUM + 5])
internal_error (__FILE__, __LINE__, "failed internal consistency check");
target_write_memory (sp + FRAME_SAVED_I0,
®isters[REGISTER_BYTE (I0_REGNUM)],
8 * REGISTER_RAW_SIZE (I0_REGNUM));
target_write_memory (sp + FRAME_SAVED_L0,
®isters[REGISTER_BYTE (L0_REGNUM)],
8 * REGISTER_RAW_SIZE (L0_REGNUM));
}
else if (regno >= L0_REGNUM && regno <= I7_REGNUM)
{
if (!register_valid[regno])
internal_error (__FILE__, __LINE__, "failed internal consistency check");
if (regno >= L0_REGNUM && regno <= L0_REGNUM + 7)
regoffset = REGISTER_BYTE (regno) - REGISTER_BYTE (L0_REGNUM)
+ FRAME_SAVED_L0;
else
regoffset = REGISTER_BYTE (regno) - REGISTER_BYTE (I0_REGNUM)
+ FRAME_SAVED_I0;
target_write_memory (sp + regoffset,
®isters[REGISTER_BYTE (regno)],
REGISTER_RAW_SIZE (regno));
}
}
if (whatregs & WHATREGS_FLOAT)
{
struct fcontext fc; /* fp regs */
int retval;
/* We read fcontext first so that we can get good values for fq_t... */
errno = 0;
retval = ptrace (PTRACE_GETFPREGS, PIDGET (inferior_ptid),
(PTRACE_ARG3_TYPE) & fc, 0);
if (errno)
perror_with_name ("ptrace(PTRACE_GETFPREGS)");
memcpy (fc.f.fregs, ®isters[REGISTER_BYTE (FP0_REGNUM)],
32 * REGISTER_RAW_SIZE (FP0_REGNUM));
fc.fsr = read_register (FPS_REGNUM);
errno = 0;
retval = ptrace (PTRACE_SETFPREGS, PIDGET (inferior_ptid),
(PTRACE_ARG3_TYPE) & fc, 0);
if (errno)
perror_with_name ("ptrace(PTRACE_SETFPREGS)");
}
}
void
generic_elf_osabi_sniff_abi_tag_sections (bfd *abfd, asection *sect, void *obj)
{
enum gdb_osabi *osabi = obj;
const char *name;
unsigned int sectsize;
char *note;
name = bfd_get_section_name (abfd, sect);
sectsize = bfd_section_size (abfd, sect);
/* Limit the amount of data to read. */
if (sectsize > MAX_NOTESZ)
sectsize = MAX_NOTESZ;
note = alloca (sectsize);
bfd_get_section_contents (abfd, sect, note, 0, sectsize);
/* .note.ABI-tag notes, used by GNU/Linux and FreeBSD. */
if (strcmp (name, ".note.ABI-tag") == 0)
{
/* GNU. */
if (check_note (abfd, sect, note, "GNU", 16, NT_GNU_ABI_TAG))
{
unsigned int abi_tag = bfd_h_get_32 (abfd, note + 16);
switch (abi_tag)
{
case GNU_ABI_TAG_LINUX:
*osabi = GDB_OSABI_LINUX;
break;
case GNU_ABI_TAG_HURD:
*osabi = GDB_OSABI_HURD;
break;
case GNU_ABI_TAG_SOLARIS:
*osabi = GDB_OSABI_SOLARIS;
break;
case GNU_ABI_TAG_FREEBSD:
*osabi = GDB_OSABI_FREEBSD_ELF;
break;
case GNU_ABI_TAG_NETBSD:
*osabi = GDB_OSABI_NETBSD_ELF;
break;
default:
internal_error (__FILE__, __LINE__,
_("generic_elf_osabi_sniff_abi_tag_sections: "
"unknown OS number %d"),
abi_tag);
}
return;
}
/* FreeBSD. */
if (check_note (abfd, sect, note, "FreeBSD", 4, NT_FREEBSD_ABI_TAG))
{
/* There is no need to check the version yet. */
*osabi = GDB_OSABI_FREEBSD_ELF;
return;
}
/* DragonFly. */
if (check_note (abfd, sect, note, "DragonFly", 4, NT_DRAGONFLY_ABI_TAG))
{
/* There is no need to check the version yet. */
*osabi = GDB_OSABI_DRAGONFLY;
return;
}
return;
}
/* .note.netbsd.ident notes, used by NetBSD. */
if (strcmp (name, ".note.netbsd.ident") == 0
&& check_note (abfd, sect, note, "NetBSD", 4, NT_NETBSD_IDENT))
{
/* There is no need to check the version yet. */
*osabi = GDB_OSABI_NETBSD_ELF;
return;
}
/* .note.openbsd.ident notes, used by OpenBSD. */
if (strcmp (name, ".note.openbsd.ident") == 0
&& check_note (abfd, sect, note, "OpenBSD", 4, NT_OPENBSD_IDENT))
{
/* There is no need to check the version yet. */
*osabi = GDB_OSABI_OPENBSD_ELF;
return;
}
/* .note.netbsdcore.procinfo notes, used by NetBSD. */
if (strcmp (name, ".note.netbsdcore.procinfo") == 0)
{
*osabi = GDB_OSABI_NETBSD_ELF;
return;
}
}
void
read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
int w, seen_dp, exponent;
int exponent_sign;
const char *p;
char *buffer;
char *out;
int seen_int_digit; /* Seen a digit before the decimal point? */
int seen_dec_digit; /* Seen a digit after the decimal point? */
seen_dp = 0;
seen_int_digit = 0;
seen_dec_digit = 0;
exponent_sign = 1;
exponent = 0;
w = f->u.w;
/* Read in the next block. */
p = read_block_form (dtp, &w);
if (p == NULL)
return;
p = eat_leading_spaces (&w, (char*) p);
if (w == 0)
goto zero;
/* In this buffer we're going to re-format the number cleanly to be parsed
by convert_real in the end; this assures we're using strtod from the
C library for parsing and thus probably get the best accuracy possible.
This process may add a '+0.0' in front of the number as well as change the
exponent because of an implicit decimal point or the like. Thus allocating
strlen ("+0.0e-1000") == 10 characters plus one for NUL more than the
original buffer had should be enough. */
buffer = gfc_alloca (w + 11);
out = buffer;
/* Optional sign */
if (*p == '-' || *p == '+')
{
if (*p == '-')
*(out++) = '-';
++p;
--w;
}
p = eat_leading_spaces (&w, (char*) p);
if (w == 0)
goto zero;
/* Process the mantissa string. */
while (w > 0)
{
switch (*p)
{
case ',':
if (dtp->u.p.current_unit->decimal_status != DECIMAL_COMMA)
goto bad_float;
/* Fall through. */
case '.':
if (seen_dp)
goto bad_float;
if (!seen_int_digit)
*(out++) = '0';
*(out++) = '.';
seen_dp = 1;
break;
case ' ':
if (dtp->u.p.blank_status == BLANK_ZERO)
{
*(out++) = '0';
goto found_digit;
}
else if (dtp->u.p.blank_status == BLANK_NULL)
break;
else
/* TODO: Should we check instead that there are only trailing
blanks here, as is done below for exponents? */
goto done;
/* Fall through. */
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
*(out++) = *p;
found_digit:
if (!seen_dp)
seen_int_digit = 1;
else
seen_dec_digit = 1;
break;
case '-':
case '+':
goto exponent;
case 'e':
case 'E':
case 'd':
case 'D':
++p;
--w;
goto exponent;
default:
goto bad_float;
}
++p;
--w;
}
/* No exponent has been seen, so we use the current scale factor. */
exponent = - dtp->u.p.scale_factor;
goto done;
/* At this point the start of an exponent has been found. */
exponent:
p = eat_leading_spaces (&w, (char*) p);
if (*p == '-' || *p == '+')
{
if (*p == '-')
exponent_sign = -1;
++p;
--w;
}
/* At this point a digit string is required. We calculate the value
of the exponent in order to take account of the scale factor and
the d parameter before explict conversion takes place. */
if (w == 0)
goto bad_float;
if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
{
while (w > 0 && isdigit (*p))
{
exponent *= 10;
exponent += *p - '0';
++p;
--w;
}
/* Only allow trailing blanks. */
while (w > 0)
{
if (*p != ' ')
goto bad_float;
++p;
--w;
}
}
else /* BZ or BN status is enabled. */
{
while (w > 0)
{
if (*p == ' ')
{
if (dtp->u.p.blank_status == BLANK_ZERO)
exponent *= 10;
else
assert (dtp->u.p.blank_status == BLANK_NULL);
}
else if (!isdigit (*p))
goto bad_float;
else
{
exponent *= 10;
exponent += *p - '0';
}
++p;
--w;
}
}
exponent *= exponent_sign;
done:
/* Use the precision specified in the format if no decimal point has been
seen. */
if (!seen_dp)
exponent -= f->u.real.d;
/* Output a trailing '0' after decimal point if not yet found. */
if (seen_dp && !seen_dec_digit)
*(out++) = '0';
/* Print out the exponent to finish the reformatted number. Maximum 4
digits for the exponent. */
if (exponent != 0)
{
int dig;
*(out++) = 'e';
if (exponent < 0)
{
*(out++) = '-';
exponent = - exponent;
}
assert (exponent < 10000);
for (dig = 3; dig >= 0; --dig)
{
out[dig] = (char) ('0' + exponent % 10);
exponent /= 10;
}
out += 4;
}
*(out++) = '\0';
/* Do the actual conversion. */
convert_real (dtp, dest, buffer, length);
return;
/* The value read is zero. */
zero:
switch (length)
{
case 4:
*((GFC_REAL_4 *) dest) = 0.0;
break;
case 8:
*((GFC_REAL_8 *) dest) = 0.0;
break;
#ifdef HAVE_GFC_REAL_10
case 10:
*((GFC_REAL_10 *) dest) = 0.0;
break;
#endif
#ifdef HAVE_GFC_REAL_16
case 16:
*((GFC_REAL_16 *) dest) = 0.0;
break;
#endif
default:
internal_error (&dtp->common, "Unsupported real kind during IO");
}
return;
bad_float:
generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Bad value during floating point read");
next_record (dtp, 1);
return;
}
void
ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
int i = 0;
int shapeSize = 0;
GFC_DESCRIPTOR_DATA (f_ptr_out) = c_ptr_in;
if (shape != NULL)
{
index_type source_stride, size;
index_type str = 1;
char *p;
f_ptr_out->offset = str;
shapeSize = 0;
p = shape->base_addr;
size = GFC_DESCRIPTOR_SIZE(shape);
source_stride = GFC_DESCRIPTOR_STRIDE_BYTES(shape,0);
/* shape's length (rank of the output array) */
shapeSize = GFC_DESCRIPTOR_EXTENT(shape,0);
for (i = 0; i < shapeSize; i++)
{
index_type ub;
/* Have to allow for the SHAPE array to be any valid kind for
an INTEGER type. */
switch (size)
{
#ifdef HAVE_GFC_INTEGER_1
case 1:
ub = *((GFC_INTEGER_1 *) p);
break;
#endif
#ifdef HAVE_GFC_INTEGER_2
case 2:
ub = *((GFC_INTEGER_2 *) p);
break;
#endif
#ifdef HAVE_GFC_INTEGER_4
case 4:
ub = *((GFC_INTEGER_4 *) p);
break;
#endif
#ifdef HAVE_GFC_INTEGER_8
case 8:
ub = *((GFC_INTEGER_8 *) p);
break;
#endif
#ifdef HAVE_GFC_INTEGER_16
case 16:
ub = *((GFC_INTEGER_16 *) p);
break;
#endif
default:
internal_error (NULL, "c_f_pointer_u0: Invalid size");
}
p += source_stride;
if (i != 0)
{
str = str * GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1);
f_ptr_out->offset += str;
}
/* Lower bound is 1, as specified by the draft. */
GFC_DIMENSION_SET(f_ptr_out->dim[i], 1, ub, str);
}
f_ptr_out->offset *= -1;
/* All we know is the rank, so set it, leaving the rest alone.
Make NO assumptions about the state of dtype coming in! If we
shift right by TYPE_SHIFT bits we'll throw away the existing
rank. Then, shift left by the same number to shift in zeros
and or with the new rank. */
f_ptr_out->dtype = ((f_ptr_out->dtype >> GFC_DTYPE_TYPE_SHIFT)
<< GFC_DTYPE_TYPE_SHIFT) | shapeSize;
}
void
new_unit (unit_flags * flags)
{
gfc_unit *u;
stream *s;
char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
/* Change unspecifieds to defaults. Leave (flags->action ==
ACTION_UNSPECIFIED) alone so open_external() can set it based on
what type of open actually works. */
if (flags->access == ACCESS_UNSPECIFIED)
flags->access = ACCESS_SEQUENTIAL;
if (flags->form == FORM_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL)
? FORM_FORMATTED : FORM_UNFORMATTED;
if (flags->delim == DELIM_UNSPECIFIED)
flags->delim = DELIM_NONE;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (ERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto cleanup;
}
}
if (flags->blank == BLANK_UNSPECIFIED)
flags->blank = BLANK_NULL;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (ERROR_OPTION_CONFLICT,
"BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto cleanup;
}
}
if (flags->pad == PAD_UNSPECIFIED)
flags->pad = PAD_YES;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (ERROR_OPTION_CONFLICT,
"PAD paramter conflicts with UNFORMATTED form in "
"OPEN statement");
goto cleanup;
}
}
if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
{
generate_error (ERROR_OPTION_CONFLICT,
"ACCESS parameter conflicts with SEQUENTIAL access in "
"OPEN statement");
goto cleanup;
}
else
if (flags->position == POSITION_UNSPECIFIED)
flags->position = POSITION_ASIS;
if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN;
/* Checks. */
if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
{
generate_error (ERROR_MISSING_OPTION,
"Missing RECL parameter in OPEN statement");
goto cleanup;
}
if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
{
generate_error (ERROR_BAD_OPTION,
"RECL parameter is non-positive in OPEN statement");
goto cleanup;
}
switch (flags->status)
{
case STATUS_SCRATCH:
if (ioparm.file == NULL)
break;
generate_error (ERROR_BAD_OPTION,
"FILE parameter must not be present in OPEN statement");
return;
case STATUS_OLD:
case STATUS_NEW:
case STATUS_REPLACE:
case STATUS_UNKNOWN:
if (ioparm.file != NULL)
break;
ioparm.file = tmpname;
ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit);
break;
default:
internal_error ("new_unit(): Bad status");
}
/* Make sure the file isn't already open someplace else.
Do not error if opening file preconnected to stdin, stdout, stderr. */
u = find_file ();
if (u != NULL
&& (options.stdin_unit < 0 || u->unit_number != options.stdin_unit)
&& (options.stdout_unit < 0 || u->unit_number != options.stdout_unit)
&& (options.stderr_unit < 0 || u->unit_number != options.stderr_unit))
{
generate_error (ERROR_ALREADY_OPEN, NULL);
goto cleanup;
}
/* Open file. */
s = open_external (flags);
if (s == NULL)
{
generate_error (ERROR_OS, NULL);
goto cleanup;
}
if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
flags->status = STATUS_OLD;
/* Create the unit structure. */
u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
memset (u, '\0', sizeof (gfc_unit) + ioparm.file_len);
u->unit_number = ioparm.unit;
u->s = s;
u->flags = *flags;
if (flags->position == POSITION_APPEND)
{
if (sseek (u->s, file_length (u->s)) == FAILURE)
generate_error (ERROR_OS, NULL);
u->endfile = AT_ENDFILE;
}
/* Unspecified recl ends up with a processor dependent value. */
u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset;
u->last_record = 0;
u->current_record = 0;
/* If the file is direct access, calculate the maximum record number
via a division now instead of letting the multiplication overflow
later. */
if (flags->access == ACCESS_DIRECT)
u->maxrec = g.max_offset / u->recl;
memmove (u->file, ioparm.file, ioparm.file_len);
u->file_len = ioparm.file_len;
insert_unit (u);
/* The file is now connected. Errors after this point leave the
file connected. Curiously, the standard requires that the
position specifier be ignored for new files so a newly connected
file starts out that the initial point. We still need to figure
out if the file is at the end or not. */
test_endfile (u);
cleanup:
/* Free memory associated with a temporary filename. */
if (flags->status == STATUS_SCRATCH)
free_mem (ioparm.file);
}
index_type count_0 (const gfc_array_l1 * array)
{
const GFC_LOGICAL_1 * restrict base;
index_type rank;
int kind;
int continue_loop;
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type result;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
kind = GFC_DESCRIPTOR_SIZE (array);
base = array->base_addr;
if (kind == 1 || kind == 2 || kind == 4 || kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, kind);
}
else
internal_error (NULL, "Funny sized logical array in count_0");
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
return 0;
}
result = 0;
continue_loop = 1;
while (continue_loop)
{
if (*base)
result ++;
count[0]++;
base += sstride[0];
n = 0;
while (count[n] == extent[n])
{
count[n] = 0;
base -= sstride[n] * extent[n];
n++;
if (n == rank)
{
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
}
return result;
}
static void
maintenance_internal_error (char *args, int from_tty)
{
internal_error (__FILE__, __LINE__, "%s", (args == NULL ? "" : args));
}
/* ------------------------------------------------------------------------
@NAME : foreign_letter()
@INPUT : str
start
stop
@OUTPUT : letter
@RETURNS : TRUE if the string delimited by start and stop is a foreign
letter control sequence
@DESCRIPTION: Determines if a character sequence is one of (La)TeX's
"foreign letter" control sequences (l, o, ae, oe, aa, ss, plus
uppercase versions). If `letter' is non-NULL, returns which
letter was found in it (as a bt_letter value).
@CALLS :
@CALLERS : purify_special_char()
@CREATED : 1997/10/19, GPW
@MODIFIED :
-------------------------------------------------------------------------- */
static boolean
foreign_letter (char *str, int start, int stop, bt_letter * letter)
{
char c1, c2;
bt_letter dummy;
/*
* This is written for speed, not flexibility -- adding new foreign
* letters would be trying and vexatious.
*
* N.B. my gold standard list of foreign letters is Kopka and Daly's
* *A Guide to LaTeX 2e*, section 2.5.6.
*/
if (letter == NULL) /* so we can assign to *letter */
letter = &dummy; /* without compunctions */
*letter = L_OTHER; /* assume not a "foreign" letter */
c1 = str[start+0]; /* only two characters that we're */
c2 = str[start+1]; /* interested in */
switch (stop - start)
{
case 1: /* one-character control sequences */
switch (c1) /* (\o and \l) */
{
case 'o':
*letter = L_OSLASH_L; return TRUE;
case 'O':
*letter = L_OSLASH_U; return TRUE;
case 'l':
*letter = L_LSLASH_L; return TRUE;
case 'L':
*letter = L_LSLASH_L; return TRUE;
case 'i':
*letter = L_INODOT_L; return TRUE;
case 'j':
*letter = L_JNODOT_L; return TRUE;
default:
return FALSE;
}
break;
case 2: /* two character control sequences */
switch (c1) /* (\oe, \ae, \aa, and \ss) */
{
case 'o':
if (c2 == 'e') { *letter = L_OELIG_L; return TRUE; }
case 'O':
if (c2 == 'E') { *letter = L_OELIG_U; return TRUE; }
/* BibTeX 0.99 does not handle \aa and \AA -- but I do!*/
case 'a':
if (c2 == 'e')
{ *letter = L_AELIG_L; return TRUE; }
else if (c2 == 'a')
{ *letter = L_ACIRCLE_L; return TRUE; }
else
return FALSE;
case 'A':
if (c2 == 'E')
{ *letter = L_AELIG_U; return TRUE; }
else if (c2 == 'A')
{ *letter = L_ACIRCLE_U; return TRUE; }
else
return FALSE;
/* uppercase sharp-s -- new with LaTeX 2e (so far all I do
* is recognize it as a "foreign" letter)
*/
case 's':
if (c2 == 's')
{ *letter = L_SSHARP_L; return TRUE; }
else
return FALSE;
case 'S':
if (c2 == 'S')
{ *letter = L_SSHARP_U; return TRUE; }
else
return FALSE;
default:
return FALSE;
}
break;
default:
return FALSE;
} /* switch on length of control sequence */
internal_error ("foreign_letter(): should never reach end of function");
return FALSE; /* to keep gcc -Wall happy */
} /* foreign_letter */
