[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Midas_samy / TSB.pm

# -*- 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	# -- perl --
	2
	3	package Midas::TSB;
	4	use strict;
	5
	6	use TRELoad 'BitFieldTie';
	7	use Midas::Command;
	8	use Midas::Error;
	9	use Midas::Globals;
	10	use Midas::MMU;
	11
	12	use fields qw(
	13	name
	14	config_register
	15
	16	base
	17	sizebits
	18	is_split
	19	numentries
	20	page_size
	21
	22	tsblinkname
	23	tsblinkobj
	24	force_ctx_zero
	25	ttefmt
	26	way
	27
	28	srcline
	29	srcfile
	30	srclinestop
	31	srcfilestop
	32
	33	touched
	34	length
	35	);
	36
	37	###############################################################################
	38
	39	sub new {
	40	my $this = shift;
	41	my %args = @_;
	42
	43	unless (ref $this) {
	44	$this = fields::new($this);
	45	}
	46
	47	$this->{touched} = 0;
	48	$this->{force_ctx_zero} = undef;
	49	$this->{page_size} = undef;
	50	$this->{way} = undef;
	51
	52	foreach my $key (keys %args) {
	53	$this->{$key} = $args{$key};
	54	}
	55
	56	return $this;
	57	}
	58
	59	###############################################################################
	60
	61	sub new_from_line {
	62	my $class = shift;
	63	my $startline = shift;
	64	my $fh = shift;
65	my $srcfile = shift;
66	my $srcline = shift;
67	my $mmu = shift;
68
69	my $srcfile_start = $srcfile;
70	my $srcline_start = $srcline;
71
72	local ($_);
73	$_ = $startline;
74
75
76	fatal "Badly formatted TSB line=$srcline, file=$srcfile:\n$_", M_TSBSYNTAX
77	unless /^\sMIDAS_TSB\s(\S+)\s((0[xX])?([\da-fA-F]+))\s(.)\s$/;
78
79	my $tsbname = lc $1;
80	my $register = $2;
81	my $rest = $5;
82
83	my $reg_bf = string2bf($register, 64);
84	fatal "TSB config register '$register' is not a number at file=$srcfile, line=$srcline\n", M_NOTNUM unless defined $reg_bf;
85
86
87	my $force_ctx_zero = undef;
88	my $page_size = undef;
89	my $ttefmt = undef;
90	my $way = undef;
91	my $tsblinkname;
92	if($rest =~ s/force_ctx_zero//i) {
93	$force_ctx_zero = 1;
94	}
95	if($rest =~ s/link\s=\s(\S+)//i) {
96	$tsblinkname = lc $1;
97	}
98	if($rest =~ s/page_size\s=\s(\d+)//i) {
99	$page_size = $1;
100	}
101	if($rest =~ s/way\s=\s(\d+)//i) {
102	$way = $1;
103	}
104	if($rest =~ s/ttefmt\s*=(\S+)//i) {
105	$ttefmt = lc $1;
106	if($ttefmt ne 'sun4u' and $ttefmt ne 'sun4v') {
107	fatal "Illegal ttefmt '$1' on TSB line line=$srcline, file=$srcfile.\n",
108	M_TSBSYNTAX;
109	}
110	}
111
112	my $this = $class->new
113	(
114	name => $tsbname,
115	tsblinkname => $tsblinkname,
116	config_register => $reg_bf,
117	srcfile => $srcfile_start,
118	srcline => $srcline_start,
119	srcfilestop => $srcfile,
120	srclinestop => $srcline,
121	);
122
123
124	$this->config_from_register($mmu);
125
126	$this->{force_ctx_zero} = $force_ctx_zero if defined $force_ctx_zero;
127	$this->{page_size} = $page_size if defined $page_size;
128	$this->{ttefmt} = $ttefmt if defined $ttefmt;
129	$this->{way} = hex($way) if defined $way;
130
131	if($this->{is_split} and not defined $this->{way}) {
132	fatal "TSB '$tsbname' is split but does not\n".
133	" define way!\n" .
134	" line=$srcline, file=$srcfile.\n", M_TSBSYNTAX;
135	}
136
137	if(defined $this->{way} and not ($this->{way} == 0 or $this->{way} == 1)) {
138	fatal "TSB '$tsbname' defines way that isn't\n".
139	" zero or one!\n".
140	" line=$srcline, file=$srcfile.\n", M_TSBSYNTAX;
141	}
142
143	if($this->{is_split} and $this->{way} == 1) {
144	my $newBase = BitFieldTie->new($PASIZE, $this->{base});
145	my $offset = $this->{numentries} * 16; # 16 bytes per entry
146	$newBase->add($offset);
147	$this->{base} = $newBase;
148	}
149
150
151	return $this;
152
153	}
154
155	###############################################################################
156
157	sub config_from_register {
158	my $this = shift;
159	my $mmu = shift;
160
161	my $base = BitFieldTie->new($PASIZE, $this->{config_register});
162	$base->store(12, 0, 0); # zero out bits 12:0;
163
164	$this->{base} = $base;
165	$this->{sizebits} = $this->{config_register}->extract(3,0);
166	$this->{is_split} = $this->{config_register}->extract(12);
167	$this->{numentries} = 512 * (1 << $this->{sizebits});
168
169	my $base_lo = 13 + $this->{sizebits};
170	if($base_lo > 13) {
171	my $overlap = $base->extract($base_lo, 13);
172
173	if($overlap) {
174	if($CONFIG{allow_misaligned_tsb_base}) {
175	$base->store($base_lo, 13, 0);
176	} else {
177	fatal "TSB '$this->{name}' has base $base, which\n".
178	" is misaligned for size=$this->{sizebits}\n" .
179	" Illegal unless -allow_misalgined_tsb_base is defined.\n" .
180	" line=$this->{srcline}, file=$this->{srcfile}\n",
181	M_TSBSYNTAX;
182	}
183	}
184
185	}
186	}
187
188	###############################################################################
189
190	sub get_ttefmt {
191	my $this = shift;
192
193	return $this->{ttefmt} if defined $this->{ttefmt};
194	return $CONFIG{ttefmt};
195	}
196
197	###############################################################################
198
199	sub touch {
200	my $this = shift;
201	$this->{touched} = 1;
202
203	if(defined $this->{tsblinkobj}) {
204	$this->{tsblinkobj}->touch();
205	}
206	}
207
208	###############################################################################
209
210	sub is_touched {
211	my $this = shift;
212	return $this->{touched} \|\| $CONFIG{gen_all_tsbs};
213	}
214
215	###############################################################################
216
217	sub is_force_ctx_zero {
218	my $this = shift;
219	return $this->{force_ctx_zero};
220	}
221
222	###############################################################################
223
224	sub get_tsblinkname {
225	my $this = shift;
226	return $this->{tsblinkname};
227	}
228
229	###############################################################################
230
231	sub set_tsblinkobj {
232	my $this = shift;
233	my $obj = shift;
234	$this->{tsblinkobj} = $obj;
235	}
236
237	###############################################################################
238
239	sub page_size {
240	my $this = shift;
241	return $this->{page_size};
242	}
243
244	###############################################################################
245
246	sub write_to_goldfinger_file {
247	my $this = shift;
248	my $ofh = shift;
249	my $indent = shift;
250
251	$indent = '' unless defined $indent;
252
253	print $ofh "${indent}TSB $this->{name}\n";
254	print $ofh "${indent} src_file = \"$this->{srcfile}\";\n";
255	print $ofh "${indent} src_line = $this->{srcline};\n";
256	print $ofh "${indent} start_addr = 0x$this->{base};\n";
257	print $ofh "${indent} size_bits = $this->{sizebits};\n";
258	print $ofh "${indent} split = $this->{is_split};\n";
259	print $ofh "${indent} num_entries = $this->{numentries};\n";
260	print $ofh "${indent} link_area = $this->{tsblinkname};\n"
261	if defined $this->{tsblinkname};
262
263	print $ofh "${indent}END TSB\n";
264	print $ofh "\n";
265	}
266
267	###############################################################################
268
269
270	###############################################################################
271	###############################################################################
272
273	package Midas::TSBLink;
274	use strict;
275
276	use TRELoad 'BitFieldTie';
277	use Midas::Command;
278	use Midas::Error;
279	use Midas::Globals;
280
281	use fields qw(
282	name
283
284	base
285	touched
286	length
287
288	srcline
289	srcfile
290	srclinestop
291	srcfilestop
292
293	);
294
295	###############################################################################
296
297	sub new {
298	my $this = shift;
299	my %args = @_;
300
301	unless (ref $this) {
302	$this = fields::new($this);
303	}
304
305	$this->{touched} = 0;
306
307	foreach my $key (keys %args) {
308	$this->{$key} = $args{$key};
309	}
310
311	return $this;
312	}
313
314	###############################################################################
315
316	sub new_from_line {
317	my $class = shift;
318	my $startline = shift;
319	my $fh = shift;
320	my $srcfile = shift;
321	my $srcline = shift;
322	my $mmu = shift;
323
324	my $srcfile_start = $srcfile;
325	my $srcline_start = $srcline;
326
327	local ($_);
328	$_ = $startline;
329
330
331	while($_ =~ /\\$/) {
332	$_ =~ s/\\\n$/ /;
333	$_ .= <$fh>;
334	$srcline++;
335	}
336
337
338	fatal "Badly formatted TSB_LINK line=$srcline, file=$srcfile:\n$_",
339	M_TSBSYNTAX
340	unless /^\sMIDAS_TSB_LINK\s(\S+)\s((0[xX])?([\da-fA-F]+))\s$/;
341
342	my $tsblinkname = lc $1;
343	my $addr = $2;
344
345	my $addr_bf = string2bf($addr, $PASIZE);
346	fatal "TSB_LINK addr '$addr' is not a number at ".
347	"file=$srcfile, line=$srcline\n", M_NOTNUM unless defined $addr_bf;
348
349	my $this = Midas::TSBLink->new
350	(
351	name => $tsblinkname,
352	base => $addr_bf,
353	srcfile => $srcfile_start,
354	srcline => $srcline_start,
355	srcfilestop => $srcfile,
356	srclinestop => $srcline,
357	);
358
359
360	return $this;
361	}
362
363	###############################################################################
364
365	sub touch {
366	my $this = shift;
367	$this->{touched} = 1;
368	}
369
370	###############################################################################
371
372	sub is_touched {
373	my $this = shift;
374	return $this->{touched} \|\| $CONFIG{gen_all_tsbs};
375	}
376
377	###############################################################################
378
379	sub set_len {
380	my $this = shift;
381	my $length_bf = shift;
382
383	$this->{length} = $length_bf;
384	}
385
386	###############################################################################
387
388	sub write_to_goldfinger_file {
389	my $this = shift;
390	my $ofh = shift;
391	my $indent = shift;
392
393	$indent = '' unless defined $indent;
394
395	print $ofh "${indent}TSB_LINK $this->{name}\n";
396	print $ofh "${indent} src_file = \"$this->{srcfile}\";\n";
397	print $ofh "${indent} src_line = $this->{srcline};\n";
398	print $ofh "${indent} start_addr = 0x$this->{base};\n";
399	print $ofh "${indent}END TSB_LINK\n";
400	print $ofh "\n";
401	}
402
403	###############################################################################
404
405	###############################################################################
406	1;