#!/usr/bin/perl 

# J.Kobus 27/11/2004, 28/11/2005 27/11/2006 30/11/2011 9/01/2015

# Producer-consumer problem using semaphores (A.S.Tanenbaum, Modern
# Operating Systems, p.43)

# Uwaga. Zamiast korzystania z trzech różnych obiektów można utworzyć jeden obiekt, z
# którym związana jest tablica semaforów

my ($empty, $empty_slots, $full, $full_slots, $mutex);
my ($comm, $d, $maxitem, $user, $usleep);

my ($usertime, $systemtime, $maxrss, $ixrss, $idrss, $isrss, $minflt, $majflt, $nswap,
    $inblock, $oublock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $nivcsw);

our ($opt_e, $opt_h, $opt_r, $opt_s, $opt_u);


use Getopt::Std;
use Text::Wrap;
use Errno qw(EAGAIN);
use IPC::SysV qw(IPC_PRIVATE S_IRWXU IPC_CREAT);
use IPC::Semaphore;
use Time::HiRes qw(gettimeofday usleep);
use BSD::Resource;
use strict;


getopts('e:hs:u:');

if ($opt_h) {
    help();
}

if ($opt_r) {
    # remove semaphors; handy option when you see the following message 
    # 'Can't call method "getval" on an undefined value at ...'

    $user=$ENV{USER};
    system (" ipcs -s | grep $user  | gawk \'\{print \$2\}\'  >  /tmp/.ipcstmp" );
    open (TMP,"</tmp/.ipcstmp");
    while (<TMP>) {
	if ( ! "" ) {
	    system ("ipcrm -s $_");
	}
    }
    exit;
}

if ($opt_s) {
    $empty_slots = $opt_s;
} else {
    $empty_slots = 5;
}

if ($opt_e) {
    $maxitem = $opt_e;
} else {
    $maxitem = 10;
}


if ($opt_u) {
    $usleep = $opt_u;
} else {
    $usleep = 1000;
}

my $run_prod = shift || 1;
my $run_cons = shift || 3;


my $timeusec;
my $item=0;

my $width=7;


(my $lines,$Text::Wrap::columns)=split(' ',`stty size`);



#######################################################################################################



sub cprintf1a {
    my $f1=shift;
    my $f2=shift;
    my $f3=shift;
    my $tstamp=timeusec();
#    printf "%-18s%-3d%-14s\n", $f1, $f2, $f3;
    printf "[ %-15.4f ] %-24s              %-3d%-14s\n", $tstamp, $f1, $f2, $f3;
}


sub cprintf1b {
    my $f1=shift;
    my $f2=shift;
    my $f3=shift;
    my $tstamp=timeusec();
#    printf "%-18s%-3d%-14s\n", $f1, $f2, $f3;
    printf "[ %-15.4f ] %-28s              %-3d%-14s\n", $tstamp, $f1, $f2, $f3;
}

sub cprintf1c {
    my $f1=shift;
    my $f2=shift;
    my $f3=shift;
    my $tstamp=timeusec();
#    printf "%-18s%-3d%-14s\n", $f1, $f2, $f3;
    printf "[ %-15.4f ] %-32s              %-3d%-14s\n", $tstamp, $f1, $f2, $f3;
}

sub cprintf1d {
    my $f1=shift;
    my $f2=shift;
    my $f3=shift;
    my $tstamp=timeusec();
#    printf "%-18s%-3d%-14s\n", $f1, $f2, $f3;
    printf "[ %-15.4f ] %-36s              %-3d%-14s\n", $tstamp, $f1, $f2, $f3;
}

sub cprintf2 {

    my $f1=shift;
    my $f2=shift;
    my $tstamp=timeusec();

#    printf "%-18s                            %-${width}d%-${width}d%6.2f\n",
#                    $f1,$empty->getval(IPC_PRIVATE),$full->getval(IPC_PRIVATE),$f2;

    printf "[ %-15.4f ] %-60s %-${width}d%-${width}d\n",$tstamp,
                    $f1,$empty->getval(IPC_PRIVATE),$full->getval(IPC_PRIVATE);

}


sub down_mutex {
    $mutex->op(0,-1,0);
}

sub up_mutex {
    $mutex->op(0,1,0);
}

sub down_empty {
    $empty_slots--;
    $empty->op(0,-1,0);
}

sub up_empty {
    $empty_slots++;
    $empty->op(0,1,0);
}

sub down_full {
    $full_slots--;
    $full->op(0,-1,0);
}

sub up_full {
    $full_slots++;
    $full->op(0,1,0);
}

