This patch does a couple of things:
* uses Getopt::Long for options. -c is now --checksyntax. I wasn't
sure how to keep compatible (patches welcome!)
* options include:
--help
--version
--verbose
--output=file
--listing=file
--checksyntax
* produces verbose listing of what the assembler saw :) Only one
nitpick with it: unknown symbols are given as 0xffffffff,
unfortunately, this includes symbols which may be defined later in the
file (i.e. forward jumps).
Brian
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.14
diff -r1.14 assemble.pl
7a8
> use Getopt::Long;
9,12c10,33
< my $opt_c;
< if (@ARGV and $ARGV[0] eq "-c") {
< shift @ARGV;
< $opt_c = 1;
---
> my %options;
> GetOptions(\%options,('checksyntax',
> 'help',
> 'version',
> 'verbose',
> 'output=s',
> 'listing=s'));
>
> if($options{'version'}) {
> print $0,'Version $Id$ ',"\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
> --output File to dump bytecode into
> --verbose Show what's going on
> --version Show assembler version
> ";
> exit;
14a36,44
> 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;
> }
54a85,87
> my $listing="PARROT ASSEMBLY LISTING - ".scalar(localtime)."\n\n";
>
>
62a96
> my $sline=$_;
65c99,104
< next if(/^\#/ || $_ eq "");
---
> if(/^\#/ || $_ eq "") {
> if($options{'listing'}) {
> $listing.=sprintf("%4d %08x %-44s %s\n", $line, $op_pc, '',$sline);
> }
> next;
> }
121a161
> log_message("substituting $op for $opcode");
161a202,209
> if($options{'listing'}) {
> # add line to listing.
> my $odata;
> foreach (unpack('l*',substr($bytecode,$op_pc))) {
> $odata.=sprintf("%08x ",$_);
> }
> $listing.=sprintf("%4d %08x %-44s %s\n", $line, $op_pc, $odata,$sline);
> }
163a212
> $listing.="\n" if($options{'listing'});
173c222,229
< # FIXUP
---
> # FIXUP (also, dump listing symbols)
> if($options{'listing'}) {
> $listing.="DEFINED SYMBOLS:\n";
> foreach (sort(keys(%label))) {
> $listing.=sprintf("\t%08x %s\n",$label{$_},$_);
> }
> }
>
184c240,244
< exit;
---
> $listing.="\nUNDEFINED SYMBOLS:\n";
> foreach (sort(keys(%fixup))) {
> $listing.="\t$_\n";
> }
> exit; # some day, unresolved symbols won't be an error!
195a256,258
> if($options{'listing'}) {
> $listing.="\nSTRING CONSTANTS\n";
> }
196a260
> my $counter=0;
204c268,271
< }
---
> }
> $listing.=sprintf("\t%04x %08x [[%s]]\n",$counter,length($_),$_)
> if($options{'listing'});
> $counter++;
217,218c284,298
< if(!$opt_c) {
< print $output;
---
> if(!$options{'checksyntax'}) {
> if($options{'output'} ne "") {
> open O,">$options{'output'}" || die $!;
> print O $output;
> close O;
> } else {
> print $output;
> }
> }
>
>
> if($options{'listing'}) {
> open L,">$options{'listing'}" || die $!;
> print L $listing;
> close L;
224a305,311
> }
>
> sub log_message {
> my($message)=@_;
> if($options{'verbose'}) {
> print STDERR "INFO ($line): $message\n";
> }
