This response was originally tacked onto the end of another node but I decided to promote it to a new response just so it'd be more visible.
I should note - the whole point of this exercise was to find out whether things like the following code fragment would produce similar results on differing endian machines. I didn't know whether reading from B's FLAGS attribute was like using unpack 'L', unpack 'P4', pack 'L', 12+\$pad_str to read directly from memory. I'd expect the direct memory read to non-portable for a couple of reasons. I just didn't know what would happen if I read the value properly. It appears to come out alright which is just great.
As for why I'm doing something so obscure - just for obfus. It'd be no fun to write more poetry and have it fail or not work because of differing endian-ness. Thanks for playing all!
require B;
my $pad_int = 1;
$o = B::svref_2object( \ $pad_int );
$flags = $o -> FLAGS;
$type = $flags & 0xff;
$flags = $flags & ~ 0xff;
$, = " ";
print "\$pad_int == $pad_int (",type($type),flags($flags),")";
# Prints "$pad_int == 1 ( IV PADBUSY PADMY IOK pIOK OK )"
sub type { ('NULL', 'IV' , 'NV' , 'RV' , 'PV' ,
'PVIV', 'PVNV', 'PVMG', 'PVBM', 'PVLV',
'PVAV', 'PVHV', 'PVCV', 'PVGV', 'PVFM',
'PVIO')[ $_[0] ] }
# I included these routines just for fun - I already had it written d
+own
# and just transcribed it. So this is at least a sniff at the fun thi
+ngs
# you can check if you can actually do this reliably - which it appea
+rs
# you can.
sub flags {
my @flags = ();
my $flags = shift;
# Mask off the TYPE portion
$flags &= ~ 0xff;
push @flags, 'PADBUSY' if $flags & 0x100;
# reserved for tmp or my already
push @flags, 'PADTMP' if $flags & 0x200;
# in use as tmp
push @flags, 'PADMY' if $flags & 0x400;
# in use as "my" variable
push @flags, 'TEMP' if $flags & 0x800;
# string is stealable?
push @flags, 'OBJECT' if $flags & 0x1000;
# is "blessed"
push @flags, 'GMG' if $flags & 0x2000;
# has magical get method
push @flags, 'SMG' if $flags & 0x4000;
# has magical set method
push @flags, 'RMG' if $flags & 0x8000;
# has random magical methods
push @flags, 'IOK' if $flags & 0x10000;
# has valid public integer value
push @flags, 'NOK' if $flags & 0x20000;
# has valid public numeric value
push @flags, 'POK' if $flags & 0x40000;
# has valid pointer value
push @flags, 'ROK' if $flags & 0x80000;
# has a valid reference pointer
push @flags, 'FAKE' if $flags & 0x100000;
# glob or lexical is just a copy
push @flags, 'OOK' if $flags & 0x200000;
# has valid offset value
push @flags, 'BREAK' if $flags & 0x400000;
# refcnt is artificially low
push @flags, 'READONLY' if $flags & 0x800000;
# may not be modified
push @flags, 'pIOK' if $flags & 0x1000000;
# has valid non-public integer value
push @flags, 'pNOK' if $flags & 0x2000000;
# has valid non-public numeric value
push @flags, 'pPOK' if $flags & 0x4000000;
# has valid non-public pointer value
push @flags, 'SCREAM' if $flags & 0x8000000;
# has been studied?
push @flags, 'UTF8' if $flags & 0x20000000;
# SvPVX is UTF-8 encoded
push @flags, 'THINKFIRST' if $flags & (0x00800000 |
0x00080000 |
0x00100000 |
0x20000000);
# READONLY, ROK, FAKE or UTF-8
push @flags, 'OK' if $flags & (0x0010000 |
0x0020000 |
0x0040000 |
0x0080000 |
0x1000000 |
0x2000000 |
0x4000000);
# IOK, NOK, POK, ROK, pIOK, pNOK or pPOK
push @flags, 'AMAGIC' if $flags & 0x10000000;
# has magical overloaded methods
# Some private flags
# SVpad_OUR may be set on SVt_PV{NV,MG,GV} types
push @flags, 'OUR' if $flags & 0x80000000;
# pad name is "our" instead of "my"
push @flags, 'IVisUV' if $flags & 0x80000000;
# use XPVUV instead of XPVIV
push @flags, 'COMPILED' if $flags & 0x80000000;
# FORMLINE is compiled
push @flags, 'VALID' if $flags & 0x80000000;
push @flags, 'TAIL' if $flags & 0x40000000;
push @flags, 'EVAL' if $flags & 0x40000000;
# Replacemenet part of S///e
push @flags, 'SHAREKEYS' if $flags & 0x20000000;
# keys live on shared string table
push @flags, 'LAZYDEL' if $flags & 0x40000000;
# entry in xhv_eiter must be deleted
push @flags, 'WEAKREF' if $flags & 0x80000000; # Weak reference
return @flags
}
Fun Fun Fun in the Fluffy Chair | 