`(Hello ,world)

ツッコミ、添削大歓迎です。いろいろ教えてください。

2009-07-12

Gaucheの拡張ライブラリ作成

genstubでスタブ生成 - `(Hello ,world) - cadr groupで、genstub で作った拡張ライブラリのソースを直接プロジェクトに含めるとクラスのdllのリンケージが異なっていてエラーが出てしまう。なので別プロジェクトとしてdllを作成してやってみる。

dllのリンケージ指定

プリプロセッサでEXTSDL_EXPORTSと指定して、

#if defined(EXTSDL_EXPORTS)
#define LIBGAUCHE_EXT_BODY
#endif
#include <gauche/extern.h>      /* redefine SCM_EXTERN  */

とする。

dllのリンクエラー

自分で拡張ライブラリを作ろうとするとリンク時にエラーが出る:

リンクしています...
   ライブラリ D:\home\repos\lisp\gauche\sdlbind\Debug\ext-sdl.lib とオブジェクト D:\home\repos\lisp\gauche\sdlbind\Debug\ext-sdl.exp を作成中
sdl-lib.obj : error LNK2001: 外部シンボル "__imp__Scm_ProcedureClass" は未解決です。
sdl-lib.obj : error LNK2001: 外部シンボル "__imp__Scm_StringClass" は未解決です。
sdl-lib.obj : error LNK2019: 未解決の外部シンボル __imp__GC_malloc が関数 _sdl_lib_sdlrect_new で参照されました。
sdl-bind.obj : error LNK2001: 外部シンボル "__imp__GC_malloc" は未解決です。
sdl-lib.obj : error LNK2019: 未解決の外部シンボル __imp__Scm_Define が関数 _Scm_Init_sdl_lib で参照されました。
sdl-lib.obj : error LNK2019: 未解決の外部シンボル __imp__Scm_Intern が関数 _Scm_Init_sdl_lib で参照されました。
sdl-bind.obj : error LNK2001: 外部シンボル "__imp__Scm_Intern" は未解決です。
sdl-lib.obj : error LNK2019: 未解決の外部シンボル __imp__Scm_MakeString が関数 _Scm_Init_sdl_lib で参照されました。
sdl-bind.obj : error LNK2001: 外部シンボル "__imp__Scm_MakeString" は未解決です。
sdl-bind.obj : error LNK2001: 外部シンボル "__imp__Scm_ClassClass" は未解決です。
sdl-bind.obj : error LNK2019: 未解決の外部シンボル __imp__Scm_InitStaticClass が関数 _Scm_Init_SDL で参照されました。
sdl-bind.obj : error LNK2019: 未解決の外部シンボル __imp__Scm_FindModule が関数 _Scm_Init_SDL で参照されました。
D:\home\repos\lisp\gauche\sdlbind\Debug\ext-sdl.dll : fatal error LNK1120: 外部参照 9 が未解決です。
ビルドログは "file://d:\home\repos\lisp\gauche\sdlbind\Debug\BuildLog.htm" に保存されました。
ext-sdl - エラー 13、警告 0

これはプロジェクト依存関係でlibgaucheにチェックを入れればOK。

gauche-package generate

進めていくうちに、Gaucheではgauche-packageに拡張ライブラリを作るための作業を多少簡単にしてくれるコマンドがあることを知った。Gauche:拡張ライブラリ入門を参考に、

$ gauche-package generate sdl

とすると

などを作ってくれる。これを元に作っていったほうがいいだろう。

WinGaucheの拡張ライブラリの規則にのっとって、プロジェクト名はext-sdlとしよう。作成するdllの名前はsdlだと本当のsdlとかぶってしまうのでgauche-sdl.dllとしよう。そうするとdllのエントリ名も合わせる必要があるので、

SCM_EXTENSION_ENTRY void Scm_Init_gauche_sdl(void)

とする。

GAUCHE_API_0_9

スタブから.cの生成は、ラベルGAUCHE_API_0_9を定義させるために

$ gosh genstub -D GAUCHE_API_0_9 sdl-bind.stub

とする。

Cの構造体に対応するSchemeのクラス定義

構造体の定義は、スタブに

(define-cclass <SDL_Rect> "ScmSDL_Rect*" "Scm_SDL_RectClass"
  ()
  ((x :type <short> :setter "obj->rc.x = (short)SCM_INT_VALUE(value);" :getter "return SCM_MAKE_INT(obj->rc.x);")
   ...)
  (allocator (c "alloc_SDL_Rect")))

