OpenCores
URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [soc_gen.pl] - Blame information for rev 56

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 16 alirezamon
#! /usr/bin/perl -w
2 48 alirezamon
use constant::boolean;
3 16 alirezamon
use strict;
4
use warnings;
5 45 alirezamon
use FindBin;
6
use lib $FindBin::Bin;
7 16 alirezamon
use soc;
8
use ip;
9
use interface;
10
use POSIX 'strtol';
11
 
12
use File::Path;
13 28 alirezamon
#use File::Find;
14 16 alirezamon
use File::Copy;
15 17 alirezamon
use File::Copy::Recursive qw(dircopy);
16 16 alirezamon
use Cwd 'abs_path';
17
 
18
 
19
require "widget.pl";
20
require "verilog_gen.pl";
21 25 alirezamon
require "readme_gen.pl";
22 17 alirezamon
require "hdr_file_gen.pl";
23 34 alirezamon
require "diagram.pl";
24
require "compile.pl";
25 48 alirezamon
require "software_editor.pl";
26 16 alirezamon
 
27
 
28
 
29
sub is_hex {
30
    local $!;
31
    return ! (POSIX::strtol($_[0], 16))[1];
32
 }
33
 
34
###############
35
#   get_instance_id
36
# return an instance id which is the module name with a unique number 
37
#############
38
sub get_instance_id{
39
        my ($soc,$category,$module)=@_;
40
        my @id_list= $soc->soc_get_all_instances_of_module($category,$module);
41
        my $id=0;
42
        my $instance_id="$module$id";
43
        do {
44
                $instance_id = "$module$id";
45
                $id++;
46
        }while ((grep {$_ eq $instance_id} @id_list) ) ;
47
        #print "$instance_id\n";
48
        return ($instance_id,$id);
49
 
50
}
51
 
52
 
53
 
54
#################
55
#  add_module_to_soc
56
###############
57
sub add_module_to_soc{
58 48 alirezamon
        my ($soc,$category,$module,$info)=@_;
59
        my $ip = ip->lib_new ();
60 16 alirezamon
        my ($instance_id,$id)= get_instance_id($soc,$category,$module);
61
 
62
        #add module instanance
63
        my $result=$soc->soc_add_instance($instance_id,$category,$module,$ip);
64
 
65
        if($result == 0){
66
                my $info_text= "Failed to add \"$instance_id\" to SoC. $instance_id is already exist.";
67
                show_info($info,$info_text);
68
                return;
69
        }
70
        $soc->soc_add_instance_order($instance_id);
71 34 alirezamon
        # Add IP version 
72
        my $v=$ip->ip_get($category,$module,"version");
73
        $v = 0 if(!defined $v);
74
        #print "$v\n";
75
        $soc->object_add_attribute($instance_id,"version",$v);
76 25 alirezamon
        # Read default parameter from lib and add them to soc
77 16 alirezamon
        my %param_default= $ip->get_param_default($category,$module);
78
 
79
        my $rr=$soc->soc_add_instance_param($instance_id,\%param_default);
80
        if($rr == 0){
81 48 alirezamon
                my $info_text= "Failed to add default parameter to \"$instance_id\".  $instance_id does not exist exist.";
82 16 alirezamon
                show_info($info,$info_text);
83
                return;
84
        }
85
        my @r=$ip->ip_get_param_order($category,$module);
86
        $soc->soc_add_instance_param_order($instance_id,\@r);
87
 
88 25 alirezamon
        get_module_parameter($soc,$ip,$instance_id);
89 48 alirezamon
        undef $ip;
90
        set_gui_status($soc,"refresh_soc",0);
91 16 alirezamon
}
92
################
93
#       remove_instance_from_soc
94
################
95
sub remove_instance_from_soc{
96 25 alirezamon
        my ($soc,$instance_id)=@_;
97 16 alirezamon
        $soc->soc_remove_instance($instance_id);
98
        $soc->soc_remove_from_instance_order($instance_id);
99 25 alirezamon
        set_gui_status($soc,"refresh_soc",0);
100 16 alirezamon
}
101
 
102
 
103
 
104
###############
105
#   get module_parameter
106
##############
107
 
108
sub get_module_parameter{
109 25 alirezamon
        my ($soc,$ip,$instance_id)=@_;
110 16 alirezamon
 
111
        #read module parameters from lib
112
        my $module=$soc->soc_get_module($instance_id);
113
        my $category=$soc->soc_get_category($instance_id);
114 25 alirezamon
        my @parameters=$ip->ip_get_param_order($category,$module);
115 16 alirezamon
        my $param_num = @parameters;
116
 
117
        #read soc parameters
118
        my %param_value= $soc->soc_get_module_param($instance_id);
119 48 alirezamon
        my %param_type=  $soc->soc_get_module_param_type($instance_id);
120 16 alirezamon
        my %new_param_value=%param_value;
121 48 alirezamon
 
122
 
123
 
124 16 alirezamon
        #gui
125
        my $table_size = ($param_num<10) ? 10 : $param_num;
126 48 alirezamon
        my $window =  def_popwin_size(40,60, "Parameter setting for $module ",'percent');
127 25 alirezamon
        my $table = def_table($table_size, 7, FALSE);
128 16 alirezamon
 
129 48 alirezamon
        my $scrolled_win = add_widget_to_scrolled_win($table);
130
 
131 16 alirezamon
        my $row=0;
132 48 alirezamon
        my $column=0;
133 16 alirezamon
 
134
        my $ok = def_image_button('icons/select.png','OK');
135 25 alirezamon
 
136 48 alirezamon
        my $at0= 'shrink';
137 34 alirezamon
        my $at1= 'shrink';
138 25 alirezamon
 
139 48 alirezamon
        $table->attach (gen_label_in_left("Parameter name"),0, 2, $row, $row+1,$at0,$at1,2,2);
140
        $table->attach (gen_label_in_left("Value"),2, 3, $row, $row+1,$at0,$at1,2,2);
141
        my $param_info='Define how parameter will be included in the SoC/Tile top module containing this IP core. If you define it as "Parameter", its value can be changed at SoC/tile  instantiation time. So multiple different instancitaions of single SoC/tile can be used in MPSoC where each has its own parameter value';
142
        $table->attach (gen_label_help($param_info,"Type"),3, 4, $row, $row+1,$at0,$at1,2,2);
143
 
144 25 alirezamon
        $row++;
145 16 alirezamon
        foreach my $p (@parameters){
146 48 alirezamon
                my ($default,$type,$content,$info,$vfile_param_type)= $ip->ip_get_parameter($category,$module,$p);
147
                my $show = ($type ne "Fixed");
148
                if ($show){
149
                        my $default_type=  "Localparam";
150
                        $default_type=$param_type{$p} if(defined $param_type{$p});
151
                        my $combo = gen_combobox_object($soc,'current_module_param_type',$p,"Parameter,Localparam",$default_type,undef,undef);
152
                        $table->attach ($combo,3, 4, $row, $row+1,$at0,$at1,2,2) if($vfile_param_type ne 'Parameter' && $category ne 'NoC' && $p ne 'WB_Aw' );
153 34 alirezamon
                }
154 48 alirezamon
                $default= $param_value{$p} if(defined $param_value{$p});
155
                ($row,$column)=add_param_widget($soc,$p,$p, $default,$type,$content,$info, $table,$row,$column,$show,'current_module_param',undef,undef,'vertical');
156
 
157 16 alirezamon
        }
158
 
159 34 alirezamon
 
160
 
161 48 alirezamon
 
162 25 alirezamon
        my $mtable = def_table(10, 1, FALSE);
163 16 alirezamon
 
164
        $mtable->attach_defaults($scrolled_win,0,1,0,9);
165 34 alirezamon
        $mtable->attach($ok,0,1,9,10,'expand','fill',2,2);
166 16 alirezamon
 
167
        $window->add ($mtable);
168
        $window->show_all();
169
 
170
        $ok-> signal_connect("clicked" => sub{
171
                $window->destroy;
172
                #save new values 
173 48 alirezamon
                my $ref=$soc->object_get_attribute('current_module_param');
174
                if(defined $ref){
175
                        %new_param_value=%{$ref} ;
176
                        $soc->soc_add_instance_param($instance_id,\%new_param_value);
177
                }
178
                $ref=$soc->object_get_attribute('current_module_param_type');
179
                if(defined $ref){
180
                        %new_param_value=%{$ref} ;
181
                        $soc->soc_add_instance_param_type($instance_id,\%new_param_value);
182
                }
183 16 alirezamon
 
184
 
185 48 alirezamon
 
186 16 alirezamon
                #check if wishbone address bus is parameterizable regenerate the addresses again 
187
                my @plugs= $soc->soc_get_all_plugs_of_an_instance($instance_id);
188
                foreach my $plug (@plugs){
189
                        if ($plug eq 'wb_slave'){
190
                                my @nums=$soc->soc_list_plug_nums($instance_id,$plug);
191
                                foreach my $plug_num (@nums){
192
                                        my ($addr_connect,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num)=$soc->soc_get_plug($instance_id,$plug,$plug_num);
193
                                        if($connect_id ne 'IO' && $connect_id ne 'NC'){
194
                                                #print "$connect_id : soc_get_plug_addr ($instance_id,$plug,$plug_num)\n";
195
                                                #remove old wb addr
196
                                                $soc->soc_add_plug_base_addr($instance_id,$plug,$plug_num,undef,undef);
197
                                                #get base and address width
198
                                                my ($addr , $width)=$soc->soc_get_plug_addr ($instance_id,$plug,$plug_num);
199
                                                #check if width is a parameter
200
                                                my $val= get_parameter_final_value($soc,$instance_id,$width);
201
                                                $width= $val if(defined $val);
202
                                                #allocate new address in $connect_id
203
                                                my ($base,$end)=get_wb_address($soc,$connect_id,$addr,$width);
204
                                                if(defined $base){#save it
205
                                                        $soc->soc_add_plug_base_addr($instance_id,$plug,$plug_num,$base,$end);
206
                                                }
207
                                        }
208
                                }#plug_num
209
                        }#if
210
                }#plugs
211 48 alirezamon
                $soc->object_add_attribute('current_module_param',undef,undef);
212
                $soc->object_add_attribute('current_module_param_type',undef,undef);
213 25 alirezamon
                set_gui_status($soc,"refresh_soc",0);
214 16 alirezamon
 
215
                });
216
}
217
 
218
 
219
 
220
############
221
#  param_box
222
#
223
############
224
 
225 48 alirezamon
 
226 16 alirezamon
 sub param_box{
227
         my ($param, $default,$type,$content,$info, $value)=@_;
228
         my $box=def_hbox(TRUE,0);
229
         my $label =gen_label_in_left($param);
230
         $box->pack_start($label,FALSE,FALSE,3);
231
 
232
         if ($type eq "Entry"){
233
                my $entry=gen_entry($default);
234
                $box->pack_start($entry,FALSE,FALSE,3);
235
 
236
         }
237
         elsif ($type eq "Combo-box"){
238 48 alirezamon
                 my @combo_list=split(/\s*,\s*/,$content);
239 16 alirezamon
                 my $pos=get_item_pos($default, @combo_list);
240
                 my $combo=gen_combo(\@combo_list, $pos);
241
                 $box->pack_start($combo,FALSE,FALSE,3);
242
         }
243
         elsif  ($type eq "Spin-button"){
244 48 alirezamon
                  my ($min,$max,$step)=split(/\s*,\s*/,$content);
245 16 alirezamon
                  $default=~ s/\D//g;
246
                  $min=~ s/\D//g;
247
                  $max=~ s/\D//g;
248
                  $step=~ s/\D//g;
249
                  my $spin=gen_spin($min,$max,$step);
250
                  $box->pack_start($spin,FALSE,FALSE,3);
251
                 # $box=def_label_spin_help_box ($param,$info, $value,$min,$max,$step, 2);
252
         }
253
 
254
         return $box;
255
}
256
 
