mroz@moose.steinmetz (Mroz) (07/18/87)
[-----------------eat me------------------------------------------------------]
Attention VMS hackers!! Pseudo "synchronous" subprocess communication
functions for GNU Emacs attached. I wrote these routines to interface
to several subprocesses, each running DCL or application programs.
There are some bugs in it which can be avoided, but if anyone knows
why I'm crashing emacs I would appreciate any help.
If someone wants to do something useful with this code, you could
write the equivalent for the DIRED function for VMS using these
routines. I've always wanted to do it but haven't had the time.
The new functions provide "synchronous" subprocess communication to
several DCL subprocesses. The code for HANDSHAKE.EL is attached.
This code relies on the issuance of a prompt when the subprocess is
ready to read input again. Because the current VMS subprocess
functions don't send back the "$" prompt and because we don't have the
pseudoterminal stuff written for VMS (yet), I wrote a little command
procedure called CMD.COM that writes a fake prompt out when it's done
executing commands.
HANDSHAKE.EL has a lisp function that is called as an AST when there's
input in it's mailbox. That AST function, called HANDSHAKE-INPUT,
checks the input to see if it's the prompt character. If it is, it
calls either an internal hook or the user's "done-hook". The internal
hook works fine (merely issues the next command to the dcl
subprocess), but sometimes the done-hook bombs emacs. I've been able
to identify several ways to get emacs to bomb with this code:
1. If the done-hook writes a buffer to a file
2. If the done-hook has a lisp error
I'm not sure what I'm stomping on, but following are all of the pieces
needed to demonstrate the bug. The lisp code in TESTHAND.EL
demonstrates both a working and non-working HANDSHAKE.EL. When it
bombs it puts you into the VAX debugger.
If anyone knows what the bug is I would appreciate hearing from you.
The nearest I can figure it is that when an error occurs the "state"
of the emacs command loop is wait_for_kbd_input. All of the file i/o
functions check this variable. If it's false that must mean it's
interpreting lisp code. If it's true it signals the error routines
and invokes the debugger.
Thanks for your help
Peter Mroz
General Electric | ARPA: mroz@ge-crd.arpa
Corporate Research and Development | UUCP: mroz@moose.steinmetz.ge.com
PO Box 8, 37-2001
Schenectady, NY 12301
518-387-6021
-------------------------------------------------------------------------------
CMD.COM looks like this:
$! cmd.com : acts like a shell, provides prompt for process handshaking
$! via emacs
$ set noon
$ 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8'
$ write sys$output "$>"
To use CMD.COM you must have a symbol pointing to it something like this:
$ CMD :== "@usr$disk1:[mroz.mead]cmd"
All that CMD.COM does is sends out your command to DCL. When it's done it
spits out it's prompt "$>". Here's an example of using it:
-------example-------example-------example-------example-------example-------
$ cmd dir *.dat
Directory USR$DISK1:[MROZ.MEAD]
CUBIC.DAT;2 FOR106.DAT;16 MDLIN1.DAT;12 MDLIN2.DAT;9
MEADDIR.DAT;3 MENU.DAT;10 PRM60.DAT;1 REALMENU.DAT;4
SIMOUT.DAT;1 TAGPRO.DAT;1 TH.DAT;3 TH01627.DAT;1
TOPLINE.DAT;2
Total of 13 files.
$>
-------example-------example-------example-------example-------example-------
I've got a small lisp example that runs the handshaking routines. One
function, called TESTHAND-OK works, while the other function, called
TESTHAND-NOT-OK, causes GNU Emacs to enter the VAX debugger.
Following is the file TESTHAND.EL:
--------testhand.el--------testhand.el------testhand.el------testhand.el------
(defun testhand-ok ()
"tests out bugs in the handshaking routine - this version works"
(interactive)
(handshake-command '91 '("dir *.dat" "dir *.el") 'ok-im-done "$>"))
(defun testhand-not-ok ()
"tests out bugs in the handshaking routine - this version causes gnu emacs
to pop into the VAX debugger"
(interactive)
(handshake-command '91 '("dir *.dat" "dir *.el") 'not-ok-im-done "$>"))
(defun not-ok-im-done ()
"Collects output in the subprocess buffer and stores it in a file"
(let ((old-buffer (current-buffer))
(bufname "*HANDSHAKE91*")
(prompt "$>")
(save-file (concat default-directory "test.dat")))
; Go into the process buffer and grab some results
(set-buffer bufname)
(search-backward prompt (point-min) t)
(search-backward prompt (point-min) t)
(copy-region-as-kill (point) (point-max))
(setq store-buf (find-file-noselect save-file))
(set-buffer store-buf)
(yank)
(save-buffer)
; Finally, bounce back to the previous buffer
(set-buffer old-buffer)
(message "ok im done")))
(defun ok-im-done ()
(message "ok im done"))
-------testhand.el-------testhand.el-------testhand.el-------testhand.el-------
Following is the sequence of events necessary to get GNU Emacs to
fail. This is on VMS version 4.5. I've indented emacs response
messages by a tab.
-----commands-----commands-----commands-----commands-----commands-----commands-
$ emacs
M-x emacs-version
GNU Emacs 18.41.2 of Fri Jun 5 1987 on ISOVAX (vax-vms)
Find file: usr$disk1:[mroz.mead.debug]testhand.el
M-x eval-current-buffer
M-x Load file: usr$disk1:[mroz.mead.debug]handshake.el
Loading usr$disk1:[mroz.mead.debug]handshake.el...done
M-x testhand-ok
Creating subprocess...done
Executing commands.done
ok im done
M-x testhand-not-ok
Executing commands.done
Mark set
Wrote usr$disk1:[mroz.mead.debug]test.dat
-----commands-----commands-----commands-----commands-----commands-----commands-
Following the last message saying that it wrote the file, emacs pops into the
VAX debugger. I did a SHOW CALLS and got the following traceback:
------traceback------traceback------traceback------traceback------traceback----
VAX DEBUG Version V4.5-6
%DEBUG-I-NOGLOBALS, some or all global symbols not accessible
%DEBUG-I-INITIAL, language is C, module set to 'SYSDEP'
%DEBUG-W-SRCLINNOT, source lines not available for module 'SYSDEP'
DBG> sh calls
module name routine name line rel PC abs PC
*SYSDEP sys_abort 6459 00000018 0003B669
*EVAL Fsignal 2545 00000041 0004F16B
*FILEIO report_file_error 3158 00000082 0003FD6B
*FILEIO Fdelete_file 4074 0000006F 00040C2B
*EVAL Ffuncall 3199 0000026B 00050123
*BYTECODE Fbyte_code 1941 0000042B 00058175
*EVAL Feval 2916 00000419 0004FB07
*EVAL Fcondition_case 2481 00000179 0004F085
*BYTECODE Fbyte_code 2038 000007A1 000584EB
*EVAL Feval 2916 00000419 0004FB07
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL funcall_lambda 3337 0000018F 0005055D
*EVAL Ffuncall 3227 00000354 0005020C
*BYTECODE Fbyte_code 1941 0000042B 00058175
*EVAL Feval 2916 00000419 0004FB07
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL funcall_lambda 3337 0000018F 0005055D
*EVAL Ffuncall 3227 00000354 0005020C
*BYTECODE Fbyte_code 1941 0000042B 00058175
*EVAL Feval 2916 00000419 0004FB07
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL funcall_lambda 3337 0000018F 0005055D
*EVAL apply_lambda 3281 000000E1 0005038F
*EVAL Feval 2941 00000519 0004FC07
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL Flet 2184 00000175 0004EAF4
*EVAL Feval 2856 00000244 0004F932
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL funcall_lambda 3337 0000018F 0005055D
*EVAL Ffuncall 3227 00000354 0005020C
*EVAL Feval 2883 00000304 0004F9F2
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL Feval 2856 00000244 0004F932
*EVAL Fif 1761 00000059 0004E1AE
*EVAL Feval 2856 00000244 0004F932
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL Flet 2184 00000175 0004EAF4
*EVAL Feval 2856 00000244 0004F932
*EVAL Fprogn 1826 000000E2 0004E337
*EVAL funcall_lambda 3337 0000018F 0005055D
*EVAL apply_lambda 3281 000000E1 0005038F
*EVAL Feval 2941 00000519 0004FC07
*VMSFNS process_mbx_input 4219 000000AE 00059EAA
*VMSFNS process_command_input 4183 0000008F 00059DFB
*SYSDEP wait_for_kbd_input 5809 00000081 0003B12E
*KEYBOARD kbd_buffer_get_char 3176 00000065 00037D48
*KEYBOARD get_char 3028 00000193 00037AB8
*KEYBOARD read_key_sequence 3463 0000006A 00037E25
*KEYBOARD command_loop_1 2781 000000E9 0003762A
*EVAL internal_condition_case 2515 00000093 0004F121
*KEYBOARD command_loop_2 2665 00000028 0003744C
*EVAL internal_catch 2333 00000063 0004EDC0
*KEYBOARD command_loop 2650 00000053 00037422
*KEYBOARD Frecursive_edit 2538 0000009A 000371B2
*EMACS main 2526 00000403 00036DA4
DBG> Exit
[Attached to DCL in directory USR$DISK1:[MROZ.MEAD.DEBUG]]
$
------traceback------traceback------traceback------traceback------traceback----
Finally, here's the code for HANDSHAKE.EL:
-----------handshake.el-----------handshake.el-----------handshake.el----------
;; HANDSHAKE.EL: DCL subprocesses with handshaking.
;; Copyright (C) 1986 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;; 4/28/87 Peter Mroz
;; These functions are used to send commands to a DCL subprocess, one at
;; a time. That is, it "waits" until it's done with the first command
;; before attempting to pass on the next command. These functions are needed
;; for cases where emacs has to wait until DCL does something before it can
;; do anything. For example, if I issue the CMS command
;; $ cms get filename
;; with the send-command-to-subprocess function it will return immediately,
;; whether or not cms got the file. So... if I wanted to bring that particular
;; file into an emacs buffer I would be hosed.
;; These routines work by using hooks. The subprocess-input function is an
;; ast, so when it detects the prompt it runs a completion hook.
;; The HANDSHAKE-COMMAND routine must be called as the LAST lisp function
;; in your code. Your program must "die", and be woken up by the DONE-HOOK
;; One final note: the current subprocess functions do not produce the current
;; VMS prompt ("$ " or whatever has been set by the user), so to get around
;; that I've got a little command procedure called CMD.COM. THIS SYMBOL
;; MUST BE DEFINED PRIOR TO RUNNING EMACS. Here's cmd.com:
;; $! cmd.com : acts like a shell, provides a prompt for process handshaking
;; $! via emacs
;; $ 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8'
;; $ write sys$output "$>"
;; This symbol should be defined something like this
;; $ cmd :== "@usr$disk1:[mroz.mead]cmd"
;; Revision 5/13/87 Peter Mroz
;; Made the cmd portion a variable, in case you want to interact with a program
;; that has it's own prompt. If the variable handshake-cmd-prefix is nil it
;; is expected that the caller has redefined handshake prompt to that of their
;; application program.
;; Revision 5/29/87 Peter Mroz
;; Made all subprocess variables a list, so multiple subprocesses can be
;; created and accessed. Very similar to MYVMSPROC.EL. Only one subprocess
;; can be using these functions at a time, although more than one subprocess
;; can be alive.
;; Revision 6/8/87 Peter Mroz
;; handshake-command now called with the prompt expected of the subprocess
;; package.
;******************************************************************************
; *** Declare global variables ***
(defvar final-hook nil
"Last hook to be called; should start up caller's function")
(defvar in-between-hook 'in-between-hook
"Function to call when done - invokes user's final-hook function")
(defvar default-hook 'imdone
"Default hook to call in case none was defined by the user")
(defvar handshake-running nil
"list of identifying integers for existing dcl handshake processes")
(defvar handshake-prompt nil
"Handshake prompt as defined in CMD.COM or in application program")
(defvar default-prompt "$>"
"Default handshake prompt as defined in CMD.COM")
(defvar handshake-cmd-prefix "cmd "
"List of prefixes for all commands going to the handshaking subprocess")
(defvar handshake-bufnames nil
"List of buffer names for the handshaking subprocesses")
(defvar handshake-hook nil
"Function to be called after a command has been executed")
(defvar handshake-list nil
"Set of commands being issued to the dcl subprocess")
(defvar handshake-pid nil
"Identifying integer for the current handshaking subprocess")
(defvar handshake-mode-map nil)
(defvar handshake-message nil
"Message to be displayed as commands are executed")
;******************************************************************************
; Set up keys for handshake buffer
(if handshake-mode-map
nil
(setq handshake-mode-map (make-sparse-keymap))
(define-key handshake-mode-map "\C-m" 'handshake-send-input)
(define-key handshake-mode-map "\C-u" 'handshake-kill-line))
;******************************************************************************
(defun handshake-input (pid str)
"Handles input from a handshaking subprocess. Called by Emacs."
(let ((old-buffer (current-buffer))
(bufname
(get-handshake-buffer pid handshake-running handshake-bufnames)))
(set-buffer bufname)
(goto-char (point-max))
(insert str)
(insert ?\n)
(set-buffer old-buffer)
; If the string from the subprocess is the prompt call the hook
(if (string= str handshake-prompt)
(progn
(message handshake-message)
(funcall handshake-hook)))))
;******************************************************************************
(defun handshake-exit (pid)
"Called by Emacs upon handshaking subprocess exit."
(let ((tmp handshake-running))
(setq handshake-running (delete-member pid handshake-running))
(setq handshake-bufnames
(delete-member
(get-handshake-buffer pid tmp handshake-bufnames)
handshake-bufnames))))
;******************************************************************************
(defun start-handshake (pid)
"Spawns an asynchronous subprocess with output redirected to the
handshake-buffer *HANDSHAKEn*. The value of n is given by pid.
Within this buffer, use C-m to send the last line to the subprocess or
to bring another line to the end."
(if (or (memq pid handshake-running)
(if (and subprocess-running (listp subprocess-running))
(memq pid subprocess-running)))
t
;else start up a new subprocess
(let ((bufname (make-handshake-bufname pid)))
(save-excursion
(get-buffer-create bufname)
(set-buffer bufname)
(use-local-map handshake-mode-map))
; ; Make sure we don't interfere with an already existing subprocess
; (while (memq handshake-pid subprocess-running)
; (setq handshake-pid (+ 1 handshake-pid)))
(if (spawn-subprocess pid 'handshake-input 'handshake-exit)
(progn
;;; (setq handshake-running t)
(setq handshake-running (append handshake-running (list pid)))
(setq handshake-bufnames
(append handshake-bufnames (list bufname)))
;; Initialize subprocess so it doesn't panic and die upon
;; encountering the first error.
(send-command-to-subprocess
pid "ON SEVERE_ERROR THEN CONTINUE"))))))
;******************************************************************************
(defun handshake-command (pid cmd-list done-hook &optional prompt)
"Starts up a subprocess using identifying integer PID. Sends the list
of commands in CMD-LIST to the subprocess. When all done, calls
DONE-HOOK. If DONE-HOOK is NIL, uses DEFAULT-HOOK. Initiates the
call to do-the-handshake, which does the actual dirty work."
(if done-hook
(setq final-hook done-hook)
; else
(setq final-hook default-hook))
(setq handshake-message "Executing commands")
(setq handshake-pid pid)
(setq handshake-list cmd-list)
(if prompt
(setq handshake-prompt prompt)
(setq handshake-prompt default-prompt))
(if (not (memq pid handshake-running))
(start-handshake pid))
; All set - let 'er rip
(do-the-handshake))
;******************************************************************************
(defun do-the-handshake ()
"Sends the set of commands in the global handshake-list to the
handshaking dcl subprocess, waiting for each one to complete before
continuing with the next one. Calls final-hook when all commands have
been completed"
(let ((curcmd (car handshake-list)))
(if (cdr handshake-list)
(progn
(setq handshake-hook 'do-the-handshake)
(setq handshake-list (cdr handshake-list))
(setq handshake-message (concat handshake-message ".")))
; Otherwise this is the last command
(setq handshake-hook final-hook)
;;; (setq handshake-hook in-between-hook)
(setq handshake-message (concat handshake-message "done")))
; Determine the name of the buffer
(set-buffer
(get-handshake-buffer handshake-pid handshake-running handshake-bufnames))
(goto-char (point-max))
(insert (concat handshake-cmd-prefix curcmd))
(handshake-send-input)))
;******************************************************************************
(defun handshake-send-input ()
"If at last line of buffer, sends the current line to the spawned
subprocess. Otherwise brings back current line to the last line for
resubmission."
(interactive)
(beginning-of-line)
(let ((current-line (buffer-substring (point)
(progn (end-of-line) (point))))
(pid (get-handshake-pid (buffer-name))))
(if (memq pid handshake-running)
(progn
(if (eobp)
(progn
(beginning-of-line)
(send-command-to-subprocess pid current-line)
(next-line '1))
;; else -- if not at last line in buffer
(end-of-buffer)
(insert current-line))))))
;******************************************************************************
(defun handshake-kill-line ()
"Kills the current line. Used in handshake mode."
(interactive)
(beginning-of-line)
(kill-line))
;******************************************************************************
(defun imdone ()
"Default function called when done handshaking."
(message "OK done handshaking"))
;******************************************************************************
(defun get-handshake-pid (bufname)
"Gets the integer pid associated with the buffer named bufname. The buffer
name is of the form *HANDSHAKEn*, where n is the pid to be extracted"
(string-to-int (substring bufname '10 (- (length bufname) 1))))
;******************************************************************************
(defun get-handshake-buffer (pid a b)
"Matches the pid in the list a to the corresponding buffer name in
the list b"
(let ((n (position pid a)))
(if n
(nth n b)
nil)))
;******************************************************************************
(defun delete-member (a alist)
"Deletes the member a from the list alist. If a is not found, simply returns
alist"
(let (blist) ; list to return
(while alist
(progn
(if (not (eq a (car alist)))
(setq blist (append blist (list (car alist)))))
(setq alist (cdr alist))))
blist))
;******************************************************************************
(defun position (a b)
"Returns the position of a in the list b as an integer. The
position of the first element in b is 0"
(let (tmp)
(setq tmp (member a b))
(if tmp
(- (length b) (length tmp))
nil)))
;******************************************************************************
(defun make-handshake-bufname (pid)
"Creates the handshake buffer name *HANDSHAKEn*, where n is replaced by
PID"
(concat "*HANDSHAKE" (prin1-to-string pid) "*"))
;******************************************************************************
(defun in-between-hook ()
(read-string "Hit <cR> to continue")
(funcall final-hook))
-----------handshake.el-----------handshake.el-----------handshake.el----------
Peter Mroz
General Electric | ARPA: mroz@ge-crd.arpa
Corporate Research and Development | UUCP: mroz@moose.steinmetz.ge.com
PO Box 8, 37-2001
Schenectady, NY 12301
518-387-6021