sub run {
    my $subname=shift;
    my $runtime=shift;

    my $start=timeusec();
    my $stop=$start;

    my $tstamp=0;
    # $max: zależny od maszyny parametr określający dokładność z jaką odmierzany jest czas zajęcia CPU;
    #       wartości rzędu 1000 dają dokładność lepszą niż 10^{-4} dla Lenovo T440s, 10^{-3} dla toru/polonu
    #        
    my $max=5000; 
    while ( $stop-$start<$runtime) {
	my $a;
	for (my $i=1; $i<=$max; $i++) {
	    $a=exp($start);
	}
	$stop=timeusec();
    }
    $tstamp=timeusec();

#    printf "[ %-15.4f ] run: delay for $subname\n", $tstamp;
#    printf "[ %-15.4f ] delay for $subname\n", $tstamp;
#    printf "[ %-15.4f ] delay %-3.1f for $subname\n", $tstamp,$runtime
}



sub produce_item {
    my $item = shift;
    run("produce_item",$run_prod);
#    cprintf1("produce_item: ",$item,"wyprodukowany");
    cprintf1a("producer: produce_item ",$item,"");
}

sub consume_item {
    my $item = shift;
    run("consume_item", $run_cons);
#    cprintf1("consume_item: ",$item,"zużyty");
    cprintf1d("consumer: consume_item ",$item,"");
}

sub enter_item {
    my $item=shift;
#    cprintf1("enter_item:   ",$item,"odłożony na półkę");
#    cprintf1("enter_item:   ",$item,"");
    cprintf1b("producer: enter_item   ",$item,"");
}

sub remove_item {
    my $item=shift;
#    cprintf1("remove_item:  ",$item,"zdjęty z półki");
    cprintf1c("consumer: remove_item ",$item,"");
}

sub timeusec {
    (my $s,my $us)=gettimeofday;
    $timeusec=$s+$us*0.000001;
}


