#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

my($debug)=0;

#Orig
# |- AdminOrig
# |- KernOrig
# \- UserOrig
#
#Event
#
#ClassOrig
# |- [ColEv]
# |   |-  ColEvSwitchTo
# |   |- [ColEvSwitchToPool]
# |   |- [ColEvInputTexte]
# |   |   |- ColEvInputTexteKernel
# |   |   \- ColEvInputTexteUser
# |   |- [ColEvFlow]
# |   |   |-  ColEvTimeSort
# |   |   |-  ColEvTimeWait
# |   |   |- [ColEvEntities]
# |   |   |   |- ColEvProc
# |   |   |   |- ColEvLwp
# |   |   |   \- ColEvUtid
# |   |   |-  ColEvSplit
# |   |   |- [ColEvFlowValidate]
# |   |   |   |-  ColEvEntitySort
# |   |   |   \- [ColEvFusion]
# |   |   |       |- ColEvFusionK
# |   |   |       \- ColEvFusionKU
# |   |   |- [ColEvHand]
# |   |   |   |- ColEvHandLwp
# |   |   |   \- ColEvHandUtid
# |   |   \- [ColEvFilter]
# |   |       |- ColEvInsertEnd
# |   |       \- ColEvFilterEnd
# |   |-  [ColEvSplitSub]
# |   \-  ColEvMerge
# \-[Collection]
#    |- ColProc
#    |- ColLwp
#    \- ColUtid
#
#Scheduler
#Schedulable
#Entity
# EntityId
#  EntityTimed
#   EntityProc[Scheduler]
#   EntityLwp[Schedulable Scheduler]
#   EntityUtid[Schedulable]

# x->x ColEvTimeSort
#         Classement par temps (avec buffer max)

# x->x ColEvTimeWait
#         Attend qu'une date soit complte avant de l'mettre
#         Utile pour tre sr que les vnements lis sont  jour

# x->(x,x,x,...) ColEvSplit
#         Rplique le flot (mais pas les vnements eux-mme)

# (x,x,x,...)->x ColEvMerge
#         Rassemble les flots

# (x,x,x,...)->x ColEvMergeUniq
#         Rassemble les flots en supprimant les vnements identiques

# x->x ColEvInsertEnd(nb_end_to_skip)
#         Insert un marqueur de fin de trace  la fin ou bien aprs avoir
#         rencontr nb_end_to_skip dans la trace.
#         Les ventuels vnements suivant sont tous filtrs.

# x->x ColEvFilterEnd
#         Filtre tous les vnements sauf le marqueur de fin de trace

# tat des vnements
# 0 : rien
# 1 : Ev bruts non ncessairement ordonns
# 2 : switch_to remplacs par des GIVE/GET_HAND
# 3 : creation/destruction des entits
# 4 : Cohrence des GIVE/GET_HAND et CREATE/DESTROY
# 5 : Fusion des entits (supertrace)

# 0->1 ColEvInputTexteKernel
# 0->1 ColEvInputTexteUser
#         Introduction des vnements

# 1->2 ColEvSwitchTo
#         Transforme les switch_to originaux en GET/GIVE_HAND
#         Retard ventuel des switch_to si ncessaire
#         vnements ordonnes ncessaires
#         + GIVE/GET_HAND
#         + NOP
#         - switch_to

# 2->3 ColEvProc
# 2->3 ColEvLwp
# 2->3 ColEvUtid
#         Creation/Destruction des entits (ncessite une collection)
#         + CREATE_*
#         + DESTROY_*

# 3->4 ColEvHandLwp
# 3->4 ColEvHandUtid
#         Ajout des GIVE/GET_HAND pour les entites en dbut/fin
#         Suppression des GIVE_HAND qui prennent la main
#         - GIVE_HAND
#         + GET_HAND
#         + GIVE_HAND

# 4->5 ColEvFusionK
# 4->5 ColEvFusionKU
#         Interprte les switch-to pour reconstruire les informations manquantes
#         Ncessite un ColEvTimeWait aprs le niveau 3

# 5->5 ColEvEntitySort
#         Antidate les CREATE_ si ncessaires (aprs apparition due  une fusion)
#         Vrifie que les DESTROY sont corrects

##########################################################################
# Origine d'un vnement
#
package Orig;

use constant USER   => 0;
use constant KERNEL => 1;
use constant ADMIN  => 2;

sub new { # [classe] TypeOrig
    my $class=shift;
    my $self={};
    bless($self, $class);
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self=shift;
    if (@_) {
	my %extra = @_;
	@$self{keys %extra} = values %extra;
    }
}

sub IsAdmin {
    my $self=shift;
    return 0;
}

sub IsUser {
    my $self=shift;
    return 0;
}

sub IsKernel {
    my $self=shift;
    return 0;
}

sub IsAppli {
    my $self=shift;
    return (!$self->IsAdmin());
}

sub Dump {
    my $self=shift;
    print $self->Name();
}

##########################################################################
# Et les sous-types...
#
package AdminOrig;

use base 'Orig';

sub new {
    my($class)=shift;

    my $self=$class->SUPER::new(@_);
    return $self;
}

sub _init {
    my $self=shift;
    
    my($class)=shift;

    $self->SUPER::_init(@_, CLASS=>$class);
}

sub IsAdmin {
    my $self=shift;
    return 1;
}

sub Type {
    my $self=shift;
    return Orig::ADMIN;
}

sub Class {
    my $self=shift;
    return $self->{CLASS};
}

sub Name {
    my $self=shift;
    return "A[".$self->Class()."]";
}

##########################################################################
package KernOrig;

use base 'Orig';

sub new {
    my($class)=shift;

    my $self=$class->SUPER::new(@_);
    return $self;
}

sub IsKernel {
    my $self=shift;
    return 1;
}

sub Type {
    my $self=shift;
    return Orig::KERNEL;
}

sub Name {
    my $self=shift;
    return "Kernel";
}

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

package UserOrig;

use base 'Orig';

sub new {
    my($class)=shift;

    my $self=$class->SUPER::new(@_);
    return $self;
}

sub _init {
    my $self=shift;
    
    my($name)=shift;

    $self->SUPER::_init(@_, APPLI=>$name);
}

sub IsUser {
    my $self=shift;
    return 1;
}

sub Type {
    my $self=shift;
    return Orig::USER;
}

sub Appli {
    my $self=shift;
    return $self->{APPLI};
}

sub Name {
    my $self=shift;
    return "U[".$self->Appli()."]";
}

##########################################################################
# vnements
#
# Pas de bless pour ne pas alourdir : on reste une rfrence sur un tableau
#
package Event;

use constant CREATE_PROC   => 0;
use constant DESTROY_PROC  => 1;
use constant CREATE_LWP    => 2;
use constant DESTROY_LWP   => 3;
use constant CREATE_UT     => 4;
use constant DESTROY_UT    => 5;
use constant UT_GIVE_HAND  => 6;
use constant UT_GET_HAND   => 7;
use constant LWP_GIVE_HAND => 8;
use constant LWP_GET_HAND  => 9;
use constant FUT           => 10;
use constant FKT           => 11;
use constant NOP           => 12;

no strict;
@Name = ("Create Proc", "Destroy Proc", "Create LWP", "Destroy LWP",
	"Create UT", "Destroy UT", "UT Give Hand", "UT Get Hand",
	"LWP Give Hand", "LWP Get Hand", "FUT", "FKT", "Nop");
use strict;

sub CreateEvent {
    my $class=shift;
    my $orig=shift;
    my $date=shift;
    my $proc=shift;
    my $lwp=shift;
    my $utid=shift;
    my $type=shift;
    my $info=shift;
    my @ev=($orig, $date, $proc, $lwp, $utid, $type, $info);
    return \@ev;
}

sub show {
    my $elem=shift;
    if (defined($elem)) {
	if(UNIVERSAL::isa($elem, 'EntityId')) {
	    return $elem->idName();
	}
	return $elem;
    }
    return "  -  ";
}

sub Dump {
    my $ev=shift;
    my $prefix=shift;
    if (not defined($prefix)) {
	$prefix="";
    }

    if (not defined($ev)) {
	die "Ev not defined";
    }

    printf("%s[%+3s]",$prefix, "".Event::date($ev));
    printf("% 20s\t%s\t%s\t%s\t%-12s", Event::orig($ev)->Name(),
	   show(Event::proc($ev)),
	   show(Event::lwp($ev)),
	   show(Event::utid($ev)),
	   $Event::Name[Event::type($ev)]);
    my $inf;
    $inf=Event::infos($ev);
    if (Event::IsMoveHand($ev)) {
	my $link=Event::infos($ev);
	if (defined($link)) {
	    print "\t", show(Event::IdEmit($link));
	}
    } elsif (ref($inf) eq "ARRAY") {
	foreach $inf (@{Event::infos($ev)}) {
	    print "\t";
	    print show($inf);
	}
    } elsif (not defined($inf)) {
	print "\t ---";
    } else {
	print "\t", $inf;
    }
    print "\n";
    return;

    my $utid;
    if (defined($ev->[3])) {
	$utid=$ev->[3]->Name;
    } else {
	$utid="UNDEF   ";
    }
    print $prefix, $ev->[0], 
    "  ",defined($ev->[1]) && $ev->[1]->Name,
    "  ",defined($ev->[2]) && $ev->[2]->Name,
    "\t",defined($ev->[3]) && $ev->[3]->Name,,
    "\t{",($Event::Name[$ev->[4]]),"}";
    if (ref($ev->[5]) eq "ARRAY") {
	my $i;
	for ($i=4; $i<scalar(@{$ev->[5]}); $i++) {
	    print "\t[", $ev->[5]->[$i], "]";
	}
    } elsif (ref($ev->[5]) eq "LWP" or ref($ev->[5]) eq "Thread") {
	print "\t", $ev->[5]->Name;
    }
    print "\n";
}

sub part {
    my $num=shift;
    my $ev=shift;

    #my $old=$ev->[$num];
    
    if (scalar @_ == 1) {
	$ev->[$num]=$_[0];
    }

    return $ev->[$num];
}

sub orig {
    part 0, @_;
}

sub date {
    part 1, @_;
}

sub proc {
    part 2, @_;
}

sub lwp {
    part 3, @_;
}

sub utid {
    part 4, @_;
}

sub type {
    part 5, @_;
}

sub infos {
    part 6, @_;
}

sub idFromUserFork {
    my $ev=shift;

    if (Event::type($ev)==Event::FKT) {
	my $infos=Event::infos($ev);
	if ($infos->[0] eq "user_fork") {
	    return $infos->[1];
	}
    }
    return undef;
}

sub idFromNewLwp {
    my $ev=shift;

    if (Event::type($ev)==Event::FUT) {
	my $infos=Event::infos($ev);
	if ($infos->[0] eq "fut_new_lwp") {
	    return ($infos->[1],$infos->[2]);
	}
    }
    return undef;
}

sub IsSwitchTo {
    my $ev=shift;
    my $infos=Event::infos($ev);
    my $res=0;
    if (defined($infos)) {
	$res= $infos->[0] =~ /^(fut_)?switch_to$/;
    }
    return $res;
}

sub IdEmit {
    my $ev=shift;
    if (Event::orig($ev)->IsKernel()) {
	return Event::lwp($ev, @_);
    }
    return Event::utid($ev, @_);
}

sub IdSwto {
    my $ev=shift;
    return Event::infos($ev)->[1]
}

sub SplitSwitchTo {
    my $ev=shift;
    # Cration de GIVE/GET_HAND  la place des switch-to originaux
    my $ev1=Event::CreateEvent("Event",
			       Event::orig($ev),
			       Event::date($ev),
			       Event::proc($ev),
			       Event::lwp($ev),
			       Event::utid($ev),
			       undef,
			       undef);
    my $ev2=Event::CreateEvent("Event",
			       Event::orig($ev),
			       Event::date($ev),
			       Event::proc($ev),
			       Event::lwp($ev),
			       Event::utid($ev),
			       undef,
			       undef);
    
    if (Event::orig($ev)->IsKernel()) {
	Event::type($ev1, Event::LWP_GIVE_HAND);
	Event::type($ev2, Event::LWP_GET_HAND);	
    } else {
	Event::type($ev1, Event::UT_GIVE_HAND);
	Event::type($ev2, Event::UT_GET_HAND);
    }
    Event::infos($ev1, $ev2);
    Event::infos($ev2, $ev1);
    Event::IdEmit($ev2, Event::IdSwto($ev));
    return ($ev1, $ev2);
}

sub IsMoveHand {
    my $ev=shift;
    my $type=Event::type($ev);

    if ($type == Event::UT_GIVE_HAND 
	|| $type == Event::UT_GET_HAND
	|| $type == Event::LWP_GIVE_HAND
	|| $type == Event::LWP_GET_HAND
	) {
	return 1;
    }
    return 0;
}

sub isDestroy {
    my $ev=shift;
    my $type=Event::type($ev);

    if ($type == Event::DESTROY_PROC
	|| $type == Event::DESTROY_LWP
	|| $type == Event::DESTROY_UT
	) {
	return 1;
    }
    return 0;
}

sub isRealEv {
    my $ev=shift;

    if (Event::type($ev) <= Event::DESTROY_UT) {
	return 0;
    }
    return 1;
}

package ClassOrig;

sub orig {
    my $self=shift;

    if (not defined($self->{__PACKAGE__ . ".orig"})) {
	$self->{__PACKAGE__ . ".orig"}=AdminOrig->new(ref($self));
    }
    return $self->{__PACKAGE__ . ".orig"};
}

##########################################################################
# Collections d'vnements
#
package ColEv;

use base 'ClassOrig';

