Commit fa937337 authored by jgarcia's avatar jgarcia

Some lisp functions with non-standard names (base-char-p, base-string) are...

Some lisp functions with non-standard names (base-char-p, base-string) are renamed and moved to the SYS package. socket.lsp fixed to understand base strings. limited support for arbitrary strings in string streams.
parent ff0be770
......@@ -178,11 +178,11 @@ weird stuff - see gethostbyname(3) for grisly details."
cl_object addr_list = Cnil;
int length = hostent->h_length;
funcall(3,#2,make_simple_string(hostent->h_name),#1);
funcall(3,#2,make_simple_base_string(hostent->h_name),#1);
funcall(3,#4,make_integer(hostent->h_addrtype),#1);
for (aliases = hostent->h_aliases; *aliases != NULL; aliases++) {
aliases_list = CONS(make_simple_string(*aliases),aliases_list);
aliases_list = CONS(make_simple_base_string(*aliases),aliases_list);
}
funcall(3,#3,aliases_list,#1);
......@@ -232,11 +232,11 @@ weird stuff - see gethostbyname(3) for grisly details."
cl_object addr_list = Cnil;
int length = hostent->h_length;
funcall(3,#2,make_simple_string(hostent->h_name),#1);
funcall(3,#2,make_simple_base_string(hostent->h_name),#1);
funcall(3,#4,make_integer(hostent->h_addrtype),#1);
for (aliases = hostent->h_aliases; *aliases != NULL; aliases++) {
aliases_list = CONS(make_simple_string(*aliases),aliases_list);
aliases_list = CONS(make_simple_base_string(*aliases),aliases_list);
}
funcall(3,#3,aliases_list,#1);
......@@ -422,6 +422,30 @@ SB-SYS:MAKE-FD-STREAM."))
(socket-error "close")))
(setf (slot-value socket 'file-descriptor) -1))))
(ffi::clines "
static void *
safe_buffer_pointer(cl_object x, cl_index size)
{
cl_type t = type_of(x);
int ok = 0;
if (t == t_base_string) {
ok = (size < x->base_string.dim);
} else if (t == t_vector) {
cl_elttype aet = x->vector.elttype;
if (aet == aet_b8 || aet == aet_i8 || aet == aet_bc) {
ok = (size < x->vector.dim);
} else if (aet == aet_fix || aet == aet_index) {
size /= sizeof(cl_index);
ok = (size < x->vector.dim);
}
}
if (!ok) {
FEerror(\"Lisp object is not a valid socket buffer: ~A\", 1, x);
}
return (void *)x->vector.self.ch;
}
")
;; FIXME: How bad is manipulating fillp directly?
(defmethod socket-receive ((socket socket) buffer length
&key oob peek waitall element-type)
......@@ -429,8 +453,6 @@ SB-SYS:MAKE-FD-STREAM."))
(let ((buffer (or buffer (make-array length :element-type element-type)))
(length (or length (length buffer)))
(fd (socket-file-descriptor socket)))
(assert (or (stringp buffer)
(typep buffer 'vector)))
(let ((len-recv
(c-inline (fd buffer length
oob peek waitall)
......@@ -443,12 +465,11 @@ SB-SYS:MAKE-FD-STREAM."))
( #5 ? MSG_WAITALL : 0 );
cl_type type = type_of(#1);
ssize_t len = recvfrom(#0,( type == t_vector ? #1->vector.self.ch :
( type == t_string ? #1->string.self : NULL )),
ssize_t len = recvfrom(#0, safe_buffer_pointer(#1, #2),
#2, flags, NULL,NULL);
if (len >= 0) {
if (type == t_vector) { #1->vector.fillp = len; }
else if (type == t_string) { #1->string.fillp = len; }
else if (type == t_string) { #1->base_string.fillp = len; }
}
@(return) = len;
}
......@@ -681,10 +702,9 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port,
fill_inet_sockaddr(&sockaddr, #3, #4, #5, #6, #7);
len = sendto(#0,( type == t_vector ? #1->vector.self.ch :
( type == t_string ? #1->string.self : NULL )),
#2, flags,(struct sockaddr*)&sockaddr,
sizeof(struct sockaddr_in));
len = sendto(#0, safe_buffer_pointer(#1,#2),
#2, flags,(struct sockaddr*)&sockaddr,
sizeof(struct sockaddr_in));
@(return) = len;
}
"
......@@ -704,9 +724,7 @@ static void fill_inet_sockaddr(struct sockaddr_in *sockaddr, int port,
( #8 ? MSG_CONFIRM : 0 );
cl_type type = type_of(#1);
ssize_t len = send(#0,( type == t_vector ? #1->vector.self.ch :
( type == t_string ? #1->string.self : NULL )),
#2, flags);
ssize_t len = send(#0, safe_buffer_pointer(#1,#2), #2, flags);
@(return) = len;
}
"
......@@ -760,7 +778,7 @@ also known as unix-domain sockets."))
int addr_len = sizeof(struct sockaddr_un);
int new_fd = accept(#0, &sockaddr, &addr_len);
@(return 0) = new_fd;
@(return 1) = (new_fd == -1) ? Cnil : make_string_copy(&sockaddr.sun_path);
@(return 1) = (new_fd == -1) ? Cnil : make_base_string_copy(&sockaddr.sun_path);
}")
(cond
((= fd -1)
......@@ -805,7 +823,7 @@ also known as unix-domain sockets."))
int ret = getpeername(#0,&name,&len);
if (ret == 0) {
@(return) = make_string_copy(&name.sun_path);
@(return) = make_base_string_copy(&name.sun_path);
} else {
@(return) = Cnil;
}
......@@ -1133,7 +1151,7 @@ also known as unix-domain sockets."))
(LPTSTR)&lpMsgBuf,
0,
NULL);
msg = make_string_copy(lpMsgBuf);
msg = make_base_string_copy(lpMsgBuf);
LocalFree(lpMsgBuf);
@(return) = msg;}"
:one-liner nil))
......
......@@ -664,9 +664,9 @@ si_bc_split(cl_object b)
if (type_of(b) != t_bytecodes)
@(return Cnil Cnil)
vector = cl_alloc_simple_vector(b->bytecodes.code_size, aet_b8);
vector = ecl_alloc_simple_vector(b->bytecodes.code_size, aet_b8);
vector->vector.self.b8 = (uint8_t*)b->bytecodes.code;
data = cl_alloc_simple_vector(b->bytecodes.data_size, aet_object);
data = ecl_alloc_simple_vector(b->bytecodes.data_size, aet_object);
data->vector.self.t = b->bytecodes.data;
@(return b->bytecodes.lex vector data)
}
......@@ -1643,11 +1643,8 @@ BEGIN:
strm = strm->stream.object1;
goto BEGIN;
case smm_string_output: {
cl_object strng = strm->stream.object0;
strng->base_string.self[strng->base_string.fillp] = '\0';
case smm_string_output:
break;
}
case smm_input:
#if defined(ECL_WSOCK)
case smm_input_wsock:
......@@ -2458,7 +2455,8 @@ cl_echo_stream_output_stream(cl_object strm)
@(defun make_string_input_stream (strng &o istart iend)
cl_index s, e;
@
assert_type_base_string(strng);
/* FIXME! We cannot read from extended strings*/
strng = si_coerce_to_base_string(strng);
if (Null(istart))
s = 0;
else if (!FIXNUMP(istart) || FIXNUM_MINUSP(istart))
......@@ -2686,7 +2684,7 @@ si_make_string_output_stream_from_string(cl_object s)
cl_object strm;
if (type_of(s) != t_base_string || !s->base_string.hasfillp)
FEerror("~S is not a string with a fill-pointer.", 1, s);
FEerror("~S is not a base-string with a fill-pointer.", 1, s);
strm = cl_alloc_object(t_stream);
strm->stream.mode = (short)smm_string_output;
strm->stream.closed = 0;
......
......@@ -108,7 +108,7 @@ cl_characterp(cl_object x)
#ifdef ECL_UNICODE
cl_object
cl_base_char_p(cl_object x)
si_base_char_p(cl_object x)
{
@(return (BASE_CHAR_P(x) ? Ct : Cnil))
}
......@@ -162,13 +162,9 @@ cl_simple_string_p(cl_object x)
#ifdef ECL_UNICODE
cl_object
cl_simple_base_string_p(cl_object x)
si_base_string_p(cl_object x)
{
cl_type t = type_of(x);
@(return (((t == t_base_string &&
!x->base_string.adjustable &&
!x->base_string.hasfillp &&
Null(CAR(x->base_string.displaced))) ? Ct : Cnil)))
@(return (type_of(x) == t_base_string))
}
#endif
......
......@@ -815,7 +815,7 @@ sharp_left_parenthesis_reader(cl_object in, cl_object c, cl_object d)
cl_list(2, @'quote', @'vector'), x));
}
} else if (fixed_size) {
v = cl_alloc_simple_vector(dim, aet_object);
v = ecl_alloc_simple_vector(dim, aet_object);
for (i = 0; i < dim; i++) {
if (in != OBJNULL) {
x = read_object_with_delimiter(in, ')');
......@@ -884,7 +884,7 @@ sharp_asterisk_reader(cl_object in, cl_object c, cl_object d)
} else {
dim = dimcount;
}
x = cl_alloc_simple_bitvector(dim);
x = ecl_alloc_simple_vector(dim, aet_bit);
for (i = 0; i < dim; i++) {
elt = (i < dimcount) ? cl_env.stack[sp+i] : last;
if (elt == MAKE_FIXNUM(0))
......
......@@ -22,13 +22,18 @@
I know the following name is not good.
*/
cl_object
cl_alloc_simple_vector(cl_index l, cl_elttype aet)
ecl_alloc_simple_vector(cl_index l, cl_elttype aet)
{
cl_object x;
if (aet == aet_bc)
switch (aet) {
case aet_bc:
return cl_alloc_simple_base_string(l);
if (aet == aet_bit) {
#ifdef ECL_UNICODE
case aet_ch:
return cl_alloc_simple_extended_string(l);
#endif
case aet_bit:
x = cl_alloc_object(t_bitvector);
x->vector.hasfillp = FALSE;
x->vector.adjustable = FALSE;
......@@ -36,7 +41,8 @@ cl_alloc_simple_vector(cl_index l, cl_elttype aet)
x->vector.dim = x->vector.fillp = l;
x->vector.offset = 0;
x->vector.self.bit = NULL;
} else {
break;
default:
x = cl_alloc_object(t_vector);
x->vector.hasfillp = FALSE;
x->vector.adjustable = FALSE;
......@@ -199,7 +205,7 @@ E:
e = sequence->vector.fillp;
else if (e < s || e > sequence->vector.fillp)
goto ILLEGAL_START_END;
x = cl_alloc_simple_vector(e - s, array_elttype(sequence));
x = ecl_alloc_simple_vector(e - s, array_elttype(sequence));
ecl_copy_subarray(x, 0, sequence, s, e-s);
@(return x)
......@@ -279,7 +285,7 @@ cl_reverse(cl_object seq)
case t_vector:
case t_bitvector:
case t_base_string:
output = cl_alloc_simple_vector(seq->vector.fillp, array_elttype(seq));
output = ecl_alloc_simple_vector(seq->vector.fillp, array_elttype(seq));
ecl_copy_subarray(output, 0, seq, 0, seq->vector.fillp);
ecl_reverse_subarray(output, 0, seq->vector.fillp);
break;
......
......@@ -336,7 +336,7 @@ cl_string(cl_object x)
#ifdef ECL_UNICODE
cl_object
cl_base_string(cl_object x)
si_coerce_to_base_string(cl_object x)
{
cl_object y;
......@@ -368,7 +368,7 @@ cl_base_string(cl_object x)
#ifdef ECL_UNICODE
cl_object
cl_extended_string(cl_object x)
si_coerce_to_extended_string(cl_object x)
{
cl_object y;
......@@ -1401,7 +1401,7 @@ nstring_case(cl_narg narg, int (*casefun)(int, bool *), cl_va_list ARGS)
#endif
/* FIXME! We should use cl_va_start() instead of this ugly trick */
for (i = 0, l = 0; i < narg; i++) {
strings[i] = cl_base_string(cl_va_arg(args));
strings[i] = si_coerce_to_base_string(cl_va_arg(args));
l += strings[i]->base_string.fillp;
}
v = cl_alloc_simple_base_string(l);
......@@ -1430,7 +1430,7 @@ nstring_case(cl_narg narg, int (*casefun)(int, bool *), cl_va_list ARGS)
#endif
/* FIXME! We should use cl_va_start() instead of this ugly trick */
for (i = 0, l = 0; i < narg; i++) {
strings[i] = cl_extended_string(cl_va_arg(args));
strings[i] = si_coerce_to_extended_string(cl_va_arg(args));
l += strings[i]->string.fillp;
}
v = cl_alloc_simple_extended_string(l);
......
......@@ -156,12 +156,7 @@ cl_symbols[] = {
{"ATANH", CL_ORDINARY, ECL_NAME(cl_atanh), -1, OBJNULL},
{"ATOM", CL_ORDINARY, cl_atom, 1, OBJNULL},
{"BASE-CHAR", CL_ORDINARY, NULL, -1, OBJNULL},
{"BASE-CHAR-P", CL_ORDINARY, cl_base_char_p, 1, OBJNULL},
#ifdef ECL_UNICODE
{"BASE-STRING", CL_ORDINARY, cl_base_string, 1, OBJNULL},
#else
{"BASE-STRING", CL_ORDINARY, NULL, -1, OBJNULL},
#endif
{"BIGNUM", CL_ORDINARY, NULL, -1, OBJNULL},
{"BIT", CL_ORDINARY, ECL_NAME(cl_bit), -1, OBJNULL},
{"BIT-AND", CL_ORDINARY, ECL_NAME(cl_bit_and), -1, OBJNULL},
......@@ -805,9 +800,6 @@ cl_symbols[] = {
{"SIGNUM", CL_ORDINARY, ECL_NAME(cl_signum), -1, OBJNULL},
{"SIMPLE-ARRAY", CL_ORDINARY, NULL, -1, OBJNULL},
{"SIMPLE-BASE-STRING", CL_ORDINARY, NULL, -1, OBJNULL},
#ifdef ECL_UNICODE
{"SIMPLE-BASE-STRING-P", CL_ORDINARY, cl_simple_base_string_p, 1, OBJNULL},
#endif
{"SIMPLE-BIT-VECTOR", CL_ORDINARY, NULL, -1, OBJNULL},
{"SIMPLE-BIT-VECTOR-P", CL_ORDINARY, cl_simple_bit_vector_p, 1, OBJNULL},
{"SIMPLE-CONDITION", CL_ORDINARY, NULL, -1, OBJNULL},
......@@ -1072,6 +1064,8 @@ cl_symbols[] = {
{SYS_ "ARGC", SI_ORDINARY, si_argc, 0, OBJNULL},
{SYS_ "ARGV", SI_ORDINARY, si_argv, 1, OBJNULL},
{SYS_ "ASET", SI_ORDINARY, si_aset, -1, OBJNULL},
{SYS_ "BASE-CHAR-P", SI_ORDINARY, si_base_char_p, 1, OBJNULL},
{SYS_ "BASE-STRING-P", SI_ORDINARY, si_base_string_p, 1, OBJNULL},
{SYS_ "BC-DISASSEMBLE", SI_ORDINARY, si_bc_disassemble, 1, OBJNULL},
{SYS_ "BC-SPLIT", SI_ORDINARY, si_bc_split, 1, OBJNULL},
{SYS_ "BDS-TOP", SI_ORDINARY, si_bds_top, 0, OBJNULL},
......@@ -1083,6 +1077,8 @@ cl_symbols[] = {
{SYS_ "CHDIR", SI_ORDINARY, si_chdir, -1, OBJNULL},
{SYS_ "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY, cl_identity, 1, OBJNULL},
{SYS_ "CLOSE-PIPE", SI_ORDINARY, si_close_pipe, 1, OBJNULL},
{SYS_ "COERCE-TO-BASE-STRING", SI_ORDINARY, si_coerce_to_base_string, 1, OBJNULL},
{SYS_ "COERCE-TO-EXTENDED-STRING", SI_ORDINARY, si_coerce_to_extended_string, 1, OBJNULL},
{SYS_ "COERCE-TO-FILENAME", SI_ORDINARY, si_coerce_to_filename, 1, OBJNULL},
{SYS_ "COERCE-TO-FUNCTION", SI_ORDINARY, si_coerce_to_function, 1, OBJNULL},
{SYS_ "COERCE-TO-PACKAGE", SI_ORDINARY, si_coerce_to_package, 1, OBJNULL},
......
......@@ -156,12 +156,7 @@ cl_symbols[] = {
{"ATANH","ECL_NAME(cl_atanh)"},
{"ATOM","cl_atom"},
{"BASE-CHAR",NULL},
{"BASE-CHAR-P","cl_base_char_p"},
#ifdef ECL_UNICODE
{"BASE-STRING","cl_base_string"},
#else
{"BASE-STRING",NULL},
#endif
{"BIGNUM",NULL},
{"BIT","ECL_NAME(cl_bit)"},
{"BIT-AND","ECL_NAME(cl_bit_and)"},
......@@ -805,9 +800,6 @@ cl_symbols[] = {
{"SIGNUM","ECL_NAME(cl_signum)"},
{"SIMPLE-ARRAY",NULL},
{"SIMPLE-BASE-STRING",NULL},
#ifdef ECL_UNICODE
{"SIMPLE-BASE-STRING-P","cl_simple_base_string_p"},
#endif
{"SIMPLE-BIT-VECTOR",NULL},
{"SIMPLE-BIT-VECTOR-P","cl_simple_bit_vector_p"},
{"SIMPLE-CONDITION",NULL},
......@@ -1072,6 +1064,8 @@ cl_symbols[] = {
{SYS_ "ARGC","si_argc"},
{SYS_ "ARGV","si_argv"},
{SYS_ "ASET","si_aset"},
{SYS_ "BASE-CHAR-P","si_base_char_p"},
{SYS_ "BASE-STRING-P","si_base_string_p"},
{SYS_ "BC-DISASSEMBLE","si_bc_disassemble"},
{SYS_ "BC-SPLIT","si_bc_split"},
{SYS_ "BDS-TOP","si_bds_top"},
......@@ -1083,6 +1077,8 @@ cl_symbols[] = {
{SYS_ "CHDIR","si_chdir"},
{SYS_ "CLEAR-COMPILER-PROPERTIES","cl_identity"},
{SYS_ "CLOSE-PIPE","si_close_pipe"},
{SYS_ "COERCE-TO-BASE-STRING","si_coerce_to_base_string"},
{SYS_ "COERCE-TO-EXTENDED-STRING","si_coerce_to_extended_string"},
{SYS_ "COERCE-TO-FILENAME","si_coerce_to_filename"},
{SYS_ "COERCE-TO-FUNCTION","si_coerce_to_function"},
{SYS_ "COERCE-TO-PACKAGE","si_coerce_to_package"},
......
......@@ -209,7 +209,7 @@
((:char :unsigned-char)
(wt "CODE_CHAR(" loc ")"))
((:cstring)
(wt "ecl_cstring_to_string_or_nil(" loc ")"))
(wt "ecl_cstring_to_base_string_or_nil(" loc ")"))
((:pointer-void)
(wt "ecl_make_foreign_data(Cnil, 0, " loc ")"))
(otherwise
......
This diff is collapsed.
......@@ -155,6 +155,11 @@ AC_ARG_WITH(rt,
[(default=YES)]),
[], [with_rt=${enable_shared}])
AC_ARG_ENABLE(unicode,
AS_HELP_STRING( [--enable-unicode],
[enable support for unicode (default=NO)]),
[], [enable_unicode=no])
dnl -----------------------------------------------------------------------
dnl Installation directories
libdir="${libdir}/ecl"
......@@ -475,6 +480,10 @@ if test "${with_rt}" = "yes"; then
ECL_ADD_LISP_MODULE([rt])
fi
if test "${enable_unicode}" = "yes"; then
AC_DEFINE(ECL_UNICODE, [1], [Support for Unicode])
fi
dnl ----------------------------------------------------------------------
dnl Configure included Boehm GC if needed
AC_SUBST(ECL_BOEHM_GC_HEADER)
......
......@@ -19,9 +19,6 @@
/* Always use CLOS */
#define CLOS
/* put this into configure where it belongs */
#define ECL_UNICODE
/* Use Boehm's garbage collector */
#undef GBC_BOEHM
#ifdef GBC_BOEHM
......@@ -53,6 +50,9 @@
/* Foreign functions interface */
#undef ECL_FFI
/* Support for Unicode strings */
#undef ECL_UNICODE
/*
* C TYPES AND SYSTEM LIMITS
*/
......@@ -75,7 +75,11 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey;
/*
* The character type
*/
#define CHAR_CODE_LIMIT 256
#ifdef ECL_UNICODE
#define CHAR_CODE_LIMIT 1114111 /* unicode character code limit */
#else
#define CHAR_CODE_LIMIT 256 /* unicode character code limit */
#endif
/*
* Array limits
......
......@@ -1073,7 +1073,6 @@ extern cl_object cl_null(cl_object x);
#define cl_not cl_null
extern cl_object cl_symbolp(cl_object x);
extern cl_object cl_atom(cl_object x);
extern cl_object cl_base_char_p(cl_object x);
extern cl_object cl_consp(cl_object x);
extern cl_object cl_listp(cl_object x);
extern cl_object cl_numberp(cl_object x);
......@@ -1087,9 +1086,6 @@ extern cl_object cl_stringp(cl_object x);
extern cl_object cl_bit_vector_p(cl_object x);
extern cl_object cl_vectorp(cl_object x);
extern cl_object cl_simple_string_p(cl_object x);
#ifdef ECL_UNICODE
extern cl_object cl_simple_base_string_p(cl_object x);
#endif
extern cl_object cl_simple_bit_vector_p(cl_object x);
extern cl_object cl_simple_vector_p(cl_object x);
extern cl_object cl_arrayp(cl_object x);
......@@ -1209,8 +1205,7 @@ extern cl_object cl_reverse(cl_object x);
extern cl_object cl_nreverse(cl_object x);
extern cl_object cl_subseq _ARGS((cl_narg narg, cl_object sequence, cl_object start, ...));
extern cl_object cl_alloc_simple_vector(cl_index l, cl_elttype aet);
#define cl_alloc_simple_bitvector(l) cl_alloc_simple_vector((l), aet_bit)
extern cl_object ecl_alloc_simple_vector(cl_index l, cl_elttype aet);
extern cl_object elt(cl_object seq, cl_fixnum index);
extern cl_object elt_set(cl_object seq, cl_fixnum index, cl_object val);
extern cl_fixnum length(cl_object x);
......@@ -1250,10 +1245,6 @@ extern cl_object cl_string_trim(cl_object char_bag, cl_object strng);
extern cl_object cl_string_left_trim(cl_object char_bag, cl_object strng);
extern cl_object cl_string_right_trim(cl_object char_bag, cl_object strng);
extern cl_object cl_string(cl_object x);
#ifdef ECL_UNICODE
extern cl_object cl_base_string(cl_object x);
extern cl_object cl_extended_string(cl_object x);
#endif
extern cl_object cl_make_string _ARGS((cl_narg narg, cl_object size, ...));
extern cl_object cl_stringE _ARGS((cl_narg narg, cl_object string1, cl_object string2, ...));
extern cl_object cl_string_equal _ARGS((cl_narg narg, cl_object string1, cl_object string2, ...));
......@@ -1274,14 +1265,8 @@ extern cl_object cl_nstring_upcase _ARGS((cl_narg narg, ...));
extern cl_object cl_nstring_downcase _ARGS((cl_narg narg, ...));
extern cl_object cl_nstring_capitalize _ARGS((cl_narg narg, ...));
extern cl_object si_base_string_concatenate _ARGS((cl_narg narg, ...));
#ifdef ECL_UNICODE
extern cl_object si_extended_string_concatenate _ARGS((cl_narg narg, ...));
#endif
extern cl_object cl_alloc_simple_base_string(cl_index l);
#ifdef ECL_UNICODE
extern cl_object cl_alloc_simple_extended_string(cl_index l);
#endif
extern cl_object cl_alloc_adjustable_base_string(cl_index l);
extern cl_object make_simple_base_string(char *s);
#define make_constant_base_string(s) (make_simple_base_string((char *)s))
......@@ -1290,9 +1275,6 @@ extern cl_object ecl_cstring_to_base_string_or_nil(const char *s);
extern cl_object copy_simple_base_string(cl_object x);
extern cl_object coerce_to_simple_string(cl_object x);
extern cl_object coerce_to_simple_base_string(cl_object x);
#ifdef ECL_UNICODE
extern cl_object coerce_to_simple_extended_string(cl_object x);
#endif
extern bool string_eq(cl_object x, cl_object y);
extern bool string_equal(cl_object x, cl_object y);
extern bool member_char(int c, cl_object char_bag);
......@@ -1466,6 +1448,25 @@ extern cl_object si_open_pipe(cl_object cmd);
extern cl_object si_close_pipe(cl_object stream);
extern cl_object si_run_program _ARGS((cl_narg narg, cl_object command, cl_object args, ...));
/* unicode -- no particular file, but we group these changes here */
#ifdef ECL_UNICODE
extern cl_object si_base_char_p(cl_object x);
extern cl_object si_base_string_p(cl_object x);
extern cl_object si_coerce_to_base_string(cl_object x);
extern cl_object si_coerce_to_extended_string(cl_object x);
extern cl_object si_extended_string_concatenate _ARGS((cl_narg narg, ...));
extern cl_object cl_alloc_simple_extended_string(cl_index l);
extern cl_object coerce_to_simple_extended_string(cl_object x);
#else
#define si_base_char_p cl_characterp
#define si_base_string_p cl_stringp
#define si_coerce_to_base_string cl_string
#define si_coerce_to_extended_string cl_string
#endif
/**********************************************************************
* FUNCTIONS GENERATED BY THE LISP COMPILER
*/
......
......@@ -25,12 +25,6 @@ extern "C" {
#define TRUE 1 /* boolean true value */
#define FALSE 0 /* boolean false value */
#ifdef ECL_UNICODE
#define CHAR_CODE_LIMIT 1114111 /* unicode character code limit */
#else
#define CHAR_CODE_LIMIT 256 /* unicode character code limit */
#endif
#if !defined(__cplusplus) && !defined(bool)
typedef int bool;
#endif
......
......@@ -358,8 +358,8 @@ Returns T if X belongs to TYPE; NIL otherwise."
(or (null i) (match-dimensions object i))))
#+unicode
(SIMPLE-BASE-STRING
(and (simple-base-string-p object)
(typep (array-element-type object) 'base-char)
(and (simple-string-p object)
(base-string-p object)
(or (null i) (match-dimensions object i))))
(SIMPLE-BIT-VECTOR
(and (simple-bit-vector-p object)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment