Chapter 11

1. Chapter 11 Multithreaded Applications

2. About threads: • Instead of two processes with individual memory, signal handlers, global variables, a multithreaded program is a single process sharing • global variables, • filehandles, • signal handlers, • other resources. • Much easier to share resources but also much more likely, the possibility of contention. • Solution: resource locking.

3. Thread API: • Described in Thread, Thread::Queue, Thread::Semaphore and attrsperldoc pages. • Every program starts with a default thread – the main thread. $> perldoc Thread::Queue

4. new() my $thread = Thread->new(\&calculate_pi, precision => 190); pass the function’s arguments pass a function reference NOTE: This is an example of what are called named parameters. Suppose we have a function foo() with three parameters – A, B and C. If we supply default values to all three parameters and call foo(B=>4) then the default values are used for parameters A and C and the parameter B is passed a 4. sub foo { my %params = {A => 1, B=> 2, C=> 3}; my %args = @_; my ($key, $A,$B,$C); foreach $key (keys %args) { $params{$key} = $args{$key} } $A = $params{‘A’); $B = $params{‘B’}; $C = $params{‘C’); … }

5. Detached Threads: • Threads can be detached from their calling environment, in which case the return value to calculate_pi() is lost to the calling environment. • Alternatively, the calling environment can “wait” for calculate_pi() to complete and recover its return value. • In fact, while only parents can wait() for a child, any thread can “wait” for another thread by calling join(). • join() blocks until the executing thread terminates. • Threads terminate by having their subroutines return. • Thread subroutines should not call exit(). $thread->detach(); my $pi = $thread->join();

6. Signal handlers: • Only the main thread should install signal handlers. You have no guarantee what thread will receive a handled signal. • Threads can call die() and it won’t kill the program – immediately. It will kill the program once the corresponding call to join() returns. my $thread1 = Thread->new(\&foo); my $thread2 = Thread->new(\&bar); $thread1->join(); $thread2->join(); sub bar { … die “bar is dead”; } the program only terminates abnormally after both threads complete.

7. But I don’t want to die!! my $x = eval {$thread2->join() } || warn “And I did not die!”; the eval{} block catches the die() and only it dies.

8. A Simple Example: #!/usr/bin/perl #hello.pl use Thread; my $thread1 = Thread->new(\&hello, “I am thread 1”,3); my $thread2 = Thread->new(\&hello, “I am thread 2”,6); $_->join foreach ($thread1,$thread2); sub hello { my ($msg,$loop) = @_; for (1..$loop) { print $msg,”\n”; sleep 1; } } $> perl hello.pl I am thread 1 I am thread 2 I am thread 1 I am thread 2 I am thread 1 I am thread 2 I am thread 2 I am thread 2 I am thread 2

9. Locking: my $bytes_sent = 0; my $socket = IO::Socket->new(. . .); sub send_data { my $data = shift; my $bytes = $socket->syswrite($data); $bytes_sent += $bytes; } • Suppose we have multiple connections, all writing at more or les the same time. • Thread 1 fetches a copy of $bytes_sent and prepares to increment it • Context switch happens and thread 2 takes control. It fetches $bytes_sent and increments it. • Context switch happens and thread 1 takes control. Thread 1 still holds the old value of $bytes_sent which it updates and saves to the global location. Thread 2’s changes are lost.

10. Locking (2): • This won’t happan all the time but from time to time – which is even worse. • The fix: lock(); my $bytes_sent = 0; my $socket = IO::Socket->new(. . .); sub send_data { my $data = shift; my $bytes = $socket->syswrite($data); lock($bytes_sent); $bytes_sent += $bytes; } prevents others from attempting to get a lock on $bytes_sent but not from reading it. lock stays in place until the end of the routine. called an “advisory” lock any other thread that tries to lock($bytes_sent) is suspended until the lock is achieved.

11. Locking (3): • If you are modifying multiple variables don’t try to lock them all. • Create a special variable just for locking. my $ok_to_update ; sub send_data { my $data = shift; my $bytes = $socket->syswrite($data); lock($ok_to_update); $bytes_sent += $bytes; $bytes_left -= $bytes; }

12. Locking (4): • You can also lock an entire subroutine. • When a subroutine is locked only one thread can execute it at a time. • Safe only for small routines; otherwise we get threads in serial and not in parallel. lock(\&foo); as is, up to 4 cars can be in the intersection at a time but with lock(\&use_intersection); only one car at a time can.

