diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/parser.boot | 4 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 31 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 2 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 14 |
4 files changed, 33 insertions, 18 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 8bf5086d..2ad0bac5 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -740,8 +740,10 @@ bpCatchItem() == (bpException() or bpTrap()) and bpPush %Catch bpPop1() +++ Return: +++ RETURN Assign bpReturn()== - (bpEqKey "RETURN" and (bpAnd() or bpTrap()) and + (bpEqKey "RETURN" and (bpAssign() or bpTrap()) and bpPush bfReturnNoName bpPop1()) or bpThrow() or bpAnd() 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|)))))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index baea8792..c6270474 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -783,7 +783,7 @@ (|bpPush| (|%Catch| (|bpPop1|))))) (DEFUN |bpReturn| () - (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAnd|) (|bpTrap|)) + (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|)) (|bpPush| (|bfReturnNoName| (|bpPop1|)))) (|bpThrow|) (|bpAnd|))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index c58a80a2..1556ea0a 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -96,7 +96,7 @@ (PROGN (SETQ *LOAD-VERBOSE* NIL) (COND - ((OR (|%hasFeature| :GCL) (|%hasFeature| :ECL)) + ((|%hasFeature| :GCL) (SETF (SYMBOL-VALUE (|bfColonColon| 'COMPILER '*COMPILE-VERBOSE*)) NIL) @@ -755,16 +755,14 @@ (SETQ |bfVar#25| (CONS (LIST |a| - (|bfColonColon| 'FFI - (|nativeType| |x|))) + (|nativeType| |x|)) |bfVar#25|)))) (SETQ |bfVar#23| (CDR |bfVar#23|)) (SETQ |bfVar#24| (CDR |bfVar#24|))))) (LIST :RETURN-TYPE - (|bfColonColon| 'FFI - (|nativeType| |t|))) + (|nativeType| |t|)) (LIST :LANGUAGE :STDC)))) (SETQ |forwardingFun| (LIST 'DEFUN |op| |args| @@ -1718,9 +1716,9 @@ (PROGN (SETQ |out| (NAMESTRING (|getOutputPathname| |options|))) (COND - (|out| (CONCAT (|shoeRemoveStringIfNec| |$effectiveFaslType| - |out|) - "clisp")) + (|out| (CONCAT (|shoeRemoveStringIfNec| + (CONCAT "." |$effectiveFaslType|) |out|) + ".clisp")) ('T (|defaultBootToLispFile| |file|))))))) (DEFUN |translateBootFile| (|progname| |options| |file|) |