Automatic date update in version.in
[external/binutils.git] / gdb / guile / scm-string.c
1 /* GDB/Scheme charset interface.
2
3    Copyright (C) 2014-2019 Free Software Foundation, Inc.
4
5    This file is part of GDB.
6
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19
20 /* See README file in this directory for implementation notes, coding
21    conventions, et.al.  */
22
23 #include "defs.h"
24 #include "charset.h"
25 #include "guile-internal.h"
26
27 /* Convert STRING to an int.
28    STRING must be a valid integer.  */
29
30 int
31 gdbscm_scm_string_to_int (SCM string)
32 {
33   char *s = scm_to_latin1_string (string);
34   int r = atoi (s);
35
36   free (s);
37   return r;
38 }
39
40 /* Convert a C (latin1) string to an SCM string.
41    "latin1" is chosen because Guile won't throw an exception.  */
42
43 SCM
44 gdbscm_scm_from_c_string (const char *string)
45 {
46   return scm_from_latin1_string (string);
47 }
48
49 /* Convert an SCM string to a C (latin1) string.
50    "latin1" is chosen because Guile won't throw an exception.
51    It is an error to call this if STRING is not a string.  */
52
53 gdb::unique_xmalloc_ptr<char>
54 gdbscm_scm_to_c_string (SCM string)
55 {
56   return gdb::unique_xmalloc_ptr<char> (scm_to_latin1_string (string));
57 }
58
59 /* Use printf to construct a Scheme string.  */
60
61 SCM
62 gdbscm_scm_from_printf (const char *format, ...)
63 {
64   va_list args;
65   SCM result;
66
67   va_start (args, format);
68   std::string string = string_vprintf (format, args);
69   va_end (args);
70   result = scm_from_latin1_string (string.c_str ());
71
72   return result;
73 }
74
75 /* Struct to pass data from gdbscm_scm_to_string to
76    gdbscm_call_scm_to_stringn.  */
77
78 struct scm_to_stringn_data
79 {
80   SCM string;
81   size_t *lenp;
82   const char *charset;
83   scm_t_string_failed_conversion_handler conversion_kind;
84   char *result;
85 };
86
87 /* Helper for gdbscm_scm_to_string to call scm_to_stringn
88    from within scm_c_catch.  */
89
90 static SCM
91 gdbscm_call_scm_to_stringn (void *datap)
92 {
93   struct scm_to_stringn_data *data = (struct scm_to_stringn_data *) datap;
94
95   data->result = scm_to_stringn (data->string, data->lenp, data->charset,
96                                  data->conversion_kind);
97   return SCM_BOOL_F;
98 }
99
100 /* Convert an SCM string to a string in charset CHARSET.
101    This function is guaranteed to not throw an exception.
102
103    If LENP is NULL then the returned string is NUL-terminated,
104    and an exception is thrown if the string contains embedded NULs.
105    Otherwise the string is not guaranteed to be NUL-terminated, but worse
106    there's no space to put a NUL if we wanted to (scm_to_stringn limitation).
107
108    If STRICT is non-zero, and there's a conversion error, then a
109    <gdb:exception> object is stored in *EXCEPT_SCMP, and NULL is returned.
110    If STRICT is zero, then escape sequences are used for characters that
111    can't be converted, and EXCEPT_SCMP may be passed as NULL.
112
113    It is an error to call this if STRING is not a string.  */
114
115 gdb::unique_xmalloc_ptr<char>
116 gdbscm_scm_to_string (SCM string, size_t *lenp,
117                       const char *charset, int strict, SCM *except_scmp)
118 {
119   struct scm_to_stringn_data data;
120   SCM scm_result;
121
122   data.string = string;
123   data.lenp = lenp;
124   data.charset = charset;
125   data.conversion_kind = (strict
126                           ? SCM_FAILED_CONVERSION_ERROR
127                           : SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
128   data.result = NULL;
129
130   scm_result = gdbscm_call_guile (gdbscm_call_scm_to_stringn, &data, NULL);
131
132   if (gdbscm_is_false (scm_result))
133     {
134       gdb_assert (data.result != NULL);
135       return gdb::unique_xmalloc_ptr<char> (data.result);
136     }
137   gdb_assert (gdbscm_is_exception (scm_result));
138   *except_scmp = scm_result;
139   return NULL;
140 }
141
142 /* Struct to pass data from gdbscm_scm_from_string to
143    gdbscm_call_scm_from_stringn.  */
144
145 struct scm_from_stringn_data
146 {
147   const char *string;
148   size_t len;
149   const char *charset;
150   scm_t_string_failed_conversion_handler conversion_kind;
151   SCM result;
152 };
153
154 /* Helper for gdbscm_scm_from_string to call scm_from_stringn
155    from within scm_c_catch.  */
156
157 static SCM
158 gdbscm_call_scm_from_stringn (void *datap)
159 {
160   struct scm_from_stringn_data *data = (struct scm_from_stringn_data *) datap;
161
162   data->result = scm_from_stringn (data->string, data->len, data->charset,
163                                    data->conversion_kind);
164   return SCM_BOOL_F;
165 }
166
167 /* Convert STRING to a Scheme string in charset CHARSET.
168    This function is guaranteed to not throw an exception.
169
170    If STRICT is non-zero, and there's a conversion error, then a
171    <gdb:exception> object is returned.
172    If STRICT is zero, then question marks are used for characters that
173    can't be converted (limitation of underlying Guile conversion support).  */
174
175 SCM
176 gdbscm_scm_from_string (const char *string, size_t len,
177                         const char *charset, int strict)
178 {
179   struct scm_from_stringn_data data;
180   SCM scm_result;
181
182   data.string = string;
183   data.len = len;
184   data.charset = charset;
185   /* The use of SCM_FAILED_CONVERSION_QUESTION_MARK is specified by Guile.  */
186   data.conversion_kind = (strict
187                           ? SCM_FAILED_CONVERSION_ERROR
188                           : SCM_FAILED_CONVERSION_QUESTION_MARK);
189   data.result = SCM_UNDEFINED;
190
191   scm_result = gdbscm_call_guile (gdbscm_call_scm_from_stringn, &data, NULL);
192
193   if (gdbscm_is_false (scm_result))
194     {
195       gdb_assert (!SCM_UNBNDP (data.result));
196       return data.result;
197     }
198   gdb_assert (gdbscm_is_exception (scm_result));
199   return scm_result;
200 }
201
202 /* Convert an SCM string to a host string.
203    This function is guaranteed to not throw an exception.
204
205    If LENP is NULL then the returned string is NUL-terminated,
206    and if the string contains embedded NULs then NULL is returned with
207    an exception object stored in *EXCEPT_SCMP.
208    Otherwise the string is not guaranteed to be NUL-terminated, but worse
209    there's no space to put a NUL if we wanted to (scm_to_stringn limitation).
210
211    Returns NULL if there is a conversion error, with the exception object
212    stored in *EXCEPT_SCMP.
213    It is an error to call this if STRING is not a string.  */
214
215 gdb::unique_xmalloc_ptr<char>
216 gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except_scmp)
217 {
218   return gdbscm_scm_to_string (string, lenp, host_charset (), 1, except_scmp);
219 }
220
221 /* Convert a host string to an SCM string.
222    This function is guaranteed to not throw an exception.
223    Returns a <gdb:exception> object if there's a conversion error.  */
224
225 SCM
226 gdbscm_scm_from_host_string (const char *string, size_t len)
227 {
228   return gdbscm_scm_from_string (string, len, host_charset (), 1);
229 }
230
231 /* (string->argv string) -> list
232    Return list of strings split up according to GDB's argv parsing rules.
233    This is useful when writing GDB commands in Scheme.  */
234
235 static SCM
236 gdbscm_string_to_argv (SCM string_scm)
237 {
238   char *string;
239   SCM result = SCM_EOL;
240
241   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
242                               string_scm, &string);
243
244   if (string == NULL || *string == '\0')
245     {
246       xfree (string);
247       return SCM_EOL;
248     }
249
250   gdb_argv c_argv (string);
251   for (char *arg : c_argv)
252     result = scm_cons (gdbscm_scm_from_c_string (arg), result);
253
254   xfree (string);
255
256   return scm_reverse_x (result, SCM_EOL);
257 }
258 \f
259 /* Initialize the Scheme charset interface to GDB.  */
260
261 static const scheme_function string_functions[] =
262 {
263   { "string->argv", 1, 0, 0, as_a_scm_t_subr (gdbscm_string_to_argv),
264   "\
265 Convert a string to a list of strings split up according to\n\
266 gdb's argv parsing rules." },
267
268   END_FUNCTIONS
269 };
270
271 void
272 gdbscm_initialize_strings (void)
273 {
274   gdbscm_define_functions (string_functions, 1);
275 }