257
 
258
###############
259
#  get_mathced_socket_pos
260
###############
261
 
262
 
263
sub  get_mathced_socket_pos{
264
        my ($soc,$instance_id,$plug,$plug_num,@connettions)=@_;
265
        my ($id,$socket,$num)=$soc->soc_get_module_plug_conection($instance_id,$plug,$plug_num);
266
        my $pos=($id eq "IO")? 0: (scalar @connettions)-1;
267
        if($id ne "IO" && $id ne 'NC'){
268
                my $name= $soc->soc_get_instance_name($id);
269
                if (defined $name){
270
                        my $connect="$name\:$socket\[$num]";
271
                        if( grep {$_ eq $connect} @connettions){$pos = get_scolar_pos($connect,@connettions);}
272
                }
273
                else {
274
                        $soc->soc_add_instance_plug_conection($instance_id,$plug,$plug_num,"IO");
275
 
276
                }
277
        }
278
        return $pos;
279
}
280
 
281
 
282
##############
283
#       gen_dev_box
284
##############
285
 
286 25 alirezamon
sub gen_instance{
287
        my ($soc,$ip,$infc,$instance_id,$info,$table,$offset)=@_;
288 48 alirezamon
 
289 16 alirezamon
 
290
 
291
#       my $box= def_vbox (FALSE,0);
292
 
293
#       my $table = def_table(3,5,TRUE);
294
        my $data_in;
295
 
296
#column 1       
297
        #module name
298
        my $module=$soc->soc_get_module($instance_id);
299
        my $category=$soc->soc_get_category($instance_id);
300
        my $module_name_label=box_label(FALSE,0,$module);
301 34 alirezamon
        my $box0=def_hbox(FALSE,5);
302
        $box0->pack_start( $module_name_label, FALSE, FALSE, 3);
303
 
304
        #module pdf
305
        my $pdf=$soc->soc_get_description_pdf($instance_id);
306
        if(defined $pdf){
307
                my $b=def_image_button('icons/evince-icon.png');
308
                $box0->pack_start( $b, FALSE, FALSE, 3);
309
                $b->signal_connect ("clicked"  => sub{
310
                        my $dir = Cwd::getcwd();
311
                        my $project_dir   = abs_path("$dir/../../"); #mpsoc directory address
312
                        #print "path ${project_dir}$pdf\n";
313
                        if (-f "${project_dir}$pdf"){
314
                                system qq (xdg-open ${project_dir}$pdf);
315
                        }elsif (-f "$pdf"){
316
                                system qq (xdg-open $pdf);
317
                        }else{
318 48 alirezamon
                                message_dialog("Error! $pdf or ${project_dir}$pdf did not find!\n",'error');
319 34 alirezamon
                        }
320
 
321
                });
322
 
323
        }
324
        $table->attach  ($box0,0,1,$offset+0,$offset+1,'expand','shrink',2,2);
325
 
326 16 alirezamon
        #parameter setting button
327
        my $param_button = def_image_button('icons/setting.png','Setting');
328
        my $box1=def_hbox(FALSE,5);
329
        my $up=def_image_button("icons/up_sim.png");
330
        $box1->pack_start( $up, FALSE, FALSE, 3);
331
        $box1->pack_start($param_button,   FALSE, FALSE,3);
332 34 alirezamon
        $table->attach  ($box1 ,0,1,$offset+1,$offset+2,'expand','shrink',2,2);
333 16 alirezamon
        $param_button->signal_connect (clicked => sub{
334 25 alirezamon
                get_module_parameter($soc,$ip,$instance_id);
335 16 alirezamon
 
336
        });
337
        $up->signal_connect (clicked => sub{
338
                $soc->soc_decrease_instance_order($instance_id);
339 25 alirezamon
                set_gui_status($soc,"refresh_soc",0);
340 16 alirezamon
 
341
        });
342
 
343
        #remove button
344
        #my ($box2,$cancel_button) = button_box("Remove");
345 48 alirezamon
 
346 16 alirezamon
        my $cancel_button=def_image_button('icons/cancel.png','Remove');
347
        my $box2=def_hbox(FALSE,5);
348
 
349
        my $dwn=def_image_button("icons/down_sim.png");
350
        $box2->pack_start( $dwn, FALSE, FALSE, 3);
351 48 alirezamon
        $box2->pack_start($cancel_button,   FALSE, FALSE,3) ;
352 34 alirezamon
        $table->attach  ($box2,0,1,$offset+2,$offset+3,'expand','shrink',2,2);
353 16 alirezamon
        $cancel_button->signal_connect (clicked => sub{
354 48 alirezamon
                remove_instance_from_soc($soc,$instance_id);
355 16 alirezamon
        });
356 48 alirezamon
 
357 16 alirezamon
        $dwn->signal_connect (clicked => sub{
358
                $soc->soc_increase_instance_order($instance_id);
359 25 alirezamon
                set_gui_status($soc,"refresh_soc",0);
360 16 alirezamon
 
361 48 alirezamon
        });
362 16 alirezamon
 
363
        #instance name
364
        my $instance_name=$soc->soc_get_instance_name($instance_id);
365 34 alirezamon
        my $instance_label=gen_label_in_left(" Instance name");
366 48 alirezamon
        my $instance_entry = gen_entry($instance_name);
367 16 alirezamon
 
368 34 alirezamon
        $table->attach  ($instance_label,1,2,$offset+0,$offset+1,'expand','shrink',2,2);
369
        #$table->attach_defaults ($instance_entry,1,2,$offset+1,$offset+2);
370
 
371
 
372
        my $enter= def_image_button("icons/enter.png");
373 16 alirezamon
 
374 34 alirezamon
        my $box=def_pack_hbox(FALSE,0,$instance_entry );
375
        $table->attach  ($box,1,2,$offset+1,$offset+2,'expand','shrink',2,2);
376
 
377
        my ($old_v,$new_v)=  get_old_new_ip_version ($soc,$ip,$instance_id);
378
        if($old_v != $new_v){
379 43 alirezamon
                my $warn=def_image_button("icons/warning.png");
380 34 alirezamon
                $table->attach  ($warn,1,2,$offset+2,$offset+3,'expand','shrink',2,2);  #$box2->pack_start($warn, FALSE, FALSE, 3);  
381
                $warn->signal_connect (clicked => sub{
382 48 alirezamon
                        message_dialog("Warning: ${module}'s version (V.$old_v) mismatches with the one existing in library (V.$new_v). The generated system may not work correctly.  Please remove and then add $module again to update it with current version")
383 34 alirezamon
 
384
                });
385
 
386
 
387
        }
388
 
389
 
390
        $instance_entry->signal_connect ("activate"  => sub{
391 16 alirezamon
                #print "changed\n";
392 34 alirezamon
                my $new_name=$instance_entry->get_text();
393 16 alirezamon
                #check if instance name exist in soc
394 34 alirezamon
                set_gui_status($soc,"refresh_soc",1) if($instance_name eq $new_name );
395 16 alirezamon
                my @instance_names= $soc->soc_get_all_instance_name();
396 34 alirezamon
                if( grep {$_ eq $new_name} @instance_names){
397
                        print "$new_name exist\n";
398 16 alirezamon
                }
399
                else {
400
                #add instance name to soc
401 34 alirezamon
                        $soc->soc_set_instance_name($instance_id,$new_name);
402 16 alirezamon
 
403 34 alirezamon
                        set_gui_status($soc,"refresh_soc",1);
404 16 alirezamon
 
405
                }
406
        });
407 34 alirezamon
        my $change=0;
408
        $instance_entry->signal_connect ("changed"  => sub{
409
                if($change ==0){
410
                        $box->pack_start( $enter, FALSE, FALSE, 0);
411
                        $box->show_all;
412
                        $change=1;
413
                }
414
 
415
        });
416 16 alirezamon
 
417 34 alirezamon
        $enter->signal_connect ("clicked"  => sub{
418
                my $new_name=$instance_entry->get_text();
419
                #check if instance name exist in soc
420
                set_gui_status($soc,"refresh_soc",1) if($instance_name eq $new_name );
421
                my @instance_names= $soc->soc_get_all_instance_name();
422
                if( grep {$_ eq $new_name} @instance_names){
423
                        print "$new_name exist\n";
424
                }
425
                else {
426
                #add instance name to soc
427
                        $soc->soc_set_instance_name($instance_id,$new_name);
428
 
429
                        set_gui_status($soc,"refresh_soc",1);
430
 
431
                }
432
 
433
 
434
        });
435
 
436
 
437 16 alirezamon
 
438
        #interface_pluges
439
        my %plugs = $ip->get_module_plugs_value($category,$module);
440 48 alirezamon
 
441
        ##print "******* %plug=get_module_plugs_value($category,$module)*************\n";
442
                #print Dumper (\%$ip);  
443 16 alirezamon
        my $row=0;
444
        foreach my $plug (sort keys %plugs) {
445 48 alirezamon
                #print "******* $plug *************\n";
446 16 alirezamon
                my $plug_num= $plugs{$plug};
447
                for (my $k=0;$k<$plug_num;$k++){
448
 
449
                        my @connettions=("IO");
450
                        my @connettions_name=("IO");
451
 
452
                        my ($connection_num,$matched_soket)= $infc->get_plug($plug);
453
 
454
 
455
 
456
                        my %connect_list= $soc->get_modules_have_this_socket($matched_soket);
457
                        foreach my $id(sort keys %connect_list ){
458 48 alirezamon
                                if($instance_id ne $id){ # assume its forbidden to connect the socket and plug of same ip to each other
459
                                        #generate socket list
460 16 alirezamon
                                        my $name=$soc->soc_get_instance_name($id);
461
                                        #check if its a number or parameter
462
                                        my $param=$connect_list{$id};
463
                                        my $value=$soc->soc_get_module_param_value($id,$param);
464
                                        my $array_name=0;
465
                                        if ( !length( $value || '' )) {
466
                                                $value=$param;
467
                                                $array_name=1;
468
 
469
 
470
                                        };
471
                                        for(my $i=0; $i<$value; $i++){
472
                                                my $s= "$name\:$matched_soket\[$i]";
473
                                                push (@connettions,$s);
474
 
475
                                                # show sockets with their connected plugs 
476
                                                my ($type_t,$value_t,$connection_num_t)=$soc->soc_get_socket_of_instance($id,$matched_soket);
477
 
478
                                                my $cc=find_connection($soc,$id,$matched_soket,$i);
479
                                                $cc= (!defined $cc )? '':
480
                                                         ($cc eq "$instance_id:$plug\[$k\]" || $connection_num_t eq 'multi connection')? '':  "->$cc";
481
 
482
                                                if($array_name eq 0){
483
                                                        my $n= $soc->soc_get_socket_name($id,$matched_soket, 0);
484
 
485
                                                        $n = (!defined $n)? $s:"$name\:$n\[$i]";
486
                                                        $n = "$n$cc";
487
                                                        push (@connettions_name,"$n");
488
 
489
                                                }else{
490
                                                        my $n= $soc->soc_get_socket_name($id,$matched_soket, $i);
491
 
492
                                                        $n = (!defined $n)? $s:"$name\:$n";
493
                                                        $n = "$n$cc";
494
                                                        push (@connettions_name,"$n");
495
 
496
                                                }
497
 
498
                                        }
499
 
500
                                }
501
 
502
 
503
                        }
504
                        push (@connettions,"NC");
505
                        push (@connettions_name,"NC");
506
 
507
                        #print "connection is $connect for $p\n";
508
                        #my @socket_list= $soc_get_sockets();
509
 
510
 
511
                        my $pos= get_mathced_socket_pos($soc,$instance_id,$plug,$k,@connettions);
512
 
513
                        #plug name
514
                        my $plug_name=  $soc->soc_get_plug_name($instance_id,$plug,$k);
515
                        if(! defined $plug_name ){$plug_name=($plug_num>1)?"$plug\[$k\]":$plug}
516 34 alirezamon
                        $plug_name="  $plug_name  ";
517 16 alirezamon
                        my($plug_box, $plug_combo)= def_h_labeled_combo_scaled($plug_name,\@connettions_name,$pos,1,2);
518
 
519
                        #if($row>2){$table->resize ($row, 2);}
520 34 alirezamon
                        $table->attach ($plug_box,2,5,$row+$offset,$row+$offset+1,'fill','fill',2,2);   $row++;
521 16 alirezamon
 
522
                        my $plug_num=$k;
523
                        my @ll=($soc,$instance_id,$plug,$info,$plug_num);
524
                        $plug_combo->signal_connect (changed => sub{
525
                                my $self=shift;
526
                                my $ref= shift;
527
                                my($soc,$instance_id,$plug,$info,$plug_num) = @{$ref};
528
                                my $connect_name=$plug_combo->get_active_text();
529
                                my $pos=get_item_pos($connect_name, @connettions_name);
530
                                my $connect=$connettions[$pos];
531
 
532
 
533
 
534
                                my($intance_name,$socket,$num)= split("[:\[ \\]]", $connect);
535
                                my $id=$intance_name;# default IO or NC
536
                                if(($intance_name ne 'IO') && ($intance_name ne 'NC')){
537
 
538
                                        $id=$soc->soc_get_instance_id($intance_name);
539
                                        my ($type,$value,$connection_num)=$soc->soc_get_socket_of_instance($id,$socket);
540
                                        #print "\$$connection_num=$connection_num\n";
541
                                        if($connection_num eq 'single connection'){# disconnect other plug from this soket
542
                                                my ($ref1,$ref2)= $soc->soc_get_modules_plug_connected_to_socket($id,$socket,$num);
543
                                                my %connected_plugs=%$ref1;
544
                                                my %connected_plug_nums=%$ref2;
545
                                                foreach my $p (sort keys %connected_plugs) {
546
                                                        #%pp{$instance_id}=$plug
547
                                                        $soc->soc_add_instance_plug_conection($p,$connected_plugs{$p},$connected_plug_nums{$p},'IO');
548 48 alirezamon
                                                        my $info_text="$id\:$socket\[$num\] support only single connection.  The previous connection to $p:$connected_plugs{$p}\[$connected_plug_nums{$p}] has been removed.";
549
                                                        show_info($info, $info_text);
550 16 alirezamon
                                                }
551
 
552
                                        }
553
                                }
554
                                #print "$id \n $connect \n$num\n";
555
                                #my @rr=$soc->soc_get_all_plugs_of_an_instance($id);
556
 
557
 
558
 
559
 
560
                                $soc->soc_add_instance_plug_conection($instance_id,$plug,$plug_num,$id,$socket,$num);
561
 
562
                                #get address for wishbone slave port
563
                                if ($plug eq 'wb_slave'){
564
                                                #remove old wb addr
565
                                                $soc->soc_add_plug_base_addr($instance_id,$plug,$plug_num,undef,undef);
566
 
567
                                                #get base and address width
568
                                                my ($addr , $width)=$soc->soc_get_plug_addr ($instance_id,$plug,$plug_num);
569
 
570
                                                #check if width is a parameter
571
                                                my $val= get_parameter_final_value($soc,$instance_id,$width);
572
                                                #print "my $val= get_parameter_final_value($soc,$instance_id,$width);\n";
573
                                                $width= $val if(defined $val);
574
 
575
 
576
                                                #allocate new address in $id
577
                                                my ($base,$end)=get_wb_address($soc,$id,$addr,$width);
578
                                                if(defined $base){#save it
579
                                                        #print "($base,$end)\n";
580
                                                        $soc->soc_add_plug_base_addr($instance_id,$plug,$plug_num,$base,$end);
581
                                                }
582
 
583
 
584
                                                #$id
585
                                }
586
                                # "$name\:$connect\[$i]";
587
 
588
 
589
 
590 25 alirezamon
                                set_gui_status($soc,"refresh_soc",0);
591 16 alirezamon
                        },\@ll);
592
 
593
 
594
        }#for $plug_num
595
 
596
        }#foreach plug
597
 
598
 
599
        if($row<3) {$row=3;}
600 48 alirezamon
        add_Hsep_to_table ($table,0,5,$row+$offset);$row++;
601
 
602 16 alirezamon
        return ($offset+$row);
603
}
604
 
