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 45

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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