From 581024db9368e3ab437a59887ea074b704f23b7c Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 22 Sep 2008 14:37:26 +0000
Subject: 	* boot/parser.boot (bpReturn): Allow assignment.

---
 src/boot/strap/ast.clisp | 31 +++++++++++++++++++++++--------
 1 file changed, 23 insertions(+), 8 deletions(-)

(limited to 'src/boot/strap/ast.clisp')

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index f5536c0c..c07edd27 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -2200,20 +2200,35 @@
 
 (DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|)))
 
+(DEFUN |unknownNativeTypeError| (|t|)
+  (|fatalError| (CONCAT "unsupported native type: " (SYMBOL-NAME |t|))))
+
 (DEFUN |nativeType| (|t|)
   (PROG (|t'|)
     (DECLARE (SPECIAL |$NativeTypeTable|))
     (RETURN
       (COND
         ((NULL |t|) |t|)
+        ((OR (EQ |t| '|buffer|) (EQ |t| '|pointer|))
+         (COND
+           ((|%hasFeature| :GCL) 'FIXNUM)
+           ((|%hasFeature| :ECL) :POINTER-VOID)
+           ((|%hasFeature| :SBCL) (LIST '* T))
+           ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
+           (#0='T (|unknownNativeTypeError| |t|))))
         ((SETQ |t'|
                (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|)))
-         (COND
-           ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL))
-            (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
-                  'BASE-CHAR))
-           (#0='T |t'|)))
-        (#0#
-         (|fatalError|
-             (CONCAT "unsupported native type: " (SYMBOL-NAME |t|))))))))
+         (PROGN
+           (SETQ |t'|
+                 (COND
+                   ((|%hasFeature| :SBCL)
+                    (|bfColonColon| 'SB-ALIEN |t'|))
+                   ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI |t'|))
+                   (#0# |t'|)))
+           (COND
+             ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL))
+              (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
+                    'BASE-CHAR))
+             (#0# |t'|))))
+        (#0# (|unknownNativeTypeError| |t|))))))
 
-- 
cgit v1.2.3