![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to m68k-iset-expand.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [The Machine Emulator] / tme / ic / m68k|
Return to m68k-iset-expand.pl CVS log | Up to [The Machine Emulator] / tme / ic / m68k |
1.1 root 1: #! /usr/local/bin/perl -w
2:
1.1.1.3 ! root 3: # $Id: m68k-iset-expand.pl,v 1.5 2007/08/25 21:14:29 fredette Exp $
1.1.1.2 root 4:
1.1 root 5: # m68k-inst-expand.pl - expands the m68k instruction templates into
6: # full instruction word patterns and their decodings:
7:
1.1.1.2 root 8: #
9: # Copyright (c) 2002, 2003 Matt Fredette
10: # All rights reserved.
11: #
12: # Redistribution and use in source and binary forms, with or without
13: # modification, are permitted provided that the following conditions
14: # are met:
15: # 1. Redistributions of source code must retain the above copyright
16: # notice, this list of conditions and the following disclaimer.
17: # 2. Redistributions in binary form must reproduce the above copyright
18: # notice, this list of conditions and the following disclaimer in the
19: # documentation and/or other materials provided with the distribution.
20: # 3. All advertising materials mentioning features or use of this software
21: # must display the following acknowledgement:
22: # This product includes software developed by Matt Fredette.
23: # 4. The name of the author may not be used to endorse or promote products
24: # derived from this software without specific prior written permission.
25: #
26: # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
27: # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
28: # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
29: # DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
30: # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31: # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
32: # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33: # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34: # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
35: # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
36: # POSSIBILITY OF SUCH DAMAGE.
37: #
1.1 root 38:
39: # globals:
40: $debug = 0;
41: @threefield = ("000", "001", "010", "011", "100", "101", "110", "111");
42:
43: # our single command line argument is the CPU name:
44: if (@ARGV != 1) {
45: print STDERR "usage: $0 CPU-NAME\n";
46: exit(1);
47: }
48: $cpu_name = shift(@ARGV);
49: print "cpu-begin $cpu_name\n";
50:
51: # to silence perl -w:
52: undef($field_q);
53:
54: # loop over the instruction set on standard input:
55: $pass = 1;
56: for($line = 1; defined($_ = <STDIN>); $line++) {
57: chomp;
58:
59: # split by spaces:
60: @tokens = split(/[,\s]+/, $_);
61:
62: # strip comments:
63: for ($token_i = 0; $token_i < @tokens; $token_i++) {
64: splice(@tokens, $token_i)
65: if ($tokens[$token_i] =~ /^\!/);
66: }
67:
68: # skip blank lines:
69: next if (@tokens == 0);
70:
71: # handle the preprocessor. this is the dumbest preprocessor ever:
72: if ($tokens[0] eq ".if") {
73: $pass = 0;
74: foreach $token (@tokens) {
75: $pass = 1 if ($token eq $cpu_name);
76: }
77: next;
78: }
79: elsif ($tokens[0] eq ".endif") {
80: $pass = 1;
81: next;
82: }
83: next if (!$pass);
84:
85: # handle an EAX category. an EAX category defines valid
86: # combinations of an EA "mode" and "reg" values found in an
87: # instruction patterns "x" field. see linear pp 60 of M68000PM.ps
88: # for a list of all possible mode and reg combinations.
89: #
90: # different combinations are valid depending on the instruction
91: # and operand being described, however most instructions use one
92: # of a small handful of common combinations.
93: #
94: # an EA category is defined as:
95: #
96: # eax-cat NAME DEFAULT-CYCLES COMBINATIONS
97: #
98: # NAME is a user-assigned name for the category
99: #
100: # DEFAULT-CYCLES specifies the default memory cycle behavior
101: # for this category of effective address. specific later uses
102: # of this category may still override this default. this is
103: # one of "un", "ro", "wo", or "rw", for no cycles, read-only,
104: # write-only, and read-write, respectively
105: #
106: # COMBINATIONS is a string of "y" and "n" characters indicating
107: # which mode and reg combinations are valid. positions zero
108: # through six in the string correspond to mode values zero
109: # through six, and positions seven through 14 correspond to
110: # mode value 7, reg values zero through seven:
111: #
112: if ($tokens[0] eq "eax-cat") {
113:
114: # get the category definition:
115: $eax_cat_name = $tokens[1];
116: $eax_cat_cycles_default = $tokens[2];
117: @eax_cat_modes = split(//, $tokens[3]);
118:
119: # expand this category once for each possible operand size,
120: # remembering what operand each valid combination of mode and
121: # reg means:
122: foreach $eax_size (0, 8, 16, 32) {
123: @eax_cat_fields = ();
124: @eay_cat_fields = ();
125: for ($mode = 0; $mode < @threefield; $mode++) {
126: for ($reg = 0; $reg < @threefield; $reg++) {
127:
128: # EXCEPTION: 8-bit address register direct is always
129: # illegal:
130: next if ($eax_size == 8 && $mode == 1);
131:
132: if ($eax_cat_modes[$mode + ($mode < 7 ? 0 : $reg)] eq "y") {
133: undef($field_x_value);
134: undef($field_y_value);
135: if ($mode == 0) {
136: # data register direct:
137: $field_x_value = "\%d${reg}.${eax_size}";
138: }
139: elsif ($mode == 1) {
140: # address register direct:
141: $field_x_value = "\%a${reg}.${eax_size}";
142: }
143: elsif ($mode == 7
144: && $reg == 4) {
145: # immediate:
146: $field_x_value = "imm.${eax_size}";
147: }
148: elsif ($eax_size == 0) {
149: # unsized, effective address complex:
150: $field_x_value = "eax.32";
151: }
152: else {
153: $field_x_value = "memx.${eax_size}.$eax_cat_cycles_default";
154: $field_y_value = "memy.${eax_size}.$eax_cat_cycles_default";
155: }
156: $field_y_value = $field_x_value if (!defined($field_y_value));
157: push(@eax_cat_fields, "$threefield[$mode]$threefield[$reg]/$field_x_value");
158: push(@eay_cat_fields, "$threefield[$reg]$threefield[$mode]/$field_y_value");
159: }
160: }
161: }
162: eval("\@eax_${eax_cat_name}${eax_size} = \@eax_cat_fields;");
163: eval("\@eay_${eax_cat_name}${eax_size} = \@eay_cat_fields;");
164: }
165: next;
166: }
167:
168: # handle a "specop" line. some instructions have a separate opcode
169: # word that needs to be read and decoded specially. we expand
170: # any .s suffixes on the instruction names but otherwise pass
171: # this line on untouched:
172: #
173: if ($tokens[0] eq "specop") {
174: foreach $token (@tokens) {
175: $token = "${1}8 ${1}16 ${1}32" if ($token =~ /^(\S+)\.s$/);
176: }
177: print join(" ", @tokens)."\n";
178: next;
179: }
180:
181: # form the instruction template from the first four tokens:
182: $template = join("", splice(@tokens, 0, 4));
183:
184: # the next token is the function:
185: $func = shift(@tokens);
186:
187: # the remaining tokens are the arguments:
188: @args = @tokens;
189: undef(@tokens);
190:
191: print "template $template, func $func, args: ".join(" ", @args)."\n" if ($debug);
192:
193: # break this template down into fields and sanity-check them.
194: # we work from the leftmost position in the template (the most
195: # significant bit, bit 15) to the rightmost position.
196: #
197: @fields = ("root");
198: for ($field_start = 15; $field_start >= 0; $field_start = $field_end - 1) {
199:
200: # find the extent of this field. a wildcard field (indicated
201: # by the "?" character, which is internally rewritten to the "w"
202: # character) is always a single bit wide, otherwise a constant
203: # field ends right before a non-constant bit, and any other field
204: # ends when it ends:
205: #
206: $field_char = substr($template, 15 - $field_start, 1);
207: $field_char =~ tr/\?/w/;
208: for ($field_end = $field_start; $field_end >= 0; $field_end--) {
209:
210: # get the next field character:
211: $field_char_next = substr($template, 15 - ($field_end - 1), 1);
212: $field_char_next =~ tr/\?/w/;
213:
214: # stop if this is the first character of the next field:
215: last if ($field_char eq "w"
216: || ($field_char =~ /[01]/
217: ? $field_char_next !~ /[01]/
218: : $field_char_next ne $field_char));
219: }
220:
221: # save this field:
222: push (@fields, ($field_char =~ /[01]/
223: ? substr($template, 15 - $field_start, $field_start - $field_end + 1)
224: : $field_char));
225:
226: # sanity check this field. some fields must be a fixed size,
227: # some fields must be used by some argument:
228: #
229: $field_size = $field_start - $field_end + 1;
230: print "$#fields: $field_char-field from $field_start to $field_end" if ($debug);
231: if ($field_char =~ /[01w]/) {
232: # constant and wildcard fields can have any size
233: }
234: elsif ($field_char =~ /[sS]/) {
235: # operand-size fields must be size two:
236: die "stdin:$line: $field_char field must be size two\n"
237: if ($field_size != 2);
238: }
239: elsif ($field_char =~ /[xy]/) {
240: # effective address fields must be size six:
241: die "stdin:$line: $field_char field must be size six\n"
242: if ($field_size != 6);
243: # effective address fields must be used by some argument:
244: for ($arg_i = 0; $arg_i < @args; $arg_i++) {
245: last if ($args[$arg_i] =~ /^$field_char([sS]|(\d+))\//);
246: }
247: die "stdin:$line: $field_char field not used by any argument\n"
248: if ($arg_i == @args);
249: print ", arg #$arg_i" if ($debug);
250: eval("\$field_${field_char}_arg = $arg_i;");
251: }
252: elsif ($field_char =~ /[daDAq]/) {
253: # register and small-immediate fields must be size three:
254: die "stdin:$line: $field_char field must be size three\n"
255: if ($field_size != 3);
256: }
257: elsif ($field_char eq "c") {
258: # condition code fields must be size four:
259: die "stdin:$line: c field must be size four\n"
260: if ($field_size != 4);
261: }
262: else {
263: die "stdin:$line: unknown field type $field_char\n";
264: }
265: print "\n" if ($debug);
266: }
267: print "fields: ".join(" ", @fields)."\n" if ($debug);
268:
269: # recursively go over the fields of this template, forming real,
270: # legal instruction patterns, and their full decoding:
271: $field_depth = 0;
272: undef(@field_n0_values);
273: @field_n0_values = ("");
274: @pattern_stack = ("");
275: @instruction_stack = ("");
276: print "root\n" if ($debug);
277: $pattern = "";
278: $instruction = "";
279: for (;;) {
280:
281: # find the next field value, popping the stack as needed, and
282: # form the next pattern:
283: for (; !defined($field_value = eval("shift(\@field_n${field_depth}_values)")); ) {
284: eval("undef(\$field_$fields[$field_depth]);");
285: last if (--$field_depth < 0);
286: $field_type = $fields[$field_depth];
287: pop(@pattern_stack);
288: pop(@instruction_stack);
289: }
290: last if ($field_depth < 0);
291: ($pattern_part, $field_value, $instruction_part) = split(/\//, $field_value, 3);
292: $pattern_part = "" if (!defined($pattern_part));
293: $field_value = $pattern_part if (!defined($field_value) || $field_value eq "");
294: $instruction_part = "" if (!defined($instruction_part));
295: $pattern = $pattern_stack[$field_depth].$pattern_part;
296: $instruction = $instruction_stack[$field_depth].$instruction_part;
297: eval("\$field_$fields[$field_depth] = \"$field_value\";");
298:
299: # if we don't have a complete pattern, descend into the
300: # next field and expand it:
301: if ($field_depth < $#fields) {
302: $field_type = $fields[++$field_depth];
303: push(@pattern_stack, $pattern);
304: push(@instruction_stack, $instruction);
305: @field_values = ();
306:
307: # a constant field:
308: if ($field_type =~ /^[01]/) {
309: @field_values = ($field_type);
310: }
311:
312: # a wildcard field:
313: elsif ($field_type eq "w") {
314: @field_values = ("0", "1");
315: }
316:
317: # a size field:
318: elsif ($field_type eq "s") {
319: @field_values = ("00/8", "01/16", "10/32");
320: }
321:
322: # the wacko size field:
323: elsif ($field_type eq "S") {
324: @field_values = ("01/8", "11/16", "10/32");
325: }
326:
327: # an eax or eay field:
328: elsif ($field_type =~ /[xy]/) {
329:
330: # take apart the argument:
331: $arg_i = eval("\$field_${field_type}_arg;");
332: die "stdin:$line: $args[$arg_i] is a bad EA argument\n"
333: unless ($args[$arg_i] =~ /^${field_type}([sS]|(\d+))\/([^\/]+)(\/(\S\S))?$/);
334: ($eax_size, $eax_cat_name, $eax_arg_cycles) = ($1, $3, $5);
335:
336: # if the EA size depends on a size field, get it:
337: if ($eax_size =~ /[sS]/) {
338: die "stdin:$line: $args[$arg_i] argument with no size field?\n"
339: if (!defined($eax_size = eval("\$field_$eax_size;")));
340: }
341:
342: # get the field values:
343: eval("\@field_values = \@ea${field_type}_${eax_cat_name}${eax_size};");
344:
345: # if this argument is overriding the default cycles on the
346: # EA category, enforce the override on the field values:
347: if (defined($eax_arg_cycles)
348: && $eax_arg_cycles ne "") {
349: foreach $field_value (@field_values) {
350: $field_value =~ s/\.(un|ro|wo|rw)$/\.$eax_arg_cycles/;
351: }
352: }
353: }
354:
355: # a register field:
356: elsif ($field_type =~ /[daDA]/) {
357: @field_values = ("000/0", "001/1", "010/2", "011/3", "100/4", "101/5", "110/6", "111/7");
358: }
359:
360: # a quick constant field:
361: elsif ($field_type eq "q") {
362: @field_values = ("000/8", "001/1", "010/2", "011/3", "100/4", "101/5", "110/6", "111/7");
363: }
364:
365: # a condition code field:
366: elsif ($field_type eq "c") {
367: @field_values = ("0000/t", "0001/f", "0010/hi", "0011/ls",
368: "0100/cc", "0101/cs", "0110/ne", "0111/eq",
369: "1000/vc", "1001/vs", "1010/pl", "1011/mi",
370: "1100/ge", "1101/lt", "1110/gt", "1111/le");
371: }
372:
373: # this field must have some values:
374: die "stdin:$line: $field_type-field has no values\n"
375: if (@field_values == 0);
376: print "".(" " x $field_depth)."$field_type-field values: ".join(" ", @field_values)."\n" if ($debug);
377: eval("\@field_n${field_depth}_values = \@field_values;");
378:
379: # loop to pick up the first value from this depth,
380: # and possibly continue descending:
381: next;
382: }
383:
1.1.1.3 ! root 384: # EXCEPTION: a move of an address register to a predecrement
! 385: # or postincrement EA with that same address register, must
! 386: # store the original value of the address register. since the
! 387: # predecrement and postincrement code in the executer updates
! 388: # the address register before the move has happened, we wrap
! 389: # the normal move function in another that gives an op1
! 390: # argument that is the original value of the address register:
! 391: if ($func =~ /^move_srp[di]\.S/) {
! 392: $func = 'move.S';
! 393: }
! 394: if ($func eq 'move.S'
! 395: && substr($pattern, (15 - 5), 6) eq '001'.substr($pattern, (15 - 11), 3)) {
! 396: if (substr($pattern, (15 - 8), 3) eq '100') {
! 397: $func = 'move_srpd.S';
! 398: }
! 399: elsif (substr($pattern, (15 - 8), 3) eq '011') {
! 400: $func = 'move_srpi.S';
! 401: }
! 402: }
! 403:
1.1 root 404: # the function name:
405: if ($func =~ /^(.*)\.([sS])$/) {
406: die "stdin:$line: $func with no size field?\n"
407: if (!defined($_ = eval("\$field_$2;")));
408: $instruction .= " func=$1$_";
409: }
410: else {
411: $instruction .= " func=$func";
412: }
413:
414: # handle the arguments:
415: for ($arg_i = 0; $arg_i < @args ; $arg_i++) {
416: $arg = $args[$arg_i];
417:
418: # replace any .s with the s-field:
419: $arg = "$1.$field_s" if ($arg =~ /^(.*)\.s$/);
420: $arg = "$1.$field_S" if ($arg =~ /^(.*)\.S$/);
421:
422: # an immediate argument:
423: $arg = "#$field_s" if ($arg eq "#s");
424: $arg = "#$field_S" if ($arg eq "#S");
425: if ($arg =~ /^\#(\d+)$/ || $arg =~ /^\#(16S32)$/) {
426: $instruction .= " imm_size=$1 imm_operand=$arg_i";
427: }
428:
429: # an EA argument:
430: elsif ($arg =~ /^([xy])/) {
431: $field_type = $1;
432: $field_value = eval("\$field_${field_type};");
433: if ($field_value =~ /^mem${field_type}\.(\d+)\.(\S\S)$/) {
434: die "stdin:$line: unsized ea${field_type} memory argument $field_value (internal error?)\n"
435: if ($1 == 0);
436: die "stdin:$line: ea${field_type} memory argument with no cycles (internal error?)\n"
437: if ($2 eq "un");
438: $instruction .= " ea${field_type}_size=$1 ea${field_type}_cycles=$2";
439: $field_value = "mem${field_type}.$1";
440: }
441: elsif ($field_value =~ /^imm\.(\d+)$/) {
442: $instruction .= " imm_size=$1 imm_operand=$arg_i";
443: $field_value = "";
444: }
445: elsif ($field_value eq "eax.32") {
446: $instruction .= " eax_size=UNSIZED";
447: }
448: $instruction .= " op${arg_i}=$field_value" if ($field_value ne "");
449: }
450:
451: # a register argument:
452: elsif ($arg =~ /^\%([daDA])(\.\d+)$/) {
453: $field_type = $1;
454: $reg = $field_type;
455: $reg =~ tr/A-Z/a-d/;
456: $instruction .= " op${arg_i}=\%$reg".eval("\$field_$1;").$2;
457: }
458:
459: # a register number argument:
460: elsif ($arg =~ /^\#([daDa])/) {
461: $field_type = $1;
462: $instruction .= " op${arg_i}=imm".eval("\$field_$1;").".32";
463: }
464:
465: # a quick integer argument:
466: elsif ($arg =~ /^\#q\.(\d+)/) {
467: $instruction .= " op${arg_i}=imm${field_q}.$1";
468: }
469:
470: # a hard-coded immediate argument:
471: elsif ($arg =~ /^\#(\d+)\.(\d+)/) {
472: $instruction .= " op${arg_i}=imm$1.$2";
473: }
474:
475: # handle a dummy argument:
476: elsif ($arg eq "X") {
477: }
478:
479: else {
480: die "stdin:$line: argument type $arg unknown\n";
481: }
482: }
483:
484: # we have a complete pattern and decoded instruction:
485: print "$pattern$instruction\n";
486: }
487:
488: }
489:
490: print "cpu-end $cpu_name\n";
491:
492: # done:
493: exit(0);
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.