aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/adadecode.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/adadecode.c')
-rw-r--r--gcc/ada/adadecode.c405
1 files changed, 0 insertions, 405 deletions
diff --git a/gcc/ada/adadecode.c b/gcc/ada/adadecode.c
deleted file mode 100644
index d2270a2..0000000
--- a/gcc/ada/adadecode.c
+++ /dev/null
@@ -1,405 +0,0 @@
-/****************************************************************************
- * *
- * GNAT COMPILER COMPONENTS *
- * *
- * A D A D E C O D E *
- * *
- * C Implementation File *
- * *
- * Copyright (C) 2001-2022, Free Software Foundation, Inc. *
- * *
- * GNAT is free software; you can redistribute it and/or modify it under *
- * terms of the GNU General Public License as published by the Free Soft- *
- * ware Foundation; either version 3, or (at your option) any later ver- *
- * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
- * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
- * or FITNESS FOR A PARTICULAR PURPOSE. *
- * *
- * As a special exception under Section 7 of GPL version 3, you are granted *
- * additional permissions described in the GCC Runtime Library Exception, *
- * version 3.1, as published by the Free Software Foundation. *
- * *
- * You should have received a copy of the GNU General Public License and *
- * a copy of the GCC Runtime Library Exception along with this program; *
- * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
- * <http://www.gnu.org/licenses/>. *
- * *
- * GNAT was originally developed by the GNAT team at New York University. *
- * Extensive contributions were provided by Ada Core Technologies Inc. *
- * *
- ****************************************************************************/
-
-#include "runtime.h"
-#include <string.h>
-#include <stdio.h>
-#include <ctype.h>
-
-#include "adaint.h" /* for a macro version of xstrdup. */
-
-#ifndef ISDIGIT
-#define ISDIGIT(c) isdigit(c)
-#endif
-
-#ifndef PARMS
-#define PARMS(ARGS) ARGS
-#endif
-
-#include "adadecode.h"
-
-static void add_verbose (const char *, char *);
-static int has_prefix (const char *, const char *);
-static int has_suffix (const char *, const char *);
-
-/* This is a safe version of strcpy that can be used with overlapped
- pointers. Does nothing if s2 <= s1. */
-static void ostrcpy (char *s1, char *s2);
-
-/* Set to nonzero if we have written any verbose info. */
-static int verbose_info;
-
-/* Add TEXT to end of ADA_NAME, putting a leading " (" or ", ", depending
- on VERBOSE_INFO. */
-
-static void add_verbose (const char *text, char *ada_name)
-{
- strcat (ada_name, verbose_info ? ", " : " (");
- strcat (ada_name, text);
-
- verbose_info = 1;
-}
-
-/* Returns 1 if NAME starts with PREFIX. */
-
-static int
-has_prefix (const char *name, const char *prefix)
-{
- return strncmp (name, prefix, strlen (prefix)) == 0;
-}
-
-/* Returns 1 if NAME ends with SUFFIX. */
-
-static int
-has_suffix (const char *name, const char *suffix)
-{
- int nlen = strlen (name);
- int slen = strlen (suffix);
-
- return nlen > slen && strncmp (name + nlen - slen, suffix, slen) == 0;
-}
-
-/* Safe overlapped pointers version of strcpy. */
-
-static void
-ostrcpy (char *s1, char *s2)
-{
- if (s2 > s1)
- {
- while (*s2) *s1++ = *s2++;
- *s1 = '\0';
- }
-}
-
-/* This function will return the Ada name from the encoded form.
- The Ada coding is done in exp_dbug.ads and this is the inverse function.
- see exp_dbug.ads for full encoding rules, a short description is added
- below. Right now only objects and routines are handled. Ada types are
- stripped of their encodings.
-
- CODED_NAME is the encoded entity name.
-
- ADA_NAME is a pointer to a buffer, it will receive the Ada name. A safe
- size for this buffer is: strlen (coded_name) * 2 + 60. (60 is for the
- verbose information).
-
- VERBOSE is nonzero if more information about the entity is to be
- added at the end of the Ada name and surrounded by ( and ).
-
- Coded name Ada name verbose info
- ---------------------------------------------------------------------
- _ada_xyz xyz library level
- x__y__z x.y.z
- x__yTKB x.y task body
- x__yB x.y task body
- x__yX x.y body nested
- x__yXb x.y body nested
- xTK__y x.y in task
- x__y$2 x.y overloaded
- x__y__3 x.y overloaded
- x__Oabs "abs"
- x__Oand "and"
- x__Omod "mod"
- x__Onot "not"
- x__Oor "or"
- x__Orem "rem"
- x__Oxor "xor"
- x__Oeq "="
- x__One "/="
- x__Olt "<"
- x__Ole "<="
- x__Ogt ">"
- x__Oge ">="
- x__Oadd "+"
- x__Osubtract "-"
- x__Oconcat "&"
- x__Omultiply "*"
- x__Odivide "/"
- x__Oexpon "**" */
-
-void
-__gnat_decode (const char *coded_name, char *ada_name, int verbose)
-{
- int lib_subprog = 0;
- int overloaded = 0;
- int task_body = 0;
- int in_task = 0;
- int body_nested = 0;
-
- /* Deal with empty input early. This allows assuming non-null length
- later on, simplifying coding. In principle, it should be our callers
- business not to call here for empty inputs. It is easy enough to
- allow it, however, and might allow simplifications upstream so is not
- a bad thing per se. We need a guard in any case. */
-
- if (*coded_name == '\0')
- {
- *ada_name = '\0';
- return;
- }
-
- /* Check for library level subprogram. */
- else if (has_prefix (coded_name, "_ada_"))
- {
- strcpy (ada_name, coded_name + 5);
- lib_subprog = 1;
- }
- else
- strcpy (ada_name, coded_name);
-
- /* Check for the first triple underscore in the name. This indicates
- that the name represents a type with encodings; in this case, we
- need to strip the encodings. */
- {
- char *encodings;
-
- if ((encodings = (char *) strstr (ada_name, "___")) != NULL)
- {
- *encodings = '\0';
- }
- }
-
- /* Check for task body. */
- if (has_suffix (ada_name, "TKB"))
- {
- ada_name[strlen (ada_name) - 3] = '\0';
- task_body = 1;
- }
-
- if (has_suffix (ada_name, "B"))
- {
- ada_name[strlen (ada_name) - 1] = '\0';
- task_body = 1;
- }
-
- /* Check for body-nested entity: X[bn] */
- if (has_suffix (ada_name, "X"))
- {
- ada_name[strlen (ada_name) - 1] = '\0';
- body_nested = 1;
- }
-
- if (has_suffix (ada_name, "Xb"))
- {
- ada_name[strlen (ada_name) - 2] = '\0';
- body_nested = 1;
- }
-
- if (has_suffix (ada_name, "Xn"))
- {
- ada_name[strlen (ada_name) - 2] = '\0';
- body_nested = 1;
- }
-
- /* Change instance of TK__ (object declared inside a task) to __. */
- {
- char *tktoken;
-
- while ((tktoken = (char *) strstr (ada_name, "TK__")) != NULL)
- {
- ostrcpy (tktoken, tktoken + 2);
- in_task = 1;
- }
- }
-
- /* Check for overloading: name terminated by $nn or __nn. */
- {
- int len = strlen (ada_name);
- int n_digits = 0;
-
- if (len > 1)
- while (ISDIGIT ((int) ada_name[(int) len - 1 - n_digits]))
- n_digits++;
-
- /* Check if we have $ or __ before digits. */
- if (ada_name[len - 1 - n_digits] == '$')
- {
- ada_name[len - 1 - n_digits] = '\0';
- overloaded = 1;
- }
- else if (ada_name[len - 1 - n_digits] == '_'
- && ada_name[len - 1 - n_digits - 1] == '_')
- {
- ada_name[len - 1 - n_digits - 1] = '\0';
- overloaded = 1;
- }
- }
-
- /* Check for nested subprogram ending in .nnnn and strip suffix. */
- {
- int last = strlen (ada_name) - 1;
-
- while (ISDIGIT (ada_name[last]) && last > 0)
- {
- last--;
- }
-
- if (ada_name[last] == '.')
- {
- ada_name[last] = (char) 0;
- }
- }
-
- /* Change all "__" to ".". */
- {
- int len = strlen (ada_name);
- int k = 0;
-
- while (k < len)
- {
- if (ada_name[k] == '_' && ada_name[k+1] == '_')
- {
- ada_name[k] = '.';
- ostrcpy (ada_name + k + 1, ada_name + k + 2);
- len = len - 1;
- }
- k++;
- }
- }
-
- /* Checks for operator name. */
- {
- const char *trans_table[][2]
- = {{"Oabs", "\"abs\""}, {"Oand", "\"and\""}, {"Omod", "\"mod\""},
- {"Onot", "\"not\""}, {"Oor", "\"or\""}, {"Orem", "\"rem\""},
- {"Oxor", "\"xor\""}, {"Oeq", "\"=\""}, {"One", "\"/=\""},
- {"Olt", "\"<\""}, {"Ole", "\"<=\""}, {"Ogt", "\">\""},
- {"Oge", "\">=\""}, {"Oadd", "\"+\""}, {"Osubtract", "\"-\""},
- {"Oconcat", "\"&\""}, {"Omultiply", "\"*\""}, {"Odivide", "\"/\""},
- {"Oexpon", "\"**\""}, {NULL, NULL} };
- int k = 0;
-
- while (1)
- {
- char *optoken;
-
- if ((optoken = (char *) strstr (ada_name, trans_table[k][0])) != NULL)
- {
- int codedlen = strlen (trans_table[k][0]);
- int oplen = strlen (trans_table[k][1]);
-
- if (codedlen > oplen)
- /* We shrink the space. */
- ostrcpy (optoken, optoken + codedlen - oplen);
- else if (oplen > codedlen)
- {
- /* We need more space. */
- int len = strlen (ada_name);
- int space = oplen - codedlen;
- int num_to_move = &ada_name[len] - optoken;
- int t;
-
- for (t = 0; t < num_to_move; t++)
- ada_name[len + space - t - 1] = ada_name[len - t - 1];
- }
-
- /* Write symbol in the space. */
- memcpy (optoken, trans_table[k][1], oplen);
- }
- else
- k++;
-
- /* Check for table's ending. */
- if (trans_table[k][0] == NULL)
- break;
- }
- }
-
- /* If verbose mode is on, we add some information to the Ada name. */
- if (verbose)
- {
- if (overloaded)
- add_verbose ("overloaded", ada_name);
-
- if (lib_subprog)
- add_verbose ("library level", ada_name);
-
- if (body_nested)
- add_verbose ("body nested", ada_name);
-
- if (in_task)
- add_verbose ("in task", ada_name);
-
- if (task_body)
- add_verbose ("task body", ada_name);
-
- if (verbose_info == 1)
- strcat (ada_name, ")");
- }
-}
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-void
-get_encoding (const char *coded_name, char *encoding)
-{
- char * dest_index = encoding;
- const char *p;
- int found = 0;
- int count = 0;
-
- /* The heuristics is the following: we assume that the first triple
- underscore in an encoded name indicates the beginning of the
- first encoding, and that subsequent triple underscores indicate
- the next encodings. We assume that the encodings are always at the
- end of encoded names. */
-
- for (p = coded_name; *p != '\0'; p++)
- {
- if (*p != '_')
- count = 0;
- else
- if (++count == 3)
- {
- count = 0;
-
- if (found)
- {
- dest_index = dest_index - 2;
- *dest_index++ = ':';
- }
-
- p++;
- found = 1;
- }
-
- if (found)
- *dest_index++ = *p;
- }
-
- *dest_index = '\0';
-}
-
-#ifdef __cplusplus
-}
-#endif
generated by cgit v1.1 at 2025-05-22 17:49:38 +0000