# mthodes :
# readEv() : [virtuelle] fournit un vnement  traiter
# needAccu() : [virtuelle] accumulation ncessaire
# getNbEvsAccu() : Nombre d'vnements actuellement accumuls
# sendEv() : renvoie un vnement (aprs accumulation et rordonnancement)
# dateLastEmit() : dernire date d'mission d'vnement
# emitEv(ev) : [virtuelle] peut ajouter des vnements administratifs
#              avant ou aprs et/ou supprimer l'vnement
# emitLastEv() : [virtuelle] Appele  la fin du flot d'entre
# addPostEv() : ajout un vnement aprs l'vnement en cours d'mission
# addPreEv() : ajout un vnement avant l'vnement en cours d'mission
# nextEv() : renvoie un vnement (aprs rajout/traitement) sans consommer
# getEv() : renvoie un vnement (aprs rajout/traitement) en consommant

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self=shift;
    my (@evs, @pre_evs, @post_evs);
    $self->{__PACKAGE__ . ".Evs"} = \@evs;
    $self->{__PACKAGE__ . ".PreEv"} = \@pre_evs;
    $self->{__PACKAGE__ . ".PostEv"} = \@post_evs;
    $self->{__PACKAGE__ . ".dateLastEmit"} = 0;
    $self->{__PACKAGE__ . ".maxaccu"}=0;
    if (scalar(@_) % 2) { die "Bad number of initial parameters"; }
    if (@_) {
	my %extra = @_;
	@$self{keys %extra} = values %extra;
    }
}

sub _readEv {
    my $self=shift;
    if (exists($self->{__PACKAGE__ . ".AllRead"})) {
	return undef;
    }
    my $ev=$self->readEv();

    if (not defined($ev)) {
	$self->{__PACKAGE__ . ".AllRead"}=1;
	return undef;
    }

    $debug && Event::Dump($ev, $self->Name()." Reading: ");

    push @{$self->{__PACKAGE__ . ".Evs"}}, $ev;

    return $ev;
}

sub _getPool {
    my $self=shift;
    return $self->{__PACKAGE__ . ".Evs"};
}

sub _setPool {
    my $self=shift;
    $self->{__PACKAGE__ . ".Evs"}=shift;
}

sub needAccu {
    my $self=shift;
    return 0;
}

sub getNbEvsAccu {
    my $self=shift;
    return scalar(@{$self->{__PACKAGE__ . ".Evs"}});
}

sub dumpStats {
    my $self=shift;

    if ($self->{__PACKAGE__ . ".maxaccu"} > 1) {
	Event::Dump($self->{__PACKAGE__ . ".maxaccuEv"},
		    ref($self).": ".$self->{__PACKAGE__ . ".maxaccu"}." for ");
    }
}

sub sendEv {
    my $self=shift;

    while ($self->getNbEvsAccu() == 0 
	   || $self->needAccu($self->{__PACKAGE__ . ".Evs"}->[0])) {
	if (not $self->_readEv()) {
	    last;
	}
    }

    my $col=$self->{__PACKAGE__ . ".Evs"};
    my $ev;
    my $nb_accu=scalar @{$col};
    if ($nb_accu > $self->{__PACKAGE__ . ".maxaccu"}) {
	$self->{__PACKAGE__ . ".maxaccu"}=$nb_accu;
	$self->{__PACKAGE__ . ".maxaccuEv"}=$col->[$nb_accu - 1];
    }
    $ev = shift @{$col};
    $debug && defined($ev) && Event::Dump($ev, $self->Name()." SendEv: ");
    return $ev;
}

sub dateLastEmit {
    my $self=shift;
    return $self->{__PACKAGE__ . ".dateLastEmit"};
}

sub addPreEv() {
    my $self=shift;
    my $ev=shift;
    unshift @{$self->{__PACKAGE__ . ".PreEv"}}, $ev;
}

sub addPostEv() {
    my $self=shift;
    my $ev=shift;
    push @{$self->{__PACKAGE__ . ".PostEv"}}, $ev;
}

sub emitEv() {
    my $self=shift;
    my $ev=shift;
    return $ev;
}

sub emitLastEvs() {
    my $self=shift;
    return;
}

sub nextEv() {
    my $self=shift;

    return $self->_getEv(0);
}

sub getEv() {
    my $self=shift;

    return $self->_getEv(1);
}

sub _getEv() {
    my $self=shift;
    my $deleteEv=shift;

    $debug && print $self->Name()." GetEv (delete=$deleteEv)\n";
    while(1) {
	while (not exists($self->{__PACKAGE__ . ".curEv"})) {
	    my $ev=$self->sendEv();
	    $debug && defined($ev) && Event::Dump($ev,$self->Name()."  Reading: ");    
	    $self->{__PACKAGE__ . ".curEv"}=$ev;
	    if (not defined($ev)) {
		if (exists($self->{__PACKAGE__ . ".lastEvs"})) {
		    $debug && print $self->Name()."  GetEv Ends\n";
		    return undef;
		}
		$self->{__PACKAGE__ . ".lastEvs"}=1;
		$self->{__PACKAGE__ . ".curEv"}=undef;
		$self->emitLastEvs();
		#$self->dumpStats();
	    } else {
		my $date=Event::date($ev);
		$debug && Event::Dump($ev,$self->Name()."  EmitEv: ");
		$self->{__PACKAGE__ . ".curEv"}=$self->emitEv($ev);
		$self->{__PACKAGE__ . ".dateLastEmit"} = $date;
	    }
	}
	my $ev=$self->{__PACKAGE__ . ".curEv"};

	$debug && defined($ev) && Event::Dump($ev,$self->Name()." GetEvSelected: ");    

	if (@{$self->{__PACKAGE__ . ".PreEv"}}) {
	    if ($deleteEv) {
		return shift @{$self->{__PACKAGE__ . ".PreEv"}};
	    } else {
		return $self->{__PACKAGE__ . ".PreEv"}->[0];
	    }
	}
	if (defined($ev)) {
	    if ($deleteEv) {
		$self->{__PACKAGE__ . ".curEv"}=undef;
	    }
	    return $ev;
	}
	if (@{$self->{__PACKAGE__ . ".PostEv"}}) {
	    if ($deleteEv) {
		return shift @{$self->{__PACKAGE__ . ".PostEv"}};
	    } else {
		return $self->{__PACKAGE__ . ".PostEv"}->[0];
	    }
	}
	delete $self->{__PACKAGE__ . ".curEv"};
	my (@t1, @t2);
	$self->{__PACKAGE__ . ".PreEv"}=\@t1;
	$self->{__PACKAGE__ . ".PostEv"}=\@t2;
	$debug && print $self->Name()." GetEvRestart\n";
    }
}

sub Name {
    my $self = shift;
    my $class = ref($self) || $self;
    return $class;
}

##########################################################################
# Collections d'vnements avec gestion des switch_to (retard ventuel)
#
package ColEvSwitchTo;

use base 'ColEv';

sub _init {
    my $self=shift;
    my $source = shift;
    my @srcs=($source);
    $self->SUPER::_init(@_,
			(__PACKAGE__ . ".source") => $source,
			(__PACKAGE__ . ".srcs") => \@srcs);
}

sub readEv {
    my $self=shift;

    if (!defined($self->{__PACKAGE__ . ".source"})) {
	return undef;
    }

    my ($source,$next);
    while(1) {
	$source=$self->{__PACKAGE__ . ".source"};
	$next=$source->getEv();
	while (not defined($next)) {
	    $source=$self->nextSource($source);
	    if (!defined($source)) {
		# Plus rien dans le flux...
		delete $self->{__PACKAGE__ . ".source"};
		return undef;
	    }
	    $self->{__PACKAGE__ . ".source"}=$source;
	    $next=$source->getEv();
	}

	if (! Event::IsSwitchTo($next)) {
	    return $next;
	}
	my $colevtracesw=ColEvSwitchToPool->new($self, $source, $next);
	$self->{__PACKAGE__ . ".source"}=$colevtracesw;
	push @{$self->{__PACKAGE__ . ".srcs"}}, $colevtracesw;
    }
    return $next;
}

sub nextSource {
    my $self=shift;
    my $empty_source=shift;

    my $next=undef;
    my $srcs=$self->{__PACKAGE__ . ".srcs"};

    my $i;
    for($i=0; $i<scalar(@{$srcs}); $i++) {
	if ($srcs->[$i] == $empty_source) {
	    splice(@{$srcs}, $i, 1);
	    return $next;
	}
	$next=$srcs->[$i];
    }
    return $next;
}

package ColEvSwitchToPool;

use base 'ColEv';

sub _init {
    my $self=shift;
    my $pere = shift;
    my $source = shift;
    my $sw = shift;
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".pere") => $pere,
			(__PACKAGE__ . ".source") => $source,
			(__PACKAGE__ . ".SwEv") => $sw,
			(__PACKAGE__ . ".SwDate") => Event::date($sw),
			(__PACKAGE__ . ".SwPrev") => Event::IdEmit($sw),
			(__PACKAGE__ . ".SwNext") => Event::IdSwto($sw),
			(__PACKAGE__ . ".Keep") => 1);
}

sub readEv {
    my $self=shift;

    my $sw=$self->{__PACKAGE__ . ".SwEv"};

    if (not defined($self->{__PACKAGE__ . ".EvNop"})) {
	my @infos=@{Event::infos($sw)};
	shift @infos;
	unshift @infos, "MOVED SwTo";
	# Cration d'un vnement NOP qui marque l'emplacement
	# du switch-to original en cas de dplacement
	my $ev=Event::CreateEvent("Event", $self->orig(),
				  Event::date($sw),
				  Event::proc($sw),
				  Event::lwp($sw),
				  Event::utid($sw),
				  Event::NOP,
				  \@infos);
	$self->{__PACKAGE__ . ".EvNop"}=$ev;
	$self->{__PACKAGE__ . ".EvToBlock"}=$ev;
	return $ev;
    }

    if (not ($self->{__PACKAGE__ . ".Keep"})) {
	# Le switch-to a t/doit tre mis...
	return undef;
    }

    my $source=$self->{__PACKAGE__ . ".source"};
    my $next=$source->nextEv();
    while (not defined($next)) {
	$source=$self->{__PACKAGE__ . ".pere"}->nextSource($source);
	if (!defined($source)) {
	    # Plus rien dans le flux...
	    $self->{__PACKAGE__ . ".Keep"}=0;
	    return undef;
	    #my $ev=$self->{__PACKAGE__ . ".SwEv"};
	    #delete $self->{__PACKAGE__ . ".SwEv"};
	    #return $ev;
	}
	$self->{__PACKAGE__ . ".source"}=$source;
	$next=$source->nextEv();
    }

    my $srcId=Event::IdEmit($next);
    my $nextId=Event::IdSwto($next);
    my $SwIdPrev=$self->{__PACKAGE__ . ".SwPrev"};
    my $SwIdNext=$self->{__PACKAGE__ . ".SwNext"};

    if (not defined($srcId)) {
	# vnement autre, on passe
	return $self->{__PACKAGE__ . ".source"}->getEv();
	Event::Dump($next, "no source");
	die "toto";
    }

    if ($srcId eq $SwIdNext
	|| (defined($nextId) && ($SwIdPrev eq $nextId))) {
	$self->{__PACKAGE__ . ".Keep"}=0;
	return undef;
	#my $ev=$self->{__PACKAGE__ . ".SwEv"};
	#delete $self->{__PACKAGE__ . ".SwEv"};
	#return $ev;
    }

    if (defined($nextId) && ($SwIdNext eq $nextId)) {
	print STDERR "Argh!!! Two entities giving hand to $nextId\n";
	Event::Dump($sw, " First: ");
	Event::Dump($next, " Second: ");
    }
    
    if ($SwIdPrev eq $srcId) {
	my $date=Event::date($next);
	$self->{__PACKAGE__ . ".EvNopEmit"}=1;
	#Event::Dump($sw, "Delaying sw to $date ");
	$self->{__PACKAGE__ . ".SwDate"}=$date;
	Event::date($sw, $date);
	if (defined($self->{__PACKAGE__ . ".EvToBlock"})) {
	    delete($self->{__PACKAGE__ . ".EvToBlock"});
	}
    } else {
	if (not defined($self->{__PACKAGE__ . ".EvToBlock"})) {
	    $self->{__PACKAGE__ . ".EvToBlock"}=$next;
	}
    }

    return $self->{__PACKAGE__ . ".source"}->getEv();
}

sub emitSw {
    my $self=shift;

    my $ev=$self->{__PACKAGE__ . ".SwEv"};
    my ($ev1,$ev2)=Event::SplitSwitchTo($ev);
    # D'abord le second puis le premier (LIFO mode)
    $self->addPreEv($ev2);
    $self->addPreEv($ev1);
    delete $self->{__PACKAGE__ . ".SwEv"};

}
	    

sub emitEv {
    my $self=shift;
    my $ev=shift;

    if (!$self->{__PACKAGE__ . ".Keep"}
	&& exists($self->{__PACKAGE__ . ".SwEv"})) {
	$self->emitSw();
    }
    if ($ev == $self->{__PACKAGE__ . ".EvNop"}) {
	if (not defined($self->{__PACKAGE__ . ".EvNopEmit"})) {
	    #Event::Dump($ev, "Skipping nop");
	    return undef;
	}
    }
    return $ev;
}

sub emitLastEvs {
    my $self=shift;

    if (exists($self->{__PACKAGE__ . ".SwEv"})) {
	$self->emitSw();
    }
}

sub needAccu {
    my $self=shift;
    my $ev_ready=shift;
    #on accumule tant que le switch-to est encore l
    #et que le premier vnement doit tre bloqu

    return (exists $self->{__PACKAGE__ . ".SwEv"})
	&& defined($self->{__PACKAGE__ . ".EvToBlock"})
	&& $ev_ready == $self->{__PACKAGE__ . ".EvToBlock"};
}

##########################################################################
# Collection d'vnements au sein d'un flot simple
#
package ColEvFlow;

use base 'ColEv';

sub _init {
    my $self=shift;
    my $source=shift;
    $self->SUPER::_init(@_,
			(__PACKAGE__ . ".source") => $source);
}

sub readEv {
    my $self=shift;
    return $self->{__PACKAGE__ . ".source"}->getEv();
}

##########################################################################
# Collections d'vnements avec accu de taille borne
#
package ColEvTimeSort;

use base 'ColEvFlow';

use sort 'stable';

# nbAccu() : nombre d'vnements  accumuler