605
 
606
sub find_connection{
607
        my ($soc,$id,$socket,$num)=@_;
608
        my ($ref1,$ref2)= $soc->soc_get_modules_plug_connected_to_socket($id,$socket,$num);
609
        my %connected_plugs=%$ref1;
610
        my %connected_plug_nums=%$ref2;
611
        my $c;
612
        foreach my $p (sort keys %connected_plugs) {
613
                                $c="$p:$connected_plugs{$p}\[$connected_plug_nums{$p}]" ;
614
                                #print "($instance_id,$plug,$plug_num);($p:$connected_plugs{$p}\[$connected_plug_nums{$p})\n";
615
        }
616
        return $c;
617
 
618
}
619
 
620
 
621
 
622
###############
623
#       generate_dev_table
624
############
625
sub generate_dev_table{
626 25 alirezamon
        my($soc,$ip,$infc,$info)=@_;
627 48 alirezamon
 
628 16 alirezamon
 
629
        my $table=def_table(3,25,FALSE);
630
        my $row=0;
631
        my @instance_list=$soc->soc_get_instance_order();
632
        if (scalar @instance_list ==0 ){
633
                @instance_list=$soc->soc_get_all_instances();
634
        }
635
        my $i=0;
636
 
637 48 alirezamon
 
638
 
639 16 alirezamon
        foreach my $instanc(@instance_list){
640 48 alirezamon
                $row=gen_instance($soc,$ip,$infc,$instanc,$info,$table,$row);
641 16 alirezamon
        }
642
        if($row<20){for ($i=$row; $i<20; $i++){
643 48 alirezamon
 
644 16 alirezamon
        }}
645
 
646 48 alirezamon
 
647 16 alirezamon
        return $table;
648
}
649
 
650
 
651
####################
652
#  show_active_dev
653
#
654
################ 
655
 
656
sub show_active_dev{
657 48 alirezamon
        my($soc,$ip,$infc,$info)=@_;
658 25 alirezamon
        my $dev_table = generate_dev_table($soc,$ip,$infc,$info);
659 48 alirezamon
        my $scrolled_win = gen_scr_win_with_adjst($soc,'device_win_adj');
660
        add_widget_to_scrolled_win($dev_table,$scrolled_win);
661 16 alirezamon
        return $scrolled_win;
662
}
663
 
664
 
665
 
666
 
667
 
668
 
669
 
670
 
671 48 alirezamon
sub show_select_ip_description {
672
        my ($soc,$category,$module,$info)=@_;
673
        my $ip = ip->lib_new ();
674 24 alirezamon
        my $describ=$ip->ip_get($category,$module,"description");
675 16 alirezamon
        if($describ){
676
                show_info($info,$describ);
677
 
678
        }
679 48 alirezamon
        undef $ip;
680
}
681 16 alirezamon
 
682
 
683
 
684
 
685
 
686
 
687 17 alirezamon
sub get_all_files_list {
688
        my ($soc,$list_name)=@_;
689 16 alirezamon
        my @instances=$soc->soc_get_all_instances();
690
        my $ip = ip->lib_new ();
691
        my @files;
692
        my $dir = Cwd::getcwd();
693
        my $warnings;
694
        #make target dir
695
        my $project_dir   = abs_path("$dir/../..");
696 48 alirezamon
 
697 16 alirezamon
        foreach my $id (@instances){
698
                my $module              =$soc->soc_get_module($id);
699
                my $module_name =$soc->soc_get_module_name($id);
700
                my $category    =$soc->soc_get_category($id);
701
                my $inst                =$soc->soc_get_instance_name($id);
702
 
703 24 alirezamon
                my @new=$ip->ip_get_list( $category,$module,$list_name);
704
                #print "@new\n";
705 16 alirezamon
                foreach my $f(@new){
706
                        my $n="$project_dir$f";
707 24 alirezamon
                         if (!(-f "$n") && !(-f "$f" ) && !(-d "$n") && !(-d "$f" )     ){
708 17 alirezamon
                                $warnings=(defined $warnings)? "$warnings WARNING: Can not find  \"$f\" which is required for \"$inst\" \n":"WARNING: Can not find  \"$f\"  which is required for \"$inst\"\n ";
709 48 alirezamon
                         }
710 16 alirezamon
                }
711
                @files=(@files,@new);
712
        }
713
        return \@files,$warnings;
714
}
715
 
716 42 alirezamon
 
717
sub add_to_project_file_list{
718
                my ($files_ref,$files_path,$list_path )=@_;
719
                        my @new_file_ref;
720
                        foreach my $f(@{$files_ref}){
721
                                my ($name,$path,$suffix) = fileparse("$f",qr"\..[^.]*$");
722
                                push(@new_file_ref,"$files_path/$name$suffix");
723
                        }
724 43 alirezamon
                        my ($old_file_ref,$r,$err) = regen_object("$list_path/file_list" );
725
 
726 42 alirezamon
                        if (defined $old_file_ref){
727
                                foreach my $f(@{$old_file_ref}){
728
                                        unless ( grep( /^$f$/, @new_file_ref ) ){
729
                                                push(@new_file_ref,$f);
730
                                        }
731
 
732
                                }
733
                        }
734
                        open(FILE,  ">$list_path/file_list") || die "Can not open: $!";
735
                        print FILE Data::Dumper->Dump([\@new_file_ref],['files']);
736
                        close(FILE) || die "Error closing file: $!";
737
}
738
 
739
 
740
 
741 16 alirezamon
################
742
#       generate_soc
743
#################
744
 
