archive/src/explorer-tape.lisp

   1
   2 ;(fs:set-logical-pathname-host
   3 ;  "Cl-maxima-source" ':physical-host (si::parse-host "R20")
   4 ;  ':translations '(("maxima" "AUX:<ATP.SCHELTER.MACSYMA>")  ;bout  2000 blocks if you keep sources
   5 ;                  ("demo" "PS:<MACSYM.LSP-TEMP>" )  ;small
   6 ;                  ))
   7 ;;if creating directories with any name you choose is no problem,
   8 ;;you might want to use something like the following so that the only
   9 ;;changes necessary are to replace "max" by your physical host
  10 ;(fs:set-logical-pathname-host
  11 ;  "Cl-maxima-source" ':physical-host "MAX"
  12 ;  ':translations '(("maxima" "MAXIMA.SOURCE;")  ;about  2000 blocks if you keep sources
  13 ;                  ("demo" "MAXIMA.DEMO;" )  ;small
  14 ;                  ))
  15
  16 #+ti
  17 (DEFUN restore-MACSYMA-FILES ()
  18   (MT::PREPARE-TAPE 6)
  19   (MT::REWIND)
  20   (MT::RESTORE-MULTIPLE-FILE :HOST "SYS" :DIRECTORY '("SITE"))
  21   (MT::RESTORE-MULTIPLE-FILE :HOST "CL-MAXIMA-OBJECT" :DIRECTORY '( "MAXIMA"))
  22   (MT::RESTORE-MULTIPLE-FILE :HOST "CL-MAXIMA-PATCH" :DIRECTORY '("PATCH"))
  23   (MT::RESTORE-MULTIPLE-FILE :HOST "MAXIMA-DOCUMENTATION" :DIRECTORY '("TEST"))
  24   (MT::RESTORE-MULTIPLE-FILE :HOST "MAXIMA-DOCUMENTATION" :DIRECTORY '( "MAXIMA"))
  25   (MT::RESTORE-MULTIPLE-FILE :HOST "CL-MAXIMA-SOURCE" :DIRECTORY '("MAXIMA"))
  26   (MT::RESTORE-MULTIPLE-FILE :HOST "CL-MAXIMA-SOURCE" :DIRECTORY '("MAXIMA"))
  27   (MT::RESTORE-MULTIPLE-FILE :HOST "CL-MAXIMA-SOURCE" :DIRECTORY '("MAXIMA"))
  28   (MT::REWIND)
  29   (MT::UNLOAD))
  30
  31 ;;eval the logical defs above first!
  32
  33 #+ti
  34 (defun dump-macsyma (&optional (sources t) verify &aux (fs:character-file-types
  35                                                          (append '("ERR" "MAC" ) fs:character-file-types
  36                                                          )))
  37    (mt::prepare-tape 6)
  38    (mt::backup-file-named "sys:site;cl-maxima.system")
  39    (mt::write-eof)
  40    (mt::multiple-dump-files "cl-maxima-object:maxima;*.*.0")
  41    (mt::write-eof)
  42    (mt::multiple-dump-files "cl-maxima-patch:patch;*.*.0")
  43    (mt::write-eof)
  44    (mt::multiple-dump-files "maxima-documentation:test;*.*.0")
  45    (mt::write-eof)
  46    (mt::multiple-dump-files "maxima-documentation:maxima;*.*.0")
  47    (mt::write-eof)
  48    (cond (sources
  49           (loop for v in (si:system-source-files 'cl-maxima)
  50                 do (mt::backup-file-named v))))
  51     (mt::backup-file-named "cl-maxima-source:maxima;explorer-changes.lisp")
  52    (mt::multiple-dump-files "cl-maxima-source:maxima;*.mac.0")
  53    (mt::backup-file-named "cl-maxima-source:maxima;cl-maxima-sysdef.lisp.0")
  54    (mt::write-eof)
  55    (mt::rewind)
  56    (with-open-file (st "max:wfs;maxima-part-dump.lst" :out)
  57      (global::print-herald st)
  58      (format st "~2%Listing of dump made on") (time::print-current-time st)
  59      (loop for i below 8 do (format st "~2%Contents of section ~A are:~3%" i)
  60        (cond (verify
  61               (let ((*standard-output* st))
  62                 (format t "~%Compare made with originals:")
  63               (mt::verify-multiple-file )))
  64              (t(mt::list-contents st)
  65            ))))
  66    (mt::rewind)
  67    (mt::unload)
  68    )
  69
  70
  71 ;;;finally here is the actual pointer to the system definition.
  72 ;(si:set-system-source-file "CL-MAXIMA" "cl-maxima-source:maxima;cl-maxima-sysdef.lisp")
  73
  74
  75
  76
  77
  78 (defun verify-sources ()
  79   (with-open-file (st "max:wfs;maxima-part-dump.lst" :out)
  80     (loop for i below 8 do (format st "~2%Contents of section ~A verified are:~3%" i)
  81           (let ((*standard-output* st))
  82             ;; (unless (memq i '(5)) (mt::skip-to-double-eof))
  83             (mt::verify-multiple-file )))
  84     ))
  85
  86
  87 ;;useful for skipping over a set of files,
  88 ;;I don't know what the proper function for this is
  89 mt::
  90 (defun skip-to-double-eof (&optional (times 1))
  91   "skips over a logical set of files separted by double eof, like list-contents and not much faster"
  92   (loop for i below times
  93         with stream
  94         do
  95         (loop do  (SETQ STREAM (MAKE-MT-FILE-STREAM ':DIRECTION ':INPUT ':ERROR NIL ':unit *CURRENT-UNIT*))
  96           (cond ((streamp stream)
  97 ;                (display-file-header stream standard-output)
  98                  (mt::space-to-eof)
  99                  (send stream :close :raw))
 100                 (t (return 'done))))))
 101