1 # fca-rreq.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31 ###
32 FCARepairRequest superclass FCA_Packet
33 FCARepairReply superclass FCA_Packet
34 Class FCARepairRequest/Tcl -superclass {FCARepairRequest}
35 FCARepairRequest/Tcl instproc init {} {
36 $self next
37 $self set maxBackoffs_ 10
38 $self set numBackoffs_ 0
39 $self set list ""
40 $self set numRequests 0
41 }
42
43
44
45 ###### participant repair request
46
47 Class FCARepairRequest/Tcl/Participant -superclass FCARepairRequest
48
49
50 FCARepairRequest/Tcl/Participant instproc init {} {
51 $self next
52 $self set pktType "PKT_PARTICIPANT_RREQ"
53 $self set list ""
54 $self set numRequests 0
55 DbgOut "NEW FCARepairRequest/Tcl/Participant"
56 }
57
58 # return 1 if list modified due to the reply
59 FCARepairRequest/Tcl/Participant instproc gotReply { important seq } {
60 $self instvar list numRequests
61 DbgOut "RReq list(start): $list :::::::: $important $seq"
62 if { $list == "" } {
63 DbgOut "FCARepairRequest/Tcl/Participant::getReply, RepairRequest_ \
64 has an empty list"
65 DbgOut "RReq list(end): $list :::::::: $important $seq"
66 return 0
67 }
68
69 set index 0
70 foreach item $list {
71 if {[lindex $item 0] == $important} {
72 set sseq [lindex $item 1]
73 set eseq [lindex $item 2]
74 if {($sseq <= $seq) && ($seq <= $eseq)} {
75 if {$sseq == $seq} {
76 set sseq [expr $sseq + 1]
77 if { $sseq > $eseq } {
78 set list [lreplace $list $index $index]
79 incr numRequests -1
80 if {[llength list] == 0 } {
81 $self cancel
82 }
83 DbgOut "RReq list(end): $list :::::::: $important $seq"
84 return 1
85 }
86 set list [lreplace $list $index $index \
87 "$important $sseq $eseq"]
88 DbgOut "RReq list(end): $list :::::::: $important $seq"
89 return 1
90 }
91
92 if {$eseq == $seq} {
93 set eseq [expr $eseq - 1]
94 set list [lreplace $list $index $index \
95 "$important $sseq $eseq"]
96 DbgOut "RReq list(end): $list :::::::: $important $seq"
97 return 1
98 }
99
100 linsert list [expr $index + 1] \
101 [list "$important [expr $seq + 1] $eseq"]
102 set list [lreplace $list $index $index \
103 [list "$important $sseq [expr $seq - 1]"]]
104 incr numRequests 1
105 DbgOut "RReq list(end): $list :::::::: $important $seq"
106 return 1
107 }
108 }
109 incr index 1
110 }
111 DbgOut "RReq list(end): $list :::::::: $important $seq"
112 return 0
113 }
114
115
116 #
117 # newItem: is a triple of "isImportant start_seq end_seq"
118 #
119 FCARepairRequest/Tcl/Participant instproc insert {newItem} {
120 $self instvar list numRequests
121 if {$newItem == ""} {
122 DbgOut "FCARepairRequest/Tcl/Participant::insert, newItem empty"
123 }
124 set isImportant [lindex $newItem 0]
125 set newsseq [lindex $newItem 1]
126 set neweseq [lindex $newItem 2]
127
128 DbgOut "FCARepairRequest/Tcl/Participant::insert, newItem = $newItem\
129 list before inserting newItem = $list"
130
131 set index 0
132 foreach item $list {
133 if {[lindex $item 0] == $isImportant} {
134 set sseq [lindex $item 1]
135 set eseq [lindex $item 2]
136 if {($newsseq <= $eseq) && ($neweseq >= $sseq)} {
137 # if overlap
138 if { ($newsseq >= $sseq) && ($eseq >= $neweseq) } {
139 # this old request encompasses the new request
140 return
141 }
142 if { ($newsseq < $sseq) && ($eseq < $neweseq) } {
143 # new emcompasses the old
144 set newItem "$isImportant $newsseq $neweseq"
145 set list [lreplace $list $index $index $newItem]
146 return
147 }
148 # old ---------
149 # new --------
150 if {$neweseq < $eseq } {
151 set newItem "$isImportant $newsseq $eseq"
152 set list [lreplace $list $index $index $newItem]
153 return
154 }
155 # old ---------
156 # new ---------
157 if {$newsseq > $sseq} {
158 set newsseq [expr $eseq + 1]
159 }
160 }
161 }
162 incr index 1
163 }
164
165 lappend list $newItem
166 incr numRequests 1
167 DbgOut "FCARepairRequest/Tcl/Participant::insert, list ($list):"
168 }
169
170
171 FCARepairRequest/Tcl/Participant instproc overlap { rqPkt } {
172 $self instvar list
173
174 set rqList [$rqPkt set list]
175 foreach rqItem $rqList {
176 foreach myItem $list {
177 if {[lindex $rqItem 0] == [lindex $myItem 0] } {
178 set rqSseq [lindex $rqItem 1]
179 set rqEseq [lindex $rqItem 2]
180 set mySseq [lindex $myItem 1]
181 set myEseq [lindex $myItem 2]
182 if {($rqSseq <= $myEseq) && ($rqEseq >= $mySseq) } {
183 return 1
184 }
185 }
186 }
187 }
188 return 0
189 }
190
191
192
193 # return 1 if backoffed, 0 otherwise
194 #FCARepairRequest/Tcl/Participant instproc backoff_ { fcaPkt } {
195 # $self instvar sseq_ eseq_ numBackoffs_ maxBackoffs_ rcvr_
196 # set newsseq [$fcaPkt set sseq]
197 # set neweseq [$fcaPkt set eseq]
198 # if {($newsseq <= $eseq_) && ($neweseq >= $sseq)} {
199 # # conservative approach, backoff if overlap
200 # $self backoff
201 # incr numBackoffs_ 1
202 # if {$numBackoffs >= $maxBackoffs_} {
203 # $rcvr_ rmPartRepairRequest $self
204 # $self cancel
205 # delete $self
206 # }
207 # return 1
208 # }
209 # return 0
210 #}
211
212
213
214 ###### moderator repair request
215
216 Class FCARepairRequest/Tcl/Moderator -superclass FCARepairRequest/Tcl
217
218
219 FCARepairRequest/Tcl/Moderator instproc init { moderatorState } {
220 $self next
221 $self set pktType "PKT_MODERATOR_RREQ"
222 $self set moderatorState $moderatorState
223 DbgOut "NEW FCARepairRequest/Tcl/Moderator"
224 }
225
226 FCARepairRequest/Tcl/Moderator instproc moderator_state {} {
227 return [$self set moderatorState]
228 }
229
230
231 FCARepairRequest/Tcl/Moderator instproc set_moderator_state {state} {
232 $self set moderatorState $state
233 }
234
235
236 # return 1 if backoffed, 0 otherwise
237 #FCARepairRequest/Tcl/Moderator instproc backoff_ { fcaPkt } {
238 # $self instvar curState_ numBackoffs_ maxBackoffs_ rcvr_
239 # set curState [$fcaPkt set curState]
240 # if {$curState_ <= curState} {
241 # # if my state is older, backoff
242 # $self backoff
243 # incr numBackoffs_ 1
244 # if {$numBackoffs >= $maxBackoffs_} {
245 # # remove from the fcd repairRequests_
246 # $rcvr_ rmModRepairRequest $self
247 # $self cancel
248 # delete $self
249 # }
250 # return 1
251 # }
252 # return 0
253 #}
254
255
256 ######
257 Class FCARepairReply/Tcl -superclass FCARepairReply
258 FCARepairReply/Tcl instproc init {} {
259 $self next
260 }
261
262
263
264 ###
265 Class FCARepairReply/Tcl/Participant -superclass FCARepairReply/Tcl
266 FCARepairReply/Tcl/Participant instproc init {} {
267 $self next
268 $self set pktType "PKT_PARTICIPANT_RREPLY"
269 $self set numReplies 0
270 $self set pktReplies ""
271 }
272
273
274 # return 1 if exist, otherwise 0
275 FCARepairReply/Tcl/Participant instproc FOOBAR { isImportant newReply } {
276 $self instvar numReplies pktReplies
277 foreach reply $pktReplies {
278 set replyPktType [$reply set pktType]
279 switch $replyPktType {
280 PKT_FLOOR_REQUEST {
281 if {!$isImportant} {
282 set requestId [$reply set requestId]
283 if { $requestId == [$newReply requestId] } {
284 return 1
285 }
286 }
287 }
288 PKT_FLOOR_CANCEL {
289 if {$important} {
290 set type [lindex $newReply 0]
291 if {$type == "cancel"} {
292 set seq [lindex $newReply 2]
293 if {[$reply set seqno] == $seq } {
294 return 1
295 }
296 }
297 }
298 }
299 PKT_FLOOR_RELEASE {
300 if {$important} {
301 if {$type == "release"} {
302 set seq [lindex $newReply 2]
303 if {[$reply set seqno] == $seq} {
304 return 1
305 }
306 }
307 }
308 }
309 }
310 }
311 return 0
312 }
313
314
315 FCARepairReply/Tcl/Participant instproc reply_exists { fcaPkt } {
316 $self instvar pktReplies
317 foreach reply $pktReplies {
318 if { [$reply set pktType] != [$fcaPkt set pktType] } continue
319
320 switch [$reply set pktType] {
321 PKT_FLOOR_REQUEST {
322 if { [$reply set requestId]==[$fcaPkt set requestId] } {
323 return 1
324 }
325 }
326 PKT_FLOOR_CANCEL {
327 set seqno [$fcaPkt set seqno]
328 if { $seqno==[$reply set seqno] } {
329 if { $seqno!=0 } {
330 return 1
331 } elseif { [$fcaPkt set requestId] \
332 == [$reply set requestId] } {
333 return 1
334 }
335 }
336 }
337 PKT_FLOOR_RELEASE {
338 not_implemented yet
339 }
340 PKT_OBSOLETE {
341 if { [$fcaPkt set seqno]==[$reply set seqno] } {
342 return 1
343 }
344 }
345 }
346 }
347
348 return 0
349 }
350
351
352 FCARepairReply/Tcl/Participant instproc insertReply { fcaPkt } {
353 $self instvar numReplies pktReplies
354
355 DbgOut "FCARepairReply/Tcl/Participant::insertReply $fcaPkt"
356
357 if {[$self reply_exists $fcaPkt]} {
358 DbgOut "reply already exist, don't need to insert to the reply"
359 delete $fcaPkt
360 return
361 }
362
363 incr numReplies 1
364 lappend pktReplies $fcaPkt
365
366 DbgOut "FCARepairReply/Tcl/Participant::insertReply: self=$self, \
367 numReplies=$numReplies"
368 foreach reply $pktReplies {
369 DbgOut " pktType = [$reply set pktType]"
370 }
371 }
372
373
374
375 FCARepairReply/Tcl/Participant instproc ANOTHER_FOOBAR { pktType reply } {
376 $self instvar numReplies pktReplies
377
378 DbgOut "FCARepairReply/Tcl/Participant::insertReply $reply"
379
380 if {[$self reply_exist $isImportant $reply]} {
381 DbgOut "reply already exist, don't need to insert to the reply"
382 return
383 }
384
385 incr numReplies 1
386 set fcaPkt [new FCA_Packet]
387 $fcaPkt set pktType $pktType
388
389 switch $pktType {
390 PKT_FLOOR_CANCEL {
391 $fcaPkt set seqno $seqno
392 $fcaPkt set requestId $requestId
393 }
394
395 }
396
397
398 if { $isImportant } {
399 # the reply is:
400 # {<type> <id>} <seqno>
401 # (cancel/release)
402 set type [lindex [lindex $reply 0] 0]
403 set id [lindex [lindex $reply 0] 1]
404 set seqno [lindex $reply 1]
405 switch $type {
406 cancel {
407 $fcaPkt set pktType "PKT_FLOOR_CANCEL"
408 $fcaPkt set seqno $seqno
409 $fcaPkt set requestId $requestId
410 }
411
412 release {
413 DbgOut "FCARepairReply/Tcl/Participant::insertReply, \
414 Release is not being handled right now"
415 $fcaPkt set pktType "PKT_FLOOR_RELEASE"
416 # $fcaPkt set seqno $seqno
417 # $fcaPkt set grantSeqno $requestId
418 }
419
420 "" {
421 # this entry is obsolete
422 $fcaPkt set pktType "PKT_OBSOLETE"
423 $fcaPkt set seqno $seqno
424 }
425
426 default {
427 DbgOut "FCARepairReply/Tcl/Participant::insertReply, \
428 wrong type"
429 }
430 }
431 } else {
432 $fcaPkt set pktType "PKT_FLOOR_REQUEST"
433 $fcaPkt set requestId [$reply requestId]
434 $fcaPkt set comment [$reply comment]
435 $fcaPkt set floors [$reply floorTypes]
436 $fcaPkt set numFloors [llength [$fcaPkt set floors]]
437 }
438 lappend pktReplies $fcaPkt
439 DbgOut "FCARepairReply/Tcl/Participant, insertReply, replyobj = $self"
440 foreach reply $pktReplies {
441 DbgOut "pktType = [$reply set pktType] \
442 requestId = [$reply set requestId] \
443 comment = [$reply set comment] \
444 floors = [$reply set floors] \
445 numFloors = [$reply set numFloors] "
446 }
447 }
448
449
450
451 # return 1 if canceled
452 FCARepairReply/Tcl/Participant instproc cancel_reply {rrpy} {
453 $self instvar list numReplies pktReplies
454
455 set canceled 0
456
457 set myIndex 0
458 foreach myRpy $pktReplies {
459 DbgOut "pktReplies: '$pktReplies', numReplies: $numReplies"
460 set myPktType [$myRpy set pktType]
461 set newPktType [$myRpy set pktType]
462 if {$myPktType == $newPktType} {
463 switch $myPktType {
464 "PKT_FLOOR_REQUEST" {
465 set newRequestId [$rrpy set requestId]
466 set myRequestId [$myRpy set requestId]
467 if {$myRequestId == $newRequestId} {
468 DbgOut "Replacing $myIndex ($myRpy): REQUEST"
469 set canceled 1
470 set pktReplies [lreplace $pktReplies $myIndex $myIndex]
471 delete $myRpy
472 incr numReplies -1
473 break
474 }
475 }
476 "PKT_FLOOR_CANCEL" {
477 set newSeqno [$rrpy set seqno]
478 set mySeqno [$myRpy set seqno]
479 if { ($mySeqno!=0 && $mySeqno == $newSeqno) || \
480 ($mySeqno==0 && \
481 [$rrpy set requestId]==[$myRpy set requestId]) } {
482 DbgOut "Replacing $myIndex ($myRpy): CANCEL"
483 set canceled 1
484 set pktReplies [lreplace $pktReplies $myIndex $myIndex]
485 delete $myRpy
486 incr numReplies -1
487 break
488 }
489 }
490 "PKT_FLOOR_RELEASE" {
491 set newSeqno [$rrpy set seqno]
492 set mySeqno [$myRpy set seqno]
493 if {$mySeqno == $newSeqno} {
494 DbgOut "Replacing $myIndex ($myRpy): RELEASE"
495 set canceled 1
496 set pktReplies [lreplace $pktReplies $myIndex $myIndex]
497 delete $myRpy
498 incr numReplies -1
499 break
500 }
501 }
502 "PKT_OBSOLETE" {
503 set newSeqno [$rrpy set seqno]
504 set mySeqno [$myRpy set seqno]
505 if {$mySeqno == $newSeqno} {
506 DbgOut "Replacing $myIndex ($myRpy): OBSOLETE"
507 set canceled 1
508 set pktReplies [lreplace $pktReplies $myIndex $myIndex]
509 delete $myRpy
510 incr numReplies -1
511 break
512 }
513 }
514 default {
515 DbgOut "FCARepairReply/Tcl/ParticipantFCARcvr/Tcl::\
516 cancel, wrong packet type"
517 }
518
519 }
520 }
521 incr myIndex 1
522 }
523 if { $numReplies <= 0 } {
524 $self cancel
525 }
526 return $canceled
527 }
528
529
530 FCARepairReply/Tcl/Participant instproc numReplies {} {
531 return [$self set numReplies]
532 }
533
534
535 FCARepairReply/Tcl/Participant instproc replies {} {
536 return [$self set pktReplies]
537 }
538
539
540 ###
541 Class FCARepairReply/Tcl/Moderator -superclass FCARepairReply/Tcl
542 FCARepairReply/Tcl/Moderator instproc init {} {
543 $self next
544 $self set pktType "PKT_MODERATOR_RREPLY"
545 $self set pktGrantUpdate ""
546 $self set pktQueueUpdate ""
547 $self set state_ 0
548 }
549
550
551 FCARepairReply/Tcl/Moderator instproc state {} {
552 return [$self set state_]
553 }
554
555
556 FCARepairReply/Tcl/Moderator instproc set_state {state} {
557 $self set state_ $state
558 }
559
560
561 # HERE!!
562 #FCARcvr/Tcl instproc backoff { fcaPkt } {
563 # $self instvar repairRequests_
564 # set pktType [$fcaPkt set pktType]
565 # if {1} {
566 # set backoffed 0
567 # foreach rreq $repairRequests_ {
568 # if { [rreq backoff_ $fcaPkt] } {
569 # set backoffed 1
570 # }
571 # }
572 # return $backoffed
573 # }
574 #}
575
576 # local receiver is participant, only have queues of
577 #FCAFloorDynamics instproc backoff { fcaPkt } {
578 # $self instvar repairRequests_
579 # set backoffed 0
580 # foreach rreq $repairRequests_ {
581 # if { [rreq backoff_ $fcaPkt] } {
582 # set backoffed 1
583 # }
584 # }
585 # return $backoffed
586 #}
587
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.