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

Subversion Repositories veristruct

[/] [veristruct/] [trunk/] [Verilog/] [Veristruct/] [Struct.pm] - Blame information for rev 6

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 5 julius
#######################################################################
2
# 
3
# This file is a part of the Rachael SPARC project accessible at
4
# https://www.rachaelsparc.org. Unless otherwise noted code is released
5
# under the Lesser GPL (LGPL) available at http://www.gnu.org.
6
#
7
# Copyright (c) 2005: 
8
#   Michael Cowell
9
#
10
# Rachael SPARC is based heavily upon the LEON SPARC microprocessor
11
# released by Gaisler Research, at http://www.gaisler.com, under the
12
# LGPL. Much of the architectural work on Rachael was done by g2
13
# Microsystems. Contact michael.cowell@g2microsystems.com for more
14
# information.
15
#
16
#######################################################################
17
# $Id: Struct.pm,v 1.1 2008-10-10 21:13:56 julius Exp $
18
# $URL: $ 
19
# $Rev: $
20
# $Author: julius $
21
######################################################################
22
#
23
# This file is the struct module of the Veristruct Perl program.
24
#
25
# This class supports structs. It can parse struct definitons, and
26
# print out various struct representations.
27
#
28
######################################################################
29
 
30
use Verilog::Veristruct::Structlib;
31
 
32
package Verilog::Veristruct::Struct;
33
 
34
our $debug = 1;
35
 
36
sub new {
37
    $classobject = {};
38
    bless($classobject);
39
    local %struct_hash;
40
    $classobject->{"struct_hash"} = \%struct_hash;
41
    return $classobject;
42
}
43
 
44
# Parses a string (that should be a valid struct definition)
45
sub parse {
46
    my ($self, $struct_string, $string_position) = @_;
47
 
48
    # Set search to begin at the relevant point in the buffer
49
    pos($$struct_string) = $string_position;
50
 
51
    # Find struct name
52
    if ($$struct_string !~ m/\G\s*struct\s+(\w+)\s*{/gis) {
53
        print "Couldn't find pattern: 'struct name {' in struct block.\n";
54
        return;
55
    }
56
 
57
    $self->{"name"} = $1;
58
 
59
    # Find all elements  
60
    while ($$struct_string =~ m/\G\s*(\w+)\s+(\w+)/gcs) {
61
 
62
        # Pull out the back-references
63
        my $elem_type = $1; my $elem_name = $2;
64
 
65
        if ($elem_type eq "wire") {
66
            if ($$struct_string =~ m/\G\s*(\S+)\s*;/gcs) {
67
                # Ranged wire
68
                my $range = $1;
69
                $self->{"struct_hash"}->{$elem_name} = {};
70
                $self->{"struct_hash"}->{$elem_name}->{"type"} = "vector";
71
                $self->{"struct_hash"}->{$elem_name}->{"range"} = $range;
72
            } elsif ($$struct_string =~ m/\G\s*;/gcs) {
73
                $self->{"struct_hash"}->{$elem_name} = {};
74
                $self->{"struct_hash"}->{$elem_name}->{"type"} = "wire";
75
            } else {
76
                print "Invalid syntax in struct file - semicolon not",
77
                " found after element definition.";
78
                return;
79
            }
80
        } elsif ($elem_type eq "signed") {
81
            if ($$struct_string =~ m/\G\s*(\S+)\s*;/gcs) {
82
                # Ranged wire
83
                my $range = $1;
84
                $self->{"struct_hash"}->{$elem_name} = {};
85
                $self->{"struct_hash"}->{$elem_name}->{"type"} = "svector";
86
                $self->{"struct_hash"}->{$elem_name}->{"range"} = $range;
87
            } elsif ($$struct_string =~ m/\G\s*;/gcs) {
88
                $self->{"struct_hash"}->{$elem_name} = {};
89
                $self->{"struct_hash"}->{$elem_name}->{"type"} = "signed";
90
            } else {
91
                print "Invalid syntax in struct file - semicolon not",
92
                " found after element definition.";
93
                return;
94
            }
95
        }  else {
96
            $self->{"struct_hash"}->{$elem_name} = {};
97
            $self->{"struct_hash"}->{$elem_name}->{"type"} = "struct";
98
            $self->{"struct_hash"}->{$elem_name}->{"struct"} = $elem_type;
99
 
100
            # Check for closing brace
101
            if ($$struct_string !~ m/\G\s*;/gcs) {
102
                print "Invalid syntax in struct file - semicolon not",
103
                " found after element definition.\n";
104
                print "Rest of buffer is: ",
105
                substr($$struct_string, pos($$struct_string)), "\n";
106
                return;
107
            }
108
        }
109
 
110
    }
111
 
112
    # Find closing brace
113
    if ($$struct_string !~ m/\G\s*};/gcs) {
114
        print "Couldn't find closing brace in struct defn.\n";
115
        return;
116
    }
117
 
118
    # Push position back to method that called us
119
    return pos($$struct_string);
120
}
121
 
