1 /* parsing for LDB monitor */
4 * This software is part of the SBCL system. See the README file for
7 * This software is derived from the CMU CL system, which was
8 * written at Carnegie Mellon University and released into the
9 * public domain. The software is in the public domain and is
10 * provided with absolutely no warranty. See the COPYING and CREDITS
11 * files for more information.
19 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
20 #include "pthreads_win32.h"
26 #if defined(LISP_FEATURE_SB_LDB)
32 #include "interrupt.h"
39 #include "pseudo-atomic.h"
41 #include "genesis/simple-fun.h"
42 #include "genesis/fdefn.h"
43 #include "genesis/symbol.h"
44 #include "genesis/static-symbols.h"
46 static void skip_ws(char **ptr
)
48 while (**ptr
<= ' ' && **ptr
!= '\0')
52 static boolean
string_to_long(char *token
, uword_t
*value
)
62 if (token
[1] == 'x') {
70 else if (token
[0] == '#') {
91 while (*ptr
!= '\0') {
92 if (*ptr
>= 'a' && *ptr
<= 'f')
93 digit
= *ptr
+ 10 - 'a';
94 else if (*ptr
>= 'A' && *ptr
<= 'F')
95 digit
= *ptr
+ 10 - 'A';
96 else if (*ptr
>= '0' && *ptr
<= '9')
100 if (digit
< 0 || digit
>= base
)
104 num
= num
* base
+ digit
;
111 static boolean
lookup_variable(char *name
, lispobj
*result
)
113 struct var
*var
= lookup_by_name(name
);
118 *result
= var_value(var
);
124 boolean
more_p(char **ptr
)
134 char *parse_token(char **ptr
)
156 uword_t
parse_number(char **ptr
)
158 char *token
= parse_token(ptr
);
162 printf("expected a number\n");
165 else if (string_to_long(token
, &result
))
168 printf("invalid number: ``%s''\n", token
);
174 char *parse_addr(char **ptr
, boolean safely
)
176 char *token
= parse_token(ptr
);
180 printf("expected an address\n");
183 else if (token
[0] == '$') {
184 if (!lookup_variable(token
+1, &result
)) {
185 printf("unknown variable: ``%s''\n", token
);
192 if (!string_to_long(token
, &value
)) {
193 printf("invalid number: ``%s''\n", token
);
196 result
= (value
& ~3);
199 if (safely
&& !is_valid_lisp_addr((os_vm_address_t
)result
)) {
200 printf("invalid Lisp-level address: %p\n", (void *)result
);
204 return (char *)result
;
207 static lispobj
lookup_symbol(char *name
)
212 /* Search static space. */
213 headerptr
= (lispobj
*)STATIC_SPACE_START
;
215 (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0) -
216 (lispobj
*)STATIC_SPACE_START
;
217 if (search_for_symbol(name
, &headerptr
, &count
))
218 return make_lispobj(headerptr
, OTHER_POINTER_LOWTAG
);
220 #ifdef LISP_FEATURE_IMMOBILE_SPACE
221 /* Search immobile space. */
222 headerptr
= (lispobj
*)IMMOBILE_SPACE_START
;
223 count
= IMMOBILE_FIXEDOBJ_SUBSPACE_SIZE
/ N_WORD_BYTES
;
224 if (search_for_symbol(name
, &headerptr
, &count
))
225 return make_lispobj(headerptr
, OTHER_POINTER_LOWTAG
);
228 /* Search dynamic space. */
229 #if defined(LISP_FEATURE_GENCGC)
230 headerptr
= (lispobj
*)DYNAMIC_SPACE_START
;
231 count
= (lispobj
*)get_alloc_pointer() - headerptr
;
233 headerptr
= (lispobj
*)current_dynamic_space
;
234 count
= dynamic_space_free_pointer
- headerptr
;
236 if (search_for_symbol(name
, &headerptr
, &count
))
237 return make_lispobj(headerptr
, OTHER_POINTER_LOWTAG
);
242 static int parse_regnum(char *s
)
244 if ((s
[1] == 'R') || (s
[1] == 'r')) {
250 /* skip the $R part and call atoi on the number */
251 regnum
= atoi(s
+ 2);
252 if ((regnum
>= 0) && (regnum
< NREGS
))
259 for (i
= 0; i
< NREGS
; i
++)
260 if (strcasecmp(s
+ 1, lisp_register_names
[i
]) == 0)
261 #ifdef LISP_FEATURE_X86
271 lispobj
parse_lispobj(char **ptr
)
273 struct thread
*thread
=arch_os_get_current_thread();
274 char *token
= parse_token(ptr
);
280 printf("expected an object\n");
282 } else if (token
[0] == '$') {
283 if (isalpha(token
[1])) {
286 os_context_t
*context
;
288 free_ici
= fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,thread
));
291 printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token
);
295 context
= thread
->interrupt_contexts
[free_ici
- 1];
297 regnum
= parse_regnum(token
);
299 printf("bogus register: ``%s''\n", token
);
303 result
= *os_context_register_addr(context
, regnum
);
304 } else if (!lookup_variable(token
+1, &result
)) {
305 printf("unknown variable: ``%s''\n", token
);
308 } else if (token
[0] == '@') {
309 if (string_to_long(token
+1, &pointer
)) {
311 if (is_valid_lisp_addr((os_vm_address_t
)pointer
))
312 result
= *(lispobj
*)pointer
;
314 printf("invalid Lisp-level address: ``%s''\n", token
+1);
319 printf("invalid address: ``%s''\n", token
+1);
323 else if (string_to_long(token
, &value
))
325 else if ((result
= lookup_symbol(token
)) != 0)
328 printf("invalid Lisp object: ``%s''\n", token
);
335 #endif /* defined(LISP_FEATURE_SB_LDB) */