Support Racket on Chez Scheme

Remove the dependency on Racket BC's C API.
We now build a plain C shared library and
interact with it through the FFI.

Closes #1

.travis.yml

@@ -0,0 +1,50 @@
+language: c
+
+# Based on: https://github.com/greghendershott/travis-racket
+
+dist: bionic
+
+env:
+  global:
+    # Supply a global RACKET_DIR environment variable. This is where
+    # Racket will be installed. A good idea is to use ~/racket because
+    # that doesn't require sudo to install and is therefore compatible
+    # with Travis CI's newer container infrastructure.
+    - RACKET_DIR=~/racket
+  matrix:
+    # Supply at least one RACKET_VERSION environment variable. This is
+    # used by the install-racket.sh script (run at before_install,
+    # below) to select the version of Racket to download and install.
+    #
+    # Supply more than one RACKET_VERSION (as in the example below) to
+    # create a Travis-CI build matrix to test against multiple Racket
+    # versions.
+    - RACKET_VERSION=7.6
+    - RACKET_VERSION=HEAD
+    - RACKET_VERSION=HEADCS
+
+matrix:
+  allow_failures:
+#   - env: RACKET_VERSION=HEAD
+  fast_finish: true
+
+before_install:
+- git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket
+- cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh!
+- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
+
+install:
+ - raco pkg install -j 4 --auto --name unix-signals
+
+before_script:
+
+# Here supply steps such as raco make, raco test, etc.  You can run
+# `raco pkg install --deps search-auto` to install any required
+# packages without it getting stuck on a confirmation prompt.
+script:
+ - raco test -x -p unix-signals
+
+after_success:
+ - raco setup --check-pkg-deps --pkgs unix-signals
+ - raco pkg install --deps search-auto cover cover-coveralls
+ - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .

info.rkt

