I've revived the ")savesystem" command to make it
work properly with frames.

I've tested it with sbcl/clisp/ccl/gcl on linux and
sbcl on windows.

It works with hyperdoc and graphics.  I think this
would be a handy feature and so far I've found no
additional issues.  I welcome you to give this a
test and report any issues to me.

- Qian

You can test it like this:

$ fricas  ## you can run with -nosman as well, both works

(1) -> x := 1

   (1)  1

(2) -> )savesystem save1

$ fricas -ws ./save1

openServer result 0

(2) -> x

   (2)  1

-- 
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 fricas-devel+unsubscr...@googlegroups.com.
To view this discussion visit 
https://groups.google.com/d/msgid/fricas-devel/f55310d8-e6c4-48cc-b2d2-3e6c3b4b1966%40gmail.com.
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 9774cc03..e359a583 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -1948,6 +1948,11 @@ read_or_compile(quiet, i_name) ==
     type = '"bbin" => LOAD(input_file)
     type = '"input" => ncINTERPFILE(input_file, not(quiet))
 
+--% )savesystem
+savesystem l ==
+  #l ~= 1 or not(SYMBOLP first l) => helpSpad2Cmd '(savesystem)
+  SPAD_-SAVESYSTEM SYMBOL_-NAME first l
+
 --% )show
 
 show l ==
diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot
index 485197e0..7d285427 100644
--- a/src/interp/i-toplev.boot
+++ b/src/interp/i-toplev.boot
@@ -171,13 +171,16 @@ interpsys_restart() ==
 
   if $displayStartMsgs then spadStartUpMsgs()
   $currentLine := nil
+  fricas_init_opendb()
+  makeConstructorsAutoLoad()
+  createInitializers2()
+
+fricas_init_opendb() ==
   -- open databases
   open_interp_db(true)
   open_operation_db(true)
   open_category_db(true)
   open_browse_db(true)
-  makeConstructorsAutoLoad()
-  createInitializers2()
 
 readSpadProfileIfThere() ==
   -- reads SPADPROF INPUT if it exists
diff --git a/src/interp/int-top.boot b/src/interp/int-top.boot
index 81cddac4..47934f67 100644
--- a/src/interp/int-top.boot
+++ b/src/interp/int-top.boot
@@ -130,6 +130,7 @@ ncTopLevel() ==
 ++ not aware of that,  It is therefore confusing to display a prompt,
 ++ because all this horse-threading happens behind the client's back.
 printFirstPrompt?() ==
+    $SpadSavedSystem and $SpadServer => false
     $interpreterFrameName ~= "initial" or not($SpadServer)
 
 
diff --git a/src/interp/server.boot b/src/interp/server.boot
index 13603341..81832da8 100644
--- a/src/interp/server.boot
+++ b/src/interp/server.boot
@@ -87,6 +87,7 @@ serverReadLine(stream) ==
       $NeedToSignalSessionManager := true
       return l
     action = $CreateFrame =>
+      if $SpadSavedSystem then previousFrameNum := $currentFrameNum
       frameName := GENTEMP('"frame")
       addNewInterpreterFrame(frameName)
       $frameAlist := [[$frameNumber,:frameName], :$frameAlist]
@@ -94,6 +95,11 @@ serverReadLine(stream) ==
       sockSendInt($SessionManager, $CreateFrameAnswer)
       sockSendInt($SessionManager, $frameNumber)
       $frameNumber := $frameNumber + 1
+      if $SpadSavedSystem then
+        $currentFrameNum := previousFrameNum
+        currentFrame := LASSOC($currentFrameNum, $frameAlist)
+        changeToNamedInterpreterFrame currentFrame
+        $SpadSavedSystem := false -- run only once at startup
       princPrompt()
       FORCE_-OUTPUT()
     action = $SwitchFrames =>
diff --git a/src/interp/setq.lisp b/src/interp/setq.lisp
index 2b7699b2..1c171aba 100644
--- a/src/interp/setq.lisp
+++ b/src/interp/setq.lisp
@@ -110,6 +110,7 @@
    (|pquit|                          . |interpreter|)
    (|quit|                           . |interpreter|)
    (|read|                           . |interpreter|)
+   (|savesystem|                     . |interpreter|)
    (|set|                            . |interpreter|)
    (|show|                           . |interpreter|)
    (|spool|                          . |interpreter|)
@@ -156,6 +157,7 @@
     |ltrace|
     |nopiles|
     |read|
+    |savesystem|
     |set|
     |spool|
     |undo|
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 81000f69..16014846 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -157,7 +157,7 @@ After this function is called the image is clean and can be saved.
 (defvar $openServerIfTrue t "t means try starting an open server")
 (defparameter $SpadServerName "/tmp/.d" "the name of the spad server socket")
 (defvar |$SpadServer| nil "t means Scratchpad acts as a remote server")
-
+(defvar |$SpadSavedSystem| nil "t means FriCAS is resuming from a previous )savesystem")
 
 (defun |loadExposureGroupData| ()
  (cond
@@ -204,6 +204,12 @@ After this function is called the image is clean and can be saved.
                     (FRICAS-LISP::cmu-init-foreign-calls)
                 )
                 (setf $openServerIfTrue nil))))
+  (|fricas_init_openserver|)
+  (setq *GENSYM-COUNTER* 0)
+  (|interpsys_restart|)
+)
+
+(defun |fricas_init_openserver| ()
     #+(or :GCL (and :clisp :ffi) :sbcl :cmu :openmcl :ecl :lispworks)
     (if $openServerIfTrue
         (let ((os (|openServer| $SpadServerName)))
@@ -215,8 +221,6 @@ After this function is called the image is clean and can be saved.
                       (if (fboundp 'si::readline-off)
                           (si::readline-off))
                       (setq |$SpadServer| t)))))
-  (setq *GENSYM-COUNTER* 0)
-  (|interpsys_restart|)
 )
 
 (defun |fricas_restart2| ()
@@ -239,6 +243,17 @@ After this function is called the image is clean and can be saved.
          (if do-restart #'boot::|fricas_restart| nil))
 )
 
+(defun spad-savesystem (save-file)
+  (setq |$SpadServer| nil)
+  (setq $openServerIfTrue t)
+  (setq |$SpadSavedSystem| t)
+  (FRICAS-LISP::save-core-restart save-file
+    (lambda ()
+      (in-package "BOOT")
+      (|fricas_init_openserver|)
+      (|fricas_init_opendb|)
+      (|fricas_restart2|))))
+
 (defun |mkAutoLoad| (cname)
    (function (lambda (&rest args)
                  #+:sbcl

Reply via email to