などと書く。スロットの定義を書けばSchemeからslot-refやslot-set!でアクセスできるようになる。

cclassの定義に親クラスを書かないとSCM_CLASS_DEFAULT_CPLを参照するようになってるが、VCだと外部dllの実体の参照が静的に置けないのでSCM_DEFINE_BUILTIN_CLASSでエラーが出てしまう。なので親クラステーブルをNULLとするためスタブに

#undef SCM_CLASS_DEFAULT_CPL
#define SCM_CLASS_DEFAULT_CPL NULL

を挿入しておく。

ForeignPointer

SDL_Surfaceのように、ポインタだけでScheme側からは中身に直接触らないものはScm_MakeForeignPointerClassを使って

ScmClass *Scm_SDL_SurfaceClass;
	Scm_SDL_SurfaceClass = Scm_MakeForeignPointerClass(mod, "<SDL_SurfacePtr>", SDL_SurfacePtr_print, SDL_SurfacePtr_cleanup, SCM_FOREIGN_POINTER_KEEP_IDENTITY|SCM_FOREIGN_POINTER_MAP_NULL);

などと書く。

gauche-init.scm

以前やったときに(use)が使えなかったのは起動時にgauche-init.scmを読み込めば解決した。これを読み込まないとuvectorを使おうとしたときにエラーが出て気がついた。gauche-init.scmはgoshなどでも起動時に読まれるスクリプト。

こんなところかな…。ドキュメントとしてまとまってないのでググッたり他の拡張ライブラリ見たり推測したり大変だった。誰かまとめないですかね。

ソース

以下、SDLの拡張ライブラリを使ってキー操作でスプライトを動かすテスト:

entry.scm

(define (/= a b) (not (= a b)))

