# include <shadow.h>
#endif
-#ifdef HAS_SYSCALL
-#ifdef __cplusplus
-extern "C" int syscall(unsigned long,...);
-#endif
-#endif
-
#ifdef I_SYS_WAIT
# include <sys/wait.h>
#endif
# undef my_chsize
# endif
# define my_chsize PerlLIO_chsize
+#else
+# ifdef HAS_TRUNCATE
+# define my_chsize PerlLIO_chsize
+# else
+I32 my_chsize(int fd, Off_t length);
+# endif
#endif
#ifdef HAS_FLOCK
#endif /* no flock() */
#define ZBTLEN 10
-static char zero_but_true[ZBTLEN + 1] = "0 but true";
+static const char zero_but_true[ZBTLEN + 1] = "0 but true";
#if defined(I_SYS_ACCESS) && !defined(R_OK)
# include <sys/access.h>
PerlIO *fp;
STRLEN n_a;
char *tmps = POPpx;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
const char *mode = "r";
TAINT_PROPER("``");
ENTER;
SAVESPTR(PL_rs);
PL_rs = &PL_sv_undef;
- sv_setpv(TARG, ""); /* note that this preserves previous buffer */
+ sv_setpvn(TARG, "", 0); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
/*SUPPRESS 530*/
;
}
XPUSHs(sv_2mortal(sv));
if (SvLEN(sv) - SvCUR(sv) > 20) {
- SvLEN_set(sv, SvCUR(sv)+1);
- Renew(SvPVX(sv), SvLEN(sv), char);
+ SvPV_shrink_to_cur(sv);
}
SvTAINTED_on(sv);
}
PP(pp_glob)
{
+ dVAR;
OP *result;
tryAMAGICunTARGET(iter, -1);
PP(pp_open)
{
- dSP;
+ dVAR; dSP;
dMARK; dORIGMARK;
dTARGET;
GV *gv;
PP(pp_close)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
MAGIC *mg;
PP(pp_fileno)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_umask)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_UMASK
+ dTARGET;
Mode_t anum;
if (MAXARG < 1) {
PP(pp_binmode)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_tie)
{
- dSP;
- dMARK;
+ dVAR; dSP; dMARK;
SV *varsv;
HV* stash;
GV *gv;
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
- HvEITER((HV *)varsv) = Null(HE *);
+ HvEITER_set((HV *)varsv, 0);
break;
case SVt_PVAV:
methname = "TIEARRAY";
PP(pp_untie)
{
- dSP;
+ dVAR; dSP;
MAGIC *mg;
SV *sv = POPs;
char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
PP(pp_dbmopen)
{
- dSP;
+ dVAR; dSP;
HV *hv;
dPOPPOPssrl;
HV* stash;
}
}
- PUSHi(nfound);
+ if (nfound == -1)
+ PUSHs(&PL_sv_undef);
+ else
+ PUSHi(nfound);
if (GIMME == G_ARRAY && tbuf) {
value = (NV)(timebuf.tv_sec) +
(NV)(timebuf.tv_usec) / 1000000.0;
PP(pp_getc)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io = NULL;
MAGIC *mg;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
{
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
RETPUSHUNDEF;
}
TAINT;
- sv_setpv(TARG, " ");
+ sv_setpvn(TARG, " ", 1);
*SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */
if (PerlIO_isutf8(IoIFP(GvIOp(gv)))) {
/* Find out how many bytes the char needs */
STATIC OP *
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
+ dVAR;
register PERL_CONTEXT *cx;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
PP(pp_leavewrite)
{
- dSP;
+ dVAR; dSP;
GV *gv = cxstack[cxstack_ix].blk_sub.gv;
register IO *io = GvIOp(gv);
PerlIO *ofp = IoOFP(io);
}
if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */
I32 lines = IoLINES_LEFT(io);
- char *s = SvPVX(PL_formtarget);
+ const char *s = SvPVX(PL_formtarget);
if (lines <= 0) /* Yow, header didn't even fit!!! */
goto forget_top;
while (lines-- > 0) {
s++;
}
if (s) {
- STRLEN save = SvCUR(PL_formtarget);
+ const STRLEN save = SvCUR(PL_formtarget);
SvCUR_set(PL_formtarget, s - SvPVX(PL_formtarget));
do_print(PL_formtarget, ofp);
SvCUR_set(PL_formtarget, save);
PP(pp_prtf)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_sysread)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
int offset;
GV *gv;
IO *io;
(should be 2 * length + offset + 1, or possibly something longer if
PL_encoding is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
- if (offset > bufsize) { /* Zero any newly allocated space */
+ if (offset > 0 && (Sock_size_t)offset > bufsize) { /* Zero any newly allocated space */
Zero(buffer+bufsize, offset-bufsize, char);
}
buffer = buffer + offset;
SvCUR_set(bufsv, offset);
read_target = sv_newmortal();
- SvUPGRADE(read_target, SVt_PV);
- buffer = SvGROW(read_target, length + 1);
+ (void)SvUPGRADE(read_target, SVt_PV);
+ buffer = SvGROW(read_target, (STRLEN)(length + 1));
}
if (PL_op->op_type == OP_SYSREAD) {
PP(pp_syswrite)
{
- dSP;
+ dVAR; dSP;
int items = (SP - PL_stack_base) - TOPMARK;
if (items == 2) {
SV *sv;
PP(pp_send)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
SV *bufsv;
PP(pp_eof)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
MAGIC *mg;
PP(pp_tell)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io;
MAGIC *mg;
PP(pp_sysseek)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
int whence = POPi;
* might not be signed: if it is not, clever compilers will moan. */
/* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
SETERRNO(0,0);
-#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
{
int result = 1;
GV *tmpgv;
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
}
-#else
- DIE(aTHX_ "truncate not implemented");
-#endif
}
PP(pp_fcntl)
if (gv != PL_defgv) {
PL_laststype = OP_STAT;
PL_statgv = gv;
- sv_setpv(PL_statname, "");
+ sv_setpvn(PL_statname, "", 0);
PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
}
else {
PL_statgv = gv;
PL_laststatval = -1;
- sv_setpv(PL_statname, "");
+ sv_setpvn(PL_statname, "", 0);
io = GvIO(PL_statgv);
}
if (io && IoIFP(io)) {
dSP;
SV *sv;
- I32 gimme = GIMME;
+ const I32 gimme = GIMME;
GV *gv = (GV *)POPs;
register Direntry_t *dp;
register IO *io = GvIOn(gv);
PP(pp_telldir)
{
#if defined(HAS_TELLDIR) || defined(telldir)
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
/* XXX does _anyone_ need this? --AD 2/20/1998 */
/* XXX netbsd still seemed to.
XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
I32 value;
STRLEN n_a;
int result;
- I32 did_pipes = 0;
if (PL_tainting) {
TAINT_ENV();
{
Pid_t childpid;
int pp[2];
+ I32 did_pipes = 0;
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
-# if defined(WIN32) || defined(OS2)
+# if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# if defined(WIN32) || defined(OS2)
+# if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
value = (I32)do_aspawn(Nullsv, MARK, SP);
# else
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
#ifdef HAS_GETPPID
dSP; dTARGET;
# ifdef THREADS_HAVE_PIDS
+ {
+ IV cur_ppid = getppid();
+ if (cur_ppid == 1)
+ /* maybe the parent process has died. Refresh ppid cache */
+ PL_ppid = cur_ppid;
+ }
XPUSHi( PL_ppid );
# else
XPUSHi( getppid() );
dSP;
Time_t when;
const struct tm *tmbuf;
- static const char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
- static const char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
+ static const char * const dayname[] =
+ {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
+ static const char * const monname[] =
+ {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
if (MAXARG < 1)
(void)time(&when);
* indent-tabs-mode: t
* End:
*
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff