chrislo-sourceclassifier 0.2.0

data/sources/gcc/wordfreq.gcc-2.gcc

@@ -0,0 +1,85 @@
+/* -*- mode: c -*-
+ * $Id: wordfreq.gcc-2.gcc,v 1.1 2004-11-10 06:40:32 bfulgham Exp $
+ * http://www.bagley.org/~doug/shootout/
+ * From Kerry Clendinning
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <malloc.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define NALPHA 26		/* number of letters in the alphabet */
+struct onebytehash {
+    int count;
+    struct onebytehash *next_chain,*next_hash[NALPHA];
+    char string[1];		/* one of those stretchy string-things */
+};
+
+int compare(struct onebytehash **a, struct onebytehash **b);
+typedef int (*comparator)(const void *, const void *);
+
+int
+main()
+{
+    int c, nextc, i = 0, curbufsz = 200, used_hash_count = 0;
+    struct onebytehash the_hash = {0,NULL},
+	*current_hash = &the_hash, *chain = NULL;
+    struct onebytehash **sort_array, **sort_tmp;
+    char *buf;
+
+    buf = malloc(curbufsz + 1);
+    c = getchar();
+    while ( (nextc = getchar()) > 0 ) {
+        if (isalpha(c)) {
+            buf[i++] = tolower(c);
+            buf[i] = '\0';
+            c = tolower(c) - 'a';
+            if (!current_hash->next_hash[c]) {
+                if (i >= curbufsz) {
+		    curbufsz *= 2;
+		    buf = realloc(buf,curbufsz + 1);
+                } 
+                current_hash->next_hash[c] =
+		    malloc(sizeof(struct onebytehash) + i+1);
+                bzero(current_hash->next_hash[c],sizeof(struct onebytehash));
+                current_hash->next_hash[c]->next_chain = chain;
+                chain = current_hash->next_hash[c];
+                strcpy(chain->string,buf);
+            }
+            current_hash = current_hash->next_hash[c];
+            if (!isalpha(nextc)) {
+                if (!current_hash->count) used_hash_count++;
+                current_hash->count++;
+            }
+        } else {
+            current_hash = &the_hash;
+            i = 0;
+        }
+        c = nextc;
+    }
+
+    sort_array = sort_tmp =
+	malloc(sizeof(struct onebytehash *) * used_hash_count);
+    while (chain) {
+	if (chain->count) *sort_tmp++ = chain;
+	chain = chain->next_chain;
+    }
+
+    qsort(sort_array, used_hash_count, sizeof(struct onebytehash *),
+	  (comparator) compare);
+
+    for (i=0;i<used_hash_count;i++)
+	printf("%7d\t%s\n", sort_array[i]->count,sort_array[i]->string); 
+
+    /* don't forget to free allocated memory here */
+
+    return(0);
+}
+
+int compare(struct onebytehash **a, struct onebytehash **b)
+{
+    if ((*b)->count == (*a)->count) return (strcmp((*b)->string,(*a)->string));
+    return ((*b)->count - (*a)->count);
+}

data/sources/perl/ackermann.perl

@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+# $Id: ackermann.perl,v 1.3 2005-04-04 14:56:35 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+# With help from Ernesto Hernandez-Novich
+use integer;
+
+# It's prettier but slower to do this
+#sub Ack {
+#    my($M, $N) = @_;
+#    return( $N + 1 )         if ($M == 0);
+#    return( Ack($M - 1, 1) ) if ($N == 0);
+#    Ack($M - 1, Ack($M, $N - 1));
+#}
+
+# in our quest for speed, we must get ugly:
+# it helps reduce stack frame size a little bit
+# from Leif Stensson
+sub Ack {
+    return $_[0] ? ($_[1] ? Ack($_[0]-1, Ack($_[0], $_[1]-1))
+		    : Ack($_[0]-1, 1))
+	: $_[1]+1;
+}
+
+my $NUM = $ARGV[0];
+$NUM = 1 if ($NUM < 1);
+my $ack = Ack(3, $NUM);
+print "Ack(3,$NUM): $ack\n";

data/sources/perl/ackermann.perl-2.perl