sub _init {
    my $self=shift;
    my $source=shift;
    my $accu = shift;
    $self->SUPER::_init($source, @_,
			(__PACKAGE__ . ".accu") => $accu);
}

sub nbAccu {
    my $self=shift;
    return $self->{__PACKAGE__ . ".accu"};
}

sub needAccu {
    my $self=shift;
    return $self->getNbEvsAccu() < $self->nbAccu();
}

sub _readEv {
    my $self=shift;

    my $ev=$self->SUPER::_readEv();

    if (defined($ev)) {
	my $date=Event::date($ev);
	if ($date < $self->dateLastEmit()) {
	    print STDERR $self->Name().": Arghh !\n";
	    print STDERR "LastEmit : ", $self->dateLastEmit(),
	    ", LastRead : $date\n";
	}
    }

    my @evs=sort { Event::date($a) <=> Event::date($b) } @{$self->_getPool()};
    $self->_setPool(\@evs);

    return $ev;
}

##########################################################################
# Collections d'vnements avec accu sur le temps
#

package ColEvTimeWait;

use base 'ColEvFlow';

use sort 'stable';

# nbAccu() : nombre d'vnements  accumuler

sub _init {
    my $self=shift;
    $self->SUPER::_init(@_,
			(__PACKAGE__ . ".lastReadDate") => 0);
}

sub readEv {
    my $self=shift;
    my $ev=$self->SUPER::readEv();
    
    if (defined($ev)) {
	$self->{__PACKAGE__ . ".lastReadDate"}=Event::date($ev);
    }
    return $ev;
}

sub needAccu {
    my $self=shift;
    my $ev=shift;
    return Event::date($ev) == $self->{__PACKAGE__ . ".lastReadDate"};
}

##########################################################################
# Collections d'vnements insrs par texte
#
package ColEvInputTexte;

use base 'ColEv';

# nbAccu() : nombre d'vnements  accumuler

sub _init {
    my $self=shift;
    my @ev=();
    $self->SUPER::_init(@_, (__PACKAGE__ . ".evInput") => \@ev);
}

sub addEv {
    my $self=shift;
    my $ev=shift;
    push @{$self->{__PACKAGE__ . ".evInput"}}, $ev;
}

sub readEv {
    my $self=shift;
    return shift @{$self->{__PACKAGE__ . ".evInput"}};
}

##########################################################################
# Collections d'vnements insrs par texte Noyau et Utilisateur
#
package ColEvInputTexteKernel;

use base 'ColEvInputTexte';

no strict;
$orig=KernOrig->new();
use strict;

sub addEvs {
    my $self=shift;
    for $_ (@_) {
	my @l=split;
	my $time=shift @l;
	my $proc=shift @l;
	my $lwp=shift @l;
	my $lwp_name= shift @l;
	push @l, $lwp_name;
	$self->addEv(Event::CreateEvent("Event", $ColEvInputTexteKernel::orig,
					$time, $proc, $lwp, undef,
					Event::FKT, \@l));
    }
}

package ColEvInputTexteUser;

use base 'ColEvInputTexte';

no strict;
$orig=UserOrig->new("DemoApp");
use strict;

sub addEvs {
    my $self=shift;
    for $_ (@_) {
	my @l=split;
	my $time=shift @l;
	shift @l;
	my $utid=shift @l;
	$self->addEv(Event::CreateEvent("Event", $ColEvInputTexteUser::orig,
					$time, undef, undef, $utid,
					Event::FUT, \@l));
    }
}

package ColEvInputFxTprintUser;

use base 'ColEv';
use Math::BigInt  lib => 'GMP';

# nbAccu() : nombre d'vnements  accumuler

sub _init {
    my $self=shift;
    my $file=shift;
    my $basename=$file;
    $basename =~ s,.*/,,;
    my $fh;
    open($fh, "<", $file);
    while(<$fh>) {
	last if (/bytes/);
    }
    $self->SUPER::_init(@_, (__PACKAGE__ . ".filename") => $file,
			(__PACKAGE__ . ".orig") => UserOrig->new($basename),
			(__PACKAGE__ . ".fh") => $fh,
			(__PACKAGE__ . ".basetime") => Math::BigInt->new(0));

}

sub readEv {
    my $self=shift;
    my $fh=$self->{__PACKAGE__ . ".fh"};
    while(<$fh>) {
	chomp;
	if (/([0-9]+)\s+\[\s*([0-9a-f]+)\]\s+[0-9a-f]+\([0-9]+\)\s+(.*)$/) {
	    my $time=$1;
	    my $utid=$2;
	    my @args=split(/\t/, $3);
	    my $base=$self->{__PACKAGE__ . ".basetime"};
	    if ($base == 0) {
		$self->{__PACKAGE__ . ".basetime"}=Math::BigInt->new($time);
		$time=0;
	    } else {
		$time -= $base;
	    }
	    my $ev=Event::CreateEvent("Event", $self->{__PACKAGE__ . ".orig"},
				      $time, undef, undef, $utid,
				      Event::FUT, \@args);
	    my ($lwp,$utid2)=Event::idFromNewLwp($ev);
	    if (defined($lwp) && defined($utid)) {
		my @infos=("assert link");
		my $ev2;
		$ev2=Event::CreateEvent("Event", $self->orig(),
					$time,
					$lwp,
					$lwp,
					$utid2,
					Event::NOP,
					\@infos);
				
		$self->addPreEv($ev2);
	    }
	    return $ev;
	}
	print "Strange Event $_\n";
    }
    return undef;
}

##########################################################################
# Collection d'vnements grant des entits
#
package ColEvEntities;

use base 'ColEvFlow';

sub _init {
    my $self=shift;
    my $source=shift;
    my $col=shift;
    $self->SUPER::_init($source, @_, (__PACKAGE__ . ".collection") => $col);
}

sub getCollection {
    my $self=shift;
    return $self->{__PACKAGE__ . ".collection"};
}

sub getId {
    my $self=shift;
    my $id=shift;
    return $self->getCollection()->getFromId($id);
}

sub emitEv {
    my $self=shift;
    my $ev=shift;
    my @ret=($ev);

    my $id=$self->readId($ev);
    if (defined($id)) {
	my $entity=$self->getId($id);
	if (not defined($entity)) {
	    @ret=$self->create($id, $ev);
	    $entity=$self->getId($id);
	}
	$self->getCollection->setEventEntity($ev, $entity);
    }

    my $ret=shift @ret;
    for $ev (@ret) {
	$self->addPreEv($ev);
    }
    if (Event::type($ev)==Event::NOP
	&& Event::infos($ev)->[0] eq "END_TRACE") {
	$self->destroyAll(Event::date($ev));
    }
    return $ret;
}

sub destroyAll {
    my $self=shift;
    my $date=shift;
    my $id;

    if (not defined ($self->{__PACKAGE__.".ended"})) {
	$self->{__PACKAGE__.".ended"}=1;
	foreach $id ($self->getCollection()->getAllIds()) {
	    $self->destroyId($id, $date);
	}
    }
}

sub emitLastEvs {
    my $self=shift;
    my $id;

    $self->destroyAll($self->dateLastEmit());
}

sub destroyId {
    my $self=shift;
    my $id=shift;
    my $date=shift;

    my $ev;
    foreach $ev ($self->getCollection()->deleteId($id)) {
	Event::date($ev, $date);
	  $self->addPostEv($ev);
      }
}

sub readId {
    my $self=shift;
    my $ev=shift;
    return $self->getCollection()->readIdFromScratchEv($ev);
}

sub create {
    my $self=shift;
    my $id=shift;
    my $event=shift;
    
    my $ev;
    foreach $ev ($self->getCollection()->createId($id)) {
	Event::date($ev, Event::date($event));
	  $self->addPreEv($ev);
      }
    return $event;
}

package ColEvProc;

use base 'ColEvEntities';

package ColEvLwp;

use base 'ColEvEntities';

package ColEvUtid;

use base 'ColEvEntities';

sub emitEv {
    my $self=shift;
    my $ev=shift;

    if (0 && Event::type($ev) == Event::FUT &&
	Event::infos($ev)->[0] eq "fut_thread_birth") {

	$self->SUPER::emitEv($ev);

	my $id=Event::infos($ev)->[1];
	if (defined($self->getId($id))) {
	    print STDERR "Entity already created...";
	} else {
	    my $event;
	    foreach $event ($self->getCollection()->createId($id)) {
		Event::orig($event, Event::orig($ev));
		Event::proc($event, Event::proc($ev));
		Event::lwp($event, Event::lwp($ev));
		Event::utid($event, Event::utid($ev));
		Event::date($event, Event::date($ev));
		$self->addPostEv($event);
	    }
	}
	return $ev;
	#return undef;
    }
    return $self->SUPER::emitEv($ev);
}

##########################################################################
# Collection d'vnements de collection d'vnements
# Merge and Split
package ColEvMerge;

use base 'ColEv';

# addSource($source) : source d'vnements  ajouter

sub _init {
    my $self=shift;
    my @sources=();
    $self->SUPER::_init((__PACKAGE__ . ".sources") => \@sources);

    my $source;
    foreach $source (@_) {
	$self->addSource($source);
    }
}

sub addSource {
    my $self=shift;
    my $source=shift;
    my %source=("colEv" => $source);

    push @{$self->sources()}, \%source;
}

sub sources {
    my $self=shift;
    return $self->{__PACKAGE__ . ".sources"};
}

sub readEv {
    my $self=shift;
    my ($date)=undef;
    my ($source)=undef;
    my $s;
    for $s (@{$self->sources()}) {
	my $ev=$s->{"colEv"}->nextEv();
	if (defined($ev)) {
	    my $d=Event::date($ev);
	    if ((not defined($date)) or ($d < $date)) {
		$date=$d;
		$source=$s;
	    }
	}
    }
    if (defined($source)) {
	return $source->{"colEv"}->getEv();
    }
    return undef;
}

package ColEvMergeUniq;

use base 'ColEvMerge';

# addSource($source) : source d'vnements  ajouter

sub _init {
    my $self=shift;
    $self->SUPER::_init(@_);
    my @evs=();
    $self->{__PACKAGE__ .".evs"}=\@evs;
}

sub readEv {
    my $self=shift;

    my $ev=shift @{$self->{__PACKAGE__ .".evs"}};
    if (defined($ev)) {
	return $ev;
    }


    my ($date)=undef;
    my $s;
    for $s (@{$self->sources()}) {
	my $ev=$s->{"colEv"}->nextEv();
	if (defined($ev)) {
	    my $d=Event::date($ev);
	    if ((not defined($date)) or ($d < $date)) {
		$date=$d;
	    }
	}
    }
    if (not defined($date)) {
	return undef;
    }

    my %evs=();
    for $s (@{$self->sources()}) {
	my $ev=$s->{"colEv"}->nextEv();
	while (defined($ev) && Event::date($ev)==$date) {
	    $ev=$s->{"colEv"}->getEv();
	    if (not defined($evs{$ev})) {
		$evs{$ev}=1;
		push @{$self->{__PACKAGE__ .".evs"}}, $ev;
	    }
	}
    }
    return undef;
}

package ColEvSplit;

use base 'ColEvFlow';

sub _init {
    my $self=shift;
    my @accuMain=();
    my @accus=(\@accuMain);
    
    $self->SUPER::_init(@_,
			(__PACKAGE__ . ".accus") => \@accus,
			(__PACKAGE__ . ".accuMain") => \@accuMain
			);
    $self->{__PACKAGE__ . ".accu"}=0;
}

sub addAccu {
    my $self=shift;
    my @accu=();
    push @{$self->{__PACKAGE__ . ".accus"}}, \@accu;
    return \@accu;
}

sub getSplited {
    my $self=shift;
    if (exists($self->{__PACKAGE__ . ".START"})) {
	# On veut dupliquer la source alors qu'on a dj mis des Evs
	die "Program error";
    }
    print "adding accu\n";
    return ColEvSplitSub->new($self, $self->addAccu());
}

sub _getEv {
    my $self=shift;
    my $deleteEv=shift;
    my $accuRead=shift;

    if (not defined($accuRead)) {
	$accuRead=$self->{__PACKAGE__ . ".accuMain"};
    }

    if (0 == scalar(@{$accuRead})) {
	if (exists($self->{__PACKAGE__ . ".END"})) {
	    return undef;
	}
	$self->{__PACKAGE__ . ".START"}=1;
	my $ev=$self->SUPER::_getEv(1);
	if (not defined($ev)) {
	    $self->{__PACKAGE__ . ".END"}=1;
	    print "***Max accu : ", $self->{__PACKAGE__ . ".accu"}, "\n";
	    return undef;
	}

	my $accu;
	my($max)=$self->{__PACKAGE__ . ".accu"};
	foreach $accu (@{$self->{__PACKAGE__ . ".accus"}}) {
	    push @{$accu}, $ev;
	    if (scalar(@{$accu}) > $max) {
		$self->{__PACKAGE__ . ".accu"}=scalar(@{$accu});
	    }
	}
    }

    if ($deleteEv) {
	return shift @{$accuRead};
    } else {
	return $accuRead->[0];
    }
}

sub getEvSplit {
    my $self=shift;
    my $accu=shift;
    return $self->_getEv(1, $accu);
}

package ColEvSplitSub;

use base 'ColEv';

sub _init {
    my $self=shift;
    my $source=shift;
    my $accu=shift;
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".source") => $source,
			(__PACKAGE__ . ".accu") => $accu);
}

sub readEv {
    my $self=shift;
    my $source=$self->{__PACKAGE__ . ".source"};

    return $source->getEvSplit($self->{__PACKAGE__ . ".accu"});
}

##########################################################################
# Filtrer des vnements...

package ColEvFilter;

use base 'ColEvFlow';

sub emitEv {
    my $self=shift;
    my $ev=shift;

    if ($self->filter($ev)) {
	return $ev;
    } else {
	my @infos=("FILTER");

	# On cre un vnement fantome pour garder le timestamp
	my $event=Event::CreateEvent("Event", $self->orig(),
				     Event::date($ev),
				     undef,
				     undef,
				     undef,
				     Event::NOP,
				     \@infos);
	return $event;
    }
}

