1#!/usr/bin/env perl
2
3use warnings;
4use strict;
5# do not include Data::Dumper except for debugging.
6# use Data::Dumper;
7
8# Converts one bwc file as given on stdin to magma-parseable text on
9# stdout
10
11my $mode = shift @ARGV;
12
13if ($mode eq 'matrix') {
14    die unless defined($_=<>);
15    die unless /^(\d+) (\d+)$/;
16    my $nr=$1;
17    my $nc=$2;
18    my $i = 0;
19    my $ne = 0;
20    my $needcomma = 0;
21    print "var:=[\n";
22    while (<>) {
23        s/^(\d+)// or die;
24        my $l = $1;
25        if ($l == 0) { $i++; next; }
26        print ",\n" if $needcomma;
27        $needcomma=0;
28        for(my $j = 0;$j < $l;$j++) {
29            s/^\s+(\d+)// or die;
30            print ", " if $needcomma;
31            $ne++;
32            my $i1 = $i + 1;
33            my $j1 = $1 + 1;
34            print "<$i1,$j1,1>";
35            $needcomma=1;
36        }
37        die unless /^\s*$/;
38        $i++;
39    }
40    print "];\n";
41    print "var:=#var eq 0 select SparseMatrix($nr,$nc) else SparseMatrix($nr,$nc,var);\n";
42    if ($i != $nr) {
43        print STDERR "Matrix nrows was wrong (read $i, expected $nr)\n";
44    }
45    exit;
46}
47
48if ($mode eq 'bmatrix') {
49    my $nr=0;
50    my $nc=0;
51    my $curr=0;
52    my @coeffs=();
53    while(sysread(STDIN, my $x, 4)) {
54        my $v=unpack("L",$x);
55        if ($curr-- == 0) {
56            $nr++;
57            $curr=$v;
58        } else {
59            $nc = $v+1 if $v >= $nc;
60            push @coeffs, [$nr, $v+1];
61        }
62    }
63    print "var:=[\n";
64    print join(", ", map { "<$_->[0], $_->[1],1>" } @coeffs);
65    print "];\n";
66    print "var:=#var eq 0 select SparseMatrix($nr,$nc) else SparseMatrix($nr,$nc,var);\n";
67    die unless $curr==0;
68    exit;
69}
70
71if ($mode =~ /^bpmatrix(?:_(\d+)_(\d+))?$/) {
72    my $nr0=$1;
73    my $nc0=$2;
74    my $nr=0;
75    my $nc=0;
76    my $curr=0;
77    my @coeffs=();
78    while(sysread(STDIN, my $x, 4)) {
79        my $v = unpack("L", $x);
80        if ($curr-- == 0) {
81            $nr++;
82            $curr=$v;
83        } else {
84            $nc = $v + 1 if $v >= $nc;
85            sysread(STDIN, my $x, 4) or die;
86            my $w=unpack("l", $x);
87            push @coeffs, [$nr, $v+1, $w];
88        }
89    }
90    if (defined($nr0) && defined($nc0)) {
91        if ($nr > $nr0 || $nc > $nc0) {
92            die "Unexpected: $mode is incompatible with seeing $nr rows and $nc cols";
93        }
94        $nr = $nr0;
95        $nc = $nc0;
96    }
97    print "var:=[\n";
98    print join(", ", map { "<$_->[0], $_->[1], $_->[2]>" } @coeffs);
99    print "];\n";
100    print "var:=#var eq 0 select SparseMatrix($nr,$nc) else SparseMatrix($nr,$nc,var);\n";
101    die unless $curr==0;
102    exit;
103}
104
105if ($mode eq 'balancing') {
106    sysread(STDIN, my $x, 8);
107    my ($zero, $magic) = unpack("L2", $x);
108    die unless $zero == 0;
109    die unless $magic == 0xba1a0000;
110    sysread(STDIN, $x, 40);
111    my ($nh,$nv,$nr,$nc,$nzr,$nzc,$ncoeffs,$checksum,$flags) = unpack("L6QLL", $x);
112    sysread(STDIN, $x, 8);
113    my ($pa, $pb) = unpack("L2", $x);
114    sysread(STDIN, $x, 8);
115    my ($pai, $pbi) = unpack("L2", $x);
116    $checksum = sprintf("%04x", $checksum);
117    my $txflags="";
118    my $colperm = $flags & 1;
119    my $rowperm = $flags & 2;
120    $txflags .= ", colperm" if $colperm;
121    $txflags .= ", rowperm" if $rowperm;
122    $txflags .= ", replicate" if $flags & 8;
123    # pad.
124    my $pad = sub {
125        my ($n,$K,$b)=@_;
126        my $x = int(($n + $K-1)/$K);
127        while ($x % $b) { $x++; }
128        return $x*$K;
129    };
130    my $tr = &$pad($nr,$nh*$nv,8);
131    my $tc = &$pad($nc,$nh*$nv,8);
132    if ($flags & 8) {
133        $tr = $tc = $tr > $tc ? $tr : $tc;
134    }
135    print "nr:=$tr; // originally $nr\n";
136    print "nc:=$tc; // originally $nc\n";
137    print "nzr:=$nzr;\n";
138    print "nzc:=$nzc;\n";
139    print "nr_orig:=$nr;\n";
140    print "nc_orig:=$nc;\n";
141    my $s = $nh * $nv;
142    while ($tr % $s) { $tr++; }
143    while ($tc % $s) { $tc++; }
144    print "// $nr rows $nc cols, split ${nh}x${nv}, checksum $checksum$txflags\n";
145    print "tr:=$tr; // originally $nr\n";
146    print "tc:=$tc; // originally $nc\n";
147    print "nh:=$nh;\n";
148    print "nv:=$nv;\n";
149    print "preshuf:=func<x|x le $nc select 1+(($pa*(x-1)+$pb) mod $nc) else x>;\n";
150    print "preshuf_inv:=func<x|x le $nc select 1+(($pai*(x-1)+$pbi) mod $nc) else x>;\n";
151    if ($rowperm) {
152        my @p=();
153        for(my $i = 0 ; $i < $tr ; $i++) {
154            die unless sysread(STDIN, my $x, 4);
155            push @p, 1+unpack("L",$x);
156        }
157        print "rowperm:=[", join(", ", @p), "];\n";
158    }
159    if ($colperm) {
160        my @p=();
161        for(my $i = 0 ; $i < $tc ; $i++) {
162            die unless sysread(STDIN, my $x, 4);
163            push @p, 1+unpack("L",$x);
164        }
165        print "colperm:=[", join(", ", @p), "];\n";
166    }
167    exit;
168}
169
170
171if ($mode =~ /^(permutation|weights|pvector32)$/) {
172    # Dump a list of unsigned ints
173    my $add1 = $mode eq 'permutation';
174    my @p=();
175    while(sysread(STDIN, my $x, 4)) {
176        my $v = unpack("L",$x);
177        push @p, $v+$add1;
178    }
179    print "var:=[",join(',',@p),"];\n";
180    exit;
181}
182
183if ($mode =~ /^(spvector32)$/) {
184    # Dump a list of SIGNED ints
185    my $add1 = $mode eq 'permutation';
186    my $delim="var:=[";
187    while(sysread(STDIN, my $x, 4)) {
188        my $v = unpack("l",$x);
189        print $delim, $v+$add1;
190        $delim=", ";
191    }
192    print "];\n";
193    exit;
194}
195
196if ($mode =~ /^(spvector64)$/) {
197    # Dump a list of SIGNED ints
198    my $add1 = $mode eq 'permutation';
199    my @p=();
200    while(sysread(STDIN, my $x, 8)) {
201        my $v = unpack("q",$x);
202        push @p, $v+$add1;
203    }
204    print "var:=[",join(',',@p),"];\n";
205    exit;
206}
207
208if ($mode eq 'x') {
209    die unless defined($_=<>);
210    die unless /^(\d+)$/;
211    my $nx = 1;
212    my @p=();
213    while(<>) {
214        my @xs = split ' ', $_;
215        @xs = map { $_+1; } @xs;
216        my $xstring=join(",",@xs);
217        push @p,"[$xstring]";
218    }
219    print "var:=[",join(',',@p),"];\n";
220    exit;
221}
222
223if ($mode eq 'vector') {
224#    # Dump a list of uint64_t's ; this version is robust on 32-bits.
225#    my @p=();
226#    while(sysread(STDIN, my $x, 8)) {
227#        my @v = unpack("L2",$x);
228#        my $sv = join(',',@v);
229#        my $v = "Seqint([$sv],2^32)";
230#        push @p, $v;
231#    }
232#    print "var:=[",join(',',@p),"];\n";
233#    exit;
234#   get rid of 32-bit clutter.
235    my @p=();
236    while(sysread(STDIN, my $x, 8)) {
237        push @p, unpack("Q",$x);
238    }
239    print "var:=[",join(',',@p),"];\n";
240    exit;
241}
242
243