home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / basnet / semafore.bas < prev    next >
BASIC Source File  |  1987-04-14  |  9KB  |  189 lines
  1. 1  ' SEMAFORE.BAS
  2. 2  '
  3. 3  ' a program to demonstrate the use of the semaphore functions
  4. 4  '
  5. 6  ' Set up to do assembly calls
  6. 10     gosub 10000
  7. 12      cls
  8. 15      print
  9. 20    print "********************************************"
  10. 30      print "*                                          *"
  11. 35      print "*           Semaphore Statistics           *"
  12. 40    print "*                                          *"
  13. 50      print "*                                          *"
  14. 55      print "*                                          *"
  15. 60      print "*                                          *"
  16. 65      print "*                                          *"
  17. 70      print "*                                          *"
  18. 75      print "*                                          *"
  19. 80      print "********************************************"
  20. 85      print
  21. 95      a$="                                                                                    "
  22. 100 ' first open the desired semaphore
  23. 105    locate 14,5:input "First, the semaphore must be opened...<RETURN) to continue.";r$
  24. 110    Sema4$ = chr$(7) + "TESTING" 'This could be the name of a program or anything
  25. 120    SemaValu% = 2
  26. 130    def seg = LibSeg
  27. 140    call OpnSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)   'Func C5h(00h)
  28. 150    def seg
  29. 160    if RetCode% <> 0 then gosub 11000:print "Unable to open semapore...Aborting program.":end
  30. 165    gosub 11000 
  31. 167    locate 6,10:print "SEMAPHORE NAME IS 'TESTING'":locate 8,10:print "VALUE = ";SemaValu%
  32. 168    locate 10,10:print "COUNT = ";OpenCnt%
  33. 169    gosub 11000
  34. 170    print "Semaphore open for use.":locate 15,5:print "We do a Wait on the Semaphore to decrement the VALUE"
  35. 180    locate 16,5:input "<RETURN> to continue.";r$
  36.  
  37. 200 ' now WAIT the semaphore
  38. 230    TimeOut% = 10
  39. 240    def seg = LibSeg
  40. 250    call WAITSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)   'Func C5h(02h)
  41. 260    def seg
  42. 270    if RetCode%=0 then gosub 11000:gosub 15000:gosub 12000:goto 281
  43. 272    gosub 11000:print "The WAIT return code is ";RetCode%;" which means the VALUE is -1...":
  44. 273    locate 15,5:print "...this means the VALUE of the semaphore has been exceeded and choose to exit the program.":goto 310
  45. 281    gosub 11000
  46. 282    print "Let's say we are now done with the program and want to exit."
  47. 283    locate 16,5:input " <RETURN> to continue.";R$
  48. 290 ' We must increment the semaphore when we leave so someone else can decrement it.   
  49. 291    gosub 11000
  50. 292    print "Before closing we must Signal the semaphore to increment the VALUE"
  51. 293    locate 15,5:print "    so that someone else can get in on this semaphore."
  52. 294    locate 16,5:input "<RETURN> to continue.";r$
  53. 295    def seg = libseg
  54. 296    call SigSem(HiHandle%,LoHandle%,RetCode%)   'Func C5h(03h)
  55. 297    def seg
  56. 298    If RetCode% <>0 then gosub 11000:print "Signaling the Semaphore did not work...exiting program.":goto 310
  57. 299    gosub 11000:print "Increment was successful...now let's look at the stats."
  58. 300    locate 16,5:input "<RETURN> to continue.";r$
  59. 301    gosub 12000
  60. 302    gosub 11000
  61. 303    print "Did the VALUE increment 1?":locate 16,5:input "<RETURN> to continue.";r$
  62. 309 ' all done, so close the semaphore
  63. 310    def seg = LibSeg
  64. 320    call ClosSem(HiHandle%,LoHandle%,RetCode%)   'Func C5h(04h)
  65. 330    def seg
  66. 350    gosub 11000
  67. 360    print "The semaphore 'TESTING' has been closed by this application..."
  68. 365    locate 15,5:print "   and the program ended."
  69.  
  70. 9999   end
  71.  
  72. 10000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  73. 10010 ' routines for network use
  74. 10020 '
  75.  
  76. 10100 '  This section contains the routine names and
  77. 10101 '  offsets for the BASNET library
  78. 10102 ' the return is after everything is set up for NetWare calls
  79.  
  80. 10110 XTNDOPN  =   0   'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
  81. 10111 SETATTR  =   3   'setattr(Func%, Filename$, Attribute%, ErrCode%)
  82. 10112 EOJSTAT  =   6   'eojstat(Flag%)
  83. 10113 PRLH.LOG =   9   'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  84. 10114 PRLH.REL =  12   'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
  85. 10115 PRLH.CLR =  15   'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
  86. 10116 PRLF.LOG =  18   'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  87. 10117 PRLF.REL =  21   'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  88. 10118 PRLF.CLR =  24   'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  89. 10119 PRLS.LCK =  27   'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
  90. 10120 PRLS.REL =  30   'PRLS.Rel(ErrCode%)
  91. 10121 PRLS.CLR =  33   'PRLS.Clr(ErrCode%)
  92. 10122 OPNSEM   =  36   'OpnSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
  93. 10123 EXAMSEM  =  39   'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
  94. 10124 WAITSEM  =  42   'WAITSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
  95. 10125 SIGSEM   =  45   'SigSem(HiHandle%,LoHandle%,RetCode%)
  96. 10126 CLOSSEM  =  48   'ClosSem(HiHandle%,LoHandle%,RetCode%)
  97. 10127 SETLCK   =  51   'setlck(Func%,Mode%)
  98. 10128 BAKOUTS  =  54   'Bakouts(Func%,RetCode%)
  99. 10129 BTRANS   =  57   'btran(ReturnCode%, Mode%)
  100. 10130 ETRANS   =  60   'etrans(ReturnCode%)
  101. 10131 EXCLOG   =  63   'exclog(ReturnCode%, FcbAddr)
  102. 10132 EXCLCKS  =  66   'exclcks(ReturnCode%, Mode%)
  103. 10133 EXCULKF  =  69   'exculkf(ReturnCode%, FcbAddr)
  104. 10134 EXCULKS  =  72   'exculks(ReturnCode%)
  105. 10135 EXCCLRF  =  75   'excclrf(ReturnCode%, FcbAddr)
  106. 10136 EXCCLRS  =  78   'excclrs(ReturnCode%)
  107. 10137 RECLOG   =  81   'reclog(ReturnCode%, String$)
  108. 10138 RECLCK   =  84   'reclck(ReturnCode%, Mode%)
  109. 10139 RECULK   =  87   'reculk(ReturnCode%, Semaphore$)
  110. 10140 RECULKS  =  90   'reculks(ReturnCode%)
  111. 10141 RECCLR   =  93   'recclr(ReturnCode%, Semaphore$)
  112. 10142 RECCLRS  =  96   'recclrs(ReturnCode%)
  113. 10143 EOJ      =  99   'eoj(ReturnCode%)
  114. 10144 SYSOUT   = 102   'sysout(ReturnCode%)
  115. 10145 ALLOCR   = 105   'allocr(ReturnCode%, Resource%)
  116. 10146 DALLOCR  = 108   'dallocr(ReturnCode%, Resource%)
  117. 10147 VOLSTAT  = 111   'volstat(volume%, reply$)
  118. 10148 LOCDRV   = 114   'locdrv(NumDisks%)
  119. 10149 WSID     = 117   'wsid(ThisStationNum%)
  120. 10150 ERRMODE  = 120   'errmode(mode%)
  121. 10151 BCSMODE  = 123   'bcsmode(mode%)
  122. 10152 CTLSPL   = 126   'ctlspl(mode%)
  123. 10153 SPLREQ   = 129   'splreq(ErrCode%, RequestBlock$, Reply$)
  124. 10154 PIPREQ   = 132   'pipreq(ErrCode%, RequestBlock$, Reply$)
  125. 10155 DPATH    = 135   'dpath(ReturnCode%, RequestBlock$, Reply$)
  126. 10156 SYSLOG   = 138   'syslog(ReturnCode%, RequestBlock$, Reply$)
  127. 10157 FATTR    = 141   'fattr(ReturnCode%, FcbAddr, Attribute%)
  128. 10158 UPDFCB   = 144   'updfcb(RetCode%,FcbAddr)
  129. 10159 CPYFILE  = 147   'cpyfile(ReturnCode%, FcbSource, FcbDest, COUNTLow, COUNTHigh)
  130. 10160 NETTOD   = 150   'nettod(time$)
  131. 10161 CLSMODE  = 153   'clsmode(mode%)
  132. 10162 DRVMAP   = 156   'drvmap(ReturnFlags%, drive%)
  133. 10163 RETSHL   = 159   'retshl(RetCode%, Mode%)
  134. 10164 ASCLOG   = 162   'asclog(RetCode%, Asciiz$)
  135. 10165 ASCULKF  = 165   'asculkf(RetCode%, Asciiz$)
  136. 10166 ASCCLRF  = 168   'ascclrf(RetCode%, Asciiz$)
  137. 10167 GETPSN   = 171   'Get_PSN(StationNo%)
  138. 10168 GETSTA   = 174   'Get_STA(Mode%,Segment%,Offset%)
  139. 10169 SETSERV  = 177   'SetServ(Mode%,NewServ%,CurrServ%)
  140. 10170 MODSERV  = 180   'ModServ(Mode%,NewServ%,RetCode%)
  141. 10200     '
  142. 10210     ' Assign the segment address for the library to the variable LibSeg
  143. 10220     '
  144. 10230     def seg = 0
  145. 10240     suboff = peek(&h4f0)+(256*peek(&h4f1))
  146. 10250     subseg = peek(&h4f2)+(256*peek(&h4f3))
  147. 10260     LibSeg = subseg
  148. 10270     def seg
  149. 10300     '
  150. 10310     ' set the error mode so its more informative
  151. 10320     def seg = LibSeg
  152. 10330     NewMode% = 1
  153. 10340     call errmode(NewMode%)
  154. 10350     def seg
  155.  
  156. 10999 return
  157.  
  158. 11000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  159. 11010 ' Clear out message line and set up for next message
  160. 11020     locate 14,5
  161. 11030     print using "&";a$:locate 15,5:print using "&";a$:locate 16,5:print using "&";a$
  162. 11040     locate 14,5
  163. 11050     return
  164.  
  165. 12000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  166. 12001 ' examine the COUNT and VALUE of the semaphore
  167. 12010 '
  168. 12015 gosub 11000
  169. 12017 print "...now examining the semaphore...and the results are above ";chr$(24)
  170. 12020 def seg = libseg
  171. 12030 call ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)  'Func C5h(01h)
  172. 12040 def seg
  173. 12042 if RetCode% <> 0 then gosub 11000:print "Semaphore examination failed...exiting program.":end
  174. 12050 locate 8,10:print "VALUE = ";SemaValu%
  175. 12060 locate 10,10:print "COUNT = ";OpenCnt%
  176. 12074 locate 16,5:input "<RETURN> to continue.";r$
  177. 12080 return
  178.  
  179. 15000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  180. 15005 ' Special message for a successful decrementing of the semaphore
  181. 15007 '
  182. 15009 gosub 11000
  183. 15010 print "The VALUE of the semaphore was decremented successfully,"
  184. 15012 locate 15,5:print "    let's look at the stats."
  185. 15020 locate 16,5
  186. 15030 input "<RETURN> to continue.";r$
  187. 15040 return
  188.  
  189.