Return to m68k-iset-expand.pl CVS log

Up to [The Machine Emulator] / tme / ic / m68k

Annotation of tme/ic/m68k/m68k-iset-expand.pl, revision 1.1

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.