/usr/share/amsn/mutex.tcl is in amsn-data 0.98.9-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | ::Version::setSubversionId {$Id: mutex.tcl 8064 2007-02-23 00:50:59Z lephilousophe $}
#Init the ticket variable. Resources is the amount of processes
#that can run the given command at same time
proc init_ticket { ticket { resources 1 }} {
upvar #0 ${ticket}_inputs ticket_inputs
upvar #0 ${ticket}_outputs ticket_outputs
set ticket_inputs 0
set ticket_outputs [expr {$ticket_inputs + $resources}]
}
#Procedure used to avoid race conditions, using a ticket systems
proc run_exclusive { command ticket {ticket_val ""}} {
global errorInfo errorCode
upvar #0 ${ticket}_inputs ticket_inputs
upvar #0 ${ticket}_outputs ticket_outputs
#Use kind of mutex here (really a ticket counter)
#Get my turn
if { $ticket_val == "" } {
set my_ticket [incr ticket_inputs]
} else {
set my_ticket $ticket_val
}
#Wait until it's my turn
if {$my_ticket != $ticket_outputs } {
after 100 [list run_exclusive $command $ticket $my_ticket]
status_log "UPS! Another instance of command $command. Avoid interleaving by waiting 100ms and try again\n" white
} else {
set hasError [catch "eval $command" errorMsg]
#Give next turn
incr ticket_outputs
if { $hasError } {
error $errorMsg $errorInfo $errorCode
}
}
}
proc SendMessageFIFO { command stack lock } {
if { ![info exists $stack] } {
set $stack [list ]
}
# Add message to queue
lappend $stack $command
FlushMessageFIFO $stack $lock
}
proc FlushMessageFIFO { stack lock } {
# Make sure only one "person" is writing to the window
if { [info exists $lock] } { return }
set $lock 1
#do the job until there's no message to send in the stack
while { [set $stack] != [list]} {
#sending the message
#the first message to send is the first element of the stack
set command [lindex [set $stack] 0]
eval $command
# remove the message from the stack
set $stack [lreplace [set $stack] 0 0]
}
unset $stack
unset $lock
}
|