[OpenSPARC-T2-DV] / tools / perlmod / Midas / 3.32 / lib / site_perl / 5.8.0 / Midas / TSB.pm

# ========== Copyright Header Begin ==========================================
# 
# OpenSPARC T2 Processor File: TSB.pm
# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
#
# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# For the avoidance of doubt, and except that if any non-GPL license 
# choice is available it will apply instead, Sun elects to use only 
# the General Public License version 2 (GPLv2) at this time for any 
# software where a choice of GPL license versions is made 
# available with the language indicating that GPLv2 or any later version 
# may be used, or where a choice of which version of the GPL is applied is 
# otherwise unspecified. 
#
# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, 
# CA 95054 USA or visit www.sun.com if you need additional information or 
# have any questions. 
# 
# ========== Copyright Header End ============================================
# -*- perl -*-

package Midas::TSB;
use strict;

use TRELoad 'BitFieldTie';
use Midas::Command;
use Midas::Error;
use Midas::Globals;
use Midas::MMU;

use fields qw(
	      name
	      config_register

	      base
	      sizebits
	      is_split
	      numentries
	      page_size

	      tsblinkname
	      tsblinkobj
	      force_ctx_zero
	      ttefmt
	      way

	      srcline
	      srcfile
	      srclinestop
	      srcfilestop

	      touched
	      length
	     );

###############################################################################

sub new {
  my $this = shift;
  my %args = @_;

  unless (ref $this) {
    $this = fields::new($this);
  }

  $this->{touched} = 0;
  $this->{force_ctx_zero} = undef;
  $this->{page_size} = undef;
  $this->{way} = undef;

  foreach my $key (keys %args) {
    $this->{$key} = $args{$key};
  }

  return $this;
}

###############################################################################

sub new_from_line {
  my $class = shift;
  my $startline = shift;
  my $fh        = shift;
  my $srcfile   = shift;
  my $srcline   = shift;
  my $mmu       = shift;

  my $srcfile_start = $srcfile;
  my $srcline_start = $srcline;

  local ($_);
  $_ = $startline;


  fatal "Badly formatted TSB line=$srcline, file=$srcfile:\n$_", M_TSBSYNTAX
    unless /^\s*MIDAS_TSB\s*(\S+)\s*((0[xX])?([\da-fA-F]+))\s*(.*)\s*$/;

  my $tsbname = lc $1;
  my $register = $2;
  my $rest = $5;

  my $reg_bf = string2bf($register, 64);
  fatal "TSB config register '$register' is not a number at file=$srcfile, line=$srcline\n", M_NOTNUM unless defined $reg_bf;


  my $force_ctx_zero = undef;
  my $page_size = undef;
  my $ttefmt = undef;
  my $way = undef;
  my $tsblinkname;
  if($rest =~ s/force_ctx_zero//i) {
    $force_ctx_zero = 1;
  }
  if($rest =~ s/link\s*=\s*(\S+)//i) {
    $tsblinkname = lc $1;
  }
  if($rest =~ s/page_size\s*=\s*(\d+)//i) {
    $page_size = $1;
  }
  if($rest =~ s/way\s*=\s*(\d+)//i) {
    $way = $1;
  }
  if($rest =~ s/ttefmt\s*=(\S+)//i) {
    $ttefmt = lc $1;
    if($ttefmt ne 'sun4u' and $ttefmt ne 'sun4v') {
      fatal "Illegal ttefmt '$1' on TSB line line=$srcline, file=$srcfile.\n",
	M_TSBSYNTAX;
    }
  }

  my $this = $class->new
    (
     name            => $tsbname,
     tsblinkname     => $tsblinkname,
     config_register => $reg_bf,
     srcfile         => $srcfile_start,
     srcline         => $srcline_start,
     srcfilestop     => $srcfile,
     srclinestop     => $srcline,
    );


  $this->config_from_register($mmu);

  $this->{force_ctx_zero} = $force_ctx_zero if defined $force_ctx_zero;
  $this->{page_size}      = $page_size      if defined $page_size;
  $this->{ttefmt}         = $ttefmt         if defined $ttefmt;
  $this->{way}            = hex($way)       if defined $way;

  if($this->{is_split} and not defined $this->{way}) {
    fatal "TSB '$tsbname' is split but does not\n". 
      "  define way!\n" .
      "  line=$srcline, file=$srcfile.\n", M_TSBSYNTAX;
  }

  if(defined $this->{way} and not ($this->{way} == 0 or $this->{way} == 1)) {
    fatal "TSB '$tsbname' defines way that isn't\n".
      "  zero or one!\n".
      "  line=$srcline, file=$srcfile.\n", M_TSBSYNTAX;
  }

  if($this->{is_split} and $this->{way} == 1) {
    my $newBase = BitFieldTie->new($PASIZE, $this->{base});
    my $offset = $this->{numentries} * 16; # 16 bytes per entry
    $newBase->add($offset);
    $this->{base} = $newBase;
  }


  return $this;

}