745
sub generate_soc{
746 48 alirezamon
        my ($soc,$info,$target_dir,$hw_path,$sw_path,$gen_top,$gen_hw_lib,$oldfiles,$multi_core)=@_;
747 28 alirezamon
                my $name=$soc->object_get_attribute('soc_name');
748 43 alirezamon
            $oldfiles = "remove" if(!defined $oldfiles);
749 48 alirezamon
                $multi_core = 0 if(!defined $multi_core);
750
                my ($file_v,$top_v,$readme,$prog)=soc_generate_verilog($soc,$sw_path,$info);
751 16 alirezamon
 
752 28 alirezamon
                # Write object file
753
                open(FILE,  ">lib/soc/$name.SOC") || die "Can not open: $!";
754
                print FILE perl_file_header("$name.SOC");
755
                print FILE Data::Dumper->Dump([\%$soc],['soc']);
756
                close(FILE) || die "Error closing file: $!";
757 16 alirezamon
 
758 28 alirezamon
                # Write verilog file
759 56 alirezamon
                my $h=autogen_warning().get_license_header("${name}.sv")."\n";
760 48 alirezamon
                open(FILE,  ">lib/verilog/$name.sv") || die "Can not open: $!";
761 34 alirezamon
                print FILE $h.$file_v;
762 28 alirezamon
                close(FILE) || die "Error closing file: $!";
763 16 alirezamon
 
764 28 alirezamon
                # Write Top module file
765
                if($gen_top){
766 48 alirezamon
                        my $l=autogen_warning().get_license_header("${name}_top.sv")."\n`timescale 1ns / 1ps\n";
767
                        open(FILE,  ">lib/verilog/${name}_top.sv") || die "Can not open: $!";
768 25 alirezamon
                        print FILE "$l\n$top_v";
769
                        close(FILE) || die "Error closing file: $!";
770 28 alirezamon
                }
771
 
772
                # Write readme file
773
                open(FILE,  ">lib/verilog/README") || die "Can not open: $!";
774
                print FILE $readme;
775
                close(FILE) || die "Error closing file: $!";
776 25 alirezamon
 
777 28 alirezamon
 
778
                # Write memory prog file
779
                open(FILE,  ">lib/verilog/write_memory.sh") || die "Can not open: $!";
780
                print FILE $prog;
781
                close(FILE) || die "Error closing file: $!";
782 38 alirezamon
 
783 48 alirezamon
 
784
        my $m_chain = $soc->object_get_attribute('JTAG','M_CHAIN');
785
 
786 38 alirezamon
                #generate prog_mem
787 42 alirezamon
                open(FILE,  ">lib/verilog/program.sh") || die "Can not open: $!";
788 48 alirezamon
                print FILE soc_mem_prog($m_chain) if (defined $m_chain);
789 38 alirezamon
                close(FILE) || die "Error closing file: $!";
790
 
791
 
792 28 alirezamon
 
793
                my $dir = Cwd::getcwd();
794
                my $project_dir   = abs_path("$dir/../../");
795
                if($gen_hw_lib){
796
 
797
                        #make target dir
798
                        my $hw_lib="$hw_path/lib";
799 48 alirezamon
                        my $hw_sim="$hw_path/../src_sim";
800 28 alirezamon
                        mkpath("$hw_lib/",1,01777);
801
                        mkpath("$sw_path/",1,01777);
802 48 alirezamon
                        mkpath("$hw_sim/",1,01777);
803 42 alirezamon
 
804 43 alirezamon
                        if ($oldfiles eq "remove"){
805
                                #remove old rtl files that were copied by ProNoC
806
                                my ($old_file_ref,$r,$err) = regen_object("$hw_path/file_list");
807
                                if (defined $old_file_ref){
808
                                        remove_file_and_folders($old_file_ref,$target_dir);
809
                                }
810
                        }
811 48 alirezamon
 
812 42 alirezamon
                        #copy hdl codes in src_verilog                  
813 48 alirezamon
                        my ($file_ref,$warnings)= get_all_files_list($soc,"hdl_files");
814
                        my ($sim_ref,$warnings2)= get_all_files_list($soc,"hdl_files_ticked");
815
                        #file_ref-sim_ref
816
                        my @n= get_diff_array($file_ref,$sim_ref);
817
                        $file_ref=\@n;
818
 
819 28 alirezamon
                        copy_file_and_folders($file_ref,$project_dir,$hw_lib);
820 48 alirezamon
                        show_colored_info($info,$warnings,'green')              if(defined $warnings);
821 42 alirezamon
                        add_to_project_file_list($file_ref,$hw_lib,$hw_path);
822 48 alirezamon
 
823
 
824
                        copy_file_and_folders($sim_ref,$project_dir,$hw_sim  );
825
                        show_colored_info($info,$warnings2,'green')     if(defined $warnings2);
826
                        add_to_project_file_list($sim_ref,$hw_sim,$hw_path);
827 42 alirezamon
 
828 48 alirezamon
 
829
 
830
 
831
                #copy clk setting hdl codes in src_verilog
832
                my $sc_soc =get_source_set_top($soc,'soc');
833
                        ($file_ref,$warnings)= get_all_files_list($sc_soc,"hdl_files");
834
                        ($sim_ref,$warnings2)= get_all_files_list($soc,"hdl_files_ticked");
835
                        #file_ref-sim_ref
836
                        my @m= get_diff_array($file_ref,$sim_ref);
837
                        $file_ref=\@m;
838
 
839
 
840
                        copy_file_and_folders($file_ref,$project_dir,$hw_lib);
841
                        show_colored_info($info,$warnings,'green')              if(defined $warnings);
842
                        add_to_project_file_list($file_ref,$hw_lib,$hw_path);
843
 
844
                        copy_file_and_folders($sim_ref,$project_dir,$hw_sim  );
845
                        show_colored_info($info,$warnings2,'green')     if(defined $warnings2);
846
                        add_to_project_file_list($sim_ref,$hw_sim,$hw_path);
847 16 alirezamon
 
848 28 alirezamon
                        #copy jtag control files 
849 48 alirezamon
                        my @jtags=(("/mpsoc/rtl/src_peripheral/jtag/jtag_wb"),("jtag"));
850 42 alirezamon
                        copy_file_and_folders(\@jtags,$project_dir,$hw_lib);
851
                        add_to_project_file_list(\@jtags,$hw_lib,$hw_path);
852
 
853 48 alirezamon
                        move ("$dir/lib/verilog/$name.sv","$hw_path/");
854
                        move ("$dir/lib/verilog/${name}_top.sv","$hw_path/");
855 28 alirezamon
                        move ("$dir/lib/verilog/README" ,"$sw_path/");
856
                        move ("$dir/lib/verilog/write_memory.sh" ,"$sw_path/");
857 38 alirezamon
                        move ("$dir/lib/verilog/program.sh" ,"$sw_path/");
858 28 alirezamon
                }
859
 
860 42 alirezamon
                #remove old software files that were copied by ProNoC
861 43 alirezamon
 
862
                my ($old_file_ref,$r,$err) = regen_object("$sw_path/file_list" );
863 42 alirezamon
                if (defined $old_file_ref){
864
                        remove_file_and_folders($old_file_ref,$project_dir);
865
                }
866
 
867 28 alirezamon
                # Copy Software files
868
                my ($file_ref,$warnings)= get_all_files_list($soc,"sw_files");
869
                copy_file_and_folders($file_ref,$project_dir,$sw_path);
870 48 alirezamon
                show_colored_info($info,$warnings,'green')              if(defined $warnings);
871 42 alirezamon
 
872
                my @new_file_ref;
873
                foreach my $f(@{$file_ref}){
874
                        my ($name,$path,$suffix) = fileparse("$f",qr"\..[^.]*$");
875
                        push(@new_file_ref,"$sw_path/$name$suffix");
876
                }
877
 
878
                push(@new_file_ref,"$sw_path/$name.h");
879
        open(FILE,  ">$sw_path/file_list") || die "Can not open: $!";
880
                print FILE Data::Dumper->Dump([\@new_file_ref],['files']);
881
                close(FILE) || die "Error closing file: $!";
882
 
883
 
884 28 alirezamon
                # Write system.h and Software gen files
885 45 alirezamon
                generate_header_file($soc,$project_dir,$sw_path,$hw_path,$dir);
886 24 alirezamon
 
887
 
888 23 alirezamon
                # Write main.c file if not exist
889 28 alirezamon
                my $n="$sw_path/main.c";
890 23 alirezamon
                if (!(-f "$n")) {
891
                        # Write main.c
892
                        open(FILE,  ">$n") || die "Can not open: $!";
893 48 alirezamon
                        print FILE '#define MULTI_CORE' if($multi_core);
894 23 alirezamon
                        print FILE main_c_template($name);
895
                        close(FILE) || die "Error closing file: $!";
896 16 alirezamon
 
897 48 alirezamon
                        #write makefile source lib list file
898
                        open(FILE,  ">$sw_path/SOURCE_LIB") || die "Can not open: $!";
899
                        print FILE "SOURCE_LIB += $name.c ";
900
                        close(FILE) || die "Error closing file: $!";
901
 
902
 
903 23 alirezamon
                }
904 48 alirezamon
 
905
                #regenerate linker var file
906
        create_linker_var_file($soc);
907
 
908 16 alirezamon
 
909 45 alirezamon
                #write perl_object_file 
910
                mkpath("$target_dir/perl_lib/",1,01777);
911
                open(FILE,  ">$target_dir/perl_lib/$name.SOC") || die "Can not open: $!";
912
                print FILE perl_file_header("$name.SOC");
913
                print FILE Data::Dumper->Dump([\%$soc],['soc']);
914 16 alirezamon
 
915 28 alirezamon
 
916 16 alirezamon
}
917
 
918
 
919 23 alirezamon
sub main_c_template{
920
        my $hdr=shift;
921
        my $text="
922
#include \"$hdr.h\"
923 16 alirezamon
 
924
 
925 23 alirezamon
// a simple delay function
926
void delay ( unsigned int num ){
927
 
928
        while (num>0){
929
                num--;
930 25 alirezamon
                nop(); // asm volatile (\"nop\");
931 23 alirezamon
        }
932
        return;
933 16 alirezamon
 
934 23 alirezamon
}
935 16 alirezamon
 
936 23 alirezamon
int main(){
937
        while(1){
938
 
939
 
940 16 alirezamon
 
941 23 alirezamon
        }
942
 
943
return 0;
944
}
945
 
946
";
947
 
948
return $text;
949
 
950
 
951
}
952
 
953
 
954
 
955
 
956 16 alirezamon
sub get_wb_address      {
957
        my ($soc,$instance_id,$addr,$width)=@_;
958
        my ($base,$end);
959
        my @list= split (" ",$addr);
960
        $base= hex ($list[0]);
961
        $end= $base+(1 << $width)-1;
962
        #print "$addr:$base \& $end\n";
963
        my %taken_bases= $soc->soc_list_base_addreses($instance_id);
964
 
965
        my $conflict=0;
966
        do{
967
                $conflict=0;
968
                foreach my $taken_end (sort {$a<=>$b} keys %taken_bases){
969
                        my $taken_base=$taken_bases{$taken_end};
970
                        #print "taken:($taken_base,$taken_end)\n";
971
                        if (($base <= $taken_base && $end >= $taken_base ) || ($base <= $taken_end && $end >= $taken_end )){
972
                        #if (!(($base < $taken_base && $end < $taken_end ) || ($base > $taken_base && $end > $taken_end ))){
973
                                 $conflict=1;
974 48 alirezamon
                                 $base+=(1 << $width)while($base<$taken_end);
975
                                # $base=$taken_end+1;
976
 
977 16 alirezamon
                                 $end= $base+(1 << $width)-1;
978
                                 last;
979
 
980
                        }
981
                }
982
 
983
        }while($conflict==1 && $end<(1 << 32));
984
        if($conflict==0){
985
                #print"new ($base,$end);\n";
986
                return ($base,$end);
987
 
988
        }
989
 
990
        return ;
991
 
992
}
993
 
994
 
995
 
996 42 alirezamon
#############
997
#  set_unset_infc
998
#############
999 16 alirezamon
 
