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

Subversion Repositories vhld_tb

[/] [vhld_tb/] [tags/] [rel_001/] [ttb_gen/] [ttb_gen_gui.tcl] - Blame information for rev 23

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

Line No. Rev Author Line
1 2 sckoarn 
##-------------------------------------------------------------------------------
2 
##--                     Copyright 2007 Ken Campbell
3 
##--                        All Rights Reserved
4 
##
5 
##           This program is free software; you can redistribute it and/or modify
6 
##               it under the terms of the GNU General Public License as published by
7 
##               the Free Software Foundation; either version 2 of the License, or
8 
##               (at your option) any later version.
9 
##
10 
##               This program is distributed in the hope that it will be useful,
11 
##               but WITHOUT ANY WARRANTY; without even the implied warranty of
12 
##               MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 
##               GNU General Public License for more details.
14 
##
15 
##               You should have received a copy of the GNU General Public License
16 
##               along with this program; if not, write to the Free Software
17 
##               Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18 
##-------------------------------------------------------------------------------
19 
##-- $Author: sckoarn $
20 
##--
21 
##-- $Date: 2007-04-06 04:06:49 $
22 
##--
23 
##-- $Name: not supported by cvs2svn $
24 
##--
25 
##-- $Id: ttb_gen_gui.tcl,v 1.1.1.1 2007-04-06 04:06:49 sckoarn Exp $
26 
##--
27 
##-- $Source: /home/marcus/revision_ctrl_test/oc_cvs/cvs/vhld_tb/ttb_gen/ttb_gen_gui.tcl,v $
28 
##--
29 
##-- Description :
30 
##--      This application takes a text file containing the definition of a VHDL
31 
##           entity, parses that entity and generates the VHDL Test Bench starting
32 
##           file set.  ( This was the first application written by the author
33 
##           in the tcl\tk language, forgive the style.)
34 
##--
35 
##------------------------------------------------------------------------------
36 
## set the current version info
37 
set ttbgen_version "v1.0"
38 
## get the time and date from the system
39 
set raw_date [clock scan now]
40 
set scan_date [clock format $raw_date -format "%d %b %Y %T"]
41 
## title and version info for window
42 
set msg_txt [label .l1 -text "Test Bench Generation Tool    $ttbgen_version"];
43 
pack $msg_txt
44 
 
45 
## destination spec frame
46 
set g [frame .dest]
47 
label $g.lab -text "Destination Directory: " -anchor e
48 
entry $g.ent -width 20
49 
pack $g.lab -side left
50 
pack $g.ent -side left -expand yes -fill x
51 
 
52 
## source spec frame  with browser
53 
set f [frame .sour]
54 
label $f.lab -text "Select Generation Source: " -anchor e
55 
entry $f.ent -width 20
56 
button $f.but -text "Browse ..." -command "fileDialog $f $f.ent $g.ent"
57 
pack $f.lab -side left
58 
pack $f.ent -side left -expand yes -fill x
59 
pack $f.but -side left
60 
pack $f -fill x -padx 1c -pady 3
61 
## pack destination frame
62 
pack $g -fill x -padx 1c -pady 3
63 
## check button for optional bhv generation
64 
checkbutton .b1 -text "Generate the bhv file?" -variable bhv
65 
pack .b1
66 
## create and place the buttons frame
67 
frame .buttons
68 
pack .buttons -side bottom -fill x -pady 2m
69 
button .buttons.exit -text "Exit" -command exit
70 
button .buttons.help -text "Help" -command "show_help $msg_txt"
71 
button .buttons.gene -text "Generate" -command "ttb_gen $f.ent $g.ent"
72 
pack .buttons.gene -side left -expand 1
73 
pack .buttons.help -side left -expand 1
74 
pack .buttons.exit -side left -expand 1
75 
 
76 
 
77 
###########################################################################
78 
##  some debug and help procs
79 
##    Message Error, terminate
80 
proc msg_error { msg } {
81 
  tk_messageBox -message $msg -type ok
82 
  exit
83 
}
84 
###########################################################################
85 
##  Message, continue
86 
proc dbg_msg { msg } {
87 
  tk_messageBox -message $msg -type ok
88 
}
89 
##-----------------------------------------------------------------------
90 
##  Help display proc.  It changes the Lable at the top of the window to
91 
##     have the following text
92 
proc show_help { h } {
93 
  $h configure -justify left -text "Test Bench Generation Help \n  \n \
94 
                      1) Use Browse to select a source entity VHDL file \n \
