![[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:
3: # m68k-inst-expand.pl - expands the m68k instruction templates into
4: # full instruction word patterns and their decodings:
5:
6: # $Header: /aquery/home0/fredette/project/tme/TME-CVS-LOCAL/tme/ic/m68k/m68k-iset-expand.pl,v 1.3 2003/04/23 19:16:16 fredette Exp $
7:
8: # globals:
9: $debug = 0;
10: @threefield = ("000", "001", "010", "011", "100", "101", "110", "111");
11:
12: # our single command line argument is the CPU name:
13: if (@ARGV != 1) {
14: print STDERR "usage: $0 CPU-NAME\n";
15: exit(1);
16: }
17: $cpu_name = shift(@ARGV);
18: print "cpu-begin $cpu_name\n";
19:
20: # to silence perl -w:
21: undef($field_q);
22:
23: # loop over the instruction set on standard input:
24: $pass = 1;
25: for($line = 1; defined($_ = <STDIN>); $line++) {
26: chomp;
27:
28: # split by spaces:
29: @tokens = split(/[,\s]+/, $_);
30:
31: # strip comments:
32: for ($token_i = 0; $token_i < @tokens; $token_i++) {
33: splice(@tokens, $token_i)
34: if ($tokens[$token_i] =~ /^\!/);
35: }
36:
37: # skip blank lines:
38: next if (@tokens == 0);
39:
40: # handle the preprocessor. this is the dumbest preprocessor ever:
41: if ($tokens[0] eq ".if") {
42: $pass = 0;
43: foreach $token (@tokens) {
44: $pass = 1 if ($token eq $cpu_name);
45: }
46: next;
47: }
48: elsif ($tokens[0] eq ".endif") {
49: $pass = 1;
50: next;
51: }
52: next if (!$pass);
53:
54: # handle an EAX category. an EAX category defines valid
55: # combinations of an EA "mode" and "reg" values found in an
56: # instruction patterns "x" field. see linear pp 60 of M68000PM.ps
57: # for a list of all possible mode and reg combinations.
58: #
59: # different combinations are valid depending on the instruction
60: # and operand being described, however most instructions use one
61: # of a small handful of common combinations.
62: #
63: # an EA category is defined as:
64: #
65: # eax-cat NAME DEFAULT-CYCLES COMBINATIONS
66: #
67: # NAME is a user-assigned name for the category
68: #
69: # DEFAULT-CYCLES specifies the default memory cycle behavior
70: # for this category of effective address. specific later uses
71: # of this category may still override this default. this is
72: # one of "un", "ro", "wo", or "rw", for no cycles, read-only,
73: # write-only, and read-write, respectively
74: #
75: # COMBINATIONS is a string of "y" and "n" characters indicating
76: # which mode and reg combinations are valid. positions zero
77: # through six in the string correspond to mode values zero
78: # through six, and positions seven through 14 correspond to
79: # mode value 7, reg values zero through seven:
80: #
81: if ($tokens[0] eq "eax-cat") {
82:
83: # get the category definition:
84: $eax_cat_name = $tokens[1];
85: $eax_cat_cycles_default = $tokens[2];
86: @eax_cat_modes = split(//, $tokens[3]);
87:
88: # expand this category once for each possible operand size,
89: # remembering what operand each valid combination of mode and
90: # reg means:
91: foreach $eax_size (0, 8, 16, 32) {
92: @eax_cat_fields = ();
93: @eay_cat_fields = ();
94: for ($mode = 0; $mode < @threefield; $mode++) {
95: for ($reg = 0; $reg < @threefield; $reg++) {
96:
97: # EXCEPTION: 8-bit address register direct is always
98: # illegal:
99: next if ($eax_size == 8 && $mode == 1);
100:
101: if ($eax_cat_modes[$mode + ($mode < 7 ? 0 : $reg)] eq "y") {
102: undef($field_x_value);
103: undef($field_y_value);
104: if ($mode == 0) {
105: # data register direct:
106: $field_x_value = "\%d${reg}.${eax_size}";
107: }
108: elsif ($mode == 1) {
109: # address register direct:
110: $field_x_value = "\%a${reg}.${eax_size}";
111: }
112: elsif ($mode == 7
113: && $reg == 4) {
114: # immediate:
115: $field_x_value = "imm.${eax_size}";
116: }
117: elsif ($eax_size == 0) {
118: # unsized, effective address complex:
119: $field_x_value = "eax.32";
120: }
121: else {
122: $field_x_value = "memx.${eax_size}.$eax_cat_cycles_default";
123: $field_y_value = "memy.${eax_size}.$eax_cat_cycles_default";
124: }
125: $field_y_value = $field_x_value if (!defined($field_y_value));
126: push(@eax_cat_fields, "$threefield[$mode]$threefield[$reg]/$field_x_value");
127: push(@eay_cat_fields, "$threefield[$reg]$threefield[$mode]/$field_y_value");
128: }
129: }
130: }
131: eval("\@eax_${eax_cat_name}${eax_size} = \@eax_cat_fields;");
132: eval("\@eay_${eax_cat_name}${eax_size} = \@eay_cat_fields;");
133: }
134: next;
135: }
136:
137: # handle a "specop" line. some instructions have a separate opcode
138: # word that needs to be read and decoded specially. we expand
139: # any .s suffixes on the instruction names but otherwise pass
140: # this line on untouched:
141: #
142: if ($tokens[0] eq "specop") {
143: foreach $token (@tokens) {
144: $token = "${1}8 ${1}16 ${1}32" if ($token =~ /^(\S+)\.s$/);
145: }
146: print join(" ", @tokens)."\n";
147: next;
148: }
149:
150: # form the instruction template from the first four tokens:
151: $template = join("", splice(@tokens, 0, 4));
152:
153: # the next token is the function:
154: $func = shift(@tokens);
155:
156: # the remaining tokens are the arguments:
157: @args = @tokens;
158: undef(@tokens);
159:
160: print "template $template, func $func, args: ".join(" ", @args)."\n" if ($debug);
161:
162: # break this template down into fields and sanity-check them.
163: # we work from the leftmost position in the template (the most
164: # significant bit, bit 15) to the rightmost position.
165: #
166: @fields = ("root");
167: for ($field_start = 15; $field_start >= 0; $field_start = $field_end - 1) {
168:
169: # find the extent of this field. a wildcard field (indicated
170: # by the "?" character, which is internally rewritten to the "w"
171: # character) is always a single bit wide, otherwise a constant
172: # field ends right before a non-constant bit, and any other field
173: # ends when it ends:
174: #
175: $field_char = substr($template, 15 - $field_start, 1);
176: $field_char =~ tr/\?/w/;
177: for ($field_end = $field_start; $field_end >= 0; $field_end--) {
178:
179: # get the next field character:
180: $field_char_next = substr($template, 15 - ($field_end - 1), 1);
181: $field_char_next =~ tr/\?/w/;
182:
183: # stop if this is the first character of the next field:
184: last if ($field_char eq "w"
185: || ($field_char =~ /[01]/
186: ? $field_char_next !~ /[01]/
187: : $field_char_next ne $field_char));
188: }
189:
190: # save this field:
191: push (@fields, ($field_char =~ /[01]/
192: ? substr($template, 15 - $field_start, $field_start - $field_end + 1)
193: : $field_char));
194:
195: # sanity check this field. some fields must be a fixed size,
196: # some fields must be used by some argument:
197: #
198: $field_size = $field_start - $field_end + 1;
199: print "$#fields: $field_char-field from $field_start to $field_end" if ($debug);
200: if ($field_char =~ /[01w]/) {
201: # constant and wildcard fields can have any size
202: }
203: elsif ($field_char =~ /[sS]/) {
204: # operand-size fields must be size two:
205: die "stdin:$line: $field_char field must be size two\n"
206: if ($field_size != 2);
207: }
208: elsif ($field_char =~ /[xy]/) {
209: # effective address fields must be size six:
210: die "stdin:$line: $field_char field must be size six\n"
211: if ($field_size != 6);
212: # effective address fields must be used by some argument:
213: for ($arg_i = 0; $arg_i < @args; $arg_i++) {
214: last if ($args[$arg_i] =~ /^$field_char([sS]|(\d+))\//);
215: }
216: die "stdin:$line: $field_char field not used by any argument\n"
217: if ($arg_i == @args);
218: print ", arg #$arg_i" if ($debug);
219: eval("\$field_${field_char}_arg = $arg_i;");
220: }
221: elsif ($field_char =~ /[daDAq]/) {
222: # register and small-immediate fields must be size three:
223: die "stdin:$line: $field_char field must be size three\n"
224: if ($field_size != 3);
225: }
226: elsif ($field_char eq "c") {
227: # condition code fields must be size four:
228: die "stdin:$line: c field must be size four\n"
229: if ($field_size != 4);
230: }
231: else {
232: die "stdin:$line: unknown field type $field_char\n";
233: }
234: print "\n" if ($debug);
235: }
236: print "fields: ".join(" ", @fields)."\n" if ($debug);
237:
238: # recursively go over the fields of this template, forming real,
239: # legal instruction patterns, and their full decoding:
240: $field_depth = 0;
241: undef(@field_n0_values);
242: @field_n0_values = ("");
243: @pattern_stack = ("");
244: @instruction_stack = ("");
245: print "root\n" if ($debug);
246: $pattern = "";
247: $instruction = "";
248: for (;;) {
249:
250: # find the next field value, popping the stack as needed, and
251: # form the next pattern:
252: for (; !defined($field_value = eval("shift(\@field_n${field_depth}_values)")); ) {
253: eval("undef(\$field_$fields[$field_depth]);");
254: last if (--$field_depth < 0);
255: $field_type = $fields[$field_depth];
256: pop(@pattern_stack);
257: pop(@instruction_stack);
258: }
259: last if ($field_depth < 0);
260: ($pattern_part, $field_value, $instruction_part) = split(/\//, $field_value, 3);
261: $pattern_part = "" if (!defined($pattern_part));
262: $field_value = $pattern_part if (!defined($field_value) || $field_value eq "");
263: $instruction_part = "" if (!defined($instruction_part));
264: $pattern = $pattern_stack[$field_depth].$pattern_part;
265: $instruction = $instruction_stack[$field_depth].$instruction_part;
266: eval("\$field_$fields[$field_depth] = \"$field_value\";");
267:
268: # if we don't have a complete pattern, descend into the
269: # next field and expand it:
270: if ($field_depth < $#fields) {
271: $field_type = $fields[++$field_depth];
272: push(@pattern_stack, $pattern);
273: push(@instruction_stack, $instruction);
274: @field_values = ();
275:
276: # a constant field:
277: if ($field_type =~ /^[01]/) {
278: @field_values = ($field_type);
279: }
280:
281: # a wildcard field:
282: elsif ($field_type eq "w") {
283: @field_values = ("0", "1");
284: }
285:
286: # a size field:
287: elsif ($field_type eq "s") {
288: @field_values = ("00/8", "01/16", "10/32");
289: }
290:
291: # the wacko size field:
292: elsif ($field_type eq "S") {
293: @field_values = ("01/8", "11/16", "10/32");
294: }
295:
296: # an eax or eay field:
297: elsif ($field_type =~ /[xy]/) {
298:
299: # take apart the argument:
300: $arg_i = eval("\$field_${field_type}_arg;");
301: die "stdin:$line: $args[$arg_i] is a bad EA argument\n"
302: unless ($args[$arg_i] =~ /^${field_type}([sS]|(\d+))\/([^\/]+)(\/(\S\S))?$/);
303: ($eax_size, $eax_cat_name, $eax_arg_cycles) = ($1, $3, $5);
304:
305: # if the EA size depends on a size field, get it:
306: if ($eax_size =~ /[sS]/) {
307: die "stdin:$line: $args[$arg_i] argument with no size field?\n"
308: if (!defined($eax_size = eval("\$field_$eax_size;")));
309: }
310:
311: # get the field values:
312: eval("\@field_values = \@ea${field_type}_${eax_cat_name}${eax_size};");
313:
314: # if this argument is overriding the default cycles on the
315: # EA category, enforce the override on the field values:
316: if (defined($eax_arg_cycles)
317: && $eax_arg_cycles ne "") {
318: foreach $field_value (@field_values) {
319: $field_value =~ s/\.(un|ro|wo|rw)$/\.$eax_arg_cycles/;
320: }
321: }
322: }
323:
324: # a register field:
325: elsif ($field_type =~ /[daDA]/) {
326: @field_values = ("000/0", "001/1", "010/2", "011/3", "100/4", "101/5", "110/6", "111/7");
327: }
328:
329: # a quick constant field:
330: elsif ($field_type eq "q") {
331: @field_values = ("000/8", "001/1", "010/2", "011/3", "100/4", "101/5", "110/6", "111/7");
332: }
333:
334: # a condition code field:
335: elsif ($field_type eq "c") {
336: @field_values = ("0000/t", "0001/f", "0010/hi", "0011/ls",
337: "0100/cc", "0101/cs", "0110/ne", "0111/eq",
338: "1000/vc", "1001/vs", "1010/pl", "1011/mi",
339: "1100/ge", "1101/lt", "1110/gt", "1111/le");
340: }
341:
342: # this field must have some values:
343: die "stdin:$line: $field_type-field has no values\n"
344: if (@field_values == 0);
345: print "".(" " x $field_depth)."$field_type-field values: ".join(" ", @field_values)."\n" if ($debug);
346: eval("\@field_n${field_depth}_values = \@field_values;");
347:
348: # loop to pick up the first value from this depth,
349: # and possibly continue descending:
350: next;
351: }
352:
353: # the function name:
354: if ($func =~ /^(.*)\.([sS])$/) {
355: die "stdin:$line: $func with no size field?\n"
356: if (!defined($_ = eval("\$field_$2;")));
357: $instruction .= " func=$1$_";
358: }
359: else {
360: $instruction .= " func=$func";
361: }
362:
363: # handle the arguments:
364: for ($arg_i = 0; $arg_i < @args ; $arg_i++) {
365: $arg = $args[$arg_i];
366:
367: # replace any .s with the s-field:
368: $arg = "$1.$field_s" if ($arg =~ /^(.*)\.s$/);
369: $arg = "$1.$field_S" if ($arg =~ /^(.*)\.S$/);
370:
371: # an immediate argument:
372: $arg = "#$field_s" if ($arg eq "#s");
373: $arg = "#$field_S" if ($arg eq "#S");
374: if ($arg =~ /^\#(\d+)$/ || $arg =~ /^\#(16S32)$/) {
375: $instruction .= " imm_size=$1 imm_operand=$arg_i";
376: }
377:
378: # an EA argument:
379: elsif ($arg =~ /^([xy])/) {
380: $field_type = $1;
381: $field_value = eval("\$field_${field_type};");
382: if ($field_value =~ /^mem${field_type}\.(\d+)\.(\S\S)$/) {
383: die "stdin:$line: unsized ea${field_type} memory argument $field_value (internal error?)\n"
384: if ($1 == 0);
385: die "stdin:$line: ea${field_type} memory argument with no cycles (internal error?)\n"
386: if ($2 eq "un");
387: $instruction .= " ea${field_type}_size=$1 ea${field_type}_cycles=$2";
388: $field_value = "mem${field_type}.$1";
389: }
390: elsif ($field_value =~ /^imm\.(\d+)$/) {
391: $instruction .= " imm_size=$1 imm_operand=$arg_i";
392: $field_value = "";
393: }
394: elsif ($field_value eq "eax.32") {
395: $instruction .= " eax_size=UNSIZED";
396: }
397: $instruction .= " op${arg_i}=$field_value" if ($field_value ne "");
398: }
399:
400: # a register argument:
401: elsif ($arg =~ /^\%([daDA])(\.\d+)$/) {
402: $field_type = $1;
403: $reg = $field_type;
404: $reg =~ tr/A-Z/a-d/;
405: $instruction .= " op${arg_i}=\%$reg".eval("\$field_$1;").$2;
406: }
407:
408: # a register number argument:
409: elsif ($arg =~ /^\#([daDa])/) {
410: $field_type = $1;
411: $instruction .= " op${arg_i}=imm".eval("\$field_$1;").".32";
412: }
413:
414: # a quick integer argument:
415: elsif ($arg =~ /^\#q\.(\d+)/) {
416: $instruction .= " op${arg_i}=imm${field_q}.$1";
417: }
418:
419: # a hard-coded immediate argument:
420: elsif ($arg =~ /^\#(\d+)\.(\d+)/) {
421: $instruction .= " op${arg_i}=imm$1.$2";
422: }
423:
424: # handle a dummy argument:
425: elsif ($arg eq "X") {
426: }
427:
428: else {
429: die "stdin:$line: argument type $arg unknown\n";
430: }
431: }
432:
433: # we have a complete pattern and decoded instruction:
434: print "$pattern$instruction\n";
435: }
436:
437: }
438:
439: print "cpu-end $cpu_name\n";
440:
441: # done:
442: exit(0);
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.