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

Subversion Repositories core_arm

[/] [core_arm/] [trunk/] [soft/] [doc/] [doc2.pl] - Blame information for rev 4

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 2 tarookumic 
$d2_mrecord   = "type".$sp."(".$id.")".$sp.
2 
                "is".$sp."record".$sp."([\\s\\S]*?)".
3 
                "end".$sp."record".$sp.";";
4 
$d2_mfunction = "function".$sp."(".$id.")".$sp.
5 
                "\\(".$sp."([\\s\\S]*?)".$sp."\\)".$sp.
6 
                "return".$sp."([\\s\\S]*?)".$sp.
7 
                "is".$sp."([\\s\\S]*?)".$sp.
8 
                "begin".$sp."([\\s\\S]*?)".$sp.
9 
                "end".$sp.";";
10 
$d2_mprocedure = "procedure".$sp."(".$id.")".$sp.
11 
                "\\(".$sp."([\\s\\S]*?)".$sp."\\)".$sp.
12 
                "is".$sp."([\\s\\S]*?)".$sp.
13 
                "begin".$sp."([\\s\\S]*?)".$sp.
14 
                "end".$sp.";";
15 
$d2_mconst     = "constant".$sp."(".$id.")".$sp.
16 
                ":".$sp."([\\s\\S]*?)".$sp.":=".$sp.
17 
                "([\\s\\S]*?)".$sp.
18 
                ";";
19 
$d2_menum      = "type".$sp."(".$id.")".$sp.
20 
                "is".$sp."\\(".$sp."([\\s\\S]*?)".$sp.
21 
                "\\)".$sp.";";
22 
 
23 
$d2_march      = "architecture".$sp."(".$id.")".$sp.
24 
                "of".$sp."(".$id.")".$sp.
25 
                "is".$sp."([\\s\\S]*?)".$sp.
26 
                "end".$sp."\\1".$sp.";";
27 
 
28 
$d2_mentity    = "entity".$sp."(".$id.")".$sp.
29 
                "is".$sp."port".$sp.
30 
                "\\(".$sp."([\\s\\S]*?)".$sp."\\)".$sp.";".$sp.
31 
                "end".$spid.$sp.";";
32 
 
33 
 
34 
%d2_records;
35 
%d2_funcs;
36 
%d2_procs;
37 
%d2_consts;
38 
%d2_enums;
39 
%d2_enumelems;
40 
%d2_archs;
41 
%d2_entities;
42 
%d2_ends;
43 
%d2_begs;
44 
$d2_id = 0;
45 
 
46 
sub d2_scanrecords
47 
{
48 
    my ($body) = @_;
49 
    my (@match,$pos,@part,$def,@def);
50 
    my $i=0;
51 
    my %tmp;
52 
    my $off = 0,my %elem=();
53 
    if ($dbgon == 1) {
54 
        print ("Scanning for  records:\n");
55 
    }
56 
    while (length($body) != 0) {
57 
        ($body,@match) = d2_scannext($body,$d2_mrecord);
58 
        if ($#match != -1) {
59 
            %elem = d2_splitdef($match[2]);
60 
            if ($dbgon == 1) {
61 
                print ("$i: found record $match[1]\n");
62 
            }
63 
            %tmp = ( body => $match[0],
64 
                     def  => $match[2],
65 
                     elem => [%elem],
66 
                     id   => $d2_id++,
67 
                     posbeg  => $off+$match[6],
68 
                     posend  => $off+$match[6]+length($match[0]));
69 
            $d2_records{$match[1]} = [%tmp];
70 
            $off += $match[6]+length($match[0]);
71 
            $i++;
72 
        }
73 
    }
74 
}
75 
 
76 
sub d2_scanfuncs
77 
{
78 
    my ($body) = @_;
79 
    my @match,my $pos,my $i=0;
80 
    my %tmp;
81 
    my $off = 0,my %args=(),my %vari=();
82 
    if ($dbgon == 1) {
83 
        print ("Scanning for functions:\n");
84 
    }
85 
    while (length($body) != 0) {
86 
        ($body,@match) = d2_scannext($body,$d2_mfunction);
87 
        if ($#match != -1) {
88 
            %args = d2_splitdef($match[2]);
89 
            %vari = d2_splitdef($match[4]);
90 
            if ($dbgon == 1) {
91 
                print ("$i: found function $match[1]\n");
92 
            }
93 
            %tmp = ( body => $match[0],
94 
                     args => $match[2],
95 
                     argselem => [%args],
96 
                     retu => $match[3],
97 
                     vari => $match[4],
98 
                     varielem => [%vari],
99 
                     code => $match[5],
100 
                     id   => $d2_id++,
101 
                     posbeg  => $off + $match[6],
102 
                     posend  => $off + $match[6]+length($match[0]));
103 
            $d2_funcs{$match[1]} = [%tmp];
104 
            d2_addend($match[1],$tmp{posbeg},$match[0]);
105 
            $off += $match[6]+length($match[0]);
106 
            $i++;
107 
        }
108 
    }
109 
}
110 
 