95 
                      2) Provide the path to the destination directory \n \
96 
                      3) Check Generate bhv, if behave file should be generated \n \
97 
                      4) Hit the Generate button"
98 
}
99 
 
100 
##---------------------------------------------------------------
101 
##  File dialog handler
102 
proc fileDialog {f ent des} {
103 
    #   Type names              Extension
104 
    #
105 
    #---------------------------------------------------------
106 
    set types {
107 
        {"VHDL Code"            {.vhd .vhdl}    }
108 
        {"Text files"           {.txt}          }
109 
        {"Tcl Scripts"          {.tcl}          TEXT}
110 
        {"All files"            *}
111 
    }
112 
 
113 
    set file [tk_getOpenFile -filetypes $types -parent $f]
114 
 
115 
    if {[string compare $file ""]} {
116 
        $ent delete 0 end
117 
        $ent insert 0 $file
118 
        $ent xview end
119 
 
120 
        set des_directory [string last / $file]
121 
        $des delete 0 end
122 
        $des insert 0 [string range $file 0 $des_directory]
123 
        $des xview end
124 
    }
125 
}
126 
 
127 
##-----------------------------------------------------------------------
128 
##  proc pars_pindef
129 
proc pars_pindef { pin } {
130 
  set pdirection ""
131 
#  dbg_msg $pin
132 
  set spin [split $pin ":"]
133 
  set pname_str [lindex $spin 0]
134 
  set pname [lindex $pname_str 0]
135 
#  dbg_msg "Pin name is $pname"
136 
  set pdirection_str [lindex $spin 1]
137 
#  dbg_msg $pdirection_str
138 
  ## parce out the direction, supporting only 3
139 
  set direction [string first "in " $pdirection_str]
140 
  if {$direction >= 0} {
141 
    set pdirection "in"
142 
  }
143 
  set direction [string first "out " $pdirection_str]
144 
  if {$direction >= 0} {
145 
    set pdirection "out"
146 
  }
147 
  set direction [string first "inout " $pdirection_str]
148 
  if {$direction >= 0} {
149 
    set pdirection "inout"
150 
  }
151 
  if {$pdirection == ""} {
152 
    msg_error "Unsuported Pin direction found. \n Suported are IN OUT and INOUT."
153 
  }
154 
#  dbg_msg "Pin direction is $pdirection"
155 
  ## now parce out the type
156 
    ##  to overcome the std_logic_vector( # to #); vs  (# to #); syntax
157 
    ##  check and see if there is a vector spec in this pin with space after
158 
    ##   the first bracket
159 
    set vect [string first "( " $pdirection_str]
160 
    if {$vect < 0} {
161 
        set ptype1 [lindex $pdirection_str 1]
162 
        set ptype2 [lindex $pdirection_str 2]
163 
        set ptype3 [lindex $pdirection_str 3]
164 
        set ptype "$ptype1 $ptype2 $ptype3"
165 
    } else {
166 
        set ptype1 [lindex $pdirection_str 1]
167 
        set ptype2 [lindex $pdirection_str 2]
168 
        set ptype3 [lindex $pdirection_str 3]
169 
        set ptype4 [lindex $pdirection_str 4]
170 
        set ptype "$ptype1 $ptype2 $ptype3 $ptype4"
171 
    }
172 
  ##puts $ptype
173 
 
174 
  set last_pin [string first \; $ptype]
175 
  if {$last_pin >= 0} {
176 
    set is_vector [string first ( $ptype]
177 
    ## if there is a vector def
178 
    if {$is_vector >= 0} {
179 
      set temp_v [string first )) $ptype]
180 
 
181 
      if {$temp_v >= 0} {
182 
        set s_e [expr $last_pin - 2]
183 
        set ptype [string range $ptype 0 $s_e]
184 
      } else {
185 
        set s_e [expr $last_pin - 1]
186 
        set ptype [string range $ptype 0 $s_e]
187 
      }
188 
    } else {
189 
      set temp_v [string first ) $ptype]
190 
      ## found a ); in the last pin def
191 
      if {$temp_v >= 0} {
192 
        set s_e [expr $last_pin - 2]
193 
        set ptype [string range $ptype 0 $s_e]
194 
      } else {
195 
        set s_e [expr $last_pin - 1]
196 
        set ptype [string range $ptype 0 $s_e]
197 
      }
198 
    }
