Home

GEONius.com
28-May-2003
E-mail

Put the Power of DCL into Your Programs

Published in VAX Professional, August 1989

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.


Introduction

Donald R. Stevens-Rayburn's description (VAX Professional, February 1989) of a make-like utility he wrote under VMS reminded me of one of the few complaints I had about VMS: the lack of a simple way to issue a DCL command to the operating system from within a program. Many of the languages on the UNIVAC 1100, the first computer I ever worked on, had the means of executing a JCL command through a simple subroutine call. And UNIX, of course, has its 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

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)
    ...


It's that simple!

Life is not so simple for 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!


Function EXECUTE_DCL

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

Completion AST

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

Subroutine READMBX

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

Subroutine WRITEMBX

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

©1989  /  Charles A. Measday  /  E-mail