111 
sub d2_scanprocedures
112 
{
113 
    my ($body) = @_;
114 
    my @match,my $pos,my $i=0, my %tmp;
115 
    my $off = 0,my %args=(),my %vari=();;
116 
    if ($dbgon == 1) {
117 
        print ("Scanning for procedures:\n");
118 
    }
119 
    while (length($body) != 0) {
120 
        ($body,@match) = d2_scannext($body,$d2_mprocedure);
121 
        if ($#match != -1) {
122 
            if ($dbgon == 1) {
123 
                print ("$i: found procedure $match[1]\n");
124 
            }
125 
            %args = d2_splitdef($match[2]);
126 
            %vari = d2_splitdef($match[3]);
127 
            %tmp = ( body => $match[0],
128 
                     args => $match[2],
129 
                     argselem => [%args],
130 
                     vari => $match[3],
131 
                     varielem => [%vari],
132 
                     code => $match[4],
133 
                     id   => $d2_id++,
134 
                     posbeg  => $off+$match[6],
135 
                     posend  => $off+$match[6]+length($match[0]));
136 
            $d2_procs{$match[1]} = [%tmp];
137 
            d2_addend($match[1],$tmp{posbeg},$match[0]);
138 
            $off += $match[6]+length($match[0]);
139 
            $i++;
140 
        }
141 
    }
142 
}
143 
 
144 
sub d2_scanconsts
145 
{
146 
    my ($body) = @_;
147 
    my @match,my $pos,my $i=0;
148 
    my $off = 0;
149 
    if ($dbgon == 1) {
150 
        print ("Scanning for constants:\n");
151 
    }
152 
    while (length($body) != 0) {
153 
        ($body,@match) = d2_scannext($body,$d2_mconst);
154 
        if ($#match != -1) {
155 
            if ($dbgon == 1) {
156 
                print ("$i: found constant $match[1]\n");
157 
            }
158 
            %tmp = ( body => $match[0],
159 
                     type => $match[2],
160 
                     valu => $match[3],
161 
                     id   => $d2_id++,
162 
                     posbeg  => $off+$match[6],
163 
                     posend  => $off+$match[6]+length($match[0]));
164 
            $d2_consts{$match[1]} = [%tmp];
165 
            $off += $match[6]+length($match[0]);
166 
            $i++;
167 
        }
168 
    }
169 
}
170 
 
171 
sub d2_scanenums
172 
{
173 
    my ($body) = @_;
174 
    my ($enum,@enum);
175 
    my @match,my $pos,my $i=0;
176 
    my $off = 0, my %tmp;
177 
    if ($dbgon == 1) {
178 
        print ("Scanning for enums:\n");
179 
    }
180 
    while (length($body) != 0) {
181 
        ($body,@match) = d2_scannext($body,$d2_menum);
182 
        if ($#match != -1) {
183 
            if ($dbgon == 1) {
184 
                print ("$i: found enum $match[1]\n");
185 
            }
186 
            %tmp = ( body => $match[0],
187 
                     enum => $match[2],
188 
                     id   => $d2_id++,
189 
                     posbeg  => $off+$match[6],
190 
                     posend  => $off+$match[6]+length($match[0]));
191 
            $off += $match[6]+length($match[0]);
192 
            $d2_enums{$match[1]} = [%tmp];
193 
            $enum = $match[2];
194 
            @enum = split (",",$enum);
195 
            foreach(@enum) {
196 
                s/[\s\n\r]//g;
197 
                $d2_enumelems{$_} = $match[1];
198 
            }
199 
            $i++;
200 
        }
201 
    }
202 
}
203 
 
204 
sub d2_scanarchs
205 
{
206 
    my ($body) = @_;
207 
    my @match,my $pos,my $i=0,my $reg;
208 
    my $off = 0;
209 
    if ($dbgon == 1) {
210 
        print ("Scanning for architectures:\n");
211 
    }
212 
    while (length($body) != 0) {
213 
        ($body,@match) = d2_scannext($body,$d2_march);
214 
        if ($#match != -1) {
215 
            if ($dbgon == 1) {
216 
                print ("$i: found architecture $match[1]\n");
217 
            }
218 
            %tmp = ( body => $match[0],
219 
                     enti => $match[2],
220 
                     id   => $d2_id++,
221 
                     posbeg  => $off+$match[6],
222 
                     posend  => $off+$match[6]+length($match[0]));
223 
            $off += $match[6]+length($match[0]);
224 
            $d2_archs{$match[2]} = [%tmp];
225 
            $reg = "end$sp".$match[1]."$sp;\$";
226 
            $match[0] =~ s/$reg/end;/g;
227 
            d2_addend($match[2],$tmp{posbeg},$match[0]);
228 
            $i++;
229 
        }
230 
    }
231 
}
232 
 