13. Locking (5); • No need to lock unshared (local) variables. • Lock object references only if the object is shared by multiple threads. • Object methods that modify a shared object should lock the object sub acknowledge { # not thread safe my $self = shift; print $self>{socket} “200 OK\n”; $self->{acknowledged}++; } sub acknowledge { # thread safe my $self = shift; lock($self); print $self>{socket} “200 OK\n”; $self->{acknowledged}++; } what is being locked; the object or the reference? lock() follows references one level only so lock($self) ~ lock(%$self);

14. Locking (6): sub acknowledge: locked method { my $self = shift; print $self>{socket} “200 OK\n”; $self->{acknowledged}++; } locks the object sub acknowledge: locked { my $self = shift; print $self>{socket} “200 OK\n”; $self->{acknowledged}++; } locks the subroutine Difference: different connections ($self) can simultaneously use acknowledge() at the same time in case 1 but not in case 2

15. Thread Functions: $thread = Thread->new(\&subroutine [, @arguments]); $return_value = $thread->join(); $thread->detach(); • new() creates and starts a new thread. join() blocks until the thread terminates. Once you detach() you can not join() later. The main thread is free. • list() returns a list of thread objects. The list includes running and dead but not joined threads • lock(@array) is not the same as lock($array[2]). @threads = Thread->list(); $thread = Thread->self(); $tid = $thread->tid(); lock($variable);

16. Thread Functions: use Thread qw(async yield coond_wait cond_signal cond_broadcast); $thread = async{BLOCK}; yield(); cond_wait($variable); cond_signal($variable); cond_broadcast($variable); • All these need to be explicitly imported. • async{} is an alternative way to create a new thread. • yield() is the current thread hint that a context switch would be a good idea – NOW. • unlocks a locked variable and waits until another thread signals the same variable with cond_signal() or cond_broadcast().

17. Thread Functions (2): • cond_signal($variable) signals $variable, restarting any threads that are cond_waiting() on the same variable. • If multiple threads are waiting on $variable, one and only one is woken up. • cond_broadcast($variable) signals $variable, restarting all threads that are cond_waiting() on the same variable. • Each awakened thread acquires a lock on $variable in turn. • In both cond_signal($variable) and cond_broadcast($variable) there is no way to determine which thread will be woken up.

18. Threads and Signals: • The book tells us so little it is best to keep clear of it.

19. A Multithreaded Eliza: #!/usr/bin/perl # file: eliza_thread.pl # Figure 11.1: Multithreaded psychiatrist server use strict; use IO::Socket; use Thread; use Chatbot::Eliza::Server; use constant PORT => 12000; my $listen_socket = IO::Socket::INET->new(LocalPort => PORT, Listen => 20, Proto => 'tcp', Reuse => 1); die $@ unless $listen_socket; warn "Listening for connections...\n";

20. A Multithreaded Eliza (2): while (my $connection = $listen_socket->accept) { Thread->new(\&interact,$connection); } sub interact { my $handle = shift; Thread->self->detach; Chatbot::Eliza::Server->new->command_interface($handle,$handle); $handle->close(); } listening server can ignore the service thread new object new object invokes method

21. A Multithreaded Eliza (3): #!/usr/bin/perl # file: eliza_thread.pl # Figure 11.1: Multithreaded psychiatrist server use strict; use IO::Socket; use Thread; use Chatbot::Eliza::Server; use constant PORT => 12000; my $listen_socket = IO::Socket::INET->new(LocalPort => PORT, Listen => 20, Proto => 'tcp', Reuse => 1); die $@ unless $listen_socket; warn "Listening for connections...\n";

22. A Multithreaded Eliza (4): package Chatbot::Eliza::Server; use Chatbot::Eliza; # file: Chatbot/Eliza/Server.pm # Figure 11.2: The Chatbot::Eliza::Server class @ISA = 'Chatbot::Eliza'; sub command_interface { my $self = shift; my $in = shift || \*STDIN; my $out = shift || \*STDOUT; my ($user_input, $previous_user_input, $reply); $self->botprompt($self->name . ":\t"); # Set Eliza's prompt $self->userprompt("you:\t"); # Set user's prompt # Print an initial greeting print $out $self->botprompt, $self->{initial}->[ int rand scalar @{ $self->{initial} } ], "\n"; tells perl to look in Charbot::Eliza if it can’t find a method, botprompt() for example, in this module. size index

23. A Multithreaded Eliza (5): while (1) { print $out $self->userprompt; $previous_user_input = $user_input; chomp( $user_input = <$in> ); last unless $user_input; # User wants to quit if ($self->_testquit($user_input) ) { $reply = $self->{final}->[ int rand scalar @{ $self->{final} } ]; print $out $self->botprompt,$reply,"\n"; last; } # Invoke the transform method to generate a reply. $reply = $self->transform( $user_input ); # Print the actual reply print $out $self->botprompt,$reply,"\n"; } } 1;

24. A Multithreaded Client: #!/usr/bin/perl # file: gab4.pl # Figure 11.3: Threaded concurrent client # usage: gab4.pl [host] [port] use strict; use IO::Socket; use Thread; use constant BUFSIZE => 1024; $SIG{TERM} = sub { exit 0 }; my $host = shift or die "Usage: gab4.pl host [port]"; my $port = shift || 'echo'; my $socket = IO::Socket::INET->new("$host:$port") or die $@; # thread reads from socket, writes to STDOUT my $read_thread = Thread->new(\&host_to_user,$socket);

25. A Multithreaded Client: # main thread reads from STDIN, writes to socket user_to_host($socket); $socket->shutdown(1); $read_thread->join; sub user_to_host { my $s = shift; my $data; syswrite($s,$data) while sysread(STDIN,$data,BUFSIZE); } sub host_to_user { my $s = shift; my $data; syswrite(STDOUT,$data) while sysread($s,$data,BUFSIZE); return 0; } 1: shutdown() starts with EOF from STDIN; propagates EOF to server 3: when thread terminates join() returns and the main thread exits. 2: server gets EOF and returns and in doing so closes its end of the connection