1 /*
2 Copyright (C) 2004-2017,2018 John E. Davis
3
4 This file is part of the S-Lang Library.
5
6 The S-Lang Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU General Public License as
8 published by the Free Software Foundation; either version 2 of the
9 License, or (at your option) any later version.
10
11 The S-Lang Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19 USA.
20 */
21
22 #include "slinclud.h"
23
24 #include "slang.h"
25 #include "_slang.h"
26
27 #define MAX_FILE_LINE_LEN (SL_MAX_TOKEN_LEN + 2)
28
29 /* int _pSLang_Compile_Line_Num_Info; */
30 #if SLANG_HAS_BOSEOS
31 int _pSLang_Compile_BOSEOS;
32 int _pSLang_Compile_BOFEOF;
33 #endif
34 #if SLANG_HAS_DEBUG_CODE
35 /* static int Default_Compile_Line_Num_Info; */
36 #if 0
37 static int Default_Compile_BOSEOS;
38 #endif
39 #endif
40
41 static char Empty_Line[1] = {0};
42
43 static char *Input_Line = Empty_Line;
44 static char *Input_Line_Pointer;
45
46 static SLprep_Type *This_SLpp;
47
48 static SLang_Load_Type *LLT;
49
next_input_line(void)50 static int next_input_line (void)
51 {
52 LLT->line_num++;
53 Input_Line_Pointer = Input_Line = LLT->read(LLT);
54 if ((NULL == Input_Line) || _pSLang_Error)
55 {
56 Input_Line_Pointer = Input_Line = NULL;
57 return -1;
58 }
59 return 0;
60 }
61
free_slstring_token_val(_pSLang_Token_Type * tok)62 static void free_slstring_token_val (_pSLang_Token_Type *tok)
63 {
64 SLCONST char *s = tok->v.s_val;
65 if (s != NULL)
66 {
67 _pSLfree_hashed_string (s, strlen(s), tok->hash);
68 tok->v.s_val = NULL;
69 }
70 }
free_static_sval_token(_pSLang_Token_Type * tok)71 static void free_static_sval_token (_pSLang_Token_Type *tok)
72 {
73 tok->v.s_val = NULL;
74 }
75
_pSLtoken_init_slstring_token(_pSLang_Token_Type * tok,_pSLtok_Type type,SLCONST char * s,SLstrlen_Type len)76 _pSLtok_Type _pSLtoken_init_slstring_token (_pSLang_Token_Type *tok, _pSLtok_Type type,
77 SLCONST char *s, SLstrlen_Type len)
78 {
79 char *sval;
80 if (NULL == (sval = _pSLstring_make_hashed_string (s, len, &tok->hash)))
81 return tok->type = EOF_TOKEN;
82
83 tok->v.s_val = sval;
84 tok->free_val_func = free_slstring_token_val;
85 return tok->type = type;
86 }
87
free_bstring_token_val(_pSLang_Token_Type * tok)88 static void free_bstring_token_val (_pSLang_Token_Type *tok)
89 {
90 if (tok->v.b_val != NULL)
91 {
92 SLbstring_free (tok->v.b_val);
93 tok->v.b_val = NULL;
94 }
95 }
96
init_bstring_token(_pSLang_Token_Type * tok,unsigned char * s,unsigned int len)97 static _pSLtok_Type init_bstring_token (_pSLang_Token_Type *tok,
98 unsigned char *s, unsigned int len)
99 {
100 if (NULL == (tok->v.b_val = SLbstring_create (s, len)))
101 return tok->type = EOF_TOKEN;
102
103 tok->free_val_func = free_bstring_token_val;
104 return tok->type = BSTRING_TOKEN;
105 }
106
107 /* In this table, if a single character can represent an operator, e.g.,
108 * '&' (BAND_TOKEN), then it must be placed before multiple-character
109 * operators that begin with the same character, e.g., "&=". See
110 * get_op_token to see how this is exploited.
111 */
112 #define NUM_OPERATOR_TABLE_ROWS 31
113 typedef struct
114 {
115 char opstring[4];
116 _pSLtok_Type type;
117 }
118 Operator_Table_Entry_Type;
119 static SLCONST Operator_Table_Entry_Type Operators[NUM_OPERATOR_TABLE_ROWS] =
120 {
121 #define OFS_EXCL 0
122 {"!=", NE_TOKEN},
123 #define OFS_POUND 1
124 {"#", POUND_TOKEN},
125 #define OFS_BAND 2
126 {"&", BAND_TOKEN},
127 {"&&", SC_AND_TOKEN},
128 {"&=", BANDEQS_TOKEN},
129 #define OFS_STAR 5
130 {"*", TIMES_TOKEN},
131 {"*=", TIMESEQS_TOKEN},
132 #define OFS_PLUS 7
133 {"+", ADD_TOKEN},
134 {"++", PLUSPLUS_TOKEN},
135 {"+=", PLUSEQS_TOKEN},
136 #define OFS_MINUS 10
137 {"-", SUB_TOKEN},
138 {"--", MINUSMINUS_TOKEN},
139 {"-=", MINUSEQS_TOKEN},
140 {"->", NAMESPACE_TOKEN},
141 #define OFS_DIV 14
142 {"/", DIV_TOKEN},
143 {"/=", DIVEQS_TOKEN},
144 #define OFS_LT 16
145 {"<", LT_TOKEN},
146 {"<<", SHL_TOKEN},
147 {"<=", LE_TOKEN},
148 #define OFS_EQS 19
149 {"=", ASSIGN_TOKEN},
150 {"==", EQ_TOKEN},
151 #define OFS_GT 21
152 {">", GT_TOKEN},
153 {">=", GE_TOKEN},
154 {">>", SHR_TOKEN},
155 #define OFS_AT 24
156 {"@", DEREF_TOKEN},
157 #define OFS_POW 25
158 {"^", POW_TOKEN},
159 #define OFS_BOR 26
160 {"|", BOR_TOKEN},
161 {"||", SC_OR_TOKEN},
162 {"|=", BOREQS_TOKEN},
163 #define OFS_BNOT 29
164 {"~", BNOT_TOKEN},
165 {"", EOF_TOKEN}
166 };
167
lookup_op_token_string(_pSLtok_Type type)168 static SLCONST char *lookup_op_token_string (_pSLtok_Type type)
169 {
170 SLCONST Operator_Table_Entry_Type *op, *opmax;
171
172 op = Operators;
173 opmax = op + NUM_OPERATOR_TABLE_ROWS;
174
175 while (op < opmax)
176 {
177 if (op->type == type)
178 return op->opstring;
179 op++;
180 }
181 return NULL;
182 }
183
map_token_to_string(_pSLang_Token_Type * tok)184 static SLCONST char *map_token_to_string (_pSLang_Token_Type *tok)
185 {
186 SLCONST char *s;
187 static char numbuf [32];
188 _pSLtok_Type type;
189 s = NULL;
190
191 if (tok != NULL) type = tok->type;
192 else type = 0;
193
194 switch (type)
195 {
196 case 0:
197 s = "??";
198 break;
199
200 case EOF_TOKEN:
201 s = "End of input";
202 break;
203
204 case CHAR_TOKEN:
205 case SHORT_TOKEN:
206 case INT_TOKEN:
207 case LONG_TOKEN:
208 sprintf (numbuf, "%ld", tok->v.long_val);
209 s = numbuf;
210 break;
211
212 case UCHAR_TOKEN:
213 case USHORT_TOKEN:
214 case UINT_TOKEN:
215 case ULONG_TOKEN:
216 sprintf (numbuf, "%lu", (unsigned long)tok->v.long_val);
217 s = numbuf;
218 break;
219
220 #ifdef HAVE_LONG_LONG
221 case LLONG_TOKEN:
222 sprintf (numbuf, SLFMT_LLD, tok->v.llong_val);
223 s = numbuf;
224 break;
225
226 case ULLONG_TOKEN:
227 sprintf (numbuf, SLFMT_LLU, tok->v.ullong_val);
228 s = numbuf;
229 break;
230 #endif
231
232 case OBRACKET_TOKEN: s = "["; break;
233 case CBRACKET_TOKEN: s = "]"; break;
234 case OPAREN_TOKEN: s = "("; break;
235 case CPAREN_TOKEN: s = ")"; break;
236 case OBRACE_TOKEN: s = "{"; break;
237 case CBRACE_TOKEN: s = "}"; break;
238 case AND_TOKEN: s = "and"; break;
239 case OR_TOKEN: s = "or"; break;
240 case MOD_TOKEN: s = "mod"; break;
241 case SHL_TOKEN: s = "shl"; break;
242 case SHR_TOKEN: s = "shr"; break;
243 case BXOR_TOKEN: s = "xor"; break;
244 case COMMA_TOKEN: s = ","; break;
245 case SEMICOLON_TOKEN: s = ";"; break;
246 case COLON_TOKEN: s = ":"; break;
247 case QUESTION_TOKEN: s = "?"; break;
248
249 case ARRAY_TOKEN: s = "["; break;
250 case DOT_TOKEN: s = "."; break;
251
252 case MULTI_STRING_TOKEN:
253 if (tok->v.multistring_val != NULL)
254 {
255 _pSLang_Multiline_String_Type *m = tok->v.multistring_val;
256 if ((m->type == STRING_TOKEN) || (m->type == STRING_DOLLAR_TOKEN))
257 s = m->v.s_val;
258 else
259 s = "<binary string>";
260 }
261 break;
262
263 case _BSTRING_TOKEN:
264 case BSTRING_TOKEN:
265 case ESC_BSTRING_TOKEN:
266 s = "<binary string>";
267 break;
268
269 #if SLANG_HAS_FLOAT
270 case FLOAT_TOKEN:
271 case DOUBLE_TOKEN:
272 case COMPLEX_TOKEN:
273 /* drop */
274 #endif
275 default:
276 if (NULL != (s = lookup_op_token_string (type)))
277 break;
278 if (((tok->free_val_func == free_slstring_token_val)
279 || (tok->free_val_func == free_static_sval_token))
280 && (tok->num_refs != 0))
281 s = tok->v.s_val;
282 break;
283 }
284
285 if (s == NULL)
286 {
287 sprintf (numbuf, "(0x%02X)", type);
288 s = numbuf;
289 }
290
291 return s;
292 }
293
_pSLparse_error(int errcode,SLCONST char * str,_pSLang_Token_Type * tok,int flag)294 void _pSLparse_error (int errcode, SLCONST char *str, _pSLang_Token_Type *tok, int flag)
295 {
296 int line = LLT->line_num;
297 SLFUTURE_CONST char *file = (char *) LLT->name;
298
299 if (str == NULL)
300 str = "Parse Error";
301
302 #if SLANG_HAS_DEBUG_CODE
303 if ((tok != NULL) && (tok->line_number != -1))
304 line = tok->line_number;
305 #endif
306 if (file == NULL) file = "??";
307
308 if (flag || (_pSLang_Error == 0))
309 _pSLang_verror (errcode, "%s:%d: %s: found '%s'",
310 file, line, str, map_token_to_string (tok));
311
312 (void) _pSLerr_set_line_info (file, line, NULL);
313 }
314
315 #define ALPHA_CHAR 1
316 #define DIGIT_CHAR 2
317 #define EXCL_CHAR 3
318 #define SEP_CHAR 4
319 #define OP_CHAR 5
320 #define DOT_CHAR 6
321 #define BOLDOT_CHAR 7
322 #define DQUOTE_CHAR 8
323 #define QUOTE_CHAR 9
324 #define COMMENT_CHAR 10
325 #define NL_CHAR 11
326 #define BAD_CHAR 12
327 #define WHITE_CHAR 13
328 #define BQUOTE_CHAR 15
329
330 #define CHAR_EOF 255
331
332 #define CHAR_CLASS(c) (Char_Type_Table[(c)][0])
333 #define CHAR_DATA(c) (Char_Type_Table[(c)][1])
334
335 static SLCONST unsigned char Char_Type_Table[256][2] =
336 {
337 { NL_CHAR, 0 }, /* 0x0 */ { BAD_CHAR, 0 }, /* 0x1 */
338 { BAD_CHAR, 0 }, /* 0x2 */ { BAD_CHAR, 0 }, /* 0x3 */
339 { BAD_CHAR, 0 }, /* 0x4 */ { BAD_CHAR, 0 }, /* 0x5 */
340 { BAD_CHAR, 0 }, /* 0x6 */ { BAD_CHAR, 0 }, /* 0x7 */
341 { WHITE_CHAR, 0 }, /* 0x8 */ { WHITE_CHAR, 0 }, /* 0x9 */
342 { NL_CHAR, 0 }, /* \n */ { WHITE_CHAR, 0 }, /* 0xb */
343 { WHITE_CHAR, 0 }, /* 0xc */ { WHITE_CHAR, 0 }, /* \r */
344 { BAD_CHAR, 0 }, /* 0xe */ { BAD_CHAR, 0 }, /* 0xf */
345 { BAD_CHAR, 0 }, /* 0x10 */ { BAD_CHAR, 0 }, /* 0x11 */
346 { BAD_CHAR, 0 }, /* 0x12 */ { BAD_CHAR, 0 }, /* 0x13 */
347 { BAD_CHAR, 0 }, /* 0x14 */ { BAD_CHAR, 0 }, /* 0x15 */
348 { BAD_CHAR, 0 }, /* 0x16 */ { BAD_CHAR, 0 }, /* 0x17 */
349 { BAD_CHAR, 0 }, /* 0x18 */ { BAD_CHAR, 0 }, /* 0x19 */
350 { BAD_CHAR, 0 }, /* 0x1a */ { BAD_CHAR, 0 }, /* 0x1b */
351 { BAD_CHAR, 0 }, /* 0x1c */ { BAD_CHAR, 0 }, /* 0x1d */
352 { BAD_CHAR, 0 }, /* 0x1e */ { BAD_CHAR, 0 }, /* 0x1f */
353 { WHITE_CHAR, 0 }, /* 0x20 */ { EXCL_CHAR, OFS_EXCL }, /* ! */
354 { DQUOTE_CHAR, 0 }, /* " */ { OP_CHAR, OFS_POUND }, /* # */
355 { ALPHA_CHAR, 0 }, /* $ */ { NL_CHAR, 0 },/* % */
356 { OP_CHAR, OFS_BAND }, /* & */ { QUOTE_CHAR, 0 }, /* ' */
357 { SEP_CHAR, OPAREN_TOKEN }, /* ( */ { SEP_CHAR, CPAREN_TOKEN }, /* ) */
358 { OP_CHAR, OFS_STAR }, /* * */ { OP_CHAR, OFS_PLUS}, /* + */
359 { SEP_CHAR, COMMA_TOKEN }, /* , */ { OP_CHAR, OFS_MINUS }, /* - */
360 { DOT_CHAR, 0 }, /* . */ { OP_CHAR, OFS_DIV }, /* / */
361 { DIGIT_CHAR, 0 }, /* 0 */ { DIGIT_CHAR, 0 }, /* 1 */
362 { DIGIT_CHAR, 0 }, /* 2 */ { DIGIT_CHAR, 0 }, /* 3 */
363 { DIGIT_CHAR, 0 }, /* 4 */ { DIGIT_CHAR, 0 }, /* 5 */
364 { DIGIT_CHAR, 0 }, /* 6 */ { DIGIT_CHAR, 0 }, /* 7 */
365 { DIGIT_CHAR, 0 }, /* 8 */ { DIGIT_CHAR, 0 }, /* 9 */
366 { SEP_CHAR, COLON_TOKEN }, /* : */ { SEP_CHAR, SEMICOLON_TOKEN }, /* ; */
367 { OP_CHAR, OFS_LT }, /* < */ { OP_CHAR, OFS_EQS }, /* = */
368 { OP_CHAR, OFS_GT }, /* > */ { SEP_CHAR, QUESTION_TOKEN}, /* ? */
369 { OP_CHAR, OFS_AT}, /* @ */ { ALPHA_CHAR, 0 }, /* A */
370 { ALPHA_CHAR, 0 }, /* B */ { ALPHA_CHAR, 0 }, /* C */
371 { ALPHA_CHAR, 0 }, /* D */ { ALPHA_CHAR, 0 }, /* E */
372 { ALPHA_CHAR, 0 }, /* F */ { ALPHA_CHAR, 0 }, /* G */
373 { ALPHA_CHAR, 0 }, /* H */ { ALPHA_CHAR, 0 }, /* I */
374 { ALPHA_CHAR, 0 }, /* J */ { ALPHA_CHAR, 0 }, /* K */
375 { ALPHA_CHAR, 0 }, /* L */ { ALPHA_CHAR, 0 }, /* M */
376 { ALPHA_CHAR, 0 }, /* N */ { ALPHA_CHAR, 0 }, /* O */
377 { ALPHA_CHAR, 0 }, /* P */ { ALPHA_CHAR, 0 }, /* Q */
378 { ALPHA_CHAR, 0 }, /* R */ { ALPHA_CHAR, 0 }, /* S */
379 { ALPHA_CHAR, 0 }, /* T */ { ALPHA_CHAR, 0 }, /* U */
380 { ALPHA_CHAR, 0 }, /* V */ { ALPHA_CHAR, 0 }, /* W */
381 { ALPHA_CHAR, 0 }, /* X */ { ALPHA_CHAR, 0 }, /* Y */
382 { ALPHA_CHAR, 0 }, /* Z */ { SEP_CHAR, OBRACKET_TOKEN }, /* [ */
383 { BAD_CHAR, 0 }, /* \ */ { SEP_CHAR, CBRACKET_TOKEN }, /* ] */
384 { OP_CHAR, OFS_POW }, /* ^ */ { ALPHA_CHAR, 0 }, /* _ */
385 { BQUOTE_CHAR, 0 }, /* ` */ { ALPHA_CHAR, 0 }, /* a */
386 { ALPHA_CHAR, 0 }, /* b */ { ALPHA_CHAR, 0 }, /* c */
387 { ALPHA_CHAR, 0 }, /* d */ { ALPHA_CHAR, 0 }, /* e */
388 { ALPHA_CHAR, 0 }, /* f */ { ALPHA_CHAR, 0 }, /* g */
389 { ALPHA_CHAR, 0 }, /* h */ { ALPHA_CHAR, 0 }, /* i */
390 { ALPHA_CHAR, 0 }, /* j */ { ALPHA_CHAR, 0 }, /* k */
391 { ALPHA_CHAR, 0 }, /* l */ { ALPHA_CHAR, 0 }, /* m */
392 { ALPHA_CHAR, 0 }, /* n */ { ALPHA_CHAR, 0 }, /* o */
393 { ALPHA_CHAR, 0 }, /* p */ { ALPHA_CHAR, 0 }, /* q */
394 { ALPHA_CHAR, 0 }, /* r */ { ALPHA_CHAR, 0 }, /* s */
395 { ALPHA_CHAR, 0 }, /* t */ { ALPHA_CHAR, 0 }, /* u */
396 { ALPHA_CHAR, 0 }, /* v */ { ALPHA_CHAR, 0 }, /* w */
397 { ALPHA_CHAR, 0 }, /* x */ { ALPHA_CHAR, 0 }, /* y */
398 { ALPHA_CHAR, 0 }, /* z */ { SEP_CHAR, OBRACE_TOKEN }, /* { */
399 { OP_CHAR, OFS_BOR }, /* | */ { SEP_CHAR, CBRACE_TOKEN }, /* } */
400 { OP_CHAR, OFS_BNOT }, /* ~ */ { BAD_CHAR, 0 }, /* 0x7f */
401
402 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
403 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
404 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
405 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
406 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
407 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
408 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
409 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
410 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
411 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
412 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
413 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
414 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
415 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
416 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
417 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
418 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
419 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
420 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
421 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
422 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
423 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
424 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
425 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
426 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
427 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
428 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
429 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
430 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
431 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
432 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
433 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
434 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
435 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
436 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
437 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
438 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
439 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
440 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
441 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
442 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
443 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
444 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
445 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
446 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
447 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
448 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
449 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
450 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
451 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
452 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
453 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
454 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
455 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
456 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
457 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
458 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
459 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
460 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
461 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
462 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
463 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
464 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
465 { ALPHA_CHAR, 0 }, /* � */ { ALPHA_CHAR, 0 }, /* � */
466 };
467
_pSLcheck_identifier_syntax(SLCONST char * name)468 int _pSLcheck_identifier_syntax (SLCONST char *name)
469 {
470 unsigned char *p;
471
472 p = (unsigned char *) name;
473 if (ALPHA_CHAR == Char_Type_Table[*p][0]) while (1)
474 {
475 unsigned ch;
476 unsigned char type;
477
478 ch = *++p;
479
480 type = Char_Type_Table [ch][0];
481 if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR))
482 {
483 if (ch == 0)
484 return 0;
485 break;
486 }
487 }
488
489 _pSLang_verror (SL_SYNTAX_ERROR,
490 "Identifier, namespace or structure field name '%s' contains an illegal character", name);
491 return -1;
492 }
493
prep_get_char(void)494 static unsigned char prep_get_char (void)
495 {
496 register unsigned char ch;
497
498 if (0 != (ch = *Input_Line_Pointer++))
499 return ch;
500
501 Input_Line_Pointer--;
502 return 0;
503 }
504
unget_prep_char(unsigned char ch)505 static void unget_prep_char (unsigned char ch)
506 {
507 if ((Input_Line_Pointer != Input_Line)
508 && (ch != 0))
509 Input_Line_Pointer--;
510 /* *Input_Line_Pointer = ch; -- Do not modify the Input_Line */
511 }
512
513 #include "keywhash.c"
514
get_ident_token(_pSLang_Token_Type * tok,unsigned char * s,unsigned int len)515 static int get_ident_token (_pSLang_Token_Type *tok, unsigned char *s, unsigned int len)
516 {
517 unsigned char ch;
518 unsigned char type;
519 Keyword_Table_Type *table;
520
521 while (1)
522 {
523 ch = prep_get_char ();
524 type = CHAR_CLASS (ch);
525 if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR))
526 {
527 unget_prep_char (ch);
528 break;
529 }
530 if (len == (SL_MAX_TOKEN_LEN - 1))
531 {
532 _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Identifier length exceeded maximum supported value", NULL, 0);
533 return tok->type = EOF_TOKEN;
534 }
535 s [len++] = ch;
536 }
537
538 s[len] = 0;
539
540 /* check if keyword */
541 table = is_keyword ((char *) s, len);
542 if (table != NULL)
543 {
544 tok->v.s_val = table->name;
545 tok->free_val_func = free_static_sval_token;
546 tok->flags |= SLTOKEN_VALUE_IS_RESERVED;
547 return (tok->type = table->type);
548 }
549
550 return _pSLtoken_init_slstring_token (tok, IDENT_TOKEN, (char *) s, len);
551 }
552
553 #define LONG_MASK (~(long)(unsigned long)-1) /* 0 */
554 #define INT_MASK (~(long)(unsigned int)-1)
555 #define SHORT_MASK (~(long)(unsigned short)-1)
556 #define CHAR_MASK (~(long)(unsigned char)-1)
557
str_to_signed_constant(unsigned char * s,SLtype stype,_pSLtok_Type ttype,long mask,_pSLang_Token_Type * tok)558 static int str_to_signed_constant (unsigned char *s, SLtype stype, _pSLtok_Type ttype, long mask,
559 _pSLang_Token_Type *tok)
560 {
561 long lval = SLatol (s);
562
563 if (lval & mask)
564 {
565 SLang_verror (SL_SYNTAX_ERROR, "Literal integer constant is too large for %s", SLclass_get_datatype_name(stype));
566 return tok->type = EOF_TOKEN;
567 }
568
569 (void) stype;
570 tok->flags |= SLTOKEN_TYPE_INTEGER;
571 tok->v.long_val = lval;
572 return tok->type = ttype;
573 }
574
str_to_unsigned_constant(unsigned char * s,SLtype stype,_pSLtok_Type ttype,long mask,_pSLang_Token_Type * tok)575 static int str_to_unsigned_constant (unsigned char *s, SLtype stype, _pSLtok_Type ttype, long mask,
576 _pSLang_Token_Type *tok)
577 {
578 unsigned long lval = SLatoul (s);
579
580 if (lval & mask)
581 {
582 SLang_verror (SL_SYNTAX_ERROR, "Literal integer constant is too large for %s", SLclass_get_datatype_name(stype));
583 return tok->type = EOF_TOKEN;
584 }
585
586 (void) stype;
587 tok->flags |= SLTOKEN_TYPE_INTEGER;
588 tok->v.long_val = (long) lval;
589 return tok->type = ttype;
590 }
591
get_number_token(_pSLang_Token_Type * tok,unsigned char * s,unsigned int len)592 static int get_number_token (_pSLang_Token_Type *tok, unsigned char *s, unsigned int len)
593 {
594 unsigned char ch;
595 unsigned char type;
596 int tok_flags = 0;
597 int status;
598
599 /* Look for pattern [0-9.xXb]*([eE][-+]?[digits])?[ijfhul]? */
600 while (1)
601 {
602 ch = prep_get_char ();
603
604 type = CHAR_CLASS (ch);
605 if ((type != DIGIT_CHAR) && (type != DOT_CHAR))
606 {
607 if ((ch == 'x') || (ch == 'X'))
608 tok_flags = SLTOKEN_IS_HEX;
609 else if ((ch == 'b') || (ch == 'B'))
610 tok_flags = SLTOKEN_IS_BINARY;
611 else
612 break;
613
614 do
615 {
616 if (len == (SL_MAX_TOKEN_LEN - 1))
617 goto too_long_return_error;
618
619 s[len++] = ch;
620 ch = prep_get_char ();
621 type = CHAR_CLASS (ch);
622 }
623 while ((type == DIGIT_CHAR) || (type == ALPHA_CHAR));
624 break;
625 }
626 if (len == (SL_MAX_TOKEN_LEN - 1))
627 goto too_long_return_error;
628 s[len++] = ch;
629 }
630
631 /* At this point, type and ch are synchronized */
632
633 if ((ch == 'e') || (ch == 'E'))
634 {
635 if (len == (SL_MAX_TOKEN_LEN - 1))
636 goto too_long_return_error;
637 s[len++] = ch;
638 ch = prep_get_char ();
639 if ((ch == '+') || (ch == '-'))
640 {
641 if (len == (SL_MAX_TOKEN_LEN - 1))
642 goto too_long_return_error;
643 s[len++] = ch;
644 ch = prep_get_char ();
645 }
646
647 while (DIGIT_CHAR == (type = CHAR_CLASS(ch)))
648 {
649 if (len == (SL_MAX_TOKEN_LEN - 1))
650 goto too_long_return_error;
651 s[len++] = ch;
652 ch = prep_get_char ();
653 }
654 }
655 tok->flags |= tok_flags;
656
657 while (ALPHA_CHAR == type)
658 {
659 if (len == (SL_MAX_TOKEN_LEN - 1))
660 goto too_long_return_error;
661 s[len++] = ch;
662 ch = prep_get_char ();
663 type = CHAR_CLASS(ch);
664 }
665
666 unget_prep_char (ch);
667 s[len] = 0;
668
669 switch (SLang_guess_type ((char *) s))
670 {
671 default:
672 tok->v.s_val = (char *) s;
673 _pSLparse_error (SL_TYPE_MISMATCH, "Not a number", tok, 0);
674 return (tok->type = EOF_TOKEN);
675
676 #if SLANG_HAS_FLOAT
677 case SLANG_FLOAT_TYPE:
678 status = _pSLtoken_init_slstring_token (tok, FLOAT_TOKEN, (char *)s, len);
679 if (status == FLOAT_TOKEN)
680 tok->flags |= SLTOKEN_TYPE_FLOAT;
681 return status;
682
683 case SLANG_DOUBLE_TYPE:
684 status = _pSLtoken_init_slstring_token (tok, DOUBLE_TOKEN, (char *)s, len);
685 if (status == DOUBLE_TOKEN)
686 tok->flags |= SLTOKEN_TYPE_FLOAT;
687 return status;
688 #endif
689 #if SLANG_HAS_COMPLEX
690 case SLANG_COMPLEX_TYPE:
691 status = _pSLtoken_init_slstring_token (tok, COMPLEX_TOKEN, (char *)s, len);
692 if (status == COMPLEX_TOKEN)
693 tok->flags |= SLTOKEN_TYPE_FLOAT;
694 return status;
695 #endif
696 case SLANG_CHAR_TYPE:
697 return str_to_signed_constant (s, SLANG_CHAR_TYPE, CHAR_TOKEN, CHAR_MASK, tok);
698
699 case SLANG_UCHAR_TYPE:
700 return str_to_unsigned_constant (s, SLANG_UCHAR_TYPE, UCHAR_TOKEN, CHAR_MASK, tok);
701
702 case SLANG_SHORT_TYPE:
703 return str_to_signed_constant (s, SLANG_SHORT_TYPE, SHORT_TOKEN, SHORT_MASK, tok);
704
705 case SLANG_USHORT_TYPE:
706 return str_to_unsigned_constant (s, SLANG_USHORT_TYPE, USHORT_TOKEN, SHORT_MASK, tok);
707
708 case SLANG_INT_TYPE:
709 return str_to_signed_constant (s, SLANG_INT_TYPE, INT_TOKEN, INT_MASK, tok);
710
711 case SLANG_UINT_TYPE:
712 return str_to_unsigned_constant (s, SLANG_UINT_TYPE, UINT_TOKEN, INT_MASK, tok);
713
714 case SLANG_LONG_TYPE:
715 return str_to_signed_constant (s, SLANG_LONG_TYPE, LONG_TOKEN, LONG_MASK, tok);
716
717 case SLANG_ULONG_TYPE:
718 return str_to_unsigned_constant (s, SLANG_ULONG_TYPE, ULONG_TOKEN, LONG_MASK, tok);
719
720 #ifdef HAVE_LONG_LONG
721 case SLANG_LLONG_TYPE:
722 tok->v.llong_val = SLatoll (s);
723 tok->flags |= SLTOKEN_TYPE_INTEGER;
724 return tok->type = LLONG_TOKEN;
725 case SLANG_ULLONG_TYPE:
726 tok->flags |= SLTOKEN_TYPE_INTEGER;
727 tok->v.ullong_val = SLatoull (s);
728 return tok->type = ULLONG_TOKEN;
729 #endif
730 }
731
732 too_long_return_error:
733 _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Number too long for buffer", NULL, 0);
734 return (tok->type = EOF_TOKEN);
735 }
736
get_op_token(_pSLang_Token_Type * tok,char ch)737 static int get_op_token (_pSLang_Token_Type *tok, char ch)
738 {
739 unsigned int offset;
740 char second_char;
741 _pSLtok_Type type;
742 SLCONST char *name;
743 SLCONST Operator_Table_Entry_Type *op;
744
745 /* operators are: + - / * ++ -- += -= = == != > < >= <= | etc..
746 * These lex to the longest valid operator token.
747 */
748
749 offset = CHAR_DATA((unsigned char) ch);
750 op = Operators + offset;
751 if (0 == op->opstring[1])
752 {
753 name = op->opstring;
754 type = op->type;
755 }
756 else
757 {
758 type = EOF_TOKEN;
759 name = NULL;
760 }
761
762 second_char = prep_get_char ();
763 do
764 {
765 if (second_char == op->opstring[1])
766 {
767 name = op->opstring;
768 type = op->type;
769 break;
770 }
771 op++;
772 }
773 while (ch == op->opstring[0]);
774
775 tok->type = type;
776
777 if (type == EOF_TOKEN)
778 {
779 _pSLparse_error (SL_NOT_IMPLEMENTED, "Operator not supported", NULL, 0);
780 return type;
781 }
782
783 tok->v.s_val = (char *)name;
784
785 if (name[1] == 0)
786 unget_prep_char (second_char);
787
788 return type;
789 }
790
791 /* s and t may point to the same buffer --- even for unicode. This
792 * is because a wchar is denoted by (greater than) 4 characters \x{...}, which
793 * will expand to at most 6 bytes when UTF-8 encoded. That is:
794 * \x{F} expands to 1 byte
795 * \x{FF} expands to 2 bytes
796 * \x{FFF} expands to 3 bytes
797 * \x{FFFF} expands to 3 bytes
798 * \x{FFFFF} expands to 4 bytes
799 * \x{FFFFFF} expands to 5 bytes
800 * \x{7FFFFFF} expands to 6 bytes
801 *
802 * Also, consider octal, decimal, and hex forms:
803 *
804 * \200 (0x80)
805 * \d128
806 * \x80
807 *
808 * In all these cases, the escaped form uses 4 bytes. Hence, these forms also
809 * may be converted to UTF-8.
810 */
811 /* If this returns non-zero, then it is a binary string */
expand_escaped_string(register char * s,register char * t,register char * tmax,unsigned int * lenp,int is_binary)812 static int expand_escaped_string (register char *s,
813 register char *t, register char *tmax,
814 unsigned int *lenp, int is_binary)
815 {
816 char *s0;
817 char ch;
818 #if 0
819 int utf8_encode;
820
821 utf8_encode = (is_binary == 0) && _pSLinterp_UTF8_Mode;
822 #endif
823 s0 = s;
824 while (t < tmax)
825 {
826 int isunicode;
827 SLwchar_Type wch;
828 char *s1;
829 ch = *t++;
830
831 if (ch != '\\')
832 {
833 if (ch == 0) is_binary = 1;
834 *s++ = ch;
835 continue;
836 }
837
838 if ((t == tmax) /* \ at EOL */
839 || (((t + 1) == tmax) && (*t == '\n'))) /* \ \n at EOL */
840 break;
841
842 if (NULL == (t = _pSLexpand_escaped_char (t, tmax, &wch, &isunicode)))
843 {
844 is_binary = -1;
845 break;
846 }
847 if ((isunicode == 0)
848 #if 0
849 && ((wch < 127)
850 || (utf8_encode == 0))
851 #endif
852 )
853 {
854 if (wch == 0)
855 is_binary = 1;
856
857 *s++ = (char) wch;
858 continue;
859 }
860 /* Escaped representation is always greater than encoded form.
861 * So, 6 below is ok (although ugly).
862 */
863 s1 = (char *) SLutf8_encode (wch, (SLuchar_Type *)s, 6);
864 if (s1 == NULL)
865 {
866 _pSLang_verror (SL_INVALID_UTF8, "Unable to UTF-8 encode 0x%lX\n", (unsigned long)wch);
867 is_binary = -1;
868 break;
869 }
870 s = s1;
871 }
872 *s = 0;
873
874 *lenp = (unsigned char) (s - s0);
875 return is_binary;
876 }
877
878 #define STRING_SUFFIX_B 1
879 #define STRING_SUFFIX_Q 2
880 #define STRING_SUFFIX_R 4
881 #define STRING_SUFFIX_S 8
get_string_suffix(int * suffixp)882 static int get_string_suffix (int *suffixp)
883 {
884 int suffix = 0;
885
886 while (1)
887 {
888 unsigned char ch = prep_get_char ();
889 if (ch == 'B')
890 {
891 suffix |= STRING_SUFFIX_B;
892 continue;
893 }
894
895 if (ch == 'R')
896 {
897 suffix |= STRING_SUFFIX_R;
898 continue;
899 }
900
901 if (ch == 'Q')
902 {
903 suffix |= STRING_SUFFIX_Q;
904 continue;
905 }
906 if (ch == '$')
907 {
908 suffix |= STRING_SUFFIX_S;
909 continue;
910 }
911 unget_prep_char (ch);
912 break;
913 }
914
915 if ((suffix & STRING_SUFFIX_R) && (suffix & STRING_SUFFIX_Q))
916 {
917 _pSLparse_error (SL_SYNTAX_ERROR, "Conflicting suffix for string literal", NULL, 0);
918 return -1;
919 }
920
921 *suffixp = suffix;
922 return 0;
923 }
924
process_string_token(_pSLang_Token_Type * tok,unsigned char quote_char,unsigned char * s,unsigned int len,int has_backslash)925 static int process_string_token (_pSLang_Token_Type *tok, unsigned char quote_char,
926 unsigned char *s, unsigned int len,
927 int has_backslash)
928 {
929 SLwchar_Type wch;
930
931 if (('"' == quote_char) || (quote_char == '`'))
932 {
933 int suffix;
934 int is_binary;
935
936 if (-1 == get_string_suffix (&suffix))
937 return tok->type = EOF_TOKEN;
938
939 if ((quote_char == '`') && (0 == (suffix & STRING_SUFFIX_Q)))
940 suffix |= STRING_SUFFIX_R;
941
942 is_binary = (suffix & STRING_SUFFIX_B);
943 if (suffix & STRING_SUFFIX_R)
944 has_backslash = 0;
945
946 if (has_backslash)
947 is_binary = expand_escaped_string ((char *) s, (char *)s, (char *)s + len, &len, is_binary);
948
949 if (is_binary && (suffix & STRING_SUFFIX_S))
950 {
951 _pSLparse_error (SL_SYNTAX_ERROR, "A binary string is not permitted to have the $ suffix", NULL, 0);
952 return tok->type = EOF_TOKEN;
953 }
954
955 if (is_binary)
956 return init_bstring_token (tok, s, len);
957 else
958 {
959 _pSLtok_Type t = (suffix & STRING_SUFFIX_S) ? STRING_DOLLAR_TOKEN : STRING_TOKEN;
960 return _pSLtoken_init_slstring_token (tok, t, (char *) s, len);
961 }
962 }
963
964 /* else single character */
965
966 if (has_backslash)
967 {
968 if ((s[0] != '\\')
969 || (NULL == (s = (unsigned char *)_pSLexpand_escaped_char ((char *)s+1, (char *)s+len, &wch, NULL)))
970 || (*s != 0))
971 {
972 _pSLparse_error (SL_SYNTAX_ERROR, "Unable to parse character", NULL, 0);
973 return (tok->type = EOF_TOKEN);
974 }
975 }
976 else if (len == 1)
977 wch = s[0];
978 else /* Assume unicode */
979 {
980 unsigned char *ss = SLutf8_decode (s, s+len, &wch, NULL);
981 if ((ss == NULL) || (*ss != 0))
982 {
983 _pSLparse_error(SL_SYNTAX_ERROR, "Single char expected", NULL, 0);
984 return (tok->type = EOF_TOKEN);
985 }
986 }
987 tok->v.long_val = wch;
988
989 if (wch > 256)
990 return tok->type = ULONG_TOKEN;
991
992 return (tok->type = UCHAR_TOKEN);
993 }
994
read_string_token(unsigned char quote_char,unsigned char * s,unsigned int maxlen,int is_multiline_raw,int * has_backslashp,unsigned int * lenp)995 static int read_string_token (unsigned char quote_char,
996 unsigned char *s, unsigned int maxlen,
997 int is_multiline_raw,
998 int *has_backslashp,
999 unsigned int *lenp)
1000 {
1001 unsigned int len = 0;
1002 int has_bs = 0;
1003 int is_continued = 0;
1004
1005 while (len < maxlen)
1006 {
1007 unsigned char ch = prep_get_char ();
1008
1009 if (ch == 0)
1010 ch = '\n';
1011
1012 if (ch == '\n')
1013 {
1014 if (is_multiline_raw)
1015 {
1016 s[len++] = ch;
1017 is_continued = 1;
1018 break;
1019 }
1020 _pSLparse_error(SL_SYNTAX_ERROR, "Expecting a quote-character", NULL, 0);
1021 return -1;
1022 }
1023
1024 if (ch == quote_char)
1025 {
1026 if (is_multiline_raw == 0)
1027 break;
1028
1029 /* For multi-line raw, double quotes make a single one */
1030 ch = prep_get_char ();
1031 if (ch == quote_char)
1032 {
1033 s[len++] = ch;
1034 continue;
1035 }
1036
1037 unget_prep_char (ch);
1038 break;
1039 }
1040
1041 if (ch == '\\')
1042 {
1043 if (is_multiline_raw)
1044 {
1045 s[len++] = ch;
1046 has_bs = 1;
1047 continue;
1048 }
1049
1050 ch = prep_get_char ();
1051 if ((ch == '\n') || (ch == 0))
1052 {
1053 is_continued = 1;
1054 break;
1055 }
1056 s[len++] = '\\';
1057 if (len < maxlen)
1058 {
1059 s[len++] = ch;
1060 has_bs = 1;
1061 }
1062 continue;
1063 }
1064
1065 s[len++] = ch;
1066 }
1067
1068 if (len == maxlen)
1069 {
1070 _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Literal string exceeds the maximum allowable size--- use concatenation", NULL, 0);
1071 return -1;
1072 }
1073
1074 s[len] = 0;
1075 *lenp = len;
1076 *has_backslashp = has_bs;
1077 return is_continued;
1078 }
1079
alloc_string_list_type(unsigned char * buf,unsigned int len)1080 static _pSLtoken_String_List_Type *alloc_string_list_type (unsigned char *buf, unsigned int len)
1081 {
1082 _pSLtoken_String_List_Type *l;
1083
1084 if (NULL == (l = (_pSLtoken_String_List_Type *) SLmalloc (sizeof (_pSLtoken_String_List_Type) + len)))
1085 return NULL;
1086
1087 l->next = NULL;
1088 l->len = len;
1089 memcpy ((char *) l->buf, (char *)buf, len);
1090 return l;
1091 }
1092
free_string_list(_pSLtoken_String_List_Type * l)1093 static void free_string_list (_pSLtoken_String_List_Type *l)
1094 {
1095 while (l != NULL)
1096 {
1097 _pSLtoken_String_List_Type *next = l->next;
1098 SLfree ((char *) l);
1099 l = next;
1100 }
1101 }
1102
free_multistring_token_val(_pSLang_Token_Type * tok)1103 static void free_multistring_token_val (_pSLang_Token_Type *tok)
1104 {
1105 _pSLang_Multiline_String_Type *m;
1106
1107 m = tok->v.multistring_val;
1108 if (m == NULL)
1109 return;
1110
1111 if ((m->type == STRING_TOKEN) || (m->type == STRING_DOLLAR_TOKEN))
1112 {
1113 _pSLfree_hashed_string (m->v.s_val, m->len, m->hash);
1114 }
1115 else if (m->type == BSTRING_TOKEN)
1116 {
1117 SLbstring_free (m->v.b_val);
1118 }
1119
1120 free_string_list (m->list);
1121 SLfree ((char *) m);
1122
1123 tok->v.multistring_val = NULL;
1124 }
1125
1126 static _pSLang_Multiline_String_Type *
create_multistring(_pSLtoken_String_List_Type ** rootp,_pSLtok_Type type)1127 create_multistring (_pSLtoken_String_List_Type **rootp, _pSLtok_Type type)
1128 {
1129 _pSLtoken_String_List_Type *root, *tail;
1130 _pSLang_Multiline_String_Type *m;
1131 char *buf;
1132 unsigned int len, num;
1133
1134 m = (_pSLang_Multiline_String_Type *) SLmalloc (sizeof (_pSLang_Multiline_String_Type));
1135 if (m == NULL)
1136 return NULL;
1137
1138 len = 0;
1139 num = 0;
1140 tail = root = *rootp;
1141 while (tail != NULL)
1142 {
1143 len += tail->len;
1144 tail = tail->next;
1145 num++;
1146 }
1147
1148 if (NULL == (buf = (char *)SLmalloc (len+1)))
1149 {
1150 SLfree ((char *) m);
1151 return NULL;
1152 }
1153
1154 tail = root;
1155 len = 0;
1156 while (tail != NULL)
1157 {
1158 memcpy (buf+len, tail->buf, tail->len);
1159 len += tail->len;
1160 tail = tail->next;
1161 }
1162
1163 m->num = num;
1164 m->type = type;
1165 if (type == BSTRING_TOKEN)
1166 {
1167 if (NULL == (m->v.b_val = SLbstring_create_malloced ((unsigned char *)buf, len, 0)))
1168 goto return_error;
1169 buf = NULL;
1170 }
1171 else
1172 {
1173 m->v.s_val = _pSLstring_make_hashed_string (buf, len, &m->hash);
1174 if (m->v.s_val == NULL)
1175 goto return_error;
1176 SLfree (buf);
1177 }
1178 m->num = num;
1179 m->list = root;
1180 m->len = len;
1181 *rootp = NULL;
1182 return m;
1183
1184 return_error:
1185 if (buf != NULL) SLfree (buf);
1186 SLfree ((char *) m);
1187 return NULL;
1188 }
1189
get_string_token(_pSLang_Token_Type * tok,unsigned char quote_char,unsigned char * s,int is_multiline_raw)1190 static int get_string_token (_pSLang_Token_Type *tok, unsigned char quote_char,
1191 unsigned char *s, int is_multiline_raw)
1192 {
1193 _pSLtoken_String_List_Type *root, *tail;
1194 _pSLang_Multiline_String_Type *m;
1195 unsigned int len;
1196 int has_backslash;
1197 int status;
1198 unsigned int num_lines;
1199 int suffix;
1200 int is_binary;
1201 _pSLtok_Type type;
1202
1203 status = read_string_token (quote_char, s, SL_MAX_TOKEN_LEN-1,
1204 is_multiline_raw, &has_backslash, &len);
1205
1206 if (status == -1)
1207 return tok->type = EOF_TOKEN;
1208
1209 if (status == 0)
1210 return process_string_token (tok, quote_char, s, len, has_backslash);
1211
1212 tail = root = alloc_string_list_type (s, len);
1213 if (root == NULL)
1214 return tok->type = EOF_TOKEN;
1215
1216 LLT->parse_level += 1;
1217
1218 num_lines = 1;
1219 do
1220 {
1221 int has_bs;
1222
1223 if (-1 == next_input_line ())
1224 {
1225 _pSLparse_error (SL_SYNTAX_ERROR, "Multiline string literal is unterminated", NULL, 0);
1226 goto return_error;
1227 }
1228
1229 status = read_string_token (quote_char, s, SL_MAX_TOKEN_LEN-1,
1230 is_multiline_raw, &has_bs, &len);
1231
1232 if ((status == -1)
1233 || (NULL == (tail->next = alloc_string_list_type (s, len))))
1234 goto return_error;
1235
1236 has_backslash = has_backslash || has_bs;
1237 tail = tail->next;
1238 num_lines++;
1239 }
1240 while (status == 1);
1241
1242 /* At this point, root contains the list of strings */
1243 if (-1 == get_string_suffix (&suffix))
1244 goto return_error;
1245
1246 /* A multiline raw string is raw unless an explicit Q suffix was given */
1247 if (is_multiline_raw
1248 && (0 == (suffix & STRING_SUFFIX_Q)))
1249 suffix |= STRING_SUFFIX_R;
1250
1251 is_binary = (suffix & STRING_SUFFIX_B);
1252 if (suffix & STRING_SUFFIX_R)
1253 has_backslash = 0;
1254
1255 if (has_backslash)
1256 {
1257 tail = root;
1258 while (tail != NULL)
1259 {
1260 int ib;
1261
1262 ib = expand_escaped_string (tail->buf, tail->buf,
1263 tail->buf+tail->len, &tail->len, is_binary);
1264
1265 is_binary = is_binary || ib;
1266
1267 if (is_binary && (suffix & STRING_SUFFIX_S))
1268 {
1269 _pSLparse_error (SL_SYNTAX_ERROR, "A binary string is not permitted to have the $ suffix", NULL, 0);
1270 goto return_error;
1271 }
1272 tail = tail->next;
1273 }
1274 }
1275
1276 if (is_binary)
1277 type = BSTRING_TOKEN;
1278 else if (suffix & STRING_SUFFIX_S)
1279 type = STRING_DOLLAR_TOKEN;
1280 else
1281 type = STRING_TOKEN;
1282
1283 if (NULL == (m = create_multistring (&root, type)))
1284 goto return_error;
1285
1286 tok->v.multistring_val = m;
1287 tok->free_val_func = free_multistring_token_val;
1288
1289 LLT->parse_level -= 1;
1290 return tok->type = MULTI_STRING_TOKEN;
1291
1292 return_error:
1293
1294 if (root != NULL)
1295 free_string_list (root);
1296
1297 LLT->parse_level -= 1;
1298 return tok->type = EOF_TOKEN;
1299 }
1300
extract_token(_pSLang_Token_Type * tok,unsigned char ch,unsigned char t)1301 static int extract_token (_pSLang_Token_Type *tok, unsigned char ch, unsigned char t)
1302 {
1303 unsigned char s [SL_MAX_TOKEN_LEN];
1304 unsigned int slen;
1305
1306 s[0] = (char) ch;
1307 slen = 1;
1308
1309 switch (t)
1310 {
1311 case ALPHA_CHAR:
1312 return get_ident_token (tok, s, slen);
1313
1314 case OP_CHAR:
1315 return get_op_token (tok, ch);
1316
1317 case DIGIT_CHAR:
1318 return get_number_token (tok, s, slen);
1319
1320 case EXCL_CHAR:
1321 ch = prep_get_char ();
1322 s [slen++] = ch;
1323 t = CHAR_CLASS(ch);
1324 if (t == ALPHA_CHAR) return get_ident_token (tok, s, slen);
1325 if (t == OP_CHAR)
1326 {
1327 unget_prep_char (ch);
1328 return get_op_token (tok, '!');
1329 }
1330 _pSLparse_error(SL_SYNTAX_ERROR, "Misplaced !", NULL, 0);
1331 return -1;
1332
1333 case DOT_CHAR:
1334 ch = prep_get_char ();
1335 if (DIGIT_CHAR == CHAR_CLASS(ch))
1336 {
1337 s [slen++] = ch;
1338 return get_number_token (tok, s, slen);
1339 }
1340 unget_prep_char (ch);
1341 return (tok->type = DOT_TOKEN);
1342
1343 case SEP_CHAR:
1344 return (tok->type = CHAR_DATA(ch));
1345
1346 case DQUOTE_CHAR:
1347 case QUOTE_CHAR:
1348 return get_string_token (tok, ch, s, 0);
1349
1350 case BQUOTE_CHAR:
1351 return get_string_token (tok, ch, s, 1);
1352
1353 default:
1354 _pSLparse_error(SL_SYNTAX_ERROR, "Invalid character", NULL, 0);
1355 return (tok->type = EOF_TOKEN);
1356 }
1357 }
1358
_pSLget_rpn_token(_pSLang_Token_Type * tok)1359 int _pSLget_rpn_token (_pSLang_Token_Type *tok)
1360 {
1361 unsigned char ch;
1362
1363 tok->v.s_val = "??";
1364 while ((ch = *Input_Line_Pointer) != 0)
1365 {
1366 unsigned char t;
1367
1368 Input_Line_Pointer++;
1369 if (WHITE_CHAR == (t = CHAR_CLASS(ch)))
1370 continue;
1371
1372 if (NL_CHAR == t)
1373 break;
1374
1375 return extract_token (tok, ch, t);
1376 }
1377 Input_Line_Pointer = Empty_Line;
1378 return EOF_TOKEN;
1379 }
1380
_pSLget_token(_pSLang_Token_Type * tok)1381 int _pSLget_token (_pSLang_Token_Type *tok)
1382 {
1383 unsigned char ch;
1384 unsigned char t;
1385
1386 tok->num_refs = 1;
1387 tok->free_val_func = NULL;
1388 tok->v.s_val = "??";
1389 tok->flags = 0;
1390 #if SLANG_HAS_DEBUG_CODE
1391 tok->line_number = LLT->line_num;
1392 #endif
1393 if (_pSLang_Error || (Input_Line == NULL))
1394 return (tok->type = EOF_TOKEN);
1395
1396 while (1)
1397 {
1398 ch = *Input_Line_Pointer++;
1399 if (WHITE_CHAR == (t = CHAR_CLASS (ch)))
1400 continue;
1401
1402 if (t != NL_CHAR)
1403 return extract_token (tok, ch, t);
1404
1405 do
1406 {
1407 #if SLANG_HAS_DEBUG_CODE
1408 tok->line_number++;
1409 #endif
1410 if (-1 == next_input_line ())
1411 return tok->type = EOF_TOKEN;
1412 }
1413 while (0 == SLprep_line_ok(Input_Line, This_SLpp));
1414
1415 if (*Input_Line_Pointer == '.')
1416 {
1417 Input_Line_Pointer++;
1418 return tok->type = RPN_TOKEN;
1419 }
1420 }
1421 }
1422
prep_exists_function(SLprep_Type * pt,SLFUTURE_CONST char * line)1423 static int prep_exists_function (SLprep_Type *pt, SLFUTURE_CONST char *line)
1424 {
1425 char buf[MAX_FILE_LINE_LEN+1], *b, *bmax;
1426 unsigned char ch;
1427 unsigned char comment;
1428
1429 (void) pt;
1430 bmax = buf + (sizeof (buf) - 1);
1431
1432 comment = (unsigned char)'%';
1433 while (1)
1434 {
1435 /* skip whitespace */
1436 while ((ch = (unsigned char) *line),
1437 ch && (ch != '\n') && (ch <= ' '))
1438 line++;
1439
1440 if ((ch <= '\n')
1441 || (ch == comment)) break;
1442
1443 b = buf;
1444 while ((ch = (unsigned char) *line) > ' ')
1445 {
1446 if (b < bmax) *b++ = (char) ch;
1447 line++;
1448 }
1449 *b = 0;
1450 #if 0
1451 if (SLang_is_defined (buf))
1452 return 1;
1453 #else
1454 if (NULL != _pSLlocate_name (buf))
1455 return 1;
1456 #endif
1457 }
1458
1459 return 0;
1460 }
1461
prep_eval_expr(SLprep_Type * pt,SLFUTURE_CONST char * expr)1462 static int prep_eval_expr (SLprep_Type *pt, SLFUTURE_CONST char *expr)
1463 {
1464 int ret;
1465 SLCONST char *end;
1466 void (*compile)(_pSLang_Token_Type *);
1467 char *expr1;
1468 #if SLANG_HAS_BOSEOS
1469 int boseos;
1470 #endif
1471
1472 (void) pt;
1473 end = strchr (expr, '\n');
1474 if (end == NULL)
1475 end = expr + strlen (expr);
1476 expr1 = SLmake_nstring (expr, (unsigned int) (end - expr));
1477 if (expr1 == NULL)
1478 return -1;
1479
1480 compile = _pSLcompile_ptr;
1481 _pSLcompile_ptr = _pSLcompile;
1482 #if SLANG_HAS_BOSEOS
1483 boseos = _pSLang_Compile_BOSEOS;
1484 if (0 == (boseos & SLANG_BOSEOS_PREPROC))
1485 _pSLang_Compile_BOSEOS = 0;
1486 #endif
1487 if ((0 != SLns_load_string (expr1, _pSLang_cur_namespace_intrinsic ()))
1488 || (-1 == SLang_pop_integer (&ret)))
1489 ret = -1;
1490 else
1491 ret = (ret != 0);
1492 #if SLANG_HAS_BOSEOS
1493 _pSLang_Compile_BOSEOS = boseos;
1494 #endif
1495 _pSLcompile_ptr = compile;
1496
1497 SLfree (expr1);
1498 return ret;
1499 }
1500
SLang_load_object(SLang_Load_Type * x)1501 int SLang_load_object (SLang_Load_Type *x)
1502 {
1503 SLprep_Type *this_pp;
1504 SLprep_Type *save_this_pp;
1505 SLang_Load_Type *save_llt;
1506 char *save_input_line, *save_input_line_ptr;
1507 #if SLANG_HAS_DEBUG_CODE
1508 /* int save_compile_line_num_info; */
1509 #endif
1510 #if SLANG_HAS_BOSEOS
1511 int save_compile_boseos;
1512 int save_compile_bofeof;
1513 #endif
1514 int save_auto_declare_variables;
1515
1516 if (NULL == (this_pp = SLprep_new ()))
1517 return -1;
1518 (void) SLprep_set_exists_hook (this_pp, prep_exists_function);
1519 (void) SLprep_set_eval_hook (this_pp, prep_eval_expr);
1520
1521 if (-1 == _pSLcompile_push_context (x))
1522 {
1523 SLprep_delete (this_pp);
1524 return -1;
1525 }
1526
1527 #if SLANG_HAS_DEBUG_CODE
1528 /* save_compile_line_num_info = _pSLang_Compile_Line_Num_Info; */
1529 #endif
1530 #if SLANG_HAS_BOSEOS
1531 save_compile_boseos = _pSLang_Compile_BOSEOS;
1532 save_compile_bofeof = _pSLang_Compile_BOFEOF;
1533 #endif
1534 save_this_pp = This_SLpp;
1535 save_input_line = Input_Line;
1536 save_input_line_ptr = Input_Line_Pointer;
1537 save_llt = LLT;
1538 save_auto_declare_variables = _pSLang_Auto_Declare_Globals;
1539
1540 This_SLpp = this_pp;
1541 Input_Line_Pointer = Input_Line = Empty_Line;
1542 LLT = x;
1543
1544 /* x->line_num = 0; */ /* already set to 0 when allocated. */
1545 x->parse_level = 0;
1546 _pSLang_Auto_Declare_Globals = x->auto_declare_globals;
1547
1548 #if SLANG_HAS_DEBUG_CODE
1549 /* _pSLang_Compile_Line_Num_Info = Default_Compile_Line_Num_Info; */
1550 #endif
1551 #if SLANG_HAS_BOSEOS
1552 #if 0
1553 /* Instead of setting this variable to 0, let it keep its current value.
1554 * Suppose that the following evalfiles take place:
1555 *
1556 * A -> B1 --> C1 --> D1
1557 * -> B2 --> C1 --> D2
1558 *
1559 * and that B1 sets _boseos_info to 1. Then C1 and D1 will get this value
1560 * but B2 will not, since it will get rest to 0 when the routine has finished
1561 * loading B1.
1562 */
1563 {
1564 char *env = getenv ("SLANG_BOSEOS");
1565 if (env != NULL)
1566 _pSLang_Compile_BOSEOS = atoi (env);
1567 else
1568 _pSLang_Compile_BOSEOS = 0;
1569 }
1570 #endif
1571 #endif
1572 _pSLparse_start (x);
1573 if (_pSLang_Error)
1574 {
1575 if (_pSLang_Error != SL_Usage_Error)
1576 (void) _pSLerr_set_line_info (x->name, x->line_num, NULL);
1577 /* Doing this resets the state of the line_info object */
1578 (void) _pSLerr_set_line_info (x->name, x->line_num, "");
1579 }
1580
1581 _pSLang_Auto_Declare_Globals = save_auto_declare_variables;
1582
1583 (void) _pSLcompile_pop_context ();
1584
1585 Input_Line = save_input_line;
1586 Input_Line_Pointer = save_input_line_ptr;
1587 LLT = save_llt;
1588 SLprep_delete (this_pp);
1589 This_SLpp = save_this_pp;
1590
1591 #if SLANG_HAS_DEBUG_CODE
1592 /* _pSLang_Compile_Line_Num_Info = save_compile_line_num_info; */
1593 #endif
1594 #if SLANG_HAS_BOSEOS
1595 _pSLang_Compile_BOSEOS = save_compile_boseos;
1596 _pSLang_Compile_BOFEOF = save_compile_bofeof;
1597 #endif
1598 if (_pSLang_Error) return -1;
1599 return 0;
1600 }
1601
SLns_allocate_load_type(SLFUTURE_CONST char * name,SLFUTURE_CONST char * namespace_name)1602 SLang_Load_Type *SLns_allocate_load_type (SLFUTURE_CONST char *name, SLFUTURE_CONST char *namespace_name)
1603 {
1604 SLang_Load_Type *x;
1605
1606 if (NULL == (x = (SLang_Load_Type *)SLmalloc (sizeof (SLang_Load_Type))))
1607 return NULL;
1608 memset ((char *) x, 0, sizeof (SLang_Load_Type));
1609
1610 if (name == NULL) name = "";
1611
1612 if (NULL == (x->name = SLang_create_slstring (name)))
1613 {
1614 SLfree ((char *) x);
1615 return NULL;
1616 }
1617
1618 if (namespace_name != NULL)
1619 {
1620 if (NULL == (x->namespace_name = SLang_create_slstring (namespace_name)))
1621 {
1622 SLang_free_slstring ((char *) x->name);
1623 SLfree ((char *) x);
1624 return NULL;
1625 }
1626 }
1627
1628 return x;
1629 }
1630
SLallocate_load_type(SLFUTURE_CONST char * name)1631 SLang_Load_Type *SLallocate_load_type (SLFUTURE_CONST char *name)
1632 {
1633 return SLns_allocate_load_type (name, NULL);
1634 }
1635
SLdeallocate_load_type(SLang_Load_Type * x)1636 void SLdeallocate_load_type (SLang_Load_Type *x)
1637 {
1638 if (x != NULL)
1639 {
1640 SLang_free_slstring ((char *) x->name);
1641 SLang_free_slstring ((char *) x->namespace_name);
1642 SLfree ((char *) x);
1643 }
1644 }
1645
1646 typedef struct
1647 {
1648 SLCONST char *string;
1649 SLCONST char *ptr;
1650 }
1651 String_Client_Data_Type;
1652
read_from_string(SLang_Load_Type * x)1653 static char *read_from_string (SLang_Load_Type *x)
1654 {
1655 String_Client_Data_Type *data;
1656 SLCONST char *s, *s1;
1657 char ch;
1658
1659 data = (String_Client_Data_Type *)x->client_data;
1660 s1 = s = data->ptr;
1661
1662 if (*s == 0)
1663 return NULL;
1664
1665 while ((ch = *s) != 0)
1666 {
1667 s++;
1668 if (ch == '\n')
1669 break;
1670 }
1671
1672 data->ptr = s;
1673 return (char *) s1;
1674 }
1675
SLang_load_string(SLFUTURE_CONST char * string)1676 int SLang_load_string (SLFUTURE_CONST char *string)
1677 {
1678 return SLns_load_string (string, NULL);
1679 }
1680
SLns_load_string(SLFUTURE_CONST char * string,SLFUTURE_CONST char * ns_name)1681 int SLns_load_string (SLFUTURE_CONST char *string, SLFUTURE_CONST char *ns_name)
1682 {
1683 SLang_Load_Type *x;
1684 String_Client_Data_Type data;
1685 int ret;
1686
1687 if (string == NULL)
1688 return -1;
1689
1690 /* Grab a private copy in case loading modifies string */
1691 if (NULL == (string = SLang_create_slstring (string)))
1692 return -1;
1693
1694 /* To avoid creating a static data space for every string loaded,
1695 * all string objects will be regarded as identical. So, identify
1696 * all of them by ***string***
1697 */
1698 if (NULL == (x = SLns_allocate_load_type ("***string***", ns_name)))
1699 {
1700 SLang_free_slstring ((char *) string);
1701 return -1;
1702 }
1703
1704 x->client_data = (VOID_STAR) &data;
1705 x->read = read_from_string;
1706
1707 data.ptr = data.string = string;
1708 if ((-1 == (ret = SLang_load_object (x)))
1709 && (SLang_Traceback & SL_TB_FULL))
1710 _pSLerr_traceback_msg ("Traceback: called from eval: %s\n", string);
1711
1712 SLang_free_slstring ((char *)string);
1713 SLdeallocate_load_type (x);
1714 return ret;
1715 }
1716
1717 typedef struct
1718 {
1719 char *buf;
1720 FILE *fp;
1721 }
1722 File_Client_Data_Type;
1723
1724 char *SLang_User_Prompt = NULL;
read_from_file(SLang_Load_Type * x)1725 static char *read_from_file (SLang_Load_Type *x)
1726 {
1727 FILE *fp;
1728 File_Client_Data_Type *c;
1729 char *buf;
1730
1731 c = (File_Client_Data_Type *)x->client_data;
1732 fp = c->fp;
1733
1734 if ((fp == stdin) && (SLang_User_Prompt != NULL))
1735 {
1736 fputs (SLang_User_Prompt, stdout);
1737 fflush (stdout);
1738 }
1739
1740 buf = fgets (c->buf, MAX_FILE_LINE_LEN+1, c->fp);
1741 if (buf != NULL)
1742 {
1743 size_t num;
1744
1745 num = strlen (buf);
1746 if ((num == MAX_FILE_LINE_LEN)
1747 && (buf[num-1] != '\n'))
1748 {
1749 SLang_verror (SL_LimitExceeded_Error, "Line %u is too long or lacks a newline character", x->line_num);
1750 return NULL;
1751 }
1752 }
1753 return buf;
1754 }
1755
1756 int _pSLang_Load_File_Verbose = 0;
SLang_load_file_verbose(int v)1757 int SLang_load_file_verbose (int v)
1758 {
1759 int v1 = _pSLang_Load_File_Verbose;
1760 _pSLang_Load_File_Verbose = v;
1761 return v1;
1762 }
1763
1764 /* Note that file could be freed from Slang during run of this routine
1765 * so get it and store it !! (e.g., autoloading)
1766 */
1767 int (*SLang_Load_File_Hook) (SLFUTURE_CONST char *) = NULL;
1768 int (*SLns_Load_File_Hook) (SLFUTURE_CONST char *, SLFUTURE_CONST char *) = NULL;
SLang_load_file(SLFUTURE_CONST char * f)1769 int SLang_load_file (SLFUTURE_CONST char *f)
1770 {
1771 return SLns_load_file (f, NULL);
1772 }
1773
SLns_load_file(SLFUTURE_CONST char * f,SLFUTURE_CONST char * ns_name)1774 int SLns_load_file (SLFUTURE_CONST char *f, SLFUTURE_CONST char *ns_name)
1775 {
1776 File_Client_Data_Type client_data;
1777 SLang_Load_Type *x;
1778 char *name, *buf;
1779 FILE *fp;
1780
1781 if ((ns_name == NULL) && (NULL != SLang_Load_File_Hook))
1782 return (*SLang_Load_File_Hook) (f);
1783
1784 if (SLns_Load_File_Hook != NULL)
1785 return (*SLns_Load_File_Hook) (f, ns_name);
1786
1787 if (f == NULL)
1788 name = SLang_create_slstring ("<stdin>");
1789 else
1790 name = _pSLpath_find_file (f, 1);
1791
1792 if (name == NULL)
1793 return -1;
1794
1795 if (NULL == (x = SLns_allocate_load_type (name, ns_name)))
1796 {
1797 SLang_free_slstring (name);
1798 return -1;
1799 }
1800
1801 buf = NULL;
1802
1803 if (f != NULL)
1804 {
1805 fp = fopen (name, "r");
1806 if (_pSLang_Load_File_Verbose & SLANG_LOAD_FILE_VERBOSE)
1807 {
1808 if ((ns_name != NULL)
1809 && (*ns_name != 0) && (0 != strcmp (ns_name, "Global")))
1810 SLang_vmessage ("Loading %s [ns:%s]", name, ns_name);
1811 else
1812 SLang_vmessage ("Loading %s", name);
1813 }
1814 }
1815 else
1816 fp = stdin;
1817
1818 if (fp == NULL)
1819 _pSLang_verror (SL_OBJ_NOPEN, "Unable to open %s", name);
1820 else if (NULL != (buf = (char *)SLmalloc (MAX_FILE_LINE_LEN + 1)))
1821 {
1822 client_data.fp = fp;
1823 client_data.buf = buf;
1824 x->client_data = (VOID_STAR) &client_data;
1825 x->read = read_from_file;
1826
1827 (void) SLang_load_object (x);
1828 }
1829
1830 if ((fp != NULL) && (fp != stdin))
1831 fclose (fp);
1832
1833 SLfree (buf);
1834 SLang_free_slstring (name);
1835 SLdeallocate_load_type (x);
1836
1837 if (_pSLang_Error)
1838 return -1;
1839
1840 return 0;
1841 }
1842
1843 /* In the byte-compiled file, a token is represented by N+3 bytes, where
1844 * byte[0] = TOKEN_TYPE;
1845 * byte[1] = len_lo
1846 * byte[2] = len_hi
1847 * bytes[3:N+3] = value
1848 * and N = (len_lo - 32) | (len_hi-32) << 7.
1849 * The maximumn value of N for this encoding is 28639.
1850 */
check_byte_compiled_token(char * buf)1851 static char *check_byte_compiled_token (char *buf)
1852 {
1853 unsigned int len_lo, len_hi, len;
1854 char *input_buffer;
1855 char *b;
1856
1857 input_buffer = Input_Line_Pointer;
1858
1859 len_lo = (unsigned char) *input_buffer++;
1860 while ((len_lo == 0) || (len_lo == '\n'))
1861 {
1862 if (-1 == next_input_line ())
1863 goto return_error;
1864 input_buffer = Input_Line_Pointer;
1865 len_lo = (unsigned char) *input_buffer++;
1866 }
1867
1868 len_hi = (unsigned char) *input_buffer++;
1869 while ((len_hi == 0) || (len_hi == '\n'))
1870 {
1871 if (-1 == next_input_line ())
1872 goto return_error;
1873 input_buffer = Input_Line_Pointer;
1874 len_hi = (unsigned char) *input_buffer++;
1875 }
1876
1877 if ((len_lo < 32) || (len_hi < 32)
1878 || ((len = (len_lo - 32) | ((len_hi - 32) << 7)) >= SL_MAX_TOKEN_LEN))
1879 goto return_error;
1880
1881 b = buf;
1882 while (len)
1883 {
1884 char ch = *input_buffer++;
1885 if ((ch == 0) || (ch == '\n'))
1886 {
1887 if (-1 == next_input_line ())
1888 goto return_error;
1889
1890 input_buffer = Input_Line_Pointer;
1891 continue;
1892 }
1893 *b++ = ch;
1894 len--;
1895 }
1896 *b = 0;
1897 Input_Line_Pointer = input_buffer;
1898 return b;
1899
1900 return_error:
1901 _pSLang_verror (SL_INVALID_DATA_ERROR, "Byte compiled file appears corrupt");
1902 return NULL;
1903 }
1904
compile_byte_compiled_multistring(char * buf)1905 static int compile_byte_compiled_multistring (char *buf)
1906 {
1907 _pSLtok_Type type;
1908 _pSLtoken_String_List_Type *root, *tail;
1909 _pSLang_Multiline_String_Type *m;
1910 _pSLang_Token_Type tok;
1911
1912 /* The caller read MULTI_STRING_TOKEN from the input stream. Concat the
1913 * next N objects in the stream until another MULTI_STRING_TOKEN is seen.
1914 */
1915 type = 0;
1916 tail = root = NULL;
1917 while (1)
1918 {
1919 char *ebuf;
1920 unsigned int len;
1921 _pSLtok_Type this_type, last_type;
1922 _pSLtoken_String_List_Type *next;
1923 unsigned char ch = *Input_Line_Pointer++;
1924
1925 if ((ch == 0) || (ch == '\n'))
1926 {
1927 if (-1 == next_input_line ())
1928 return -1;
1929 continue;
1930 }
1931 this_type = ch;
1932
1933 if (this_type == MULTI_STRING_TOKEN)
1934 break;
1935
1936 switch (this_type)
1937 {
1938 case STRING_TOKEN:
1939 case STRING_DOLLAR_TOKEN:
1940 if (NULL == (ebuf = check_byte_compiled_token (buf)))
1941 goto return_error;
1942 len = (unsigned int) (ebuf - buf);
1943 last_type = this_type;
1944 break;
1945
1946 case ESC_STRING_TOKEN:
1947 if (NULL == (ebuf = check_byte_compiled_token (buf)))
1948 goto return_error;
1949 (void) expand_escaped_string (buf, buf, ebuf, &len, 0);
1950 last_type = STRING_TOKEN;
1951 break;
1952
1953 case ESC_STRING_DOLLAR_TOKEN:
1954 last_type = STRING_DOLLAR_TOKEN;
1955 if (NULL == (ebuf = check_byte_compiled_token (buf)))
1956 goto return_error;
1957 (void) expand_escaped_string (buf, buf, ebuf, &len, 0);
1958 last_type = STRING_DOLLAR_TOKEN;
1959 break;
1960
1961 case ESC_BSTRING_TOKEN:
1962 type = BSTRING_TOKEN;
1963 if (NULL == (ebuf = check_byte_compiled_token (buf)))
1964 goto return_error;
1965 (void) expand_escaped_string (buf, buf, ebuf, &len, 1);
1966 last_type = BSTRING_TOKEN;
1967 break;
1968
1969 default:
1970 SLang_verror (SL_INVALID_DATA_ERROR, "Unexpected object (0x%X) encountered in stream", (int)this_type);
1971 goto return_error;
1972 }
1973
1974 if ((last_type != type) && (type != 0))
1975 {
1976 SLang_verror (SL_INVALID_DATA_ERROR, "Unexpected object (0x%X) encountered in stream", (int)this_type);
1977 return -1;
1978 }
1979 type = last_type;
1980
1981 if (NULL == (next = alloc_string_list_type ((unsigned char *)buf, len)))
1982 goto return_error;
1983 if (root == NULL)
1984 root = next;
1985 else
1986 tail->next = next;
1987 tail = next;
1988 }
1989
1990 if (NULL == (m = create_multistring (&root, type)))
1991 goto return_error;
1992
1993 tok.v.multistring_val = m;
1994 tok.free_val_func = free_multistring_token_val;
1995 tok.type = MULTI_STRING_TOKEN;
1996 (*_pSLcompile_ptr)(&tok);
1997 (*tok.free_val_func) (&tok);
1998 if (_pSLang_Error)
1999 return -1;
2000 return 0;
2001
2002 return_error:
2003 if (root != NULL) free_string_list (root);
2004 return -1;
2005 }
2006
_pSLcompile_byte_compiled(void)2007 void _pSLcompile_byte_compiled (void)
2008 {
2009 _pSLtok_Type type;
2010 _pSLang_Token_Type tok;
2011 char buf[SL_MAX_TOKEN_LEN+1];
2012 char *ebuf;
2013 unsigned int len;
2014
2015 memset ((char *) &tok, 0, sizeof (_pSLang_Token_Type));
2016
2017 while (_pSLang_Error == 0)
2018 {
2019 top_of_switch:
2020 type = (unsigned char) *Input_Line_Pointer++;
2021 switch (type)
2022 {
2023 case '\n':
2024 case 0:
2025 if (-1 == next_input_line ())
2026 return;
2027
2028 goto top_of_switch;
2029
2030 case CONT_N_TOKEN:
2031 case BREAK_N_TOKEN:
2032 case LINE_NUM_TOKEN:
2033 case CHAR_TOKEN:
2034 case SHORT_TOKEN:
2035 case INT_TOKEN:
2036 case LONG_TOKEN:
2037 if (NULL == check_byte_compiled_token (buf))
2038 return;
2039 tok.v.long_val = SLatol ((unsigned char *)buf);
2040 break;
2041
2042 case UCHAR_TOKEN:
2043 case USHORT_TOKEN:
2044 case UINT_TOKEN:
2045 case ULONG_TOKEN:
2046 if (NULL == check_byte_compiled_token (buf))
2047 return;
2048 tok.v.ulong_val = SLatoul ((unsigned char *)buf);
2049 break;
2050 #ifdef HAVE_LONG_LONG
2051 case LLONG_TOKEN:
2052 if (NULL == check_byte_compiled_token (buf))
2053 return;
2054 tok.v.llong_val = SLatoll ((unsigned char *)buf);
2055 break;
2056 case ULLONG_TOKEN:
2057 if (NULL == check_byte_compiled_token (buf))
2058 return;
2059 tok.v.ullong_val = SLatoull ((unsigned char *)buf);
2060 break;
2061 #endif
2062 case COMPLEX_TOKEN:
2063 case FLOAT_TOKEN:
2064 case DOUBLE_TOKEN:
2065 if (NULL == check_byte_compiled_token (buf))
2066 return;
2067 tok.v.s_val = buf;
2068 break;
2069
2070 case ESC_STRING_DOLLAR_TOKEN:
2071 if (NULL == (ebuf = check_byte_compiled_token (buf)))
2072 return;
2073 tok.v.s_val = buf;
2074 (void) expand_escaped_string (buf, buf, ebuf, &len, 0);
2075 tok.hash = _pSLstring_hash ((unsigned char *)buf, (unsigned char *)buf + len);
2076 type = STRING_DOLLAR_TOKEN;
2077 break;
2078
2079 case ESC_STRING_TOKEN:
2080 if (NULL == (ebuf = check_byte_compiled_token (buf)))
2081 return;
2082 tok.v.s_val = buf;
2083 (void) expand_escaped_string (buf, buf, ebuf, &len, 0);
2084 tok.hash = _pSLstring_hash ((unsigned char *)buf, (unsigned char *)buf + len);
2085 type = STRING_TOKEN;
2086 break;
2087
2088 case ESC_BSTRING_TOKEN:
2089 if (NULL == (ebuf = check_byte_compiled_token (buf)))
2090 return;
2091 tok.v.s_val = buf;
2092 (void) expand_escaped_string (buf, buf, ebuf, &len, 1);
2093 tok.hash = len;
2094 type = _BSTRING_TOKEN;
2095 break;
2096
2097 case TMP_TOKEN:
2098 case DEFINE_TOKEN:
2099 case DEFINE_STATIC_TOKEN:
2100 case DEFINE_PRIVATE_TOKEN:
2101 case DEFINE_PUBLIC_TOKEN:
2102 case DOT_TOKEN:
2103 case DOT_METHOD_CALL_TOKEN:
2104 case STRING_DOLLAR_TOKEN:
2105 case STRING_TOKEN:
2106 case IDENT_TOKEN:
2107 case _REF_TOKEN:
2108 /* case _DEREF_ASSIGN_TOKEN: */
2109 case _SCALAR_ASSIGN_TOKEN:
2110 case _SCALAR_PLUSEQS_TOKEN:
2111 case _SCALAR_MINUSEQS_TOKEN:
2112 case _SCALAR_TIMESEQS_TOKEN:
2113 case _SCALAR_DIVEQS_TOKEN:
2114 case _SCALAR_BOREQS_TOKEN:
2115 case _SCALAR_BANDEQS_TOKEN:
2116 case _SCALAR_PLUSPLUS_TOKEN:
2117 case _SCALAR_POST_PLUSPLUS_TOKEN:
2118 case _SCALAR_MINUSMINUS_TOKEN:
2119 case _SCALAR_POST_MINUSMINUS_TOKEN:
2120 case _STRUCT_ASSIGN_TOKEN:
2121 case _STRUCT_PLUSEQS_TOKEN:
2122 case _STRUCT_MINUSEQS_TOKEN:
2123 case _STRUCT_TIMESEQS_TOKEN:
2124 case _STRUCT_DIVEQS_TOKEN:
2125 case _STRUCT_BOREQS_TOKEN:
2126 case _STRUCT_BANDEQS_TOKEN:
2127 case _STRUCT_POST_MINUSMINUS_TOKEN:
2128 case _STRUCT_MINUSMINUS_TOKEN:
2129 case _STRUCT_POST_PLUSPLUS_TOKEN:
2130 case _STRUCT_PLUSPLUS_TOKEN:
2131 case _STRUCT_FIELD_REF_TOKEN:
2132 if (NULL == (ebuf = check_byte_compiled_token (buf)))
2133 return;
2134 tok.v.s_val = buf;
2135 tok.hash = _pSLstring_hash ((unsigned char *)buf, (unsigned char *)ebuf);
2136 break;
2137
2138 case MULTI_STRING_TOKEN:
2139 if (-1 == compile_byte_compiled_multistring (buf))
2140 return;
2141 type = 0;
2142 break;
2143
2144 default:
2145 break;
2146 }
2147
2148 if (type == 0)
2149 continue;
2150
2151 tok.type = type;
2152 (*_pSLcompile_ptr) (&tok);
2153 }
2154 }
2155
escape_string(unsigned char * s,unsigned char * smax,unsigned char * buf,unsigned char * buf_max,int * is_escaped)2156 static int escape_string (unsigned char *s, unsigned char *smax,
2157 unsigned char *buf, unsigned char *buf_max,
2158 int *is_escaped)
2159 {
2160 unsigned char ch;
2161
2162 *is_escaped = 0;
2163 while (buf < buf_max)
2164 {
2165 if (s == smax)
2166 {
2167 *buf = 0;
2168 return 0;
2169 }
2170
2171 ch = *s++;
2172 switch (ch)
2173 {
2174 default:
2175 *buf++ = ch;
2176 break;
2177
2178 case 0:
2179 *buf++ = '\\';
2180 if (buf < buf_max) *buf++ = 'x';
2181 if (buf < buf_max) *buf++ = '0';
2182 if (buf < buf_max) *buf++ = '0';
2183 *is_escaped = 1;
2184 break; /* return 0; */
2185
2186 case '\n':
2187 *buf++ = '\\';
2188 if (buf < buf_max) *buf++ = 'n';
2189 *is_escaped = 1;
2190 break;
2191
2192 case '\r':
2193 *buf++ = '\\';
2194 if (buf < buf_max) *buf++ = 'r';
2195 *is_escaped = 1;
2196 break;
2197
2198 case 0x1A: /* ^Z */
2199 *buf++ = '\\';
2200 if (buf < buf_max) *buf++ = 'x';
2201 if (buf < buf_max) *buf++ = '1';
2202 if (buf < buf_max) *buf++ = 'A';
2203 *is_escaped = 1;
2204 break;
2205
2206 case '\\':
2207 *buf++ = ch;
2208 if (buf < buf_max) *buf++ = ch;
2209 *is_escaped = 1;
2210 break;
2211 }
2212 }
2213 _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "String too long to byte-compile", NULL, 0);
2214 return -1;
2215 }
2216
2217 static FILE *Byte_Compile_Fp;
2218 static unsigned int Byte_Compile_Line_Len;
2219
bytecomp_write_data(SLCONST char * buf,unsigned int len)2220 static int bytecomp_write_data (SLCONST char *buf, unsigned int len)
2221 {
2222 unsigned int clen = Byte_Compile_Line_Len;
2223 unsigned int clen_max = MAX_FILE_LINE_LEN - 1;
2224 SLCONST char *bufmax = buf + len;
2225 FILE *fp = Byte_Compile_Fp;
2226
2227 while (buf < bufmax)
2228 {
2229 if (clen == clen_max)
2230 {
2231 if (EOF == putc ('\n', fp))
2232 {
2233 SLang_set_error (SL_IO_WRITE_ERROR);
2234 return -1;
2235 }
2236 clen = 0;
2237 }
2238
2239 if (EOF == putc ((unsigned char)*buf, fp))
2240 {
2241 SLang_set_error (SL_IO_WRITE_ERROR);
2242 return -1;
2243 }
2244 buf++;
2245 clen++;
2246 }
2247 Byte_Compile_Line_Len = clen;
2248 return 0;
2249 }
2250
byte_compile_multiline_token(_pSLang_Token_Type * tok,unsigned char * buf,unsigned char * buf_max)2251 static int byte_compile_multiline_token (_pSLang_Token_Type *tok,
2252 unsigned char *buf, unsigned char *buf_max)
2253 {
2254 _pSLtoken_String_List_Type *root;
2255 _pSLang_Multiline_String_Type *m;
2256 _pSLtok_Type type, esc_type;
2257 char *b3;
2258
2259 /* The token consists of N elements. It gets encoded as N+2 tokens:
2260 * TYPE STRING_1 .... STRING_N TYPE
2261 */
2262 m = tok->v.multistring_val;
2263 switch (m->type)
2264 {
2265 case STRING_TOKEN:
2266 type = STRING_TOKEN;
2267 esc_type = ESC_STRING_TOKEN;
2268 break;
2269
2270 case BSTRING_TOKEN:
2271 type = esc_type = ESC_BSTRING_TOKEN;
2272 break;
2273
2274 case STRING_DOLLAR_TOKEN:
2275 type = STRING_DOLLAR_TOKEN;
2276 esc_type = ESC_STRING_DOLLAR_TOKEN;
2277 break;
2278
2279 default:
2280 SLang_verror (SL_Internal_Error, "Unsupported multline token: 0x%X", tok->type);
2281 return -1;
2282 }
2283
2284 buf[0] = tok->type;
2285 buf[1] = 0;
2286 if (-1 == bytecomp_write_data ((char *)buf, 1))
2287 return -1;
2288
2289 root = m->list;
2290 b3 = (char *)buf + 3;
2291 while (root != NULL)
2292 {
2293 unsigned int len;
2294 int is_escaped;
2295
2296 if (-1 == escape_string ((unsigned char *)root->buf, (unsigned char *)root->buf + root->len,
2297 (unsigned char *)b3, buf_max, &is_escaped))
2298 return -1;
2299
2300 if (is_escaped)
2301 buf[0] = esc_type;
2302 else
2303 buf[0] = type;
2304
2305 len = strlen (b3);
2306 buf[1] = (unsigned char) ((len & 0x7F) + 32);
2307 buf[2] = (unsigned char) (((len >> 7) & 0x7F) + 32);
2308 len += 3;
2309
2310 if (-1 == bytecomp_write_data ((char *) buf, len))
2311 return -1;
2312
2313 root = root->next;
2314 }
2315
2316 buf[0] = tok->type;
2317 buf[1] = 0;
2318 if (-1 == bytecomp_write_data ((char *)buf, 1))
2319 return -1;
2320
2321 return 0;
2322 }
2323
byte_compile_token(_pSLang_Token_Type * tok)2324 static void byte_compile_token (_pSLang_Token_Type *tok)
2325 {
2326 unsigned char buf [SL_MAX_TOKEN_LEN + 4], *buf_max;
2327 SLstrlen_Type len;
2328 char *b3;
2329 int is_escaped;
2330 unsigned char *s;
2331
2332 if (_pSLang_Error) return;
2333
2334 buf [0] = (unsigned char) tok->type;
2335 buf [1] = 0;
2336
2337 buf_max = buf + sizeof(buf);
2338 b3 = (char *) buf + 3;
2339
2340 switch (tok->type)
2341 {
2342 case BOS_TOKEN:
2343 case LINE_NUM_TOKEN:
2344 case CHAR_TOKEN:
2345 case SHORT_TOKEN:
2346 case INT_TOKEN:
2347 case LONG_TOKEN:
2348 sprintf (b3, "%ld", tok->v.long_val);
2349 break;
2350
2351 case UCHAR_TOKEN:
2352 case USHORT_TOKEN:
2353 case UINT_TOKEN:
2354 case ULONG_TOKEN:
2355 sprintf (b3, "%lu", tok->v.long_val);
2356 break;
2357
2358 #ifdef HAVE_LONG_LONG
2359 case LLONG_TOKEN:
2360 sprintf (b3, SLFMT_LLD, tok->v.llong_val);
2361 break;
2362
2363 case ULLONG_TOKEN:
2364 sprintf (b3, SLFMT_LLU, tok->v.ullong_val);
2365 break;
2366 #endif
2367 case _BSTRING_TOKEN:
2368 s = (unsigned char *) tok->v.s_val;
2369 len = (unsigned int) tok->hash;
2370
2371 if (-1 == escape_string (s, s + len,
2372 (unsigned char *)b3, buf_max,
2373 &is_escaped))
2374 return;
2375
2376 buf[0] = ESC_BSTRING_TOKEN;
2377 break;
2378
2379 case BSTRING_TOKEN:
2380 if (NULL == (s = SLbstring_get_pointer (tok->v.b_val, &len)))
2381 return;
2382
2383 if (-1 == escape_string (s, s + len,
2384 (unsigned char *)b3, buf_max,
2385 &is_escaped))
2386 return;
2387 buf[0] = ESC_BSTRING_TOKEN;
2388 break;
2389
2390 case STRING_DOLLAR_TOKEN:
2391 case STRING_TOKEN:
2392 s = (unsigned char *)tok->v.s_val;
2393
2394 if (-1 == escape_string (s, s + strlen ((char *)s),
2395 (unsigned char *)b3, buf_max,
2396 &is_escaped))
2397 return;
2398
2399 if (is_escaped)
2400 buf[0] = ((tok->type == STRING_TOKEN)
2401 ? ESC_STRING_TOKEN : ESC_STRING_DOLLAR_TOKEN);
2402 break;
2403
2404 /* case _DEREF_ASSIGN_TOKEN: */
2405 /* a _SCALAR_* token is attached to an identifier. */
2406 case _SCALAR_ASSIGN_TOKEN:
2407 case _SCALAR_PLUSEQS_TOKEN:
2408 case _SCALAR_MINUSEQS_TOKEN:
2409 case _SCALAR_TIMESEQS_TOKEN:
2410 case _SCALAR_DIVEQS_TOKEN:
2411 case _SCALAR_BOREQS_TOKEN:
2412 case _SCALAR_BANDEQS_TOKEN:
2413 case _SCALAR_PLUSPLUS_TOKEN:
2414 case _SCALAR_POST_PLUSPLUS_TOKEN:
2415 case _SCALAR_MINUSMINUS_TOKEN:
2416 case _SCALAR_POST_MINUSMINUS_TOKEN:
2417 case DOT_TOKEN:
2418 case DOT_METHOD_CALL_TOKEN:
2419 case TMP_TOKEN:
2420 case DEFINE_TOKEN:
2421 case DEFINE_STATIC_TOKEN:
2422 case DEFINE_PRIVATE_TOKEN:
2423 case DEFINE_PUBLIC_TOKEN:
2424 case FLOAT_TOKEN:
2425 case DOUBLE_TOKEN:
2426 case COMPLEX_TOKEN:
2427 case IDENT_TOKEN:
2428 case _REF_TOKEN:
2429 case _STRUCT_ASSIGN_TOKEN:
2430 case _STRUCT_PLUSEQS_TOKEN:
2431 case _STRUCT_MINUSEQS_TOKEN:
2432 case _STRUCT_TIMESEQS_TOKEN:
2433 case _STRUCT_DIVEQS_TOKEN:
2434 case _STRUCT_BOREQS_TOKEN:
2435 case _STRUCT_BANDEQS_TOKEN:
2436 case _STRUCT_POST_MINUSMINUS_TOKEN:
2437 case _STRUCT_MINUSMINUS_TOKEN:
2438 case _STRUCT_POST_PLUSPLUS_TOKEN:
2439 case _STRUCT_PLUSPLUS_TOKEN:
2440 case _STRUCT_FIELD_REF_TOKEN:
2441 strcpy (b3, tok->v.s_val);
2442 break;
2443
2444 case BREAK_N_TOKEN:
2445 case CONT_N_TOKEN:
2446 sprintf (b3, "%ld", tok->v.long_val);
2447 break;
2448
2449 case MULTI_STRING_TOKEN:
2450 (void) byte_compile_multiline_token (tok, buf, buf_max);
2451 return;
2452
2453 default:
2454 b3 = NULL;
2455 }
2456
2457 if (b3 != NULL)
2458 {
2459 len = strlen (b3);
2460 buf[1] = (unsigned char) ((len & 0x7F) + 32);
2461 buf[2] = (unsigned char) (((len >> 7) & 0x7F) + 32);
2462 len += 3;
2463 }
2464 else len = 1;
2465
2466 (void) bytecomp_write_data ((char *)buf, len);
2467 }
2468
SLang_byte_compile_file(SLFUTURE_CONST char * name,int method)2469 int SLang_byte_compile_file (SLFUTURE_CONST char *name, int method)
2470 {
2471 char file [1024];
2472
2473 (void) method;
2474 if (strlen (name) + 2 >= sizeof (file))
2475 {
2476 _pSLang_verror (SL_INVALID_PARM, "Filename too long");
2477 return -1;
2478 }
2479 sprintf (file, "%sc", name);
2480 if (NULL == (Byte_Compile_Fp = fopen (file, "w")))
2481 {
2482 _pSLang_verror(SL_OBJ_NOPEN, "%s: unable to open", file);
2483 return -1;
2484 }
2485
2486 Byte_Compile_Line_Len = 0;
2487 if (-1 != bytecomp_write_data (".#", 2))
2488 {
2489 _pSLcompile_ptr = byte_compile_token;
2490 (void) SLang_load_file (name);
2491 _pSLcompile_ptr = _pSLcompile;
2492
2493 (void) bytecomp_write_data ("\n", 1);
2494 }
2495
2496 if (EOF == fclose (Byte_Compile_Fp))
2497 SLang_set_error (SL_IO_WRITE_ERROR);
2498
2499 if (_pSLang_Error)
2500 {
2501 _pSLang_verror (0, "Error processing %s", name);
2502 return -1;
2503 }
2504 return 0;
2505 }
2506
SLang_generate_debug_info(int x)2507 int SLang_generate_debug_info (int x)
2508 {
2509 #if SLANG_HAS_DEBUG_CODE
2510 /* int y = Default_Compile_Line_Num_Info; */
2511 /* Default_Compile_Line_Num_Info = x; */
2512 int y = 0;
2513 (void)x;
2514 #if 0
2515 if (x == 0)
2516 Default_Compile_BOSEOS = 0;
2517 else
2518 Default_Compile_BOSEOS = 3;
2519 #endif
2520 return y;
2521 #else
2522 (void) x;
2523 return 0;
2524 #endif
2525 }
2526