233 
sub d2_scanentities
234 
{
235 
    my ($body) = @_;
236 
    my @match,my $pos,my $i=0,my $reg;
237 
    my $off = 0,my %port=(),my %tmp;
238 
    if ($dbgon == 1) {
239 
        print ("Scanning for entities:\n");
240 
    }
241 
    while (length($body) != 0) {
242 
        ($body,@match) = d2_scannext($body,$d2_mentity);
243 
        if ($#match != -1) {
244 
 
245 
            if ($dbgon == 1) {
246 
                print ("$i: found entity $match[1]\n");
247 
            }
248 
            %port = d2_splitdef($match[2]);
249 
            %tmp = ( body => $match[0],
250 
                     port  => $match[2],
251 
                     portelem => [%port],
252 
                     id   => $d2_id++,
253 
                     posbeg  => $off+$match[6],
254 
                     posend  => $off+$match[6]+length($match[0]));
255 
            $off += $match[6]+length($match[0]);
256 
            $d2_entities{$match[1]} = [%tmp];
257 
            $reg = "end$sp".$match[1]."$sp;\$";
258 
            $i++;
259 
        }
260 
    }
261 
}
262 
 
263 
sub d2_addend
264 
{
265 
    my ($name,$posbeg,$match) = @_;
266 
    my $pos,my $reg = "end$sp;$sp\$";
267 
    $match =~ s/$reg//;
268 
    $pos = $posbeg+length($match);
269 
    $d2_ends{$pos} = '1';
270 
    $d2_begs{$posbeg} = $name;
271 
}
272 
 
273 
sub d2_dumpscan
274 
{
275 
    my ($k,$ke,$v,$body);
276 
    my $i=0;
277 
    my (%tmp,%args,%vari,%port);
278 
    if ($dbgon == 1) {
279 
        for $k (sort keys(%d2_records)) {
280 
            print ("$i: Record $k:\n");
281 
            %tmp = @{$d2_records{$k}};
282 
            $body = $tmp{body};
283 
            %elem = @{$tmp{elem}};
284 
            $body =~ s/\n/\n  /g;
285 
            print ("start-body:\n  ".$body."end-body\n");
286 
            print ("posbeg: ".$tmp{posbeg}."\n");
287 
            print ("posend: ".$tmp{posend}."\n");
288 
            for $ke (sort keys(%elem)) {
289 
                print ("    elem: $ke:".$elem{$ke}."\n");
290 
            }
291 
            $i++;
292 
        }
293 
        for $k (sort keys(%d2_funcs)) {
294 
            print ("$i: Function $k:\n");
295 
            %tmp = @{$d2_funcs{$k}};
296 
            $body = $tmp{body};
297 
            %args = @{$tmp{argselem}};
298 
            %vari = @{$tmp{varielem}};
299 
            $body =~ s/\n/\n  /g;
300 
            print ("start-body:\n  ".$body."\nend-body\n");
301 
            for $ke (sort keys(%args)) {
302 
                print ("    args: $ke:".$args{$ke}."\n");
303 
            }
304 
            for $ke (sort keys(%vari)) {
305 
                print ("    vars: $ke:".$vari{$ke}."\n");
306 
            }
307 
            $i++;
308 
        }
309 
        for $k (sort keys(%d2_procs)) {
310 
            print ("$i: Procedure $k:\n");
311 
            %tmp = @{$d2_procs{$k}};
312 
            $body = $tmp{body};
313 
            %args = @{$tmp{argselem}};
314 
            %vari = @{$tmp{varielem}};
315 
            $body =~ s/\n/\n  /g;
316 
            print ("start-body:\n  ".$body."\nend-body\n");
317 
            for $ke (sort keys(%args)) {
318 
                print ("    args: $ke:".$args{$ke}."\n");
319 
            }
320 
            for $ke (sort keys(%vari)) {
321 
                print ("    vars: $ke:".$vari{$ke}."\n");
322 
            }
323 
            $i++;
324 
        }
325 
        for $k (sort keys(%d2_consts)) {
326 
            print ("$i: Constant $k:\n");
327 
            %tmp = @{$d2_consts{$k}};
328 
            $body = $tmp{body};
329 
            $body =~ s/\n/\n  /g;
330 
            print ("start-body:\n  ".$body."\nend-body\n");
331 
            $i++;
332 
        }
333 
        for $k (sort keys(%d2_enums)) {
334 
            print ("$i: Enum $k:\n");
335 
            %tmp = @{$d2_enums{$k}};
336 
            $body = $tmp{body};
337 
            $body =~ s/\n/\n  /g;
338 
            print ("start-body:\n  ".$body."\nend-body\n");
339 
            $i++;
340 
        }
341 
        for $k (sort keys(%d2_archs)) {
342 
            print ("$i: Architecture $k:\n");
343 
            %tmp = @{$d2_archs{$k}};
344 
            $enti = $tmp{enti};
345 
            print ("  architecture $k of $enti\n");
346 
            print ("  posbeg: ".$tmp{posbeg}."\n");
347 
            print ("  posend: ".$tmp{posend}."\n");
348 
            $i++;
349 
        }
350 
        for $k (sort keys(%d2_entities)) {
351 
            print ("$i: Entity $k:\n");
352 
            %tmp = @{$d2_entities{$k}};
353 
            %port = @{$tmp{portelem}};
354 
            for $ke (sort keys(%port)) {
355 
                print ("    ports: $ke:".$port{$ke}."\n");
356 
            }
357 
            print ("  posbeg: ".$tmp{posbeg}."\n");
358 
            print ("  posend: ".$tmp{posend}."\n");
359 
            $i++;
360 
        }
361 
    }
362 
}
363 
 