###############################################################################

sub config_from_register {
  my $this = shift;
  my $mmu  = shift;

  my $base = BitFieldTie->new($PASIZE, $this->{config_register});
  $base->store(12, 0, 0); # zero out bits 12:0;

  $this->{base} = $base;
  $this->{sizebits} = $this->{config_register}->extract(3,0);
  $this->{is_split} = $this->{config_register}->extract(12);
  $this->{numentries} = 512 * (1 << $this->{sizebits});

  my $base_lo = 13 + $this->{sizebits};
  if($base_lo > 13) {
    my $overlap = $base->extract($base_lo, 13);

    if($overlap) {
      if($CONFIG{allow_misaligned_tsb_base}) {
	$base->store($base_lo, 13, 0);
      } else {
	fatal "TSB '$this->{name}' has base $base, which\n".
	  "   is misaligned for size=$this->{sizebits}\n" .
	  "   Illegal unless -allow_misalgined_tsb_base is defined.\n" .
	  "   line=$this->{srcline}, file=$this->{srcfile}\n",
	    M_TSBSYNTAX;
      }
    }

  }
}

###############################################################################

sub get_ttefmt {
  my $this = shift;

  return $this->{ttefmt} if defined $this->{ttefmt};
  return $CONFIG{ttefmt};
}

###############################################################################

sub touch {
  my $this = shift;
  $this->{touched} = 1;

  if(defined $this->{tsblinkobj}) {
    $this->{tsblinkobj}->touch();
  }
}

###############################################################################

sub is_touched {
  my $this = shift;
  return $this->{touched} || $CONFIG{gen_all_tsbs};
}

###############################################################################

sub is_force_ctx_zero {
  my $this = shift;
  return $this->{force_ctx_zero};
}

###############################################################################

sub get_tsblinkname {
  my $this = shift;
  return $this->{tsblinkname};
}

###############################################################################

sub set_tsblinkobj {
  my $this = shift;
  my $obj  = shift;
  $this->{tsblinkobj} = $obj;
}

###############################################################################

sub page_size {
  my $this = shift;
  return $this->{page_size};
}

###############################################################################

sub write_to_goldfinger_file {
  my $this = shift;
  my $ofh  = shift;
  my $indent = shift;

  $indent = '' unless defined $indent;

  print $ofh "${indent}TSB $this->{name}\n";
  print $ofh "${indent}  src_file    = \"$this->{srcfile}\";\n";
  print $ofh "${indent}  src_line    = $this->{srcline};\n";
  print $ofh "${indent}  start_addr  = 0x$this->{base};\n";
  print $ofh "${indent}  size_bits   = $this->{sizebits};\n";
  print $ofh "${indent}  split       = $this->{is_split};\n";
  print $ofh "${indent}  num_entries = $this->{numentries};\n";
  print $ofh "${indent}  link_area   = $this->{tsblinkname};\n"
    if defined $this->{tsblinkname};

  print $ofh "${indent}END TSB\n";
  print $ofh "\n";
}