1000 42 alirezamon
sub set_unset_infc{
1001
        my $soc =shift;
1002
        my $window = def_popwin_size(40,60,"Unconnected Socket Interfaces",'percent');
1003
        my $table = def_table(10,4, FALSE);
1004 48 alirezamon
        my $scrolled_win = add_widget_to_scrolled_win($table);
1005 42 alirezamon
        my $row=0;
1006
        my $column=0;
1007
 
1008
        my $ip = ip->lib_new ();
1009
        my @instances=$soc->soc_get_all_instances();
1010
        foreach my $id (@instances){
1011
                my $module      =$soc->soc_get_module($id);
1012
                my $module_name =$soc->soc_get_module_name($id);
1013
                my $category    =$soc->soc_get_category($id);
1014
                my $inst        = $soc->soc_get_instance_name($id);
1015
                my @ports=$ip->ip_list_ports($category,$module);
1016
                foreach my $port (@ports){
1017
                        my ($type,$range,$intfc_name,$i_port)=$ip->ip_get_port($category,$module,$port);
1018
                        my($i_type,$i_name,$i_num) =split("[:\[ \\]]", $intfc_name);
1019 48 alirezamon
                        if($i_type eq 'socket' && $i_name ne'wb_addr_map' && $i_name ne'jtag_to_wb'){
1020 42 alirezamon
                                my ($ref1,$ref2)= $soc->soc_get_modules_plug_connected_to_socket($id,$i_name,$i_num);
1021
                                my %connected_plugs=%$ref1;
1022
                                my %connected_plug_nums=%$ref2;
1023
                                if(!%connected_plugs ){
1024
                                        my  ($s_type,$s_value,$s_connection_num)=$soc->soc_get_socket_of_instance($id,$i_name);
1025
                                        my $v=$soc->soc_get_module_param_value($id,$s_value);
1026
                                        if ( length( $v || '' ) || $category eq 'NoC' ){ }
1027
                                        else {
1028
                                                ($row,$column)=add_param_widget ($soc,"$inst->$port","$inst-$port", 'IO','Combo-box',"IO,NC",undef, $table,$row,$column,1,"Unset-intfc",undef,undef,"vertical");
1029
                                                if($column == 0){
1030
                                                        $column = 4;
1031
 
1032
                                                        $row= $row-1;
1033
                                                }else{
1034
                                                        $column =  0;
1035
 
1036
 
1037
 
1038
                                                }
1039
 
1040
                                        }
1041
 
1042
                                }
1043
                        }
1044
                }
1045
        }
1046
 
1047
        my $box1=def_hbox(FALSE, 1);
1048 48 alirezamon
        $box1->pack_start( gen_Vsep(), FALSE, FALSE, 3);
1049 42 alirezamon
        $table->attach($box1,3,4,0,$row+1,'expand','fill',2,2);
1050
        my $ok = def_image_button('icons/select.png','OK');
1051
        $ok->signal_connect     ( 'clicked'=> sub {
1052
                $window->destroy;
1053
        });
1054
 
1055
        my $mtable = def_table(10, 1, FALSE);
1056
        $mtable->attach_defaults($scrolled_win,0,1,0,9);
1057
        $mtable->attach($ok,0,1,9,10,'expand','fill',2,2);
1058
        $window->add ($mtable);
1059
        $window->show_all;
1060
 
1061
 
1062
}
1063 16 alirezamon
 
1064
 
1065
 
1066
 
1067
 
1068
##########
1069
#       wb address setting
1070
#########
1071
 
1072
sub wb_address_setting {
1073
        my $soc=shift;
1074
 
1075
 
1076 34 alirezamon
        my $window = def_popwin_size(80,50,"Wishbone slave port address setting",'percent');
1077 25 alirezamon
        my $table = def_table(10, 6, FALSE);
1078 16 alirezamon
 
1079 48 alirezamon
        my $scrolled_win = add_widget_to_scrolled_win($table);
1080 16 alirezamon
        my $row=0;
1081
 
1082
        #title
1083 25 alirezamon
        $table->attach(gen_label_in_left  ("Instance name"),0,1,$row,$row+1,'expand','shrink',2,2);
1084
        $table->attach(gen_label_in_left  ("Interface name"),1,2,$row,$row+1,'expand','shrink',2,2);
1085
        $table->attach(gen_label_in_left  ("Bus name"),2,3,$row,$row+1,'expand','shrink',2,2);
1086
        $table->attach(gen_label_in_center("Base address"),3,4,$row,$row+1,'expand','shrink',2,2);
1087
        $table->attach(gen_label_in_center("End address"),4,5,$row,$row+1,'expand','shrink',2,2);
1088
        $table->attach(gen_label_in_center("Size (Bytes)"),5,6,$row,$row+1,'expand','shrink',2,2);
1089 16 alirezamon
 
1090
        my (@newbase,@newend,@connects);
1091
 
1092
        $row++;
1093
        my @all_instances=$soc->soc_get_all_instances();
1094
        foreach my $instance_id (@all_instances){
1095
                my @plugs= $soc->soc_get_all_plugs_of_an_instance($instance_id);
1096
                foreach my $plug (@plugs){
1097
                        my @nums=$soc->soc_list_plug_nums($instance_id,$plug);
1098
                        foreach my $num (@nums){
1099
                                my ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num)=$soc->soc_get_plug($instance_id,$plug,$num);
1100
                                if((defined $connect_socket) && ($connect_socket eq 'wb_slave')){
1101
                                        my $number=$row-1;
1102
                                        $newbase[$number]=$base;
1103
                                        $newend[$number]=$end;
1104
                                        $connects[$number]=$connect_id;
1105
                                        $row++;
1106
                                }#if
1107
                        }#foreach my $num
1108
                }#foreach my $plug
1109
        }#foreach my $instance_id
1110
 
1111
        my @status_all;
1112
        $row=1;
1113
        foreach my $instance_id (@all_instances){
1114
                my @plugs= $soc->soc_get_all_plugs_of_an_instance($instance_id);
1115
                foreach my $plug (@plugs){
1116
                        my @nums=$soc->soc_list_plug_nums($instance_id,$plug);
1117
                        foreach my $num (@nums){
1118
                                my ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num)=$soc->soc_get_plug($instance_id,$plug,$num);
1119
                                if((defined $connect_socket) && ($connect_socket eq 'wb_slave')){
1120
                                        my $instance_name=$soc->soc_get_instance_name($instance_id);
1121
                                        my $plug_name=(defined $name ) ? gen_label_in_left($name):
1122
                                                                                                         gen_label_in_left("$plug\[$num\]");
1123
 
1124
                                        my $connected_instance_name= $soc->soc_get_instance_name($connect_id);
1125
                                        my $number=$row-1;
1126
                                        my $label1= gen_label_in_left("$number: $instance_name");
1127
                                        my $label2= gen_label_in_left($connected_instance_name);
1128 48 alirezamon
                                        my $entry1= gen_entry_new_with_max_length (10,sprintf("0x%08x", $base));
1129
                                        my $entry2= gen_entry_new_with_max_length (10,sprintf("0x%08x", $end));
1130 16 alirezamon
 
1131
                                        my ($box,$valid) =addr_box_gen(sprintf("0x%08x", $base), sprintf("0x%08x", $end),\@newbase,\@newend,\@connects,$number);
1132
                                        $status_all[$number]=$valid;
1133
 
1134
 
1135 25 alirezamon
                                        $table->attach($label1,0,1,$row,$row+1,'expand','shrink',2,2);
1136
                                        $table->attach($plug_name,1,2,$row,$row+1,'expand','shrink',2,2);
1137
                                        $table->attach($label2,2,3,$row,$row+1,'expand','shrink',2,2);
1138
                                        $table->attach($entry1,3,4,$row,$row+1,'expand','shrink',2,2);
1139
                                        $table->attach($entry2,4,5,$row,$row+1,'expand','shrink',2,2);
1140 16 alirezamon
 
1141
 
1142 25 alirezamon
                                        $table->attach($box,5,7,$row,$row+1,'expand','shrink',2,2);
1143 16 alirezamon
 
1144
 
1145
                                        $entry1->signal_connect('changed'=>sub{
1146
                                                my $base_in=$entry1->get_text();
1147
                                                if (length($base_in)<2){ $entry1->set_text('0x')};
1148
                                                my $end_in=$entry2->get_text();
1149
                                                my $valid;
1150
                                                $box->destroy;
1151
                                                ($box,$valid)=addr_box_gen($base_in, $end_in,\@newbase,\@newend,\@connects,$number);
1152
                                                $status_all[$number]=$valid;
1153 25 alirezamon
                                                $table->attach($box,5,7,$number+1,$number+2,'expand','shrink',2,2);
1154 16 alirezamon
                                                $table->show_all;
1155
 
1156
 
1157
                                        } );
1158
                                        $entry2->signal_connect('changed'=>sub{
1159
                                                my $base_in=$entry1->get_text();
1160
                                                my $end_in=$entry2->get_text();
1161
                                                if (length($end_in)<2){ $entry2->set_text('0x')};
1162
                                                my $valid;
1163
                                                $box->destroy;
1164
                                                ($box,$valid)=addr_box_gen($base_in, $end_in,\@newbase,\@newend,\@connects,$number);
1165
                                                $status_all[$number]=$valid;
1166 25 alirezamon
                                                $table->attach($box,5,7,$number+1,$number+2,'expand','shrink',2,2);
1167 16 alirezamon
                                                $table->show_all;
1168
                                        } );
1169
 
1170
 
1171
 
1172
                                        $row++;
1173
 
1174
 
1175
                                }#if
1176
                        }#foreach my $num
1177
                }#foreach my $plug
1178
        }#foreach my $instance_id
1179
 
1180
 
1181
        my $ok = def_image_button('icons/select.png','OK');
1182
 
1183 25 alirezamon
 
1184
 
1185 16 alirezamon
        my $refresh = def_image_button('icons/revert.png','Revert');
1186
        my $refbox=def_hbox(TRUE,0);
1187
        $refbox->pack_start($refresh, FALSE, FALSE,0);
1188
 
1189
        $refresh->signal_connect( 'clicked'=> sub {
1190
                $window->destroy;
1191
                wb_address_setting($soc);
1192
 
1193
 
1194
                });
1195
        $ok->signal_connect     ( 'clicked'=> sub {
1196
                my $st=1;
1197
                foreach my $valid (@status_all){
1198
                        if($valid==0){
1199
                                $st=0;
1200
 
1201
                        }
1202
                }
1203
 
1204
                if($st==1){
1205
                        $row=1;
1206
                        foreach my $instance_id (@all_instances){
1207
                        my @plugs= $soc->soc_get_all_plugs_of_an_instance($instance_id);
1208
                        foreach my $plug (@plugs){
1209
                                my @nums=$soc->soc_list_plug_nums($instance_id,$plug);
1210
                                foreach my $num (@nums){
1211
                                        my ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num)=$soc->soc_get_plug($instance_id,$plug,$num);
1212
                                        if(defined $connect_socket && ($connect_socket eq 'wb_slave')){
1213
                                                my $number=$row-1;
1214
                                                $soc->soc_add_plug_base_addr($instance_id,$plug,$num,$newbase[$number],$newend[$number]);
1215
                                                $row++;
1216
                                        }#if
1217
                                }#foreach my $num
1218
                        }#foreach my $plug
1219
                }#foreach my $instance_id
1220
 
1221
 
1222
 
1223
 
1224
 
1225
                        $window->destroy;
1226
                }else{
1227 48 alirezamon
                        message_dialog("Invalid address!",'error');
1228 16 alirezamon
 
1229
                }
1230
 
1231
 
1232
                });
1233
 
1234
 
1235 42 alirezamon
        my $mtable = def_table(10, 2, FALSE);
1236
        $mtable->attach_defaults($scrolled_win,0,2,0,9);
1237
        $mtable->attach ($refbox,0,1,9,10,'expand','shrink',2,2);
1238
        $mtable->attach($ok,1,2,9,10,'expand','fill',2,2);
1239
        $window->add ($mtable);
1240 16 alirezamon
        $window->show_all;
1241 42 alirezamon
 
1242 16 alirezamon
 
1243
 
1244
 
1245
}
1246
##############
1247
#       addr_box_gen
1248
##############
1249
 
