aboutsummaryrefslogtreecommitdiff
path: root/risugen_common.pm
blob: 71ee9965657e94d7a69ccbee6aaaf50e4220fd50 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
#!/usr/bin/perl -w
###############################################################################
# Copyright (c) 2017 Linaro Limited
# All rights reserved. This program and the accompanying materials
# are made available under the terms of the Eclipse Public License v1.0
# which accompanies this distribution, and is available at
# http://www.eclipse.org/legal/epl-v10.html
#
# Contributors:
#     Peter Maydell (Linaro) - initial implementation
###############################################################################

# risugen_common -- common utility routines for CPU modules.
# We don't declare ourselves in a package so all these functions
# and variables are available for use.

package risugen_common;

use strict;
use warnings;

BEGIN {
    require Exporter;

    our @ISA = qw(Exporter);
    our @EXPORT = qw(open_bin close_bin set_endian insn32 insn16 $bytecount
                   progress_start progress_update progress_end
                   eval_with_fields is_pow_of_2 sextract ctz
                   dump_insn_details);
}

our $bytecount;

my $bigendian = 0;

# Set the endianness when insn32() and insn16() write to the output
# (default is little endian, 0).
sub set_endian
{
    $bigendian = @_;
}

sub open_bin
{
    my ($fname) = @_;
    open(BIN, ">", $fname) or die "can't open %fname: $!";
    $bytecount = 0;
}

sub close_bin
{
    close(BIN) or die "can't close output file: $!";
}

sub insn32($)
{
    my ($insn) = @_;
    print BIN pack($bigendian ? "N" : "V", $insn);
    $bytecount += 4;
}

sub insn16($)
{
    my ($insn) = @_;
    print BIN pack($bigendian ? "n" : "v", $insn);
    $bytecount += 2;
}

# Progress bar implementation
my $lastprog;
my $proglen;
my $progmax;

sub progress_start($$)
{
    ($proglen, $progmax) = @_;
    $proglen -= 2; # allow for [] chars
    $| = 1;        # disable buffering so we can see the meter...
    print "[" . " " x $proglen . "]\r";
    $lastprog = 0;
}

sub progress_update($)
{
    # update the progress bar with current progress
    my ($done) = @_;
    my $barlen = int($proglen * $done / $progmax);
    if ($barlen != $lastprog) {
        $lastprog = $barlen;
        print "[" . "-" x $barlen . " " x ($proglen - $barlen) . "]\r";
    }
}

sub progress_end()
{
    print "[" . "-" x $proglen . "]\n";
    $| = 0;
}

sub eval_with_fields($$$$$) {
    # Evaluate the given block in an environment with Perl variables
    # set corresponding to the variable fields for the insn.
    # Return the result of the eval; we die with a useful error
    # message in case of syntax error.
    #
    # At the moment we just evaluate the string in the environment
    # of the calling package.
    # What we *ought* to do here is to give the config snippets
    # their own package, and explicitly import into it only the
    # functions that we want to be accessible to the config.
    # That would provide better separation and an explicitly set up
    # environment that doesn't allow config file code to accidentally
    # change state it shouldn't have access to, and avoid the need to
    # use 'caller' to get the package name of our calling function.
    my ($insnname, $insn, $rec, $blockname, $block) = @_;
    my $calling_package = caller;
    my $evalstr = "{ package $calling_package; ";
    for my $tuple (@{ $rec->{fields} }) {
        my ($var, $pos, $mask) = @$tuple;
        my $val = ($insn >> $pos) & $mask;
        $evalstr .= "my (\$$var) = $val; ";
    }
    $evalstr .= $block;
    $evalstr .= "}";
    my $v = eval $evalstr;
    if ($@) {
        print "Syntax error detected evaluating $insnname $blockname string:\n$block\n$@";
        exit(1);
    }
    return $v;
}

sub is_pow_of_2($)
{
    my ($x) = @_;
    return ($x > 0) && (($x & ($x - 1)) == 0);
}

# sign-extract from a nbit optionally signed bitfield
sub sextract($$)
{
    my ($field, $nbits) = @_;

    my $sign = $field & (1 << ($nbits - 1));
    return -$sign + ($field ^ $sign);
}

sub ctz($)
{
    # Count trailing zeros, similar semantic to gcc builtin:
    # undefined return value if input is zero.
    my ($in) = @_;

    # XXX should use log2, popcount, ...
    my $imm = 0;
    for (my $cnt = $in; $cnt > 1; $cnt >>= 1) {
        $imm += 1;
    }
    return $imm;
}

sub dump_insn_details($$)
{
    # Dump the instruction details for one insn
    my ($insn, $rec) = @_;
    print "insn $insn: ";
    my $insnwidth = $rec->{width};
    my $fixedbits = $rec->{fixedbits};
    my $fixedbitmask = $rec->{fixedbitmask};
    my $constraint = $rec->{blocks}{"constraints"};
    print sprintf(" insnwidth %d fixedbits %08x mask %08x ", $insnwidth, $fixedbits, $fixedbitmask);
    if (defined $constraint) {
        print "constraint $constraint ";
    }
    for my $tuple (@{ $rec->{fields} }) {
        my ($var, $pos, $mask) = @$tuple;
        print "($var, $pos, " . sprintf("%08x", $mask) . ") ";
    }
    print "\n";
}

1;