###############################################################################


###############################################################################
###############################################################################

package Midas::TSBLink;
use strict;

use TRELoad 'BitFieldTie';
use Midas::Command;
use Midas::Error;
use Midas::Globals;

use fields qw(
	      name

	      base
	      touched
	      length

	      srcline
	      srcfile
	      srclinestop
	      srcfilestop

	     );

###############################################################################

sub new {
  my $this = shift;
  my %args = @_;

  unless (ref $this) {
    $this = fields::new($this);
  }

  $this->{touched} = 0;

  foreach my $key (keys %args) {
    $this->{$key} = $args{$key};
  }

  return $this;
}

###############################################################################

sub new_from_line {
  my $class = shift;
  my $startline = shift;
  my $fh        = shift;
  my $srcfile   = shift;
  my $srcline   = shift;
  my $mmu       = shift;

  my $srcfile_start = $srcfile;
  my $srcline_start = $srcline;

  local ($_);
  $_ = $startline;


  while($_ =~ /\\$/) {
    $_ =~ s/\\\n$/ /;
    $_ .= <$fh>;
    $srcline++;
  }


  fatal "Badly formatted TSB_LINK line=$srcline, file=$srcfile:\n$_",
    M_TSBSYNTAX
    unless /^\s*MIDAS_TSB_LINK\s*(\S+)\s*((0[xX])?([\da-fA-F]+))\s*$/;

  my $tsblinkname = lc $1;
  my $addr = $2;

  my $addr_bf = string2bf($addr, $PASIZE);
  fatal "TSB_LINK addr '$addr' is not a number at ".
    "file=$srcfile, line=$srcline\n", M_NOTNUM unless defined $addr_bf;

  my $this = Midas::TSBLink->new
    (
     name         => $tsblinkname,
     base         => $addr_bf,
     srcfile      => $srcfile_start,
     srcline      => $srcline_start,
     srcfilestop  => $srcfile,
     srclinestop  => $srcline,
    );


  return $this;
}

###############################################################################

sub touch {
  my $this = shift;
  $this->{touched} = 1;
}

###############################################################################

sub is_touched {
  my $this = shift;
  return $this->{touched} || $CONFIG{gen_all_tsbs};
}

###############################################################################

sub set_len {
  my $this = shift;
  my $length_bf = shift;

  $this->{length} = $length_bf;
}

###############################################################################

sub write_to_goldfinger_file {
  my $this = shift;
  my $ofh  = shift;
  my $indent = shift;

  $indent = '' unless defined $indent;

  print $ofh "${indent}TSB_LINK $this->{name}\n";
  print $ofh "${indent}  src_file    = \"$this->{srcfile}\";\n";
  print $ofh "${indent}  src_line    = $this->{srcline};\n";
  print $ofh "${indent}  start_addr  = 0x$this->{base};\n";
  print $ofh "${indent}END TSB_LINK\n";
  print $ofh "\n";
}

###############################################################################

