/[cmucl]/src/lisp/parse.c
ViewVC logotype

Contents of /src/lisp/parse.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (show annotations)
Wed Mar 19 09:17:13 2008 UTC (6 years ago) by cshapiro
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, merged-unicode-utf16-extfmt-2009-06-11, unicode-utf16-extfmt-2009-03-27, snapshot-2008-08, snapshot-2008-09, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, GIT-CONVERSION, unicode-utf16-sync-2008-12, cross-sol-x86-merged, label-2009-03-16, release-19f-base, merge-sse2-packed, merge-with-19f, intl-branch-working-2010-02-11-1000, unicode-snapshot-2009-05, unicode-snapshot-2009-06, unicode-utf16-sync-2008-07, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, RELEASE_20b, snapshot-2008-04, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, label-2009-03-25, cross-sol-x86-2010-12-20, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, sse2-merge-with-2008-11, sse2-merge-with-2008-10, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, cross-sparc-branch-base, intl-branch-base, unicode-utf16-base, portable-clx-base, snapshot-2009-08, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, HEAD
Branch point for: RELEASE-19F-BRANCH, portable-clx-branch, cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, sse2-packed-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, unicode-utf16-branch, cross-sol-x86-branch, sse2-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.11: +6 -11 lines
File MIME type: text/plain
Always use prototype style function definitions.  Consistently use the
void keyword to specify empty parameter lists.
1 /* $Header: /tiger/var/lib/cvsroots/cmucl/src/lisp/parse.c,v 1.12 2008/03/19 09:17:13 cshapiro Rel $ */
2 #include <stdio.h>
3 #include <ctype.h>
4 #include <signal.h>
5 #include <string.h>
6 #include <strings.h>
7 #include <stdlib.h>
8
9 #include "lisp.h"
10 #include "internals.h"
11 #include "globals.h"
12 #include "vars.h"
13 #include "parse.h"
14 #include "os.h"
15 #include "interrupt.h"
16 #include "lispregs.h"
17 #include "monitor.h"
18 #include "arch.h"
19 #include "search.h"
20
21 /*
22 * What platforms DON'T have strcasecmp nowadays? Enable this if you
23 * don't have it.
24 */
25 #if 0
26
27 static int
28 strcasecmp(s1, s2)
29 char *s1, *s2;
30 {
31 int c1, c2;
32
33 do {
34 c1 = (*s1++);
35 if (isupper(c1))
36 c1 = tolower(c1);
37
38 c2 = (*s2++);
39 if (isupper(c2))
40 c2 = tolower(c2);
41 } while (c1 == c2 && c1 != 0);
42
43 return c1 - c2;
44 }
45
46 #endif
47
48 static void
49 skip_ws(char **ptr)
50 {
51 while (**ptr <= ' ' && **ptr != '\0')
52 (*ptr)++;
53 }
54
55 static boolean
56 string_to_long(char *token, long *value)
57 {
58 int base, digit;
59 long num;
60 char *ptr;
61
62 if (token == 0)
63 return FALSE;
64
65 if (token[0] == '0')
66 if (token[1] == 'x') {
67 base = 16;
68 token += 2;
69 } else {
70 base = 8;
71 token++;
72 } else if (token[0] == '#') {
73 switch (token[1]) {
74 case 'x':
75 case 'X':
76 base = 16;
77 token += 2;
78 break;
79 case 'o':
80 case 'O':
81 base = 8;
82 token += 2;
83 break;
84 default:
85 return FALSE;
86 }
87 } else
88 base = 10;
89
90 num = 0;
91 ptr = token;
92 while (*ptr != '\0') {
93 if (*ptr >= 'a' && *ptr <= 'f')
94 digit = *ptr + 10 - 'a';
95 else if (*ptr >= 'A' && *ptr <= 'F')
96 digit = *ptr + 10 - 'A';
97 else if (*ptr >= '0' && *ptr <= '9')
98 digit = *ptr - '0';
99 else
100 return FALSE;
101 if (digit < 0 || digit >= base)
102 return FALSE;
103
104 ptr++;
105 num = num * base + digit;
106 }
107
108 *value = num;
109 return TRUE;
110 }
111
112 static boolean
113 lookup_variable(char *name, lispobj * result)
114 {
115 struct var *var = lookup_by_name(name);
116
117 if (var == NULL)
118 return FALSE;
119 else {
120 *result = var_value(var);
121 return TRUE;
122 }
123 }
124
125
126 boolean
127 more_p(char **ptr)
128 {
129 skip_ws(ptr);
130
131 if (**ptr == '\0')
132 return FALSE;
133 else
134 return TRUE;
135 }
136
137 char *
138 parse_token(char **ptr)
139 {
140 char *token;
141
142 skip_ws(ptr);
143
144 if (**ptr == '\0')
145 return NULL;
146
147 token = *ptr;
148
149 while (**ptr > ' ')
150 (*ptr)++;
151
152 if (**ptr != '\0') {
153 **ptr = '\0';
154 (*ptr)++;
155 }
156
157 return token;
158 }
159
160 #if 0
161 static boolean
162 number_p(token)
163 char *token;
164 {
165 char *okay;
166
167 if (token == NULL)
168 return FALSE;
169
170 okay = "abcdefABCDEF987654321d0";
171
172 if (token[0] == '0')
173 if (token[1] == 'x' || token[1] == 'X')
174 token += 2;
175 else {
176 token++;
177 okay += 14;
178 } else if (token[0] == '#') {
179 switch (token[1]) {
180 case 'x':
181 case 'X':
182 break;
183 case 'o':
184 case 'O':
185 okay += 14;
186 break;
187 default:
188 return FALSE;
189 }
190 } else
191 okay += 12;
192
193 while (*token != '\0')
194 if (index(okay, *token++) == NULL)
195 return FALSE;
196 return TRUE;
197 }
198 #endif
199
200 long
201 parse_number(char **ptr)
202 {
203 char *token = parse_token(ptr);
204 long result;
205
206 if (token == NULL) {
207 printf("Expected a number.\n");
208 throw_to_monitor();
209 } else if (string_to_long(token, &result))
210 return result;
211 else {
212 printf("Invalid number: ``%s''\n", token);
213 throw_to_monitor();
214 }
215 return 0;
216 }
217
218 char *
219 parse_addr(char **ptr)
220 {
221 char *token = parse_token(ptr);
222 long result;
223
224 if (token == NULL) {
225 printf("Expected an address.\n");
226 throw_to_monitor();
227 } else if (token[0] == '$') {
228 if (!lookup_variable(token + 1, (lispobj *) & result)) {
229 printf("Unknown variable: ``%s''\n", token);
230 throw_to_monitor();
231 }
232 result &= ~7;
233 } else {
234 if (!string_to_long(token, &result)) {
235 printf("Invalid number: ``%s''\n", token);
236 throw_to_monitor();
237 }
238 result &= ~3;
239 }
240
241 if (!valid_addr((os_vm_address_t) result)) {
242 printf("Invalid address: 0x%lx\n", result);
243 throw_to_monitor();
244 }
245
246 return (char *) result;
247 }
248
249 static boolean
250 lookup_symbol(char *name, lispobj * result)
251 {
252 int count;
253 lispobj *headerptr;
254
255 /* Search static space */
256 headerptr = static_space;
257 count = ((lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) - static_space);
258 if (search_for_symbol(name, &headerptr, &count)) {
259 *result = (lispobj) headerptr | type_OtherPointer;
260 return TRUE;
261 }
262
263 /* Search dynamic space */
264 headerptr = current_dynamic_space;
265 #if !defined(ibmrt) && !defined(i386) && !defined(__x86_64)
266 count = current_dynamic_space_free_pointer - current_dynamic_space;
267 #else
268 count = (lispobj *) SymbolValue(ALLOCATION_POINTER) - current_dynamic_space;
269 #endif
270 if (search_for_symbol(name, &headerptr, &count)) {
271 *result = (lispobj) headerptr | type_OtherPointer;
272 return TRUE;
273 }
274
275 return FALSE;
276 }
277
278 static int
279 parse_regnum(char *s)
280 {
281 if ((s[1] == 'R') || (s[1] == 'r')) {
282 int regnum;
283
284 if (s[2] == '\0')
285 return -1;
286
287 /* skip the $R part and call atoi on the number */
288 regnum = atoi(s + 2);
289 if ((regnum >= 0) && (regnum < NREGS))
290 return regnum;
291 else
292 return -1;
293 } else {
294 int i;
295
296 for (i = 0; i < NREGS; i++)
297 if (strcasecmp(s + 1, lisp_register_names[i]) == 0)
298 #ifdef i386
299 return i * 2;
300 #else
301 return i;
302 #endif
303
304 return -1;
305 }
306 }
307
308 lispobj
309 parse_lispobj(char **ptr)
310 {
311 char *token = parse_token(ptr);
312 long pointer;
313 lispobj result;
314
315 if (token == NULL) {
316 printf("Expected an object.\n");
317 throw_to_monitor();
318 } else if (token[0] == '$') {
319 if (isalpha(token[1])) {
320 int free;
321 int regnum;
322 os_context_t *context;
323
324 free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2;
325
326 if (free == 0) {
327 printf
328 ("Variable ``%s'' is not valid -- there is no current interrupt context.\n",
329 token);
330 throw_to_monitor();
331 }
332
333 context = lisp_interrupt_contexts[free - 1];
334
335 regnum = parse_regnum(token);
336 if (regnum < 0) {
337 printf("Bogus register: ``%s''\n", token);
338 throw_to_monitor();
339 }
340
341 result = SC_REG(context, regnum);
342 } else if (!lookup_variable(token + 1, &result)) {
343 printf("Unknown variable: ``%s''\n", token);
344 throw_to_monitor();
345 }
346 } else if (token[0] == '@') {
347 if (string_to_long(token + 1, &pointer)) {
348 pointer &= ~3;
349 if (valid_addr((os_vm_address_t) pointer))
350 result = *(lispobj *) pointer;
351 else {
352 printf("Invalid address: ``%s''\n", token + 1);
353 throw_to_monitor();
354 }
355 } else {
356 printf("Invalid address: ``%s''\n", token + 1);
357 throw_to_monitor();
358 }
359 } else if (string_to_long(token, (long *) &result));
360 else if (lookup_symbol(token, &result));
361 else {
362 printf("Invalid lisp object: ``%s''\n", token);
363 throw_to_monitor();
364 }
365
366 return result;
367 }

  ViewVC Help
Powered by ViewVC 1.1.5