beginnings of a gh_ interface for stk

From: Russ McManus <>
Date: Tue, 29 Apr 1997 09:25:20 -0400

i know this is a bit late, but i use the following quite
effectively. maybe someone can clean it up a little bit
and include it in stk.

to use this code, #include <gh_extra.h> into your code,
and link in gh_extra.o. then one can code with the gh_
api in stk. mostly, anyway.

one important difference: i use a new c function called
gh_new_procedure_simple rather than gh_new_procedure. it
is a direct simplification of the gh_new_procedure, and
is trivially implemented if one is programming in guile

i've also added a couple of goodies that would need to
be added to gh_ in guile itself. gh_assert comes to mind,
there may be others.

certainly, things are missing. i've added things as i've
needed them. use as you please, if you do please include
my name.



#ifndef GH_EXTRA_H
#define GH_EXTRA_H

#if defined(__cplusplus)
extern "C" {

#include <stdio.h>
#include <stk.h>
#define gh_eq_p(obj1, obj2) STk_eq(obj1, obj2)
#define gh_gc_mark(obj) STk_gc_mark(obj)
#define gh_gc_link(obj) (void)0;
#define gh_gc_unlink(obj) (void)0;
#define gh_string_p(obj) STRINGP(obj)
#define gh_exact_p(obj) INTEGERP(obj)
#define gh_number_p(obj) NUMBERP(obj)
#define gh_procedure_p(obj) CLOSUREP(obj)
#define gh_car(obj) CAR(obj)
#define gh_cdr(obj) CDR(obj)
#define gh_str2scm(s,len) (s?STk_makestrg(len,s):STk_makestrg(1,"\0"))
#define gh_str02scm(s) (s?STk_makestrg(strlen(s),s):STk_makestrg(1,"\0"))
#define gh_vector(n, init) STk_make_vector(n, init)
#define gh_int2scm(n) STk_makeinteger((double)n)
#define gh_scm2int(obj) INTEGER(obj)
#define gh_scm2long(obj) ((long)INTEGER(obj))
#define gh_scm2double(obj) FLONM(obj)
#define gh_double2scm(n) STk_makenumber(n)
#define gh_vset(v, i, obj) STk_vector_set(v, i, obj)
#define SCM_EOL STk_nil
#define gh_list_length(obj) ((unsigned long)STk_llength(obj))
#define gh_apply(proc, ls) STk_apply(proc, ls)
#define gh_cons(obj1, obj2) STk_cons(obj1, obj2)
#define SCM_BOOL_F STk_ntruth
#define SCM_BOOL_T STk_truth
#define gh_defer_ints() (void)1
#define gh_allow_ints() (void)1
#define gh_new_cell(obj, tag) NEWCELL((obj), (tag))
#define gh_type_p(obj, tag) TYPEP(obj, tag)
#define gh_set_ext_data(obj, x) EXTDATA(obj) = (void*)(x);
#define gh_get_ext_data(obj) (void*)EXTDATA(obj)
#define gh_intern(str) STk_intern(str)
#define gh_defer_ints() (void)1
#define gh_allow_ints() (void)1

/* prototypes for functions defined in gh_extra.c */
#define GH_ARGLIST -1
void gh_new_procedure_simple(char *name, SCM (*fn)(), int n_args);
void gh_assert(int cond, const char *proc, const char *msg, SCM obj);
char *gh_must_malloc(long size);
void gh_scm2str(SCM obj, char **return_str, int *len);
void gh_scm2str0(SCM obj, char *return_str0, int max_len);

#if defined(__cplusplus)


void gh_new_procedure_simple(char *name, SCM (*fn)(), int n_args)
    int type;
    switch (n_args) {
    case 0:
        type = tc_subr_0;
    case 1:
        type = tc_subr_1;
    case 2:
        type = tc_subr_2;
    case 3:
        type = tc_subr_3;
    case GH_ARGLIST:
        type = tc_lsubr;
    STk_add_new_primitive(name, type, fn);

void gh_assert(int cond, const char *proc, const char *msg, SCM obj)
    if (!cond) {
        char buf[256];
        sprintf(buf, "%s:%s", proc, msg);
        STk_err(buf, obj);

void gh_scm2str0(SCM obj, char *return_str0, int max_len)
    char *ret_str = CHARS(obj);
    int i, len = STRSIZE(obj);

    for (i = 0; (i < len) && (i < (max_len-1)); ++i) {
        return_str0[i] = ret_str[i];

    /* now make sure we null-terminate it */
    return_str0[i] = '\0';

void gh_scm2str(SCM obj, char **return_str, int *len)
    *return_str = CHARS(obj);
    *len = STRSIZE(obj);

char *gh_must_malloc(long size)
    return must_malloc(size);

Russell D. McManus             phone: 212-357-4901
Goldman, Sachs & Co.            beep: 917-556-0708
Intl. Equities Technology
Received on Tue Apr 29 1997 - 15:24:25 CEST

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST