OpenCores
URL https://opencores.org/ocsvn/core_arm/core_arm/trunk

Subversion Repositories core_arm

[/] [core_arm/] [trunk/] [soft/] [modgen_depricated/] [init.pl] - Blame information for rev 4

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 2 tarookumic 
#!/usr/bin/perl
2 
# Purpose: Initialize the combinatorial tmp variables
3 
#          to avoid instanciation in synthesis
4 
 
5 
if ($#ARGV < 0) {
6 
    die ("# Call: init.pl [getinit <comp> <record>|infile <file>|rem <file>]\n");
7 
}
8 
$cmd = $ARGV[0];
9 
$arg1 = $ARGV[1];
10 
$arg2 = $ARGV[2];
11 
$ident = "[a-zA-Z][a-zA-Z0-9_]*";
12 
$exp = "[a-zA-Z0-9_\\-+*\\(\\)\s]*";
13 
$space = "[[:space:]]*";
14 
$nl = "\n";
15 
 
16 
if ($cmd eq "getinit") {
17 
    getinit($arg1,$arg2);
18 
} elsif ($cmd eq "infile") {
19 
    infile($arg1);
20 
} elsif ($cmd eq "remfile") {
21 
    remfile($arg1);
22 
}
23 
 
24 
sub infile {
25 
    my ($file) = @_;
26 
    my $comp = compname($file);
27 
    ($s,$last,$lastfn) = readfiles($comp);
28 
    if (!($file eq $lastfn)) {
29 
        die ("Error: $file not last file of \"make $comp\"\n");
30 
    } else {
31 
        print STDERR ("Scanning file $file\n");
32 
    }
33 
    $last = process($s,$last);
34 
 
35 
    if (-f $file) {
36 
        print STDERR ("Making backup of $file\n");
37 
        `cp $file $file.bck`;
38 
    }
39 
    if (open(RF, ">$file")) {
40 
        print RF $last;
41 
        close(RF);
42 
    } else {
43 
        print "opening \"$n\": $!\n";
44 
    }
45 
}
46 
 
47 
sub remfile {
48 
    my ($file) = @_;
49 
    $s = readin($file);
50 
    $s = removeinit($s);
51 
    if (-f $file) {
52 
        print STDERR ("Making backup of $file\n");
53 
        `cp $file $file.bck`;
54 
    }
55 
    if (open(RF, ">$file")) {
56 
        print RF $s;
57 
        close(RF);
58 
    } else {
59 
        print "opening \"$n\": $!\n";
60 
    }
61 
}
62 
 
63 
 
64 
sub getinit {
65 
    my ($comp,$record) = @_;
66 
    my $s,my $last,my $lastfn;
67 
 
68 
    ($s,$last,$lastfn) = readfiles($comp);
69 
    $s .= $last;
70 
    ($rec,$pos) = getrecord($record,$s);
71 
    $i = InitRec("%start%",$record,$rec,$f.substr($s,0,$pos));
72 
    print $i;
73 
}
74 
 
75 
sub readfiles {
76 
    my ($comp) = @_;
77 
    my $r, my @r, my $f, my $rf,my @a,my $fn, my $s;
78 
    my $last, my $lastfn;
79 
    $r = `make clean`;
80 
    $r = `make -n $comp`;
81 
    @r = split("\n",$r);
82 
    $f = "";
83 
    $rf = "";
84 
    $pr = "";
85 
    @a = ();
86 
    foreach(@r) {
87 
        $fn = $_;
88 
        if ($fn =~ /([^\s]*\.vhd)$/) {
89 
            push(@a,$1);
90 
        }
91 
    }
92 
 
93 
    $s = "";
94 
    $last = "";
95 
    $lastfn = "";
96 
    foreach(@a) {
97 
        print STDERR ("Append file: $_\n");
98 
        $lastfn = $_;
99 
        $last = readin($lastfn);
100 
        $s .= $last;
101 
    }
102 
    return ($s,$last,$lastfn);
103 
}
104 
 
105 
#$reg = "    -- \$(init-automatically-generated-for-synthesis:\(($ident):($record)\)$nl";
106 
#$reg .= "    -- \$(/init-automatically-generated-for-synthesis:\(\1:\2\)$nl";
107 
#$s =~ s/$reg//i;
108 
#
109 
#       print STDERR ("Scanning $1\n");
110 
#       $fn = $1;
111 
#       $pr = process($fn);
112 
#       $f .= $pr;
113 
#       $rf .= $pr;
114 
#print $rf;
115 
 
116 
sub removeinit {
117 
    my ($s) = @_;
118 
    my $reg;
119 
    my $r = "";
120 
 
121 
    $reg = "    -- \\\$\\(init-automatically-generated-for-synthesis:\\(($ident):($ident)\\)\\)([^\\\$]*)?";
122 
    $reg .= "    -- \\\$\\(/init-automatically-generated-for-synthesis:\\(\\1:\\2\\)\\)[\r\n]*";
123 
    while ($s =~ /$reg/) {
124 
        my $p = index($s,$&,0);
125 
        print STDERR ("Removed previous init for $1:$2\n");
126 
        $r .= substr($s,0,$p);
127 
        $s = substr($s,$p+length($&));
128 
    }
129 
    $r .= $s;
130 
    return $r;
131 
}
132 
 
133 
sub process
134 
{
135 
    my ($def,$s)=@_;
136 
    my $ns = "";
137 
    my $pos,$n,$typ,$rec,$i;
138 
    my @e,@s;
139 
 
140 
    $s = removeinit($s);
141 
 
142 
    @s = split("\n",$s);
143 
    foreach (@s) {
144 
        s/[\r\n]//g;
145 
        if (/\$\(init\(($ident):($ident)\)\)/) {
146 
            #print("\n-Init: $1:$2\n");
147 
            $dn = $1,
148 
            $dtyp = $2;
149 
            ($rec,$pos) = getrecord($dtyp,$def.$s);
150 
            $i = InitRec($dn,$dtyp,$rec,$f.substr($def.$s,0,$pos));
151 
            $ns .= $_."$nl";
152 
            $ns .= "    -- \$(init-automatically-generated-for-synthesis:($dn:$dtyp))$nl";
153 
            $ns .= $i."$nl";
154 
            $ns .= "    -- \$(/init-automatically-generated-for-synthesis:($dn:$dtyp))$nl";
155 
        }
156 
        else {
157 
            $ns .= $_."$nl";
158 
        }
159 
    }
160 
    return $ns;
161 
}
162 
 
