#!/usr/bin/perl

use strict;
use warnings;

use threads;
use threads::shared;


my %SUSPEND :shared;    # Thread suspension counts by TID

# Set up the suspend signal handler
$SIG{'STOP'} = sub {
    my $tid = threads->tid();
    lock(%SUSPEND);
    while ($SUSPEND{$tid}) {
        cond_wait(%SUSPEND);
    }
};

# Set up the thread termination signal handler
$SIG{'KILL'} = sub {
    threads->exit();
};


# Add methods to 'threads' namespace

sub threads::suspend
{
    # Suspend threads
print("Debug: locking\n");
    lock(%SUSPEND);
print("Debug: locked\n");
    foreach my $thr (@_) {
        my $tid = $thr->tid();
print("Debug: got tid\n");
        # Increment suspension count
        if (! $SUSPEND{$tid}++) {
            # Send suspend signal if not currently suspended
            $thr->kill('STOP');
            if (! $thr->is_running()) {
                # Thread terminated before it could be suspended
                delete($SUSPEND{$tid});
            }
print("Debug: signal sent\n");
        }
print("Debug: not hung\n");
    }
}


sub threads::resume
{
    # Resume threads
    my $resume = 0;
print("Debug: locking\n");
    lock(%SUSPEND);
print("Debug: locked\n");
    foreach my $thr (@_) {
        my $tid = $thr->tid();
print("Debug: got tid\n");
        if ($SUSPEND{$tid}) {
            # Decrement suspension count
            if (! --$SUSPEND{$tid}) {
                # Suspension count reached zero
                $resume = 1;
                delete($SUSPEND{$tid});
            }
        }
print("Debug: not hung\n");
    }
    # Broadcast any resumptions
    if ($resume) {
print("Debug: broadcasting\n");
        cond_broadcast(%SUSPEND);
print("Debug: broadcasted\n");
    }
}


# Create some threads

our %CHECKER :shared;

sub checker
{
    my $tid = threads->tid();
    while (1) {
        delete($CHECKER{$tid});
        threads->yield();
    }
}

my @threads;
push(@threads, threads->create('checker')) for (1..10);

# Test thread suspension

foreach my $thr (@threads) {
    my $tid = $thr->tid();

    print("Suspending thread $tid once\n");
    $thr->suspend();

    print("Suspending thread $tid twice\n");
    $thr->suspend();

    print("Resuming thread $tid once\n");
    $thr->resume();

    print("Resuming thread $tid twice\n");
    $thr->resume();
}


# Cleanup

$_->kill('KILL')->join() foreach (@threads);

print("Done\n");
exit(0);

# EOF