IDENTIFICATION DIVISION. PROGRAM-ID. DOSUB. AUTHOR. B. Wallis. INSTALLATION. Fleetwood Enterprises, Inc. DATE-WRITTEN. 9-Mar-84. ****************************************************************************** * * PROGRAM FUNCTIONS: * This subprogram will spawn a subprocess which will execute whatever * command it is given. * * PROGRAM OPTIONS: * None. * * PROGRAM MODIFICATIONS: * * AUTHOR T. MOORE * DATE 17-Mar-86 * VERSION 1-C * * PROGRAM CHANGES: * Define SYS$INPUT before returning to UIF program * Check Return status after creating a subprocess * ****************************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT MAILBOX-FILE ASSIGN TO DISK. SELECT MAILBOX-FILE-IN ASSIGN TO DISK. DATA DIVISION. FILE SECTION. FD MAILBOX-FILE VALUE OF ID IS MAILBOX-LOGICAL. 01 MAILBOX-RECORD PIC X(127). FD MAILBOX-FILE-IN VALUE OF ID IS MAILBOX-LOGICAL-IN. 01 MAILBOX-RECORD-IN PIC X(127). WORKING-STORAGE SECTION. 01 PROG-ID PIC X(9) VALUE "DOSUB-1C". 01 ACKNOWLEDGE-COMMAND PIC X(26) VALUE 'WRITE DOSUBSUBMBX "DONE"'. 01 CNT PIC S9(9) COMP. 01 DEFINE-INPUT PIC X(33) VALUE "DEFINE/NOLOG SYS$INPUT SYS$OUTPUT". 01 DEFINE-COMMAND PIC X(35) VALUE "DEFINE/NOLOG SYS$COMMAND SYS$OUTPUT". 01 FIRST-TIME-SW PIC X(1) VALUE "T". 88 FIRST-TIME VALUE "T". 88 NOT-FIRST-TIME VALUE "F". 01 MAILBOX-CHANNEL PIC S9(9) COMP. 01 MAILBOX-LOGICAL PIC X(10) VALUE "DOSUBMBX:". 01 MAILBOX-CHANNEL-IN PIC S9(9) COMP. 01 MAILBOX-LOGICAL-IN PIC X(12) VALUE "DOSUBINMBX:". 01 NOWAIT-MASK PIC S9(9) COMP VALUE EXTERNAL CLI$M_NOWAIT. 01 OPEN-MAILBOX. 05 OPEN-MAILBOX-FILLER PIC X(24) VALUE "OPEN/WRITE DOSUBSUBMBX ". 05 OPEN-MAILBOX-LOGICAL PIC X(12). 01 PROCESS-ID PIC S9(9) COMP. 01 RETURN-STATUS PIC S9(9) COMP. 01 SS-NORMAL PIC S9(9) COMP VALUE EXTERNAL SS$_NORMAL. LINKAGE SECTION. 01 COMMAND-STRING PIC X(127). 01 SUBPROCESS-RETURN-STATUS PIC S9(9) COMP. PROCEDURE DIVISION USING COMMAND-STRING, SUBPROCESS-RETURN-STATUS GIVING RETURN-STATUS. MAIN SECTION. 001-MAIN. IF FIRST-TIME PERFORM 100-SET-UP-SUBPROCESS THRU 100-EXIT IF RETURN-STATUS IS SUCCESS SET NOT-FIRST-TIME TO TRUE PERFORM 200-SEND-OUT-COMMAND THRU 200-EXIT END-IF ELSE PERFORM 200-SEND-OUT-COMMAND THRU 200-EXIT END-IF. * * We can no longer get the subprocess return status so we will always * return success. * MOVE SS-NORMAL TO SUBPROCESS-RETURN-STATUS. EXIT PROGRAM. SUBROUTINE SECTION. 100-SET-UP-SUBPROCESS. PERFORM 110-CREATE-MAILBOXES THRU 110-EXIT. IF RETURN-STATUS IS SUCCESS PERFORM 130-SPAWN-SUBPROCESS THRU 130-EXIT END-IF. 100-EXIT. 110-CREATE-MAILBOXES. CALL "SYS$CREMBX" USING OMITTED, BY REFERENCE MAILBOX-CHANNEL, OMITTED, OMITTED, OMITTED, OMITTED, BY DESCRIPTOR MAILBOX-LOGICAL(1:9) GIVING RETURN-STATUS. IF RETURN-STATUS IS SUCCESS CALL "SYS$CREMBX" USING OMITTED, BY REFERENCE MAILBOX-CHANNEL-IN, OMITTED, OMITTED, OMITTED, OMITTED, BY DESCRIPTOR MAILBOX-LOGICAL-IN(1:11) GIVING RETURN-STATUS END-IF. 110-EXIT. 130-SPAWN-SUBPROCESS. CALL "LIB$SPAWN" USING BY DESCRIPTOR "SET NOON", BY DESCRIPTOR MAILBOX-LOGICAL(1:9), OMITTED, BY REFERENCE NOWAIT-MASK, OMITTED, BY REFERENCE PROCESS-ID, OMITTED, OMITTED, OMITTED, OMITTED, OMITTED, OMITTED GIVING RETURN-STATUS. IF RETURN-STATUS IS SUCCESS OPEN INPUT MAILBOX-FILE-IN OPEN OUTPUT MAILBOX-FILE MOVE MAILBOX-LOGICAL-IN TO OPEN-MAILBOX-LOGICAL WRITE MAILBOX-RECORD FROM OPEN-MAILBOX WRITE MAILBOX-RECORD FROM DEFINE-INPUT WRITE MAILBOX-RECORD FROM DEFINE-COMMAND. 130-EXIT. 200-SEND-OUT-COMMAND. * * Make sure that there are no trailing spaces * PERFORM WITH TEST BEFORE VARYING CNT FROM 127 BY -1 UNTIL CNT < 2 OR COMMAND-STRING (CNT:1) NOT = SPACE CONTINUE END-PERFORM. * * Write the command followed by a write to the mailbox we are reading. * When we get input from the mailbox the last command is done. * WRITE MAILBOX-RECORD FROM COMMAND-STRING (1:CNT). WRITE MAILBOX-RECORD FROM DEFINE-INPUT. WRITE MAILBOX-RECORD FROM ACKNOWLEDGE-COMMAND. READ MAILBOX-FILE-IN AT END CONTINUE END-READ. 200-EXIT.