diff options
Diffstat (limited to 'macros/latex/contrib/register/Reg_macro.pm')
-rw-r--r-- | macros/latex/contrib/register/Reg_macro.pm | 498 |
1 files changed, 498 insertions, 0 deletions
diff --git a/macros/latex/contrib/register/Reg_macro.pm b/macros/latex/contrib/register/Reg_macro.pm new file mode 100644 index 0000000000..5c00bc805e --- /dev/null +++ b/macros/latex/contrib/register/Reg_macro.pm @@ -0,0 +1,498 @@ +############################################################################### +# +# File: Reg_macro.pm +# Description: Module for parsing register macros from LaTeX documentation +# Author: Matthew Lovell +# Created: Mon Mar 31 16:50:05 2003 +# Modified: Sat May 19 09:33:20 2018 +# Language: CPerl +# +# (C) Copyright 2003, Matthew Lovell, all rights reserved. +# +############################################################################### + +=pod + +=head1 NAME + +Reg_macro.pm + +=head1 SYNOPSIS + +Parses register/CSR information from LaTeX files. + +=head1 DESCRIPTION + +After searching through a files input/include tree, this module will search +for all \begin{register} macros. All available information will be parsed +out of each encountered macro. Parsed information includes: + + register name + function + offset + field names, positions, and widths + register reset value + register reset mask + register write mask + +The parsed information can either be used either to produce in-order +tables for inclusion in documentation or to provide CSR information to +Phase 1 tools (metacheckers, CSR checkers, etc). + +=head1 PUBLIC ROUTINES + + get_tex_files() Recursively follow a file's input/include/import tree + + get_regs() Parse CSR information from a single specified file + + build_reg_hash() Build a multi-level hash, keyed by function and + offset, from the specified register information + +=head1 SEE ALSO + +Any project-specific LaTeX introductory material. + + +=head1 AUTHOR + +Matthew Lovell (lovells@gmail.com) + +=cut + +############################################################################### + +package Reg_macro; +use Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(get_tex_files + get_regs + build_reg_hash + $REG_DEBUG + $REG_STRIDE + $REG_ERRORS + ); + +use FileHandle; +use Data::Dumper; + +# Debug flag +$REG_DEBUG = 0; + +# How large are registers? Default is 64-bits. +$REG_STRIDE = hex(0x08); + +# Error count +$REG_ERRORS = 0; + +############################################################################### +# P U B L I C R O U T I N E S # +############################################################################### + + + + +# Read a .tex file line by line, finding all \include or \input +# commands. Recurse upon encountering one of those, thus making +# a list of the entire TeX file tree. +# +# This subroutine can also be called with an option indicating that +# all \includegraphics targets should be parsed. With that option, +# this routine can extract all dependencies for a LaTeX file, which +# is useful for GNU make. +# +# Arguments: filename +# flag indicating all dependencies should be tracked +# +sub get_tex_files { + my ($filename, $all_files) = @_; + + # return immediately for some file types + if ($filename =~ /\.(eps|pdf|ps|func|error)$/) { + print "#INFO Reg_macro Not attempting to read '$filename'\n" if ($REG_DEBUG); + return $filename; + } + + my $path = dirname($filename); + + # Add .tex if not present + if ($filename !~ /\.\w+$/) { + $filename .= '.tex'; + } + + # initialize file list + my @file_list = ($filename); + + my $file = new FileHandle "$filename"; + unless (defined $file) { + print STDERR "#ERROR Reg_macro Unable to open '$filename'\n"; + $REG_ERRORS++; + return @file_list; + } + + # Allow files to turn off dependency extraction in particular sections, + # when desired. This may be useful if a preamble needs to input a file + # from the texmf tree, for example. + my $dependency_skip = 0; + + while (<$file>) { + + $dependency_skip = 1 if (m/^%% DEPEND OFF/); + $dependency_skip = 0 if (m/^%% DEPEND ON/); + next if $dependency_skip; + + # Skip over comments. + s/^%.*$//; # Remove whole comment lines + s/([^\\])%.*$/$1/; # Remove everything after unescaped %'s + + + # Get all include and input commands + my @list = m/\\(?:include|input)\{([\w\/.-]+)\}/g; + if ($path ne '' and $path ne '.') { + @list = map { $path . "/" . $_ } @list; + } + + # Find any import commands + if (m|\\import\{([\w\/.-]+)}\{([\w\/.-]+)\}|) { + push(@list,$1.$2); + } + + # Find ALL files for make dependencies + if ($all_files) { + + # Graphics files + if (m|\\includegraphics(?:\[.*?\])?\{([\w\/.-]+)\}|) { + + # Add .eps if not present + my $gfx_file = $1; + if ($gfx_file !~ /\.\w+$/) { + $gfx_file .= '.eps'; + } + + if ($path ne '' and $path ne '.') { + $gfx_file = $path . "/" . $gfx_file; + } + + push(@list,$gfx_file); + } + + + # project-specific: + # + # CSR files (just look for the \CSRtable invocation) + if (m|\\CSRtable|) { + my $func_file; + ($func_file = $filename) =~ s/\.tex$/.func/; + push(@list, $func_file); + } + + + } # end all_files + + my $subfile; + for $subfile (@list) { + push(@file_list, get_tex_files($subfile, $all_files)); + } + } + + return @file_list; +} # get_tex_files + + + + +# Read a .tex file line by line, looking for register declarations +# using the register.sty macro. This subroutine only examines +# a single file. +# +# Arguments: filename +# reference to array of register information +# +sub get_regs { + my ($filename, $reg_data) = @_; + + my $file = new FileHandle "$filename"; + + # Record the function in which a register resides. Allow this to + # be defined for just the first register in a file, then carried + # over to all the others. + my $function = 0; + + while (<$file>) { + # find register definition + if ( m/\\begin\{register\}\{[\w\!]+\}\{(.*)\}\{(.*)\}%(.*)$/ ) { + my $long_name = $1; + my $offset = $2; + my $testable = 1; + my $short_name = undef; + + my $remainder = $3; + + if ($remainder ne "") { + if ($remainder =~ /don\'?t(_| )test/i) { $testable = 0 } + if ($remainder =~ /NAME=([\w\\<>\d]+)/i) { $short_name = $1 } + if ($remainder =~ /func=(\d)/i) { $function = $1 } + if ($remainder =~ /off(?:set)?=([\w-,g]+)/) { $offset = $1 } + } + + # get rid of escaped underscores + $long_name =~ s/\\_/_/g; + $short_name =~ s/\\_/_/g; + + my $width = 0; + my $reg = { + long_name => $long_name, + short_name => $short_name, + function => $function, + offset => $offset, + testable => $testable, + fields => [] + }; + + + # now we need to extract fields. first, + # read in rest of the reg macro + @wholereg = (); + while (<$file>) { + push(@wholereg, $_); + last if (/\\end\{register\}/); + } + + + # combine lines if nested {}'s do not match + for (my $i = 0; $i <= $#wholereg; $i++) { + my $open = grep(/\{/, split(//, $wholereg[$i])); + my $close = grep(/\}/, split(//, $wholereg[$i])); + + if ($open != $close) { + my ($next) = splice(@wholereg, $i+1, 1); + $wholereg[$i] .= $next; + redo; + } + } + + foreach (@wholereg) { + + if (m/\\label\{(.*)\}/) { + $reg->{label} = $1; + } + + # normal register field (reset value specified) + if ( m/\\regfield\{(.*)\}\s*\{(.*)\}\s*\{(.*)\}\s*\{(.*)\}\s*%(.*)$/s ) { + my $remain = $5; + my $field_name = $1; + my $field_len = $2; + my $field_start = $3; + my $reset = $4; $reset =~ s/^\{//; $reset =~ s/\}$//; $reset =~ s/_//g; + my $reset_mask = $testable; # indicates field is deterministic after reset + my $write_mask = $testable; # indicates field is modified by regbus writes + + + if ($field_name =~ m/\{([\w ])\}$/) { + $field_name = $1; + } + $field_name =~ s/\\_/_/g; + + + if ($remain =~ /read(?:_| )only/i) { $write_mask = 0; } + if ($remain =~ /status/i) { $reset_mask = 0; $write_mask = 0; } + if ($field_name =~ /reserved/i) { $write_mask = 0; } + + + if ($field_len > 32) { + die "#ERROR Reg_macro Field of greater than 32 bits in $short_name!\n"; + } + + push(@{$reg->{fields}}, + { + name => $field_name, + len => $field_len, + start => $field_start, + reset => $reset, + reset_mask => $reset_mask, + write_mask => $write_mask + }); + } + + + # register field without reset + if ( m/\\regfieldb\{(.*)\}\s*\{(.*)\}\s*\{(.*)\}\s*%(.*)$/s ) { + my $remain = $4; + my $field_name = $1; + my $field_len = $2; + my $field_start = $3; + my $reset_mask = $testable; # indicates field is deterministic after reset + my $write_mask = $testable; # indicates field is modified by regbus writes + + + if ($field_name =~ m/\{([\w ])\}$/) { + $field_name = $1; + } + $field_name =~ s/\\_/_/g; + + if ($remain =~ /read(?:_| )only/i) { $write_mask = 0; } + if ($remain =~ /status/i) { $reset_mask = 0; $write_mask = 0; } + if ($field_name =~ /reserved/i) { $write_mask = 0; } + + if ($field_len > 32) { + die "#ERROR Reg_macro Field of greater than 32 bits in $short_name!\n"; + } + + push(@{$reg->{fields}}, + { + name => $field_name, + len => $field_len, + start => $field_start, + reset_mask => $reset_mask, + write_mask => $write_mask + }); + } + + + } # end of register macro found + + print Dumper $reg if ($REG_DEBUG); + push(@$reg_data, $reg); + + } + } + +} # get_regs + + + +# Build a hash of registers, keyed on function and offset. That is, +# given parsed register information, construct a hash with the +# following structure +# +# $reg_hash { function } { offset } +# +# This will enable loops that iterate through registers in offset order +# +# Arguments: reference to array of reg information from get_regs +# Returns: reference to constructed hash +# +sub build_reg_hash { + my ($reg_array) = @_; + my $reg_hash = {}; + + my $unknown_count = 0; + + # iterate through all defined registers + foreach my $reg (@$reg_array) { + + if ($reg->{offset} =~ m/^(0x[0-9A-F]+)$/i) { + # simple offset specified + my $offset = $1; + + if (exists $reg_hash->{$reg->{function}}{$offset}) { + print STDERR "##ERROR Reg_macro A Collision at offset $offset of function $reg->{function} \n"; + print STDERR " Existing register: " . $reg_hash->{$reg->{function}}{$offset}{long_name} . "\n"; + print STDERR " New register: " . $reg->{long_name} . "\n"; + print STDERR "#END\n"; + $REG_ERRORS++; + } + + $reg_hash->{$reg->{function}}{$offset} = $reg; + + } elsif ($reg->{offset} =~ m/^(0x[0-9A-F]+)\s*-+\s*(0x[0-9A-F]+)/i) { + + # range specified. + my $start = hex($1); + my $end = hex($2); + + # determine stride + my $stride = $REG_STRIDE; + if ($reg->{offset} =~ m/,((?:0x)?[0-9A-F]+)/) { + $stride = hex($1); + } + + my $count = 0; + for (my $index = $start; $index <= $end; $index += $stride) { + + my $offset = sprintf("0x%03x",$index); + + if (exists $reg_hash->{$reg->{function}}{$offset}) { + print STDERR "##ERROR Reg_macro Collision at offset $offset of function $reg->{function} \n"; + print STDERR " Existing register: " . $reg_hash->{$reg->{function}}{$offset}{long_name} . "\n"; + print STDERR " New register: " . $reg->{long_name} . "\n"; + print STDERR "#END\n"; + $REG_ERRORS++; + } + + # perform any substitutions in long_name + my $reg_copy = { %{$reg} }; + if ($reg_copy->{long_name} =~ m/<n>/) { + $reg_copy->{long_name} =~ s/<n>/$count/; + } else { + $reg_copy->{long_name} .= " $count"; + } + + # perform any substitutions in short_name + if ($reg_copy->{short_name} =~ m/<n>/) { + $reg_copy->{short_name} =~ s/<n>/$count/; + } else { + $reg_copy->{short_name} .= "$count"; + } + + $reg_hash->{$reg->{function}}{$offset} = $reg_copy; + $count++; + } + + } else { + # unknown offset + $reg_hash->{$reg->{function}}{"unk".$unknown_count++} = $reg; + print STDERR "#WARNING Reg_macro Register '$reg->{long_name}' has an unknown offset \n"; + } + + } # end foreach + + return $reg_hash; +} # build_reg_hash + + + +# Convert an ASCII string representing a binary number to a true decimal number +sub bin2dec { + return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); +} + +# Convert a true number to a binary ASCII string +sub dec2bin { + my $str = unpack("B32", pack("N", shift)); + return $str; +} + +# Covert an ASCII string representing a hex number to a binary ASCII string; +sub hex2bin { + return unpack("B32", pack("N", hex(shift))); +} + +# Convert an ASCII string representing a binary number to a hex ASCII string; +sub bin2hex { + + my $Bin = shift(@_); + my $Hex; + + # Clean up string and look for errors + chomp $Bin; + + if ($Bin =~ m/[^10]/) { + print STDERR "#ERROR Reg_macro $Bin is not binary\n"; + return (""); + } + return scalar reverse unpack "h*",(pack "b*", scalar reverse $Bin); +} + + + +# required by Perl +1; + +## Local Variables: +## mode: perl +## End: + + + + + |