@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+# $Id: ackermann.perl-2.perl,v 1.1 2005-04-04 14:56:35 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+# With help from Ernesto Hernandez-Novich
+use integer;
+
+# Note:  If memoization were allowed in this program, we could
+# do so by adding:
+use Memoize;
+memoize("Ack");
+
+# in our quest for speed, we must get ugly:
+# it helps reduce stack frame size a little bit
+# from Leif Stensson
+sub Ack {
+    return $_[0] ? ($_[1] ? Ack($_[0]-1, Ack($_[0], $_[1]-1))
+		    : Ack($_[0]-1, 1))
+	: $_[1]+1;
+}
+
+my $NUM = $ARGV[0];
+$NUM = 1 if ($NUM < 1);
+my $ack = Ack(3, $NUM);
+print "Ack(3,$NUM): $ack\n";

data/sources/perl/ackermann.perl-3.perl

@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+# $Id: ackermann.perl-3.perl,v 1.1 2005-04-27 16:51:28 greg-guest Exp $
+# http://www.bagley.org/~doug/shootout/
+
+# We avoid using memoize by inlining the cache
+# from Thomas Drugeon
+
+# in our quest for speed, we must get ugly:
+# it helps reduce stack frame size a little bit
+# from Leif Stensson
+sub Ack {
+    $_[0] ? ($Ack[$_[0]][$_[1]] ||= $_[1] ? Ack($_[0]-1, Ack($_[0], $_[1]-1))
+		    : Ack($_[0]-1, 1))
+	: $_[1]+1;
+}
+
+my $NUM = $ARGV[0];
+$NUM = 1 if ($NUM < 1);
+my $ack = Ack(3, $NUM);
+print "Ack(3,$NUM): $ack\n";

data/sources/perl/ackermann.perl-4.perl

@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+# The Great Win32 Computer Language Shootout
+# http://shootout.alioth.debian.org/
+# modified by Isaac Gouy
+
+use integer;
+
+sub Ack {
+    my($M, $N) = @_;
+    return( $N + 1 )         if ($M == 0);
+    return( Ack($M - 1, 1) ) if ($N == 0);
+    Ack($M - 1, Ack($M, $N - 1));
+}
+
+my $NUM = $ARGV[0];
+$NUM = 1 if ($NUM < 1);
+my $ack = Ack(3, $NUM);
+print "Ack(3,$NUM): $ack\n";

data/sources/perl/ary.perl

@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+# $Id: ary.perl,v 1.2 2004-05-22 07:25:00 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+# this program is modified from:
+#   http://cm.bell-labs.com/cm/cs/who/bwk/interps/pap.html
+# Timing Trials, or, the Trials of Timing: Experiments with Scripting
+# and User-Interface Languages</a> by Brian W. Kernighan and
+# Christopher J. Van Wyk.
+
+my $n = @ARGV[0] || 1;
+my @X;
+my @Y;
+
+my $last = $n - 1;
+for my $i (0..$last) {
+    $X[$i] = $i + 1;
+}
+for my $k (0..999) {
+    for my $i (reverse 0..$last) {
+	$Y[$i] += $X[$i];
+    }
+}
+
+print "$Y[0] $Y[$last]\n";

data/sources/perl/ary.perl-2.perl

@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+# The Great Computer Language Shootout
+# http://shootout.alioth.debian.org/
+# Modified: 2005-06-18 Cosimo Streppone
+
+use integer;
+
+my $n = @ARGV[0] || 1;
+my(@X, @Y, $i, $k);
+my $last = $n - 1;
+
+# Initialize @X list in a single step
+@X = (1 .. $n);
+
+# Execute 1000 times
+for(0 .. 999) {
+    # Use of `$_' aliasing is faster than using a lexical var
+    # Also, there is no need to reverse (0 .. $last) list
+    $Y[$_] += $X[$_] for 0 .. $last;
+}
+
+print $Y[0], ' ', $Y[$last], "\n";
+

data/sources/perl/binarytrees.perl