package ColEvInsertEnd;

use base 'ColEvFilter';

sub _init {
    my $self=shift;
    my $source=shift;
    my $skip=shift;
    
    $self->SUPER::_init($source, @_,
			(__PACKAGE__ . ".skip") => $skip
			);
}


sub emitEndTrace {
    my $self=shift;
    my $date=shift;

    my @infos=("END_TRACE");
    my $ev=Event::CreateEvent("Event", $self->orig(),
			      $date,
			      undef,
			      undef,
			      undef,
			      Event::NOP,
			      \@infos);
    $self->addPostEv($ev);
}

sub emitLastEvs {
    my $self=shift;

    $self->emitEndTrace($self->dateLastEmit());
}

sub filter {
    my $self=shift;
    my $ev=shift;
    return not defined($self->{__PACKAGE__ . ".end"});
}

sub emitEv {
    my $self=shift;
    my $ev=shift;
    
    if (Event::type($ev) == Event::NOP
	&& Event::infos($ev)->[0] eq "END_TRACE") {
	if ($self->{__PACKAGE__ . ".skip"} > 0) {
	    $self->{__PACKAGE__ . ".skip"} --;
	    return undef
	} elsif (defined($self->{__PACKAGE__ . ".end"})) {
	    return undef;
	} else {
	    $self->{__PACKAGE__ . ".end"}=1;
	    $self->emitEndTrace(Event::date($ev));
	    return undef;
	}
    }
    return $self->SUPER::emitEv($ev);
}

package ColEvFilterEnd;

use base 'ColEvFilter';

sub filter {
    my $self=shift;
    my $ev=shift;

    return (Event::type($ev)==Event::NOP
	    && Event::infos($ev)->[1] eq "END_TRACE");
}

##########################################################################
# Collection d'vnements grant des entits
#
package ColEvHand;

use base 'ColEvFlow';

sub emitEv {
    my $self=shift;
    my $ev=shift;

    { #if (1 || !Event::orig($ev)->IsAdmin()) {
	my $entity=$self->getEntity($ev);

	if (defined($entity) && Event::isRealEv($ev)) {
	    my $getHand=$self->isGetHand($ev);
	    my $giveHand=$self->isGiveHand($ev);
	    my $scheduled=$entity->scheduled($self);
	    if ($getHand) {
		if ($scheduled) {
		    Event::Dump($ev, "Arghh: on est dj schedul");
		    #  die "bye";
		} else {
		    $entity->scheduled($self, 1);
		}
	    } elsif ($giveHand) {
		if (not $scheduled) {
		    # On n'est pas encore ordonnanc,
		    # pas la peine de venir pour repartir
		    return undef;
		} else {
		    $entity->scheduled($self, undef);
		}
	    } else {
		if (not defined($scheduled)) {
		    # On n'est pas encore ordonnanc,
		    # insertion d'un GET_HAND
		    $entity->scheduled($self, 1);
		    my $event=Event::CreateEvent("Event",
						 $self->orig(),
						 Event::date($ev),
						 Event::proc($ev),
						 Event::lwp($ev),
						 $self->setUtid($ev),
						 $self->createType(),
						 undef);
		    $self->addPreEv($event);
		} 
	    } 
	}
    }
    if (Event::isDestroy($ev)) {
	my $entity=Event::infos($ev)->[0];
	if (UNIVERSAL::isa($entity, 'Schedulable')) {
	    my $scheduled=$entity->scheduled($self);
	    if ($scheduled) {
		# On est encore ordonnanc,
		# insertion d'un GIVE_HAND
		$entity->scheduled($self, undef);
		my $newEv=Event::CreateEvent("Event",
					     $self->orig(),
					     Event::date($ev),
					     Event::proc($ev),
					     Event::lwp($ev),
					     Event::utid($ev),
					     $self->destroyType(),
					     undef);
		$self->setEntity($newEv, $entity);
		$self->addPreEv($newEv);
	    }
	}
    }
    return $ev;
}

package ColEvHandLwp;

use base 'ColEvHand';

sub createType {
    my $self=shift;
    return Event::LWP_GET_HAND;
}

sub setUtid {
    my $self=shift;
    my $ev=shift;
    return undef;
}

sub destroyType {
    my $self=shift;
    return Event::LWP_GIVE_HAND;
}

sub getEntity {
    my $self=shift;
    my $ev=shift;

    return Event::lwp($ev);
}

sub setEntity {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    return Event::lwp($ev, $entity);
}

sub isGetHand {
    my $self=shift;
    my $ev=shift;
    return Event::type($ev) == Event::LWP_GET_HAND;
}

sub isGiveHand {
    my $self=shift;
    my $ev=shift;
    return Event::type($ev) == Event::LWP_GIVE_HAND;
}

package ColEvHandUtid;

use base 'ColEvHand';

sub createType {
    my $self=shift;
    return Event::UT_GET_HAND;
}

sub setUtid {
    my $self=shift;
    my $ev=shift;
    return Event::utid($ev);
}

sub destroyType {
    my $self=shift;
    return Event::UT_GIVE_HAND;
}

sub getEntity {
    my $self=shift;
    my $ev=shift;

    return Event::utid($ev);
}

sub setEntity {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    return Event::utid($ev, $entity);
}

sub isGetHand {
    my $self=shift;
    my $ev=shift;
    return Event::type($ev) == Event::UT_GET_HAND;
}

sub isGiveHand {
    my $self=shift;
    my $ev=shift;
    return Event::type($ev) == Event::UT_GIVE_HAND;
}

##########################################################################
package ColEvFlowValidate;

use base 'ColEvFlow';

sub _init {
    my $self=shift;

    my %valided=();
    my %discarded=();
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".discarded") => \%discarded,
			(__PACKAGE__ . ".valided") => \%valided);
}

sub validate {
    my $self=shift;
    my $ev=shift;
    my $clear=shift;
    if (not defined($ev)) { die "kjk";}
    $self->{__PACKAGE__ . ".valided"}->{$ev}=1;
    if (defined($clear) && ($clear==0)) {
	delete $self->{__PACKAGE__ . ".valided"}->{$ev};
    }
}

sub isValide {
    my $self=shift;
    my $ev=shift;
    return defined($self->{__PACKAGE__ . ".valided"}->{$ev});
}

sub discard {
    my $self=shift;
    my $ev=shift;
    my $clear=shift;
    $self->{__PACKAGE__ . ".discarded"}->{$ev}=1;
    if (defined($clear) && ($clear==0)) {
	delete $self->{__PACKAGE__ . ".discarded"}->{$ev};
    } else {
	$self->validate($ev);
    }
}

sub isDiscarded {
    my $self=shift;
    my $ev=shift;
    return defined($self->{__PACKAGE__ . ".discarded"}->{$ev});
}

sub needAccu {
    my $self=shift;
    my $ev=shift;

    if ($self->isValide($ev)) {
	#Event::Dump($ev, "Valid: ");
      } else {
	  #Event::Dump($ev, "Not yet valid: ");
	}

    return not $self->isValide($ev);
}

sub emitEv {
    my $self=shift;
    my $ev=shift;
    my $ret=$ev;

    if ($self->isDiscarded($ev)) {
	$self->discard($ev, 0);
	$ret=undef;
	$debug && Event::Dump($ev, "Discarding ");
    }

    $self->validate($ev, 0);
    return $ret;
}

##########################################################################
package ColEvEntitySort;

use base 'ColEvFlowValidate';

sub _init {
    my $self=shift;

    $self->SUPER::_init(@_);
    #(__PACKAGE__ . ".valided") => \%valided);
}

sub tblInit {
    my $self=shift;
    my $name=shift;

    if (!defined($self->{__PACKAGE__ . $name})) {
	my %hash=();
	$self->{__PACKAGE__ . $name}=\%hash;
    }
    return $self->{__PACKAGE__ . $name};
}

sub tblAdd {
    my $self=shift;
    my $name=shift;
    my $key=shift;
    my $value=shift;

    my $hash=$self->tblInit($name);
    if (defined($hash->{$key})) {
	push @{$hash->{$key}}, $value;
    } else {
	my @tbl=($value);
	$hash->{$key}=\@tbl;
    }
}

sub tblCheck {
    my $self=shift;
    my $name=shift;
    my $key=shift;

    my $hash=$self->tblInit($name);
    return defined($hash->{$key});
}

sub tblGet {
    my $self=shift;
    my $name=shift;
    my $key=shift;

    my $hash=$self->tblInit($name);
    if (defined($hash->{$key})) {
	return $hash->{$key};
    }
    return undef;
}

sub tblClean {
    my $self=shift;
    my $name=shift;
    my $key=shift;
    my $value=shift;

    my $hash=$self->tblInit($name);
    my $tbl=$self->tblGet($name, $key);
    if (not defined($tbl)) {
	return;
    }
    if (scalar(@{$tbl})==1 && $tbl->[0]==$value) {
	$self->tblPurge($name, $key);
    } else {
	@{$tbl}=map { if ($_ != $value) { $_; } else { } } @{$tbl};
    }
}

sub tblPurge {
    my $self=shift;
    my $name=shift;
    my $key=shift;

    my $hash=$self->tblInit($name);
    if (defined($hash->{$key})) {
	delete($hash->{$key});
    }
}

sub waitFor {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    $self->tblAdd(".preEvs", $ev, $entity->startEv());
    $entity->info($self, "created", 1);
}

sub check {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    if (not defined($entity)) {
	return 1;
    }
    if (not defined($entity->info($self, "created"))) {
	$self->waitFor($ev, $entity);
	return 1;
    }
    
    if (defined($entity->info($self, "destroyed"))) {
	#
	Event::Dump($ev, "Using $entity destroyed\t");
	#  $self->discard($ev);
	return 0;
    }
    return 1;
}

sub checkEv {
    my $self=shift;
    my $ev=shift;

    if ($self->check($ev, Event::proc($ev))
	+$self->check($ev, Event::lwp($ev))
	+$self->check($ev, Event::utid($ev))
	== 3) {
	$self->validate($ev);
    }
}

sub readEv {
    my $self=shift;

    my $ev=$self->SUPER::readEv();

    if (not defined($ev)) {
	return undef;
    }

    if (Event::isRealEv($ev)) {
	$self->checkEv($ev);
    } else {
	my $entity=Event::infos($ev)->[0];
	if (Event::isDestroy($ev)) {
	    $entity->info($self, "destroyed", 1);
	    $self->validate($ev);
	} else {
	    if ($entity->info($self, "created")) {
		$self->discard($ev);
	    } else {
		$entity->info($self, "created", 1);
		$self->validate($ev);
	    }
	}
    }
    return $ev;
}

sub emitEv {
    my $self=shift;
    my $ev=shift;

    $ev=$self->SUPER::emitEv($ev);
    if (defined($ev) && ($self->tblCheck(".preEvs", $ev))) {
	my $event;
	foreach $event (@{$self->tblGet(".preEvs", $ev)}) {
	    Event::date($event, Event::date($ev));
	    $self->addPreEv($event);
	}
	$self->tblPurge(".preEvs", $ev);
    }
    return $ev;
}

##########################################################################
# Fusion en supertrace !!!
package ColEvFusion;

use base 'ColEvFlowValidate';

# Corrlation de deux entits (utid/lwp ou lwp/proc)
# grce aux les SwitchTo correspondants 

sub _init {
    my $self=shift;
    my %chains=();
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".chains") => \%chains);
}

# Est-ce que l'vnement (gnr par le contenu) a son contenant dans ses
# arguments ?
sub tryLinkDown {
    my $self=shift;
    my $ev=shift;
    return 0;
}

# Est-ce que l'vnement (gnr par le contenant) a son contenu dans ses
# arguments ?
sub tryLinkUp {
    my $self=shift;
    my $ev=shift;
    return 0;
}

# Tous les contenants doivent-ils avoir un contenu ?
# Non pour lwp/utid, oui pour proc/lwp
sub forceLinkDown {
    my $self=shift;
    my $ev=shift;
    return 0;
}

sub _chain {
    my $self=shift;
    my $id=shift;
    
    if (scalar @_ == 1) {
	my $chain=shift;
	if (not defined($chain)) {
	    delete $self->{__PACKAGE__ . ".chains"}->{$id};
	} else {
	    $self->{__PACKAGE__ . ".chains"}->{$id}=$chain;
	}
	return $chain;
    }

    if (not defined($self->{__PACKAGE__ . ".chains"}->{$id})) {
	my @chain=();
	$self->{__PACKAGE__ . ".chains"}->{$id}=\@chain;
    }
    return $self->{__PACKAGE__ . ".chains"}->{$id};
}

sub chainUp {
    my $self=shift;
    # my $cle=shift;
    # my $list_to_set=shift;
    return $self->_chain(@_);
}

sub chainDown {
    my $self=shift;

    return $self->_chain(@_);
}

sub retain {
    my $self=shift;
    my $ev=shift;
    my $chain=shift;

    push @{$chain}, $ev;
}

sub retainUp {
    my $self=shift;
    my $ev=shift;
    my $chain=shift;

    $self->retain($ev, $chain);
}

sub retainDown {
    my $self=shift;
    my $ev=shift;
    my $chain=shift;

    $self->retain($ev, $chain);
}

#  la fin du flot, on valide les vnements des chains
sub endRead {
    my $self=shift;
    my $chain;
    foreach $chain (keys %{$self->{__PACKAGE__ . ".chains"}}) {
	my $event;
	foreach $event (@{$self->chainUp($chain)}) {
	    $self->validate($event);
	}
	$self->chainUp($chain, undef);
    }
}

