static Lisp_Object swap_in_symval_forwarding ();
+Lisp_Object set_internal ();
+
Lisp_Object
wrong_type_argument (predicate, value)
register Lisp_Object predicate, value;
{
if (STRINGP (value) &&
(EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
- return Fstring_to_number (value);
+ return Fstring_to_number (value, Qnil);
if (INTEGERP (value) && EQ (predicate, Qstringp))
return Fnumber_to_string (value);
}
if (idxval < 0)
args_out_of_range (array, idx);
- if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
+ if (idxval < CHAR_TABLE_SINGLE_BYTE_SLOTS)
{
- /* The element is stored in the top table. We may return a
- deeper char-table. */
+ /* For ASCII and 8-bit European characters, the element is
+ stored in the top table. */
val = XCHAR_TABLE (array)->contents[idxval];
if (NILP (val))
val = XCHAR_TABLE (array)->defalt;
}
else
{
- int idx[4]; /* For charset, code1, code2, and anchor. */
- int i;
- Lisp_Object sub_array;
-
- /* There's no reason to treat a composite character
- specially here. */
-#if 0
- if (COMPOSITE_CHAR_P (idxval))
- /* For a composite characters, we use the first element as
- the index. */
- idxval = cmpchar_component (idxval, 0);
-#endif
- SPLIT_NON_ASCII_CHAR (idxval, idx[0], idx[1], idx[2]);
- idx[3] = 0;
+ int code[4], i;
+ Lisp_Object sub_table;
+
+ SPLIT_NON_ASCII_CHAR (idxval, code[0], code[1], code[2]);
+ if (code[0] != CHARSET_COMPOSITION)
+ {
+ if (code[1] < 32) code[1] = -1;
+ else if (code[2] < 32) code[2] = -1;
+ }
+ /* Here, the possible range of CODE[0] (== charset ID) is
+ 128..MAX_CHARSET. Since the top level char table contains
+ data for multibyte characters after 256th element, we must
+ increment CODE[0] by 128 to get a correct index. */
+ code[0] += 128;
+ code[3] = -1; /* anchor */
try_parent_char_table:
- sub_array = array;
- for (i = 0; idx[i]; i++)
+ sub_table = array;
+ for (i = 0; code[i] >= 0; i++)
{
- val = XCHAR_TABLE (sub_array)->contents[idx[i]];
- if (NILP (val))
- val = XCHAR_TABLE (sub_array)->defalt;
- if (NILP (val))
+ val = XCHAR_TABLE (sub_table)->contents[code[i]];
+ if (SUB_CHAR_TABLE_P (val))
+ sub_table = val;
+ else
{
- array = XCHAR_TABLE (array)->parent;
- if (NILP (array))
- return Qnil;
- goto try_parent_char_table;
+ if (NILP (val))
+ val = XCHAR_TABLE (sub_table)->defalt;
+ if (NILP (val))
+ {
+ array = XCHAR_TABLE (array)->parent;
+ if (!NILP (array))
+ goto try_parent_char_table;
+ }
+ return val;
}
- if (!CHAR_TABLE_P (val))
- return val;
- sub_array = val;
}
- /* We come here because ARRAY is deeper than the specified
- indices. We return a default value stored at the deepest
- level specified. */
- val = XCHAR_TABLE (sub_array)->defalt;
+ /* Here, VAL is a sub char table. We try the default value
+ and parent. */
+ val = XCHAR_TABLE (val)->defalt;
if (NILP (val))
{
array = XCHAR_TABLE (array)->parent;
- if (NILP (array))
- return Qnil;
- goto try_parent_char_table;
+ if (!NILP (array))
+ goto try_parent_char_table;
}
return val;
}
if (idxval < 0)
args_out_of_range (array, idx);
- if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
+ if (idxval < CHAR_TABLE_SINGLE_BYTE_SLOTS)
XCHAR_TABLE (array)->contents[idxval] = newelt;
else
{
- int idx[4]; /* For charset, code1, code2, and anchor. */
- int i;
+ int code[4], i;
Lisp_Object val;
- SPLIT_NON_ASCII_CHAR (idxval, idx[0], idx[1], idx[2]);
- idx[3] = 0;
-
- for (i = 0; idx[i + 1]; i++)
+ SPLIT_NON_ASCII_CHAR (idxval, code[0], code[1], code[2]);
+ if (code[0] != CHARSET_COMPOSITION)
+ {
+ if (code[1] < 32) code[1] = -1;
+ else if (code[2] < 32) code[2] = -1;
+ }
+ /* See the comment of the corresponding part in Faref. */
+ code[0] += 128;
+ code[3] = -1; /* anchor */
+ for (i = 0; code[i + 1] >= 0; i++)
{
- val = XCHAR_TABLE (array)->contents[idx[i]];
- if (CHAR_TABLE_P (val))
- /* Look into this deeper array. */
+ val = XCHAR_TABLE (array)->contents[code[i]];
+ if (SUB_CHAR_TABLE_P (val))
array = val;
else
- {
- /* VAL is the leaf. Create a deeper array with the
- default value VAL, set it in the slot of VAL, and
- look into it. */
- array = XCHAR_TABLE (array)->contents[idx[i]]
- = Fmake_char_table (Qnil, Qnil);
- XCHAR_TABLE (array)->defalt = val;
- }
+ /* VAL is a leaf. Create a sub char table with the
+ default value VAL here and look into it. */
+ array = (XCHAR_TABLE (array)->contents[code[i]]
+ = make_sub_char_table (val));
}
- return XCHAR_TABLE (array)->contents[idx[i]] = newelt;
+ XCHAR_TABLE (array)->contents[code[i]] = newelt;
}
}
else
return build_string (buffer);
}
-DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 1, 0,
+INLINE static int
+digit_to_number (character, base)
+ int character, base;
+{
+ int digit;
+
+ if (character >= '0' && character <= '9')
+ digit = character - '0';
+ else if (character >= 'a' && character <= 'z')
+ digit = character - 'a' + 10;
+ else if (character >= 'A' && character <= 'Z')
+ digit = character - 'A' + 10;
+ else
+ return -1;
+
+ if (digit >= base)
+ return -1;
+ else
+ return digit;
+}
+
+DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
"Convert STRING to a number by parsing it as a decimal number.\n\
This parses both integers and floating point numbers.\n\
-It ignores leading spaces and tabs.")
- (string)
- register Lisp_Object string;
+It ignores leading spaces and tabs.\n\
+\n\
+If BASE, interpret STRING as a number in that base. If BASE isn't\n\
+present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\
+Floating point numbers always use base 10.")
+ (string, base)
+ register Lisp_Object string, base;
{
- Lisp_Object value;
- unsigned char *p;
+ register unsigned char *p;
+ register int b, digit, v = 0;
+ int negative = 1;
CHECK_STRING (string, 0);
+ if (NILP (base))
+ b = 10;
+ else
+ {
+ CHECK_NUMBER (base, 1);
+ b = XINT (base);
+ if (b < 2 || b > 16)
+ Fsignal (Qargs_out_of_range, Fcons (base, Qnil));
+ }
+
p = XSTRING (string)->data;
/* Skip any whitespace at the front of the number. Some versions of
while (*p == ' ' || *p == '\t')
p++;
+ if (*p == '-')
+ {
+ negative = -1;
+ p++;
+ }
+ else if (*p == '+')
+ p++;
+
#ifdef LISP_FLOAT_TYPE
if (isfloat_string (p))
return make_float (atof (p));
#endif /* LISP_FLOAT_TYPE */
- if (sizeof (int) == sizeof (EMACS_INT))
- XSETINT (value, atoi (p));
- else if (sizeof (long) == sizeof (EMACS_INT))
- XSETINT (value, atol (p));
- else
- abort ();
- return value;
+ while (1)
+ {
+ int digit = digit_to_number (*p++, b);
+ if (digit < 0)
+ break;
+ v = v * b + digit;
+ }
+
+ return make_number (negative * v);
}
+
\f
enum arithop
{ Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };