~ chicken-core (chicken-5) 4c6f10c182f18df3935b74cc24e2ba203476db89
commit 4c6f10c182f18df3935b74cc24e2ba203476db89
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Nov 12 14:03:33 2017 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Dec 4 19:11:14 2017 +0100
Avoid expanding to unbound procedures in FFI macros.
These macros call procedures that are defined inside the compiler
only. This will result in an "unbound variable" error in DEBUGBUILD
CHICKENs, and a segfault(!) in non-DEBUGBUILDs.
So, we check to see if the macro expander is running inside the
compiler and emit an error if that's not the case.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm
index 0b3008c0..255c9c93 100644
--- a/chicken-ffi-syntax.scm
+++ b/chicken-ffi-syntax.scm
@@ -31,9 +31,6 @@
(disable-interrupts)
(fixnum))
-;; IMPORTANT: These macros expand directly into fully qualified names
-;; from the "chicken.compiler.c-backend" and "chicken.compiler.support" modules.
-
#+(not debugbuild)
(declare
(no-bound-checks)
@@ -42,6 +39,8 @@
(import chicken.base
chicken.format
chicken.internal
+ chicken.platform
+ chicken.syntax
chicken.string)
(include "common-declarations.scm")
@@ -50,10 +49,21 @@
(define ##sys#chicken-ffi-macro-environment
(let ((me0 (##sys#macro-environment)))
+;; IMPORTANT: These macros directly call fully qualified names from
+;; the "chicken.compiler.c-backend" and "chicken.compiler.support"
+;; modules. These are unbound in the interpreter, so check first:
+(define (compiler-only-er-transformer transformer)
+ (##sys#er-transformer
+ (lambda (form r c)
+ (if (feature? 'compiling)
+ (transformer form r c)
+ (syntax-error
+ (car form) "The FFI is not supported in interpreted mode")))))
+
(##sys#extend-macro-environment
'define-external
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(let* ((form (cdr form))
(quals (and (pair? form) (string? (car form))))
@@ -90,7 +100,7 @@
(##sys#extend-macro-environment
'location
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (x r c)
(##sys#check-syntax 'location x '(location _))
`(##core#location ,(cadr x)))))
@@ -98,7 +108,7 @@
(##sys#extend-macro-environment
'define-location
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'define-location form '(_ variable _ . #(_ 0 1)))
(let ((var (cadr form))
@@ -115,7 +125,7 @@
(##sys#extend-macro-environment
'let-location
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'let-location form '(_ #((variable _ . #(_ 0 1)) 0) . _))
(let* ((bindings (cadr form))
@@ -151,7 +161,7 @@
(##sys#extend-macro-environment
'foreign-code
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-code form '(_ . #(string 0)))
(let ([tmp (gensym 'code_)])
@@ -166,7 +176,7 @@
(##sys#extend-macro-environment
'foreign-value
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-value form '(_ _ _))
(let ((tmp (gensym "code_"))
@@ -192,7 +202,7 @@
(##sys#extend-macro-environment
'foreign-declare
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-declare form '(_ . #(string 0)))
`(##core#declare (foreign-declare ,@(cdr form))))))
@@ -203,7 +213,7 @@
(##sys#extend-macro-environment
'define-foreign-type
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'define-foreign-type form '(_ symbol _ . #(_ 0 2)))
`(##core#define-foreign-type ,@(cdr form)))))
@@ -211,7 +221,7 @@
(##sys#extend-macro-environment
'define-foreign-variable
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'define-foreign-variable form '(_ symbol _ . #(string 0 1)))
`(##core#define-foreign-variable ,@(cdr form)))))
@@ -219,7 +229,7 @@
(##sys#extend-macro-environment
'foreign-primitive
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-primitive form '(_ _ . _))
(let* ((hasrtype (and (pair? (cddr form)) (not (string? (caddr form)))))
@@ -238,7 +248,7 @@
(##sys#extend-macro-environment
'foreign-lambda
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-lambda form '(_ _ _ . _))
`(##core#the
@@ -252,7 +262,7 @@
(##sys#extend-macro-environment
'foreign-lambda*
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-lambda* form '(_ _ _ _ . _))
`(##core#the
@@ -269,7 +279,7 @@
(##sys#extend-macro-environment
'foreign-safe-lambda
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-safe-lambda form '(_ _ _ . _))
`(##core#the
@@ -283,7 +293,7 @@
(##sys#extend-macro-environment
'foreign-safe-lambda*
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-safe-lambda* form '(_ _ _ _ . _))
`(##core#the
@@ -298,7 +308,7 @@
(##sys#extend-macro-environment
'foreign-type-size
'()
- (##sys#er-transformer
+ (compiler-only-er-transformer
(lambda (form r c)
(##sys#check-syntax 'foreign-type-size form '(_ _))
(let* ((t (chicken.syntax#strip-syntax (cadr form)))
diff --git a/support.scm b/support.scm
index 9402309e..4b77a9dd 100644
--- a/support.scm
+++ b/support.scm
@@ -1144,7 +1144,7 @@
(list argconv a) )
a) )
-(define (final-foreign-type t0) ; Used only in compiler.scm
+(define (final-foreign-type t0) ; Used here and in compiler.scm
(follow-without-loop
t0
(lambda (t next)
@@ -1256,7 +1256,7 @@
;;; Translate foreign-type into scrutinizer type:
-;; Used only in chicken-ffi-syntax.scm; can we move it there?
+;; Used in chicken-ffi-syntax.scm and scrutinizer.scm
(define (foreign-type->scrutiny-type t mode) ; MODE = 'arg | 'result
(let ((ft (final-foreign-type t)))
(case ft
Trap