|
|
|
My C-based, xqt_util
package provides portable,
more generalized access to a UNIX shell or VMS
DCL subprocess than does the dusty FORTRAN
module described in this article.
system() function. Why not VMS?
Such a capability has many uses, ranging from the seemingly simple task of copying a file (e.g., an editor making a backup file) to the more complex task of compiling and linking a program (e.g., make). In the former case, you could write a subroutine to read and write a limited number of file types. In the latter case, your only choice was to write the compile and link commands to a temporary file and submit a batch job to VMS.
Fortunately, there's an easier way that's actually superior to the methods
used on other operating systems. Spawn a Command Language Interpreter (CLI)
subprocess and connect its SYS$INPUT and SYS$OUTPUT
channels to mailboxes that you can read and write. Now, your program can
issue DCL commands to its heart's content, writing the commands to the CLI's
SYS$INPUT mailbox and reading any responses from the CLI's
SYS$OUTPUT mailbox (see Figure 1).
UNIX, probably like other operating systems, forks a new process
for each system() call you make to execute a UNIX shell command.
Consequently, a command executes with no knowledge of prior commands
and will have no effect on future commands. The VMS CLI subprocess
approach, on the other hand, allows all your DCL commands to execute
within the context of a single process. You can use any of the normal
DCL means of modifying the CLI's environment: changing directories,
defining symbols and logical names, etc.
EXECUTE_DCL is a function that
provides a program with simple, one-subroutine access to VMS DCL. The
program makes one call to EXECUTE_DCL for each DCL command to
be executed:
I/O_status = EXECUTE_DCL (command, [max_lines],
result, [num_lines], DCL_status)
EXECUTE_DCL's function value returns the status of the VMS system
services used for CLI process creation and mailbox I/O operations.
The DCL command's output is stored in a user-defined array of strings,
result, and the command's completion status is returned in the last
argument, DCL_status.
A make program, for example, might compile a source file as follows:
...
INTEGER*4 execute_dcl ! External function.
CHARACTER command*256, result*132, source_file*256
INTEGER*4 dcl_status, status
...
command = 'FORTRAN/DEBUG ' // source_file
status = execute_dcl (command, , result, , dcl_status)
...
EXECUTE_DCL, of course.
EXECUTE_DCL is responsible for initially creating the CLI
subprocess and its mailboxes, writing to and reading from the mailboxes,
and re-creating the CLI subprocess should it go down. The subprogram is
fairly straightforward, however. The calling program's process ID is used
to construct unique names for the CLI subprocess and its mailboxes; the
mailboxes are then created and the CLI subprocess is spawned. An
asynchronous trap (AST) routine detects the
untimely demise of the CLI.
READMBX and
WRITEMBX handle the mailbox
communications. These routines, general-purpose subroutines in their own
right, provide a high-level interface to the VMS mailbox system services.
They automatically create mailboxes and/or assign channels and perform the
QIO's necessary for the actual I/O.
Two interesting problems arose when implementing EXECUTE_DCL.
First, EXECUTE_DCL sends a DCL command to the CLI's input
mailbox and then waits on the CLI's output mailbox for the DCL output. How
do you know when a DCL command completes? Commands such as logical name
definitions generate no response; directory listings may produce many lines
of output. Don't expect a dollar-sign prompt for the next command to
conveniently appear in the CLI's output mailbox! Second, how do you
determine the completion status of a DCL command?
The solution to the latter problem solves both problems. The CLI updates
symbol $STATUS with the completion status of executed
commands. DCL command SHOW SYMBOL $STATUS displays the
symbol's value on SYS$OUTPUT (i.e., the CLI output mailbox) in
the form, $STATUS = %Xvalue. Not only does this
status message supply command completion status, it can also act as a
synchronizization flag between EXECUTE_DCL and the CLI
subprocess.
Each command sent to the CLI subprocess by EXECUTE_DCL is
followed by SHOW SYMBOL $STATUS. EXECUTE_DCL
then reads and stores the CLI output until $STATUS = ... is
received. The completion status is decoded and returned to the calling
program, along with the original command's output. The exchanges resulting
from a single call to EXECUTE_DCL to get a directory listing
appear in Figure 2 (the ON SEVERE ERROR
statement prevents CLI termination if an error occurs).
EXECUTE_DCL now allows you to merge the power of DCL into your
programs. As a matter of fact, if Mr. Stevens-Rayburn gets strapped
for time in his quest for a complete set of callable DCL lexicals, he
can always code up simple, albeit slow, "emulations" of the missing
functions using the real DCL lexicals!
C**************************************************************************
INTEGER*4 FUNCTION execute_dcl (command, max_lines, result,
+ num_lines, dcl_status)
C**************************************************************************
C
C Subroutine EXECUTE_DCL executes a DCL command.
C
C Arguments:
C
C COMMAND (Character)
C The DCL command to be executed.
C
C MAX_LINES (Integer)
C The maximum number of lines that should be returned.
C If this argument is null, then at most 1 line will
C be returned.
C
C RESULT (Array of Character)
C Returns the output from the Command Language
C Interpreter (CLI). At most MAX_LINES will be
C returned; the actual number of lines returned
C is stored in NUM_LINES.
C
C NUM_LINES (Integer)
C Returns the number of result lines being returned to
C the caller. This argument may be null.
C
C DCL_STATUS (Integer)
C Returns the VAX/VMS status of the DCL command
C execution.
C
C EXECUTE_DCL (Function Value)
C Returns the status of creating/assigning the CLI
C input/output mailboxes, spawning the CLI subprocess,
C or sending/receiving mailbox messages.
C
C**************************************************************************
IMPLICIT NONE
C... Parameters and external definitions.
INCLUDE '($CLIDEF)' ! Command language interface definitions -
! defines the offset values for structures
! used to communicate information to CLI.
INCLUDE '($JPIDEF)' ! Job/process information request type codes.
INCLUDE '($SSDEF)' ! System service failure and status codes.
PARAMETER p_error_command = 'ON SEVERE_ERROR THEN CONTINUE'
PARAMETER p_status_command = 'SHOW SYMBOL $STATUS'
INTEGER*4 LIB$GETJPI, LIB$SPAWN ! External routines.
EXTERNAL cli_completion_ast
C... Subroutine arguments.
CHARACTER*(*) command
INTEGER*4 max_lines
CHARACTER*(*) result(*)
INTEGER*4 num_lines
INTEGER*4 dcl_status
C... Local variables.
CHARACTER process_id*8, process_name*12
CHARACTER input_mailbox*32, output_mailbox*32
CHARACTER text*256
INTEGER*4 i, ierr, l_max_lines, length, status
LOGICAL done
INTEGER*4 cli_status
INTEGER*4 in_chan /0/
INTEGER*4 out_chan /0/
LOGICAL cli_subprocess_active /.FALSE./
SAVE cli_status, in_chan, out_chan, cli_subprocess_active
dcl_status = SS$_NORMAL ! Assume no errors.
status = SS$_NORMAL
l_max_lines = 1
IF (%LOC(max_lines) .NE. 0) THEN
l_max_lines = MAX (max_lines, 1)
ENDIF
IF (%LOC(num_lines) .NE. 0) num_lines = 0 ! No result lines yet.
C... If the CLI subprocess is not active (not created yet or
C terminated), then create a new CLI subprocess. First, get
C the process ID (used for naming the CLI subprocess and its
C mailboxes). Second, delete and (re-)create the CLI input
C and output mailboxes (outstanding messages in old mailboxes
C could skew the command/result protocol synchronization).
C Finally, spawn the CLI subprocess.
IF (.NOT. cli_subprocess_active) THEN
status = LIB$GETJPI (JPI$_PID, , , , process_id, length)
IF (.NOT. status) GOTO 90
CALL SYS$DASSGN (%VAL(in_chan))
in_chan = 0
input_mailbox = 'CLI_INPUT_MBX_' // process_id
CALL writembx (input_mailbox, in_chan, 256, , , -1, status)
IF (.NOT. status) GOTO 90
CALL SYS$DASSGN (%VAL(out_chan))
out_chan = 0
output_mailbox = 'CLI_OUTPUT_MBX_' // process_id
CALL writembx (output_mailbox, out_chan, 256, , , -1, status)
IF (.NOT. status) GOTO 90
cli_subprocess_active = .TRUE.
process_name = process_id // '_DCL'
status = LIB$SPAWN ( , input_mailbox, output_mailbox,
+ CLI$M_NOWAIT, process_name, ,
+ cli_status, , cli_completion_ast,
+ cli_subprocess_active)
IF (.NOT. status) THEN
cli_subprocess_active = .FALSE.
GOTO 90
ENDIF
ENDIF
C... Send the command to the CLI subprocess. Actually, three
C commands are sent to the CLI subprocess:
C
C $ ON SEVERE_ERROR THEN CONTINUE
C userCommand
C $ SHOW SYMBOL $STATUS
C
C The "ON error" statement prevents the CLI subprocess from
C aborting because of errors arising during the execution of
C the user command. The output of the "SHOW SYMBOL $STATUS"
C command signals the completion of the user's command and
C provides the completion status of the user's command.
CALL writembx (input_mailbox, in_chan, , , %REF(p_error_command),
+ LEN(p_error_command), status)
IF (.NOT. status) GOTO 90
CALL writembx (input_mailbox, in_chan, , , %REF(command),
+ LEN(command), status)
IF (.NOT. status) GOTO 90
CALL writembx (input_mailbox, in_chan, , , %REF(p_status_command),
+ LEN(p_status_command), status)
IF (.NOT. status) GOTO 90
C... Wait for the user's command to finish executing.
done = .FALSE.
i = 0
DO WHILE ((.NOT. done) .AND. status)
CALL readmbx (output_mailbox, out_chan, , ,
+ %REF(text), LEN(text), length, status)
IF (status) THEN
text = text(1:length)
IF (INDEX (text, '$STATUS =') .GT. 0) done = .TRUE.
IF ((i .LT. l_max_lines) .AND. (.NOT. DONE)) then
i = i + 1
CALL STR$COPY_R (result(i), length, %REF(text))
ENDIF
ENDIF
ENDDO
IF (%LOC(num_lines) .NE. 0) num_lines = i ! # of result lines.
C... Decode the status of the DCL command execution and return
C it to the calling routine.
IF (done) THEN
i = INDEX (text, '%X') + 2
READ (text(i:i+7),'(Z8)',IOSTAT=ierr) dcl_status
ENDIF
90 execute_dcl = status
RETURN
END
C**************************************************************************
C
C Subroutine CLI_COMPLETION_AST, declared when the CLI subprocess
C was created, is automatically invoked when the CLI subprocess
C terminates.
C
C**************************************************************************
SUBROUTINE cli_completion_ast (cli_subprocess_active)
C... Subroutine argument.
LOGICAL cli_subprocess_active
cli_subprocess_active = .FALSE.
RETURN
END
C**************************************************************************
SUBROUTINE readmbx (mailbox_name, iochan, mailbox_size, no_wait,
+ buffer, buffer_length,
+ num_bytes_read, status)
C**************************************************************************
C
C Subroutine READMBX reads the next message in a VAX/VMS mailbox.
C If a channel has not been assigned to the mailbox (IOCHAN = 0),
C then READMBX tries to create the mailbox (if the mailbox already
C exists, VMS simply assigns a channel to it). If NO_WAIT is
C specified, READMBX checks the mailbox for a message and returns
C the message if one is found or returns a status code indicating
C the mailbox is empty. If the caller wants to wait at the mailbox,
C READMBX waits until a message is available in the mailbox and
C then returns that message to the caller.
C
C Arguments:
C
C MAILBOX_NAME (Character)
C The name of the mailbox to be created/assigned.
C
C IOCHAN (Integer*4)
C The channel assigned to the mailbox. If zero, READMBX
C creates and/or assigns a channel to the mailbox and
C returns the channel number in this argument.
C
C MAILBOX_SIZE (Integer*4)
C The maximum message size for this mailbox. This
C argument is only needed when a new mailbox is being
C created (IOCHAN = 0).
C
C NO_WAIT (Logical)
C If TRUE, READMBX checks the mailbox and returns to
C the caller immediately. If a message is available,
C the message is returned to the caller; otherwise,
C a status code indicating an empty mailbox is returned.
C If FALSE or a null argument, READMBX waits until a
C message is available in the mailbox and returns it
C to the caller.
C
C BUFFER (Byte Array)
C A buffer to receive the incoming message.
C
C BUFFER_LENGTH (Integer*4)
C The size of the buffer. If the size is less than
C zero, then no I/O is actually performed (useful
C when you simply want to create the mailbox).
C
C NUM_BYTES_READ (Integer*4)
C Returns the actual length of the received message.
C
C STATUS
C Returns the VAX/VMS status of the mailbox creation
C or assign or of the mailbox read. SS$_ENDOFFILE is
C returned if the mailbox is empty and the caller has
C requested NO_WAIT.
C
C**************************************************************************
IMPLICIT NONE
C... Parameters and external definitions.
INCLUDE '($IODEF)' ! I/O function codes.
INCLUDE '($SSDEF)' ! System service failure and status codes.
INCLUDE '($SYSSRVNAM)' ! VMS system service entry points.
C... Subroutine arguments.
CHARACTER*(*) mailbox_name
INTEGER*4 iochan
INTEGER*4 mailbox_size
LOGICAL no_wait
BYTE buffer(*)
INTEGER*4 buffer_length
INTEGER*4 num_bytes_read
INTEGER*4 status
C... Local variables.
CHARACTER*64 local_mailbox_name
INTEGER*2 length, iosb(4)
INTEGER*4 read_function
status = SS$_NORMAL ! Assume no error.
C... If the mailbox has not yet been created or assigned, do so.
IF (iochan .EQ. 0) THEN
CALL STR$TRIM (local_mailbox_name, mailbox_name, length)
status = SYS$CREMBX ( , iochan, %VAL(mailbox_size), , , ,
+ local_mailbox_name(1:length))
IF (.NOT. status) RETURN
ENDIF
C... Set up the read function code depending on whether the caller
C wants to wait for a message or not.
read_function = IO$_READVBLK
IF (%LOC(no_wait) .NE. 0) THEN
IF (no_wait) read_function = read_function + IO$M_NOW
ENDIF
C... Read a message from the mailbox.
IF (buffer_length .GE. 0) THEN
status = SYS$QIOW ( , %VAL(iochan),
+ %VAL(read_function), iosb, , ,
+ %REF(buffer), %VAL(buffer_length), , , , )
IF (status) status = iosb(1)
IF (status) THEN
num_bytes_read = iosb(2)
ELSE
num_bytes_read = 0
ENDIF
ENDIF
RETURN
END
C**************************************************************************
SUBROUTINE writembx (mailbox_name, iochan, mailbox_size, wait,
+ buffer, buffer_length, status)
C**************************************************************************
C
C Subroutine WRITEMBX writes a message to a VAX/VMS mailbox.
C If a channel has not been assigned to the mailbox (IOCHAN = 0),
C then WRITEMBX tries to create the mailbox (if the mailbox already
C exists, VMS simply assigns a channel to it). If WAIT is
C specified, WRITEMBX writes the message to the mailbox and waits
C until someone reads it. If WAIT is not specified, WRITEMBX
C returns immediately after sending the message.
C
C Arguments:
C
C MAILBOX_NAME (Character)
C The name of the mailbox to be created/assigned.
C
C IOCHAN (Integer*4)
C The channel assigned to the mailbox. If zero, WRITEMBX
C creates and/or assigns a channel to the mailbox and
C returns the channel number in this argument.
C
C MAILBOX_SIZE (Integer*4)
C The maximum message size for this mailbox. This
C argument is only needed when a new mailbox is being
C created (IOCHAN = 0).
C
C WAIT (Logical)
C If TRUE, WRITEMBX writes the message to the mailbox
C and then waits for someone else to read it.
C If FALSE or a null argument, WRITEMBX writes the
C message to the mailbox and immediately returns to the
C caller.
C
C BUFFER (Byte Array)
C The message to be sent.
C
C BUFFER_LENGTH (Integer*4)
C The length of the message. If the length is less
C than zero, then no I/O is actually performed (useful
C when you simply want to create the mailbox).
C
C STATUS
C Returns the VAX/VMS status of the mailbox creation
C or assign or of the mailbox write.
C
C**************************************************************************
IMPLICIT NONE
C... Parameters and external definitions.
INCLUDE '($IODEF)' ! I/O function codes.
INCLUDE '($SSDEF)' ! System service failure and status codes.
INCLUDE '($SYSSRVNAM)' ! VMS system service entry points.
C... Subroutine arguments.
CHARACTER*(*) mailbox_name
INTEGER*4 iochan
INTEGER*4 mailbox_size
LOGICAL wait
BYTE buffer(*)
INTEGER*4 buffer_length
INTEGER*4 status
C... Local variables.
CHARACTER*64 local_mailbox_name
INTEGER*2 length, iosb(4)
INTEGER*4 write_function
status = SS$_NORMAL ! Assume no error.
C... If the mailbox has not yet been created or assigned, do so.
IF (iochan .EQ. 0) THEN
CALL STR$TRIM (local_mailbox_name, mailbox_name, length)
status = SYS$CREMBX ( , iochan, %VAL(mailbox_size), , , ,
+ local_mailbox_name(1:length))
IF (.NOT. status) RETURN
ENDIF
C... Set up the write function code depending on whether the caller
C wants to wait for the message to be read or not.
write_function = IO$_WRITEVBLK + IO$M_NOW
IF (%LOC(wait) .NE. 0) THEN
IF (wait) write_function = IO$_WRITEVBLK
ENDIF
C... Write the message to the mailbox.
IF (buffer_length .GE. 0) THEN
status = SYS$QIOW ( , %VAL(iochan),
+ %VAL(write_function), iosb, , ,
+ %REF(buffer), %VAL(buffer_length), , , , )
IF (status) status = iosb(1)
ENDIF
RETURN
END