aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/translator.clisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap/translator.clisp')
-rw-r--r--src/boot/strap/translator.clisp156
1 files changed, 92 insertions, 64 deletions
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 8e7ab21c..df59ddc4 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -16,56 +16,83 @@
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
(EXPORT
'(|evalBootFile| |loadNativeModule| |loadSystemRuntimeCore|
- |string2BootTree| |genImportDeclaration| |retainFile?|)))
+ |compileBootHandler| |string2BootTree|
+ |genImportDeclaration| |retainFile?|)))
(DEFPARAMETER |$currentModuleName| NIL)
+(DEFPARAMETER |$foreignLoadUnits| NIL)
+
(DEFPARAMETER |$foreignsDefsForCLisp| NIL)
(DEFUN |reallyPrettyPrint| (|x| &OPTIONAL (|st| *STANDARD-OUTPUT*))
(PROGN (|prettyPrint| |x| |st|) (TERPRI |st|)))
(DEFUN |genModuleFinalization| (|stream|)
- (LET* (|init| |setFFS|)
- (DECLARE (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|))
- (COND ((NULL |$ffs|) NIL)
- ((NULL |$currentModuleName|)
- (|coreError| "current module has no name"))
- (T
- (SETQ |setFFS|
- (LIST 'SETQ '|$dynamicForeignFunctions|
- (LIST '|append!| (|quote| |$ffs|)
- '|$dynamicForeignFunctions|)))
- (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|)
- (COND
- ((|%hasFeature| :CLISP)
- (COND ((NULL |$foreignsDefsForCLisp|) NIL)
- (T
- (SETQ |init|
- (CONS 'PROGN
- (LET ((|bfVar#2| NIL)
- (|bfVar#3| NIL)
- (|bfVar#1| |$foreignsDefsForCLisp|)
- (|d| NIL))
- (LOOP
- (COND
- ((OR (NOT (CONSP |bfVar#1|))
- (PROGN
- (SETQ |d| (CAR |bfVar#1|))
- NIL))
- (RETURN |bfVar#2|))
- ((NULL |bfVar#2|)
- (SETQ |bfVar#2|
- #1=(CONS
- (LIST 'EVAL (|quote| |d|))
- NIL))
- (SETQ |bfVar#3| |bfVar#2|))
- (T (RPLACD |bfVar#3| #1#)
- (SETQ |bfVar#3| (CDR |bfVar#3|))))
- (SETQ |bfVar#1| (CDR |bfVar#1|))))))
- (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|)
- |stream|))))
- (T NIL))))))
+ (LET* (|init| |setFFS| |loadUnitsForm| |loadUnits|)
+ (DECLARE
+ (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|
+ |$foreignLoadUnits|))
+ (PROGN
+ (SETQ |loadUnits|
+ (LET ((|bfVar#2| NIL)
+ (|bfVar#3| NIL)
+ (|bfVar#1| |$foreignLoadUnits|)
+ (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (NOT (CONSP |bfVar#1|))
+ (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL))
+ (RETURN |bfVar#2|))
+ ((NULL |bfVar#2|)
+ (SETQ |bfVar#2| #1=(CONS (SYMBOL-NAME |x|) NIL))
+ (SETQ |bfVar#3| |bfVar#2|))
+ (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
+ (SETQ |bfVar#1| (CDR |bfVar#1|)))))
+ (COND
+ (|loadUnits|
+ (SETQ |loadUnitsForm|
+ (LIST 'MAP (|quote| '|loadNativeModule|) (|quote| |loadUnits|)))
+ (|reallyPrettyPrint| (|atLoadOrExecutionTime| |loadUnitsForm|)
+ |stream|)))
+ (COND ((NULL |$ffs|) NIL)
+ ((NULL |$currentModuleName|)
+ (|coreError| "current module has no name"))
+ (T
+ (SETQ |setFFS|
+ (LIST 'SETQ '|$dynamicForeignFunctions|
+ (LIST '|append!| (|quote| |$ffs|)
+ '|$dynamicForeignFunctions|)))
+ (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|)
+ (COND
+ ((|%hasFeature| :CLISP)
+ (COND ((NULL |$foreignsDefsForCLisp|) NIL)
+ (T
+ (SETQ |init|
+ (CONS 'PROGN
+ (LET ((|bfVar#5| NIL)
+ (|bfVar#6| NIL)
+ (|bfVar#4| |$foreignsDefsForCLisp|)
+ (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (NOT (CONSP |bfVar#4|))
+ (PROGN
+ (SETQ |d| (CAR |bfVar#4|))
+ NIL))
+ (RETURN |bfVar#5|))
+ ((NULL |bfVar#5|)
+ (SETQ |bfVar#5|
+ #2=(CONS
+ (LIST 'EVAL (|quote| |d|))
+ NIL))
+ (SETQ |bfVar#6| |bfVar#5|))
+ (T (RPLACD |bfVar#6| #2#)
+ (SETQ |bfVar#6| (CDR |bfVar#6|))))
+ (SETQ |bfVar#4| (CDR |bfVar#4|))))))
+ (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|)
+ |stream|))))
+ (T NIL)))))))
(DEFUN |genOptimizeOptions| (|stream|)
(|reallyPrettyPrint|
@@ -416,7 +443,7 @@
(SETQ |ps| (|makeParserState| |toks|))
(|bpFirstTok| |ps|)
(SETQ |found|
- (LET ((#1=#:G401
+ (LET ((#1=#:G402
(CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
(COND
((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
@@ -632,8 +659,8 @@
(|bootImport| (SYMBOL-NAME |m|))))
(LIST (LIST 'IMPORT-MODULE (SYMBOL-NAME |m|)))))))
(|%ImportSignature|
- (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)))
- (|genImportDeclaration| |x| |sig|)))
+ (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)) (|dom| (CADDDR |b|)))
+ (|genImportDeclaration| |x| |sig| |dom|)))
(|%TypeAlias|
(LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|)))
(LIST (|genTypeAlias| |lhs| |rhs|))))
@@ -865,13 +892,14 @@
(DEFUN |getIntermediateLispFile| (|file| |options|)
(LET* (|out|)
- (PROGN
- (SETQ |out| (NAMESTRING (|getOutputPathname| |options|)))
- (COND
- (|out|
- (CONCAT (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) |out|)
- ".clisp"))
- (T (|defaultBootToLispFile| |file|))))))
+ (BLOCK NIL
+ (PROGN
+ (SETQ |out|
+ (OR (|getOutputPathname| |options|)
+ (RETURN (|defaultBootToLispFile| |file|))))
+ (CONCAT
+ (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) (NAMESTRING |out|))
+ ".clisp")))))
(DEFUN |translateBootFile| (|progname| |options| |file|)
(LET* (|outFile|)
@@ -909,20 +937,20 @@
#'|compileBootHandler|)
(DEFUN |loadNativeModule| (|m|)
- (COND
- ((|%hasFeature| :SBCL)
- (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE T))
- ((|%hasFeature| :CLISP)
- (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
- ((|%hasFeature| :ECL)
- (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|)))
- ((|%hasFeature| :CLOZURE)
- (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|)))
- (T (|coreError| "don't know how to load a dynamically linked module"))))
+ (PROGN
+ (SETQ |m| (CONCAT |$NativeModulePrefix| |m| |$NativeModuleExt|))
+ (COND
+ ((|%hasFeature| :SBCL)
+ (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE T))
+ ((|%hasFeature| :CLISP)
+ (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
+ ((|%hasFeature| :ECL)
+ (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|)))
+ ((|%hasFeature| :CLOZURE)
+ (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|)))
+ (T (|coreError| "don't know how to load a dynamically linked module")))))
(DEFUN |loadSystemRuntimeCore| ()
(COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL)
- (T
- (|loadNativeModule|
- (CONCAT "libopen-axiom-core" |$NativeModuleExt|)))))
+ (T (|loadNativeModule| "open-axiom-core"))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-19 01:49:49 +0000