Back to index

plt-scheme  4.2.1
Defines | Typedefs | Functions | Variables
symbol.c File Reference
#include "schpriv.h"
#include "mzrt.h"
#include <string.h>
#include <ctype.h>
#include "schgc.h"

Go to the source code of this file.

Defines

#define SCHEME_NO_GC_PROTO
#define HASH_TABLE_INIT_SIZE   256
#define FILL_FACTOR   2
#define mzrt_rwlock_rdlock(l)   /* empty */
#define mzrt_rwlock_wrlock(l)   /* empty */
#define mzrt_rwlock_unlock(l)   /* empty */
#define HASH_SEED   0xF0E1D2C3
#define SYMTAB_LOST_CELL   scheme_false
#define WEAK_ARRAY_HEADSIZE   0
#define MAX_SYMBOL_SIZE   256
#define isSpecial(ch)

Typedefs

typedef unsigned long hash_v_t

Functions

int GC_is_marked (void *)
void scheme_set_case_sensitive (int v)
static Scheme_Objectsymbol_p_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectsymbol_interned_p_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_to_symbol_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_to_uninterned_symbol_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_to_unreadable_symbol_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectsymbol_to_string_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectkeyword_p_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectkeyword_lt (int argc, Scheme_Object *argv[])
static Scheme_Objectstring_to_keyword_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectkeyword_to_string_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectgensym (int argc, Scheme_Object *argv[])
static Scheme_Objectrehash_symbol_bucket (Scheme_Hash_Table *table, GC_CAN_IGNORE const char *key, unsigned int length, Scheme_Object *naya)
static Scheme_Objectsymbol_bucket (Scheme_Hash_Table *table, GC_CAN_IGNORE const char *key, unsigned int length, Scheme_Object *naya)
static void clean_one_symbol_table (Scheme_Hash_Table *symbol_table)
static void clean_symbol_table (void)
static Scheme_Hash_Tableinit_one_symbol_table ()
void scheme_init_symbol_table ()
void scheme_init_symbol_type (Scheme_Env *env)
void scheme_init_symbol (Scheme_Env *env)
static Scheme_Objectmake_a_symbol (const char *name, unsigned int len, int kind)
Scheme_Objectscheme_make_symbol (const char *name)
Scheme_Objectscheme_make_exact_symbol (const char *name, unsigned int len)
Scheme_Objectscheme_make_exact_char_symbol (const mzchar *name, unsigned int len)
Scheme_Objectscheme_intern_exact_symbol_in_table_worker (Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len)
Scheme_Objectscheme_intern_exact_symbol_in_table (Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len)
Scheme_Objectscheme_intern_exact_symbol (const char *name, unsigned int len)
Scheme_Objectscheme_intern_exact_parallel_symbol (const char *name, unsigned int len)
Scheme_Objectscheme_intern_exact_char_symbol (const mzchar *name, unsigned int len)
Scheme_Objectscheme_intern_exact_keyword (const char *name, unsigned int len)
Scheme_Objectscheme_intern_exact_char_keyword (const mzchar *name, unsigned int len)
Scheme_Objectscheme_intern_symbol (const char *name)
const char * scheme_symbol_name_and_size (Scheme_Object *sym, unsigned int *length, int flags)
const char * scheme_symbol_name (Scheme_Object *sym)
char * scheme_symbol_val (Scheme_Object *sym)
Scheme_Objectscheme_symbol_append (Scheme_Object *s1, Scheme_Object *s2)

Variables

MZ_DLLIMPORT void(* GC_custom_finalize )(void)
Scheme_Hash_Tablescheme_symbol_table = NULL
Scheme_Hash_Tablescheme_keyword_table = NULL
Scheme_Hash_Tablescheme_parallel_symbol_table = NULL
unsigned long scheme_max_found_symbol_name
int scheme_case_sensitive = 1
static int gensym_counter

Define Documentation

#define FILL_FACTOR   2

Definition at line 41 of file symbol.c.

#define HASH_SEED   0xF0E1D2C3

Definition at line 88 of file symbol.c.

#define HASH_TABLE_INIT_SIZE   256

Definition at line 37 of file symbol.c.