(define-macro (iflet var val then . rest)
  (let1 g (gensym)
    `(let1 ,g ,val
       (if ,g
           (let1 ,var ,g
             ,then)
         ,@rest))))

(define-macro (vcase val . rest)
  (let1 g (gensym)
    `(let1 ,g ,val
       (cond ,@(map (lambda (exp)
                      (if (eq? (car exp) 'else)
                          exp
                        `((= ,(car exp) ,g) ,@(cdr exp))))
                    rest)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(use sdl)

(use gauche.uvector)
(define *key-state* (make-u8vector SDLK_LAST 0))

(define (keydown keysym)
  (u8vector-set! *key-state* keysym 1))

(define (keyup keysym)
  (u8vector-set! *key-state* keysym 0))

(define (key-pressed? keysym)
  (/= (u8vector-ref *key-state* keysym) 0))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-constant FRAME_TICKS 16) ;(div 1000 60))
(define-constant ScreenWidth 640)
(define-constant ScreenHeight 480)

(define *screen* '())
(define videoflags '())
(define video_bpp '())

(define (term)
  (SDL_Quit))

(define (init caption w h)
  (if (< (SDL_Init SDL_INIT_VIDEO) 0)
      #f
    (begin
      (SDL_WM_SetCaption caption '())
      
      (let* ((info (SDL_GetVideoInfo))
             (bpp (slot-ref info 'vfmt->BitsPerPixel)))
        (set! video_bpp (if (> bpp 8)
                            bpp
                          16)))
      
      (set! videoflags (logior SDL_HWSURFACE SDL_DOUBLEBUF))
      (set! *screen* (SDL_SetVideoMode w h video_bpp videoflags))
      *screen*)))

(define wait
  (let ((lastticks #f))
    (lambda (frame_ticks)
      (let1 ticks (SDL_GetTicks)
        (when lastticks
          (let1 d (- frame_ticks (- ticks lastticks))
            (when (> d 0)
              (SDL_Delay d))))
        (set! lastticks ticks)))))

(define proc-events
  (let ((event (make <SDL_Event>)))
    (lambda ()
      (let1 cont #t
        (while (SDL_PollEvent event)
          (vcase (slot-ref event 'type)
                 (SDL_QUIT         (set! cont #f))
                 (SDL_VIDEORESIZE  (SDL_SetVideoMode (slot-ref event 'resize.w) (slot-ref event 'resize.h) video_bpp videoflags))
                 (SDL_KEYDOWN      (keydown (slot-ref event 'key.keysym.sym)))
                 (SDL_KEYUP        (keyup   (slot-ref event 'key.keysym.sym)))
                 ))
        cont))))

(define (load-image fn)
  (iflet surface (SDL_LoadBMP fn)
      (iflet converted (SDL_DisplayFormat surface)
          (begin
            (SDL_FreeSurface surface)
            converted)
        surface)
    #f))

(define blit
  (let ((rc (make <SDL_Rect>)))
    (lambda (src-surface x y)
      (slot-set! rc 'x x)
      (slot-set! rc 'y y)
      (SDL_BlitSurface src-surface '() *screen* rc))))

(define (loop sprite)
  (let ((x 100)
        (y 100))
    (call/cc
     (lambda (break)
       (while (proc-events)
         (when (key-pressed? SDLK_ESCAPE)
           (break))
         (SDL_FillRect *screen* '() 0)

         (when (key-pressed? SDLK_LEFT)
           (dec! x 1))
         (when (key-pressed? SDLK_RIGHT)
           (inc! x 1))
         (when (key-pressed? SDLK_UP)
           (dec! y 1))
         (when (key-pressed? SDLK_DOWN)
           (inc! y 1))
         (blit sprite x y)

         (wait FRAME_TICKS)
         (SDL_Flip *screen*))))))

(define (main)
  (if (init "SDL Test" ScreenWidth ScreenHeight)
      (let1 sprite (load-image "icon.bmp")
        (loop sprite)
        (SDL_FreeSurface sprite)
        (term))
    (print "failed")))

sdllib.stub

;;-*-Scheme-*-
;;;
;;; sdllib.stub
;;;

"
#include \"sdl.h\"
#include <SDL/SDL.h>
#include \"gauche/class.h\"

#undef SCM_CLASS_DEFAULT_CPL
#define SCM_CLASS_DEFAULT_CPL NULL

typedef struct ScmSDL_RectRec {
	SCM_HEADER;
	SDL_Rect rc;
} ScmSDL_Rect;

SCM_CLASS_DECL(Scm_SDL_RectClass);
#define SCM_CLASS_SDL_RECT (&Scm_SDL_RectClass)
#define SCM_SDL_RECT(obj) ((ScmSDL_Rect*)(obj))
#define SCM_SDL_RECTP(obj) (SCM_XTYPEP(obj, SCM_CLASS_SDL_RECT))

ScmObj alloc_SDL_Rect(ScmClass *klass, ScmObj initargs)
{
    ScmSDL_Rect *obj = SCM_ALLOCATE(ScmSDL_Rect, klass);
    SCM_SET_CLASS(obj, klass);
    memset(&obj->rc, 0x00, sizeof(obj->rc));
    return SCM_OBJ(obj);
}

typedef struct ScmSDL_Event {
	SCM_HEADER;
	SDL_Event event;
} ScmSDL_Event;

SCM_CLASS_DECL(Scm_SDL_EventClass);
#define SCM_CLASS_SDL_EVENT (&Scm_SDL_EventClass)
#define SCM_SDL_EVENT(obj) ((ScmSDL_Event*)(obj))
#define SCM_SDL_EVENTP(obj) (SCM_XTYPEP(obj, SCM_CLASS_SDL_EVENT))

ScmObj alloc_SDL_Event(ScmClass *klass, ScmObj initargs)
{
    ScmSDL_Event *obj = SCM_ALLOCATE(ScmSDL_Event, klass);
    SCM_SET_CLASS(obj, klass);
    return SCM_OBJ(obj);
}

typedef struct ScmSDL_VideoInfo {
	SCM_HEADER;
	const SDL_VideoInfo* info;
} ScmSDL_VideoInfo;

SCM_CLASS_DECL(Scm_SDL_VideoInfoClass);
#define SCM_CLASS_SDL_VIDEOINFO (&Scm_SDL_VideoInfoClass)
#define SCM_SDL_VIDEOINFO(obj) ((ScmSDL_VideoInfo*)(obj))
#define SCM_SDL_VIDEOINFOP(obj) (SCM_XTYPEP(obj, SCM_CLASS_SDL_VIDEOINFO))
"

(define-cclass <SDL_Rect> "ScmSDL_Rect*" "Scm_SDL_RectClass"
  ()
  ((x :type <short> :setter "if (!SCM_INTP(value)) Scm_Error(\"short required, but got %S\", value);\nobj->rc.x = (short)SCM_INT_VALUE(value);" :getter "return SCM_MAKE_INT(obj->rc.x);")
   (y :type <short> :setter "if (!SCM_INTP(value)) Scm_Error(\"short required, but got %S\", value);\nobj->rc.y = (short)SCM_INT_VALUE(value);" :getter "return SCM_MAKE_INT(obj->rc.y);")
   (w :type <short> :setter "if (!SCM_INTP(value)) Scm_Error(\"short required, but got %S\", value);\nobj->rc.w = (short)SCM_INT_VALUE(value);" :getter "return SCM_MAKE_INT(obj->rc.w);")
   (h :type <short> :setter "if (!SCM_INTP(value)) Scm_Error(\"short required, but got %S\", value);\nobj->rc.h = (short)SCM_INT_VALUE(value);" :getter "return SCM_MAKE_INT(obj->rc.h);"))
  (allocator (c "alloc_SDL_Rect")))

(define-cclass <SDL_Event> "ScmSDL_Event*" "Scm_SDL_EventClass"
  ()
  ((type :type <char> :setter "" :getter "return SCM_MAKE_INT(obj->event.type);")
   (key.keysym.sym :type <int> :setter "" :getter "return SCM_MAKE_INT(obj->event.key.keysym.sym);")
   (resize.w :type <int> :setter "" :getter "return SCM_MAKE_INT(obj->event.resize.w);")
   (resize.h :type <int> :setter "" :getter "return SCM_MAKE_INT(obj->event.resize.h);")
   )
  (allocator (c "alloc_SDL_Event")))

(define-cclass <SDL_VideoInfo> "ScmSDL_VideoInfo*" "Scm_SDL_VideoInfoClass"
  ()
  ((vfmt->BitsPerPixel :type <char> :setter "" :getter "return SCM_MAKE_INT(obj->info->vfmt->BitsPerPixel);")
   ))

(define-type <SDL_SurfacePtr> "SDL_Surface*")

(define-cproc SDL_Init (flags::<int>)
  (expr <int> "SDL_Init(flags)"))

(define-cproc SDL_Quit ()
  (body <void> "SDL_Quit();"))

(define-cproc SDL_WM_SetCaption (caption::<string> icon)
  (body <void> "SDL_WM_SetCaption(Scm_GetStringConst(caption), NULL);"))

(define-cproc SDL_GetVideoInfo ()
  "const SDL_VideoInfo* info = SDL_GetVideoInfo();
    ScmSDL_VideoInfo *obj = SCM_ALLOCATE(ScmSDL_VideoInfo, &Scm_SDL_VideoInfoClass);
    SCM_SET_CLASS(obj, &Scm_SDL_VideoInfoClass);
    obj->info = info;
    return SCM_OBJ(obj);")

(define-cproc SDL_SetVideoMode (width::<int> height::<int> bpp::<int> flags::<int>)
  "SDL_Surface* screen = SDL_SetVideoMode(width, height, bpp, flags);
   SCM_RETURN(screen != NULL ? SCM_SDL_SURFACEPTR_BOX(screen) : SCM_FALSE);")

(define-cproc SDL_LoadBMP (fn::<string>)
  "SDL_Surface* surface = SDL_LoadBMP(Scm_GetStringConst(fn));
   SCM_RETURN(surface != NULL ? SCM_SDL_SURFACEPTR_BOX(surface) : SCM_FALSE);")

(define-cproc SDL_DisplayFormat (surface::<SDL_SurfacePtr>)
  "SDL_Surface* converted = SDL_DisplayFormat(surface);
   SCM_RETURN(converted != NULL ? SCM_SDL_SURFACEPTR_BOX(converted) : SCM_FALSE);")

(define-cproc SDL_FreeSurface (surface::<SDL_SurfacePtr>)
  (body <void> "SDL_FreeSurface(surface);"))

(define-cproc SDL_FillRect (dst::<SDL_SurfacePtr> dstrect_scm color::<int>)
  "SDL_Rect* dstrect;
   if (SCM_NULLP(dstrect_scm)) dstrect = NULL;
   else if (SCM_SDL_RECTP(dstrect_scm)) dstrect = &SCM_SDL_RECT(dstrect_scm)->rc;
   else Scm_Error(\"<SDL_Rect> required, but got %S\", dstrect_scm);"
  (expr <int> "SDL_FillRect(dst, dstrect, color)"))

(define-cproc SDL_BlitSurface (src::<SDL_SurfacePtr> srcrect_scm dst::<SDL_SurfacePtr> dstrect::<SDL_Rect>)
  "SDL_Rect *srcrect;
   if (SCM_NULLP(srcrect_scm)) srcrect = NULL;
   else if (SCM_SDL_RECTP(srcrect_scm)) srcrect = &SCM_SDL_RECT(srcrect_scm)->rc;
   else Scm_Error(\"<SDL_Rect> required, but got %S\", srcrect_scm);"
  (expr <int> "SDL_BlitSurface(src, srcrect, dst, &dstrect->rc)"))

(define-cproc SDL_Flip (surface::<SDL_SurfacePtr>)
  (expr <int> "SDL_Flip(surface)"))

(define-cproc SDL_GetTicks ()
  (expr <int> "SDL_GetTicks()"))

(define-cproc SDL_Delay (ms::<int>)
  (body <void> "SDL_Delay(ms);"))

(define-cproc SDL_PollEvent (event::<SDL_Event>)
  "SCM_RETURN(SDL_PollEvent(&event->event) ? SCM_TRUE : SCM_FALSE);")

;; Local variables:
;; mode: scheme
;; end:

sdl.c

/*
 * sdl.c
 */

#include "sdl.h"
#include <SDL/SDL.h>

/*
 * Module initialization function.
 */
extern void Scm_Init_sdllib(ScmModule*);

static void SDL_SurfacePtr_print(ScmObj obj, ScmPort *out, ScmWriteContext *ctx) {
	SDL_Surface *q = SCM_SDL_SURFACEPTR(obj);
	Scm_Printf(out, "#<SDL_Surface*: %p>", q);
}

static void SDL_SurfacePtr_cleanup(ScmObj obj) {
	SDL_Surface *q = SCM_SDL_SURFACEPTR(obj);
//	delete q;
}

ScmClass *Scm_SDL_SurfaceClass;

SCM_EXTENSION_ENTRY void Scm_Init_gauche_sdl(void)
{
	ScmModule *mod;

	/* Register this DSO to Gauche */
	SCM_INIT_EXTENSION(sdl);

	/* Create the module if it doesn't exist yet. */
	mod = SCM_MODULE(SCM_FIND_MODULE("sdl", TRUE));

	Scm_SDL_SurfaceClass = Scm_MakeForeignPointerClass(mod, "<SDL_SurfacePtr>", SDL_SurfacePtr_print, SDL_SurfacePtr_cleanup, SCM_FOREIGN_POINTER_KEEP_IDENTITY|SCM_FOREIGN_POINTER_MAP_NULL);

	SCM_DEFINE(mod, "SDL_INIT_VIDEO", Scm_MakeInteger(SDL_INIT_VIDEO));

	// flags for SDL_SetVideoMode
	SCM_DEFINE(mod, "SDL_HWSURFACE", Scm_MakeInteger(SDL_HWSURFACE));
	SCM_DEFINE(mod, "SDL_DOUBLEBUF", Scm_MakeInteger(SDL_DOUBLEBUF));
	SCM_DEFINE(mod, "SDL_FULLSCREEN", Scm_MakeInteger(SDL_FULLSCREEN));
	SCM_DEFINE(mod, "SDL_RESIZABLE", Scm_MakeInteger(SDL_RESIZABLE));

	// event
	SCM_DEFINE(mod, "SDL_KEYDOWN", Scm_MakeInteger(SDL_KEYDOWN));
	SCM_DEFINE(mod, "SDL_KEYUP", Scm_MakeInteger(SDL_KEYUP));
	SCM_DEFINE(mod, "SDL_QUIT", Scm_MakeInteger(SDL_QUIT));
	SCM_DEFINE(mod, "SDL_VIDEORESIZE", Scm_MakeInteger(SDL_VIDEORESIZE));

	// keysym
	SCM_DEFINE(mod, "SDLK_ESCAPE", Scm_MakeInteger(SDLK_ESCAPE));
	SCM_DEFINE(mod, "SDLK_UP", Scm_MakeInteger(SDLK_UP));
	SCM_DEFINE(mod, "SDLK_DOWN", Scm_MakeInteger(SDLK_DOWN));
	SCM_DEFINE(mod, "SDLK_RIGHT", Scm_MakeInteger(SDLK_RIGHT));
	SCM_DEFINE(mod, "SDLK_LEFT", Scm_MakeInteger(SDLK_LEFT));
	SCM_DEFINE(mod, "SDLK_LAST", Scm_MakeInteger(SDLK_LAST));

	/* Register stub-generated procedures */
	Scm_Init_sdllib(mod);
}

sdl.h

/*
 * sdl.h
 */

/* Prologue */
#ifndef GAUCHE_SDL_H
#define GAUCHE_SDL_H

#include <gauche.h>
#include <gauche/extend.h>

#if defined(EXTSDL_EXPORTS)
#define LIBGAUCHE_EXT_BODY
#endif
#include <gauche/extern.h>      /* redefine SCM_EXTERN  */

SCM_DECL_BEGIN

extern ScmClass *Scm_SDL_SurfaceClass;
#define SCM_SDL_SURFACEPTRP(obj)     SCM_XTYPEP(obj, Scm_SDL_SurfaceClass)
#define SCM_SDL_SURFACEPTR(obj)      SCM_FOREIGN_POINTER_REF(SDL_Surface*, obj)
#define SCM_SDL_SURFACEPTR_BOX(ptr)  Scm_MakeForeignPointer(Scm_SDL_SurfaceClass, ptr)

/* Epilogue */
SCM_DECL_END

#endif  /* GAUCHE_SDL_H */

sdl.scm

;;;
;;; sdl
;;;

(define-module sdl
  (export <SDL_Rect>
          <SDL_Event>
          
          SDL_Init
          SDL_Quit
          SDL_WM_SetCaption
          SDL_GetVideoInfo
          SDL_SetVideoMode
          SDL_LoadBMP
          SDL_DisplayFormat
          SDL_FreeSurface
          SDL_FillRect
          SDL_BlitSurface
          SDL_Flip
          
          SDL_GetTicks
          SDL_Delay
          
          SDL_PollEvent
          
          SDL_INIT_VIDEO
          ; flags for SDL_SetVideoMode
          SDL_HWSURFACE
          SDL_DOUBLEBUF
          SDL_FULLSCREEN
          SDL_RESIZABLE
          
          ; event
          SDL_KEYDOWN
          SDL_KEYUP
          SDL_QUIT
          SDL_VIDEORESIZE

          ; keysym
          SDLK_ESCAPE
          SDLK_UP
          SDLK_DOWN
          SDLK_RIGHT
          SDLK_LEFT
          SDLK_LAST
          )
  )
(select-module sdl)

;; Loads extension
(dynamic-load "gauche-sdl")

;;
;; Put your Scheme definitions here
;;

;; Epilogue
(provide "sdl")

main.cpp

#define	GAUCHE_API_0_9
#include <gauche.h>
#include <stdio.h>

#include <SDL/SDL.h>

//=============================================================================

/* Error handling */
void error_exit(ScmObj c) {
	ScmObj m = Scm_ConditionMessage(c);
	if (SCM_FALSEP(m)) {
		Scm_Printf(SCM_CURERR, "gosh: Thrown unknown condition: %S\n", c);
	} else {
		Scm_Printf(SCM_CURERR, "gosh: %S: %A\n", Scm_ConditionTypeName(c), m);
	}
	Scm_Exit(1);
}

int dofile(const char* fn) {
	ScmLoadPacket lpak;
	if (Scm_Load(fn, 0, &lpak) >= 0) {
		return TRUE;
	} else {
		error_exit(lpak.exception);
		return FALSE;
	}
}

int call_proc(ScmSymbol* proc_sym, ScmObj args) {
	ScmModule* module = Scm_UserModule();
	ScmObj proc = Scm_GlobalVariableRef(module, proc_sym, 0);
	ScmEvalPacket epak;
	if (Scm_Apply(proc, args, &epak) >= 0) {
		return TRUE;
	} else {
		error_exit(epak.exception);
		return FALSE;
	}
}

int main(int argc, char* argv[]) {
	GC_INIT();
	Scm_Init(GAUCHE_SIGNATURE);
	Scm_AddLoadPath(".", FALSE);
	Scm_AddLoadPath("../Gauche-0.8.14/winnt/share/gauche/0.8.14/lib", FALSE);
	Scm_AddLoadPath("../Gauche-0.8.14/winnt/lib/gauche/site/0.8.14/i686-pc-winnt", FALSE);

	dofile("gauche-init.scm");
	dofile("./entry.scm");
	call_proc(SCM_SYMBOL(SCM_INTERN("main")), SCM_NIL);
	Scm_Exit(0);

	return 0;
}
  • sdl.scmにエクスポートする関数や変数などを書かないといけないのがメンドイ
  • ポインタ構造体もしくはnil()を受け付ける、というのを簡単に書きたい

参考:

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20090712