Back to index

plt-scheme  4.2.1
Classes | Defines | Typedefs | Functions | Variables
string.c File Reference
#include "schpriv.h"
#include "schvers.h"
#include <string.h>
#include <ctype.h>
#include <locale.h>
#include <iconv.h>
#include <langinfo.h>
#include <wchar.h>
#include <wctype.h>
#include <errno.h>
#include "schsys.h"
#include "schustr.inc"
#include "strops.inc"

Go to the source code of this file.

Classes

struct  Scheme_Converter

Defines

#define ICONV_errno   errno
#define iconv_ready   1
#define mzCHK_PROC(x)   1
#define mzLOCALE_IS_UTF_8(s)   !mzCHK_PROC(iconv_open)
#define mzICONV_KIND   0
#define mzUTF8_KIND   1
#define mzUTF8_TO_UTF16_KIND   2
#define mzUTF16_TO_UTF8_KIND   3
#define portable_isspace(x)   (((x) < 128) && isspace(x))
#define MZ3M_SUBDIR   ":3m"
#define SCHEME_X_STR_VAL(x)   SCHEME_CHAR_STR_VAL(x)
#define SCHEME_X_STRTAG_VAL(x)   SCHEME_CHAR_STRTAG_VAL(x)
#define SCHEME_X_STRINGP(x)   SCHEME_CHAR_STRINGP(x)
#define SCHEME_MUTABLE_X_STRINGP(x)   SCHEME_MUTABLE_CHAR_STRINGP(x)
#define SCHEME_SET_X_STRING_IMMUTABLE(x)   SCHEME_SET_CHAR_STRING_IMMUTABLE(x)
#define scheme_x_string_type   scheme_char_string_type
#define X(a, b)   a##_char##b
#define X_(a, b)   a##_##b
#define X__(a)   a
#define EMPTY   (mzchar *)"\0\0\0"
#define Xchar   mzchar
#define uXchar   mzchar
#define XSTR   ""
#define XSTRINGSTR   "string"
#define SUBXSTR   "substring"
#define CHARP(x)   SCHEME_CHARP(x)
#define CHAR_VAL(x)   SCHEME_CHAR_VAL(x)
#define CHAR_STR   "character"
#define MAKE_CHAR(x)   _scheme_make_char(x)
#define xstrlen   scheme_char_strlen
#define GEN_STRING_COMP(name, scheme_name, comp, op, ul, size_shortcut)
#define SCHEME_BYTEP(x)   ((SCHEME_INTP(x)) && (SCHEME_INT_VAL(x) >= 0) && (SCHEME_INT_VAL(x) <= 255))
#define BYTE_STR   "exact integer in [0,255]"
#define SCHEME_X_STR_VAL(x)   SCHEME_BYTE_STR_VAL(x)
#define SCHEME_X_STRTAG_VAL(x)   SCHEME_BYTE_STRTAG_VAL(x)
#define SCHEME_X_STRINGP(x)   SCHEME_BYTE_STRINGP(x)
#define SCHEME_MUTABLE_X_STRINGP(x)   SCHEME_MUTABLE_BYTE_STRINGP(x)
#define SCHEME_SET_X_STRING_IMMUTABLE(x)   SCHEME_SET_BYTE_STRING_IMMUTABLE(x)
#define scheme_x_string_type   scheme_byte_string_type
#define X(a, b)   a##_byte##b
#define X_(a, b)   a##_byte_##b
#define X__(a)   byte_##a
#define EMPTY   ""
#define Xchar   char
#define uXchar   unsigned char
#define XSTR   "byte "
#define XSTRINGSTR   "bytes"
#define SUBXSTR   "subbytes"
#define CHARP(x)   SCHEME_BYTEP(x)
#define CHAR_VAL(x)   SCHEME_INT_VAL(x)
#define CHAR_STR   BYTE_STR
#define MAKE_CHAR(x)   scheme_make_integer_value(x)
#define xstrlen   strlen
#define GEN_BYTE_STRING_COMP(name, scheme_name, comp, op)
#define VERSION_SUFFIX   " [cgc]"
#define mzGETENV   getenv
#define mzPUTENV(var, val, s)   MSC_IZE(putenv)(s)
#define ICONV_ARG_CAST   /* empty */
#define MZ_SC_BUF_SIZE   32
#define MZ_WC_BUF_SIZE   32
#define mz_mbsnrtowcs(t, f, fl, tl, s)   mbsrtowcs(t, f, tl, s)
#define mz_wcsnrtombs(t, f, fl, tl, s)   wcsrtombs(t, f, tl, s)
#define MZ_JAMO_INITIAL_CONSONANT_START   0x1100
#define MZ_JAMO_INITIAL_CONSONANT_COUNT   19
#define MZ_JAMO_INITIAL_CONSONANT_END   (MZ_JAMO_INITIAL_CONSONANT_START + MZ_JAMO_INITIAL_CONSONANT_COUNT - 1)
#define MZ_JAMO_VOWEL_START   0x1161
#define MZ_JAMO_VOWEL_COUNT   21
#define MZ_JAMO_VOWEL_END   (MZ_JAMO_VOWEL_START + MZ_JAMO_VOWEL_COUNT - 1)
#define MZ_JAMO_TRAILING_CONSONANT_START   0x11A7
#define MZ_JAMO_TRAILING_CONSONANT_COUNT   28
#define MZ_JAMO_TRAILING_CONSONANT_END   (MZ_JAMO_TRAILING_CONSONANT_START + MZ_JAMO_TRAILING_CONSONANT_COUNT - 1)
#define MZ_JAMO_SYLLABLE_START   0xAC00
#define MZ_JAMO_SYLLABLE_END   (MZ_JAMO_SYLLABLE_START + 11171)
#define ENCFAIL   i = oki; failmode = -2; break
#define UNPAIRED_MASK   0xF800

Typedefs

typedef struct Scheme_Converter Scheme_Converter
typedef int(* strcoll_proc )(char *s1, int d1, int l1, char *s2, int d2, int l2, int cvt_case)
typedef mzchar *(* recase_proc )(int to_up, mzchar *in, int delta, int len, long *olen)

Functions

