summaryrefslogtreecommitdiff
path: root/macros/latex/contrib/register/Reg_macro.pm
diff options
context:
space:
mode:
Diffstat (limited to 'macros/latex/contrib/register/Reg_macro.pm')
-rw-r--r--macros/latex/contrib/register/Reg_macro.pm498
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:
+
+
+
+
+