simon 01/09/14 02:57:04
Modified: . Configure.pl MANIFEST assemble.pl
build_interp_starter.pl bytecode.c bytecode.h
disassemble.pl interpreter.c
Added: . Config_pm.in Makefile.in config_h.in
Removed: . Makefile config.h.in
Log:
Configure now generates Makefile
Courtesy of: Brent Dax <[EMAIL PROTECTED]>
Revision Changes Path
1.2 +73 -18 parrot/Configure.pl
Index: Configure.pl
===================================================================
RCS file: /home/perlcvs/parrot/Configure.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- Configure.pl 2001/09/11 09:43:59 1.1
+++ Configure.pl 2001/09/14 09:57:00 1.2
@@ -1,11 +1,18 @@
#!/usr/bin/perl -w
#so we get -w
-#Configre.pl, written by Brent Dax
+#Configure.pl, written by Brent Dax
use strict;
use Config;
+my($DDOK)=undef;
+eval {
+ require Data::Dumper;
+ Data::Dumper->import();
+ $DDOK=1;
+};
+
#print the header
print <<"END";
Parrot Configure
@@ -23,10 +30,16 @@
#XXX Figure out better defaults
my(%c)=(
iv => ($Config{ivtype}||'long'),
- nv => ($Config{nvtype}||'long double')
+ nv => ($Config{nvtype}||'long double'),
+ cc => $Config{cc},
+ ccflags => '-Wall -o $@',
+ libs => $Config{libs}
);
-#inquire about numeric sizes
+#ask questions
+prompt("What C compiler do you want to use?", 'cc');
+prompt("What flags would you like passed to your C compiler?", 'ccflags');
+prompt("Which libraries would you like your C compiler to include?", 'libs');
prompt("How big would you like integers to be?", 'iv');
prompt("How about your floats?", 'nv');
@@ -40,25 +53,22 @@
#set up HAS_HEADER_
foreach(grep {/^i_/} keys %Config) {
+ $c{$_}=$Config{$_};
$c{headers}.=defineifdef((/^i_(.*)$/));
}
-#now let's assemble the config.h file
-my $config_h;
-{
- local $/;
- open(CONFIG_HT, "<config.h.in") or die $!;
- $config_h=<CONFIG_HT>;
- close CONFIG_HT;
-}
+print <<"END";
+
+Okay, that's finished. I'm now going to write your very
+own Makefile, config.h, and Parrot::Config to disk.
+END
-# ${field} is replaced with $c{field}
-$config_h =~ s/\$\{(\w+)\}/$c{$1}/g;
-
-#write out the config.h file
-open(CONFIG_H, ">config.h");
-print CONFIG_H $config_h;
-close CONFIG_H;
+#now let's assemble the config.h file
+buildfile("config_h");
+#and the makefile
+buildfile("Makefile");
+#and Parrot::Config
+buildconfigpm();
print <<"END";
@@ -91,3 +101,48 @@
$c{$field}=$input||$c{$field};
}
+sub buildfile {
+ my($filename)=shift;
+
+ local $/;
+ open(IN, "<$filename.in") or die "Can't open $filename.in: $!";
+ my $text=<IN>;
+ close(IN) or die "Can't close $filename.in: $!";
+
+ $text =~ s/\$\{(\w+)\}/$c{$1}/g;
+ $filename =~ s/_/./; #config_h => config.h
+
+ open(OUT, ">$filename") or die "Can't open $filename: $!";
+ print OUT $text;
+ close(OUT) or die "Can't close $filename: $!";
+}
+
+sub buildconfigpm {
+ unless($DDOK) {
+ print <<"END";
+
+Your system doesn't have Data::Dumper installed, so I couldn't
+build Parrot::Config. If you want Parrot::Config installed,
+use CPAN.pm to install Data::Dumper and run this script again.
+END
+
+ return;
+ }
+
+ my %C=%c;
+ delete $C{headers};
+ my $dd=new Data::Dumper([\%C]);
+ $dd->Names(['*PConfig']);
+
+ local $/;
+ open(IN, "<Config_pm.in") or die "Can't open Config_pm.in: $!";
+ my $text=<IN>;
+ close(IN) or die "Can't close Config.pm_in: $!";
+
+ $text =~ s/#DUMPER OUTPUT HERE/$dd->Dump()/eg;
+
+ mkdir("Parrot") or ( $! =~ /File exists/i or die "Can't make directory
./Parrot: $!");
+ open(OUT, ">Parrot/Config.pm") or die "Can't open file Parrot/Config.pm: $!";
+ print OUT $text;
+ close(OUT) or die "Can't close file Parrot/Config.pm: $!";
+}
1.7 +3 -2 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /home/perlcvs/parrot/MANIFEST,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- MANIFEST 2001/09/13 07:57:10 1.6
+++ MANIFEST 2001/09/14 09:57:00 1.7
@@ -1,6 +1,7 @@
Configure.pl
+Config_pm.in
+Makefile.in
MANIFEST
-Makefile
README
TODO
assemble.pl
@@ -8,7 +9,7 @@
build_interp_starter.pl
bytecode.c
bytecode.h
-config.h.in
+config_h.in
disassemble.pl
docs/opcodes.pod
docs/overview.pod
1.17 +7 -2 parrot/assemble.pl
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- assemble.pl 2001/09/14 09:07:24 1.16
+++ assemble.pl 2001/09/14 09:57:01 1.17
@@ -5,6 +5,7 @@
# Brian Wheeler ([EMAIL PROTECTED])
use strict;
+use Digest::MD5 qw(&md5_hex);
use Getopt::Long;
my %options;
@@ -16,7 +17,7 @@
'listing=s'));
if($options{'version'}) {
- print $0,'Version $Id: assemble.pl,v 1.16 2001/09/14 09:07:24 simon Exp $
',"\n";
+ print $0,'Version $Id: assemble.pl,v 1.17 2001/09/14 09:57:01 simon Exp $
',"\n";
exit;
}
@@ -68,7 +69,9 @@
# get opcodes and their arg lists
open OPCODES, "<opcode_table" or die "Can't get opcode table, $!/$^E";
+my $opcode_table;
while (<OPCODES>) {
+ $opcode_table .= $_;
next if /^\s*#/;
chomp;
s/^\s+//;
@@ -81,6 +84,8 @@
$opcodes{$name}{RTYPES}=[@rtypes];
}
close OPCODES;
+my $opcode_fingerprint = md5_hex($opcode_table);
+constantize($opcode_fingerprint); # Make it constant zero.
my $listing="PARROT ASSEMBLY LISTING - ".scalar(localtime)."\n\n";
@@ -282,7 +287,7 @@
$output.=$bytecode;
if(!$options{'checksyntax'}) {
- if($options{'output'} ne "") {
+ if(defined $options{'output'} and $options{'output'} ne "") {
open O,">$options{'output'}" || die $!;
print O $output;
close O;
1.4 +12 -0 parrot/build_interp_starter.pl
Index: build_interp_starter.pl
===================================================================
RCS file: /home/perlcvs/parrot/build_interp_starter.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- build_interp_starter.pl 2001/09/11 22:21:16 1.3
+++ build_interp_starter.pl 2001/09/14 09:57:01 1.4
@@ -1,5 +1,6 @@
# !/usr/bin/perl -w
use strict;
+use Digest::MD5 qw(&md5_hex);
open INTERP, "> interp_guts.h" or die "Can't open interp_guts.h, $!/$^E";
@@ -18,8 +19,10 @@
#define BUILD_TABLE(x) do { \\
CONST
+my $opcode_table;
my $count = 1;
while (<OPCODES>) {
+ $opcode_table .= $_;
chomp;
s/#.*$//;
s/^\s+//;
@@ -30,8 +33,11 @@
print INTERP "\tx[$num] = $name; \\\n";
$count++ unless $name eq 'end';
}
+close OPCODES;
+my $opcode_fingerprint = md5_hex($opcode_table);
print INTERP "} while (0);\n";
+
# Spit out the DO_OP function
print INTERP <<EOI;
@@ -40,4 +46,10 @@
(void *)y = x[*w]; \\
w = (y)(w,z); \\
} while (0);
+EOI
+
+# Spit out the OPCODE_FINGERPRINT macro
+print INTERP <<EOI
+
+#define OPCODE_FINGERPRINT "$opcode_fingerprint"
EOI
1.7 +2 -0 parrot/bytecode.c
Index: bytecode.c
===================================================================
RCS file: /home/perlcvs/parrot/bytecode.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- bytecode.c 2001/09/14 09:03:43 1.6
+++ bytecode.c 2001/09/14 09:57:01 1.7
@@ -66,6 +66,8 @@
IV len = GRAB_IV(program_code);
IV num;
IV i = 0;
+
+ Parrot_num_string_constants = len;
if (len == 0)
return;
1.3 +1 -0 parrot/bytecode.h
Index: bytecode.h
===================================================================
RCS file: /home/perlcvs/parrot/bytecode.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- bytecode.h 2001/09/10 09:50:39 1.2
+++ bytecode.h 2001/09/14 09:57:01 1.3
@@ -10,6 +10,7 @@
void* init_bytecode(void* program_code);
+IV Parrot_num_string_constants;
VAR_SCOPE STRING** Parrot_string_constants;
#endif
1.6 +10 -0 parrot/disassemble.pl
Index: disassemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/disassemble.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- disassemble.pl 2001/09/13 07:21:37 1.5
+++ disassemble.pl 2001/09/14 09:57:02 1.6
@@ -5,6 +5,7 @@
# Turn a parrot bytecode file into text
use strict;
+use Digest::MD5 qw(&md5_hex);
my(%opcodes, @opcodes);
@@ -32,8 +33,10 @@
$opcodes{$2}{CODE} = $1;
}
+my $opcode_table;
open OPCODES, "<opcode_table" or die "Can't get opcode table, $!/$^E";
while (<OPCODES>) {
+ $opcode_table .= $_;
next if /^\s*#/;
s/^\s+//;
chomp;
@@ -48,6 +51,7 @@
TYPES => [@types]
}
}
+my $opcode_fingerprint = md5_hex($opcode_table);
$/ = \4;
@@ -62,6 +66,7 @@
my $count=unpack('l', <>);
print "# Constants: $count entries ($constants bytes)\n";
print "# ID Flags Encoding Type Size Data\n";
+ my $constant_num = 0;
foreach (1..$count) {
my $flags=unpack('l',<>);
my $encoding=unpack('l',<>);
@@ -74,7 +79,12 @@
# strip off any padding nulls
$data=substr($data,0,$size);
printf("%04x: %08x %08x %08x %08x
%s\n",$_-1,$flags,$encoding,$type,$size,$data);
+
+ die "Cannot disassemble (differing opcode table)!" if $constant_num == 0 and
$data ne $opcode_fingerprint;
+ $constant_num++;
}
+} else {
+ warn "Disassembling without opcode table fingerprint!";
}
print "# Code Section\n";
my $offset=0;
1.8 +18 -0 parrot/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- interpreter.c 2001/09/14 09:03:43 1.7
+++ interpreter.c 2001/09/14 09:57:03 1.8
@@ -14,6 +14,24 @@
time through */
IV *(*func)();
void **temp;
+
+ if (Parrot_num_string_constants == 0) {
+ printf("Warning: Bytecode does not include opcode table fingerprint!\n");
+ } else {
+ const char * fp_data;
+ IV fp_len;
+
+ fp_data = Parrot_string_constants[0]->bufstart;
+ fp_len = Parrot_string_constants[0]->buflen;
+
+ if (strncmp(OPCODE_FINGERPRINT, fp_data, fp_len)) {
+ printf("Error: Opcode table fingerprint in bytecode does not match
interpreter!\n");
+ printf(" Bytecode: %*s\n", -fp_len, fp_data);
+ printf(" Interpreter: %s\n", OPCODE_FINGERPRINT);
+ exit(1);
+ }
+ }
+
while (*code) {
DO_OP(code, temp, func, interpreter);
}
1.1 parrot/Config_pm.in
Index: Config_pm.in
===================================================================
package Parrot::Config;
use strict;
use warnings;
use Exporter;
use vars qw(@ISA @EXPORT %PConfig);
@ISA=qw(Exporter);
@EXPORT=qw(%PConfig);
#DUMPER OUTPUT HERE
1;
1.1 parrot/Makefile.in
Index: Makefile.in
===================================================================
O = .o
H_FILES = config.h exceptions.h io.h op.h register.h string.h events.h interpreter.h
memory.h parrot.h stacks.h bytecode.h global_setup.h
O_FILES = global_setup$(O) interpreter$(O) parrot$(O) register$(O) basic_opcodes$(O)
memory$(O) bytecode$(O) string$(O) strnative$(O)
C_FLAGS = ${ccflags}
C_LIBS = ${libs}
CC = ${cc} $(C_FLAGS)
all : $(O_FILES)
test_prog: test_main$(O) $(O_FILES)
$(CC) $(C_LIBS) -o test_prog $(O_FILES) test_main$(O)
test_main$(O): $(H_FILES)
global_setup$(O): $(H_FILES)
string$(O): $(H_FILES)
strnative$(O): $(H_FILES)
interp_guts.h: opcode_table build_interp_starter.pl
perl build_interp_starter.pl
interpreter$(O): interpreter.c $(H_FILES) interp_guts.h
memory$(O): $(H_FILES)
bytecode$(O): $(H_FILES)
parrot$(O): $(H_FILES)
register$(O): $(H_FILES)
basic_opcodes$(O): $(H_FILES) basic_opcodes.c
basic_opcodes.c: basic_opcodes.ops process_opfunc.pl interp_guts.h
perl process_opfunc.pl basic_opcodes.ops
op.h: opcode_table make_op_header.pl
perl make_op_header.pl opcode_table > op.h
config.h: Configure.pl config_h.in
perl Configure.pl
clean:
rm -f *$(O) *.s basic_opcodes.c interp_guts.h op.h test_prog
1.1 parrot/config_h.in
Index: config_h.in
===================================================================
/* config.h
*
* Platform-specific config file
*
*/
#if !defined(PARROT_CONFIG_H_GUARD)
#define PARROT_CONFIG_H_GUARD
typedef ${iv} IV;
typedef ${iv} double NV;
typedef struct _vtable VTABLE;
typedef void DPOINTER;
typedef void SYNC;
//typedef IV *(*opcode_funcs)(void *, void *) OPFUNC;
#define FRAMES_PER_CHUNK 16
#define FRAMES_PER_PMC_REG_CHUNK FRAMES_PER_CHUNK
#define FRAMES_PER_NUM_REG_CHUNK FRAMES_PER_CHUNK
#define FRAMES_PER_INT_REG_CHUNK FRAMES_PER_CHUNK
#define FRAMES_PER_STR_REG_CHUNK FRAMES_PER_CHUNK
#define MASK_CHUNK_LOW_BITS 0xfffff000
${headers}
#endif
