static void primop_make_string(long argc) {
object s, o = sp[0];
long size = the_long(1,o);
if (size < 0 || size > MAX_STRING_SIZE)
error(sp[0],"too big of a size for a string");
s = make_string_of_size(size,argc!=2);
if (argc == 2) {
char *p = STRING_VALUE(s), fill;
TYPE_CHECK(CHARACTER_P(sp[1]),1,"character",sp[1]);
fill = CHARACTER_VALUE(sp[1]);
while (size--)
*p++ = fill;
*p = '\0';
}
sp += argc;
*--sp = s;
}
static void primop_list_to_string(long argc) {
object l = sp[0];
long i, max = 0;
object s;
char *p;
while (PAIR_P(l)) {
object c = CAR(l);
if (!CHARACTER_P(c))
error(sp[0],"list contains a non-character");
max++;
l = CDR(l);
}
if (!NULL_P(l))
error(sp[0],"not a proper list");
s = make_string_of_size(max,0);
p = STRING_VALUE(s);
l = sp[0];
for (i=0; i<max; i++) {
*p++ = CHARACTER_VALUE(CAR(l));
l = CDR(l);
}
*p = '\0';
*sp = s;
}
if (! (CHAR_TO_ASCII_P (object)))
error_bad_range_arg (n);
return (CHAR_TO_ASCII (object));
}
}
long
arg_ascii_integer (int n)
{
return (arg_index_integer (n, MAX_ASCII));
}
DEFINE_PRIMITIVE ("CHAR?", Prim_char_p, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (CHARACTER_P (ARG_REF (1))));
}
DEFINE_PRIMITIVE ("MAKE-CHAR", Prim_make_char, 2, 2, 0)
{
PRIMITIVE_HEADER (2);
PRIMITIVE_RETURN
(MAKE_CHAR ((arg_index_integer (2, MAX_BITS)),
(arg_index_integer (1, MAX_CODE))));
}
DEFINE_PRIMITIVE ("CHAR-BITS", Prim_char_bits, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
CHECK_ARG (1, CHARACTER_P);
PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (CHAR_BITS (ARG_REF (1))));
static void primop_character_p(long argc) {
if (!CHARACTER_P(*sp)) *sp = false_object;
}
