1 # fca-localrcvr.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 ################## local receiver ####################
33 Class FCARcvr/Tcl/Local -superclass FCARcvr/Tcl
34 FCARcvr/Tcl/Local instproc init { mgr srcId } {
35 # outstandingPkts_ requests_ pendingCancelIds_ pendingRls_
36 # haveImportant_
37 $self next $mgr $srcId
38 $self set outstandingPkts_ {}
39 #$self set haveImportant_ 0
40 }
41
42
43 # whether there are more ADUs to send
44 FCARcvr/Tcl/Local instproc more_ADU {} {
45 $self instvar outstandingPkts_
46 return [llength $outstandingPkts_]
47 }
48
49
50 #--- SRM callbacks ---#
51 #FCARcvr/Tcl/Local instproc handle_request { fcaPkt } {
52 # DbgOut "FCARcvr/Tcl/Local::handle_request, repair request feed back to \
53 # local rcvr."
54 # return
55 #}
56
57
58 # return FCA_Packet to be sent by periodic_update
59 FCARcvr/Tcl/Local instproc create_sa { fcaPkt } {
60 $self instvar requests_ important_ mgr_ srcId_
61 $fcaPkt set pktType "PKT_PARTICIPANT_SA"
62 $fcaPkt set maxRequestId [$requests_ maxRequestId]
63 $fcaPkt set maxImportantSeqno [$important_ maxSeqno]
64 }
65
66
67 # return FCA_Packet filled by next_ADU
68 FCARcvr/Tcl/Local instproc next_ADU {} {
69 $self instvar outstandingPkts_
70 if { [llength $outstandingPkts_] == 0 } {
71 DbgOut "no outstanding packets"
72 return ""
73 }
74 DbgOut "Outstanding pkt list: *$outstandingPkts_*"
75 set pkt [lindex $outstandingPkts_ 0]
76 set outstandingPkts_ [lreplace $outstandingPkts_ 0 0]
77 return $pkt
78 }
79
80
81 # SRM callbacks
82 FCARcvr/Tcl/Local instproc handle_SA {fcaPkt} {
83 # DbgOut "FCARcvr/Tcl/Local::handle_SA, SA feedback to local rcvr"
84 return
85 }
86
87
88 #FCARcvr/Tcl/Local instproc handle_reply {fcaPkt} {
89 # DbgOut "FCARcvr/Tcl/Local::handle_reply, reply feedback to local rcvr"
90 # return
91 #}
92
93
94
95 #--- send messages ---#\
96 # called from UI
97 # floorRequest is of class FCAFloorRequest
98 # floorRequest only have floorTypes and comment set
99 FCARcvr/Tcl/Local instproc sendFloorRequest { ftypes comment } {
100 $self instvar mgr_ outstandingPkts_ srcId_ requests_
101
102 set requestId [expr [$requests_ maxRequestId] + 1]
103 set floorRequest [new FCAFloorRequest $srcId_ $requestId \
104 $ftypes $comment]
105 $requests_ got_request $requestId $floorRequest
106 DbgOut "Added request *$floorRequest* for $srcId_:$requestId"
107
108 set fcd [$mgr_ fcDynamics]
109 $fcd new_pending_request $floorRequest
110 ## UI
111 #[$mgr_ set uiMgr_] add_pending $floorRequest
112
113 set fcaPkt [new FCA_Packet]
114 $fcaPkt set pktType "PKT_FLOOR_REQUEST"
115 $fcaPkt set requestId $requestId
116 $fcaPkt set comment $comment
117 $fcaPkt set floors $ftypes
118 $fcaPkt set numFloors [llength $ftypes]
119
120 lappend outstandingPkts_ $fcaPkt
121 $mgr_ request_send $fcaPkt
122 }
123
124
125
126 #Called from UI, request is of Class FCAFloorRequest
127 FCARcvr/Tcl/Local instproc sendFloorCancel { request } {
128 $self instvar mgr_ outstandingPkts_ requests_ important_
129 set requestId [$request requestId]
130 set fcDynamics [$mgr_ fcDynamics]
131
132 set fcaPkt [new FCA_Packet]
133 $fcaPkt set pktType "PKT_FLOOR_CANCEL"
134
135 DbgOut "Trying to remove [$request srcId]:$requestId from the admit q"
136 if { [$fcDynamics remove_admitted_request [$request srcId] $requestId] } {
137 # this is an admitted request; we must set a seqno for this cancel
138 $fcaPkt set seqno [$important_ add cancel $requestId]
139 } else {
140 # this is probably a pending request
141
142 $fcDynamics delete_pending_request [$request srcId] $requestId
143 $fcaPkt set seqno 0
144 }
145
146 $requests_ cancel $requestId
147 $fcaPkt set requestId $requestId
148 lappend outstandingPkts_ $fcaPkt
149 $mgr_ request_send $fcaPkt
150 }
151
152
153 # called from UI
154 FCARcvr/Tcl/Local instproc sendFloorRelease { ftype instance } {
155 $self instvar mgr_ nextFcaPkt_ pendingRls_ srcId_ \
156 outstandingPkts_
157 #set $haveImportant_ 1
158 set $fcd [$mgr fcDynamics]
159 set grantSeq [$fcd getLastGrantSeq $ftype $instance]
160 set releaseRq [new FloorGrant $ftype $instance $grantSeq $srcId_]
161
162 # save
163 set pendingRls_([$floorRelease set grantSeqNo_]) $floorRelease
164 # update UI
165 [$mgr_ set uiMgr_] release_received $ftype $instance
166
167 set fcaPkt [new FCA_Packet]
168 $fcaPkt set pktType "PKT_FLOOR_RELEASE"
169 $fcaPkt set srcId $srcId_
170 $fcaPkt set grantSeqno $grantSeq
171 $fcaPkt set floorType $ftype
172 $fcaPkt set floorInstance $instance
173 $fcaPkt set isGrant 0
174
175 lappend outstandingPkts_ $fcaPkt
176 $mgr_ request_send $fcaPkt
177 }
178
179
180 ################# moderator local receiver ###############
181 # next_ADU is inherited from above
182 Class FCARcvr/Tcl/LocalModerator -superclass { FCARcvr/Tcl/Local FCARcvr/Tcl/Moderator }
183
184 FCARcvr/Tcl/LocalModerator instproc init { mgr srcId } {
185 $self next $mgr $srcId
186 $self instvar topGrantSeq_
187 set topGrantSeq_ 1
188 }
189
190 #---- SRM Callbacks ----#
191
192 # return FCA_Packet to be sent by periodic_update
193 FCARcvr/Tcl/LocalModerator instproc create_sa { fcaPkt } {
194 $self instvar mgr_
195 $self next $fcaPkt
196 $fcaPkt set pktType "PKT_MODERATOR_SA"
197 set fcd [$mgr_ fcDynamics]
198 $fcaPkt set currentState [$fcd moderator_state]
199 # DbgOut "FCARcvr/Tcl/LocalModerator::create_sa, about to send mod SA "
200 }
201
202 #---- Send messages ----#
203 # sendFloorRequest sendFloorRelease sendFloorCancel inherited from Local
204
205
206
207 # requests is a list of {srcId requestId} pairs
208 FCARcvr/Tcl/LocalModerator instproc sendQueueUpdate { isAdd requests state } {
209 DbgOut "Sending queue update for *$requests*"
210 $self instvar mgr_ outstandingPkts_
211 set fcaPkt [new FCA_Packet]
212 $fcaPkt set pktType "PKT_QUEUE_UPDATE"
213 $fcaPkt set moderatorState $state
214 $fcaPkt set numUpdates [llength $requests]
215 $fcaPkt set pktUpdates {}
216 DbgOut "isAdd is $isAdd"
217 foreach rq $requests {
218 set pktUpdate [new FCA_Packet]
219 $pktUpdate set srcId [lindex $rq 0]
220 $pktUpdate set requestId [lindex $rq 1]
221 $pktUpdate set isAdd $isAdd
222
223
224 # don't bother updating the UI here!
225
226 ## update UI
227 #if {$isAdd} {
228 # [$mgr_ set uiMgr_] add_admit $rq
229 #} else {
230 # [$mgr_ set uiMgr_] remove_admit $rq
231 #}
232
233
234 $fcaPkt lappend pktUpdates $pktUpdate
235 }
236
237 lappend outstandingPkts_ $fcaPkt
238 $mgr_ request_send $fcaPkt
239 }
240
241
242 #FCARcvr/Tcl/LocalModerator instproc sendCancelUpdate {srcId requestId state} {
243 # $self instvar mgr_ outstandingPkts_
244 # set fcaPkt [new FCA_Packet]
245 # $fcaPkt set pktType "PKT_CANCEL_UPDATE"
246 # $fcaPkt set moderatorState $state
247 # $fcaPkt set numUpdates 1
248 #
249 # set pktUpdate [new FCA_Packet]
250 # $pktUpdate set srcId $srcId
251 # $pktUpdate set requestId $requestId
252 # $fcaPkt set pktUpdates $pktUpdate
253 #
254 # lappend outstandingPkts_ $fcaPkt
255 # $mgr_ request_send $fcaPkt
256 #}
257
258
259
260
261
262 # called by UI floor grant to someone who is not in the admitted floor
263 # request list
264 FCARcvr/Tcl/LocalModerator instproc uiGrantParticipant { ftypes srcId } {
265 $self instvar mgr_ topGrantSeq_
266 # create request object
267 set rq [new FCAFloorRequest $srcId 0 $ftypes ""]
268 $self uiGrant $rq
269 }
270
271
272 # called by UI request is of type FCAFloorRequest
273 FCARcvr/Tcl/LocalModerator instproc uiGrant { request } {
274 $self instvar mgr_ topGrantSeq_
275
276 set fcd [$mgr_ fcDynamics]
277 set grants {}
278 set fcdChanged 0
279
280 foreach ftype [$request set floorTypes_] {
281 set instance [$fcd getFreeInstance $ftype]
282 if { $instance == -1 } {
283 ## !! for now
284 set instance 0
285 }
286 lappend grants "$topGrantSeq_ $ftype $instance"
287 if { [$fcd grant_floor $ftype $instance [$request srcId] \
288 [$request requestId] $topGrantSeq_] } {
289 set fcdChanged 1
290 }
291 incr topGrantSeq_ 1
292 }
293
294 if { $fcdChanged } {
295 set state [$fcd incr_moderator_state]
296 set isGrant 1
297 $self send_grant_update "PKT_GRANT_UPDATE" [$request srcId] \
298 [$request requestId] 1 $grants $state
299 } else {
300 DbgOut "no floor is granted, something wrong"
301 }
302 }
303
304
305 # grants is a list of {grantSeq floorType floorInstance} pairs
306 FCARcvr/Tcl/LocalModerator instproc send_grant_update { pktType srcId \
307 requestId isGrant grants moderatorState } {
308 $self instvar mgr_ outstandingPkts_ topGrantSeq_
309
310 # packetize and send out
311 set fcaPkt [new FCA_Packet]
312 $fcaPkt set pktType $pktType
313 $fcaPkt set moderatorState $moderatorState
314 $fcaPkt set numUpdates [llength $grants]
315 $fcaPkt set pktUpdates {}
316
317 foreach grant $grants {
318 set pktUpdate [new FCA_Packet]
319 #$pktUpdate set isGrant $isGrant
320 $pktUpdate set srcId $srcId
321 $pktUpdate set grantSeqno [lindex $grant 0]
322
323 $pktUpdate set requestId $requestId
324 $pktUpdate set floorType [lindex $grant 1]
325 $pktUpdate set floorInstance [lindex $grant 2]
326 $fcaPkt lappend pktUpdates $pktUpdate
327 }
328 lappend outstandingPkts_ $fcaPkt
329 $mgr_ request_send $fcaPkt
330 }
331
332
333
334 # request for the floor only if we don't already have a pending/admitted
335 # request for the same floor-type
336
337 FCARcvr/Tcl/Local instproc auto_request_floor { floorType } {
338 set r [$self set requests_]
339 $r instvar requests_
340 foreach entry [array names requests_ *] {
341 if { [$r have $entry] } {
342 # make sure this entry contains a valid request object
343 set ftypes [[$r get $entry] floorTypes]
344 if { [lsearch $ftypes $floorType] != -1 } {
345 # we found a matching entry,why should we care to add a new one
346 return
347 }
348 }
349 }
350
351 # we should create a new request
352 $self sendFloorRequest $floorType \
353 "$floorType floor requested by media agent"
354 }
355
356
357
358 # called when the admitted queue has available slots
359 # return list of new requests that have been admitted
360 #FCARcvr/Tcl/LocalModerator instproc admitRequests {} {
361 # $self instvar mgr_
362 # set returnlist {}
363 # set fcd [$mgr_ fcDynamics]
364 # while {![$fcd isRequestQFull]} {
365 # set pRqst [$fcd nextPendingRequest]
366 # if { $pRqst != "" } {
367 # set success [$fcd newFloorRequest $pRqst]
368 # if {$success} {
369 # set returnlist [lappend $returnlist $pRqst]
370 # } else {
371 # DbgOut "FCARcvr/Tcl/LocalModerator::admit, failed"
372 # }
373 # } else {
374 # DbgOut "next pending request is blank"
375 # }
376 # }
377 # return $returnlist
378 #}
379
380 # called when the floor instances have vacancies, return FloorGrant object
381 #FCARcvr/Tcl/LocalModerator instproc admitNewHolder {ftype instance} {
382 # $self instvar mgr_ topGrantSeq_
383 # set fcd [$mgr_ fcDynamics]
384 # set rqst [$fcd getFloorRequest $ftype $instance]
385 # if {$rqst == ""} {
386 # DbgOut "no admitted floor requests in the queue"
387 # return ""
388 # }
389 # set success [$fcd grantHolder $ftype $instance [$rqst set srcId_] $topGrantSeq_]
390 # if { $success } {
391 # $fcd deleteFloorRequest [$rqst set srcId_] [$rqst set requestId_]
392 # set grantUpdate [new FloorGrant $ftype $instance $topGrantSeq_ [$rqst set srcId_] [$rqst set requestId_]]
393 # incr topGrantSeq_ 1
394 # return $grantUpdate
395 # }
396 # return ""
397 #}
398
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.