sub link {
    # On doit lier les entits up et down
    my $self=shift;
    my $down=shift;
    my $up=shift;

    # On rcupre les entits actuelles sur up et down
    my $oldDown=$up->scheduled($self);
    my $oldUp=$down->scheduling($self);

    # On vrifie qu'elles taient absentes ou qu'elles correspondent aux nouvelles
    if (defined($oldDown) && $oldDown != $down) {
	print "Arghhh down\n";
    }
    if (defined($oldUp) && $oldUp != $up) {
	print "Arghhh up\n";
    }

    # On enregistre les nouvelles
    $up->scheduled($self, $down);
    $down->scheduling($self, $up);

    if (not defined($oldUp)) {
	# Le contenant n'avait pas de contenu : c'est un vrai vnement liant
	# On rcupre la liste des vnements survenus dans le contenant auparavant
	#   et on les rattache au contenu actuel
	my $chain=$self->chainDown($down);
	my $event;
	foreach $event (@{$chain}) {
	    $self->up($event, $up);
	    $self->validate($event);
	}
	# On dtruit la liste des vnements du contenant
	$self->chainDown($down, undef);
    }
    if (not defined($oldDown)) {
	# Le contenu n'avait pas de contenant : c'est un vrai vnement liant
	# On rcupre la liste des vnements survenus dans le contenu auparavant
	#   et on les rattache au contenant actuel
	my $chain=$self->chainUp($up);
	my $event;
	foreach $event (@{$chain}) {
	    $self->down($event, $down);
	    $self->validate($event);
	}
	# On dtruit la liste des vnements du contenu
	$self->chainUp($up, undef);
    }
}

sub manageSwTo {
    my $self=shift;
    my $ev=shift;
    my $down=shift;
    my $up=shift;

    if ($self->isGiveHand($ev)) {
	# C'est un changement de context

	# on rcupre la liste des vnements dans ce contenu 
	# qui sont encore sans contenant
	my $chain=$self->chainUp($up);

	# up n'a plus la main
	$up->scheduled($self, undef);
	# ni donc de liste d'vnements associe
	$self->chainUp($up, undef);

	if (defined($down)) {
	    # Si on connait le contenant, il n'ordonnance plus le contenu
	    $down->scheduling($self, undef);
	}
       	
	# On veut le prochain contenu
	# On rcupre l'argument qui doit tre le GET_HAND correspondant
	# (sauf si c'est la fin et que personne ne prend la main)
	my $next=Event::infos($ev);
	if (defined($next)) {
	    # On rcupre le contenu suivant
	    my $newUp=Event::IdEmit($next);

	    if (!UNIVERSAL::isa($newUp, 'Schedulable')) {
		# l'argument de GIVE_HAND doit tre positionn correctement
		# Au dbut, c'est seulement l'ID (une chaine ou un nombre),
		# aprs c'est une rfrence sur la structure perl
		# Les GIVE/GET HAND tant au mme tick, il suffit d'attendre la fin
		# des vnements de ce tick
		die ("Link between GIVE/GET_HAND not up-to-date\n".
		    "\t\t=> Try to add ColEvTimeWait before ".ref($self)."\n");
	    }
	    
	    # le nouveau contenu est ordonnanc dans le contenant
	    # (ventuellement UNDEF si il n'est pas encore connu)
	    $newUp->scheduled($self, $down);
	    # et on renregistre la chaine des vnements sans contenant
	    $self->chainUp($newUp, $chain);
	    if (defined($down)) {
		# S'il y a un contenant, il possde maintenant un nouveau contenu
		$down->scheduling($self, $newUp);
	    }
	}
    }
}

# Les vnements  ignorer. Typiquement :
# - les vnements qui n'ont aucune des deux infos
# - les vnements factices (cration/destruction)
sub skipEv {
    my $self=shift;
    my $ev=shift;
    my $down=shift;
    my $up=shift;

    if (not (defined($up) or defined($down))) {
	return 1;
    }
    my $type=Event::type($ev);
    if (not Event::isRealEv($ev)) {
	return 1;
    }
    return 0;
}

sub readEv {
    my $self=shift;

    my $ev=$self->SUPER::readEv();
    if (not defined($ev)) {
	# Plus d'vnements ? On valide ce qui est en attente.
	$self->endRead();
	return undef;
    }
    # On prend les deux entits  mettre en corrlation
    my $up=$self->up($ev);
    my $down=$self->down($ev);

    if ($self->skipEv($ev, $down, $up)) {
	# Aucune info, on passe
	$self->validate($ev);
	return $ev;
    }
    if (defined($up) && defined($down)) {
	# Les deux infos sont prsentes.
	# On lie les deux entits (plutt on vrifie que c'est cohrent)
	$self->link($down, $up);
	# On valide si ncessaire
	$self->validate($ev);
	# On traite le SwTo si besoin
	$self->manageSwTo($ev, $down, $up);
	return $ev;
    }

    if (defined($up)) {
	# $down est non dfini. On essaye de rcuprer la valeur ailleurs
	$down=$up->scheduled($self);
	if (defined($down)) {
	    $self->link($down, $up);
	    $self->down($ev, $down);
	    $self->validate($ev);
	} elsif ($self->tryLinkUp($ev)) {
	    $down=$self->down($ev);
	    $self->link($down, $up);
	    $self->validate($ev);	    
	} else {
	    my $chain=$self->chainUp($up);
	    $self->retainUp($ev, $chain);
	}
	$self->manageSwTo($ev, $up->scheduled($self), $up);
    } else {
	# $up est non dfini. On essaye de rcuprer la valeur ailleurs
	$up=$down->scheduling($self);
	if (defined($up)) {
	    $self->link($down, $up);
	    $self->up($ev, $up);
	    $self->validate($ev);
	} elsif ($self->tryLinkDown($ev)) {
	    $up=$self->up($ev);
	    $self->link($down, $up);
	    $self->validate($ev);
	} elsif ($self->forceLinkDown($ev)) {
	    my $chain=$self->chainDown($down);
	    $self->retainDown($ev, $chain);
	} else {
	    $self->validate($ev);
	}
    }

    return $ev;
}

##########################################################################
package ColEvFusionKU;

use base 'ColEvFusion';

sub _init {
    my $self=shift;
    my %utids=();
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".utids") => \%utids);
}

sub up {
    my $self=shift;
    #my $ev=shift;
    #my $value=shift;
    return Event::utid(@_);
}

sub down {
    my $self=shift;
    return Event::lwp(@_);
}

sub chainUp {
    my $self=shift;
    my $id=shift;

    if (scalar @_ == 1) {
	my $chain=shift;
	if (not defined($chain)) {
	    delete $self->{__PACKAGE__ . ".utids"}->{$id};
	} else {
	    $self->{__PACKAGE__ . ".utids"}->{$id}=$id;
	}
	return $self->SUPER::chainUp($id, $chain);
    }

    $self->{__PACKAGE__ . ".utids"}->{$id}=$id;
    return $self->SUPER::chainUp($id);
}

sub tryLinkDown {
    my $self=shift;
    my $ev=shift;
    my $id=Event::idFromUserFork($ev);
    if (defined($id)) {
	my $utid;
	foreach $utid (values %{$self->{__PACKAGE__ . ".utids"}}) {
	    if ($utid->id() eq $id) {
		Event::utid($ev, $utid);
		return 1;
	    }
	}
	print "Nothing for $id\n";
    }
    return 0;
}

sub isGiveHand {
    my $self=shift;
    my $ev=shift;
    return Event::UT_GIVE_HAND == Event::type($ev);
}

##########################################################################
package ColEvFusionK;

use base 'ColEvFusion';

sub up {
    my $self=shift;
    return Event::lwp(@_);
}

sub down {
    my $self=shift;
    return Event::proc(@_);
}

sub forceLinkDown {
    my $self=shift;
    my $ev=shift;
    return 1;
}

sub isGiveHand {
    my $self=shift;
    my $ev=shift;
    return Event::LWP_GIVE_HAND == Event::type($ev);
}

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

##########################################################################
# Entits
#

package Entity;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self=shift;
    my %col=();
    $self->{__PACKAGE__ . ".hash"} = \%col;
    if (scalar(@_) % 2) { die "Entity"; }
    if (@_) {
	my %extra = @_;
	@$self{keys %extra} = values %extra;
    }
}

sub name {
    my $self=shift;

    #my $old=$ev->{__PACKAGE__ . ".name"};
    
    if (scalar @_ == 1) {
	$self->{__PACKAGE__ . ".name"}=$_[0];
    }

    if (defined($self->{__PACKAGE__ . ".name"})) {
	return $self->{__PACKAGE__ . ".name"};
    }

    return undef;    
}

sub getName {
    my $self=shift;
    my $name=$self->name(@_);
    if (!defined($name)) {
	return "no name";
    }
    return $name;
}

sub Name {
    my $self=shift;
    return $self->getName();
}

sub info {
    my $self=shift;
    my $name=shift;
    my $key=shift;

    if (scalar @_ == 1) {
	my $value=shift;
	if (defined($value)) {
	    $self->{__PACKAGE__ . ".info"}->{$name}->{$key}=$value;
	} else {
	    if (defined($self->{__PACKAGE__ . ".info"}->{$name})
		&& defined($self->{__PACKAGE__ . ".info"}->{$name}->{$key})) {
		    delete($self->{__PACKAGE__ . ".info"}->{$name}->{$key});
		}
	}
	return $value;
    }

    if (defined($self->{__PACKAGE__ . ".info"}->{$name})
	&& defined($self->{__PACKAGE__ . ".info"}->{$name}->{$key})) {
	return $self->{__PACKAGE__ . ".info"}->{$name}->{$key};
    }

    return undef;    
}

##########################################################################
# Entits avec identificateur
#

package EntityId;

use base 'Entity';

sub _init {
    my $self=shift;
    my $id=shift;
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".id") => $id);

}

sub id {
    my $self=shift;

    return $self->{__PACKAGE__ . ".id"};
}

sub idName {
    my $self=shift;

    return $self->prefix().$self->id();
}


sub prefix {
    my $self=shift;

    return "";
}

sub getName {
    my $self=shift;
    my $name=$self->name(@_);
    if (!defined($name)) {
	return $self->idName();
    }
    return $name;
}

package EntityTimed;

use base 'EntityId';

sub _init {
    my $self=shift;
    $self->SUPER::_init(@_, 
			(__PACKAGE__ . ".startEv") => undef,
			(__PACKAGE__ . ".endEv") => undef);

}

sub startEv {
    my $self=shift;

    if (scalar @_ == 1) {
	$self->{__PACKAGE__ . ".startEv"}=$_[0];
    }

    return $self->{__PACKAGE__ . ".startEv"};
}

sub endEv {
    my $self=shift;

    if (scalar @_ == 1) {
	$self->{__PACKAGE__ . ".endEv"}=$_[0];
    }

    return $self->{__PACKAGE__ . ".endEv"};
}

package Scheduler;

sub scheduling {
    my $self=shift;
    my $obj=shift;

    if (scalar @_ == 1) {
	$self->{__PACKAGE__ . ".schedule"}->{$obj}=$_[0];
    }

    if (defined($self->{__PACKAGE__ . ".schedule"})) {
	if (defined($self->{__PACKAGE__ . ".schedule"}->{$obj})) {
	    return $self->{__PACKAGE__ . ".schedule"}->{$obj};
	}
    }

    return undef;    
}

sub scheduleClean {
    my $self=shift;
    my $obj=shift;

    if (defined($self->{__PACKAGE__ . ".schedule"})) {
	delete $self->{__PACKAGE__ . ".schedule"}->{$obj};
    }
}

package Schedulable;

sub scheduled {
    my $self=shift;
    my $obj=shift;

    if (scalar @_ == 1) {
	#print "Setting scheduled($obj) $_[0]\n";
	$self->{__PACKAGE__ . ".scheduler"}->{$obj}=$_[0];
    }

    if (defined($self->{__PACKAGE__ . ".scheduler"})) {
	if (defined($self->{__PACKAGE__ . ".scheduler"}->{$obj})) {
	    #print "Retuning scheduled($obj) ".$self->{__PACKAGE__ . ".scheduler"}->{$obj}."\n";
	    return $self->{__PACKAGE__ . ".scheduler"}->{$obj};
	}
    }

    return undef;    
}

sub scheduler {
    my $self=shift;
    my $obj=shift;

    if (scalar @_ == 1) {
	$self->{__PACKAGE__ . ".scheduler"}->{$obj}=$_[0];
    }

    if (defined($self->{__PACKAGE__ . ".scheduler"})) {
	if (defined($self->{__PACKAGE__ . ".scheduler"}->{$obj})) {
	    return $self->{__PACKAGE__ . ".scheduler"}->{$obj};
	}
    }

    return undef;    
}

sub schedulerClean {
    my $self=shift;
    my $obj=shift;

    if (defined($self->{__PACKAGE__ . ".scheduler"})) {
	delete $self->{__PACKAGE__ . ".scheduler"}->{$obj};
    }
}

##########################################################################
# Entits processeurs
#

package EntityProc;

use base qw(EntityTimed Scheduler);

sub prefix {
    my $self=shift;

    return "Proc";
}

##########################################################################
# Entits LWP
#

package EntityLwp;

use base qw(EntityTimed Schedulable Scheduler);

sub prefix {
    my $self=shift;

    return "Lwp";
}

##########################################################################
# Entits Thread Utilisateurs
#

package EntityUtid;

use base qw(EntityTimed Schedulable);

sub prefix {
    my $self=shift;

    return "Ut";
}



##########################################################################
# Collections d'objects
#

package Collection;

use base 'ClassOrig';

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self=shift;
    my %col=();
    $self->{__PACKAGE__ . ".hash"} = \%col;
    if (scalar(@_) % 2) { die "Collection"; }
    if (@_) {
	my %extra = @_;
	@$self{keys %extra} = values %extra;
    }
}

sub _getCol {
    my $self=shift;
    return $self->{__PACKAGE__ . ".hash"};
}

sub getFromId {
    my $self=shift;
    my $id=shift;
    if (exists($self->_getCol()->{$id})) {
	return $self->_getCol()->{$id};
    }
    return undef;
}

sub createId {
    my $self=shift;
    my $id=shift;

    my $entity=$self->createEntityFromId($id);

    my @info=($entity);
    # Cration d'une entit
    my $ev=Event::CreateEvent("Event", $self->orig(), 
			      undef,
			      undef, undef, undef,
			      $self->createEvType(), \@info
			      );
    $entity->startEv($ev);
    $self->setEventEntity($ev, $entity);

    $self->_getCol()->{$id}=$entity;
    my @evs=($ev);
    return @evs;
}

