cvsuser 02/07/14 22:12:32
Modified: . assemble.pl
config/gen/makefiles root.in
Log:
Remove dependence on XS.
Revision Changes Path
1.78 +132 -6 parrot/assemble.pl
Index: assemble.pl
===================================================================
RCS file: /cvs/public/parrot/assemble.pl,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -w -r1.77 -r1.78
--- assemble.pl 4 Jul 2002 18:36:17 -0000 1.77
+++ assemble.pl 15 Jul 2002 05:12:00 -0000 1.78
@@ -380,10 +380,7 @@
use lib "$FindBin::Bin/lib";
use Parrot::Types; # For pack_op()
use Parrot::OpLib::core;
-
-use lib "$FindBin::Bin/lib/Parrot/blib/lib";
-use lib "$FindBin::Bin/lib/Parrot/blib/arch/auto/Parrot/PakFile2";
-use Parrot::PakFile2;
+use Parrot::Config;
=head2 Assembler class
@@ -658,6 +655,133 @@
$operator->[0][0] =~ s/^([a-zA-Z]+)/${1}_keyed_integer/;
}
+=item constant_table
+
+Constant table returns a hash with the length in bytes of the constant table
+and the constant table packed.
+
+=cut
+
+sub constant_table {
+ my $self = shift;
+
+ # $constl = the length in bytes of the constant table
+ my ($constl, $wordsize);
+ my $const = "";
+
+ $constl = $wordsize = $PConfig{'opcode_t_size'};
+ my $packtype = $PConfig{'packtype_op'};
+
+ for(@{$self->{constants}}) {
+ # if it's a string constant.
+ if ($_->[0] eq 'S') {
+ # Length of the string in bytes.
+ my $slen = length($_->[1]);
+ # The number of bytes to fill in the last opcode_t holding the string
constant.
+ my $fill = ($slen % $wordsize) ? $wordsize - $slen % $wordsize : 0;
+ # Length of the whole constant.
+ $constl += 6 * $wordsize + $slen + $fill;
+ # Constant type, S
+ $const .= pack($packtype,0x73);
+ # The size of the Parrot string.
+ $const .= pack($packtype, 3 * $wordsize + $slen + $fill + $wordsize);
+ # Flags
+ $const .= pack($packtype,0x0);
+ # Encoding
+ $const .= pack($packtype,0x0);
+ # Type
+ $const .= pack($packtype,0x0);
+ # Length of string alone in bytes
+ $const .= pack($packtype,$slen);
+ # The string it self.
+ $const .= $_->[1] . "\0" x $fill;
+ }
+ # if it's a float constant.
+ elsif ($_->[0] eq 'N') {
+ # The size of the whole constant.
+ $constl += 2 * $wordsize + $PConfig{numvalsize};
+ # Constant type, N
+ $const .= pack($packtype,0x6e);
+ # Sizeof the Parrot floatval.
+ $const .= pack($packtype,$PConfig{numvalsize});
+ # The number if self.
+ $const .= pack($PConfig{'packtype_n'},$_->[1]);
+ }
+ }
+
+ return ('table' => $const,
+ 'length' => $constl);
+}
+
+
+=item output_bytecode
+
+Returns a string with the Packfile.
+
+First process the constants and generate the constant table to be able to make
+the packfile header, then return all.
+
+=cut
+
+sub output_bytecode {
+ my $self = shift;
+ my $wordsize;
+
+ $wordsize = $PConfig{'opcode_t_size'};
+ my $packtype = $PConfig{'packtype_op'};
+
+ my %const_table = constant_table($self);
+
+ my $packfile_header = {
+ wordsize => $wordsize, # unsigned char wordsize
+ byteorder => 0x00, # unsigned char byteorder
+ major => 0x00, # unsigned char major
+ minor => 0x00, # unsigned char minor
+
+ flags => 0x00, # unsigned char flags
+ floattype => 0x00, # unsigned char floattype
+ pad => [
+ 0x19, # unsigned char pad[0]
+ 0x40, # unsigned char pad[1]
+
+ 0xe4, # unsigned char pad[2]
+ 0x73, # unsigned char pad[3]
+ 0x09, # unsigned char pad[4]
+ 0x08, # unsigned char pad[5]
+
+ 0x00, # unsigned char pad[6]
+ 0x00, # unsigned char pad[7]
+ 0x00, # unsigned char pad[8]
+ 0x00 # unsigned char pad[9]
+ ],
+
+ magic => 0x0131_55a1, # opcode_t magic
+ opcodetype => 0x5045_524c, # opcode_t opcodetype
+ fixup_ss => 0x0000_0000, # opcode_t fixup_ss
+ const_ss => $const_table{'length'}, # opcode_t const_ss
+ bytecode_ss => $self->{num_constants}, # opcode_t bytecode_ss
+ };
+
+ my $packfile_string = "CCCCCC".("C"x10).$packtype x5;
+
+ return pack($packfile_string,
+ $packfile_header->{wordsize}, # C
+ $packfile_header->{byteorder}, # C
+ $packfile_header->{major}, # C
+ $packfile_header->{minor}, # C
+ $packfile_header->{flags}, # C
+ $packfile_header->{floattype}, # C
+ @{$packfile_header->{pad}}, # "C" x 10
+ $packfile_header->{magic},
+ $packfile_header->{opcodetype},
+ $packfile_header->{fixup_ss},
+ $packfile_header->{const_ss},
+ $packfile_header->{bytecode_ss}) .
+ $const_table{'table'} .
+ pack ($packtype,length($self->{bytecode})) .
+ $self->{bytecode};
+}
+
=item to_bytecode
Take the content array ref and turn it into a ragged AoAoA of operations with
@@ -850,12 +974,14 @@
$self->_generate_bytecode(); # XXX merged, but I'm not going to worry about
# XXX it right now.
- return Parrot::PakFile2::output_bytecode({
+ return output_bytecode({
bytecode => $self->{bytecode},
- constants => $self->{ordered_constants}
+ constants => $self->{ordered_constants},
+ num_constants => $self->{num_constants}
});
}
+
package main;
use strict;
1.15 +1 -4 parrot/config/gen/makefiles/root.in
Index: root.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/root.in,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- root.in 14 Jul 2002 10:34:19 -0000 1.14
+++ root.in 15 Jul 2002 05:12:32 -0000 1.15
@@ -159,7 +159,7 @@
libparrot$(A) : $(O_DIRS) $(O_FILES)
$(AR_CRS) $@ $(O_FILES)
-$(TEST_PROG) : test_main$(O) $(GEN_HEADERS) $(O_DIRS) $(O_FILES)
lib/Parrot/OpLib/core.pm lib/Parrot/PMC.pm lib/Parrot/.dummy
+$(TEST_PROG) : test_main$(O) $(GEN_HEADERS) $(O_DIRS) $(O_FILES)
lib/Parrot/OpLib/core.pm lib/Parrot/PMC.pm
$(LD) ${ld_out}$(TEST_PROG) $(LDFLAGS) $(O_FILES) test_main$(O) $(C_LIBS)
lib_deps_object : $(O_DIRS) $(O_FILES)
@@ -405,9 +405,6 @@
docs : docs/.dummy
#newasm : $(TEST_PROG) lib/Parrot/.dummy
-
-lib/Parrot/.dummy :
- cd lib && cd Parrot && $(PERL) Makefile.PL && $(MAKE) && cd .. && cd ..
docs/.dummy :
cd docs && $(MAKE) && cd ..
