I introduced a new function |run_program|:
(defun |run_program| (command arguments)
;; Execute "command" with a list of "arguments" synchronously.
;; Output to the standard output stream.
;; The return value is the exit code of "command".
And try to replace "OBEY" with it.
This is still in early stages, definitely should not go to
the up coming release. Some comments are left there need
clearing up, more testing are needed, especially on Windows.
See patch at https://github.com/oldk1331/fricas/tree/cleanup-obey
or in attachment.
Some potential problems:
0. Rename 'OBEY' to '|run_shell_command|'?
1. jfricas and *OBEY-STDOUT*
This change will affect jfricas. I'll not sure what's the best
approach to fix it yet, maybe make a duplicated definition?
Or redirect various streams? I'll take a deeper look.
2. editFile and SPADEDIT
Related code is messy and not working on my side. (I did not
try hard.)
Is this functionality still useful? This surely is not how
programs interactwith users these days.
3. Aldor related
"asList" in as.boot: can use '(directory "as/*.asy")' to replace
OBEY. However is this function still needed?
"compile-as-file" in foam_l.lisp. Is it used during Aldor interface
build? I plan to change the type of optional argument "opts" from
(or nil string) to (list string).
4. In buildLibdb, I skipped rename-file. Should not be a problem.
5. "grepFile" in br-search.boot uses IO redirection, so it has to use
OBEY instead of |run_program|.
- Qian
--
You received this message because you are subscribed to the Google Groups "FriCAS -
computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
To view this discussion on the web visit
https://groups.google.com/d/msgid/fricas-devel/039beef2-464e-400c-beae-76e28cb51ec6%40gmail.com.
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index bfa348cf..fd7cec67 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -82,8 +82,8 @@ buildLibdb(domainList) == --called by make-databases (daase.lisp)
domainList => 'done --leave new database in temp.text
-- FIXME: This is confusing: result is in olibdb.text,
-- but this is expected by save_browser_data
- OBEY '"sort _"temp.text_" > _"libdb.text_""
- RENAME_-FILE('"libdb.text", '"olibdb.text")
+ -- use OBEY here, otherwise SBCL will choose C:/Windows/System32/sort.exe
+ OBEY('"sort temp.text -o olibdb.text")
deleteFile '"temp.text"
buildLibdbConEntry conname ==
diff --git a/src/interp/compat.boot b/src/interp/compat.boot
index ce9fe6c9..7541fb37 100644
--- a/src/interp/compat.boot
+++ b/src/interp/compat.boot
@@ -64,5 +64,5 @@ rwrite(key,val,stream) ==
editFile file ==
MEMQ(INTERN('"WIN32",FIND_-PACKAGE("KEYWORD")),_*FEATURES_*) =>
- OBEY STRCONC('"notepad ", file)
- OBEY STRCONC('"$FRICAS/lib/SPADEDIT ", file)
+ run_program('"notepad", [file])
+ run_program(CONCAT($spadroot, '"/lib/SPADEDIT"), [file])
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 21c2b3d1..e4cccf30 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -571,8 +571,7 @@ compileAsharpArchiveCmd args ==
throwKeyedMsg("S2IL0027",[namestring dir, path])
if isDir ~= 1 then
- cmd := STRCONC('"mkdir ", namestring dir)
- rc := OBEY cmd
+ rc := makedir namestring dir
rc ~= 0 => throwKeyedMsg("S2IL0027", [namestring dir, path])
curDir := GET_-CURRENT_-DIRECTORY()
@@ -581,8 +580,7 @@ compileAsharpArchiveCmd args ==
cd [ namestring dir ]
- cmd := STRCONC( '"ar x ", path)
- rc := OBEY cmd
+ rc := run_command('"ar", ['"x", path])
rc ~= 0 =>
cd [ namestring curDir ]
throwKeyedMsg("S2IL0028",[namestring dir, path])
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 8c844fa7..e659c988 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -312,9 +312,9 @@
(defun |erase_lib0|(fn ft) (|erase_lib| (|make_filename0| fn ft)))
-#+:GCL
+#+(or :abcl :clisp :cmu :ecl :gcl :lispworks :poplog)
(defun delete-directory (dirname)
- (SI::system (concat "rm -r " dirname)))
+ (|run_program| "rm" (list "-r" dirname)))
#+:sbcl
(defun delete-directory (dirname)
@@ -322,46 +322,27 @@
0
1))
-#+:cmu
-(defun delete-directory (dirname)
- (ext::run-program "rm" (list "-r" dirname))
- )
-
#+:openmcl
(defun delete-directory (dirname)
(if (ccl:delete-directory dirname)
0
1))
-#+:clisp
+#|
+#+:clisp ;; test on win
(defun delete-directory (dirname)
#-:win32
(obey (concat "rm -r " dirname))
#+:win32
(obey (concat "rmdir /q /s " "\"" dirname "\"")))
-
-#+:ecl
-(defun delete-directory (dirname)
- (ext:system (concat "rm -r " dirname)))
-
-#+:poplog
-(defun delete-directory (dirname)
- (POP11:sysobey (concat "rm -r " dirname)))
-
-#+:abcl
-(defun delete-directory (dirname)
- (sys:run-program "rm" (list "-r" dirname)))
-
-#+:lispworks
-(defun delete-directory (dirname)
- (system:call-system (concatenate 'string "rm -r " dirname)))
+|#
(defun |replace_lib|(filespec2 filespec1)
(|erase_lib| (setq filespec1 (|make_full_namestring| filespec1)))
#-(or :clisp :openmcl :ecl)
(rename-file (|make_full_namestring| filespec2) filespec1)
#+(or :clisp :openmcl :ecl)
- (obey (concat "mv " (|make_full_namestring| filespec2) " " filespec1))
+ (|run_program| "mv" (list (|make_full_namestring| filespec2) filespec1))
)
@@ -371,48 +352,8 @@
(copy-lib-directory name1 name2)
))
-
-#+:GCL
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (SI::system (concat "sh -c 'cp " name1 "/* " name2 "'")))
-
-#+:sbcl
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (sb-ext::run-program "/bin/sh" (list "-c" (concat "cp " name1 "/* " name2)))
- )
-
-#+:cmu
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (ext::run-program "sh" (list "-c" (concat "cp " name1 "/* " name2)))
- )
-
-#+:openmcl
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (ccl::run-program "sh" (list "-c" (concat "cp " name1 "/* " name2))))
-
-#+(or :clisp :ecl)
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (OBEY (concat "sh -c 'cp " name1 "/* " name2 "'")))
-
-#+:poplog
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (POP11:sysobey (concat "cp " name1 "/* " name2)))
-
-#+:abcl
-(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (sys:run-program "cp" (list "-r" (concat name1 "/*") name2)))
-
-#+:lispworks
(defun copy-lib-directory (name1 name2)
- (makedir name2)
- (system:call-system (concat "cp " (concat name1 "/*") " " name2)))
+ (|run_program| "cp" (list "-r" name1 name2)))
(defvar |$filetype_table|
'(
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 919781b4..95fefd55 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -707,56 +707,6 @@
func)))
((symbolp func) func)))
-#+:cmu
-(defun OBEY (S)
- (ext::process-exit-code
- (ext::run-program "sh" (list "-c" S) :input t :output t)))
-
-#+:GCL
-(defun OBEY (S) (SI::SYSTEM S))
-
-#+:allegro
-(defun OBEY (S) (excl::run-shell-command s))
-
-(defvar *OBEY-STDOUT* nil "if T use *standard output*")
-#+:sbcl
-(defun OBEY (S)
- #-:win32 (if *OBEY-STDOUT*
- (sb-ext::process-exit-code
- (sb-ext::run-program "/bin/sh" (list "-c" S) :input t
- :output *standard-output* :error *standard-output*))
-
- (sb-ext::process-exit-code
- (sb-ext::run-program "/bin/sh"
- (list "-c" S) :input t :output t :error t)))
- #+:win32 (sb-ext::process-exit-code
- (sb-ext::run-program "sh"
- (list "-c" S) :input t :output t :error t :search t)))
-
-#+:openmcl
-(defun OBEY (S)
- (ccl::run-program "sh" (list "-c" S) :input t :output t :error t))
-
-#+(and :clisp (or :win32 :unix))
-(defun OBEY (S)
- (ext:run-shell-command S))
-
-#+:ecl
-(defun OBEY (S)
- (ext:system S))
-
-#+:poplog
-(defun OBEY (S)
- (POP11:sysobey S))
-
-#+:abcl
-(defun OBEY (S)
- (sys:run-program "sh" (list "-c" S) :input t :output t :error t))
-
-#+:lispworks
-(defun OBEY (S)
- (system:call-system S))
-
;;; moved from hash.lisp
;17.0 Operations on Hashtables
diff --git a/src/lisp/fricas-lisp.lisp b/src/lisp/fricas-lisp.lisp
index 8680a3a1..82ea63e2 100644
--- a/src/lisp/fricas-lisp.lisp
+++ b/src/lisp/fricas-lisp.lisp
@@ -756,18 +756,14 @@ with this hack and will try to convince the GCL crowd to fix this.
;;; Make directory
-#+:cmu
+#+(or :abcl :cmu :lispworks :openmcl)
(defun makedir (fname)
- (ext::run-program "mkdir" (list fname)))
+ (|run_program| "mkdir" (list fname)))
#+:sbcl
(defun makedir (fname)
(sb-unix:unix-mkdir fname #o777))
-#+:openmcl
-(defun makedir (fname)
- (ccl::run-program "mkdir" (list fname)))
-
#+:clisp
(defun makedir (fname)
;; ext:make-dir was deprecated in clisp-2.44-2008-02-02
@@ -776,14 +772,6 @@ with this hack and will try to convince the GCL crowd to fix this.
(find-symbol "MAKE-DIR" "EXT"))))
(funcall sym (pad-directory-name (namestring fname)))))
-#+:lispworks
-(defun makedir (fname)
- (system:call-system (concatenate 'string "mkdir " fname)))
-
-#+:abcl
-(defun makedir (fname)
- (sys:run-program "mkdir" (list fname)))
-
;;;
#+:sbcl
@@ -886,7 +874,7 @@ with this hack and will try to convince the GCL crowd to fix this.
#+:poplog
(defun fricas_compile_file (f output-file)
- (POP11::sysobey (concatenate 'string "cp " f " " output-file)))
+ (|run_program| "cp" (list f output-file)))
#-(or :ecl :poplog)
(defun fricas_compile_file (f output-file)
@@ -899,6 +887,61 @@ with this hack and will try to convince the GCL crowd to fix this.
(compile-file f :output-file (relative-to-absolute output-file))
)
+;; |run_program|
+
+#|
+(defvar *OBEY-STDOUT* nil "if T use *standard output*")
+#+:sbcl
+(defun OBEY (S)
+ #-:win32 (if *OBEY-STDOUT*
+ (sb-ext::process-exit-code
+ (sb-ext::run-program "/bin/sh" (list "-c" S) :input t
+ :output *standard-output* :error *standard-output*))
+
+ (sb-ext::process-exit-code
+ (sb-ext::run-program "/bin/sh"
+ (list "-c" S) :input t :output t :error t)))
+ #+:win32 (sb-ext::process-exit-code
+ (sb-ext::run-program "sh"
+ (list "-c" S) :input t :output t :error t :search t)))
+|#
+
+(defun OBEY (s)
+ #+:gcl
+ (si:system s)
+ #+:poplog
+ (POP11:sysobey s)
+ #-(or :gcl :poplog)
+ (|run_program| "sh" (list "-c" s)))
+
+(defun |run_program| (command arguments)
+ ;; Execute "command" with a list of "arguments" synchronously.
+ ;; Output to the standard output stream.
+ ;; The return value is the exit code of "command".
+ #+:abcl
+ (sys:process-exit-code (sys:run-program command arguments :output t))
+ #+:clisp
+ (let ((exit-code (ext:run-program command :arguments arguments)))
+ (if exit-code exit-code 0))
+ #+:cmu
+ (ext:process-exit-code (ext:run-program command arguments :output t))
+ #+:ecl
+ (cadr (multiple-value-list (ext:run-program command arguments :output t)))
+ ;; #+:gcl ;; run-process is asynchronous
+ ;; (si:run-process command arguments)
+ #+:lispworks ;; call-system requires absolute path for "command"
+ (system:call-system-showing-output `("/usr/bin/env" ,command ,@arguments))
+ #+:openmcl
+ (cadr (multiple-value-list (ccl:external-process-status
+ (ccl:run-program command arguments :output t))))
+ #+:sbcl
+ (sb-ext:process-exit-code
+ (sb-ext:run-program command arguments :search t :output t))
+ #+:gcl
+ (si:system (format nil "~{~a~^ ~}" (cons command arguments)))
+ #+:poplog
+ (pop11:sysobey (format nil "~{~a~^ ~}" (cons command arguments))))
+
(defmacro DEFCONST (name value)
`(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)))
diff --git a/src/lisp/fricas-package.lisp b/src/lisp/fricas-package.lisp
index 4fdacb2e..77b20ac6 100644
--- a/src/lisp/fricas-package.lisp
+++ b/src/lisp/fricas-package.lisp
@@ -44,7 +44,7 @@
(export '(quit chdir |getEnv| |getCLArgs| |load_quietly| get-current-directory
trim-directory-name pad-directory-name
file-kind makedir fricas_compile_file fricas_compile_fasl
- |fricas_probe_file|
+ |fricas_probe_file| |run_program| OBEY
DEFCONST |exit_with_status| MEMQ |quiet_load_alien|
|handle_input_file| |handle_output_file| |maybe_delete_file|
|remove_directory| |writeablep| |openServer| |sockGetInt|