@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+# The Computer Language Shootout
+# http://shootout.alioth.debian.org/
+#
+# Contributed by Doug King
+# Corrected by Heiner Marxen
+
+use integer;
+
+sub item_check {
+    my ($tree) = @_;
+
+    return $$tree[2] unless (defined $$tree[0]);
+    return $$tree[2] + item_check($$tree[0]) - item_check($$tree[1]);
+}
+
+
+sub bottom_up_tree {
+    my($item, $depth) = @_;
+
+    return [ undef, undef, $item ] if $depth <= 0;
+    return [ bottom_up_tree(2 * $item - 1, $depth - 1),
+	     bottom_up_tree(2 * $item,     $depth - 1),
+	     $item ];
+}
+
+
+$n = shift @ARGV;
+
+$min_depth = 4;
+
+if ( ($min_depth + 2) > $n) {
+    $max_depth = $min_depth + 2;
+} else {
+    $max_depth = $n;
+}
+
+$stretch_depth = $max_depth + 1;
+
+$stretch_tree = bottom_up_tree(0, $stretch_depth);
+print "stretch tree of depth $stretch_depth\t check: ", item_check($stretch_tree), "\n";
+$stretch_tree = undef;
+
+$long_lived_tree = bottom_up_tree(0, $max_depth);
+
+$depth = $min_depth;
+while( $depth <= $max_depth ) {
+
+    $iterations = 2 ** ($max_depth - $depth + $min_depth);
+    $check = 0;
+
+    for $i (1..$iterations) {
+	$temp_tree = bottom_up_tree($i, $depth);
+	$check += item_check($temp_tree);
+	$temp_tree = undef;
+
+	$temp_tree = bottom_up_tree(-$i, $depth);
+	$check += item_check($temp_tree);
+	$temp_tree = undef;
+    }
+
+    print $iterations * 2, "\t trees of depth $depth\t check: ", $check, "\n";
+    $depth += 2;
+}
+
+print "long lived tree of depth $max_depth\t check: ", item_check($long_lived_tree), "\n";

data/sources/perl/binarytrees.perl-2.perl

@@ -0,0 +1,71 @@
+# The Computer Language Benchmarks Game
+# http://shootout.alioth.debian.org/
+#
+# Contributed by Doug King
+# Corrected by Heiner Marxen
+# Tree-building made non-recursive by Steffen Mueller
+
+use integer;
+
+sub item_check {
+    my ($tree) = @_;
+
+    return $tree->[2] unless (defined $tree->[0]);
+    return $tree->[2] + item_check($tree->[0]) - item_check($tree->[1]);
+}
+
+
+sub bottom_up_tree {
+    my($depth) = @_;
+
+    my @pool;
+    push @pool, [undef, undef, -$_] foreach 0..2**$depth-1;
+
+    foreach my $exponent (reverse(0..($depth-1))) {
+        push @pool, [reverse(splice(@pool, 0, 2)), $_] 
+                       foreach reverse(-(2**$exponent-1) .. 0);
+    }
+    return $pool[0];
+}
+
+
+my $n = shift @ARGV;
+
+my $min_depth = 4;
+my $max_depth;
+
+if ( ($min_depth + 2) > $n) {
+    $max_depth = $min_depth + 2;
+} else {
+    $max_depth = $n;
+}
+
+{
+    my $stretch_depth = $max_depth + 1;
+    my $stretch_tree = bottom_up_tree($stretch_depth);
+    print "stretch tree of depth $stretch_depth\t check: ",
+           item_check($stretch_tree), "\n";
+}
+
+my $long_lived_tree = bottom_up_tree($max_depth);
+
+my $depth = $min_depth;
+while( $depth <= $max_depth ) {
+    my $iterations = 2 ** ($max_depth - $depth + $min_depth);
+    my $check = 0;
+
+    foreach my $i (1..$iterations) {
+	my $temp_tree = bottom_up_tree($depth);
+	$check += item_check($temp_tree);
+
+	$temp_tree = bottom_up_tree($depth);
+	$check += item_check($temp_tree);
+    }
+
+    print $iterations * 2, "\t trees of depth $depth\t check: ", $check, "\n";
+    $depth += 2;
+}
+
+print "long lived tree of depth $max_depth\t check: ", 
+       item_check($long_lived_tree), "\n";
+