163 
sub InitRec
164 
{
165 
    my ($n,$typ,$rec,$beg)=@_;
166 
    my $ntyp,$nn,$i,$enum;
167 
    my $nrec,$npos;
168 
    my $r = "";
169 
    my @e = ();
170 
    #print "\-Initialize $n:$typ";
171 
 
172 
    @e = ExpandRec($rec,$beg);
173 
 
174 
    for $i ( 0 .. $#e ) {
175 
        $nn = $e[$i][0];
176 
        $ntyp = $e[$i][1];
177 
        #print ("-Elem $nn:$ntyp\n");
178 
        if ($ntyp =~ /[[:space:]]*std_logic_vector[[:space:]]*\(/) {
179 
            $r .= "    $n.$nn := (others => '0');$nl";
180 
        }
181 
        elsif ($ntyp =~ /[[:space:]]*std_logic$/)  {
182 
            $r .= "    $n.$nn := '0';$nl";
183 
        }
184 
        elsif ($ntyp =~ /[[:space:]]*integer/)  {
185 
            $r .= "    $n.$nn := 0;$nl";
186 
        }
187 
        else {
188 
            $enum = GetEnum($ntyp,$beg);
189 
            if ($enum eq "") {
190 
                ($nrec,$npos) = getrecord($ntyp,$beg);
191 
                $r .= InitRec($n.".".$nn,$ntyp,$nrec,$beg);
192 
            }
193 
            else {
194 
                $r .= "    $n.$nn := $enum;$nl";
195 
            }
196 
        }
197 
    }
198 
    return $r;
199 
}
200 
 
201 
 
202 
sub lin_log2 {
203 
    my ($val) = @_;
204 
    my $r;
205 
    my @lin_log2a  = ("x",0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,
206 
                                5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,6);
207 
    if ($val > $#lin_log2a) {
208 
        $r = 6;
209 
    }
210 
    $r = $lin_log2a[$val];
211 
    return $r;
212 
}
213 
sub lin_log2x {
214 
    my ($val) = @_;
215 
    my $r;
216 
    my @lin_log2xa :=("x",1,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,
217 
                                5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,6);
218 
    if ($val > $#lin_log2xa) {
219 
        $r = 6;
220 
    }
221 
    $r = $lin_log2xa[$val];
222 
    return $r;
223 
}
224 
 
225 
sub ExpandRec
226 
{
227 
    my ($rec,$beg)=@_;
228 
    my $e,$typ,$reg,$typdef,$l,$r;
229 
    my @rec,@n,@tmp;
230 
    my @r = ();
231 
 
232 
    @rec = split("\n",$rec);
233 
 
234 
    for $e (@rec) {
235 
        $e =~ s/--(.)*$//g;
236 
        if ($e =~ /(.*?):(.*);/) {
237 
            $typ = $2;
238 
            @n = split (",",$1);
239 
            $typ =~ s/[[:space:]]*//g;
240 
            for $e (@n) {
241 
                $e =~ s/[[:space:]]*//g;
242 
                $reg = $space."(".$ident.")".$space."\\(".$space.
243 
                    "([0-9]*)".$space."downto".$space."([0-9]*)".$space."\\)";
244 
                $reg = $space."(".$ident.")".$space."\\(".$space.
245 
                    "($exp)".$space."downto".$space."($exp)".$space."\\)";
246 
 
247 
                if (!($typ =~ /[[:space:]]*std_logic_vector[\s\r\n\(\)\$]/ || $typ =~ /[[:space:]]*std_logic[\s\r\n\$]/) &&
248 
                      $typ =~ /$reg/ ) {
249 
                    my $p = 0;
250 
                    $typdef = $1;
251 
                    $l = $2;
252 
                    $r = $3;
253 
                    ($typdef,$p) = GetType($typdef,$beg);
254 
                    print STDERR ("Type resolve: $typdef\n");
255 
 
256 
                    $l = ResolveExp($l,$beg);
257 
                    $r = ResolveExp($r,$beg);
258 
                    print STDERR ("-Left resolved to $l:");
259 
                    print STDERR ("eval($l)=");
260 
                    $l = eval "$l";
261 
                    print STDERR ($l."\n");
262 
                    print STDERR ("-Right resolved to $r:");
263 
                    print STDERR ("eval($r)=");
264 
                    $r = eval "$r";
265 
                    print STDERR ($r."\n");
266 
 
267 
                    for ($i=$r;$i<=$l;$i++) {
268 
                        @tmp = ($e."($i)",$typdef);
269 
                        push @r, [ @tmp ];
270 
                    }
271 
                }
272 
                else {
273 
                    @tmp = ($e,$typ);
274 
                    push @r, [ @tmp ];
275 
                }
276 
            }
277 
        }
278 
    }
279 
    return @r;
280 
}
281 
 
282 
sub ResolveExp
283 
{
284 
    my ($exp,$beg) = @_;
285 
    my $n = 0, my $p;
286 
    my $resolve = "",my $id;
287 
    print STDERR ("Resolve: $exp\n");
288 
    while ($exp =~ /($ident)/) {
289 
        $id = $1;
290 
        $p = index($exp,$&,0);
291 
        $resolve .= substr($exp,0,$p);
292 
        if (($id eq "lin_log2") || ($id eq "log2")) {
293 
            $resolve .= "lin_log2";
294 
        } elsif (($id eq "lin_log2x") || ($id eq "log2x")) {
295 
            $resolve .= "lin_log2x";
296 
        } else {
297 
            $resolve .= GetConstant($id,$beg);
298 
        }
299 
        $exp = substr($exp,$p+length($id));
300 
    }
301 
    $resolve .= $exp;
302 
    return $resolve;
303 
}
304 
 
305 
sub GetConstant
306 
{
307 
    my ($id,$beg) = @_;
308 
    my $p,my $exp,$resolve="";
309 
    print STDERR ("Search for constant $id \n");
310 
    $exp2 = "[a-zA-Z0-9_\\-+*\\(\\)\s]*";
311 
 
312 
    if ($beg =~ /constant\s*$id\s*:\s*integer\s*[^:]*:=\s*([^;]*)\s*;/) {
313 
        $exp = $1;
314 
        $p = index($beg,$&,0);
315 
        $beg = substr($beg,0,$p);
316 
        print STDERR ("$id = $exp\n");
317 
        if ($exp =~ /$ident/) {
318 
            $exp = ResolveExp($exp,substr($beg,0,$p));
319 
        }
320 
    } else {
321 
        die ("Could not find constant $id\n");
322 
    }
323 
    return $exp;
324 
}
325 
 
326 
sub GetType
327 
{
328 
    my ($typ,$beg)=@_;
329 
    my $r = "",my $p = 0;
330 
    if ($beg =~/type\s*$typ\s*is\s*array\s*\(\s*natural\s*range\s*<\s*>\s*\)\s*of\s*([^;]*)/) {
331 
        $r = $1;
332 
        $p = index($beg,$&,0);
333 
    }
334 
    else {
335 
        die ("Did not find typedef $typ");
336 
    }
337 
    return ($r,$p);
338 
}
339 
 
340 
sub GetEnum
341 
{
342 
    my ($typ,$beg)=@_;
343 
    my $r = "";
344 
 
345 
    if ($beg =~/type\s*$typ\s*is\s*\(\s*($ident)/) {
346 
        $r = $1;
347 
    }
348 
    return $r;
349 
}
350 
 
351 
sub getrecord
352 
{
353 
    my ($rn,$s)=@_;
354 
    my $rec,$pos=0;
355 
 
356 
    $reg = "type".$space.$rn.$space."is".$space."record([[:print:][:space:]]*?)end".$space."record";
357 
 
358 
    if ($s =~ /$reg/g) {
359 
        $pos = index($s,$&,0);
360 
        $rec = $1;
361 
    } else {
362 
        die ("Did not find record $rn with $reg ");
363 
    }
364 
    return ($rec,$pos);
365 
}
366 
 
367 
sub compname() {
368 
    my ($n) = @_;
369 
    my ($f,$p) = splitpath($n);
370 
    $f =~ s/\.vhd$//gi;
371 
    return $f;
372 
}
373 
 
374 
sub splitpath() {
375 
    my ($n) = @_;
376 
    my @n = split("/",$n);
377 
    if ($#n > -1) {
378 
        my $f = splice(@n,$#n,1);
379 
        my $p = join("/",@n);
380 
        return ($f,$p);
381 
    }
382 
    return $n;
383 
}
384 
 
385 
sub readin() {
386 
    my ($n) = @_;
387 
    my $l = "";
388 
    if (open(RF, "$n")) {
389 
        while (<RF>) {
390 
            $l .= $_;
391 
        }
392 
        close(RF);
393 
    } else {
394 
        print "opening \"$n\": $!\n";
395 
    }
396 
 
397 
    if ($l =~ /[\\r][\\n]/) {
398 
        #$nl = "\r\n";
399 
    }
400 
    return $l;
401 
}
402 
 
403 
sub getnewline {
404 
    my ($f) = @_;
405 
    if ($f =~ /[\\r][\\n]/) {
406 
        return "\r\n";
407 
    } else {
408 
        return "\n";
409 
    }
410 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.