Hi you all, the gurus of CFFI ;-)
I do have a major problem when running the following code on LW Personal Edition on Mac OS X 10.4.10 Intel:
;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
(eval-when (:load-toplevel :compile-toplevel :execute) (ignore-errors #-asdf (load "~/lw-start.lisp") #-cffi (asdf:operate 'asdf:load-op 'cffi) #-net.goenninger.app.debug (asdf:operate 'asdf:load-op 'net.goenninger.app.debug) ))
(defpackage #:lw-tk-test (:use #:common-lisp #:clos #:cffi #+net.goenninger.app.debug #:net.goenninger.app.debug ) (:export #:main ))
(in-package #:lw-tk-test) (in-module :lw-tk-test) ;; needed for debugging
;;; ------------------------------------------------------------------------ ----------------- ;;; SPECIAL VARS ;;; ------------------------------------------------------------------------ -----------------
(defparameter *tki* nil) ;; Pointer to Tcl/Tk Interp structure.
;;; ------------------------------------------------------------------------ ----------------- ;;; DEBUG... ;;; ------------------------------------------------------------------------ -----------------
#-net.goenninger.app.debug (defun logmsg (msg-class method method-desc msg &rest msg-args) (format *debug-io* "~&~%--- ~a --------------------------------------------------" (get-universal-time) t) (format *debug-io* "~&*** ~A [ FN ~S ( ~A ) ]~&" msg-class method method-desc) (format *debug-io* "*** ") (apply 'format *debug-io* msg msg-args) (format *debug-io* "~%") (force-output *debug-io*))
;;; ------------------------------------------------------------------------ ----------------- ;;; FOREIGN LIB DEFINITIONS ;;; ------------------------------------------------------------------------ -----------------
(define-foreign-library Tcl (:darwin (:framework "Tcl")) (:windows (:or "/tcl/bin/Tcl85.dll")) (:unix "libtcl.so") (t (:default "libtcl")))
(define-foreign-library Tk (:darwin (:framework "Tk")) (:windows (:or "/tcl/bin/tk85.dll")) (:unix "libtk.so") (t (:default "libtk")))
;;; ------------------------------------------------------------------------ ----------------- ;;; FOREIGN TYPE DEFINITIONS ;;; ------------------------------------------------------------------------ -----------------
(defctype tcl-retcode :int)
(defcenum tcl-retcode-values (:tcl-ok 0) (:tcl-error 1))
;;; ------------------------------------------------------------------------ ----------------- ;;; FOREIGN FUNCTION DEFINITIONS ;;; ------------------------------------------------------------------------ -----------------
;;; <tcl.h> void Tcl_FindExecutable(char *); (defcfun ("Tcl_FindExecutable" tcl-find-executable) :void (argv0 :string))
;;; <tcl.h> int Tcl_Init( Tcl-Interp *interp ); (defcfun ("Tcl_Init" Tcl_Init) tcl-retcode (interp :pointer))
;;; <tk.h> int Tk_Init( Tcl-Interp *interp ); (defcfun ("Tk_Init" Tk_Init) tcl-retcode (interp :pointer))
;;; <tcl.h> Tcl_Interp* Tcl_CreateInterp(void); (defcfun ("Tcl_CreateInterp" Tcl_CreateInterp) :pointer)
;;; <tcl.h> voíd Tcl_DeleteInterp(Tcl_Interp* interp); (defcfun ("Tcl_DeleteInterp" Tcl_DeleteInterp) :void (interp :pointer))
;;; <tcl.> char *Tcl_GetStringResult( Tcl_Interp *interp); (defcfun ("Tcl_GetStringResult" Tcl_GetStringResult) :string (interp :pointer))
;;; Helper function: translate int return code to :tcl-ok or :tcl- error and checks for ;;; :tcl-ok. (defmethod translate-from-foreign (value (type (eql 'tcl-retcode))) (unless (eql value (foreign-enum-value 'tcl-retcode-values :tcl-ok)) (error "Tcl error: ~a" (Tcl_GetStringResult *tki*))) value)
;;; ------------------------------------------------------------------------ ----------------- ;;; TCL/TK LOADING ... ;;; ------------------------------------------------------------------------ -----------------
(defun tk-app-init (interp) (assert (not (null-pointer-p interp))) (Tcl_Init interp) (Tk_Init interp) ;; <<<--- CRASH HAPPENS HERE ... ;; Return OK (foreign-enum-value 'tcl-retcode-values :tcl-ok))
(defun argv0 () #+allegro (sys:command-line-argument 0) #+lispworks (nth 0 system:*line-arguments-list*) ;; portable to OS X #+sbcl (nth 0 sb-ext:*posix-argv*) #+openmcl (car ccl:*command-line-argument-list*) #-(or allegro lispworks sbcl openmcl) (error "argv0 function not implemented for this lisp"))
;;; ------------------------------------------------------------------------ ----------------- ;;; TEST ROUTINE ;;; ------------------------------------------------------------------------ -----------------
#+net.goenninger.app.debug (progn (enable-debugging :module :lw-tk-test) (enable-debugging :function 'main))
(defun main ()
(use-foreign-library Tcl) (use-foreign-library Tk)
(setq *tki* (Tcl_CreateInterp)) (logmsg :DEBUG 'main "-" "*tki* = ~s" *tki*)
(let ((argv0 (argv0))) (logmsg :DEBUG 'main "-" "argv0 = ~s" argv0) (tcl-find-executable argv0))
(tk-app-init *tki*) (Tcl_DeleteInterp *tki*) (setf *tki* nil) )
Sooo - the code crashes at the point marked "<<<--- CRASH HAPPENS HERE ...". This occurs on LW but not on ACL 8.1 Express Edition.
I have double, no triple, checked the defc... stuff - to no avail. The code had been working for half a year on ACL without problems. I recently switched to LW and can't get to the point of seeing where there's something going astray.
Any help really appreciated!!! Thanks so much in advance !
Frank
-- Frank Goenninger frgo@goenninger.net