data/sources/perl/chameneos.perl

@@ -0,0 +1,67 @@
+#########################################
+#     The Computer Language Shootout    #
+#   http://shootout.alioth.debian.org/  #
+#                                       #
+#      Contributed by Jesse Millikan    #
+#########################################
+
+use threads;
+use threads::shared;
+
+# Complement method is numerical based on Haskell version
+my ($red, $yellow, $blue, $none) = (0,1,2,3);
+
+# Count, signal and mutex are all $meetings
+my $meetings : shared = $ARGV[0];
+
+# Locked and updated by each thread when it ends
+my $total_meetings : shared = 0;
+
+# Colour communication variables
+my $first : shared = $none;
+my $second : shared = $none;
+
+# $_ is thread on the outer map and color on the inner loop
+map { $_->join } (map {
+ # async starts a new thread running the block given
+ async {
+  my ($color, $other_color) = ($_,$none);
+  my $met = 0; 
+
+  # with 'redo', loop until 'last' is called
+  LIVE: { 
+
+   # Meeting place 
+   { 
+    lock $meetings;
+    
+    last LIVE if($meetings <= 0); # 'fade' by jumping out of the block
+
+    if($first != $none){
+     $other_color = $first;
+     $second = $color;
+     cond_signal $meetings; 
+     $meetings -= 1;
+     $first = $none;
+    }
+    else
+    {
+     $first = $color; 
+     cond_wait $meetings;
+     $other_color = $second;
+    }
+   } # Unlock the meeting place 
+
+   $color = 3 - $color - $other_color if($color != $other_color);
+   $met++;
+
+   redo;
+  }
+
+  # Lock the total and add own to it before dying
+  lock $total_meetings;
+  $total_meetings += $met;
+ }
+} ($blue, $red, $yellow, $blue));
+
+print "$total_meetings\n";

data/sources/perl/echo.perl

@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+# $Id: echo.perl,v 1.1.1.1 2004-05-19 18:09:37 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+use Socket;
+
+my $DATA = "Hello there sailor\n";
+
+sub server_sock {
+    local *SS;
+    socket(SS, PF_INET, SOCK_STREAM, 0) or
+	die "server/socket ($!)";
+    setsockopt(SS, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or
+	die "server/setsockopt ($!)";
+    bind(SS, sockaddr_in(0, INADDR_LOOPBACK)) or
+	die "server/bind ($!)";
+    listen(SS, 2);
+    return(*SS);
+}
+
+sub get_port {
+    local *SK = shift;
+    (sockaddr_in(getsockname(SK)))[0];
+}
+
+sub client_sock {
+    my $port = shift;
+    local *CS;
+    socket(CS, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or
+	die "client/socket ($!)";
+    connect(CS, sockaddr_in($port, INADDR_LOOPBACK)) or
+	die "client/connect ($!)";
+    return(*CS);
+}
+
+sub echo_client {
+    my($N, $port) = @_;
+    local *SOCK = client_sock($port);
+    select(SOCK);
+    $| = 1;
+    for my $i (0..($N-1)) {
+	print $DATA;
+	my $ans = <SOCK>;
+	($ans eq $DATA) or die qq{client: "$DATA" ne "$ans"};
+    }
+    close SOCK;
+}
+
+sub echo_server {
+    my($N) = @_;
+    local *SSOCK = server_sock();
+    my $port = get_port(*SSOCK);
+    my $pid = fork;
+    defined $pid or die "server/fork ($!)";
+    if ($pid) {
+	# parent is server
+	local *CSOCK;
+	accept(CSOCK, SSOCK) or die "server/accept ($!)";
+	select(CSOCK);
+	$| = 1;
+	my $n = 0;
+	while (<CSOCK>) {
+	    print $_;
+	    $n += length($_);
+	}
+	select(STDOUT);
+	print "server processed $n bytes\n";
+    } else {
+	# child is client
+	echo_client($N, $port);
+    }
+    wait();
+}
+
+sub main {
+    my $N = $ARGV[0] || 1;
+    echo_server($N);
+    exit(0);
+}
+
+main();