199 
  }
200 
  set ptype [string trim $ptype]
201 
#  dbg_msg "The type is $ptype"
202 
   lappend pdef $pname $pdirection $ptype
203 
  return $pdef
204 
}
205 
 
206 
##--------------------------------------------------------------------------------
207 
##  Write header to file passed
208 
proc write_header { handle } {
209 
  global ttbgen_version
210 
  global scan_date
211 
 
212 
  ## so CVS will not modify selections, they have to be chopped up
213 
  set auth "-- \$Auth"
214 
  append auth "or:  \$"
215 
  set cvs_date "-- \$dat"
216 
  append cvs_date "e:  \$"
217 
  set cvs_name "-- \$Nam"
218 
  append cvs_name "e:  \$"
219 
  set cvs_id "-- \$I"
220 
  append cvs_id "d:  \$"
221 
  set cvs_source "-- \$Sour"
222 
  append cvs_source "ce:  \$"
223 
  set cvs_log "-- \$Lo"
224 
  append cvs_log "g:  \$"
225 
 
226 
  puts $handle "-------------------------------------------------------------------------------"
227 
  puts $handle "--                    Copyright 2007 xxxx"
228 
  puts $handle "--                        All Rights Reserved"
229 
  puts $handle "-------------------------------------------------------------------------------"
230 
  puts $handle "$auth"
231 
  puts $handle "--"
232 
  puts $handle "$cvs_date"
233 
  puts $handle "--"
234 
  puts $handle "$cvs_name"
235 
  puts $handle "--"
236 
  puts $handle "$cvs_id"
237 
  puts $handle "--"
238 
  puts $handle "$cvs_source"
239 
  puts $handle "--"
240 
  puts $handle "-- Description :"
241 
  puts $handle "--          This file was generated by ttb_gen2_gui $ttbgen_version"
242 
  puts $handle "--            on $scan_date"
243 
  puts $handle "------------------------------------------------------------------------------"
244 
#  puts $handle "-- This software contains concepts confidential to ------------------"
245 
#  puts $handle "-- -----------. and is only made available within the terms of a written"
246 
#  puts $handle "-- agreement."
247 
#  puts $handle "-------------------------------------------------------------------------------"
248 
  puts $handle "-- Revision History:"
249 
  puts $handle "$cvs_log"
250 
  puts $handle "--"
251 
  puts $handle "-------------------------------------------------------------------------------"
252 
  puts $handle ""
253 
}
254 
 
255 
##-------------------------------------------------------------------------
256 
## write Library and use statements
257 
proc write_lib_statements { handle } {
258 
puts $handle "library IEEE;"
259 
puts $handle "library ieee_proposed;"
260 
puts $handle "--library modelsim_lib;"
261 
puts $handle "use IEEE.STD_LOGIC_1164.all;"
262 
puts $handle "use IEEE.STD_LOGIC_ARITH.all;"
263 
puts $handle "use ieee_proposed.STD_LOGIC_1164_additions.all;"
264 
puts $handle "use std.textio.all;"
265 
puts $handle "--use modelsim_lib.util.all;"
266 
puts $handle ""
267 
}
268 
 
269 
 
