home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / CBLNSM.ZIP / KWI_NSM1.CBL next >
Text File  |  1993-01-15  |  7KB  |  155 lines
  1.  
  2.       $set ans85 mf noosvs defaultbyte"00"
  3.       ****************************************************************
  4.       *
  5.       *  Program:
  6.       *      KWI_NSM1.CBL
  7.       *  Desription:
  8.       *      Allocates 32K of Named Shared Memory (NSM).  Creates a
  9.       *      system semaphore so child process can signal receipt of 
  10.       *      NSM.  Launches child process and waits for semaphore 
  11.       *      to clear.
  12.       ****************************************************************
  13.  
  14.       ****************************************************************
  15.       *
  16.       *     Enable the PASCAL calling convention (number 3)
  17.       *     and call it APIENTRY because it is used for APIENTRY
  18.       *     functions.  (We will use it for COBOL to COBOL calls
  19.       *     as well.)
  20.       *
  21.       ****************************************************************
  22.         special-names.
  23.             call-convention 3 is APIENTRY.
  24.  
  25.         working-storage section.
  26.       ****************************************************************
  27.       *  Constants used to create and access system semaphore
  28.       ****************************************************************
  29.            78 SEM-EXCLUSIVE             VALUE 0.
  30.            78 SEM-NOT-EXCLUSIVE         VALUE 1.
  31.            78 SEM-WAIT                  VALUE -1.
  32.            78 SEM-RETURN                VALUE 0.
  33.  
  34.       ****************************************************************
  35.       *  Constants used to launch child process
  36.       ****************************************************************
  37.            78 FILE-NAME-SIZE            VALUE 30.
  38.            78 EXEC-SYNC                 VALUE 0.
  39.            78 EXEC-ASYNC                VALUE 1.
  40.            78 EXEC-ASYNCRESULT          VALUE 2.
  41.            78 EXEC-TRACE                VALUE 3.
  42.            78 EXEC-BACKGROUND           VALUE 4.
  43.            78 EXEC-LOAD                 VALUE 5.
  44.  
  45.  
  46.         01  RC          PIC 9(4) COMP-5 VALUE 0.
  47.  
  48.       ****************************************************************
  49.       *  Fields used to allocate and access Named Shared Memory
  50.       ****************************************************************
  51.         01  seg-fields.
  52.             05  seg-name        PIC X(30)
  53.                                 VALUE '\SHAREMEM\KWI_NSM.MEM'& X'00'.
  54.             05  seg-ptr.
  55.                 10  seg-zero            PIC 9(4) COMP-5 VALUE ZERO.
  56.  
  57.                 10  seg-selector        PIC 9(4) COMP-5.
  58.             05  seg-pt                  REDEFINES seg-ptr.
  59.                 10 seg-pointer          USAGE IS POINTER.
  60.         01  seg-selector-fields.
  61.             05  seg-selector-ptr.
  62.                 10  seg-pointers-zero      PIC 9(4) COMP-5 VALUE ZERO.
  63.                 10  seg-pointers-selector  PIC 9(4) COMP-5.
  64.             05  seg-selector-pt            REDEFINES seg-selector-ptr.
  65.                 10 seg-selectors-pointer   USAGE IS POINTER.
  66.  
  67.       ****************************************************************
  68.       *  Fields used to create and access system semaphore
  69.       ****************************************************************
  70.         01 Semaphore-fields.
  71.            05  sem-handle         USAGE IS POINTER.
  72.            05  sem-name           PIC X(30)
  73.                                   VALUE '\SEM\KWI_NSM.SEM' & X'00'.
  74.  
  75.       ****************************************************************
  76.       *  Fields used to start child process.
  77.       ****************************************************************
  78.         01  START-FIELDS.
  79.             05  START-FAIL-NAME         PIC X(30) VALUE x'00'.
  80.             05  START-ARGS              PIC X(13) VALUE x'00'.
  81.             05  START-ENV               PIC X(15) VALUE x'00'.
  82.             05  START-PGM               PIC X(15) 
  83.                                         VALUE 'KWI_NSM2.EXE' & x'00'.
  84.             05  RESULTCODES.
  85.                 10 RESULTCODES-codeTerminate    PIC 9(4) COMP-5.
  86.                 10 RESULTCODES-codeResult       PIC 9(4) COMP-5.
  87.  
  88.         procedure division APIENTRY.
  89.         main section.
  90.  
  91.       ****************************************************************
  92.       *  Allocate Named Shared Memory
  93.       ****************************************************************
  94.         CALL APIENTRY "DosAllocShrSeg" USING
  95.                         BY value 32768 SIZE 2
  96.                         BY REFERENCE seg-name
  97.                         BY REFERENCE seg-selector
  98.                 RETURNING RC
  99.                 IF RC NOT = 0
  100.                     EXIT PROGRAM RETURNING RC
  101.                 End-If.
  102.  
  103.       ****************************************************************
  104.       *  Create System Semaphore
  105.       ****************************************************************
  106.         CALL APIENTRY "DosCreateSem" USING
  107.                         BY VALUE SEM-NOT-EXCLUSIVE SIZE 2
  108.                         BY REFERENCE sem-handle
  109.                         BY REFERENCE sem-name
  110.                 RETURNING RC
  111.                 IF RC NOT = 0
  112.                    EXIT PROGRAM RETURNING RC
  113.                 End-If.
  114.  
  115.       ****************************************************************
  116.       *  Set Semaphore so it can be cleared by child process
  117.       ****************************************************************
  118.         CALL APIENTRY "DosSemSet" USING
  119.                         BY VALUE sem-handle
  120.                 RETURNING RC
  121.                 IF RC NOT = 0
  122.                    EXIT PROGRAM RETURNING RC
  123.                 End-If.
  124.  
  125.       ****************************************************************
  126.       *  Launch child process
  127.       ****************************************************************
  128.         CALL APIENTRY "DosExecPgm" USING
  129.                         BY REFERENCE START-FAIL-NAME
  130.                         BY VALUE     FILE-NAME-SIZE SIZE 2
  131.                         BY VALUE     EXEC-ASYNC     SIZE 2
  132.                         BY REFERENCE START-ARGS
  133.                         BY REFERENCE START-ENV
  134.                         BY REFERENCE RESULTCODES
  135.                         BY REFERENCE START-PGM
  136.                 RETURNING RC
  137.                 IF RC NOT = 0
  138.                     EXIT PROGRAM RETURNING RC
  139.                 End-If.
  140.  
  141.       ****************************************************************
  142.       *  Wait for semaphore to be cleared
  143.       ****************************************************************
  144.         CALL APIENTRY "DosSemWait" USING
  145.                         BY VALUE sem-handle
  146.                         BY VALUE SEM-WAIT
  147.                 RETURNING RC
  148.  
  149.                 IF RC NOT = 0
  150.                     EXIT PROGRAM RETURNING RC
  151.                 End-If.
  152.  
  153.        GOBACK.
  154.  
  155.