C++ SCM_OBJ函数代码示例

/* 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);
    }
}

/* Cleanup */
void cleanup_main(void *data)
{
    ScmVM *vm = Scm_VM();

    if (profiling_mode) {
        Scm_ProfilerStop();
        Scm_EvalCString("(profiler-show)",
                        SCM_OBJ(Scm_GaucheModule()),
                        NULL); /* ignore errors */
    }

    /* EXPERIMENTAL */
    if (stats_mode) {
        fprintf(stderr, "\n;; Statistics (*: main thread only):\n");
        fprintf(stderr,
                ";;  GC: %zubytes heap, %zubytes allocated\n",
                GC_get_heap_size(), GC_get_total_bytes());
        fprintf(stderr,
                ";;  stack overflow*: %ldtimes, %.2fms total/%.2fms avg\n",
                vm->stat.sovCount,
                vm->stat.sovTime/1000.0,
                (vm->stat.sovCount > 0?
                 (double)(vm->stat.sovTime/vm->stat.sovCount)/1000.0 :
                 0.0));
    }

    /* EXPERIMENTAL */
    if (SCM_VM_RUNTIME_FLAG_IS_SET(vm, SCM_COLLECT_LOAD_STATS)) {
        Scm_Eval(SCM_LIST2(SCM_INTERN("profiler-show-load-stats"),
                           SCM_LIST2(SCM_INTERN("quote"),
                                     vm->stat.loadStat)),
                 SCM_OBJ(Scm_GaucheModule()),
                 NULL);    /* ignore errors */
    }
}

ScmObj Scm_SocketAccept(ScmSocket *sock)
{
    Socket newfd;
    struct sockaddr_storage addrbuf;
    socklen_t addrlen = sizeof(addrbuf);
    ScmSocket *newsock;
    ScmClass *addrClass = Scm_ClassOf(SCM_OBJ(sock->address));

    CLOSE_CHECK(sock->fd, "accept from", sock);
    SCM_SYSCALL(newfd, accept(sock->fd, (struct sockaddr*)&addrbuf, &addrlen));
    if (SOCKET_INVALID(newfd)) {
        if (errno == EAGAIN) {
            return SCM_FALSE;
        } else {
            Scm_SysError("accept(2) failed");
        }
    }
    newsock = make_socket(newfd, sock->type);
    newsock->address =
        SCM_SOCKADDR(Scm_MakeSockAddr(addrClass,
                                      (struct sockaddr*)&addrbuf,
                                      addrlen));
    newsock->status = SCM_SOCKET_STATUS_CONNECTED;
    return SCM_OBJ(newsock);
}

/* 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 Scm_SocketOutputPort(ScmSocket *sock, int buffering)
{
    if (sock->outPort == NULL) {
        int outfd;
        if (sock->type != SOCK_DGRAM &&
                sock->status < SCM_SOCKET_STATUS_CONNECTED) {
            sockport_err(sock, "output");
        }
#ifndef GAUCHE_WINDOWS
        outfd = sock->fd;
#else  /*GAUCHE_WINDOWS*/
        /* cfd will be closed when this socket is closed. */
        if (sock->cfd < 0) {
            sock->cfd = _open_osfhandle(sock->fd, 0);
        }
        outfd = sock->cfd;
#endif /*GAUCHE_WINDOWS*/
        if (outfd == INVALID_SOCKET) sockport_err(sock, "output");

        /* NB: I keep the socket itself in the port name, in order to avoid
           the socket from GCed prematurely if application doesn't keep
           pointer to the socket. */
        ScmObj sockname = SCM_LIST2(SCM_MAKE_STR("socket output"),
                                    SCM_OBJ(sock));
        sock->outPort = SCM_PORT(Scm_MakePortWithFd(sockname, SCM_PORT_OUTPUT,
                                 outfd, buffering, FALSE));
    }
    return SCM_OBJ(sock->outPort);
}

/* 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 cv_allocate(ScmClass *klass, ScmObj initargs)
{
    ScmConditionVariable *cv = SCM_NEW_INSTANCE(ScmConditionVariable, klass);
    SCM_INTERNAL_COND_INIT(cv->cv);
    Scm_RegisterFinalizer(SCM_OBJ(cv), cv_finalize, NULL);
    cv->name = SCM_FALSE;
    cv->specific = SCM_UNDEFINED;
    return SCM_OBJ(cv);
}

/* Implemented in Scheme */
static void write_walk(ScmObj obj, ScmPort *port)
{
    static ScmObj proc = SCM_UNDEFINED;
    SCM_ASSERT(port->writeState);
    ScmHashTable *ht = port->writeState->sharedTable;
    SCM_ASSERT(ht != NULL);
    SCM_BIND_PROC(proc, "%write-walk-rec", Scm_GaucheInternalModule());
    Scm_ApplyRec3(proc, obj, SCM_OBJ(port), SCM_OBJ(ht));
}

