static void parse_char(char **pscan)
{
char rbuf[50];
char *rbufp = NULL;
if (**pscan == '\0'){
reg = make_char('\n');
current_state = stack_pop(&state_stack);
if (current_state == STATE_QUOTE){
reg = cons(reg, NIL);
reg = cons(make_symbol("quote"), reg);
current_state = stack_pop(&state_stack);
}
stack_push(&parser_stack, reg);
return;
}
rbufp = rbuf;
*rbufp++ = **pscan;
++*pscan;
if (is_delimiter(**pscan) || **pscan == '\0'){
reg = make_char(*rbuf);
current_state = stack_pop(&state_stack);
if (current_state == STATE_QUOTE){
reg = cons(reg, NIL);
reg = cons(make_symbol("quote"), reg);
current_state = stack_pop(&state_stack);
}
stack_push(&parser_stack, reg);
}else {
while (!is_delimiter(**pscan) && **pscan != '\0'){
*rbufp++ = **pscan;
++*pscan;
}
*rbufp = '\0';
if (strcmp(rbuf, "space") == 0){
reg = make_char(' ');
current_state = stack_pop(&state_stack);
if (current_state == STATE_QUOTE){
reg = cons(reg, NIL);
reg = cons(make_symbol("quote"), reg);
current_state = stack_pop(&state_stack);
}
stack_push(&parser_stack, reg);
}else if (strcmp(rbuf, "newline") == 0){
reg = make_char('\n');
current_state = stack_pop(&state_stack);
if (current_state == STATE_QUOTE){
reg = cons(reg, NIL);
reg = cons(make_symbol("quote"), reg);
current_state = stack_pop(&state_stack);
}
stack_push(&parser_stack, reg);
}else {
printf("Error: Bad character constant #\\%s -- READ", rbuf);
do_input_error(pscan);
}
}
}
CELL func_integer_to_char(CELL frame)
{
if (!(INTP(FV0) && GET_INT(FV0) >= 0 && GET_INT(FV0) <= 255)) {
return make_exception("expects an <integer> in [0,255]");
}
return make_char(GET_INT(FV0));
}
CELL func_string_to_list(CELL frame)
{
CELL string = FV0;
if (!STRINGP(string)) {
return make_exception("expects string");
}
CELL result = V_NULL;
CELL pre_tail = V_EMPTY;
gc_root_3("func_string_to_list", string, result, pre_tail);
const size_t len = GET_STRING(string)->len;
int i;
for(i = 0; i < len; ++i) {
const CELL next = make_cons(make_char(GET_STRING(string)->data[i]), V_NULL);
if (i == 0) {
result = next;
}
else {
CDR(pre_tail) = next;
}
pre_tail = next;
}
gc_unroot();
return result;
}
std::bitset<N>
bitset_ctor (std::bitset<N>*,
std::basic_string<charT, Traits, Allocator> *p,
const char *str, std::size_t pos, std::size_t n)
{
charT wstr [1024];
for (std::size_t i = 0; i != sizeof wstr / sizeof *wstr; ++i) {
if (str [i])
Traits::assign (wstr [i], make_char (str [i], (charT*)0));
else {
Traits::assign (wstr [i], charT ());
break;
}
}
typedef std::bitset<N> Bitset;
typedef std::basic_string<charT, Traits, Allocator> String;
if (p) { // use one of the const basic_string& overloads
const String bstr (wstr);
return bitset_ctor ((Bitset*)0, &bstr, 0, pos, n, (charT*)0);
}
else { // invoke one of the const charT* overloads
return bitset_ctor ((Bitset*)0, (String*)0, wstr, pos, n, (charT*)0);
}
}
CELL func_char_downcase(CELL frame)
{
if (!CHARP(FV0)) {
return make_exception("expects a <character> argument");
}
return make_char(tolower(GET_CHAR(FV0)));
}
cell pp_curs_mvinch(cell x) {
char name[] = "curs:mvinch";
if (!Running) return UNSPECIFIC;
return make_char((int) mvinch(integer_value(name, car(x)),
integer_value(name, cadr(x))));
}
static void shift_up(){
for(size_t i = 0 ; i < VGA_HEIGHT-1 ; i++ ){
for(size_t j = 0 ; j < VGA_WIDTH ; j++ ){
set(i,j,get(i+1,j));
}
}
for(size_t i = 0; i < VGA_WIDTH ; i++ ){
set(VGA_HEIGHT-1,i,make_char(' ',terminal_color));
}
}
LLVMValueRef gen_const(struct node *ast)
{
switch (ast->val[0]) {
case '\'':
return make_char(ast->val);
case '"':
return make_str(ast->val);
case '0':
/* TODO: Support 09 and 08: see section 4.1.4 */
return LLVMConstIntOfString(TYPE_INT, ast->val, 8);
default:
return LLVMConstIntOfString(TYPE_INT, ast->val, 10);
}
}
static Token *read_char(void) {
char c = getc(stdin);
if (c == EOF) goto err;
if (c == '\\') {
c = getc(stdin);
if (c == EOF) goto err;
}
char c2 = getc(stdin);
if (c2 == EOF) goto err;
if (c2 != '\'') error("Malformed char literal");
return make_char(c);
err:
error("Unterminated char");
}
CELL func_string_ref(CELL frame)
{
CELL string = FV0;
CELL k = FV1;
if (!STRINGP(string)) {
return make_exception("expects a string");
}
if (!INTP(k)) {
return make_exception("expects a non-negative integer index");
}
STRING *str = GET_STRING(string);
size_t kth = GET_INT(k);
if (! (kth >= 0 && kth < str->len) ) {
return make_exception("index %d out of range [0,%d]", kth, str->len - 1);
}
return make_char(str->data[kth]);
}
static obj_t string2list_fn(obj_t args, Reporter rep)
{
obj_t string, list = null_obj;
char *cs;
size_t n, i;
if (!args_match(rep, args, 1, is_string))
return unspecific;
string = list_ref(args, 0);
cs = fetch_string(string)->data;
n = fetch_string(string)->len;
for (i = 0; i < n; i++)
list = cons(make_char(cs[n-i-1]), list);
return list;
}
void terminal_putchar(char c){
if( c == '\n' ){
terminal_row++;
terminal_column = 0;
}else{
set(terminal_row,terminal_column,make_char(c,terminal_color));
terminal_column++;
}
if( terminal_column == VGA_WIDTH ){
terminal_row++;
terminal_column = 0;
}
if( terminal_row == VGA_HEIGHT ){
shift_up();
terminal_row = VGA_HEIGHT-1;
terminal_column = 0;
}
}
static obj_t string_ref_fn(obj_t args, Reporter rep)
{
obj_t obj, idx;
long k;
if (!args_match(rep, args, 2, is_string, is_num))
return unspecific;
obj = list_ref(args, 0);
idx = list_ref(args, 1);
k = fetch_num(idx);
if (k < 0 || (size_t)k >= fetch_string(obj)->len) {
reportf(rep, "string-ref: index %ld is out of range", k);
return unspecific;
}
return make_char(fetch_string(obj)->data[k]);
}
static struct console *
allocate_console (Lisp_Object type)
{
Lisp_Object console = ALLOC_NORMAL_LISP_OBJECT (console);
struct console *con = XCONSOLE (console);
struct gcpro gcpro1;
copy_lisp_object (console, Vconsole_defaults);
GCPRO1 (console);
con->conmeths = decode_console_type (type, ERROR_ME);
con->contype = get_console_variant (type);
con->command_builder = allocate_command_builder (console, 1);
con->function_key_map = Fmake_sparse_keymap (Qnil);
Fset_keymap_parents (con->function_key_map, Vfunction_key_map_parent);
set_quit_events (con, make_char (7)); /* C-g */
UNGCPRO;
return con;
}
char *make_define( letter_t i )
/*****************************/
{
static char define_string[2];
char c;
if( i == LETTER_NULLCHAR ) {
return( "00h" );
}
if( i == LETTER_DOLLAR ) {
return( "DOLLAR" );
}
if( i == LETTER_BACK_QUOTE ) {
return( "BACK_QUOTE" );
}
if( (c = make_char( i )) == CHAR_UNKNOWN )
return( "UNKNOWN" );
define_string[0] = c;
define_string[1] = '\0';
return( define_string );
}
static Token *read_char(void)
{
char c = getc(stdin);
if (c == EOF) {
goto err;
}
if (c == '\\') {
c = getc(stdin);
if (c == EOF) {
goto err;
}
}
char c2 = getc(stdin);
if (c2 == EOF) {
goto err;
}
if (c2 != '\'') {
error("Malformed char constant");
}
return make_char(c);
err:
error("Unterminated char");
}
void
test_is (charT*, const char *cname)
{
rw_info (0, 0, __LINE__, "UserCtype<%s>::is"
"(mask, char_type) const", cname);
//////////////////////////////////////////////////////////////////
// exercise default behavior
test_is ((charT*)0, cname, std::ctype_base::alnum, lower, n_lower);
test_is ((charT*)0, cname, std::ctype_base::alnum, upper, n_upper);
test_is ((charT*)0, cname, std::ctype_base::alnum, digits, n_digits);
test_is ((charT*)0, cname, std::ctype_base::alnum, xdigits, n_xdigits);
test_is ((charT*)0, cname, std::ctype_base::alpha, lower, n_lower);
test_is ((charT*)0, cname, std::ctype_base::alpha, upper, n_upper);
test_is ((charT*)0, cname, std::ctype_base::cntrl, cntrl, n_cntrl);
test_is ((charT*)0, cname, std::ctype_base::digit, digits, n_digits);
test_is ((charT*)0, cname, std::ctype_base::graph, graph, n_graph);
test_is ((charT*)0, cname, std::ctype_base::lower, lower, n_lower);
test_is ((charT*)0, cname, std::ctype_base::print, print, n_print);
test_is ((charT*)0, cname, std::ctype_base::punct, punct, n_punct);
test_is ((charT*)0, cname, std::ctype_base::space, spaces, n_spaces);
test_is ((charT*)0, cname, std::ctype_base::xdigit, xdigits, n_xdigits);
//////////////////////////////////////////////////////////////////
// exercise custom behavior
static const int chars[] = {
'0', '1', '2', '3', 'a', 'b', 'c',
0x100, 0x7fff, 0x8000, 0xffff,
#if 2 < _RWSTD_INT_SIZE
0x10000, 0x7fffffff, 0x80000000, 0xffffffff,
#else
0x1ff, 0x700, 0x8fff, 0xf000,
#endif
-1 // end of chars
};
static const int masks[] = {
/* '0' */ std::ctype_base::alpha,
/* '1' */ std::ctype_base::cntrl,
/* '2' */ std::ctype_base::digit,
/* '3' */ std::ctype_base::lower,
/* 'a' */ std::ctype_base::print,
/* 'b' */ std::ctype_base::punct,
/* 'c' */ std::ctype_base::space,
/* 0x100 */ std::ctype_base::upper,
/* 0x7fff */ std::ctype_base::xdigit,
/* 0x8000 */ std::ctype_base::alpha | std::ctype_base::cntrl,
/* 0xffff */ std::ctype_base::cntrl | std::ctype_base::digit,
/* 0x10000 */ std::ctype_base::digit | std::ctype_base::lower,
/* 0x7fffffff */ std::ctype_base::lower | std::ctype_base::print,
/* 0x80000000 */ std::ctype_base::print | std::ctype_base::punct,
/* 0xffffffff */ std::ctype_base::punct | std::ctype_base::space,
-1 // end of masks
};
static const int mask_all =
std::ctype_base::alpha
| std::ctype_base::cntrl
| std::ctype_base::digit
| std::ctype_base::lower
| std::ctype_base::print
| std::ctype_base::punct
| std::ctype_base::space
| std::ctype_base::upper
| std::ctype_base::xdigit;
const UserCtype<charT> cust (chars, masks);
for (std::size_t i = 0; 0 <= chars [i]; ++i) {
// FIXME: enable tests of characters greater than CHAR_MAX
if ( _RWSTD_UCHAR_MAX < std::size_t (chars [i])
/* && sizeof (char) == sizeof (charT) */) {
// when charT == char break out when the character
// value is greater than CHAR_MAX
break;
}
const charT ch = make_char (chars [i], (charT*)0);
const std::ctype_base::mask m_is =
std::ctype_base::mask (masks [i]);
rw_assert (cust.is (m_is, ch),
0, __LINE__,
"UserCtype<%s>::is(%{LC}, %{#lc}) == true",
cname, m_is, chars [i]);
const std::ctype_base::mask m_not =
std::ctype_base::mask (~m_is & mask_all);
rw_assert (!cust.is (m_not, ch), 0, __LINE__,
"UserCtype<%s>::is(%{LC}, %{#lc}) == false",
cname, m_not, chars [i]);
}
}
void test_find_first_not_of (charT, Traits*, Allocator*,
const StringFunc &func,
const StringTestCase &tcase)
{
typedef std::basic_string <charT, Traits, Allocator> String;
static const std::size_t BUFSIZE = 256;
static charT wstr_buf [BUFSIZE];
static charT warg_buf [BUFSIZE];
std::size_t str_len = sizeof wstr_buf / sizeof *wstr_buf;
std::size_t arg_len = sizeof warg_buf / sizeof *warg_buf;
charT* wstr = rw_expand (wstr_buf, tcase.str, tcase.str_len, &str_len);
charT* warg = rw_expand (warg_buf, tcase.arg, tcase.arg_len, &arg_len);
// construct the string object and the argument string
const String s_str (wstr, str_len);
const String s_arg (warg, arg_len);
if (wstr != wstr_buf)
delete[] wstr;
if (warg != warg_buf)
delete[] warg;
wstr = 0;
warg = 0;
// save the state of the string object before the call
// to detect wxception safety violations (changes to
// the state of the object after an exception)
const StringState str_state (rw_get_string_state (s_str));
const charT* const arg_ptr = tcase.arg ? s_arg.c_str () : s_str.c_str ();
const String& arg_str = tcase.arg ? s_arg : s_str;
const charT arg_val = make_char (char (tcase.val), (charT*)0);
std::size_t size = tcase.size >= 0 ? tcase.size : s_arg.max_size () + 1;
#ifndef _RWSTD_NO_EXCEPTIONS
// is some exception expected ?
const char* expected = 0;
if (1 == tcase.bthrow)
expected = exceptions [2];
const char* caught = 0;
#else // if defined (_RWSTD_NO_EXCEPTIONS)
if (tcase.bthrow)
return;
#endif // _RWSTD_NO_EXCEPTIONS
try {
std::size_t res = 0;
switch (func.which_) {
case FindFirstNotOf (cptr):
res = s_str.find_first_not_of (arg_ptr);
break;
case FindFirstNotOf (cstr):
res = s_str.find_first_not_of (arg_str);
break;
case FindFirstNotOf (cptr_size):
res = s_str.find_first_not_of (arg_ptr, tcase.off);
break;
case FindFirstNotOf (cptr_size_size):
res = s_str.find_first_not_of (arg_ptr, tcase.off, size);
break;
case FindFirstNotOf (cstr_size):
res = s_str.find_first_not_of (arg_str, tcase.off);
break;
case FindFirstNotOf (val):
res = s_str.find_first_not_of (arg_val);
break;
case FindFirstNotOf (val_size):
res = s_str.find_first_not_of (arg_val, tcase.off);
break;
default:
RW_ASSERT (!"logic error: unknown find_first_not_of overload");
return;
}
const std::size_t exp_res =
NPOS != tcase.nres ? tcase.nres : String::npos;
// verify the returned value
rw_assert (exp_res == res, 0, tcase.line,
"line %d. %{$FUNCALL} == %{?}%zu%{;}%{?}npos%{;}, "
"got %{?}%zu%{;}%{?}npos%{;}",
__LINE__, NPOS != tcase.nres, exp_res, NPOS == tcase.nres,
String::npos != res, res, String::npos == res);
}
#ifndef _RWSTD_NO_EXCEPTIONS
catch (const std::length_error &ex) {
caught = exceptions [2];
rw_assert (caught == expected, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught std::%s(%#s)",
__LINE__, 0 != expected, expected, caught, ex.what ());
}
catch (const std::exception &ex) {
caught = exceptions [4];
rw_assert (0, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught std::%s(%#s)",
__LINE__, 0 != expected, expected, caught, ex.what ());
}
catch (...) {
caught = exceptions [0];
rw_assert (0, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught %s",
__LINE__, 0 != expected, expected, caught);
}
#endif // _RWSTD_NO_EXCEPTIONS
if (caught) {
// verify that an exception thrown during allocation
// didn't cause a change in the state of the object
str_state.assert_equal (rw_get_string_state (s_str),
__LINE__, tcase.line, caught);
}
else if (-1 != tcase.bthrow) {
rw_assert (caught == expected, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s, caught %s"
"%{:}unexpectedly caught %s%{;}",
__LINE__, 0 != expected, expected, caught, caught);
}
}
void
test_is (charT*, const char *cname,
std::ctype_base::mask m,
const char *chars, std::size_t n_chars)
{
UserCtype<charT> ctp;
std::size_t n_calls = ctp.n_calls_ [ctp.mf_is];
std::size_t n_throws = ctp.n_throws_ [ctp.mf_is];
std::size_t expect_calls = 0;
std::size_t expect_throws = 0;
for (std::size_t i = 0; i != n_chars; ++i) {
const charT ch = make_char (chars [i], (charT*)0);
int result = -1;
#ifndef _RWSTD_NO_EXCEPTIONS
// let the first call call succeed and trigger an exception
// on the second call to UserCtype::is()
ctp.throw_at_calls_ [ctp.mf_is] =
ctp.n_calls_ [ctp.mf_is] + 2;
for (int j = 0; j != 2; ++j) {
if (1 < sizeof (charT)) {
// can only count UserCtype<charT>::is() calls when
// charT != char since there is no virtual do_is()
// in the char explicit specialization
++expect_calls;
}
else if (j) {
// cannot induce an exception out of UserCtype<char>::is()
// since there is no virtual do_is() in the specialization
break;
}
if (j)
++expect_throws;
int threw = 0;
try {
result = ctp.is (m, ch);
}
catch (...) {
threw = 1;
}
rw_assert (j == threw, 0, __LINE__,
"UserCtype<%s>::is(%{LC}, %{#c}) "
"%{?}unexpectedly threw%{:}failed to throw%{;}",
cname, m, ch, j == threw);
}
#else // if defined (_RWSTD_NO_EXCEPTIONS)
++expect_calls;
result = ctp.is (m, ch);
#endif // _RWSTD_NO_EXCEPTIONS
rw_assert (result, 0, __LINE__,
"UserCtype<%s>::is(%{LC}, %{#c}) == true",
cname, m, chars [i]);
}
n_calls = ctp.n_calls_ [ctp.mf_is] - n_calls;
rw_assert (expect_calls == n_calls, 0, __LINE__,
"expected %zu calls to UserCtype<%s>::is(%{LC}, char_type), "
"got %zu", expect_calls, cname, m, n_calls);
n_throws = ctp.n_throws_ [ctp.mf_is] - n_throws;
rw_assert (expect_throws == n_throws, 0, __LINE__,
"expected %zu exceptions thrown by UserCtype<%s>::is(%{LC}, "
"char_type), got %zu", expect_throws, cname, m, n_throws);
}
CharType do_decimal_point () const {
return -1 == dp_ ? Base::do_decimal_point ()
: make_char (char (dp_), (CharType*)0);
}
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object string_or_char,
Lisp_Object buffer)
{
struct buffer *buf = decode_buffer (buffer, 0);
retry:
if (CHAR_OR_CHAR_INTP (string_or_char))
{
Ichar c;
CHECK_CHAR_COERCE_INT (string_or_char);
c = XCHAR (string_or_char);
if (flag == CASE_DOWN)
{
c = DOWNCASE (buf, c);
}
else if (flag == CASE_UP)
{
c = UPCASE (buf, c);
}
else
{
c = CANONCASE (buf, c);
}
return make_char (c);
}
if (STRINGP (string_or_char))
{
Lisp_Object syntax_table = buf->mirror_syntax_table;
Ibyte *storage =
alloca_ibytes (XSTRING_LENGTH (string_or_char) * MAX_ICHAR_LEN);
Ibyte *newp = storage;
Ibyte *oldp = XSTRING_DATA (string_or_char);
Ibyte *endp = oldp + XSTRING_LENGTH (string_or_char);
int wordp = 0, wordp_prev;
while (oldp < endp)
{
Ichar c = itext_ichar (oldp);
switch (flag)
{
case CASE_UP:
c = UPCASE (buf, c);
break;
case CASE_DOWN:
c = DOWNCASE (buf, c);
break;
case CASE_CANONICALIZE:
c = CANONCASE (buf, c);
break;
case CASE_CAPITALIZE:
case CASE_CAPITALIZE_UP:
wordp_prev = wordp;
wordp = WORD_SYNTAX_P (syntax_table, c);
if (!wordp) break;
if (wordp_prev)
{
if (flag == CASE_CAPITALIZE)
c = DOWNCASE (buf, c);
}
else
c = UPCASE (buf, c);
break;
}
newp += set_itext_ichar (newp, c);
INC_IBYTEPTR (oldp);
}
return make_string (storage, newp - storage);
}
string_or_char = wrong_type_argument (Qchar_or_string_p, string_or_char);
goto retry;
}
void test_op_plus (charT, Traits*, Allocator*,
const StringFunc &func,
const StringTestCase &tcase)
{
typedef std::basic_string <charT, Traits, Allocator> String;
typedef typename UserTraits<charT>::MemFun UTMemFun;
static const std::size_t BUFSIZE = 256;
static charT wstr_buf [BUFSIZE];
static charT warg_buf [BUFSIZE];
std::size_t str_len = sizeof wstr_buf / sizeof *wstr_buf;
std::size_t arg_len = sizeof warg_buf / sizeof *warg_buf;
charT* wstr = rw_expand (wstr_buf, tcase.str, tcase.str_len, &str_len);
charT* warg = rw_expand (warg_buf, tcase.arg, tcase.arg_len, &arg_len);
static charT wres_buf [BUFSIZE];
std::size_t res_len = sizeof wres_buf / sizeof *wres_buf;
charT* wres = rw_expand (wres_buf, tcase.res, tcase.nres, &res_len);
// construct the string object to be modified
// and the (possibly unused) argument string
/* const */ String s_str (wstr, str_len);
const String s_arg (warg, arg_len);
if (wstr != wstr_buf)
delete[] wstr;
if (warg != warg_buf)
delete[] warg;
wstr = 0;
warg = 0;
String s_res;
// save the state of the string object before the call
// to detect wxception safety violations (changes to
// the state of the object after an exception)
const StringState str_state (rw_get_string_state (s_res));
const charT* const arg1_ptr = tcase.str ? s_str.c_str () : s_arg.c_str ();
const String& arg1_str = tcase.str ? s_str : s_arg;
const charT* const arg2_ptr = tcase.arg ? s_arg.c_str () : s_str.c_str ();
const String& arg2_str = tcase.arg ? s_arg : s_str;
const charT arg_val = make_char (char (tcase.val), (charT*)0);
std::size_t total_length_calls = 0;
std::size_t n_length_calls = 0;
std::size_t* const rg_calls = rw_get_call_counters ((Traits*)0, (charT*)0);
if (rg_calls)
total_length_calls = rg_calls [UTMemFun::length];
rwt_free_store* const pst = rwt_get_free_store (0);
SharedAlloc* const pal = SharedAlloc::instance ();
// iterate for`throw_after' starting at the next call to operator new,
// forcing each call to throw an exception, until the function finally
// succeeds (i.e, no exception is thrown)
std::size_t throw_count;
for (throw_count = 0; ; ++throw_count) {
// (name of) expected and caught exception
const char* expected = 0;
const char* caught = 0;
#ifndef _RWSTD_NO_EXCEPTIONS
if (0 == tcase.bthrow) {
// by default excercise the exception safety of the function
// by iteratively inducing an exception at each call to operator
// new or Allocator::allocate() until the call succeeds
expected = exceptions [3]; // bad_alloc
*pst->throw_at_calls_ [0] = pst->new_calls_ [0] + throw_count + 1;
pal->throw_at_calls_ [pal->m_allocate] =
pal->throw_at_calls_ [pal->m_allocate] + throw_count + 1;
}
else {
// exceptions disabled for this test case
}
#else // if defined (_RWSTD_NO_EXCEPTIONS)
if (tcase.bthrow) {
if (wres != wres_buf)
delete[] wres;
return;
}
#endif // _RWSTD_NO_EXCEPTIONS
// start checking for memory leaks
rw_check_leaks (s_res.get_allocator ());
try {
switch (func.which_) {
case OpPlus (cptr_cstr):
s_res = arg1_ptr + arg2_str;
if (rg_calls)
n_length_calls = rg_calls [UTMemFun::length];
break;
case OpPlus (cstr_cstr):
s_res = arg1_str + arg2_str;
break;
case OpPlus (cstr_cptr):
s_res = arg1_str + arg2_ptr;
if (rg_calls)
n_length_calls = rg_calls [UTMemFun::length];
break;
case OpPlus (cstr_val):
s_res = arg1_str + arg_val;
break;
case OpPlus (val_cstr):
s_res = arg_val + arg2_str;
break;
default:
RW_ASSERT ("test logic error: unknown operator+ overload");
return;
}
// verfiy that strings length are equal
rw_assert (res_len == s_res.size (), 0, tcase.line,
"line %d. %{$FUNCALL} expected %{#*s} "
"with length %zu, got %{/*.*Gs} with length %zu",
__LINE__, int (tcase.nres), tcase.res, res_len,
int (sizeof (charT)), int (s_res.size ()),
s_res.c_str (), s_res.size ());
if (res_len == s_res.size ()) {
// if the result length matches the expected length
// (and only then), also verify that the modified
// string matches the expected result
const std::size_t match =
rw_match (tcase.res, s_res.c_str(), s_res.size ());
rw_assert (match == res_len, 0, tcase.line,
"line %d. %{$FUNCALL} expected %{#*s}, "
"got %{/*.*Gs}, difference at offset %zu",
__LINE__, int (tcase.nres), tcase.res,
int (sizeof (charT)), int (s_res.size ()),
s_res.c_str (), match);
}
// verify that Traits::length was used
if ((OpPlus (cptr_cstr) == func.which_
|| OpPlus (cstr_cptr) == func.which_) && rg_calls) {
rw_assert (n_length_calls - total_length_calls > 0,
0, tcase.line, "line %d. %{$FUNCALL} doesn't "
"use traits::length()", __LINE__);
}
}
#ifndef _RWSTD_NO_EXCEPTIONS
catch (const std::bad_alloc &ex) {
caught = exceptions [3];
rw_assert (0 == tcase.bthrow, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught std::%s(%#s)",
__LINE__, 0 != expected, expected, caught, ex.what ());
}
catch (const std::exception &ex) {
caught = exceptions [4];
rw_assert (0, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught std::%s(%#s)",
__LINE__, 0 != expected, expected, caught, ex.what ());
}
catch (...) {
caught = exceptions [0];
rw_assert (0, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught %s",
__LINE__, 0 != expected, expected, caught);
}
#endif // _RWSTD_NO_EXCEPTIONS
// FIXME: verify the number of blocks the function call
// is expected to allocate and detect any memory leaks
rw_check_leaks (s_res.get_allocator (), tcase.line,
std::size_t (-1), std::size_t (-1));
if (caught) {
// verify that an exception thrown during allocation
// didn't cause a change in the state of the object
str_state.assert_equal (rw_get_string_state (s_res),
__LINE__, tcase.line, caught);
if (0 == tcase.bthrow) {
// allow this call to operator new to succeed and try
// to make the next one to fail during the next call
// to the same function again
continue;
}
}
else if (0 < tcase.bthrow) {
rw_assert (caught == expected, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s, caught %s"
"%{:}unexpectedly caught %s%{;}",
__LINE__, 0 != expected, expected, caught, caught);
}
break;
}
#ifndef _RWSTD_NO_REPLACEABLE_NEW_DELETE
// verify that if exceptions are enabled and when capacity changes
// at least one exception is thrown
const std::size_t expect_throws = str_state.capacity_ < s_res.capacity ();
#else // if defined (_RWSTD_NO_REPLACEABLE_NEW_DELETE)
const std::size_t expect_throws =
(StringIds::UserAlloc == func.alloc_id_)
? str_state.capacity_ < s_res.capacity () : 0;
#endif // _RWSTD_NO_REPLACEABLE_NEW_DELETE
// we may got no more 2 bad_allocs
rw_assert (expect_throws <= throw_count && throw_count <= 2, 0, tcase.line,
"line %d: %{$FUNCALL}: expected at least 1 %s exception "
"while changing capacity from %zu to %zu, got %zu",
__LINE__, exceptions [3],
str_state.capacity_, s_res.capacity (), throw_count);
// disable bad_alloc exceptions
*pst->throw_at_calls_ [0] = 0;
pal->throw_at_calls_ [pal->m_allocate] = 0;
if (wres != wres_buf)
delete[] wres;
}
SchObj read_sharp_sequence( SchPort* port ) {
unsigned int c = SCH_GETC(port);
char *s, *format;
char msg[256]; /* TODO hard code */
int size;
switch(c) {
case 't':
s = token(port);
if ( STRLEN(s) != 0 ) {
format="#t followed by garbage \"%s\"";
sprintf(msg,format,s);
EXCEPTION(msg);
break;
} else {
return SCH_TRUE;
}
case 'f':
s = token(port);
if ( STRLEN(s) != 0 ) {
format="#f followed by garbage \"%s\"";
sprintf(msg,format,s);
EXCEPTION(msg);
break;
} else {
return SCH_FALSE;
}
case '\\':
c = SCH_GETC(port);
size = get_char_size(c);
if ( size > 1 ) {
unsigned int c4 = (unsigned char)c;
while ( --size > 0 && (c = SCH_GETC(port)) ) {
c4 = ((c4 << 8) | (unsigned char)c);
}
return make_char(c4);
} else {
s = token(port);
if ( strlen(s) == 0 ) {
return make_char(c);
} else if (c == 's') {
if ( strcmp(s,"pace") == 0 ) { return make_char(' '); }
} else if (c == 'n') {
if ( strcmp(s,"ewline") == 0 ) { return make_char('\n'); }
} else if (c == 't') {
if ( strcmp(s,"ab") == 0 ) { return make_char('\t'); }
} else if (c == 'f') {
if ( strcmp(s,"ormfeed") == 0 ) { return make_char('\f'); }
} else if (c == 'r') {
if ( strcmp(s,"eturn") == 0 ) { return make_char('\r'); }
} else {
char msg[256];
char* format="unknown character #\\%c%s";
sprintf(msg,format,c,s);
EXCEPTION(msg);
}
}
break;
case '(': {
SchObj x, vec;
size = 0;
SchVecLList* lst = make_vec_llist();
while ( (x = read_obj(port)) != SCH_KOKKA ) {
vec_push(lst,x);
size++;
}
vec = (SchObj)make_vec_from_list(lst,size);
return vec;
}
case 'b':
s = token(port);
return read_number(s, 2);
case 'o':
s = token(port);
return read_number(s, 8);
case 'd':
s = token(port);
return read_number(s, 10);
case 'x':
s = token(port);
return read_number(s, 16);
default:
format = "unknown syntax #%c";
sprintf(msg,format,c);
EXCEPTION(msg);
}
return SCH_UNDEFINE;
}
CharType do_thousands_sep () const {
return -1 == ts_ ? Base::do_thousands_sep ()
: make_char (char (ts_), (CharType*)0);
}
void test_copy (charT, Traits*, Allocator*,
const StringFunc &func,
const StringTestCase &tcase)
{
typedef std::basic_string <charT, Traits, Allocator> String;
static const std::size_t BUFSIZE = 256;
static charT wstr_buf [BUFSIZE];
std::size_t str_len = sizeof wstr_buf / sizeof *wstr_buf;
charT* wstr = rw_expand (wstr_buf, tcase.str, tcase.str_len, &str_len);
static charT wres_buf [BUFSIZE];
std::size_t res_len = sizeof wres_buf / sizeof *wres_buf;
charT* wres = rw_expand (wres_buf, tcase.res, tcase.nres, &res_len);
// construct the string object
const String str (wstr, str_len);
if (wstr != wstr_buf)
delete[] wstr;
wstr = 0;
const std::size_t min_len =
str_len < std::size_t (tcase.size) ? str_len : tcase.size;
std::size_t res = 0;
// create destination array and initialize it with garbage
charT* const s_res = new charT [min_len + 2];
const char cgb [2] = "#";
const charT wcgb = make_char (cgb [0], (charT*)0);
Traits::assign (s_res, min_len + 1, wcgb);
s_res [min_len + 1] = charT ();
// save the state of the string object before the call
// to detect wxception safety violations (changes to
// the state of the object after an exception)
const StringState str_state (rw_get_string_state (str));
#ifndef _RWSTD_NO_EXCEPTIONS
// is some exception expected?
const char* const expected = tcase.bthrow ? exceptions [1] : 0;
const char* caught = 0;
#else // if defined (_RWSTD_NO_EXCEPTIONS)
if (tcase.bthrow) {
if (wres != wres_buf)
delete[] wres;
return;
}
#endif // _RWSTD_NO_EXCEPTIONS
try {
switch (func.which_) {
case Copy (ptr_size): {
res = str.copy (s_res, tcase.size);
break;
}
case Copy (ptr_size_size): {
res = str.copy (s_res, tcase.size, tcase.off);
break;
}
default:
RW_ASSERT (!"logic error: unknown copy overload");
return;
}
// verify the returned value
rw_assert (res == res_len, 0, tcase.line,
"line %d. %{$FUNCALL} == %zu, got %zu",
__LINE__, res_len, res);
if (res == res_len)
{
const std::size_t match = rw_match (tcase.res, s_res, res_len);
bool success = match == res_len;
rw_assert (success, 0, tcase.line,
"line %d. %{$FUNCALL} expected %{#*s}, "
"got %{/*.*Gs}, differ at pos %zu",
__LINE__, int (tcase.nres), tcase.res,
int (sizeof (charT)), int (res), s_res, match);
success = 1 == rw_match (cgb, s_res + min_len, 1);
rw_assert (success, 0, tcase.line,
"line %d. %{$FUNCALL} detected writing past the end of "
"the provided buffer", __LINE__);
}
}
#ifndef _RWSTD_NO_EXCEPTIONS
catch (const std::out_of_range &ex) {
caught = exceptions [1];
rw_assert (caught == expected, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught std::%s(%#s)",
__LINE__, 0 != expected, expected, caught, ex.what ());
}
catch (const std::exception &ex) {
caught = exceptions [4];
rw_assert (0, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught std::%s(%#s)",
__LINE__, 0 != expected, expected, caught, ex.what ());
}
catch (...) {
caught = exceptions [0];
rw_assert (0, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s,%{:}"
"unexpectedly%{;} caught %s",
__LINE__, 0 != expected, expected, caught);
}
if (caught) {
// verify that an exception thrown during allocation
// didn't cause a change in the state of the object
str_state.assert_equal (rw_get_string_state (str),
__LINE__, tcase.line, caught);
}
else if (-1 != tcase.bthrow) {
rw_assert (caught == expected, 0, tcase.line,
"line %d. %{$FUNCALL} %{?}expected %s, caught %s"
"%{:}unexpectedly caught %s%{;}",
__LINE__, 0 != expected, expected, caught, caught);
}
#endif // _RWSTD_NO_EXCEPTIONS
if (wres != wres_buf)
delete[] wres;
delete[] s_res;
}
static Lisp_Object
casify_object(enum case_action flag, Lisp_Object string_or_char,
Lisp_Object buffer)
{
struct buffer *buf = decode_buffer(buffer, 0);
retry:
if (CHAR_OR_CHAR_INTP(string_or_char)) {
Emchar c;
CHECK_CHAR_COERCE_INT(string_or_char);
c = XCHAR(string_or_char);
c = (flag == CASE_DOWN) ? DOWNCASE(buf, c) : UPCASE(buf, c);
return make_char(c);
}
if (STRINGP(string_or_char)) {
Lisp_Char_Table *syntax_table =
XCHAR_TABLE(buf->mirror_syntax_table);
Bufbyte *storage =
alloca_array(Bufbyte,
XSTRING_LENGTH(string_or_char) *
MAX_EMCHAR_LEN);
Bufbyte *newp = storage;
Bufbyte *oldp = XSTRING_DATA(string_or_char);
int wordp = 0, wordp_prev;
while (*oldp) {
Emchar c = charptr_emchar(oldp);
switch (flag) {
case CASE_UP:
c = UPCASE(buf, c);
break;
case CASE_DOWN:
c = DOWNCASE(buf, c);
break;
case CASE_CAPITALIZE:
case CASE_CAPITALIZE_UP:
wordp_prev = wordp;
wordp = WORD_SYNTAX_P(syntax_table, c);
if (!wordp)
break;
if (wordp_prev) {
if (flag == CASE_CAPITALIZE)
c = DOWNCASE(buf, c);
} else
c = UPCASE(buf, c);
break;
/* can't happen */
default:
/* abort()? */
break;
}
newp += set_charptr_emchar(newp, c);
INC_CHARPTR(oldp);
}
return make_string(storage, newp - storage);
}
string_or_char = wrong_type_argument(Qchar_or_string_p, string_or_char);
goto retry;
}
void dump_tiny( unsigned first_index, unsigned last_index )
/*********************************************************/
{
unsigned i;
int c;
letter_t letter;
int min_char;
int max_char;
unsigned ord;
min_char = INT_MAX;
max_char = 0;
for( letter = LETTER_MIN; letter <= LETTER_MAX; ++letter ) {
if( weights[letter] != 0 ) {
c = make_char( letter );
if( c < min_char ) {
min_char = c;
}
if( c > max_char ) {
max_char = c;
}
}
}
assert( min_char != INT_MAX );
outfile = fopen( get_gh_filename( "tiny" ), "w" );
dump_common_defs( first_index, last_index );
fprintf( outfile, "#define TINY_MIN_CHAR '%c'\n", min_char );
fprintf( outfile, "static unsigned char TINY_WEIGHTS[%u] = {\n",
(( max_char - min_char ) + 4 ) & ~3 );
for( c = min_char; c <= max_char; ++c ) {
letter = make_letter( (char)c );
fprintf( outfile, "%6u, /* '%c' */\n", weights[letter], c );
}
fputs( "};\n", outfile );
init_ordered();
fputs( "static char const * const TINY_IDS[] = {\n", outfile );
for( i = 1; i <= hashsize; ++i ) {
ord = ordered[i];
if( ord == 0 || ord > num_keywords ) {
dump_string( "" );
} else {
dump_string( tokens[ord] );
}
fputs( ",\n", outfile );
}
fputs( "};\n", outfile );
fputs( "#define TINY_DEFS \\\n", outfile );
extra = 0;
for( i = 1; i <= hashsize; ++i ) {
ord = ordered[i];
fputs( "TINY_DEF( ", outfile );
if( ord == 0 || ord > num_keywords ) {
dump_token_name( 0 );
} else {
dump_token_name( ord );
}
++extra;
fputs( " ) \\\n", outfile );
}
fputs( "/* TINY_DEFS */\n", outfile );
fclose( outfile );
}
static obj_t parse_atom(struct Parser *st)
{
struct token *t = next(st);
size_t i;
switch (t->type) {
case DOT:
reportlocf(st->rep, t->loc, "datum expected");
return unspecific;
case CPAREN:
reportlocf(st->rep, t->loc, "unmatched parenthesis");
return unspecific;
case END:
return unspecific;
case CHAR:
if (t->len == 2) {
reportlocf(st->rep, t->loc,
"end-of-input in character literal");
return unspecific;
} else if (t->len == 3) {
return make_char(t->text[2]);
} else {
/* Convert to lowercase */
for (i = 0; i < t->len; i++)
t->text[i] = tolower(t->text[i]);
if (atom_eq("#\\space", t->text, t->len)) {
/* Space character literal */
return make_char(' ');
} else if (atom_eq("#\\newline", t->text, t->len)) {
/* Newline character literal */
return make_char('\n');
} else {
reportlocf(st->rep, t->loc,
"illegal character literal");
return unspecific;
}
}
case ATOM:
/* Convert to lowercase */
for (i = 0; i < t->len; i++)
t->text[i] = tolower(t->text[i]);
if (atom_eq("#f", t->text, t->len)) {
/* False constant */
return false_obj;
} else if (atom_eq("#t", t->text, t->len)) {
/* True constant */
return true_obj;
} else if (is_number(t->text, t->len)) {
/* Copy to buffer to make null-terminated */
char *buf = GC_MALLOC_ATOMIC((t->len+1) * sizeof(char));
strncpy(buf, t->text, t->len);
buf[t->len] = 0;
/* Convert to number */
return make_num(atol(buf));
} else if (is_ident(t->text, t->len)) {
/* Symbol */
return make_symbol(intern_string(string_from(t->text, t->len)));
} else {
/* Invalid atom */
reportlocf(st->rep, t->loc, "unrecognized atom");
return unspecific;
}
case STRING:
return parse_string(st, t);
case OARRAY:
reportlocf(st->rep, t->loc, "array literals are not supported");
/* fallthrough: continue processing as lists */
case OPAREN:
return parse_list(st);
case QUOTE:
return parse_quotation(S_QUOTE, st);
case QUASIQUOTE:
return parse_quotation(S_QUASIQUOTE, st);
case UNQUOTE:
return parse_quotation(S_UNQUOTE, st);
case UNQUOTE_SPLICING:
return parse_quotation(S_UNQUOTE_SPLICING, st);
}
/* We should never get to here */
return unspecific;
}
void sort_frequency( void )
/*************************/
{
letter_t previous;
letter_t after_c;
letter_t c;
char prt_c;
bool change;
/* find the alphabetic character that occurs the most in the keywords */
most_used_character = LETTER_MIN;
for( c = LETTER_MIN; c <= LETTER_MAX; ++c ) {
if( c == LETTER__ )
continue;
if( freq[c] > freq[most_used_character] ) {
most_used_character = c;
}
}
/* make the next[] links into a ring */
for( c = LETTER_MIN; c < LETTER_MAX; ++c ) {
next[c] = c + 1;
}
next[LETTER_MAX] = LETTER_MIN;
/* sort the list of characters in descending order of frequency */
do {
change = false;
c = most_used_character;
for(;;) {
previous = c;
c = next[previous];
after_c = next[c];
if( after_c == most_used_character )
break;
if( freq[c] < freq[after_c] ) {
/* exchange 'c' and 'after_c' */
next[c] = next[after_c];
next[after_c] = c;
next[previous] = after_c;
change = true;
}
}
} while( change );
/* sort lists of equal frequency characters in ascending order */
do {
change = false;
c = most_used_character;
for(;;) {
previous = c;
c = next[previous];
after_c = next[c];
if( after_c == most_used_character )
break;
if( freq[c] == freq[after_c] ) {
if( c > after_c ) {
/* exchange 'c' and 'after_c' */
next[c] = next[after_c];
next[after_c] = c;
next[previous] = after_c;
change = true;
}
}
}
} while( change );
output( "frequency ordering of characters: " );
/* update the prev pointers to reflect the new ordering */
c = most_used_character;
do {
if( freq[c] != 0 ) {
prt_c = make_char( c );
if( isprint( prt_c ) ) {
output( "%c", prt_c );
} else {
output( "\\x%02x", prt_c );
}
}
after_c = next[c];
prev[after_c] = c;
c = after_c;
} while( c != most_used_character );
output( "\n" );
}
cell pp_curs_inch(cell x) {
if (!Running) return UNSPECIFIC;
return make_char(inch());
}