sub deleteId {
    my $self=shift;
    my $id=shift;

    my $entity=$self->getFromId($id);
    my @evs=$self->deleteEntity($entity);

    my @info=($entity);
    # Destruction d'une entit
    my $ev=Event::CreateEvent("Event", $self->orig(), 
			      undef,
			      undef, undef, undef,
			      $self->deleteEvType(), \@info
			      );
    $entity->endEv($ev);
    $self->setEventEntity($ev, $entity);

    delete $self->_getCol()->{$id};
    push @evs, $ev;
    return @evs;
}

sub getAllIds {
    my $self=shift;
    return keys (%{$self->_getCol()});
}

sub deleteEntity {
    my $self=shift;
    my $entity=shift;

    return ();
}

##########################################################################
# Collections de processeurs
#

package ColProc;

use base 'Collection';

sub readIdFromScratchEv {
    my $self=shift;
    my $ev=shift;
    return Event::proc($ev);
}

sub createEntityFromId {
    my $self=shift;
    my $id=shift;
    return EntityProc->new($id);
}

sub createEvType {
    my $self=shift;
    return Event::CREATE_PROC;
}

sub deleteEvType {
    my $self=shift;
    return Event::DESTROY_PROC;
}

sub setEventEntity {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    return Event::proc($ev, $entity);    
}

##########################################################################
# Collections de lwps
#

package ColLwp;

use base 'Collection';

sub readIdFromScratchEv {
    my $self=shift;
    my $ev=shift;
    return Event::lwp($ev);
}

sub createEntityFromId {
    my $self=shift;
    my $id=shift;
    return EntityLwp->new($id);
}

sub createEvType {
    my $self=shift;
    return Event::CREATE_LWP;
}

sub deleteEvType {
    my $self=shift;
    return Event::DESTROY_LWP;
}

sub setEventEntity {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    return Event::lwp($ev, $entity);    
}

##########################################################################
# Collections de utid
#

package ColUtid;

use base 'Collection';

sub readIdFromScratchEv {
    my $self=shift;
    my $ev=shift;
    return Event::utid($ev);
}

sub createEntityFromId {
    my $self=shift;
    my $id=shift;
    return EntityUtid->new($id);
}

sub createEvType {
    my $self=shift;
    return Event::CREATE_UT;
}

sub deleteEvType {
    my $self=shift;
    return Event::DESTROY_UT;
}

sub setEventEntity {
    my $self=shift;
    my $ev=shift;
    my $entity=shift;

    return Event::utid($ev, $entity);    
}

################################################################
################################################################
################################################################
package Paje;

use constant SetLimits => 0;
use constant DefineContainerType => 1;
use constant DefineEventType     => 2;
use constant DefineStateType     => 3;
use constant DefineVariableType  => 4;
use constant DefineLinkType      => 5;
use constant DefineEntityValue   => 6;
use constant CreateContainer     => 7;
use constant DestroyContainer    => 8;
use constant NewEvent    => 9;
use constant SetState    => 10;
use constant PushState   => 11;
use constant PopState    => 12;
use constant SetVariable => 13;
use constant AddVariable => 14;
use constant SubVariable => 15;
use constant StartLink   => 16;
use constant EndLink     => 17;

################################################################
# Gnration d'une trace paje
sub Entete {
# TODO: Paje
#    my($first_date)=SuperTrace::DateStart();
#    my($end_date)=SuperTrace::DateEnd();
    my($first_date)=0;
    print
	'%EventDef       SetLimits       '.SetLimits."\n".
	'%       Time    date'."\n".
	'%       StartTime       date'."\n".
	'%       EndTime date'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDefineContainerType '.DefineContainerType."\n".
	'%       Time    date'."\n".
	'%       NewType string'."\n".
	'%       ContainerType   string'."\n".
	'%       NewName string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDefineEventType '.DefineEventType."\n".
	'%       Time    date'."\n".
	'%       NewType string'."\n".
	'%       ContainerType   string'."\n".
	'%       NewName string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDefineStateType '.DefineStateType."\n".
	'%       Time    date'."\n".
	'%       NewType string'."\n".
	'%       ContainerType   string'."\n".
	'%       NewName string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDefineVariableType '.DefineVariableType."\n".
	'%       Time    date'."\n".
	'%       NewType string'."\n".
	'%       ContainerType   string'."\n".
	'%       NewName string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDefineLinkType '.DefineLinkType."\n".
	'%       Time    date'."\n".
	'%       NewType string'."\n".
	'%       ContainerType   string'."\n".
	'%       SourceContainerType     string'."\n".
	'%       DestContainerType       string'."\n".
	'%       NewName string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDefineEntityValue '.DefineEntityValue."\n".
	'%       Time    date'."\n".
	'%       NewValue        string'."\n".
	'%       EntityType      string'."\n".
	'%       NewName string'."\n".
	'%       Color   color'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeCreateContainer '.CreateContainer."\n".
	'%       Time    date'."\n".
	'%       NewContainer    string'."\n".
	'%       NewContainerType        string'."\n".
	'%       Container       string'."\n".
	'%       NewName string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeDestroyContainer '.DestroyContainer."\n".
	'%       Time    date'."\n".
	'%       Container       string'."\n".
	'%       Type        string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeNewEvent '.NewEvent."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeSetState '.SetState."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajePushState '.PushState."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajePopState '.PopState."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeSetVariable '.SetVariable."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   double'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeAddVariable '.AddVariable."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   double'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeSubVariable '.SubVariable."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   double'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeStartLink '.StartLink."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   string'."\n".
	'%       SourceContainer string'."\n".
	'%       Key     string'."\n".
	'%EndEventDef'."\n".
	'%EventDef       PajeEndLink '.EndLink."\n".
	'%       Time    date'."\n".
	'%       EntityType      string'."\n".
	'%       Container       string'."\n".
	'%       Value   string'."\n".
	'%       DestContainer   string'."\n".
	'%       Key     string'."\n".
	'%EndEventDef'."\n";
# TODO: Paje
#    Print(0,$first_date,$first_date." ".($end_date+1));
    Print(1,$first_date,"PRG\t0\tProgramme");
    Print(1,$first_date,"UV\tPRG\t\"User Thread View\"");
    Print(1,$first_date,"LV\tPRG\t\"LWP View\"");
    Print(1,$first_date,"PV\tPRG\t\"Processor View\"");
    #paje_print(1,$first_date," UTV_UT\t\tUTV\tUser_Thread");
    
    GroupRegister("UT",
		  EventDef("U", 
			   1, "UV\t\"User Thread\"",
			   \&paje_event_create_u,
			   \&paje_event_destroy_u),
		  EventDef("LU",
			   3, "L\t\"Threads per LWP\"",
			   \&paje_event_create_lu,
			   \&paje_event_destroy_lu, 
			   "L"),
		  EventDef("PU",
			   3, "P\t\"Threads per Processor\"",
			   \&paje_event_create_pu,
			   \&paje_event_destroy_pu, 
			   "P")
		  );
    GroupRegister("LWP",
		  EventDef("L", 
			   1, "LV\t\"LWP\"",
			   \&paje_event_create_l,
			   \&paje_event_destroy_l),
		  EventDef("UL",
			   3, "U\t\"LWPs running Thread\"",
			   \&paje_event_create_ul,
			   \&paje_event_destroy_ul, 
			   "U"),
		  EventDef("PL",
			   3, "P\t\"LWPs per Processor\"",
			   \&paje_event_create_pl,
			   \&paje_event_destroy_pl, 
			   "P")
		  );
    GroupRegister("PROC",
		  EventDef("P", 
			   1, "PV\t\"Processor\"",
			   \&paje_event_create_p,
			   \&paje_event_destroy_p),
		  EventDef("UP",
			   3, "U\t\"Processors running Thread \"",
			   \&paje_event_create_up,
			   \&paje_event_destroy_up, 
			   "U"),
		  EventDef("LP",
			   3, "L\t\"Processors running LWP \"",
			   \&paje_event_create_lp,
			   \&paje_event_destroy_lp, 
			   "L")
			);
    GroupRegister("UF",
		  EventDef("UF",
			   3, "U\tFunctions",
			   \&paje_event_create_uf,
			   \&paje_event_destroy_uf));
    GroupRegister("UE",
		  EventDef("UE",
			   2, "U\t\"Misc Events\"",
			   \&paje_event_create_ue,
			   \&paje_event_destroy_ue));
    
    GroupPrint($first_date);
    #paje_print(3,$first_date,' UTV_UT_LWP   UTV_UT LWP');
    Print(7,$first_date,"PRG1\tPRG\t0\tProgramme");
    Print(7,$first_date,"UV1\tUV\tPRG1\t\"User Thread View\"");
    Print(7,$first_date,"LV1\tLV\tPRG1\t\"LWP View\"");
    Print(7,$first_date,"PV1\tPV\tPRG1\t\"Processor View\"");

    #paje_print(6,$first_date,"ULnone\tUL\t\"Lwp Dummy\"");
#	'6  0.00220 R            S      Running'."\n".
#	'6  0.00230 B            S      Blocked'."\n".
#	'6  0.00220 F1           FUNC   "function A"'."\n".
#	'6  0.00230 F2           FUNC   "Function B"'."\n".
#	'7  0.10100 T1           UT     UTV1    Thread_1'."\n".
#	"7  0.10100 T2           UT     UTV1    Thread_2\n";
}

my(%paje_groups)=();

################################################################
# Paje : gestion collections gnrique

#group
#- groups
#  [name]->
#     - name->[name]
#     - cles
#       [cle]->elem
#     - events
#       [name]->event
#     - nb_events
#     - count
#- events
#  [name]->event
#
#event
#- name
#- master_type
#- master_enddef
#- sub_enddef_func_create (date, group, event, elem)
#- sub_enddef_func_destroy (date, group, event, elem)
#- depends
#- master_printed
#
#elem
#- id -> [paje_id]
#- cle -> [cle]
#- infos -> [infos]
sub EventDef {
    my($name)=shift;
    my($master_type)=shift;
    my($master_enddef)=shift;
    my($sub_enddef_func_create)=shift;
    my($sub_enddef_func_destroy)=shift;
    my(@depends)=@_;
    
    my(%hash)=("name" => $name,
	       "master_type" => $master_type,
	       "master_enddef" => $master_enddef,
	       "sub_enddef_func_create" => $sub_enddef_func_create,
	       "sub_enddef_func_destroy" => $sub_enddef_func_destroy,
	       "depends" => \@depends);
    return \%hash;
}

sub GroupRegister {
    my($name)=shift;
    my($event);
    
    if (defined($paje_groups{$name})) {
	print STDERR "paje group $name already exists\n";
    }
    my(%empty_hash,%eh2);
    $paje_groups{"groups"}{$name}{"cles"}=\%empty_hash;
    $paje_groups{"groups"}{$name}{"name"}=$name;

    for $event (@_) {
	my($evname)=$event->{"name"};
	if (defined($paje_groups{"events"}{$evname})) {
	    print STDERR "Event $evname already defined\n";
	}
	$paje_groups{"events"}{$evname}=$event;
	$paje_groups{"groups"}{$name}{"events"}{$evname}=$event;
	$event->{"group"}=$paje_groups{"groups"}{$name};
    }
    $paje_groups{"groups"}{$name}{"nb_events"}=
	scalar (keys %{$paje_groups{"groups"}{$name}{"events"}});
    $paje_groups{"groups"}{$name}{"count"}=0;    
}

sub GroupPrint {
    my($date)=shift;
    my($paje_event_print_master);
    $paje_event_print_master=sub {
	my($event)=shift;
	
	if (defined($event->{"master_printed"})) {
	    return;
	}
	$event->{"master_printed"}=1;
	my($dep_event);
	for $dep_event (@{$event->{"depends"}}) {
	    $paje_event_print_master->($paje_groups{"events"}{$dep_event});
	}
	Print($event->{"master_type"}, $date, $event->{"name"}."\t".$event->{"master_enddef"});
    };
    my($event);
    for $event (values %{$paje_groups{"events"}}) {
	$paje_event_print_master->($event);
    }
}

sub paje_group_find {
    my($group)=shift;

    if (defined($paje_groups{"groups"}{$group})) {
	return $paje_groups{"groups"}{$group};
    }

    print STDERR "No group for $group\n";
}

sub paje_group_get_event {
    my($group)=shift;
    my($event_name)=shift;

    if (!defined($event_name)) {
	if ($group->{"nb_events"}==1) {
	    print STDERR "Auto event in group ",$group->{"name"},"\n";
	    die "toto";
	}
	$event_name=$group->{"name"};
    }
    if (!defined($group->{"events"}{$event_name})) {
	print STDERR "No event $event_name in group ",$group->{"name"},"\n";
	die;
    }
    return $group->{"events"}{$event_name};
}

sub paje_group_get_elem {
    my($group)=shift;
    my($cle)=shift;

    if (!defined($group->{"cles"}{$cle})) {
	print STDERR "No cle $cle in group ",$group->{"name"},"\n";
    }
    return $group->{"cles"}{$cle};
}

sub paje_group_get_id {
    my($gr)=paje_group_find(shift);
    my($event)=paje_group_get_event($gr, shift);
    my($cle)=shift;
    my($date)=shift;
    my($infos)=shift;

    if (!defined($cle)) { die "toto"; } ;
    if (defined($gr->{"cles"}->{$cle})) {
	return $event->{"name"}.$gr->{"cles"}->{$cle}->{"id"};
    }
    my($elem)=paje_group_create($gr->{"name"}, $cle, $date, $infos);
    return $event->{"name"}.$elem->{"id"};
}

sub paje_group_get {
    my($group)=shift;
    my($info)=shift;
    my($gr)=paje_group_find($group);

    if (defined($gr->{$info})) {
	return $gr->{$info};
    }
    print STDERR "No info $info for group $group\n";
    return;
}

