[compiler] Win32 changes from Sarathy, tweaked slightly by me.

p4raw-id: //depot/perlext/Compiler@561

diff --git a/B.xs b/B.xs
index 7291522..0bb7acb 100644 (file)
--- a/B.xs
+++ b/B.xs
@@ -433,6 +433,9 @@ MODULE = B  PACKAGE = B     PREFIX = B_
 
 PROTOTYPES: DISABLE
 
+BOOT:
+    INIT_SPECIALSV_LIST;
+
 #define B_main_cv()    main_cv
 #define B_main_root()  main_root
 #define B_main_start() main_start
@@ -553,12 +556,14 @@ cchar(sv)
 void
 threadsv_names()
     PPCODE:
+#ifdef USE_THREADS
        int i;
        STRLEN len = strlen(threadsv_names);
 
        EXTEND(sp, len);
        for (i = 0; i < len; i++)
            PUSHs(sv_2mortal(newSVpv(&threadsv_names[i], 1)));
+#endif
 
 
 #define OP_next(o)     o->op_next

diff --git a/B/Bytecode.pm b/B/Bytecode.pm
index 4fb42ac..447bd37 100644 (file)
--- a/B/Bytecode.pm
+++ b/B/Bytecode.pm
@@ -675,6 +675,7 @@ sub bytecompile_main {
 sub prepare_assemble {
     my $newfh = IO::File->new_tmpfile;
     select($newfh);
+    binmode $newfh;
     return $newfh;
 }
 
@@ -688,6 +689,7 @@ sub compile {
     my @options = @_;
     my ($option, $opt, $arg);
     open(OUT, ">&STDOUT");
+    binmode OUT;
     select(OUT);
   OPTION:
     while ($option = shift @options) {
@@ -704,6 +706,7 @@ sub compile {
        } elsif ($opt eq "o") {
            $arg ||= shift @options;
            open(OUT, ">$arg") or return "$arg: $!\n";
+           binmode OUT;
        } elsif ($opt eq "D") {
            $arg ||= shift @options;
            foreach $arg (split(//, $arg)) {

diff --git a/B/C.pm b/B/C.pm
index e0186ef..4158bc4 100644 (file)
--- a/B/C.pm
+++ b/B/C.pm
@@ -982,8 +982,10 @@ main(int argc, char **argv, char **env)
        perl_construct( my_perl );
     }
 
+#ifdef CSH
     if (!cshlen) 
       cshlen = strlen(cshname);
+#endif
 
 #ifdef ALLOW_PERL_OPTIONS
 #define EXTRA_OPTIONS 2

diff --git a/Makefile.PL b/Makefile.PL
index b3b9bd0..bcc8baa 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,15 +1,27 @@
 use ExtUtils::MakeMaker;
 use Config;
 
+my $e = $Config{'exe_ext'};
+my $o = $Config{'obj_ext'};
+my $exeout_flag = '-o ';
+if ($^O eq 'MSWin32') {
+    if ($Config{'cc'} =~ /^cl/i) {
+       $exeout_flag = '-Fe';
+    }
+    elsif ($Config{'cc'} =~ /^bcc/i) {
+       $exeout_flag = '-e';
+    }
+}
+
 WriteMakefile(
     NAME       => "B",
     VERSION    => "a5",
-    OBJECT     => "B.o byterun.o",
+    OBJECT     => "B$o byterun$o",
     depend     => {
-       "B.o"           => "B.c bytecode.h byterun.h",
+       "B$o"           => "B.c bytecode.h byterun.h",
     },
     clean      => {
-       FILES           => "perl byteperl btest btest.c *.o B.c *~"
+       FILES           => "perl byteperl$e btest$e btest.c *$o B.c *~"
     }
 );
 
@@ -20,23 +32,23 @@ sub MY::post_constants {
 sub MY::top_targets {
     my $self = shift;
     my $targets = $self->MM::top_targets();
-    $targets =~ s/^(all ::.*)$/$1 byteperl/m;
-    return <<'EOT' . $targets;
+    $targets =~ s/^(all ::.*)$/$1 byteperl$e/m;
+    return <<"EOT" . $targets;
 #
 # byterun.h, byterun.c and Asmdata.pm are auto-generated. If any of the
 # files are missing or if you change bytecode.pl (which is what generates
 # them all) then you can "make regen_headers" to regenerate them.
 #
 regen_headers:
-       $(PERL) bytecode.pl
-       $(MV) Asmdata.pm B
+       \$(PERL) bytecode.pl
+       \$(MV) Asmdata.pm B
 #
 # byteperl is *not* a standard perl+XSUB executable. It's a special
 # program for running standalone bytecode executables. It isn't an XSUB
 # at the moment because a standlone Perl program needs to set up curpad
 # which is overwritten on exit from an XSUB.
 #
-byteperl: byteperl.o B.o byterun.o
-       $(CC) -o byteperl byteperl.o B.o byterun.o $(LDFLAGS) -L$(PERL_ARCHLIB)/CORE -lperl $(LIBS)
+byteperl$e : byteperl$o B$o byterun$o
+       \$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS)
 EOT
 }

diff --git a/assemble b/assemble
index 3ad14f7..43cc5bc 100755 (executable)
--- a/assemble
+++ b/assemble
@@ -1,23 +1,30 @@
 use B::Assembler qw(assemble_fh);
 use FileHandle;
 
-my ($filename, $fh);
+my ($filename, $fh, $out);
 
 if ($ARGV[0] eq "-d") {
     B::Assembler::debug(1);
     shift;
 }
 
+$out = \*STDOUT;
+
 if (@ARGV == 0) {
     $fh = \*STDIN;
     $filename = "-";
 } elsif (@ARGV == 1) {
     $filename = $ARGV[0];
     $fh = new FileHandle "<$filename";
+} elsif (@ARGV == 2) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+    $out = new FileHandle ">$ARGV[1]";
 } else {
-    die "Usage: assemble [filename]\n";
+    die "Usage: assemble [filename] [outfilename]\n";
 }
 
+binmode $out;
 $SIG{__WARN__} = sub { warn "$filename:@_" };
 $SIG{__DIE__} = sub { die "$filename: @_" };
-assemble_fh($fh, sub { print @_ });
+assemble_fh($fh, sub { print $out @_ });

diff --git a/bytecode.h b/bytecode.h
index 0fcaa97..bfa4025 100644 (file)
--- a/bytecode.h
+++ b/bytecode.h
@@ -156,7 +156,9 @@ EXT I32 obj_list_fill INIT(-1);
  */
 #define BSET_op_type(o, arg)   do {    \
        o->op_type = arg;               \
-       o->op_ppaddr = (arg != OP_MAPSTART) ? ppaddr[arg] : pp_grepstart; \
+       if (arg == OP_MAPSTART)         \
+           arg = OP_GREPSTART;         \
+       o->op_ppaddr = ppaddr[arg];     \
     } while (0)
 #define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented")
 #define BSET_curpad(pad, arg) pad = AvARRAY(arg)

diff --git a/bytecode.pl b/bytecode.pl
index d753213..2423e3c 100644 (file)
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -220,13 +220,14 @@ print BYTERUN_H <<'EOT';
 EOT
 
 printf BYTERUN_H <<'EOT', scalar(@specialsv);
-EXT SV * specialsv_list[%d]
-#ifdef DOINIT
+EXT SV * specialsv_list[%d];
+#define INIT_SPECIALSV_LIST STMT_START { \
 EOT
-print BYTERUN_H "= { ", join(", ", @specialsv), " }\n";
+for ($i = 0; $i < @specialsv; $i++) {
+    print BYTERUN_H "specialsv_list[$i] = $specialsv[$i]; \\\n";
+}
 print BYTERUN_H <<'EOT';
-#endif /* DOINIT */
-;
+} STMT_END
 EOT
 
 #

diff --git a/byteperl.c b/byteperl.c
index b86615a..c4bf6d7 100644 (file)
--- a/byteperl.c
+++ b/byteperl.c
@@ -26,6 +26,7 @@ main(int argc, char **argv, char **env)
     struct bytestream bs;
 #endif /* INDIRECT_BGET_MACROS */
 
+    INIT_SPECIALSV_LIST;
     PERL_SYS_INIT(&argc,&argv);
  
 #if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1)
@@ -41,13 +42,19 @@ main(int argc, char **argv, char **env)
        perl_construct( my_perl );
     }
 
+#ifdef CSH
     if (!cshlen) 
       cshlen = strlen(cshname);
+#endif
 
     if (argc < 2)
        fp = stdin;
     else {
+#ifdef WIN32
+       fp = fopen(argv[1], "rb");
+#else
        fp = fopen(argv[1], "r");
+#endif
        if (!fp) {
            perror(argv[1]);
            exit(1);

diff --git a/byterun.h b/byterun.h
index 0e10b63..81e8204 100644 (file)
--- a/byterun.h
+++ b/byterun.h
@@ -185,8 +185,10 @@ EXT int optype_size[]
 #endif /* DOINIT */
 ;
 
-EXT SV * specialsv_list[4]
-#ifdef DOINIT
-= { Nullsv, &sv_undef, &sv_yes, &sv_no }
-#endif /* DOINIT */
-;
+EXT SV * specialsv_list[4];
+#define INIT_SPECIALSV_LIST STMT_START { \
+specialsv_list[0] = Nullsv; \
+specialsv_list[1] = &sv_undef; \
+specialsv_list[2] = &sv_yes; \
+specialsv_list[3] = &sv_no; \
+} STMT_END

diff --git a/cc_harness b/cc_harness
index b00b65d..79f8727 100644 (file)
--- a/cc_harness
+++ b/cc_harness
@@ -3,7 +3,8 @@ use Config;
 $libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
 
 if (!grep(/^-[cS]$/, @ARGV)) {
-    $linkargs = sprintf("%s -L$libdir -lperl %s", @Config{qw(ldflags libs)});
+    $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
+                       @Config{qw(ldflags libs)});
 }
 
 $cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";