270 
#########################################################################
271 
##
272 
##  START of main program
273 
##
274 
#########################################################################
275 
proc ttb_gen { source destin } {
276 
 
277 
global bhv
278 
 
279 
set path_text [$source get]
280 
set destin_text [$destin get]
281 
 
282 
set infile [open "$path_text"  r]
283 
set file_list list
284 
 
285 
##########################################
286 
##   Path needs to be set up for the some usage cases
287 
## set the path to the template behave file
288 
set template "template_tb_bhv.vhd"
289 
#set template "\\\\Gs1\\public\\fpga_projects\\verification_docs\\html\\vhdltb\\template2_tb_bhv.vhd"
290 
 
291 
set tmpcnt 0
292 
 
293 
## -------------------------------------------------------------
294 
##  Read in the file and strip comments as we do
295 
while {![eof $infile]} {
296 
  ##  Get a line
297 
  set rline [gets $infile]
298 
  ## get rid of white space
299 
  set rline [string trim $rline]
300 
  ##  Find comment if there
301 
  set cindex [string first -- $rline]
302 
  ## if a comment was found at the start of the line
303 
  if {$cindex == 0 || $rline == ""} {
304 
    set rline [string range $rline 0 [expr $cindex - 1]]
305 
    ##dbg_msg $rline
306 
    if {[llength $rline] > 0} {
307 
      lappend file_list [string tolower $rline]
308 
    }
309 
  ## else was not found so put line in list
310 
  } else {
311 
    lappend file_list [string tolower $rline]
312 
     # if {$tmpcnt > 490} {
313 
     #     dbg_msg "$rline $tmpcnt"
314 
     # }
315 
  }
316 
  incr tmpcnt
317 
}
318 
 
319 
## collect the library statements
320 
foreach l $file_list {
321 
  set libpos [string first library $l]
322 
  if {$libpos >= 0} {
323 
    lappend libs_list $l
324 
  }
325 
}
326 
 
327 
## collect the use statements
328 
foreach l $file_list {
329 
  set usepos [string first use $l]
330 
  if {$usepos >= 0} {
331 
    lappend use_list $l
332 
  }
333 
}
334 
## check for the entity def
335 
set ent_found 0
336 
foreach l $file_list {
337 
  set ent_def [string first entity $l]
338 
  if {$ent_def >= 0} {
339 
##    set ent_found 1
340 
    set ent_name [lindex $l 1]
341 
    break
342 
  }
343 
}
344 
## if no ent  die
345 
if {$ent_def < 0} {
346 
  msg_error "An entity definition was not found in the file provided."
347 
##  exit
348 
}
349 
 
350 
## check for end entity
351 
foreach l $file_list {
352 
  lappend ent_list $l
353 
  set end_def [string first end $l]
354 
  if {$end_def >= 0} {
355 
    set end_ent [string first "end $ent_name" $l]
356 
    if {$end_ent >= 0} {
357 
      break
358 
    }
359 
    set end_ent [string first "end entity $ent_name" $l]
360 
    if {$end_ent >= 0} {
361 
      break
362 
    }
363 
  }
364 
}
365 
## if no end die
366 
if {$end_def < 0} {
367 
  msg_error "no end statement found for this entity"
368 
##  exit
369 
}
370 
 
371 
set port_found 0
372 
#######----------------------------------------------------------------
373 
##  a few checks have been done, and non-relevant stuff stripped off.
374 
##  now create an arrry of just the pin names and related info
375 
foreach l $ent_list {
376 
  ## look for the port statement
377 
  if {$port_found == 0} {
378 
    set pfound [string first port $l]
379 
    ## found one now check if there is a pin def in the same line
380 
    if {$pfound >= 0} {
381 
      set port_found 1
382 
      set efound [string first : $l]
383 
      if {$efound >= 0} {
384 
        set line_test [split $l "("]
385 
        if {[llength $line_test] > 1} {
386 
          lappend port_list [lindex $line_test 1]
387 
        }
388 
      }
389 
    }
390 
  } else {
391 
    set efound [string first : $l]
392 
    if {$efound >= 0} {
393 
      lappend port_list $l
394 
    }
395 
  }
396 
}
397 
#dbg_msg $port_list
398 
##  Change the port list into a pin info list
399 
foreach l $port_list {
400 
  lappend split_pin [pars_pindef $l]
401 
}
402 
# dbg_msg $split_pin
403 
 
404 
## calculate the longest pin name in characters
405 
set name_length 0
406 
foreach l $split_pin {
407 
  set temp_length [string length [lindex $l 0]]
408 
  if {$temp_length > $name_length} {
409 
    set name_length $temp_length
410 
  }
411 
}
412 
#dbg_msg $name_length
413 
##  Make the name length one bigger
414 
incr name_length
415 
 
416 
#########################################################################
417 
## Generate the test bench entity.
418 
 
419 
##  Create the file name
420 
set file_type "_tb_ent.vhd"
421 
set ent_file_name $destin_text
422 
append ent_file_name "/" $ent_name $file_type
423 
#  dbg_msg $ent_file_name
424 
## Create the tb entity name
425 
set tb_ent_name $ent_name
426 
set tb_sufix "_tb"
427 
append tb_ent_name $tb_sufix
428 
 
429 
## open and write the header
430 
set ent_file [open $ent_file_name w+]
431 
write_header $ent_file
432 
 
433 
## write out Library and use statements
434 
write_lib_statements $ent_file
435 
 
436 
puts $ent_file "entity $tb_ent_name is"
437 
puts $ent_file "   generic ("
438 
puts $ent_file "            stimulus_file: in string"
439 
puts $ent_file "           )\;"
440 
puts $ent_file "   port ("
441 
 
442 
##-----------------------------------------
443 
#  for each pin in the list output the TB ent pin
444 
set plist_size [llength $split_pin]
445 
#dbg_msg $plist_size
446 
set i 1
447 
foreach l $split_pin {
448 
  set pdirection [lindex $l 1]
449 
#  puts $pdirection
450 
  ## switch on the source pin direction
451 
  switch -exact $pdirection {
452 
    "in" {set tb_ptype "buffer"}
453 
    "out" {set tb_ptype "in"}
454 
    "inout" {set tb_ptype "inout"}
455 
    default {
456 
      msg_error "Should have not got here .. pin direction in entity creation!!"
457 
    }
458 
  }
459 
  ## creat some formats for appending
460 
  set new_pname [format "         %-${name_length}s" [lindex $l 0]]
461 
  set new_ptype [format ": %-8s" $tb_ptype]
462 
  if {$i != $plist_size} {
463 
    append new_pname $new_ptype [lindex $l 2] ";"
464 
  } else {
465 
    append new_pname $new_ptype [lindex $l 2]
466 
  }
467 
  puts $ent_file $new_pname
468 
  incr i
469 
}
470 
 
471 
puts $ent_file "        )\;"
472 
puts $ent_file "end $tb_ent_name;"
473 
 
474 
close $ent_file
475 
 
476 
##################################################################
477 
##  Generate the top level test bench entity
478 
##  Create the file name
479 
set file_type "_ttb_ent.vhd"
480 
set ent_file_name $destin_text
481 
append ent_file_name "/" $ent_name $file_type
482 
# dbg_msg $ent_file_name
483 
## Create the tb entity name
484 
set ttb_ent_name $ent_name
485 
set ttb_sufix "_ttb"
486 
append ttb_ent_name $ttb_sufix
487 
 
488 
## open and write the header
489 
set ttb_ent_file [open $ent_file_name w+]
490 
write_header $ttb_ent_file
491 
 
492 
puts $ttb_ent_file "library IEEE;"
493 
puts $ttb_ent_file "library dut_lib;"
494 
puts $ttb_ent_file "use IEEE.STD_LOGIC_1164.all;"
495 
puts $ttb_ent_file "use dut_lib.all;"
496 
puts $ttb_ent_file ""
497 
puts $ttb_ent_file "entity $ttb_ent_name is"
498 
puts $ttb_ent_file "  generic ("
499 
puts $ttb_ent_file "           stimulus_file: string := \"stm/stimulus_file.stm\""
500 
puts $ttb_ent_file "          )\;"
501 
puts $ttb_ent_file "end $ttb_ent_name\;"
502 
 
503 
close $ttb_ent_file
504 
 
505 
#################################################################
506 
## Generate the top level structure
507 
##  Create the file name
508 
set file_type "_ttb_str.vhd"
509 
set str_file_name $destin_text
510 
append str_file_name "/" $ent_name $file_type
511 
# dbg_msg $ent_file_name
512 
## Create the tb entity name
513 
set ttb_ent_name $ent_name
514 
set ttb_sufix "_ttb"
515 
append ttb_ent_name $ttb_sufix
516 
 
517 
## open and write the header
518 
set ttb_str_file [open $str_file_name w+]
519 
write_header $ttb_str_file
520 
 
521 
puts $ttb_str_file ""
522 
puts $ttb_str_file "architecture struct of $ttb_ent_name is"
523 
puts $ttb_str_file ""
524 
puts $ttb_str_file "component $ent_name"
525 
puts $ttb_str_file "  port ("
526 
## put out the dut component def
527 
##-----------------------------------------
528 
#  for each pin in the list output the TB ent pin
529 
set i 1
530 
foreach l $split_pin {
531 
  ## creat some formats for appending
532 
  set new_pname [format "        %-${name_length}s" [lindex $l 0]]
533 
  set new_ptype [format ": %-8s" [lindex $l 1]]
534 
  if {$i != $plist_size} {
535 
    append new_pname $new_ptype [lindex $l 2] ";"
536 
  } else {
537 
    append new_pname $new_ptype [lindex $l 2]
538 
  }
539 
  puts $ttb_str_file $new_pname
540 
  incr i
541 
}
542 
puts $ttb_str_file "       )\;"
543 
puts $ttb_str_file "end component\;"
544 
 
545 
puts $ttb_str_file ""
546 
puts $ttb_str_file "component $tb_ent_name"
547 
puts $ttb_str_file "  generic ("
548 
puts $ttb_str_file "           stimulus_file: in string"
549 
puts $ttb_str_file "          )\;"
550 
puts $ttb_str_file "  port ("
551 
## put out the tb component def
552 
##-----------------------------------------
553 
#  for each pin in the list output the TB ent pin
554 
set i 1
555 
foreach l $split_pin {
556 
  set pdirection [lindex $l 1]
557 
#  dbg_msg $pdirection
558 
  ## switch on the source pin direction
559 
  switch -exact $pdirection {
560 
    "in" {set tb_ptype "buffer"}
561 
    "out" {set tb_ptype "in"}
562 
    "inout" {set tb_ptype "inout"}
563 
    default {
564 
      msg_error "Should have not got here .. pin direction in entity creation!!"
565 
    }
566 
  }
567 
  ## creat some formats for appending
568 
  set new_pname [format "        %-${name_length}s" [lindex $l 0]]
569 
  set new_ptype [format ": %-8s" $tb_ptype]
570 
  if {$i != $plist_size} {
571 
    append new_pname $new_ptype [lindex $l 2] ";"
572 
  } else {
573 
    append new_pname $new_ptype [lindex $l 2]
574 
  }
575 
  puts $ttb_str_file $new_pname
576 
  incr i
577 
}
578 
puts $ttb_str_file "       )\;"
579 
puts $ttb_str_file "end component\;"
580 
puts $ttb_str_file ""
581 
 
582 
puts $ttb_str_file "for all: $ent_name    use entity dut_lib.$ent_name\(str)\;"
583 
puts $ttb_str_file "for all: $tb_ent_name    use entity work.$tb_ent_name\(bhv)\;"
584 
 
585 
puts $ttb_str_file ""
586 
##-----------------------------------------
587 
#  for each pin in the list output the TB ent pin
588 
#     generate a signal name
589 
foreach l $split_pin {
590 
  ## creat some formats for appending
591 
  set new_pname [format "  signal temp_%-${name_length}s" [lindex $l 0]]
592 
  append new_pname ": " [lindex $l 2] ";"
593 
  puts $ttb_str_file $new_pname
594 
}
595 
 
596 
puts $ttb_str_file ""
597 
puts $ttb_str_file "begin"
598 
puts $ttb_str_file ""
599 
puts $ttb_str_file "dut: $ent_name"
600 
puts $ttb_str_file "  port map("
601 
##-----------------------------------------
602 
#  for each pin in the list output the TB ent pin
603 
#     Generate port map for DUT
604 
set i 1
605 
foreach l $split_pin {
606 
  ## creat some formats for appending
607 
  set new_pname [format "           %-${name_length}s" [lindex $l 0]]
608 
  if {$i != $plist_size} {
609 
    append new_pname "=>  temp_" [lindex $l 0] ","
610 
  } else {
611 
    append new_pname "=>  temp_" [lindex $l 0]
612 
  }
613 
  puts $ttb_str_file $new_pname
614 
  incr i
615 
}
616 
 
617 
puts $ttb_str_file "          )\;"
618 
puts $ttb_str_file ""
619 
puts $ttb_str_file "tb: $tb_ent_name"
620 
puts $ttb_str_file "  generic map("
621 
puts $ttb_str_file "               stimulus_file => stimulus_file"
622 
puts $ttb_str_file "             )"
623 
puts $ttb_str_file "  port map("
624 
##-----------------------------------------
625 
#  for each pin in the list output the TB ent pin
626 
#     Generate port map for DUT
627 
set i 1
628 
foreach l $split_pin {
629 
  ## creat some formats for appending
630 
  set new_pname [format "           %-${name_length}s" [lindex $l 0]]
631 
  if {$i != $plist_size} {
632 
    append new_pname "=>  temp_" [lindex $l 0] ","
633 
  } else {
634 
    append new_pname "=>  temp_" [lindex $l 0]
635 
  }
636 
  puts $ttb_str_file $new_pname
637 
  incr i
638 
}
639 
 
640 
puts $ttb_str_file "          )\;"
641 
puts $ttb_str_file ""
642 
puts $ttb_str_file "end struct\;"
643 
 
644 
close $ttb_str_file
645 
 
646 
######################################################################
647 
##  Now generate the bhv file from template
648 
 
649 
if {$bhv == 1} {
650 
 
651 
  set infile [open "$template"  r]
652 
 
653 
  while {![eof $infile]} {
654 
    ##  Get a line
655 
    set rline [gets $infile]
656 
    lappend temp_file_list $rline
657 
  }
658 
 
659 
  close $infile
660 
 
661 
  ## strip off the header
662 
  set end_header 0
663 
  foreach l $temp_file_list {
664 
    set comment [string first -- $l]
665 
    if {$comment < 0} {
666 
      set end_header 1
667 
    }
668 
    ## if we found the end of the header
669 
    if {$end_header == 1} {
670 
      lappend template_list $l
671 
    }
672 
  }
673 
 
674 
  ## split the file into two peices, to the point of input initialization
675 
  set i 1
676 
  foreach l $template_list {
677 
    ## check for parsing point
678 
    set mid_point [string first parse_tb1 $l]
679 
    if {$mid_point >= 0} {
680 
      break
681 
    }
682 
 
683 
    if {$i > 2} {
684 
      lappend top_half $l
685 
    }
686 
    incr i
687 
  }
688 
 
689 
  set found 0
690 
  foreach l $template_list {
691 
    if {$found == 1} {
692 
      lappend bottom_half $l
693 
    }
694 
    ## check for parsing point
695 
    set mid_point [string first parse_tb1 $l]
696 
    if {$mid_point >= 0} {
697 
      set found 1
698 
    }
699 
  }
700 
 
701 
  ##  Create the file name
702 
  set file_type "_tb_bhv.vhd"
703 
  set bhv_file_name $destin_text
704 
  append bhv_file_name "/" $ent_name $file_type
705 
  # dbg_msg $ent_file_name
706 
 
707 
  ## open and write the header
708 
  set bhv_file [open $bhv_file_name w+]
709 
  write_header $bhv_file
710 
 
711 
  puts $bhv_file ""
712 
  puts $bhv_file "architecture bhv of $tb_ent_name is"
713 
  puts $bhv_file ""
714 
  foreach l $top_half {
715 
    puts $bhv_file $l
716 
  }
717 
 
718 
  puts $bhv_file ""
719 
  ## now generate and write out input initialization
720 
  foreach l $split_pin {
721 
    set temp_def [lindex $l 1]
722 
    set input_def [string first in $temp_def]
723 
    if {$input_def >= 0} {
724 
      set vector [string first vector $l]
725 
      set init_def [format "    %-${name_length}s" [lindex $l 0]]
726 
      if {$vector >= 0} {
727 
        append init_def "<=  (others => '0')\;"
728 
      } else {
729 
        append init_def "<=  '0'\;"
730 
      }
731 
      puts $bhv_file $init_def
732 
    }
733 
  }
734 
  puts $bhv_file ""
735 
  ## now write out the bottem half and termination
736 
  foreach l $bottom_half {
737 
    puts $bhv_file $l
738 
  }
739 
 
740 
  close $bhv_file
741 
  }
742 
  ## put out a terminating message for the user
743 
  dbg_msg "Test bench files were generated in directory:\n $destin_text"
744 
 
745 
}
746 
 
747 
bind . <F12> {catch {console show}}
748 
 
749 
##-------------------------------------------------------------------------------
750 
##-- Revision History:
751 
##-- $Log: not supported by cvs2svn $
752 
##--
753 
##----------------------------------------------------------------------------
754 
 

powered by: WebSVN 2.1.0

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