home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / CBLNSM.ZIP / KWI_NSM2.CBL < prev    next >
Text File  |  1993-01-15  |  4KB  |  110 lines
  1.  
  2.       $set ans85 mf noosvs defaultbyte"00"
  3.       ****************************************************************
  4.       *
  5.       *  Program:
  6.       *      KWI_NSM2.CBL
  7.       *  Desription:
  8.       *      "Gets" Named Shared Memory (KWI_NSM.MEM) created in 
  9.       *      KWI_NSM1.CBL. Clears semaphore (KWI_NSM.SEM) created
  10.       *      in KWI_NSM1.CBL to signal that NSM was retrieved
  11.       *      successfully.
  12.       *
  13.       ****************************************************************
  14.  
  15.       ****************************************************************
  16.       *
  17.       *     Enable the PASCAL calling convention (number 3)
  18.       *     and call it APIENTRY because it is used for APIENTRY
  19.       *     functions.  (We will use it for COBOL to COBOL calls
  20.       *     as well.)
  21.       *
  22.       ****************************************************************
  23.         special-names.
  24.             call-convention 3 is APIENTRY.
  25.  
  26.         working-storage section.
  27.  
  28.         01  RC                   PIC 9(4) COMP-5 VALUE 0.
  29.  
  30.       ****************************************************************
  31.       *  Fields used to access system semaphore
  32.       ****************************************************************
  33.         01  Semaphore-fields.
  34.             05 sem-handle       USAGE IS POINTER.
  35.             05 sem-name         PIC X(30) 
  36.                                 VALUE "\SEM\KWI_NSM.SEM" & X'00'.
  37.  
  38.       ****************************************************************
  39.       *  Fields used to access Named Shared Memory
  40.       ****************************************************************
  41.         01  seg-fields.
  42.             05  seg-name        PIC X(30)
  43.                                 VALUE "\SHAREMEM\KWI_NSM.MEM"& X'00'.
  44.             05  seg-ptr.
  45.                 10  seg-zero        PIC 9(4) COMP-5 VALUE ZERO.
  46.  
  47.                 10  seg-selector    PIC 9(4) COMP-5.
  48.             05  seg-pt              REDEFINES seg-ptr.
  49.                 10 seg-pointer      USAGE IS POINTER.
  50.  
  51.         01  seg-selector-fields.
  52.             05  seg-selector-ptr.
  53.                 10  seg-pointers-zero     PIC 9(4) COMP-5 VALUE ZERO.
  54.                 10  seg-pointers-selector PIC 9(4) COMP-5.
  55.             05  seg-selector-pt           REDEFINES seg-selector-ptr.
  56.                 10 seg-selectors-pointer  USAGE IS POINTER.
  57.  
  58.         procedure division APIENTRY.
  59.         main section.
  60.  
  61.       *****************************************************************
  62.       *  Obrain selector for Named Shared Memory (NSM) allocated in
  63.       *  parent program
  64.       *****************************************************************
  65.         CALL APIENTRY "DosGetShrSeg" USING
  66.                 BY REFERENCE seg-name
  67.                 BY REFERENCE seg-selector
  68.            RETURNING RC
  69.  
  70.            IF RC NOT = 0
  71.                EXIT PROGRAM RETURNING RC
  72.            End-If.
  73.  
  74.       *****************************************************************
  75.       *  Optain handle for system semaphore created in parent program
  76.       *****************************************************************
  77.         CALL APIENTRY "DosOpenSem" USING
  78.                 BY REFERENCE sem-handle
  79.                 BY REFERENCE sem-name
  80.            RETURNING RC
  81.  
  82.            IF RC NOT = 0
  83.                EXIT PROGRAM RETURNING RC
  84.            End-If.
  85.  
  86.       *****************************************************************
  87.       *  Clear semaphore to signal parent program that NSM was 
  88.       *  received successfully
  89.       *****************************************************************
  90.         CALL APIENTRY "DosSemClear" USING
  91.                 BY VALUE sem-handle
  92.                 RETURNING RC
  93.  
  94.            IF RC NOT = 0
  95.                EXIT PROGRAM RETURNING RC
  96.            End-If.
  97.  
  98.       *****************************************************************
  99.       *  Close semaphore since it is not used further.
  100.       *****************************************************************
  101.         CALL APIENTRY "DosCloseSem" USING
  102.                         BY VALUE sem-handle
  103.                 RETURNING RC
  104.                 IF RC NOT = 0
  105.                     EXIT PROGRAM RETURNING RC
  106.                 End-If.
  107.  
  108.         GOBACK.
  109.  
  110.