home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / NWSEM.PRG < prev    next >
Encoding:
Text File  |  1991-08-17  |  15.7 KB  |  510 lines
  1. /*
  2.  * File......: NWSEM.PRG
  3.  * Author....: Glenn Scott
  4.  * CIS ID....: 71620,1521
  5.  * Date......: $Date:   17 Aug 1991 16:11:46  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/nwsem.prv  $
  8.  * 
  9.  * This is an original work by Glenn Scott and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/nwsem.prv  $
  16.  * 
  17.  *    Rev 1.2   17 Aug 1991 16:11:46   GLENN
  18.  * Oops, I forgot to comment out some test code.
  19.  * 
  20.  *    Rev 1.1   15 Aug 1991 23:05:34   GLENN
  21.  * Forest Belt proofread/edited/cleaned up doc
  22.  * 
  23.  *    Rev 1.0   28 Jun 1991 00:44:14   GLENN
  24.  * Initial revision.
  25.  *
  26.  */
  27.  
  28.  
  29. // --------------------------------------------------------------
  30. //    Semaphore Package for Novell NetWare
  31. // --------------------------------------------------------------
  32.  
  33.  
  34. #include "ftint86.ch"
  35.  
  36. #define INT21    33
  37.  
  38. #xcommand DEFAULT <v1> TO <x1> [, <vN> TO <xN> ];
  39.       => IIF((<v1>)=NIL,<v1>:=<x1>,NIL) [; IF((<vN>)=NIL,<vN>:=<xN>,NIL)]
  40.  
  41. #define WAIT_SEMAPHORE    2
  42. #define SIGNAL_SEMAPHORE  3
  43. #define CLOSE_SEMAPHORE   4
  44.  
  45. // Sorry this test routine is pretty lame but it sort of gets
  46. // the point across
  47.  
  48. #ifdef FT_TEST
  49.  
  50.   #define INITIAL_SEMAPHORE_VALUE     2
  51.   #define WAIT_SECONDS                1
  52.  
  53.   function main()
  54.      local nInitVal, nRc, nHandle, nValue, nOpenCnt
  55.  
  56.      cls
  57.  
  58.      nInitVal := INITIAL_SEMAPHORE_VALUE
  59.      FT_NWSEMOPEN( "TEST", nInitVal, @nHandle, @nOpenCnt )
  60.  
  61.      qout( "Waiting ten seconds..." )
  62.      nRc := ft_nwSemWait( nHandle, 180 )
  63.      qout( "Final nRc value = " + STR( nRc ) )
  64.      inkey(0)
  65.      if nRc == 254
  66.         qout("Couldn't get the semaphore.  Try again.")
  67.         quit
  68.      end
  69.  
  70.      cls
  71.  
  72.      @ 24, 0 say "Any key to exit"
  73.      @ 0,  0 say "Handle: " + str( nHandle )
  74.  
  75.      ft_nwSemEx( nHandle, @nValue, @nOpenCnt )
  76.      while .t.
  77.         @ 23, 0 say "Semaphore test -> Open at [" + ;
  78.                     alltrim(str(nOpenCnt))        + ;
  79.                     "] stations, value is ["      + ;
  80.                     alltrim(str(nValue)) + "]"
  81.  
  82.         if inkey( WAIT_SECONDS ) != 0
  83.            exit
  84.         endif
  85.  
  86.         tone( nHandle,.5 )
  87.         ft_nwSemEx( nHandle, @nValue, @nOpenCnt )
  88.      end
  89.  
  90.      qout( "Signal returns: " + str( ft_nwsemSig( nHandle ) ) )
  91.      qout( "Close returns:  " + str( ft_nwsemClose( nHandle ) ) )
  92.  
  93.   return nil
  94.  
  95. #endif
  96.  
  97.  
  98. /*  $DOC$
  99.  *  $FUNCNAME$
  100.  *      FT_NWSEMOPEN()
  101.  *  $CATEGORY$
  102.  *      NetWare
  103.  *  $ONELINER$
  104.  *      Open or create a NetWare semaphore
  105.  *  $SYNTAX$
  106.  *      FT_NWSEMOPEN( <cName>, <nInitVal>, <@nHandle>, <@nOpenCnt> ) -> nRc
  107.  *  $ARGUMENTS$
  108.  *      <cName> is the semaphore name, maximum length is 127 characters.
  109.  *
  110.  *      <nInitVal> is the initial value for the semaphore.  It must start
  111.  *      as a positive number, to a maximum of 127.
  112.  *
  113.  *      <@nHandle> is the semaphore handle.  THIS MUST BE PASSED BY 
  114.  *      REFERENCE!  On exit, <nHandle> will contain a numeric value that
  115.  *      refers to the opened semaphore.  You will need it to pass to 
  116.  *      other semaphore functions!  PASS IT BY REFERENCE!
  117.  *
  118.  *      <@nOpenCnt> is the number of stations that have opened the 
  119.  *      semaphore.  THIS MUST BE PASSED BY REFERENCE! On exit, <nOpenCnt>
  120.  *      will contain a numeric value.
  121.  *  $RETURNS$
  122.  *      nRc, a numeric result code, as follows:
  123.  *
  124.  *            0 - success
  125.  *          254 - Invalid semaphore name length
  126.  *          255 - Invalid semaphore value
  127.  *     
  128.  *      <nHandle> will contain the semaphore handle, and 
  129.  *      <nOpenCnt> will contain the number of stations that have opened
  130.  *      the semaphore.
  131.  *  $DESCRIPTION$
  132.  *      A semaphore is simply a label that indirectly controls network
  133.  *      activity.  There is a semaphore name, which can be up to 127
  134.  *      characters, and an associated value, which can range from 0 to
  135.  *      127.
  136.  *
  137.  *      A semaphore can be used for many things, but is most often used
  138.  *      to limit the number of users in an application, and to control
  139.  *      access to a network resource.
  140.  *
  141.  *      A semaphore essentially allows you to place locks on resources
  142.  *      other than files.  
  143.  *
  144.  *      An application begins the process by calling FT_NWSEMOPEN().
  145.  *      If the semaphore doesn't exist, NetWare will create it.  
  146.  *      FT_NWSEMOPEN() returns a handle that is used in other semaphore
  147.  *      calls.
  148.  *
  149.  *      Applications use FT_NWSEMWAIT() to wait for a semaphore to 
  150.  *      become available.  FT_NWSEMWAIT() decrements the semaphore's
  151.  *      value by 1.  If the value > 0, then the application should 
  152.  *      be allowed to access the semaphore's resource.  If the value 
  153.  *      goes negative, then the application is placed in a queue.
  154.  *      How long your app is in the queue is determined by how you 
  155.  *      set the timeout parameter.  If you can't get the resource in 
  156.  *      the time you allot, you're let out of the queue and the 
  157.  *      value increments by 1 again.
  158.  *
  159.  *      When an application finishes with a semaphore, it should 
  160.  *      call FT_NWSEMSIG() to increment the value, and then 
  161.  *      FT_NWSEMCLOSE() to close the semaphore.  When the semaphore's
  162.  *      open count goes to 0, NetWare deletes it.
  163.  *
  164.  *      FT_NWSEMEX() can be used to examine the value and open count
  165.  *      without affecting them.
  166.  *
  167.  *      For an interesting discussion on the operating system aspects
  168.  *      of semaphores, check "Operating Systems Design and Implementation"
  169.  *      by A. Tanenbaum, page 60.  For more details on NetWare's 
  170.  *      semaphore facilities, refer to Charles Rose's "Programmer's 
  171.  *      Guide to NetWare".  The "Programmer's Guide" will make an 
  172.  *      excellent companion guide to the source code for all NetWare
  173.  *      functions in the Nanforum Toolkit.
  174.  *  $EXAMPLES$
  175.  *      LOCAL nInitVal, nRc, nHandle, nOpenCnt
  176.  *
  177.  *      nInitVal := 2
  178.  *      nRc      := FT_NWSEMOPEN( "Semaphore Test", nInitVal, ;
  179.  *                                @nHandle, @nOpenCnt )
  180.  *
  181.  *      IF nRc != 0
  182.  *        QOUT =: "Error: " + STR( nRc ) )
  183.  *        QUIT
  184.  *      ENDIF
  185.  *  $SEEALSO$
  186.  *      FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK()
  187.  *  $END$
  188.  */
  189.  
  190. function ft_nwSemOpen( cName, nInitVal, nHandle, nOpenCnt )
  191.   local aRegs[ INT86_MAX_REGS ], cRequest, nRet
  192.  
  193.   default cName    to "",   ;
  194.           nInitVal to 0,    ;
  195.           nHandle  to 0,    ;
  196.           nOpenCnt to 0
  197.  
  198.  
  199.   cName    := iif( len( cName ) > 127, substr( cName, 1, 127 ), cName )
  200.   cRequest := chr( len( cName ) ) + cName
  201.  
  202.   aRegs[ AX ]      := makehi( 197 )                       // C5h
  203.   aRegs[ DS ]      := cRequest
  204.   aRegs[ DX ]      := REG_DS
  205.   aRegs[ CX ]      := nInitVal
  206.  
  207.   ft_int86( INT21, aRegs )
  208.  
  209.   nHandle  := bin2l( i2bin( aRegs[CX] ) + i2bin( aRegs[DX] ) )
  210.   nOpenCnt := lowbyte( aRegs[ BX ] )
  211.  
  212.   nRet := lowbyte( aRegs[AX] )
  213.  
  214.   return iif( nRet < 0, nRet + 256, nRet )
  215.  
  216.  
  217.  
  218.  
  219. /*  $DOC$
  220.  *  $FUNCNAME$
  221.  *      FT_NWSEMEX()
  222.  *  $CATEGORY$
  223.  *      NetWare
  224.  *  $ONELINER$
  225.  *      Examine a NetWare semaphore's value and open count
  226.  *  $SYNTAX$
  227.  *      FT_NWSEMEX( <nHandle>, <@nValue>, <@nOpenCnt> ) -> nRc
  228.  *  $ARGUMENTS$
  229.  *      <nHandle> is the semaphore handle, returned from a previous call
  230.  *      to FT_NWSEMOPEN().
  231.  *
  232.  *      <@nValue> will get the current semaphore value.  THIS NUMERIC
  233.  *      ARGUMENT MUST BE PASSED BY REFERENCE!
  234.  *
  235.  *      <@nOpenCnt> will get the current number of workstations 
  236.  *      that have opened the semaphore.  THIS NUMERIC ARGUMENT MUST BE
  237.  *      PASSED BY REFERENCE!
  238.  *  $RETURNS$
  239.  *      nRc, a numeric, as follows:
  240.  *
  241.  *            0 - success
  242.  *          255 - invalid semaphore handle
  243.  *
  244.  *      In addition, nValue will be set to the semaphore's current value,
  245.  *      and nOpenCnt will be set to the number of stations that have 
  246.  *      opened the semaphore.
  247.  *  $DESCRIPTION$
  248.  *      See the description for FT_NWSEMOPEN().
  249.  *  $EXAMPLES$
  250.  *    nInitVal := 2
  251.  *    nHandle  := 0
  252.  *    nOpenCnt := 0
  253.  *
  254.  *    FT_NWSEMOPEN( "Semaphore Test", nInitVal, @nHandle, @nOpenCnt )
  255.  *
  256.  *    nRc := FT_NWSEMWAIT( nHandle )
  257.  *        IF nRc == 254
  258.  *       QOUT( "All slots for this resource are currently in use" )
  259.  *       QUIT
  260.  *    ENDIF
  261.  *
  262.  *    FT_NWSEMEX( nHandle, @nValue, @nOpenCnt )
  263.  *    QOUT( "Semaphore test -> Open at [" + ;
  264.  *          ALLTRIM(STR(nOpenCnt))        + ;
  265.  *          "] stations, value is ["      + ;
  266.  *          ALLTRIM(STR(nValue)) + "]" )
  267.  *  $SEEALSO$
  268.  *      FT_NWSEMOPEN() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK()
  269.  *  $END$
  270.  */
  271.  
  272.  
  273. function ft_nwSemEx( nHandle, nValue, nOpenCnt )
  274.   local aRegs[ INT86_MAX_REGS ], nRet
  275.  
  276.   default nHandle  to 0,  ;
  277.           nValue   to 0,  ;
  278.           nOpenCnt to 0
  279.  
  280.   aRegs[ AX ] :=  makehi( 197 ) + 1                         // C5h, 01h
  281.   aRegs[ CX ] :=  bin2i( substr( l2bin( nHandle ), 1, 2 ) )
  282.   aRegs[ DX ] :=  bin2i( substr( l2bin( nHandle ), 3, 2 ) )
  283.  
  284.   ft_int86( INT21, aRegs )
  285.  
  286.   #ifdef FT_TEST
  287.    
  288.      @ 5, 1 say highbyte( aregs[CX] )
  289.      @ 6, 1 say lowbyte( aregs[CX ] )
  290.  
  291.   #endif
  292.  
  293.   nValue   := aRegs[ CX ]
  294.   nOpenCnt := lowbyte( aRegs[ DX ] ) 
  295.   nRet     := lowbyte( aRegs[ AX ] )
  296.  
  297.   return iif( nRet < 0, nRet + 256, nRet )
  298.  
  299.  
  300. /*  $DOC$
  301.  *  $FUNCNAME$
  302.  *     FT_NWSEMWAIT()
  303.  *  $CATEGORY$
  304.  *     NetWare
  305.  *  $ONELINER$
  306.  *     Wait on a NetWare semaphore (decrement)
  307.  *  $SYNTAX$
  308.  *     FT_NWSEMWAIT( <nHandle> [, nTimeout ] ) -> nRc
  309.  *  $ARGUMENTS$
  310.  *     <nHandle> is the semaphore handle, returned from a previous call
  311.  *     to FT_NWSEMOPEN().
  312.  *
  313.  *     <nTimeOut> is an optional parameter telling how long you wish to
  314.  *     wait on this semaphore.  This is a numeric indicating the number
  315.  *     of clock ticks (approx 1/18 sec ) to wait.  A zero (the default)
  316.  *     means "don't wait."
  317.  *  $RETURNS$
  318.  *     nRc, a numeric, as follows:
  319.  *
  320.  *           0 - success
  321.  *         254 - timeout failure
  322.  *         255 - invalid semaphore handle
  323.  *  $DESCRIPTION$
  324.  *     See the description for the FT_NWSEMOPEN() function.
  325.  *  $EXAMPLES$
  326.  *    FT_NWSEMOPEN( "Semaphore Test", nInitVal, @nHandle, @nOpenCnt )
  327.  *
  328.  *    nRc := FT_NWSEMWAIT( nHandle )
  329.  *    IF nRc == 254
  330.  *       QOUT( "All slots for this resource are currently in use" )
  331.  *       QUIT
  332.  *    ENDIF
  333.  *  $SEEALSO$
  334.  *      FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK()
  335.  *  $END$
  336.  */
  337.  
  338.  
  339.  
  340. function ft_nwSemWait( nHandle, nTimeout )
  341.   return  _ftnwsem( WAIT_SEMAPHORE, nHandle, nTimeout )
  342.  
  343.  
  344.  
  345. /*  $DOC$
  346.  *  $FUNCNAME$
  347.  *     FT_NWSEMSIG()
  348.  *  $CATEGORY$
  349.  *     NetWare
  350.  *  $ONELINER$
  351.  *     Signal a NetWare semaphore (increment)
  352.  *  $SYNTAX$
  353.  *     FT_NWSEMSIG( nHandle ) -> nRc
  354.  *  $ARGUMENTS$
  355.  *     <nHandle> is the semaphore handle, returned from a previous call
  356.  *     to FT_NWSEMOPEN().
  357.  *  $RETURNS$
  358.  *     nRc, a numeric, as follows
  359.  *
  360.  *          0 - success
  361.  *          1 - semaphore overflow ( value > 127 )
  362.  *        255 - invalid semaphore handle
  363.  *  $DESCRIPTION$
  364.  *      Use FT_NWSEMSIG() when your app has finished with the resource
  365.  *      locked by a semaphore.  This will increase the value (thus
  366.  *      making a slot available to another app).
  367.  *
  368.  *      For more information, see the description under FT_NWSEMOPEN().
  369.  *  $EXAMPLES$
  370.  *      QOUT( "Signal returns: " + STR( FT_NWSEMSIG( nHandle ) ) )
  371.  *  $SEEALSO$
  372.  *      FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMCLOSE() FT_NWSEMLOCK()
  373.  *  $END$
  374.  */
  375.  
  376.  
  377. function ft_nwSemSig( nHandle )
  378.   return  _ftnwsem( SIGNAL_SEMAPHORE, nHandle )
  379.  
  380.  
  381. /*  $DOC$
  382.  *  $FUNCNAME$
  383.  *     FT_NWSEMCLOSE()
  384.  *  $CATEGORY$
  385.  *     NetWare
  386.  *  $ONELINER$
  387.  *     Close a NetWare semaphore
  388.  *  $SYNTAX$
  389.  *     FT_NWSEMCLOSE( <nHandle> )  -> nRc
  390.  *  $ARGUMENTS$
  391.  *     <nHandle> is the semaphore handle, returned from a previous call
  392.  *     to FT_NWSEMOPEN().
  393.  *  $RETURNS$
  394.  *     nRc, a numeric, as follows:
  395.  *
  396.  *            0 - success
  397.  *          255 - invalid semaphore handle
  398.  *  $DESCRIPTION$
  399.  *     Call FT_NWSEMCLOSE() when the app is finished.  This decrements
  400.  *     the open count for the semaphore.  If the open count hits zero,
  401.  *     the semaphore is deleted by NetWare.
  402.  *  $EXAMPLES$
  403.  *     QOUT( "Close returns:  " + STR( FT_NWSEMCLOSE( nHandle ) ) )
  404.  *  $SEEALSO$
  405.  *     FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMLOCK()
  406.  *  $END$
  407.  */
  408.  
  409. function ft_nwSemClose( nHandle )
  410.   return  _ftnwsem( CLOSE_SEMAPHORE, nHandle )
  411.  
  412.  
  413. // ---------------------------------------------------------
  414. // _ftnwsem() - internal for the semaphore package
  415. // ---------------------------------------------------------
  416.  
  417. static function _ftnwsem( nOp, nHandle, nTimeout )
  418.   local aRegs[ INT86_MAX_REGS ],;
  419.         nRet
  420.  
  421.   default nOp      to SIGNAL_SEMAPHORE, ;
  422.           nHandle  to 0,                ;
  423.           nTimeout to 0
  424.  
  425.   aRegs[ AX ] :=  makehi( 197 ) + nOp
  426.   aRegs[ CX ] :=  bin2i( substr( l2bin( nHandle ), 1, 2 ) )
  427.   aRegs[ DX ] :=  bin2i( substr( l2bin( nHandle ), 3, 2 ) )
  428.   aRegs[ BP ] :=  nTimeout
  429.  
  430.  
  431.   ft_int86( INT21, aRegs )
  432.   nRet := lowbyte( aRegs[AX] )
  433.   nRet := iif( nRet < 0, nRet + 256, nRet )
  434.  
  435.   return nRet
  436.  
  437.  
  438.  
  439. /*  $DOC$
  440.  *  $FUNCNAME$
  441.  *     FT_NWSEMLOCK()
  442.  *  $CATEGORY$
  443.  *     NetWare
  444.  *  $ONELINER$
  445.  *     Perform a semaphore "lock"
  446.  *  $SYNTAX$
  447.  *     FT_NWSEMLOCK ( <cSemaphore> ) -> lRet
  448.  *  $ARGUMENTS$
  449.  *     <cSemaphore> is the name of a semaphore you want to "lock."
  450.  *  $RETURNS$
  451.  *     lRet == .t. if you get the lock, .f. if you don't.
  452.  *  $DESCRIPTION$
  453.  *     FT_NWSEMLOCK() uses the Nanforum Toolkit's NetWare Semaphore API functions
  454.  *     in order to provide a general purpose "lock" you can use in 
  455.  *     a NetWare environment.  
  456.  *
  457.  *     An interesting byproduct of NetWare's semaphore functions is
  458.  *     the "open count" which tells you how many connections have this
  459.  *     semaphore open.  This is different from the semaphore's _value_,
  460.  *     which is set when the semaphore is opened and changed with 
  461.  *     signal() and wait().  
  462.  *
  463.  *     The point of semaphores is that you don't care how many users
  464.  *     are using the resource; you merely wait on a semaphore until
  465.  *     the resource becomes available or you give up.  When you're done,
  466.  *     you signal it and off you go.
  467.  *
  468.  *     Back to the open count.  FT_NWSEMLOCK() opens the semaphore
  469.  *     as named in <cSemaphore>.  After it is opened, the open count
  470.  *     is checked.  If it is anything other than 1, that means someone
  471.  *     else has it (or you failed in your open) so the semaphore is
  472.  *     closed and the "lock" is refused.  If the value is 1, then your
  473.  *     app is that 1 station so the "lock" is granted.
  474.  *
  475.  *     You can use a semaphore lock to control access to anything
  476.  *     that Clipper's RLOCK() and FLOCK() can't help you with, such 
  477.  *     as text files written with the low level file i/o functions,
  478.  *     etc.  
  479.  *  $EXAMPLES$
  480.  *     IF FT_NWSEMLOCK( "k:\apps\error.log" )
  481.  *         // Note, you aren't actually LOCKING this file, you are
  482.  *         // just locking a semaphore by the same name.  As long as
  483.  *         // all apps that might be using this file are cooperating
  484.  *         // with the same kind of semaphore lock, you can effectively
  485.  *         // control access to the file.
  486.  *       ELSE
  487.  *         QOUT("Couldn't lock file.")
  488.  *       ENDIF
  489.  *  $SEEALSO$
  490.  *     FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG()
  491.  *  $END$
  492.  */
  493.  
  494.  
  495.  
  496. function ft_nwSemLock( cSemaphore )
  497.   local nRc
  498.   local nHandle  := 0
  499.   local nOpenCnt := 0
  500.   
  501.   nRc  := FT_NWSEMOPEN( cSemaphore, 0, @nHandle, @nOpenCnt )
  502.  
  503.   if nRc == 0
  504.      if nOpenCnt != 1
  505.         ft_nwSemClose( nHandle )
  506.      endif
  507.   endif
  508.  
  509.   return ( nOpenCnt == 1 )
  510.