sub help {

    print << "EOFF";

NAZWA
	$0 - ilustracja rozwiązania problemu producenta-konsumenta

SKŁADNIA
        $0 [-dh] [ -e #elementów ] [ -s #przegródek ] [ -u usleep ] [ czas_prod [czas_kons] ]

OPIS

       Program ilustruje w jaki sposób przy pomocy trzech semaforów można rozwiązać
       problem producenta-konsumenta (patrz A.S.Tanenbaum, Modern Operating Systems,
       p.43). Domyślnie wytwarzanych jest 10 elementów, które odkładane są na półkę o 5
       przegrodach. Producent (proces rodzica) wytwarza elementy w tempie jednego na
       sekundę, a konsument (proces potomny) zużywa je w tempie jednego na 3 sekundy. Te
       wartości można zmienić podając parametry czas_prod i czas_kons.

       Program pozwala śledzić kolejność i czas trwania poszczególnych faz produkcji i
       konsumpcji dzięki znacznikom czasu (liczba sekund od początku epoki) wskazującym na
       moment wykonania danej czynności. Dodatkowo wypisywane są także wartości semaforów
       empty i full.

       Dokładność z jaką odmierzany jest czas produkcji i konsumpcji określony jest przez
       odpowiedni parametr zależny od szybkości procesora (zob. procedura run). Decyduje
       on o długości trwania obliczeń i powinien być tak dobrany, aby czas wykonania
       obliczeń nie był większy niż około 100 mikrosekund.

      -e  liczba_elementów
             zmiana maksymalnej liczby elementów możliwych do wyprodukowania (domyślnie 10)

      -h     pomoc


      -s  liczba_przegród
             zmiana liczby miejsc, do których można odkładać wytworzone elementy (domyślnie 5)

      -u  czas 
             czas (w mikrosekundach, domyślnie 1000), który upływa między kolejnymi wywołaniami 
             funkcji waitpid przez proces macierzysty w celu sprawdzenia, czy proces potomny 
             jeszcze działa
             

PRZYKŁADY 

       $0   1  5

       $0   -e 10 -s 5  0.1  1

       $0   -e 10 -s 2  0.1  2

       $0   -e50 -s5 0.01 0.1
 

AUTOR
	Jacek Kobus <jkob\@fizyka.umk.pl> 

EOFF
exit;
}

sub consumer {
    my $maxitem=shift;
    my $startc=timeusec();
    my ($item, $endc);

    for ($item=1; $item<=$maxitem; $item++) {
	cprintf2("consumer: beg",$endc);
	down_full;
	down_mutex;
	remove_item($item);
	up_mutex;
	up_empty;

	$endc=timeusec()-$startc;
	consume_item($item);
	cprintf2("consumer: end",$endc);
    }
#   zwróć liczbę zużytych elementów
    return $item;
}


sub producer {
    my $maxitem=shift;
    my $startp=timeusec;
    my ($item,$endp);
    for ($item=1; $item<=$maxitem; $item++) {
	cprintf2("producer: beg",$endp);
	produce_item($item);
	down_empty;
	down_mutex;
	enter_item($item);
	up_mutex;
	up_full;

	$endp=timeusec()-$startp;
	cprintf2("producer: end",$endp);
    }

#   zwróć liczbę wyprodukownych elementów
    return $item;
}

$comm="Producent może wyprodukować maksymalnie $maxitem elementów, ale w magazynie można pomieścić tylko $empty_slots.";
print "\n",wrap("","",$comm),"\n\n";

$comm="Elementy są produkowane w tempie jednego na $run_prod sek. i używane w tempie jednego na $run_cons sek.";
print wrap("","",$comm),"\n\n";

#my $comm="Zmiana wartości domyślnych: patrz $0 -h\n";
#print wrap("","",$comm),"\n";

# używamy 3 semaforów
$mutex = new IPC::Semaphore(IPC_PRIVATE, 100, S_IRWXU | IPC_CREAT);
$mutex->op(0, 1, 0);

#$empty_slots = 10; # liczba miejsc w buforze
$empty = new IPC::Semaphore(IPC_PRIVATE, 100, S_IRWXU | IPC_CREAT);
$empty->op(0,$empty_slots,0);

$full_slots  = 0;
$full  = new IPC::Semaphore(IPC_PRIVATE, 100, S_IRWXU | IPC_CREAT);
$full->op(0,$full_slots,0);

printf "%89s\n", "empty  full";

my ($item_parent, $item_child);

FORK: {

    if (my $pid = fork) {
	# proces macierzysty
	
	my $start_prod_cons=timeusec();
	printf "[ %-15.4f ] parent:   CPID=$pid\n", $start_prod_cons;

	$item_parent=producer ($maxitem);

	use POSIX ":sys_wait_h";
	my $child=0;
	do {
	    usleep($usleep);
	    $child = waitpid(-1, WNOHANG);
	} until $child > 0;

	($usertime, $systemtime, $maxrss, $ixrss, $idrss, $isrss, $minflt, $majflt, $nswap,
         $inblock, $oublock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $nivcsw) = getrusage(RUSAGE_SELF);
#         $inblock, $oublock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $nivcsw) = getrusage(RUSAGE_CHILDREN);

	$mutex->remove;
	$empty->remove;
	$full->remove;

	printf "\n%-13s\n     usertime    %6.3f\n     systemtime  %6.3f\n     nvcsw       %-d8\n     nivcsw      %-d8\n",
               "parent (producer):",$usertime,$systemtime,$nvcsw,$nivcsw;

	my $stop_prod_cons=timeusec();

    } 
    elsif (defined $pid) { 
	# proces potomny; jeśli potomek istnieje, to $pid jest zdefiniowane i równe 0

	my $tstamp=timeusec();
	my $ppid=getppid();
	printf "[ %-15.4f ] child:    PPID=$ppid\n", $tstamp;
	$item_child=consumer($maxitem);

	($usertime, $systemtime, $maxrss, $ixrss, $idrss, $isrss, $minflt, $majflt, $nswap,
         $inblock, $oublock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $nivcsw) = getrusage();
	printf "\n%-13s\n     usertime    %6.3f\n     systemtime  %6.3f\n     nvcsw       %-d8\n     nivcsw      %-d8\n", 
          "child (consumer):",$usertime,$systemtime,$nvcsw,$nivcsw;

    }
    elsif ($! == EAGAIN) {
	# EAGAIN przypuszczalnie odwracalny błąd przy tworzeniu potomka
#	sleep 2;
#	redo FORK;
    }
    else {
	# złośliwy błąd przy tworzeniu procesu potomnego
	die "Nie  mozna wykonać fork: $!\n";
    }

}





      # The elements of the list are, in order:      index     name      meaning usually (quite system
      #  dependent)

      #           0      utime           user time
      #           1      stime           system time
      #           2      maxrss          maximum shared memory or current resident set
      #           3      ixrss           integral shared memory
      #           4      idrss           integral or current unshared data
      #           5      isrss           integral or current unshared stack
      #           6      minflt          page reclaims
      #           7      majflt          page faults
      #           8      nswap           swaps
      #           9      inblock         block input operations
      #          10      oublock         block output operations
      #          11      msgsnd          messages sent
      #          12      msgrcv          messaged received
      #          13      nsignals        signals received
      #          14      nvcsw           voluntary context switches
      #          15      nivcsw          involuntary context switches