sub paje_group_create {
    my($gr)=paje_group_find(shift);
    my($cle)=shift;
    my($date)=shift;
    my($infos)=shift;

#    if ($cle == 3221158976) {
#	die;
#    }

    if (defined($gr->{"cles"}->{$cle})) {
	die ("Cle $cle already exist in group ".$gr->{"name"});
    }

    my($id)=++($gr->{"count"});
    my(%new_hash)=("id" => $id,
		   "cle" => $cle,
		   "infos" => $infos);
    $gr->{"cles"}->{$cle}=\%new_hash;
    
    my($sub_event);
    for $sub_event (values %{$gr->{"events"}}) {
	($sub_event->{"sub_enddef_func_create"})->
	    ($date, $gr, $sub_event, \%new_hash);
    }
    return \%new_hash;

}

sub paje_group_destroy {
    my($gr)=paje_group_find(shift);
    my($cle)=shift;
    my($elem)=paje_group_get_elem($gr, $cle);
    my($date)=shift;
    my($infos)=shift;

#    if ($cle == 3221158976) {
#	die;
#    }

    my($sub_event);
    for $sub_event (reverse (values %{$gr->{"events"}})) {
	($sub_event->{"sub_enddef_func_destroy"})->
	    ($date, $gr, $sub_event, $elem);
    }
    delete ($gr->{"cles"}->{$cle});
}

my $color=' "1 1 0"';
################################################################
# Paje : gestion vnements utilisateurs
sub paje_event_create_ue {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	       $event->{"name"}.' "'.$elem->{"infos"}.'"'.$color);
}

sub paje_event_destroy_ue {
}

sub paje_event_create_id {
    my($group)=shift;
    my($cle)=shift;
    my($date)=shift;
    my($id)=shift;
    my($gr)=paje_group_find($group);

    Print($gr->{"type"}, $date, $gr->{"prefix"}.$id.
	       " ".$gr->{"type_name"}.' "'.
	       $gr->{"cles"}->{$cle}->{"infos"}.'"');
}

sub paje_event_destroy_id {
}

sub paje_event_gen {
    my($date)= shift;
    my($utid)= shift;
    my($event)= shift;

    if (defined($utid)) {
	my($id)=paje_group_get_id("UE", "UE", "none", $date, $event);
	my($tid)=paje_group_get_id("UT", "U", $utid->Name, $date);
	Print(10,$date,"UE $tid $id");
	paje_group_destroy("UE", "none");
    }
}

################################################################
# Paje : gestion threads utilisateurs
sub paje_event_create_u {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(CreateContainer, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' UV1 "'.$elem->{"cle"}.'"');
}

sub paje_event_destroy_u {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DestroyContainer, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"});
}

sub paje_event_create_lu {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' "'.$elem->{"cle"}.'"'.$color);
}

sub paje_event_destroy_lu {
}

sub paje_event_create_pu {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' "'.$elem->{"cle"}.'"'.$color);
}

sub paje_event_destroy_pu {
}

sub paje_event_create_l {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(CreateContainer, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' LV1 "'.$elem->{"cle"}.'"');
}

sub paje_event_destroy_l {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DestroyContainer, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"});
}

sub paje_event_create_ul {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' "'.$elem->{"cle"}.'"'.$color);
}

sub paje_event_destroy_ul {
}

sub paje_event_create_pl {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' "'.$elem->{"cle"}.'"'.$color);
}

sub paje_event_destroy_pl {
}

sub paje_event_create_p {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(CreateContainer, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' PV1 "'.$elem->{"cle"}.'"');
}

sub paje_event_destroy_p {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DestroyContainer, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"});
}

sub paje_event_create_up {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' "'.$elem->{"cle"}.'"'.$color);
}

sub paje_event_destroy_up {
}

sub paje_event_create_lp {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    Print(DefineEntityValue, $date, $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' "'.$elem->{"cle"}.'"'.$color);
}

sub paje_event_destroy_lp {
}

sub paje_ut_register {
    my($date)=shift;
    my($utid)=shift;

    my($id)=paje_group_create("UT", $utid->Name, $date);
}

sub paje_ut_unregister {
    my($date)=shift;
    my($utid)=shift;

    my($id)=paje_group_destroy("UT", $utid->Name, $date);
}

sub paje_lwp_register {
    my($date)=shift;
    my($lwp)=shift;

    my($id)=paje_group_create("LWP", $lwp->Name, $date);
}

sub paje_lwp_unregister {
    my($date)=shift;
    my($lwp)=shift;

    my($id)=paje_group_destroy("LWP", $lwp->Name, $date);
}

sub paje_proc_register {
    my($date)=shift;
    my($proc)=shift;

    my($id)=paje_group_create("PROC", $proc->Name, $date);
}

sub paje_proc_unregister {
    my($date)=shift;
    my($proc)=shift;

    my($id)=paje_group_destroy("PROC", $proc->Name, $date);
}

my($actif)=-1;

sub paje_ut_get_hand {
    my($date)=shift;
    my($proc)=shift;
    my($act)=shift;
    my($lwp)=shift;
    my($utid)=shift;
    
    my($cuid)=paje_group_get_id("UT", "U", $utid->Name, $date);
    my($clid)=paje_group_get_id("LWP", "L", $lwp->Name, $date);
    my($cpid)=paje_group_get_id("PROC", "P", $proc->Name, $date);

    my($luid)=paje_group_get_id("UT", "LU", $utid->Name, $date);
    my($ulid)=paje_group_get_id("LWP", "UL", $lwp->Name, $date);
    my($puid)=paje_group_get_id("UT",  "PU", $utid->Name, $date);
    my($upid)=paje_group_get_id("PROC","UP", $proc->Name, $date);

    Print(11,$date,"UL $cuid $ulid");
    Print(11,$date,"LU $clid $luid");
    Print(11,$date,"PU $cpid $puid");
    Print(11,$date,"UP $cuid $upid");
}

sub paje_ut_give_hand {
    my($date)=shift;
    my($proc)=shift;
    my($act)=shift;
    my($lwp)=shift;
    my($utid)=shift;
    
    my($cuid)=paje_group_get_id("UT", "U", $utid->Name, $date);
    my($clid)=paje_group_get_id("LWP", "L", $lwp->Name, $date);
    my($cpid)=paje_group_get_id("PROC", "P", $proc->Name, $date);

    Print(12,$date,"UL $cuid");
    Print(12,$date,"LU $clid");
    Print(12,$date,"PU $cpid");
    Print(12,$date,"UP $cuid");
}

sub paje_kt_get_hand {
    my($date)=shift;
    my($proc)=shift;
    my($act)=shift;
    my($lwp)=shift;
    my($utid)=shift;
    
    my($cuid);
    if (defined($utid)) {
	$cuid=paje_group_get_id("UT", "U", $utid->Name, $date);
    }
    my($clid)=paje_group_get_id("LWP", "L", $lwp->Name, $date);
    my($cpid)=paje_group_get_id("PROC", "P", $proc->Name, $date);

    my($lpid)=paje_group_get_id("PROC", "LP", $proc->Name, $date);
    my($plid)=paje_group_get_id("LWP", "PL", $lwp->Name, $date);
    my($puid);
    if (defined($utid)) {
	$puid=paje_group_get_id("UT",  "PU", $utid->Name, $date);
    }
    my($upid)=paje_group_get_id("PROC","UP", $proc->Name, $date);

    Print(11,$date,"LP $clid $lpid");
    Print(11,$date,"PL $cpid $plid");
    if (defined($utid)) {
	Print(11,$date,"PU $cpid $puid");
	Print(11,$date,"UP $cuid $upid");
    }
}

sub paje_kt_give_hand {
    my($date)=shift;
    my($proc)=shift;
    my($act)=shift;
    my($lwp)=shift;
    my($utid)=shift;

    my($cuid);
    if (defined($utid)) {
	$cuid=paje_group_get_id("UT", "U", $utid->Name, $date);
    }
    my($clid)=paje_group_get_id("LWP", "L", $lwp->Name, $date);
    my($cpid)=paje_group_get_id("PROC", "P", $proc->Name, $date);

    Print(12,$date,"LP $clid");
    Print(12,$date,"PL $cpid");
    if (defined($utid)) {
	Print(12,$date,"PU $cpid");
	Print(12,$date,"UP $cuid");
    }
}

################################################################
# Paje : gestion fonctions utilisateurs
sub paje_event_create_uf {
    my($date)=shift;
    my($gr)=shift;
    my($event)=shift;
    my($elem)=shift;

    my($mycolor)=$color;

    $_=$elem->{"infos"}->[1];

    if (/all_reduce/) {
	$mycolor=' "0.5 0 0"';
    } elsif (/want_spinlock/) {
	$mycolor=' "1 0 0"';
    } elsif (/have_spinlock/) {
	$mycolor=' "1 0 0"';
    } elsif (/EnvoyerRecouvrement/) {
	$mycolor=' "1 0 0"';
    } elsif (/RecevoirFantome/) {
	$mycolor=' "1 0 0"';
    } elsif (/WaitEndComm/) {
	$mycolor=' "1 0 0"';
    }

    Print(DefineEntityValue, $date, 
	  $event->{"name"}.$elem->{"id"}." ".
	  $event->{"name"}.' '.$elem->{"infos"}->[1].$mycolor);
}

sub paje_function_enter {
    my($date)= shift;
    my($function)= shift;
    my($utid)= shift;
    my($infos)= shift;
    my($tid)=paje_group_get_id("UT", "U", $utid->Name, $date);
    my($fid)=paje_group_get_id("UF", "UF", $function, $date, $infos);
   
    Print(11,$date,"UF $tid $fid");
}

sub paje_function_exit {
    my($date)= shift;
    my($function)= shift;
    my($utid)= shift;
    my($infos)= shift;
    my($tid)=paje_group_get_id("UT", "U", $utid->Name, $date);
    my($fid)=paje_group_get_id("UF", "UF", $function, $date, $infos);
   
    Print(12,$date,"UF $tid");
}

################################################################
my($last_date)=0;
my($rand_delay)=0;
use Math::BigInt  lib => 'GMP';
sub Print {
    my($type) = shift;
    my($date) = shift;
    my($infos) = shift;
    my($pdate) = Math::BigInt->new(0);

# TODO: Paje
#    if ($date < SuperTrace::DateStart()) {
#	$pdate = SuperTrace::DateStart();
#    } else {
	$pdate += $date*1;
#    }

    my($cycle)=$pdate % 2657798000;
    my($s)=$pdate/2657798000;
    my($ns)=($cycle*1000000000) / 2657798000;

    #printf("%i $s.%09s %s\n", $type, $ns, $infos);
    printf("%i $date.0 %s\n", $type, $infos);
}

#sub Events {
#    SuperTrace::PajeEvents;
#}

sub Event {
    my($ev)=shift;
    my($date, $proc, $act, $lwp, $utid, $ev_type, $event_infos);
    
    $date=Event::date($ev);
    $proc=Event::proc($ev);
    $lwp=Event::lwp($ev);
    $utid=Event::utid($ev);
    $ev_type=Event::type($ev);
    $event_infos=Event::infos($ev);

    if ($ev_type==Event::UT_GIVE_HAND) {
	Paje::paje_ut_give_hand($date, $proc, undef, $lwp, $utid);
    } elsif ($ev_type==Event::UT_GET_HAND) {
	Paje::paje_ut_get_hand($date, $proc, undef, $lwp, $utid);
    } elsif ($ev_type==Event::LWP_GIVE_HAND) {
	Paje::paje_kt_give_hand($date, $proc, undef, $lwp, $utid);
    } elsif ($ev_type==Event::LWP_GET_HAND) {
	Paje::paje_kt_get_hand($date, $proc, undef, $lwp, $utid);
    } elsif ($ev_type==Event::FUT || $ev_type==Event::FKT) {
	my @ev=@{$event_infos};
	#splice(@ev,0,5);
	if ($ev[0] =~ /gcc-traced function/) {
	    $ev[1] =~ s/No symbol at //;
	    if ($ev[0] =~ /entry/) { 
		Paje::paje_function_enter($date, $ev[1], $utid, \@ev);
	    } else {
		Paje::paje_function_exit($date, $ev[1], $utid, \@ev);
	    }
	} else {
	    Paje::paje_event_gen($date, $utid, join(' ', @ev));
	}
    } elsif ($ev_type==Event::CREATE_PROC) {
	Paje::paje_proc_register($date, $proc);
    } elsif ($ev_type==Event::DESTROY_PROC) {
	Paje::paje_proc_unregister($date, $proc);
    } elsif ($ev_type==Event::CREATE_LWP) {
	Paje::paje_lwp_register($date, $lwp);
    } elsif ($ev_type==Event::DESTROY_LWP) {
	Paje::paje_lwp_unregister($date, $lwp);
    } elsif ($ev_type==Event::CREATE_UT) {
	my @ev=(undef, "Existing");
	Paje::paje_ut_register($date, $utid);
	Paje::paje_function_enter($date, "Existing", $utid, \@ev);
    } elsif ($ev_type==Event::DESTROY_UT) {
	my @ev=(undef, "Existing");
	Paje::paje_function_exit($date, "Existing", $utid, \@ev);
	Paje::paje_ut_unregister($date, $utid);
#    } elsif (/UEV_FUNC_ENTER/) {
#	my($function)=$event_infos->{"function"};
#	paje_function_enter($date, $function, $utid, $event_infos);
#    } elsif (/UEV_FUNC_EXIT/) {
#	my($function)=$event_infos->{"function"};
#	paje_function_exit($date, $function, $utid, $event_infos);
	#my($fid)=paje_function_get_id($function, $date);
	#paje_print(6,$date,"$fid UE \"$event_infos\"");
	#paje_print(10,$date,"UE UTV_UT$utid $fid");
	#paje_print(6,$date,"UE".++$nbev." UTV_UT_FUNC \"$event_infos\"");
	#paje_print(10,$date,"UTV_UT_FUNC UTV_UT$utid UTV_UT_E".$nbev);
	#__display_event($date, $proc, $act, $lwp, $utid, $event_infos);
    } elsif ($ev_type==Event::NOP) {
    } else {
	print STDERR "Unknown event type $ev_type\n";
	#__display_event($date, $proc, $act, $lwp, $utid, 
	#		"Unknown event type $ev_type");
    }
}