static void init_iconv ()
static void reset_locale (void)
static char * mz_iconv_nl_langinfo ()
static Scheme_Objectmake_string (int argc, Scheme_Object *argv[])
static Scheme_Objectstring (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_p (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_length (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_ci_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_ci_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_lt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_lt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_gt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_gt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_lt_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_gt_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_ci_lt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_ci_lt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_ci_gt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_ci_gt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_ci_lt_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_ci_gt_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_upcase (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_downcase (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_titlecase (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_foldcase (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_upcase (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_locale_downcase (int argc, Scheme_Object *argv[])
static Scheme_Objectsubstring (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_append (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_to_list (int argc, Scheme_Object *argv[])
static Scheme_Objectlist_to_string (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_copy (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_copy_bang (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_fill (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_to_immutable (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_normalize_c (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_normalize_kc (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_normalize_d (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_normalize_kd (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_byte_string (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_p (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_p (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_length (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_eq (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_lt (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_gt (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_substring (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_append (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_to_list (int argc, Scheme_Object *argv[])
static Scheme_Objectlist_to_byte_string (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_copy (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_copy_bang (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_fill (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_to_immutable (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_utf8_index (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_utf8_ref (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_utf8_length (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_to_char_string (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_to_char_string_locale (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_to_char_string_latin1 (int argc, Scheme_Object *argv[])
static Scheme_Objectchar_string_to_byte_string (int argc, Scheme_Object *argv[])
static Scheme_Objectchar_string_to_byte_string_locale (int argc, Scheme_Object *argv[])
static Scheme_Objectchar_string_to_byte_string_latin1 (int argc, Scheme_Object *argv[])
static Scheme_Objectchar_string_utf8_length (int argc, Scheme_Object *argv[])
static Scheme_Objectversion (int argc, Scheme_Object *argv[])
static Scheme_Objectformat (int argc, Scheme_Object *argv[])
static Scheme_Objectsch_printf (int argc, Scheme_Object *argv[])
static Scheme_Objectsch_fprintf (int argc, Scheme_Object *argv[])
static Scheme_Objectbanner (int argc, Scheme_Object *argv[])
static Scheme_Objectsch_getenv (int argc, Scheme_Object *argv[])
static Scheme_Objectsch_putenv (int argc, Scheme_Object *argv[])
static Scheme_Objectsystem_type (int argc, Scheme_Object *argv[])
static Scheme_Objectsystem_library_subpath (int argc, Scheme_Object *argv[])
static Scheme_Objectcmdline_args (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_locale (int argc, Scheme_Object *argv[])
static Scheme_Objectlocale_string_encoding (int argc, Scheme_Object *argv[])
static Scheme_Objectsystem_language_country (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_open_converter (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_close_converter (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_convert (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_string_convert_end (int argc, Scheme_Object *argv[])
static Scheme_Objectbyte_converter_p (int argc, Scheme_Object *argv[])
static int mz_char_strcmp (const char *who, const mzchar *str1, int l1, const mzchar *str2, int l2, int locale, int size_shortcut)
static int mz_char_strcmp_ci (const char *who, const mzchar *str1, int l1, const mzchar *str2, int l2, int locale, int size_shortcut)
static int mz_strcmp (const char *who, unsigned char *str1, int l1, unsigned char *str2, int l2)
static XFORM_NONGCING int utf8_decode_x (const unsigned char *s, int start, int end, unsigned int *us, int dstart, int dend, long *ipos, long *jpos, char compact, char utf16, int *state, int might_continue, int permissive)
static XFORM_NONGCING int utf8_encode_x (const unsigned int *us, int start, int end, unsigned char *s, int dstart, int dend, long *_ipos, long *_opos, char utf16)
static char * string_to_from_locale (int to_bytes, char *in, int delta, int len, long *olen, int perm, int *no_cvt)
void scheme_init_string (Scheme_Env *env)
Scheme_Objectscheme_make_sized_offset_utf8_string (char *chars, long d, long len)
Scheme_Objectscheme_make_sized_utf8_string (char *chars, long len)
Scheme_Objectscheme_make_immutable_sized_utf8_string (char *chars, long len)
Scheme_Objectscheme_make_utf8_string (const char *chars)
Scheme_Objectscheme_make_locale_string (const char *chars)
void scheme_out_of_string_range (const char *name, const char *which, Scheme_Object *i, Scheme_Object *s, long start, long len)
long scheme_extract_index (const char *name, int pos, int argc, Scheme_Object **argv, long top, int false_ok)
void scheme_get_substring_indices (const char *name, Scheme_Object *str, int argc, Scheme_Object **argv, int spos, int fpos, long *_start, long *_finish)
void scheme_do_get_substring_indices (const char *name, Scheme_Object *str, int argc, Scheme_Object **argv, int spos, int fpos, long *_start, long *_finish, long len)
static Scheme_Objectdo_byte_string_to_char_string (const char *who, Scheme_Object *bstr, long istart, long ifinish, int perm, int as_locale)
static Scheme_Objectdo_byte_string_to_char_string_locale (const char *who, Scheme_Object *bstr, long istart, long ifinish, int perm)
static Scheme_Objectdo_string_to_vector (const char *who, int mode, int argc, Scheme_Object *argv[])
Scheme_Objectscheme_byte_string_to_char_string (Scheme_Object *o)
Scheme_Objectscheme_byte_string_to_char_string_locale (Scheme_Object *o)
static Scheme_Objectdo_char_string_to_byte_string (Scheme_Object *s, long istart, long ifinish, int as_locale)
static Scheme_Objectdo_char_string_to_byte_string_locale (const char *who, Scheme_Object *cstr, long istart, long ifinish, int perm)
Scheme_Objectscheme_char_string_to_byte_string (Scheme_Object *s)
Scheme_Objectscheme_char_string_to_byte_string_locale (Scheme_Object *s)
static Scheme_Objectdo_chars_to_bytes (const char *who, int mode, int argc, Scheme_Object *argv[])
void scheme_do_format (const char *procname, Scheme_Object *port, const mzchar *format, int flen, int fpos, int offset, int argc, Scheme_Object **argv)
char * scheme_format (mzchar *format, int flen, int argc, Scheme_Object **argv, long *rlen)
void scheme_printf (mzchar *format, int flen, int argc, Scheme_Object **argv)
char * scheme_format_utf8 (char *format, int flen, int argc, Scheme_Object **argv, long *rlen)
void scheme_printf_utf8 (char *format, int flen, int argc, Scheme_Object **argv)
char * scheme_version (void)
char * scheme_banner (void)
void scheme_set_banner (char *s)
int scheme_byte_string_has_null (Scheme_Object *o)
int scheme_any_string_has_null (Scheme_Object *o)
void scheme_init_getenv (void)
static void machine_details (char *s)
const char * scheme_system_library_subpath ()
int scheme_strncmp (const char *a, const char *b, int len)
static Scheme_Objectok_cmdline (int argc, Scheme_Object **argv)
static Scheme_Objectok_locale (int argc, Scheme_Object **argv)
static char * do_convert (iconv_t cd, const char *from_e, const char *to_e, int to_from_utf8, char *in, int id, int iilen, char *out, int od, int iolen, int grow, int add_end_shift, int extra, long *oilen, long *oolen, int *status)
static char * locale_recase (int to_up, char *in, int id, int iilen, char *out, int od, int iolen, long *oolen)
int mz_locale_strcoll (char *s1, int d1, int l1, char *s2, int d2, int l2, int cvt_case)
int do_locale_comp (const char *who, const mzchar *us1, long ul1, const mzchar *us2, long ul2, int cvt_case)
mzchardo_locale_recase (int to_up, mzchar *in, int delta, int len, long *olen)
static Scheme_Objectmz_recase (const char *who, int to_up, mzchar *us, long ulen)
static Scheme_Objectunicode_recase (const char *who, int to_up, int argc, Scheme_Object *argv[])
static int find_special_casing (int ch)
static int is_final_sigma (int mode, mzchar *s, int d, int i, int len)
mzcharscheme_string_recase (mzchar *s, int d, int len, int mode, int inplace, int *_len)
static Scheme_Objectstring_recase (const char *name, int argc, Scheme_Object *argv[], int mode)
static mzchar get_composition (mzchar a, mzchar b)
mzchar get_canon_decomposition (mzchar key, mzchar *b)
int get_kompat_decomposition (mzchar key, unsigned short **chars)
static Scheme_Objectnormalize_c (Scheme_Object *o)
static Scheme_Objectnormalize_d (Scheme_Object *o, int kompat)
static Scheme_Objectdo_string_normalize_c (const char *who, int argc, Scheme_Object *argv[], int kompat)
static Scheme_Objectdo_string_normalize_d (const char *who, int argc, Scheme_Object *argv[], int kompat)
int scheme_char_strlen (const mzchar *s)
static void close_converter (Scheme_Object *o, void *data)
Scheme_Objectscheme_open_converter (const char *from_e, const char *to_e)
static Scheme_Objectbyte_string_open_converter (int argc, Scheme_Object **argv)
static Scheme_Objectconvert_one (const char *who, int opos, int argc, Scheme_Object *argv[])
void scheme_close_converter (Scheme_Object *conv)
static Scheme_Objectbyte_string_close_converter (int argc, Scheme_Object **argv)
int scheme_utf8_decode (const unsigned char *s, int start, int end, unsigned int *us, int dstart, int dend, long *ipos, char utf16, int permissive)
int scheme_utf8_decode_as_prefix (const unsigned char *s, int start, int end, unsigned int *us, int dstart, int dend, long *ipos, char utf16, int permissive)
int scheme_utf8_decode_all (const unsigned char *s, int len, unsigned int *us, int permissive)
int scheme_utf8_decode_prefix (const unsigned char *s, int len, unsigned int *us, int permissive)
mzcharscheme_utf8_decode_to_buffer_len (const unsigned char *s, int len, mzchar *buf, int blen, long *_ulen)
mzcharscheme_utf8_decode_to_buffer (const unsigned char *s, int len, mzchar *buf, int blen)
int scheme_utf8_decode_count (const unsigned char *s, int start, int end, int *_state, int might_continue, int permissive)
int scheme_utf8_encode (const unsigned int *us, int start, int end, unsigned char *s, int dstart, char utf16)
int scheme_utf8_encode_all (const unsigned int *us, int len, unsigned char *s)
char * scheme_utf8_encode_to_buffer_len (const mzchar *s, int len, char *buf, int blen, long *_slen)
char * scheme_utf8_encode_to_buffer (const mzchar *s, int len, char *buf, int blen)
unsigned short * scheme_ucs4_to_utf16 (const mzchar *text, int start, int end, unsigned short *buf, int bufsize, long *ulen, int term_size)
mzcharscheme_utf16_to_ucs4 (const unsigned short *text, int start, int end, mzchar *buf, int bufsize, long *ulen, int term_size)
static int try_subproc (Scheme_Object *subprocess_proc, char *prog)

Variables

static int locale_on
static const mzcharcurrent_locale_name = "xxxx\0\0\0\0"
static const char *const STRING_IS_NOT_UTF_8 = "string is not a well-formed UTF-8 encoding: "
static Scheme_Objectsys_symbol
static Scheme_Objectplatform_3m_path
static Scheme_Objectplatform_cgc_path
static Scheme_Objectzero_length_char_string
static Scheme_Objectzero_length_byte_string
static Scheme_Hash_Tableputenv_str_table
static char * embedding_banner
static Scheme_Objectvers_str
static Scheme_Objectbanner_str
static Scheme_Objectcomplete_symbol
static Scheme_Objectcontinues_symbol
static Scheme_Objectaborts_symbol
static Scheme_Objecterror_symbol
static char * uname_locations []

Class Documentation

struct Scheme_Converter

Definition at line 150 of file string.c.

Collaboration diagram for Scheme_Converter:
Class Members
iconv_t cd
short closed
short kind
Scheme_Custodian_Reference * mref
int permissive
Scheme_Object so

Define Documentation

#define BYTE_STR   "exact integer in [0,255]"

Definition at line 1094 of file string.c.

#define CHAR_STR   "character"

Definition at line 1119 of file string.c.

#define CHAR_STR   BYTE_STR

Definition at line 1119 of file string.c.

#define CHAR_VAL (   x)    SCHEME_CHAR_VAL(x)

Definition at line 1118 of file string.c.

#define CHAR_VAL (   x)    SCHEME_INT_VAL(x)

Definition at line 1118 of file string.c.

#define CHARP (   x)    SCHEME_CHARP(x)

Definition at line 1117 of file string.c.

#define CHARP (   x)    SCHEME_BYTEP(x)

Definition at line 1117 of file string.c.

#define EMPTY   (mzchar *)"\0\0\0"

Definition at line 1111 of file string.c.

#define EMPTY   ""

Definition at line 1111 of file string.c.

#define ENCFAIL   i = oki; failmode = -2; break
#define GEN_BYTE_STRING_COMP (   name,
  scheme_name,
  comp,
  op 
)
Value:
static Scheme_Object * name (int argc, Scheme_Object *argv[]) \
{  char *s, *prev; int i, sl, pl; int falz = 0;\
   if (!SCHEME_BYTE_STRINGP(argv[0])) \
    scheme_wrong_type(scheme_name, "byte string", 0, argc, argv); \
   prev = SCHEME_BYTE_STR_VAL(argv[0]); pl = SCHEME_BYTE_STRTAG_VAL(argv[0]); \
   for (i = 1; i < argc; i++) { \
     if (!SCHEME_BYTE_STRINGP(argv[i])) \
      scheme_wrong_type(scheme_name, "byte string", i, argc, argv); \
     s = SCHEME_BYTE_STR_VAL(argv[i]); sl = SCHEME_BYTE_STRTAG_VAL(argv[i]); \
     if (!falz) if (!(comp(scheme_name, \
                           (unsigned char *)prev, pl, \
                           (unsigned char *)s, sl) op 0)) falz = 1; \
     prev = s; pl = sl; \
  } \
  return falz ? scheme_false : scheme_true; \
}

Definition at line 1126 of file string.c.

#define GEN_STRING_COMP (   name,
  scheme_name,
  comp,
  op,
  ul,
  size_shortcut 
)
Value:
static Scheme_Object * name (int argc, Scheme_Object *argv[]) \
{  mzchar *s, *prev; int i, sl, pl; int falz = 0;\
   if (!SCHEME_CHAR_STRINGP(argv[0])) \
    scheme_wrong_type(scheme_name, "string", 0, argc, argv); \
   prev = SCHEME_CHAR_STR_VAL(argv[0]); pl = SCHEME_CHAR_STRTAG_VAL(argv[0]); \
   for (i = 1; i < argc; i++) { \
     if (!SCHEME_CHAR_STRINGP(argv[i])) \
      scheme_wrong_type(scheme_name, "string", i, argc, argv); \
     s = SCHEME_CHAR_STR_VAL(argv[i]); sl = SCHEME_CHAR_STRTAG_VAL(argv[i]); \
     if (!falz) if (!(comp(scheme_name, \
                           prev, pl, \
                           s, sl, ul, size_shortcut) op 0)) falz = 1; \
     prev = s; pl = sl; \
  } \
  return falz ? scheme_false : scheme_true; \
}

Definition at line 1052 of file string.c.

#define ICONV_ARG_CAST   /* empty */

Definition at line 2420 of file string.c.

#define ICONV_errno   errno

Definition at line 129 of file string.c.

#define iconv_ready   1

Definition at line 130 of file string.c.

#define MAKE_CHAR (   x)    _scheme_make_char(x)

Definition at line 1120 of file string.c.

#define MAKE_CHAR (   x)    scheme_make_integer_value(x)

Definition at line 1120 of file string.c.

#define MZ3M_SUBDIR   ":3m"

Definition at line 3527 of file string.c.

Definition at line 3528 of file string.c.

#define MZ_JAMO_INITIAL_CONSONANT_START   0x1100

Definition at line 3526 of file string.c.

Definition at line 3540 of file string.c.

#define MZ_JAMO_SYLLABLE_START   0xAC00

Definition at line 3539 of file string.c.

Definition at line 3536 of file string.c.

Definition at line 3537 of file string.c.

#define MZ_JAMO_TRAILING_CONSONANT_START   0x11A7

Definition at line 3535 of file string.c.

#define MZ_JAMO_VOWEL_COUNT   21

Definition at line 3531 of file string.c.

Definition at line 3532 of file string.c.

#define MZ_JAMO_VOWEL_START   0x1161

Definition at line 3530 of file string.c.

#define mz_mbsnrtowcs (   t,
  f,
  fl,
  tl,
 
)    mbsrtowcs(t, f, tl, s)
#define MZ_SC_BUF_SIZE   32

Definition at line 2621 of file string.c.

#define MZ_WC_BUF_SIZE   32
#define mz_wcsnrtombs (   t,
  f,
  fl,
  tl,
 
)    wcsrtombs(t, f, tl, s)
#define mzCHK_PROC (   x)    1

Definition at line 131 of file string.c.

#define mzGETENV   getenv

Definition at line 2000 of file string.c.

#define mzICONV_KIND   0

Definition at line 145 of file string.c.

#define mzLOCALE_IS_UTF_8 (   s)    !mzCHK_PROC(iconv_open)

Definition at line 142 of file string.c.

#define mzPUTENV (   var,
  val,
 
)    MSC_IZE(putenv)(s)

Definition at line 2001 of file string.c.

#define mzUTF16_TO_UTF8_KIND   3

Definition at line 148 of file string.c.

#define mzUTF8_KIND   1

Definition at line 146 of file string.c.

#define mzUTF8_TO_UTF16_KIND   2

Definition at line 147 of file string.c.

#define portable_isspace (   x)    (((x) < 128) && isspace(x))

Definition at line 334 of file string.c.

#define SCHEME_BYTEP (   x)    ((SCHEME_INTP(x)) && (SCHEME_INT_VAL(x) >= 0) && (SCHEME_INT_VAL(x) <= 255))

Definition at line 1093 of file string.c.

Definition at line 1105 of file string.c.

Definition at line 1105 of file string.c.

Definition at line 1106 of file string.c.

Definition at line 1106 of file string.c.

#define SCHEME_X_STR_VAL (   x)    SCHEME_CHAR_STR_VAL(x)

Definition at line 1102 of file string.c.

#define SCHEME_X_STR_VAL (   x)    SCHEME_BYTE_STR_VAL(x)

Definition at line 1102 of file string.c.

Definition at line 1107 of file string.c.

Definition at line 1107 of file string.c.

#define SCHEME_X_STRINGP (   x)    SCHEME_CHAR_STRINGP(x)

Definition at line 1104 of file string.c.

#define SCHEME_X_STRINGP (   x)    SCHEME_BYTE_STRINGP(x)

Definition at line 1104 of file string.c.

Definition at line 1103 of file string.c.

Definition at line 1103 of file string.c.

#define SUBXSTR   "substring"

Definition at line 1116 of file string.c.

#define SUBXSTR   "subbytes"

Definition at line 1116 of file string.c.

#define UNPAIRED_MASK   0xF800
#define uXchar   mzchar

Definition at line 1113 of file string.c.

#define uXchar   unsigned char

Definition at line 1113 of file string.c.

#define VERSION_SUFFIX   " [cgc]"

Definition at line 1932 of file string.c.

#define X (   a,
  b 
)    a##_char##b

Definition at line 1108 of file string.c.

#define X (   a,
  b 
)    a##_byte##b

Definition at line 1108 of file string.c.

#define X_ (   a,
  b 
)    a##_##b

Definition at line 1109 of file string.c.

#define X_ (   a,
  b 
)    a##_byte_##b

Definition at line 1109 of file string.c.

#define X__ (   a)    a

Definition at line 1110 of file string.c.

#define X__ (   a)    byte_##a

Definition at line 1110 of file string.c.

#define Xchar   mzchar

Definition at line 1112 of file string.c.

#define Xchar   char

Definition at line 1112 of file string.c.

#define XSTR   ""

Definition at line 1114 of file string.c.

#define XSTR   "byte "

Definition at line 1114 of file string.c.

#define XSTRINGSTR   "string"

Definition at line 1115 of file string.c.

#define XSTRINGSTR   "bytes"

Definition at line 1115 of file string.c.

Definition at line 1121 of file string.c.

#define xstrlen   strlen

Definition at line 1121 of file string.c.


Typedef Documentation

typedef mzchar*(* recase_proc)(int to_up, mzchar *in, int delta, int len, long *olen)

Definition at line 3208 of file string.c.

typedef int(* strcoll_proc)(char *s1, int d1, int l1, char *s2, int d2, int l2, int cvt_case)

Definition at line 3013 of file string.c.


Function Documentation

static Scheme_Object * banner ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1910 of file string.c.

Here is the caller graph for this function:

static Scheme_Object * byte_converter_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4519 of file string.c.

Here is the caller graph for this function:

static Scheme_Object * byte_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1097 of file string.c.

{
  return (SCHEME_BYTEP(argv[0]) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object* byte_string ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_append ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_close_converter ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_close_converter ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 4508 of file string.c.

{
  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_string_converter_type))
    scheme_wrong_type("bytes-close-converter", "converter", 0, argc, argv);

  scheme_close_converter(argv[0]);

  return scheme_void;
}
static Scheme_Object * byte_string_convert ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4493 of file string.c.

{
  return convert_one("bytes-convert", 4, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * byte_string_convert_end ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4498 of file string.c.

{
  return convert_one("bytes-convert-end", 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* byte_string_copy ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_copy_bang ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_fill ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_gt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_length ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_lt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_open_converter ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_open_converter ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 4234 of file string.c.

{
  Scheme_Object *s1, *s2;
  char *from_e, *to_e;
  
  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("bytes-open-converter", "byte string", 0, argc, argv);
  if (!SCHEME_CHAR_STRINGP(argv[1]))
    scheme_wrong_type("bytes-open-converter", "byte string", 1, argc, argv);

  scheme_custodian_check_available(NULL, "bytes-open-converter", "converter");

  s1 = scheme_char_string_to_byte_string(argv[0]);
  s2 = scheme_char_string_to_byte_string(argv[1]);

  if (scheme_byte_string_has_null(s1))
    return scheme_false;
  if (scheme_byte_string_has_null(s2))
    return scheme_false;

  from_e = SCHEME_BYTE_STR_VAL(s1);
  to_e = SCHEME_BYTE_STR_VAL(s2);

  return scheme_open_converter(from_e, to_e);
}

Here is the call graph for this function:

static Scheme_Object* byte_string_p ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * byte_string_to_char_string ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1279 of file string.c.

{
  return do_string_to_vector("bytes->string/utf-8", 0, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * byte_string_to_char_string_latin1 ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1291 of file string.c.

{
  return do_string_to_vector("bytes->string/latin-1", 2, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * byte_string_to_char_string_locale ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1285 of file string.c.

{
  return do_string_to_vector("bytes->string/locale", 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* byte_string_to_immutable ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* byte_string_to_list ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * byte_string_utf8_index ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1493 of file string.c.

{
  long istart, ifinish, pos = -1, opos, ipos;
  int result, perm;
  char *chars;

  if (!SCHEME_BYTE_STRINGP(argv[0]))
    scheme_wrong_type("bytes-utf-8-index", "byte string", 0, argc, argv);

  chars = SCHEME_BYTE_STR_VAL(argv[0]);

  if (SCHEME_INTP(argv[1])) {
    pos = SCHEME_INT_VAL(argv[1]);
  } else if (SCHEME_BIGNUMP(argv[1])) {
    if (SCHEME_BIGPOS(argv[1]))
      pos = 0x7FFFFFFF;
  }

  if (pos < 0) {
    scheme_wrong_type("bytes-utf-8-index", "non-negative exact integer", 1, argc, argv);
  }

  if ((argc > 2) && !SCHEME_FALSEP(argv[2])) {
    if (!SCHEME_CHARP(argv[2]))
      scheme_wrong_type("bytes-utf-8-index", "character or #f", 1, argc, argv);
    perm = 1;
  } else
    perm = 0;

  scheme_get_substring_indices("bytes-utf-8-index", argv[0], argc, argv,
                            3, 4,
                            &istart, &ifinish);

  result = utf8_decode_x((unsigned char *)chars, istart, ifinish,
                      NULL, 0, pos,
                      &ipos, &opos,
                      0, 0, NULL, 0, perm ? 1 : 0);

  if (((result < 0) && (result != -3))
      || ((ipos == ifinish) && (opos <= pos)))
    return scheme_false;
  else
    return scheme_make_integer(ipos);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * byte_string_utf8_length ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1460 of file string.c.

{
  int len, perm;
  long istart, ifinish;
  char *chars;

  if (!SCHEME_BYTE_STRINGP(argv[0]))
    scheme_wrong_type("bytes-utf-8-length", "string", 0, argc, argv);

  chars = SCHEME_BYTE_STR_VAL(argv[0]);

  if ((argc > 1) && !SCHEME_FALSEP(argv[1])) {
    if (!SCHEME_CHARP(argv[1]))
      scheme_wrong_type("bytes-utf-8-length", "character or #f", 1, argc, argv);
    perm = 1;
  } else
    perm = 0;

  scheme_get_substring_indices("bytes-utf-8-length", argv[0], argc, argv,
                            2, 3,
                            &istart, &ifinish);

  len = scheme_utf8_decode((unsigned char *)chars, istart, ifinish,
                        NULL, 0, -1,
                        NULL, 0, perm);

  if (len < 0)
    return scheme_false;
  else
    return scheme_make_integer(len);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * byte_string_utf8_ref ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1539 of file string.c.

{
  long istart, ifinish, pos = -1, opos, ipos;
  char *chars;
  unsigned int us[1];
  Scheme_Object *perm;

  if (!SCHEME_BYTE_STRINGP(argv[0]))
    scheme_wrong_type("bytes-utf-8-ref", "byte string", 0, argc, argv);

  chars = SCHEME_BYTE_STR_VAL(argv[0]);

  if (SCHEME_INTP(argv[1])) {
    pos = SCHEME_INT_VAL(argv[1]);
  } else if (SCHEME_BIGNUMP(argv[1])) {
    if (SCHEME_BIGPOS(argv[1]))
      pos = 0x7FFFFFFF;
  }

  if (pos < 0) {
    scheme_wrong_type("bytes-utf-8-ref", "non-negative exact integer", 1, argc, argv);
  }

  if ((argc > 2) && !SCHEME_FALSEP(argv[2])) {
    if (!SCHEME_CHARP(argv[2]))
      scheme_wrong_type("bytes-utf-8-ref", "character or #f", 1, argc, argv);
    perm = argv[2];
  } else
    perm = 0;

  scheme_get_substring_indices("bytes-utf-8-ref", argv[0], argc, argv,
                            3, 4,
                            &istart, &ifinish);

  if (pos > 0) {
    utf8_decode_x((unsigned char *)chars, istart, ifinish,
                NULL, 0, pos,
                &ipos, &opos,
                0, 0, NULL, 0, perm ? 1 : 0);
    if (opos < pos)
      return scheme_false;
    istart = ipos;
  }

  utf8_decode_x((unsigned char *)chars, istart, ifinish,
              us, 0, 1,
              &ipos, &opos,
              0, 0, NULL, 0, perm ? 0xFFFF : 0);

  if (opos < 1)
    return scheme_false;
  else if (us[0] == 0xFFFF)
    return perm;
  else
    return scheme_make_character(us[0]);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* byte_substring ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * char_string_to_byte_string ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1426 of file string.c.

{
  return do_chars_to_bytes("string->bytes/utf-8", 0, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * char_string_to_byte_string_latin1 ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1436 of file string.c.

{
  return do_chars_to_bytes("string->bytes/latin-1", 2, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * char_string_to_byte_string_locale ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1431 of file string.c.

{
  return do_chars_to_bytes("string->bytes/locale", 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * char_string_utf8_length ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1443 of file string.c.

{
  long istart, ifinish, len;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string-utf-8-length", "string", 0, argc, argv);

  scheme_get_substring_indices("string-utf-8-length", argv[0], argc, argv,
                            1, 2, &istart, &ifinish);

  len = scheme_utf8_encode(SCHEME_CHAR_STR_VAL(argv[0]), istart, ifinish,
                        NULL, 0, 0);

  return scheme_make_integer(len);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void close_converter ( Scheme_Object o,
void data 
) [static]

Definition at line 4134 of file string.c.

{
  Scheme_Converter *c = (Scheme_Converter *)o;

  if (!c->closed) {
    c->closed = 1;
    if (c->kind == mzICONV_KIND) {
      iconv_close(c->cd);
      c->cd = (iconv_t)-1;
    }
    if (c->mref) {
      scheme_remove_managed(c->mref, (Scheme_Object *)c);
      c->mref = NULL;
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * cmdline_args ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2286 of file string.c.

{
  return scheme_param_config("current-command-line-arguments",
                          scheme_make_integer(MZCONFIG_CMDLINE_ARGS),
                          argc, argv,
                          -1, ok_cmdline, "vector of strings", 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* convert_one ( const char *  who,
int  opos,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4260 of file string.c.

{
  char *r, *instr;
  int status;
  long amt_read, amt_wrote;
  long istart, ifinish, ostart, ofinish;
  Scheme_Object *a[3], *status_sym;
  Scheme_Converter *c;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_string_converter_type))
    scheme_wrong_type(who, "converter", 0, argc, argv);

  if (opos > 1) {
    if (!SCHEME_BYTE_STRINGP(argv[1]))
      scheme_wrong_type(who, "bytes", 1, argc, argv);
    scheme_get_substring_indices(who, argv[1], argc, argv, 2, 3, &istart, &ifinish);
  } else {
    istart = 0;
    ifinish = 4; /* This is really a guess about how much space we need for a shift terminator */
  }

  if (argc > opos) {
    if (SCHEME_TRUEP(argv[opos])) {
      if (!SCHEME_MUTABLE_BYTE_STRINGP(argv[opos]))
       scheme_wrong_type(who, "mutable byte string", opos, argc, argv);
      r = SCHEME_BYTE_STR_VAL(argv[opos]);
      scheme_get_substring_indices(who, argv[opos], argc, argv, opos + 1, opos + 2, &ostart, &ofinish);
    } else {
      int ip;
      r = NULL;
      for (ip = opos + 1; ip <= opos + 2; ip++) {
       if (argc > ip) {
         int ok = 0;
         if (SCHEME_INTP(argv[ip]))
           ok = SCHEME_INT_VAL(argv[ip]) >= 0;
         else if (SCHEME_BIGNUMP(argv[ip]))
           ok = SCHEME_BIGPOS(argv[ip]);
         else if ((ip == opos + 2) && SCHEME_FALSEP(argv[ip]))
           ok = 1;
         if (!ok)
           scheme_wrong_type(who,
                           ((ip == opos + 2)
                            ? "non-negative exact integer or #f"
                            : "non-negative exact integer"),
                           ip, argc, argv);
       }
      }
      if ((argc > opos + 2) && SCHEME_TRUEP(argv[opos + 2])) {
       Scheme_Object *delta;
       if (scheme_bin_lt(argv[opos + 2], argv[opos + 1])) {
         scheme_arg_mismatch(who,
                           "ending index is less than the starting index: ",
                           argv[opos + 2]);
       }
       delta = scheme_bin_minus(argv[opos + 2], argv[opos + 1]);
       if (SCHEME_BIGNUMP(delta))
         ofinish = -1;
       else
         ofinish = SCHEME_INT_VAL(delta);
       ostart = 0;
      } else {
       ostart = 0;
       ofinish = -1;
      }
    }
  } else {
    r = NULL;
    ostart = 0;
    ofinish = -1;
  }

  c = (Scheme_Converter *)argv[0];
  if (c->closed)
    scheme_arg_mismatch(who, "converter is closed: ", argv[0]);

  instr = ((opos > 1) ? SCHEME_BYTE_STR_VAL(argv[1]) : NULL);

  if (c->kind == mzUTF16_TO_UTF8_KIND) {
    if (istart & 0x1) {
      /* Copy to word-align */
      char *c2;
      c2 = (char *)scheme_malloc_atomic(ifinish - istart);
      memcpy(c2, instr XFORM_OK_PLUS istart, ifinish - istart);
      ifinish = ifinish - istart;
      istart = 0;
      instr = c2;
    }

    status = utf8_encode_x((const unsigned int *)instr, istart >> 1, ifinish >> 1,
                        (unsigned char *)r, ostart, ofinish,
                        &amt_read, &amt_wrote, 1);
    
    amt_read -= (istart >> 1);

    if (amt_read) {
      if (!r) {
       /* Need to allocate, then do it again: */
       r = (char *)scheme_malloc_atomic(amt_wrote + 1);
       utf8_encode_x((const unsigned int *)instr, istart >> 1, ifinish >> 1,
                    (unsigned char *)r, ostart, ofinish,
                    NULL, NULL, 1);
       r[amt_wrote] = 0;
      }
      amt_read <<= 1;
    }

    /* We might get a -1 result because the input has an odd number of
       bytes, and 2nd+next-to-last bytes form an unpaired
       surrogate. In that case, the transformer normally needs one
       more byte: Windows is little-endian, so we need the byte to
       tell whether the surrogate is paired, and for all other
       platforms (where we assume that surrogates are paired), we need
       the byte to generate output. Technically, on a big-endian
       non-Windows machine, we could generate the first byte of UTF-8
       output and keep the byte as state, but we don't. */

    if (status != -1) {
      if (amt_read < ((ifinish - istart) & ~0x1)) {
       /* Must have run out of output space */
       status = 1;
      } else {
       /* Read all of input --- but it wasn't really all if there
          was an odd number of bytes. */
       if ((ifinish - istart) & 0x1)
         status = -1;
       else
         status = 0;
      }
    }
  } else if (c->kind != mzICONV_KIND) {
    /* UTF-8 -> UTF-{8,16} "identity" converter, but maybe permissive */
    if (instr) {
      long _ostart, _ofinish;
      int utf16;

      if (c->kind == mzUTF8_TO_UTF16_KIND) {
       _ostart = ostart;
       _ofinish = ofinish;
       if (_ostart & 0x1)
         _ostart++;
       _ostart >>= 1;
       if (_ofinish > 0)
         _ofinish >>= 1;
       utf16 = 1;
      } else {
       _ostart = ostart;
       _ofinish = ofinish;
       utf16 = 0;
      }

      status = utf8_decode_x((unsigned char *)instr, istart, ifinish,
                          (unsigned int *)r, _ostart, _ofinish,
                          &amt_read, &amt_wrote,
                          1, utf16, NULL, 1, c->permissive);
      
      if (utf16) {
       _ostart <<= 1;
       amt_wrote <<= 1;
       if ((ostart & 0x1) && (amt_wrote > _ostart)) {
         /* Shift down one byte: */
         memmove(r XFORM_OK_PLUS ostart, r XFORM_OK_PLUS _ostart, amt_wrote - _ostart);
       }
      }

      amt_read -= istart;
      amt_wrote -= _ostart;
      if (status == -3) {
       /* r is not NULL; ran out of room */
       status = 1;
      } else {
       if (amt_wrote) {
         if (!r) {
           /* Need to allocate, then do it again: */
           r = (char *)scheme_malloc_atomic(amt_wrote + 1);
           utf8_decode_x((unsigned char *)instr, istart, ifinish,
                       (unsigned int *)r, ostart, _ofinish,
                       NULL, NULL,
                       1, utf16, NULL, 1, c->permissive);
           r[amt_wrote] = 0;
         }
       } else if (!r)
         r = "";
       if (status > 0)
         status = 0;
      }
    } else {
      r = "";
      status = 0;
      amt_read = 0;
      amt_wrote = 0;
    }
  } else {
    r = do_convert(c->cd, NULL, NULL, 0,
                 instr, istart, ifinish-istart,
                 r, ostart, ofinish-ostart,
                 !r, /* grow? */
                 0,
                 (r ? 0 : 1), /* terminator */
                 &amt_read, &amt_wrote,
                 &status);
  }

  if (status == 0) {
    /* Converted all input without error */
    status_sym = complete_symbol;
  } else if (status == 1) {
    /* Filled output, more input ready */
    status_sym = continues_symbol;
  } else if (status == -1) {
    /* Input ends in the middle of an encoding */
    status_sym = aborts_symbol;
  } else {
    /* Assert: status == -2 */
    /* Input has error (that won't be fixed by
       adding more characters */
    status_sym = error_symbol;
  }

  if (argc <= opos) {
    a[0] = scheme_make_sized_byte_string(r, amt_wrote, 0);
  } else {
    a[0] = scheme_make_integer(amt_wrote);
  }
  if (opos > 1) {
    a[1] = scheme_make_integer(amt_read);
    a[2] = status_sym;
    return scheme_values(3, a);
  } else {
    a[1] = status_sym;
    return scheme_values(2, a);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_locale ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2315 of file string.c.

{
  Scheme_Object *v;

  v = scheme_param_config("current-locale",
                       scheme_make_integer(MZCONFIG_LOCALE),
                       argc, argv,
                       -1, ok_locale, "#f or string", 1);

  return v;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_byte_string_to_char_string ( const char *  who,
Scheme_Object bstr,
long  istart,
long  ifinish,
int  perm,
int  as_locale 
) [static]

Definition at line 1155 of file string.c.

{
  int i, ulen;
  char *chars;
  unsigned int *v;

  chars = SCHEME_BYTE_STR_VAL(bstr);

  ulen = utf8_decode_x((unsigned char *)chars, istart, ifinish,
                     NULL, 0, -1,
                     NULL, NULL, 0, 0,
                     NULL, 0, 
                     (perm > -1) ? 0xD800 : 0);
  if (ulen < 0) {
    scheme_arg_mismatch(who,
                     STRING_IS_NOT_UTF_8,
                     bstr);
  }

  v = (unsigned int *)scheme_malloc_atomic((ulen + 1) * sizeof(unsigned int));
  utf8_decode_x((unsigned char *)chars, istart, ifinish,
              v, 0, -1,
              NULL, NULL, 0, 0,
              NULL, 0, 
              (perm > -1) ? 0xD800 : 0);
  
  if (perm > -1) {
    for (i = 0; i < ulen; i++) {
      if (v[i] == 0xD800)
       v[i] = perm;
    }
  }
  v[ulen] = 0;

  return scheme_make_sized_char_string(v, ulen, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_byte_string_to_char_string_locale ( const char *  who,
Scheme_Object bstr,
long  istart,
long  ifinish,
int  perm 
) [static]

Definition at line 1196 of file string.c.

{
  char *us;
  long olen;

  reset_locale();
  if (!iconv_ready) init_iconv();

  if (mzLOCALE_IS_UTF_8(current_locale_name) || !locale_on || !mzCHK_PROC(iconv_open))
    return do_byte_string_to_char_string(who, bstr, istart, ifinish, perm, 1);

  if (istart < ifinish) {
    int no_cvt;

    us = string_to_from_locale(0, SCHEME_BYTE_STR_VAL(bstr),
                            istart, ifinish - istart,
                            &olen, perm, &no_cvt);

    if (!us) {
      if (no_cvt) {
       return do_byte_string_to_char_string(who, bstr, istart, ifinish, perm, 1);
      } else {
       scheme_arg_mismatch(who,
                         "byte string is not a valid encoding for the current locale: ",
                         bstr);
      }
    }
    ((mzchar *)us)[olen] = 0;
  } else {
    us = "\0\0\0";
    olen = 0;
  }

  return scheme_make_sized_char_string((mzchar *)us, olen, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_char_string_to_byte_string ( Scheme_Object s,
long  istart,
long  ifinish,
int  as_locale 
) [static]

Definition at line 1308 of file string.c.

{
  char *bs;
  int slen;

  slen = scheme_utf8_encode(SCHEME_CHAR_STR_VAL(s), istart, ifinish,
                         NULL, 0,
                         0 /* UTF-16 */);
  bs = (char *)scheme_malloc_atomic(slen + 1);
  scheme_utf8_encode(SCHEME_CHAR_STR_VAL(s), istart, ifinish,
                   (unsigned char *)bs, 0,
                   0 /* UTF-16 */);
  bs[slen] = 0;

  return scheme_make_sized_byte_string(bs, slen, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_char_string_to_byte_string_locale ( const char *  who,
Scheme_Object cstr,
long  istart,
long  ifinish,
int  perm 
) [static]

Definition at line 1327 of file string.c.

{
  char *s;
  long olen;

  reset_locale();
  if (!iconv_ready) init_iconv();

  if (mzLOCALE_IS_UTF_8(current_locale_name) || !locale_on || !mzCHK_PROC(iconv_open))
    return do_char_string_to_byte_string(cstr, istart, ifinish, 1);

  if (istart < ifinish) {
    int no_cvt;

    s = string_to_from_locale(1, (char *)SCHEME_CHAR_STR_VAL(cstr),
                           istart, ifinish - istart,
                           &olen, perm, &no_cvt);

    if (!s) {
      if (no_cvt) {
       return do_char_string_to_byte_string(cstr, istart, ifinish, 1);
      } else {
       scheme_arg_mismatch(who,
                         "string cannot be encoded for the current locale: ",
                         cstr);
      }
    }
    s[olen] = 0;
  } else {
    s = "";
    olen = 0;
  }

  return scheme_make_sized_byte_string(s, olen, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_chars_to_bytes ( const char *  who,
int  mode,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1377 of file string.c.

{
  long istart, ifinish;
  int permc;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type(who, "string", 0, argc, argv);

  if ((argc < 2) || SCHEME_FALSEP(argv[1]))
    permc = -1;
  else {
    if (!SCHEME_BYTEP(argv[1]))
      scheme_wrong_type(who, "byte or #f", 1, argc, argv);
    permc = SCHEME_INT_VAL(argv[1]);
  }

  scheme_get_substring_indices(who, argv[0], argc, argv,
                            2, 3, &istart, &ifinish);

  if (mode == 1)
    return do_char_string_to_byte_string_locale(who, argv[0], istart, ifinish, permc);
  else if (mode == 0)
    return do_char_string_to_byte_string(argv[0], istart, ifinish, 0);
  else {
    /* Latin-1 */
    mzchar *us;
    unsigned char *s;
    long i, len;
    len = ifinish - istart;
    us = SCHEME_CHAR_STR_VAL(argv[0]);
    s = (unsigned char *)scheme_malloc_atomic(len + 1);
    for (i = istart; i < ifinish; i++) {
      if (us[i] < 256)
       s[i - istart] = us[i];
      else if (permc >= 0) {
       s[i - istart] = permc;
      } else {
       scheme_arg_mismatch(who,
                         "string cannot be encoded in Latin-1: ",
                         argv[0]);
      }
    }
    s[len] = 0;

    return scheme_make_sized_byte_string((char *)s, len, 0);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char* do_convert ( iconv_t  cd,
const char *  from_e,
const char *  to_e,
int  to_from_utf8,
char *  in,
int  id,
int  iilen,
char *  out,
int  od,
int  iolen,
int  grow,
int  add_end_shift,
int  extra,
long *  oilen,
long *  oolen,
int status 
) [static]

Definition at line 2422 of file string.c.

{
  int dip, dop, close_it = 0, mz_utf8 = 0;
  size_t il, ol, r;
  GC_CAN_IGNORE char *ip, *op;

  /* Defaults: */
  *status = -1;
  if (oilen)
    *oilen = 0;
  *oolen = 0;

  if (cd == (iconv_t)-1) {
    if (!iconv_ready) init_iconv();
    if (mzCHK_PROC(iconv_open)) {
      if (!from_e)
       from_e = mz_iconv_nl_langinfo();
      if (!to_e)
       to_e = mz_iconv_nl_langinfo();
      cd = iconv_open(to_e, from_e);
      close_it = 1;
    } else if (to_from_utf8) {
      /* Assume UTF-8 */
      mz_utf8 = 1;
    }
  }

  if ((cd == (iconv_t)-1) && !mz_utf8) {
    if (out) {
      while (extra--) {
       out[extra] = 0;
      }
    }
    return out;
  }

  /* The converter is ready. Allocate out space, if necessary */

  if (!out) {
    if (iolen <= 0)
      iolen = iilen;
    out = (char *)scheme_malloc_atomic(iolen + extra);
    od = 0;
  }

  /* il and ol are the number of available chars */
  il = iilen;
  ol = iolen;
  /* dip and dop are the number of characters read so far;
     we use these and NULL out the ip and op pointers
     for the sake of precise GC */
  dip = 0;
  dop = 0;
  if (!in)
    add_end_shift = 0;

  while (1) {
    int icerr;

    if (mz_utf8) {
      /* Use our UTF-8 routines as if they were iconv */
      if (to_from_utf8 == 1) {
       /* UCS-4 -> UTF-8 */
       /* We assume that in + id and iilen are mzchar-aligned */
       int opos, uid, uilen;
       uid = (id + dip) >> 2;
       uilen = (iilen - dip) >> 2;
       opos = scheme_utf8_encode((const unsigned int *)in, uid, uilen,
                              NULL, 0,
                              0);
       if (opos <= iolen) {
         opos = scheme_utf8_encode((const unsigned int *)in, uid, uilen,
                                (unsigned char *)out, od + dop,
                                0);
         dop += opos;
         dip += iilen;
         icerr = 0;
         r = (size_t)opos;
       } else {
         icerr = E2BIG;
         r = (size_t)-1;
       }
      } else {
       /* UTF-8 -> UCS-4 */
       /* We assume that out + od is mzchar-aligned */
       long ipos, opos;

       r = utf8_decode_x((unsigned char *)in, id + dip, iilen,
                       (unsigned int *)out, (od + dop) >> 2, iolen >> 2,
                       &ipos, &opos,
                       0, 0, NULL, 0, 0);
       
       opos <<= 2;
       dop = (opos - od);
       dip = (ipos - id);

       if ((r == -1) || (r == -2)) {
         r = (size_t)-1;
         icerr = EILSEQ;
       } else if (r == -3) {
         icerr = E2BIG;
         r = (size_t)-1;
       } else
         icerr = 0;
      }
    } else  {
      ip = in XFORM_OK_PLUS id + dip;
      op = out XFORM_OK_PLUS od + dop;
      r = iconv(cd, ICONV_ARG_CAST &ip, &il, &op, &ol);
      dip = ip - (in XFORM_OK_PLUS id);
      dop = op - (out XFORM_OK_PLUS od);
      ip = op = NULL;
      icerr = ICONV_errno;
    }

    /* Record how many chars processed, now */
    if (oilen)
      *oilen = dip;
    *oolen = dop;

    /* Got all the chars? */
    if (r == (size_t)-1) {
      if (icerr == E2BIG) {
       if (grow) {
         /* Double the string size and try again */
         char *naya;
         naya = (char *)scheme_malloc_atomic((iolen * 2) + extra);
         memcpy(naya, out + od, *oolen);
         ol += iolen;
         iolen += iolen;
         out = naya;
         od = 0;
       } else {
         *status = 1;
         if (close_it)
           iconv_close(cd);
         while (extra--) {
           out[od + dop + extra] = 0;
         }
         return out;
       }
      } else {
       /* Either EINVAL (premature end) or EILSEQ (bad sequence) */
       if (icerr == EILSEQ)
         *status = -2;
       if (close_it)
         iconv_close(cd);
       while (extra--) {
         out[od + dop + extra] = 0;
       }
       return out;
      }
    } else {
      /* All done... */
      if (add_end_shift) {
       add_end_shift = 0;
       in = NULL;
       dip = 0;
       id = 0;
       il = 0; /* should be redundant */
       oilen = NULL; /* so it doesn't get set to 0 */
      } else {
       *status = 0;
       if (close_it)
         iconv_close(cd);
       while (extra--) {
         out[od + dop + extra] = 0;
       }
       return out;
      }
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int do_locale_comp ( const char *  who,
const mzchar us1,
long  ul1,
const mzchar us2,
long  ul2,
int  cvt_case 
)

Definition at line 3015 of file string.c.

{
  int xl1;
  int v, endres, utf16 = 0;
  GC_CAN_IGNORE strcoll_proc mz_strcoll = mz_locale_strcoll;

#if defined(MACOS_UNICODE_SUPPORT) || defined(WINDOWS_UNICODE_SUPPORT)
  if (current_locale_name && !*current_locale_name) {
    utf16 = 1;
    mz_strcoll = mz_native_strcoll;
  }
#endif

  if (utf16) {
    us1 = (mzchar *)scheme_ucs4_to_utf16(us1, 0, ul1, NULL, 0, &ul1, 1);
    us2 = (mzchar *)scheme_ucs4_to_utf16(us2, 0, ul2, NULL, 0, &ul2, 1);
    ((short *)us1)[ul1] = 0;
    ((short *)us2)[ul2] = 0;
  }

  if (ul1 > ul2) {
    ul1 = ul2;
    endres = 1;
  } else {
    if (ul2 > ul1)
      endres = -1;
    else
      endres = 0;
  }

  /* Walk back through the strings looking for nul characters. If we
     find one, compare the part after the null character to update
     endres, then continue. Unfortunately, we do too much work if an
     earlier part of the string (tested later) determines the result,
     but hopefully nul characters are rare. */

  xl1 = 0;
  while (ul1--) {
    if ((utf16 && (!(((short *)us1)[ul1]) || !(((short *)us2)[ul1])))
       || (!utf16 && (!(us1[ul1]) || !(us2[ul1])))) {
      if (utf16) {
       if (((short *)us1)[ul1])
         endres = 1;
       else if (((short *)us2)[ul1])
         endres = -1;
      } else {
       if (us1[ul1])
         endres = 1;
       else if (us2[ul1])
         endres = -1;
      }

      if (xl1)
       v = mz_strcoll((char *)us1, ul1 + 1, xl1, (char *)us2, ul1 + 1, xl1, cvt_case);
      else
       v = 0;

      if (v)
       endres = v;
      xl1 = 0;
    } else {
      xl1++;
    }
  }

  v = mz_strcoll((char *)us1, 0, xl1, (char *)us2, 0, xl1, cvt_case);
  if (v)
    endres = v;

  return endres;
}

Here is the call graph for this function:

Here is the caller graph for this function:

mzchar* do_locale_recase ( int  to_up,
mzchar in,
int  delta,
int  len,
long *  olen 
)

Definition at line 3088 of file string.c.

{
  Scheme_Object *parts = scheme_null;
  char *c, buf[MZ_SC_BUF_SIZE], case_buf[MZ_SC_BUF_SIZE];
  long clen, used;
  int status;

  while (len) {
    /* We might have conversion errors... */
    c = do_convert((iconv_t)-1, MZ_UCS4_NAME, NULL, 1,
                 (char *)in, 4 * delta, 4 * len,
                 buf, 0, MZ_SC_BUF_SIZE - 1,
                 1 /* grow */, 0, 1 /* terminator size */,
                 &used, &clen,
                 &status);

    used >>= 2;
    delta += used;
    len -= used;

    c = locale_recase(to_up, c, 0, clen,
                    case_buf, 0, MZ_SC_BUF_SIZE - 1,
                    &clen);
    if (!c)
      clen = 0;

    c = do_convert((iconv_t)-1, NULL, MZ_UCS4_NAME, 2,
                 c, 0, clen,
                 NULL, 0, 0,
                 1 /* grow */, 0, sizeof(mzchar) /* terminator size */,
                 &used, &clen,
                 &status);

    if (!len && SCHEME_NULLP(parts)) {
      *olen = (clen >> 2);
      ((mzchar *)c)[*olen] = 0;
      return (mzchar *)c;
    }

    /* We can get here if there was some conversion error at some
       point. We're building up a list of parts. */

    parts = scheme_make_pair(scheme_make_sized_char_string((mzchar *)c, clen >> 2, 0),
                          parts);

    if (len) {
      /* Conversion error, so skip one char. */
      parts = scheme_make_pair(scheme_make_sized_offset_char_string(in, delta, 1, 1),
                            parts);
      delta += 1;
      len -= 1;
    }
  }

  parts = append_all_strings_backwards(parts);
  *olen = SCHEME_CHAR_STRTAG_VAL(parts);

  return SCHEME_CHAR_STR_VAL(parts);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_string_normalize_c ( const char *  who,
int  argc,
Scheme_Object argv[],
int  kompat 
) [static]

Definition at line 3864 of file string.c.

{
  Scheme_Object *o;
  mzchar *s, last_c0 = 0, snd;
  int len, i, last_cc = 0;

  o = argv[0];
  if (!SCHEME_CHAR_STRINGP(o))
    scheme_wrong_type(who, "string", 0, argc, argv);

  s = SCHEME_CHAR_STR_VAL(o);
  len = SCHEME_CHAR_STRLEN_VAL(o);

  for (i = 0; i < len; i++) {
    if (scheme_needs_decompose(s[i])
       && (kompat || get_canon_decomposition(s[i], &snd))) {
      /* Decomposition may expose a different composition */
      break;
    } else if ((i + 1 < len)
       && scheme_combining_class(s[i])
       && scheme_combining_class(s[i+1])
       && (scheme_combining_class(s[i+1]) < scheme_combining_class(s[i]))) {
      /* Need to reorder */
      break;
    } else if ((s[i] >= MZ_JAMO_INITIAL_CONSONANT_START)
              && (s[i] <= MZ_JAMO_INITIAL_CONSONANT_END)
              && (s[i+1] >= MZ_JAMO_VOWEL_START)
              && (s[i+1] <= MZ_JAMO_VOWEL_END)) {
      /* Need Hangul composition */
      break;
    } else if (last_c0 
              && get_composition(last_c0, s[i])
              && (scheme_combining_class(s[i]) > last_cc)) {
      /* Need to compose */
      break;
    } else {
      int cc;

      cc = scheme_combining_class(s[i]);

      if (!cc) {
       if (scheme_needs_maybe_compose(s[i]))
         last_c0 = s[i];
       else
         last_c0 = 0;
       last_cc = -1;
      } else
       last_cc = cc;
    }
  }

  if (i < len) {
    o = normalize_c(normalize_d(o, kompat));
  }

  return o;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_string_normalize_d ( const char *  who,
int  argc,
Scheme_Object argv[],
int  kompat 
) [static]

Definition at line 3932 of file string.c.

{
  Scheme_Object *o;
  mzchar *s;
  int len, i;

  o = argv[0];
  if (!SCHEME_CHAR_STRINGP(o))
    scheme_wrong_type(who, "string", 0, argc, argv);

  s = SCHEME_CHAR_STR_VAL(o);
  len = SCHEME_CHAR_STRLEN_VAL(o);

  for (i = len; i--; ) {
    if (scheme_needs_decompose(s[i])) {
      /* Need to decompose */
      mzchar snd;
      if (kompat || get_canon_decomposition(s[i], &snd))
       break;
    } else if ((i + 1 < len)
              && scheme_combining_class(s[i])
              && scheme_combining_class(s[i+1])
              && (scheme_combining_class(s[i+1]) < scheme_combining_class(s[i]))) {
      /* Need to reorder */
      break;
    } else if ((s[i] >= MZ_JAMO_SYLLABLE_START)
              && (s[i] <= MZ_JAMO_SYLLABLE_END)) {
      /* Need Hangul decomposition */
      break;
    }
  }

  if (i >= 0) {
    o = normalize_d(o, kompat);
  }

  return o;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_string_to_vector ( const char *  who,
int  mode,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1236 of file string.c.

{
  int permc;
  long istart, ifinish;

  if (!SCHEME_BYTE_STRINGP(argv[0]))
    scheme_wrong_type(who, "byte string", 0, argc, argv);

  if ((argc < 2) || SCHEME_FALSEP(argv[1]))
    permc = -1;
  else {
    if (!SCHEME_CHARP(argv[1]))
      scheme_wrong_type(who, "character or #f", 1, argc, argv);
    permc = SCHEME_CHAR_VAL(argv[1]);
  }

  scheme_get_substring_indices(who, argv[0], argc, argv,
                            2, 3,
                            &istart, &ifinish);

  if (mode == 0)
    return do_byte_string_to_char_string(who, argv[0], istart, ifinish, permc, 0);
  else if (mode == 1)
    return do_byte_string_to_char_string_locale(who, argv[0], istart, ifinish, permc);
  else {
    /* Latin-1 */
    mzchar *us;
    unsigned char *s;
    long i, len;
    len = ifinish - istart;
    s = (unsigned char *)SCHEME_BYTE_STR_VAL(argv[0]);
    us = (mzchar *)scheme_malloc_atomic((len + 1) * sizeof(mzchar));
    for (i = istart; i < ifinish; i++) {
      us[i - istart] = s[i];
    }
    us[len] = 0;

    return scheme_make_sized_char_string(us, len, 0);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int find_special_casing ( int  ch) [static]

Definition at line 3335 of file string.c.

{
  /* Binary search */
  int i, lo, hi, j;

  i = NUM_SPECIAL_CASINGS >> 1;
  lo = i;
  hi = NUM_SPECIAL_CASINGS - i - 1;

  while (1) {
    if (uchar_special_casings[i * 10] == ch)
      return i * 10;
    if (uchar_special_casings[i * 10] > ch) {
      j = i - lo;
      i = j + (lo >> 1);
      hi = lo - (i - j) - 1;
      lo = i - j;
    } else {
      j = i + 1;
      i = j + (hi >> 1);
      lo = i - j;
      hi = hi - (i - j) - 1;
    }
  }
}

Here is the caller graph for this function:

static Scheme_Object * format ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1861 of file string.c.

{
  Scheme_Object *port;
  char *s;
  long len;

  port = scheme_make_byte_string_output_port();

  scheme_do_format("format", port, NULL, 0, 0, 1, argc, argv);

  s = scheme_get_sized_byte_string_output(port, &len);
  return scheme_make_sized_utf8_string(s, len);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 3573 of file string.c.

{
  int pos = (DECOMPOSE_TABLE_SIZE >> 1), new_pos;
  int below_len = pos;
  int above_len = (DECOMPOSE_TABLE_SIZE - pos - 1);

  /* Binary search: */
  while (key != utable_decomp_keys[pos]) {
    if (key > utable_decomp_keys[pos]) {
      if (!above_len)
       return 0;
      new_pos = pos + (above_len >> 1) + 1;
      below_len = (new_pos - pos - 1);
      above_len = (above_len - below_len - 1);
      pos = new_pos;
    } else if (key < utable_decomp_keys[pos]) {
      if (!below_len)
       return 0;
      new_pos = pos - ((below_len >> 1) + 1);
      above_len = (pos - new_pos - 1);
      below_len = (below_len - above_len - 1);
      pos = new_pos;
    }
  }

  pos = utable_decomp_indices[pos];
  if (pos < 0) {
    pos = -(pos + 1);
    pos <<= 1;
    *b = utable_compose_long_pairs[pos + 1];
    return utable_compose_long_pairs[pos];
  } else {
    key = utable_compose_pairs[pos];
    *b = (key & 0xFFFF);
    return (key >> 16);
  }
}

Here is the caller graph for this function:

static mzchar get_composition ( mzchar  a,
mzchar  b 
) [static]

Definition at line 3542 of file string.c.

{
  unsigned long key = (a << 16) | b;
  int pos = (COMPOSE_TABLE_SIZE >> 1), new_pos;
  int below_len = pos;
  int above_len = (COMPOSE_TABLE_SIZE - pos - 1);
  
  if (a > 0xFFFF) return 0;

  /* Binary search: */
  while (key != utable_compose_pairs[pos]) {
    if (key > utable_compose_pairs[pos]) {
      if (!above_len)
       return 0;
      new_pos = pos + (above_len >> 1) + 1;
      below_len = (new_pos - pos - 1);
      above_len = (above_len - below_len - 1);
      pos = new_pos;
    } else if (key < utable_compose_pairs[pos]) {
      if (!below_len)
       return 0;
      new_pos = pos - ((below_len >> 1) + 1);
      above_len = (pos - new_pos - 1);
      below_len = (below_len - above_len - 1);
      pos = new_pos;
    }
  }

  return utable_compose_result[pos];
}

Here is the caller graph for this function:

int get_kompat_decomposition ( mzchar  key,
unsigned short **  chars 
)

Definition at line 3611 of file string.c.

{
  int pos = (KOMPAT_DECOMPOSE_TABLE_SIZE >> 1), new_pos;
  int below_len = pos;
  int above_len = (KOMPAT_DECOMPOSE_TABLE_SIZE - pos - 1);

  /* Binary search: */
  while (key != utable_kompat_decomp_keys[pos]) {
    if (key > utable_kompat_decomp_keys[pos]) {
      if (!above_len)
       return 0;
      new_pos = pos + (above_len >> 1) + 1;
      below_len = (new_pos - pos - 1);
      above_len = (above_len - below_len - 1);
      pos = new_pos;
    } else if (key < utable_kompat_decomp_keys[pos]) {
      if (!below_len)
       return 0;
      new_pos = pos - ((below_len >> 1) + 1);
      above_len = (pos - new_pos - 1);
      below_len = (below_len - above_len - 1);
      pos = new_pos;
    }
  }

  *chars = utable_kompat_decomp_strs XFORM_OK_PLUS utable_kompat_decomp_indices[pos];
  return utable_kompat_decomp_lens[pos];
}

Here is the caller graph for this function:

static void init_iconv ( ) [static]

Definition at line 132 of file string.c.

{ }

Here is the caller graph for this function:

static int is_final_sigma ( int  mode,
mzchar s,
int  d,
int  i,
int  len 
) [static]

Definition at line 3361 of file string.c.

{
  int j;

  if (mode == 3)
    return 1;
  
  /* find a cased char before, skipping case-ignorable: */
  for (j = i - 1; j >= d; j--) {
    if (!scheme_iscaseignorable(s[j])) {
      if (scheme_iscased(s[j]))
       break;
      else
       return 0;
    }
  }
  if (j < d)
    return 0;

  /* next non-case-ignorable must not be cased: */
  for (j = i + 1; j < d + len; j++) {
    if (!scheme_iscaseignorable(s[j])) {
      return !scheme_iscased(s[j]);
    }
  }

  return 1;
}

Here is the caller graph for this function:

static Scheme_Object* list_to_byte_string ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* list_to_string ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static char* locale_recase ( int  to_up,
char *  in,
int  id,
int  iilen,
char *  out,
int  od,
int  iolen,
long *  oolen 
) [static]

Definition at line 2723 of file string.c.

{
#ifdef NO_MBTOWC_FUNCTIONS
  /* No wide-char functions...
     The C library's toupper and tolower is supposed to be
     locale-sensitive. It can't be right for characters that are
     encoded in multiple bytes, but probably it will do the right
     thing in common cases. */
  int i;

  /* First, copy "in" to "out" */
  if (iilen + 1 >= iolen) {
    out = (char *)scheme_malloc_atomic(iilen + 1);
    od = 0;
  }
  memcpy(out + od, in + id, iilen);
  out[od + iilen] = 0;
  *oolen = iilen;

  /* Re-case chars in "out" */
  for (i = 0; i < iilen; i++) {
    if (to_up)
      out[od + i] = toupper(out[od + i]);
    else
      out[od + i] = tolower(out[od + i]);
  }

  return out;
#else
  /* To change the case, convert the string to multibyte, re-case the
     multibyte, then convert back. */
# define MZ_WC_BUF_SIZE 32
  GC_CAN_IGNORE mbstate_t state;
  size_t wl, wl2, ml, ml2;
  wchar_t *wc, *ws, wcbuf[MZ_WC_BUF_SIZE], cwc;
  const char *s;
  unsigned int j;
  /* The "n" versions are apparently not too standard: */
# define mz_mbsnrtowcs(t, f, fl, tl, s) mbsrtowcs(t, f, tl, s)
# define mz_wcsnrtombs(t, f, fl, tl, s) wcsrtombs(t, f, tl, s)

  /* ----- to wide char ---- */

  /* Get length */
  memset(&state, 0, sizeof(mbstate_t));
  s = in XFORM_OK_PLUS id;
  wl = mz_mbsnrtowcs(NULL, &s, iilen, 0, &state);
  s = NULL;
  if (wl < 0) return NULL;

  /* Allocate space */
  if (wl < MZ_WC_BUF_SIZE) {
    wc = wcbuf;
  } else {
    wc = (wchar_t *)scheme_malloc_atomic(sizeof(wchar_t) * (wl + 1));
  }

  /* Convert */
  memset(&state, 0, sizeof(mbstate_t));
  s = in XFORM_OK_PLUS id;
  wl2 = mz_mbsnrtowcs(wc, &s, iilen, wl + 1, &state);
  s = NULL;
  if (wl2 < 0) return NULL; /* Very strange! */

  wc[wl] = 0; /* just in case */

  /* ---- re-case ---- */

  if (to_up) {
    for (j = 0; j < wl; j++) {
      cwc = towupper(wc[j]);
      wc[j] = cwc;
    }
  } else {
    for (j = 0; j < wl; j++) {
      cwc = towlower(wc[j]);
      wc[j] = cwc;
    }
  }

  /* ---- back to multibyte ---- */

  /* Measure */
  memset(&state, 0, sizeof(mbstate_t));
  ws = wc;
  ml = mz_wcsnrtombs(NULL, (const wchar_t **)&ws, wl, 0, &state);
  ws = NULL;
  if (ml < 0) return NULL;

  /* Allocate space */
  *oolen = ml;
  if (ml + 1 >= (unsigned int)iolen) {
    out = (char *)scheme_malloc_atomic(ml + 1);
    od = 0;
  }

  /* Convert */
  memset(&state, 0, sizeof(mbstate_t));
  ws = wc;
  ml2 = mz_wcsnrtombs(out + od, (const wchar_t **)&ws, wl, ml + 1, &state);
  ws = NULL;
  if (ml2 < 0) return NULL; /* Very strange! */

  out[od + ml] = 0;

  return out;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * locale_string_encoding ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2327 of file string.c.

{
  reset_locale();
  if (mzLOCALE_IS_UTF_8(current_locale_name) || !locale_on)
    return scheme_make_utf8_string("UTF-8");
  
#if HAVE_CODESET
  return scheme_make_utf8_string(nl_langinfo(CODESET));
#else
  /* nl_langinfo doesn't work, so just make up something */
  return scheme_make_utf8_string("UTF-8");
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

void machine_details ( char *  s) [static]

Definition at line 5400 of file string.c.

{
  Scheme_Object *subprocess_proc;
  int i;

  subprocess_proc = scheme_builtin_value("subprocess");

  for (i = 0; uname_locations[i]; i++) {
    if (scheme_file_exists(uname_locations[i])) {
      /* Try running it. */
      if (try_subproc(subprocess_proc, uname_locations[i])) {
       Scheme_Object *sout, *sin, *serr;
       long c;

       sout = scheme_current_thread->ku.multiple.array[1];
       sin = scheme_current_thread->ku.multiple.array[2];
       serr = scheme_current_thread->ku.multiple.array[3];

       scheme_close_output_port(sin);
       scheme_close_input_port(serr);

       /* Read result: */
       strcpy(buff, "<unknown machine>");
       c = scheme_get_bytes(sout, 1023, buff, 0);
       buff[c] = 0;

       scheme_close_input_port(sout);

       /* Remove trailing whitespace (especially newlines) */
       while (c && portable_isspace(((unsigned char *)buff)[c - 1])) {
         buff[--c] = 0;
       }

       return;
      }
    }
  }

  strcpy(buff, "<unknown machine>");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_byte_string ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* make_string ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static int mz_char_strcmp ( const char *  who,
const mzchar str1,
int  l1,
const mzchar str2,
int  l2,
int  locale,
int  size_shortcut 
) [static]

Definition at line 3993 of file string.c.

{
  int endres;

  if (size_shortcut && (l1 != l2))
    return 1;

#ifndef DONT_USE_LOCALE
  if (use_locale) {
    reset_locale();
    if (locale_on) {
      return do_locale_comp(who, str1, l1, str2, l2, 0);
    }
  }
#endif

  if (l1 > l2) {
    l1 = l2;
    endres = 1;
  } else {
    if (l2 > l1)
      endres = -1;
    else
      endres = 0;
  }

  while (l1--) {
    unsigned int a, b;

    a = *(str1++);
    b = *(str2++);

    a = a - b;
    if (a)
      return a;
  }

  return endres;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int mz_char_strcmp_ci ( const char *  who,
const mzchar str1,
int  l1,
const mzchar str2,
int  l2,
int  locale,
int  size_shortcut 
) [static]

Definition at line 4034 of file string.c.

{
  int p1, p2, sp1, sp2, a, b;
  mzchar spec1[SPECIAL_CASE_FOLD_MAX], spec2[SPECIAL_CASE_FOLD_MAX];

  if (size_shortcut && (l1 != l2))
    return 1;

#ifndef DONT_USE_LOCALE
  if (use_locale) {
    reset_locale();
    if (locale_on) {
      return do_locale_comp(who, str1, l1, str2, l2, 1);
    }
  }
#endif

  p1 = sp1 = 0;
  p2 = sp2 = 0;

  while (((p1 < l1) || sp1) && ((p2 < l2) || sp2)) {
    if (sp1) {
      a = spec1[--sp1];
    } else {
      a = str1[p1];
      if (scheme_isspecialcasing(a)) {
       int pos, i;
       pos = find_special_casing(a);
       sp1 = uchar_special_casings[pos + 7];
       pos = uchar_special_casings[pos + 8];
       for (i = sp1; i--; pos++) {
         spec1[i] = uchar_special_casing_data[pos];
       }
       a = spec1[--sp1];
      } else {
       a = scheme_tofold(a);
      }
      p1++;
    }

    if (sp2) {
      b = spec2[--sp2];
    } else {
      b = str2[p2];
      if (scheme_isspecialcasing(b)) {
       int pos, i;
       pos = find_special_casing(b);
       sp2 = uchar_special_casings[pos + 7];
       pos = uchar_special_casings[pos + 8];
       for (i = sp2; i--; pos++) {
         spec2[i] = uchar_special_casing_data[pos];
       }
       b = spec2[--sp2];
      } else {
       b = scheme_tofold(b);
      }
      p2++;
    }

    a = a - b;
    if (a)
      return a;
  }

  return ((p1 < l1) || sp1) - ((p2 < l2) || sp2);
}

Here is the call graph for this function:

static char* mz_iconv_nl_langinfo ( ) [static]

Definition at line 208 of file string.c.

                                   {
  char *s;
# if HAVE_CODESET
  s = nl_langinfo(CODESET);
# else
  s = NULL;
# endif
  if (!s)
    return "";
  else
    return s;
}

Here is the caller graph for this function:

int mz_locale_strcoll ( char *  s1,
int  d1,
int  l1,
char *  s2,
int  d2,
int  l2,
int  cvt_case 
)

Definition at line 2838 of file string.c.

{
  long clen1, clen2, used1, used2, origl1, origl2;
  char *c1, *c2, buf1[MZ_SC_BUF_SIZE], buf2[MZ_SC_BUF_SIZE];
  char case_buf1[MZ_SC_BUF_SIZE], case_buf2[MZ_SC_BUF_SIZE];
  int status, got_more;

  /* First, convert UCS-4 to locale-specific encoding. If some
     characters don't fit into the encoding, then we'll have leftover
     characters. Count unconvertable charc as greater than anything
     that can be converted */

  origl1 = l1;
  origl2 = l2;

  /* Loop to check both convertable and unconvertable parts */
  while (1) {
    if (!origl1 && !origl2)
      return 0;
    if (!origl1)
      return -1;
    if (!origl2)
      return 1;

    /* Loop to get consistent parts of the wto strings, in case
       a conversion fails. */
    got_more = 0;
    l1 = origl1;
    l2 = origl2;
    while (1) {
      c1 = do_convert((iconv_t)-1, MZ_UCS4_NAME, NULL, 1,
                    s1, d1 * 4, 4 * l1,
                    buf1, 0, MZ_SC_BUF_SIZE - 1,
                    1 /* grow */, 0, 1 /* terminator size */,
                    &used1, &clen1,
                    &status);
      c2 = do_convert((iconv_t)-1, MZ_UCS4_NAME, NULL, 1,
                    s2, d2 * 4, 4 * l2,
                    buf2, 0, MZ_SC_BUF_SIZE - 1,
                    1 /* grow */, 0, 1 /* terminator size */,
                    &used2, &clen2,
                    &status);

      if ((used1 < 4 * l1) || (used2 < 4 * l2)) {
       if (got_more) {
         /* Something went wrong. We've already tried to
            even out the parts that work. Let's give up
            on the first characters */
         clen1 = clen2 = 0;
         break;
       } else if (used1 == used2) {
         /* Not everything, but both ended at the same point */
         break;
       } else {
         /* Pick the smallest */
         if (used2 < used1) {
           used1 = used2;
           got_more = 1;
         } else
           got_more = 2;
         l2 = (used1 >> 2);
         l1 = (used1 >> 2);

         if (!l1) {
           /* Nothing to get this time. */
           clen1 = clen2 = 0;
           c1 = c2 = "";
           used1 = used2 = 0;
           break;
         }
       }
      } else
       /* Got all that we wanted */
       break;
    }

    if (cvt_case) {
      if (clen1)
       c1 = locale_recase(0, c1, 0, clen1,
                        case_buf1, 0, MZ_SC_BUF_SIZE - 1,
                        &clen1);
      else
       c1 = NULL;
      if (clen2)
       c2 = locale_recase(0, c2, 0, clen2,
                        case_buf2, 0, MZ_SC_BUF_SIZE - 1,
                        &clen2);
      else
       c2 = NULL;
      /* There shouldn't have been conversion errors, but just in
        case, care of NULL. */
      if (!c1) c1 = "";
      if (!c2) c2 = "";
    }

    /* Collate, finally. */
    status = strcoll(c1, c2);

    /* If one is bigger than the other, we're done. */
    if (status)
      return status;

    /* Otherwise, is there more to check? */
    origl1 -= (used1 >> 2);
    origl2 -= (used2 >> 2);
    d1 += (used1 >> 2);
    d2 += (used2 >> 2);
    if (!origl1 && !origl2)
      return 0;

    /* There's more. It must be that the next character wasn't
       convertable in one of the encodings. */
    if (got_more)
      return ((got_more == 2) ? 1 : -1);

    if (!origl1)
      return -1;

    /* Compare an unconverable character directly. No case conversions
       if it's outside the locale. */
    if (((unsigned int *)s1)[d1] > ((unsigned int *)s2)[d2])
      return 1;
    else if (((unsigned int *)s1)[d1] < ((unsigned int *)s2)[d2])
      return -1;
    else {
      /* We've skipped one unconvertable char, and they still look the
        same.  Now try again. */
      origl1 -= 1;
      origl2 -= 1;
      d1 += 1;
      d2 += 1;
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* mz_recase ( const char *  who,
int  to_up,
mzchar us,
long  ulen 
) [static]

Definition at line 3210 of file string.c.

{
  long ulen1;
  int utf16 = 0, i, delta = 0;
  mzchar *us1;
  recase_proc mz_do_recase = do_locale_recase;
  Scheme_Object *s, *parts = scheme_null;

  reset_locale();

#if defined(MACOS_UNICODE_SUPPORT) || defined(WINDOWS_UNICODE_SUPPORT)
  if (current_locale_name && !*current_locale_name) {
    utf16 = 1;
    mz_do_recase = do_native_recase;
  }
#endif

  if (utf16) {
    us = (mzchar *)scheme_ucs4_to_utf16(us, 0, ulen, NULL, 0, &ulen, 1);
    ((short *)us)[ulen] = 0;
  }

  /* If there are nulls in the string, then we have to make multiple
     calls to mz_do_recase */
  i = 0;
  while (1) {
    for (; i < ulen; i++) {
      if (utf16) {
       if (!((short *)us)[i])
         break;
      } else if (!us[i])
       break;
    }

    us1 = mz_do_recase(to_up, us, delta, i - delta, &ulen1);

    if (utf16) {
      us1 = scheme_utf16_to_ucs4((unsigned short *)us1, 0, ulen1, NULL, 0, &ulen1, 1);
      us1[ulen1] = 0;
    }

    s = scheme_make_sized_char_string((mzchar *)us1, ulen1, 0);

    if (SCHEME_NULLP(parts) && (i == ulen))
      return s;

    parts = scheme_make_pair(s, parts);

    if (i == ulen)
      break;

    /* upcasing and encoding a nul char is easy: */
    s = scheme_make_sized_char_string((mzchar *)"\0\0\0\0", 1, 0);
    parts = scheme_make_pair(s, parts);
    i++;
    delta = i;

    if (i == ulen)
      break;
  }

  return append_all_strings_backwards(parts);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int mz_strcmp ( const char *  who,
unsigned char *  str1,
int  l1,
unsigned char *  str2,
int  l2 
) [static]

Definition at line 4102 of file string.c.

{
  int endres;

  if (l1 > l2) {
    l1 = l2;
    endres = 1;
  } else {
    if (l2 > l1)
      endres = -1;
    else
      endres = 0;
  }

  while (l1--) {
    unsigned int a, b;

    a = *(str1++);
    b = *(str2++);

    a = a - b;
    if (a)
      return a;
  }

  return endres;
}
static Scheme_Object* normalize_c ( Scheme_Object o) [static]

Definition at line 3640 of file string.c.

{
  mzchar *s, *s2, tmp, last_c0 = 0;
  int len, i, j = 0, last_c0_pos = 0, last_cc = 0;

  s = SCHEME_CHAR_STR_VAL(o);
  len = SCHEME_CHAR_STRLEN_VAL(o);

  s2 = (mzchar *)scheme_malloc_atomic((len + 1) * sizeof(mzchar));
  memcpy(s2, s, len * sizeof(mzchar));
  
  for (i = 0; i < len; i++) {
    if ((i + 1 < len)
       && (s2[i] >= MZ_JAMO_INITIAL_CONSONANT_START)
       && (s2[i] <= MZ_JAMO_INITIAL_CONSONANT_END)
       && (s2[i+1] >= MZ_JAMO_VOWEL_START)
       && (s2[i+1] <= MZ_JAMO_VOWEL_END)) {
      /* Need Hangul composition */
      if ((i + 2 < len)
         && (s2[i+2] > MZ_JAMO_TRAILING_CONSONANT_START)
         && (s2[i+2] <= MZ_JAMO_TRAILING_CONSONANT_END)) {
       /* 3-char composition */
       tmp = (MZ_JAMO_SYLLABLE_START
              + ((s2[i] - MZ_JAMO_INITIAL_CONSONANT_START) 
                * MZ_JAMO_VOWEL_COUNT * MZ_JAMO_TRAILING_CONSONANT_COUNT)
              + ((s2[i+1] - MZ_JAMO_VOWEL_START)
                * MZ_JAMO_TRAILING_CONSONANT_COUNT)
              + (s2[i+2] - MZ_JAMO_TRAILING_CONSONANT_START));
       i += 2;
      } else {
       /* 2-char composition */
       tmp = (MZ_JAMO_SYLLABLE_START
              + ((s2[i] - MZ_JAMO_INITIAL_CONSONANT_START) 
                * MZ_JAMO_VOWEL_COUNT * MZ_JAMO_TRAILING_CONSONANT_COUNT)
              + ((s2[i+1] - MZ_JAMO_VOWEL_START)
                * MZ_JAMO_TRAILING_CONSONANT_COUNT));
       i++;
      }
      last_c0 = tmp;
      last_c0_pos = j;
      last_cc = 0;
      s2[j++] = tmp;
    } else {
      int cc;
      
      cc = scheme_combining_class(s2[i]);
      if (last_c0 && (cc > last_cc))
       tmp = get_composition(last_c0, s2[i]);
      else
       tmp = 0;

      if (tmp) {
       /* Need to compose */
       s2[last_c0_pos] = tmp;
       last_c0 = tmp;
      } else if (!cc) {
       /* Reset last_c0... */
       tmp = s2[i];
       if (scheme_needs_maybe_compose(tmp)) {
         last_c0 = tmp;
         last_c0_pos = j;
       } else {
         last_c0 = 0;
       }
       last_cc = -1;
       s2[j++] = tmp;
      } else {
       s2[j++] = s2[i];
       last_cc = cc;
      }
    }
  }

  s2[j] = 0;
  if (len - j > 16) {
    s2 = (mzchar *)scheme_malloc_atomic((j + 1) * sizeof(mzchar));
    memcpy(s2, s, (j + 1) * sizeof(mzchar));
    s2 = s;
  }

  return scheme_make_sized_char_string(s2, j, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* normalize_d ( Scheme_Object o,
int  kompat 
) [static]

Definition at line 3724 of file string.c.

{
  mzchar *s, tmp, *s2;
  int len, i, delta, j, swapped;

  s = SCHEME_CHAR_STR_VAL(o);
  len = SCHEME_CHAR_STRLEN_VAL(o);

  /* Run through string list to predict expansion: */
  delta = 0;
  for (i = 0; i < len; i++) {
    if (scheme_needs_decompose(s[i])) {
      int klen;
      mzchar snd;
      GC_CAN_IGNORE unsigned short *start;

      tmp = s[i];
      while (scheme_needs_decompose(tmp)) {
       if (kompat)
         klen = get_kompat_decomposition(tmp, &start);
       else
         klen = 0;
       if (klen) {
         delta += (klen - 1);
         break;
       } else {
         tmp = get_canon_decomposition(tmp, &snd);
         if (tmp) {
           if (snd) {
             delta++;
             if (kompat) {
              klen = get_kompat_decomposition(snd, &start);
              if (klen)
                delta += (klen - 1);
             }
           }
         } else
           break;
       }
      }
    } else if ((s[i] >= MZ_JAMO_SYLLABLE_START)
              && (s[i] <= MZ_JAMO_SYLLABLE_END)) {
      tmp = s[i];
      tmp -= MZ_JAMO_SYLLABLE_START;
      if (tmp % MZ_JAMO_TRAILING_CONSONANT_COUNT)
       delta += 2;
      else
       delta += 1;
    }
  }

  s2 = (mzchar *)scheme_malloc_atomic((len + delta + 1) * sizeof(mzchar));

  j = 0;
  for (i = 0; i < len; i++) {
    if (scheme_needs_decompose(s[i])) {
      mzchar snd, tmp2;
      int snds = 0, klen = 0, k;
      GC_CAN_IGNORE unsigned short*start;

      tmp = s[i];
      while (scheme_needs_decompose(tmp)) {
       if (kompat)
         klen = get_kompat_decomposition(tmp, &start);
       else
         klen = 0;
       if (klen) {
         for (k = 0; k < klen; k++) {
           s2[j++] = start[k];
         }
         break;
       } else {
         tmp2 = get_canon_decomposition(tmp, &snd);
         if (tmp2) {
           tmp = tmp2;
           if (snd) {
             if (kompat)
              klen = get_kompat_decomposition(snd, &start);
             else
              klen = 0;
             if (klen) {
              snds += klen;
              for (k = 0; k < klen; k++) {
                s2[len + delta - snds + k] = start[k];
              }
              klen = 0;
             } else {
              snds++;
              s2[len + delta - snds] = snd;
             }
           }
         } else 
           break;
       }
      }
      if (!klen)
       s2[j++] = tmp;
      memcpy(s2 + j, s2 + len + delta - snds, snds * sizeof(mzchar));
      j += snds;
    } else if ((s[i] >= MZ_JAMO_SYLLABLE_START)
              && (s[i] <= MZ_JAMO_SYLLABLE_END)) {
      int l, v, t;
      tmp = s[i];
      tmp -= MZ_JAMO_SYLLABLE_START;
      l = tmp / (MZ_JAMO_VOWEL_COUNT * MZ_JAMO_TRAILING_CONSONANT_COUNT);
      v = (tmp % (MZ_JAMO_VOWEL_COUNT * MZ_JAMO_TRAILING_CONSONANT_COUNT)) / MZ_JAMO_TRAILING_CONSONANT_COUNT;
      t = tmp % MZ_JAMO_TRAILING_CONSONANT_COUNT;
      s2[j++] = MZ_JAMO_INITIAL_CONSONANT_START + l;
      s2[j++] = MZ_JAMO_VOWEL_START + v;
      if (t) {
       s2[j++] = MZ_JAMO_TRAILING_CONSONANT_START + t;
      }
    } else {
      s2[j++] = s[i];
    }
  }
  s2[j] = 0;
  len += delta;

  /* Reorder pass: */
  do {
    swapped = 0;
    for (i = 0; i < len; i++) {
      if ((i + 1 < len)
         && scheme_combining_class(s2[i])
         && scheme_combining_class(s2[i+1])
         && (scheme_combining_class(s2[i+1]) < scheme_combining_class(s2[i]))) {
       /* Reorder and try again: */
       tmp = s2[i + 1];
       s2[i + 1] = s2[i];
       s2[i] = tmp;
       i--;
       swapped = 1;
      }
    }
  } while (swapped);

  return scheme_make_sized_char_string(s2, len, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* ok_cmdline ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 2252 of file string.c.

{
  if (SCHEME_VECTORP(argv[0])) {
    Scheme_Object *vec = argv[0], *vec2, *str;
    int i, size = SCHEME_VEC_SIZE(vec);


    if (!size)
      return vec;

    for (i = 0; i < size; i++) {
      if (!SCHEME_CHAR_STRINGP(SCHEME_VEC_ELS(vec)[i]))
       return NULL;
    }

    /* Make sure vector and strings are immutable: */
    vec2 = scheme_make_vector(size, NULL);
    if (size)
      SCHEME_SET_VECTOR_IMMUTABLE(vec2);
    for (i = 0; i < size; i++) {
      str = SCHEME_VEC_ELS(vec)[i];
      if (!SCHEME_IMMUTABLE_CHAR_STRINGP(str)) {
       str = scheme_make_sized_char_string(SCHEME_CHAR_STR_VAL(str), SCHEME_CHAR_STRLEN_VAL(str), 0);
       SCHEME_SET_CHAR_STRING_IMMUTABLE(str);
      }
      SCHEME_VEC_ELS(vec2)[i] = str;
    }

    return vec2;
  }

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* ok_locale ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 2298 of file string.c.

{
  if (SCHEME_FALSEP(argv[0]))
    return argv[0];
  else if (SCHEME_CHAR_STRINGP(argv[0])) {
    if (SCHEME_IMMUTABLEP(argv[0]))
      return argv[0];
    else {
      Scheme_Object *str = argv[0];
      str = scheme_make_immutable_sized_char_string(SCHEME_CHAR_STR_VAL(str), SCHEME_CHAR_STRLEN_VAL(str), 1);
      return str;
    }
  }

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void reset_locale ( void  ) [static]

Definition at line 3303 of file string.c.

{
  Scheme_Object *v;
  const mzchar *name;

  v = scheme_get_param(scheme_current_config(), MZCONFIG_LOCALE);
  locale_on = SCHEME_TRUEP(v);

  if (locale_on) {
    name = SCHEME_CHAR_STR_VAL(v);
#ifndef DONT_USE_LOCALE
    if ((current_locale_name != name)
       && mz_char_strcmp("result-locale",
                       current_locale_name, scheme_char_strlen(current_locale_name),
                       name, SCHEME_CHAR_STRLEN_VAL(v),
                       0, 1)) {
      /* We only need CTYPE and COLLATE; two calls seem to be much
        faster than one call with ALL */
      char *n, buf[32];

      n = scheme_utf8_encode_to_buffer(name, SCHEME_CHAR_STRLEN_VAL(v), buf, 32);

      if (!setlocale(LC_CTYPE, n))
       setlocale(LC_CTYPE, "C");
      if (!setlocale(LC_COLLATE, n))
       setlocale(LC_COLLATE, "C");
    }
#endif
    current_locale_name = name;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_fprintf ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1884 of file string.c.

{
  if (!SCHEME_OUTPUT_PORTP(argv[0]))
    scheme_wrong_type("fprintf", "output-port", 0, argc, argv);

  scheme_do_format("fprintf", argv[0], NULL, 0, 1, 2, argc, argv);
  return scheme_void;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_getenv ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2051 of file string.c.

{
  char *s;
  Scheme_Object *bs;

  if (!SCHEME_CHAR_STRINGP(argv[0])
      || scheme_any_string_has_null(argv[0]))
    scheme_wrong_type("getenv", CHAR_STRING_W_NO_NULLS, 0, argc, argv);

  bs = scheme_char_string_to_byte_string_locale(argv[0]);

#ifdef GETENV_FUNCTION
  s = mzGETENV(SCHEME_BYTE_STR_VAL(bs));
#else
  if (putenv_str_table) {
    s = (char *)scheme_hash_get(putenv_str_table, (Scheme_Object *)SCHEME_BYTE_STR_VAL(argv[0]));
    /* If found, skip over the `=' in the table: */
    if (s)
      s += SCHEME_BYTE_STRTAG_VAL(bs) + 1;
  } else
    s = NULL;
#endif

  if (s)
    return scheme_make_locale_string(s);

  return scheme_false;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_printf ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1876 of file string.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_putenv ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2080 of file string.c.

{
  char *s, *var, *val;
  long varlen, vallen;
  Scheme_Object *bs;

  if (!SCHEME_CHAR_STRINGP(argv[0])
      || scheme_any_string_has_null(argv[0]))
    scheme_wrong_type("putenv", CHAR_STRING_W_NO_NULLS, 0, argc, argv);
  if (!SCHEME_CHAR_STRINGP(argv[1])
      || scheme_any_string_has_null(argv[1]))
    scheme_wrong_type("putenv", CHAR_STRING_W_NO_NULLS, 1, argc, argv);

  bs = scheme_char_string_to_byte_string_locale(argv[0]);
  var = SCHEME_BYTE_STR_VAL(bs);

  bs = scheme_char_string_to_byte_string_locale(argv[1]);
  val = SCHEME_BYTE_STR_VAL(bs);

  varlen = strlen(var);
  vallen = strlen(val);

  s = (char *)scheme_malloc_atomic(varlen + vallen + 2);
  memcpy(s, var, varlen);
  memcpy(s + varlen + 1, val, vallen + 1);
  s[varlen] = '=';

#ifdef MZ_PRECISE_GC
  {
    /* Can't put moveable string into array. */
    char *ss;
    ss = s;
    s = malloc(varlen + vallen + 2);
    memcpy(s, ss, varlen + vallen + 2);

    /* Free old, if in table: */
    if (putenv_str_table) {
      ss = (char *)scheme_hash_get(putenv_str_table, (Scheme_Object *)var);
      if (ss)
       free(ss);
    }
  }
#endif

  if (!putenv_str_table)
    putenv_str_table = scheme_make_hash_table(SCHEME_hash_string);

  scheme_hash_set(putenv_str_table, (Scheme_Object *)var, (Scheme_Object *)s);

#ifdef GETENV_FUNCTION
  return mzPUTENV(var, val, s) ? scheme_false : scheme_true;
#else
  return scheme_true;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1962 of file string.c.

{
  if (SCHEME_BYTE_STRINGP(o))
    return scheme_byte_string_has_null(o);
  else {
    const mzchar *s = SCHEME_CHAR_STR_VAL(o);
    int i = SCHEME_CHAR_STRTAG_VAL(o);
    while (i--) {
      if (!s[i])
       return 1;
    }
    return 0;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

char* scheme_banner ( void  )

Definition at line 1936 of file string.c.

{
  if (embedding_banner)
    return embedding_banner;
  else
    return "Welcome to MzScheme"
      " v" MZSCHEME_VERSION VERSION_SUFFIX
      ", Copyright (c) 2004-2009 PLT Scheme Inc.\n";
}

Definition at line 1951 of file string.c.

{
  const char *s = SCHEME_BYTE_STR_VAL(o);
  int i = SCHEME_BYTE_STRTAG_VAL(o);
  while (i--) {
    if (!s[i])
      return 1;
  }
  return 0;
}

Here is the caller graph for this function:

Definition at line 1296 of file string.c.

{
  return do_byte_string_to_char_string("s->s", o, 0, SCHEME_BYTE_STRLEN_VAL(o), 0xFFFD, 0);
}

Here is the call graph for this function:

Definition at line 1301 of file string.c.

{
  return do_byte_string_to_char_string_locale("s->s", o, 0, SCHEME_BYTE_STRLEN_VAL(o), 0xFFFD);
}

Here is the call graph for this function:

Definition at line 1367 of file string.c.

Here is the call graph for this function:

Definition at line 1372 of file string.c.

Here is the call graph for this function:

Definition at line 3985 of file string.c.

{
  int i;
  for (i = 0; s[i]; i++) {
  }
  return i;
}

Definition at line 4503 of file string.c.

{
  close_converter(conv, NULL);
}

Here is the call graph for this function:

void scheme_do_format ( const char *  procname,
Scheme_Object port,
const mzchar format,
int  flen,
int  fpos,
int  offset,
int  argc,
Scheme_Object **  argv 
)

Definition at line 1600 of file string.c.

{
  int i, start, end;
  int used = offset;
  int num_err = 0, char_err = 0, end_ok = 0;
  Scheme_Object *a[2];

  if (!format) {
    if (!SCHEME_CHAR_STRINGP(argv[fpos])) {
      scheme_wrong_type(procname, "format-string", fpos, argc, argv);
      return;
    }
    format = SCHEME_CHAR_STR_VAL(argv[fpos]);
    flen = SCHEME_CHAR_STRTAG_VAL(argv[fpos]);
  } else if (flen == -1)
    flen = strlen((char *)format);

  /* Check string first: */
  end = flen - 1;
  for (i = 0; i < end; i++) {
    if (format[i] == '~') {
      i++;
      if (scheme_isspace(format[i])) {
       /* skip spaces... */
      } else switch (format[i]) {
      case '~':
       if (i == end)
         end_ok = 1;
       break;
      case '%':
      case 'n':
      case 'N':
       break;
      case 'a':
      case 'A':
      case 's':
      case 'S':
      case 'v':
      case 'V':
      case 'e':
      case 'E':
       used++;
       break;
      case 'x':
      case 'X':
      case 'o':
      case 'O':
      case 'b':
      case 'B':
       if (!num_err && !char_err && (used < argc)) {
         Scheme_Object *o = argv[used];
         if (!SCHEME_EXACT_REALP(o)
             && (!SCHEME_COMPLEXP(o)
                || !SCHEME_EXACT_REALP(scheme_complex_real_part(o))))
           num_err = used + 1;
       }
       used++;
       break;
      case 'c':
      case 'C':
       if (!num_err && !char_err && (used < argc)) {
         if (!SCHEME_CHARP(argv[used]))
           char_err = used + 1;
       }
       used++;
       break;
      default:
       {
         char buffer[64];
         sprintf(buffer, "pattern-string (tag ~%c not allowed)", format[i]);
         scheme_wrong_type(procname, buffer, fpos, argc, argv);
         return;
       }
      }
    }
  }
  if ((format[end] == '~') && !end_ok) {
    scheme_wrong_type(procname, "pattern-string (cannot end in ~)", fpos, argc, argv);
    return;
  }
  if (used != argc) {
    char *args;
    long alen;

    args = scheme_make_args_string("", -1, argc, argv, &alen);

    if (used > argc) {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                     "%s: format string requires %d arguments, given %d%t",
                     procname, used - offset, argc - offset, args, alen);
    } else {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                     "%s: format string requires %d arguments, given %d%t",
                     procname, used - offset, argc - offset, args, alen);
    }
    return;
  }
  if (num_err || char_err) {
    int pos = (num_err ? num_err : char_err) - 1;
    char *args, *bstr;
    long alen;
    int blen;
    char *type = (num_err ? "exact-number" : "character");
    Scheme_Object *bad = argv[pos];

    args = scheme_make_args_string("other ", pos, argc, argv, &alen);
    bstr = scheme_make_provided_string(bad, 1, &blen);
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "%s: format string requires argument of type <%s>, given %t%t",
                   procname, type,
                   bstr, blen,
                   args, alen);
    return;
  }

  for (used = offset, i = start = 0; i < flen; i++) {
    if (format[i] == '~') {
      if (start < i) {
       (void)scheme_put_char_string(procname, port, format, start, i - start);
      }
      i++;
      if (scheme_isspace(format[i])) {
       /* skip spaces (at most one newline) */
       do {
         if ((format[i] == '\n') || (format[i] == '\r')) {
           /* got one */
           if ((format[i] == '\r') && (format[i + 1] == '\n'))
             i++; /* Windows-style CR-NL */
           i++;
           while (portable_isspace(format[i])
                 && !((format[i] == '\n') || (format[i] == '\r'))) {
             i++;
           }
           break;
         } else
           i++;
       } while (scheme_isspace(format[i]));
       --i; /* back up over something */
      } else switch (format[i]) {
      case '~':
       scheme_write_byte_string("~", 1, port);
       break;
      case '%':
      case 'n':
      case 'N':
       scheme_write_byte_string("\n", 1, port);
       break;
      case 'c':
      case 'C':
      case 'a':
      case 'A':
       a[0] = argv[used++];
       a[1] = port;
       _scheme_apply(scheme_display_proc, 2, a);
       break;
      case 's':
      case 'S':
       a[0] = argv[used++];
       a[1] = port;
       _scheme_apply(scheme_write_proc, 2, a);
       break;
      case 'v':
      case 'V':
       a[0] = argv[used++];
       a[1] = port;
       _scheme_apply(scheme_print_proc, 2, a);
       break;
      case 'e':
      case 'E':
       {
         int len;
         char *s;
         s = scheme_make_provided_string(argv[used++], 0, &len);
         scheme_write_byte_string(s, len, port);
       }
       break;
      case 'x':
      case 'X':
      case 'o':
      case 'O':
      case 'b':
      case 'B':
       {
         char *s;
         int radix;

         switch(format[i]) {
         case 'x':
         case 'X':
           radix = 16;
           break;
         case 'o':
         case 'O':
           radix = 8;
           break;
         default:
         case 'b':
         case 'B':
           radix = 2;
           break;
         }
         s = scheme_number_to_string(radix, argv[used++]);

         scheme_write_byte_string(s, strlen(s), port);
       }
       break;
      }
      SCHEME_USE_FUEL(1);
      start = i + 1;
    }
  }

  SCHEME_USE_FUEL(flen);

  if (start < i) {
    (void)scheme_put_char_string(procname, port, format, start, i - start);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_do_get_substring_indices ( const char *  name,
Scheme_Object str,
int  argc,
Scheme_Object **  argv,
int  spos,
int  fpos,
long *  _start,
long *  _finish,
long  len 
)

Definition at line 996 of file string.c.

{
  if (argc > spos) {
    if (SCHEME_INTP(argv[spos])) {
      long start = SCHEME_INT_VAL(argv[spos]);
      if ((start >= 0) && (start < len)) {
        *_start = start;
        if (argc > fpos) {
          long finish = SCHEME_INT_VAL(argv[fpos]);
          if ((finish >= start) && (finish <= len)) {
            *_finish = finish;
            return;
          }
        } else {
          *_finish = len;
          return;
        }
      }
    }
  } else {
    *_start = 0;
    *_finish = len;
    return;
  }

  scheme_get_substring_indices(name, str, argc, argv, spos, fpos, _start, _finish);
}

Here is the call graph for this function:

Here is the caller graph for this function:

long scheme_extract_index ( const char *  name,
int  pos,
int  argc,
Scheme_Object **  argv,
long  top,
int  false_ok 
)

Definition at line 938 of file string.c.

{
  long i;
  int is_top = 0;

  if (SCHEME_INTP(argv[pos])) {
    i = SCHEME_INT_VAL(argv[pos]);
  } else if (SCHEME_BIGNUMP(argv[pos])) {
    if (SCHEME_BIGPOS(argv[pos])) {
      i = top; /* out-of-bounds */
      is_top = 1;
    } else
      i = -1; /* negative */
  } else
    i = -1;

  if (!is_top && (i < 0))
    scheme_wrong_type(name,
                    (false_ok ? "non-negative exact integer or #f" : "non-negative exact integer"),
                    pos, argc, argv);

  return i;
}

Here is the caller graph for this function:

char* scheme_format ( mzchar format,
int  flen,
int  argc,
Scheme_Object **  argv,
long *  rlen 
)

Definition at line 1821 of file string.c.

{
  Scheme_Object *port;
  port = scheme_make_byte_string_output_port();
  scheme_do_format("format", port, format, flen, 0, 0, argc, argv);
  return scheme_get_sized_byte_string_output(port, rlen);
}

Here is the call graph for this function:

char* scheme_format_utf8 ( char *  format,
int  flen,
int  argc,
Scheme_Object **  argv,
long *  rlen 
)

Definition at line 1835 of file string.c.

{
  mzchar *s;
  long srlen;
  if (flen == -1)
    flen = strlen(format);
  s = scheme_utf8_decode_to_buffer_len((unsigned char *)format, flen, NULL, 0, &srlen);
  if (s)
    return scheme_format(s, srlen, argc, argv, rlen);
  else
    return "";
}
void scheme_get_substring_indices ( const char *  name,
Scheme_Object str,
int  argc,
Scheme_Object **  argv,
int  spos,
int  fpos,
long *  _start,
long *  _finish 
)

Definition at line 962 of file string.c.

{
  long len;
  long start, finish;

  if (SCHEME_VECTORP(str))
    len = SCHEME_VEC_SIZE(str);
  else if (SCHEME_CHAR_STRINGP(str))
    len = SCHEME_CHAR_STRTAG_VAL(str);
  else
    len = SCHEME_BYTE_STRTAG_VAL(str);

  if (argc > spos)
    start = scheme_extract_index(name, spos, argc, argv, len + 1, 0);
  else
    start = 0;
  if (argc > fpos)
    finish = scheme_extract_index(name, fpos, argc, argv, len + 1, 0);
  else
    finish = len;

  if (!(start <= len)) {
    scheme_out_of_string_range(name, (fpos < 100) ? "starting " : "", argv[spos], str, 0, len);
  }
  if (!(finish >= start && finish <= len)) {
    scheme_out_of_string_range(name, "ending ", argv[fpos], str, start, len);
  }

  *_start = start;
  *_finish = finish;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 2005 of file string.c.

{
#ifndef GETENV_FUNCTION
  FILE *f = fopen("Environment", "r");
  if (f) {
    Scheme_Object *p = scheme_make_file_input_port(f);
    mz_jmp_buf *savebuf, newbuf;
    savebuf = scheme_current_thread->error_buf;
    scheme_current_thread->error_buf = &newbuf;
    if (!scheme_setjmp(newbuf)) {
      while (1) {
       Scheme_Object *v = scheme_read(p);
       if (SCHEME_EOFP(v))
         break;

       if (SCHEME_PAIRP(v) && SCHEME_PAIRP(SCHEME_CDR(v))
           && SCHEME_NULLP(SCHEME_CDR(SCHEME_CDR(v)))) {
         Scheme_Object *key = SCHEME_CAR(v);
         Scheme_Object *val = SCHEME_CADR(v);
         if (SCHEME_STRINGP(key) && SCHEME_STRINGP(val)) {
           Scheme_Object *a[2];
           a[0] = key;
           a[1] = val;
           sch_putenv(2, a);
           v = NULL;
         }
       }

       if (v)
         scheme_signal_error("bad environment specification: %V", v);
      }
    }
    scheme_current_thread->error_buf = savebuf;
    scheme_close_input_port(p);

    if (scheme_hash_get(putenv_str_table, (Scheme_Object *)"PLTNOMZJIT")) {
      scheme_set_startup_use_jit(0);
    }
  }
#else
  if (mzGETENV("PLTNOMZJIT")) {
    scheme_set_startup_use_jit(0);
  }
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 349 of file string.c.

{
  Scheme_Object *p;

  REGISTER_SO(sys_symbol);
  sys_symbol = scheme_intern_symbol(SYSTEM_TYPE_NAME);

  REGISTER_SO(zero_length_char_string);
  REGISTER_SO(zero_length_byte_string);
  zero_length_char_string = scheme_alloc_char_string(0, 0);
  zero_length_byte_string = scheme_alloc_byte_string(0, 0);

  REGISTER_SO(complete_symbol);
  REGISTER_SO(continues_symbol);
  REGISTER_SO(aborts_symbol);
  REGISTER_SO(error_symbol);
  complete_symbol = scheme_intern_symbol("complete");
  continues_symbol = scheme_intern_symbol("continues");
  aborts_symbol = scheme_intern_symbol("aborts");
  error_symbol = scheme_intern_symbol("error");

  REGISTER_SO(platform_3m_path);
#ifdef UNIX_FILE_SYSTEM
# define MZ3M_SUBDIR "/3m"
#else
# ifdef DOS_FILE_SYSTEM
#  define MZ3M_SUBDIR "\\3m"
# else
#  define MZ3M_SUBDIR ":3m"
# endif
#endif
  REGISTER_SO(platform_3m_path);
  REGISTER_SO(platform_cgc_path);
  platform_cgc_path = scheme_make_path(SCHEME_PLATFORM_LIBRARY_SUBPATH);
  platform_3m_path = scheme_make_path(SCHEME_PLATFORM_LIBRARY_SUBPATH MZ3M_SUBDIR);

  REGISTER_SO(putenv_str_table);
  REGISTER_SO(embedding_banner);
  REGISTER_SO(current_locale_name);

  p = scheme_make_folding_prim(string_p, "string?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("string?", p, env);

  scheme_add_global_constant("make-string",
                          scheme_make_immed_prim(make_string,
                                              "make-string",
                                              1, 2),
                          env);
  scheme_add_global_constant("string",
                          scheme_make_immed_prim(string,
                                              "string",
                                              0, -1),
                          env);
  scheme_add_global_constant("string-length",
                          scheme_make_folding_prim(string_length,
                                                "string-length",
                                                1, 1, 1),
                          env);

  p = scheme_make_immed_prim(scheme_checked_string_ref, "string-ref", 2, 2);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("string-ref", p, env);


  p = scheme_make_immed_prim(scheme_checked_string_set, "string-set!", 3, 3);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
  scheme_add_global_constant("string-set!", p, env);

  scheme_add_global_constant("string=?",
                          scheme_make_immed_prim(string_eq,
                                              "string=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-locale=?",
                          scheme_make_immed_prim(string_locale_eq,
                                              "string-locale=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-ci=?",
                          scheme_make_immed_prim(string_ci_eq,
                                              "string-ci=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-locale-ci=?",
                          scheme_make_immed_prim(string_locale_ci_eq,
                                              "string-locale-ci=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string<?",
                          scheme_make_immed_prim(string_lt,
                                              "string<?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-locale<?",
                          scheme_make_immed_prim(string_locale_lt,
                                              "string-locale<?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string>?",
                          scheme_make_immed_prim(string_gt,
                                              "string>?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-locale>?",
                          scheme_make_immed_prim(string_locale_gt,
                                              "string-locale>?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string<=?",
                          scheme_make_immed_prim(string_lt_eq,
                                              "string<=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string>=?",
                          scheme_make_immed_prim(string_gt_eq,
                                              "string>=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-ci<?",
                          scheme_make_immed_prim(string_ci_lt,
                                              "string-ci<?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-locale-ci<?",
                          scheme_make_immed_prim(string_locale_ci_lt,
                                              "string-locale-ci<?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-ci>?",
                          scheme_make_immed_prim(string_ci_gt,
                                              "string-ci>?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-locale-ci>?",
                          scheme_make_immed_prim(string_locale_ci_gt,
                                              "string-locale-ci>?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-ci<=?",
                          scheme_make_immed_prim(string_ci_lt_eq,
                                              "string-ci<=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("string-ci>=?",
                          scheme_make_immed_prim(string_ci_gt_eq,
                                              "string-ci>=?",
                                              2, -1),
                          env);

  scheme_add_global_constant("substring",
                          scheme_make_immed_prim(substring,
                                              "substring",
                                              2, 3),
                          env);
  scheme_add_global_constant("string-append",
                          scheme_make_immed_prim(string_append,
                                              "string-append",
                                              0, -1),
                          env);
  scheme_add_global_constant("string->list",
                          scheme_make_immed_prim(string_to_list,
                                              "string->list",
                                              1, 1),
                          env);
  scheme_add_global_constant("list->string",
                          scheme_make_immed_prim(list_to_string,
                                              "list->string",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-copy",
                          scheme_make_immed_prim(string_copy,
                                              "string-copy",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-copy!",
                          scheme_make_immed_prim(string_copy_bang,
                                              "string-copy!",
                                              3, 5),
                          env);
  scheme_add_global_constant("string-fill!",
                          scheme_make_immed_prim(string_fill,
                                              "string-fill!",
                                              2, 2),
                          env);
  scheme_add_global_constant("string->immutable-string",
                          scheme_make_immed_prim(string_to_immutable,
                                              "string->immutable-string",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-normalize-nfc",
                          scheme_make_immed_prim(string_normalize_c,
                                              "string-normalize-nfc",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-normalize-nfkc",
                          scheme_make_immed_prim(string_normalize_kc,
                                              "string-normalize-nfkc",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-normalize-nfd",
                          scheme_make_immed_prim(string_normalize_d,
                                              "string-normalize-nfd",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-normalize-nfkd",
                          scheme_make_immed_prim(string_normalize_kd,
                                              "string-normalize-nfkd",
                                              1, 1),
                          env);

  scheme_add_global_constant("string-upcase",
                          scheme_make_immed_prim(string_upcase,
                                              "string-upcase",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-downcase",
                          scheme_make_immed_prim(string_downcase,
                                              "string-downcase",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-titlecase",
                          scheme_make_immed_prim(string_titlecase,
                                              "string-titlecase",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-foldcase",
                          scheme_make_immed_prim(string_foldcase,
                                              "string-foldcase",
                                              1, 1),
                          env);

  scheme_add_global_constant("string-locale-upcase",
                          scheme_make_immed_prim(string_locale_upcase,
                                              "string-locale-upcase",
                                              1, 1),
                          env);
  scheme_add_global_constant("string-locale-downcase",
                          scheme_make_immed_prim(string_locale_downcase,
                                              "string-locale-downcase",
                                              1, 1),
                          env);

  scheme_add_global_constant("current-locale",
                          scheme_register_parameter(current_locale,
                                                 "current-locale",
                                                 MZCONFIG_LOCALE),
                          env);
  scheme_add_global_constant("locale-string-encoding",
                          scheme_make_immed_prim(locale_string_encoding,
                                              "locale-string-encoding",
                                              0, 0),
                          env);
  scheme_add_global_constant("system-language+country",
                          scheme_make_immed_prim(system_language_country,
                                              "system-language+country",
                                              0, 0),
                          env);

  scheme_add_global_constant("bytes-converter?",
                          scheme_make_immed_prim(byte_converter_p,
                                              "bytes-converter?",
                                              1, 1),
                          env);
  scheme_add_global_constant("bytes-convert",
                          scheme_make_prim_w_arity2(byte_string_convert,
                                                 "bytes-convert",
                                                 1, 7,
                                                 3, 3),
                          env);
  scheme_add_global_constant("bytes-convert-end",
                          scheme_make_prim_w_arity2(byte_string_convert_end,
                                                 "bytes-convert-end",
                                                 0, 3,
                                                 2, 2),
                          env);
  scheme_add_global_constant("bytes-open-converter",
                          scheme_make_immed_prim(byte_string_open_converter,
                                              "bytes-open-converter",
                                              2, 2),
                          env);
  scheme_add_global_constant("bytes-close-converter",
                          scheme_make_immed_prim(byte_string_close_converter,
                                              "bytes-close-converter",
                                              1, 1),
                          env);

  scheme_add_global_constant("format",
                          scheme_make_noncm_prim(format,
                                                    "format",
                                                    1, -1),
                          env);
  scheme_add_global_constant("printf",
                          scheme_make_noncm_prim(sch_printf,
                                                    "printf",
                                                    1, -1),
                          env);
  scheme_add_global_constant("fprintf",
                          scheme_make_noncm_prim(sch_fprintf,
                                                    "fprintf",
                                                    2, -1),
                          env);

  scheme_add_global_constant("byte?",
                          scheme_make_folding_prim(byte_p,
                                                "byte?",
                                                1, 1, 1),
                          env);

  p = scheme_make_folding_prim(byte_string_p, "bytes?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
  scheme_add_global_constant("bytes?", p, env);

  scheme_add_global_constant("make-bytes",
                          scheme_make_immed_prim(make_byte_string,
                                              "make-bytes",
                                              1, 2),
                          env);
  scheme_add_global_constant("bytes",
                          scheme_make_immed_prim(byte_string,
                                              "bytes",
                                              0, -1),
                          env);
  scheme_add_global_constant("bytes-length",
                          scheme_make_folding_prim(byte_string_length,
                                                "bytes-length",
                                                1, 1, 1),
                          env);

  p = scheme_make_immed_prim(scheme_checked_byte_string_ref, "bytes-ref", 2, 2);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("bytes-ref", p, env);

  p = scheme_make_immed_prim(scheme_checked_byte_string_set, "bytes-set!", 3, 3);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
  scheme_add_global_constant("bytes-set!", p, env);

  scheme_add_global_constant("bytes=?",
                          scheme_make_immed_prim(byte_string_eq,
                                              "bytes=?",
                                              2, -1),
                          env);
  scheme_add_global_constant("bytes<?",
                          scheme_make_immed_prim(byte_string_lt,
                                              "bytes<?",
                                              2, -1),
                          env);
  scheme_add_global_constant("bytes>?",
                          scheme_make_immed_prim(byte_string_gt,
                                              "bytes>?",
                                              2, -1),
                          env);

  scheme_add_global_constant("subbytes",
                          scheme_make_immed_prim(byte_substring,
                                              "subbytes",
                                              2, 3),
                          env);
  scheme_add_global_constant("bytes-append",
                          scheme_make_immed_prim(byte_string_append,
                                              "bytes-append",
                                              0, -1),
                          env);
  scheme_add_global_constant("bytes->list",
                          scheme_make_immed_prim(byte_string_to_list,
                                              "bytes->list",
                                              1, 1),
                          env);
  scheme_add_global_constant("list->bytes",
                          scheme_make_immed_prim(list_to_byte_string,
                                              "list->bytes",
                                              1, 1),
                          env);
  scheme_add_global_constant("bytes-copy",
                          scheme_make_immed_prim(byte_string_copy,
                                              "bytes-copy",
                                              1, 1),
                          env);
  scheme_add_global_constant("bytes-copy!",
                          scheme_make_immed_prim(byte_string_copy_bang,
                                              "bytes-copy!",
                                              3, 5),
                          env);
  scheme_add_global_constant("bytes-fill!",
                          scheme_make_immed_prim(byte_string_fill,
                                              "bytes-fill!",
                                              2, 2),
                          env);
  scheme_add_global_constant("bytes->immutable-bytes",
                          scheme_make_immed_prim(byte_string_to_immutable,
                                              "bytes->immutable-bytes",
                                              1, 1),
                          env);


  scheme_add_global_constant("bytes-utf-8-index",
                          scheme_make_immed_prim(byte_string_utf8_index,
                                              "bytes-utf-8-index",
                                              2, 4),
                          env);
  scheme_add_global_constant("bytes-utf-8-length",
                          scheme_make_immed_prim(byte_string_utf8_length,
                                              "bytes-utf-8-length",
                                              1, 4),
                          env);
  scheme_add_global_constant("bytes-utf-8-ref",
                          scheme_make_immed_prim(byte_string_utf8_ref,
                                              "bytes-utf-8-ref",
                                              2, 4),
                          env);

  scheme_add_global_constant("bytes->string/utf-8",
                          scheme_make_immed_prim(byte_string_to_char_string,
                                              "bytes->string/utf-8",
                                              1, 4),
                          env);
  scheme_add_global_constant("bytes->string/locale",
                          scheme_make_immed_prim(byte_string_to_char_string_locale,
                                              "bytes->string/locale",
                                              1, 4),
                          env);
  scheme_add_global_constant("bytes->string/latin-1",
                          scheme_make_immed_prim(byte_string_to_char_string_latin1,
                                              "bytes->string/latin-1",
                                              1, 4),
                          env);
  scheme_add_global_constant("string->bytes/utf-8",
                          scheme_make_immed_prim(char_string_to_byte_string,
                                              "string->bytes/utf-8",
                                              1, 4),
                          env);
  scheme_add_global_constant("string->bytes/locale",
                          scheme_make_immed_prim(char_string_to_byte_string_locale,
                                              "string->bytes/locale",
                                              1, 4),
                          env);
  scheme_add_global_constant("string->bytes/latin-1",
                          scheme_make_immed_prim(char_string_to_byte_string_latin1,
                                              "string->bytes/latin-1",
                                              1, 4),
                          env);

  scheme_add_global_constant("string-utf-8-length",
                          scheme_make_immed_prim(char_string_utf8_length,
                                              "string-utf-8-length",
                                              1, 3),
                          env);


  /* In principle, `version' could be foldable, but it invites
     more problems than it solves... */

  scheme_add_global_constant("version",
                          scheme_make_immed_prim(version,
                                              "version",
                                              0, 0),
                          env);
  scheme_add_global_constant("banner",
                          scheme_make_immed_prim(banner,
                                              "banner",
                                              0, 0),
                          env);

  scheme_add_global_constant("getenv",
                          scheme_make_immed_prim(sch_getenv,
                                              "getenv",
                                              1, 1),
                          env);
  scheme_add_global_constant("putenv",
                          scheme_make_immed_prim(sch_putenv,
                                              "putenv",
                                              2, 2),
                          env);

  /* Don't make these folding, since they're platform-specific: */

  scheme_add_global_constant("system-type",
                          scheme_make_immed_prim(system_type,
                                              "system-type",
                                              0, 1),
                          env);
  scheme_add_global_constant("system-library-subpath",
                          scheme_make_immed_prim(system_library_subpath,
                                              "system-library-subpath",
                                              0, 1),
                          env);

  scheme_add_global_constant("current-command-line-arguments",
                          scheme_register_parameter(cmdline_args,
                                                 "current-command-line-arguments",
                                                 MZCONFIG_CMDLINE_ARGS),
                          env);

#ifdef MZ_PRECISE_GC
  register_traversers();
#endif
}

Here is the caller graph for this function:

Scheme_Object* scheme_make_immutable_sized_utf8_string ( char *  chars,
long  len 
)

Definition at line 880 of file string.c.

Definition at line 898 of file string.c.

Here is the call graph for this function:

Scheme_Object* scheme_make_sized_offset_utf8_string ( char *  chars,
long  d,
long  len 
)

Definition at line 851 of file string.c.

{
  long ulen;
  mzchar *us;

  if (len) {
    ulen = scheme_utf8_decode((unsigned char *)chars, d, d + len,
                           NULL, 0, -1,
                           NULL, 0 /* not UTF-16 */, 0xFFFD);
    us = scheme_malloc_atomic(sizeof(mzchar) * (ulen + 1));
    scheme_utf8_decode((unsigned char *)chars, d, d + len,
                     us, 0, -1,
                     NULL, 0 /* not UTF-16 */, 0xFFFD);

    us[ulen] = 0;
  } else {
    us = (mzchar *)"\0\0\0";
    ulen = 0;
  }
  return scheme_make_sized_offset_char_string(us, 0, ulen, 0);
}

Here is the call graph for this function:

Scheme_Object* scheme_make_sized_utf8_string ( char *  chars,
long  len 
)

Definition at line 874 of file string.c.

Definition at line 892 of file string.c.

{
  return scheme_make_sized_offset_utf8_string((char *)chars, 0, -1);
}
Scheme_Object* scheme_open_converter ( const char *  from_e,
const char *  to_e 
)

Definition at line 4151 of file string.c.

{
  Scheme_Converter *c;
  iconv_t cd;
  int kind;
  int permissive;
  int need_regis = 1;
  Scheme_Custodian_Reference *mref;

  if (!iconv_ready) init_iconv();

  if (!*to_e || !*from_e)
    reset_locale();

  if ((!strcmp(from_e, "UTF-8")
       || !strcmp(from_e, "UTF-8-permissive")
       || (!*from_e && mzLOCALE_IS_UTF_8(current_locale_name)))
      && (!strcmp(to_e, "UTF-8")
         || (!*to_e && mzLOCALE_IS_UTF_8(current_locale_name)))) {
    /* Use the built-in UTF-8<->UTF-8 converter: */
    kind = mzUTF8_KIND;
    if (!strcmp(from_e, "UTF-8-permissive"))
      permissive = 0xFFFD;
    else
      permissive = 0;
    cd = (iconv_t)-1;
    need_regis = (*to_e && *from_e);
  } else if ((!strcmp(from_e, "platform-UTF-8")
             || !strcmp(from_e, "platform-UTF-8-permissive"))
            && !strcmp(to_e, "platform-UTF-16")) {
    kind = mzUTF8_TO_UTF16_KIND;
    if (!strcmp(from_e, "platform-UTF-8-permissive"))
      permissive = 0xFFFD;
    else
      permissive = 0;
    cd = (iconv_t)-1;
    need_regis = 0;
  } else if (!strcmp(from_e, "platform-UTF-16")
            && !strcmp(to_e, "platform-UTF-8")) {
    kind = mzUTF16_TO_UTF8_KIND;
    permissive = 0;
    cd = (iconv_t)-1;
    need_regis = 0;
  } else {
    if (!iconv_ready) init_iconv();

    if (!mzCHK_PROC(iconv_open))
      return scheme_false;

    if (!*from_e || !*to_e)
      reset_locale();

    if (!*from_e)
      from_e = mz_iconv_nl_langinfo();
    if (!*to_e)
      to_e = mz_iconv_nl_langinfo();
    cd = iconv_open(to_e, from_e);

    if (cd == (iconv_t)-1)
      return scheme_false;

    kind = mzICONV_KIND;
    permissive = 0;
  }

  c = MALLOC_ONE_TAGGED(Scheme_Converter);
  c->so.type = scheme_string_converter_type;
  c->closed = 0;
  c->kind = kind;
  c->permissive = permissive;
  c->cd = cd;
  if (!need_regis)
    mref = NULL;
  else
    mref = scheme_add_managed(NULL,
                           (Scheme_Object *)c,
                           close_converter,
                           NULL, 1);
  c->mref = mref;

  return (Scheme_Object *)c;
}

Here is the call graph for this function:

void scheme_out_of_string_range ( const char *  name,
const char *  which,
Scheme_Object i,
Scheme_Object s,
long  start,
long  len 
)

Definition at line 907 of file string.c.

{
  int is_byte;

  is_byte = SCHEME_BYTE_STRINGP(s);

  if (len) {
    char *sstr;
    int slen;

    sstr = scheme_make_provided_string(s, 2, &slen);
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "%s: %sindex %s out of range [%d, %d] for %s%s: %t",
                   name, which,
                   scheme_make_provided_string(i, 2, NULL),
                   start, len,
                   is_byte ? "byte-" : "",
                     SCHEME_VECTORP(s) ? "vector" : "string",
                   sstr, slen);
  } else {
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "%s: %sindex %s out of range for empty %s%s",
                   name, which,
                   scheme_make_provided_string(i, 0, NULL),
                   is_byte ? "byte-" : "",
                     SCHEME_VECTORP(s) ? "vector" : "string");
  }
}

Here is the caller graph for this function:

void scheme_printf ( mzchar format,
int  flen,
int  argc,
Scheme_Object **  argv 
)

Definition at line 1829 of file string.c.

Here is the call graph for this function:

void scheme_printf_utf8 ( char *  format,
int  flen,
int  argc,
Scheme_Object **  argv 
)

Definition at line 1848 of file string.c.

{
  mzchar *s;
  long srlen;
  if (flen == -1)
    flen = strlen(format);
  s = scheme_utf8_decode_to_buffer_len((unsigned char *)format, flen, NULL, 0, &srlen);
  if (s)
    scheme_printf(s, srlen, argc, argv);
}
void scheme_set_banner ( char *  s)

Definition at line 1946 of file string.c.

Here is the caller graph for this function:

mzchar* scheme_string_recase ( mzchar s,
int  d,
int  len,
int  mode,
int  inplace,
int _len 
)

Definition at line 3390 of file string.c.

{
  mzchar *t;
  int i, extra = 0, pos, special = 0, td, prev_was_cased = 0, xmode = mode;

  for (i = 0; i < len; i++) {
    if (scheme_isspecialcasing(s[d+i])) {
      pos = find_special_casing(s[d+i]);
      if (!uchar_special_casings[pos + 9] || is_final_sigma(xmode, s, d, i, len)) {
       special = 1;
       extra += (uchar_special_casings[pos + 1 + (xmode << 1)] - 1);
      }
    }
    if (mode == 2) {
      if (!scheme_iscaseignorable(s[d+i]))
       prev_was_cased = scheme_iscased(s[d+i]);
      xmode = (prev_was_cased ? 0 : 2);
    }
  }

  if (_len)
    *_len = len + extra;

  if (!extra && inplace) {
    t = s;
    td = d;
  } else {
    t = scheme_malloc_atomic(sizeof(mzchar) * (len + extra + 1));
    td = 0;
  }

  if (!special) {
    if (mode == 0) {
      for (i = 0; i < len; i++) {
       t[i+td] = scheme_tolower(s[i+d]);
      }
    } else if (mode == 1) {
      for (i = 0; i < len; i++) {
       t[i+td] = scheme_toupper(s[i+d]);
      }
    } else if (mode == 2) {
      prev_was_cased = 0;
      for (i = 0; i < len; i++) {
       if (!prev_was_cased)
         t[i+td] = scheme_totitle(s[i+d]);
       else
         t[i+td] = scheme_tolower(s[i+d]);
       if (!scheme_iscaseignorable(s[i+d]))
         prev_was_cased = scheme_iscased(s[i+d]);
      }
    } else /* if (mode == 3) */ {
      for (i = 0; i < len; i++) {
       t[i+td] = scheme_tofold(s[i+d]);
      }
    }
  } else {
    int j = 0, c;
    prev_was_cased = 0;
    for (i = 0; i < len; i++) {
      if (mode == 0) {
       t[j+td] = scheme_tolower(s[i+d]);
      } else if (mode == 1) {
       t[j+td] = scheme_toupper(s[i+d]);
      } else if (mode == 2) {
       if (!prev_was_cased) {
         xmode = 2;
         t[j+td] = scheme_totitle(s[i+d]);
       } else {
         xmode = 0;
         t[j+td] = scheme_tolower(s[i+d]);
       }
       if (!scheme_iscaseignorable(s[i+d]))
         prev_was_cased = scheme_iscased(s[i+d]);
      } else /* if (mode == 3) */ {
       t[j+td] = scheme_tofold(s[i+d]);
      }

      if (scheme_isspecialcasing(s[i+d])) {
       pos = find_special_casing(s[i+d]);
       if (!uchar_special_casings[pos + 9] || is_final_sigma(xmode, s, d, i, len)) {
         c = uchar_special_casings[pos + 1 + (xmode << 1)];
         pos = uchar_special_casings[pos + 2 + (xmode << 1)];
         while (c--) {
           t[(j++)+td] = uchar_special_casing_data[pos++];
         }
       } else
         j++;
      } else
       j++;
    }
  }
  t[len+extra+td] = 0;

  return t;
}

Here is the call graph for this function:

int scheme_strncmp ( const char *  a,
const char *  b,
int  len 
)

Definition at line 2239 of file string.c.

{
  while (len-- && (*a == *b) && *a) {
    a++;
    b++;
  }

  if (len < 0)
    return 0;
  else
    return *a - *b;
}

Here is the caller graph for this function:

Definition at line 2231 of file string.c.

{
  return SCHEME_PLATFORM_LIBRARY_SUBPATH;
}
unsigned short* scheme_ucs4_to_utf16 ( const mzchar text,
int  start,
int  end,
unsigned short *  buf,
int  bufsize,
long *  ulen,
int  term_size 
)

Definition at line 5187 of file string.c.

{
  mzchar v;
  int extra, i, j;
  unsigned short *utf16;

  /* Count characters that fall outside UCS-2: */
  for (i = start, extra = 0; i < end; i++) {
    if (text[i] > 0xFFFF)
      extra++;
  }

  if ((end - start) + extra + term_size < bufsize)
    utf16 = buf;
  else
    utf16 = (unsigned short *)scheme_malloc_atomic(sizeof(unsigned short) * ((end - start) + extra + term_size));

  for (i = start, j = 0; i < end; i++) {
    v = text[i];
    if (v > 0xFFFF) {
      utf16[j++] = 0xD800 | ((v >> 10) & 0x3FF);
      utf16[j++] = 0xDC00 | (v & 0x3FF);
    } else
      utf16[j++] = v;
  }

  *ulen = j;

  return utf16;
}
mzchar* scheme_utf16_to_ucs4 ( const unsigned short *  text,
int  start,
int  end,
mzchar buf,
int  bufsize,
long *  ulen,
int  term_size 
)

Definition at line 5220 of file string.c.

{
  int wc;
  int i, j;

  for (i = start, j = 0; i < end; i++) {
    wc = text[i];
    if ((wc & 0xF800) == 0xD800) {
      i++;
    }
    j++;
  }

  if (j + term_size >= bufsize)
    buf = (mzchar *)scheme_malloc_atomic((j + term_size) * sizeof(mzchar));

  for (i = start, j = 0; i < end; i++) {
    wc = text[i];
    if ((wc & 0xF800) == 0xD800) {
      i++;
      wc = ((wc & 0x3FF) << 10) + ((((unsigned short *)text)[i]) & 0x3FF);
      wc += 0x10000;
    }
    buf[j++] = wc;
  }

  *ulen = j;

  return buf;
}
int scheme_utf8_decode ( const unsigned char *  s,
int  start,
int  end,
unsigned int us,
int  dstart,
int  dend,
long *  ipos,
char  utf16,
int  permissive 
)

Definition at line 4885 of file string.c.

{
  return utf8_decode_x(s, start, end, us, dstart, dend,
                     ipos, NULL, utf16, utf16, NULL, 0, permissive);
}

Here is the call graph for this function:

int scheme_utf8_decode_all ( const unsigned char *  s,
int  len,
unsigned int us,
int  permissive 
)

Definition at line 4904 of file string.c.

{
  return utf8_decode_x(s, 0, len, us, 0, -1, NULL, NULL, 0, 0, NULL, 0, permissive);
}

Here is the call graph for this function:

int scheme_utf8_decode_as_prefix ( const unsigned char *  s,
int  start,
int  end,
unsigned int us,
int  dstart,
int  dend,
long *  ipos,
char  utf16,
int  permissive 
)

Definition at line 4893 of file string.c.

{
  long opos;
  utf8_decode_x(s, start, end, us, dstart, dend,
              ipos, &opos, utf16, utf16, NULL, 1, permissive);
  return opos - dstart;
}

Here is the call graph for this function:

int scheme_utf8_decode_count ( const unsigned char *  s,
int  start,
int  end,
int _state,
int  might_continue,
int  permissive 
)

Definition at line 4956 of file string.c.

{
  long pos = 0;

  if (!_state || !*_state) {
    /* Try fast path (all ASCII): */
    int i;
    for (i = start; i < end; i++) {
      if (s[i] > 127)
       break;
    }
    if (i == end)
      return end - start;
  }

  utf8_decode_x(s, start, end,
              NULL, 0, -1,
              NULL, &pos,
              0, 0, _state,
              might_continue, permissive);

  return pos;
}

Here is the call graph for this function:

int scheme_utf8_decode_prefix ( const unsigned char *  s,
int  len,
unsigned int us,
int  permissive 
)

Definition at line 4909 of file string.c.

{
  {
    /* Try fast path (all ASCII) */
    int i;
    for (i = 0; i < len; i++) {
      if (s[i] < 128)
       us[i] = s[i];
      else
       break;
    }
    if (i == len)
      return len;
  }

  return utf8_decode_x(s, 0, len, us, 0, -1, NULL, NULL, 0, 0, NULL, 1, permissive);
}

Here is the call graph for this function:

mzchar* scheme_utf8_decode_to_buffer ( const unsigned char *  s,
int  len,
mzchar buf,
int  blen 
)

Definition at line 4949 of file string.c.

{
  long ulen;
  return scheme_utf8_decode_to_buffer_len(s, len, buf, blen, &ulen);
}
mzchar* scheme_utf8_decode_to_buffer_len ( const unsigned char *  s,
int  len,
mzchar buf,
int  blen,
long *  _ulen 
)

Definition at line 4928 of file string.c.

{
  int ulen;

  ulen = utf8_decode_x(s, 0, len, NULL, 0, -1,
                     NULL, NULL, 0, 0,
                     NULL, 0, 0);
  if (ulen < 0)
    return NULL;
  if (ulen + 1 > blen) {
    buf = (mzchar *)scheme_malloc_atomic((ulen + 1) * sizeof(mzchar));
  }
  utf8_decode_x(s, 0, len, buf, 0, -1,
              NULL, NULL, 0, 0,
              NULL, 0, 0);
  buf[ulen] = 0;
  *_ulen = ulen;
  return buf;
}

Here is the call graph for this function:

int scheme_utf8_encode ( const unsigned int us,
int  start,
int  end,
unsigned char *  s,
int  dstart,
char  utf16 
)

Definition at line 5135 of file string.c.

{
  return utf8_encode_x(us, start, end,
                     s, dstart, -1,
                     NULL, NULL, utf16);
}

Here is the call graph for this function:

int scheme_utf8_encode_all ( const unsigned int us,
int  len,
unsigned char *  s 
)

Definition at line 5144 of file string.c.

{
  return utf8_encode_x(us, 0, len, s, 0, -1, NULL, NULL, 0 /* utf16 */);
}

Here is the call graph for this function:

char* scheme_utf8_encode_to_buffer ( const mzchar s,
int  len,
char *  buf,
int  blen 
)

Definition at line 5180 of file string.c.

{
  long slen;
  return scheme_utf8_encode_to_buffer_len(s, len, buf, blen, &slen);
}
char* scheme_utf8_encode_to_buffer_len ( const mzchar s,
int  len,
char *  buf,
int  blen,
long *  _slen 
)

Definition at line 5149 of file string.c.

{
  int slen;

  /* ASCII with len < blen is a common case: */
  if (len < blen) {
    for (slen = 0; slen < len; slen++) {
      if (s[slen] > 127)
        break;
      else
        buf[slen] = s[slen];
    }
    if (slen == len) {
      buf[slen] = 0;
      *_slen = slen;
      return buf;
    }
  }

  slen = utf8_encode_x(s, 0, len, NULL, 0, -1, NULL, NULL, 0);
  if (slen + 1 > blen) {
    buf = (char *)scheme_malloc_atomic(slen + 1);
  }
  utf8_encode_x(s, 0, len, (unsigned char *)buf, 0, -1, NULL, NULL, 0);
  buf[slen] = 0;
  *_slen = slen;
  return buf;
}

Here is the call graph for this function:

char* scheme_version ( void  )

Definition at line 1921 of file string.c.

{
  return MZSCHEME_VERSION;
}
static Scheme_Object* string ( int  argc,
Scheme_Object argv[] 
) [static]
static Scheme_Object* string_append ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_ci_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_ci_gt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_ci_gt_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_ci_lt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_ci_lt_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_copy ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_copy_bang ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * string_downcase ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3507 of file string.c.

{
  return string_recase("string-downcase", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* string_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_fill ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * string_foldcase ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3517 of file string.c.

{
  return string_recase("string-foldcase", argc, argv, 3);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* string_gt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_gt_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_length ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_locale_ci_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_locale_ci_gt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_locale_ci_lt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * string_locale_downcase ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3298 of file string.c.

{
  return unicode_recase("string-locale-downcase", 0, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* string_locale_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_locale_gt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_locale_lt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * string_locale_upcase ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3292 of file string.c.

{
  return unicode_recase("string-locale-upcase", 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* string_lt ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_lt_eq ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * string_normalize_c ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3922 of file string.c.

{
  return do_string_normalize_c("string-normalize-nfc", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * string_normalize_d ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3971 of file string.c.

{
  return do_string_normalize_d("string-normalize-nfd", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * string_normalize_kc ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3927 of file string.c.

{
  return do_string_normalize_c("string-normalize-nfkc", argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * string_normalize_kd ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3976 of file string.c.

{
  return do_string_normalize_d("string-normalize-nfkd", argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* string_p ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_recase ( const char *  name,
int  argc,
Scheme_Object argv[],
int  mode 
) [static]

Definition at line 3486 of file string.c.

{
  mzchar *s;
  int len;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type(name, "string", 0, argc, argv);
  
  s = SCHEME_CHAR_STR_VAL(argv[0]);
  len = SCHEME_CHAR_STRLEN_VAL(argv[0]);

  s = scheme_string_recase(s, 0, len, mode, 0, &len);

  return scheme_make_sized_char_string(s, len, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * string_titlecase ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3512 of file string.c.

{
  return string_recase("string-titlecase", argc, argv, 2);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char * string_to_from_locale ( int  to_bytes,
char *  in,
int  delta,
int  len,
long *  olen,
int  perm,
int no_cvt 
) [static]

Definition at line 2623 of file string.c.

{
  Scheme_Object *parts = scheme_null, *one;
  char *c;
  long clen, used;
  int status;
  iconv_t cd;

  if (!iconv_ready) init_iconv();

  if (to_bytes)
    cd = iconv_open(mz_iconv_nl_langinfo(), MZ_UCS4_NAME);
  else
    cd = iconv_open(MZ_UCS4_NAME, mz_iconv_nl_langinfo());
  if (cd == (iconv_t)-1) {
    *no_cvt = 1;
    return NULL;
  }
  *no_cvt = 0;

  while (len) {
    /* We might have conversion errors... */
    c = do_convert(cd, NULL, NULL, 0,
                 (char *)in, (to_bytes ? 4 : 1) * delta, (to_bytes ? 4 : 1) * len,
                 NULL, 0, (to_bytes ? 1 : 4) * (len + 1),
                 1 /* grow */, 1, (to_bytes ? 1 : 4) /* terminator size */,
                 &used, &clen,
                 &status);

    if (to_bytes)
      used >>= 2;

    if ((perm < 0) && (used < len)) {
      iconv_close(cd);
      return NULL;
    }

    delta += used;
    len -= used;

    if (!len && SCHEME_NULLP(parts)) {
      if (to_bytes) {
       *olen = clen;
       c[*olen] = 0;
      } else {
       *olen = (clen >> 2);
       ((mzchar *)c)[*olen] = 0;
      }
      iconv_close(cd);
      return c;
    }

    /* We can get here if there was some conversion error at some
       point. We're building up a list of parts. */

    if (to_bytes) {
      one = scheme_make_sized_byte_string(c, clen, 0);
    } else {
      one = scheme_make_sized_char_string((mzchar *)c, clen >> 2, 0);
    }

    parts = scheme_make_pair(one, parts);

    if (len) {
      /* Conversion error, so skip one char. */
      if (to_bytes) {
       char bc[1];
       bc[0] = perm;
       one = scheme_make_sized_byte_string(bc, 1, 1);
      } else {
       mzchar bc[1];
       bc[0] = perm;
       one = scheme_make_sized_char_string(bc, 1, 1);
      }
      parts = scheme_make_pair(one, parts);
      delta += 1;
      len -= 1;
    }
  }

  iconv_close(cd);

  if (to_bytes) {
    parts = append_all_byte_strings_backwards(parts);
    *olen = SCHEME_BYTE_STRTAG_VAL(parts);

    return SCHEME_BYTE_STR_VAL(parts);
  } else {
    parts = append_all_strings_backwards(parts);
    *olen = SCHEME_CHAR_STRTAG_VAL(parts);

    return (char *)SCHEME_CHAR_STR_VAL(parts);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* string_to_immutable ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* string_to_list ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * string_upcase ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3502 of file string.c.

{
  return string_recase("string-upcase", argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* substring ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * system_language_country ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2341 of file string.c.

{
#ifdef MACOS_UNICODE_SUPPORT
  /* Mac OS X */
  CFLocaleRef l;
  CFStringRef s;
  int len;
  char *r;

  l = CFLocaleCopyCurrent();
  s = CFLocaleGetIdentifier(l);

  len = CFStringGetLength(s);
  r = (char *)scheme_malloc_atomic(len * 6 + 1);
  CFStringGetCString(s, r, len * 6 + 1, kCFStringEncodingUTF8);

  CFRelease(l);

  return scheme_make_sized_utf8_string(r, 5);
#else
# ifdef WINDOWS_UNICODE_SUPPORT
  /* Windows */
  LCID l;
  int llen, clen;
  char *lang, *country, *s;
  l = GetUserDefaultLCID();

  llen = GetLocaleInfo(l, LOCALE_SENGLANGUAGE, NULL, 0);
  lang = (char *)scheme_malloc_atomic(llen);
  GetLocaleInfo(l, LOCALE_SENGLANGUAGE, lang, llen);
  if (llen)
    llen -= 1; /* drop nul terminator */

  clen = GetLocaleInfo(l, LOCALE_SENGCOUNTRY, NULL, 0);
  country = (char *)scheme_malloc_atomic(clen);
  GetLocaleInfo(l, LOCALE_SENGCOUNTRY, country, clen);
  if (clen)
    clen -= 1; /* drop nul terminator */

  s = (char *)scheme_malloc_atomic(clen + llen + 1);
  memcpy(s, lang, llen);
  memcpy(s + 1 + llen, country, clen);
  s[llen] = '_';
  
  return scheme_make_sized_utf8_string(s, llen + 1 + clen);
# else
  /* Unix */
  char *s;
  
  s = getenv("LC_ALL");
  if (!s)
    s = getenv("LC_CTYPE");
  if (!s)
    s = getenv("LANG");
  
  if (s) {
    /* Check that the environment variable has the form
       xx_XX[.ENC] */
    if ((s[0] >= 'a') && (s[0] <= 'z')
       && (s[1] >= 'a') && (s[1] <= 'z')
       && (s[2] == '_')
       && (s[3] >= 'A') && (s[3] <= 'Z')
       && (s[4] >= 'A') && (s[4] <= 'Z')
       && (!s[5] || s[5] == '.')) {
      /* Good */
    } else
      s = NULL;
  }
  
  if (!s)
    s = "en_US";
  
  return scheme_make_sized_utf8_string(s, 5);
# endif
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * system_library_subpath ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2204 of file string.c.

{
  if (argc > 0) {
    Scheme_Object *sym;

    if (SCHEME_FALSEP(argv[0]))
      return platform_cgc_path;
    
    sym = scheme_intern_symbol("cgc");
    if (SAME_OBJ(sym, argv[0]))
      return platform_cgc_path;

    sym = scheme_intern_symbol("3m");
    if (SAME_OBJ(sym, argv[0]))
      return platform_3m_path;

    scheme_wrong_type("system-library-subpath", "'cgc, '3m, or #f", 0, argc, argv);
    return NULL;
  } else {
#ifdef MZ_PRECISE_GC
    return platform_3m_path;
#else
    return platform_cgc_path;
#endif
  }
}

Here is the caller graph for this function:

static Scheme_Object * system_type ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2138 of file string.c.

{
  if (argc) {
    Scheme_Object *sym;
    sym = scheme_intern_symbol("link");
    if (SAME_OBJ(argv[0], sym)) {
#if defined(OS_X) && !defined(XONX)
      return scheme_intern_symbol("framework");
#else
# ifdef DOS_FILE_SYSTEM
      return scheme_intern_symbol("dll");
# else
#  ifdef MZ_USES_SHARED_LIB
      return scheme_intern_symbol("shared");
#  else
      return scheme_intern_symbol("static");
#  endif
# endif
#endif
    }

    sym = scheme_intern_symbol("machine");
    if (SAME_OBJ(argv[0], sym)) {
      char buff[1024];
      
      machine_details(buff);
    
      return scheme_make_utf8_string(buff);
    }

    sym = scheme_intern_symbol("gc");
    if (SAME_OBJ(argv[0], sym)) {
#ifdef MZ_PRECISE_GC
      return scheme_intern_symbol("3m");
#else
      return scheme_intern_symbol("cgc");
#endif
    }

    sym = scheme_intern_symbol("so-suffix");
    if (SAME_OBJ(argv[0], sym)) {
#ifdef DOS_FILE_SYSTEM
      return scheme_make_byte_string(".dll");
#else
# ifdef OS_X
      return scheme_make_byte_string(".dylib");
# else
#  ifdef USE_CYGWIN_SO_SUFFIX
      return scheme_make_byte_string(".dll");
#  else
      return scheme_make_byte_string(".so");
#  endif
# endif
#endif
    }

    sym = scheme_intern_symbol("os");
    if (!SAME_OBJ(argv[0], sym)) {
      scheme_wrong_type("system-type", "'os, 'link, 'machine, 'gc, or 'so-suffix", 0, argc, argv);
      return NULL;
    }
  }

  return sys_symbol;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int try_subproc ( Scheme_Object subprocess_proc,
char *  prog 
) [static]

Definition at line 5376 of file string.c.

{
  Scheme_Object *a[5];
  mz_jmp_buf * volatile savebuf, newbuf;

  savebuf = scheme_current_thread->error_buf;
  scheme_current_thread->error_buf = &newbuf;

  if (!scheme_setjmp(newbuf)) {
    a[0] = scheme_false;
    a[1] = scheme_false;
    a[2] = scheme_false;
    a[3] = scheme_make_locale_string(prog);
    a[4] = scheme_make_locale_string("-a");
    _scheme_apply_multi(subprocess_proc, 5, a);
    scheme_current_thread->error_buf = savebuf;
    return 1;
  } else {
    scheme_clear_escape();
    scheme_current_thread->error_buf = savebuf;
    return 0;
  }
}

Here is the caller graph for this function:

static Scheme_Object* unicode_recase ( const char *  who,
int  to_up,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3277 of file string.c.

{
  long len;
  mzchar *chars;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type(who, "string", 0, argc, argv);

  chars = SCHEME_CHAR_STR_VAL(argv[0]);
  len = SCHEME_CHAR_STRTAG_VAL(argv[0]);

  return mz_recase(who, to_up, chars, len);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int utf8_decode_x ( const unsigned char *  s,
int  start,
int  end,
unsigned int us,
int  dstart,
int  dend,
long *  ipos,
long *  jpos,
char  compact,
char  utf16,
int state,
int  might_continue,
int  permissive 
) [static]

Definition at line 4530 of file string.c.

{
  int i, j, oki, failmode = -3, state;
  int init_doki;
  int nextbits, v;
  unsigned int sc;
# ifdef WINDOWS_UNICODE_SUPPORT
  int pending_surrogate = 0;
# endif

  if (_state) {
    state = (*_state) & 0x7;
    init_doki = (((*_state) >> 3) & 0x7);
    nextbits = ((((*_state) >> 6) & 0xF) << 2);
    /* Need v to detect 0xD800 through 0xDFFF
       Note that we have 22 bits to work with, which is
       is enough to detect > 0x10FFFF */
    v = ((*_state) >> 10);
  } else {
    state = 0;
    init_doki = 0;
    nextbits = 0;
    v = 0;
  }

  /* In non-permissive mode, a negative result means ill-formed input.
     Permissive mode accepts anything and tries to convert it.  In
     that case, the strategy for illegal sequences is to convert
     anything bad to the given "permissive" value. */

  if (end < 0)
    end = strlen((char *)s);
  if (dend < 0)
    dend = 0x7FFFFFFF;

# define ENCFAIL i = oki; failmode = -2; break

  oki = start;
  j = dstart;
  i = start;
  if (j < dend) {
    while (i < end) {
      sc = s[i];
      if (sc < 0x80) {
       if (state) {
         /* In a sequence, but didn't continue */
         state = 0;
         nextbits = 0;
         if (permissive) {
           v = permissive;
           i = oki;
           j += init_doki;
         } else {
           ENCFAIL;
         }
       } else {
         v = sc;
       }
      } else if ((sc & 0xC0) == 0x80) {
       /* Continues a sequence ... */
       if (state) {
         /* ... and we're in one ... */
         if (!nextbits || (sc & nextbits)) {
           /* and we have required bits. */
           v = (v << 6) + (sc & 0x3F);
           nextbits = 0;
           --state;
           if (state) {
             i++;
             continue;
           }
           /* We finished. One last check: */
           if ((((v >= 0xD800) && (v <= 0xDFFF))
               || (v > 0x10FFFF))
# ifdef WINDOWS_UNICODE_SUPPORT
              && (!utf16
                  /* If UTF-16 for Windows, just apply upper-limit check */
                  || (v > 0x10FFFF))
# endif
              ) {
             /* UTF-16 surrogates or other illegal code units */
             if (permissive) {
              v = permissive;
              j += init_doki;
              i = oki;
             } else {
              ENCFAIL;
             }
           }
         } else {
           /* ... but we're missing required bits. */
           state = 0;
           nextbits = 0;
           if (permissive) {
             v = permissive;
             j += init_doki;
             i = oki;
           } else {
             ENCFAIL;
           }
         }
       } else {
         /* ... but we're not in one */
         if (permissive) {
           v = permissive;
         } else {
           ENCFAIL;
         }
       }
      } else if (state) {
       /* bad: already in a sequence */
       state = 0;
       if (permissive) {
         v = permissive;
         i = oki;
         j += init_doki;
       } else {
         ENCFAIL;
       }
      } else {
       if ((sc & 0xE0) == 0xC0) {
         if (sc & 0x1E) {
           state = 1;
           v = (sc & 0x1F);
           i++;
           continue;
         }
         /* else too small */
       } else if ((sc & 0xF0) == 0xE0) {
         state = 2;
         v = (sc & 0xF);
         if (!v)
           nextbits = 0x20;
         i++;
         continue;
       } else if ((sc & 0xF8) == 0xF0) {
         v = (sc & 0x7);
         if (v <= 4) {
           state = 3;
           if (!v)
             nextbits = 0x30;
           i++;
           continue;
         } 
         /* Else will be larger than 0x10FFFF, so fail */
       }
       /* Too small, or 0xFF or 0xFe, or start of a 5- or 6-byte sequence */
       if (permissive) {
         v = permissive;
       } else {
         ENCFAIL;
       }
      }

      /* If we get here, we're supposed to output v */

      if (compact) {
       if (utf16) {
         if (v > 0xFFFF) {
# ifdef WINDOWS_UNICODE_SUPPORT
           if (pending_surrogate) {
             if (us)
              ((unsigned short *)us)[j] = pending_surrogate;
             j++; /* Accept previously written unpaired surrogate */
             pending_surrogate = 0;
           }
# endif
           if (j + 1 >= dend)
             break;
           if (us) {
             v -= 0x10000;
             ((unsigned short *)us)[j] = 0xD800 | ((v >> 10) & 0x3FF);
             ((unsigned short *)us)[j+1] = 0xDC00 | (v & 0x3FF);
           }
           j++;
         } else {
# ifdef WINDOWS_UNICODE_SUPPORT
           /* We allow a surrogate by itself, but don't allow
              a 0xDC00 after a 0xD800, otherwise multiple encodings can
              map to the same thing. */
           if ((v >= 0xD800) && (v <= 0xDFFF)) {
             if (pending_surrogate && ((v & 0xDC00) == 0xDC00)) {
              /* This looks like a surrogate pair, so disallow it. */
              if (permissive) {
                /* We need to fill in 6 permissive substitutions,
                   one for each input byte. If we can't put all 6,
                   then don't use any input. */
                if (j + 5 >= dend) {
                  break;
                } else {
                  int p;
                  if (us) {
                    for (p = 0; p < 5; p++) {
                     if (j + p >= dend)
                       break;
                     ((unsigned short *)us)[j+p] = permissive;
                    }
                  }
                  j += 5;
                  v = permissive;
                }
              } else {
                ENCFAIL;
              }
              pending_surrogate = 0;
             } else {
              if (pending_surrogate) {
                if (us)
                  ((unsigned short *)us)[j] = pending_surrogate;
                j++; /* Accept previousy written unpaired surrogate */
                pending_surrogate = 0;
                if (j >= dend)
                  break;
              }
              if ((v & 0xDC00) == 0xD800)
                pending_surrogate = v;
              else
                pending_surrogate = 0;
             }
           } else {
             if (pending_surrogate) {
              if (us)
                ((unsigned short *)us)[j] = pending_surrogate;
              j++; /* Accept previousy written unpaired surrogate */
              pending_surrogate = 0;
              if (j >= dend)
                break;
             }
           }

           if (pending_surrogate)
             --j; /* don't accept unpaired surrogate, yet */
           else if (us)
             ((unsigned short *)us)[j] = v;
# else
           if (us)
             ((unsigned short *)us)[j] = v;
# endif
         }
       } else {
         int delta;
         delta = (i - oki);
         if (delta) {
           if (j + delta + 1 < dend) {
             if (us)
              memcpy(((char *)us) + j, s + oki, delta + 1);
             j += delta;
           } else
             break;
         } else if (v == 0xFFFD) {
            if (j + 3 < dend) {
              if (us) {
                ((unsigned char *)us)[j] = 0xEF;
                ((unsigned char *)us)[j+1] = 0xBF;
                ((unsigned char *)us)[j+2] = 0xBD;
              }
              j += 2;
            } else
              break;
          } else if (us) {
            ((unsigned char *)us)[j] = v;
          }
       }
      } else if (us) {
       us[j] = v;
      }
      j++;
      i++;
      oki = i;
      init_doki = 0;
      if (j >= dend)
       break;
    }
  }

  if (_state) {
    if (!state)
      *_state = 0;
    else
      *_state = (state 
               | (((end - oki) + init_doki) << 3)
               | ((nextbits >> 2) << 6)
               | (v << 10));
  } else if (state) {
    if (might_continue || !permissive) {
      failmode = -1;
      i = end - 1; /* to ensure that failmode is returned */
    } else if (permissive) {
      for (i = oki; i < end; i++) {
       if (j < dend) {
         if (us) {
           if (compact) {
             if (utf16)
              ((unsigned short *)us)[j] = permissive;
             else
              ((unsigned char *)us)[j] = permissive;
           } else
             us[j] = permissive;
         }
         j++;
       } else
         break;
      }
      oki = i;
    }
  }

# ifdef WINDOWS_UNICODE_SUPPORT
  if (pending_surrogate)
    oki -= 3;
#endif

  if (ipos)
    *ipos = oki;
  if (jpos)
    *jpos = j;

  if (i < end)
    return failmode;

# ifdef WINDOWS_UNICODE_SUPPORT
  if (pending_surrogate) {
    /* input must have ended right after surrogate */
    return -1;
  }
#endif

  return j - dstart;
}

Here is the caller graph for this function:

static int utf8_encode_x ( const unsigned int us,
int  start,
int  end,
unsigned char *  s,
int  dstart,
int  dend,
long *  _ipos,
long *  _opos,
char  utf16 
) [static]

Definition at line 4981 of file string.c.

{
  int i, j, done = start;

  if (dend < 0)
    dend = 0x7FFFFFFF;

  if (!s) {
    unsigned int wc;
    j = 0;
    for (i = start; i < end; i++) {
      if (utf16) {
       wc = ((unsigned short *)us)[i];
       if ((wc & 0xF800) == 0xD800) {
         /* Unparse surrogates. We assume that the surrogates are
            well formed, unless this is Windows or if we're at the
             end and _opos is 0. */
# ifdef WINDOWS_UNICODE_SUPPORT
#  define UNPAIRED_MASK 0xFC00
# else
#  define UNPAIRED_MASK 0xF800
# endif
         if (((i + 1) == end) && ((wc & UNPAIRED_MASK) == 0xD800) && _opos) {
           /* Ended in the middle of a surrogate pair */
           *_opos = j;
           if (_ipos)
             *_ipos = i;
           return -1;
         }
# ifdef WINDOWS_UNICODE_SUPPORT
         if ((wc & 0xFC00) != 0xD800) {
           /* Count as one */
         } else if ((i + 1 >= end)
                   || (((((unsigned short *)us)[i+1]) & 0xFC00) != 0xDC00)) {
         } else 
# endif
           {
             i++;
             wc = ((wc & 0x3FF) << 10) + ((((unsigned short *)us)[i]) & 0x3FF);
             wc += 0x10000;
           }
       }
      } else {
       wc = us[i];
      }
      if (wc < 0x80) {
       j += 1;
      } else if (wc < 0x800) {
       j += 2;
      } else if (wc < 0x10000) {
       j += 3;
      } else if (wc < 0x200000) {
       j += 4;
      } else if (wc < 0x4000000) {
       j += 5;
      } else {
       j += 6;
      }
    }
    if (_ipos)
      *_ipos = i;
    if (_opos)
      *_opos = j + dstart;
    return j;
  } else {
    unsigned int wc;
    j = dstart;
    for (i = start; i < end; i++) {
      if (utf16) {
       wc = ((unsigned short *)us)[i];
       if ((wc & 0xF800) == 0xD800) {
         /* Unparse surrogates. We assume that the surrogates are
            well formed on non-Windows platforms, but when _opos,
            we detect ending in the middle of an surrogate pair. */
         if (((i + 1) == end) && ((wc & UNPAIRED_MASK) == 0xD800) && _opos) {
           /* Ended in the middle of a surrogate pair */
           *_opos = j;
           if (_ipos)
             *_ipos = i;
           return -1;
         }
# ifdef WINDOWS_UNICODE_SUPPORT
         if ((wc & 0xFC00) != 0xD800) {
           /* Let the misplaced surrogate through */
         } else if ((i + 1 >= end)
                   || (((((unsigned short *)us)[i+1]) & 0xFC00) != 0xDC00)) {
           /* Let the misplaced surrogate through */
         } else
# endif
           {
             i++;
             wc = ((wc & 0x3FF) << 10) + ((((unsigned short *)us)[i]) & 0x3FF);
             wc += 0x10000;
           }
       }
      } else {
       wc = us[i];
      }

      if (wc < 0x80) {
       if (j + 1 > dend)
         break;
       s[j++] = wc;
      } else if (wc < 0x800) {
       if (j + 2 > dend)
         break;
       s[j++] = 0xC0 | ((wc & 0x7C0) >> 6);
       s[j++] = 0x80 | (wc & 0x3F);
      } else if (wc < 0x10000) {
       if (j + 3 > dend)
         break;
       s[j++] = 0xE0 | ((wc & 0xF000) >> 12);
       s[j++] = 0x80 | ((wc & 0x0FC0) >> 6);
       s[j++] = 0x80 | (wc & 0x3F);
      } else if (wc < 0x200000) {
       if (j + 4 > dend)
         break;
       s[j++] = 0xF0 | ((wc & 0x1C0000) >> 18);
       s[j++] = 0x80 | ((wc & 0x03F000) >> 12);
       s[j++] = 0x80 | ((wc & 0x000FC0) >> 6);
       s[j++] = 0x80 | (wc & 0x3F);
      } else if (wc < 0x4000000) {
       if (j + 5 > dend)
         break;
       s[j++] = 0xF8 | ((wc & 0x3000000) >> 24);
       s[j++] = 0x80 | ((wc & 0x0FC0000) >> 18);
       s[j++] = 0x80 | ((wc & 0x003F000) >> 12);
       s[j++] = 0x80 | ((wc & 0x0000FC0) >> 6);
       s[j++] = 0x80 | (wc & 0x3F);
      } else {
       if (j + 6 > dend)
         break;
       s[j++] = 0xFC | ((wc & 0x40000000) >> 30);
       s[j++] = 0x80 | ((wc & 0x3F000000) >> 24);
       s[j++] = 0x80 | ((wc & 0x00FC0000) >> 18);
       s[j++] = 0x80 | ((wc & 0x0003F000) >> 12);
       s[j++] = 0x80 | ((wc & 0x00000FC0) >> 6);
       s[j++] = 0x80 | (wc & 0x3F);
      }
      done = i;
    }
    if (_ipos)
      *_ipos = done;
    if (_opos)
      *_opos = j;
    return j - dstart;
  }
}

Here is the caller graph for this function:

static Scheme_Object* version ( int  argc,
Scheme_Object argv[] 
) [static]

Variable Documentation

Definition at line 346 of file string.c.

Definition at line 344 of file string.c.