home *** CD-ROM | disk | FTP | other *** search
/ vis-ftp.cs.umass.edu / vis-ftp.cs.umass.edu.tar / vis-ftp.cs.umass.edu / pub / Software / ASCENDER / ascendMar8.tar / UMass / ISR / old-isr2-test-load.lisp < prev    next >
Lisp/Scheme  |  1995-04-11  |  4KB  |  119 lines
  1. ;;; -*- Mode:Common-Lisp; Package:USER;  Base:10 -*-
  2.  
  3. (unwind-protect
  4.   (net:set-logical-host 'nanovax 'julius)
  5.  
  6.   (unwind-protect
  7.     (net:add-logical-pathname-host
  8.       'nanovax 'julius 
  9.       '((maind "vis7$disk:[heller]")
  10.     (procsd "vis7$disk:[heller.procs]")
  11.     (hairyhackd "vis7$disk:[heller.hairyhack]")
  12.     (mld "vis7$disk:[heller.ml]")
  13.     (tempd "vis7$disk:[heller.temp]")
  14.     (llvsd "vis7$disk:[heller.llvs]")
  15.     (llvs_isr2-lispd "vis7$disk:[heller.llvs.isr2-lisp]")
  16.     (isr2test "vis7$disk:[heller.llvs.isr2-lisp]")
  17.     (isr2system "vis7$disk:[heller.llvs.isr2-lisp.stable]")
  18.     (llvs_uis_deviced "vis7$disk:[heller.llvs.uis_device]")
  19.     (llvs_vs-lispm-windowd "vis7$disk:[heller.llvs.vs-lispm-window]")
  20.     ) "vis7$disk:")
  21.     nil)
  22.   )
  23.  
  24. (unless (find-package 'isr2) (make-package 'isr2))
  25. (unless (find-package 'isr) (make-package 'isr))
  26. (unless (fboundp 'user::cdefvar)
  27.   (defmacro cdefvar (variable &optional (initial-value nil) (docstring nil))
  28.   "do defvar unless variable is already bound" 
  29.   ;;-- Bob Collins 5/20
  30.   ;;john brolio 1/7/88 -- to get rid of unspecial variable problem in compiling
  31.   `(eval-when (compile eval load)
  32.      (proclaim '(special ,variable))
  33.      (unless (variable-boundp ,variable)
  34.        (setf ,variable ,initial-value)
  35.        (setf (documentation ',variable 'variable) ,docstring)))))
  36.  
  37.  
  38. (defun format-date-time (stream second minute hour date month year day-of-week 
  39.                 dst-p tz)
  40.   (declare (ignore dst-p tz))
  41.   (format stream "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~] ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d,~d ~2,'0d:~2,'0d:~2,'0d"
  42.       day-of-week (1- month) date year hour minute second)
  43.   )
  44.  
  45. (proclaim '(special isr2::*version*))
  46.  
  47. (defun re-load-isr2-system (&key (reload t) &aux (inhibit-fdefine-warnings t))
  48.   (format t "~2&;; Answer 'yes' or 'proceed' to any of the questions asked below.")
  49.  
  50.   (make-system 'user::isr2 (if reload :reload :noop))
  51.  
  52.   (format t "~2&;;")
  53.   (format t "~&;; ISR2, Release B1.8 of ~A"
  54.       (multiple-value-call
  55.         #'format-date-time
  56.         nil
  57.         (decode-universal-time 
  58.           (file-write-date
  59.         "nanovax:isr2test;isr2-test-load.lisp")))
  60.       )
  61.   (format t "~&;; Questions, Problems, etc. - Send mail to COINS::HELLER")
  62.   (format t "~&;; (The system can be re-made by calling the function ")
  63.   (format t "~&;; user::re-load-isr2-system.")
  64.   (format t "~&;;~2&")
  65.  
  66.   (setf isr2::*version* 'B1.8)
  67.   (pushnew :isr2 *features*)
  68.   (values 'isr2 'B1.8)
  69.   )
  70.  
  71.  
  72. (defparameter *nanonodes*
  73.           '(julius ardana argus deneva iotia janus kelva pyris scalos yonada))
  74.  
  75. (prog (temp errorp)
  76.  
  77.   (setf temp (cons nil *nanonodes*)
  78.     errorp t)
  79.  
  80. :Try_another_node
  81.  
  82.   (setf temp (rest temp))
  83.  
  84.   (when (null temp) 
  85.     (format t "~&Huh?  All of the VIS:: VAXen seem to be having trouble.  I give up!")
  86.     (return nil))
  87.  
  88.   (unwind-protect
  89.     (progn
  90.       (unwind-protect
  91.     (net:set-logical-host 'nanovax (first temp))
  92.  
  93.     (unwind-protect
  94.       (net:add-logical-pathname-host
  95.         'nanovax (first temp)
  96.         '((maind "vis7$disk:[heller]")
  97.           (procsd "vis7$disk:[heller.procs]")
  98.           (hairyhackd "vis7$disk:[heller.hairyhack]")
  99.           (mld "vis7$disk:[heller.ml]")
  100.           (tempd "vis7$disk:[heller.temp]")
  101.           (llvsd "vis7$disk:[heller.llvs]")
  102.           (llvs_isr2-lispd "vis7$disk:[heller.llvs.isr2-lisp]")
  103.           (isr2test "vis7$disk:[heller.llvs.isr2-lisp]")
  104.           (isr2system "vis7$disk:[heller.llvs.isr2-lisp.stable]")
  105.           (llvs_uis_deviced "vis7$disk:[heller.llvs.uis_device]")
  106.           (llvs_vs-lispm-windowd "vis7$disk:[heller.llvs.vs-lispm-window]")
  107.           ) "vis7$disk:")
  108.       nil)
  109.     )
  110.       (load "nanovax:isr2test;isr2-defsystem" :verbose nil)
  111.  
  112.       (re-load-isr2-system :reload t)
  113.       
  114.       (setf errorp nil))
  115.     (when errorp (go :Try_Another_node)))
  116.   (return t)
  117.   )
  118.  
  119.