1250
sub addr_box_gen{
1251
        my ($base_in, $end_in,$newbase_ref,$newend_ref,$connects_ref,$number)=@_;
1252
        my $box= def_hbox(TRUE,0);
1253
        my $label;
1254
        my $valid=1;
1255
        my $info;
1256
        if(is_hex($base_in) && is_hex($end_in)){
1257
                my $size=(hex ($end_in) >= hex ($base_in))? hex ($end_in) - hex ($base_in) +1 : 0;
1258 24 alirezamon
                my $size_text=  metric_conversion($size);
1259 16 alirezamon
                $label= gen_label_in_center($size_text);
1260
                $$newbase_ref[$number]=hex($base_in);
1261
                $$newend_ref[$number]=hex($end_in);
1262
                $info=check_entered_address($newbase_ref,$newend_ref,$connects_ref,$number);
1263
                if(defined      $info) {$valid=0;}
1264
 
1265
        }
1266
        else {
1267
                $label= gen_label_in_center("Invalid hex value!");
1268
                $info="Invalid hex value!";
1269
                $valid=0;
1270
        }
1271
 
1272
 
1273 43 alirezamon
        my $status=(defined $info)? gen_button_message ($info,'icons/warning.png'):
1274 16 alirezamon
                                                                gen_button_message (undef,'icons/select.png');
1275
 
1276
        $box->pack_start($label,FALSE,FALSE,3);
1277
        $box->pack_start($status,FALSE,FALSE,3);
1278
        return ($box,$valid);
1279
 
1280
}
1281
 
1282
 
1283
 
1284
 
1285
###########
1286
#       get_parameter_final_value
1287
############
1288
sub get_parameter_final_value{
1289
        my ($soc,$id,$param)=@_;
1290
        #get ordered param
1291
        my @ordered_param=$soc->soc_get_instance_param_order($id);
1292
        my %sim_params;
1293
        foreach my $p (@ordered_param){
1294
                my $value=$soc->soc_get_module_param_value($id,$p);
1295 48 alirezamon
                #print "\n$value=\$soc->soc_get_module_param_value($id,$p)\n";
1296 16 alirezamon
                foreach my $q (sort keys %sim_params){
1297 48 alirezamon
 
1298 16 alirezamon
                        $value=replace_value($value,$q,$sim_params{$q}) if (defined $value);
1299 48 alirezamon
 
1300
 
1301 16 alirezamon
                }
1302
                $sim_params{$p}=$value;
1303 48 alirezamon
                #print "\$sim_params{$p}=$value;\n";
1304 16 alirezamon
        }
1305
        return $sim_params{$param};
1306
}
1307
 
1308
 
1309
 
1310
 
1311
sub replace_value{
1312
        my ($string,$param,$value)=@_;
1313
 
1314
        my $new_string=$string;
1315
        #print "$new_range\n";
1316
        my $new_param= $value;
1317
        ($new_string=$new_string)=~ s/\b$param\b/$new_param/g;
1318 48 alirezamon
        my $new_val = eval $new_string;
1319
        return $new_val if (defined $new_val);
1320
        return $string;
1321 16 alirezamon
 
1322
}
1323
 
1324
 
1325
 
1326
 
1327
 
1328
sub check_entered_address{
1329 48 alirezamon
        my      ($base_ref,$end_ref,$connect_ref,$number)=@_;
1330
        my @bases=@{$base_ref};
1331
        my @ends=@{$end_ref};
1332
        my @connects=@{$connect_ref};
1333 16 alirezamon
 
1334 48 alirezamon
        my $current_base=$bases[$number];
1335
        my $current_end=$ends[$number];
1336 16 alirezamon
 
1337 48 alirezamon
        if($current_base>  $current_end) {
1338
 
1339
        return "Error: the given base address is bigger than the End address!";
1340
                }
1341
 
1342
        my $size= scalar @bases;
1343
        my $conflicts;
1344
        foreach (my $i=0; $i<$size; $i++){
1345
                if($i != $number){ #if not same row
1346
                        if      ($connects[$i] eq $connects[$number]) {#same bus
1347
                                        my $ok=(($bases[$i]< $bases[$number] && $bases[$i] < $ends[$number])||($bases[$i]> $bases[$number] && $bases[$i] > $ends[$number]));
1348
                                        if($ok==0) {
1349
                                                $conflicts=(defined $conflicts )? "$conflicts,$i": $i;
1350
                                        }
1351
                        }
1352 16 alirezamon
 
1353 48 alirezamon
 
1354
                }
1355
 
1356
 
1357
        }
1358
        if (defined $conflicts){ return " The given address range has conflict with rows:$conflicts"; }
1359
        return;
1360 16 alirezamon
 
1361
 
1362
}
1363
 
1364
#############
1365
#       load_soc
1366
#############
1367
 
1368
sub load_soc{
1369 34 alirezamon
        my ($soc,$info,$ip)=@_;
1370 16 alirezamon
        my $file;
1371 48 alirezamon
        my $dialog =  gen_file_dialog (undef, 'SOC');
1372 16 alirezamon
        my $dir = Cwd::getcwd();
1373 48 alirezamon
        $dialog->set_current_folder ("$dir/lib/soc");
1374 16 alirezamon
 
1375
 
1376
        if ( "ok" eq $dialog->run ) {
1377
                $file = $dialog->get_filename;
1378
                my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
1379
                if($suffix eq '.SOC'){
1380 43 alirezamon
                        my ($pp,$r,$err) = regen_object($file);
1381
                        if ($r || !defined $pp){
1382 48 alirezamon
                                show_info($info,"**Error reading  $file file: $err\n");
1383 25 alirezamon
                                 $dialog->destroy;
1384
                                return;
1385
                        }
1386 16 alirezamon
                        clone_obj($soc,$pp);
1387 34 alirezamon
                        check_instances_version($soc,$ip);
1388 25 alirezamon
                        set_gui_status($soc,"load_file",0);
1389 16 alirezamon
                }
1390
     }
1391
     $dialog->destroy;
1392
 
1393 48 alirezamon
}
1394 16 alirezamon
 
1395
 
1396
 
1397
 
1398 34 alirezamon
sub check_instances_version{
1399
        my ($soc,$ip)=@_;
1400 16 alirezamon
 
1401 34 alirezamon
 #check if the IP's version didnt increases 
1402
    my @all_instances=$soc->soc_get_all_instances();
1403
    foreach my $instance_id (@all_instances){
1404
        my ($old_v,$new_v)=  get_old_new_ip_version ($soc,$ip,$instance_id);
1405
        my $differences='';
1406 48 alirezamon
        $differences="$differences \t The $instance_id version (V.$old_v) mismatches with the one existing in the library (V.$new_v).\n " if($old_v != $new_v);
1407 34 alirezamon
 
1408
 
1409
        message_dialog("Warning: The generated system may not work correctly: \n $differences Please remove and then add the aforementioned instance(s) to update them with current version(s)") if(length($differences)>1);
1410 16 alirezamon
 
1411 34 alirezamon
    }
1412 16 alirezamon
 
1413
 
1414 34 alirezamon
}
1415 16 alirezamon
 
1416 34 alirezamon
sub get_old_new_ip_version{
1417
        my ($soc,$ip,$instance_id)=@_;
1418
        my $old_v=$soc->object_get_attribute($instance_id,"version",undef);
1419
        $old_v=0 if(!defined $old_v);
1420
        my $module=$soc->soc_get_module($instance_id);
1421
        my $category=$soc->soc_get_category($instance_id);
1422
        my $new_v=$ip->ip_get($category,$module,"version");
1423
        $new_v=0 if(!defined $new_v);
1424
        return ($old_v,$new_v);
1425
}
1426 16 alirezamon
 
1427 38 alirezamon
sub check_for_ni{
1428
        my $self=shift;
1429
        my $ckeck=0;
1430
        my @instances=$self->soc_get_all_instances();
1431
        foreach my $id (@instances){
1432
                my $category = $self->soc_get_category($id);
1433
                if ($category eq 'NoC') {
1434
                $ckeck=1;
1435
                }
1436
        }
1437
        return $ckeck;
1438 16 alirezamon
 
1439 38 alirezamon
}
1440 16 alirezamon
 
1441
 
1442 34 alirezamon
sub get_ram_init{
1443
        my $soc=shift;
1444
        my $window = def_popwin_size(80,50,"Memory initial file setting setting",'percent');
1445
        my $table = def_table(10, 6, FALSE);
1446
 
1447 48 alirezamon
        my $scrolled_win = add_widget_to_scrolled_win($table);
1448 34 alirezamon
        my $row=0;
1449
        my $col=0;
1450
        my @instances=$soc->soc_get_all_instances();
1451
        foreach my $id (@instances){
1452
                my $category = $soc->soc_get_category($id);
1453
                if ($category eq 'RAM') {
1454
                        my $ram_name=  $soc->soc_get_instance_name($id);
1455
                        $table->attach (gen_label_in_left("$ram_name"),$col,$col+1, $row, $row+1,'fill','shrink',2,2);$col++;
1456
                        my $init_type=gen_combobox_object ($soc,'RAM_INIT','type',"Dont_Care,Fill_0,Fill_1,Search_in_sw,Fixed_file","Search_in_sw",undef);
1457
                        my $init_inf= "Define how the memory must be initialized :
1458
 Dont_Care: The memory wont be initialized
1459
 Fill_0: All memory bits will fill with value zero
1460
 Fill_1: All memory bits will fill with value one
1461
 Search_in_sw: Each instance of this processing core
1462
               use different initial file that is
1463
               located in its SW folder.
1464
 Fixed_file: All instance of this processing core
1465
             use the same initial file";
1466
 
1467
                        $row++;
1468
                }
1469
        }
1470
 
1471
 
1472
        $window->add($scrolled_win);
1473
        $window->show_all;
1474
}
1475 16 alirezamon
 
1476
 
