archive/share/trash/batch.mac

   1 ;;;-*-LISP-*-
   2
   3 ;;; functions to aid in running a macsyma background job.
   4 (eval-when (eval compile)
   5            (or (status feature iota) (load '|liblsp;iota fasl|)))
   6
   7
   8 (DEFUN $SLEEP (&OPTIONAL (SEC '|no arg/||) (MINUTES 0) (HOURS 0))
   9        (COND ((EQ SEC '|no arg/||)
  10               (ERLIST1 '|
  11 SLEEP(SECONDS,MINUTES,HOURS), where MINUTES and HOURS
  12 are optional arguments. SLEEP for that much wall clock time.|))
  13              (T
  14               (SLEEP (PLUS SEC (TIMES 60. (PLUS MINUTES (TIMES 60. HOURS)))))
  15               '$AWAKE)))
  16
  17 (SSTATUS CLI T)
  18
  19 (DEFUN CLI-SEND-FORMS (UNAME JNAME request &REST FORMS)
  20        (IOTA ((F `((CLI *) ,UNAME ,JNAME) '(OUT)))
  21              (TERPRI F)
  22              (PRINT (LIST REQUEST (STATUS UNAME) (STATUS JNAME)) F)
  23              (COND (FORMS
  24                     (MAPCAR '(LAMBDA (U) (PRINT U F)) FORMS)))))
  25
  26
  27
  28 (DEFUN CLI-interrupt-HANDLER (&REST ARGS &AUX uname jname request FORMS)
  29        (NOINTERRUPT NIL)
  30        (IOTA ((CLA '((CLA)) '(CLA)))
  31              (READLINE CLA) ;;; Sixbit cruft.
  32              (SETQ request (READ CLA)
  33                    uname (cadr request)
  34                    jname (caddr request)
  35                    request (car request)
  36                    FORMS NIL)
  37              (DO ((FORM (READ CLA '*EOF*)
  38                         (READ CLA '*EOF*)))
  39                  ((EQ FORM '*EOF*)
  40                   (setq forms (reverse forms)))
  41                  (SETQ FORMS (CONS FORM FORMS))))
  42        (COND ((EQ REQUEST 'EVAL)
  43               (MAPCAR 'EVAL FORMS))
  44              ((EQ REQUEST 'EVAL-RETURN)
  45               (APPLY 'CLI-SEND-FORMS `(,UNAME ,JNAME RETURN
  46                                               ,@(MAPCAR 'EVAL FORMS))))
  47              ((EQ REQUEST 'EVAL-PRINT)
  48               (APPLY 'CLI-SEND-FORMS
  49                      `(,UNAME ,JNAME PRINT ,@(MAPCAR 'EVAL FORMS))))
  50              ((EQ REQUEST 'RETURN)
  51               (*throw 'cli-return-throw forms)   ;;; can have sync problems.
  52              ((EQ REQUEST 'PRINT)
  53               (MAPCAR 'PRINT FORMS)))))
  54
  55
  56
  57 (SETQ CLI-MESSAGE 'CLI-INTERRUPT-HANDLER)
  58
  59 (defun cli-eval-form (jname uname form &aux ret)
  60        (cli-send-forms jname uname 'eval-return form)
  61        (setq ret (*catch 'cli-return-throw (sleep (* 60. 60. 10.)) ; 10. hours?
  62                          '*no*return*))
  63        (cond ((eq ret '*no*return*) ret)
  64              (t (car ret))))
  65
  66 (defun cli-print-form (jname uname form)
  67        (cli-send-forms jname uname 'print form))
  68
  69 (defun $REMOTE%DEBUG (&aux uname jname)
  70        (terpri tyo)
  71        (setq uname
  72              (stripdollar (retrieve '|What user name does the macsyma have?|
  73                                     nil))
  74              jname
  75              (stripdollar (retrieve '|What is its job name?| nil)))
  76        (terpri tyo)
  77        (princ '|Enter expessions and wait for reply from remote job.| tyo)
  78        (terpri tyo)
  79        (do ((form (retrieve '|Expression to send or EXIT| nil)
  80                   (retrieve '|Expression to send or EXIT| nil)))
  81            ((eq form '$exit) '$done)
  82            (setq $REMOTE (cli-eval-form uname jname
  83                                         `((lambda (u)
  84                                                   (cond ((null u)
  85                                                          '$SOME-ERROR)
  86                                                         (t (car u))))
  87                                           (errset (meval ',form) nil))))
  88            (displa `((mlable) $REMOTE ,$REMOTE))))
  89
  90 (DEFUN $DISOWN ()
  91        (setq $dynamalloc t
  92              ^W t) ;;; ^W , what a crock oldio.
  93        (valret '|:PROCEED
  94 :DISOWN
  95 |))
  96
  97 (defun $alarm_off () (alarmclock 'time -1))
  98 (defun $alarm_exp fexpr (L)
  99        (let (((expr time) l))
 100             (setq time (meval time))
 101             (cond ((not (numberp time)) (erlist '|non-numeric time|))
 102                   ((lessp time 0.01) (erlist '|Time is in minutes, I don't like it less than 0.01|)))
 103             (setq alarmclock
 104                   `(lambda (u)
 105                            (meval1 ',expr)
 106                            (alarmclock 'time ,time)))
 107             '$|O.K.|))