All --
This now works on my system. This is a big change, so we really need
to see results from folks before we even think about committing this.
Also, I've probably made some style or portability missteps in a
change this large, so I'd appreciate some feedback there, too. If we
can make whatever changes are necessary to get this working everywhere,
I'd like to commit it so we can release 0.0.2.
Right now my sandbox is passing all its tests.
Here's a rundown of what I did:
* Changes to Types_pm.in to make life easier for some of the
packing/etc. I'm doing elsewhere. Also, we now pack 'n' as
'i'.
* Moved the guts of assemble.pl to Parrot/Assembler.pm so that
eventually we can use all these tools together inside scripts
rather than call out to the shell to run the programs.
* As I was tracking down problems, I converted the internal
documentation of the assembler to POD from comments.
* Changed the numeric regexp in the assembler to detect leading
signs and trailing exponents.
* Updated basic_opcodes.ops to fetch numeric constants from the
constant table.
* Enhanced the disassembler in a number of ways to make my life
easier while tracking down bugs (try it out). It now puts in
labels for ops that are the destinations of flow control ops.
* packfile.c now has a TRACE_PACKFILE switch that can be set
to get it to print info as it processes. I needed this while
debugging, but I can remove it or change it before committing
if its a problem.
* Updated pdump.c because it was missing a call to init_world().
* Updated process_opfunc.pl to deal with numeric constants
being stored in the constant table instead of inline.
* Added multiple type support to Parrot/PackFile/Constant.pm
* Added Parrot/String.pm, to be used for constants.
* Added packfile.[hc] functions for allocating new constants
of various types.
* Made string_copy visible to the world in parrot/string.h.
Let me know how this works for you...
Regards,
-- Gregor
_____________________________________________________________________
/ perl -e 'srand(-2091643526); print chr rand 90 for (0..4)' \
Gregor N. Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
8080 Beckett Center Drive #203 513-860-3570 vox
West Chester, OH 45069 513-860-3579 fax
\_____________________________________________________________________/
? x
? tryme.c
? tryme
? const.pbc
? const.pasm
? const2.pbc
? number.pasm
? number.pbc
? nvconst.patch
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.14
diff -u -r1.14 Makefile.in
--- Makefile.in 2001/09/26 18:13:50 1.14
+++ Makefile.in 2001/09/29 15:02:13
@@ -17,11 +17,12 @@
PERL = ${perl}
TEST_PROG = test_prog${exe}
PDUMP = pdump${exe}
+TRYME = tryme${exe}
.c.o:
$(CC) $(CFLAGS) -o $@ -c $<
-all : $(TEST_PROG) $(PDUMP)
+all : $(TEST_PROG) $(PDUMP) $(TRYME)
#XXX This target is not portable to Win32
shared: libparrot.so
@@ -33,6 +34,9 @@
$(PDUMP): pdump$(O) $(O_FILES)
$(CC) $(CFLAGS) -o $(PDUMP) $(O_FILES) pdump$(O) $(C_LIBS)
+
+$(TRYME): tryme$(O) $(O_FILES)
+ $(CC) $(CFLAGS) -o $(TRYME) $(O_FILES) tryme$(O) $(C_LIBS)
test_main$(O): $(H_FILES)
Index: Types_pm.in
===================================================================
RCS file: /home/perlcvs/parrot/Types_pm.in,v
retrieving revision 1.1
diff -u -r1.1 Types_pm.in
--- Types_pm.in 2001/09/22 13:38:42 1.1
+++ Types_pm.in 2001/09/29 15:02:13
@@ -4,10 +4,28 @@
use Carp;
@Parrot::Types::ISA = qw(Exporter);
-@Parrot::Types::EXPORT = qw(&sizeof
- &pack_op &unpack_op &shift_op
- &pack_arg &unpack_arg &shift_arg);
+@Parrot::Types::EXPORT = qw(
+ &sizeof
+ &pack_iv
+ &pack_nv
+ &pack_sv
+ &pack_op
+ &pack_arg
+
+ &unpack_iv
+ &unpack_nv
+ &unpack_sv
+ &unpack_op
+ &unpack_arg
+
+ &shift_iv
+ &shift_nv
+ &shift_sv
+ &shift_op
+ &shift_arg
+);
+
my %pack_type = (
i => q/${packtype_i}/,
n => q/${packtype_n}/,
@@ -18,11 +36,13 @@
I => $pack_type{i},
i => $pack_type{i},
N => $pack_type{i},
- n => $pack_type{n},
+ n => $pack_type{i},
S => $pack_type{i},
s => $pack_type{i},
D => $pack_type{i},
op => $pack_type{op},
+ iv => $pack_type{i},
+ nv => $pack_type{n},
);
my %sizeof;
@@ -36,8 +56,32 @@
return $sizeof{$what};
}
+sub pack_iv { return pack ($how_to_pack{iv}, shift) }
+sub pack_nv { return pack ($how_to_pack{nv}, shift) }
+sub pack_sv { return shift->pack }
sub pack_op { return pack ($how_to_pack{op}, shift) }
+
+sub unpack_iv { return unpack($how_to_pack{iv}, shift) }
+sub unpack_nv { return unpack($how_to_pack{nv}, shift) }
sub unpack_op { return unpack($how_to_pack{op}, shift) }
+
+sub shift_iv { my $iv = substr($_[0], 0, sizeof("iv"), ''); return unpack_iv($iv) }
+sub shift_nv { my $nv = substr($_[0], 0, sizeof("nv"), ''); return unpack_nv($nv) }
+sub shift_sv {
+ my $flags = shift_iv($_[0]);
+ my $encoding = shift_iv($_[0]);
+ my $type = shift_iv($_[0]);
+ my $size = shift_iv($_[0]);
+
+ my $align = sizeof("iv");
+
+ my $under = ($size % $align) ? $align - ($size % $align) : 0;
+ my $block_size = $size + $under;
+ my $data = substr($_[0], 0, $block_size, '');
+ $data = substr($data, 0, $size);
+
+ return new Parrot::String $flags, $encoding, $type, $size, $data;
+}
sub shift_op { my $op = substr($_[0], 0, sizeof("op"), ''); return unpack_op($op) }
sub pack_arg {
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.49
diff -u -r1.49 assemble.pl
--- assemble.pl 2001/09/27 14:15:41 1.49
+++ assemble.pl 2001/09/29 15:02:13
@@ -3,718 +3,17 @@
# assemble.pl - take a parrot assembly file and spit out a bytecode file
# This is based heavily on assemble.pl by Dan Sugalski
# Brian Wheeler ([EMAIL PROTECTED])
+#
use strict;
-use Getopt::Long;
-use Parrot::Opcode;
-use Parrot::Types;
-use Parrot::PackFile::ConstTable;
-use Parrot::Config;
-use Symbol;
+use Parrot::Assembler;
-# %options holds the command line options
-my %options = get_options();
-# type_to_suffix is used to change from an argument
-# type to the suffix that would be used in the
-# name of the function that contained that
-# argument.
-my(%type_to_suffix)=('I'=>'i', 'N'=>'n',
- 'S'=>'s', 'P'=>'p',
- 'i'=>'ic', 'n'=>'nc',
- 's'=>'sc', 'D'=>'ic');
-# @program will hold an array ref for each line in the
-# program. Each array ref will contain
-# 1.) The file name in which the source line was found
-# 2.) The line number in the file of the source line
-# 3.) The chomped source line without beginning and ending spaces
-# 4.) The chomped source line
-my (@program);
-
-# $output will be what is output to the bytecode file.
-# $listing will be what is output to the listing file.
-# $bytecode is the program's bytecode (executable instructions).
-my ($output, $listing, $bytecode) = ('', '', '');
-
-# $file, $line, $pline, and $sline are used to reference
-# information from the @program array. Please look
-# at the comments for @program for the description
-# of each.
-my ($file, $line, $pline, $sline) = ('','','','');
-
-# %label will hold each label and the PC at which it was defined.
-# %fixup will hold labels that have not yet been defined,
-# where they are used in the source code, and the PC at that
-# point. It is used for backpatching.
-# %macros will map a macro name to an array of program lines
-# with the same format as @program.
-# %local_label will hold local label definitions,
-# %local_fixup will hold the occurances of local labels
-# in the source file.
-# $last_label is the name of the last label seen
-my (%label, %fixup, %macros, %local_label, %local_fixup, $last_label);
-
-# pc is the current program counter. op_pc is the program counter for the
-# most recent operator.
-my ($pc, $op_pc) = (0,0);
-
-# %constants is a map of constant name to index in the constant table
-# @constants is an array of constant values in the same order that
-# they should be in the constant table
-my (%constants, @constants);
-
-# %equate maps assembler directives to their replacements.
-my %equate=('*'=>sub { return $pc },
- '__DATE__'=>'"'.scalar(localtime).'"',
- '__VERSION__'=>'" $Revision: 1.49 $ "',
- '__LINE__' => sub { return $line },
- '__FILE__' => sub { return "\"$file\"" });
-
-my %opcodes = Parrot::Opcode::read_ops( -f "../opcode_table" ? "../opcode_table" :
"opcode_table" );
-
-# initialize the assembler
init_assembler(@ARGV);
-
-# process each element in the @program array
process_program_lines();
-
-# emit the magic cookie as the first thing in the output file
-magic_cookie();
-
-# fixup the bytecode
fixup();
-
-# add constants to the bytecode
add_constants();
-
-# if we are doing more than checking syntax,
-# output the bytecode
-if( !$options{'checksyntax'} ) {
- output_bytecode();
-}
-
-# if the user wants a listing, output it
-if( $options{'listing'} ) {
- output_listing();
-}
-
-# get_options
-# this function gets and verifies the options
-# current options are:
-# checksyntax - do not emit bytecode, only check to see if the assembly is valid
-# help - emit a help message (usage)
-# version - emit the CVS revision of this file
-# verbose - output log messages
-# output - the file to output the bytecode
-# listing - the file to output the listing
-# include - a list of files to add to the source code
-# Validation checks to make sure that if either output
-# or listing is present, it has an argument (which
-# is the name of the file to output to.
-sub get_options {
- my %options;
- GetOptions(\%options,('checksyntax',
- 'help',
- 'version',
- 'verbose',
- 'output=s',
- 'listing=s',
- 'include=s@'));
-
- my(@include)=('.');
- if($options{'include'}) {
- unshift(@include,@{$options{'include'}});
- }
-
- if($options{'version'}) {
- print $0,'Version $Id: assemble.pl,v 1.49 2001/09/27 14:15:41 thgibbs Exp $
',"\n";
- exit;
- }
-
- if($options{'help'}) {
- print "$0 - Parrot Assembler
-Options:
- --checksyntax Check assembler syntax only, no output
- --help This text
- --listing Dump assembly listing to file
- --include Directory to search for included files
- --output File to dump bytecode into
- --verbose Show what's going on
- --version Show assembler version
-";
- exit;
- }
-
- if(exists($options{'output'}) && $options{'output'} eq "") {
- print STDERR "You must provide a file with --output flag!\n";
- exit;
- }
-
- if(exists($options{'listing'}) && $options{'listing'} eq "") {
- print STDERR "You must provide a file with --listing flag!\n";
- exit;
- }
- return %options;
-}
-
-# init_assembler
-# 1.) adds the opcode fingerprint to the constant table
-# 2.) adds the listing header
-# 3.) creates the program lines array from each source file passed in
-sub init_assembler {
- my @cmdln = @_;
- constantize( Parrot::Opcode::fingerprint() ); # make it constant zero.
- add_line_to_listing( "PARROT ASSEMBLY LISTING - " . scalar( localtime ) . "\n\n" );
- foreach my $file( @cmdln ) {
- push( @program, read_source( $file ) );
- }
-}
-
-# magic_cookie
-# emit 0x13155a1 as the first thing in the output.
-# If this is not present, parrot will NOT process
-# the file.
-sub magic_cookie {
- $output = pack_op( 0x13155a1 );
-}
-
-# fixup
-# checks to make sure that all labels are defined.
-# also outputs the label information to the listing.
-sub fixup {
- add_line_to_listing( "\nDEFINED SYMBOLS:\n" );
- foreach( sort( keys( %label ) ) ) {
- add_line_to_listing( sprintf( "\t%08x %s\n", $label{$_}, $_ ) );
- }
-
- if( keys( %fixup ) ) {
- print STDERR "SQUAK! These symbols were referenced but not defined:\n";
- add_line_to_listing( "\nUNDEFINED SYMBOLS:\n" );
- foreach( sort( keys( %fixup ) ) ) {
- print STDERR "\t$_ at pc: ";
- foreach my $pc (@{ $fixup{ $_ } } ) {
- print STDERR sprintf( "%08x ", $pc );
- }
- print STDERR "\n";
- add_line_to_listing( "\t$_\n" );
- }
- exit; # some day, unresolved symbols won't be an error!
- }
- else {
- # dump empty header
- $output .= pack_op(0);
- }
-}
-
-# add_constants
-# adds each constant to a ConstTable perl
-# class and then adds the packed representation
-# to the output.
-sub add_constants {
- my $const_table = new Parrot::PackFile::ConstTable;
-
- add_line_to_listing( "\nSTRING CONSTANTS\n" );
-
- # now emit each constant
- my $counter = 0;
- for( @constants ) {
- add_line_to_listing( sprintf( "\t%04x %08x [[%s]]\n", $counter, length($_), $_ )
);
- $counter++;
- $const_table->add( new Parrot::PackFile::Constant (0, 0, 0, length( $_ ), $_ ) );
- }
-
- $output .= $const_table->pack;
-}
-
-# output_bytecode
-# writes the bytecode to the output file
-# (or stdout if no filename was given).
-# Ensures the file is in binmode.
-sub output_bytecode {
- $output .= $bytecode;
- if( defined $options{'output'} and $options{'output'} ne "" ) {
- open O, ">$options{'output'}" || die $!;
- binmode O;
- print O $output;
- close O;
- }
- else {
- binmode STDOUT;
- print $output;
- }
-}
-
-# output_listing
-# outputs the listing information to the filename
-# given by the listing option.
-sub output_listing {
- open L, ">$options{'listing'}" or die $!;
- print L $listing;
- close L;
-}
-
-# process_program_lines
-# loops through each program line and checks for
-# comments, labels, and assembler directives.
-# Then, it examines the operator and arguments
-# to find the best match. Finally, it outputs
-# its information to the listing.
-sub process_program_lines {
- while( my $lineinfo = shift( @program ) ) {
- ($file, $line, $pline, $sline) = @$lineinfo;
- my $code = $pline;
- next if( is_comment($code) );
- $code = handle_label($code) if( has_label( $code ) );
- next if( !defined( $code ) || $code eq "" );
- if( has_asm_directive( $code ) ) {
- # handle_asm_directive will shift @program as needed
- # for macro processing.
- next if( handle_asm_directive($code, @program) );
- }
- $code = replace_constants( $code );
- $code =~ s/,/ /g;
-