122
# For debugging:
123
sub print_elem_info {
124
    my ($self) = @_;
125
    foreach $elem_name (keys (%{$self->{"struct_hash"}})) {
126
        print "  $elem_name: ";
127
        my $type = $self->{"struct_hash"}->{$elem_name}->{"type"};
128
        if (($type eq "wire") or ($type eq "signed")) {
129
            print "wire\n";
130
        } elsif (($type eq "vector") or ($type eq "svector")) {
131
            my $range = $self->{"struct_hash"}->{$elem_name}->{"range"};
132
            print "vector, range is $range\n";
133
        } elsif ($type eq "struct") {
134
            my $struct = $self->{"struct_hash"}->{$elem_name}->{"struct"};
135
            print "nested struct of type $struct\n";
136
        }
137
    }
138
}
139
 
140
sub get_name {
141
    my ($self) = @_;
142
    return $self->{"name"};
143
}
144
 
145
# Function to return a valid portlist string
146
sub get_portlist_string {
147
    my ($self, $inst_name, $range, $sep, $structlib) = @_;
148
    my $buffer; my $seperator = "";
149
 
150
    foreach $elem (keys (%{$self->{"struct_hash"}})) {
151
        my $type = $self->{"struct_hash"}->{$elem}->{"type"};
152
        if (($type eq "wire") or ($type eq "vector") or
153
            ($type eq "signed") or ($type eq "svector")) {
154
            $buffer .= $seperator . $inst_name . "__" . $elem . $range;
155
            $seperator = $sep." ";
156
        } else {
157
            # nested struct
158
            my $struct = $self->{"struct_hash"}->{$elem}->{"struct"};
159
            if (!($structlib->{"structs"}->{$struct})) {
160
                print "Nested struct named $struct_name in module port list",
161
                " undefined. Failure.\n";
162
                return;
163
            }
164
            $buffer .= $seperator .
165
                $structlib->{"structs"}->{$struct}->get_portlist_string(
166
                ($inst_name . "__" . $elem), $range, $sep, $structlib);
167
            $seperator = $sep." ";
168
        }
169
    }
170
 
171
    return $buffer;
172
}
173
 
174
# Function to return a named portlist string
175
sub get_named_portlist_string {
176
    my ($self, $local_name, $port_name, $local_range, $structlib) = @_;
177
    my $buffer; my $seperator = "";
178
 
179
    foreach $elem (keys (%{$self->{"struct_hash"}})) {
180
        my $type = $self->{"struct_hash"}->{$elem}->{"type"};
181
        if (($type eq "wire") or ($type eq "vector") or
182
            ($type eq "signed") or ($type eq "svector")) {
183
            $buffer .= $seperator . "." . $port_name . "__" . $elem .
184
                " (" . $local_name . "__" . $elem . $local_range. ")";
185
            $seperator = ", ";
186
        } else {
187
            # nested struct
188
            my $struct = $self->{"struct_hash"}->{$elem}->{"struct"};
189
            if (!($structlib->{"structs"}->{$struct})) {
190
                print "Nested struct named $struct_name in module port list",
191
                " undefined. Failure.\n";
192
                return;
193
            }
194
            $buffer .= $seperator .
195
                $structlib->{"structs"}->{$struct}->
196
                get_named_portlist_string(($local_name . "__" . $elem),
197
                  ($port_name . "__" . $elem), $local_range, $structlib);
198
            $seperator = ", ";
199
        }
200
    }
201
 
202
    return $buffer;
203
}
204
 
205
# Function to get a whole struct assignment
206
sub get_decl_struct_assign {
207
    my ($self, $procedural, $left, $lrange,
208
        $right, $rrange, $operator, $structlib) = @_;
209
    my $buffer;
210
 
211
    if ($procedural) {$assign = "";} else {$assign = "assign ";}
212
 
213
    foreach $elem (keys (%{$self->{"struct_hash"}})) {
214
        my $type = $self->{"struct_hash"}->{$elem}->{"type"};
215
        if (($type eq "wire") or ($type eq "vector") or
216
            ($type eq "signed") or ($type eq "svector")) {
217
            $buffer.="${assign}${left}__$elem$lrange $operator ".
218
            "${right}__$elem$rrange; ";
219
        } else {
220
            # nested struct
221
            my $struct = $self->{"struct_hash"}->{$elem}->{"struct"};
222
            if (!($structlib->{"structs"}->{$struct})) {
223
                print "Nested struct named $struct in assignment",
224
                " undefined. Failure.\n";
225
                return;
226
            }
227
            $buffer .=
228
                $structlib->{"structs"}->{$struct}->get_decl_struct_assign(
229
                $procedural, ($left."__".$elem), $lrange, ($right."__".$elem),
230
                    $rrange, $operator, $structlib);
231
            $seperator = ", ";
232
        }
233
    }
234
 
235
    return $buffer;
236
}
237
 