sub End {

}


package main;

################################################################
# FKT/FUT

sub insert_fkt_event {
    my($date)=shift;
    my($proc)=shift;
    my($lwp)=shift;
    my($ev)=shift; # vnement

    ensure_proc($date, $proc, $lwp) or
	print STDERR "Event on new proc $proc\n";
    if ($lwp == 0) {
	$lwp = -$proc #IDLE processes
    }
    ensure_proc($date, $proc, $lwp) or
	print STDERR "Event on new proc $proc\n";

    if ($ev->[5] eq "switch_to") {
	my($old_lwp)=proc_get_lwp($proc);
    	insert_KSW($date, $old_lwp, $lwp, $proc);
    } elsif ($ev->[5] eq "user_fork") {
	my($utid)=$ev->[6];
	$utid =~ s/,$//;
	ensure_lwp($date, $proc, $lwp, $utid, $utid);	
	ensure_ut($date, $proc, get_lwp_by_num($lwp), $utid, $utid);	
    } else {
	print STDERR "Ignoring ev $ev->[5]\n";
    }
}

sub insert_fut_event {
    my($date)=shift;
    my($proc)=shift;
    my($utid)=shift;
    my($ev)=shift; # vnement

    if ($ev->[5] eq "fut_switch_to") {
    	insert_USW($date, $utid, $ev->[6], $proc);
    } elsif ($ev->[5] eq "user_fork") {
	my($utid)=$ev->[6];
	$utid =~ s/,$//;
	my($lwp)=0;
	ensure_lwp($date, $proc, $lwp, $utid, $utid);	
	ensure_ut($date, $proc, get_lwp_by_num($lwp), $utid, $utid);	
    } elsif ($ev->[5] eq "gcc-traced") {
	
    } else {
	print STDERR "Ignoring ev $ev->[5]\n";
    }
}


my($max_prefetch)=5;
my($global_offset)=10;
use Math::BigInt  lib => 'GMP';
use sort 'stable';
my($fkt_print)="/home/vdanjean/travail/fkt/tools/fkt_print";
my($fut_print)="/home/vdanjean/travail/fkt/tools/fut_print";
sub input_from_fxt {
    my($user_traces)=shift;
    my($kernel_traces)=shift;
    my($user_basetime);
    my($kernel_basetime);
    my($basetime);
    my($user_offset);
    my($kernel_offset);

    open(FKT, "$fkt_print 2>/dev/null -f $kernel_traces |") 
	or die "Unable to open $kernel_traces: $!\n";
    open(FUT, "$fut_print 2>/dev/null -f $user_traces |") 
	or die "Unable to open $user_traces: $!\n";
    

    while(<FUT>) {
	chomp;
	if (/^initial: basetime ([0-9]+)$/) {
	    $user_basetime = Math::BigInt->new($1);
	    disp("User basetime : ", $user_basetime,"\n");
	    last;
	}
    }
    while(<FKT>) {
	chomp;
	if (/^initial: basetime ([0-9]+)$/) {
	    $kernel_basetime = Math::BigInt->new($1);
	    disp("Kernel basetime : ", $kernel_basetime, "\n");
	    last;
	}
    }
    while(<FKT>) {
	chomp;
	if (/^ *[0-9]+ +([0-9]+) +.* fkt_setup +[0-9a-fx]+,? +[0-9a-fx]+,? +[0-9a-fx]+,? +[0-9a-fx]+,? +([0-9a-fx]+)$/) {
	    my($correction)=Math::BigInt->new($1);
	    my($hi)=Math::BigInt->new(2**32 * $2);
	    $kernel_basetime += $correction + $hi; # + $correction;
	    disp("Kernel basetime corrected : ", $kernel_basetime, "\n");
	    last;
	}
    }
    if ($user_basetime < $kernel_basetime) {
	$basetime=$user_basetime;
	$user_offset=$global_offset;
	$kernel_offset=$kernel_basetime-$user_basetime+$global_offset;
    } else {
	$basetime=$kernel_basetime;
	$kernel_offset=$global_offset;
	$user_offset=$user_basetime-$kernel_basetime+$global_offset;
    }
    disp("Basetime: ", $basetime, " User offset: ", $user_offset, 
	    " Kernel offset: ", $kernel_offset, "\n");

    my($read_user)=$max_prefetch;
    my($read_kernel)=$max_prefetch;
    my(@lines);
    my($last_time)=0;
    
    while(1) {
	while ($read_user>0 || $read_kernel>0) {
	    my(@ligne);
	    my($type);
	    my($offset);
	    if ($read_user>0) {
		$_=<FUT>;
		if ((not $_) || ($_ eq "\n")) {
		    $read_user=-($max_prefetch*2+10);
		    next;
		}
		if (/^===/) {
		    next;
		}
		$read_user--;
		$type="FUT_EV";
		$offset=$user_offset;
	    } elsif ($read_kernel>0) {
		$_=<FKT>;
		if ((not $_) || ($_ eq "\n")) {
		    $read_kernel=-($max_prefetch*2+10);
		    next;
		}
		if (/^===/) {
		    next;
		}
		$read_kernel--;
		$type="FKT_EV";
		$offset=$kernel_offset;
	    } else {
		last;
	    }
	    chomp;
	    @ligne=split;
	    $ligne[0]=$type;
	    $ligne[1]+=$offset;
	    @lines=sort { $a->[1] <=> $b->[1] } @lines, \@ligne;
	}
	my($ev);
	$ev=shift @lines;
	if (!defined($ev)) {
	    last;
	}
	my $field;
	$debug && print "--------------------------------------------------\n";
	$debug && print "Insert: ";
	for $field (@{$ev}) {
	    $field =~ s/,$//;
	    $debug && print $field, " ";
	}
	$debug && print "\n";
	if ($ev->[0] eq "FUT_EV") {
	    FxT::InsertFUT($ev->[1], $ev->[3], $ev);
	    $read_user++;
	} elsif ($ev->[0] eq "FKT_EV") {
	    FxT::InsertFKT($ev->[1], $ev->[2], $ev->[3], $ev);
	    $read_kernel++;
	} else {
	    print "Arghhh\n";
	}
    }
    
    close(FUT);
    close(FKT);

}

################################################################
# Programme principal
use Getopt::Long qw(:config permute);
use Pod::Usage;

sub disp {
    print STDERR @_;
    return 0;
    my($info)=shift;
    while($info) {
    	print STDERR $info;
	$info=shift;
    }
}

sub insert {
    $_=shift;
    chomp;
    $debug && print "--------------------------------------------------\n";
    $debug && print "Insert: ",$_,"\n";
    my @l=split;
    if ($l[0] eq "K") {
	FxT::InsertFKT($l[1], $l[2], $l[3], \@l);
    } else {
	FxT::InsertFUT($l[1], $l[3], \@l);
    }
}

sub input_test {
    insert("U 00	0 T01		fut_setup	0x7fffffff, 0, 2097152");
    insert("K 10	2 1181	unknown	switch_to	_K1_");
    insert("K 20	0 0	idle	switch_to	457");
    insert("K 30	1 460	klogd	switch_to	-1");
    insert("K 40	2 _K1_	traces	fkt_keychange	0x100000 0x24169980");
    insert("U 50	0 T01		fut_new_lwp	T01 0");
    insert("K 60	0 457	syslogd	switch_to	0");
    insert("K 70	2 _K1_	traces	user_fork	T01 0");
    insert("U 80	2 T01		fut_thread_birth T02");
    insert("U 85	2 T01		fut_thread_birth T11");
    insert("U 85	2 T01		fut_thread_birth T12");
    insert("U 90	2 T01		fut_thread_birth T03");
    insert("U 95	2 T01		fut_thread_birth T13");
    insert("K 97    1 -1    traces  switch_to       _K2_");
    insert("K 99    1 _K2_	traces  user_fork       T13");
    insert("U 100   2 T01		fut_switch_to	T02");
    insert("U 110   2 T02		fut_switch_to	T03");
    insert("U 115   1 T13		fut_switch_to	T12");
    insert("U 120   2 T03		fut_switch_to	T01");
    insert("K 125   1 _K2_	traces  switch_to       TOTO");
    insert("U 130   2 T01		fut_switch_to	T02");
    insert("U 140   2 T02		fut_switch_to	T03");
    insert("U 150   2 T03		fut_switch_to	T01");
    insert("K 155   0 0     traces  switch_to       _K2_");
    insert("U 160   2 T01		fut_switch_to	T02");
    insert("U 170   2 T02		fut_switch_to	T03");
    insert("U 172   0 T13		event 		T13_a_encore_la_main");
    insert("U 175   0 T12		fut_switch_to	T11");
    insert("U 180   2 T03		fut_switch_to	T01");
    insert("K 190   2 _K1_	traces	switch_to	0");
}

sub usage {
    print "Options\n", 
    "  --user trace_user\n",
    "  --kernel trace_kernel\n",
    "  --test : small predefined entries\n",
    "  --dump : stop and show events before generating Paje traces\n",
    "  --debug : full traces of execution\n",
    "";
}

sub main {
    my($test, $dump)=(0,0);
    my($cache_size)=3;
    our($user_traces, $kernel_traces);
    GetOptions ("user=s" => \$user_traces,
		"kernel=s" => \$kernel_traces,
		"test"   =>  \$test,
		"debug"   =>  \$debug,
		"dump"   =>  \$dump,
		"cache-size=i" => \$cache_size) 
	|| ( usage() , exit(1) );

    my($colK)=ColEvInputTexteKernel->new();

    $colK->addEvs
	("10	2 1181	unknown	switch_to	_K1_",
	 "20	0 0	idle	switch_to	457",
	 "40	2 _K1_	traces	fkt_keychange	0x100000 0x24169980",
	 "30	1 460	klogd	switch_to	-1",
	 "60	0 457	syslogd	switch_to	0",
	 "70	2 _K1_	traces	user_fork	T01 0",
	 "97    1 -1    traces  switch_to       _K2_",
	 "99    1 _K2_	traces  user_fork       T13",
	 "125   1 _K2_	traces  switch_to       TOTO",
	 "155   0 0     traces  switch_to       _K2_",
	 "210   2 _K1_	traces	switch_to	0");

    my($colU);

    if ($user_traces) {
	$colU=ColEvInputFxTprintUser->new($user_traces);
    } else {
	$colU=ColEvInputTexteUser->new();
    
	$colU->addEvs
	    (
	     "00	0 T01		fut_setup	0x7fffffff, 0, 2097152",
	     "50	0 T01		fut_new_lwp	T01 0",
	     "68	x T01	        fut_user_fork	_K1_",
	     "80	2 T01		fut_thread_birth T02",
	     "85	2 T01		fut_thread_birth T11",
	     "85	2 T01		fut_thread_birth T12",
	     "90	2 T01		fut_thread_birth T03",
	     "95	2 T01		fut_thread_birth T13",
	     "98    X T13	        fut_user_fork    _K2_",
	     "100   2 T01		fut_switch_to	T02",
	     "110   2 T02		fut_switch_to	T03",
	     "115   1 T13		fut_switch_to	T12",
	     "120   2 T03		fut_switch_to	T01",
	     "130   2 T01		fut_switch_to	T02",
	     "140   2 T02		fut_switch_to	T03",
	     "150   2 T03		fut_switch_to	T01",
	     "160   2 T01		fut_switch_to	T02",
	     "170   2 T02		fut_switch_to	T03",
	     "180   0 T13		event 		T13_a_encore_la_main",
	     "185   0 T13		event 		T13_a_encore_la_main2",
	     "190   0 T12		fut_switch_to	T11",
	     "200   2 T03		fut_switch_to	T01",
	     "220   2 T01		event	Oh_encore_un_ev"
	     );
    }

    $colU=ColEvTimeSort->new($colU, $cache_size);
    $colK=ColEvTimeSort->new($colK, $cache_size);

    $colK=ColEvInsertEnd->new($colK, 0);    
      $colU=ColEvInsertEnd->new($colU, 0);    

    $colU=ColEvSwitchTo->new($colU);
    $colK=ColEvSwitchTo->new($colK);

    $colK=ColEvProc->new($colK, ColProc->new());
    $colK=ColEvLwp->new($colK, ColLwp->new());

     $colU=ColEvProc->new($colU, ColProc->new());
     $colU=ColEvLwp->new($colU, ColLwp->new());

    $colU=ColEvUtid->new($colU, ColUtid->new());

    $colK=ColEvHandLwp->new($colK);
      #$colU=ColEvHandLwp->new($colU);
    $colU=ColEvHandUtid->new($colU);
    

    #$colK=ColEvSplit->new($colK);

    #$colU=ColEvFusion($colU, $colK->getSplited());
    #$colU=ColEvFusion($colU, $colK);

    my($colEv);
    #$colEv=ColEvMerge->new($colU, $splitEv);
    
    $colEv=$colU;
    #$colEv=ColEvMerge->new($colU, $colK);

    $colEv=ColEvTimeWait->new($colEv);
    $colEv=ColEvFusionKU->new($colEv);
    
    #$colEv=$colK;
    #$colEv=ColEvTimeWait->new($colEv);

    $colEv=ColEvFusionK->new($colEv);
    $colEv=ColEvEntitySort->new($colEv);

    $colEv=ColEvHandLwp->new($colEv);
    $colEv=ColEvFusionK->new($colEv);


    if ($dump) {
	my($ev)=$colEv->getEv(); 
	while (defined($ev)) {
	    Event::Dump($ev);
	      $ev=$colEv->getEv();
	  }
    } else {
	
	Paje::Entete();
	  
	my($ev)=$colEv->getEv();
	while (defined($ev)) {
	    #Event::Dump($ev);
	    Paje::Event($ev);
	    $ev=$colEv->getEv();
	}

	Paje::End();
    }

}
 
main();

