use register-finalizer-and-custodian-shutdown

Author: Chongkai Zhu

light.ss

@@ -3,11 +3,10 @@
 (require "mathlink.ss"
          "translation.ss"
          racket/contract
-         (only-in ffi/unsafe register-finalizer)
          ffi/unsafe/custodian)
 
 (provide/contract (MathKernel
-                   (->* () () #:rest (listof string?) any))
+                   (-> string? ... MathLink?))
                   (MathEval
                    (->* ((flat-rec-contract Mexp
                            number? boolean? symbol? string? void? eof-object?
@@ -164,18 +163,16 @@
                     "/Applications/Mathematica.app/Contents/MacOS/MathKernel -mathlink"))))
     (arg
      (let ((link (apply MLOpen arg)))
-       (set-MathLink-ref! link
-                          (register-custodian-shutdown link MLClose #:at-exit? #t))
-       (register-finalizer link MathExit)
+       (register-finalizer-and-custodian-shutdown link MLClose #:at-exit? #t)
        (current-mathlink link)
        link))))
 
 (define (MathEval exp (link (or (current-mathlink) (MathKernel))))
   (call-with-semaphore (MathLink-sema link)
                        (lambda ()
-                         (unless (MathLink-ref link)
-                           (mathlink-error "MathEval: MathLink is closed"))
                          (let ((lp (MathLink-lp link)))
+                           (unless lp
+                             (mathlink-error "MathEval: MathLink is closed"))
                            (MLPutFunction lp #"EvaluatePacket" 1)
                            (MLPut lp exp)
                            (MLEndPacket lp)
@@ -186,13 +183,6 @@
     (()
      (cond ((current-mathlink) => MathExit)))
     ((link)
-     (call-with-semaphore (MathLink-sema link)
-                          (lambda ()
-                            (when (eq? link (current-mathlink))
-                              (current-mathlink #f))
-                            (let ((ref (MathLink-ref link)))
-                              (when ref
-                                (set-MathLink-ref! link #f)
-                                (unregister-custodian-shutdown link ref)
-                                (MLClose link)
-                                (set-phantom-bytes! (MathLink-phantom link) 0))))))))
+     (when (eq? link (current-mathlink))
+       (current-mathlink #f))
+     (MLClose link))))

mathlink.ss

@@ -5,7 +5,7 @@
 (provide (except-out (all-defined-out)
                      mathlink))
 
-(define-struct MathLink (ep lp (ref #:mutable) sema phantom))
+(define-struct MathLink (ep (lp #:mutable) sema))
 
 (define-struct (exn:fail:mathlink exn:fail) () #:transparent)
 (define-syntax-rule (mathlink-error str)
@@ -39,19 +39,22 @@
                        -> (if lp
                               (begin (MLNextPacket lp)
                                      (MLNewPacket lp)
-                                     (make-MathLink ep lp #t (make-semaphore 1) (make-phantom-bytes 65536)))
+                                     (make-MathLink ep lp (make-semaphore 1)))
                               (mathlink-error "MathKernel: MathLink Open Error"))))))
 
 (define MLClose
-  (let ((MLClose (get-ffi-obj 'WSClose mathlink
+  (let ((close (get-ffi-obj 'WSClose mathlink
                               (_fun _pointer -> _void)))
-        (MLDeinitialize
+        (deinitialize
          (get-ffi-obj 'WSDeinitialize mathlink
                       (_fun _pointer -> _void))))
     (lambda (link)
-      (MLPutMessage (MathLink-lp link) 1)
-      (MLClose (MathLink-lp link))
-      (MLDeinitialize (MathLink-ep link)))))
+      (let ((lp (MathLink-lp link)))
+        (when lp
+          (MLPutMessage (MathLink-lp link) 1)
+          (close (MathLink-lp link))
+          (deinitialize (MathLink-ep link))
+          (set-MathLink-lp! link #f))))))
 
 (define MLPutFunction
   (get-ffi-obj 'WSPutFunction mathlink