static ScmObj flock_allocate(ScmClass *klass, ScmObj initargs)
{
ScmSysFlock *f = SCM_NEW(ScmSysFlock);
SCM_SET_CLASS(f, SCM_CLASS_SYS_FLOCK);
memset(&f->lock, 0, sizeof(f->lock));
return SCM_OBJ(f);
}
ScmObj Scm_TreeMapCopy(const ScmTreeMap *src)
{
ScmTreeMap *tm = SCM_NEW(ScmTreeMap);
SCM_SET_CLASS(tm, SCM_CLASS_TREE_MAP);
Scm_TreeCoreCopy(SCM_TREE_MAP_CORE(tm), SCM_TREE_MAP_CORE(src));
return SCM_OBJ(tm);
}
/* internal constructor. NAME must be an immutable string. */
static ScmSymbol *make_sym(ScmClass *klass, ScmString *name, int interned)
{
if (interned) {
/* fast path */
SCM_INTERNAL_MUTEX_LOCK(obtable_mutex);
ScmObj e = Scm_HashTableRef(obtable, SCM_OBJ(name), SCM_FALSE);
SCM_INTERNAL_MUTEX_UNLOCK(obtable_mutex);
if (!SCM_FALSEP(e)) return SCM_SYMBOL(e);
}
ScmSymbol *sym = SCM_NEW(ScmSymbol);
SCM_SET_CLASS(sym, klass);
sym->name = name;
sym->flags = interned? SCM_SYMBOL_FLAG_INTERNED : 0;
if (!interned) {
return sym;
} else {
/* Using SCM_DICT_NO_OVERWRITE ensures that if another thread interns
the same name symbol between above HashTableRef and here, we'll
get the already interned symbol. */
SCM_INTERNAL_MUTEX_LOCK(obtable_mutex);
ScmObj e = Scm_HashTableSet(obtable, SCM_OBJ(name), SCM_OBJ(sym),
SCM_DICT_NO_OVERWRITE);
SCM_INTERNAL_MUTEX_UNLOCK(obtable_mutex);
return SCM_SYMBOL(e);
}
}
static ScmObj makeGlutFont(void *ptr)
{
ScmGlutFont *gf = SCM_NEW(ScmGlutFont);
SCM_SET_CLASS(gf, SCM_CLASS_GLUT_FONT);
gf->font = ptr;
return SCM_OBJ(gf);
}
static ScmObj compound_allocate(ScmClass *klass, ScmObj initargs)
{
ScmCompoundCondition *e = SCM_ALLOCATE(ScmCompoundCondition, klass);
SCM_SET_CLASS(e, klass);
e->conditions = SCM_NIL;
return SCM_OBJ(e);
}
/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
#if GAUCHE_UNIFY_SYMBOL_KEYWORD
/* We could optimize this later. */
ScmObj prefix = Scm_MakeString(":", 1, 1, SCM_STRING_IMMUTABLE);
ScmObj sname = Scm_StringAppend2(SCM_STRING(prefix), name);
ScmSymbol *s = make_sym(SCM_CLASS_KEYWORD, SCM_STRING(sname), TRUE);
Scm_DefineConst(Scm_KeywordModule(), s, SCM_OBJ(s));
return SCM_OBJ(s);
#else /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
ScmObj r = Scm_HashTableRef(keywords.table, SCM_OBJ(name), SCM_FALSE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
if (SCM_KEYWORDP(r)) return r;
ScmKeyword *k = SCM_NEW(ScmKeyword);
SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
k->name = SCM_STRING(Scm_CopyString(name));
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableSet(keywords.table, SCM_OBJ(name), SCM_OBJ(k),
SCM_DICT_NO_OVERWRITE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
return r;
#endif /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
}
static ScmObj termios_allocate(ScmClass *klass, ScmObj initargs)
{
ScmSysTermios *t = SCM_NEW(ScmSysTermios);
SCM_SET_CLASS(t, SCM_CLASS_SYS_TERMIOS);
memset(&t->term, 0, sizeof(t->term));
return SCM_OBJ(t);
}
static ScmObj message_allocate(ScmClass *klass, ScmObj initargs)
{
ScmError *e = SCM_ALLOCATE(ScmError, klass);
SCM_SET_CLASS(e, klass);
e->message = SCM_FALSE; /* would be set by initialize */
return SCM_OBJ(e);
}
/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
#if GAUCHE_KEEP_DISJOINT_KEYWORD_OPTION
if (keyword_disjoint_p) {
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
ScmObj r = Scm_HashTableRef(keywords.table, SCM_OBJ(name), SCM_FALSE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
if (SCM_KEYWORDP(r)) return r;
ScmKeyword *k = SCM_NEW(ScmKeyword);
SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
k->name = SCM_STRING(Scm_CopyString(name));
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableSet(keywords.table, SCM_OBJ(name), SCM_OBJ(k),
SCM_DICT_NO_OVERWRITE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
return r;
}
#endif /*GAUCHE_KEEP_DISJOINT_KEYWORD_OPTION*/
ScmObj sname = Scm_StringAppend2(&keyword_prefix, name);
ScmSymbol *s = make_sym(SCM_CLASS_KEYWORD, SCM_STRING(sname), TRUE);
Scm_DefineConst(Scm__GaucheKeywordModule(), s, SCM_OBJ(s));
return SCM_OBJ(s);
}
ScmObj sigset_allocate(ScmClass *klass, ScmObj initargs)
{
ScmSysSigset *s = SCM_ALLOCATE(ScmSysSigset, klass);
SCM_SET_CLASS(s, klass);
sigemptyset(&s->set);
return SCM_OBJ(s);
}
ScmBox *Scm_MakeBox(ScmObj value)
{
ScmBox *b = SCM_NEW(ScmBox);
SCM_SET_CLASS(b, &Scm_BoxClass);
SCM_BOX_SET(b, value);
return b;
}
ScmObj Scm_MakeMacro(ScmSymbol *name, ScmObj transformer)
{
ScmMacro *s = SCM_NEW(ScmMacro);
SCM_SET_CLASS(s, SCM_CLASS_MACRO);
s->name = name;
s->transformer = transformer;
return SCM_OBJ(s);
}
static ScmCharSet *make_charset(void)
{
ScmCharSet *cs = SCM_NEW(ScmCharSet);
SCM_SET_CLASS(cs, SCM_CLASS_CHARSET);
Scm_BitsFill(cs->small, 0, SCM_CHAR_SET_SMALL_CHARS, 0);
Scm_TreeCoreInit(&cs->large, cmp, NULL);
return cs;
}
ScmObj Scm_MakeTreeMap(ScmTreeCoreCompareProc *cmp, void *data)
{
ScmTreeMap *tm = SCM_NEW(ScmTreeMap);
SCM_SET_CLASS(tm, SCM_CLASS_TREE_MAP);
/* TODO: default cmp should be different from TreeCore */
Scm_TreeCoreInit(SCM_TREE_MAP_CORE(tm), cmp, data);
return SCM_OBJ(tm);
}
ScmObj Scm_MakeSyntax(ScmSymbol *name, ScmObj handler)
{
ScmSyntax *s = SCM_NEW(ScmSyntax);
SCM_SET_CLASS(s, SCM_CLASS_SYNTAX);
s->name = name;
s->handler = handler;
return SCM_OBJ(s);
}
static ScmObj porterror_allocate(ScmClass *klass, ScmObj initargs)
{
ScmPortError *e = SCM_ALLOCATE(ScmPortError, klass);
SCM_SET_CLASS(e, klass);
e->common.message = SCM_FALSE; /* set by initialize */
e->port = NULL; /* set by initialize */
return SCM_OBJ(e);
}
static ScmObj sigerror_allocate(ScmClass *klass, ScmObj initargs)
{
ScmUnhandledSignalError *e = SCM_ALLOCATE(ScmUnhandledSignalError, klass);
SCM_SET_CLASS(e, klass);
e->common.message = SCM_FALSE; /* set by initialize */
e->signal = 0; /* set by initialize */
return SCM_OBJ(e);
}
static ScmObj syserror_allocate(ScmClass *klass, ScmObj initargs)
{
ScmSystemError *e = SCM_ALLOCATE(ScmSystemError, klass);
SCM_SET_CLASS(e, klass);
e->common.message = SCM_FALSE; /* set by initialize */
e->error_number = 0; /* set by initialize */
return SCM_OBJ(e);
}
ScmObj Scm_MakeLazyPair(ScmObj item, ScmObj generator)
{
ScmLazyPair *z = SCM_NEW(ScmLazyPair);
z->owner = (AO_t)0;
SCM_SET_CLASS(z, SCM_CLASS_LAZY_PAIR);
z->generator = generator;
z->item = item;
return SCM_OBJ(z);
}
static ScmObj objc_error_allocate(ScmClass *klass, ScmObj initargs)
{
ScmObjCError *err = SCM_ALLOCATE(ScmObjCError, klass);
SCM_SET_CLASS(err, klass);
err->name = SCM_FALSE;
err->reason = SCM_FALSE;
SCM_RETURN(SCM_OBJ(err));
}
ScmObj Scm_MakeMacro(ScmSymbol *name, ScmTransformerProc transformer,
void *data)
{
ScmMacro *s = SCM_NEW(ScmMacro);
SCM_SET_CLASS(s, SCM_CLASS_MACRO);
s->name = name;
s->transformer = transformer;
s->data = data;
return SCM_OBJ(s);
}
ScmSyntaxPattern *make_syntax_pattern(int level, int numFollowing)
{
ScmSyntaxPattern *p = SCM_NEW(ScmSyntaxPattern);
SCM_SET_CLASS(p, SCM_CLASS_SYNTAX_PATTERN);
p->pattern = SCM_NIL;
p->vars = SCM_NIL;
p->level = level;
p->numFollowingItems = numFollowing;
return p;
}
static ScmBignum *make_bignum(int size)
{
if (size < 0) Scm_Error("invalid bignum size (internal error): %d", size);
if (size > (int)SCM_BIGNUM_MAX_DIGITS) Scm_Error("too large bignum");
ScmBignum *b = SCM_NEW_ATOMIC2(ScmBignum*, BIGNUM_SIZE(size));
SCM_SET_CLASS(b, SCM_CLASS_INTEGER);
b->size = size;
b->sign = 1;
return bignum_clear(b);
}
ScmSyntaxPattern *make_syntax_pattern(int level, int repeat)
{
ScmSyntaxPattern *p = SCM_NEW(ScmSyntaxPattern);
SCM_SET_CLASS(p, SCM_CLASS_SYNTAX_PATTERN);
p->pattern = SCM_NIL;
p->vars = SCM_NIL;
p->level = level;
p->repeat = repeat;
return p;
}
/* NB: For the time being, proto argument is ignored. */
ScmWriteState *Scm_MakeWriteState(ScmWriteState *proto)
{
ScmWriteState *z = SCM_NEW(ScmWriteState);
SCM_SET_CLASS(z, SCM_CLASS_WRITE_STATE);
z->sharedTable = NULL;
z->sharedCounter = 0;
z->currentLevel = 0;
z->controls = NULL;
return z;
}
Scm_GLGDNode
*Scm_GLGDNodeBox(glgdNode *node)
{
Scm_GLGDNode *Scm_node;
Scm_node = SCM_NEW(Scm_GLGDNode);
SCM_SET_CLASS(Scm_node, SCM_CLASS_GLGD_NODE);
Scm_node->node = (glgdNode *)node;
return Scm_node;
}
Scm_GLGDLinkList
*Scm_GLGDLinkListBox(glgdLinkList *list)
{
Scm_GLGDLinkList *Scm_list;
Scm_list = SCM_NEW(Scm_GLGDLinkList);
SCM_SET_CLASS(Scm_list, SCM_CLASS_GLGD_LINKLIST);
Scm_list->list = (glgdLinkList *)list;
return Scm_list;
}
Scm_GLGDGraph
*Scm_GLGDGraphBox(glgdGraph *graph)
{
Scm_GLGDGraph *Scm_graph;
Scm_graph = SCM_NEW(Scm_GLGDGraph);
SCM_SET_CLASS(Scm_graph, SCM_CLASS_GLGD_GRAPH);
Scm_graph->graph = (glgdGraph *)graph;
return Scm_graph;
}
/* NB: For the time being, proto argument is ignored. */
ScmWriteState *Scm_MakeWriteState(ScmWriteState *proto)
{
ScmWriteState *z = SCM_NEW(ScmWriteState);
SCM_SET_CLASS(z, SCM_CLASS_WRITE_STATE);
z->sharedTable = NULL;
z->sharedCounter = 0;
z->printLength = 0;
z->printDepth = 0;
z->currentDepth = 0;
return z;
}
Scm_GLGDLink
*Scm_GLGDLinkBox(glgdLink *link)
{
Scm_GLGDLink *Scm_link;
Scm_link = SCM_NEW(Scm_GLGDLink);
SCM_SET_CLASS(Scm_link, SCM_CLASS_GLGD_LINK);
Scm_link->link = (glgdLink *)link;
return Scm_link;
}