364 
sub d2_scannext
365 
{
366 
    my ($body,$reg) = @_;
367 
    my $pos = -1;
368 
    my @match = ();
369 
    if ($body =~ /$reg/) {
370 
        $pos = index($body,$&,0);
371 
        if ($pos != -1) {
372 
            $match[0] = $&;
373 
            $match[1] = $1;
374 
            $match[2] = $2;
375 
            $match[3] = $3;
376 
            $match[4] = $4;
377 
            $match[5] = $5;
378 
            $match[6] = $pos;
379 
            $body = substr($body,$pos+length($match[0]));
380 
 
381 
        } else {
382 
            $body = "";
383 
        }
384 
    } else {
385 
        $body = "";
386 
    }
387 
    return ($body,@match);
388 
}
389 
 
390 
sub d2_remcomment
391 
{
392 
    my ($s) = @_;
393 
    $s =~ s/--.*\n/\n/g;
394 
    return $s;
395 
}
396 
 
397 
sub d2_remspace
398 
{
399 
    my ($s) = @_;
400 
    my $reg = $sp;
401 
    $s =~ s/$sp//g;
402 
    return $s;
403 
}
404 
 
405 
sub d2_remindex
406 
{
407 
    my ($s) = @_;
408 
    my $reg = "\\([^\\)]*?\\)";
409 
    $s =~ s/$reg//g;
410 
    $s = d2_remspace($s);
411 
    return $s;
412 
}
413 
 
414 
sub d2_splitdef
415 
{
416 
    my ($def) = @_;
417 
    my %elem = (),my $reg;
418 
    my @part,my @list,my $listelem;
419 
    $def = d2_remcomment($def);
420 
    $def =~ s/\bvariable\b//g;
421 
    $def =~ s/\bin\b//g;
422 
    $def =~ s/\bout\b//g;
423 
    $def =~ s/\binout\b//g;
424 
    @def = split(";",$def);
425 
    %elem=();
426 
    foreach (@def) {
427 
        @part = split (":",$_);
428 
        @list = split (",",$part[0]);
429 
        $reg = "^$sp($id)";
430 
        if ($part[1] =~ /$reg/) {
431 
            $part[1] = $1;
432 
            foreach (@list) {
433 
                $listelem = $_;
434 
                $listelem = d2_remspace($listelem);
435 
                if (not ($part[0] eq "")) {
436 
                    $elem{$listelem} = $part[1];
437 
                }
438 
            }
439 
        }
440 
    }
441 
    return %elem;
442 
}
443 
 
444 
sub d2_dumpmasks
445 
{
446 
    if ($dbgon == 1) {
447 
        print ("record    mask: $d2_mrecord \n");
448 
        print ("function  mask: $d2_mfunction \n");
449 
        print ("procedure mask: $d2_mprocedure \n");
450 
        print ("constants mask: $d2_mconst \n");
451 
        print ("enum      mask: $d2_menum \n");
452 
        print ("entities  mask: $d2_mentity \n");
453 
    }
454 
}
455 
1;

powered by: WebSVN 2.1.0

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