From: Perl 5 Porters Date: Thu, 17 Apr 1997 00:00:00 +0000 (+0000) Subject: [inseparable changes from match from perl-5.003_97e to perl-5.003_97f] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=96e4d5b14cf2dfb0235faa8bc3f701c15b15bb05;p=p5sagit%2Fp5-mst-13.2.git [inseparable changes from match from perl-5.003_97e to perl-5.003_97f] CORE LANGUAGE CHANGES Subject: New operator systell() From: Chip Salzenberg Files: doio.c ext/Opcode/Opcode.pm keywords.pl opcode.pl pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c t/op/sysio.t toke.c Subject: Allow constant sub to be optimized when called with parens From: Chip Salzenberg Files: toke.c Subject: Make {,un}pack fail on invalid pack types From: Chip Salzenberg Files: pod/perldiag.pod pp.c CORE PORTABILITY Subject: Fix bitwise ops and {,un}pack() on Cray CPUs From: Chip Salzenberg Files: pp.c Subject: VMS update From: Charles Bailey Files: lib/Cwd.pm lib/File/Path.pm lib/FindBin.pm vms/perly_c.vms vms/vms.c vms/writemain.pl Subject: Win32 update (three patches) From: Gurusamy Sarathy Files: lib/Cwd.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm lib/File/Basename.pm win32/Makefile win32/makedef.pl win32/perllib.c win32/win32.c win32/win32iop.h DOCUMENTATION Subject: Document size restrictions for packed integers From: Jarkko Hietaniemi Files: pod/perlfunc.pod LIBRARY AND EXTENSIONS Subject: Fix bug in Opcode when (maxo & 15) > 8 From: Chip Salzenberg Files: ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm ext/Opcode/Opcode.xs --- diff --git a/Changes b/Changes index 54ef8fa..b50c1ad 100644 --- a/Changes +++ b/Changes @@ -18,7 +18,6 @@ file, and their current addresses (as of March 1997): Gisle Aas Kenneth Albanowski - Charles Bailey Graham Barr Spider Boardman Tim Bunce @@ -41,8 +40,103 @@ file, and their current addresses (as of March 1997): And the Keepers of the Patch Pumpkin: + Charles Bailey Andy Dougherty - Chip Salzenberg + Chip Salzenberg + + +------------------- + Version 5.003_97f +------------------- + +This is it before _98. No more last-minute features. Really, I mean +it this time. No kidding. + + CORE LANGUAGE CHANGES + + Title: "New operator systell()" + From: Chip Salzenberg + Files: doio.c ext/Opcode/Opcode.pm keywords.pl opcode.pl + pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c + t/op/sysio.t toke.c + + Title: "Allow constant sub to be optimized when called with parens" + From: Chip Salzenberg + Files: toke.c + + Title: "Make {,un}pack fail on invalid pack types" + From: Chip Salzenberg + Files: pod/perldiag.pod pp.c + + CORE PORTABILITY + + Title: "Fix bitwise ops and {,un}pack() on Cray CPUs" + From: Chip Salzenberg + Files: pp.c + + Title: "VMS update" + From: Charles Bailey + Files: lib/Cwd.pm lib/File/Path.pm lib/FindBin.pm vms/perly_c.vms + vms/vms.c vms/writemain.pl + + Title: "Win32 update (three patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: lib/Cwd.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm + lib/File/Basename.pm win32/Makefile win32/makedef.pl + win32/perllib.c win32/win32.c win32/win32iop.h + + OTHER CORE CHANGES + + Title: "Fix error messages on method lookup failure" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix use of var before init in util.c" + From: Gurusamy Sarathy + Msg-ID: <199704162342.TAA20773@aatma.engin.umich.edu> + Date: Wed, 16 Apr 1997 19:42:41 -0400 + Files: util.c + + BUILD PROCESS + + Title: "Linux hints: Allow build w/o suidperl, prefer tcsh to csh" + From: Michael De La Rue + Files: Configure hints/linux.sh + + LIBRARY AND EXTENSIONS + + Title: "Fix bug in Opcode when (maxo & 15) > 8" + From: Chip Salzenberg + Files: ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm + ext/Opcode/Opcode.xs + + Title: "CGI.pm broke again" + From: Andreas Koenig + Msg-ID: <199704171136.NAA24859@anna.in-berlin.de> + Date: Thu, 17 Apr 1997 13:36:28 +0200 + Files: lib/CGI.pm + + Title: "Revise quotewords()" + From: Shishir Gundavaram + Files: lib/Text/ParseWords.pm + + TESTS + + (no other changes) + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "Doc updates: INSTALL-1.13, pumpkin.pod-1.9" + From: Andy Dougherty + Files: INSTALL Porting/pumpkin.pod + + Title: "Document size restrictions for packed integers" + From: Jarkko Hietaniemi + Files: pod/perlfunc.pod ------------------- diff --git a/doio.c b/doio.c index b8c5a06..829d6d9 100644 --- a/doio.c +++ b/doio.c @@ -660,24 +660,20 @@ do_tell(gv) GV *gv; { register IO *io; + register PerlIO *fp; - if (!gv) - goto phooey; - - io = GvIO(gv); - if (!io || !IoIFP(io)) - goto phooey; - + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH - if (PerlIO_eof(IoIFP(io))) - (void)PerlIO_seek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ + if (PerlIO_eof(fp)) + (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif - - return PerlIO_tell(IoIFP(io)); - -phooey: + if (op->op_type == OP_SYSTELL) + return lseek(PerlIO_fileno(fp), 0L, 1); + else + return PerlIO_tell(fp); + } if (dowarn) - warn("tell() on unopened file"); + warn("%s() on unopened file", op_name[op->op_type]); SETERRNO(EBADF,RMS$_IFI); return -1L; } @@ -702,7 +698,7 @@ int whence; return PerlIO_seek(fp, pos, whence) >= 0; } if (dowarn) - warn("seek() on unopened file"); + warn("%s() on unopened file", op_name[op->op_type]); SETERRNO(EBADF,RMS$_IFI); return FALSE; } diff --git a/ext/Opcode/Makefile.PL b/ext/Opcode/Makefile.PL index 400ae7c..c7ddaaf 100644 --- a/ext/Opcode/Makefile.PL +++ b/ext/Opcode/Makefile.PL @@ -3,5 +3,5 @@ WriteMakefile( NAME => 'Opcode', MAN3PODS => ' ', VERSION_FROM => 'Opcode.pm', - XS_VERSION => '1.00' + XS_VERSION => '1.01' ); diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index fe96e25..b3cfb50 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -4,8 +4,8 @@ require 5.002; use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK); -$VERSION = "1.02"; -$XS_VERSION = "1.00"; +$VERSION = "1.03"; +$XS_VERSION = "1.01"; use strict; use Carp; @@ -380,7 +380,9 @@ such as open would need to be enabled. formline enterwrite leavewrite - print sysread syswrite send recv eof tell seek sysseek + print sysread syswrite send recv + + eof tell seek systell sysseek readdir telldir seekdir rewinddir diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 5a95238..ef2be80 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -46,7 +46,7 @@ op_names_init() while(i-- > 0) bitmap[i] = 0xFF; /* Take care to set the right number of bits in the last byte */ - bitmap[len-1] = (maxo & 0x07) ? ~(~0 << (maxo & 0x07)) : 0xFF; + bitmap[len-1] = ~(0xFF << (maxo & 0x07)); put_op_bitspec(":all",0, opset_all); /* don't mortalise */ } @@ -290,7 +290,7 @@ invert_opset(opset) while(len-- > 0) bitmap[len] = ~bitmap[len]; /* take care of extra bits beyond maxo in last byte */ - bitmap[opset_len-1] &= ~(0xFF << (maxo & 0x0F)); + bitmap[opset_len-1] &= ~(0xFF << (maxo & 0x07)); } ST(0) = opset; diff --git a/keywords.h b/keywords.h index 2be133b..7c62db5 100644 --- a/keywords.h +++ b/keywords.h @@ -212,36 +212,37 @@ #define KEY_sysopen 211 #define KEY_sysread 212 #define KEY_sysseek 213 -#define KEY_system 214 -#define KEY_syswrite 215 -#define KEY_tell 216 -#define KEY_telldir 217 -#define KEY_tie 218 -#define KEY_tied 219 -#define KEY_time 220 -#define KEY_times 221 -#define KEY_tr 222 -#define KEY_truncate 223 -#define KEY_uc 224 -#define KEY_ucfirst 225 -#define KEY_umask 226 -#define KEY_undef 227 -#define KEY_unless 228 -#define KEY_unlink 229 -#define KEY_unpack 230 -#define KEY_unshift 231 -#define KEY_untie 232 -#define KEY_until 233 -#define KEY_use 234 -#define KEY_utime 235 -#define KEY_values 236 -#define KEY_vec 237 -#define KEY_wait 238 -#define KEY_waitpid 239 -#define KEY_wantarray 240 -#define KEY_warn 241 -#define KEY_while 242 -#define KEY_write 243 -#define KEY_x 244 -#define KEY_xor 245 -#define KEY_y 246 +#define KEY_systell 214 +#define KEY_system 215 +#define KEY_syswrite 216 +#define KEY_tell 217 +#define KEY_telldir 218 +#define KEY_tie 219 +#define KEY_tied 220 +#define KEY_time 221 +#define KEY_times 222 +#define KEY_tr 223 +#define KEY_truncate 224 +#define KEY_uc 225 +#define KEY_ucfirst 226 +#define KEY_umask 227 +#define KEY_undef 228 +#define KEY_unless 229 +#define KEY_unlink 230 +#define KEY_unpack 231 +#define KEY_unshift 232 +#define KEY_untie 233 +#define KEY_until 234 +#define KEY_use 235 +#define KEY_utime 236 +#define KEY_values 237 +#define KEY_vec 238 +#define KEY_wait 239 +#define KEY_waitpid 240 +#define KEY_wantarray 241 +#define KEY_warn 242 +#define KEY_while 243 +#define KEY_write 244 +#define KEY_x 245 +#define KEY_xor 246 +#define KEY_y 247 diff --git a/keywords.pl b/keywords.pl index aebb3ee..805b5bc 100755 --- a/keywords.pl +++ b/keywords.pl @@ -238,6 +238,7 @@ syscall sysopen sysread sysseek +systell system syswrite tell diff --git a/lib/Cwd.pm b/lib/Cwd.pm index e25ff4b..efcfeca 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -1,7 +1,5 @@ package Cwd; require 5.000; -require Exporter; -use Carp; =head1 NAME @@ -44,13 +42,20 @@ kept up to date if all packages which use chdir import it from Cwd. =cut +## use strict; + +use Carp; + +$VERSION = '2.00'; + +require Exporter; @ISA = qw(Exporter); @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); -@EXPORT_OK = qw(chdir abs_path fast_abspath); +@EXPORT_OK = qw(chdir abs_path fast_abs_path); -# use strict; # The 'natural and safe form' for UNIX (pwd may be setuid root) + sub _backtick_pwd { my $cwd; chop($cwd = `pwd`); @@ -275,14 +280,13 @@ sub abs_path $cwd; } -sub fast_abspath -{ - my $cwd = getcwd(); - my $path = shift || '.'; - chdir($path) || croak "Cannot chdir to $path:$!"; - my $realpath = getcwd(); - chdir($cwd) || croak "Cannot chdir back to $cwd:$!"; - $realpath; +sub fast_abs_path { + my $cwd = getcwd(); + my $path = shift || '.'; + chdir($path) || croak "Cannot chdir to $path:$!"; + my $realpath = getcwd(); + chdir($cwd) || croak "Cannot chdir back to $cwd:$!"; + $realpath; } @@ -297,7 +301,14 @@ sub fast_abspath # the CRTL chdir() function persist only until Perl exits. sub _vms_cwd { - return $ENV{'DEFAULT'} + return $ENV{'DEFAULT'}; +} + +sub _vms_abs_path { + return $ENV{'DEFAULT'} unless @_; + my $path = VMS::Filespec::pathify($_[0]); + croak("Invalid path name $_[0]") unless defined $path; + return VMS::Filespec::rmsexpand($path); } sub _os2_cwd { @@ -307,7 +318,16 @@ sub _os2_cwd { return $ENV{'PWD'}; } -*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; +sub _win32_cwd { + $ENV{'PWD'} = Win32::GetCurrentDirectory(); + $ENV{'PWD'} =~ s:\\:/:g ; + return $ENV{'PWD'}; +} + +*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && + defined &Win32::GetCurrentDirectory); + +*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; sub _msdos_cwd { $ENV{'PWD'} = `command /c cd`; @@ -320,34 +340,35 @@ sub _msdos_cwd { local $^W = 0; # assignments trigger 'subroutine redefined' warning if ($^O eq 'VMS') { - *cwd = \&_vms_cwd; - *getcwd = \&_vms_cwd; - *fastcwd = \&_vms_cwd; - *fastgetcwd = \&_vms_cwd; - *abs_path = \&fast_abspath; + *cwd = \&_vms_cwd; + *getcwd = \&_vms_cwd; + *fastcwd = \&_vms_cwd; + *fastgetcwd = \&_vms_cwd; + *abs_path = \&_vms_abs_path; + *fast_abs_path = \&_vms_abs_path; } elsif ($^O eq 'NT' or $^O eq 'MSWin32') { # We assume that &_NT_cwd is defined as an XSUB or in the core. - *cwd = \&_NT_cwd; - *getcwd = \&_NT_cwd; - *fastcwd = \&_NT_cwd; - *fastgetcwd = \&_NT_cwd; - *abs_path = \&fast_abspath; + *cwd = \&_NT_cwd; + *getcwd = \&_NT_cwd; + *fastcwd = \&_NT_cwd; + *fastgetcwd = \&_NT_cwd; + *abs_path = \&fast_abs_path; } elsif ($^O eq 'os2') { # sys_cwd may keep the builtin command - *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; - *getcwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; - *fastgetcwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; - *fastcwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; - *abs_path = \&fast_abspath; + *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; + *getcwd = \&cwd; + *fastgetcwd = \&cwd; + *fastcwd = \&cwd; + *abs_path = \&fast_abs_path; } elsif ($^O eq 'msdos') { - *cwd = \&_msdos_cwd; - *getcwd = \&_msdos_cwd; - *fastgetcwd = \&_msdos_cwd; - *fastcwd = \&_msdos_cwd; - *abs_path = \&fast_abspath; + *cwd = \&_msdos_cwd; + *getcwd = \&_msdos_cwd; + *fastgetcwd = \&_msdos_cwd; + *fastcwd = \&_msdos_cwd; + *abs_path = \&fast_abs_path; } } diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index b2466f1..b8f1f0a 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -2839,7 +2839,10 @@ sub test { # --- Test and Installation Sections --- my($self, %attribs) = @_; - my($tests) = $attribs{TESTS} || (-d "t" ? "t/*.t" : ""); + my $tests = $attribs{TESTS}; + if (!$tests && -d 't') { + $tests = $Is_Win32 ? join(' ', ) : 't/*.t'; + } my(@m); push(@m," TEST_VERBOSE=0 diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index d001901..e3161b5 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -130,9 +130,8 @@ sub catfile { my $file = pop @_; return $file unless @_; my $dir = $self->catdir(@_); - for ($dir) { - $_ .= "\\" unless substr($_,length($_)-1,1) eq "\\"; - } + $dir =~ s/(\\\.)$//; + $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\"; return $dir.$file; } @@ -256,6 +255,7 @@ path. On UNIX eliminated successive slashes and successive "/.". sub canonpath { my($self,$path) = @_; + $path =~ s/^([a-z]:)/\u$1/; $path =~ s|/|\\|g; $path =~ s|\\+|\\|g ; # xx////xx -> xx/xx $path =~ s|(\\\.)+\\|\\|g ; # xx/././xx -> xx/xx diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm index 3ceb10e..e4863f8 100644 --- a/lib/File/Basename.pm +++ b/lib/File/Basename.pm @@ -162,7 +162,7 @@ sub fileparse { ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/); } } - if ($fstype =~ /^MSDOS/i) { + if ($fstype =~ /^MS(DOS|Win32)/i) { ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/); $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/; } @@ -173,10 +173,6 @@ sub fileparse { ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/); $dirpath = './' unless $dirpath; } - elsif ($fstype =~ /^MSWin32/i) { - ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/); - $dirpath .= ".\\" unless $dirpath =~ /[\\\/]$/; - } elsif ($fstype !~ /^VMS/i) { # default to Unix ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#); $dirpath = './' unless $dirpath; diff --git a/lib/File/Path.pm b/lib/File/Path.pm index e086028..419bd03 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -69,21 +69,30 @@ skip any files to which you do not have delete access (if running under VMS) or write access (if running under another OS). This will change in the future when a criterion for 'delete permission' under OSs other -than VMS is settled. (defaults to FALSE) +than VMS is settled. (defaults to FALSE) =back -It returns the number of files successfully deleted. Symlinks are +It returns the number of files successfully deleted. Symlinks are treated as ordinary files. +B If the third parameter is not TRUE, C is B +in the face of failure or interruption. Files and directories which +were not deleted may be left with permissions reset to allow world +read and write access. Note also that the occurrence of errors in +rmtree can be determined I by trapping diagnostic messages +using C<$SIG{__WARN__}>; it is not apparent from the return value. +Therefore, you must be extremely careful about using C +in situations where security is an issue. + =head1 AUTHORS -Tim Bunce EFE -Charles Bailey EFE +Tim Bunce > and +Charles Bailey > =head1 REVISION -Current $VERSION is 1.02. +Current $VERSION is 1.03. =cut @@ -94,7 +103,7 @@ use Exporter (); use strict; use vars qw( $VERSION @ISA @EXPORT ); -$VERSION = "1.02"; +$VERSION = "1.03"; @ISA = qw( Exporter ); @EXPORT = qw( mkpath rmtree ); @@ -138,13 +147,14 @@ sub rmtree { my($root); foreach $root (@{$roots}) { $root =~ s#/$##; - $count++, next unless -e $root; + next unless -e $root; if (not -l $root and -d _) { # notabene: 0777 is for making readable in the first place, # it's also intended to change it to writable in case we have # to recurse in which case we are better than rm -rf for # subtrees with strange permissions - chmod 0777, $root + my $rp = (stat(_))[2] & 0777; #Is this portable??? + chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) or carp "Can't make directory $root read+writeable: $!" unless $safe; @@ -168,8 +178,15 @@ sub rmtree { or carp "Can't make directory $root writeable: $!" if $force_writeable; print "rmdir $root\n" if $verbose; - rmdir($root) && ++$count - or carp "Can't remove directory $root: $!"; + if (rmdir $root) { + ++$count; + } + else { + carp "Can't remove directory $root: $!"; + chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) + or carp("and can't restore permissions to " + . sprintf("0%o",$rp) . "\n"); + } } else { if ($safe && @@ -177,14 +194,24 @@ sub rmtree { print "skipped $root\n" if $verbose; next; } + my $rp = (stat(_))[2] & 0777; #Is this portable??? chmod 0666, $root or carp "Can't make file $root writeable: $!" if $force_writeable; print "unlink $root\n" if $verbose; # delete all versions under VMS while (-e $root || -l $root) { - unlink($root) && ++$count - or croak "Can't unlink file $root: $!"; + if (unlink $root) { + ++$count; + } + else { + carp "Can't unlink file $root: $!"; + if ($force_writeable) { + chmod $rp, $root + or carp("and can't restore permissions to " + . sprintf("0%o",$rp) . "\n"); + } + } } } } diff --git a/lib/FindBin.pm b/lib/FindBin.pm index d908121..918775c 100644 --- a/lib/FindBin.pm +++ b/lib/FindBin.pm @@ -91,6 +91,12 @@ sub is_abs_path { return m#^[a-z]:[\\/]#i; } + elsif ($^O eq 'VMS') + { + # If it's a logical name, expand it. + $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_}; + return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/; + } else { return m#^/#; diff --git a/opcode.h b/opcode.h index 52403d4..eb6ff8f 100644 --- a/opcode.h +++ b/opcode.h @@ -212,146 +212,147 @@ typedef enum { OP_PRTF, /* 205 */ OP_PRINT, /* 206 */ OP_SYSOPEN, /* 207 */ - OP_SYSSEEK, /* 208 */ - OP_SYSREAD, /* 209 */ - OP_SYSWRITE, /* 210 */ - OP_SEND, /* 211 */ - OP_RECV, /* 212 */ - OP_EOF, /* 213 */ - OP_TELL, /* 214 */ - OP_SEEK, /* 215 */ - OP_TRUNCATE, /* 216 */ - OP_FCNTL, /* 217 */ - OP_IOCTL, /* 218 */ - OP_FLOCK, /* 219 */ - OP_SOCKET, /* 220 */ - OP_SOCKPAIR, /* 221 */ - OP_BIND, /* 222 */ - OP_CONNECT, /* 223 */ - OP_LISTEN, /* 224 */ - OP_ACCEPT, /* 225 */ - OP_SHUTDOWN, /* 226 */ - OP_GSOCKOPT, /* 227 */ - OP_SSOCKOPT, /* 228 */ - OP_GETSOCKNAME, /* 229 */ - OP_GETPEERNAME, /* 230 */ - OP_LSTAT, /* 231 */ - OP_STAT, /* 232 */ - OP_FTRREAD, /* 233 */ - OP_FTRWRITE, /* 234 */ - OP_FTREXEC, /* 235 */ - OP_FTEREAD, /* 236 */ - OP_FTEWRITE, /* 237 */ - OP_FTEEXEC, /* 238 */ - OP_FTIS, /* 239 */ - OP_FTEOWNED, /* 240 */ - OP_FTROWNED, /* 241 */ - OP_FTZERO, /* 242 */ - OP_FTSIZE, /* 243 */ - OP_FTMTIME, /* 244 */ - OP_FTATIME, /* 245 */ - OP_FTCTIME, /* 246 */ - OP_FTSOCK, /* 247 */ - OP_FTCHR, /* 248 */ - OP_FTBLK, /* 249 */ - OP_FTFILE, /* 250 */ - OP_FTDIR, /* 251 */ - OP_FTPIPE, /* 252 */ - OP_FTLINK, /* 253 */ - OP_FTSUID, /* 254 */ - OP_FTSGID, /* 255 */ - OP_FTSVTX, /* 256 */ - OP_FTTTY, /* 257 */ - OP_FTTEXT, /* 258 */ - OP_FTBINARY, /* 259 */ - OP_CHDIR, /* 260 */ - OP_CHOWN, /* 261 */ - OP_CHROOT, /* 262 */ - OP_UNLINK, /* 263 */ - OP_CHMOD, /* 264 */ - OP_UTIME, /* 265 */ - OP_RENAME, /* 266 */ - OP_LINK, /* 267 */ - OP_SYMLINK, /* 268 */ - OP_READLINK, /* 269 */ - OP_MKDIR, /* 270 */ - OP_RMDIR, /* 271 */ - OP_OPEN_DIR, /* 272 */ - OP_READDIR, /* 273 */ - OP_TELLDIR, /* 274 */ - OP_SEEKDIR, /* 275 */ - OP_REWINDDIR, /* 276 */ - OP_CLOSEDIR, /* 277 */ - OP_FORK, /* 278 */ - OP_WAIT, /* 279 */ - OP_WAITPID, /* 280 */ - OP_SYSTEM, /* 281 */ - OP_EXEC, /* 282 */ - OP_KILL, /* 283 */ - OP_GETPPID, /* 284 */ - OP_GETPGRP, /* 285 */ - OP_SETPGRP, /* 286 */ - OP_GETPRIORITY, /* 287 */ - OP_SETPRIORITY, /* 288 */ - OP_TIME, /* 289 */ - OP_TMS, /* 290 */ - OP_LOCALTIME, /* 291 */ - OP_GMTIME, /* 292 */ - OP_ALARM, /* 293 */ - OP_SLEEP, /* 294 */ - OP_SHMGET, /* 295 */ - OP_SHMCTL, /* 296 */ - OP_SHMREAD, /* 297 */ - OP_SHMWRITE, /* 298 */ - OP_MSGGET, /* 299 */ - OP_MSGCTL, /* 300 */ - OP_MSGSND, /* 301 */ - OP_MSGRCV, /* 302 */ - OP_SEMGET, /* 303 */ - OP_SEMCTL, /* 304 */ - OP_SEMOP, /* 305 */ - OP_REQUIRE, /* 306 */ - OP_DOFILE, /* 307 */ - OP_ENTEREVAL, /* 308 */ - OP_LEAVEEVAL, /* 309 */ - OP_ENTERTRY, /* 310 */ - OP_LEAVETRY, /* 311 */ - OP_GHBYNAME, /* 312 */ - OP_GHBYADDR, /* 313 */ - OP_GHOSTENT, /* 314 */ - OP_GNBYNAME, /* 315 */ - OP_GNBYADDR, /* 316 */ - OP_GNETENT, /* 317 */ - OP_GPBYNAME, /* 318 */ - OP_GPBYNUMBER, /* 319 */ - OP_GPROTOENT, /* 320 */ - OP_GSBYNAME, /* 321 */ - OP_GSBYPORT, /* 322 */ - OP_GSERVENT, /* 323 */ - OP_SHOSTENT, /* 324 */ - OP_SNETENT, /* 325 */ - OP_SPROTOENT, /* 326 */ - OP_SSERVENT, /* 327 */ - OP_EHOSTENT, /* 328 */ - OP_ENETENT, /* 329 */ - OP_EPROTOENT, /* 330 */ - OP_ESERVENT, /* 331 */ - OP_GPWNAM, /* 332 */ - OP_GPWUID, /* 333 */ - OP_GPWENT, /* 334 */ - OP_SPWENT, /* 335 */ - OP_EPWENT, /* 336 */ - OP_GGRNAM, /* 337 */ - OP_GGRGID, /* 338 */ - OP_GGRENT, /* 339 */ - OP_SGRENT, /* 340 */ - OP_EGRENT, /* 341 */ - OP_GETLOGIN, /* 342 */ - OP_SYSCALL, /* 343 */ + OP_SYSTELL, /* 208 */ + OP_SYSSEEK, /* 209 */ + OP_SYSREAD, /* 210 */ + OP_SYSWRITE, /* 211 */ + OP_SEND, /* 212 */ + OP_RECV, /* 213 */ + OP_EOF, /* 214 */ + OP_TELL, /* 215 */ + OP_SEEK, /* 216 */ + OP_TRUNCATE, /* 217 */ + OP_FCNTL, /* 218 */ + OP_IOCTL, /* 219 */ + OP_FLOCK, /* 220 */ + OP_SOCKET, /* 221 */ + OP_SOCKPAIR, /* 222 */ + OP_BIND, /* 223 */ + OP_CONNECT, /* 224 */ + OP_LISTEN, /* 225 */ + OP_ACCEPT, /* 226 */ + OP_SHUTDOWN, /* 227 */ + OP_GSOCKOPT, /* 228 */ + OP_SSOCKOPT, /* 229 */ + OP_GETSOCKNAME, /* 230 */ + OP_GETPEERNAME, /* 231 */ + OP_LSTAT, /* 232 */ + OP_STAT, /* 233 */ + OP_FTRREAD, /* 234 */ + OP_FTRWRITE, /* 235 */ + OP_FTREXEC, /* 236 */ + OP_FTEREAD, /* 237 */ + OP_FTEWRITE, /* 238 */ + OP_FTEEXEC, /* 239 */ + OP_FTIS, /* 240 */ + OP_FTEOWNED, /* 241 */ + OP_FTROWNED, /* 242 */ + OP_FTZERO, /* 243 */ + OP_FTSIZE, /* 244 */ + OP_FTMTIME, /* 245 */ + OP_FTATIME, /* 246 */ + OP_FTCTIME, /* 247 */ + OP_FTSOCK, /* 248 */ + OP_FTCHR, /* 249 */ + OP_FTBLK, /* 250 */ + OP_FTFILE, /* 251 */ + OP_FTDIR, /* 252 */ + OP_FTPIPE, /* 253 */ + OP_FTLINK, /* 254 */ + OP_FTSUID, /* 255 */ + OP_FTSGID, /* 256 */ + OP_FTSVTX, /* 257 */ + OP_FTTTY, /* 258 */ + OP_FTTEXT, /* 259 */ + OP_FTBINARY, /* 260 */ + OP_CHDIR, /* 261 */ + OP_CHOWN, /* 262 */ + OP_CHROOT, /* 263 */ + OP_UNLINK, /* 264 */ + OP_CHMOD, /* 265 */ + OP_UTIME, /* 266 */ + OP_RENAME, /* 267 */ + OP_LINK, /* 268 */ + OP_SYMLINK, /* 269 */ + OP_READLINK, /* 270 */ + OP_MKDIR, /* 271 */ + OP_RMDIR, /* 272 */ + OP_OPEN_DIR, /* 273 */ + OP_READDIR, /* 274 */ + OP_TELLDIR, /* 275 */ + OP_SEEKDIR, /* 276 */ + OP_REWINDDIR, /* 277 */ + OP_CLOSEDIR, /* 278 */ + OP_FORK, /* 279 */ + OP_WAIT, /* 280 */ + OP_WAITPID, /* 281 */ + OP_SYSTEM, /* 282 */ + OP_EXEC, /* 283 */ + OP_KILL, /* 284 */ + OP_GETPPID, /* 285 */ + OP_GETPGRP, /* 286 */ + OP_SETPGRP, /* 287 */ + OP_GETPRIORITY, /* 288 */ + OP_SETPRIORITY, /* 289 */ + OP_TIME, /* 290 */ + OP_TMS, /* 291 */ + OP_LOCALTIME, /* 292 */ + OP_GMTIME, /* 293 */ + OP_ALARM, /* 294 */ + OP_SLEEP, /* 295 */ + OP_SHMGET, /* 296 */ + OP_SHMCTL, /* 297 */ + OP_SHMREAD, /* 298 */ + OP_SHMWRITE, /* 299 */ + OP_MSGGET, /* 300 */ + OP_MSGCTL, /* 301 */ + OP_MSGSND, /* 302 */ + OP_MSGRCV, /* 303 */ + OP_SEMGET, /* 304 */ + OP_SEMCTL, /* 305 */ + OP_SEMOP, /* 306 */ + OP_REQUIRE, /* 307 */ + OP_DOFILE, /* 308 */ + OP_ENTEREVAL, /* 309 */ + OP_LEAVEEVAL, /* 310 */ + OP_ENTERTRY, /* 311 */ + OP_LEAVETRY, /* 312 */ + OP_GHBYNAME, /* 313 */ + OP_GHBYADDR, /* 314 */ + OP_GHOSTENT, /* 315 */ + OP_GNBYNAME, /* 316 */ + OP_GNBYADDR, /* 317 */ + OP_GNETENT, /* 318 */ + OP_GPBYNAME, /* 319 */ + OP_GPBYNUMBER, /* 320 */ + OP_GPROTOENT, /* 321 */ + OP_GSBYNAME, /* 322 */ + OP_GSBYPORT, /* 323 */ + OP_GSERVENT, /* 324 */ + OP_SHOSTENT, /* 325 */ + OP_SNETENT, /* 326 */ + OP_SPROTOENT, /* 327 */ + OP_SSERVENT, /* 328 */ + OP_EHOSTENT, /* 329 */ + OP_ENETENT, /* 330 */ + OP_EPROTOENT, /* 331 */ + OP_ESERVENT, /* 332 */ + OP_GPWNAM, /* 333 */ + OP_GPWUID, /* 334 */ + OP_GPWENT, /* 335 */ + OP_SPWENT, /* 336 */ + OP_EPWENT, /* 337 */ + OP_GGRNAM, /* 338 */ + OP_GGRGID, /* 339 */ + OP_GGRENT, /* 340 */ + OP_SGRENT, /* 341 */ + OP_EGRENT, /* 342 */ + OP_GETLOGIN, /* 343 */ + OP_SYSCALL, /* 344 */ OP_max } opcode; -#define MAXO 344 +#define MAXO 345 #ifndef DOINIT EXT char *op_name[]; @@ -565,6 +566,7 @@ EXT char *op_name[] = { "prtf", "print", "sysopen", + "systell", "sysseek", "sysread", "syswrite", @@ -916,6 +918,7 @@ EXT char *op_desc[] = { "printf", "print", "sysopen", + "systell", "sysseek", "sysread", "syswrite", @@ -1296,6 +1299,7 @@ OP * pp_leavewrite _((void)); OP * pp_prtf _((void)); OP * pp_print _((void)); OP * pp_sysopen _((void)); +OP * pp_systell _((void)); OP * pp_sysseek _((void)); OP * pp_sysread _((void)); OP * pp_syswrite _((void)); @@ -1645,6 +1649,7 @@ EXT OP * (*ppaddr[])() = { pp_prtf, pp_print, pp_sysopen, + pp_systell, pp_sysseek, pp_sysread, pp_syswrite, @@ -1996,6 +2001,7 @@ EXT OP * (*check[]) _((OP *op)) = { ck_listiob, /* prtf */ ck_listiob, /* print */ ck_fun, /* sysopen */ + ck_fun, /* systell */ ck_fun, /* sysseek */ ck_fun, /* sysread */ ck_fun, /* syswrite */ @@ -2347,6 +2353,7 @@ EXT U32 opargs[] = { 0x00002e15, /* prtf */ 0x00002e15, /* print */ 0x00911604, /* sysopen */ + 0x00000e0c, /* systell */ 0x00011604, /* sysseek */ 0x0091761d, /* sysread */ 0x0091161d, /* syswrite */ diff --git a/opcode.pl b/opcode.pl index 6fed2f8..2d3e28d 100755 --- a/opcode.pl +++ b/opcode.pl @@ -470,6 +470,7 @@ prtf printf ck_listiob ims F? L print print ck_listiob ims F? L sysopen sysopen ck_fun s F S S S? +systell systell ck_fun st F? sysseek sysseek ck_fun s F S S sysread sysread ck_fun imst F R S S? syswrite syswrite ck_fun imst F S S S? diff --git a/patchlevel.h b/patchlevel.h index 32aafef..0579db5 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -43,6 +43,7 @@ static char *local_patches[] = { ,"Dev97C - Third development patch to 5.003_97" ,"Dev97D - Fourth development patch to 5.003_97" ,"Dev97E - Fifth development patch to 5.003_97" + ,"Dev97F - Sixth development patch to 5.003_97" ,NULL }; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b1e11f4..5132b49 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -299,10 +299,12 @@ provides seven bits of the total value, with the most significant first. Bit eight of each byte is set, except for the last byte, in which bit eight is clear. -=item sysseek() +=item sysseek() and systell() -This is a variant of seek() that works on the system file pointer. -It is the only reliable way to seek before sysread() or syswrite(). +These are new. The sysseek() operator is a variant of seek() that works +on the system file pointer. It is the only reliable way to seek before +using sysread() or syswrite(). Its companion operator systell() reports +the current position of the system file pointer. =item use VERSION diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 0152662..feee58a 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1229,6 +1229,14 @@ C<./Configure -S> and rebuild Perl. (F) The range specified in a character class had a minimum character greater than the maximum character. See L. +=item Invalid type in pack: '%s' + +(F) The given character is not a valid pack type. See L. + +=item Invalid type in unpack: '%s' + +(F) The given character is not a valid unpack type. See L. + =item ioctl is not implemented (F) Your machine apparently doesn't implement ioctl(), which is pretty @@ -1987,10 +1995,10 @@ or setgid bit set. This doesn't make much sense. (F) The lexer couldn't find the final delimiter of a // or m{} construct. Remember that bracketing delimiters count nesting level. -=item seek() on unopened file +=item %sseek() on unopened file -(W) You tried to use the seek() function on a filehandle that was either -never opened or has since been closed. +(W) You tried to use the seek() or sysseek() function on a filehandle that +was either never opened or has since been closed. =item select not implemented @@ -2206,10 +2214,10 @@ or "msg". See L, for example. (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. -=item tell() on unopened file +=item %stell() on unopened file -(W) You tried to use the tell() function on a filehandle that was either -never opened or has since been closed. +(W) You tried to use the tell() or systell() function on a filehandle that +was either never opened or has since been closed. =item Test on unopened file E%sE diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index cba3f2a..e8dc893 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -108,8 +108,8 @@ delete, each, exists, keys, values binmode, close, closedir, dbmclose, dbmopen, die, eof, fileno, flock, format, getc, print, printf, read, readdir, -rewinddir, seek, seekdir, select, syscall, sysread, -syswrite, tell, telldir, truncate, warn, write +rewinddir, seek, seekdir, select, syscall, sysread, sysseek, +systell, syswrite, tell, telldir, truncate, warn, write =item Functions for fixed length data or records @@ -2096,17 +2096,29 @@ follows: c A signed char value. C An unsigned char value. + s A signed short value. S An unsigned short value. + (This 'short' is _exactly_ 16 bits, which may differ from + what a local C compiler calls 'short'.) + i A signed integer value. I An unsigned integer value. + (This 'integer' is _at_least_ 32 bits wide. Its exact size + depends on what a local C compiler calls 'int', and may + even be larger than the 'long' described in the next item.) + l A signed long value. L An unsigned long value. + (This 'long' is _exactly_ 32 bits, which may differ from + what a local C compiler calls 'long'.) - n A short in "network" order. - N A long in "network" order. + n A short in "network" (big-endian) order. + N A long in "network" (big-endian) order. v A short in "VAX" (little-endian) order. V A long in "VAX" (little-endian) order. + (These 'shorts' and 'longs' are _exactly_ 16 bits and + _exactly_ 32 bits, respectively.) f A single-precision float in the native format. d A double-precision float in the native format. @@ -2116,10 +2128,10 @@ follows: u A uuencoded string. - w A BER compressed integer. Bytes give an unsigned integer base - 128, most significant digit first, with as few digits as - possible, and with the bit 8 of each byte except the last set - to "1." + w A BER compressed integer. Its bytes represent an unsigned + integer in base 128, most significant digit first, with as few + digits as possible. Bit eight (the high bit) is set on each + byte except the last. x A null byte. X Back up a byte. @@ -3330,11 +3342,12 @@ into that kind of thing. =item sysread FILEHANDLE,SCALAR,LENGTH Attempts to read LENGTH bytes of data into variable SCALAR from the -specified FILEHANDLE, using the system call read(2). It bypasses -stdio, so mixing this with other kinds of reads or with seek() may -cause confusion. Returns the number of bytes actually read, or undef -if there was an error. SCALAR will be grown or shrunk so that the -last byte actually read is the last byte of the scalar after the read. +specified FILEHANDLE, using the system call read(2). It bypasses stdio, +so mixing this with other kinds of reads, print(), write(), seek(), or +tell() can cause confusion. Returns the number of bytes actually read, +or undef if there was an error. SCALAR will be grown or shrunk so that +the last byte actually read is the last byte of the scalar after the +read. An OFFSET may be specified to place the read data at some place in the string other than the beginning. A negative OFFSET specifies @@ -3346,13 +3359,25 @@ the result of the read is appended. =item sysseek FILEHANDLE,POSITION,WHENCE Randomly positions the system file pointer for FILEHANDLE using the -system call lseek(2). It bypasses stdio, so mixing this with read(), -print(), write(), or seek() may cause confusion. FILEHANDLE may be an -expression whose value gives the name of the filehandle. The values for -WHENCE are 0 to set the file pointer to POSITION, 1 to set the it to -current plus POSITION, and 2 to set it to EOF plus offset. You may use -the values SEEK_SET, SEEK_CUR, and SEEK_END for this from either the -IO::Seekable or the POSIX module. Returns 1 upon success, 0 otherwise. +system call lseek(2). It bypasses stdio, so mixing this with reads +(other than sysread()), print(), write(), seek(), or tell() may cause +confusion. FILEHANDLE may be an expression whose value gives the name +of the filehandle. The values for WHENCE are 0 to set the file pointer +to POSITION, 1 to set the it to current plus POSITION, and 2 to set it +to EOF plus offset. You may use the values SEEK_SET, SEEK_CUR, and +SEEK_END for this from either the IO::Seekable or the POSIX module. +Returns 1 upon success, 0 otherwise. See also L. + +=item systell FILEHANDLE + +=item systell + +Returns the current position of the system file pointer for FILEHANDLE +as reported by the system call lseek(2). It bypasses stdio, so mixing +this with reads (other than sysread()), print(), write(), seek(), or +tell() may cause confusion. FILEHANDLE may be an expression whose value +gives the name of the actual filehandle. If FILEHANDLE is omitted, +assumes the file last read. See also L. =item system LIST @@ -3404,10 +3429,11 @@ signals and core dumps. Attempts to write LENGTH bytes of data from variable SCALAR to the specified FILEHANDLE, using the system call write(2). It bypasses -stdio, so mixing this with prints or with seek() may cause confusion. -Returns the number of bytes actually written, or undef if there was an -error. If the length is greater than the available data, only as much -data as is available will be written. +stdio, so mixing this with reads (other than sysread()), print(), +write(), seek(), or tell() may cause confusion. Returns the number of +bytes actually written, or undef if there was an error. If the length +is greater than the available data, only as much data as is available +will be written. An OFFSET may be specified to write the data from some part of the string other than the beginning. A negative OFFSET specifies writing diff --git a/pod/perltoc.pod b/pod/perltoc.pod index ef59edb..e7fed66 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -860,10 +860,11 @@ $^E, $^H, $^M =item New and changed builtin functions delete on slices, flock, printf and sprintf, keys as an lvalue, my() in -Control Structures, pack() and unpack(), sysseek(), use VERSION, use Module -VERSION LIST, prototype(FUNCTION), srand, $_ as Default, C does not -reset search position on failure, C ignores whitespace before ?*+{}, -nested C closures work now, formats work right on changing lexicals +Control Structures, pack() and unpack(), sysseek() and systell(), use +VERSION, use Module VERSION LIST, prototype(FUNCTION), srand, $_ as +Default, C does not reset search position on failure, C ignores +whitespace before ?*+{}, nested C closures work now, formats work +right on changing lexicals =item New builtin methods @@ -1221,15 +1222,16 @@ sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN, substr EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST, sysopen FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS, sysread FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, sysseek -FILEHANDLE,POSITION,WHENCE, system LIST, syswrite -FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite FILEHANDLE,SCALAR,LENGTH, tell -FILEHANDLE, tell, telldir DIRHANDLE, tie VARIABLE,CLASSNAME,LIST, tied -VARIABLE, time, times, tr///, truncate FILEHANDLE,LENGTH, truncate -EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, ucfirst, umask EXPR, umask, undef -EXPR, undef, unlink LIST, unlink, unpack TEMPLATE,EXPR, untie VARIABLE, -unshift ARRAY,LIST, use Module LIST, use Module, use Module VERSION LIST, -use VERSION, utime LIST, values HASH, vec EXPR,OFFSET,BITS, wait, waitpid -PID,FLAGS, wantarray, warn LIST, write FILEHANDLE, write EXPR, write, y/// +FILEHANDLE,POSITION,WHENCE, systell FILEHANDLE, systell, system LIST, +syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite +FILEHANDLE,SCALAR,LENGTH, tell FILEHANDLE, tell, telldir DIRHANDLE, tie +VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate +FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, +ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack +TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module LIST, use +Module, use Module VERSION LIST, use VERSION, utime LIST, values HASH, vec +EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn LIST, write +FILEHANDLE, write EXPR, write, y/// =back diff --git a/pp.c b/pp.c index 4effd28..34c4ed3 100644 --- a/pp.c +++ b/pp.c @@ -23,12 +23,69 @@ * floating-point type to use for NV that has adequate bits to fully * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).) * - * It just so happens that "int" is the right size everywhere, at - * least today. + * It just so happens that "int" is the right size almost everywhere. */ typedef int IBW; typedef unsigned UBW; +/* + * Mask used after bitwise operations. + * + * There is at least one realm (Cray word machines) that doesn't + * have an integral type (except char) small enough to be represented + * in a double without loss; that is, it has no 32-bit type. + */ +#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP) +# define BWBITS 32 +# define BWMASK ((1 << BWBITS) - 1) +# define BWSIGN (1 << (BWBITS - 1)) +# define BWi(i) (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK)) +# define BWu(u) ((u) & BW_MASK) +#else +# define BWi(i) (i) +# define BWu(u) (u) +#endif + +/* + * Offset for integer pack/unpack. + * + * On architectures where I16 and I32 aren't really 16 and 32 bits, + * which for now are all Crays, pack and unpack have to play games. + */ + +/* + * These values are required for portability of pack() output. + * If they're not right on your machine, then pack() and unpack() + * wouldn't work right anyway; you'll need to apply the Cray hack. + * (I'd like to check them with #if, but you can't use sizeof() in + * the preprocessor.) + */ +#define SIZE16 2 +#define SIZE32 4 + +#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP) +# if BYTEORDER == 0x12345678 +# define OFF16(p) (char*)(p) +# define OFF32(p) (char*)(p) +# else +# if BYTEORDER == 0x87654321 +# define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16)) +# define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32)) +# else + }}}} bad cray byte order +# endif +# endif +# define COPY16(s,p) (*(p) = 0, Copy(s, OFF16(p), SIZE16, char)) +# define COPY32(s,p) (*(p) = 0, Copy(s, OFF32(p), SIZE32, char)) +# define CAT16(sv,p) sv_catpvn(sv, OFF16(p), SIZE16) +# define CAT32(sv,p) sv_catpvn(sv, OFF32(p), SIZE32) +#else +# define COPY16(s,p) Copy(s, p, SIZE16, char) +# define COPY32(s,p) Copy(s, p, SIZE32, char) +# define CAT16(sv,p) sv_catpvn(sv, (char*)(p), SIZE16) +# define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) +#endif + static void doencodes _((SV* sv, char* s, I32 len)); static SV* refto _((SV* sv)); static U32 seed _((void)); @@ -806,11 +863,13 @@ PP(pp_left_shift) IBW shift = POPi; if (op->op_private & HINT_INTEGER) { IBW i = TOPi; - SETi( i << shift ); + i <<= shift; + SETi(BWi(i)); } else { UBW u = TOPu; - SETu( u << shift ); + u <<= shift; + SETu(BWu(u)); } RETURN; } @@ -823,11 +882,13 @@ PP(pp_right_shift) IBW shift = POPi; if (op->op_private & HINT_INTEGER) { IBW i = TOPi; - SETi( i >> shift ); + i >>= shift; + SETi(BWi(i)); } else { UBW u = TOPu; - SETu( u >> shift ); + u >>= shift; + SETu(BWu(u)); } RETURN; } @@ -998,11 +1059,11 @@ PP(pp_bit_and) if (SvNIOKp(left) || SvNIOKp(right)) { if (op->op_private & HINT_INTEGER) { IBW value = SvIV(left) & SvIV(right); - SETi( value ); + SETi(BWi(value)); } else { UBW value = SvUV(left) & SvUV(right); - SETu( value ); + SETu(BWu(value)); } } else { @@ -1021,11 +1082,11 @@ PP(pp_bit_xor) if (SvNIOKp(left) || SvNIOKp(right)) { if (op->op_private & HINT_INTEGER) { IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); - SETi( value ); + SETi(BWi(value)); } else { UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); - SETu( value ); + SETu(BWu(value)); } } else { @@ -1044,11 +1105,11 @@ PP(pp_bit_or) if (SvNIOKp(left) || SvNIOKp(right)) { if (op->op_private & HINT_INTEGER) { IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); - SETi( value ); + SETi(BWi(value)); } else { UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); - SETu( value ); + SETu(BWu(value)); } } else { @@ -1108,11 +1169,11 @@ PP(pp_complement) if (SvNIOKp(sv)) { if (op->op_private & HINT_INTEGER) { IBW value = ~SvIV(sv); - SETi( value ); + SETi(BWi(value)); } else { UBW value = ~SvUV(sv); - SETu( value ); + SETu(BWu(value)); } } else { @@ -2637,7 +2698,7 @@ PP(pp_unpack) len = (datumtype != '@'); switch(datumtype) { default: - break; + croak("Invalid type in unpack: '%c'", datumtype); case '%': if (len == 1 && pat[-1] != '1') len = 16; @@ -2829,13 +2890,13 @@ PP(pp_unpack) } break; case 's': - along = (strend - s) / sizeof(I16); + along = (strend - s) / SIZE16; if (len > along) len = along; if (checksum) { while (len-- > 0) { - Copy(s, &ashort, 1, I16); - s += sizeof(I16); + COPY16(s, &ashort); + s += SIZE16; culong += ashort; } } @@ -2843,8 +2904,8 @@ PP(pp_unpack) EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0) { - Copy(s, &ashort, 1, I16); - s += sizeof(I16); + COPY16(s, &ashort); + s += SIZE16; sv = NEWSV(38, 0); sv_setiv(sv, (IV)ashort); PUSHs(sv_2mortal(sv)); @@ -2854,13 +2915,13 @@ PP(pp_unpack) case 'v': case 'n': case 'S': - along = (strend - s) / sizeof(U16); + along = (strend - s) / SIZE16; if (len > along) len = along; if (checksum) { while (len-- > 0) { - Copy(s, &aushort, 1, U16); - s += sizeof(U16); + COPY16(s, &aushort); + s += SIZE16; #ifdef HAS_NTOHS if (datumtype == 'n') aushort = ntohs(aushort); @@ -2876,8 +2937,8 @@ PP(pp_unpack) EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0) { - Copy(s, &aushort, 1, U16); - s += sizeof(U16); + COPY16(s, &aushort); + s += SIZE16; sv = NEWSV(39, 0); #ifdef HAS_NTOHS if (datumtype == 'n') @@ -2945,13 +3006,13 @@ PP(pp_unpack) } break; case 'l': - along = (strend - s) / sizeof(I32); + along = (strend - s) / SIZE32; if (len > along) len = along; if (checksum) { while (len-- > 0) { - Copy(s, &along, 1, I32); - s += sizeof(I32); + COPY32(s, &along); + s += SIZE32; if (checksum > 32) cdouble += (double)along; else @@ -2962,8 +3023,8 @@ PP(pp_unpack) EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0) { - Copy(s, &along, 1, I32); - s += sizeof(I32); + COPY32(s, &along); + s += SIZE32; sv = NEWSV(42, 0); sv_setiv(sv, (IV)along); PUSHs(sv_2mortal(sv)); @@ -2973,13 +3034,13 @@ PP(pp_unpack) case 'V': case 'N': case 'L': - along = (strend - s) / sizeof(U32); + along = (strend - s) / SIZE32; if (len > along) len = along; if (checksum) { while (len-- > 0) { - Copy(s, &aulong, 1, U32); - s += sizeof(U32); + COPY32(s, &aulong); + s += SIZE32; #ifdef HAS_NTOHL if (datumtype == 'N') aulong = ntohl(aulong); @@ -2998,8 +3059,8 @@ PP(pp_unpack) EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0) { - Copy(s, &aulong, 1, U32); - s += sizeof(U32); + COPY32(s, &aulong); + s += SIZE32; #ifdef HAS_NTOHL if (datumtype == 'N') aulong = ntohl(aulong); @@ -3102,7 +3163,10 @@ PP(pp_unpack) s += sizeof(Quad_t); } sv = NEWSV(42, 0); - sv_setiv(sv, (IV)aquad); + if (aquad >= IV_MIN && aquad <= IV_MAX) + sv_setiv(sv, (IV)aquad); + else + sv_setnv(sv, (double)aquad); PUSHs(sv_2mortal(sv)); } break; @@ -3117,7 +3181,10 @@ PP(pp_unpack) s += sizeof(unsigned Quad_t); } sv = NEWSV(43, 0); - sv_setuv(sv, (UV)auquad); + if (aquad <= UV_MAX) + sv_setuv(sv, (UV)auquad); + else + sv_setnv(sv, (double)auquad); PUSHs(sv_2mortal(sv)); } break; @@ -3238,10 +3305,10 @@ PP(pp_unpack) } else { if (checksum < 32) { - along = (1 << checksum) - 1; - culong &= (U32)along; + aulong = (1 << checksum) - 1; + culong &= aulong; } - sv_setnv(sv, (double)culong); + sv_setuv(sv, (UV)culong); } XPUSHs(sv_2mortal(sv)); checksum = 0; @@ -3407,7 +3474,7 @@ PP(pp_pack) len = 1; switch(datumtype) { default: - break; + croak("Invalid type in pack: '%c'", datumtype); case '%': DIE("%% may only be used in unpack"); case '@': @@ -3609,7 +3676,7 @@ PP(pp_pack) #ifdef HAS_HTONS ashort = htons(ashort); #endif - sv_catpvn(cat, (char*)&ashort, sizeof(I16)); + CAT16(cat, &ashort); } break; case 'v': @@ -3619,7 +3686,7 @@ PP(pp_pack) #ifdef HAS_HTOVS ashort = htovs(ashort); #endif - sv_catpvn(cat, (char*)&ashort, sizeof(I16)); + CAT16(cat, &ashort); } break; case 'S': @@ -3627,13 +3694,13 @@ PP(pp_pack) while (len-- > 0) { fromstr = NEXTFROM; ashort = (I16)SvIV(fromstr); - sv_catpvn(cat, (char*)&ashort, sizeof(I16)); + CAT16(cat, &ashort); } break; case 'I': while (len-- > 0) { fromstr = NEXTFROM; - auint = U_I(SvNV(fromstr)); + auint = SvUV(fromstr); sv_catpvn(cat, (char*)&auint, sizeof(unsigned int)); } break; @@ -3706,35 +3773,35 @@ PP(pp_pack) case 'N': while (len-- > 0) { fromstr = NEXTFROM; - aulong = U_L(SvNV(fromstr)); + aulong = SvUV(fromstr); #ifdef HAS_HTONL aulong = htonl(aulong); #endif - sv_catpvn(cat, (char*)&aulong, sizeof(U32)); + CAT32(cat, &aulong); } break; case 'V': while (len-- > 0) { fromstr = NEXTFROM; - aulong = U_L(SvNV(fromstr)); + aulong = SvUV(fromstr); #ifdef HAS_HTOVL aulong = htovl(aulong); #endif - sv_catpvn(cat, (char*)&aulong, sizeof(U32)); + CAT32(cat, &aulong); } break; case 'L': while (len-- > 0) { fromstr = NEXTFROM; - aulong = U_L(SvNV(fromstr)); - sv_catpvn(cat, (char*)&aulong, sizeof(U32)); + aulong = SvUV(fromstr); + CAT32(cat, &aulong); } break; case 'l': while (len-- > 0) { fromstr = NEXTFROM; along = SvIV(fromstr); - sv_catpvn(cat, (char*)&along, sizeof(I32)); + CAT32(cat, &along); } break; #ifdef HAS_QUAD diff --git a/pp_sys.c b/pp_sys.c index 4eca776..712b003 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1357,6 +1357,11 @@ PP(pp_eof) PP(pp_tell) { + return pp_systell(ARGS); +} + +PP(pp_systell) +{ dSP; dTARGET; GV *gv; diff --git a/t/op/sysio.t b/t/op/sysio.t index f2e72cf..6135cd3 100755 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -1,6 +1,6 @@ #!./perl -print "1..32\n"; +print "1..34\n"; chdir('op') || die "sysio.t: cannot look for myself: $!"; @@ -164,17 +164,21 @@ print "ok 29\n"; print 'not ' unless ($b eq '#!ererl'); print "ok 30\n"; -# test sysseek +# test sysseek and systell sysseek(I, 2, 0); sysread(I, $b, 3); print 'not ' unless $b eq 'ere'; print "ok 31\n"; +print 'not ' unless systell(I) == 5; +print "ok 32\n"; sysseek(I, -2, 1); sysread(I, $b, 4); print 'not ' unless $b eq 'rerl'; -print "ok 32\n"; +print "ok 33\n"; +print 'not ' unless systell(I) == 7; +print "ok 34\n"; close(I); diff --git a/toke.c b/toke.c index d96d9ad..1431d26 100644 --- a/toke.c +++ b/toke.c @@ -2514,6 +2514,7 @@ yylex() default: /* not a keyword */ just_a_word: { GV *gv; + SV *sv; char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]); /* Get the rest if it looks like a package qualifier */ @@ -2580,6 +2581,13 @@ yylex() s = skipspace(s); if (*s == '(') { CLINE; + if (gv && GvCVu(gv)) { + for (d = s + 1; *d == ' ' || *d == '\t'; d++) ; + if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) { + s = d + 1; + goto its_constant; + } + } nextval[nexttoke].opval = yylval.opval; expect = XOPERATOR; force_next(WORD); @@ -2604,27 +2612,18 @@ yylex() if (gv && GvCVu(gv)) { CV* cv = GvCV(gv); - if (*s == '(') { - nextval[nexttoke].opval = yylval.opval; - expect = XTERM; - force_next(WORD); - yylval.ival = 0; - TOKEN('&'); - } if (lastchar == '-') warn("Ambiguous use of -%s resolved as -&%s()", tokenbuf, tokenbuf); last_lop = oldbufptr; last_lop_op = OP_ENTERSUB; /* Check for a constant sub */ - { - SV *sv = cv_const_sv(cv); - if (sv) { - SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv); - ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv); - yylval.opval->op_private = 0; - TOKEN(WORD); - } + if ((sv = cv_const_sv(cv))) { + its_constant: + SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv); + ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv); + yylval.opval->op_private = 0; + TOKEN(WORD); } /* Resolve to GV now. */ @@ -3530,12 +3529,15 @@ yylex() case KEY_sysopen: LOP(OP_SYSOPEN,XTERM); - case KEY_sysread: - LOP(OP_SYSREAD,XTERM); + case KEY_systell: + UNI(OP_SYSTELL); case KEY_sysseek: LOP(OP_SYSSEEK,XTERM); + case KEY_sysread: + LOP(OP_SYSREAD,XTERM); + case KEY_syswrite: LOP(OP_SYSWRITE,XTERM); @@ -4188,6 +4190,7 @@ I32 len; if (strEQ(d,"sysopen")) return -KEY_sysopen; if (strEQ(d,"sysread")) return -KEY_sysread; if (strEQ(d,"sysseek")) return -KEY_sysseek; + if (strEQ(d,"systell")) return -KEY_systell; break; case 8: if (strEQ(d,"syswrite")) return -KEY_syswrite; diff --git a/vms/perly_c.vms b/vms/perly_c.vms index 0949d5b..c371e4b 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1631,8 +1631,8 @@ case 32: #line 209 "perly.y" { copline = yyvsp[-9].ival; yyval.opval = block_end(yyvsp[-7].ival, - append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), - newSTATEOP(0, yyvsp[-10].pval, + newSTATEOP(0, yyvsp[-10].pval, + append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), newWHILEOP(0, 1, (LOOP*)Nullop, scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval))))); } diff --git a/vms/vms.c b/vms/vms.c index 20710f7..e1977fb 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -2,8 +2,8 @@ * * VMS-specific routines for perl5 * - * Last revised: 15-Feb-1997 by Charles Bailey bailey@genetics.upenn.edu - * Version: 5.3.27 + * Last revised: 11-Apr-1997 by Charles Bailey bailey@genetics.upenn.edu + * Version: 5.3.97c */ #include @@ -774,15 +774,18 @@ my_gconvert(double val, int ndig, int trail, char *buf) * rmesexpand() returns the address of the resultant string if * successful, and NULL on error. */ +static char *do_tounixspec(char *, char *, int); + static char * do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) { static char __rmsexpand_retbuf[NAM$C_MAXRSS+1]; + char vmsfspec[NAM$C_MAXRSS+1], tmpfspec[NAM$C_MAXRSS+1]; char esa[NAM$C_MAXRSS], *cp, *out = NULL; struct FAB myfab = cc$rms_fab; struct NAM mynam = cc$rms_nam; STRLEN speclen; - unsigned long int retsts, haslower = 0; + unsigned long int retsts, haslower = 0, isunix = 0; if (!filespec || !*filespec) { set_vaxc_errno(LIB$_INVARG); set_errno(EINVAL); @@ -792,12 +795,20 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) if (ts) out = New(7019,outbuf,NAM$C_MAXRSS+1,char); else outbuf = __rmsexpand_retbuf; } + if ((isunix = (strchr(filespec,'/') != NULL))) { + if (do_tovmsspec(filespec,vmsfspec,0) == NULL) return NULL; + filespec = vmsfspec; + } myfab.fab$l_fna = filespec; myfab.fab$b_fns = strlen(filespec); myfab.fab$l_nam = &mynam; if (defspec && *defspec) { + if (strchr(defspec,'/') != NULL) { + if (do_tovmsspec(defspec,tmpfspec,0) == NULL) return NULL; + defspec = tmpfspec; + } myfab.fab$l_dna = defspec; myfab.fab$b_dns = strlen(defspec); } @@ -852,7 +863,17 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) if (haslower) __mystrtolower(out); /* Have we been working with an expanded, but not resultant, spec? */ - if (!mynam.nam$b_rsl) strcpy(outbuf,esa); + /* Also, convert back to Unix syntax if necessary. */ + if (!mynam.nam$b_rsl) { + if (isunix) { + if (do_tounixspec(esa,outbuf,0) == NULL) return NULL; + } + else strcpy(outbuf,esa); + } + else if (isunix) { + if (do_tounixspec(outbuf,tmpfspec,0) == NULL) return NULL; + strcpy(outbuf,tmpfspec); + } return outbuf; } /*}}}*/ @@ -897,8 +918,6 @@ char *rmsexpand_ts(char *spec, char *buf, char *def, unsigned opt) ** found in the Perl standard distribution. */ -static char *do_tounixspec(char *, char *, int); - /*{{{ char *fileify_dirspec[_ts](char *path, char *buf)*/ static char *do_fileify_dirspec(char *dir,char *buf,int ts) { diff --git a/vms/writemain.pl b/vms/writemain.pl index 5f1c8bf..a502d61 100644 --- a/vms/writemain.pl +++ b/vms/writemain.pl @@ -36,7 +36,6 @@ print OUT <<'EOH'; static void xs_init() { - dXSUB_SYS; EOH if (@ARGV) { @@ -53,6 +52,8 @@ if (@exts) { $subname =~ s/::/__/g; print OUT "extern void boot_${subname} _((CV* cv));\n" } + # May not actually be a declaration, so put after other declarations + print OUT " dXSUB_SYS;\n"; foreach $ext (@exts) { my($subname) = $ext; $subname =~ s/::/__/g; diff --git a/win32/Makefile b/win32/Makefile index 0e7068f..5005181 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -48,12 +48,12 @@ OPTIMIZE = -Od $(RUNTIME) -Z7 -D "_DEBUG" ! ELSE OPTIMIZE = -Od $(RUNTIME)d -Z7 -D "_DEBUG" ! ENDIF -LINK_DBG = -pdb:$(*B).pdb +LINK_DBG = -debug -pdb:none !ELSE ! IF "$(CCTYPE)" == "MSVC20" OPTIMIZE = -Od $(RUNTIME) -D "NDEBUG" ! ELSE -OPTIMIZE = -O2 $(RUNTIME) -D "NDEBUG" +OPTIMIZE = -Od $(RUNTIME) -D "NDEBUG" ! ENDIF LINK_DBG = -release !ENDIF diff --git a/win32/makedef.pl b/win32/makedef.pl index 0d510ae..5237676 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -208,17 +208,18 @@ perl_call_pv perl_call_method perl_call_sv perl_requirepv -win32_stat win32_errno -win32_stderr +win32_environ win32_stdin win32_stdout +win32_stderr win32_ferror win32_feof win32_strerror win32_fprintf win32_printf win32_vfprintf +win32_vprintf win32_fread win32_fwrite win32_fopen @@ -240,14 +241,18 @@ win32_rewind win32_tmpfile win32_abort win32_fstat +win32_stat win32_pipe win32_popen win32_pclose win32_setmode -win32_open -win32_close +win32_lseek +win32_tell win32_dup win32_dup2 +win32_open +win32_close +win32_eof win32_read win32_write win32_spawnvpe diff --git a/win32/perllib.c b/win32/perllib.c index 9d24a2a..43d84c5 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -8,6 +8,7 @@ extern "C" { #include "EXTERN.h" #include "perl.h" +#include "XSUB.h" #ifdef __cplusplus } @@ -60,12 +61,35 @@ char *staticlinkmodules[] = { EXTERN_C void boot_DynaLoader _((CV* cv)); +static +XS(w32_GetCurrentDirectory) +{ + dXSARGS; + SV *sv = sv_newmortal(); + /* Make one call with zero size - return value is required size */ + DWORD len = GetCurrentDirectory((DWORD)0,NULL); + SvUPGRADE(sv,SVt_PV); + SvGROW(sv,len); + SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv)); + /* + * If result != 0 + * then it worked, set PV valid, + * else leave it 'undef' + */ + if (SvCUR(sv)) + SvPOK_on(sv); + EXTEND(sp,1); + ST(0) = sv; + XSRETURN(1); +} + static void xs_init() { char *file = __FILE__; dXSUB_SYS; newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + newXS("Win32::GetCurrentDirectory", w32_GetCurrentDirectory, file); } extern HANDLE PerlDllHandle; diff --git a/win32/win32.c b/win32/win32.c index 9090364..ee50147 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -841,6 +841,12 @@ win32_vfprintf(FILE *fp, const char *format, va_list args) return (pIOSubSystem->pfnvfprintf(fp, format, args)); } +DllExport int +win32_vprintf(const char *format, va_list args) +{ + return (pIOSubSystem->pfnvprintf(format, args)); +} + DllExport size_t win32_fread(void *buf, size_t size, size_t count, FILE *fp) { @@ -998,6 +1004,18 @@ win32_setmode(int fd, int mode) return pIOSubSystem->pfnsetmode(fd, mode); } +DllExport long +win32_lseek(int fd, long offset, int origin) +{ + return pIOSubSystem->pfnlseek(fd, offset, origin); +} + +DllExport long +win32_tell(int fd) +{ + return pIOSubSystem->pfntell(fd); +} + DllExport int win32_open(const char *path, int flag, ...) { @@ -1020,6 +1038,12 @@ win32_close(int fd) } DllExport int +win32_eof(int fd) +{ + return pIOSubSystem->pfneof(fd); +} + +DllExport int win32_dup(int fd) { return pIOSubSystem->pfndup(fd); @@ -1048,16 +1072,19 @@ win32_mkdir(const char *dir, int mode) { return pIOSubSystem->pfnmkdir(dir); /* just ignore mode */ } + DllExport int win32_rmdir(const char *dir) { return pIOSubSystem->pfnrmdir(dir); } + DllExport int win32_chdir(const char *dir) { return pIOSubSystem->pfnchdir(dir); } + DllExport int win32_spawnvpe(int mode, const char *cmdname, const char *const *argv, const char *const *envp) diff --git a/win32/win32iop.h b/win32/win32iop.h index eadc08f..f630000 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -21,6 +21,7 @@ EXT char* win32_strerror(int e); EXT int win32_fprintf(FILE *pf, const char *format, ...); EXT int win32_printf(const char *format, ...); EXT int win32_vfprintf(FILE *pf, const char *format, va_list arg); +EXT int win32_vprintf(const char *format, va_list arg); EXT size_t win32_fread(void *buf, size_t size, size_t count, FILE *pf); EXT size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf); EXT FILE* win32_fopen(const char *path, const char *mode); @@ -100,6 +101,7 @@ void * SetIOSubSystem(void *piosubsystem); #define fprintf win32_fprintf #define vfprintf win32_vfprintf #define printf win32_printf +#define vprintf win32_vprintf #define fread(buf,size,count,f) win32_fread(buf,size,count,f) #define fwrite(buf,size,count,f) win32_fwrite(buf,size,count,f) #define fopen win32_fopen