#define isSpecial (   ch)
Value:
((ch == '(') || (ch == '[') || (ch == '{')       \
                     || (ch == ')') || (ch == ']') || (ch == '}')    \
                     || (ch == ')') || (ch == '\\')   \
                     || (ch == '"') || (ch == '\'')   \
                     || (ch == '`') || (ch == ',')    \
                       || (ch == ';')                   \
                       || (((ch == '>') || (ch == '<')) \
                        && (flags & SCHEME_SNF_FOR_TS)))
#define MAX_SYMBOL_SIZE   256

Definition at line 460 of file symbol.c.

#define mzrt_rwlock_rdlock (   l)    /* empty */

Definition at line 58 of file symbol.c.

#define mzrt_rwlock_unlock (   l)    /* empty */

Definition at line 60 of file symbol.c.

#define mzrt_rwlock_wrlock (   l)    /* empty */

Definition at line 59 of file symbol.c.

Definition at line 28 of file symbol.c.

Definition at line 90 of file symbol.c.

#define WEAK_ARRAY_HEADSIZE   0

Definition at line 95 of file symbol.c.


Typedef Documentation

typedef unsigned long hash_v_t

Definition at line 87 of file symbol.c.


Function Documentation

static void clean_one_symbol_table ( Scheme_Hash_Table symbol_table) [static]

Definition at line 222 of file symbol.c.

