Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Abstract the argument and opcode packing types and functions out into

a separate module. This *should* help us maintain consistency when we
change the various types.


git-svn-id: https://svn.parrot.org/parrot/trunk@200 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit 6fba4381d98a9bc0fe590880945550a787fb3234 1 parent 38d0400
@simoncozens simoncozens authored
View
34 Configure.pl
@@ -139,16 +139,42 @@ END
print <<"END";
+Done. Now I'm figuring out what formats to pass to pack() for the
+various Parrot internal types.
+END
+
+my %pack_type;
+# Alas perl5.7.2 doesn't have an IV flag for pack().
+# The ! modifier only works for perl 5.6.x or greater.
+if (($] >= 5.006) && ($c{ivsize} == $c{longsize}) ) {
+ $c{packtype_i} = 'l!';
+ $c{packtype_op} = 'l!';
+}
+elsif ($c{ivsize} == 4) {
+ $c{packtype_i} = 'l';
+ $c{packtype_op} = 'l';
+}
+elsif ($c{ivsize} == 8) {
+ $c{packtype_i} = 'q';
+ $c{packtype_op} = 'l';
+}
+
+$c{packtype_n} = 'd';
+
+print <<"END";
+
Okay, that's finished. I'm now going to write your very
-own Makefile, config.h, and Parrot::Config to disk.
+own Makefile, config.h, Parrot::Types, and Parrot::Config to disk.
END
-#now let's assemble the config.h file
+# now let's assemble the config.h file
buildfile("config_h", "include/parrot");
-#and the makefile
+# and the makefile
buildfile("Makefile");
-#and Parrot::Config
+# and Parrot::Config
buildconfigpm();
+# and the types file
+buildfile("Types_pm", "Parrot");
print <<"END";
View
1  MANIFEST
@@ -10,6 +10,7 @@ Parrot/PackFile/FixupTable.pm
Parrot/Test.pm
README
TODO
+Types_pm.in
assemble.pl
basic_opcodes.ops
build_interp_starter.pl
View
70 Types_pm.in
@@ -0,0 +1,70 @@
+package Parrot::Types;
+use strict;
+use Exporter;
+use Carp;
+
+@Parrot::Types::ISA = qw(Exporter);
+@Parrot::Types::EXPORT = qw(&sizeof
+ &pack_op &unpack_op &shift_op
+ &pack_arg &unpack_arg &shift_arg);
+
+my %pack_type = (
+ i => q/${packtype_i}/,
+ n => q/${packtype_n}/,
+ op => q/${packtype_op}/,
+);
+
+my %how_to_pack = (
+ I => $pack_type{i},
+ i => $pack_type{i},
+ N => $pack_type{i},
+ n => $pack_type{n},
+ S => $pack_type{i},
+ s => $pack_type{i},
+ D => $pack_type{i},
+ op => $pack_type{op},
+);
+
+my %sizeof;
+foreach (keys %how_to_pack) {
+ $sizeof{$_}=length(pack($how_to_pack{$_},0));
+}
+
+sub sizeof {
+ my $what = shift;
+ croak "Don't know what a $what is" unless exists $sizeof{$what};
+ return $sizeof{$what};
+}
+
+sub pack_op { return pack ($how_to_pack{op}, shift) }
+sub unpack_op { return unpack($how_to_pack{op}, shift) }
+sub shift_op { my $op = substr($_[0], 0, sizeof("op"), ''); return unpack_op($op) }
+
+sub pack_arg {
+ croak "Don't know what a $_[0] is" unless exists $sizeof{$_[0]};
+ return pack ($how_to_pack{$_[0]}, $_[1])
+}
+sub unpack_arg{
+ croak "Don't know what a $_[0] is" unless exists $sizeof{$_[0]};
+ return unpack($how_to_pack{$_[0]}, $_[1])
+}
+sub shift_arg {
+ my $arg = substr($_[1], 0, sizeof($_[0]), '');
+ return unpack_arg($_[0], $arg)
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parrot::Types - Basic types for Parrot
+
+=head1 SYNOPSIS
+
+ use Parrot::Types;
+
+ $opcode = pack_op($opnumber) . pack_arg("I", $ireg) . ...
+
+=head1 DESCRIPTION
View
9 assemble.pl
@@ -7,6 +7,7 @@
use strict;
use Getopt::Long;
use Parrot::Opcode;
+use Parrot::Types;
use Parrot::Config;
use Symbol;
@@ -133,7 +134,7 @@
while(scalar(@{$local_fixup{$label}})) {
my $op_pc=shift(@{$local_fixup{$label}});
my $offset=shift(@{$local_fixup{$label}});
- substr($bytecode,$offset,$sizeof{'i'})=pack($pack_type{'i'},($pc-$op_pc)/$sizeof{'i'});
+ substr($bytecode,$offset,sizeof('i'))=pack_arg('i', ($pc-$op_pc)/sizeof('i'));
}
delete($local_fixup{$label});
}
@@ -148,7 +149,7 @@
while(scalar(@{$fixup{$label}})) {
my $op_pc=shift(@{$fixup{$label}});
my $offset=shift(@{$fixup{$label}});
- substr($bytecode,$offset,$sizeof{'i'})=pack($pack_type{'i'},($pc-$op_pc)/$sizeof{'i'});
+ substr($bytecode,$offset,sizeof('i'))=pack_arg('i', ($pc-$op_pc)/sizeof('i'));
}
delete($fixup{$label});
}
@@ -320,7 +321,7 @@
if (@args != $opcodes{$opcode}{ARGS}) {
error("Wrong arg count--got ".scalar(@args)." needed ".$opcodes{$opcode}{ARGS}." in <$_>" ,$file,$line);
}
- $bytecode .= pack $pack_type{'i'}, $opcodes{$opcode}{CODE};
+ $bytecode .= pack_op($opcodes{$opcode}{CODE});
$op_pc=$pc;
$pc+=$sizeof{'i'};
@@ -359,7 +360,7 @@
$args[$_]=oct($args[$_]) if($args[$_]=~/^0/);
$pc+=$sizeof{$rtype};
}
- $bytecode .= pack $pack_type{$type}, $args[$_];
+ $bytecode .= pack_arg($rtype, $args[$_]);
}
if($options{'listing'}) {
# add line to listing.
View
43 disassemble.pl
@@ -15,6 +15,7 @@
use Parrot::Config;
use Parrot::Opcode;
+use Parrot::Types;
use Parrot::PackFile;
use Parrot::PackFile::ConstTable;
@@ -23,35 +24,6 @@
# GLOBAL VARIABLES:
#
-my %unpack_type;
-if (($] >= 5.006) && ($PConfig{ivsize} == $PConfig{longsize}) ) {
- %unpack_type = ('i'=>'l!','n'=>'d');
-}
-elsif ($PConfig{ivsize} == 4) {
- %unpack_type = ('i'=>'l','n'=>'d');
-}
-elsif ($PConfig{ivsize} == 8) {
- %unpack_type = ('i'=>'q','n'=>'d');
-}
-else {
- die("I don't know how to pack an IV!\n");
-}
-
-my(%real_type)=('I'=>'i','i'=>'i',
- 'N'=>'i','n'=>'n',
- 'S'=>'i','s'=>'i',
- 'D'=>'i');
-my(%type_swap)=('I'=>'i', 'N'=>'n',
- 'S'=>'s', 'P'=>'p',
- 'i'=>'ic', 'n'=>'nc',
- 's'=>'sc', 'D'=>'ic');
-
-my %unpack_size;
-foreach (keys(%real_type)) {
- $unpack_size{$_}=length(pack($unpack_type{$real_type{$_}},0));
- $unpack_type{$_} = $unpack_type{$real_type{$_}};
-}
-
my %opcodes = Parrot::Opcode::read_ops();
my $opcode_fingerprint = Parrot::Opcode::fingerprint();
my @opcodes;
@@ -106,11 +78,12 @@ sub disassemble_byte_code {
print "# Code Section\n";
my $offset=0;
+ my $bytecode = $pf->byte_code;
- while ($offset + 4 <= $length) {
+ while ($bytecode) {
my $op_start = $offset;
- my $op_code = unpack "x$offset l", $pf->byte_code;
- printf "%08x: %-10s", $op_start, $opcodes[$op_code]{NAME};
+ my $op_code = shift_op($bytecode);
+ printf "%08x: %-15s", $op_start, $opcodes[$op_code]{NAME};
$offset += 4;
my $arg_count = $opcodes[$op_code]{ARGS};
@@ -123,13 +96,13 @@ sub disassemble_byte_code {
foreach (0 .. $arg_count - 1) {
my $type = $opcodes[$op_code]{TYPES}[$_];
- my $unpack_type = $unpack_type{$type};
- my $unpack_size = $unpack_size{$type};
+ my $unpack_size = sizeof($type);
die "$0: Premature end of bytecode in argument.\n"
if ($offset + $unpack_size) > $length;
- my $arg = unpack "x$offset $unpack_type", $pf->byte_code;
+ my $arg = shift_arg($type, $bytecode);
+
$offset += $unpack_size;
Please sign in to comment.
Something went wrong with that request. Please try again.