#! /usr/bin/perl # Realmode X86 Emulator Library # # Copyright (C) 1996-1999 SciTech Software, Inc. # Copyright (C) David Mosberger-Tang # Copyright (C) 1999 Egbert Eich # # ======================================================================== # # Permission to use, copy, modify, distribute, and sell this software and # its documentation for any purpose is hereby granted without fee, # provided that the above copyright notice appear in all copies and that # both that copyright notice and this permission notice appear in # supporting documentation, and that the name of the authors not be used # in advertising or publicity pertaining to distribution of the software # without specific, written prior permission. The authors makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # THE AUTHORS DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, # INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO # EVENT SHALL THE AUTHORS BE LIABLE FOR ANY SPECIAL, INDIRECT OR # CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF # USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR # OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # PERFORMANCE OF THIS SOFTWARE. use Getopt::Long; use strict; use warnings FATAL => 'all'; sub prepare; sub parse_memory_init; sub parse_loadfile; sub loadfile_set_length; sub loadfile_set_status; sub add_interrupt_table; sub print_listing; sub print_mem; sub print_regs; sub zero_if_undef; sub nr; sub seg_ofs; sub get_num_segsel_base; sub parse_segofs_or_linear; sub parse_segofs_segmented; sub display_hex; sub decode_descr; sub new_tmp_file; sub cleanup; END { cleanup } $SIG{INT} = \&cleanup; $SIG{TERM} = \&cleanup; our $opt_save_temp = 0; our $opt_quiet = 0; our $opt_debug = 0; our $opt_debug_memory = 0; our $opt_debug_load = 0; our $opt_compat_in = 0; our $opt_compat_out = 0; our $opt_compat_dt = 0; our $opt_compat_rand = 0; our $opt_compat = 0; our $opt_help = 0; our $opt_help_page; our $file_name; our @rands; our $randnow_semantics; Getopt::Long::Configure(qw(pass_through)); GetOptions( 'save-temp|save' => \$opt_save_temp, 'quiet' => \$opt_quiet, 'debug' => \$opt_debug, 'debug-memory' => \$opt_debug_memory, 'debug-load' => \$opt_debug_load, 'compat-in' => \$opt_compat_in, 'compat-out' => \$opt_compat_out, 'compat-dt' => \$opt_compat_dt, 'compat-rand' => \$opt_compat_rand, 'compat' => \$opt_compat, 'help|h|?' => \$opt_help, ); $opt_compat and $opt_compat_in = $opt_compat_out = $opt_compat_dt = $opt_compat_rand = 1; foreach (@ARGV) { /^--$/ and last; /^-/ or next; /^-h([A-Za-z]+)$/ or die "prepare_test: invalid option '$_'\n"; defined $opt_help_page and die "prepare_test: already requested help page '$opt_help_page', request '$1' is duplicate\n"; $opt_help_page = $1; } if (defined $opt_help_page) { if ($opt_help_page =~ /^(?:f|if)$/) { print STDOUT <<\HELPTEXT; prepare_test input format (For details on abbreviations used on this help page, see -ha.) The input file is divided into sections. Each section is specified using brackets that contain a section type as well as optional section attributes. The following section types are recognised: init initialisation of registers and memory, attributes: srand= numeric, seed pseudorandom number generator, default 0 bits= 16 or 32, force cs and default ss to bitness, default none mode= 86 or protected, forces cr0 bit 0 off or on, default none code code to be assembled and listed, attributes: bits= 16 or 32, passed to assembler on a bits line org= ofs, passed to assembler on an org line base= [seg:]ofs, resulting adr is where to place assembly output start= [seg:]ofs, implies base=[seg:]ofs, implies org=ofs, and additionally initialises cs:eip with resulting segadr; section's bits=xx (if specified) implies init's bits=xx list= numeric, type of listing, default 1, empty attribute means 1 load data/code to be loaded, attributes: time= run or now, default run now means time=now base= [seg:]ofs, resulting adr is base address, default 0 ; prefix for commented sections (semicolon must be inside brackets!) There must be at least one init section and all init sections must precede all other sections. Each line of an init section is one of: memvals initialise memory, see -hm for details reg = val initialise a register descr = descrspec initialise a descriptor Otherwise uninitialised regs will be zero-initialised, including sels but excluding sel cache values, see next paragraph. Each sel cache value is loaded from the LDT or GDT after the init section has been parsed, unless it has been explicitly specified in the init section. (Note that data specified in load sections has not been loaded yet when this default sel cache value initialisation occurs.) Each line of a code section is literally passed to the assembler, with the exception that \[ at the beginning is replaced by [. Some assembler directives beginning with [ are detected and then automatically passed as well even if they are unescaped. By default, the assembler's listing is copied into the output file as a comment. This can be disabled using list=0 or the alias nolist. There are various aliases of the default list=1 such as list=asm. There is the alternative list=2 or list=disasm which disassembles all bytes written by the assembler and then uses the disassembler's output as the listing comment. This is usually terser than the assembler's listing, but loses all comments and won't be able to correctly distinguish initialised data from literal code. Therefore it is only suitable for very short instruction sequences. Each line of a load section is one of: memvals initialise memory, see -hm for details memfile initialise memory, see -hm for details Note that the base= attribute currently does not affect status or length variable addresses, ie it only is honoured for the addresses specifying the destination of the assignment. Parsed numeric values (excepting all in code section lines) can be explicitly specified as octal, hexadecimal, binary, and otherwise are parsed as decimal. Numeric values may contain any amount of _ digit separators. Instead of a numeric value, rand can be specified to get the next output of the pseudorandom number generator. In repeating patterns, a specified rand can be parsed multiple times; each time it is parsed it gets a next output of the pseudorandom number generator. Sections and individual lines are processed one after another; a section or line can overwrite memory locations or registers that already have been written by a previous section or line. Descriptor table access (to initialise descriptors or to resolve segmented addresses) is not checked for temporal consistency; it uses the current values of the descriptor table registers and the descriptor tables currently in memory. (However, it is insured that a used table's base and limit both have been initialised.) In particular then, later initialisation can still change the values in the descriptor tables and descriptor table registers. HELPTEXT } elsif ($opt_help_page =~ /^(?:a|ifa)$/) { print STDOUT <<\HELPTEXT; prepare_test input format, explanation of abbreviations ofs numeric, specifies offset into a segment or file len numeric, specifies length of an area adr 21- or 32-bit flat address, numeric value arange address range specified as one of: adr..adr minimum and maximum address, inclusive adr adr same as above adr-adr same as above adr L len similar to above, but specifies length adrlen adr|arange seg specifies a selector's name or number segadr (internal) 16-bit selector value, 16- or 32-bit ofs seg:ofs yields an adr (= seg.base+ofs) and a segadr (= seg:ofs), one or both are used later for initialisation [seg:]ofs either same as above; or yields adr = ofs, segadr = 0:ofs reg uncapitalised register name, one of: GP regs: eax, ebx, ecx, edx, esi, edi, ebp, esp sels: cs, ss, ds, es, fs, gs, ldtr, tr sel cache values: cs.base, cs.limit, cs.acc, ... ctrl regs: cr0..4 debug regs: dr0..3,6,7 gdtr.base, gdtr.limit, idtr.base, idtr.limit efl, eip HELPTEXT } elsif ($opt_help_page =~ /^(?:m|ifm)$/) { print STDOUT <<\HELPTEXT; prepare_test input format, explanation of memory initialisation syntax adrlen = [R] val[...] full "memvals" form Initialise memory from specified (repeating) value pattern: adr = val[...] length is implied by amount of vals arange = val[...] amount of vals must match range's length arange = R val[...] fill range with repeating val pattern adrlen [~] = [?[S adr]] [L adr] loadfile full "memfile" form Initialise memory from specified (optional) (partial) file: adr = [...] file see below for loadfile details; variants: arange = [...] file both maxlen and minlen forced to range's length arange ~ = [...] file (only) maxlen forced to range's length The optional suffixes shown after the assignment operator mean: ? load is optional; missing file or shorter than ofs+minlen will cancel the (entire) load but continue execution S adr will set octet at adr to load Status: zero iff loaded L adr will set quadlet at adr to loaded Length filename,[ofs],[maxlen],[minlen],[maxcheck] full "loadfile" form Specifies the file to load, with optional size constraints for the loaded portion of the file as well as an optional offset into the file. If by the above form trailing commas would occur, they can be omitted. [FILE] filename name that is enclosed in quotation marks [FROM] ofs from where to load, default 0 [AT MOST] maxlen len, load no more than this, default up to EOF [AT LEAST] minlen len, insure loading at least as much, default 1 [CHECK EOF] maxcheck 0 or 1, iff 1 insure that loaded up to EOF An unnecessary R keyword causes a warning. The proper way to suppress this warning is not to employ R where unnecessary. All of the required or optional keywords in the above descriptions have longer alternative forms. These are the complete forms (with xyz representing the following "term" either purely to clarify the syntax or to indicate that some of the optional keyword extensions follow after this following term): R REPEAT ?S xyz ? STATUS [OCTET] xyz L xyz LENGTH [QUADLET] xyz FILE xyz [LOAD] FILE xyz FROM xyz FROM [OCTET] xyz AT MOST xyz AT MOST xyz [OCTETS] AT LEAST xyz AT LEAST xyz [OCTETS] CHECK EOF xyz CHECK EOF [LOADED] xyz In the above descriptions, all optional as well as necessary keywords including their optional keyword extensions are capitalised purely for clarification of the type of syntax (ie keywords) they represent. They are parsed cap-insensitively and it is in fact recommended to actually specify them entirely uncapitalised. The time of actual memory initialisation depends on the load time of the section containing the corresponding memory initialisation line. The load time of load sections is determined by the time= attribute. The load time of the init section is always immediately. If the load time is immediately, each memory initialisation line is parsed and then processed at once. If the load time is run time, each line is parsed (and checked) but not processed yet - instead, it is written essentially unchanged (possibly with required normalisations) to the output file for the reader of that file to process at run time (that is, right before starting the machine). Note that the current output format does not define any semantics of a pseudorandom number generator. Hence, rand inside repeating patterns effectively is always resolved immediately, so that the output file never contains any rand specifiers. For this reason, using rand in a repeating pattern in a load section to load at run time will cause a warning. If randnow is instead used (which is valid only in these exact circumstances) that warning is not generated. HELPTEXT } else { die "prepare_test: invalid help page '$opt_help_page' requested\n"; } } elsif ($opt_help) { print STDOUT <<\HELPTEXT; usage: prepare_test [options...] filename[...] --quiet suppress warnings --compat-in less strict parsing to allow old input format --compat-out disable improvements to match old output format --compat-dt handle uninitialised DT limits only as warnings --compat-rand use previous PRNG semantics for compatible output --compat all of the above --compat options --save-temp leave assembly input and output files in /tmp/ --debug display verbose debug output --debug-memory dump content of initialised memory --debug-load dump processed load statements -h (or --help) display this help text and exit -hf ... input format description -ha ... explanation of -hf's abbreviations -hm ... explanation of memory initialisation All input filenames must end in .tst and each output filename is the corresponding input filename except .init replacing the .tst ending. HELPTEXT } else { @ARGV or die "prepare_test: no input file specified\nuse 'prepare_test -h' for help\n"; my $errors = 0; for $file_name (@ARGV) { eval { prepare; }; $. = 0; $@ or next; $errors += 1; warn $@; warn "$file_name: error occurred\n"; } $errors and die "prepare_test: errors occurred\n"; } sub prepare { my ($section_name, $section, $line, $addr, $v, $mem, @i, $i); my ($asm, $listing, $seen_start, $first_init_seen, $seen_noninit); our ($file_name, $opt_compat_out, $opt_compat_dt, $opt_debug, $opt_quiet); our %nasm_section_names; %nasm_section_names or %nasm_section_names = ( bits => 1, default => 1, section => 1, segment => 1,absolute => 1, extern => 1, global => 1, common => 1, cpu => 1, float => 1, list => 1, warning => 1,map => 1, sectalign => 1, listing => 1, warn => 1, incbin => 1, ); $file_name =~ /\.tst$/ or die "$file_name: filename must end in .tst\n"; open(F, '<', $file_name) or die "$file_name: unable to open file, error $!\n"; undef $randnow_semantics; @rands = (); $mem = \%{$section->{init}{mem}}; $section->{init}{listing} = []; while(1) { $_ = ; if (! defined $_ || /^\s*\[\s*(\S+)(\s+(.*?))?\]\s*(.*)/ && (! defined $asm || ! defined $nasm_section_names{lc $1} ) ) { if (defined $asm) { $v = $.; print A "\n%line $.+0\n"; defined $section->{$section_name}{args}{endstub} or die "internal error"; $section->{$section_name}{args}{endstub} and print A "\thlt\n"; $section->{$section_name}{args}{endstub} and not $opt_compat_out and print A "\tjmp \$-1\n"; close A; defined $section->{$section_name}{args}{list} or die "internal error"; our $opt_save_temp; my $lst; my $bin = new_tmp_file "bin"; # (currently listing is always required to search interrupt labels) # $opt_save_temp || $section->{$section_name}{args}{list} == 1 # and $lst = new_tmp_file "lst"; my $cmd = $section->{init}{args}{nasm}; $cmd .= " -w+all -w+error -f bin -Ox -o $bin -l $lst $asm"; $opt_debug and warn "$file_name:$.: debug: executing:\n '$cmd'\n"; $i = system $cmd; die "$file_name: nasm failed\n" if $i; $i = \@{$section->{init}{listing}}; unless ($section->{$section_name}{args}{list}) { } elsif ($section->{$section_name}{args}{list} == 1) { $i->[@$i] = [`cat $lst`]; map { s/^ // } @{ $i->[$#$i] }; } elsif ($section->{$section_name}{args}{list} == 2) { $cmd = $section->{init}{args}{ndisasm}; defined $section->{$section_name}{args}{org} and $cmd .= ' -o '.display_hex($section->{$section_name}{args}{org}); defined $section->{$section_name}{args}{bits} and $cmd .= ' -b '.$section->{$section_name}{args}{bits}; $cmd .= ' '.$bin; $opt_debug and warn "$file_name:$.: debug: executing:\n '$cmd'\n"; $i->[@$i] = [`$cmd`]; $opt_debug and warn "$file_name:$.: debug:\n"; $opt_debug and map { warn s/^(.*)\n$/ >>$1<<\n/r; } @{ $i->[$#$i] }; # map { s/^(0000| )// } @{ $i->[$#$i] } if $bits == 16; map { s/^(.)/ ($1 eq ' ' ? ' ' : ' cs:').$1 /e } @{ $i->[$#$i] }; } add_interrupt_table $section, $lst; $i = `cat $bin`; $addr = $section->{$section_name}{args}{base}; foreach (unpack "C*", $i) { $section->{init}{mem}{$addr++} = $_; } undef $asm; $section->{$section_name} = (); $. = $v; } elsif (defined $section_name && $section_name eq 'load') { $section->{$section_name} = (); } defined $_ or last; $4 eq '' or substr($4, 0, 1) eq ';' or die "$file_name:$.: trailing garbage after closing bracket\n"; $section_name = lc $1; substr($section_name, 0, 1) eq ';' and next; $v = \%{$section->{$section_name}{args}}; @i = (); defined $3 and @i = split ' ', lc $3; undef $i; #fixme $section_name eq 'note' # skip attribute validation for now, and next; # and allow in front of first init section my $allowed_attribs = ''; my $attribs_translation = {}; $section_name eq 'init' or defined $first_init_seen or die "$file_name:$.: missing an init section in front of non-init section\n"; if ($section_name ne 'init') { $seen_noninit = $.; unless (defined $section->{init}{regs}{'86m'}) { $section->{init}{regs}{'86m'} = ($section->{init}{regs}{cr0} & 1) ^ 1; $opt_debug and warn "$file_name:$.: debug: automode>".$section->{init}{regs}{'86m'}.'<'; } } if($section_name eq 'init') { defined $seen_noninit and die "$file_name:$.: invalid init after non-init section (on line $seen_noninit)\n"; $allowed_attribs = 'mode|bits|srand'; $attribs_translation = { 'pm' => 'mode=protected', '86m' => 'mode=86', 'rm' => 'mode=86', }; } elsif ($section_name eq 'code') { $allowed_attribs = 'bits|start|base|org|list|endstub'; $attribs_translation = { list => 'list=1', nolist => 'list=0', endstub => 'endstub=1', noendstub => 'endstub=0', omitendstub => 'endstub=0', }; } elsif ($section_name eq 'load') { $allowed_attribs = 'time|base'; $attribs_translation = { rt => 'time=run', run => 'time=run', runtime => 'time=run', now => 'time=now', immed => 'time=now', immediate => 'time=now', immediately => 'time=now', }; } else { die "$file_name:$.: unknown section type: $section_name\n"; } $opt_debug and warn "$file_name:$.: debug: section>$section_name<\n"; keys $attribs_translation and map { defined $attribs_translation->{$_} and $_ = $attribs_translation->{$_}; } @i; undef $attribs_translation; foreach (@i) { /^(.*?)=(.*)$/ or die "$file_name:$.: unknown empty section attribute: $_\n"; defined $v->{$1} and die "$file_name:$.: duplicate section attribute: $1\n"; my ($s1, $s2) = ($1, $2); $s1 =~ /^(?:$allowed_attribs)$/ or die "$file_name:$.: unknown section attribute: $s1\n"; $opt_debug and warn "$file_name:$.: debug: attrib>$s1< =>$s2<\n"; $v->{$s1} = $s2; }; undef $allowed_attribs; if($section_name eq 'init') { if (defined $v->{bits}) { $v->{bits} = nr $v->{bits}; $v->{bits} != 16 and $v->{bits} != 32 and die "$file_name:$.: invalid bits= specifier: $v->{bits}\n"; } unless (defined $first_init_seen) { $section->{$section_name}{regs}{cr0} = 0; $section->{$section_name}{regs}{'cpu.level'} = 0xFF; $v->{nasm} = 'nasm'; $v->{ndisasm} = 'ndisasm'; map { $section->{$section_name}{regs}{$_} = 0 } (qw (cs ss ds es fs gs)); $v->{srand} = zero_if_undef $v->{srand}; } if (defined $v->{srand}) { our @rands; srand $v->{srand}; push @rands, $v->{srand}; push @rands, 0; } delete $v->{srand}; if (defined $v->{mode}) { $attribs_translation = { rm => ['86',0], '86' => ['86',0], '86m' => ['86',0], real => ['86',0], pm => ['protected',1], protected => ['protected',1], }; defined $attribs_translation->{$v->{mode}} or die "$file_name:$.: invalid mode= specifier: $v->{mode}\n"; $v->{mode} = $attribs_translation->{$v->{mode}}[0]; $section->{$section_name}{regs}{cr0} = $attribs_translation->{$v->{mode}}[1]; $section->{$section_name}{regs}{'86m'} = $attribs_translation->{$v->{mode}}[1] ^ 1; } $first_init_seen = 1; } elsif ($section_name eq 'code') { if (defined $v->{bits}) { $v->{bits} = nr $v->{bits}; $v->{bits} != 16 and $v->{bits} != 32 and die "$file_name:$.: invalid bits= specifier: $v->{bits}\n"; } defined $v->{endstub} or $v->{endstub} = 1; $attribs_translation = { 1 => 1, yes => 1, on => 1, 0 => 0, no => 0, off => 0, none => 0, omit => 0, }; defined $attribs_translation->{$v->{endstub}} or die "$file_name:$.: invalid endstub= specifier: $v->{endstub}\n"; $v->{endstub} = $attribs_translation->{$v->{endstub}}; defined $v->{list} or $v->{list} = 1; $attribs_translation = { 0 => 0, no => 0, off => 0, none => 0, omit => 0, 1 => 1, yes => 1, on => 1, default => 1, lst => 1, list => 1, listing => 1, asm => 1, 2 => 2, disasm => 2, dis => 2, }; defined $attribs_translation->{$v->{list}} or die "$file_name:$.: invalid list= specifier: $v->{list}\n"; $v->{list} = $attribs_translation->{$v->{list}}; defined $v->{start} or defined $v->{base} or die "$file_name:$.: need either start= or base= specifier\n"; if (defined $v->{start}) { defined $v->{base} || defined $v->{org} and die "$file_name:$.: start= prohibits base= and org=\n"; defined $seen_start and die "$file_name:$.: code section on line $seen_start already specified a start=\n"; $v->{base} = $v->{start}; $seen_start = $.; if (defined $v->{bits}) { defined $section->{init}{args}{bits} and $section->{init}{args}{bits} != $v->{bits} and die "$file_name:$.: start= used and bits= differs from init section's\n"; $section->{init}{args}{bits} = $v->{bits}; } ($section->{init}{regs}{cs}, $section->{init}{regs}{eip}) = parse_segofs_segmented($section, $v->{start}); $v->{org} = $section->{init}{regs}{eip}; } elsif (defined $v->{org}) { $v->{org} = nr($v->{org}, 0xFFFFFFFF); } $v->{base} = parse_segofs_or_linear($section, $v->{base}); $asm = new_tmp_file "asm"; open(A, '>', $asm) or die "$file_name: unable to open file $asm, error $!\n"; print A "%line $.+0 $file_name\n"; defined $v->{bits} and print A "\tbits $v->{bits}\n"; defined $v->{org} and printf A "\torg ".display_hex($v->{org})."\n"; print A "%line $.+1\n"; } elsif ($section_name eq 'load') { defined $v->{time} or $v->{time} = 'run'; $attribs_translation = { rt => 'run', run => 'run', runtime => 'run', now => 'now', immed => 'now', immediate => 'now', immediately => 'now', }; defined $attribs_translation->{$v->{time}} or die "$file_name:$.: invalid time= specifier: $v->{time}\n"; $v->{time} = $attribs_translation->{$v->{time}}; undef $attribs_translation; $v->{base} = parse_segofs_or_linear($section, replace_undef($v->{base}, '0')); } next; } chomp; $line = $_; unless (defined $section_name) { s/^(.*?);.*$/$1/; next if /^\s*$/; die "$file_name:$.: invalid non-empty line before first section\n"; } $section_name =~ /^;/ and next; if ($section_name eq 'load') { next if /^\s*$/; next if /^\s*;/; /^\s*(.+?)\s*(~)?\s*(=|:=)\s*(.+)$/ or die "$file_name:$.: invalid input format (common load section check)\n"; $v = \%{$section->{$section_name}{args}}; defined $section->{init}{load} or @{ $section->{init}{load} } = (); parse_memory_init($section, $v->{time} eq 'now' ? undef : \@{$section->{init}{load}}, $v->{time} eq 'now' ? $mem : undef, $v->{base}, $1, $2, $3, $4); next; } if ($section_name eq 'code') { s/^(\s*)\\\[/$1\[/; print A "$_\n"; next; } $section_name eq 'note' and next; $section_name eq 'init' or die "internal error"; our %reg_existence_masks; next if /^\s*$/; next if /^\s*;/; /^\s*(.+?)\s*(~)?\s*([:=]|:=)\s*(.+)$/ or die "$file_name:$.: invalid input format (common init section check)\n"; $i = lc $1; if ($i eq 'nasm' || $i eq 'ndisasm') { defined $2 and die "$file_name:$.: invalid input format (snake with asm)\n"; $3 ne ':' or die "$file_name:$.: colon-assignment syntax is invalid\n"; $_ = $4; s/['"](\.*?)\g1// or die "$file_name:$.: filename specification invalid\n"; $section->{$section_name}{args}{$i} = $1; next if /^\s*$/; next if /^\s*;/; die "$file_name:$.: trailing garbage after filename specification\n"; } %reg_existence_masks or %reg_existence_masks = ( (map { $_ => 0xFFFFFFFF } ( qw(cr0 cr1 cr2 cr3 cr4), qw(dr0 dr1 dr2 dr3 dr6 dr7), qw(gdtr.base idtr.base), qw(eax ebx ecx edx), qw(esi edi ebp esp), qw(eip efl), )), (map { $_ => 0xFFFF } qw(gdtr.limit idtr.limit)), (map { $_ => 0xFFFF, $_.'.base' => 0xFFFFFFFF, $_.'.limit' => 0xFFFFFFFF, $_.'.acc' => 0xFFFF, } qw(tr ldt cs ss ds es fs gs)), (map { $_ => 0xFF } qw(cpu.level cpu.sublevel)), ); unless (defined $reg_existence_masks{$i} || $i =~ /^[gl]dt\s*\[\s*\S+\s*\]$/) { parse_memory_init($section, undef, $mem, 0, $1, $2, $3, $4); next; } my $ctr = 0; defined $2 and die "$file_name:$.: invalid input format (snake with non-mem)\n"; s/^(.*?);.*$/$1/; s/^\s*(.*?)\s*$/$1/; while (/\S/) { $ctr += 1; s/^(.+?)\s*(=|:=)\s*((?:descr|desc)\s*\(.+?\)|\S+)\s*// or die "$file_name:$.:$ctr: invalid data: \"$_\""; my $r = lc $1; $v = $3; unless ($r =~ /^([gl]dt)\s*\[\s*(\S+)\s*\]$/) { %reg_existence_masks or die "internal error"; defined $reg_existence_masks{$r} or die "$file_name:$.:$ctr: invalid reg '$r' specified\n"; $v = nr($v, $reg_existence_masks{$r}); $opt_debug and warn "$file_name:$.:$ctr: debug: reg>$r< =>".display_hex($v)."<, 86m>" .replace_undef($section->{$section_name}{regs}{'86m'},'undef')."<\n"; defined $section->{$section_name}{regs}{'86m'} and ($r ne 'cr0' or ($section->{$section_name}{regs}{'86m'} xor $v&1) or ~$v&1 and die "$file_name:$.:$ctr: specified PM conflicts with cr0= here\n" or die "$file_name:$.:$ctr: specified 86M conflicts with cr0= here\n"); $section->{$section_name}{regs}{$r} = $v; next; } my ($dt_name, $sel, $selbit, $dt, $dt_base, $dt_limit); $sel = nr($2, 0xFFFF); $selbit = 0; $dt_base = $section->{init}{regs}{'gdtr.base'}; $dt_limit = $section->{init}{regs}{'gdtr.limit'}; $dt_name = uc $1; if ($dt_name eq "LDT") { $selbit = 4; $dt_base = $section->{init}{regs}{'ldtr.base'}; $dt_limit = $section->{init}{regs}{'ldtr.limit'}; } defined $dt_base and (defined $dt_limit or $opt_compat_dt) or die "$file_name:$.:$ctr: no $dt_name (" .(defined $dt_base ? (lc $dt_name).'.limit' : (lc $dt_name).'.base' .(! defined $dt_limit ? ', '.(lc $dt_name).'.limit' : ''))." uninitialised)\n"; defined $dt_limit or $opt_quiet or warn "$file_name:$.:$ctr: ".(lc $dt_name).'.limit' ." uninitialised, default used\n"; defined $dt_limit or $dt_limit = 0xFFFF; $dt = ($sel | 7); $dt <= $dt_limit or die "$file_name:$.:$ctr: descriptor is not in $dt_name\n"; $dt &= ~7; $dt += $dt_base; ($sel & 7) == $selbit or die "$file_name:$.:$ctr: invalid $dt_name index: ".display_hex($sel)."\n"; $sel & ~3 or $v =~ /^0$/ or $opt_quiet or warn "$file_name:$.:$ctr: warning: non-null descriptor in GDT index 0\n"; $v =~ /^0$/ and $v = 'descr(,)'; $v =~ s/^(?:descr|desc)\s*\(\s*(.+)\s*\)$/$1/i or die "$file_name:$.:$ctr: invalid data: \"$v\"\n"; my %desc_elems = (base => undef, limit => undef, acc => undef); for (split ',', $v) { /^\s*(.+?)\s*(?:=|:=)\s*(.*)\s*$/ or die "$file_name:$.:$ctr: invalid empty descriptor element '$_'\n"; my $elem = lc $1; exists $desc_elems{$elem} or die "$file_name:$.:$ctr: invalid descriptor element '$elem'\n"; defined $desc_elems{$elem} and die "$file_name:$.:$ctr: duplicate descriptor element ($elem)\n"; $desc_elems{$elem} = nr ($2, ($elem eq 'acc' ? 0xFFF : 0xFFFFFFFF)); } foreach (qw(base limit acc)) { defined $desc_elems{$_} or $desc_elems{$_} = 0; } ($desc_elems{acc} & ~0xCFF) and die "$file_name:$.:$ctr: invalid access rights\n"; if (($desc_elems{acc} & 0x800)) { ($desc_elems{limit} & 0xFFF) == 0xFFF or die "$file_name:$.:$ctr: invalid limit (not page-aligned)\n"; $desc_elems{limit} >>= 12; $desc_elems{limit} &= 0xFFFFF; } $desc_elems{limit} <= 0xFFFFF or die "$file_name:$.:$ctr: invalid limit (too high for byte granularity)\n"; $mem->{$dt} = $desc_elems{limit} & 0xFF; $mem->{$dt + 1} = ($desc_elems{limit} >> 8) & 0xFF; $mem->{$dt + 2} = $desc_elems{base} & 0xFF; $mem->{$dt + 3} = ($desc_elems{base} >> 8) & 0xFF; $mem->{$dt + 4} = ($desc_elems{base} >> 16) & 0xFF; $mem->{$dt + 5} = $desc_elems{acc} & 0xFF; $mem->{$dt + 6} = (($desc_elems{acc} >> 4) & 0xF0) + (($desc_elems{limit} >> 16) & 0xF); $mem->{$dt + 7} = ($desc_elems{base} >> 24) & 0xFF; } } close F; defined $first_init_seen or die "$file_name:$.: missing init section (file is empty)\n"; ($i = $file_name) =~ s/\.tst$/.init/ or die "internal error"; open(W, '>', $i) or die "$file_name: unable to open file $i, error $!\n"; $section_name = 'init'; $v = \%{$section->{$section_name}}; @i = (); foreach (sort keys %{$v->{args}}) { $v->{args}{$_} eq $_ and next; push @i, "$_ = $v->{args}{$_}"; } @i and print W "\n; ".join(', ', @i)."\n"; { our @rands; while (@rands and $rands[$#rands] == 0) { pop @rands; pop @rands; } if (@rands) { print W "; srands and usages: ".join(', ', @rands)."\n"; } } if($v->{regs}) { print W "\n"; print_regs $section, $v->{regs}; } if (@{replace_undef($v->{load},[])}) { print W "\n"; } foreach (@{replace_undef($v->{load},[])}) { print W $_."\n"; } foreach ($v->{listing}) { print_listing $_; } if($mem) { print W "\n"; print_mem $mem; } close W; } # call with (ref-to-load-array, ref-to-mem, # base, assign-target, snake, # assign-op, assign-val) # Only one of the refs is defined; # the one that is defined implies whether to process the file load (now) # or (later) write a line similar to the input line to the output. # assign-val includes trailing blanks and a trailing comment. # snake is undef or '~'. sub parse_memory_init { our ($opt_quiet, $file_name, $opt_compat_in, $opt_debug_load); my $section = shift; my $load = shift; my $mem = shift; my $base = shift; local $_ = shift; my $snake = shift; my $assignop = shift; my $assignval = shift; my ($addr, $i, @i); my $repeating = 0; defined $section and (defined $load xor defined $mem) and defined $base and defined $_ and ! defined $snake || $snake eq '~' and defined $assignop and defined $assignval or die "internal error"; $assignop eq ':' and $opt_compat_in == 0 and die "$file_name:$.: colon-assignment syntax is invalid\n"; $assignop ne ':' or $opt_quiet or warn "$file_name:$.: warning: colon-assignment syntax is obsolete\n"; if (/^(\d\S*?)\s*(\.\.|[-lL\s])\s*(\d\S*?)$/) { $addr = nr($1, 0xFFFFFFFF); $i = nr($3, 0xFFFFFFFF); uc $2 eq 'L' and $i += $addr-1; $i += $base; $addr += $base; $i > 0xFFFFFFFF || $addr > 0xFFFFFFFF and die "$file_name:$.: invalid address range\n"; $addr <= $i or die "$file_name:$.: invalid address range\n"; # basic syntax blocks expressed in regexp: # {xyz} xyz # [xyz] (?:xyz)? # xyz|abc (?:xyz|abc) can not need group, then literal syntax # these then just have to be properly nested etc $assignval =~ /^ # [ ? [ { S[ TATUS] [ OCTET ] [ AT ]}} xyz ] ] (\?\s*(?: S(?:TATUS)?\s* (?:OCTET \s*)? (?:AT\s*)? ([0-9A-F]\S*)\s*)?)? # [ { L[ ENGTH] [ QUADLET ] [ AT ]}} xyz ] (?: L(?:ENGTH)?\s* (?:QUADLET\s*)? (?:AT\s*)? ([0-9A-F]\S*)\s*)? # [ LOAD ] [ FILE ] "|'etc (?:LOAD\s*)?(?:FILE\s*)?(["'].*)$ /ix and return parse_loadfile($section, $load, $mem, $addr, $i, $snake, $1, $2, $3, $4, $assignval); defined $snake and die "$file_name:$.: invalid input format (snake with values)\n"; $assignval =~ s/^(.*?);.*$/$1/; $assignval =~ s/^(.*?)\s*$/$1/; $assignval =~ s/^R(?:EPEAT)?\s+//i and $repeating = 1; @i = split (' ', $assignval); @i or die "$file_name:$.: no values for address range\n"; @i > $i-$addr+1 and die "$file_name:$.: too many values (".(@i).") for address range (".($i-$addr+1).")\n"; @i == $i-$addr+1 or $repeating or ($opt_compat_in and ($opt_quiet or warn "$file_name:$.: warning: implicit repetition is obsolete\n")) or die "$file_name:$.: too few values (".(@i).") for address range (".($i-$addr+1).")\n"; @i == $i-$addr+1 and $repeating and warn "$file_name:$.: warning: unnecessary repetition specified\n"; if (defined $load or $opt_debug_load) { if (defined $load) { our $randnow_semantics = 0; } my @list = map { sprintf('%02X',nr($_, 0xFF)) } @i; $_ = sprintf('%X',$addr).' = '; @i == $i-$addr+1 or $_ .= 'R '.sprintf('%X',$i-$addr+1).' '; $_ .= join(' ', @list); undef @list; if (defined $load) { our $randnow_semantics; $randnow_semantics and warn "$file_name:$.: should use only randnow here\n"; undef $randnow_semantics; $opt_debug_load and warn "$file_name:$.: debug: runtime loadmem>$_<\n"; push @$load, $_; return; } } $opt_debug_load and warn "$file_name:$.: debug: immed loadmem>$_<\n"; my $idx = 0; for (; $addr <= $i; $addr++) { $mem->{$addr} = nr($i[$idx], 0xFF); $idx += 1; $idx == @i and $idx = 0; } return; } elsif (/^(\d.*)$/) { $addr = nr($1, 0xFFFFFFFF); $addr += $base; $addr > 0xFFFFFFFF and die "$file_name:$.: invalid address range\n"; defined $snake and die "$file_name:$.: invalid input format (snake without range)\n"; $assignval =~ /^ # [ ? [ { S[ TATUS] [ OCTET ] [ AT ]}} xyz ] ] (\?\s*(?: S(?:TATUS)?\s* (?:OCTET \s*)? (?:AT\s*)? ([0-9A-F]\S*)\s*)?)? # [ { L[ ENGTH] [ QUADLET ] [ AT ]}} xyz ] (?: L(?:ENGTH)?\s* (?:QUADLET\s*)? (?:AT\s*)? ([0-9A-F]\S*)\s*)? # [ LOAD ] [ FILE ] "|'etc (?:LOAD\s*)?(?:FILE\s*)?(["'].*)$ /ix and return parse_loadfile($section, $load, $mem, $addr, $i, $snake, $1, $2, $3, $4, $assignval); $assignval =~ s/^(.*?);.*$/$1/; $assignval =~ s/^\s*(.*?)\s*$/$1/; if (defined $load or $opt_debug_load) { my @list = map { sprintf('%02X',nr($_, 0xFF)) } split(' ', $assignval); $_ = sprintf('%X',$addr).' = '; $_ .= join(' ', @list); undef @list; if (defined $load) { $opt_debug_load and warn "$file_name:$.: debug: runtime loadmem>$_<\n"; push @$load, $_; return; } } $opt_debug_load and warn "$file_name:$.: debug: immed loadmem>$_<\n"; map { $mem->{$addr++} = nr($_, 0xFF) } split (' ', $assignval); return; } else { die "$file_name:$.: invalid assignment target '$_'\n"; } } # call with (ref-to-load-array, ref-to-mem, # addr, endaddr, snake, # ques-entire, ques-set-status, set-length, # incbin) # Only one of the refs is defined; # the one that is defined implies whether to process the file load (now) # or (later) write a line similar to the input line to the output. # incbin includes trailing blanks and a trailing comment. # ques-entire, ques-set-status, set-length include trailing blanks. # endaddr is defined iff an arange was specified. sub parse_loadfile { our $file_name; our $opt_debug_load; my $section = shift; my $load = shift; my $mem = shift; my $addr = shift; my $endaddr = shift; my $snake = shift; my $ques_entire = shift; my $ques_status_addr = shift; my $set_length_addr = shift; local $_ = shift; defined $section and (defined $load xor defined $mem) and defined $addr and ! defined $snake || $snake eq '~' && defined $endaddr and defined $_ or die "internal error"; /^["']/ or die "internal error"; defined $ques_status_addr and $ques_status_addr = parse_segofs_or_linear($section, $ques_status_addr); defined $set_length_addr and $set_length_addr = parse_segofs_or_linear($section, $set_length_addr); unless (s/^(.)(.*?)\g1 # filename, enclosed in matching quotes (?:\s*,\s*(?:(?:FROM\s* (?:OCTET\s*)?)? (\S+?) )? (?:\s*,\s*(?:(?:AT\s* MOST\s*)? (\S+?) (?:OCTETS\s*)?)? (?:\s*,\s*(?:(?:AT\s* LEAST\s*)? (\S+?) (?:OCTETS\s*)?)? (?:\s*,\s*(?:(?:CHECK\s* EOF\s* (?:LOADED\s*)?)? (\S+?) )? )?)?)?)?\s*?(?:;.*)?$//ix) { (/^(.)(.*?)\g1 (?:\s*,\s*(?:(?:FROM\s* (?:OCTET\s*)?)? (\S+?) )? (?:\s*,\s*(?:(?:AT\s* MOST\s*)? (\S+?) (?:OCTETS\s*)?)? (?:\s*,\s*(?:(?:AT\s* LEAST\s*)? (\S+?) (?:OCTETS\s*)?)? (?:\s*,\s*(?:(?:CHECK\s* EOF\s* (?:LOADED\s*)?)? (\S+?) )? )?)?)?)?/ix) and die "$file_name:$.: trailing garbage behind loadfile specification\n"; die "$file_name:$.: loadfile specification invalid\n"; } my ($quote, $fname, $ofs, $maxlen, $minlen, $eofcheck) = ( $1, $2, $3, $4, $5, $6); defined $minlen and $minlen = nr($minlen, 0xFFFFFFFF); defined $maxlen and $maxlen = nr($maxlen, 0xFFFFFFFF); if (defined $ofs) { $ofs = nr($ofs, 0xFFFFFFFF); } else { $ofs = 0; } defined $eofcheck and $eofcheck = nr($eofcheck, 1); if (defined $endaddr) { my $len = $endaddr-$addr+1; unless (defined $snake) { if (defined $minlen) { $minlen > $len and die "$file_name:$.: loadfile minimum length conflicts\n"; warn "$file_name:$.: loadfile minimum length ignored\n"; } $minlen = $len; } if (defined $maxlen) { $maxlen < $len and die "$file_name:$.: loadfile maximum length conflicts\n"; warn "$file_name:$.: loadfile maximum length ignored\n"; } $maxlen = $len; defined $eofcheck or $eofcheck = 1; } defined $eofcheck or $eofcheck = 0; defined $minlen or $minlen = 0; defined $maxlen and $minlen > $maxlen and die "$file_name:$.: loadfile length constraints conflict\n"; $quote eq "'" and $fname !~ /"/ and $quote = '"'; if (defined $load or $opt_debug_load) { $_ = sprintf('%X',$addr).' = '; if (defined $ques_entire) { $_ .= '?'; defined $ques_status_addr and $_ .= 'S '.sprintf('%X',$ques_status_addr); $_ .= ' '; } defined $set_length_addr and $_ .= 'L '.sprintf('%X',$set_length_addr).' '; $_ .= $quote.$fname.$quote.', '; if ($ofs != 0 || defined $maxlen || $minlen != 0 || $eofcheck) { $_ .= sprintf('%X',$ofs); $_ .= ', '; defined $maxlen and $_ .= sprintf('%X',$maxlen); $_ .= ', '; $minlen != 0 and $_ .= sprintf('%X',$minlen); $_ .= ', '; $eofcheck and $_ .= '1'; } s/, $//g; s/, ,([^$quote]*)$/,,$1/g; if (defined $load) { $opt_debug_load and warn "$file_name:$.: debug: runtime loadfile>$_<\n"; push @$load, $_; return; } $opt_debug_load and warn "$file_name:$.: debug: immed loadfile>$_<\n"; } defined $maxlen or $maxlen = 0xFFFFFFFF - $addr; my ($counter, $status, $fsize) = (0, 0, undef); while (1) { $status = 2; -e $fname and -f $fname or last; $fsize = -s $fname; defined $fsize or last; $status = 38; $fsize >= $ofs+$minlen or last; $status = 8; $eofcheck == 0 or $fsize <= $ofs+$maxlen or last; $status = 0; open(L, '<', $fname) or die "$file_name:$.: unable to open file $quote$fname$quote, error $!\n"; binmode(L); sysseek(L, $ofs, 0); my $buffer; my $buffersize = 8192; my $readlen = $buffersize-($ofs % $buffersize); while (1) { $counter+$readlen > $maxlen and $readlen = $maxlen - $counter; $readlen or last; my $ret = sysread(L, $buffer, $readlen); defined $ret or die "$file_name:$.: unable to read file $quote$fname$quote, error $!\n"; { use bytes; bytes::length($buffer) == $ret or die "internal error"; } $counter += $ret; foreach (unpack "C*", $buffer) { $mem->{$addr++} = $_; } $ret == $readlen or last; $readlen = $buffersize; } close(L); $counter >= $minlen or die "$file_name:$.: file $quote$fname$quote is shorter than expected\n"; loadfile_set_length($mem, $set_length_addr, $counter); loadfile_set_status($mem, $ques_status_addr, 0); return; } my $msg = { 2 => 'not found', 38 => 'too short', 8 => 'too long' }->{$status}; defined $msg or die "internal error"; defined $ques_entire or die "$file_name:$.: file $quote$fname$quote $msg\n"; loadfile_set_length($mem, $set_length_addr, 0); loadfile_set_status($mem, $ques_status_addr, $status); return; } sub loadfile_set_length { my ($mem, $addr, $data) = (shift, shift, shift); defined $mem and defined $data and ($data & ~ 0xFFFFFFFF) == 0 or die "internal error"; defined $addr or return; foreach (0..3) { $mem->{$addr} = $data & 0xFF; $addr += 1; $data >>= 8; } } sub loadfile_set_status { my ($mem, $addr, $data) = (shift, shift, shift); defined $mem and defined $data and ($data & ~ 0xFF) == 0 or die "internal error"; defined $addr or return; $mem->{$addr} = $data & 0xFF; } sub add_interrupt_table { local $_; my (%int, $i, $eip, $org, $idt_base, $cs, $addr); my $section = shift; my $file = shift; our $file_name; open(L, '<', $file); while() { if(/^\s*(\S+)\s+interrupt_([0-9a-f]{2})(:|\s)/) { $i = $2; $_ = ; $int{$i} = $2 if(/^\s*(\S+)\s+(\S+)/); } elsif(/^\s*(\S+)\s+(\S+)\s+\S+\s+interrupt_([0-9a-f]{2})(:|\s)/) { $int{$3} = $2; } } close L; $idt_base = $section->{init}{regs}{'idtr.base'}; $cs = $section->{init}{regs}{cs}; $org = $section->{init}{regs}{eip}; for (sort keys %int) { $i = nr "0x$_"; $eip = $org + nr "0x$int{$_}"; unless ($section->{init}{regs}{'86m'}) { $addr = 8*$i + $idt_base; die "$file_name:$.: PM IDT unimplemented, stopped"; } else { $addr = 4*$i + $idt_base; $eip < 0xFFFF or die "$file_name:$.: 86M IDT entry of Int $i offset too high\n"; $section->{init}{mem}{$addr} = $eip & 0xff; $section->{init}{mem}{$addr+1} = ($eip >> 8) & 0xff; $section->{init}{mem}{$addr+2} = $cs & 0xff; $section->{init}{mem}{$addr+3} = ($cs >> 8) & 0xff; } } } sub print_listing { my $l = shift; local $_; for (@$l) { print W "\n"; for (@$_) { print W ";$_"; } } } sub print_mem { my $mem = shift; my ($base_addr, $addr, $last_addr, $i, $maxidx, $lines_since_header); local $_; our $file_name; our $opt_debug_memory; $opt_debug_memory and warn "$file_name: debug:\n"; foreach $addr (sort { $a <=> $b } keys %{$mem}) { $i = $addr & ~0xF; unless (defined $base_addr && $i == $base_addr) { if (defined $_) { $maxidx = 15-$maxidx; s/.{$maxidx}$//; print W $_."\n"; $lines_since_header += 1; $opt_debug_memory and warn " prev base:".display_hex($base_addr, 5) ." prev addr:".display_hex($last_addr, 5) ." base:".display_hex($i, 5) ." addr:".display_hex($addr, 5) ."\n"; $addr == $last_addr+1 or print W "\n"; } elsif ($opt_debug_memory) { warn "" ." base:".display_hex($i, 5) ." addr:".display_hex($addr, 5) ."\n"; } if (! defined $_ || $addr != $last_addr+1 && $lines_since_header > 30) { print W ';'.' 'x8; printf W '%3X', $_ for (0..15); print W "\n"; $lines_since_header = 0; } $base_addr = $i; $last_addr = $base_addr - 1; $_ = sprintf('%08X ', $base_addr) .' 'x(+3*8).'-'.' 'x(3*8+16); $maxidx = 0; } my $idx = $addr&15; $maxidx >= $idx or $maxidx = $idx; $i = $addr - $last_addr - 1; $i = $mem->{$addr}; substr($_, 10+$idx*3, 2, sprintf('%02X', $i)); $i < 32 || $i >= 127 and $i = 46; substr($_, 10+16*3+$idx, 1, pack('C',$i)); $last_addr = $addr; } if (defined $_) { $maxidx = 15-$maxidx; s/.{$maxidx}$//; print W $_."\n"; $opt_debug_memory and warn " prev base:".display_hex($base_addr, 5) ." prev addr:".display_hex($last_addr, 5) ."\n"; } } sub print_regs { our ($file_name, $opt_quiet); my $section = shift; my $regs = shift; my ($i, $rl, $w, $v); local $_; my @reg_list = ( 'cpu.level cpu.sublevel', '', 'cr0 cr1 cr2 cr3 cr4', 'dr0 dr1 dr2 dr3 dr6 dr7', '', 'gdtr.base gdtr.limit', 'idtr.base idtr.limit', 'tr ldtr', '', 'cs ss ds es fs gs', '', 'eax ebx ecx edx', 'esi edi ebp esp', 'eip efl' ); $regs->{'gdtr.limit'} = 0xFFFF unless defined $regs->{'gdtr.limit'}; $regs->{'idtr.limit'} = 0xFFFF unless defined $regs->{'idtr.limit'}; $regs->{'efl'} = 2 unless defined $regs->{'efl'}; for (qw (cs ss ds es fs gs)) { my $x; eval { $x = decode_descr $section, $regs->{$_} }; unless ($@) { foreach my $elem (qw(base limit acc)) { defined $regs->{"$_.$elem"} or $regs->{"$_.$elem"} = $x->{$elem}; } unless ($opt_quiet) { foreach my $elem (qw(base limit acc)) { if (zero_if_undef($regs->{"$_.$elem"}) != zero_if_undef($x->{$elem}) ) { warn "$file_name: $_: selector cache does not match " .($section->{init}{regs}{'86m'} ? 'register' : ($regs->{$_} & 4 ? 'LDT' : 'GDT'))."\n"; } } } } else { foreach my $elem (qw(base limit acc)) { $elem eq 'acc' and $section->{init}{regs}{'86m'} and next; defined $regs->{"$_.$elem"} or $regs->{"$_.$elem"} = 0; } } if (/^cs$/ and defined $section->{init}{args}{bits} and defined $regs->{"$_.acc"} ) { my $D_bit = $section->{init}{args}{bits} == 32 ? 0x400 : 0; defined $regs->{"$_.acc"} and ($regs->{"$_.acc"} & 0x400) != $D_bit and warn "$file_name: warning: $_: forcibly toggling defined D bit\n"; $regs->{"$_.acc"} &= ~0x400; $regs->{"$_.acc"} |= $D_bit; } if(! defined $regs->{"$_.acc"}) { $regs->{"$_.acc"} = $_ eq 'cs' ? 0x9B : 0x93; if (/^cs|ss$/ and defined $section->{init}{args}{bits} ) { my $D_bit = $section->{init}{args}{bits} == 32 ? 0x400 : 0; $regs->{"$_.acc"} |= $D_bit; } if($regs->{"$_.limit"} & ~0xfffff) { $regs->{"$_.acc"} |= 0x800; } } $regs->{"$_.limit"} & ~0xFFFFF and ($regs->{"$_.limit"} & 0xFFF) != 0xFFF and ($regs->{"$_.limit"} |= 0xFFF, warn "$file_name: warning: $_: limit has been increased for page alignment\n"); } for $rl (@reg_list) { $i = 0; if($rl eq '') { print W "\n"; next; } for (split ' ', $rl) { if(/^(cs|ds|es|fs|gs|ss|tr|ldtr)$/) { print W "\n" if $i; printf W "%s=%04X %s.base=%08X %s.limit=%08X %s.acc=%04X", $_, (zero_if_undef $regs->{$_}), $_, (zero_if_undef $regs->{"$_.base"}), $_, (zero_if_undef $regs->{"$_.limit"}), $_, (zero_if_undef $regs->{"$_.acc"}); } else { $w = /^cpu\.level$/ ? 1 : (/^cpu\.sublevel$/ ? 2 : (/^(gdtr|idtr)\.limit$/ ? 4 : 8)); printf W "%s%s=%0${w}X", $i ? ' ' : '', $_, (zero_if_undef $regs->{$_}); if($_ eq 'efl') { my $f = (zero_if_undef $regs->{$_}); my $d = ''; $d .= $f & 0x800 ? ' OV' : ' NV'; $d .= $f & 0x400 ? ' DN' : ' UP'; $d .= $f & 0x200 ? ' EI' : ' DI'; $d .= $f & 0x100 ? ' TP' : ' NT'; $d .= $f & 0x080 ? ' NG' : ' PL'; $d .= $f & 0x040 ? ' ZR' : ' NZ'; $d .= $f & 0x010 ? ' AC' : ' NA'; $d .= $f & 0x004 ? ' PE' : ' PO'; $d .= $f & 0x001 ? ' CY' : ' NC'; printf W " ;$d"; } } $i++; } print W "\n" if $i; } } sub zero_if_undef { my $i; $i = shift; return $i if defined $i; return 0; } sub replace_undef { my $i; $i = shift; return $i if defined $i; $i = shift; defined $i or die "internal error"; return $i; } sub nr { our ($file_name, $opt_debug, $opt_compat_rand); my ($s, $so, $n, $mask); $s = shift; $mask = shift; my $caller = ''; $opt_debug and (undef, undef, $caller) = caller; $opt_debug and $caller = " (caller: $caller)"; defined $s or die "$file_name:$.: not a valid number: $caller\n"; if (lc($s) ne 'rand' and !defined $randnow_semantics || lc($s) ne 'randnow') { $so = $s; $s =~ s/_//g; if ($s =~ s/[xh]$//i or $s =~ s/^0[xh]//i) { $s =~ /^[0-9A-Fa-f]+$/ and $n = hex $s; } elsif ($s =~ s/b$//i or $s =~ s/^0b//i) { $s =~ /^[01]+$/ and $n = oct ("0b" . $s); } elsif ($s =~ s/o$//i or $s =~ s/^0o//i) { $s =~ /^[0-7]+$/ and $n = oct ($s); } else { $s =~ /^[0-9]+$/ and $n = ($s + 0); } defined $n or die "$file_name:$.: not a valid number: $so$caller\n"; $n == 0 and $s !~ /^0+$/ and die "$file_name:$.: not a valid number: $so$caller\n"; defined $mask and $n & ~$mask and die "$file_name:$.: numeric value too high here: $so$caller\n"; return $n; } lc($s) eq 'rand' and defined $randnow_semantics and $randnow_semantics |= 1; { our @rands; $rands[$#rands] += 1; } if ($opt_compat_rand) { $n = ((int rand 0x1000000) & 0xffff00) << 8; $n += int((rand 0x1000000) / 11); defined $mask and $n &= $mask; } else { defined $mask or $mask = 0xFFFFFFFF; if ($mask < 0x10000) { $n = int rand ($mask+1); } else { $n = (int rand 0x10000)*0x10001 ^ (int rand 0x10000); } $n &= $mask; } return $n; } sub seg_ofs { my @n = split /:/, $_[0]; our $file_name; @n <3 or die "$file_name:$.: invalid seg:ofs specification: $_[0]\n"; $n[$#n] = nr($n[$#n], 0xFFFFFFFF); @n == 1 or $n[0] = nr($n[0], 0xFFFF); @n == 1 and unshift @n, undef; return @n; } sub get_num_segsel_base { my $section = shift; my $segsel = shift; defined $section and defined $segsel and ($segsel & ~0xFFFF) == 0 or die "internal error"; return decode_descr($section, $segsel)->{base}; } sub parse_segofs_or_linear { my ($section, $inp) = (shift, shift); my ($seg, $ofs) = seg_ofs $inp; defined $seg and $ofs += get_num_segsel_base($section, $seg); return $ofs; } sub parse_segofs_segmented { my ($section, $inp) = (shift, shift); my ($seg, $ofs) = seg_ofs $inp; defined $seg or $seg = 0; return ($seg, $ofs); } sub display_hex { my ($num, $width) = (shift, shift); local $_; if (defined $width) { $width += 0; $_ = sprintf("%0${width}Xh", $num); } else { $num < 10 and return sprintf('%d', $num); $_ = sprintf('%Xh', $num); } s/^([A-F].*)$/0$1/; s/^(.+)(.{4}h)$/$1_$2/; return $_; } sub decode_descr { our ($file_name, $opt_compat_dt, $opt_quiet); my ($mem, $dt, $dt_name, $base, $limit, $acc); my $section = shift; my $sel = shift; defined $section and defined $sel and ($sel & ~0xFFFF) == 0 or die "internal error"; ($section->{init}{regs}{cr0} & 1) == 0 and return { base => $sel << 4, limit => 0xFFFF, acc => undef }; $sel & ~3 or return { base => 0, limit => 0, acc => 0 }; $base = $section->{init}{regs}{'gdtr.base'}; $limit = $section->{init}{regs}{'gdtr.limit'}; $dt_name = "GDT"; if ($sel & 4) { $base = $section->{init}{regs}{'ldtr.base'}; $limit = $section->{init}{regs}{'ldtr.limit'}; $dt_name = "LDT"; } defined $base and (defined $limit or $opt_compat_dt) or die "$file_name:$.: no $dt_name (" .(defined $base ? (lc $dt_name).'.limit' : (lc $dt_name).'.base' .(! defined $limit ? ', '.(lc $dt_name).'.limit' : ''))." uninitialised)\n"; defined $limit or $opt_quiet or warn "$file_name:$.: ".(lc $dt_name).'.limit' ." uninitialised, default used\n"; defined $limit or $limit = 0xFFFF; $dt = ($sel | 7); $dt <= $limit or die "$file_name:$.: descriptor is not in $dt_name\n"; $dt &= ~7; $dt += $base; $mem = \%{$section->{init}{mem}}; foreach ($dt..$dt+7) { defined $mem->{$_} or die "$file_name: selector $sel descriptor not initialised\n"; } $base = $mem->{$dt + 2} + ($mem->{$dt + 3} << 8) + ($mem->{$dt + 4} << 16) + ($mem->{$dt + 7} << 24); $limit = $mem->{$dt} + ($mem->{$dt + 1} << 8) + (($mem->{$dt + 6} & 0xF) << 16); $acc = $mem->{$dt + 5} + (($mem->{$dt + 6} & 0xF0) << 4); $acc & 0x800 and $limit = ($limit << 12) + 0xFFF; return { base => $base, limit => $limit, acc => $acc }; } sub new_tmp_file { local $_; my $extension = shift; our @tmp_files; defined $extension or die "internal error"; chomp ($_ = `mktemp /tmp/x86test.XXXXXXXXXX.$extension`); die "prepare_test: error: mktemp failed\n" if $?; push @tmp_files, $_; return $_; } sub cleanup { our ($opt_save_temp, @tmp_files); unlink @tmp_files unless $opt_save_temp; undef @tmp_files; }