/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
    /* 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);
}

ScmObj Scm_Acons(ScmObj caar, ScmObj cdar, ScmObj cdr)
{
    ScmPair *y = SCM_NEW(ScmPair);
    ScmPair *z = SCM_NEW(ScmPair);
    SCM_SET_CAR(y, caar);
    SCM_SET_CDR(y, cdar);
    SCM_SET_CAR(z, SCM_OBJ(y));
    SCM_SET_CDR(z, cdr);
    return SCM_OBJ(z);
}

ScmObj Scm_MakeTLS(uint32_t options, int num_sessions)
{
    ScmTLS* t = SCM_NEW(ScmTLS);
    SCM_SET_CLASS(t, SCM_CLASS_TLS);
#if defined(GAUCHE_USE_AXTLS)
    t->ctx = ssl_ctx_new(options, num_sessions);
    t->conn = NULL;
    t->in_port = t->out_port = 0;
#endif /*GAUCHE_USE_AXTLS*/
    Scm_RegisterFinalizer(SCM_OBJ(t), tls_finalize, NULL);
    return SCM_OBJ(t);
}

/* for debug */
static void dump_traverse(Node *node, int depth, ScmPort *out, int scmobj)
{
    if (node->left) dump_traverse(node->left, depth+1, out, scmobj);
    for (int i=0; i<depth; i++) Scm_Printf(out, "  ");
    if (scmobj) {
        Scm_Printf(out, "%c:%S => %S\n", BLACKP(node)?'B':'R',
                   SCM_OBJ(node->key), SCM_OBJ(node->value));
    } else {
        Scm_Printf(out, "%c:%08x => %08x\n", BLACKP(node)?'B':'R',
                   node->key, node->value);
    }
    if (node->right) dump_traverse(node->right, depth+1, out, scmobj);
}

static ScmObj mutex_allocate(ScmClass *klass, ScmObj initargs)
{
    ScmMutex *mutex = SCM_NEW_INSTANCE(ScmMutex, klass);
    SCM_INTERNAL_MUTEX_INIT(mutex->mutex);
    SCM_INTERNAL_COND_INIT(mutex->cv);
    Scm_RegisterFinalizer(SCM_OBJ(mutex), mutex_finalize, NULL);
    mutex->name = SCM_FALSE;
    mutex->specific = SCM_UNDEFINED;
    mutex->locked = FALSE;
    mutex->owner = NULL;
    mutex->locker_proc = mutex->unlocker_proc = SCM_FALSE;
    return SCM_OBJ(mutex);
}

static gboolean
glgdGraphKeyCB(GtkWidget *widget, GdkEventKey *event, gpointer data)
{
    glgdGraph   *graph;
    ScmObj      keyFn;
    
    graph = (glgdGraph *)data;
    if (graph == NULL)
    {
        return FALSE;
    }
    
    switch (event->keyval)
    {
        case GDK_Control_L:
        case GDK_Control_R:
            if (event->type == GDK_KEY_PRESS)
            {
                graph->flags |= GLGDGRAPH_FLAG_CTRLHELD;
            }
            else if (event->type == GDK_KEY_RELEASE)
            {
                graph->flags &= ~GLGDGRAPH_FLAG_CTRLHELD;
            }
        break;
        
        case GDK_Escape:
            if (event->type == GDK_KEY_PRESS)
            {
                graph->flags |= GLGDGRAPH_FLAG_ESCPRESSED;
            }
        break;
        
        default:
            return FALSE;
    }

    gdk_window_invalidate_rect(widget->window, &widget->allocation, FALSE);

    keyFn = graph->fn[GLGDGRAPH_FN_KEY];
    if (keyFn != NULL)
    {
        Scm_ApplyRec4(keyFn,
                      SCM_OBJ(SCM_MAKE_GLGD_GRAPH(graph)),
                      SCM_OBJ(SCM_MAKE_GLGD_NODE(graph->hoverNode)),
                      SCM_OBJ(SCM_MAKE_GLGD_LINK(graph->hoverLink)),
                      SCM_OBJ(Scm_MakeGdkEventKey(event)));
    }

    return TRUE;
}

ScmObj Scm_CharSetAdd(ScmCharSet *dst, ScmCharSet *src)
{
    if (dst == src) return SCM_OBJ(dst);  /* precaution */

    ScmTreeIter iter;
    ScmDictEntry *e;
    Scm_BitsOperate(dst->small, SCM_BIT_IOR, dst->small, src->small,
                    0, SCM_CHAR_SET_SMALL_CHARS);
    Scm_TreeIterInit(&iter, &src->large, NULL);
    while ((e = Scm_TreeIterNext(&iter)) != NULL) {
        Scm_CharSetAddRange(dst, SCM_CHAR(e->key), SCM_CHAR(e->value));
    }
    return SCM_OBJ(dst);
}