summaryrefslogtreecommitdiffstats
path: root/mdk-stage1/slang/sltoken.c
diff options
context:
space:
mode:
authorMystery Man <unknown@mandriva.org>2001-06-11 13:49:39 +0000
committerMystery Man <unknown@mandriva.org>2001-06-11 13:49:39 +0000
commit16bde8b3d7027aba56051fbf557b7735eb2ee6aa (patch)
tree0d8736af65eea4a83b8445ee8e2a6d0c951aea67 /mdk-stage1/slang/sltoken.c
parent0a121a8ecd6de894c14d60daf9da2022ec47405c (diff)
downloaddrakx-16bde8b3d7027aba56051fbf557b7735eb2ee6aa.tar
drakx-16bde8b3d7027aba56051fbf557b7735eb2ee6aa.tar.gz
drakx-16bde8b3d7027aba56051fbf557b7735eb2ee6aa.tar.bz2
drakx-16bde8b3d7027aba56051fbf557b7735eb2ee6aa.tar.xz
drakx-16bde8b3d7027aba56051fbf557b7735eb2ee6aa.zip
This commit was manufactured by cvs2svn to create branch 'rp-pppoe'.topic/rp-pppoe
Diffstat (limited to 'mdk-stage1/slang/sltoken.c')
-rw-r--r--mdk-stage1/slang/sltoken.c1702
1 files changed, 0 insertions, 1702 deletions
diff --git a/mdk-stage1/slang/sltoken.c b/mdk-stage1/slang/sltoken.c
deleted file mode 100644
index d08967a24..000000000
--- a/mdk-stage1/slang/sltoken.c
+++ /dev/null
@@ -1,1702 +0,0 @@
-/* Copyright (c) 1998, 1999, 2001 John E. Davis
- * This file is part of the S-Lang library.
- *
- * You may distribute under the terms of either the GNU General Public
- * License or the Perl Artistic License.
- */
-#include "slinclud.h"
-
-#include "slang.h"
-#include "_slang.h"
-
-#define MAX_TOKEN_LEN 254
-#define MAX_FILE_LINE_LEN 256
-
-static char Empty_Line[1] = {0};
-
-static int Default_Compile_Line_Num_Info;
-static char *Input_Line = Empty_Line;
-static char *Input_Line_Pointer;
-
-static SLPreprocess_Type *This_SLpp;
-
-static SLang_Load_Type *LLT;
-
-static char *map_token_to_string (_SLang_Token_Type *tok)
-{
- char *s;
- static char numbuf [32];
- unsigned char type;
- s = NULL;
-
- if (tok != NULL) type = tok->type;
- else type = 0;
-
- switch (type)
- {
- case 0:
- s = "??";
- break;
-
- case CHAR_TOKEN:
- case SHORT_TOKEN:
- case INT_TOKEN:
- case LONG_TOKEN:
- s = numbuf;
- sprintf (s, "%ld", tok->v.long_val);
- break;
-
- case UCHAR_TOKEN:
- case USHORT_TOKEN:
- case UINT_TOKEN:
- case ULONG_TOKEN:
- s = numbuf;
- sprintf (s, "%lu", (unsigned long)tok->v.long_val);
- break;
-
- case OBRACKET_TOKEN: s = "["; break;
- case CBRACKET_TOKEN: s = "]"; break;
- case OPAREN_TOKEN: s = "("; break;
- case CPAREN_TOKEN: s = ")"; break;
- case OBRACE_TOKEN: s = "{"; break;
- case CBRACE_TOKEN: s = "}"; break;
- case DEREF_TOKEN: s = "@"; break;
- case POUND_TOKEN: s = "#"; break;
- case COMMA_TOKEN: s = ","; break;
- case SEMICOLON_TOKEN: s = ";"; break;
- case COLON_TOKEN: s = ":"; break;
-
-#if SLANG_HAS_FLOAT
- case FLOAT_TOKEN:
- case DOUBLE_TOKEN:
- case COMPLEX_TOKEN:
-#endif
- case IDENT_TOKEN:
- if ((tok->free_sval_flag == 0) || (tok->num_refs == 0))
- break;
- /* drop */
- default:
- s = tok->v.s_val;
- break;
- }
-
- if (s == NULL)
- {
- s = numbuf;
- sprintf (s, "(0x%02X)", type);
- }
-
- return s;
-}
-
-static char *make_line_file_error (char *buf, unsigned int buflen,
- _SLang_Token_Type *tok, char *dsc, int line, char *file)
-{
-#if _SLANG_HAS_DEBUG_CODE
- if (tok != NULL) line = tok->line_number;
-#endif
- if (file == NULL) file = "??";
-
- (void) _SLsnprintf (buf, buflen, "%s: found '%s', line %d, file: %s",
- dsc, map_token_to_string (tok), line, file);
-
- return buf;
-}
-
-void _SLparse_error(char *str, _SLang_Token_Type *tok, int flag)
-{
- char buf [1024];
-
- if (str == NULL)
- str = "Parse Error";
-
- make_line_file_error (buf, sizeof (buf), tok, str, LLT->line_num, (char *) LLT->name);
-
- if ((flag == 0) && SLang_Error)
- return;
-
- SLang_verror (SL_SYNTAX_ERROR, "%s", buf);
-}
-
-static void do_line_file_error (int line, char *file)
-{
- SLang_verror (SL_SYNTAX_ERROR,
- "called from line %d, file: %s", line, file);
-}
-
-#define ALPHA_CHAR 1
-#define DIGIT_CHAR 2
-#define EXCL_CHAR 3
-#define SEP_CHAR 4
-#define OP_CHAR 5
-#define DOT_CHAR 6
-#define BOLDOT_CHAR 7
-#define DQUOTE_CHAR 8
-#define QUOTE_CHAR 9
-#define COMMENT_CHAR 10
-#define NL_CHAR 11
-#define BAD_CHAR 12
-#define WHITE_CHAR 13
-
-#define CHAR_EOF 255
-
-#define CHAR_CLASS(c) (Char_Type_Table[(c)][0])
-#define CHAR_DATA(c) (Char_Type_Table[(c)][1])
-
-/* In this table, if a single character can represent an operator, e.g.,
- * '&' (BAND_TOKEN), then it must be placed before multiple-character
- * operators that begin with the same character, e.g., "&=". See
- * get_op_token to see how this is exploited.
- *
- * The third character null terminates the operator string. This is for
- * the token structure.
- */
-static char Operators [29][4] =
-{
-#define OFS_EXCL 0
- {'!', '=', 0, NE_TOKEN},
-#define OFS_POUND 1
- {'#', 0, 0, POUND_TOKEN},
-#define OFS_BAND 2
- {'&', 0, 0, BAND_TOKEN},
- {'&', '&', 0, EOF_TOKEN},
- {'&', '=', 0, BANDEQS_TOKEN},
-#define OFS_STAR 5
- {'*', 0, 0, TIMES_TOKEN},
- {'*', '=', 0, TIMESEQS_TOKEN},
-#define OFS_PLUS 7
- {'+', 0, 0, ADD_TOKEN},
- {'+', '+', 0, PLUSPLUS_TOKEN},
- {'+', '=', 0, PLUSEQS_TOKEN},
-#define OFS_MINUS 10
- {'-', 0, 0, SUB_TOKEN},
- {'-', '-', 0, MINUSMINUS_TOKEN},
- {'-', '=', 0, MINUSEQS_TOKEN},
- {'-', '>', 0, NAMESPACE_TOKEN},
-#define OFS_DIV 14
- {'/', 0, 0, DIV_TOKEN},
- {'/', '=', 0, DIVEQS_TOKEN},
-#define OFS_LT 16
- {'<', 0, 0, LT_TOKEN},
- {'<', '=', 0, LE_TOKEN},
-#define OFS_EQS 18
- {'=', 0, 0, ASSIGN_TOKEN},
- {'=', '=', 0, EQ_TOKEN},
-#define OFS_GT 20
- {'>', 0, 0, GT_TOKEN},
- {'>', '=', 0, GE_TOKEN},
-#define OFS_AT 22
- {'@', 0, 0, DEREF_TOKEN},
-#define OFS_POW 23
- {'^', 0, 0, POW_TOKEN},
-#define OFS_BOR 24
- {'|', 0, 0, BOR_TOKEN},
- {'|', '|', 0, EOF_TOKEN},
- {'|', '=', 0, BOREQS_TOKEN},
-#define OFS_BNOT 27
- {'~', 0, 0, BNOT_TOKEN},
- { 0, 0, 0, EOF_TOKEN}
-};
-
-static unsigned char Char_Type_Table[256][2] =
-{
- { NL_CHAR, 0 }, /* 0x0 */ { BAD_CHAR, 0 }, /* 0x1 */
- { BAD_CHAR, 0 }, /* 0x2 */ { BAD_CHAR, 0 }, /* 0x3 */
- { BAD_CHAR, 0 }, /* 0x4 */ { BAD_CHAR, 0 }, /* 0x5 */
- { BAD_CHAR, 0 }, /* 0x6 */ { BAD_CHAR, 0 }, /* 0x7 */
- { WHITE_CHAR, 0 }, /* 0x8 */ { WHITE_CHAR, 0 }, /* 0x9 */
- { NL_CHAR, 0 }, /* \n */ { WHITE_CHAR, 0 }, /* 0xb */
- { WHITE_CHAR, 0 }, /* 0xc */ { WHITE_CHAR, 0 }, /* \r */
- { BAD_CHAR, 0 }, /* 0xe */ { BAD_CHAR, 0 }, /* 0xf */
- { BAD_CHAR, 0 }, /* 0x10 */ { BAD_CHAR, 0 }, /* 0x11 */
- { BAD_CHAR, 0 }, /* 0x12 */ { BAD_CHAR, 0 }, /* 0x13 */
- { BAD_CHAR, 0 }, /* 0x14 */ { BAD_CHAR, 0 }, /* 0x15 */
- { BAD_CHAR, 0 }, /* 0x16 */ { BAD_CHAR, 0 }, /* 0x17 */
- { BAD_CHAR, 0 }, /* 0x18 */ { BAD_CHAR, 0 }, /* 0x19 */
- { BAD_CHAR, 0 }, /* 0x1a */ { BAD_CHAR, 0 }, /* 0x1b */
- { BAD_CHAR, 0 }, /* 0x1c */ { BAD_CHAR, 0 }, /* 0x1d */
- { BAD_CHAR, 0 }, /* 0x1e */ { BAD_CHAR, 0 }, /* 0x1f */
- { WHITE_CHAR, 0 }, /* 0x20 */ { EXCL_CHAR, OFS_EXCL }, /* ! */
- { DQUOTE_CHAR, 0 }, /* " */ { OP_CHAR, OFS_POUND }, /* # */
- { ALPHA_CHAR, 0 }, /* $ */ { NL_CHAR, 0 },/* % */
- { OP_CHAR, OFS_BAND }, /* & */ { QUOTE_CHAR, 0 }, /* ' */
- { SEP_CHAR, OPAREN_TOKEN }, /* ( */ { SEP_CHAR, CPAREN_TOKEN }, /* ) */
- { OP_CHAR, OFS_STAR }, /* * */ { OP_CHAR, OFS_PLUS}, /* + */
- { SEP_CHAR, COMMA_TOKEN }, /* , */ { OP_CHAR, OFS_MINUS }, /* - */
- { DOT_CHAR, 0 }, /* . */ { OP_CHAR, OFS_DIV }, /* / */
- { DIGIT_CHAR, 0 }, /* 0 */ { DIGIT_CHAR, 0 }, /* 1 */
- { DIGIT_CHAR, 0 }, /* 2 */ { DIGIT_CHAR, 0 }, /* 3 */
- { DIGIT_CHAR, 0 }, /* 4 */ { DIGIT_CHAR, 0 }, /* 5 */
- { DIGIT_CHAR, 0 }, /* 6 */ { DIGIT_CHAR, 0 }, /* 7 */
- { DIGIT_CHAR, 0 }, /* 8 */ { DIGIT_CHAR, 0 }, /* 9 */
- { SEP_CHAR, COLON_TOKEN }, /* : */ { SEP_CHAR, SEMICOLON_TOKEN }, /* ; */
- { OP_CHAR, OFS_LT }, /* < */ { OP_CHAR, OFS_EQS }, /* = */
- { OP_CHAR, OFS_GT }, /* > */ { BAD_CHAR, 0 }, /* ? */
- { OP_CHAR, OFS_AT}, /* @ */ { ALPHA_CHAR, 0 }, /* A */
- { ALPHA_CHAR, 0 }, /* B */ { ALPHA_CHAR, 0 }, /* C */
- { ALPHA_CHAR, 0 }, /* D */ { ALPHA_CHAR, 0 }, /* E */
- { ALPHA_CHAR, 0 }, /* F */ { ALPHA_CHAR, 0 }, /* G */
- { ALPHA_CHAR, 0 }, /* H */ { ALPHA_CHAR, 0 }, /* I */
- { ALPHA_CHAR, 0 }, /* J */ { ALPHA_CHAR, 0 }, /* K */
- { ALPHA_CHAR, 0 }, /* L */ { ALPHA_CHAR, 0 }, /* M */
- { ALPHA_CHAR, 0 }, /* N */ { ALPHA_CHAR, 0 }, /* O */
- { ALPHA_CHAR, 0 }, /* P */ { ALPHA_CHAR, 0 }, /* Q */
- { ALPHA_CHAR, 0 }, /* R */ { ALPHA_CHAR, 0 }, /* S */
- { ALPHA_CHAR, 0 }, /* T */ { ALPHA_CHAR, 0 }, /* U */
- { ALPHA_CHAR, 0 }, /* V */ { ALPHA_CHAR, 0 }, /* W */
- { ALPHA_CHAR, 0 }, /* X */ { ALPHA_CHAR, 0 }, /* Y */
- { ALPHA_CHAR, 0 }, /* Z */ { SEP_CHAR, OBRACKET_TOKEN }, /* [ */
- { BAD_CHAR, 0 }, /* \ */ { SEP_CHAR, CBRACKET_TOKEN }, /* ] */
- { OP_CHAR, OFS_POW }, /* ^ */ { ALPHA_CHAR, 0 }, /* _ */
- { BAD_CHAR, 0 }, /* ` */ { ALPHA_CHAR, 0 }, /* a */
- { ALPHA_CHAR, 0 }, /* b */ { ALPHA_CHAR, 0 }, /* c */
- { ALPHA_CHAR, 0 }, /* d */ { ALPHA_CHAR, 0 }, /* e */
- { ALPHA_CHAR, 0 }, /* f */ { ALPHA_CHAR, 0 }, /* g */
- { ALPHA_CHAR, 0 }, /* h */ { ALPHA_CHAR, 0 }, /* i */
- { ALPHA_CHAR, 0 }, /* j */ { ALPHA_CHAR, 0 }, /* k */
- { ALPHA_CHAR, 0 }, /* l */ { ALPHA_CHAR, 0 }, /* m */
- { ALPHA_CHAR, 0 }, /* n */ { ALPHA_CHAR, 0 }, /* o */
- { ALPHA_CHAR, 0 }, /* p */ { ALPHA_CHAR, 0 }, /* q */
- { ALPHA_CHAR, 0 }, /* r */ { ALPHA_CHAR, 0 }, /* s */
- { ALPHA_CHAR, 0 }, /* t */ { ALPHA_CHAR, 0 }, /* u */
- { ALPHA_CHAR, 0 }, /* v */ { ALPHA_CHAR, 0 }, /* w */
- { ALPHA_CHAR, 0 }, /* x */ { ALPHA_CHAR, 0 }, /* y */
- { ALPHA_CHAR, 0 }, /* z */ { SEP_CHAR, OBRACE_TOKEN }, /* { */
- { OP_CHAR, OFS_BOR }, /* | */ { SEP_CHAR, CBRACE_TOKEN }, /* } */
- { OP_CHAR, OFS_BNOT }, /* ~ */ { BAD_CHAR, 0 }, /* 0x7f */
-
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
- { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */
-};
-
-int _SLcheck_identifier_syntax (char *name)
-{
- unsigned char *p;
-
- p = (unsigned char *) name;
- if (ALPHA_CHAR == Char_Type_Table[*p][0]) while (1)
- {
- unsigned ch;
- unsigned char type;
-
- ch = *++p;
-
- type = Char_Type_Table [ch][0];
- if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR))
- {
- if (ch == 0)
- return 0;
- break;
- }
- }
-
- SLang_verror (SL_SYNTAX_ERROR,
- "Name %s contains an illegal character", name);
- return -1;
-}
-
-static unsigned char prep_get_char (void)
-{
- register unsigned char ch;
-
- if (0 != (ch = *Input_Line_Pointer++))
- return ch;
-
- Input_Line_Pointer--;
- return 0;
-}
-
-static void unget_prep_char (unsigned char ch)
-{
- if ((Input_Line_Pointer != Input_Line)
- && (ch != 0))
- Input_Line_Pointer--;
- /* *Input_Line_Pointer = ch; -- Do not modify the Input_Line */
-}
-
-#include "keywhash.c"
-
-static int get_ident_token (_SLang_Token_Type *tok, unsigned char *s, unsigned int len)
-{
- unsigned char ch;
- unsigned char type;
- Keyword_Table_Type *table;
-
- while (1)
- {
- ch = prep_get_char ();
- type = CHAR_CLASS (ch);
- if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR))
- {
- unget_prep_char (ch);
- break;
- }
- s [len++] = ch;
- }
-
- s[len] = 0;
-
- /* check if keyword */
- table = is_keyword ((char *) s, len);
- if (table != NULL)
- {
- tok->v.s_val = table->name;
- return (tok->type = table->type);
- }
-
- tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
- tok->free_sval_flag = 1;
- return (tok->type = IDENT_TOKEN);
-}
-
-static int get_number_token (_SLang_Token_Type *tok, unsigned char *s, unsigned int len)
-{
- unsigned char ch;
- unsigned char type;
-
- /* Look for pattern [0-9.xX]*([eE][-+]?[digits])?[ijfhul]? */
- while (1)
- {
- ch = prep_get_char ();
-
- type = CHAR_CLASS (ch);
- if ((type != DIGIT_CHAR) && (type != DOT_CHAR))
- {
- if ((ch != 'x') && (ch != 'X'))
- break;
- /* It must be hex */
- do
- {
- if (len == (MAX_TOKEN_LEN - 1))
- goto too_long_return_error;
-
- s[len++] = ch;
- ch = prep_get_char ();
- type = CHAR_CLASS (ch);
- }
- while ((type == DIGIT_CHAR) || (type == ALPHA_CHAR));
- break;
- }
- if (len == (MAX_TOKEN_LEN - 1))
- goto too_long_return_error;
- s [len++] = ch;
- }
-
- /* At this point, type and ch are synchronized */
-
- if ((ch == 'e') || (ch == 'E'))
- {
- if (len == (MAX_TOKEN_LEN - 1))
- goto too_long_return_error;
- s[len++] = ch;
- ch = prep_get_char ();
- if ((ch == '+') || (ch == '-'))
- {
- if (len == (MAX_TOKEN_LEN - 1))
- goto too_long_return_error;
- s[len++] = ch;
- ch = prep_get_char ();
- }
-
- while (DIGIT_CHAR == (type = CHAR_CLASS(ch)))
- {
- if (len == (MAX_TOKEN_LEN - 1))
- goto too_long_return_error;
- s[len++] = ch;
- ch = prep_get_char ();
- }
- }
-
- while (ALPHA_CHAR == type)
- {
- if (len == (MAX_TOKEN_LEN - 1))
- goto too_long_return_error;
- s[len++] = ch;
- ch = prep_get_char ();
- type = CHAR_CLASS(ch);
- }
-
- unget_prep_char (ch);
- s[len] = 0;
-
- switch (SLang_guess_type ((char *) s))
- {
- default:
- tok->v.s_val = (char *) s;
- _SLparse_error ("Not a number", tok, 0);
- return (tok->type = EOF_TOKEN);
-
-#if SLANG_HAS_FLOAT
- case SLANG_FLOAT_TYPE:
- tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
- tok->free_sval_flag = 1;
- return (tok->type = FLOAT_TOKEN);
-
- case SLANG_DOUBLE_TYPE:
- tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
- tok->free_sval_flag = 1;
- return (tok->type = DOUBLE_TOKEN);
-#endif
-#if SLANG_HAS_COMPLEX
- case SLANG_COMPLEX_TYPE:
- tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash);
- tok->free_sval_flag = 1;
- return (tok->type = COMPLEX_TOKEN);
-#endif
- case SLANG_CHAR_TYPE:
- tok->v.long_val = (char)SLatol (s);
- return tok->type = CHAR_TOKEN;
- case SLANG_UCHAR_TYPE:
- tok->v.long_val = (unsigned char)SLatol (s);
- return tok->type = UCHAR_TOKEN;
- case SLANG_SHORT_TYPE:
- tok->v.long_val = (short)SLatol (s);
- return tok->type = SHORT_TOKEN;
- case SLANG_USHORT_TYPE:
- tok->v.long_val = (unsigned short)SLatoul (s);
- return tok->type = USHORT_TOKEN;
- case SLANG_INT_TYPE:
- tok->v.long_val = (int)SLatol (s);
- return tok->type = INT_TOKEN;
- case SLANG_UINT_TYPE:
- tok->v.long_val = (unsigned int)SLatoul (s);
- return tok->type = UINT_TOKEN;
- case SLANG_LONG_TYPE:
- tok->v.long_val = SLatol (s);
- return tok->type = LONG_TOKEN;
- case SLANG_ULONG_TYPE:
- tok->v.long_val = SLatoul (s);
- return tok->type = ULONG_TOKEN;
- }
-
- too_long_return_error:
- _SLparse_error ("Number too long for buffer", NULL, 0);
- return (tok->type == EOF_TOKEN);
-}
-
-static int get_op_token (_SLang_Token_Type *tok, char ch)
-{
- unsigned int offset;
- char second_char;
- unsigned char type;
- char *name;
-
- /* operators are: + - / * ++ -- += -= = == != > < >= <= | etc..
- * These lex to the longest valid operator token.
- */
-
- offset = CHAR_DATA((unsigned char) ch);
- if (0 == Operators [offset][1])
- {
- name = Operators [offset];
- type = name [3];
- }
- else
- {
- type = EOF_TOKEN;
- name = NULL;
- }
-
- second_char = prep_get_char ();
- do
- {
- if (second_char == Operators[offset][1])
- {
- name = Operators [offset];
- type = name [3];
- break;
- }
- offset++;
- }
- while (ch == Operators[offset][0]);
-
- tok->type = type;
-
- if (type == EOF_TOKEN)
- {
- _SLparse_error ("Operator not supported", NULL, 0);
- return type;
- }
-
- tok->v.s_val = name;
-
- if (name[1] == 0)
- unget_prep_char (second_char);
-
- return type;
-}
-
-/* If this returns non-zero, then it is a binary string */
-static int expand_escaped_string (register char *s,
- register char *t, register char *tmax,
- unsigned int *lenp)
-{
- char *s0;
- int is_binary = 0;
- char ch;
-
- s0 = s;
- while (t < tmax)
- {
- ch = *t++;
- if (ch == '\\')
- {
- t = _SLexpand_escaped_char (t, &ch);
- if (ch == 0) is_binary = 1;
- }
- *s++ = ch;
- }
- *s = 0;
-
- *lenp = (unsigned char) (s - s0);
- return is_binary;
-}
-
-static int get_string_token (_SLang_Token_Type *tok, unsigned char quote_char,
- unsigned char *s)
-{
- unsigned char ch;
- unsigned int len = 0;
- int has_quote = 0;
- int is_binary;
-
- while (1)
- {
- ch = prep_get_char ();
- if (ch == 0)
- {
- _SLparse_error("Expecting quote-character", NULL, 0);
- return (tok->type = EOF_TOKEN);
- }
- if (ch == quote_char) break;
-
- s[len++] = ch;
-
- if (len == (MAX_TOKEN_LEN - 1))
- {
- _SLparse_error ("String too long for buffer", NULL, 0);
- return (tok->type == EOF_TOKEN);
- }
-
- if (ch == '\\')
- {
- has_quote = 1;
- ch = prep_get_char ();
- s[len++] = ch;
- }
- }
-
- s[len] = 0;
-
- if (has_quote)
- is_binary = expand_escaped_string ((char *) s, (char *)s, (char *)s + len, &len);
- else is_binary = 0;
-
- if ('"' == quote_char)
- {
- tok->free_sval_flag = 1;
- if (is_binary)
- {
- tok->v.b_val = SLbstring_create (s, len);
- return tok->type = BSTRING_TOKEN;
- }
- else
- {
- tok->v.s_val = _SLstring_make_hashed_string ((char *)s,
- len,
- &tok->hash);
- tok->free_sval_flag = 1;
- return (tok->type = STRING_TOKEN);
- }
- }
-
- /* else single character */
- if (s[1] != 0)
- {
- _SLparse_error("Single char expected", NULL, 0);
- return (tok->type = EOF_TOKEN);
- }
-
- tok->v.long_val = s[0];
- return (tok->type = UCHAR_TOKEN);
-}
-
-static int extract_token (_SLang_Token_Type *tok, unsigned char ch, unsigned char t)
-{
- unsigned char s [MAX_TOKEN_LEN];
- unsigned int slen;
-
- s[0] = (char) ch;
- slen = 1;
-
- switch (t)
- {
- case ALPHA_CHAR:
- return get_ident_token (tok, s, slen);
-
- case OP_CHAR:
- return get_op_token (tok, ch);
-
- case DIGIT_CHAR:
- return get_number_token (tok, s, slen);
-
- case EXCL_CHAR:
- ch = prep_get_char ();
- s [slen++] = ch;
- t = CHAR_CLASS(ch);
- if (t == ALPHA_CHAR) return get_ident_token (tok, s, slen);
- if (t == OP_CHAR)
- {
- unget_prep_char (ch);
- return get_op_token (tok, '!');
- }
- _SLparse_error("Misplaced !", NULL, 0);
- return -1;
-
- case DOT_CHAR:
- ch = prep_get_char ();
- if (DIGIT_CHAR == CHAR_CLASS(ch))
- {
- s [slen++] = ch;
- return get_number_token (tok, s, slen);
- }
- unget_prep_char (ch);
- return (tok->type = DOT_TOKEN);
-
- case SEP_CHAR:
- return (tok->type = CHAR_DATA(ch));
-
- case DQUOTE_CHAR:
- case QUOTE_CHAR:
- return get_string_token (tok, ch, s);
-
- default:
- _SLparse_error("Invalid character", NULL, 0);
- return (tok->type = EOF_TOKEN);
- }
-}
-
-int _SLget_rpn_token (_SLang_Token_Type *tok)
-{
- unsigned char ch;
-
- tok->v.s_val = "??";
- while ((ch = *Input_Line_Pointer) != 0)
- {
- unsigned char t;
-
- Input_Line_Pointer++;
- if (WHITE_CHAR == (t = CHAR_CLASS(ch)))
- continue;
-
- if (NL_CHAR == t)
- break;
-
- return extract_token (tok, ch, t);
- }
- Input_Line_Pointer = Empty_Line;
- return EOF_TOKEN;
-}
-
-int _SLget_token (_SLang_Token_Type *tok)
-{
- unsigned char ch;
- unsigned char t;
-
- tok->num_refs = 1;
- tok->free_sval_flag = 0;
- tok->v.s_val = "??";
-#if _SLANG_HAS_DEBUG_CODE
- tok->line_number = LLT->line_num;
-#endif
- if (SLang_Error || (Input_Line == NULL))
- return (tok->type = EOF_TOKEN);
-
- while (1)
- {
- ch = *Input_Line_Pointer++;
- if (WHITE_CHAR == (t = CHAR_CLASS (ch)))
- continue;
-
- if (t != NL_CHAR)
- return extract_token (tok, ch, t);
-
- do
- {
- LLT->line_num++;
-#if _SLANG_HAS_DEBUG_CODE
- tok->line_number++;
-#endif
- Input_Line = LLT->read(LLT);
- if ((NULL == Input_Line) || SLang_Error)
- {
- Input_Line_Pointer = Input_Line = NULL;
- return (tok->type = EOF_TOKEN);
- }
- }
- while (0 == SLprep_line_ok(Input_Line, This_SLpp));
-
- Input_Line_Pointer = Input_Line;
- if (*Input_Line_Pointer == '.')
- {
- Input_Line_Pointer++;
- return tok->type = RPN_TOKEN;
- }
- }
-}
-
-static int prep_exists_function (char *line, char comment)
-{
- char buf[MAX_FILE_LINE_LEN], *b, *bmax;
- unsigned char ch;
-
- bmax = buf + (sizeof (buf) - 1);
-
- while (1)
- {
- /* skip whitespace */
- while ((ch = (unsigned char) *line),
- ch && (ch != '\n') && (ch <= ' '))
- line++;
-
- if ((ch <= '\n')
- || (ch == (unsigned char) comment)) break;
-
- b = buf;
- while ((ch = (unsigned char) *line) > ' ')
- {
- if (b < bmax) *b++ = (char) ch;
- line++;
- }
- *b = 0;
-
- if (SLang_is_defined (buf))
- return 1;
- }
-
- return 0;
-}
-
-static int prep_eval_expr (char *expr)
-{
- int ret;
-
- if (0 != SLang_load_string (expr))
- return -1;
- if (-1 == SLang_pop_integer (&ret))
- return -1;
- return (ret != 0);
-}
-
-
-int SLang_load_object (SLang_Load_Type *x)
-{
- SLPreprocess_Type this_pp;
- SLPreprocess_Type *save_this_pp;
- SLang_Load_Type *save_llt;
- char *save_input_line, *save_input_line_ptr;
-#if _SLANG_HAS_DEBUG_CODE
- int save_compile_line_num_info;
-#endif
- int save_auto_declare_variables;
-
- if (SLprep_exists_hook == NULL)
- SLprep_exists_hook = prep_exists_function;
-
- if (_SLprep_eval_hook == NULL)
- _SLprep_eval_hook = prep_eval_expr;
-
- if (-1 == SLprep_open_prep (&this_pp)) return -1;
-
- if (-1 == _SLcompile_push_context (x))
- return -1;
-
-#if _SLANG_HAS_DEBUG_CODE
- save_compile_line_num_info = _SLang_Compile_Line_Num_Info;
-#endif
- save_this_pp = This_SLpp;
- save_input_line = Input_Line;
- save_input_line_ptr = Input_Line_Pointer;
- save_llt = LLT;
- save_auto_declare_variables = _SLang_Auto_Declare_Globals;
-
- This_SLpp = &this_pp;
- Input_Line_Pointer = Input_Line = Empty_Line;
- LLT = x;
-
- x->line_num = 0;
- x->parse_level = 0;
- _SLang_Auto_Declare_Globals = x->auto_declare_globals;
-
-#if _SLANG_HAS_DEBUG_CODE
- _SLang_Compile_Line_Num_Info = Default_Compile_Line_Num_Info;
-#endif
-
- _SLparse_start (x);
- if (SLang_Error)
- do_line_file_error (x->line_num, x->name);
-
- _SLang_Auto_Declare_Globals = save_auto_declare_variables;
-
- if (SLang_Error) SLang_restart (0);
-
- (void) _SLcompile_pop_context ();
-
- Input_Line = save_input_line;
- Input_Line_Pointer = save_input_line_ptr;
- LLT = save_llt;
- This_SLpp = save_this_pp;
-
-#if _SLANG_HAS_DEBUG_CODE
- _SLang_Compile_Line_Num_Info = save_compile_line_num_info;
-#endif
-
- if (SLang_Error) return -1;
- return 0;
-}
-
-SLang_Load_Type *SLallocate_load_type (char *name)
-{
- SLang_Load_Type *x;
-
- if (NULL == (x = (SLang_Load_Type *)SLmalloc (sizeof (SLang_Load_Type))))
- return NULL;
- memset ((char *) x, 0, sizeof (SLang_Load_Type));
-
- if (name == NULL) name = "";
-
- x->name = SLang_create_slstring (name);
- if (x->name == NULL)
- {
- SLfree ((char *) x);
- return NULL;
- }
- return x;
-}
-
-void SLdeallocate_load_type (SLang_Load_Type *x)
-{
- if (x != NULL)
- {
- SLang_free_slstring (x->name);
- SLfree ((char *) x);
- }
-}
-
-typedef struct
-{
- char *string;
- char *ptr;
-}
-String_Client_Data_Type;
-
-static char *read_from_string (SLang_Load_Type *x)
-{
- String_Client_Data_Type *data;
- char *s, *s1, ch;
-
- data = (String_Client_Data_Type *)x->client_data;
- s1 = s = data->ptr;
-
- if (*s == 0)
- return NULL;
-
- while ((ch = *s) != 0)
- {
- s++;
- if (ch == '\n')
- break;
- }
-
- data->ptr = s;
- return s1;
-}
-
-int SLang_load_string (char *string)
-{
- SLang_Load_Type *x;
- String_Client_Data_Type data;
- int ret;
-
- if (string == NULL)
- return -1;
-
- /* Grab a private copy in case loading modifies string */
- if (NULL == (string = SLang_create_slstring (string)))
- return -1;
-
- /* To avoid creating a static data space for every string loaded,
- * all string objects will be regarded as identical. So, identify
- * all of them by ***string***
- */
- if (NULL == (x = SLallocate_load_type ("***string***")))
- {
- SLang_free_slstring (string);
- return -1;
- }
-
- x->client_data = (VOID_STAR) &data;
- x->read = read_from_string;
-
- data.ptr = data.string = string;
- if (-1 == (ret = SLang_load_object (x)))
- SLang_verror (SLang_Error, "called from eval: %s", string);
-
- SLang_free_slstring (string);
- SLdeallocate_load_type (x);
- return ret;
-}
-
-typedef struct
-{
- char *buf;
- FILE *fp;
-}
-File_Client_Data_Type;
-
-char *SLang_User_Prompt;
-static char *read_from_file (SLang_Load_Type *x)
-{
- FILE *fp;
- File_Client_Data_Type *c;
-
- c = (File_Client_Data_Type *)x->client_data;
- fp = c->fp;
-
- if ((fp == stdin) && (SLang_User_Prompt != NULL))
- {
- fputs (SLang_User_Prompt, stdout);
- fflush (stdout);
- }
-
- return fgets (c->buf, MAX_FILE_LINE_LEN, c->fp);
-}
-
-/* Note that file could be freed from Slang during run of this routine
- * so get it and store it !! (e.g., autoloading)
- */
-int (*SLang_Load_File_Hook) (char *);
-int SLang_load_file (char *f)
-{
- File_Client_Data_Type client_data;
- SLang_Load_Type *x;
- char *name, *buf;
- FILE *fp;
-
- if (SLang_Load_File_Hook != NULL)
- return (*SLang_Load_File_Hook) (f);
-
- if (f == NULL) name = "<stdin>"; else name = f;
-
- name = SLang_create_slstring (name);
- if (name == NULL)
- return -1;
-
- if (NULL == (x = SLallocate_load_type (name)))
- {
- SLang_free_slstring (name);
- return -1;
- }
-
- buf = NULL;
-
- if (f != NULL)
- fp = fopen (f, "r");
- else
- fp = stdin;
-
- if (fp == NULL)
- SLang_verror (SL_OBJ_NOPEN, "Unable to open %s", name);
- else if (NULL != (buf = SLmalloc (MAX_FILE_LINE_LEN + 1)))
- {
- client_data.fp = fp;
- client_data.buf = buf;
- x->client_data = (VOID_STAR) &client_data;
- x->read = read_from_file;
-
- (void) SLang_load_object (x);
- }
-
- if ((fp != NULL) && (fp != stdin))
- fclose (fp);
-
- SLfree (buf);
- SLang_free_slstring (name);
- SLdeallocate_load_type (x);
-
- if (SLang_Error)
- return -1;
-
- return 0;
-}
-
-int SLang_guess_type (char *t)
-{
- char *p;
- register char ch;
- int modifier = 0;
-
- if (*t == '-') t++;
- p = t;
-
-#if SLANG_HAS_FLOAT
- if (*p != '.')
- {
-#endif
- modifier = 0;
- while ((*p >= '0') && (*p <= '9')) p++;
- if (t == p) return (SLANG_STRING_TYPE);
- if ((*p == 'x') && (p == t + 1)) /* 0x?? */
- {
- modifier |= 8;
- p++;
- while (ch = *p,
- ((ch >= '0') && (ch <= '9'))
- || (((ch | 0x20) >= 'a') && ((ch | 0x20) <= 'f'))) p++;
- }
-
- /* Now look for UL, LU, UH, HU, L, H modifiers */
- while ((ch = *p) != 0)
- {
- ch |= 0x20;
- if (ch == 'h') modifier |= 1;
- else if (ch == 'l') modifier |= 2;
- else if (ch == 'u') modifier |= 4;
- else break;
- p++;
- }
- if ((1|2) == (modifier & (1|2))) /* hl present */
- return SLANG_STRING_TYPE;
-
- if (ch == 0)
- {
- if ((modifier & 0x7) == 0) return SLANG_INT_TYPE;
- if (modifier & 4)
- {
- if (modifier & 1) return SLANG_USHORT_TYPE;
- if (modifier & 2) return SLANG_ULONG_TYPE;
- return SLANG_UINT_TYPE;
- }
- if (modifier & 1) return SLANG_SHORT_TYPE;
- if (modifier & 2) return SLANG_LONG_TYPE;
- return SLANG_INT_TYPE;
- }
-
- if (modifier) return SLANG_STRING_TYPE;
-#if SLANG_HAS_FLOAT
- }
-
- /* now down to double case */
- if (*p == '.')
- {
- p++;
- while ((*p >= '0') && (*p <= '9')) p++;
- }
- if (*p == 0) return(SLANG_DOUBLE_TYPE);
- if ((*p != 'e') && (*p != 'E'))
- {
-# if SLANG_HAS_COMPLEX
- if (((*p == 'i') || (*p == 'j'))
- && (p[1] == 0))
- return SLANG_COMPLEX_TYPE;
-# endif
- if (((*p | 0x20) == 'f') && (p[1] == 0))
- return SLANG_FLOAT_TYPE;
-
- return SLANG_STRING_TYPE;
- }
-
- p++;
- if ((*p == '-') || (*p == '+')) p++;
- while ((*p >= '0') && (*p <= '9')) p++;
- if (*p != 0)
- {
-# if SLANG_HAS_COMPLEX
- if (((*p == 'i') || (*p == 'j'))
- && (p[1] == 0))
- return SLANG_COMPLEX_TYPE;
-# endif
- if (((*p | 0x20) == 'f') && (p[1] == 0))
- return SLANG_FLOAT_TYPE;
-
- return SLANG_STRING_TYPE;
- }
- return SLANG_DOUBLE_TYPE;
-#else
- return SLANG_STRING_TYPE;
-#endif /* SLANG_HAS_FLOAT */
-}
-
-static int hex_atoul (unsigned char *s, unsigned long *ul)
-{
- register unsigned char ch;
- register unsigned long value;
- register int base;
-
- s++; /* skip the leading 0 */
-
- /* look for 'x' which indicates hex */
- if ((*s | 0x20) == 'x')
- {
- base = 16;
- s++;
- if (*s == 0)
- {
- SLang_Error = SL_SYNTAX_ERROR;
- return -1;
- }
- }
- else base = 8;
-
- value = 0;
- while ((ch = *s++) != 0)
- {
- char ch1 = ch | 0x20;
- switch (ch1)
- {
- default:
- SLang_Error = SL_SYNTAX_ERROR;
- break;
-
- case 'u':
- case 'l':
- case 'h':
- *ul = value;
- return 0;
-
- case '8':
- case '9':
- if (base != 16) SLang_Error = SL_SYNTAX_ERROR;
- /* drop */
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- ch1 -= '0';
- break;
-
- case 'a':
- case 'b':
- case 'c':
- case 'd':
- case 'e':
- case 'f':
- if (base != 16) SLang_Error = SL_SYNTAX_ERROR;
- ch1 = (ch1 - 'a') + 10;
- break;
- }
- value = value * base + ch1;
- }
- *ul = value;
- return 0;
-}
-
-/* Note: These routines do not check integer overflow. I would use the C
- * library functions atol and atoul but some implementations check overflow
- * and some do not. The following implementations provide a consistent
- * behavior.
- */
-unsigned long SLatoul (unsigned char *s)
-{
- int sign;
- unsigned long value;
-
- if (*s == '-') sign = -1;
- else
- {
- sign = 1;
- if (*s == '+') s++;
- }
-
- if (*s == '0')
- {
- if (-1 == hex_atoul (s, &value))
- return (unsigned long) -1;
- }
- else
- {
- while (WHITE_CHAR == CHAR_CLASS(*s))
- s++;
-
- value = 0;
- while (DIGIT_CHAR == CHAR_CLASS(*s))
- {
- value = value * 10 + (unsigned long) (*s - '0');
- s++;
- }
- }
-
- if (sign == -1)
- value = (unsigned long)-1L * value;
-
- return value;
-}
-
-long SLatol (unsigned char *s)
-{
- while (WHITE_CHAR == CHAR_CLASS(*s))
- s++;
-
- if (*s == '-')
- {
- long value = (long) SLatoul (s+1);
- return -value;
- }
- return (long) SLatoul (s);
-}
-
-int SLatoi (unsigned char *s)
-{
- return (int) SLatol (s);
-}
-
-static char *check_byte_compiled_token (char *buf)
-{
- unsigned int len_lo, len_hi, len;
-
- len_lo = (unsigned char) *Input_Line_Pointer++;
- if ((len_lo < 32)
- || ((len_hi = (unsigned char)*Input_Line_Pointer++) < 32)
- || ((len = (len_lo - 32) | ((len_hi - 32) << 7)) >= MAX_TOKEN_LEN))
- {
- SLang_doerror ("Byte compiled file appears corrupt");
- return NULL;
- }
-
- SLMEMCPY (buf, Input_Line_Pointer, len);
- buf += len;
- Input_Line_Pointer += len;
- *buf = 0;
- return buf;
-}
-
-void _SLcompile_byte_compiled (void)
-{
- unsigned char type;
- _SLang_Token_Type tok;
- char buf[MAX_TOKEN_LEN];
- char *ebuf;
- unsigned int len;
-
- memset ((char *) &tok, 0, sizeof (_SLang_Token_Type));
-
- while (SLang_Error == 0)
- {
- top_of_switch:
- type = (unsigned char) *Input_Line_Pointer++;
- switch (type)
- {
- case '\n':
- case 0:
- if (NULL == (Input_Line = LLT->read(LLT)))
- {
- Input_Line_Pointer = Input_Line = NULL;
- return;
- }
- Input_Line_Pointer = Input_Line;
- goto top_of_switch;
-
- case LINE_NUM_TOKEN:
- case CHAR_TOKEN:
- case UCHAR_TOKEN:
- case SHORT_TOKEN:
- case USHORT_TOKEN:
- case INT_TOKEN:
- case UINT_TOKEN:
- case LONG_TOKEN:
- case ULONG_TOKEN:
- if (NULL == check_byte_compiled_token (buf))
- return;
- tok.v.long_val = atol (buf);
- break;
-
- case COMPLEX_TOKEN:
- case FLOAT_TOKEN:
- case DOUBLE_TOKEN:
- if (NULL == check_byte_compiled_token (buf))
- return;
- tok.v.s_val = buf;
- break;
-
- case ESC_STRING_TOKEN:
- if (NULL == (ebuf = check_byte_compiled_token (buf)))
- return;
- tok.v.s_val = buf;
- if (expand_escaped_string (buf, buf, ebuf, &len))
- {
- tok.hash = len;
- type = _BSTRING_TOKEN;
- }
- else
- {
- tok.hash = _SLstring_hash ((unsigned char *)buf, (unsigned char *)buf + len);
- type = STRING_TOKEN;
- }
- break;
-
- case TMP_TOKEN:
- case DEFINE_TOKEN:
- case DEFINE_STATIC_TOKEN:
- case DEFINE_PRIVATE_TOKEN:
- case DEFINE_PUBLIC_TOKEN:
- case DOT_TOKEN:
- case STRING_TOKEN:
- case IDENT_TOKEN:
- case _REF_TOKEN:
- case _DEREF_ASSIGN_TOKEN:
- case _SCALAR_ASSIGN_TOKEN:
- case _SCALAR_PLUSEQS_TOKEN:
- case _SCALAR_MINUSEQS_TOKEN:
- case _SCALAR_TIMESEQS_TOKEN:
- case _SCALAR_DIVEQS_TOKEN:
- case _SCALAR_BOREQS_TOKEN:
- case _SCALAR_BANDEQS_TOKEN:
- case _SCALAR_PLUSPLUS_TOKEN:
- case _SCALAR_POST_PLUSPLUS_TOKEN:
- case _SCALAR_MINUSMINUS_TOKEN:
- case _SCALAR_POST_MINUSMINUS_TOKEN:
- case _STRUCT_ASSIGN_TOKEN:
- case _STRUCT_PLUSEQS_TOKEN:
- case _STRUCT_MINUSEQS_TOKEN:
- case _STRUCT_TIMESEQS_TOKEN:
- case _STRUCT_DIVEQS_TOKEN:
- case _STRUCT_BOREQS_TOKEN:
- case _STRUCT_BANDEQS_TOKEN:
- case _STRUCT_POST_MINUSMINUS_TOKEN:
- case _STRUCT_MINUSMINUS_TOKEN:
- case _STRUCT_POST_PLUSPLUS_TOKEN:
- case _STRUCT_PLUSPLUS_TOKEN:
- if (NULL == (ebuf = check_byte_compiled_token (buf)))
- return;
- tok.v.s_val = buf;
- tok.hash = _SLstring_hash ((unsigned char *)buf, (unsigned char *)ebuf);
- break;
-
- default:
- break;
- }
- tok.type = type;
-
- (*_SLcompile_ptr) (&tok);
- }
-}
-
-static int escape_string (unsigned char *s, unsigned char *smax,
- unsigned char *buf, unsigned char *buf_max,
- int *is_escaped)
-{
- unsigned char ch;
-
- *is_escaped = 0;
- while (buf < buf_max)
- {
- if (s == smax)
- {
- *buf = 0;
- return 0;
- }
-
- ch = *s++;
- switch (ch)
- {
- default:
- *buf++ = ch;
- break;
-
- case 0:
- *buf++ = '\\';
- if (buf < buf_max) *buf++ = 'x';
- if (buf < buf_max) *buf++ = '0';
- if (buf < buf_max) *buf++ = '0';
- *is_escaped = 1;
- break; /* return 0; */
-
- case '\n':
- *buf++ = '\\';
- if (buf < buf_max) *buf++ = 'n';
- *is_escaped = 1;
- break;
-
- case '\r':
- *buf++ = '\\';
- if (buf < buf_max) *buf++ = 'r';
- *is_escaped = 1;
- break;
-
- case 0x1A: /* ^Z */
- *buf++ = '\\';
- if (buf < buf_max) *buf++ = 'x';
- if (buf < buf_max) *buf++ = '1';
- if (buf < buf_max) *buf++ = 'A';
- *is_escaped = 1;
- break;
-
- case '\\':
- *buf++ = ch;
- if (buf < buf_max) *buf++ = ch;
- *is_escaped = 1;
- break;
- }
- }
- _SLparse_error ("String too long to byte-compile", NULL, 0);
- return -1;
-}
-
-static FILE *Byte_Compile_Fp;
-static unsigned int Byte_Compile_Line_Len;
-
-static int bytecomp_write_data (char *buf, unsigned int len)
-{
- char *err = "Write Error";
-
- if ((Byte_Compile_Line_Len + len + 1) >= MAX_FILE_LINE_LEN)
- {
- if (EOF == fputs ("\n", Byte_Compile_Fp))
- {
- SLang_doerror (err);
- return -1;
- }
- Byte_Compile_Line_Len = 0;
- }
-
- if (EOF == fputs (buf, Byte_Compile_Fp))
- {
- SLang_doerror (err);
- return -1;
- }
- Byte_Compile_Line_Len += len;
- return 0;
-}
-
-static void byte_compile_token (_SLang_Token_Type *tok)
-{
- unsigned char buf [MAX_TOKEN_LEN + 4], *buf_max;
- unsigned int len;
- char *b3;
- int is_escaped;
- unsigned char *s;
-
- if (SLang_Error) return;
-
- buf [0] = (unsigned char) tok->type;
- buf [1] = 0;
-
- buf_max = buf + sizeof(buf);
- b3 = (char *) buf + 3;
-
- switch (tok->type)
- {
- case LINE_NUM_TOKEN:
- case CHAR_TOKEN:
- case SHORT_TOKEN:
- case INT_TOKEN:
- case LONG_TOKEN:
- sprintf (b3, "%ld", tok->v.long_val);
- break;
-
- case UCHAR_TOKEN:
- case USHORT_TOKEN:
- case UINT_TOKEN:
- case ULONG_TOKEN:
- sprintf (b3, "%lu", tok->v.long_val);
- break;
-
- case _BSTRING_TOKEN:
- s = (unsigned char *) tok->v.s_val;
- len = (unsigned int) tok->hash;
-
- if (-1 == escape_string (s, s + len,
- (unsigned char *)b3, buf_max,
- &is_escaped))
- return;
-
- buf[0] = ESC_STRING_TOKEN;
- break;
-
- case BSTRING_TOKEN:
- if (NULL == (s = SLbstring_get_pointer (tok->v.b_val, &len)))
- return;
-
- if (-1 == escape_string (s, s + len,
- (unsigned char *)b3, buf_max,
- &is_escaped))
- return;
- buf[0] = ESC_STRING_TOKEN;
- break;
-
- case STRING_TOKEN:
- s = (unsigned char *)tok->v.s_val;
-
- if (-1 == escape_string (s, s + strlen ((char *)s),
- (unsigned char *)b3, buf_max,
- &is_escaped))
- return;
-
- if (is_escaped)
- buf[0] = ESC_STRING_TOKEN;
- break;
-
- /* a _SCALAR_* token is attached to an identifier. */
- case _DEREF_ASSIGN_TOKEN:
- case _SCALAR_ASSIGN_TOKEN:
- case _SCALAR_PLUSEQS_TOKEN:
- case _SCALAR_MINUSEQS_TOKEN:
- case _SCALAR_TIMESEQS_TOKEN:
- case _SCALAR_DIVEQS_TOKEN:
- case _SCALAR_BOREQS_TOKEN:
- case _SCALAR_BANDEQS_TOKEN:
- case _SCALAR_PLUSPLUS_TOKEN:
- case _SCALAR_POST_PLUSPLUS_TOKEN:
- case _SCALAR_MINUSMINUS_TOKEN:
- case _SCALAR_POST_MINUSMINUS_TOKEN:
- case DOT_TOKEN:
- case TMP_TOKEN:
- case DEFINE_TOKEN:
- case DEFINE_STATIC_TOKEN:
- case DEFINE_PRIVATE_TOKEN:
- case DEFINE_PUBLIC_TOKEN:
- case FLOAT_TOKEN:
- case DOUBLE_TOKEN:
- case COMPLEX_TOKEN:
- case IDENT_TOKEN:
- case _REF_TOKEN:
- case _STRUCT_ASSIGN_TOKEN:
- case _STRUCT_PLUSEQS_TOKEN:
- case _STRUCT_MINUSEQS_TOKEN:
- case _STRUCT_TIMESEQS_TOKEN:
- case _STRUCT_DIVEQS_TOKEN:
- case _STRUCT_BOREQS_TOKEN:
- case _STRUCT_BANDEQS_TOKEN:
- case _STRUCT_POST_MINUSMINUS_TOKEN:
- case _STRUCT_MINUSMINUS_TOKEN:
- case _STRUCT_POST_PLUSPLUS_TOKEN:
- case _STRUCT_PLUSPLUS_TOKEN:
- strcpy (b3, tok->v.s_val);
- break;
-
- default:
- b3 = NULL;
- }
-
- if (b3 != NULL)
- {
- len = strlen (b3);
- buf[1] = (unsigned char) ((len & 0x7F) + 32);
- buf[2] = (unsigned char) (((len >> 7) & 0x7F) + 32);
- len += 3;
- }
- else len = 1;
-
- (void) bytecomp_write_data ((char *)buf, len);
-}
-
-int SLang_byte_compile_file (char *name, int method)
-{
- char file [1024];
-
- (void) method;
- if (strlen (name) + 2 >= sizeof (file))
- {
- SLang_verror (SL_INVALID_PARM, "Filename too long");
- return -1;
- }
- sprintf (file, "%sc", name);
- if (NULL == (Byte_Compile_Fp = fopen (file, "w")))
- {
- SLang_verror(SL_OBJ_NOPEN, "%s: unable to open", file);
- return -1;
- }
-
- Byte_Compile_Line_Len = 0;
- if (-1 != bytecomp_write_data (".#", 2))
- {
- _SLcompile_ptr = byte_compile_token;
- (void) SLang_load_file (name);
- _SLcompile_ptr = _SLcompile;
-
- (void) bytecomp_write_data ("\n", 1);
- }
-
- if (EOF == fclose (Byte_Compile_Fp))
- SLang_doerror ("Write Error");
-
- if (SLang_Error)
- {
- SLang_verror (0, "Error processing %s", name);
- return -1;
- }
- return 0;
-}
-
-int SLang_generate_debug_info (int x)
-{
- int y = Default_Compile_Line_Num_Info;
- Default_Compile_Line_Num_Info = x;
- return y;
-}