###############################################################################
1;
Commit	Line	Data
86530b38 AT	1	# ========== Copyright Header Begin ==========================================
	2	#
	3	# OpenSPARC T2 Processor File: TSB.pm
	4	# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
	5	# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
	6	#
	7	# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
	8	#
	9	# This program is free software; you can redistribute it and/or modify
	10	# it under the terms of the GNU General Public License as published by
	11	# the Free Software Foundation; version 2 of the License.
	12	#
	13	# This program is distributed in the hope that it will be useful,
	14	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	# GNU General Public License for more details.
	17	#
	18	# You should have received a copy of the GNU General Public License
	19	# along with this program; if not, write to the Free Software
	20	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	21	#
	22	# For the avoidance of doubt, and except that if any non-GPL license
	23	# choice is available it will apply instead, Sun elects to use only
	24	# the General Public License version 2 (GPLv2) at this time for any
	25	# software where a choice of GPL license versions is made
	26	# available with the language indicating that GPLv2 or any later version
	27	# may be used, or where a choice of which version of the GPL is applied is
	28	# otherwise unspecified.
	29	#
	30	# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara,
	31	# CA 95054 USA or visit www.sun.com if you need additional information or
	32	# have any questions.
	33	#
	34	# ========== Copyright Header End ============================================
	35	# -- perl --
	36
	37	package Midas::TSB;
	38	use strict;
	39
	40	use TRELoad 'BitFieldTie';
	41	use Midas::Command;
	42	use Midas::Error;
	43	use Midas::Globals;
	44	use Midas::MMU;
	45
	46	use fields qw(
	47	name
	48	config_register
	49
	50	base
	51	sizebits
	52	is_split
	53	numentries
	54	page_size
	55
	56	tsblinkname
	57	tsblinkobj
	58	force_ctx_zero
	59	ttefmt
	60	way
	61
	62	srcline
	63	srcfile
	64	srclinestop
65	srcfilestop
66
67	touched
68	length
69	);
70
71	###############################################################################
72
73	sub new {
74	my $this = shift;
75	my %args = @_;
76
77	unless (ref $this) {
78	$this = fields::new($this);
79	}
80
81	$this->{touched} = 0;
82	$this->{force_ctx_zero} = undef;
83	$this->{page_size} = undef;
84	$this->{way} = undef;
85
86	foreach my $key (keys %args) {
87	$this->{$key} = $args{$key};
88	}
89
90	return $this;
91	}
92
93	###############################################################################
94
95	sub new_from_line {
96	my $class = shift;
97	my $startline = shift;
98	my $fh = shift;
99	my $srcfile = shift;
100	my $srcline = shift;
101	my $mmu = shift;
102
103	my $srcfile_start = $srcfile;
104	my $srcline_start = $srcline;
105
106	local ($_);
107	$_ = $startline;
108
109
110	fatal "Badly formatted TSB line=$srcline, file=$srcfile:\n$_", M_TSBSYNTAX
111	unless /^\sMIDAS_TSB\s(\S+)\s((0[xX])?([\da-fA-F]+))\s(.)\s$/;
112
113	my $tsbname = lc $1;
114	my $register = $2;
115	my $rest = $5;
116
117	my $reg_bf = string2bf($register, 64);
118	fatal "TSB config register '$register' is not a number at file=$srcfile, line=$srcline\n", M_NOTNUM unless defined $reg_bf;
119
120
121	my $force_ctx_zero = undef;
122	my $page_size = undef;
123	my $ttefmt = undef;
124	my $way = undef;
125	my $tsblinkname;
126	if($rest =~ s/force_ctx_zero//i) {
127	$force_ctx_zero = 1;
128	}
129	if($rest =~ s/link\s=\s(\S+)//i) {
130	$tsblinkname = lc $1;
131	}
132	if($rest =~ s/page_size\s=\s(\d+)//i) {
133	$page_size = $1;
134	}
135	if($rest =~ s/way\s=\s(\d+)//i) {
136	$way = $1;
137	}
138	if($rest =~ s/ttefmt\s*=(\S+)//i) {
139	$ttefmt = lc $1;
140	if($ttefmt ne 'sun4u' and $ttefmt ne 'sun4v') {
141	fatal "Illegal ttefmt '$1' on TSB line line=$srcline, file=$srcfile.\n",
142	M_TSBSYNTAX;
143	}
144	}
145
146	my $this = $class->new
147	(
148	name => $tsbname,
149	tsblinkname => $tsblinkname,
150	config_register => $reg_bf,
151	srcfile => $srcfile_start,
152	srcline => $srcline_start,
153	srcfilestop => $srcfile,
154	srclinestop => $srcline,
155	);
156
157
158	$this->config_from_register($mmu);
159
160	$this->{force_ctx_zero} = $force_ctx_zero if defined $force_ctx_zero;
161	$this->{page_size} = $page_size if defined $page_size;
162	$this->{ttefmt} = $ttefmt if defined $ttefmt;
163	$this->{way} = hex($way) if defined $way;
164
165	if($this->{is_split} and not defined $this->{way}) {
166	fatal "TSB '$tsbname' is split but does not\n".
167	" define way!\n" .
168	" line=$srcline, file=$srcfile.\n", M_TSBSYNTAX;
169	}
170
171	if(defined $this->{way} and not ($this->{way} == 0 or $this->{way} == 1)) {
172	fatal "TSB '$tsbname' defines way that isn't\n".
173	" zero or one!\n".
174	" line=$srcline, file=$srcfile.\n", M_TSBSYNTAX;
175	}
176
177	if($this->{is_split} and $this->{way} == 1) {
178	my $newBase = BitFieldTie->new($PASIZE, $this->{base});
179	my $offset = $this->{numentries} * 16; # 16 bytes per entry
180	$newBase->add($offset);
181	$this->{base} = $newBase;
182	}
183
184
185	return $this;
186
187	}
188
189	###############################################################################
190
191	sub config_from_register {
192	my $this = shift;
193	my $mmu = shift;
194
195	my $base = BitFieldTie->new($PASIZE, $this->{config_register});
196	$base->store(12, 0, 0); # zero out bits 12:0;
197
198	$this->{base} = $base;
199	$this->{sizebits} = $this->{config_register}->extract(3,0);
200	$this->{is_split} = $this->{config_register}->extract(12);
201	$this->{numentries} = 512 * (1 << $this->{sizebits});
202
203	my $base_lo = 13 + $this->{sizebits};
204	if($base_lo > 13) {
205	my $overlap = $base->extract($base_lo, 13);
206
207	if($overlap) {
208	if($CONFIG{allow_misaligned_tsb_base}) {
209	$base->store($base_lo, 13, 0);
210	} else {
211	fatal "TSB '$this->{name}' has base $base, which\n".
212	" is misaligned for size=$this->{sizebits}\n" .
213	" Illegal unless -allow_misalgined_tsb_base is defined.\n" .
214	" line=$this->{srcline}, file=$this->{srcfile}\n",
215	M_TSBSYNTAX;
216	}
217	}
218
219	}
220	}
221
222	###############################################################################
223
224	sub get_ttefmt {
225	my $this = shift;
226
227	return $this->{ttefmt} if defined $this->{ttefmt};
228	return $CONFIG{ttefmt};
229	}
230
231	###############################################################################
232
233	sub touch {
234	my $this = shift;
235	$this->{touched} = 1;
236
237	if(defined $this->{tsblinkobj}) {
238	$this->{tsblinkobj}->touch();
239	}
240	}
241
242	###############################################################################
243
244	sub is_touched {
245	my $this = shift;
246	return $this->{touched} \|\| $CONFIG{gen_all_tsbs};
247	}
248
249	###############################################################################
250
251	sub is_force_ctx_zero {
252	my $this = shift;
253	return $this->{force_ctx_zero};
254	}
255
256	###############################################################################
257
258	sub get_tsblinkname {
259	my $this = shift;
260	return $this->{tsblinkname};
261	}
262
263	###############################################################################
264
265	sub set_tsblinkobj {
266	my $this = shift;
267	my $obj = shift;
268	$this->{tsblinkobj} = $obj;
269	}
270
271	###############################################################################
272
273	sub page_size {
274	my $this = shift;
275	return $this->{page_size};
276	}
277
278	###############################################################################
279
280	sub write_to_goldfinger_file {
281	my $this = shift;
282	my $ofh = shift;
283	my $indent = shift;
284
285	$indent = '' unless defined $indent;
286
287	print $ofh "${indent}TSB $this->{name}\n";
288	print $ofh "${indent} src_file = \"$this->{srcfile}\";\n";
289	print $ofh "${indent} src_line = $this->{srcline};\n";
290	print $ofh "${indent} start_addr = 0x$this->{base};\n";
291	print $ofh "${indent} size_bits = $this->{sizebits};\n";
292	print $ofh "${indent} split = $this->{is_split};\n";
293	print $ofh "${indent} num_entries = $this->{numentries};\n";
294	print $ofh "${indent} link_area = $this->{tsblinkname};\n"
295	if defined $this->{tsblinkname};
296
297	print $ofh "${indent}END TSB\n";
298	print $ofh "\n";
299	}
300
301	###############################################################################
302
303
304	###############################################################################
305	###############################################################################
306
307	package Midas::TSBLink;
308	use strict;
309
310	use TRELoad 'BitFieldTie';
311	use Midas::Command;
312	use Midas::Error;
313	use Midas::Globals;
314
315	use fields qw(
316	name
317
318	base
319	touched
320	length
321
322	srcline
323	srcfile
324	srclinestop
325	srcfilestop
326
327	);
328
329	###############################################################################
330
331	sub new {
332	my $this = shift;
333	my %args = @_;
334
335	unless (ref $this) {
336	$this = fields::new($this);
337	}
338
339	$this->{touched} = 0;
340
341	foreach my $key (keys %args) {
342	$this->{$key} = $args{$key};
343	}
344
345	return $this;
346	}
347
348	###############################################################################
349
350	sub new_from_line {
351	my $class = shift;
352	my $startline = shift;
353	my $fh = shift;
354	my $srcfile = shift;
355	my $srcline = shift;
356	my $mmu = shift;
357
358	my $srcfile_start = $srcfile;
359	my $srcline_start = $srcline;
360
361	local ($_);
362	$_ = $startline;
363
364
365	while($_ =~ /\\$/) {
366	$_ =~ s/\\\n$/ /;
367	$_ .= <$fh>;
368	$srcline++;
369	}
370
371
372	fatal "Badly formatted TSB_LINK line=$srcline, file=$srcfile:\n$_",
373	M_TSBSYNTAX
374	unless /^\sMIDAS_TSB_LINK\s(\S+)\s((0[xX])?([\da-fA-F]+))\s$/;
375
376	my $tsblinkname = lc $1;
377	my $addr = $2;
378
379	my $addr_bf = string2bf($addr, $PASIZE);
380	fatal "TSB_LINK addr '$addr' is not a number at ".
381	"file=$srcfile, line=$srcline\n", M_NOTNUM unless defined $addr_bf;
382
383	my $this = Midas::TSBLink->new
384	(
385	name => $tsblinkname,
386	base => $addr_bf,
387	srcfile => $srcfile_start,
388	srcline => $srcline_start,
389	srcfilestop => $srcfile,
390	srclinestop => $srcline,
391	);
392
393
394	return $this;
395	}
396
397	###############################################################################
398
399	sub touch {
400	my $this = shift;
401	$this->{touched} = 1;
402	}
403
404	###############################################################################
405
406	sub is_touched {
407	my $this = shift;
408	return $this->{touched} \|\| $CONFIG{gen_all_tsbs};
409	}
410
411	###############################################################################
412
413	sub set_len {
414	my $this = shift;
415	my $length_bf = shift;
416
417	$this->{length} = $length_bf;
418	}
419
420	###############################################################################
421
422	sub write_to_goldfinger_file {
423	my $this = shift;
424	my $ofh = shift;
425	my $indent = shift;
426
427	$indent = '' unless defined $indent;
428
429	print $ofh "${indent}TSB_LINK $this->{name}\n";
430	print $ofh "${indent} src_file = \"$this->{srcfile}\";\n";
431	print $ofh "${indent} src_line = $this->{srcline};\n";
432	print $ofh "${indent} start_addr = 0x$this->{base};\n";
433	print $ofh "${indent}END TSB_LINK\n";
434	print $ofh "\n";
435	}
436
437	###############################################################################
438
439	###############################################################################
440	1;