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