U32 dprof_ticks;
char* out_file_name; /* output file (defaults to tmon.out) */
PerlIO* fp; /* pointer to tmon.out file */
- long TIMES_LOCATION; /* Where in the file to store the time totals */
+ Off_t TIMES_LOCATION; /* Where in the file to store the time totals */
int SAVE_STACK; /* How much data to buffer until end of run */
int prof_pid; /* pid of profiled process */
struct tms prof_start;
int fd1
int fd2
-SysRetLong
+SV *
lseek(fd, offset, whence)
int fd
Off_t offset
int whence
+ CODE:
+ Off_t pos = PerlLIO_lseek(fd, offset, whence);
+ RETVAL = sizeof(Off_t) > sizeof(IV)
+ ? newSVnv((NV)pos) : newSViv((IV)pos);
+ OUTPUT:
+ RETVAL
SysRet
nice(incr)
PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
- char *dst = SvGROW(s->var, s->posn + count);
+ char *dst = SvGROW(s->var, (STRLEN)s->posn + count);
Move(vbuf, dst + s->posn, count, char);
s->posn += count;
- SvCUR_set(s->var, s->posn);
+ SvCUR_set(s->var, (STRLEN)s->posn);
SvPOK_on(s->var);
return count;
}
}
else {
if ((s->posn + count) > SvCUR(sv))
- dst = SvGROW(sv, s->posn + count);
+ dst = SvGROW(sv, (STRLEN)s->posn + count);
else
dst = SvPV_nolen(sv);
offset = s->posn;
}
Move(vbuf, dst + offset, count, char);
if ((STRLEN) s->posn > SvCUR(sv))
- SvCUR_set(sv, s->posn);
+ SvCUR_set(sv, (STRLEN)s->posn);
SvPOK_on(s->var);
return count;
}
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
if (SvCUR(s->var) > (STRLEN) s->posn)
- return SvCUR(s->var) - s->posn;
+ return SvCUR(s->var) - (STRLEN)s->posn;
else
return 0;
}
PerlIOVia_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
- SV *offsv = sv_2mortal(newSViv(offset));
+ SV *offsv = sv_2mortal(sizeof(Off_t) > sizeof(IV)
+ ? newSVnv((NV)offset) : newSViv((IV)offset));
SV *whsv = sv_2mortal(newSViv(whence));
SV *result =
PerlIOVia_method(aTHX_ f, MYMethod(SEEK), G_SCALAR, offsv, whsv,
PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
SV *result =
PerlIOVia_method(aTHX_ f, MYMethod(TELL), G_SCALAR, Nullsv);
- return (result) ? (Off_t) SvIV(result) : (Off_t) - 1;
+ return (result)
+ ? (SvNOK(result) ? (Off_t)SvNV(result) : (Off_t)SvIV(result))
+ : (Off_t) - 1;
}
SSize_t
typedef int (*LPLIOChmod)(struct IPerlLIO*, const char*, int);
typedef int (*LPLIOChown)(struct IPerlLIO*, const char*, uid_t,
gid_t);
-typedef int (*LPLIOChsize)(struct IPerlLIO*, int, long);
+typedef int (*LPLIOChsize)(struct IPerlLIO*, int, Off_t);
typedef int (*LPLIOClose)(struct IPerlLIO*, int);
typedef int (*LPLIODup)(struct IPerlLIO*, int);
typedef int (*LPLIODup2)(struct IPerlLIO*, int, int);
PUSHs(sv_2mortal(newSVpvn("", 0)));
#endif
#if Off_t_size > IVSIZE
- PUSHs(sv_2mortal(newSVnv(PL_statcache.st_size)));
+ PUSHs(sv_2mortal(newSVnv((NV)PL_statcache.st_size)));
#else
PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
#endif
USE_PERLIO = define
#
+# Comment this out if you don't want to enable large file support for
+# some reason. Should normally only be changed to maintain compatibility
+# with an older release of perl.
+USE_LARGE_FILES = define
+
+#
# uncomment one of the following lines if you are using either
# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98)
#
#CCTYPE = MSVC20
-#CCTYPE = MSVC60
+CCTYPE = MSVC60
#
# uncomment next line if you want debug version of perl (big,slow)
USE_PERLIO = undef
!ENDIF
+!IF "$(USE_LARGE_FILES)" == ""
+USE_LARGE_FILES = undef
+!ENDIF
+
!IF "$(USE_PERLCRT)" == ""
USE_PERLCRT = undef
!ENDIF
"useithreads=$(USE_ITHREADS)" \
"usemultiplicity=$(USE_MULTI)" \
"useperlio=$(USE_PERLIO)" \
+ "uselargefiles=$(USE_LARGE_FILES)" \
"LINK_FLAGS=$(LINK_FLAGS:"=\")" \
"optimize=$(OPTIMIZE:"=\")"
lp=''
lpr=''
ls='dir'
-lseeksize='4'
-lseektype='off_t'
+lseeksize='8'
+lseektype='__int64'
mail=''
mailx=''
make='dmake'
usecrosscompile='undef'
usedl='define'
useithreads='undef'
-uselargefiles='undef'
+uselargefiles='define'
uselongdouble='undef'
usemorebits='undef'
usemultiplicity='undef'
lp=''
lpr=''
ls='dir'
-lseeksize='4'
-lseektype='off_t'
+lseeksize='8'
+lseektype='long long'
mail=''
mailx=''
make='dmake'
usecrosscompile='undef'
usedl='define'
useithreads='undef'
-uselargefiles='undef'
+uselargefiles='define'
uselongdouble='undef'
usemorebits='undef'
usemultiplicity='undef'
lp=''
lpr=''
ls='dir'
-lseeksize='4'
-lseektype='off_t'
+lseeksize='8'
+lseektype='__int64'
mail=''
mailx=''
make='nmake'
usecrosscompile='undef'
usedl='define'
useithreads='undef'
-uselargefiles='undef'
+uselargefiles='define'
uselongdouble='undef'
usemorebits='undef'
usemultiplicity='undef'
usecrosscompile='undef'
usedl='define'
useithreads='undef'
-uselargefiles='undef'
+uselargefiles='define'
uselongdouble='undef'
usemorebits='undef'
usemultiplicity='undef'
/* Off_t_size:
* This symbol holds the number of bytes used by the Off_t.
*/
-#define Off_t off_t /* <offset> type */
-#define LSEEKSIZE 4 /* <offset> size */
-#define Off_t_size 4 /* <offset> size */
+#define Off_t __int64 /* <offset> type */
+#define LSEEKSIZE 8 /* <offset> size */
+#define Off_t_size 8 /* <offset> size */
/* Free_t:
* This variable contains the return type of free(). It is usually
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+#define USE_LARGE_FILES /**/
#endif
/* USE_LONG_DOUBLE:
/* Off_t_size:
* This symbol holds the number of bytes used by the Off_t.
*/
-#define Off_t off_t /* <offset> type */
-#define LSEEKSIZE 4 /* <offset> size */
-#define Off_t_size 4 /* <offset> size */
+#define Off_t long long /* <offset> type */
+#define LSEEKSIZE 8 /* <offset> size */
+#define Off_t_size 8 /* <offset> size */
/* Free_t:
* This variable contains the return type of free(). It is usually
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+#define USE_LARGE_FILES /**/
#endif
/* USE_LONG_DOUBLE:
/* Off_t_size:
* This symbol holds the number of bytes used by the Off_t.
*/
-#define Off_t off_t /* <offset> type */
-#define LSEEKSIZE 4 /* <offset> size */
-#define Off_t_size 4 /* <offset> size */
+#define Off_t __int64 /* <offset> type */
+#define LSEEKSIZE 8 /* <offset> size */
+#define Off_t_size 8 /* <offset> size */
/* Free_t:
* This variable contains the return type of free(). It is usually
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+#define USE_LARGE_FILES /**/
#endif
/* USE_LONG_DOUBLE:
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+#define USE_LARGE_FILES /**/
#endif
/* USE_LONG_DOUBLE:
$opt{d_link} = 'undef';
}
+if ($opt{uselargefiles} ne 'define') {
+ $opt{lseeksize} = 4;
+ $opt{lseektype} = 'off_t';
+}
+
while (<>) {
s/~([\w_]+)~/$opt{$1}/g;
if (/^([\w_]+)=(.*)$/) {
# then get a number of fails from make test i.e. bugs - complain to them not us ;-).
# You will also be unable to take full advantage of perl5.8's support for multiple
# encodings and may see lower IO performance. You have been warned.
-USE_PERLIO = define
+USE_PERLIO *= define
+
+#
+# Comment this out if you don't want to enable large file support for
+# some reason. Should normally only be changed to maintain compatibility
+# with an older release of perl.
+USE_LARGE_FILES *= define
#
# uncomment exactly one of the following
USE_ITHREADS *= undef
USE_IMP_SYS *= undef
USE_PERLIO *= undef
+USE_LARGE_FILES *= undef
USE_PERLCRT *= undef
.IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
useithreads=$(USE_ITHREADS) ~ \
usemultiplicity=$(USE_MULTI) ~ \
useperlio=$(USE_PERLIO) ~ \
- LINK_FLAGS=$(LINK_FLAGS:s/\/\\/) ~ \
+ uselargefiles=$(USE_LARGE_FILES) ~ \
+ LINK_FLAGS=$(LINK_FLAGS:s/\/\\/) ~ \
optimize=$(OPTIMIZE)
#
}
int
-PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
+PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
{
- return chsize(handle, size);
+ return win32_chsize(handle, size);
}
int
return setmode(fd, mode);
}
+DllExport int
+win32_chsize(int fd, Off_t size)
+{
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+ int retval = 0;
+ Off_t cur, end, extend;
+
+ cur = win32_tell(fd);
+ if (cur < 0)
+ return -1;
+ end = win32_lseek(fd, 0, SEEK_END);
+ if (end < 0)
+ return -1;
+ extend = size - end;
+ if (extend == 0) {
+ /* do nothing */
+ }
+ else if (extend > 0) {
+ /* must grow the file, padding with nulls */
+ char b[4096];
+ int oldmode = win32_setmode(fd, O_BINARY);
+ size_t count;
+ memset(b, '\0', sizeof(b));
+ do {
+ count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
+ count = win32_write(fd, b, count);
+ if (count < 0) {
+ retval = -1;
+ break;
+ }
+ } while ((extend -= count) > 0);
+ win32_setmode(fd, oldmode);
+ }
+ else {
+ /* shrink the file */
+ win32_lseek(fd, size, SEEK_SET);
+ if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
+ errno = EACCES;
+ retval = -1;
+ }
+ }
+finish:
+ win32_lseek(fd, cur, SEEK_SET);
+ return retval;
+#else
+ return chsize(fd, size);
+#endif
+}
+
DllExport Off_t
win32_lseek(int fd, Off_t offset, int origin)
{
DllExport int win32_pclose( PerlIO *pf);
DllExport int win32_rename( const char *oname, const char *newname);
DllExport int win32_setmode( int fd, int mode);
+DllExport int win32_chsize(int fd, Off_t size);
DllExport Off_t win32_lseek( int fd, Off_t offset, int origin);
DllExport Off_t win32_tell( int fd);
DllExport int win32_dup( int fd);
#define longpath(pth) win32_longpath(pth)
#define rename(old,new) win32_rename(old,new)
#define setmode(fd,mode) win32_setmode(fd,mode)
+#define chsize(fd,sz) win32_chsize(fd,sz)
#define lseek(fd,offset,orig) win32_lseek(fd,offset,orig)
#define tell(fd) win32_tell(fd)
#define dup(fd) win32_dup(fd)