1477 34 alirezamon
sub software_edit_soc {
1478
        my $soc=shift;
1479
        my $name=$soc->object_get_attribute('soc_name');
1480 48 alirezamon
        $name="" if (!defined $name);
1481 34 alirezamon
        if (length($name)==0){
1482 38 alirezamon
                message_dialog("Please define the Tile name!");
1483 34 alirezamon
                return ;
1484
        }
1485
        my $target_dir  = "$ENV{'PRONOC_WORK'}/SOC/$name";
1486
        my $sw  = "$target_dir/sw";
1487
        my ($app,$table,$tview) = software_main($sw);
1488 16 alirezamon
 
1489 34 alirezamon
 
1490 16 alirezamon
 
1491 48 alirezamon
    my $ram = def_image_button('icons/info.png',"Required BRAMs\' size",FALSE,1);
1492
    my $linker = def_image_button('icons/setting.png','LD Linker',FALSE,1);
1493 34 alirezamon
        my $make = def_image_button('icons/gen.png','Compile');
1494 38 alirezamon
        my $regen= def_image_button('icons/refresh.png','Regenerate main.c');
1495
        my $prog= def_image_button('icons/write.png','Program the memory');
1496
 
1497 48 alirezamon
        $table->attach ($ram,0, 1, 1,2,'shrink','shrink',0,0);
1498
        $table->attach ($regen,1, 2, 1,2,'shrink','shrink',0,0);
1499
        $table->attach ($linker,4, 5, 1,2,'shrink','shrink',0,0);
1500 38 alirezamon
        $table->attach ($make,5, 6, 1,2,'shrink','shrink',0,0);
1501
        $table->attach ($prog,9, 10, 1,2,'shrink','shrink',0,0);
1502 34 alirezamon
        $regen -> signal_connect ("clicked" => sub{
1503 48 alirezamon
                my $response =  yes_no_dialog("Are you sure you want to regenerate the main.c file? Note that any changes you have made will be lost");
1504
                if ($response eq 'yes') {
1505 34 alirezamon
                        save_file ("$sw/main.c",main_c_template($name));
1506 48 alirezamon
                        $app->refresh_source("$sw/main.c");
1507 34 alirezamon
                }
1508
        });
1509 48 alirezamon
 
1510
    my $load;
1511 34 alirezamon
        $make -> signal_connect("clicked" => sub{
1512 48 alirezamon
                $load->destroy   if(defined $load);
1513
                $app->ask_to_save_changes();
1514
                $load= show_gif("icons/load.gif");
1515 43 alirezamon
        $table->attach ($load,7, 8, 1,2,'shrink','shrink',0,0);
1516
        $load->show_all;
1517 48 alirezamon
                unless (run_make_file($sw,$tview,'clean')){
1518
                $load->destroy;
1519
                $load=def_icon("icons/cancel.png");
1520
                $table->attach ($load,7, 8, 1,2,'shrink','shrink',0,0);
1521
                $load->show_all;
1522
                return;
1523
        };
1524
                unless (run_make_file($sw,$tview)){
1525
                        $load->destroy;
1526
                $load=def_icon("icons/cancel.png");
1527
                $table->attach ($load,7, 8, 1,2,'shrink','shrink',0,0);
1528
                $load->show_all;
1529
                return;
1530
                }
1531 43 alirezamon
                $load->destroy;
1532 48 alirezamon
                $load=def_icon("icons/button_ok.png");
1533
        $table->attach ($load,7, 8, 1,2,'shrink','shrink',0,0);
1534
        $load->show_all;
1535 34 alirezamon
        });
1536 16 alirezamon
 
1537 38 alirezamon
        #Programe the board 
1538
        $prog-> signal_connect("clicked" => sub{
1539
                my $error = 0;
1540
                my $bash_file="$target_dir/sw/program.sh";
1541 42 alirezamon
                my $jtag_intfc="$sw/jtag_intfc.sh";
1542 38 alirezamon
 
1543 48 alirezamon
                add_info($tview,"Program the board using quartus_pgm and $bash_file file\n");
1544 38 alirezamon
                #check if the programming file exists
1545
                unless (-f $bash_file) {
1546 48 alirezamon
                        add_colored_info($tview,"\tThe $bash_file does not exists! \n", 'red');
1547 38 alirezamon
                        $error=1;
1548
                }
1549 42 alirezamon
                #check if the jtag_intfc.sh file exists
1550
                unless (-f $jtag_intfc) {
1551 48 alirezamon
                        add_colored_info($tview,"\tThe $jtag_intfc does not exists!. Press the compile button and select your FPGA board first to generate $jtag_intfc file\n", 'red');
1552 42 alirezamon
                        $error=1;
1553
                }
1554 38 alirezamon
 
1555
                return if($error);
1556 45 alirezamon
                my $command = "cd $target_dir/sw; bash program.sh";
1557 48 alirezamon
                add_info($tview,"$command\n");
1558 38 alirezamon
                my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($command);
1559
                if(length $stderr>1){
1560 48 alirezamon
                        add_colored_info($tview,"$stderr\n",'red');
1561
                        add_colored_info($tview,"Memory was not programmed successfully!\n",'red');
1562 38 alirezamon
                }else {
1563
 
1564
                        if($exit){
1565 48 alirezamon
                                add_colored_info($tview,"$stdout\n",'red');
1566
                                add_colored_info($tview,"Memory was not programmed successfully!\n",'red');
1567 38 alirezamon
                        }else{
1568 48 alirezamon
                                add_info($tview,"$stdout\n");
1569
                                add_colored_info($tview,"Memory is programmed successfully!\n",'blue');
1570 38 alirezamon
 
1571
                        }
1572
 
1573
                }
1574
        });
1575 48 alirezamon
 
1576
        $ram -> signal_connect("clicked" => sub{
1577
                show_reqired_brams($soc,$tview);
1578
        });
1579
 
1580
        $linker -> signal_connect("clicked" => sub{
1581
                linker_setting($soc,$tview);
1582
        });
1583 38 alirezamon
 
1584 34 alirezamon
}
1585 16 alirezamon
 
1586 34 alirezamon
 
1587 38 alirezamon
sub soc_mem_prog {
1588 48 alirezamon
        my $chain=shift;
1589
        my $string="#!/bin/bash
1590 34 alirezamon
 
1591
 
1592 48 alirezamon
#JTAG_INTFC=\"\$PRONOC_WORK/toolchain/bin/JTAG_INTFC\"
1593 38 alirezamon
source ./jtag_intfc.sh
1594
 
1595
#reset and disable cpus, then release the reset but keep the cpus disabled
1596
 
1597 48 alirezamon
\$JTAG_INTFC -t $chain -n 127  -d  \"I:1,D:2:3,D:2:2,I:0\"
1598 38 alirezamon
 
1599
# jtag instruction
1600
#       0: bypass
1601
#       1: getting data
1602
# jtag data :
1603
#       bit 0 is reset
1604
#       bit 1 is disable
1605
# I:1  set jtag_enable  in active mode
1606
# D:2:3 load jtag_enable data register with 0x3 reset=1 disable=1
1607
# D:2:2 load jtag_enable data register with 0x2 reset=0 disable=1
1608
# I:0  set jtag_enable  in bypass mode
1609
 
1610
 
1611
 
1612 48 alirezamon
#Program the memory
1613 38 alirezamon
 
1614 45 alirezamon
        bash write_memory.sh
1615 38 alirezamon
 
1616
 
1617
#Enable the cpu
1618 48 alirezamon
\$JTAG_INTFC -t $chain -n 127  -d  \"I:1,D:2:0,I:0\"
1619 38 alirezamon
# I:1  set jtag_enable  in active mode
1620
# D:2:0 load jtag_enable data register with 0x0 reset=0 disable=0
1621
# I:0  set jtag_enable  in bypass mode
1622 48 alirezamon
";
1623 38 alirezamon
return $string;
1624
 
1625
}
1626
 
1627
 
1628 48 alirezamon
sub soc_gen_top_ip{
1629
        my $soc=shift;
1630
        my $top_ip=ip_gen->top_gen_new();
1631
        my $ip = ip->lib_new ();
1632
        my $intfc=interface->interface_new();
1633
        my @instances=$soc->soc_get_all_instances();
1634
        my $wires=soc->new_wires();
1635
        foreach my $id (@instances){
1636
                my ($param_v, $local_param_v, $wire_def_v, $inst_v, $plugs_assign_v, $sockets_assign_v,$io_full_v,$io_top_full_v,$io_sim_v,
1637
                $top_io_short,$param_as_in_v,$param_pass_v,$system_v,$assigned_ports,$top_io_pass,$src_io_short, $src_io_full)=gen_module_inst($id,$soc,$top_ip,$intfc,$wires);
1638
        }       #$id
1639
        return $top_ip;
1640
}
1641 38 alirezamon
 
1642
 
1643 16 alirezamon
 
1644
 
1645 48 alirezamon
sub get_soc_clk_source_list{
1646
        my $soc=shift;
1647
    my %all_sources;
1648
    my $top = soc_gen_top_ip($soc);
1649
    my @intfcs=$top->top_get_intfc_list();
1650
        my @sources=('clk','reset');
1651
        foreach my $intfc (@intfcs){
1652
                        my($type,$name,$num)= split("[:\[ \\]]", $intfc);
1653
                        foreach my $s (@sources){
1654
                                if ($intfc =~ /plug:$s/){
1655
                                        my @ports=$top->top_get_intfc_ports_list($intfc);
1656
                                        $all_sources{$s}=\@ports;
1657
                                }
1658
                        }
1659
        }
1660
        return %all_sources;
1661
}
1662 16 alirezamon
 
1663 48 alirezamon
sub check_soc_name{
1664
        my $name=shift;
1665
        $name="" if (!defined $name);
1666
        if (length($name)==0){
1667
                message_dialog("Please define the Tile name!");
1668
                return 1;
1669
        }
1670 16 alirezamon
 
1671 48 alirezamon
        my @tmp=split('_',$name);
1672
        if ( $tmp[-1] =~ /^[0-9]+$/ ){
1673
                message_dialog("The soc name must not end with '_number'!");
1674
                return 1;
1675
        }
1676 16 alirezamon
 
1677 48 alirezamon
        my $error = check_verilog_identifier_syntax($name);
1678
        if ( defined $error ){
1679
                message_dialog("The \"$name\" is given with an unacceptable formatting. This name will be used as top level Verilog module name so it must follow Verilog identifier declaration formatting:\n $error");
1680
                return 1;
1681
        }
1682
        return 0;
1683
}
1684 16 alirezamon
 
1685
 
1686 48 alirezamon
############
1687
#    main
1688
############
1689 16 alirezamon
 
1690
 
1691 48 alirezamon
 
1692
sub soc_clk_setting_win1 {
1693
        my ($soc,$info)=@_;
1694
        my $window = def_popwin_size(80,80,"CLK setting",'percent');
1695
 
1696
    my $next=def_image_button('icons/right.png','Next');
1697
        my $mtable = def_table(10, 1, FALSE);
1698
        #get the list of all tiles clk sources
1699 16 alirezamon
 
1700
 
1701 25 alirezamon
 
1702 48 alirezamon
        my $table = def_table(10, 7, FALSE);
1703
        my($row,$column)=(0,0);
1704 25 alirezamon
 
1705 48 alirezamon
        my %all = get_soc_clk_source_list($soc) ;
1706
        my @ports = @{$all{'clk'}} if defined $all{'clk'};
1707
        my $n=0;
1708
        foreach my $p (@ports){
1709
                my $r_lab=gen_label_in_center("$p:");
1710
                $table->attach  ($r_lab,$column,$column+1,$row,$row+1,'fill','shrink',2,2);$column+=1;
1711
                $soc->object_add_attribute('SOURCE_SET',"clk_${n}_name",$p);
1712
                ($column,$row)=get_clk_constrain_widget($soc,$table,$column,$row,'clk',$n);
1713
                $n++;
1714
        }
1715 34 alirezamon
 
1716 48 alirezamon
        $mtable->attach_defaults($table,0,1,0,1);
1717
        $mtable->attach($next,0,1,20,21,'expand','fill',2,2);
1718
        $window->add ($mtable);
1719
        $window->show_all();
1720
        $next-> signal_connect("clicked" => sub{
1721
                $window->destroy;
1722
                clk_setting_win2($soc,$info,'soc');
1723
 
1724
        });
1725 34 alirezamon
 
1726
 
1727 48 alirezamon
 
1728 34 alirezamon
 
1729 48 alirezamon
}
1730 34 alirezamon
 
1731
 
1732 48 alirezamon
######
1733
# ctrl
1734
######
1735 34 alirezamon
 