@@ -1,5 +1,11 @@
-#lang setup/infotab
+#lang info
+(define pkg-name 'unix-signals)
 (define collection 'multi)
-(define deps '("base" "rackunit-lib" "make"))
-(define build-deps '("racket-doc" "scribble-lib"))
-(define homepage "https://github.com/tonyg/racket-unix-signals")
+(define deps
+  '(["base" #:version "6.12"]
+    "dynext-lib"))
+(define build-deps
+  '("racket-doc"
+    "scribble-lib"))
+(define homepage
+  "https://github.com/tonyg/racket-unix-signals")

unix-signals/info.rkt

@@ -1,4 +1,4 @@
-#lang setup/infotab
+#lang info
 (define scribblings '(("unix-signals.scrbl" ())))
 (define pre-install-collection "private/install.rkt")
 (define compile-omit-files '("private/install.rkt"))

unix-signals/main.rkt

@@ -1,48 +1,137 @@
 #lang racket/base
 
-(provide next-signal-evt
-         read-signal
-         lookup-signal-number
+(require ffi/unsafe
+         ffi/unsafe/port
+         ffi/unsafe/define
+         racket/port
+         (rename-in racket/contract
+                    [-> ->/c])
+         (only-in racket/os getpid))
+
+(provide lookup-signal-number
          lookup-signal-name
-         capture-signal!
-         ignore-signal!
-         release-signal!
          getpid
-         send-signal!)
+         (contract-out
+          ;; These may not do what you want,
+          ;; but they shouldn't break invariants
+          ;; of the runtime system:
+          [next-signal-evt
+           (evt/c byte?)]
+           [read-signal
+            (->/c byte?)])
+         ;; These are unsafe:
+         (protect-out
+          (contract-out
+           [capture-signal!
+            (->/c (or/c symbol? fixnum?) boolean?)]
+           [ignore-signal!
+            (->/c (or/c symbol? fixnum?) boolean?)]
+           [release-signal!
+            (->/c (or/c symbol? fixnum?) boolean?)]
+           [send-signal!
+            (->/c fixnum? (or/c symbol? fixnum?) boolean?)])))
+
+(define (local-lib-dirs)
+  ;; FIXME: There's probably a better way to do this with
+  ;; define-runtime-path and cross-system-library-subpath,
+  ;; but this is what the bcrypt package is doing.
+  (list (build-path (collection-path "unix-signals")
+                    "private"
+                    "compiled"
+                    "native"
+                    (system-library-subpath #f))))
+
+(define libracket-unix-signals
+  (ffi-lib "libracket_unix_signals" #:get-lib-dirs local-lib-dirs))
 
-(require (only-in racket/os getpid))
-(require "private/unix-signals-extension.rkt")
+(define-ffi-definer define-unix libracket-unix-signals
+  #:default-make-fail make-not-available)
 
-(define signal-fd (get-signal-fd))
+;; TODO: should we be using #:lock-name, #:in-original-place?,
+;; or other options for some of these _fun types?
 
-(define next-signal-evt
-  (handle-evt signal-fd (lambda (_) (read-signal))))
+(define-values [signals-by-name signals-by-number]
+  (let ([signals-by-name #hasheq()]
+        [signals-by-number #hasheq()])
+    ;; "two fixnums that are `=` are also the same according to `eq?`"
+    (define-unix racket_unix_signals_init
+      (_fun -> _stdbool))
+    (unless (racket_unix_signals_init)
+      (error 'unix-signals "error initializing foreign library"))
+    (define-unix prim_signal_names_for_each
+      (_fun (_fun _symbol _fixint -> _void)
+            -> _void))
+    (prim_signal_names_for_each
+     (λ (name num)
+       (set! signals-by-name (hash-set signals-by-name name num))
+       (set! signals-by-number (hash-set signals-by-number num name))))  
+    (values signals-by-name signals-by-number)))
 
-(define (read-signal) (read-byte signal-fd))
+(define (lookup-signal-number sym)
+  (hash-ref signals-by-name sym #f))
+(define (lookup-signal-name num)
+  (hash-ref signals-by-number num #f))
 
-(define signals-by-name (get-signal-names))
-(define signals-by-number
-  (for/hash [((name number) (in-hash signals-by-name))] (values number name)))
 
-(define (lookup-signal-number sym) (hash-ref signals-by-name sym #f))
-(define (lookup-signal-name num) (hash-ref signals-by-number num #f))
+(define-values [read-signal next-signal-evt]
+  (let ()
+    (define-unix prim_get_signal_fd
+      (_fun -> _int))
+    (define signal-fd-in
+      ;; NB: closing this port closes the file descriptor
+      ;; (that was already true with scheme_make_fd_input_port)
+      (unsafe-file-descriptor->port (prim_get_signal_fd)
+                                    'signal-fd
+                                    '(read)))
+    (define (assert-not-eof who v)
+      (if (eof-object? v)
+          (raise (exn:fail:read:eof
+                  (format "~a: internal error;\n unexpected eof" who)
+                  (current-continuation-marks)
+                  null))
+          v))
+    (define (read-signal)
+      (assert-not-eof 'read-signal (read-byte signal-fd-in)))
+    (values read-signal
+            (wrap-evt (read-bytes-evt 1 signal-fd-in)
+                      (λ (bs)
+                        (assert-not-eof 'next-signal-evt bs)
+                        (bytes-ref bs 0))))))
 
-(define (name->signum who n)
-  (cond
-    [(symbol? n) (or (lookup-signal-number n)
-                     (error who "Unknown signal name ~a" n))]
-    [(fixnum? n) n]
-    [else (error who "Expects signal name symbol or signal number; got ~v" n)]))
+(define name->signum
+  (case-lambda
+    [(who sig)
+     (name->signum who #f sig)]
+    [(who ?pid sig)
+     (cond
+       [(fixnum? sig)
+        sig]
+       [(lookup-signal-number sig)]
+       [else
+        (error who
+               "unknown signal name\n  given: ~e~a\n  known names...:~a"
+               sig
+               (if ?pid (format "\n  pid: ~e" ?pid) "")
+               (apply string-append
+                      (hash-map signals-by-name
+                                (λ (name _num)
+                                  (format "\n   ~e" name))
+                                'ordered)))])]))
+
+(define-unix prim_capture_signal
+  (_fun _fixint _fixint -> _stdbool))
 
 (define (capture-signal! sig)
-  (set-signal-handler! (name->signum 'capture-signal! sig) 0))
+  (prim_capture_signal (name->signum 'capture-signal! sig) 0))
 
 (define (ignore-signal! sig)
-  (set-signal-handler! (name->signum 'capture-signal! sig) 1))
+  (prim_capture_signal (name->signum 'ignore-signal! sig) 1))
 
 (define (release-signal! sig)
-  (set-signal-handler! (name->signum 'capture-signal! sig) 2))
+  (prim_capture_signal (name->signum 'release-signal! sig) 2))
+
+(define-unix prim_send_signal
+  (_fun _fixint _fixint -> _stdbool))
 
 (define (send-signal! pid sig)
-  (when (not (fixnum? pid)) (error 'send-signal! "Expected fixnum pid; got ~v" pid))
-  (lowlevel-send-signal! pid (name->signum 'send-signal! sig)))
+  (prim_send_signal pid (name->signum 'send-signal! pid sig)))

unix-signals/private/install.rkt

@@ -1,19 +1,32 @@
 #lang racket/base
 
-(require make/setup-extension)
+(require dynext/file
+         dynext/link
+         racket/file)
 
 (provide pre-installer)
 
-(define (pre-installer collections-top-path our-path)
-  (pre-install our-path
-	       (build-path our-path "private")
-	       "unix-signals-extension.c"
-	       "."
-	       '()
-	       '()
-	       '()
-	       '()
-	       '()
-	       '()
-	       (lambda (thunk) (thunk))
-	       #t))
+;; Used by "../info.rkt" (so this-collection-path is "..").
+
+;; Heavily based on Sam Tobin-Hochstadt's bcrypt/private/install.rkt
+;; https://github.com/samth/bcrypt.rkt
+
+(define (pre-installer collections-top-path this-collection-path)
+  (define unix-signals/private/
+    (build-path this-collection-path "private"))
+  (parameterize ([current-directory unix-signals/private/]
+                 [current-use-mzdyn #f])
+    (define racket_unix_signals.c
+      (build-path unix-signals/private/ "racket_unix_signals.c"))
+    (define libracket_unix_signals.so
+      (build-path unix-signals/private/
+                  "compiled"
+                  "native"
+                  (system-library-subpath #f)
+                  (append-extension-suffix "libracket_unix_signals")))
+    (when (file-exists? libracket_unix_signals.so)
+      (delete-file libracket_unix_signals.so))
+    (make-parent-directory* libracket_unix_signals.so)
+    (link-extension #f ;; not quiet
+                    (list racket_unix_signals.c)
+                    libracket_unix_signals.so)))