Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* General utility routines for GDB/Scheme code. |
2 | ||
b811d2c2 | 3 | Copyright (C) 2014-2020 Free Software Foundation, Inc. |
ed3ef339 DE |
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" | |
ed3ef339 DE |
24 | #include "guile-internal.h" |
25 | ||
26 | /* Define VARIABLES in the gdb module. */ | |
27 | ||
28 | void | |
fe978cb0 | 29 | gdbscm_define_variables (const scheme_variable *variables, int is_public) |
ed3ef339 DE |
30 | { |
31 | const scheme_variable *sv; | |
32 | ||
33 | for (sv = variables; sv->name != NULL; ++sv) | |
34 | { | |
35 | scm_c_define (sv->name, sv->value); | |
fe978cb0 | 36 | if (is_public) |
ed3ef339 DE |
37 | scm_c_export (sv->name, NULL); |
38 | } | |
39 | } | |
40 | ||
41 | /* Define FUNCTIONS in the gdb module. */ | |
42 | ||
43 | void | |
fe978cb0 | 44 | gdbscm_define_functions (const scheme_function *functions, int is_public) |
ed3ef339 DE |
45 | { |
46 | const scheme_function *sf; | |
47 | ||
48 | for (sf = functions; sf->name != NULL; ++sf) | |
49 | { | |
50 | SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional, | |
51 | sf->rest, sf->func); | |
52 | ||
53 | scm_set_procedure_property_x (proc, gdbscm_documentation_symbol, | |
54 | gdbscm_scm_from_c_string (sf->doc_string)); | |
fe978cb0 | 55 | if (is_public) |
ed3ef339 DE |
56 | scm_c_export (sf->name, NULL); |
57 | } | |
58 | } | |
59 | ||
60 | /* Define CONSTANTS in the gdb module. */ | |
61 | ||
62 | void | |
63 | gdbscm_define_integer_constants (const scheme_integer_constant *constants, | |
fe978cb0 | 64 | int is_public) |
ed3ef339 DE |
65 | { |
66 | const scheme_integer_constant *sc; | |
67 | ||
68 | for (sc = constants; sc->name != NULL; ++sc) | |
69 | { | |
70 | scm_c_define (sc->name, scm_from_int (sc->value)); | |
fe978cb0 | 71 | if (is_public) |
ed3ef339 DE |
72 | scm_c_export (sc->name, NULL); |
73 | } | |
74 | } | |
75 | \f | |
76 | /* scm_printf, alas it doesn't exist. */ | |
77 | ||
78 | void | |
79 | gdbscm_printf (SCM port, const char *format, ...) | |
80 | { | |
81 | va_list args; | |
ed3ef339 DE |
82 | |
83 | va_start (args, format); | |
467dc1e2 | 84 | std::string string = string_vprintf (format, args); |
ed3ef339 | 85 | va_end (args); |
467dc1e2 | 86 | scm_puts (string.c_str (), port); |
ed3ef339 DE |
87 | } |
88 | ||
89 | /* Utility for calling from gdb to "display" an SCM object. */ | |
90 | ||
91 | void | |
92 | gdbscm_debug_display (SCM obj) | |
93 | { | |
94 | SCM port = scm_current_output_port (); | |
95 | ||
96 | scm_display (obj, port); | |
97 | scm_newline (port); | |
98 | scm_force_output (port); | |
99 | } | |
100 | ||
101 | /* Utility for calling from gdb to "write" an SCM object. */ | |
102 | ||
103 | void | |
104 | gdbscm_debug_write (SCM obj) | |
105 | { | |
106 | SCM port = scm_current_output_port (); | |
107 | ||
108 | scm_write (obj, port); | |
109 | scm_newline (port); | |
110 | scm_force_output (port); | |
111 | } | |
112 | \f | |
113 | /* Subroutine of gdbscm_parse_function_args to simplify it. | |
114 | Return the number of keyword arguments. */ | |
115 | ||
116 | static int | |
117 | count_keywords (const SCM *keywords) | |
118 | { | |
119 | int i; | |
120 | ||
121 | if (keywords == NULL) | |
122 | return 0; | |
123 | for (i = 0; keywords[i] != SCM_BOOL_F; ++i) | |
124 | continue; | |
125 | ||
126 | return i; | |
127 | } | |
128 | ||
129 | /* Subroutine of gdbscm_parse_function_args to simplify it. | |
130 | Validate an argument format string. | |
131 | The result is a boolean indicating if "." was seen. */ | |
132 | ||
133 | static int | |
134 | validate_arg_format (const char *format) | |
135 | { | |
136 | const char *p; | |
137 | int length = strlen (format); | |
138 | int optional_position = -1; | |
139 | int keyword_position = -1; | |
140 | int dot_seen = 0; | |
141 | ||
142 | gdb_assert (length > 0); | |
143 | ||
144 | for (p = format; *p != '\0'; ++p) | |
145 | { | |
146 | switch (*p) | |
147 | { | |
148 | case 's': | |
149 | case 't': | |
150 | case 'i': | |
151 | case 'u': | |
152 | case 'l': | |
153 | case 'n': | |
154 | case 'L': | |
155 | case 'U': | |
156 | case 'O': | |
157 | break; | |
158 | case '|': | |
159 | gdb_assert (keyword_position < 0); | |
160 | gdb_assert (optional_position < 0); | |
161 | optional_position = p - format; | |
162 | break; | |
163 | case '#': | |
164 | gdb_assert (keyword_position < 0); | |
165 | keyword_position = p - format; | |
166 | break; | |
167 | case '.': | |
168 | gdb_assert (p[1] == '\0'); | |
169 | dot_seen = 1; | |
170 | break; | |
171 | default: | |
172 | gdb_assert_not_reached ("invalid argument format character"); | |
173 | } | |
174 | } | |
175 | ||
176 | return dot_seen; | |
177 | } | |
178 | ||
179 | /* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error. */ | |
180 | #define CHECK_TYPE(ok, arg, position, func_name, expected_type) \ | |
181 | do { \ | |
182 | if (!(ok)) \ | |
183 | { \ | |
184 | return gdbscm_make_type_error ((func_name), (position), (arg), \ | |
185 | (expected_type)); \ | |
186 | } \ | |
187 | } while (0) | |
188 | ||
189 | /* Subroutine of gdbscm_parse_function_args to simplify it. | |
190 | Check the type of ARG against FORMAT_CHAR and extract the value. | |
191 | POSITION is the position of ARG in the argument list. | |
192 | The result is #f upon success or a <gdb:exception> object. */ | |
193 | ||
194 | static SCM | |
195 | extract_arg (char format_char, SCM arg, void *argp, | |
196 | const char *func_name, int position) | |
197 | { | |
198 | switch (format_char) | |
199 | { | |
200 | case 's': | |
201 | { | |
9a3c8263 | 202 | char **arg_ptr = (char **) argp; |
ed3ef339 DE |
203 | |
204 | CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position, | |
205 | func_name, _("string")); | |
4c693332 | 206 | *arg_ptr = gdbscm_scm_to_c_string (arg).release (); |
ed3ef339 DE |
207 | break; |
208 | } | |
209 | case 't': | |
210 | { | |
9a3c8263 | 211 | int *arg_ptr = (int *) argp; |
ed3ef339 DE |
212 | |
213 | /* While in Scheme, anything non-#f is "true", we're strict. */ | |
214 | CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name, | |
215 | _("boolean")); | |
216 | *arg_ptr = gdbscm_is_true (arg); | |
217 | break; | |
218 | } | |
219 | case 'i': | |
220 | { | |
9a3c8263 | 221 | int *arg_ptr = (int *) argp; |
ed3ef339 DE |
222 | |
223 | CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX), | |
224 | arg, position, func_name, _("int")); | |
225 | *arg_ptr = scm_to_int (arg); | |
226 | break; | |
227 | } | |
228 | case 'u': | |
229 | { | |
9a3c8263 | 230 | int *arg_ptr = (int *) argp; |
ed3ef339 DE |
231 | |
232 | CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX), | |
233 | arg, position, func_name, _("unsigned int")); | |
234 | *arg_ptr = scm_to_uint (arg); | |
235 | break; | |
236 | } | |
237 | case 'l': | |
238 | { | |
9a3c8263 | 239 | long *arg_ptr = (long *) argp; |
ed3ef339 DE |
240 | |
241 | CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX), | |
242 | arg, position, func_name, _("long")); | |
243 | *arg_ptr = scm_to_long (arg); | |
244 | break; | |
245 | } | |
246 | case 'n': | |
247 | { | |
9a3c8263 | 248 | unsigned long *arg_ptr = (unsigned long *) argp; |
ed3ef339 DE |
249 | |
250 | CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX), | |
251 | arg, position, func_name, _("unsigned long")); | |
252 | *arg_ptr = scm_to_ulong (arg); | |
253 | break; | |
254 | } | |
255 | case 'L': | |
256 | { | |
9a3c8263 | 257 | LONGEST *arg_ptr = (LONGEST *) argp; |
ed3ef339 DE |
258 | |
259 | CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX), | |
260 | arg, position, func_name, _("LONGEST")); | |
261 | *arg_ptr = gdbscm_scm_to_longest (arg); | |
262 | break; | |
263 | } | |
264 | case 'U': | |
265 | { | |
9a3c8263 | 266 | ULONGEST *arg_ptr = (ULONGEST *) argp; |
ed3ef339 DE |
267 | |
268 | CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX), | |
269 | arg, position, func_name, _("ULONGEST")); | |
270 | *arg_ptr = gdbscm_scm_to_ulongest (arg); | |
271 | break; | |
272 | } | |
273 | case 'O': | |
274 | { | |
9a3c8263 | 275 | SCM *arg_ptr = (SCM *) argp; |
ed3ef339 DE |
276 | |
277 | *arg_ptr = arg; | |
278 | break; | |
279 | } | |
280 | default: | |
281 | gdb_assert_not_reached ("invalid argument format character"); | |
282 | } | |
283 | ||
284 | return SCM_BOOL_F; | |
285 | } | |
286 | ||
287 | #undef CHECK_TYPE | |
288 | ||
289 | /* Look up KEYWORD in KEYWORD_LIST. | |
290 | The result is the index of the keyword in the list or -1 if not found. */ | |
291 | ||
292 | static int | |
293 | lookup_keyword (const SCM *keyword_list, SCM keyword) | |
294 | { | |
295 | int i = 0; | |
296 | ||
297 | while (keyword_list[i] != SCM_BOOL_F) | |
298 | { | |
299 | if (scm_is_eq (keyword_list[i], keyword)) | |
300 | return i; | |
301 | ++i; | |
302 | } | |
303 | ||
304 | return -1; | |
305 | } | |
306 | ||
ed3ef339 | 307 | |
4895f384 PA |
308 | /* Helper for gdbscm_parse_function_args that does most of the work, |
309 | in a separate function wrapped with gdbscm_wrap so that we can use | |
310 | non-trivial-dtor objects here. The result is #f upon success or a | |
311 | <gdb:exception> object otherwise. */ | |
ed3ef339 | 312 | |
4895f384 PA |
313 | static SCM |
314 | gdbscm_parse_function_args_1 (const char *func_name, | |
315 | int beginning_arg_pos, | |
316 | const SCM *keywords, | |
317 | const char *format, va_list args) | |
ed3ef339 | 318 | { |
ed3ef339 | 319 | const char *p; |
798a7429 | 320 | int i, have_rest, num_keywords, position; |
ed3ef339 DE |
321 | int have_optional = 0; |
322 | SCM status; | |
323 | SCM rest = SCM_EOL; | |
324 | /* Keep track of malloc'd strings. We need to free them upon error. */ | |
d8611974 | 325 | std::vector<char *> allocated_strings; |
ed3ef339 DE |
326 | |
327 | have_rest = validate_arg_format (format); | |
328 | num_keywords = count_keywords (keywords); | |
329 | ||
ed3ef339 DE |
330 | p = format; |
331 | position = beginning_arg_pos; | |
332 | ||
333 | /* Process required, optional arguments. */ | |
334 | ||
335 | while (*p && *p != '#' && *p != '.') | |
336 | { | |
337 | SCM arg; | |
338 | void *arg_ptr; | |
339 | ||
340 | if (*p == '|') | |
341 | { | |
342 | have_optional = 1; | |
343 | ++p; | |
344 | continue; | |
345 | } | |
346 | ||
347 | arg = va_arg (args, SCM); | |
348 | if (!have_optional || !SCM_UNBNDP (arg)) | |
349 | { | |
350 | arg_ptr = va_arg (args, void *); | |
351 | status = extract_arg (*p, arg, arg_ptr, func_name, position); | |
352 | if (!gdbscm_is_false (status)) | |
353 | goto fail; | |
354 | if (*p == 's') | |
d8611974 | 355 | allocated_strings.push_back (*(char **) arg_ptr); |
ed3ef339 DE |
356 | } |
357 | ++p; | |
358 | ++position; | |
359 | } | |
360 | ||
361 | /* Process keyword arguments. */ | |
362 | ||
363 | if (have_rest || num_keywords > 0) | |
364 | rest = va_arg (args, SCM); | |
365 | ||
366 | if (num_keywords > 0) | |
367 | { | |
8d749320 SM |
368 | SCM *keyword_args = XALLOCAVEC (SCM, num_keywords); |
369 | int *keyword_positions = XALLOCAVEC (int, num_keywords); | |
ed3ef339 DE |
370 | |
371 | gdb_assert (*p == '#'); | |
372 | ++p; | |
373 | ||
374 | for (i = 0; i < num_keywords; ++i) | |
375 | { | |
376 | keyword_args[i] = SCM_UNSPECIFIED; | |
377 | keyword_positions[i] = -1; | |
378 | } | |
379 | ||
380 | while (scm_is_pair (rest) | |
381 | && scm_is_keyword (scm_car (rest))) | |
382 | { | |
383 | SCM keyword = scm_car (rest); | |
384 | ||
385 | i = lookup_keyword (keywords, keyword); | |
386 | if (i < 0) | |
387 | { | |
388 | status = gdbscm_make_error (scm_arg_type_key, func_name, | |
389 | _("Unrecognized keyword: ~a"), | |
390 | scm_list_1 (keyword), keyword); | |
391 | goto fail; | |
392 | } | |
393 | if (!scm_is_pair (scm_cdr (rest))) | |
394 | { | |
395 | status = gdbscm_make_error | |
396 | (scm_arg_type_key, func_name, | |
397 | _("Missing value for keyword argument"), | |
398 | scm_list_1 (keyword), keyword); | |
399 | goto fail; | |
400 | } | |
401 | keyword_args[i] = scm_cadr (rest); | |
402 | keyword_positions[i] = position + 1; | |
403 | rest = scm_cddr (rest); | |
404 | position += 2; | |
405 | } | |
406 | ||
407 | for (i = 0; i < num_keywords; ++i) | |
408 | { | |
409 | int *arg_pos_ptr = va_arg (args, int *); | |
410 | void *arg_ptr = va_arg (args, void *); | |
411 | SCM arg = keyword_args[i]; | |
412 | ||
413 | if (! scm_is_eq (arg, SCM_UNSPECIFIED)) | |
414 | { | |
415 | *arg_pos_ptr = keyword_positions[i]; | |
416 | status = extract_arg (p[i], arg, arg_ptr, func_name, | |
417 | keyword_positions[i]); | |
418 | if (!gdbscm_is_false (status)) | |
419 | goto fail; | |
420 | if (p[i] == 's') | |
d8611974 | 421 | allocated_strings.push_back (*(char **) arg_ptr); |
ed3ef339 DE |
422 | } |
423 | } | |
424 | } | |
425 | ||
426 | /* Process "rest" arguments. */ | |
427 | ||
428 | if (have_rest) | |
429 | { | |
430 | if (num_keywords > 0) | |
431 | { | |
432 | SCM *rest_ptr = va_arg (args, SCM *); | |
433 | ||
434 | *rest_ptr = rest; | |
435 | } | |
436 | } | |
437 | else | |
438 | { | |
439 | if (! scm_is_null (rest)) | |
440 | { | |
441 | status = gdbscm_make_error (scm_args_number_key, func_name, | |
442 | _("Too many arguments"), | |
443 | SCM_EOL, SCM_BOOL_F); | |
444 | goto fail; | |
445 | } | |
446 | } | |
447 | ||
4895f384 PA |
448 | /* Return anything not-an-exception. */ |
449 | return SCM_BOOL_F; | |
ed3ef339 DE |
450 | |
451 | fail: | |
d8611974 | 452 | for (char *ptr : allocated_strings) |
ed3ef339 | 453 | xfree (ptr); |
4895f384 PA |
454 | |
455 | /* Return the exception, which gdbscm_wrap takes care of | |
456 | throwing. */ | |
457 | return status; | |
ed3ef339 | 458 | } |
4895f384 PA |
459 | |
460 | /* Utility to parse required, optional, and keyword arguments to Scheme | |
461 | functions. Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made | |
462 | at similarity or functionality. | |
463 | There is no result, if there's an error a Scheme exception is thrown. | |
464 | ||
465 | Guile provides scm_c_bind_keyword_arguments, and feel free to use it. | |
466 | This is for times when we want a bit more parsing. | |
467 | ||
468 | BEGINNING_ARG_POS is the position of the first argument passed to this | |
469 | routine. It should be one of the SCM_ARGn values. It could be > SCM_ARG1 | |
470 | if the caller chooses not to parse one or more required arguments. | |
471 | ||
472 | KEYWORDS may be NULL if there are no keywords. | |
473 | ||
474 | FORMAT: | |
475 | s - string -> char *, malloc'd | |
476 | t - boolean (gdb uses "t", for biT?) -> int | |
477 | i - int | |
478 | u - unsigned int | |
479 | l - long | |
480 | n - unsigned long | |
481 | L - longest | |
482 | U - unsigned longest | |
483 | O - random scheme object | |
484 | | - indicates the next set is for optional arguments | |
485 | # - indicates the next set is for keyword arguments (must follow |) | |
486 | . - indicates "rest" arguments are present, this character must appear last | |
487 | ||
488 | FORMAT must match the definition from scm_c_{make,define}_gsubr. | |
489 | Required and optional arguments appear in order in the format string. | |
490 | Afterwards, keyword-based arguments are processed. There must be as many | |
491 | remaining characters in the format string as their are keywords. | |
492 | Except for "|#.", the number of characters in the format string must match | |
493 | #required + #optional + #keywords. | |
494 | ||
495 | The function is required to be defined in a compatible manner: | |
496 | #required-args and #optional-arguments must match, and rest-arguments | |
497 | must be specified if keyword args are desired, and/or regular "rest" args. | |
498 | ||
499 | Example: For this function, | |
500 | scm_c_define_gsubr ("execute", 2, 3, 1, foo); | |
501 | the format string + keyword list could be any of: | |
502 | 1) "ss|ttt#tt", { "key1", "key2", NULL } | |
503 | 2) "ss|ttt.", { NULL } | |
504 | 3) "ss|ttt#t.", { "key1", NULL } | |
505 | ||
506 | For required and optional args pass the SCM of the argument, and a | |
507 | pointer to the value to hold the parsed result (type depends on format | |
508 | char). After that pass the SCM containing the "rest" arguments followed | |
509 | by pointers to values to hold parsed keyword arguments, and if specified | |
510 | a pointer to hold the remaining contents of "rest". | |
511 | ||
512 | For keyword arguments pass two pointers: the first is a pointer to an int | |
513 | that will contain the position of the argument in the arg list, and the | |
514 | second will contain result of processing the argument. The int pointed | |
515 | to by the first value should be initialized to -1. It can then be used | |
516 | to tell whether the keyword was present. | |
517 | ||
518 | If both keyword and rest arguments are present, the caller must pass a | |
519 | pointer to contain the new value of rest (after keyword args have been | |
520 | removed). | |
521 | ||
522 | There's currently no way, that I know of, to specify default values for | |
523 | optional arguments in C-provided functions. At the moment they're a | |
524 | work-in-progress. The caller should test SCM_UNBNDP for each optional | |
525 | argument. Unbound optional arguments are ignored. */ | |
526 | ||
527 | void | |
528 | gdbscm_parse_function_args (const char *func_name, | |
529 | int beginning_arg_pos, | |
530 | const SCM *keywords, | |
531 | const char *format, ...) | |
532 | { | |
533 | va_list args; | |
534 | va_start (args, format); | |
535 | ||
536 | gdbscm_wrap (gdbscm_parse_function_args_1, func_name, | |
537 | beginning_arg_pos, keywords, format, args); | |
538 | ||
539 | va_end (args); | |
540 | } | |
541 | ||
ed3ef339 DE |
542 | \f |
543 | /* Return longest L as a scheme object. */ | |
544 | ||
545 | SCM | |
546 | gdbscm_scm_from_longest (LONGEST l) | |
547 | { | |
548 | return scm_from_int64 (l); | |
549 | } | |
550 | ||
551 | /* Convert scheme object L to LONGEST. | |
552 | It is an error to call this if L is not an integer in range of LONGEST. | |
553 | (because the underlying Scheme function will thrown an exception, | |
554 | which is not part of our contract with the caller). */ | |
555 | ||
556 | LONGEST | |
557 | gdbscm_scm_to_longest (SCM l) | |
558 | { | |
559 | return scm_to_int64 (l); | |
560 | } | |
561 | ||
562 | /* Return unsigned longest L as a scheme object. */ | |
563 | ||
564 | SCM | |
565 | gdbscm_scm_from_ulongest (ULONGEST l) | |
566 | { | |
567 | return scm_from_uint64 (l); | |
568 | } | |
569 | ||
570 | /* Convert scheme object U to ULONGEST. | |
571 | It is an error to call this if U is not an integer in range of ULONGEST | |
572 | (because the underlying Scheme function will thrown an exception, | |
573 | which is not part of our contract with the caller). */ | |
574 | ||
575 | ULONGEST | |
576 | gdbscm_scm_to_ulongest (SCM u) | |
577 | { | |
578 | return scm_to_uint64 (u); | |
579 | } | |
580 | ||
581 | /* Same as scm_dynwind_free, but uses xfree. */ | |
582 | ||
583 | void | |
584 | gdbscm_dynwind_xfree (void *ptr) | |
585 | { | |
586 | scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY); | |
587 | } | |
588 | ||
589 | /* Return non-zero if PROC is a procedure. */ | |
590 | ||
591 | int | |
592 | gdbscm_is_procedure (SCM proc) | |
593 | { | |
594 | return gdbscm_is_true (scm_procedure_p (proc)); | |
595 | } | |
e698b8c4 DE |
596 | |
597 | /* Same as xstrdup, but the string is allocated on the GC heap. */ | |
598 | ||
599 | char * | |
600 | gdbscm_gc_xstrdup (const char *str) | |
601 | { | |
602 | size_t len = strlen (str); | |
224c3ddb SM |
603 | char *result |
604 | = (char *) scm_gc_malloc_pointerless (len + 1, "gdbscm_gc_xstrdup"); | |
e698b8c4 DE |
605 | |
606 | strcpy (result, str); | |
607 | return result; | |
608 | } | |
06eb1586 DE |
609 | |
610 | /* Return a duplicate of ARGV living on the GC heap. */ | |
611 | ||
612 | const char * const * | |
613 | gdbscm_gc_dup_argv (char **argv) | |
614 | { | |
615 | int i, len; | |
616 | size_t string_space; | |
617 | char *p, **result; | |
618 | ||
619 | for (len = 0, string_space = 0; argv[len] != NULL; ++len) | |
620 | string_space += strlen (argv[len]) + 1; | |
621 | ||
622 | /* Allocating "pointerless" works because the pointers are all | |
623 | self-contained within the object. */ | |
224c3ddb SM |
624 | result = (char **) scm_gc_malloc_pointerless (((len + 1) * sizeof (char *)) |
625 | + string_space, | |
626 | "parameter enum list"); | |
06eb1586 DE |
627 | p = (char *) &result[len + 1]; |
628 | ||
629 | for (i = 0; i < len; ++i) | |
630 | { | |
631 | result[i] = p; | |
632 | strcpy (p, argv[i]); | |
633 | p += strlen (p) + 1; | |
634 | } | |
635 | result[i] = NULL; | |
636 | ||
637 | return (const char * const *) result; | |
638 | } | |
d2929fdc DE |
639 | |
640 | /* Return non-zero if the version of Guile being used it at least | |
641 | MAJOR.MINOR.MICRO. */ | |
642 | ||
643 | int | |
644 | gdbscm_guile_version_is_at_least (int major, int minor, int micro) | |
645 | { | |
646 | if (major > gdbscm_guile_major_version) | |
647 | return 0; | |
648 | if (major < gdbscm_guile_major_version) | |
649 | return 1; | |
650 | if (minor > gdbscm_guile_minor_version) | |
651 | return 0; | |
652 | if (minor < gdbscm_guile_minor_version) | |
653 | return 1; | |
654 | if (micro > gdbscm_guile_micro_version) | |
655 | return 0; | |
656 | return 1; | |
657 | } |