{
  /* Clean the symbol table by removing pointers to collected
     symbols. The correct way to do this is to install a GC
     finalizer on symbol pointers, but that would be expensive. */

  if (symbol_table) {
    Scheme_Object **buckets = (Scheme_Object **)symbol_table->keys;
    int i = symbol_table->size;
    void *b;

    while (i--) {
      if (buckets[WEAK_ARRAY_HEADSIZE + i] && !SAME_OBJ(buckets[WEAK_ARRAY_HEADSIZE + i], SYMTAB_LOST_CELL)
         && (!(b = GC_base(buckets[WEAK_ARRAY_HEADSIZE + i]))
#ifndef USE_SENORA_GC
             || !GC_is_marked(b)
#endif
             )) {
       buckets[WEAK_ARRAY_HEADSIZE + i] = SYMTAB_LOST_CELL;
      }
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void clean_symbol_table ( void  ) [static]

Definition at line 246 of file symbol.c.

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 827 of file symbol.c.

{
  char buffer[100], *str;
  Scheme_Object *r;

  if (argc)
    r = argv[0];
  else
    r = NULL;

  if (r && !SCHEME_SYMBOLP(r) && !SCHEME_CHAR_STRINGP(r))
    scheme_wrong_type("gensym", "symbol or string", 0, argc, argv);

  if (r) {
    char buf[64];
    if (SCHEME_CHAR_STRINGP(r)) {
      str = scheme_utf8_encode_to_buffer(SCHEME_CHAR_STR_VAL(r),
                                    SCHEME_CHAR_STRTAG_VAL(r),
                                    buf, 64);
    } else
      str = SCHEME_SYM_VAL(r);
    sprintf(buffer, "%.80s%d", str, gensym_counter++);
    str = NULL; /* because it might be GC-misaligned */
  } else
    sprintf(buffer, "g%d", gensym_counter++);

  r = scheme_make_symbol(buffer);

  return r;
}

Here is the caller graph for this function:

Definition at line 266 of file symbol.c.

{
  Scheme_Hash_Table *symbol_table;
  int size;
  Scheme_Object **ba;

  symbol_table = scheme_make_hash_table(SCHEME_hash_ptr);

  symbol_table->size = HASH_TABLE_INIT_SIZE;
  
  size = symbol_table->size * sizeof(Scheme_Object *);
#ifdef MZ_PRECISE_GC
  ba = (Scheme_Object **)GC_malloc_weak_array(size, SYMTAB_LOST_CELL);
#else
  ba = MALLOC_N_ATOMIC(Scheme_Object *, size);
  memset((char *)ba, 0, size);
#endif
  symbol_table->keys = ba;

  return symbol_table;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 758 of file symbol.c.

{
  Scheme_Object *prev = argv[0], *kw;
  GC_CAN_IGNORE unsigned char *a, *b;
  int i, al, bl, t;

  if (!SCHEME_KEYWORDP(prev))
    scheme_wrong_type("keyword<?", "keyword", 0, argc, argv);

  for (i = 1; i < argc; i++) {
    kw = argv[i];
    if (!SCHEME_KEYWORDP(kw))
      scheme_wrong_type("keyword<?", "keyword", i, argc, argv);

    a = (unsigned char *)SCHEME_SYM_VAL(prev);
    al = SCHEME_SYM_LEN(prev);
    b = (unsigned char *)SCHEME_SYM_VAL(kw);
    bl = SCHEME_SYM_LEN(kw);
    t = ((al < bl) ? al : bl);
    while (t--) {
      if (*a < *b) {
        al = 0;
        bl = 1;
        break;
      } else if (*a > *b) {
        al = bl = 0;
        break;
      } else {
        a++;
        b++;
      }
    }
    a = b = NULL;

    if (al >= bl) {
      /* Check remaining types */
      for (i++; i < argc; i++) {
        if (!SCHEME_KEYWORDP(argv[i]))
          scheme_wrong_type("keyword<?", "keyword", i, argc, argv);
      }
      return scheme_false;
    }

    prev = kw;
  }

  return scheme_true;
}

Here is the caller graph for this function:

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

Definition at line 753 of file symbol.c.

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

Here is the caller graph for this function:

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

Definition at line 817 of file symbol.c.

{
  if (!SCHEME_KEYWORDP(argv[0]))
    scheme_wrong_type("keyword->string", "keyword", 0, argc, argv);
  
  return scheme_make_sized_offset_utf8_string((char *)(argv[0]),
                                         SCHEME_SYMSTR_OFFSET(argv[0]),
                                         SCHEME_SYM_LEN(argv[0]));
}

Here is the caller graph for this function:

static Scheme_Object* make_a_symbol ( const char *  name,
unsigned int  len,
int  kind 
) [static]

Definition at line 337 of file symbol.c.

Here is the caller graph for this function:

static Scheme_Object * rehash_symbol_bucket ( Scheme_Hash_Table table,
GC_CAN_IGNORE const char *  key,
unsigned int  length,
Scheme_Object naya 
) [static]

Definition at line 169 of file symbol.c.

{
  int i, oldsize = table->size, newsize, lostc;
  size_t asize;
  Scheme_Object *cb;
  Scheme_Object **old = table->keys;

  /* WARNING: key may be GC-misaligned... */

  /* Don't grow table if it's mostly lost cells (due to lots of
     temporary symbols). */
  lostc = 0;
  for (i = 0; i < oldsize; i++) {
    cb = old[WEAK_ARRAY_HEADSIZE + i];
    if (cb == SYMTAB_LOST_CELL)
      lostc++;
  }
  if ((lostc * 2) < table->count)
    newsize = oldsize << 1;
  else
    newsize = oldsize;

  asize = (size_t)newsize * sizeof(Scheme_Object *);
  {
    Scheme_Object **ba;
#ifdef MZ_PRECISE_GC
    ba = (Scheme_Object **)GC_malloc_weak_array(sizeof(Scheme_Object *) * newsize,
                                                SYMTAB_LOST_CELL);
#else
    ba = MALLOC_N_ATOMIC(Scheme_Object *, newsize);
    memset((char *)ba, 0, asize);
#endif
    table->keys = ba;
  }
  table->size = newsize;

  table->count = 0;

  for (i = 0; i < oldsize; i++) {
    cb = old[WEAK_ARRAY_HEADSIZE + i] ;
    if (cb && (cb != SYMTAB_LOST_CELL))
      symbol_bucket(table, SCHEME_SYM_VAL(cb), SCHEME_SYM_LEN(cb), cb);
  }

  /* Restore GC-misaligned key: */
  key = SCHEME_SYM_VAL(naya);

  return symbol_bucket(table, key, length, naya);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 314 of file symbol.c.

{
  Scheme_Object *p;

  p = scheme_make_folding_prim(symbol_p_prim, "symbol?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("symbol?", p, env);
  
  p = scheme_make_folding_prim(symbol_interned_p_prim, "symbol-interned?", 1, 1, 1);
  scheme_add_global_constant("symbol-interned?", p, env);
  
  GLOBAL_IMMED_PRIM("string->symbol",             string_to_symbol_prim,            1, 1, env);
  GLOBAL_IMMED_PRIM("string->uninterned-symbol",  string_to_uninterned_symbol_prim, 1, 1, env);
  GLOBAL_IMMED_PRIM("string->unreadable-symbol",  string_to_unreadable_symbol_prim, 1, 1, env);
  GLOBAL_IMMED_PRIM("symbol->string",             symbol_to_string_prim,            1, 1, env);
  GLOBAL_FOLDING_PRIM("keyword?",                 keyword_p_prim,                   1, 1, 1, env);
  GLOBAL_FOLDING_PRIM("keyword<?",                keyword_lt,                       2, -1, 1, env);
  GLOBAL_IMMED_PRIM("string->keyword",            string_to_keyword_prim,           1, 1, env);
  GLOBAL_IMMED_PRIM("keyword->string",            keyword_to_string_prim,           1, 1, env);
  GLOBAL_IMMED_PRIM("gensym",                     gensym,                           0, 1, env);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 289 of file symbol.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 309 of file symbol.c.

{
}

Here is the caller graph for this function:

Definition at line 448 of file symbol.c.

{
  char buf[64], *bs;
  long blen;
  Scheme_Object *s;
  bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &blen);
  s = scheme_intern_exact_symbol_in_table(scheme_keyword_table, 0, bs, blen);
  if (s->type == scheme_symbol_type)
    s->type = scheme_keyword_type;
  return s;
}

Here is the call graph for this function:

Definition at line 430 of file symbol.c.

{
  char buf[64], *bs;
  long blen;
  bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &blen);
  return scheme_intern_exact_symbol_in_table(scheme_symbol_table, 0, bs, blen);
}

Here is the call graph for this function:

Scheme_Object* scheme_intern_exact_keyword ( const char *  name,
unsigned int  len 
)

Definition at line 439 of file symbol.c.

Here is the call graph for this function:

Scheme_Object* scheme_intern_exact_parallel_symbol ( const char *  name,
unsigned int  len 
)

Definition at line 424 of file symbol.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* scheme_intern_exact_symbol ( const char *  name,
unsigned int  len 
)

Definition at line 418 of file symbol.c.

Here is the call graph for this function:

Scheme_Object* scheme_intern_exact_symbol_in_table ( Scheme_Hash_Table symbol_table,
int  kind,
const char *  name,
unsigned int  len 
)

Definition at line 402 of file symbol.c.

{
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
  void *return_payload;
  Scheme_Symbol_Parts parts;
  parts.table = symbol_table;
  parts.kind = kind;
  parts.len  = len;
  parts.name = name;
  return_payload = scheme_master_fast_path(3, &parts);
  return (Scheme_Object*) return_payload;
#endif
  return scheme_intern_exact_symbol_in_table_worker(symbol_table, kind, name, len);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* scheme_intern_exact_symbol_in_table_worker ( Scheme_Hash_Table symbol_table,
int  kind,
const char *  name,
unsigned int  len 
)

Definition at line 378 of file symbol.c.

{
  Scheme_Object *sym;

  mzrt_rwlock_rdlock(symbol_table_lock);
  sym = symbol_bucket(symbol_table, name, len, NULL);
  mzrt_rwlock_unlock(symbol_table_lock);

  if (!sym) {
    Scheme_Object *newsymbol;
    newsymbol = make_a_symbol(name, len, kind);
    
    /* we must return the result of this symbol bucket call because another
     * thread could have inserted the same symbol between the first
     * :qsymbol_bucket call above and this one */
    mzrt_rwlock_wrlock(symbol_table_lock);
    sym = symbol_bucket(symbol_table, name, len, newsymbol);
    mzrt_rwlock_unlock(symbol_table_lock);
  }

  return sym;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 463 of file symbol.c.

{
  if (!scheme_case_sensitive) {
      unsigned long i, len;
    char *naya;
    char on_stack[MAX_SYMBOL_SIZE];

    len = strlen(name);
    if (len >= MAX_SYMBOL_SIZE)
      naya = (char *)scheme_malloc_atomic(len + 1);
    else
      naya = on_stack;

    for (i = 0; i < len; i++) {
      int c = ((unsigned char *)name)[i];

      c = scheme_tolower(c);

      naya[i] = c;
    }

    naya[len] = 0;

    return scheme_intern_exact_symbol(naya, len);
  }

  return scheme_intern_exact_symbol(name, strlen(name));
}
Scheme_Object* scheme_make_exact_char_symbol ( const mzchar name,
unsigned int  len 
)

Definition at line 369 of file symbol.c.

{
  char buf[64], *bs;
  long blen;
  bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &blen);
  return make_a_symbol(bs, blen, 0x1);
}

Here is the call graph for this function:

Scheme_Object* scheme_make_exact_symbol ( const char *  name,
unsigned int  len 
)

Definition at line 363 of file symbol.c.

{
  return make_a_symbol(name, len, 0x1);
}

Here is the call graph for this function:

Definition at line 357 of file symbol.c.

{
  return make_a_symbol(name, strlen(name), 0x1);
}

Here is the call graph for this function:

Definition at line 68 of file symbol.c.

Definition at line 858 of file symbol.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 650 of file symbol.c.

{
  return scheme_symbol_name_and_size(sym, NULL, 0);
}
const char* scheme_symbol_name_and_size ( Scheme_Object sym,
unsigned int length,
int  flags 
)

Definition at line 495 of file symbol.c.

{
  int has_space = 0, has_special = 0, has_pipe = 0, has_upper = 0, digit_start;
  int dz;
  unsigned int i, len = SCHEME_SYM_LEN(sym), total_length;
  int pipe_quote;
  char buf[100];
  char *s, *result;

  if ((flags & SCHEME_SNF_PIPE_QUOTE) || (flags & SCHEME_SNF_FOR_TS))
    pipe_quote = 1;
  else if (flags & SCHEME_SNF_NO_PIPE_QUOTE)
    pipe_quote = 0;
  else {
    pipe_quote = SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_CAN_READ_PIPE_QUOTE));
  }

  if (len < 100) {
    s = buf;
    memcpy(buf, SCHEME_SYM_VAL(sym), len + 1);
  } else
    s = scheme_symbol_val(sym);
  

#define isSpecial(ch) ((ch == '(') || (ch == '[') || (ch == '{')       \
                     || (ch == ')') || (ch == ']') || (ch == '}')    \
                     || (ch == ')') || (ch == '\\')   \
                     || (ch == '"') || (ch == '\'')   \
                     || (ch == '`') || (ch == ',')    \
                       || (ch == ';')                   \
                       || (((ch == '>') || (ch == '<')) \
                        && (flags & SCHEME_SNF_FOR_TS)))

  if (len) {
    if (flags & SCHEME_SNF_KEYWORD) {
      digit_start = 0;
    } else {
      digit_start = (isdigit((unsigned char)s[0]) || (s[0] == '.')
                   || (s[0] == '+') || (s[0] == '-'));
      if (s[0] == '#' && (len == 1 || s[1] != '%'))
       has_special = 1;
      if (s[0] == '.' && len == 1)
       has_special = 1;
    }
  } else {
    digit_start = 0;
    if (!(flags & SCHEME_SNF_KEYWORD))
      has_space = 1;
  }

  for (i = 0; i < len; i++) {
    if (isspace((unsigned char)s[i])) { /* used to have || !isprint((unsigned char)s[i]) */
      if ((flags & SCHEME_SNF_FOR_TS) && (s[i] == ' ')) {
       /* space is OK in type symbols */
      } else
       has_space = 1;
    } else if (isSpecial(s[i]))
      has_special = 1;
    else if (s[i] == '|')
      has_pipe = 1;
    else if (flags & SCHEME_SNF_NEED_CASE) {
      int ch = ((unsigned char *)s)[i];
      if (ch > 127) {
       /* Decode UTF-8. */
       mzchar buf[2];
       int ul = 2;
       while (1) {
         if (scheme_utf8_decode((unsigned char *)s, i, i + ul,
                             buf, 0, 1,
                             NULL, 0, 0) > 0)
           break;
         ul++;
       }
       ch = buf[0];
       if (scheme_isspecialcasing(ch)) {
         mzchar *rc;
         buf[1] = 0;
         rc = scheme_string_recase(buf, 0, 1, 3, 1, NULL);
         if ((rc != buf) || (rc[0] != ch))
           has_upper = 1;
         ch = 'a';
       }
       i += (ul - 1);
      }
      if (scheme_tofold(ch) != ch)
       has_upper = 1;
    }
  }

  result = NULL;
  total_length = 0;

  if (!has_space && !has_special && (!pipe_quote || !has_pipe) && !has_upper) {
    mzchar cbuf[100], *cs;
    long clen;
    dz = 0;
    cs = scheme_utf8_decode_to_buffer_len((unsigned char *)s, len, cbuf, 100, &clen);
    if (cs
       && digit_start
       && !(flags & SCHEME_SNF_FOR_TS)
       && (SCHEME_TRUEP(scheme_read_number(cs, clen, 0, 0, 1, 10, 0, NULL, &dz, 1, NULL, 0, 0, 0, 0, NULL))
           || dz)) {
      /* Need quoting: */
      if (pipe_quote)
       has_space = 1; /* Use normal */
      else {
       /* Just need a leading backslash: */
       result = (char *)scheme_malloc_atomic(len + 2);
       total_length = len + 1;
       memcpy(result + 1, s, len);
       result[0] = '\\';
       result[len + 1] = 0;
      }
    } else {
      total_length = len;
      result = s;
    }
  }

  if (!result) {
    if (!has_pipe && pipe_quote) {
      result = (char *)scheme_malloc_atomic(len + 3);
      total_length = len + 2;
      memcpy(result + 1, s, len);
      result[0] = '|';
      result[len + 1] = '|';
      result[len + 2] = 0;
    } else {
      int p = 0;
      unsigned int i = 0;

      result = (char *)scheme_malloc_atomic((2 * len) + 1);

      for (i = 0; i < len; i++) {
       if (isspace((unsigned char)s[i])
           || isSpecial(s[i])
           || ((s[i] == '|') && pipe_quote)
           || (!i && s[0] == '#')
           || (has_upper && ((((unsigned char)s[i]) >= 'A')
                           && (((unsigned char)s[i]) <= 'Z'))))
         result[p++] = '\\';
       result[p++] = s[i];
      }

      result[p] = 0;
      total_length = p;
    }
  }

  if (length)
    *length = total_length;

  return (result == buf) ? scheme_symbol_val (sym) : result;
}

Here is the call graph for this function:

char* scheme_symbol_val ( Scheme_Object sym)

Definition at line 655 of file symbol.c.

{
  char *s;
  s = scheme_malloc_atomic(SCHEME_SYM_LEN(sym) + 1);
  memcpy(s, SCHEME_SYM_VAL(sym), SCHEME_SYM_LEN(sym) + 1);
  return s;
}
static Scheme_Object * string_to_keyword_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 808 of file symbol.c.

{
  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string->keyword", "string", 0, argc, argv);
  return scheme_intern_exact_char_keyword(SCHEME_CHAR_STR_VAL(argv[0]),
                                     SCHEME_CHAR_STRTAG_VAL(argv[0]));
}

Here is the caller graph for this function:

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

Definition at line 682 of file symbol.c.

{
  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string->symbol", "string", 0, argc, argv);
  return scheme_intern_exact_char_symbol(SCHEME_CHAR_STR_VAL(argv[0]),
                                    SCHEME_CHAR_STRTAG_VAL(argv[0]));
}

Here is the caller graph for this function:

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

Definition at line 691 of file symbol.c.

{
  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string->uninterned-symbol", "string", 0, argc, argv);
  return scheme_make_exact_char_symbol(SCHEME_CHAR_STR_VAL(argv[0]),
                                   SCHEME_CHAR_STRTAG_VAL(argv[0]));
}

Here is the caller graph for this function:

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

Definition at line 700 of file symbol.c.

{
  char buf[64], *bs;
  long blen;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string->symbol", "string", 0, argc, argv);

  bs = scheme_utf8_encode_to_buffer_len(SCHEME_CHAR_STR_VAL(argv[0]),
                                        SCHEME_CHAR_STRTAG_VAL(argv[0]), 
                                        buf, 64, &blen);

  return scheme_intern_exact_parallel_symbol(bs, blen);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* symbol_bucket ( Scheme_Hash_Table table,
GC_CAN_IGNORE const char *  key,
unsigned int  length,
Scheme_Object naya 
) [static]

Definition at line 103 of file symbol.c.

{
  hash_v_t h, h2;
  unsigned long mask;
  Scheme_Object *bucket;

  /* WARNING: key may be GC-misaligned... */
  /* This function is designed to need no MZ_PRECISE_GC instrumentation.
     To handle re-hashing, it tail-calls rehash_symbol_bucket. */

  mask = table->size - 1;

  {
    unsigned int i;
    i = 0;
    h = HASH_SEED;
    h2 = 0;

    while (i < length) {
      int c = key[i++];
       h ^= (h << 5) + (h >> 2) + c;
       h2 += c;
    }
    /* post hash mixing helps for short symbols */
    h ^= (h << 5) + (h >> 2) + 0xA0A0;
    h ^= (h << 5) + (h >> 2) + 0x0505;

    h = h & mask;
    h2 = h2 & mask;
  }

  h2 |= 0x1;

  while ((bucket = table->keys[WEAK_ARRAY_HEADSIZE + h])) {
    if (SAME_OBJ(bucket, SYMTAB_LOST_CELL)) {
      if (naya) {
       /* We're re-using, so decrement count and it will be
          re-incremented. */
       --table->count;
       break;
      }
    } else if (((int)length == SCHEME_SYM_LEN(bucket))
              && !memcmp(key, SCHEME_SYM_VAL(bucket), length))
      return bucket;
    h = (h + h2) & mask;
  }

  /* In case it's GC-misaligned: */
  key = NULL;

  if (!naya)
    return NULL;

  if (table->count * FILL_FACTOR >= table->size) {
    return rehash_symbol_bucket(table, key, length, naya);
  }

  table->keys[WEAK_ARRAY_HEADSIZE + h] = naya;

  table->count++;

  return naya;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 672 of file symbol.c.

{
  if (SCHEME_SYMBOLP(argv[0]))
    return (SCHEME_SYM_WEIRDP(argv[0]) ? scheme_false : scheme_true);
  
  scheme_wrong_type("symbol-interned?", "symbol", 0, argc, argv);
  return NULL;
}

Here is the caller graph for this function:

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

Definition at line 666 of file symbol.c.

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

Here is the caller graph for this function:

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

Definition at line 716 of file symbol.c.

{
  Scheme_Object *sym, *str;
  GC_CAN_IGNORE unsigned char *s;
  GC_CAN_IGNORE mzchar *s2;
  long len, i;

  sym = argv[0];

  if (!SCHEME_SYMBOLP(sym))
    scheme_wrong_type("symbol->string", "symbol", 0, argc, argv);

  s = (unsigned char *)SCHEME_SYM_VAL(sym);
  len = SCHEME_SYM_LEN(sym);
  for (i = 0; i < len; i++) {
    if (s[i] >= 128)
      break;
  }
  s = NULL;

  if (i == len) {
    /* ASCII */
    str = scheme_alloc_char_string(len, 0);
    s = (unsigned char *)SCHEME_SYM_VAL(sym);
    s2 = SCHEME_CHAR_STR_VAL(str);
    for (i = 0; i < len; i++) {
      s2[i] = s[i];
    }
    return str;
  } else {
    return scheme_make_sized_offset_utf8_string((char *)sym,
                                                SCHEME_SYMSTR_OFFSET(sym),
                                                SCHEME_SYM_LEN(sym));
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

Definition at line 37 of file finalize.c.

int gensym_counter [static]

Definition at line 83 of file symbol.c.

Definition at line 66 of file symbol.c.

Definition at line 52 of file symbol.c.

Definition at line 63 of file symbol.c.

Definition at line 53 of file symbol.c.

Definition at line 51 of file symbol.c.