Sign In/My Account | View Cart  
advertisement


Listen Print

Going Up?
by Sam Tregar | Pages: 1, 2, 3, 4

The Person Class

Now that we've looked at the machinery, let's turn our attention to the inhabitants of this building, the people. Each person thread is created with a goal - ride an elevator up to the assigned floor, wait a bit and then ride an elevator back down. Person threads are also responsible for keeping track of how long they wait for the elevator and how long they ride. When they finish they report this information back to the main thread where it is output for your edification.

Person::run() starts the same way as Elevator::run(), by creating a new object:


  # run a Person thread, takes an id and a destination floor as
  # arguments.  Creates a Person object.
  sub run {
      my $self = Person->new(@_);

Inside Person::new() two attributes are setup to keep track of the person's progress, floor and elevator:


  # create a new Person object
  sub new {
      my $pkg = shift;
      my $self = { @_,
                   floor    => 0,
                   elevator => 0 };
      return bless($self, $pkg);
  }

Back in Person::run() the person thread begins waiting for the elevator by calling $self->wait(). The calls to time() will be used later to report on how long the person waited.


  # wait for elevator going up
  my $wait_start1 = time;
  $self->wait;
  my $wait1 = time - $wait_start1;

The wait() method is responsible for waiting until an elevator arrives and opens its doors on this floor:


  # wait for an elevator
  sub wait {
      my $self = shift;

      print "Person $self->{id} waiting on floor 1 for elevator ",
        "to floor $self->{dest}.\n";

      while(1) {
          $self->press_button();
          lock(%DOOR);
          cond_wait(%DOOR);
          for (0 .. $NUM_ELEVATORS - 1) {
              if ($DOOR{"$_.$self->{floor}"}) {
                  $self->{elevator} = $_;
                  return;
              }
          }
      }
  }

  # signal an elevator to come to this floor
  sub press_button {
      my $self = shift;
      lock @BUTTON;
      $BUTTON[$self->{floor}] = 1;
  }

Related Reading

Perl Pocket Reference, 4th Edition

Perl Pocket Reference, 4th Edition
By Johan Vromans

Table of Contents
Index

After printing out a message, the code enters an infinite loop waiting for the elevator. At the top of the loop, the press_button() method is called. press_button() locks @BUTTON and sets $BUTTON[$self->{floor}] to 1. This will tell the elevators that a person is waiting on the ground floor.

The code then locks %DOOR and calls cond_wait(%DOOR). This has the effect of releasing the lock on %DOOR and putting the thread to sleep until another thread does a cond_broadcast(%DOOR) (or cond_signal(%DOOR), a variant of cond_broadcast() that just wakes a single thread). When the thread wakes up again it re-acquires the lock on %DOOR and then checks to see if the door that just opened is on this floor. If it is the person notes the elevator and returns from wait().

If there's no elevator on the floor where the person is waiting, the loop is run again. The person presses the button again and then goes back to sleep waiting for the elevator. You might be wondering why the call to press_button() is inside the loop instead of outside. The reason is that it is possible for the person to wake up from cond_wait() but have to wait so long to re-acquire the lock on %DOOR that the elevator is already gone.

Once the elevator arrives, control returns to run() and the person boards the elevator:


    # board the elevator, wait for arrival at destination floor and get off
    my $ride_start1 = time;
    $self->board;
    $self->ride;
    $self->disembark;
    my $ride1 = time - $ride_start1;

The board() method is simple enough. It just turns off the @BUTTON entry used to summon the elevator and presses the appropriate button inside the elevator's %PANEL:


  # get on an elevator
  sub board {
      my $self = shift;
      lock @BUTTON;
      lock %PANEL;
      $BUTTON[$self->{floor}] = 0;
      $PANEL{"$self->{elevator}.$self->{dest}"} = 1;
  }

Next, the run() code calls ride() which does another cond_wait() on %DOOR, this time waiting for the door in the elevator to open on the destination floor:


  # ride to the destination
  sub ride {
      my $self = shift;

      print "Person $self->{id} riding elevator $self->{elevator} ",
        "to floor $self->{dest}.\n";

      lock %DOOR;
      cond_wait(%DOOR) until $DOOR{"$self->{elevator}.$self->{dest}"};
  }

When the elevator arrives, ride() will return and the person thread calls disembark(), which clears the entry in %PANEL for this floor and sets the current floor in $self->{floor}.


  # get off the elevator
  sub disembark {
      my $self = shift;



      print "Person $self->{id} getting off elevator $self->{elevator} ",
        "at floor $self->{dest}.\n";


      lock %PANEL;
      $PANEL{"$self->{elevator}.$self->{dest}"} = 0;
      $self->{floor} = $self->{dest};
  }

After reaching the destination floor, the person thread waits for $PEOPLE_WAIT seconds and then heads back down by repeating the steps again with $self->{dest} set to 0:


    # spend some time on the destination floor and then head back
    sleep $PEOPLE_WAIT;
    $self->{dest} = 0;

When this is complete the person has arrived at the ground floor. The thread ends by returning the recorded timing data with return:


    # return wait and ride times
    return ($wait1, $wait2, $ride1, $ride2);

The Grand Finale

While the simulation is running the main thread is sitting in init_people() creating person threads periodically. Once this task is complete the finish() routine is called.

The first task of finish() is to collect statistics from the people threads as they complete:


  # finish the simulation - join all threads and collect statistics
  sub finish {
      our (@people, @elevators);



      # join the people threads and collect statistics
      my ($total_wait, $total_ride, $max_wait, $max_ride) = (0,0,0,0);
      foreach my $person (@people) {
          my ($wait1, $wait2, $ride1, $ride2) = $person->join;
          $total_wait += $wait1 + $wait2;
          $total_ride += $ride1 + $ride2;
          $max_wait    = $wait1 if $wait1 > $max_wait;
          $max_wait    = $wait2 if $wait2 > $max_wait;
          $max_ride    = $ride1 if $ride1 > $max_ride;
          $max_ride    = $ride2 if $ride2 > $max_ride;
      }

To extract return values from a finished thread the join() method must be called on the thread object. This method will wait for the thread to end, which means that this loop won't finish until the last person reaches the ground floor.

Once all the people are processed, the simulation is over. To tell the elevators to shutdown the shared variable $FINISHED is set to 1 and the elevators are joined:


  # tell the elevators to shut down
  { lock $FINISHED; $FINISHED = 1; }
  $_->join for @elevators;

If this code were omitted the simulation would still end but Perl would print a warning because the main thread exited with other threads still running.

Finally, finish() prints out the statistics collected from the person threads:


  # print out statistics
  print "\n", "-" x 72, "\n\nSimulation Complete\n\n", "-" x 72, "\n\n";
  printf "Average Wait Time: %6.2fs\n",   ($total_wait / ($NUM_PEOPLE * 2));
  printf "Average Ride Time: %6.2fs\n\n", ($total_ride / ($NUM_PEOPLE * 2));
  printf "Longest Wait Time: %6.2fs\n",   $max_wait;
  printf "Longest Ride Time: %6.2fs\n\n", $max_ride;

The end!

A Few Wrinkles

Overall, the simulator was a fun project with few major stumbling blocks. However, there were a few problems or near problems that you would do well to avoid.

Deadlock

All parallel programs are susceptible to deadlock, but, by virtue of higher levels of inter-activity, threads suffer it more frequently. Deadlock occurs when independent threads (or processes) each need a resource the other has.

In the elevator simulator I avoided deadlock by always performing multiple locks in the same order. For example, Elevator::next_dest() begins with:


  lock @BUTTON;
  lock %PANEL;

And in Person::board() the same sequence is repeated:


  lock @BUTTON;
  lock %PANEL;

If the lock calls in Person::board() were reversed then the following could occur:

  1. Elevator 2 locks @BUTTON.
  2. Person 3 locks %PANEL.
  3. Elevator 2 tries to lock %PANEL and blocks waiting for Person 3's lock.
  4. Person 3 tries to lock @BUTTON and blocks waiting for Elevator 2's lock.
  5. Deadlock! Neither thread can proceed and the simulation will never end.

Modules

In general, unless a module has been specifically vetted as thread safe it cannot be used in a threaded program. Most pure Perl modules should be thread safe but most XS modules are not. This goes for core modules too!

An earlier version of the elevator simulator used Time::HiRes to allow for fractional sleep() times. This really helped speed up the simulation since it meant that elevators could traverse more than one floor per second. However, on further investigation (and advice from Nick Ing-Simmons) I realized that Time::HiRes is not necessarily thread safe. Although it seemed to work fine on my machine there's no reason to believe that would be the case elsewhere, or even that it wouldn't blow up at some random point in the future. The problem with thread safety is that it's virtually impossible to test for; either you can prove you have it or you must assume you don't!

Synchronized rand()

The first version of the simulator I wrote had the people threads calling rand() inside Person::run() to choose the destination floor. I also had a call to srand() in the main thread, not realizing that Perl now calls srand() with a good seed automatically. The combination resulted in every person choosing the same destination floor. Yikes!

The reason for this is that by calling srand() in the main thread I set the random seed. Then when the threads were created that seed was copied into each thread. The call to rand() then generated the same first value in each thread.

Resources

Perl comes with copious threading documentation. You can read these docs by following the links below or by using the perldoc program that comes with Perl.