Byteloader patching from Enache continues;

[p5sagit/p5-mst-13.2.git] / ext / B / B / Assembler.pm

diff --git a/ext/B/B/Assembler.pm b/ext/B/B/Assembler.pm
index 10ae81b..989e1e1 100644 (file)
--- a/ext/B/B/Assembler.pm
+++ b/ext/B/B/Assembler.pm
@@ -12,9 +12,11 @@ use B::Asmdata qw(%insn_data @insn_name);
 use Config qw(%Config);
 require ByteLoader;            # we just need its $VERSIOM
 
+no warnings;                   # XXX
+
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(assemble_fh newasm endasm assemble);
-$VERSION = 0.04;
+@EXPORT_OK = qw(assemble_fh newasm endasm assemble asm);
+$VERSION = 0.06;
 
 use strict;
 my %opnumber;
@@ -72,7 +74,7 @@ sub B::Asmdata::PUT_U32 {
 }
 sub B::Asmdata::PUT_I32 {
     my $arg = limcheck( $_[0], -0x80000000, 0x7fffffff, 'I32' );
-    pack("L", $arg);
+    pack("l", $arg);
 }
 sub B::Asmdata::PUT_NV  { sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...)
                                                   # may not even be portable between compilers
@@ -128,25 +130,22 @@ sub B::Asmdata::PUT_none {
     return "";
 }
 sub B::Asmdata::PUT_op_tr_array {
-    my $arg = shift;
-    my @ary = split(/\s*,\s*/, $arg);
-    if (@ary != 256) {
-       error "wrong number of arguments to op_tr_array";
-       @ary = (0) x 256;
-    }
-    return pack("S256", @ary);
+    my @ary = split /\s*,\s*/, shift;
+    return pack "S*", @ary;
 }
-# XXX Check this works
-# Note: $arg >> 32 is a no-op on 32-bit systems
+
 sub B::Asmdata::PUT_IV64 {
-    my $arg = shift;
-    return pack("LL", ($arg >> 16) >>16 , $arg & 0xffffffff);
+    return pack "Q", shift;
 }
 
 sub B::Asmdata::PUT_IV {
     $Config{ivsize} == 4 ? &B::Asmdata::PUT_I32 : &B::Asmdata::PUT_IV64;
 }
 
+sub B::Asmdata::PUT_PADOFFSET {
+    $Config{ptrsize} == 8 ? &B::Asmdata::PUT_IV64 : &B::Asmdata::PUT_U32;
+}
+
 my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
             b => "\b", f => "\f", v => "\013");
 
@@ -160,9 +159,8 @@ sub uncstring {
 sub strip_comments {
     my $stmt = shift;
     # Comments only allowed in instructions which don't take string arguments
+    # Treat string as a single line so .* eats \n characters.
     $stmt =~ s{
-       (?sx)   # Snazzy extended regexp coming up. Also, treat
-               # string as a single line so .* eats \n characters.
        ^\s*    # Ignore leading whitespace
        (
          [^"]* # A double quote '"' indicates a string argument. If we
@@ -170,7 +168,7 @@ sub strip_comments {
        )
        \s*\#   # Any amount of whitespace plus the comment marker...
        .*$     # ...which carries on to end-of-string.
-    }{$1};     # Keep only the instruction and optional argument.
+    }{$1}sx;   # Keep only the instruction and optional argument.
     return $stmt;
 }
 
@@ -187,8 +185,6 @@ sub gen_header {
     $header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]);
     $header .= B::Asmdata::PUT_U32($Config{ivsize});
     $header .= B::Asmdata::PUT_U32($Config{ptrsize});
-    $header .= B::Asmdata::PUT_strconst(sprintf(qq["0x%s"], $Config{byteorder}));
-
     $header;
 }
 
@@ -286,6 +282,17 @@ sub assemble {
     }
 }
 
+### temporary workaround
+
+sub asm {
+    return if $_[0] =~ /\s*\W/;
+    if (defined $_[1]) {
+       return if $_[1] eq "0" and $_[0] !~ /^(?:newsvx?|av_pushx?|xav_flags)$/;
+       return if $_[1] eq "1" and $_[0] =~ /^(?:sv_refcnt)$/;
+    }
+    assemble "@_";
+}
+
 1;
 
 __END__