diff options
| -rw-r--r-- | src/boot/strap/translator.clisp | 57 | ||||
| -rw-r--r-- | src/boot/translator.boot | 21 | ||||
| -rw-r--r-- | src/driver/main.cc | 4 | ||||
| -rw-r--r-- | src/interp/i-output.boot | 20 | ||||
| -rw-r--r-- | src/interp/sys-driver.boot | 6 |
5 files changed, 66 insertions, 42 deletions
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index df59ddc4..bde5bea1 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -15,9 +15,9 @@ (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (EXPORT - '(|evalBootFile| |loadNativeModule| |loadSystemRuntimeCore| - |compileBootHandler| |string2BootTree| - |genImportDeclaration| |retainFile?|))) + '(|evalBootFile| |directoryFromCommandLine| |loadNativeModule| + |loadSystemRuntimeCore| |compileBootHandler| + |string2BootTree| |genImportDeclaration| |retainFile?|))) (DEFPARAMETER |$currentModuleName| NIL) @@ -443,7 +443,7 @@ (SETQ |ps| (|makeParserState| |toks|)) (|bpFirstTok| |ps|) (SETQ |found| - (LET ((#1=#:G402 + (LET ((#1=#:G379 (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|)))) (COND ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT)) @@ -936,21 +936,40 @@ (|associateRequestWithFileType| (|Option| "compile") "boot" #'|compileBootHandler|) -(DEFUN |loadNativeModule| (|m|) - (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 |directoryFromCommandLine| (|opt|) + (LET* (|dir|) + (COND + ((SETQ |dir| (ASSOC (|Option| |opt|) (|%systemOptions|))) + (|ensureTrailingSlash| (CDR |dir|))) + (T NIL)))) + +(DEFUN |loadNativeModule| (|m| &REST |dir|) + (LET* (|LETTMP#1|) + (PROGN + (SETQ |m| (CONCAT |$NativeModulePrefix| |m| |$NativeModuleExt|)) + (COND + (|dir| (SETQ |LETTMP#1| |dir|) (SETQ |dir| (CAR |LETTMP#1|)) + (SETQ |m| (CONCAT |dir| |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")))))) (DEFUN |loadSystemRuntimeCore| () - (COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL) - (T (|loadNativeModule| "open-axiom-core")))) + (LET* (|dir| |path|) + (COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL) + (T + (SETQ |dir| + (COND + ((SETQ |path| (|directoryFromCommandLine| "syslib")) + |path|) + (T (CONCAT (|systemRootDirectory|) "lib/")))) + (|loadNativeModule| "open-axiom-core" |dir|))))) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 03c493a1..55bf9321 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -39,8 +39,9 @@ import pile import parser import ast namespace BOOTTRAN -module translator (evalBootFile, loadNativeModule, loadSystemRuntimeCore, - compileBootHandler, string2BootTree, genImportDeclaration, retainFile?) +module translator (evalBootFile, directoryFromCommandLine, + loadNativeModule, loadSystemRuntimeCore, + compileBootHandler, string2BootTree, genImportDeclaration, retainFile?) ++ If non nil, holds the name of the current module being translated. $currentModuleName := nil @@ -607,9 +608,18 @@ associateRequestWithFileType(Option '"compile", '"boot", --% Runtime support +++ Returns the directory name as specified through option name `opt'. +directoryFromCommandLine opt == + dir := ASSOC(Option opt, %systemOptions()) => + ensureTrailingSlash rest dir + nil + ++ Load native dynamically linked module -loadNativeModule m == +loadNativeModule(m,:dir) == m := strconc($NativeModulePrefix,m,$NativeModuleExt) + if dir ~= nil then + [dir] := dir + m := strconc(dir,m) %hasFeature KEYWORD::SBCL => apply(bfColonColon("SB-ALIEN","LOAD-SHARED-OBJECT"), [m,KEYWORD::DONT_-SAVE,true]) @@ -623,4 +633,7 @@ loadNativeModule m == loadSystemRuntimeCore() == %hasFeature KEYWORD::ECL or %hasFeature KEYWORD::GCL => nil - loadNativeModule '"open-axiom-core" + dir := + path := directoryFromCommandLine '"syslib" => path + strconc(systemRootDirectory(),'"lib/") + loadNativeModule('"open-axiom-core",dir) diff --git a/src/driver/main.cc b/src/driver/main.cc index 3d8431b6..cf9233bc 100644 --- a/src/driver/main.cc +++ b/src/driver/main.cc @@ -64,7 +64,7 @@ namespace OpenAxiom { augment_variable(const char* name, const char* value) { const char* oldval = oa_getenv(name); const int value_length = strlen(value); - const int oldval_length = oldval == 0 ? 0 : strlen(oldval); + const int oldval_length = oldval == nullptr ? 0 : strlen(oldval); const int newval_length = value_length + 1 + oldval_length; char* newval = (char*) malloc(newval_length + 1); @@ -86,7 +86,7 @@ namespace OpenAxiom { augment_variable("BIBINPUTS", oa_concatenate_string(sysdir, OPENAXIOM_BIBINPUTS_PATH)); const char* ldd_path = option_value(command, "--syslib"); - if (ldd_path == 0) + if (ldd_path == nullptr) ldd_path = oa_concatenate_string(sysdir, "/lib"); #ifdef OPENAXIOM_MS_WINDOWS_HOST augment_variable("PATH", ldd_path); diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index d035bd0b..a4c44912 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2016, Gabriel Dos Reis. +-- Copyright (C) 2007-2022, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1111,21 +1111,19 @@ aggregateApp(u,x,y,d,s) == --% Function to compute Width +widthOfString u == + u = $EmptyString => 0 + stringChar(u,0) = char "%" and + (stringChar(u,1) = char "b" or stringChar(u,1) = char "d") => 1 + #u + outformWidth u == --WIDTH as called from OUTFORM to do a COPY - string? u => - u = $EmptyString => 0 - stringChar(u,0) = char "%" and - (stringChar(u,1) = char "b" or stringChar(u,1) = char "d") => 1 - #u + string? u => widthOfString u u isnt [.,:.] => # atom2String u WIDTH copyTree u WIDTH u == - string? u => - u = $EmptyString => 0 - stringChar(u,0) = char "%" and - (stringChar(u,1) = char "b" or stringChar(u,1) = char "d") => 1 - #u + string? u => widthOfString u integer? u => if (u < 1) then negative := 1 diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot index 4ab20b23..7fd65924 100644 --- a/src/interp/sys-driver.boot +++ b/src/interp/sys-driver.boot @@ -75,12 +75,6 @@ symbolFunction('%sysInit) := () +-> --% -++ Returns the directory name as specified through option name `opt'. -directoryFromCommandLine opt == - dir := ASSOC(Option opt, %systemOptions()) => - ensureTrailingSlash rest dir - nil - ++ Returns the system algebra directory, as specified on command ++ line. nil, otherwise. systemAlgebraDirectory() == |