Exemplo n.º 1
0
// ### char-not-equal
Value CL_char_not_equal(unsigned int numargs, Value args[])
{
    switch (numargs)
    {
    case 0:
        return wrong_number_of_arguments(S_char_ne, numargs, 1, MANY);
    case 1:
        if (characterp(args[0]))
            return T;
        else
            return signal_type_error(args[0], S_character);
    case 2:
    {
        unsigned char c0 = char_value(args[0]);
        unsigned char c1 = char_value(args[1]);
        return (c0 == c1 || toupper(c0) == toupper(c1)) ? NIL : T;
    }
    default:
    {
        for (unsigned int i = 0; i < numargs; i++)
            args[i] = toupper(char_value(args[i]));
        for (unsigned int i = 0; i < numargs - 1; i++)
        {
            unsigned char c = args[i];
            for (unsigned int j = i + 1; j < numargs; j++)
            {
                if (args[j] == c)
                    return NIL;
            }
        }
        return T;
    }
    }
}
Exemplo n.º 2
0
// ### char/=
Value CL_char_ne(unsigned int numargs, Value args[])
{
    switch (numargs)
    {
    case 0:
        return wrong_number_of_arguments(S_char_ne, numargs, 1, MANY);
    case 1:
        if (characterp(args[0]))
            return T;
        else
            return signal_type_error(args[0], S_character);
    case 2:
        if (!characterp(args[0]))
            return signal_type_error(args[0], S_character);
        if (!characterp(args[1]))
            return signal_type_error(args[1], S_character);
        return args[0] != args[1] ? T : NIL;
    default:
    {
        for (unsigned int i = 0; i < numargs - 1; i++)
        {
            unsigned char c = char_value(args[i]);
            for (unsigned int j = i + 1; j < numargs; j++)
            {
                if (char_value(args[j]) == c)
                    return NIL;
            }
        }
        return T;
    }
    }
}
Exemplo n.º 3
0
// ### char=
Value CL_char_e(unsigned int numargs, Value args[])
{
    switch (numargs)
    {
    case 0:
        return wrong_number_of_arguments(S_char_e, numargs, 1, MANY);
    case 1:
        if (characterp(args[0]))
            return T;
        else
            return signal_type_error(args[0], S_character);
    case 2:
        if (!characterp(args[0]))
            return signal_type_error(args[0], S_character);
        if (args[0] == args[1])
            return T;
        if (!characterp(args[1]))
            return signal_type_error(args[1], S_character);
        return NIL;
    default:
    {
        BASE_CHAR c0 = char_value(args[0]);
        for (unsigned int i = 1; i < numargs; i++)
        {
            if (c0 != char_value(args[i]))
                return NIL;
        }
        return T;
    }
    }
}
Exemplo n.º 4
0
void aes128_string_parse(const char *string, uint8_t *data) {
    assert(strlen(string) == 32);

    int i;
    for (i = 0; i < 16; i++)
        data[i] = char_value(string[i * 2]) * 16 + char_value(string[i * 2 + 1]);

}
Exemplo n.º 5
0
Value SimpleString::aset(unsigned long i, Value new_value)
{
  if (i >= _capacity)
    return bad_index(i);
  _chars[i] = char_value(new_value);
  return new_value;
}
Exemplo n.º 6
0
// ### upper-case-p character => generalized-boolean
Value CL_upper_case_p(Value arg)
{
    char c = char_value(arg);
    if ('A' <= c && c <= 'Z')
        return T;
    return NIL;
}
Exemplo n.º 7
0
// ### digit-char-p char &optional radix => weight
Value CL_digit_char_p(unsigned int numargs, Value args[])
{
    if (numargs < 1 || numargs > 2)
        return wrong_number_of_arguments(S_digit_char_p, numargs, 1, 2);
    BASE_CHAR c = char_value(args[0]);
    int radix;
    if (numargs == 2)
        radix = check_index(args[1], 2, 36);
    else
        radix = 10;
    if (c >= '0')
    {
        int n = c - '0';
        if (radix <= 10)
            return (n < radix) ? make_fixnum(n) : NIL;
        if (n < 10)
            return make_fixnum(n);
        if (c >= 'A')
        {
            // A-Z
            n -= 7;
            if (n >= 10 && n < radix)
                return make_fixnum(n);
            if (c >= 'a')
            {
                // a-z
                n -= 32;
                if (n >= 10 && n < radix)
                    return make_fixnum(n);
            }
        }
    }
    return NIL;
}
Exemplo n.º 8
0
// ### lower-case-p character => generalized-boolean
Value CL_lower_case_p(Value arg)
{
    char c = char_value(arg);
    if ('a' <= c && c <= 'z')
        return T;
    return NIL;
}
Exemplo n.º 9
0
AbstractVector * SimpleString::adjust_vector(INDEX new_capacity,
                                             Value initial_element,
                                             Value initial_contents)
{
  if (initial_contents != NIL)
    {
      BASE_CHAR * new_chars = (BASE_CHAR *) GC_malloc_atomic(new_capacity + 1);
      if (listp(initial_contents))
        {
          Value list = initial_contents;
          for (unsigned long i = 0; i < new_capacity; i++)
            {
              new_chars[i] = char_value(car(list));
              list = xcdr(list);
            }
        }
      else if (vectorp(initial_contents))
        {
          AbstractVector * v = the_vector(initial_contents);
          for (unsigned long i = 0; i < new_capacity; i++)
            new_chars[i] = char_value(v->aref(i));
        }
      else
        signal_type_error(initial_contents, S_sequence);
      new_chars[new_capacity] = 0;
      return new_simple_string(new_capacity, new_chars);
    }
  if (_capacity != new_capacity)
    {
      BASE_CHAR * new_chars = (BASE_CHAR *) GC_malloc_atomic(new_capacity + 1);
      unsigned long limit = (_capacity < new_capacity) ? _capacity : new_capacity;
      for (unsigned long i = 0; i < limit; i++)
        new_chars[i] = _chars[i];
      if (_capacity < new_capacity)
        {
          BASE_CHAR c = char_value(initial_element);
          for (unsigned long i = _capacity; i < new_capacity; i++)
            new_chars[i] = c;
        }
      new_chars[new_capacity] = 0;
      return new_simple_string(new_capacity, new_chars);
    }
  // No change.
  return this;
}
Exemplo n.º 10
0
// ### both-case-p character => generalized-boolean
Value CL_both_case_p(Value arg)
{
    char c = char_value(arg);
    if ('A' <= c && c <= 'Z')
        return T;
    if ('a' <= c && c <= 'z')
        return T;
    return NIL;
}
Exemplo n.º 11
0
// ### graphic-char-p character => generalized-boolean
Value CL_graphic_char_p(Value arg)
{
    BASE_CHAR c = char_value(arg);
    if (c >= 32 && c < 127)
        return T;
    if (c >= 160)
        return T;
    return NIL;
}
Exemplo n.º 12
0
cell pp_curs_mvinsch(cell x) {
	char	name[] = "curs:mvinsch";

	if (!Running) return UNSPECIFIC;
	mvinsch(integer_value(name, car(x)),
		integer_value(name, cadr(x)),
		char_value(caddr(x)));
	return UNSPECIFIC;
}
Exemplo n.º 13
0
// ### alpha-char-p character => generalized-boolean
Value CL_alpha_char_p(Value character)
{
    char c = char_value(character);
    if ('A' <= c && c <= 'Z')
        return T;
    if ('a' <= c && c <= 'z')
        return T;
    return NIL;
}
Exemplo n.º 14
0
// ### alphanumericp character => generalized-boolean
Value CL_alphanumericp(Value character)
{
    char c = char_value(character);
    if ('A' <= c && c <= 'Z')
        return T;
    if ('a' <= c && c <= 'z')
        return T;
    if ('0' <= c && c <= '9')
        return T;
    return NIL;
}
Exemplo n.º 15
0
// ### fasl-sharp-illegal stream sub-char numarg => value
Value SYS_fasl_sharp_illegal(Value streamarg, Value subchar, Value numarg)
{
  Stream * stream = check_ansi_stream(streamarg);
  String * s = new String("Illegal # macro character: #\\");
  Value name = CL_char_name(subchar);
  if (stringp(name))
    s->append(the_string(name));
  else
    s->append_char(char_value(subchar));
  return signal_lisp_error(new ReaderError(stream, s));
}
Exemplo n.º 16
0
// ### char-equal
Value CL_char_equal(unsigned int numargs, Value args[])
{
    switch (numargs)
    {
    case 0:
        return wrong_number_of_arguments(S_char_equal, numargs, 1, MANY);
    case 1:
        if (characterp(args[0]))
            return T;
        else
            return signal_type_error(args[0], S_character);
    case 2:
    {
        if (!characterp(args[0]))
            return signal_type_error(args[0], S_character);
        if (args[0] == args[1])
            return T;
        if (!characterp(args[1]))
            return signal_type_error(args[1], S_character);
        BASE_CHAR c1 = xchar(args[0]);
        BASE_CHAR c2 = xchar(args[1]);
        if (toupper(c1) == toupper(c2))
            return T;
        return NIL;
    }
    default:
    {
        BASE_CHAR c0 = char_value(args[0]);
        for (INDEX i = 1; i < numargs; i++)
        {
            BASE_CHAR c1 = char_value(args[i]);
            if (c0 != c1 && toupper(c0) != toupper(c1))
                return NIL;
        }
        return T;
    }
    }
}
Exemplo n.º 17
0
// FIXME check the character's syntax type in *READTABLE*
// ### whitespacep character => T or NIL
Value SYS_whitespacep(Value arg)
{
    switch (char_value(arg))
    {
    case 9:     // tab
    case 10:    // linefeed
    case 12:    // form feed
    case 13:    // return
    case ' ':   // space
        return T;
    default:
        return NIL;
    }
}
Exemplo n.º 18
0
// ### char-not-lessp
Value CL_char_not_lessp(unsigned int numargs, Value args[])
{
    switch (numargs)
    {
    case 0:
        return wrong_number_of_arguments(S_char_not_lessp, numargs, 1, MANY);
    case 1:
        if (characterp(args[0]))
            return T;
        else
            return signal_type_error(args[0], S_character);
    case 2:
        return toupper(char_value(args[0])) >= toupper(char_value(args[1])) ? T : NIL;
    default:
    {
        for (unsigned int i = 1; i < numargs; i++)
        {
            if (toupper(char_value(args[i - 1])) < toupper(char_value(args[i])))
                return NIL;
        }
        return T;
    }
    }
}
Exemplo n.º 19
0
void display(LISP_OBJ_PTR objp) {
  switch (objp->form) {
  case INT_FORM:
    fprintf(out_stream, "%d", int_value(objp));
    break;
  case FLOAT_FORM:
    fprintf(out_stream, "%g", float_value(objp));
    break;
  case CHAR_FORM:
    fprintf(out_stream, "%c", char_value(objp));
    break;
  case STRING_FORM:
    fprintf(out_stream, "%s", string_value(objp));
    break;
  case SYMBOL_FORM:
    fprintf(out_stream, "%s", symbol_value(objp));
    break;
  case PROCEDURE_FORM:
    fprintf(out_stream, "<PROCEDURE>");
    break;
  case BOOLEAN_FORM:
    fprintf(out_stream, "#%c", bool_value(objp) ? 't' : 'f');
    break;
  case CONS_FORM:
    fprintf(out_stream, "(");
    while (TRUE) {
      print_lispobj(car(objp));
      objp = cdr(objp);
      if (objp == nil_ptr)
        break;
      if (!(is_pair(objp))) {
        printf(" . ");
        print_lispobj(objp);
        break;
      }
      fprintf(out_stream, " ");
    }
    fprintf(out_stream, ")");
    break;
  case NO_FORM:
    fprintf(out_stream, "no form, boss");
    break;
  default:
    fprintf(out_stream, "dunno that form %d", form(objp));
  }
}
Exemplo n.º 20
0
int get_roman_int(const char *rom)
{
	int previous = 0;
	int total = 0;
	// Checking if i != 0 is faster than a lt/gt comparison, and we wanted
	// a reversed iteration anyway
	for (int i = strnlen(rom,MAX_STRLEN); i != 0; i--)
	{
		int conv = char_value(rom[i-1]);
		// If the previous reading was lesser, it's a newer, larger number to add
		// Else, it's a subtraction (e.g. IV == 5 - 1 == 4)
		total += ((previous <= conv) ? (conv) : (conv * -1));
		// Record the previous
		previous = conv;
	}
	return total;
}
Exemplo n.º 21
0
// ### char-name character => name
Value CL_char_name(Value arg)
{
    const char * s = NULL;
    BASE_CHAR c = char_value(arg);
    switch (c)
    {
    case 0:
        s = "Null";
        break;
    case 7:
        s = "Bell";
        break;
    case '\b':
        s = "Backspace";
        break;
    case '\t':
        s = "Tab";
        break;
    case '\n':
        s = "Newline";
        break;
    case '\f':
        s = "Page";
        break;
    case '\r':
        s = "Return";
        break;
    case ' ':
        s = "Space";
        break;
    case 127:
        s = "Rubout";
        break;
    }
    return s ? make_simple_string(s) : NIL;
}
Exemplo n.º 22
0
unsigned long int
strtoul(const char *nptr, char **endptr, int base)
{
	/*
	  Decompose input into threee parts:
	  - initial list of whitespace (as per isspace)
	  - subject sequence
	  - final string one or more unrecognized
	*/
	const char *ptr = nptr;
	bool negative = false;
	unsigned int value;
	long int return_value = 0;
	/* Remove spaces */
	while(*ptr != '\0') {
		if (! isspace(*ptr)) {
			break;
		}
		ptr++;
	}

	if (*ptr == '\0') 
		goto fail;

	/* check [+|-] */	
	if (*ptr == '+') {
		ptr++;
	} else if (*ptr == '-') {
		negative = true;
		ptr++;
	}

	if (*ptr == '\0') 
		goto fail;

	if (base == 16) {
		/* _May_ have 0x prefix */
		if (*ptr == '0') {
			ptr++;
		        if (*ptr == 'x' || *ptr == 'X') {
				ptr++;
			}
		}
	}

	/* [0(x|X)+] */
	if (base == 0) {
		/* Could be hex or octal or decimal */
		if (*ptr != '0') {
			base = 10;
		} else {
			ptr++;
			if (ptr == '\0')
				goto fail;
			if (*ptr == 'x' || *ptr == 'X') {
				base = 16;
				ptr++;
			} else {
				base = 8;
			}
		}
	}

	if (*ptr == '\0')
		goto fail;

	/* Ok, here we have a base, and we might have a valid number */
	value = char_value(*ptr);
	if (value >= base) {
		goto fail;
	} else {
		return_value = value;
		ptr++;
	}

	while (*ptr != '\0' && (value = char_value(*ptr)) < base) {
		return_value = return_value * base + value;
		ptr++;
	}

	if (endptr != NULL)
		*endptr = (char*) ptr;

	if (negative) {
		return_value *= -1;
	}

	return return_value;

	/*
	  if base is 0, then we work it out based on a couple
	  of things 
	*/
	/*
	  [+|-][0(x|X)+][0-9A-Za-z] not LL *
	*/

	/* endptr == final string */

 fail:
	if (endptr != NULL)
		*endptr = (char*) nptr;
	return 0;

}
Exemplo n.º 23
0
long_double_t
__strtold(char **endptr, int size, char *(*get_next_char)(const void**),
               void (*inc_next_char)(const void**), const void *func_data)
{
    char buf[50];
    unsigned int pos, mant_start, mant_end;
    char *s;

    int base = 10;
    int sign = 0;
    int exp = 0;
    int exp_sign = 0;

    int mant_size = 0;
    int has_point = 0;

    int possible_underflow = 0;

    buf[0] = '\0';
    pos = 0;
    mant_start = 0;
    mant_end = 0;

    long_double_t result = 0.0;
    long_double_t old_res;

    if (size <= 0) {
        size = 10000;
    }


    s = get_next_char(&func_data);
    if (s == NULL || *s == '\0') {
        goto fail;
    }
    /* Ignore blank spaces */
    while (isspace(*s)) {
        inc_next_char(&func_data);
        s = get_next_char(&func_data);
        if (s == NULL || *s == '\0') {
            goto fail;
        }
    }
    /* Check for sign */
    if (*s == '-') {
        sign = 1;
        inc_next_char(&func_data);
        if (--size <= 0) {
            goto end_ret;
        }
        s = get_next_char(&func_data);
    } else if (*s == '+') {
        sign = 0;
        inc_next_char(&func_data);
        if (--size <= 0) {
            goto end_ret;
        }
        s = get_next_char(&func_data);
    }

    if (s == NULL || *s == '\0') {
        goto fail;
    }

    if (*s == '0') {
        inc_next_char(&func_data);
        if (--size <= 0) {
            goto end_ret;
        }
        s = get_next_char(&func_data);
        if (s == NULL || *s == '\0') { /* input = "(+|-)0" = 0 */
            return 0;
        }
        if (*s == 'x' || *s == 'X') {
            base = 16;
            inc_next_char(&func_data);
            if (--size <= 0) {
                goto end_ret;
            }
            s = get_next_char(&func_data);
        }
    }

    mant_start = pos = 0;
    while (s && *s != '\0' && (isdigit(*s) || *s == '.')) {
        if (*s == '.') {
            if (has_point) {
                break;
            } else {
                has_point = 1;
            }
        } else {
            buf[pos] = *s;
            if (!has_point) {
                mant_size++;
            }
            pos++;
        }
        inc_next_char(&func_data);
        if (--size <= 0) {
            goto end_ret;
        }
        s = get_next_char(&func_data);
    }

    if (s && (*s == 'e' || *s == 'E' || *s == 'p' || *s == 'P')) {
        inc_next_char(&func_data);
        if (--size <= 0) {
            goto end_ret;
        }
        s = get_next_char(&func_data);
        if (s == NULL || *s == '\0') {
            goto end_ret;
        }
        if (*s == '+' || *s == '-') {
            if (*s == '-') {
                exp_sign = 1;
            } else {
                exp_sign = 0;
            }
            inc_next_char(&func_data);
            if (--size <= 0) {
                goto end_ret;
            }
            s = get_next_char(&func_data);
        }
        while (s && *s != '\0' && isdigit(*s)) {
            exp *= 10;
            exp += (*s - '0');
            inc_next_char(&func_data);
            if (--size <= 0) {
                goto end_ret;
            }
            s = get_next_char(&func_data);
        }
    }

    if(exp_sign && exp != 0) {
        possible_underflow = 1;
    }

end_ret:
    if (base == 10) {
        if (exp_sign) {
            exp = exp - (mant_size - 1);
        } else {
            exp = exp + (mant_size - 1);
        }
    } else if (base == 16) {
        if (exp_sign) {
            exp = exp - ((mant_size - 1) * 4);
        } else {
            exp = exp + ((mant_size - 1) * 4);
        }
    }

    if (exp < 0) {
        exp *= -1;
        if (exp_sign) {
            exp_sign = 0;
        } else {
            exp_sign = 1;
        }
    }

    mant_end = pos-1;
    if (base == 10) {
        pos = mant_start;
        for (; pos <= mant_end; pos++) {
            old_res = result;
            if (exp_sign) {
                result = result +
                    (long_double_t)((long_double_t)char_value(buf[pos]) /
                    (long_double_t)get_power_of_10(exp));
            } else {
                result = result +
                    (long_double_t)((long_double_t)char_value(buf[pos]) *
                    (long_double_t)get_power_of_10(exp));
            }
            if (exp_sign) {
                exp++;
            } else {
                exp--;
                if (exp < 0) {
                    exp *= -1;
                    if (exp_sign) {
                        exp_sign = 0;
                    } else {
                        exp_sign = 1;
                    }
                }
            }
            if (result != old_res && result == (result/2)) {
                errno = ERANGE;
                return result;
            }
        }
    } else if (base == 16) {
        pos = mant_start;
        for (; pos <= mant_end; pos++) {
            old_res = result;
            if (exp_sign) {
                result = result +
                    (long_double_t)((long_double_t)char_value(buf[pos]) /
                    (long_double_t)(1 << exp));
            } else {
                result = result +
                    (long_double_t)((long_double_t)(char_value(buf[pos]) *
                    (long_double_t)(1 << exp)));
            }
            if (exp_sign) {
                exp += 4;
            } else {
                exp -= 4;
                if (exp < 0) {
                    exp *= -1;
                    if (exp_sign) {
                        exp_sign = 0;
                    } else {
                        exp_sign = 1;
                    }
                }
            }
            if (result != old_res && result == (result/2)) {
                errno = ERANGE;
                return result;
            }
        }
    }

    if (possible_underflow && result == (result/2)) {
        errno = ERANGE;
    }

    return result;

fail:
    errno = EINVAL;
    return 0;
}
Exemplo n.º 24
0
// ### fasl-read-string stream character => value
Value SYS_fasl_read_string(Value streamarg, Value character)
{
  return stream_read_string(streamarg, char_value(character), FASL_READTABLE);
}
Exemplo n.º 25
0
// ### fasl-read-dispatch-char stream character => value
Value SYS_fasl_read_dispatch_char(Value streamarg, Value character)
{
  return stream_read_dispatch_char(streamarg, char_value(character), current_thread(), FASL_READTABLE);
}
Exemplo n.º 26
0
// ### two-arg-char<
Value SYS_two_arg_char_lt(Value arg1, Value arg2)
{
    return char_value(arg1) < char_value(arg2) ? T : NIL;
}
Exemplo n.º 27
0
// ### char-upcase
Value CL_char_upcase(Value arg)
{
    return make_character(toupper(char_value(arg)));
}
Exemplo n.º 28
0
// ### char-downcase
Value CL_char_downcase(Value arg)
{
    return make_character(tolower(char_value(arg)));
}
Exemplo n.º 29
0
// ### two-arg-char>=
Value SYS_two_arg_char_ge(Value arg1, Value arg2)
{
    return char_value(arg1) >= char_value(arg2) ? T : NIL;
}
Exemplo n.º 30
0
// ### char-int character => integer
Value CL_char_int(Value arg)
{
    return make_fixnum(char_value(arg));
}