238
# Function to return a struct declaration:
239
sub get_scalar_decl_string {
240
    my ($self, $inst, $context, $structlib) = @_;
241
    my $buffer;
242
    foreach $elem (keys (%{$self->{"struct_hash"}})) {
243
        my $type = $self->{"struct_hash"}->{$elem}->{"type"};
244
        if ($type eq "wire") {
245
            $buffer .= "$context ${inst}__${elem}; ";
246
        } elsif ($type eq "vector") {
247
            my $range = $self->{"struct_hash"}->{$elem}->{"range"};
248
            $buffer .= "$context $range ${inst}__${elem}; ";
249
        } elsif ($type eq "signed") {
250
            $buffer .= "$context signed ${inst}__${elem}; ";
251
        } elsif ($type eq "svector") {
252
            my $range = $self->{"struct_hash"}->{$elem}->{"range"};
253
            $buffer .= "$context signed $range ${inst}__${elem}; ";
254
        } elsif ($type eq "struct") {
255
            my $struct = $self->{"struct_hash"}->{$elem}->{"struct"};
256
            $buffer .= $structlib->{"structs"}->{$struct}->
257
                get_scalar_decl_string(($inst."__".$elem), $context,
258
                                       $structlib);
259
        }
260
    }
261
    return $buffer;
262
}
263
 
264
# Function to return a struct declaration:
265
sub get_vector_decl_string {
266
    my ($self, $inst, $context, $range, $structlib) = @_;
267
    my $buffer;
268
    foreach $elem (keys (%{$self->{"struct_hash"}})) {
269
        my $type = $self->{"struct_hash"}->{$elem}->{"type"};
270
        if ($type eq "wire") {
271
            $buffer .= "$context ${range}${inst}__${elem}; ";
272
        } elsif ($type eq "vector") {
273
            my $elem_range = $self->{"struct_hash"}->{$elem}->{"range"};
274
            $buffer .= "$context $elem_range${inst}__${elem}$range; ";
275
        } elsif ($type eq "signed") {
276
            $buffer .= "$context signed ${range}${inst}__${elem}; ";
277
        } elsif ($type eq "svector") {
278
            my $elem_range = $self->{"struct_hash"}->{$elem}->{"range"};
279
            $buffer .= "$context signed $elem_range${inst}__${elem}$erange; ";
280
        } elsif ($type eq "struct") {
281
            my $struct = $self->{"struct_hash"}->{$elem}->{"struct"};
282
            $buffer .= $structlib->{"structs"}->{$struct}->
283
                get_scalar_decl_string(($inst."__".$elem), $context,
284
                                       $structlib);
285
        }
286
    }
287
    return $buffer;
288
}
289
 
290
# Get elem range string
291
sub get_elem_range_string {
292
    my ($self, $elem_string, $structlib) = @_;
293
    if ($elem_string =~ m/(\w+)\.(.*)/) {
294
        $struct = $self->{"struct_hash"}->{${1}}->{"struct"};
295
        $struct or die
296
            "${1} not a valid struct.";
297
        return $structlib->{"structs"}->{$struct}->get_elem_range_string($2,$structlib);
298
    }
299
    return $self->{"struct_hash"}->{$elem_string}->{"range"};
300
}
301
 
302
# Retuns a series of assignments (that copies one struct to another)
303
sub get_struct_assign {
304
    my ($self, $linst, $lrange, $rinst, $rrange, $op, $seperator, $structlib, $recurs) = @_;
305
    my $buffer;
306
    foreach $elem (keys (%{$self->{"struct_hash"}})) {
307
        my $type = $self->{"struct_hash"}->{$elem}->{"type"};
308
        if ($type eq "wire"  or $type eq "vector") {
309
            $buffer .= "${linst}__${elem}${lrange}${op}${rinst}__${elem}".
310
                "${rrange}${seperator}";
311
            #print "Buffer now $buffer\n";
312
        } elsif ($type eq "struct") {
313
            my $struct = $self->{"struct_hash"}->{$elem}->{"struct"};
314
            $buffer .= $structlib->{"structs"}->{$struct}->
315
                get_struct_assign(($linst."__".$elem), $lrange, ($rinst."__".$elem),
316
                                  $rrange, $op, $seperator, $structlib, 1);
317
            #print "Buffer now $buffer\n";
318
        }
319
    }
320
    # Have to remove the last seperator if we're not recursive
321
    if (!($recurs)) {
322
        #print "Recurs is $recurs\n";
323
        $buffer =~ s/(.*)${seperator}/$1/;
324
    }
325
    return $buffer;
326
}
327
 
328
1;

powered by: WebSVN 2.1.0

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