# TAOCP Vol 1, Section 2.5, Exercise 27. MMIX version. 
# Algorithms R and S pg. 443, buddy system reservation and liberation.
# Perl wrapping for testing.

$path_to_mmix = "mmix";


# Arguments
$m = $ARGV[0] || 10;
$runs = $ARGV[1] || 100;
$blocks = $ARGV[2] || 100;
$seed = $ARGV[3] || 0;
$dry_until = $ARGV[4] || 0;

# Prepare distribution of block lengths.
@dist = ();
for my $i (5..$m-1) {
    for  (1..2**($m-1-$i)) {
	push(@dist,$i);
    }
}

srand($seed);
for (my $i = 0; $i < $runs; $i++) {
    if ($i >= $dry_until) {
	&run($i);
    }
}


sub create_source {
    my $ma= shift;
    my $f,$o;
    open($f,"buddy_run.mms") || die;
    open($o,">test.mms") || die;
    my $ignore = 0;
    while(<$f>) {
	s/^M\s+IS\s+10/M IS $m/;
	if (/^[%]{2}START/) {
	    $ignore = 1;
	    # Initial bias
	    $alloc = 0;
	    $blnum = 0;
	    @code = ();

	    for (1..$blocks) {
		&test_liberate($o) if ($alloc > 2*2**$m);	# initial warming-up
		&test_reserve($o);
	    }
	    &test_liberate($o) until ($#b < 0);

	    print $o "code SWYM\n";
	    for (@code) {
		if (/^R(\d+)/) {
		    printf $o " GETA p,data%05d\n",$1;
		    print $o  " LDBU para1,p,0\n LDOU para2,p,8\n PUSHJ para0,:TestReserve\n STOU para0,p,16\n";
		}
		if (/^L(\d+)/) {
		    printf $o " GETA p,data%05d\n",$1;
		    print $o  " LDOU para1,p,16\n LDBU para2,p,0\n LDOU para3,p,8\n PUSHJ para0,:TestLiberate\n";
		}
	    }
	    
	}
	if (/^[%]{2}STOP/) {
	    $ignore = 0;
	}
	if (!$ignore) {
	    print $o $_ ;
	}
    }
    close($o);
    close($f);
}


sub test_reserve {
    my $file = shift;
    my $k = $dist[int(rand($#dist))];
    my $pattern = join('',map { sprintf("%04X",int(rand(65536))) } (1..4));
    printf $file "data%05d BYTE $k\n OCTA #$pattern\n OCTA 0\n\n", $blnum;
    push(@code,"R$blnum");
#    print "reserve($k) $blnum\n";
    push (@b,$blnum++);
    $alloc+=2**$k;

}

sub test_liberate {
    my $n = $#b;
    my $i = int(rand($n));
    my $bn = splice(@b,$i,1);
    push(@code,"L$bn");    
#    print "liberate $bn n: $n i: $i\n";
}



sub run {
    my $n = shift;
    &create_source();
    system("mmixal test.mms");
    my $r;
    my $result = '';
    open ($r,"$path_to_mmix test|") || die;
    while (<$r>) {
	$result .= $_;
    }
    close($r);
    printf "n=%4d result=%s\n",$n,$result;
}