aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap')
-rw-r--r--src/boot/strap/ast.clisp805
-rw-r--r--src/boot/strap/includer.clisp1
-rw-r--r--src/boot/strap/parser.clisp5
-rw-r--r--src/boot/strap/pile.clisp1
-rw-r--r--src/boot/strap/scanner.clisp1
-rw-r--r--src/boot/strap/tokens.clisp6
-rw-r--r--src/boot/strap/translator.clisp547
7 files changed, 887 insertions, 479 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index c07edd27..62028541 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IN-PACKAGE "BOOTTRAN")
@@ -476,7 +477,7 @@
(SETQ |a|
(COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|)))
(SETQ |op| (|bfReName| |a|))
- (SETQ |init| (GET |op| 'SHOETHETA))
+ (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
(SETQ |g| (|bfGenSymbol|))
(SETQ |g1| (|bfGenSymbol|))
(SETQ |body| (LIST 'SETQ |g| (LIST |op| |g| |g1|)))
@@ -507,7 +508,7 @@
(SETQ |a|
(COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|)))
(SETQ |op| (|bfReName| |a|))
- (SETQ |init| (GET |op| 'SHOETHETA))
+ (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
(|bfOpReduce| |op| |init| |body| |itl|))
(#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1)))
(|bfReduce| |op| |a|))))))
@@ -1259,6 +1260,7 @@
((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|))
((NULL |l|) (LIST 'NULL |r|))
((NULL |r|) (LIST 'NULL |l|))
+ ((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|))
('T (LIST 'EQUAL |l| |r|))))
(DEFUN |bfLessp| (|l| |r|)
@@ -2192,6 +2194,18 @@
(SETQ |args| (CDR |head|))
(LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|))))))
+(DEFCONSTANT |$NativeSimpleDataTypes|
+ '(|char| |byte| |int| |int8| |uint8| |int16| |uint16| |int32|
+ |uint32| |int64| |uint64| |float| |float32| |double|
+ |float64|))
+
+(DEFCONSTANT |$NativeSimpleReturnTypes|
+ (APPEND |$NativeSimpleDataTypes| '(|void| |string|)))
+
+(DEFUN |isSimpleNativeType| (|t|)
+ (DECLARE (SPECIAL |$NativeSimpleReturnTypes|))
+ (MEMBER |t| |$NativeSimpleReturnTypes|))
+
(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|))
(DEFUN |coreSymbol| (|s|) (INTERN (SYMBOL-NAME |s|) '|AxiomCore|))
@@ -2209,26 +2223,779 @@
(RETURN
(COND
((NULL |t|) |t|)
- ((OR (EQ |t| '|buffer|) (EQ |t| '|pointer|))
+ ((ATOM |t|)
+ (COND
+ ((SETQ |t'|
+ (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|)))
+ (PROGN
+ (SETQ |t'|
+ (COND
+ ((|%hasFeature| :SBCL)
+ (|bfColonColon| 'SB-ALIEN |t'|))
+ ((|%hasFeature| :CLISP)
+ (|bfColonColon| 'FFI |t'|))
+ (#0='T |t'|)))
+ (COND
+ ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL))
+ (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
+ 'BASE-CHAR))
+ (#0# |t'|))))
+ ((MEMBER |t| '(|byte| |uint8|))
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 8))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT8))
+ ((|%hasFeature| :ECL) :UNSIGNED-BYTE)
+ (#0# (|nativeType| '|char|))))
+ ((EQ |t| '|int16|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 16))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT16))
+ ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT16-T))
+ :INT16-T)
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ |t| '|uint16|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 16))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT16))
+ ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT16-T))
+ :UINT16-T)
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ |t| '|int32|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 32))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT32))
+ ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT32-T))
+ :INT32-T)
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ |t| '|uint32|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 32))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT32))
+ ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT32-T))
+ :UINT32-T)
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ |t| '|int64|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 64))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT64))
+ ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT64-T))
+ :INT64-T)
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ |t| '|uint64|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 64))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT64))
+ ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT64-T))
+ :UINT64-T)
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ |t| '|float32|) (|nativeType| '|float|))
+ ((EQ |t| '|float64|) (|nativeType| '|double|))
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ (CAR |t|) '|buffer|)
(COND
- ((|%hasFeature| :GCL) 'FIXNUM)
- ((|%hasFeature| :ECL) :POINTER-VOID)
- ((|%hasFeature| :SBCL) (LIST '* T))
+ ((|%hasFeature| :GCL) 'OBJECT)
+ ((|%hasFeature| :ECL) :OBJECT)
+ ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|))))
((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
- (#0='T (|unknownNativeTypeError| |t|))))
- ((SETQ |t'|
- (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|)))
+ (#0# (|unknownNativeTypeError| |t|))))
+ ((EQ (CAR |t|) '|buffer|)
+ (COND
+ ((|%hasFeature| :GCL) '|fixnum|)
+ ((|%hasFeature| :ECL) :OBJECT)
+ ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|))))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
+ (#0# (|unknownNativeTypeError| |t|))))
+ (#0# (|unknownNativeTypeError| |t|))))))
+
+(DEFUN |nativeReturnType| (|t|)
+ (DECLARE (SPECIAL |$NativeSimpleReturnTypes|))
+ (COND
+ ((MEMBER |t| |$NativeSimpleReturnTypes|) (|nativeType| |t|))
+ ('T
+ (|coreError|
+ (CONCAT "invalid return type for native function: "
+ (SYMBOL-NAME |t|))))))
+
+(DEFUN |nativeArgumentType| (|t|)
+ (PROG (|t'| |c| |m|)
+ (DECLARE (SPECIAL |$NativeSimpleDataTypes|))
+ (RETURN
+ (COND
+ ((MEMBER |t| |$NativeSimpleDataTypes|) (|nativeType| |t|))
+ ((EQ |t| '|string|) (|nativeType| |t|))
+ ((OR (ATOM |t|) (NOT (EQL (LENGTH |t|) 2)))
+ (|coreError| "invalid argument type for a native function"))
+ (#0='T
+ (PROGN
+ (SETQ |m| (CAR |t|))
+ (SETQ |c| (CAADR . #1=(|t|)))
+ (SETQ |t'| (CADADR . #1#))
+ (COND
+ ((NOT (MEMBER |m| '(|readonly| |writeonly| |readwrite|)))
+ (|coreError|
+ "missing modifier for argument type for a native function"))
+ ((NOT (MEMBER |c| '(|buffer| |pointer|)))
+ (|coreError|
+ "expect 'buffer' or 'pointer' type instance"))
+ ((NOT (MEMBER |t'| |$NativeSimpleDataTypes|))
+ (|coreError| "expected simple native data type"))
+ (#0# (|nativeType| (CADR |t|))))))))))
+
+(DEFUN |needsStableReference?| (|t|)
+ (PROG (|m|)
+ (RETURN
+ (AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) 'T)
+ (MEMBER |m| '(|readonly| |writeonly| |readwrite|))))))
+
+(DEFUN |coerceToNativeType| (|a| |t|)
+ (PROG (|y| |c|)
+ (RETURN
+ (COND
+ ((OR (|%hasFeature| :GCL) (|%hasFeature| :ECL)
+ (|%hasFeature| :CLISP))
+ |a|)
+ ((|%hasFeature| :SBCL)
+ (COND
+ ((NOT (|needsStableReference?| |t|)) |a|)
+ (#0='T
+ (PROGN
+ (SETQ |c| (CAADR . #1=(|t|)))
+ (SETQ |y| (CADADR . #1#))
+ (COND
+ ((EQ |c| '|buffer|)
+ (LIST (|bfColonColon| 'SB-SYS 'VECTOR-SAP) |a|))
+ ((EQ |c| '|pointer|)
+ (LIST (|bfColonColon| 'SB-SYS 'ALIEN-SAP) |a|))
+ ((|needsStableReference?| |t|)
+ (|fatalError|
+ (CONCAT "don't know how to coerce argument for native type"
+ (SYMBOL-NAME |c|)))))))))
+ (#0#
+ (|fatalError|
+ "don't know how to coerce argument for native type"))))))
+
+(DEFUN |genGCLnativeTranslation| (|op| |s| |t| |op'|)
+ (PROG (|ccode| |cargs| |cop| |rettype| |argtypes|)
+ (RETURN
+ (PROGN
+ (SETQ |argtypes|
+ (LET ((|bfVar#133| NIL) (|bfVar#132| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#132|)
+ (PROGN (SETQ |x| (CAR |bfVar#132|)) NIL))
+ (RETURN (NREVERSE |bfVar#133|)))
+ (#0='T
+ (SETQ |bfVar#133|
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#133|))))
+ (SETQ |bfVar#132| (CDR |bfVar#132|)))))
+ (SETQ |rettype| (|nativeReturnType| |t|))
+ (COND
+ ((LET ((|bfVar#135| T) (|bfVar#134| (CONS |t| |s|))
+ (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#134|)
+ (PROGN (SETQ |x| (CAR |bfVar#134|)) NIL))
+ (RETURN |bfVar#135|))
+ (#0#
+ (PROGN
+ (SETQ |bfVar#135| (|isSimpleNativeType| |x|))
+ (COND ((NOT |bfVar#135|) (RETURN NIL))))))
+ (SETQ |bfVar#134| (CDR |bfVar#134|))))
+ (LIST (LIST 'DEFENTRY |op| |argtypes|
+ (LIST |rettype| (SYMBOL-NAME |op'|)))))
+ (#1='T
+ (PROGN
+ (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub"))
+ (SETQ |cargs|
+ (LET ((|bfVar#142| NIL)
+ (|bfVar#141| (- (LENGTH |s|) 1)) (|i| 0))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#141|)
+ (RETURN (NREVERSE |bfVar#142|)))
+ (#0#
+ (SETQ |bfVar#142|
+ (CONS (|genGCLnativeTranslation,mkCArgName|
+ |i|)
+ |bfVar#142|))))
+ (SETQ |i| (+ |i| 1)))))
+ (SETQ |ccode|
+ (LET ((|bfVar#138| "")
+ (|bfVar#140|
+ (CONS (|genGCLnativeTranslation,gclTypeInC|
+ |t|)
+ (CONS " "
+ (CONS |cop|
+ (CONS "("
+ (APPEND
+ (LET
+ ((|bfVar#136| NIL) (|x| |s|)
+ (|a| |cargs|))
+ (LOOP
+ (COND
+ ((OR (ATOM |x|)
+ (ATOM |a|))
+ (RETURN
+ (NREVERSE |bfVar#136|)))
+ (#0#
+ (SETQ |bfVar#136|
+ (CONS
+ (|genGCLnativeTranslation,cparm|
+ |x| |a|)
+ |bfVar#136|))))
+ (SETQ |x| (CDR |x|))
+ (SETQ |a| (CDR |a|))))
+ (CONS ") { "
+ (CONS
+ (COND
+ ((NOT (EQ |t| '|void|))
+ "return ")
+ (#1# '||))
+ (CONS (SYMBOL-NAME |op'|)
+ (CONS "("
+ (APPEND
+ (LET
+ ((|bfVar#137| NIL)
+ (|x| |s|) (|a| |cargs|))
+ (LOOP
+ (COND
+ ((OR (ATOM |x|)
+ (ATOM |a|))
+ (RETURN
+ (NREVERSE
+ |bfVar#137|)))
+ (#0#
+ (SETQ |bfVar#137|
+ (CONS
+ (|genGCLnativeTranslation,gclArgsInC|
+ |x| |a|)
+ |bfVar#137|))))
+ (SETQ |x| (CDR |x|))
+ (SETQ |a| (CDR |a|))))
+ (CONS "); }" NIL))))))))))))
+ (|bfVar#139| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#140|)
+ (PROGN
+ (SETQ |bfVar#139| (CAR |bfVar#140|))
+ NIL))
+ (RETURN |bfVar#138|))
+ (#0#
+ (SETQ |bfVar#138|
+ (CONCAT |bfVar#138| |bfVar#139|))))
+ (SETQ |bfVar#140| (CDR |bfVar#140|)))))
+ (LIST (LIST 'CLINES |ccode|)
+ (LIST 'DEFENTRY |op| |argtypes|
+ (LIST |rettype| |cop|))))))))))
+
+(DEFUN |genGCLnativeTranslation,mkCArgName| (|i|)
+ (CONCAT "x" (STRINGIMAGE |i|)))
+
+(DEFUN |genGCLnativeTranslation,cparm| (|x| |a|)
+ (CONCAT (|genGCLnativeTranslation,gclTypeInC| (CAR |x|)) " "
+ (CAR |a|) (COND ((CDR |x|) ", ") ('T ""))))
+
+(DEFUN |genGCLnativeTranslation,gclTypeInC| (|x|)
+ (PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|)
+ (DECLARE (SPECIAL |$NativeSimpleDataTypes|))
+ (RETURN
+ (COND
+ ((MEMBER |x| |$NativeSimpleDataTypes|) (SYMBOL-NAME |x|))
+ ((EQ |x| '|void|) "void")
+ ((EQ |x| '|string|) "char*")
+ ((AND (CONSP |x|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN
+ (SETQ |ISTMP#2| (CAR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CAR |ISTMP#2|) '|pointer|)
+ (PROGN
+ (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL))))))))
+ '|fixnum|)
+ ('T "object")))))
+
+(DEFUN |genGCLnativeTranslation,gclArgInC| (|x| |a|)
+ (PROG (|y| |c|)
+ (DECLARE (SPECIAL |$NativeSimpleDataTypes|))
+ (RETURN
+ (COND
+ ((MEMBER |x| |$NativeSimpleDataTypes|) |a|)
+ ((EQ |x| '|string|) |a|)
+ (#0='T
+ (PROGN
+ (SETQ |c| (CAADR |x|))
+ (SETQ |y| (CADADR |x|))
+ (COND
+ ((EQ |c| '|pointer|) |a|)
+ ((EQ |y| '|char|) (CONCAT |a| "->st.st_self"))
+ ((EQ |y| '|byte|) (CONCAT |a| "->ust.ust_self"))
+ ((EQ |y| '|int|) (CONCAT |a| "->fixa.fixa_self"))
+ ((EQ |y| '|float|) (CONCAT |a| "->sfa.sfa_self"))
+ ((EQ |y| '|double|) (CONCAT |a| "->lfa.lfa_self"))
+ (#0# (|coreError| "unknown argument type")))))))))
+
+(DEFUN |genGCLnativeTranslation,gclArgsInC| (|x| |a|)
+ (CONCAT (|genGCLnativeTranslation,gclArgInC| (CAR |x|) (CAR |a|))
+ (COND ((CDR |x|) ", ") ('T ""))))
+
+(DEFUN |genECLnativeTranslation| (|op| |s| |t| |op'|)
+ (PROG (|rettype| |argtypes| |args|)
+ (RETURN
+ (PROGN
+ (SETQ |args| NIL)
+ (SETQ |argtypes| NIL)
+ (LET ((|bfVar#143| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#143|)
+ (PROGN (SETQ |x| (CAR |bfVar#143|)) NIL))
+ (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |argtypes|
+ (CONS (|nativeArgumentType| |x|) |argtypes|))
+ (SETQ |args| (CONS (GENSYM) |args|)))))
+ (SETQ |bfVar#143| (CDR |bfVar#143|))))
+ (SETQ |args| (REVERSE |args|))
+ (SETQ |rettype| (|nativeReturnType| |t|))
+ (LIST (LIST 'DEFUN |op| |args|
+ (LIST (|bfColonColon| 'FFI 'C-INLINE) |args|
+ (NREVERSE |argtypes|) |rettype|
+ (|genECLnativeTranslation,callTemplate| |op'|
+ (LENGTH |args|) |s|)
+ :ONE-LINER T)))))))
+
+(DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|)
+ (LET ((|bfVar#147| "")
+ (|bfVar#149|
+ (CONS (SYMBOL-NAME |op|)
+ (CONS "("
+ (APPEND (LET ((|bfVar#146| NIL)
+ (|bfVar#144| (- |n| 1)) (|i| 0)
+ (|bfVar#145| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (> |i| |bfVar#144|)
+ (ATOM |bfVar#145|)
+ (PROGN
+ (SETQ |x| (CAR |bfVar#145|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#146|)))
+ (#0='T
+ (SETQ |bfVar#146|
+ (CONS
+ (|genECLnativeTranslation,sharpArg|
+ |i| |x|)
+ |bfVar#146|))))
+ (SETQ |i| (+ |i| 1))
+ (SETQ |bfVar#145|
+ (CDR |bfVar#145|))))
+ (CONS ")" NIL)))))
+ (|bfVar#148| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#149|)
+ (PROGN (SETQ |bfVar#148| (CAR |bfVar#149|)) NIL))
+ (RETURN |bfVar#147|))
+ (#0# (SETQ |bfVar#147| (CONCAT |bfVar#147| |bfVar#148|))))
+ (SETQ |bfVar#149| (CDR |bfVar#149|)))))
+
+(DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|)
+ (COND
+ ((EQL |i| 0)
+ (CONCAT "(#0)" (|genECLnativeTranslation,selectDatum| |x|)))
+ ('T
+ (CONCAT "," "(#" (STRINGIMAGE |i|) ")"
+ (|genECLnativeTranslation,selectDatum| |x|)))))
+
+(DEFUN |genECLnativeTranslation,selectDatum| (|x|)
+ (PROG (|y| |c|)
+ (DECLARE (SPECIAL |$ECLVersionNumber|))
+ (RETURN
+ (COND
+ ((|isSimpleNativeType| |x|) "")
+ (#0='T
(PROGN
- (SETQ |t'|
+ (SETQ |c| (CAADR |x|))
+ (SETQ |y| (CADADR |x|))
+ (COND
+ ((EQ |c| '|buffer|)
+ (COND
+ ((OR (EQ |y| '|char|) (EQ |y| '|byte|))
(COND
- ((|%hasFeature| :SBCL)
- (|bfColonColon| 'SB-ALIEN |t'|))
- ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI |t'|))
- (#0# |t'|)))
+ ((< |$ECLVersionNumber| 90100) "->vector.self.ch")
+ ((EQ |y| '|char|) "->vector.self.i8")
+ (#0# "->vector.self.b8")))
+ ((EQ |y| '|int|) "->vector.self.fix")
+ ((EQ |y| '|float|) "->vector.self.sf")
+ ((EQ |y| '|double|) "->vector.self.df")
+ (#0#
+ (|coreError|
+ "unknown argument to buffer type constructor"))))
+ ((EQ |c| '|pointer|) '||)
+ (#0# (|coreError| "unknown type constructor")))))))))
+
+(DEFUN |genCLISPnativeTranslation| (|op| |s| |t| |op'|)
+ (PROG (|forwardingFun| |ISTMP#2| |p| |fixups| |q| |call| |localPairs|
+ |y| |x| |ISTMP#1| |a| |foreignDecl| |unstableArgs| |parms|
+ |n| |argtypes| |rettype|)
+ (DECLARE (SPECIAL |$foreignsDefsForCLisp|))
+ (RETURN
+ (PROGN
+ (SETQ |rettype| (|nativeReturnType| |t|))
+ (SETQ |argtypes|
+ (LET ((|bfVar#151| NIL) (|bfVar#150| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#150|)
+ (PROGN (SETQ |x| (CAR |bfVar#150|)) NIL))
+ (RETURN (NREVERSE |bfVar#151|)))
+ (#0='T
+ (SETQ |bfVar#151|
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#151|))))
+ (SETQ |bfVar#150| (CDR |bfVar#150|)))))
+ (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
+ (SETQ |parms|
+ (LET ((|bfVar#153| NIL) (|bfVar#152| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#152|)
+ (PROGN (SETQ |x| (CAR |bfVar#152|)) NIL))
+ (RETURN (NREVERSE |bfVar#153|)))
+ (#0#
+ (SETQ |bfVar#153|
+ (CONS (GENSYM "parm") |bfVar#153|))))
+ (SETQ |bfVar#152| (CDR |bfVar#152|)))))
+ (SETQ |unstableArgs| NIL)
+ (LET ((|bfVar#154| |parms|) (|p| NIL) (|bfVar#155| |s|)
+ (|x| NIL) (|bfVar#156| |argtypes|) (|y| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#154|)
+ (PROGN (SETQ |p| (CAR |bfVar#154|)) NIL)
+ (ATOM |bfVar#155|)
+ (PROGN (SETQ |x| (CAR |bfVar#155|)) NIL)
+ (ATOM |bfVar#156|)
+ (PROGN (SETQ |y| (CAR |bfVar#156|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (COND
+ ((|needsStableReference?| |x|)
+ (IDENTITY
+ (SETQ |unstableArgs|
+ (CONS (CONS |p| (CONS |x| |y|))
+ |unstableArgs|)))))))
+ (SETQ |bfVar#154| (CDR |bfVar#154|))
+ (SETQ |bfVar#155| (CDR |bfVar#155|))
+ (SETQ |bfVar#156| (CDR |bfVar#156|))))
+ (SETQ |foreignDecl|
+ (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n|
+ (LIST :NAME (SYMBOL-NAME |op'|))
+ (CONS :ARGUMENTS
+ (LET ((|bfVar#159| NIL)
+ (|bfVar#157| |argtypes|) (|x| NIL)
+ (|bfVar#158| |parms|) (|a| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#157|)
+ (PROGN
+ (SETQ |x| (CAR |bfVar#157|))
+ NIL)
+ (ATOM |bfVar#158|)
+ (PROGN
+ (SETQ |a| (CAR |bfVar#158|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#159|)))
+ (#0#
+ (SETQ |bfVar#159|
+ (CONS (LIST |a| |x|)
+ |bfVar#159|))))
+ (SETQ |bfVar#157| (CDR |bfVar#157|))
+ (SETQ |bfVar#158| (CDR |bfVar#158|)))))
+ (LIST :RETURN-TYPE |rettype|)
+ (LIST :LANGUAGE :STDC)))
+ (SETQ |forwardingFun|
+ (COND
+ ((NULL |unstableArgs|)
+ (LIST 'DEFUN |op| |parms| (CONS |n| |parms|)))
+ (#1='T
+ (PROGN
+ (SETQ |localPairs|
+ (LET ((|bfVar#162| NIL)
+ (|bfVar#161| |unstableArgs|)
+ (|bfVar#160| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#161|)
+ (PROGN
+ (SETQ |bfVar#160|
+ (CAR |bfVar#161|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#162|)))
+ (#0#
+ (AND (CONSP |bfVar#160|)
+ (PROGN
+ (SETQ |a| (CAR |bfVar#160|))
+ (SETQ |ISTMP#1|
+ (CDR |bfVar#160|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |x| (CAR |ISTMP#1|))
+ (SETQ |y| (CDR |ISTMP#1|))
+ #2='T)))
+ (SETQ |bfVar#162|
+ (CONS
+ (CONS |a|
+ (CONS |x|
+ (CONS |y| (GENSYM "loc"))))
+ |bfVar#162|)))))
+ (SETQ |bfVar#161| (CDR |bfVar#161|)))))
+ (SETQ |call|
+ (CONS |n|
+ (LET ((|bfVar#164| NIL)
+ (|bfVar#163| |parms|) (|p| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#163|)
+ (PROGN
+ (SETQ |p| (CAR |bfVar#163|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#164|)))
+ (#0#
+ (SETQ |bfVar#164|
+ (CONS
+ (|genCLISPnativeTranslation,actualArg|
+ |p| |localPairs|)
+ |bfVar#164|))))
+ (SETQ |bfVar#163| (CDR |bfVar#163|))))))
+ (SETQ |call|
+ (PROGN
+ (SETQ |fixups|
+ (LET ((|bfVar#166| NIL)
+ (|bfVar#165| |localPairs|)
+ (|p| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#165|)
+ (PROGN
+ (SETQ |p| (CAR |bfVar#165|))
+ NIL))
+ (RETURN
+ (NREVERSE |bfVar#166|)))
+ (#0#
+ (AND
+ (NOT
+ (NULL
+ (SETQ |q|
+ (|genCLISPnativeTranslation,copyBack|
+ |p|))))
+ (SETQ |bfVar#166|
+ (CONS |q| |bfVar#166|)))))
+ (SETQ |bfVar#165|
+ (CDR |bfVar#165|)))))
+ (COND
+ ((NULL |fixups|) (LIST |call|))
+ (#1#
+ (LIST (CONS 'PROG1
+ (CONS |call| |fixups|)))))))
+ (LET ((|bfVar#168| |localPairs|) (|bfVar#167| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#168|)
+ (PROGN
+ (SETQ |bfVar#167| (CAR |bfVar#168|))
+ NIL))
+ (RETURN NIL))
+ (#0#
+ (AND (CONSP |bfVar#167|)
+ (PROGN
+ (SETQ |p| (CAR |bfVar#167|))
+ (SETQ |ISTMP#1| (CDR |bfVar#167|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |x| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2|
+ (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |y| (CAR |ISTMP#2|))
+ (SETQ |a| (CDR |ISTMP#2|))
+ #2#)))))
+ (SETQ |call|
+ (LIST
+ (CONS
+ (|bfColonColon| 'FFI
+ 'WITH-FOREIGN-OBJECT)
+ (CONS
+ (LIST |a|
+ (LIST 'FUNCALL
+ (LIST 'INTERN "getCLISPType"
+ "BOOTTRAN")
+ |p|)
+ |p|)
+ |call|)))))))
+ (SETQ |bfVar#168| (CDR |bfVar#168|))))
+ (CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))))
+ (SETQ |$foreignsDefsForCLisp|
+ (CONS |foreignDecl| |$foreignsDefsForCLisp|))
+ (LIST |forwardingFun|)))))
+
+(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#169|)
+ (PROG (|a| |y| |x| |p|)
+ (RETURN
+ (PROGN
+ (SETQ |p| (CAR |bfVar#169|))
+ (SETQ |x| (CADR . #0=(|bfVar#169|)))
+ (SETQ |y| (CADDR . #0#))
+ (SETQ |a| (CDDDR . #0#))
+ (COND
+ ((AND (CONSP |x|) (EQ (CAR |x|) '|readonly|)) NIL)
+ ('T
+ (LIST 'SETF |p|
+ (LIST (|bfColonColon| 'FFI 'FOREIGN-VALUE) |a|))))))))
+
+(DEFUN |genCLISPnativeTranslation,actualArg| (|p| |pairs|)
+ (PROG (|a'|)
+ (RETURN
+ (COND
+ ((SETQ |a'| (CDR (ASSOC |p| |pairs|))) (CDR (CDR |a'|)))
+ ('T |p|)))))
+
+(DEFUN |getCLISPType| (|a|)
+ (LIST (|bfColonColon| 'FFI 'C-ARRAY) (LENGTH |a|)))
+
+(DEFUN |genSBCLnativeTranslation| (|op| |s| |t| |op'|)
+ (PROG (|newArgs| |unstableArgs| |args| |argtypes| |rettype|)
+ (RETURN
+ (PROGN
+ (SETQ |rettype| (|nativeReturnType| |t|))
+ (SETQ |argtypes|
+ (LET ((|bfVar#171| NIL) (|bfVar#170| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#170|)
+ (PROGN (SETQ |x| (CAR |bfVar#170|)) NIL))
+ (RETURN (NREVERSE |bfVar#171|)))
+ (#0='T
+ (SETQ |bfVar#171|
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#171|))))
+ (SETQ |bfVar#170| (CDR |bfVar#170|)))))
+ (SETQ |args|
+ (LET ((|bfVar#173| NIL) (|bfVar#172| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#172|)
+ (PROGN (SETQ |x| (CAR |bfVar#172|)) NIL))
+ (RETURN (NREVERSE |bfVar#173|)))
+ (#0#
+ (SETQ |bfVar#173| (CONS (GENSYM) |bfVar#173|))))
+ (SETQ |bfVar#172| (CDR |bfVar#172|)))))
+ (SETQ |unstableArgs| NIL)
+ (SETQ |newArgs| NIL)
+ (LET ((|bfVar#174| |args|) (|a| NIL) (|bfVar#175| |s|)
+ (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#174|)
+ (PROGN (SETQ |a| (CAR |bfVar#174|)) NIL)
+ (ATOM |bfVar#175|)
+ (PROGN (SETQ |x| (CAR |bfVar#175|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (PROGN
+ (SETQ |newArgs|
+ (CONS (|coerceToNativeType| |a| |x|) |newArgs|))
+ (COND
+ ((|needsStableReference?| |x|)
+ (SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))))
+ (SETQ |bfVar#174| (CDR |bfVar#174|))
+ (SETQ |bfVar#175| (CDR |bfVar#175|))))
+ (COND
+ ((NULL |unstableArgs|)
+ (LIST (LIST 'DEFUN |op| |args|
+ (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN")
+ (CONS (LIST
+ (INTERN "EXTERN-ALIEN" "SB-ALIEN")
+ (SYMBOL-NAME |op'|)
+ (CONS 'FUNCTION
+ (CONS |rettype| |argtypes|)))
+ |args|)))))
+ ('T
+ (LIST (LIST 'DEFUN |op| |args|
+ (LIST (|bfColonColon| 'SB-SYS
+ 'WITH-PINNED-OBJECTS)
+ (NREVERSE |unstableArgs|)
+ (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN")
+ (CONS
+ (LIST
+ (INTERN "EXTERN-ALIEN" "SB-ALIEN")
+ (SYMBOL-NAME |op'|)
+ (CONS 'FUNCTION
+ (CONS |rettype| |argtypes|)))
+ (NREVERSE |newArgs|))))))))))))
+
+(DEFUN |genImportDeclaration| (|op| |sig|)
+ (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|Signature|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |sig|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |op'| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |m| (CAR |ISTMP#2|))
+ #0='T)))))))
+ (|coreError| "invalid signature"))
+ ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|Mapping|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |m|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |t| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |s| (CAR |ISTMP#2|))
+ #0#)))))))
+ (|coreError| "invalid function type"))
+ (#1='T
+ (PROGN
(COND
- ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL))
- (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
- 'BASE-CHAR))
- (#0# |t'|))))
- (#0# (|unknownNativeTypeError| |t|))))))
+ ((AND (NOT (NULL |s|)) (SYMBOLP |s|))
+ (SETQ |s| (LIST |s|))))
+ (COND
+ ((|%hasFeature| :GCL)
+ (|genGCLnativeTranslation| |op| |s| |t| |op'|))
+ ((|%hasFeature| :SBCL)
+ (|genSBCLnativeTranslation| |op| |s| |t| |op'|))
+ ((|%hasFeature| :CLISP)
+ (|genCLISPnativeTranslation| |op| |s| |t| |op'|))
+ ((|%hasFeature| :ECL)
+ (|genECLnativeTranslation| |op| |s| |t| |op'|))
+ (#1#
+ (|fatalError|
+ "import declaration not implemented for this Lisp")))))))))
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 8fb93c82..08964695 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "tokens")
(IN-PACKAGE "BOOTTRAN")
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index c6270474..fc373262 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IMPORT-MODULE "scanner")
@@ -519,8 +520,10 @@
T))
('T NIL)))
+(DEFUN |bpArgtypeList| () (|bpTuple| #'|bpApplication|))
+
(DEFUN |bpMapping| ()
- (OR (AND (|bpParenthesized| #'|bpIdList|) (|bpEqKey| 'ARROW)
+ (OR (AND (|bpParenthesized| #'|bpArgtypeList|) (|bpEqKey| 'ARROW)
(|bpApplication|)
(|bpPush| (|Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|)))))
(|bpSimpleMapping|)))
diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp
index 8a2c8048..4b624e7e 100644
--- a/src/boot/strap/pile.clisp
+++ b/src/boot/strap/pile.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IMPORT-MODULE "scanner")
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index b6eae196..5590d0ca 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "tokens")
(IMPORT-MODULE "includer")
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index c82ec5c5..75e3f3f5 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "initial-env")
(IN-PACKAGE "BOOTTRAN")
@@ -181,8 +182,9 @@
(LET ((|bfVar#8|
(LIST (LIST '+ 0) (LIST '|gcd| 0) (LIST '|lcm| 1)
(LIST 'STRCONC "") (LIST '|strconc| "")
- (LIST 'MAX (- 999999)) (LIST 'MIN 999999) (LIST '* 1)
- (LIST '|times| 1) (LIST 'CONS NIL) (LIST 'APPEND NIL)
+ (LIST 'CONCAT "") (LIST 'MAX (- 999999))
+ (LIST 'MIN 999999) (LIST '* 1) (LIST '|times| 1)
+ (LIST 'CONS NIL) (LIST 'APPEND NIL)
(LIST '|append| NIL) (LIST 'UNION NIL)
(LIST 'UNIONQ NIL) (LIST '|union| NIL)
(LIST 'NCONC NIL) (LIST '|and| 'T) (LIST '|or| NIL)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 1556ea0a..32cad87a 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -1,3 +1,4 @@
+(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IMPORT-MODULE "scanner")
@@ -141,7 +142,6 @@
(PROG (|infn|)
(RETURN
(PROGN
- (SETQ *READ-DEFAULT-FLOAT-FORMAT* 'DOUBLE-FLOAT)
(SETQ |infn| (|shoeAddbootIfNec| |fn|))
(|shoeOpenInputFile| |a| |infn|
(|shoeClLines| |a| |fn| |lines| |outfn|))))))
@@ -504,374 +504,6 @@
(DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|)))
-(DEFUN |needsStableReference?| (|t|)
- (COND
- ((|%hasFeature| :GCL) NIL)
- ((OR (|%hasFeature| :SBCL) (|%hasFeature| :CLISP)
- (|%hasFeature| :ECL))
- (OR (EQ |t| '|pointer|) (EQ |t| '|buffer|)))
- ('T T)))
-
-(DEFUN |coerceToNativeType| (|a| |t|)
- (COND
- ((|%hasFeature| :GCL) |a|)
- ((|%hasFeature| :SBCL)
- (COND
- ((EQ |t| '|buffer|)
- (LIST (|bfColonColon| 'SB-SYS 'VECTOR-SAP) |a|))
- ((EQ |t| '|string|) |a|)
- ((|needsStableReference?| |t|)
- (|fatalError|
- "don't know how to coerce argument for native type"))
- (#0='T |a|)))
- ((OR (|%hasFeature| :CLISP) (|%hasFeature| :ECL))
- (COND
- ((|needsStableReference?| |t|)
- (|fatalError|
- "don't know how to coerce argument for native type"))
- (#0# |a|)))
- (#0#
- (|fatalError| "don't know how to coerce argument for native type"))))
-
-(DEFUN |prepareArgumentsForNativeCall| (|args| |types|)
- (PROG (|preparedArgs| |unstableArgs|)
- (RETURN
- (PROGN
- (SETQ |unstableArgs|
- (LET ((|bfVar#11| NIL) (|bfVar#9| |args|) (|a| NIL)
- (|bfVar#10| |types|) (|t| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#9|)
- (PROGN (SETQ |a| (CAR |bfVar#9|)) NIL)
- (ATOM |bfVar#10|)
- (PROGN (SETQ |t| (CAR |bfVar#10|)) NIL))
- (RETURN (NREVERSE |bfVar#11|)))
- (#0='T
- (AND (|needsStableReference?| |t|)
- (SETQ |bfVar#11| (CONS |a| |bfVar#11|)))))
- (SETQ |bfVar#9| (CDR |bfVar#9|))
- (SETQ |bfVar#10| (CDR |bfVar#10|)))))
- (SETQ |preparedArgs|
- (LET ((|bfVar#14| NIL) (|bfVar#12| |args|) (|a| NIL)
- (|bfVar#13| |types|) (|t| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#12|)
- (PROGN (SETQ |a| (CAR |bfVar#12|)) NIL)
- (ATOM |bfVar#13|)
- (PROGN (SETQ |t| (CAR |bfVar#13|)) NIL))
- (RETURN (NREVERSE |bfVar#14|)))
- (#0#
- (SETQ |bfVar#14|
- (CONS (|coerceToNativeType| |a| |t|)
- |bfVar#14|))))
- (SETQ |bfVar#12| (CDR |bfVar#12|))
- (SETQ |bfVar#13| (CDR |bfVar#13|)))))
- (LIST |unstableArgs| |preparedArgs|)))))
-
-(DEFUN |genImportDeclaration| (|op| |sig|)
- (PROG (|bfVar#33| |forwardingFun| |foreignDecl| |n| |newArgs|
- |unstableArgs| |LETTMP#1| |args| |s| |t| |m| |ISTMP#2|
- |op'| |ISTMP#1|)
- (DECLARE (SPECIAL |$foreignsDefsForCLisp|))
- (RETURN
- (COND
- ((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|Signature|)
- (PROGN
- (SETQ |ISTMP#1| (CDR |sig|))
- (AND (CONSP |ISTMP#1|)
- (PROGN
- (SETQ |op'| (CAR |ISTMP#1|))
- (SETQ |ISTMP#2| (CDR |ISTMP#1|))
- (AND (CONSP |ISTMP#2|)
- (EQ (CDR |ISTMP#2|) NIL)
- (PROGN
- (SETQ |m| (CAR |ISTMP#2|))
- #0='T)))))))
- (|coreError| "invalid signature"))
- ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|Mapping|)
- (PROGN
- (SETQ |ISTMP#1| (CDR |m|))
- (AND (CONSP |ISTMP#1|)
- (PROGN
- (SETQ |t| (CAR |ISTMP#1|))
- (SETQ |ISTMP#2| (CDR |ISTMP#1|))
- (AND (CONSP |ISTMP#2|)
- (EQ (CDR |ISTMP#2|) NIL)
- (PROGN
- (SETQ |s| (CAR |ISTMP#2|))
- #0#)))))))
- (|coreError| "invalid function type"))
- (#1='T
- (PROGN
- (COND
- ((AND (NOT (NULL |s|)) (SYMBOLP |s|))
- (SETQ |s| (LIST |s|))))
- (COND
- ((|needsStableReference?| |t|)
- (|fatalError|
- "non trivial return type for native function"))
- ((|%hasFeature| :GCL)
- (LIST (LIST 'DEFENTRY |op|
- (LET ((|bfVar#16| NIL) (|bfVar#15| |s|)
- (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#15|)
- (PROGN
- (SETQ |x| (CAR |bfVar#15|))
- NIL))
- (RETURN (NREVERSE |bfVar#16|)))
- (#2='T
- (SETQ |bfVar#16|
- (CONS (|nativeType| |x|)
- |bfVar#16|))))
- (SETQ |bfVar#15| (CDR |bfVar#15|))))
- (LIST (|nativeType| |t|) (SYMBOL-NAME |op'|)))))
- (#1#
- (PROGN
- (SETQ |args|
- (LET ((|bfVar#18| NIL) (|bfVar#17| |s|)
- (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#17|)
- (PROGN
- (SETQ |x| (CAR |bfVar#17|))
- NIL))
- (RETURN (NREVERSE |bfVar#18|)))
- (#2#
- (SETQ |bfVar#18|
- (CONS (GENSYM) |bfVar#18|))))
- (SETQ |bfVar#17| (CDR |bfVar#17|)))))
- (COND
- ((|%hasFeature| :SBCL)
- (PROGN
- (SETQ |LETTMP#1|
- (|prepareArgumentsForNativeCall| |args| |s|))
- (SETQ |unstableArgs| (CAR |LETTMP#1|))
- (SETQ |newArgs| (CADR |LETTMP#1|))
- (COND
- ((NULL |unstableArgs|)
- (LIST (LIST 'DEFUN |op| |args|
- (CONS
- (INTERN "ALIEN-FUNCALL"
- "SB-ALIEN")
- (CONS
- (LIST
- (INTERN "EXTERN-ALIEN"
- "SB-ALIEN")
- (SYMBOL-NAME |op'|)
- (CONS 'FUNCTION
- (CONS (|nativeType| |t|)
- (LET
- ((|bfVar#20| NIL)
- (|bfVar#19| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#19|)
- (PROGN
- (SETQ |x|
- (CAR |bfVar#19|))
- NIL))
- (RETURN
- (NREVERSE |bfVar#20|)))
- (#2#
- (SETQ |bfVar#20|
- (CONS
- (|nativeType| |x|)
- |bfVar#20|))))
- (SETQ |bfVar#19|
- (CDR |bfVar#19|)))))))
- |args|)))))
- (#1#
- (LIST (LIST 'DEFUN |op| |args|
- (LIST
- (|bfColonColon| 'SB-SYS
- 'WITH-PINNED-OBJECTS)
- |unstableArgs|
- (CONS
- (INTERN "ALIEN-FUNCALL"
- "SB-ALIEN")
- (CONS
- (LIST
- (INTERN "EXTERN-ALIEN"
- "SB-ALIEN")
- (SYMBOL-NAME |op'|)
- (CONS 'FUNCTION
- (CONS (|nativeType| |t|)
- (LET
- ((|bfVar#22| NIL)
- (|bfVar#21| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#21|)
- (PROGN
- (SETQ |x|
- (CAR |bfVar#21|))
- NIL))
- (RETURN
- (NREVERSE
- |bfVar#22|)))
- (#2#
- (SETQ |bfVar#22|
- (CONS
- (|nativeType| |x|)
- |bfVar#22|))))
- (SETQ |bfVar#21|
- (CDR |bfVar#21|)))))))
- |newArgs|)))))))))
- ((|%hasFeature| :CLISP)
- (PROGN
- (SETQ |foreignDecl|
- (PROGN
- (SETQ |n|
- (INTERN
- (CONCAT (SYMBOL-NAME |op|)
- "%clisp-hack")))
- (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT)
- |n| (LIST :NAME (SYMBOL-NAME |op'|))
- (CONS :ARGUMENTS
- (LET
- ((|bfVar#25| NIL) (|bfVar#23| |s|)
- (|x| NIL) (|bfVar#24| |args|)
- (|a| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#23|)
- (PROGN
- (SETQ |x|
- (CAR |bfVar#23|))
- NIL)
- (ATOM |bfVar#24|)
- (PROGN
- (SETQ |a|
- (CAR |bfVar#24|))
- NIL))
- (RETURN
- (NREVERSE |bfVar#25|)))
- (#2#
- (SETQ |bfVar#25|
- (CONS
- (LIST |a|
- (|nativeType| |x|))
- |bfVar#25|))))
- (SETQ |bfVar#23|
- (CDR |bfVar#23|))
- (SETQ |bfVar#24|
- (CDR |bfVar#24|)))))
- (LIST :RETURN-TYPE
- (|nativeType| |t|))
- (LIST :LANGUAGE :STDC))))
- (SETQ |forwardingFun|
- (LIST 'DEFUN |op| |args|
- (CONS |n|
- (LET
- ((|bfVar#28| NIL)
- (|bfVar#26| |args|) (|a| NIL)
- (|bfVar#27| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#26|)
- (PROGN
- (SETQ |a|
- (CAR |bfVar#26|))
- NIL)
- (ATOM |bfVar#27|)
- (PROGN
- (SETQ |x|
- (CAR |bfVar#27|))
- NIL))
- (RETURN
- (NREVERSE |bfVar#28|)))
- (#2#
- (SETQ |bfVar#28|
- (CONS
- (|coerceToNativeType|
- |a| |t|)
- |bfVar#28|))))
- (SETQ |bfVar#26|
- (CDR |bfVar#26|))
- (SETQ |bfVar#27|
- (CDR |bfVar#27|)))))))
- (SETQ |$foreignsDefsForCLisp|
- (CONS |foreignDecl| |$foreignsDefsForCLisp|))
- (LIST |forwardingFun|)))
- ((|%hasFeature| :ECL)
- (LIST (LIST 'DEFUN |op| |args|
- (LIST (|bfColonColon| 'FFI 'C-INLINE)
- |args|
- (LET
- ((|bfVar#30| NIL)
- (|bfVar#29| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#29|)
- (PROGN
- (SETQ |x|
- (CAR |bfVar#29|))
- NIL))
- (RETURN
- (NREVERSE |bfVar#30|)))
- (#2#
- (SETQ |bfVar#30|
- (CONS (|nativeType| |x|)
- |bfVar#30|))))
- (SETQ |bfVar#29|
- (CDR |bfVar#29|))))
- (|nativeType| |t|)
- (PROGN
- (SETQ |bfVar#33|
- (|genImportDeclaration,callTemplate|
- |op'| (LENGTH |args|)))
- (LET
- ((|bfVar#31| (CAR |bfVar#33|))
- (|bfVar#34| (CDR |bfVar#33|))
- (|bfVar#32| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#34|)
- (PROGN
- (SETQ |bfVar#32|
- (CAR |bfVar#34|))
- NIL))
- (RETURN |bfVar#31|))
- (#2#
- (SETQ |bfVar#31|
- (CONCAT |bfVar#31|
- |bfVar#32|))))
- (SETQ |bfVar#34|
- (CDR |bfVar#34|)))))
- :ONE-LINER T))))
- (#1#
- (|fatalError|
- "import declaration not implemented for this Lisp"))))))))))))
-
-(DEFUN |genImportDeclaration,callTemplate| (|op| |n|)
- (CONS (SYMBOL-NAME |op|)
- (CONS "("
- (APPEND (LET ((|bfVar#36| NIL) (|bfVar#35| (- |n| 1))
- (|i| 0))
- (LOOP
- (COND
- ((> |i| |bfVar#35|)
- (RETURN (NREVERSE |bfVar#36|)))
- ('T
- (SETQ |bfVar#36|
- (APPEND
- (REVERSE
- (|genImportDeclaration,sharpArg|
- |i|))
- |bfVar#36|))))
- (SETQ |i| (+ |i| 1))))
- (CONS ")" NIL)))))
-
-(DEFUN |genImportDeclaration,sharpArg| (|i|)
- (COND
- ((EQL |i| 0) (LIST "#0"))
- ('T (LIST "," "#" (STRINGIMAGE |i|)))))
-
(DEFUN |shoeOutParse| (|stream|)
(PROG (|found|)
(DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings|
@@ -926,14 +558,14 @@
('T (LIST 'DECLAIM (LIST 'TYPE |t| |n|)))))))
(DEFUN |translateSignatureDeclaration| (|d|)
- (PROG (|bfVar#38| |bfVar#37|)
+ (PROG (|bfVar#10| |bfVar#9|)
(RETURN
(PROGN
- (SETQ |bfVar#37| |d|)
- (SETQ |bfVar#38| (CDR |bfVar#37|))
- (CASE (CAR |bfVar#37|)
+ (SETQ |bfVar#9| |d|)
+ (SETQ |bfVar#10| (CDR |bfVar#9|))
+ (CASE (CAR |bfVar#9|)
(|Signature|
- (LET ((|n| (CAR |bfVar#38|)) (|t| (CADR |bfVar#38|)))
+ (LET ((|n| (CAR |bfVar#10|)) (|t| (CADR |bfVar#10|)))
(|genDeclaration| |n| |t|)))
(T (|coreError| "signature expected")))))))
@@ -945,17 +577,17 @@
(SETQ |expr'|
(CDR (CDR (|shoeCompTran|
(LIST 'LAMBDA (LIST '|x|) |expr|)))))
- (LET ((|bfVar#39| |expr'|) (|t| NIL))
+ (LET ((|bfVar#11| |expr'|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#39|)
- (PROGN (SETQ |t| (CAR |bfVar#39|)) NIL))
+ ((OR (ATOM |bfVar#11|)
+ (PROGN (SETQ |t| (CAR |bfVar#11|)) NIL))
(RETURN NIL))
('T
(COND
((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE))
(IDENTITY (RPLACA |t| 'DECLAIM))))))
- (SETQ |bfVar#39| (CDR |bfVar#39|))))
+ (SETQ |bfVar#11| (CDR |bfVar#11|))))
(SETQ |expr'|
(COND
((< 1 (LENGTH |expr'|)) (CONS 'PROGN |expr'|))
@@ -968,7 +600,7 @@
(COND (|export?| |d|) ('T |d|)))
(DEFUN |translateToplevel| (|b| |export?|)
- (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |bfVar#45| |bfVar#44|
+ (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |bfVar#17| |bfVar#16|
|xs|)
(DECLARE (SPECIAL |$InteractiveMode| |$foreignsDefsForCLisp|
|$currentModuleName|))
@@ -977,63 +609,63 @@
((ATOM |b|) (LIST |b|))
((AND (CONSP |b|) (EQ (CAR |b|) 'TUPLE)
(PROGN (SETQ |xs| (CDR |b|)) #0='T))
- (LET ((|bfVar#41| NIL) (|bfVar#40| |xs|) (|x| NIL))
+ (LET ((|bfVar#13| NIL) (|bfVar#12| |xs|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#40|)
- (PROGN (SETQ |x| (CAR |bfVar#40|)) NIL))
- (RETURN (NREVERSE |bfVar#41|)))
+ ((OR (ATOM |bfVar#12|)
+ (PROGN (SETQ |x| (CAR |bfVar#12|)) NIL))
+ (RETURN (NREVERSE |bfVar#13|)))
(#1='T
- (SETQ |bfVar#41|
+ (SETQ |bfVar#13|
(CONS (|maybeExportDecl| |x| |export?|)
- |bfVar#41|))))
- (SETQ |bfVar#40| (CDR |bfVar#40|)))))
+ |bfVar#13|))))
+ (SETQ |bfVar#12| (CDR |bfVar#12|)))))
(#2='T
(PROGN
- (SETQ |bfVar#44| |b|)
- (SETQ |bfVar#45| (CDR |bfVar#44|))
- (CASE (CAR |bfVar#44|)
+ (SETQ |bfVar#16| |b|)
+ (SETQ |bfVar#17| (CDR |bfVar#16|))
+ (CASE (CAR |bfVar#16|)
(|Signature|
- (LET ((|op| (CAR |bfVar#45|)) (|t| (CADR |bfVar#45|)))
+ (LET ((|op| (CAR |bfVar#17|)) (|t| (CADR |bfVar#17|)))
(LIST (|maybeExportDecl| (|genDeclaration| |op| |t|)
|export?|))))
(|%Module|
- (LET ((|m| (CAR |bfVar#45|)) (|ds| (CADR |bfVar#45|)))
+ (LET ((|m| (CAR |bfVar#17|)) (|ds| (CADR |bfVar#17|)))
(PROGN
(SETQ |$currentModuleName| |m|)
(SETQ |$foreignsDefsForCLisp| NIL)
(CONS (LIST 'PROVIDE (STRING |m|))
- (LET ((|bfVar#43| NIL) (|bfVar#42| |ds|)
+ (LET ((|bfVar#15| NIL) (|bfVar#14| |ds|)
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#42|)
+ ((OR (ATOM |bfVar#14|)
(PROGN
- (SETQ |d| (CAR |bfVar#42|))
+ (SETQ |d| (CAR |bfVar#14|))
NIL))
- (RETURN (NREVERSE |bfVar#43|)))
+ (RETURN (NREVERSE |bfVar#15|)))
(#1#
- (SETQ |bfVar#43|
+ (SETQ |bfVar#15|
(CONS
(CAR
(|translateToplevel| |d| T))
- |bfVar#43|))))
- (SETQ |bfVar#42| (CDR |bfVar#42|))))))))
+ |bfVar#15|))))
+ (SETQ |bfVar#14| (CDR |bfVar#14|))))))))
(|Import|
- (LET ((|m| (CAR |bfVar#45|)))
+ (LET ((|m| (CAR |bfVar#17|)))
(LIST (LIST 'IMPORT-MODULE (STRING |m|)))))
(|ImportSignature|
- (LET ((|x| (CAR |bfVar#45|))
- (|sig| (CADR |bfVar#45|)))
+ (LET ((|x| (CAR |bfVar#17|))
+ (|sig| (CADR |bfVar#17|)))
(|genImportDeclaration| |x| |sig|)))
(|%TypeAlias|
- (LET ((|lhs| (CAR |bfVar#45|))
- (|rhs| (CADR |bfVar#45|)))
+ (LET ((|lhs| (CAR |bfVar#17|))
+ (|rhs| (CADR |bfVar#17|)))
(LIST (|maybeExportDecl|
(|genTypeAlias| |lhs| |rhs|) |export?|))))
(|ConstantDefinition|
- (LET ((|lhs| (CAR |bfVar#45|))
- (|rhs| (CADR |bfVar#45|)))
+ (LET ((|lhs| (CAR |bfVar#17|))
+ (|rhs| (CADR |bfVar#17|)))
(PROGN
(SETQ |sig| NIL)
(COND
@@ -1058,8 +690,8 @@
(LIST 'DEFCONSTANT |lhs| |rhs|)
|export?|)))))
(|%Assignment|
- (LET ((|lhs| (CAR |bfVar#45|))
- (|rhs| (CADR |bfVar#45|)))
+ (LET ((|lhs| (CAR |bfVar#17|))
+ (|rhs| (CADR |bfVar#17|)))
(PROGN
(SETQ |sig| NIL)
(COND
@@ -1088,7 +720,7 @@
(LIST 'DEFPARAMETER |lhs| |rhs|)
|export?|)))))))
(|namespace|
- (LET ((|n| (CAR |bfVar#45|)))
+ (LET ((|n| (CAR |bfVar#17|)))
(LIST (LIST 'IN-PACKAGE (STRING |n|)))))
(T (LIST (|translateToplevelExpression| |b|))))))))))
@@ -1186,17 +818,17 @@
(PROGN
(|shoeFileLine| "DEFINED and not USED" |stream|)
(SETQ |a|
- (LET ((|bfVar#47| NIL)
- (|bfVar#46| (HKEYS |$bootDefined|)) (|i| NIL))
+ (LET ((|bfVar#19| NIL)
+ (|bfVar#18| (HKEYS |$bootDefined|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#46|)
- (PROGN (SETQ |i| (CAR |bfVar#46|)) NIL))
- (RETURN (NREVERSE |bfVar#47|)))
+ ((OR (ATOM |bfVar#18|)
+ (PROGN (SETQ |i| (CAR |bfVar#18|)) NIL))
+ (RETURN (NREVERSE |bfVar#19|)))
(#0='T
(AND (NOT (GETHASH |i| |$bootUsed|))
- (SETQ |bfVar#47| (CONS |i| |bfVar#47|)))))
- (SETQ |bfVar#46| (CDR |bfVar#46|)))))
+ (SETQ |bfVar#19| (CONS |i| |bfVar#19|)))))
+ (SETQ |bfVar#18| (CDR |bfVar#18|)))))
(|bootOut| (SSORT |a|) |stream|)
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "DEFINED TWICE" |stream|)
@@ -1204,29 +836,29 @@
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "USED and not DEFINED" |stream|)
(SETQ |a|
- (LET ((|bfVar#49| NIL) (|bfVar#48| (HKEYS |$bootUsed|))
+ (LET ((|bfVar#21| NIL) (|bfVar#20| (HKEYS |$bootUsed|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#48|)
- (PROGN (SETQ |i| (CAR |bfVar#48|)) NIL))
- (RETURN (NREVERSE |bfVar#49|)))
+ ((OR (ATOM |bfVar#20|)
+ (PROGN (SETQ |i| (CAR |bfVar#20|)) NIL))
+ (RETURN (NREVERSE |bfVar#21|)))
(#0#
(AND (NOT (GETHASH |i| |$bootDefined|))
- (SETQ |bfVar#49| (CONS |i| |bfVar#49|)))))
- (SETQ |bfVar#48| (CDR |bfVar#48|)))))
- (LET ((|bfVar#50| (SSORT |a|)) (|i| NIL))
+ (SETQ |bfVar#21| (CONS |i| |bfVar#21|)))))
+ (SETQ |bfVar#20| (CDR |bfVar#20|)))))
+ (LET ((|bfVar#22| (SSORT |a|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#50|)
- (PROGN (SETQ |i| (CAR |bfVar#50|)) NIL))
+ ((OR (ATOM |bfVar#22|)
+ (PROGN (SETQ |i| (CAR |bfVar#22|)) NIL))
(RETURN NIL))
(#0#
(PROGN
(SETQ |b| (CONCAT (PNAME |i|) " is used in "))
(|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
|stream| |b|))))
- (SETQ |bfVar#50| (CDR |bfVar#50|))))))))
+ (SETQ |bfVar#22| (CDR |bfVar#22|))))))))
(DEFUN |shoeDefUse| (|s|)
(LOOP
@@ -1322,16 +954,16 @@
(#1# (CONS |nee| |$bootDefinedTwice|)))))
('T (HPUT |$bootDefined| |nee| T)))
(|defuse1| |e| |niens|)
- (LET ((|bfVar#51| |$used|) (|i| NIL))
+ (LET ((|bfVar#23| |$used|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#51|)
- (PROGN (SETQ |i| (CAR |bfVar#51|)) NIL))
+ ((OR (ATOM |bfVar#23|)
+ (PROGN (SETQ |i| (CAR |bfVar#23|)) NIL))
(RETURN NIL))
('T
(HPUT |$bootUsed| |i|
(CONS |nee| (GETHASH |i| |$bootUsed|)))))
- (SETQ |bfVar#51| (CDR |bfVar#51|))))))))
+ (SETQ |bfVar#23| (CDR |bfVar#23|))))))))
(DEFUN |defuse1| (|e| |y|)
(PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
@@ -1369,14 +1001,14 @@
(SETQ |LETTMP#1| (|defSeparate| |a|))
(SETQ |dol| (CAR |LETTMP#1|))
(SETQ |ndol| (CADR |LETTMP#1|))
- (LET ((|bfVar#52| |dol|) (|i| NIL))
+ (LET ((|bfVar#24| |dol|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#52|)
- (PROGN (SETQ |i| (CAR |bfVar#52|)) NIL))
+ ((OR (ATOM |bfVar#24|)
+ (PROGN (SETQ |i| (CAR |bfVar#24|)) NIL))
(RETURN NIL))
(#2='T (HPUT |$bootDefined| |i| T)))
- (SETQ |bfVar#52| (CDR |bfVar#52|))))
+ (SETQ |bfVar#24| (CDR |bfVar#24|))))
(|defuse1| (APPEND |ndol| |e|) |b|)))
((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
(PROGN (SETQ |a| (CDR |y|)) #1#))
@@ -1385,14 +1017,14 @@
(PROGN (SETQ |a| (CDR |y|)) #1#))
NIL)
(#0#
- (LET ((|bfVar#53| |y|) (|i| NIL))
+ (LET ((|bfVar#25| |y|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#53|)
- (PROGN (SETQ |i| (CAR |bfVar#53|)) NIL))
+ ((OR (ATOM |bfVar#25|)
+ (PROGN (SETQ |i| (CAR |bfVar#25|)) NIL))
(RETURN NIL))
(#2# (|defuse1| |e| |i|)))
- (SETQ |bfVar#53| (CDR |bfVar#53|)))))))))
+ (SETQ |bfVar#25| (CDR |bfVar#25|)))))))))
(DEFUN |defSeparate| (|x|)
(PROG (|x2| |x1| |LETTMP#1| |f|)
@@ -1428,13 +1060,13 @@
(GETHASH |x| |$lispWordTable|))
(DEFUN |bootOut| (|l| |outfn|)
- (LET ((|bfVar#54| |l|) (|i| NIL))
+ (LET ((|bfVar#26| |l|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#54|) (PROGN (SETQ |i| (CAR |bfVar#54|)) NIL))
+ ((OR (ATOM |bfVar#26|) (PROGN (SETQ |i| (CAR |bfVar#26|)) NIL))
(RETURN NIL))
('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
- (SETQ |bfVar#54| (CDR |bfVar#54|)))))
+ (SETQ |bfVar#26| (CDR |bfVar#26|)))))
(DEFUN CLESSP (|s1| |s2|) (NOT (SHOEGREATERP |s1| |s2|)))
@@ -1485,18 +1117,18 @@
(PROGN
(|shoeFileLine| "USED and where DEFINED" |stream|)
(SETQ |c| (SSORT (HKEYS |$bootUsed|)))
- (LET ((|bfVar#55| |c|) (|i| NIL))
+ (LET ((|bfVar#27| |c|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#55|)
- (PROGN (SETQ |i| (CAR |bfVar#55|)) NIL))
+ ((OR (ATOM |bfVar#27|)
+ (PROGN (SETQ |i| (CAR |bfVar#27|)) NIL))
(RETURN NIL))
('T
(PROGN
(SETQ |a| (CONCAT (PNAME |i|) " is used in "))
(|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
|stream| |a|))))
- (SETQ |bfVar#55| (CDR |bfVar#55|))))))))
+ (SETQ |bfVar#27| (CDR |bfVar#27|))))))))
(DEFUN FBO (|name| |fn|) (|shoeGeneralFC| #'BO |name| |fn|))
@@ -1537,16 +1169,16 @@
(SETQ |filename|
(CONCAT "/tmp/" |filename| ".boot"))
(|shoeOpenOutputFile| |stream| |filename|
- (LET ((|bfVar#56| |lines|) (|line| NIL))
+ (LET ((|bfVar#28| |lines|) (|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#56|)
+ ((OR (ATOM |bfVar#28|)
(PROGN
- (SETQ |line| (CAR |bfVar#56|))
+ (SETQ |line| (CAR |bfVar#28|))
NIL))
(RETURN NIL))
('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#56| (CDR |bfVar#56|)))))
+ (SETQ |bfVar#28| (CDR |bfVar#28|)))))
T))
('T NIL))))))
@@ -1561,20 +1193,20 @@
(RETURN
(PROGN
(SETQ |dq| (CAR |str|))
- (CONS (LIST (LET ((|bfVar#58| NIL)
- (|bfVar#57| (|shoeDQlines| |dq|))
+ (CONS (LIST (LET ((|bfVar#30| NIL)
+ (|bfVar#29| (|shoeDQlines| |dq|))
(|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#57|)
+ ((OR (ATOM |bfVar#29|)
(PROGN
- (SETQ |line| (CAR |bfVar#57|))
+ (SETQ |line| (CAR |bfVar#29|))
NIL))
- (RETURN (NREVERSE |bfVar#58|)))
+ (RETURN (NREVERSE |bfVar#30|)))
('T
- (SETQ |bfVar#58|
- (CONS (CAR |line|) |bfVar#58|))))
- (SETQ |bfVar#57| (CDR |bfVar#57|)))))
+ (SETQ |bfVar#30|
+ (CONS (CAR |line|) |bfVar#30|))))
+ (SETQ |bfVar#29| (CDR |bfVar#29|)))))
(CDR |str|))))))
(DEFUN |stripm| (|x| |pk| |bt|)
@@ -1759,7 +1391,8 @@
(DEFUN |loadNativeModule| (|m|)
(COND
((|%hasFeature| :SBCL)
- (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m|))
+ (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m|
+ :DONT-SAVE T))
((|%hasFeature| :CLISP)
(EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
((|%hasFeature| :ECL)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 13:31:20 +0000