1736 48 alirezamon
sub soc_ctrl_tab {
1737
        my ($soc,$info,$ip)=@_;
1738 16 alirezamon
 
1739 48 alirezamon
        my $generate = def_image_button('icons/gen.png','_Generate RTL',FALSE,1);
1740
        my $compile  = def_image_button('icons/gate.png','Compile RTL');
1741
        my $software = def_image_button('icons/binary.png','Software');
1742
        my $diagram  = def_image_button('icons/diagram.png','Diagram');
1743
        my $clk=  def_image_button('icons/clk.png','CLK setting');
1744
        my $unset    = def_image_button('icons/intfc.png','Unset Intfc.');
1745 42 alirezamon
 
1746 48 alirezamon
        my $ram      = def_image_button('icons/RAM.png','Memory');
1747
        my $wb = def_image_button('icons/setting.png','WB addr');
1748
        my $open = def_image_button('icons/browse.png',"_Load Tile",FALSE,1);
1749
        my $entry=gen_entry_object($soc,'soc_name',undef,undef,undef,undef);
1750
        my $entrybox=gen_label_info(" Tile name:",$entry);
1751
        my $save      = def_image_button('icons/save.png');
1752
        my $open_dir  = def_image_button('icons/open-folder.png');
1753
        set_tip($save, "Save current tile configuration setting");
1754
        set_tip($open_dir, "Open target tile folder");
1755
 
1756
        $entrybox->pack_start( $save, FALSE, FALSE, 0);
1757
        $entrybox->pack_start( $open_dir, FALSE, FALSE, 0);
1758 34 alirezamon
 
1759 48 alirezamon
        my $main_table = def_table (1, 12, FALSE);
1760
 
1761
        $main_table->attach ($open              , 0, 1, 0,1,'expand','shrink',2,2);
1762
        $main_table->attach ($entrybox  , 1, 3, 0,1,'expand','shrink',2,2);
1763
        $main_table->attach ($unset             , 3, 4, 0,1,'expand','shrink',2,2);
1764
        $main_table->attach ($wb                , 4, 5, 0,1,'expand','shrink',2,2);
1765
        $main_table->attach ($diagram   , 5, 6, 0,1,'expand','shrink',2,2);
1766
        $main_table->attach ($clk               , 6, 7, 0,1,'expand','shrink',2,2);
1767
        $main_table->attach ($generate  , 7, 8, 0,1,'expand','shrink',2,2);
1768
        $main_table->attach ($software  , 8, 9, 0,1,'expand','shrink',2,2);
1769
        $main_table->attach ($compile   ,10,12, 0,1,'expand','shrink',2,2);
1770
 
1771
 
1772
        $clk-> signal_connect("clicked" => sub{
1773
                        soc_clk_setting_win1($soc,$info);
1774
        });
1775 16 alirezamon
 
1776 34 alirezamon
        $diagram-> signal_connect("clicked" => sub{
1777
                show_tile_diagram ($soc);
1778
        });
1779 28 alirezamon
 
1780 48 alirezamon
 
1781
        $save-> signal_connect("clicked" => sub{
1782
                my $name=$soc->object_get_attribute('soc_name');
1783
                return if(check_soc_name($name)) ;
1784
 
1785
                # Write object file
1786
                open(FILE,  ">lib/soc/$name.SOC") || die "Can not open: $!";
1787
                print FILE perl_file_header("$name.SOC");
1788
                print FILE Data::Dumper->Dump([\%$soc],['soc']);
1789
                close(FILE) || die "Error closing file: $!";
1790
                message_dialog("Processing Tile  \"$name\" is saved as lib/soc/$name.SOC.");
1791
 
1792
        });
1793
 
1794
 
1795 28 alirezamon
        $generate-> signal_connect("clicked" => sub{
1796 48 alirezamon
                my $name=$soc->object_get_attribute('soc_name');
1797
                return if(check_soc_name($name)) ;
1798 28 alirezamon
 
1799
                my $target_dir  = "$ENV{'PRONOC_WORK'}/SOC/$name";
1800
                my $hw_dir      = "$target_dir/src_verilog";
1801
                my $sw_path     = "$target_dir/sw";
1802
 
1803
                $soc->object_add_attribute('global_param','CORE_ID',0);
1804 42 alirezamon
                $soc->object_add_attribute('global_param','SW_LOC',$sw_path);
1805
 
1806
                unlink  "$hw_dir/file_list";
1807 28 alirezamon
                generate_soc($soc,$info,$target_dir,$hw_dir,$sw_path,1,1);
1808 45 alirezamon
 
1809 38 alirezamon
                my $has_ni= check_for_ni($soc);
1810
                if($has_ni){
1811 48 alirezamon
                        my $message = "Processing Tile  \"$name\" has been created successfully at $target_dir/.  In order to include this tile in MPSoC Generator you need to restart the ProNoC. Do you ant to reset the ProNoC now?";
1812
                        my $response =  yes_no_dialog ($message);
1813
                        if ($response eq 'yes') {
1814 38 alirezamon
                                exec($^X, $0, @ARGV);# reset ProNoC to apply changes    
1815
                        }
1816 48 alirezamon
 
1817 38 alirezamon
                } else {
1818
                        message_dialog("Processing Tile  \"$name\" has been created successfully at $target_dir/.");
1819
 
1820
                }
1821 28 alirezamon
        });
1822
 
1823 34 alirezamon
        $software -> signal_connect("clicked" => sub{
1824
                software_edit_soc($soc);
1825
 
1826
        });
1827 42 alirezamon
 
1828
        $unset-> signal_connect("clicked" => sub{
1829
                set_unset_infc($soc);
1830
        });
1831 34 alirezamon
 
1832
        $ram-> signal_connect("clicked" => sub{
1833
                get_ram_init($soc);
1834
 
1835
        });
1836
 
1837 48 alirezamon
 
1838 38 alirezamon
 
1839 34 alirezamon
        $compile -> signal_connect("clicked" => sub{
1840 48 alirezamon
                $soc->object_add_attribute('compile','compilers',"QuartusII,Vivado,Verilator,Modelsim");
1841 34 alirezamon
                my $name=$soc->object_get_attribute('soc_name');
1842 48 alirezamon
                $name="" if (!defined $name);
1843 34 alirezamon
                if (length($name)==0){
1844 38 alirezamon
                        message_dialog("Please define the Tile name!");
1845 34 alirezamon
                        return ;
1846
                }
1847
                my $target_dir  = "$ENV{'PRONOC_WORK'}/SOC/$name";
1848 38 alirezamon
                my $hw_dir      = "$target_dir/src_verilog";
1849
                my $sw_path     = "$target_dir/sw";
1850 48 alirezamon
                my $top         = "$target_dir/src_verilog/${name}_top.sv";
1851 38 alirezamon
                if (-f $top){
1852 42 alirezamon
                        unlink  "$hw_dir/file_list";
1853 38 alirezamon
                        generate_soc($soc,$info,$target_dir,$hw_dir,$sw_path,1,1);
1854 34 alirezamon
                        select_compiler($soc,$name,$top,$target_dir);
1855
                } else {
1856 48 alirezamon
                        message_dialog("Cannot find $top file. Please run RTL Generator first!",'error');
1857 34 alirezamon
                        return;
1858
                }
1859
        });
1860
 
1861 28 alirezamon
        $wb-> signal_connect("clicked" => sub{
1862
                wb_address_setting($soc);
1863
 
1864
        });
1865
 
1866
        $open-> signal_connect("clicked" => sub{
1867 34 alirezamon
                load_soc($soc,$info,$ip);
1868 28 alirezamon
 
1869
        });
1870 48 alirezamon
 
1871
        $open_dir-> signal_connect("clicked" => sub{
1872
                my $name=$soc->object_get_attribute('soc_name');
1873
                $name="" if (!defined $name);
1874
                if (length($name)==0){
1875
                        message_dialog("Please define the Tile name!");
1876
                        return ;
1877
                }
1878
                my $target_dir  = "$ENV{'PRONOC_WORK'}/SOC/$name";
1879
                unless (-d $target_dir){
1880
                        message_dialog("Cannot find $target_dir.\n Please run RTL Generator first!",'error');
1881
                        return;
1882
                }
1883
                system "xdg-open   $target_dir";
1884
 
1885
        });
1886
 
1887
        return $main_table;
1888
 
1889
}
1890 28 alirezamon
 
1891
 
1892 48 alirezamon
sub socgen_main{
1893
 
1894
        my $infc = interface->interface_new();
1895
        my $ip = ip->lib_new ();
1896
        my $soc = soc->soc_new();
1897
        set_gui_status($soc,"ideal",0);
1898
 
1899
        #  The main table containing the lib tree, selected modules and info section 
1900
        my $main_table = def_table (20, 12, FALSE);
1901
 
1902
        # The box which holds the info, warning, error ...  messages
1903
        my ($infobox,$info)= create_txview();
1904
 
1905
 
1906
        # A tree view for holding a library
1907
        my %tree_text;
1908
        my @categories= $ip->ip_get_categories();
1909
    foreach my $p (@categories)
1910
    {
1911
                #next if ($p eq 'PLL');
1912
                my @modules= $ip->get_modules($p);
1913
                $tree_text{$p}=\@modules;
1914
    }
1915
        my $tree_box = create_tree ($soc,'IP list', $info,\%tree_text,\&show_select_ip_description,\&add_module_to_soc);
1916 28 alirezamon
 
1917 48 alirezamon
        $main_table->set_row_spacings (4);
1918
        $main_table->set_col_spacings (1);
1919
 
1920
        my  $device_win=show_active_dev($soc,$ip,$infc,$info);
1921
 
1922
 
1923
 
1924
 
1925
 
1926
        my $h1=gen_hpaned($tree_box,.15,$device_win);
1927
        my $v2=gen_vpaned($h1,.55,$infobox);
1928
        $main_table->attach_defaults ($v2  , 0, 12, 0,19);
1929
 
1930
        my $ctrl = soc_ctrl_tab($soc,$info,$ip);
1931
        $main_table->attach ($ctrl  , 0, 12, 19,20,'fill','fill',2,2);
1932 28 alirezamon
 
1933 48 alirezamon
 
1934
 
1935
        my $sc_win = add_widget_to_scrolled_win($main_table);
1936
 
1937
 
1938
 
1939
        #check soc status every 0.5 second. refresh device table if there is any changes 
1940 16 alirezamon
        Glib::Timeout->add (100, sub{
1941 25 alirezamon
                my ($state,$timeout)= get_gui_status($soc);
1942
 
1943 16 alirezamon
                if ($timeout>0){
1944
                        $timeout--;
1945 25 alirezamon
                        set_gui_status($soc,$state,$timeout);
1946
 
1947 34 alirezamon
                }elsif ($state eq 'save_project'){
1948
                        # Write object file
1949
                        my $name=$soc->object_get_attribute('soc_name',undef);
1950
                        open(FILE,  ">lib/soc/$name.SOC") || die "Can not open: $!";
1951
                        print FILE perl_file_header("$name.SOC");
1952
                        print FILE Data::Dumper->Dump([\%$soc],['soc']);
1953 48 alirezamon
                        close(FILE) || die "Error closing file: $!";
1954 34 alirezamon
                        set_gui_status($soc,"ideal",0);
1955 16 alirezamon
                }
1956
                elsif( $state ne "ideal" ){
1957 48 alirezamon
                        $device_win->destroy;
1958
                        $device_win=show_active_dev($soc,$ip,$infc,$info);
1959
                        $h1 -> pack2($device_win, TRUE, TRUE);
1960
                        $h1 -> show_all;
1961
                        $ctrl->destroy;
1962
                        $ctrl= soc_ctrl_tab($soc,$info,$ip);
1963
                        $main_table->attach ($ctrl  , 0, 12, 19,20,'fill','fill',2,2);
1964
                        $main_table->show_all;
1965 25 alirezamon
                        set_gui_status($soc,"ideal",0);
1966 16 alirezamon
                }
1967
                return TRUE;
1968
 
1969
        } );
1970
 
1971
 
1972
 
1973
        return $sc_win;
1974 48 alirezamon
 
1975 16 alirezamon
 
1976
 
1977
}
1978 34 alirezamon
 
1979
 
1980
 
1981
 
1982
 
1983
 

powered by: WebSVN 2.1.0

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