| 1 |
2 |
ja_rd |
################################################################################
|
| 2 |
|
|
# uasm.pl : light8080 core microcode assembler
|
| 3 |
|
|
################################################################################
|
| 4 |
|
|
# Usage: perl uasm.pl <microcode file name> <command list>
|
| 5 |
|
|
#
|
| 6 |
|
|
# The command list is a space-separated sequence of the following:
|
| 7 |
|
|
#
|
| 8 |
|
|
# -lst : Shows a listing of the assembled microinstructions next to their
|
| 9 |
|
|
# assembler source lines. Not very useful because it does not show
|
| 10 |
|
|
# assembler pragma, label or comment lines.
|
| 11 |
|
|
# -labels : Shows a list of all defined labels with their address and the
|
| 12 |
|
|
# number of times they are used.
|
| 13 |
|
|
# -bitfields: Shows a list of all the different microinstructions generated,
|
| 14 |
|
|
# plus the number of times they are used. Might be useful to encode
|
| 15 |
|
|
# the microinstructions and save rom bits.
|
| 16 |
|
|
# -instructions: Shows a list of all defined instructions with the address their
|
| 17 |
|
|
# microcode starts at.
|
| 18 |
|
|
# -rom_bin : Shows a raw list of all the binary microinstructions.
|
| 19 |
|
|
# -rom_vhdl : Shows a vhdl block containing the microcode rom declaration.
|
| 20 |
|
|
#
|
| 21 |
|
|
# If none of the above commands is given, the program just exits silently. Any
|
| 22 |
|
|
# unrecognized command is silently ignored.
|
| 23 |
|
|
################################################################################
|
| 24 |
|
|
# Assembler format (informal definition, source is the ultimate reference!):
|
| 25 |
|
|
#
|
| 26 |
|
|
#<microinstruction line> :=
|
| 27 |
62 |
ja_rd |
# [<label>] | (*1)
|
| 28 |
|
|
# <operand stage control> ; <ALU stage control> [; [<flag list>]] |
|
| 29 |
|
|
# JSR <destination address>|TJSR <destination address>
|
| 30 |
2 |
ja_rd |
#
|
| 31 |
|
|
#<label> := {':' immediately followed by a common identifier}
|
| 32 |
|
|
#<destination address> := {an identifier defined as label anywhere in the file}
|
| 33 |
|
|
#<operand stage control> := <op_reg> = <op_src> | NOP
|
| 34 |
|
|
#<op_reg> := T1 | T2
|
| 35 |
|
|
#<op_src> := <register> | DI | <IR register>
|
| 36 |
|
|
#<IR register> := {s}|{d}|{p}0|{p}1 (*3)
|
| 37 |
|
|
#<register> := _a|_b|_c|_d|_e|_h|_l|_f|_a|_ph|_pl|_x|_y|_z|_w|_sh|_sl|
|
| 38 |
|
|
#<ALU stage control> := <alu_dst> = <alu_op> | NOP
|
| 39 |
|
|
#<alu_dst> := <register> | DO
|
| 40 |
|
|
#<alu_op> := add|adc|sub|sbb| and|orl|not|xrl| rla|rra|rlca|rrca| aaa|
|
| 41 |
|
|
# t1|rst|daa|cpc|sec|psw
|
| 42 |
|
|
#<flag list> := <flag> [, <flag> ...]
|
| 43 |
|
|
#<flag> := #decode|#di|#ei|#io|#auxcy|#clrt1|#halt|#end|#ret|#rd|#wr|#setacy
|
| 44 |
62 |
ja_rd |
# #ld_al|#ld_addr|#fp_c|#fp_r|#fp_rc (*2)
|
| 45 |
2 |
ja_rd |
#
|
| 46 |
62 |
ja_rd |
# *1 Labels appear alone by themselves in a line
|
| 47 |
|
|
# *2 There are some restrictions on the flags that can be used together
|
| 48 |
|
|
# *3 Registers are specified by IR field
|
| 49 |
2 |
ja_rd |
#
|
| 50 |
|
|
################################################################################
|
| 51 |
|
|
# ALU operations
|
| 52 |
|
|
#
|
| 53 |
|
|
#Operation Encoding ALU result
|
| 54 |
|
|
#===============================================================================
|
| 55 |
|
|
#ADD 001100 T2 + T1
|
| 56 |
|
|
#ADC 001101 T2 + T1 + CY
|
| 57 |
|
|
#SUB 001110 T2 - T1
|
| 58 |
|
|
#SBB 001111 T2 – T1 - CY
|
| 59 |
|
|
#AND 000100 T1 AND T2
|
| 60 |
|
|
#ORL 000101 T1 OR T2
|
| 61 |
|
|
#NOT 000110 NOT T1
|
| 62 |
|
|
#XRL 000111 T1 XOR T2
|
| 63 |
|
|
#RLA 000000 8080 RLC
|
| 64 |
|
|
#RRA 000001 8080 RRC
|
| 65 |
|
|
#RLCA 000010 8080 RAL
|
| 66 |
|
|
#RRCA 000011 8080 RAR
|
| 67 |
|
|
#T1 010111 T1
|
| 68 |
|
|
#RST 011111 8*IR(5..3), as per RST instruction
|
| 69 |
|
|
#DAA 101000 DAA T1 (but only after executing 2 in a row)
|
| 70 |
|
|
#CPC 101100 UNDEFINED (CY complemented)
|
| 71 |
|
|
#SEC 101101 UNDEFINED (CY set)
|
| 72 |
|
|
################################################################################
|
| 73 |
|
|
# Flags :
|
| 74 |
|
|
# --- Flags from group 1: use only one of these
|
| 75 |
|
|
# #decode : Load address counter and IR with contents of data input lines,
|
| 76 |
|
|
# thus starting opcode decoging.
|
| 77 |
|
|
# #ei : Set interrupt enable register.
|
| 78 |
|
|
# #di : Reset interrupt enable register.
|
| 79 |
|
|
# #io : Activate io signal for 1st cycle.
|
| 80 |
|
|
# #auxcy : Use aux carry instead of regular carry for this operation.
|
| 81 |
|
|
# #clrt1 : Clear T1 at the end of 1st cycle.
|
| 82 |
|
|
# #halt : Jump to microcode address 0x07 without saving return value.
|
| 83 |
|
|
#
|
| 84 |
|
|
# --- Flags from group 2: use only one of these
|
| 85 |
|
|
# #setacy : Set aux carry at the start of 1st cycle (used for ++).
|
| 86 |
|
|
# #end : Jump to microinstruction address 3 after the present m.i.
|
| 87 |
|
|
# #ret : Jump to address saved by the last JST or TJSR m.i.
|
| 88 |
|
|
# #rd : Activate rd signal for the 2nd cycle.
|
| 89 |
|
|
# #wr : Activate wr signal for the 2nd cycle.
|
| 90 |
|
|
# --- Independent flags: no restrictions
|
| 91 |
|
|
# #ld_al : Load AL register with register bank output as read by operation 1.
|
| 92 |
|
|
# (used in memory and io access).
|
| 93 |
|
|
# #ld_addr : Load address register (H byte = register bank output as read by
|
| 94 |
|
|
# operation 1, L byte = AL).
|
| 95 |
|
|
# Activate vma signal for 1st cycle.
|
| 96 |
|
|
# --- PSW update flags: use only one of these
|
| 97 |
|
|
# #fp_r : This instruction updates all PSW flags except for C.
|
| 98 |
|
|
# #fp_c : This instruction updates only the C flag in the PSW.
|
| 99 |
|
|
# #fp_rc : This instruction updates all the flags in the PSW.
|
| 100 |
|
|
################################################################################
|
| 101 |
|
|
# Read the design notes for a brief reference to the micromachine internal
|
| 102 |
|
|
# behavior, including implicit loads/erases.
|
| 103 |
|
|
################################################################################
|
| 104 |
|
|
|
| 105 |
|
|
$file = shift(@ARGV);
|
| 106 |
|
|
|
| 107 |
|
|
open(INFO, $file) or die "unable to open file '$file'\n";
|
| 108 |
|
|
@lines = <INFO>;
|
| 109 |
|
|
close(INFO);
|
| 110 |
|
|
|
| 111 |
|
|
$field2_nop = '0'.'0000'.'00'.'0'.'0'.'000000';
|
| 112 |
|
|
$field2_jsr = '0'.'0000'.'00'.'0'.'0'.'000000';
|
| 113 |
|
|
|
| 114 |
|
|
%field1_ops =
|
| 115 |
|
|
( 'nop', '000'.'000'.'00000'.'00'.'0000'.$field2_nop,
|
| 116 |
|
|
'jsr', '000'.'010'.'00000'.'00'.'0000'.$field2_jsr,
|
| 117 |
|
|
'tjsr', '000'.'100'.'00000'.'00'.'0000'.$field2_jsr,
|
| 118 |
|
|
|
| 119 |
|
|
't1 = {s}', '000'.'000'.'00101'.'01'.'0000'.$field2_nop,
|
| 120 |
|
|
't1 = {d}', '000'.'000'.'00101'.'10'.'0000'.$field2_nop,
|
| 121 |
|
|
't1 = {p}0', '000'.'000'.'00101'.'11'.'0000'.$field2_nop,
|
| 122 |
|
|
't1 = {p}1', '000'.'000'.'00101'.'11'.'0001'.$field2_nop,
|
| 123 |
|
|
't1 = di', '000'.'000'.'00100'.'00'.'0000'.$field2_nop,
|
| 124 |
|
|
't1 = _b', '000'.'000'.'00101'.'00'.'0000'.$field2_nop,
|
| 125 |
|
|
't1 = _c', '000'.'000'.'00101'.'00'.'0001'.$field2_nop,
|
| 126 |
|
|
't1 = _d', '000'.'000'.'00101'.'00'.'0010'.$field2_nop,
|
| 127 |
|
|
't1 = _e', '000'.'000'.'00101'.'00'.'0011'.$field2_nop,
|
| 128 |
|
|
't1 = _h', '000'.'000'.'00101'.'00'.'0100'.$field2_nop,
|
| 129 |
|
|
't1 = _l', '000'.'000'.'00101'.'00'.'0101'.$field2_nop,
|
| 130 |
|
|
't1 = _a', '000'.'000'.'00101'.'00'.'0111'.$field2_nop,
|
| 131 |
|
|
't1 = _f', '000'.'000'.'00101'.'00'.'0110'.$field2_nop,
|
| 132 |
|
|
't1 = _ph', '000'.'000'.'00101'.'00'.'1000'.$field2_nop,
|
| 133 |
|
|
't1 = _pl', '000'.'000'.'00101'.'00'.'1001'.$field2_nop,
|
| 134 |
|
|
't1 = _x', '000'.'000'.'00101'.'00'.'1010'.$field2_nop,
|
| 135 |
|
|
't1 = _y', '000'.'000'.'00101'.'00'.'1011'.$field2_nop,
|
| 136 |
|
|
't1 = _z', '000'.'000'.'00101'.'00'.'1100'.$field2_nop,
|
| 137 |
|
|
't1 = _w', '000'.'000'.'00101'.'00'.'1101'.$field2_nop,
|
| 138 |
|
|
't1 = _sh', '000'.'000'.'00101'.'00'.'1110'.$field2_nop,
|
| 139 |
|
|
't1 = _sl', '000'.'000'.'00101'.'00'.'1111'.$field2_nop,
|
| 140 |
|
|
|
| 141 |
|
|
't2 = {s}', '000'.'000'.'00011'.'01'.'0000'.$field2_nop,
|
| 142 |
|
|
't2 = {d}', '000'.'000'.'00011'.'10'.'0000'.$field2_nop,
|
| 143 |
|
|
't2 = {p}0', '000'.'000'.'00011'.'11'.'0000'.$field2_nop,
|
| 144 |
|
|
't2 = {p}1', '000'.'000'.'00011'.'11'.'0001'.$field2_nop,
|
| 145 |
|
|
't2 = di', '000'.'000'.'00010'.'00'.'0000'.$field2_nop,
|
| 146 |
|
|
't2 = _b', '000'.'000'.'00011'.'00'.'0000'.$field2_nop,
|
| 147 |
|
|
't2 = _c', '000'.'000'.'00011'.'00'.'0001'.$field2_nop,
|
| 148 |
|
|
't2 = _d', '000'.'000'.'00011'.'00'.'0010'.$field2_nop,
|
| 149 |
|
|
't2 = _e', '000'.'000'.'00011'.'00'.'0011'.$field2_nop,
|
| 150 |
|
|
't2 = _h', '000'.'000'.'00011'.'00'.'0100'.$field2_nop,
|
| 151 |
|
|
't2 = _l', '000'.'000'.'00011'.'00'.'0101'.$field2_nop,
|
| 152 |
|
|
't2 = _a', '000'.'000'.'00011'.'00'.'0111'.$field2_nop,
|
| 153 |
|
|
't2 = _f', '000'.'000'.'00011'.'00'.'0110'.$field2_nop,
|
| 154 |
|
|
't2 = _ph', '000'.'000'.'00011'.'00'.'1000'.$field2_nop,
|
| 155 |
|
|
't2 = _pl', '000'.'000'.'00011'.'00'.'1001'.$field2_nop,
|
| 156 |
|
|
't2 = _x', '000'.'000'.'00011'.'00'.'1010'.$field2_nop,
|
| 157 |
|
|
't2 = _y', '000'.'000'.'00011'.'00'.'1011'.$field2_nop,
|
| 158 |
|
|
't2 = _z', '000'.'000'.'00011'.'00'.'1100'.$field2_nop,
|
| 159 |
|
|
't2 = _w', '000'.'000'.'00011'.'00'.'1101'.$field2_nop,
|
| 160 |
|
|
't2 = _sh', '000'.'000'.'00011'.'00'.'1110'.$field2_nop,
|
| 161 |
|
|
't2 = _sl', '000'.'000'.'00011'.'00'.'1111'.$field2_nop
|
| 162 |
|
|
|
| 163 |
|
|
);
|
| 164 |
|
|
|
| 165 |
|
|
|
| 166 |
|
|
$re_field1 = "(".join('|',keys %field1_ops).")";
|
| 167 |
|
|
$re_field1 =~ s/\[/\\\[/g;
|
| 168 |
|
|
$re_field1 =~ s/\]/\\\]/g;
|
| 169 |
|
|
|
| 170 |
|
|
%field2_ops =
|
| 171 |
|
|
( 'add', '001100',
|
| 172 |
|
|
'adc', '001101',
|
| 173 |
|
|
'sub', '001110',
|
| 174 |
|
|
'sbb', '001111',
|
| 175 |
|
|
|
| 176 |
|
|
'and', '000100',
|
| 177 |
|
|
'orl', '000110',
|
| 178 |
|
|
'not', '000111',
|
| 179 |
|
|
'xrl', '000101',
|
| 180 |
|
|
|
| 181 |
|
|
'rla', '000000',
|
| 182 |
|
|
'rra', '000001',
|
| 183 |
|
|
'rlca', '000010',
|
| 184 |
|
|
'rrca', '000011',
|
| 185 |
|
|
|
| 186 |
|
|
'aaa', '111000',
|
| 187 |
|
|
|
| 188 |
|
|
't1', '010111',
|
| 189 |
|
|
'rst', '011111',
|
| 190 |
|
|
'daa', '101000',
|
| 191 |
|
|
'cpc', '101100',
|
| 192 |
|
|
'sec', '101101',
|
| 193 |
|
|
'psw', '110000'
|
| 194 |
|
|
);
|
| 195 |
|
|
|
| 196 |
|
|
|
| 197 |
|
|
$re_f2_ops = "(".join('|',keys %field2_ops).")";
|
| 198 |
|
|
$re_f2_ops =~ s/\[/\\\[/g;
|
| 199 |
|
|
$re_f2_ops =~ s/\]/\\\]/g;
|
| 200 |
|
|
|
| 201 |
|
|
# 'parse' command line flags into a string
|
| 202 |
|
|
$cmdline = join ':', @ARGV;
|
| 203 |
|
|
|
| 204 |
|
|
$num_line = 0;
|
| 205 |
|
|
$addr = 0;
|
| 206 |
|
|
|
| 207 |
|
|
%labels = (); # <label, address>
|
| 208 |
|
|
@label_uses = (); # <label, [addresses in which it's used]>
|
| 209 |
|
|
@undefined_targets = (); # array of <label, address in which it's used>
|
| 210 |
|
|
$num_errors = 0;
|
| 211 |
|
|
|
| 212 |
|
|
@bitfields = ();
|
| 213 |
|
|
|
| 214 |
|
|
@rom = ();
|
| 215 |
|
|
@asm = ();
|
| 216 |
|
|
@errors = ();
|
| 217 |
|
|
@num_lines = ();
|
| 218 |
|
|
|
| 219 |
|
|
%asm_to_uaddr = (); # opcode asm -> uaddress
|
| 220 |
|
|
%uaddr_to_asm = (); # uaddress -> opcode asm
|
| 221 |
|
|
|
| 222 |
|
|
%uaddr_to_pattern = (); # uaddress -> pattern
|
| 223 |
|
|
%pattern_to_uaddr = (); # pattern -> uaddress -- simulation, decoder
|
| 224 |
|
|
|
| 225 |
|
|
LINE: foreach $line (@lines) {
|
| 226 |
|
|
|
| 227 |
62 |
ja_rd |
$num_line++;
|
| 228 |
|
|
|
| 229 |
|
|
$line =~ tr/A-Z/a-z/;
|
| 230 |
|
|
$line =~ s/(--|\/\/).*//;
|
| 231 |
2 |
ja_rd |
$line =~ s/^\s*//g;
|
| 232 |
|
|
$line =~ s/\s*\$//g;
|
| 233 |
|
|
chomp($line);
|
| 234 |
|
|
|
| 235 |
|
|
$uinst = {
|
| 236 |
|
|
field_1 => '',
|
| 237 |
|
|
src => '',
|
| 238 |
|
|
special => '',
|
| 239 |
|
|
field_2 => '',
|
| 240 |
|
|
field_0 => '000000',
|
| 241 |
|
|
flags => '',
|
| 242 |
|
|
error => '',
|
| 243 |
|
|
asm => $line
|
| 244 |
|
|
};
|
| 245 |
|
|
|
| 246 |
|
|
|
| 247 |
|
|
# if line is whitespace or comment (which has been changed to whitespace)
|
| 248 |
|
|
# then skip to next line
|
| 249 |
|
|
if($line eq ''){
|
| 250 |
|
|
next;
|
| 251 |
|
|
}
|
| 252 |
|
|
|
| 253 |
62 |
ja_rd |
# if $line is a label declaration, get it and skip to next line
|
| 254 |
2 |
ja_rd |
# note labels come alone in the line, unlike other assemblers
|
| 255 |
|
|
# TODO it'd be simple to change this...
|
| 256 |
62 |
ja_rd |
if($line =~ /^\s*:(\w+)/){
|
| 257 |
|
|
# subroutine label (labels are only used for jsrs)
|
| 258 |
|
|
$labels{$1} = $addr;
|
| 259 |
|
|
next;
|
| 260 |
|
|
}
|
| 261 |
2 |
ja_rd |
|
| 262 |
|
|
# if line is a pragma, process it
|
| 263 |
|
|
if($line =~ /^\s*__/){
|
| 264 |
|
|
# TODO process pragmas __reset, __fetch, __int
|
| 265 |
|
|
|
| 266 |
|
|
#if($line =~ /^\s*__code\s+"([0|1|s|d|p|a|r]+)"/){
|
| 267 |
|
|
# we do nothing with the opcode byte; it's for reference only
|
| 268 |
|
|
#printf "%04d # %s\n",$addr,$1;
|
| 269 |
|
|
#}
|
| 270 |
|
|
if($line =~ /^\s*__asm\s+(.*)/){
|
| 271 |
|
|
# save the start address for the CPU instruction
|
| 272 |
|
|
# it will be used in the design of the decoder
|
| 273 |
|
|
$asm_to_uaddr{$1} = $addr;
|
| 274 |
|
|
$uaddr_to_asm{$addr} = $1;
|
| 275 |
|
|
}
|
| 276 |
|
|
|
| 277 |
|
|
if($line =~ /^\s*__code\s+"(.*)".*/){
|
| 278 |
|
|
# save the start address for the CPU instruction
|
| 279 |
|
|
# it will be used in the design of the decoder
|
| 280 |
|
|
$pattern_to_uaddr{$1} = $addr;
|
| 281 |
|
|
$uaddr_to_pattern{$addr} = $1;
|
| 282 |
|
|
}
|
| 283 |
|
|
|
| 284 |
|
|
|
| 285 |
|
|
next;
|
| 286 |
|
|
}
|
| 287 |
|
|
|
| 288 |
|
|
# get flags field (all text following 1st '#' included)
|
| 289 |
|
|
# remove it so we're left with 'field1 ; field2 [;]'
|
| 290 |
|
|
$line = process_flags($line);
|
| 291 |
|
|
|
| 292 |
|
|
# break line in 1 or 2 fields
|
| 293 |
|
|
@fields = split /;/, $line;
|
| 294 |
|
|
|
| 295 |
|
|
# process 1st field...
|
| 296 |
62 |
ja_rd |
$done = process_field1($fields[0]);
|
| 297 |
2 |
ja_rd |
|
| 298 |
|
|
# ...and process 2nd field if there is one (depends on field1 format)
|
| 299 |
|
|
# TODO check that there's no field2 when there shouldn't
|
| 300 |
62 |
ja_rd |
if($done != 1){
|
| 301 |
2 |
ja_rd |
$done = process_field2($fields[1]);
|
| 302 |
62 |
ja_rd |
}
|
| 303 |
2 |
ja_rd |
|
| 304 |
|
|
# finally, process extra flags produced by field1 assembly (jsr/tjsr)
|
| 305 |
|
|
process_extra_flags();
|
| 306 |
|
|
|
| 307 |
|
|
# complete bitfield with flags...
|
| 308 |
|
|
substr($uinst->{field1}, 0, 6) = $uinst->{field_0};
|
| 309 |
|
|
|
| 310 |
|
|
# Now, we already have the bitfields.
|
| 311 |
|
|
|
| 312 |
|
|
push(@rom, $uinst->{field1});
|
| 313 |
|
|
push(@asm, substr($line,0,40));
|
| 314 |
|
|
push(@num_lines, $num_line);
|
| 315 |
|
|
if($uinst->{error} eq ''){
|
| 316 |
|
|
push(@errors, '');
|
| 317 |
|
|
}
|
| 318 |
|
|
else{
|
| 319 |
|
|
push(@errors, $uinst->{error});
|
| 320 |
|
|
}
|
| 321 |
|
|
|
| 322 |
|
|
$addr++; #addr++ even for error uinsts
|
| 323 |
|
|
|
| 324 |
|
|
}
|
| 325 |
|
|
continue {
|
| 326 |
|
|
}
|
| 327 |
|
|
|
| 328 |
|
|
# Line processing finished (1st pass). Start 2nd pass and do listings
|
| 329 |
|
|
# if requested
|
| 330 |
|
|
|
| 331 |
|
|
# 2nd pass
|
| 332 |
|
|
|
| 333 |
|
|
# now we know the value of all labels, fill in address field of forward jumps
|
| 334 |
|
|
foreach $target (@undefined_targets){
|
| 335 |
|
|
@item = @{$target};
|
| 336 |
|
|
$value = to_bin($labels{$item[0]}, 8);
|
| 337 |
|
|
$adr = $item[1]*1;
|
| 338 |
|
|
|
| 339 |
62 |
ja_rd |
substr($rom[$adr], 20,2, substr($value, 0,2));
|
| 340 |
|
|
substr($rom[$adr], 26,6, substr($value, 2,6));
|
| 341 |
2 |
ja_rd |
}
|
| 342 |
|
|
|
| 343 |
|
|
foreach $bf (@rom){
|
| 344 |
|
|
push(@bitfields, $bf);
|
| 345 |
|
|
}
|
| 346 |
|
|
|
| 347 |
|
|
# listings
|
| 348 |
|
|
|
| 349 |
|
|
if($cmdline =~ /-lst/){
|
| 350 |
|
|
$do_lst = 1;
|
| 351 |
|
|
}
|
| 352 |
|
|
|
| 353 |
|
|
$i = 0;
|
| 354 |
|
|
foreach $bf (@rom){
|
| 355 |
|
|
if($do_lst){
|
| 356 |
|
|
printf "%02x %32s :: %s\n", $i, $bf, $asm[$i];
|
| 357 |
|
|
if($errors[$i] ne ''){
|
| 358 |
|
|
printf " ERROR (%d): %s\n", $num_lines[$i], $errors[$i];
|
| 359 |
|
|
}
|
| 360 |
|
|
}
|
| 361 |
|
|
|
| 362 |
|
|
$i++;
|
| 363 |
|
|
}
|
| 364 |
|
|
|
| 365 |
|
|
if($do_lst){
|
| 366 |
|
|
# completion message
|
| 367 |
|
|
printf "\nDone. %d uinsts, %d errors.\n", $addr, $num_errors;
|
| 368 |
|
|
}
|
| 369 |
|
|
|
| 370 |
|
|
# label listing
|
| 371 |
|
|
if($cmdline =~ /\-labels/){
|
| 372 |
|
|
label_list();
|
| 373 |
|
|
}
|
| 374 |
|
|
|
| 375 |
|
|
# bitfield histogram
|
| 376 |
|
|
if($cmdline =~ /\-bitfields/){
|
| 377 |
|
|
bitfield_histogram();
|
| 378 |
|
|
}
|
| 379 |
|
|
|
| 380 |
|
|
# show cpu instruction microcode addresses
|
| 381 |
|
|
if($cmdline =~ /\-instructions/){
|
| 382 |
|
|
foreach $asm (sort {$asm_to_uaddr{$a} <=> $asm_to_uaddr{$b}}(keys %asm_to_uaddr)){
|
| 383 |
|
|
$uaddress = $asm_to_uaddr{$asm};
|
| 384 |
|
|
printf "%02x %s %s\n", $uaddress, $uaddr_to_pattern{$uaddress}, $asm;
|
| 385 |
|
|
}
|
| 386 |
|
|
}
|
| 387 |
|
|
|
| 388 |
|
|
if($cmdline =~ /\-rom_vhdl/){
|
| 389 |
|
|
show_decoder_table('vhdl');
|
| 390 |
|
|
}
|
| 391 |
|
|
|
| 392 |
|
|
if($cmdline =~ /\-rom_bin/){
|
| 393 |
|
|
show_decoder_table('bin');
|
| 394 |
|
|
}
|
| 395 |
|
|
|
| 396 |
|
|
# end of main program
|
| 397 |
|
|
|
| 398 |
|
|
|
| 399 |
|
|
################################################################################
|
| 400 |
|
|
|
| 401 |
|
|
|
| 402 |
|
|
sub show_decoder_table {
|
| 403 |
|
|
|
| 404 |
|
|
my $fmat = shift(@_);
|
| 405 |
|
|
|
| 406 |
|
|
# show decoder rom contents
|
| 407 |
|
|
%decoder_hash = ();
|
| 408 |
|
|
foreach $pat (keys %pattern_to_uaddr){
|
| 409 |
|
|
$add = $pattern_to_uaddr{$pat};
|
| 410 |
|
|
$pat =~ s/[a-z]/\[01\]/g;
|
| 411 |
|
|
$decoder_hash{$pat} = $add;
|
| 412 |
|
|
}
|
| 413 |
|
|
|
| 414 |
|
|
@decoder_rom = ();
|
| 415 |
|
|
for($i = 0; $i<256; $i++){
|
| 416 |
|
|
$b = to_bin($i, 8);
|
| 417 |
|
|
$val = 0;
|
| 418 |
|
|
# We'll match the opcode to the pattern with the shortest length; that is,
|
| 419 |
|
|
# the one with the less wildcards in it. Crude but effective in this case.
|
| 420 |
|
|
$len_matched_pat = 1000;
|
| 421 |
|
|
foreach $pat (keys %decoder_hash){
|
| 422 |
|
|
if($b =~ /$pat/){
|
| 423 |
|
|
if(length($pat) < $len_matched_pat){
|
| 424 |
|
|
$val = $decoder_hash{$pat};
|
| 425 |
|
|
$len_matched_pat = length($pat);
|
| 426 |
|
|
}
|
| 427 |
|
|
#last;
|
| 428 |
|
|
}
|
| 429 |
|
|
}
|
| 430 |
|
|
push @decoder_rom, $val;
|
| 431 |
|
|
}
|
| 432 |
|
|
|
| 433 |
|
|
if($fmat eq 'vhdl'){
|
| 434 |
|
|
# print rom vhdl header...
|
| 435 |
|
|
print "type t_rom is array (0 to 511) of std_logic_vector(31 downto 0);\n";
|
| 436 |
|
|
print "signal rom : t_rom := (\n";
|
| 437 |
|
|
}
|
| 438 |
|
|
|
| 439 |
|
|
# The 1st half of the uinst rom holds 256 uinstructions
|
| 440 |
|
|
my $i=0;
|
| 441 |
|
|
foreach $bf (@rom){
|
| 442 |
|
|
if($fmat eq 'vhdl'){
|
| 443 |
|
|
printf "\"%s\", -- %03x\n", $bf, $i;
|
| 444 |
|
|
}
|
| 445 |
|
|
else{
|
| 446 |
|
|
printf "%s\n", $bf;
|
| 447 |
|
|
}
|
| 448 |
|
|
$i++;
|
| 449 |
|
|
}
|
| 450 |
|
|
# Fill remaining slots with ENDs
|
| 451 |
|
|
for(;$i<256;$i++){
|
| 452 |
|
|
my $val = '00000100000000000000000000000000';
|
| 453 |
|
|
if($fmat eq 'vhdl'){
|
| 454 |
|
|
printf "\"%s\", -- %03x\n", $val, $i;
|
| 455 |
|
|
}
|
| 456 |
|
|
else{
|
| 457 |
|
|
printf "%s\n", $val;
|
| 458 |
|
|
}
|
| 459 |
|
|
}
|
| 460 |
|
|
|
| 461 |
|
|
# The 2nd half (upper 256 entries) of the ucode rom contains a jump table
|
| 462 |
|
|
# with a jsr for each of the 256 opcodes, serving as cheap decoder:
|
| 463 |
|
|
foreach $entry (@decoder_rom){
|
| 464 |
|
|
my $val = to_bin($entry, 8);
|
| 465 |
|
|
$val = '00001000000000000000'.substr($val,0,2).'0000'.substr($val,2,6);
|
| 466 |
|
|
$i++;
|
| 467 |
|
|
if($fmat eq 'vhdl'){
|
| 468 |
|
|
printf "\"%s\"", $val;
|
| 469 |
|
|
if($i<512){
|
| 470 |
|
|
print ",";
|
| 471 |
|
|
}
|
| 472 |
|
|
else{
|
| 473 |
|
|
print " ";
|
| 474 |
|
|
}
|
| 475 |
|
|
printf " -- %03x\n", ($i - 1);
|
| 476 |
|
|
}
|
| 477 |
|
|
else{
|
| 478 |
|
|
printf "%s\n", $val;
|
| 479 |
|
|
}
|
| 480 |
|
|
}
|
| 481 |
|
|
|
| 482 |
|
|
if($fmat eq 'vhdl'){
|
| 483 |
|
|
# close vhdl declaration
|
| 484 |
|
|
print "\n);\n";
|
| 485 |
|
|
}
|
| 486 |
|
|
|
| 487 |
|
|
}
|
| 488 |
|
|
|
| 489 |
|
|
sub label_list {
|
| 490 |
|
|
# label table listing
|
| 491 |
|
|
print "\nlabels:\n";
|
| 492 |
|
|
print "---------------------------------\n";
|
| 493 |
|
|
print "label addr uses\n";
|
| 494 |
|
|
print "---------------------------------\n";
|
| 495 |
|
|
|
| 496 |
|
|
%hist_labels;
|
| 497 |
|
|
$hist_labels{$_}++ for @label_uses;
|
| 498 |
|
|
|
| 499 |
|
|
foreach $label (keys %hist_labels){
|
| 500 |
|
|
printf "%-20s %04x %d\n", $label, $labels{$label}, $hist_labels{$label};
|
| 501 |
|
|
}
|
| 502 |
|
|
}
|
| 503 |
|
|
|
| 504 |
|
|
sub bitfield_histogram {
|
| 505 |
|
|
|
| 506 |
|
|
%hist_bitfields;
|
| 507 |
|
|
$hist_bitfields{$_}++ for @bitfields;
|
| 508 |
|
|
@unique_bitfields = keys %hist_bitfields;
|
| 509 |
|
|
|
| 510 |
|
|
printf "\nbitfield usage (total: %d)\n", $#unique_bitfields;
|
| 511 |
|
|
print "------------------------------------------------\n";
|
| 512 |
|
|
print "bitfield uses\n";
|
| 513 |
|
|
print "------------------------------------------------\n";
|
| 514 |
|
|
|
| 515 |
|
|
foreach $bfield (sort sortFieldsByFrequency(keys %hist_bitfields)){
|
| 516 |
|
|
printf "%-32s %d\n", $bfield, $hist_bitfields{$bfield};
|
| 517 |
|
|
}
|
| 518 |
|
|
}
|
| 519 |
|
|
|
| 520 |
|
|
sub sortFieldsByFrequency {
|
| 521 |
|
|
$hist_bitfields{$b} <=> $hist_bitfields{$a};
|
| 522 |
|
|
}
|
| 523 |
|
|
|
| 524 |
|
|
sub process_extra_flags {
|
| 525 |
|
|
|
| 526 |
|
|
$flags1 = '';
|
| 527 |
|
|
$flags2 = '';
|
| 528 |
|
|
|
| 529 |
|
|
|
| 530 |
|
|
# first, process flags produced by 1st field processing
|
| 531 |
|
|
if($uinst->{flags} =~ /#jsr/){
|
| 532 |
|
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
| 533 |
|
|
$flags2 = '010';
|
| 534 |
|
|
}
|
| 535 |
|
|
if($uinst->{flags} =~ /#tjsr/){
|
| 536 |
|
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
| 537 |
|
|
$flags2 = '100';
|
| 538 |
|
|
}
|
| 539 |
|
|
|
| 540 |
|
|
$provisional_flags2 = substr($uinst->{field_0},3,3);
|
| 541 |
|
|
if($flags2 ne ''){
|
| 542 |
|
|
if($provisional_flags2 ne '000'){
|
| 543 |
|
|
$error = "flags incompatible with jsr/tjsr operation: "
|
| 544 |
|
|
.$provisional_flags2;
|
| 545 |
|
|
$num_errors++;
|
| 546 |
62 |
ja_rd |
$uinst->{error} = $error;
|
| 547 |
2 |
ja_rd |
}
|
| 548 |
|
|
else{
|
| 549 |
|
|
substr($uinst->{field_0},3,3) = $flags2;
|
| 550 |
|
|
}
|
| 551 |
|
|
}
|
| 552 |
|
|
|
| 553 |
|
|
if($uinst->{flags} =~ /#ld_al/){
|
| 554 |
|
|
substr($uinst->{field1},7,1) = '1';
|
| 555 |
|
|
}
|
| 556 |
|
|
if($uinst->{flags} =~ /#ld_addr/){
|
| 557 |
|
|
substr($uinst->{field1},6,1) = '1';
|
| 558 |
|
|
}
|
| 559 |
|
|
|
| 560 |
|
|
if($uinst->{flags} =~ /#fp_c/){
|
| 561 |
|
|
substr($uinst->{field1},22,2) = '01';
|
| 562 |
|
|
}
|
| 563 |
|
|
if($uinst->{flags} =~ /#fp_r/){
|
| 564 |
|
|
substr($uinst->{field1},22,2) = '10';
|
| 565 |
|
|
}
|
| 566 |
|
|
if($uinst->{flags} =~ /#fp_rc/){
|
| 567 |
|
|
substr($uinst->{field1},22,2) = '11';
|
| 568 |
|
|
}
|
| 569 |
|
|
|
| 570 |
|
|
|
| 571 |
|
|
}
|
| 572 |
|
|
|
| 573 |
|
|
sub process_flags {
|
| 574 |
|
|
|
| 575 |
|
|
my $line = shift(@_);
|
| 576 |
|
|
|
| 577 |
|
|
$line =~ s/#/##/;
|
| 578 |
|
|
$line =~ /(.*)#(#.*)/;
|
| 579 |
|
|
|
| 580 |
|
|
$flags1 = '';
|
| 581 |
|
|
$flags2 = '';
|
| 582 |
|
|
|
| 583 |
|
|
|
| 584 |
|
|
if($1 ne ''){
|
| 585 |
|
|
$line_without_flags = $1;
|
| 586 |
|
|
$flag_str = $2;
|
| 587 |
|
|
|
| 588 |
|
|
@flags = split /,/, $flag_str;
|
| 589 |
|
|
$error = '';
|
| 590 |
|
|
|
| 591 |
|
|
if($flag_str =~ /#end/){
|
| 592 |
|
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
| 593 |
|
|
$flags2 = '001';
|
| 594 |
|
|
}
|
| 595 |
|
|
if($flag_str =~ /#ret/){
|
| 596 |
|
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
| 597 |
|
|
$flags2 = '011';
|
| 598 |
|
|
}
|
| 599 |
|
|
if($flag_str =~ /#rd/){
|
| 600 |
|
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
| 601 |
|
|
$flags2 = '101';
|
| 602 |
|
|
}
|
| 603 |
|
|
if($flag_str =~ /#wr/){
|
| 604 |
|
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
| 605 |
|
|
$flags2 = '110';
|
| 606 |
|
|
}
|
| 607 |
|
|
if($flag_str =~ /#auxcy/){
|
| 608 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 609 |
|
|
$flags1 = '101';
|
| 610 |
|
|
}
|
| 611 |
|
|
|
| 612 |
|
|
if($flag_str =~ /#decode/){
|
| 613 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 614 |
|
|
$flags1 = '001';
|
| 615 |
|
|
}
|
| 616 |
|
|
if($flag_str =~ /#clrt1/){
|
| 617 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 618 |
|
|
$flags1 = '110';
|
| 619 |
|
|
}
|
| 620 |
|
|
if($flag_str =~ /#halt/){
|
| 621 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 622 |
|
|
$flags1 = '111';
|
| 623 |
|
|
}
|
| 624 |
|
|
if($flag_str =~ /#di/){
|
| 625 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 626 |
|
|
$flags1 = '010';
|
| 627 |
|
|
}
|
| 628 |
|
|
if($flag_str =~ /#ei/){
|
| 629 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 630 |
|
|
$flags1 = '011';
|
| 631 |
|
|
}
|
| 632 |
|
|
if($flag_str =~ /#io/){
|
| 633 |
|
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
| 634 |
|
|
$flags1 = '100';
|
| 635 |
|
|
}
|
| 636 |
|
|
if($flag_str =~ /#setacy/){
|
| 637 |
|
|
if($flags2 ne ''){$error = 'incompatible flags:'.$flags2};
|
| 638 |
|
|
$flags2 = '111';
|
| 639 |
|
|
}
|
| 640 |
|
|
|
| 641 |
|
|
if($flags2 eq ''){ $flags2 = '000';};
|
| 642 |
|
|
if($flags1 eq ''){ $flags1 = '000';};
|
| 643 |
|
|
|
| 644 |
|
|
$uinst->{field_0} = $flags1.$flags2;
|
| 645 |
|
|
|
| 646 |
|
|
# Some of the flags must be processed after the rest of the uinst
|
| 647 |
|
|
# has been assembled; save them into $uinst->{flags} for later.
|
| 648 |
|
|
|
| 649 |
|
|
if($flag_str =~ /#ld_al/){
|
| 650 |
|
|
$uinst->{flags} = $uinst->{flags}." #ld_al";
|
| 651 |
|
|
}
|
| 652 |
|
|
if($flag_str =~ /#ld_addr/){
|
| 653 |
|
|
$uinst->{flags} = $uinst->{flags}." #ld_addr";
|
| 654 |
|
|
}
|
| 655 |
|
|
if($flag_str =~ /#fp_c/){
|
| 656 |
|
|
$uinst->{flags} = $uinst->{flags}." #fp_c";
|
| 657 |
|
|
}
|
| 658 |
|
|
if($flag_str =~ /#fp_r/){
|
| 659 |
|
|
$uinst->{flags} = $uinst->{flags}." #fp_r";
|
| 660 |
|
|
}
|
| 661 |
|
|
if($flag_str =~ /#fp_rc/){
|
| 662 |
|
|
$uinst->{flags} = $uinst->{flags}." #fp_rc";
|
| 663 |
|
|
}
|
| 664 |
|
|
|
| 665 |
|
|
if($error ne ''){
|
| 666 |
|
|
$num_errors++;
|
| 667 |
|
|
$uinst->{error} = $error;
|
| 668 |
|
|
};
|
| 669 |
|
|
|
| 670 |
|
|
return $line_without_flags;
|
| 671 |
|
|
}
|
| 672 |
|
|
|
| 673 |
|
|
return $line;
|
| 674 |
|
|
}
|
| 675 |
|
|
|
| 676 |
|
|
|
| 677 |
|
|
sub process_field2 {
|
| 678 |
|
|
my $field = shift(@_).";";
|
| 679 |
|
|
|
| 680 |
|
|
$field =~ s/^\s*//g;
|
| 681 |
|
|
$field =~ s/\s*;//g;
|
| 682 |
|
|
$field =~ s/\s+/ /g;
|
| 683 |
|
|
|
| 684 |
|
|
$field =~ s/A-Z/a-z/g;
|
| 685 |
|
|
|
| 686 |
|
|
|
| 687 |
|
|
# check for special field2 formats: nop
|
| 688 |
|
|
if($field =~ /(nop)/){
|
| 689 |
|
|
# field2 is nop by default
|
| 690 |
|
|
return 0;
|
| 691 |
|
|
}
|
| 692 |
|
|
|
| 693 |
|
|
|
| 694 |
|
|
if($field =~ /(_\w+|{p}0|{p}1|{d}|{s}|do) = (\w+|t1)/){
|
| 695 |
|
|
|
| 696 |
|
|
#check that dst address is the same as field1's src address
|
| 697 |
|
|
#(since they end up being the same physical bits)
|
| 698 |
|
|
@parts = split /=/, $field;
|
| 699 |
|
|
$dst = $parts[0];
|
| 700 |
|
|
$dst =~ s/\s//g;
|
| 701 |
|
|
if(($dst ne $uinst->{src})
|
| 702 |
|
|
&& ($dst ne 'do')
|
| 703 |
|
|
&& ($uinst->{src} ne 'di')
|
| 704 |
|
|
&& ($uinst->{src} ne '')){
|
| 705 |
|
|
# field mismatch
|
| 706 |
|
|
$num_errors++;
|
| 707 |
|
|
$uinst->{error} = "field source/destination address mismatch";
|
| 708 |
|
|
return 1;
|
| 709 |
|
|
}
|
| 710 |
|
|
else{
|
| 711 |
|
|
# build bitfield for field2, including those bits that overlap
|
| 712 |
|
|
# bits from field 1
|
| 713 |
|
|
|
| 714 |
|
|
if($dst eq 'do'){
|
| 715 |
|
|
substr($uinst->{field1}, 24, 1) = '1'; #ld_do
|
| 716 |
|
|
}
|
| 717 |
|
|
else{
|
| 718 |
|
|
substr($uinst->{field1}, 25, 1) = '1'; #ld_reg
|
| 719 |
|
|
|
| 720 |
|
|
if($dst eq '{p}0'){
|
| 721 |
|
|
substr($uinst->{field1}, 11, 2) = '11';
|
| 722 |
|
|
substr($uinst->{field1}, 13, 4) = '0000';
|
| 723 |
|
|
}
|
| 724 |
|
|
elsif($dst eq '{p}1'){
|
| 725 |
|
|
substr($uinst->{field1}, 11, 2) = '11';
|
| 726 |
|
|
substr($uinst->{field1}, 13, 4) = '0001';
|
| 727 |
|
|
}
|
| 728 |
|
|
elsif($dst eq '{d}'){
|
| 729 |
|
|
substr($uinst->{field1}, 11, 2) = '10';
|
| 730 |
|
|
substr($uinst->{field1}, 13, 4) = '0000';
|
| 731 |
|
|
}
|
| 732 |
|
|
elsif($dst eq '{s}'){
|
| 733 |
|
|
substr($uinst->{field1}, 11, 2) = '01';
|
| 734 |
|
|
substr($uinst->{field1}, 13, 4) = '0000';
|
| 735 |
|
|
}
|
| 736 |
|
|
else{
|
| 737 |
|
|
%regs = ( '_b',0, '_c',1, '_d',2, '_e',3,
|
| 738 |
|
|
'_h',4, '_l',5, '_f',6, '_a',7,
|
| 739 |
|
|
'_ph',8, '_pl',9, '_x',10, '_y',11,
|
| 740 |
|
|
'_z',12, '_w',13, '_sh',14, '_sl',15);
|
| 741 |
|
|
|
| 742 |
|
|
$val_reg = to_bin($regs{$dst},4);
|
| 743 |
|
|
substr($uinst->{field1}, 11, 2) = '00';
|
| 744 |
|
|
substr($uinst->{field1}, 13, 4) = $val_reg; # RD address; same as WR
|
| 745 |
|
|
}
|
| 746 |
|
|
|
| 747 |
|
|
}
|
| 748 |
|
|
|
| 749 |
|
|
# TODO deal with flag pattern
|
| 750 |
|
|
$parts[1] =~ s/\s//g;
|
| 751 |
|
|
$src = $field2_ops{$parts[1]}.'';
|
| 752 |
|
|
if($src eq ''){
|
| 753 |
|
|
$num_errors++;
|
| 754 |
|
|
$uinst->{error} = "field 2 operation unknown: [".$parts[1]."]";
|
| 755 |
|
|
return 1;
|
| 756 |
|
|
}
|
| 757 |
|
|
else{
|
| 758 |
|
|
substr($uinst->{field1},26,6) = $src;
|
| 759 |
|
|
return 0;
|
| 760 |
|
|
}
|
| 761 |
|
|
}
|
| 762 |
|
|
|
| 763 |
|
|
}
|
| 764 |
|
|
elsif($field =~ /(sec|cpc)/){
|
| 765 |
|
|
substr($uinst->{field1},26,6) = $field2_ops{$1};
|
| 766 |
|
|
}
|
| 767 |
|
|
else{
|
| 768 |
|
|
# field2 empty or invalid
|
| 769 |
|
|
$num_errors++;
|
| 770 |
|
|
$uinst->{error} = "field 2 empty or invalid: ".$re_field2;
|
| 771 |
|
|
return 1;
|
| 772 |
|
|
}
|
| 773 |
|
|
|
| 774 |
|
|
}
|
| 775 |
|
|
|
| 776 |
|
|
|
| 777 |
|
|
|
| 778 |
62 |
ja_rd |
# return !=0 when uinst is finished except for flags,
|
| 779 |
|
|
# 0 when field2 has to be processed
|
| 780 |
2 |
ja_rd |
|
| 781 |
|
|
sub process_field1 {
|
| 782 |
|
|
|
| 783 |
|
|
my $field = shift(@_).";";
|
| 784 |
|
|
|
| 785 |
|
|
$field =~ s/^\s*//g;
|
| 786 |
|
|
$field =~ s/\s*;//g;
|
| 787 |
|
|
$field =~ s/\s+/ /g;
|
| 788 |
|
|
|
| 789 |
62 |
ja_rd |
# look for special format uinsts: jsr, tjsr, nop
|
| 790 |
|
|
if($field =~ /(jsr|tjsr)\s+([_\w]+)/){
|
| 791 |
|
|
$opcode = $1;
|
| 792 |
|
|
$target = $2;
|
| 793 |
|
|
# set flag
|
| 794 |
|
|
$uinst->{flags} = $uinst->{flags}." #".$opcode." ";
|
| 795 |
|
|
|
| 796 |
|
|
# check that target is defined, otherwise tag it for 2nd pass
|
| 797 |
|
|
$target_addr = $labels{$target};
|
| 798 |
2 |
ja_rd |
|
| 799 |
62 |
ja_rd |
tag_label_use($target, $addr);
|
| 800 |
|
|
|
| 801 |
|
|
if($target_addr eq ''){
|
| 802 |
|
|
push @undefined_targets, [$target, $addr];
|
| 803 |
|
|
$code = $field1_ops{$opcode};
|
| 804 |
|
|
$uinst->{field1} = $code;
|
| 805 |
|
|
}
|
| 806 |
|
|
else{
|
| 807 |
|
|
# set up bitfield so we can fill the address in in 2nd pass
|
| 808 |
|
|
$code = $field1_ops{$opcode};
|
| 809 |
|
|
$a = to_bin($target_addr+0, 8);
|
| 810 |
|
|
substr($code, 20,2, substr($a, 0,2));
|
| 811 |
|
|
substr($code, 26,6, substr($a, 2,6));
|
| 812 |
|
|
$uinst->{field1} = $code;
|
| 813 |
|
|
}
|
| 814 |
|
|
return 1;
|
| 815 |
|
|
}
|
| 816 |
|
|
|
| 817 |
|
|
if($field =~ /nop/){
|
| 818 |
|
|
# TODO encode NOP as 1st field
|
| 819 |
|
|
$uinst->{field1} = $field1_ops{'nop'};
|
| 820 |
|
|
return 0;
|
| 821 |
|
|
}
|
| 822 |
2 |
ja_rd |
|
| 823 |
62 |
ja_rd |
# process regular field1 (register load): dst = src
|
| 824 |
|
|
|
| 825 |
2 |
ja_rd |
if($field =~ /$re_field1/){
|
| 826 |
|
|
@parts = split /=/, $field;
|
| 827 |
|
|
|
| 828 |
|
|
# if a src reg address literal is specified, it has to be the same
|
| 829 |
|
|
# address as for field2 dest; save it for later comparison.
|
| 830 |
|
|
|
| 831 |
|
|
$src = $parts[1];
|
| 832 |
|
|
$src =~ s/\s//g;
|
| 833 |
|
|
|
| 834 |
|
|
$d = $field1_ops{$field}.'';
|
| 835 |
|
|
|
| 836 |
|
|
if($d eq ''){
|
| 837 |
|
|
# unrecognized source that somehow matches pattern (e.g. _pl0)
|
| 838 |
62 |
ja_rd |
$error = "invalid source in uinst field 1";
|
| 839 |
|
|
$uinst->{field1} = $field1_ops{'nop'};
|
| 840 |
|
|
$uinst->{error} = $error;
|
| 841 |
|
|
$num_errors++;
|
| 842 |
2 |
ja_rd |
$uinst->{src} = '?';
|
| 843 |
|
|
return 1;
|
| 844 |
|
|
}
|
| 845 |
|
|
else{
|
| 846 |
|
|
$uinst->{src} = $src;
|
| 847 |
|
|
$uinst->{field1} = $d;
|
| 848 |
|
|
}
|
| 849 |
|
|
return 0;
|
| 850 |
|
|
}
|
| 851 |
|
|
else{
|
| 852 |
62 |
ja_rd |
# field1 not recognized.
|
| 853 |
|
|
$error = "uinst field 1 not recognized: '".$field."'";
|
| 854 |
|
|
$uinst->{field1} = $field1_ops{'nop'};
|
| 855 |
|
|
$uinst->{error} = $error;
|
| 856 |
|
|
$num_errors++;
|
| 857 |
2 |
ja_rd |
return 1;
|
| 858 |
|
|
}
|
| 859 |
|
|
|
| 860 |
|
|
}
|
| 861 |
|
|
|
| 862 |
|
|
sub tag_label_use {
|
| 863 |
|
|
|
| 864 |
|
|
my $label = shift(@_);
|
| 865 |
|
|
my $address = shift(@_);
|
| 866 |
|
|
|
| 867 |
|
|
push(@label_uses, $label);
|
| 868 |
|
|
|
| 869 |
|
|
}
|
| 870 |
|
|
|
| 871 |
|
|
sub to_bin {
|
| 872 |
|
|
my $number = shift(@_) * 1;
|
| 873 |
|
|
my $length = shift(@_);
|
| 874 |
|
|
|
| 875 |
|
|
$n = $number;
|
| 876 |
|
|
$r = '';
|
| 877 |
|
|
for( my $i=$length-1;$i>=0;$i--){
|
| 878 |
|
|
$d = 2 ** $i;
|
| 879 |
|
|
|
| 880 |
|
|
if($n >= $d){
|
| 881 |
|
|
$r = $r.'1';
|
| 882 |
|
|
$n = $n - $d;
|
| 883 |
|
|
}
|
| 884 |
|
|
else{
|
| 885 |
|
|
$r = $r.'0';
|
| 886 |
|
|
}
|
| 887 |
|
|
}
|
| 888 |
|
|
|
| 889 |
|
|
return $r;
|
| 890 |
|
|
}
|
| 891 |
|
|
|
| 892 |
|
|
# End of file
|
