diff --git a/EXTERN.h b/EXTERN.h index 2aa77dbf8f34..20968a19723a 100644 --- a/EXTERN.h +++ b/EXTERN.h @@ -32,18 +32,18 @@ /* miniperl should not export anything */ # if defined(PERL_IS_MINIPERL) && !defined(UNDER_CE) && defined(_MSC_VER) # define EXT extern -# define dEXT +# define dEXT # define EXTCONST extern const # define dEXTCONST const # else # if defined(PERLDLL) || defined(__SYMBIAN32__) # define EXT extern __declspec(dllexport) -# define dEXT +# define dEXT # define EXTCONST extern __declspec(dllexport) const # define dEXTCONST const # else # define EXT extern __declspec(dllimport) -# define dEXT +# define dEXT # define EXTCONST extern __declspec(dllimport) const # define dEXTCONST const # endif @@ -51,7 +51,7 @@ # else # if defined(__CYGWIN__) && defined(USEIMPORTLIB) # define EXT extern __declspec(dllimport) -# define dEXT +# define dEXT # define EXTCONST extern __declspec(dllimport) const # define dEXTCONST const # else diff --git a/NetWare/NWTInfo.c b/NetWare/NWTInfo.c index b057d56b2ad8..b9cc3581fd36 100644 --- a/NetWare/NWTInfo.c +++ b/NetWare/NWTInfo.c @@ -23,7 +23,7 @@ #include "nwtinfo.h" #ifdef MPK_ON - #include + #include #include #else #include @@ -129,7 +129,7 @@ void fnInitializeThreadInfo(void) #else g_tinfoSem = OpenLocalSemaphore(1); #endif //MPK_ON - + for (index = 0; index < NUM_ENTRIES; index++) g_ThreadInfo[index] = NULL; @@ -159,7 +159,7 @@ BOOL fnRegisterWithThreadTable(void) #else tinfo = fnAddThreadInfo(GetThreadID()); #endif //MPK_ON - + if (!tinfo) return FALSE; else @@ -219,7 +219,7 @@ ThreadInfo* fnAddThreadInfo(int tid) // tip = (ThreadInfo *) malloc(sizeof(ThreadInfo)); if (tip == NULL) - { + { if (g_tinfoSem) { #ifdef MPK_ON @@ -330,7 +330,7 @@ BOOL fnRemoveThreadInfo(int tid) ThreadInfo* fnGetThreadInfo(int tid) { - ThreadInfo* tip; + ThreadInfo* tip; int index = INDEXOF(tid); // just take the bottom five bits if (g_tinfoSem) { @@ -373,10 +373,10 @@ ThreadInfo* fnGetThreadInfo(int tid) BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList) { - ThreadInfo* tip; + ThreadInfo* tip; int index,tid; - if (g_tinfoSem) + if (g_tinfoSem) { #ifdef MPK_ON kSemaphoreWait(g_tinfoSem); @@ -391,7 +391,7 @@ BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList) tid=index = GetThreadID(); #endif //MPK_ON - index = INDEXOF(index); // just take the bottom five bits + index = INDEXOF(index); // just take the bottom five bits // see if this is already in the table at the index'th offset // @@ -427,10 +427,10 @@ BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList) BOOL fnGetHashListAddrs(void **addrs, BOOL *dontTouchHashList) { - ThreadInfo* tip; - int index,tid; + ThreadInfo* tip; + int index,tid; - if (g_tinfoSem) + if (g_tinfoSem) { #ifdef MPK_ON kSemaphoreWait(g_tinfoSem); @@ -445,7 +445,7 @@ BOOL fnGetHashListAddrs(void **addrs, BOOL *dontTouchHashList) tid=index = GetThreadID(); #endif //MPK_ON - index = INDEXOF(index); // just take the bottom five bits + index = INDEXOF(index); // just take the bottom five bits // see if this is already in the table at the index'th offset // @@ -542,7 +542,7 @@ ThreadContext* fnAddThreadCtx(long lTLSIndex, void *t) // tip = (ThreadContext *) malloc(sizeof(ThreadContext)); if (tip == NULL) - { + { if (g_tCtxSem) { #ifdef MPK_ON @@ -673,9 +673,9 @@ BOOL fnRemoveThreadCtx(long lTLSIndex) void* fnGetThreadCtx(long lTLSIndex) { - ThreadContext* tip; + ThreadContext* tip; - if (g_tCtxSem) + if (g_tCtxSem) { #ifdef MPK_ON kSemaphoreWait(g_tCtxSem); diff --git a/NetWare/NWUtil.c b/NetWare/NWUtil.c index 6d60dfbabdb5..3b812cbb636e 100644 --- a/NetWare/NWUtil.c +++ b/NetWare/NWUtil.c @@ -411,7 +411,7 @@ void fnAppendArgument(PCOMMANDLINEPARSER pclp, char *new_arg) // Lengthen the argument vector if there's not room for another. - // Testing for 'm_argc+2' rather than 'm_argc+1' in the test guarantees + // Testing for 'm_argc+2' rather than 'm_argc+1' in the test guarantees // that there'll always be a NULL terminator at the end of argv. if ((pclp->m_argc + 2) > pclp->m_argv_len) { @@ -480,7 +480,7 @@ void fnAppendArgument(PCOMMANDLINEPARSER pclp, char *new_arg) // More so when the command was like, "perl ", that is the name "perl" followed // by a few blank spaces, it used to give error in opening file: // "unable to open the file" since the filename would have some junk characters. - // + // // These issues are fixed through the code below. for(i=pclp->m_argc; im_argv_len; i++) strncpy(pclp->m_argv[i], "", (MAX_DN_BYTES * sizeof(char))); // MAX_DN_BYTES is the size of pclp->m_argv[]. @@ -544,7 +544,7 @@ char *fnSkipToken(char *s, char *r) else if (ch==quote) // if close quote... { quote = 0; // ...leave quote mode - } + } } } @@ -586,7 +586,7 @@ char *fnScanToken(char *x, char *r) while (*s) { ch = *s; // invariant: ch != 0 - + // look to see if we've reached the end of the token if (!quote) // but don't look for token break if we're inside quotes { @@ -599,7 +599,7 @@ char *fnScanToken(char *x, char *r) if (ch=='&' && x[1]=='>') break; // break on "&>" (redirect both stdout & stderr) } - + // process the next source character if (ch=='\\' && (c=s[1]) && (c=='\\'||c=='>'||c=='<'||c==quote)) { diff --git a/NetWare/Nwmain.c b/NetWare/Nwmain.c index 0b9728a8ac85..457d78eae85d 100644 --- a/NetWare/Nwmain.c +++ b/NetWare/Nwmain.c @@ -120,8 +120,8 @@ int fnFpSetMode(FILE* fp, int mode, int *err); void fnGetPerlScreenName(char *sPerlScreenName); void fnGetPerlScreenName(char *sPerlScreenName); -void fnSetupNamespace(void); -char *getcwd(char [], int); +void fnSetupNamespace(void); +char *getcwd(char [], int); void fnRunScript(ScriptData* psdata); void nw_freeenviron(); @@ -140,7 +140,7 @@ void nw_freeenviron(); ==============================================================================================*/ -void main(int argc, char *argv[]) +void main(int argc, char *argv[]) { char sysCmdLine[MAX_COMMAND_SIZE] = {'\0'}; char cmdLineCopy[sizeof(PERL_COMMAND_NAME)+sizeof(sysCmdLine)+2] = {'\0'}; @@ -205,7 +205,7 @@ void main(int argc, char *argv[]) { strcpy(cmdLineCopy, PERL_COMMAND_NAME); strcat(cmdLineCopy, (char *)" "); // Space between the Perl Command and the input script name. - strcat(cmdLineCopy, sysCmdLine); // The command line parameters built into + strcat(cmdLineCopy, sysCmdLine); // The command line parameters built into // Create a safe copy of the command line and pass it to the // new thread for parsing. The new thread will be responsible @@ -466,9 +466,9 @@ void fnSetupNamespace(void) //LATER: call SetTargetNameSpace(NWOS2_NAME_SPACE)? Currently, if // I make this call, then CPerlExe::Rename fails in certain cases, // and it isn't clear why. Looks like a CLIB bug... -// SetTargetNameSpace(NWOS2_NAME_SPACE); +// SetTargetNameSpace(NWOS2_NAME_SPACE); - //Uncommented that above call, retaining the comment so that it will be easy + //Uncommented that above call, retaining the comment so that it will be easy //to revert back if there is any problem - sgp - 10th May 2000 //Commented again, since Perl debugger had some problems because of @@ -478,12 +478,12 @@ void fnSetupNamespace(void) // if running on Moab, call UseAccurateCaseForPaths. This API // does bad things on 4.11 so we call only for Moab. PFGETFILESERVERMAJORVERSIONNUMBER pf_getfileservermajorversionnumber = NULL; - pf_getfileservermajorversionnumber = (PFGETFILESERVERMAJORVERSIONNUMBER) + pf_getfileservermajorversionnumber = (PFGETFILESERVERMAJORVERSIONNUMBER) ImportSymbol(GetNLMHandle(), (char *)"GetFileServerMajorVersionNumber"); if (pf_getfileservermajorversionnumber && ((*pf_getfileservermajorversionnumber)() > 4)) { PFUSEACCURATECASEFORPATHS pf_useaccuratecaseforpaths = NULL; - pf_useaccuratecaseforpaths = (PFUSEACCURATECASEFORPATHS) + pf_useaccuratecaseforpaths = (PFUSEACCURATECASEFORPATHS) ImportSymbol(GetNLMHandle(), (char *)"UseAccurateCaseForPaths"); if (pf_useaccuratecaseforpaths) (*pf_useaccuratecaseforpaths)(TRUE); @@ -1354,7 +1354,7 @@ void fnGetPerlScreenName(char *sPerlScreenName) // Global variable to hold the environ information. -// First time it is accessed, it will be created and initialized and +// First time it is accessed, it will be created and initialized and // next time onwards, the pointer will be returned. // Improvements - Dynamically read env everytime a request comes - Is this required? diff --git a/NetWare/deb.h b/NetWare/deb.h index e79a8f41a76d..8c6ff0cfc73c 100644 --- a/NetWare/deb.h +++ b/NetWare/deb.h @@ -37,8 +37,8 @@ #define IDB ConsolePrintf #else //release build, so disable DBGMESG and IDB - #define DBGMESG - #define IDB + #define DBGMESG + #define IDB #endif //if defined(USE_D2) #endif //if defined(DEBUGON) && !defined(USE_D2) diff --git a/NetWare/interface.h b/NetWare/interface.h index 98979937e34a..d41c2a75ab3a 100644 --- a/NetWare/interface.h +++ b/NetWare/interface.h @@ -12,7 +12,7 @@ * DESCRIPTION : Perl parsing and running functions. * Author : SGP * Date Created : January 2001. - * Date Modified: July 2nd 2001. + * Date Modified: July 2nd 2001. */ diff --git a/NetWare/nw5.c b/NetWare/nw5.c index 531b308efad0..b50aebda85f4 100644 --- a/NetWare/nw5.c +++ b/NetWare/nw5.c @@ -70,7 +70,7 @@ nw_abort(void) } int -nw_access(const char *path, int mode) +nw_access(const char *path, int mode) { return access(path, mode); } @@ -293,13 +293,13 @@ nw_vfprintf(FILE *fp, const char *format, va_list args) int nw_wait(int *status) { - return 0; + return 0; } int nw_waitpid(int pid, int *status, int flags) { - return 0; + return 0; } int @@ -572,7 +572,7 @@ nw_opendir(const char *filename) char *buff = NULL; int len = 0; DIR *ret = NULL; - + len = strlen(filename); buff = malloc(len + 5); if (buff) { @@ -740,7 +740,7 @@ nw_vprintf(const char *format, va_list args) int nw_printf(const char *format, ...) { - + va_list marker; va_start(marker, format); /* Initialize variable arguments. */ @@ -850,7 +850,7 @@ sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) void Perl_init_os_extras(void) { - + } void diff --git a/NetWare/nw5iop.h b/NetWare/nw5iop.h index 0026b3218117..5cbe00ee6a90 100644 --- a/NetWare/nw5iop.h +++ b/NetWare/nw5iop.h @@ -27,8 +27,8 @@ # define END_EXTERN_C } # define EXTERN_C extern "C" #else -# define START_EXTERN_C -# define END_EXTERN_C +# define START_EXTERN_C +# define END_EXTERN_C # define EXTERN_C #endif #endif @@ -57,7 +57,7 @@ */ /********CHKSGP ****/ //making DLLExport as nothing -#define DllExport +#define DllExport /*******************/ START_EXTERN_C diff --git a/NetWare/nw5sck.c b/NetWare/nw5sck.c index 35dee92bf123..5f26e13988b5 100644 --- a/NetWare/nw5sck.c +++ b/NetWare/nw5sck.c @@ -74,7 +74,7 @@ nw_connect(SOCKET s, const struct sockaddr *addr, int addrlen) } void -nw_endhostent() +nw_endhostent() { endhostent(); } @@ -104,13 +104,13 @@ nw_gethostent() } struct netent * -nw_getnetent(void) +nw_getnetent(void) { return ((struct netent *) getnetent()); } struct protoent * -nw_getprotoent(void) +nw_getprotoent(void) { return ((struct protoent *) getprotoent()); } @@ -134,13 +134,13 @@ nw_gethostbyaddr(const char *addr, int len, int type) } struct netent * -nw_getnetbyaddr(long net, int type) +nw_getnetbyaddr(long net, int type) { return(getnetbyaddr(net,type)); } struct netent * -nw_getnetbyname(char *name) +nw_getnetbyname(char *name) { return (struct netent *)getnetbyname(name); } @@ -177,7 +177,7 @@ nw_getservbyport(int port, const char *proto) } struct servent * -nw_getservent(void) +nw_getservent(void) { return (struct servent *) getservent(); } diff --git a/NetWare/nw5thread.c b/NetWare/nw5thread.c index abedb5c2da1f..7efd979bd5f8 100644 --- a/NetWare/nw5thread.c +++ b/NetWare/nw5thread.c @@ -74,7 +74,7 @@ Remove_Thread_Ctx(void) //PL_thr_key - Not very sure if this is global or per thread. When multiple scripts -//run simultaneously on NetWare, this will give problems. Hence in nwtinfo.c, the -//current thread id is used as the TLS index & PL_thr_key is not used. +//run simultaneously on NetWare, this will give problems. Hence in nwtinfo.c, the +//current thread id is used as the TLS index & PL_thr_key is not used. //This has to be checked???? - sgp diff --git a/NetWare/nwhashcls.cpp b/NetWare/nwhashcls.cpp index aaf5a5c0be65..de30004576d4 100644 --- a/NetWare/nwhashcls.cpp +++ b/NetWare/nwhashcls.cpp @@ -8,9 +8,9 @@ /* * FILENAME : hashcls.cpp - * DESCRIPTION : Implementation of Equivalent of Hash class, NWPerlHashList and + * DESCRIPTION : Implementation of Equivalent of Hash class, NWPerlHashList and NWPerlKeyHashList - * + * * Author : Srivathsa M * Date Created : July 26 2001 */ @@ -24,7 +24,7 @@ NWPerlHashList::NWPerlHashList() MemListHash[i] = NULL; DEBUGPRINT("In constructor\n"); } - + NWPerlHashList::~NWPerlHashList() { DEBUGPRINT("In destructor\n"); @@ -50,7 +50,7 @@ NWPerlHashList::insert(void *ldata) DEBUGPRINT("Inserted first time to %d\n",Bucket); } return 1; - } else + } else return 0; } @@ -63,7 +63,7 @@ NWPerlHashList::remove(void *ldata) int found = 0; HASHNODE *next =list; HASHNODE *prev =NULL; - do + do { if (list->data != ldata) { prev = list; @@ -92,7 +92,7 @@ NWPerlHashList::remove(void *ldata) // if (!found) // ConsolePrintf("Couldn;t find %x in Bucket %d\n",ldata,Bucket); return(found); - } + } return 1; } @@ -100,7 +100,7 @@ NWPerlHashList::remove(void *ldata) void NWPerlHashList::forAll( void (*user_fn)(void *, void*), void *data ) const { - for(int i=0; ikey != key) { prev = list; @@ -205,7 +205,7 @@ NWPerlKeyHashList::remove(void *key) // if (!found) // ConsolePrintf("Couldn;t find %x in Bucket %d\n",key,Bucket); return(found); - } + } return 1; } @@ -213,7 +213,7 @@ NWPerlKeyHashList::remove(void *key) void NWPerlKeyHashList::forAll( void (*user_fn)(void *, void*), void *data ) const { - for(int i=0; ipVprintf)(PL_StdIO, (f),(fmt),a) #define PerlIO_flush(f) (*PL_StdIO->pFlush)(PL_StdIO, (f)) -#define PerlIO_stdout() (*PL_StdIO->pStdout)(PL_StdIO) +#define PerlIO_stdout() (*PL_StdIO->pStdout)(PL_StdIO) #define PerlIO_stdin() (*PL_StdIO->pStdin)(PL_StdIO) #define PerlIO_clearerr(f) (*PL_StdIO->pClearerr)(PL_StdIO, (f)) #define PerlIO_fdopen(f,s) (*PL_StdIO->pFdopen)(PL_StdIO, (f),(s)) -#define PerlIO_getc(f) (*PL_StdIO->pGetc)(PL_StdIO, (f)) -#define PerlIO_ungetc(f,c) (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f)) -#define PerlIO_tell(f) (*PL_StdIO->pTell)(PL_StdIO, (f)) +#define PerlIO_getc(f) (*PL_StdIO->pGetc)(PL_StdIO, (f)) +#define PerlIO_ungetc(f,c) (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f)) +#define PerlIO_tell(f) (*PL_StdIO->pTell)(PL_StdIO, (f)) #define PerlIO_seek(f,o,w) (*PL_StdIO->pSeek)(PL_StdIO, (f),(o),(w)) -#define PerlIO_error(f) (*PL_StdIO->pError)(PL_StdIO, (f)) +#define PerlIO_error(f) (*PL_StdIO->pError)(PL_StdIO, (f)) #define PerlIO_write(f,buf,size) (*PL_StdIO->pWrite)(PL_StdIO, (buf), (size),1, (f)) -#define PerlIO_puts(f,s) (*PL_StdIO->pPuts)(PL_StdIO, (f),(s)) +#define PerlIO_puts(f,s) (*PL_StdIO->pPuts)(PL_StdIO, (f),(s)) #define PerlIO_read(f,buf,size) (*PL_StdIO->pRead)(PL_StdIO, (buf), (size), 1, (f)) -#define PerlIO_eof(f) (*PL_StdIO->pEof)(PL_StdIO, (f)) +#define PerlIO_eof(f) (*PL_StdIO->pEof)(PL_StdIO, (f)) //#define PerlIO_fdupopen(f) (*PL_StdIO->pFdupopen)(PL_StdIO, (f)) #define PerlIO_reopen(p,m,f) (*PL_StdIO->pReopen)(PL_StdIO, (p), (m), (f)) #define PerlIO_open(x,y) (*PL_StdIO->pOpen)(PL_StdIO, (x),(y)) @@ -107,7 +107,7 @@ #ifdef FILE_base #define PerlIO_has_base(f) 1 #define PerlIO_get_bufsiz(f) (*PL_StdIO->pGetBufsiz)(PL_StdIO, (f)) -#define PerlIO_get_base(f) (*PL_StdIO->pGetBase)(PL_StdIO, (f)) +#define PerlIO_get_base(f) (*PL_StdIO->pGetBase)(PL_StdIO, (f)) #else #define PerlIO_has_base(f) 0 #define PerlIO_get_base(f) (abort(),(void *)0) diff --git a/NetWare/nwvmem.h b/NetWare/nwvmem.h index e82eaeef8b50..d204a2b32648 100644 --- a/NetWare/nwvmem.h +++ b/NetWare/nwvmem.h @@ -42,7 +42,7 @@ class VMem protected: BOOL m_dontTouchHashLists; -// WCValHashTable* m_allocList; +// WCValHashTable* m_allocList; NWPerlHashList *m_allocList; // CW changes }; @@ -101,11 +101,11 @@ void fnFreeMemEntry(void* ptr, void* context) Function : VMem Constructor - Description : + Description : - Parameters : + Parameters : - Returns : + Returns : ==============================================================================================*/ @@ -114,7 +114,7 @@ VMem::VMem() //Constructor m_dontTouchHashLists = FALSE; m_allocList = NULL; - // m_allocList = new WCValHashTable (fnAllocListHash, 256); + // m_allocList = new WCValHashTable (fnAllocListHash, 256); m_allocList = new NWPerlHashList(); // CW changes } @@ -124,11 +124,11 @@ VMem::VMem() Function : VMem Destructor - Description : + Description : - Parameters : + Parameters : - Returns : + Returns : ==============================================================================================*/ diff --git a/NetWare/sv_nw.c b/NetWare/sv_nw.c index 85a33f071de6..e462843f8fd6 100644 --- a/NetWare/sv_nw.c +++ b/NetWare/sv_nw.c @@ -16,7 +16,6 @@ Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr) void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) { - sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC); } diff --git a/XSUB.h b/XSUB.h index 187919158cc6..f91d367d32b6 100644 --- a/XSUB.h +++ b/XSUB.h @@ -17,17 +17,17 @@ =head1 Variables created by C and C internal functions =for apidoc Amn|char*|CLASS -Variable which is setup by C to indicate the +Variable which is setup by C to indicate the class name for a C++ XS constructor. This is always a C. See C. =for apidoc Amn|(whatever)|RETVAL -Variable which is setup by C to hold the return value for an -XSUB. This is always the proper type for the XSUB. See +Variable which is setup by C to hold the return value for an +XSUB. This is always the proper type for the XSUB. See L. =for apidoc Amn|(whatever)|THIS -Variable which is setup by C to designate the object in a C++ -XSUB. This is always the proper type for the C++ object. See C and +Variable which is setup by C to designate the object in a C++ +XSUB. This is always the proper type for the C++ object. See C and L. =for apidoc Amn|I32|ax @@ -36,11 +36,11 @@ used by the C, C and C macros. The C macro must be called prior to setup the C variable. =for apidoc Amn|I32|items -Variable which is setup by C to indicate the number of +Variable which is setup by C to indicate the number of items on the stack. See L. =for apidoc Amn|I32|ix -Variable which is setup by C to indicate which of an +Variable which is setup by C to indicate which of an XSUB's aliases was used to invoke it. See L. =for apidoc Am|SV*|ST|int ix @@ -212,7 +212,7 @@ Place a double into the specified position C on the stack. The value is stored in a new mortal SV. =for apidoc Am|void|XST_mPV|int pos|char* str -Place a copy of a string into the specified position C on the stack. +Place a copy of a string into the specified position C on the stack. The value is stored in a new mortal SV. =for apidoc Am|void|XST_mNO|int pos @@ -388,7 +388,7 @@ Rethrows a previously caught exception. See L. if (name[7] == 's'){ \ arg = sv_2mortal(arg); \ } \ - } } STMT_END + } } STMT_END #if 1 /* for compatibility */ # define VTBL_sv &PL_vtbl_sv diff --git a/av.c b/av.c index 5ef3a557d72d..75d683c48799 100644 --- a/av.c +++ b/av.c @@ -80,7 +80,7 @@ Perl_av_extend(pTHX_ AV *av, SSize_t key) return; } av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av)); -} +} /* The guts of av_extend. *Not* for general use! */ void @@ -131,9 +131,9 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, newmax = Perl_safesysmalloc_size((void*)*allocp) / sizeof(const SV *) - 1; - if (key <= newmax) + if (key <= newmax) goto resized; -#endif +#endif newmax = key + *maxp / 5; resize: { @@ -182,7 +182,7 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, while (tmp) ary[--tmp] = NULL; } - + *arrayp = *allocp; *maxp = newmax; } @@ -198,7 +198,7 @@ it wasn't real before), which you can then modify. Check that the return value is non-null before dereferencing it to a C. See L for -more information on how to use this function on tied arrays. +more information on how to use this function on tied arrays. The rough perl equivalent is C<$myarray[$idx]>. @@ -463,7 +463,7 @@ Perl_av_clear(pTHX_ AV *av) if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa) PL_delaymagic |= DM_ARRAY_ISA; else - mg_clear(MUTABLE_SV(av)); + mg_clear(MUTABLE_SV(av)); } if (AvMAX(av) < 0) @@ -510,7 +510,7 @@ Perl_av_undef(pTHX_ AV *av) assert(SvTYPE(av) == SVt_PVAV); /* Give any tie a chance to cleanup first */ - if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) + if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) av_fill(av, -1); if ((real = !!AvREAL(av))) { @@ -563,7 +563,7 @@ Perl equivalent: C. void Perl_av_push(pTHX_ AV *av, SV *val) -{ +{ dVAR; MAGIC *mg; @@ -682,7 +682,7 @@ Perl_av_unshift(pTHX_ AV *av, SSize_t num) if (i > num) i = num; num -= i; - + AvMAX(av) += i; AvFILLp(av) += i; AvARRAY(av) = AvARRAY(av) - i; @@ -823,7 +823,7 @@ Perl_av_fill(pTHX_ AV *av, SSize_t fill) while (key < fill) ary[++key] = NULL; } - + AvFILLp(av) = fill; if (SvSMAGICAL(av)) mg_set(MUTABLE_SV(av)); diff --git a/av.h b/av.h index e15ebe69e434..d6cd2359c9b8 100644 --- a/av.h +++ b/av.h @@ -22,7 +22,7 @@ struct xpvav { * Some things like "@_" and the scratchpad list do not set this, to * indicate that they are cheating (for efficiency) by not refcounting * the AV's contents. - * + * * SVpav_REIFY is only meaningful on such "fake" AVs (i.e. where SVpav_REAL * is not set). It indicates that the fake AV is capable of becoming * real if the array needs to be modified in some way. Functions that @@ -78,7 +78,7 @@ Same as C. #define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY)) - + #define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \ ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) #define av_tindex(av) av_top_index(av) diff --git a/config_h.SH b/config_h.SH index 640d0a23b20e..09d20d320fc9 100755 --- a/config_h.SH +++ b/config_h.SH @@ -211,7 +211,7 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un #$d_getlogin HAS_GETLOGIN /**/ /* HAS_GETPGID: - * This symbol, if defined, indicates to the C program that + * This symbol, if defined, indicates to the C program that * the getpgid(pid) function is available to get the * process group id. */ @@ -657,8 +657,8 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * This symbol holds the type used for the second argument to * getgroups() and setgroups(). Usually, this is the same as * gidtype (gid_t) , but sometimes it isn't. - * It can be int, ushort, gid_t, etc... - * It may be necessary to include to get any + * It can be int, ushort, gid_t, etc... + * It may be necessary to include to get any * typedef'ed information. This is only required if you have * getgroups() or setgroups().. */ diff --git a/cop.h b/cop.h index 37980f04bdde..5abb626731ef 100644 --- a/cop.h +++ b/cop.h @@ -59,35 +59,35 @@ typedef struct jmpenv JMPENV; /* * PERL_FLEXIBLE_EXCEPTIONS - * + * * All the flexible exceptions code has been removed. * See the following threads for details: * * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-07/msg00378.html - * + * * Joshua's original patches (which weren't applied) and discussion: - * + * * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html - * + * * Chip's reworked patch and discussion: - * + * * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html - * + * * The flaw in these patches (which went unnoticed at the time) was * that they moved some code that could potentially die() out of the * region protected by the setjmp()s. This caused exceptions within * END blocks and such to not be handled by the correct setjmp(). - * + * * The original patches that introduces flexible exceptions were: * * http://perl5.git.perl.org/perl.git/commit/312caa8e97f1c7ee342a9895c2f0e749625b4929 - * http://perl5.git.perl.org/perl.git/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a - * + * http://perl5.git.perl.org/perl.git/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a + * */ #define dJMPENV JMPENV cur_env @@ -397,7 +397,7 @@ struct cop { # define CopFILE(c) ((c)->cop_file) # define CopFILEGV(c) (CopFILE(c) \ ? gv_fetchfile(CopFILE(c)) : NULL) - + # ifdef NETWARE # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) # define CopFILE_setn(c,pv,l) ((c)->cop_file = savepvn((pv),(l))) @@ -967,7 +967,7 @@ struct context { this bit needs to be kept clear for most everything else. For reasons I haven't investigated, it can coexist with CXp_FOR_DEF */ #define CXp_MULTICALL 0x10 /* part of a multicall (so don't - tear down context on exit). */ + tear down context on exit). */ /* private flags for CXt_SUB and CXt_FORMAT */ #define CXp_HASARGS 0x20 @@ -999,7 +999,7 @@ struct context { #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) -/* +/* =head1 "Gimme" Values */ diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c index 59aa73044809..0ca1cbaf49aa 100644 --- a/cygwin/cygwin.c +++ b/cygwin/cygwin.c @@ -192,7 +192,7 @@ XS(Cygwin_cwd) dXSARGS; char *cwd; - /* See http://rt.perl.org/rt3/Ticket/Display.html?id=38628 + /* See http://rt.perl.org/rt3/Ticket/Display.html?id=38628 There is Cwd->cwd() usage in the wild, and previous versions didn't die. */ if(items > 1) diff --git a/deb.c b/deb.c index bccfc180e70e..03f057c85413 100644 --- a/deb.c +++ b/deb.c @@ -121,7 +121,7 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, if (i < stack_min) i = stack_min; - + while (++markscan <= PL_markstack + mark_max) if (*markscan >= i) break; diff --git a/dist/IO/poll.c b/dist/IO/poll.c index 9d39d57f2f62..533cb2e97fe7 100644 --- a/dist/IO/poll.c +++ b/dist/IO/poll.c @@ -131,7 +131,7 @@ poll(struct pollfd *fds, unsigned long nfds, int timeout) count++; } - return count; + return count; } #endif /* EMULATE_POLL_WITH_SELECT */ diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 6d136e38bbf2..9de320d83afd 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -77,7 +77,7 @@ djgpp_pclose (FILE *pp) { int fd; fflush (l1->fp); - close (fileno (l1->fp)); + close (fileno (l1->fp)); if ((fd = dup (fileno (stdin))) >= 0 && (freopen (l1->fp->_name_to_remove, "rb", stdin))) @@ -117,7 +117,7 @@ int do_aspawn (pTHX_ SV *really,SV **mark,SV **sp) { int rc; - char **a,*tmps,**argv; + char **a,*tmps,**argv; STRLEN n_a; if (sp<=mark) @@ -386,7 +386,7 @@ Perl_init_os_extras(pTHX) char *file = __FILE__; dXSUB_SYS; - + newXS ("Dos::GetCwd",dos_GetCwd,file); newXS ("Dos::UseLFN",dos_UseLFN,file); newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file); diff --git a/doio.c b/doio.c index e2bfda58ffe7..b516903ae637 100644 --- a/doio.c +++ b/doio.c @@ -618,7 +618,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (!fp) { if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE) && strchr(oname, '\n') - + ) { GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */ @@ -2478,7 +2478,7 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */ /* since spawning off a process is a real performance hit */ -PerlIO * +PerlIO * Perl_vms_start_glob (pTHX_ SV *tmpglob, IO *io); diff --git a/doop.c b/doop.c index 96185bd79da8..5f2c786b0329 100644 --- a/doop.c +++ b/doop.c @@ -164,7 +164,7 @@ S_do_trans_complex(pTHX_ SV * const sv) p = d++; } else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; + *d++ = *s; else if (ch == -2) /* -2 is delete character */ matches++; s++; @@ -518,7 +518,7 @@ S_do_trans_complex_utf8(pTHX_ SV * const sv) UV puv = 0xfeedface; while (s < send) { UV uv = swash_fetch(rv, s, TRUE); - + if (d > dend) { const STRLEN clen = d - dstart; const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES; @@ -770,7 +770,7 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) if (!s) { s = (unsigned char *)""; } - + PERL_ARGS_ASSERT_DO_VECGET; if (offset < 0) diff --git a/dosish.h b/dosish.h index 8b34369ab5c6..ef7731d6c8fb 100644 --- a/dosish.h +++ b/dosish.h @@ -89,7 +89,7 @@ #define USE_STAT_RDEV /**/ /* ACME_MESS: - * This symbol, if defined, indicates that error messages should be + * This symbol, if defined, indicates that error messages should be * should be generated in a format that allows the use of the Acme * GUI/editor's autofind feature. */ diff --git a/dump.c b/dump.c index 354cd57a9f48..433d8e95efb4 100644 --- a/dump.c +++ b/dump.c @@ -132,9 +132,9 @@ Returns a pointer to the escaped text as held by dsv. #define PV_ESCAPE_OCTBUFSIZE 32 char * -Perl_pv_escape( pTHX_ SV *dsv, char const * const str, - const STRLEN count, const STRLEN max, - STRLEN * const escaped, const U32 flags ) +Perl_pv_escape( pTHX_ SV *dsv, char const * const str, + const STRLEN count, const STRLEN max, + STRLEN * const escaped, const U32 flags ) { const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\'; const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc; @@ -153,37 +153,37 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, /* This won't alter the UTF-8 flag */ sv_setpvs(dsv, ""); } - + if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) isuni = 1; - + for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) { const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv; const U8 c = (U8)u & 0xFF; - + if ( ( u > 255 ) || (flags & PERL_PV_ESCAPE_ALL) || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM)))) { - if (flags & PERL_PV_ESCAPE_FIRSTCHAR) - chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, "%"UVxf, u); else - chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, ((flags & PERL_PV_ESCAPE_DWIM) && !isuni) ? "%cx%02"UVxf : "%cx{%02"UVxf"}", esc, u); } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { - chsize = 1; - } else { + chsize = 1; + } else { if ( (c == dq) || (c == esc) || !isPRINT(c) ) { chsize = 2; switch (c) { - + case '\\' : /* fallthrough */ case '%' : if ( c == esc ) { - octbuf[1] = esc; + octbuf[1] = esc; } else { chsize = 1; } @@ -193,10 +193,10 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, case '\r' : octbuf[1] = 'r'; break; case '\n' : octbuf[1] = 'n'; break; case '\f' : octbuf[1] = 'f'; break; - case '"' : - if ( dq == '"' ) + case '"' : + if ( dq == '"' ) octbuf[1] = '"'; - else + else chsize = 1; break; default: @@ -206,10 +206,10 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, esc, u); } else if ( (pv+readsize < end) && isDIGIT((U8)*(pv+readsize)) ) - chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, "%c%03o", esc, c); else - chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, "%c%o", esc, c); } } else { @@ -231,7 +231,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, Perl_sv_catpvf( aTHX_ dsv, "%c", c); wrote++; } - if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) + if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) break; } if (escaped != NULL) @@ -244,10 +244,10 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, Converts a string into something presentable, handling escaping via pv_escape() and supporting quoting and ellipses. -If the PERL_PV_PRETTY_QUOTE flag is set then the result will be +If the PERL_PV_PRETTY_QUOTE flag is set then the result will be double quoted with any double quotes in the string escaped. Otherwise if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in -angle brackets. +angle brackets. If the PERL_PV_PRETTY_ELLIPSES flag is set and not all characters in string were output then an ellipsis C<...> will be appended to the @@ -260,19 +260,19 @@ any quotes or ellipses. Returns a pointer to the prettified text as held by dsv. -=cut +=cut */ char * -Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, - const STRLEN max, char const * const start_color, char const * const end_color, - const U32 flags ) +Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, + const STRLEN max, char const * const start_color, char const * const end_color, + const U32 flags ) { const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; STRLEN escaped; - + PERL_ARGS_ASSERT_PV_PRETTY; - + if (!(flags & PERL_PV_PRETTY_NOCLEAR)) { /* This won't alter the UTF-8 flag */ sv_setpvs(dsv, ""); @@ -282,23 +282,23 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, sv_catpvs(dsv, "\""); else if ( flags & PERL_PV_PRETTY_LTGT ) sv_catpvs(dsv, "<"); - - if ( start_color != NULL ) + + if ( start_color != NULL ) sv_catpv(dsv, start_color); - - pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR ); - - if ( end_color != NULL ) + + pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR ); + + if ( end_color != NULL ) sv_catpv(dsv, end_color); - if ( dq == '"' ) + if ( dq == '"' ) sv_catpvs( dsv, "\""); else if ( flags & PERL_PV_PRETTY_LTGT ) - sv_catpvs(dsv, ">"); - + sv_catpvs(dsv, ">"); + if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) ) sv_catpvs(dsv, "..."); - + return SvPVX(dsv); } @@ -502,7 +502,7 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) /* =for apidoc dump_all -Dumps the entire optree of the current program starting at C to +Dumps the entire optree of the current program starting at C to C. Also dumps the optrees for all visible subroutines in C. @@ -1162,7 +1162,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) SV* tmpsv = newSVpvs_flags("", SVs_TEMP); HV *stash = CopSTASH(cCOPo); const char * const hvname = HvNAME_get(stash); - + Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", generic_pv_escape(tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash))); @@ -1627,7 +1627,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (flags & SVs_PADMY) sv_catpv(d, "PADMY,"); } append_flags(d, flags, first_sv_flags_names); - if (flags & SVf_ROK) { + if (flags & SVf_ROK) { sv_catpv(d, "ROK,"); if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,"); } @@ -1953,7 +1953,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (ents) { HE *const *const last = ents + HvMAX(sv); count = last + 1 - ents; - + do { if (!*ents) --count; diff --git a/ext/SDBM_File/sdbm/dbu.c b/ext/SDBM_File/sdbm/dbu.c index d861c0f1b194..557159db2d9b 100644 --- a/ext/SDBM_File/sdbm/dbu.c +++ b/ext/SDBM_File/sdbm/dbu.c @@ -148,7 +148,7 @@ doit(cmd *act, char *file) } break; case DCAT: - for (key = dbm_firstkey(db); key.dptr != 0; + for (key = dbm_firstkey(db); key.dptr != 0; key = dbm_nextkey(db)) { prdatum(stdout, key); putchar('\t'); @@ -172,7 +172,7 @@ doit(cmd *act, char *file) } else oops("bad input; %s", line); - + if (dbm_store(db, key, val, DBM_REPLACE) < 0) { prdatum(stderr, key); fprintf(stderr, ": "); @@ -213,7 +213,7 @@ parse(char *str) { int i = CTABSIZ; cmd *p; - + for (p = cmds; i--; p++) if (strcmp(p->sname, str) == 0) return p; @@ -233,7 +233,7 @@ prdatum(FILE *stream, datum d) fprintf(stream, "M-"); c &= 0177; } - if (c == 0177 || c < ' ') + if (c == 0177 || c < ' ') fprintf(stream, "^%c", (c == 0177) ? '?' : c + '@'); else putc(c, stream); diff --git a/ext/SDBM_File/sdbm/hash.c b/ext/SDBM_File/sdbm/hash.c index f0115baa5452..fe2a2f878175 100644 --- a/ext/SDBM_File/sdbm/hash.c +++ b/ext/SDBM_File/sdbm/hash.c @@ -15,7 +15,7 @@ * [this seems to work remarkably well, in fact better * then the ndbm hash function. Replace at your own risk] * use: 65599 nice. - * 65587 even better. + * 65587 even better. */ long sdbm_hash(const char *str, int len) diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c index 62045ec97739..673d76e4d490 100644 --- a/ext/SDBM_File/sdbm/pair.c +++ b/ext/SDBM_File/sdbm/pair.c @@ -19,8 +19,8 @@ #define exhash(item) sdbm_hash((item).dptr, (item).dsize) -/* - * forward +/* + * forward */ static int seepair proto((char *, int, const char *, int)); @@ -250,7 +250,7 @@ splpage(char *pag, char *New, long int sbit) n = ino[0]; for (ino++; n > 0; ino += 2) { - key.dptr = cur + ino[0]; + key.dptr = cur + ino[0]; key.dsize = off - ino[0]; val.dptr = cur + ino[1]; val.dsize = ino[0] - ino[1]; @@ -263,13 +263,13 @@ splpage(char *pag, char *New, long int sbit) n -= 2; } - debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, + debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, ((short *) New)[0] / 2, ((short *) pag)[0] / 2)); } /* - * check page sanity: + * check page sanity: * number of entries should be something * reasonable, and all offsets in the index should be in order. * this could be made more rigorous. diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c index f5f893cb18d3..ab5fdca08d33 100644 --- a/ext/SDBM_File/sdbm/sdbm.c +++ b/ext/SDBM_File/sdbm/sdbm.c @@ -126,7 +126,7 @@ sdbm_prep(char *dirname, char *pagname, int flags, int mode) db->blkptr = 0; db->keyptr = 0; /* - * adjust user flags so that WRONLY becomes RDWR, + * adjust user flags so that WRONLY becomes RDWR, * as required by this package. Also set our internal * flag for RDONLY if needed. */ @@ -441,7 +441,7 @@ getpage(DBM *db, long int hash) * see if the block we need is already in memory. * note: this lookaside cache has about 10% hit rate. */ - if (pagb != db->pagbno) { + if (pagb != db->pagbno) { /* * note: here, we assume a "hole" is read as 0s. * if not, must zero pagbuf first. @@ -472,7 +472,7 @@ getdbit(DBM *db, long int dbit) if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) return 0; - if (got==0) + if (got==0) memset(db->dirbuf,0,DBLKSIZ); db->dirbno = dirb; @@ -496,7 +496,7 @@ setdbit(DBM *db, long int dbit) if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) return 0; - if (got==0) + if (got==0) memset(db->dirbuf,0,DBLKSIZ); db->dirbno = dirb; @@ -509,7 +509,7 @@ setdbit(DBM *db, long int dbit) if (dbit >= db->maxbno) db->maxbno += DBLKSIZ * BYTESIZ; #else - if (OFF_DIR((dirb+1))*BYTESIZ > db->maxbno) + if (OFF_DIR((dirb+1))*BYTESIZ > db->maxbno) db->maxbno=OFF_DIR((dirb+1))*BYTESIZ; #endif diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index 2ada7a18caf9..7a29504e6665 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -2,7 +2,7 @@ * sdbm - ndbm work-alike hashed database library * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). * author: oz@nexus.yorku.ca - * status: public domain. + * status: public domain. */ #define DBLKSIZ 4096 #define PBLKSIZ 1024 @@ -204,7 +204,7 @@ Free_t Perl_mfree proto((Malloc_t where)); #ifdef I_MEMORY #include -#endif +#endif #ifdef __cplusplus #define HAS_MEMCPY diff --git a/ext/XS-APItest/exception.c b/ext/XS-APItest/exception.c index c0de7ec48898..05a674315747 100644 --- a/ext/XS-APItest/exception.c +++ b/ext/XS-APItest/exception.c @@ -13,7 +13,7 @@ static void throws_exception(int throw_e) /* Don't give this the same name as execution() in ext/Devel/PPPort/module3.c as otherwise building entirely statically will cause a test to fail, as PPPort's execption() gets used in place of this one. */ - + int apitest_exception(int throw_e) { dTHR; diff --git a/ext/re/re_top.h b/ext/re/re_top.h index e73550f9a863..673e7ece6ad8 100644 --- a/ext/re/re_top.h +++ b/ext/re/re_top.h @@ -22,12 +22,12 @@ #define Perl_reg_numbered_buff_length my_reg_numbered_buff_length #define Perl_reg_named_buff my_reg_named_buff #define Perl_reg_named_buff_iter my_reg_named_buff_iter -#define Perl_reg_named_buff_fetch my_reg_named_buff_fetch -#define Perl_reg_named_buff_exists my_reg_named_buff_exists +#define Perl_reg_named_buff_fetch my_reg_named_buff_fetch +#define Perl_reg_named_buff_exists my_reg_named_buff_exists #define Perl_reg_named_buff_firstkey my_reg_named_buff_firstkey -#define Perl_reg_named_buff_nextkey my_reg_named_buff_nextkey -#define Perl_reg_named_buff_scalar my_reg_named_buff_scalar -#define Perl_reg_named_buff_all my_reg_named_buff_all +#define Perl_reg_named_buff_nextkey my_reg_named_buff_nextkey +#define Perl_reg_named_buff_scalar my_reg_named_buff_scalar +#define Perl_reg_named_buff_all my_reg_named_buff_all #define Perl_reg_qr_package my_reg_qr_package #define PERL_NO_GET_CONTEXT diff --git a/fakesdio.h b/fakesdio.h index 094fd006c3eb..a5b05605122f 100644 --- a/fakesdio.h +++ b/fakesdio.h @@ -57,8 +57,8 @@ #undef vfprintf #undef printf -/* printf used to live in perl.h like this - more sophisticated - than the rest +/* printf used to live in perl.h like this - more sophisticated + than the rest */ #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) #define printf(fmt,args...) PerlIO_stdoutf(fmt,##args) diff --git a/generate_uudmap.c b/generate_uudmap.c index b6307c09cf75..07a411b2afcf 100644 --- a/generate_uudmap.c +++ b/generate_uudmap.c @@ -144,7 +144,7 @@ int main(int argc, char **argv) { mg_data[p->type].comment = p->comment; ++p; } - + output_to_file(argv[0], argv[3], &format_mg_data, (const void *)mg_data, sizeof(mg_data)/sizeof(mg_data[0])); diff --git a/gv.c b/gv.c index e402f6bf72f5..528d6e415c5b 100644 --- a/gv.c +++ b/gv.c @@ -600,7 +600,7 @@ Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags) /* =for apidoc gv_fetchmeth_pv -Exactly like L, but takes a nul-terminated string +Exactly like L, but takes a nul-terminated string instead of a string/length pair. =cut @@ -1346,7 +1346,7 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) assert(stash); if (!HvNAME_get(stash)) { hv_name_set(stash, name, namelen, flags & SVf_UTF8 ? SVf_UTF8 : 0 ); - + /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */ /* If the containing stash has multiple effective names, see that this one gets them, too. */ @@ -1406,7 +1406,7 @@ S_gv_magicalize_isa(pTHX_ GV *gv) /* This function grabs name and tries to split a stash and glob * from its contents. TODO better description, comments - * + * * If the function returns TRUE and 'name == name_end', then * 'gv' can be directly returned to the caller of gv_fetchpvn_flags */ @@ -1420,7 +1420,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, const char *const name_em1 = name_end - 1; PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME; - + if (full_len > 2 && **name == '*' && isIDFIRST_lazy_if(*name + 1, is_utf8)) { /* accidental stringify on a GV? */ (*name)++; @@ -1504,7 +1504,7 @@ PERL_STATIC_INLINE bool S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8) { PERL_ARGS_ASSERT_GV_IS_IN_MAIN; - + /* If it's an alphanumeric variable */ if ( len && isIDFIRST_lazy_if(name, is_utf8) ) { /* Some "normal" variables are always in main::, @@ -1548,7 +1548,7 @@ S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8) /* *{""}, or a special variable like $@ */ else return TRUE; - + return FALSE; } @@ -1556,7 +1556,7 @@ S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8) /* This function is called if parse_gv_stash_name() failed to * find a stash, or if GV_NOTQUAL or an empty name was passed * to gv_fetchpvn_flags. - * + * * It returns FALSE if the default stash can't be found nor created, * which might happen during global destruction. */ @@ -1566,7 +1566,7 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, const svtype sv_type) { PERL_ARGS_ASSERT_FIND_DEFAULT_STASH; - + /* No stash in name, so see how we can default */ if ( gv_is_in_main(name, len, is_utf8) ) { @@ -1657,7 +1657,7 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, * magicalization, which some variables require need in order * to work (like $[, %+, %-, %!), so callers must take care of * that beforehand. - * + * * The return value has a specific meaning for gv_fetchpvn_flags: * If it returns true, and the gv is empty, it indicates that its * refcount should be decreased. @@ -1669,7 +1669,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, SSize_t paren; PERL_ARGS_ASSERT_GV_MAGICALIZE; - + if (stash != PL_defstash) { /* not the main stash */ /* We only have to check for a few names here: a, b, EXPORT, ISA and VERSION. All the others apply only to the main stash or to @@ -2117,7 +2117,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (!stash && !find_default_stash(&stash, name, len, is_utf8, add, sv_type)) { return NULL; } - + /* By this point we should have a stash and a name */ gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add); if (!gvp || *gvp == (const GV *)&PL_sv_undef) { @@ -2194,7 +2194,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, */ #define GvEMPTY(gv) !(GvAV(gv) || GvHV(gv) || GvIO(gv) \ || GvCV(gv) || (GvSV(gv) && SvOK(GvSV(gv)))) - + if ( addmg && !GvEMPTY(gv) ) { (void)hv_store(stash,name,len,(SV *)gv,0); } @@ -2217,7 +2217,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, } } } - + if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type); return gv; } @@ -2795,7 +2795,7 @@ Perl_amagic_deref_call(pTHX_ SV *ref, int method) { return ref; while ((tmpsv = amagic_call(ref, &PL_sv_undef, method, - AMGf_noright | AMGf_unary))) { + AMGf_noright | AMGf_unary))) { if (!SvROK(tmpsv)) Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); if (tmpsv == ref || SvRV(tmpsv) == SvRV(ref)) { @@ -3195,7 +3195,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLunary(left,copy_amg))) { SvRV_set(left, rv_copy); SvSETMAGIC(left); - SvREFCNT_dec_NN(tmpRef); + SvREFCNT_dec_NN(tmpRef); } } diff --git a/hv.c b/hv.c index ef686ab704c5..848a4095f63d 100644 --- a/hv.c +++ b/hv.c @@ -16,7 +16,7 @@ * [p.278 of _The Lord of the Rings_, II/iii: "The Ring Goes South"] */ -/* +/* =head1 Hash Manipulation Functions A HV structure represents a Perl hash. It consists mainly of an array @@ -368,7 +368,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, ((flags & HVhek_UTF8) ? SVf_UTF8 : 0)); } - + mg->mg_obj = keysv; /* pass key */ uf->uf_index = action; /* pass action */ magic_getuvar(MUTABLE_SV(hv), mg); @@ -712,7 +712,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return entry; } #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ - if (!(action & HV_FETCH_ISSTORE) + if (!(action & HV_FETCH_ISSTORE) && SvRMAGICAL((const SV *)hv) && mg_find((const SV *)hv, PERL_MAGIC_env)) { unsigned long len; @@ -920,12 +920,12 @@ Perl_hv_scalar(pTHX_ HV *hv) } sv = sv_newmortal(); - if (HvTOTALKEYS((const HV *)hv)) + if (HvTOTALKEYS((const HV *)hv)) Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv) + 1); else sv_setiv(sv, 0); - + return sv; } @@ -983,7 +983,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* No longer an element */ sv_unmagic(sv, PERL_MAGIC_tiedelem); return sv; - } + } return NULL; /* element cannot be deleted */ } #ifdef ENV_IS_CASELESS @@ -1071,7 +1071,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (k_flags & HVhek_FREEKEY) Safefree(key); - /* If this is a stash and the key ends with ::, then someone is + /* If this is a stash and the key ends with ::, then someone is * deleting a package. */ if (HeVAL(entry) && HvENAME_get(hv)) { @@ -1926,7 +1926,7 @@ Perl_hv_fill(pTHX_ HV *const hv) } else if (HvMAX(hv) >= HV_FILL_THRESHOLD) { aux = hv_auxinit(hv); aux->xhv_fill_lazy = count; - } + } return count; } @@ -2175,7 +2175,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) ? -iter->xhv_name_count : iter->xhv_name_count ); - while(hekp-- > name+1) + while(hekp-- > name+1) unshare_hek_or_pvn(*hekp, 0, 0, 0); /* The first elem may be null. */ if(*name) unshare_hek_or_pvn(*name, 0, 0, 0); @@ -2279,7 +2279,7 @@ Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags) HEK **hekp = xhv_name + (count < 0 ? -count : count); while (hekp-- > xhv_name) if ( - (HEK_UTF8(*hekp) || (flags & SVf_UTF8)) + (HEK_UTF8(*hekp) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ *hekp, name, (I32)len, flags) : (HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)) ) { @@ -2342,7 +2342,7 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) HEK **victim = namep + (count < 0 ? -count : count); while (victim-- > namep + 1) if ( - (HEK_UTF8(*victim) || (flags & SVf_UTF8)) + (HEK_UTF8(*victim) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ *victim, name, (I32)len, flags) : (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len)) ) { @@ -2366,7 +2366,7 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) return; } if ( - count > 0 && (HEK_UTF8(*namep) || (flags & SVf_UTF8)) + count > 0 && (HEK_UTF8(*namep) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ *namep, name, (I32)len, flags) : (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len)) ) { @@ -2374,7 +2374,7 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) } } else if( - (HEK_UTF8(aux->xhv_name_u.xhvnameu_name) || (flags & SVf_UTF8)) + (HEK_UTF8(aux->xhv_name_u.xhvnameu_name) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ aux->xhv_name_u.xhvnameu_name, name, (I32)len, flags) : (HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len && memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len)) @@ -3473,7 +3473,7 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) { HINTS_REFCNT_LOCK; new_count = --he->refcounted_he_refcnt; HINTS_REFCNT_UNLOCK; - + if (new_count) { return; } diff --git a/hv.h b/hv.h index 95dde4681ed4..73b4624fdb54 100644 --- a/hv.h +++ b/hv.h @@ -105,7 +105,7 @@ struct xpvhv_aux { HE *xhv_eiter; /* current entry of iterator */ I32 xhv_riter; /* current root of iterator */ -/* Concerning xhv_name_count: When non-zero, xhv_name_u contains a pointer +/* Concerning xhv_name_count: When non-zero, xhv_name_u contains a pointer * to an array of HEK pointers, this being the length. The first element is * the name of the stash, which may be NULL. If xhv_name_count is positive, * then *xhv_name is one of the effective names. If xhv_name_count is nega- @@ -423,7 +423,7 @@ C. #ifndef PERL_USE_LARGE_HV_ALLOC /* Default to allocating the correct size - default to assuming that malloc() is not broken and is efficient at allocating blocks sized at powers-of-two. -*/ +*/ # define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*)) #else # define MALLOC_OVERHEAD 16 diff --git a/hv_func.h b/hv_func.h index 191912a6cc79..1a49f9d5daf9 100644 --- a/hv_func.h +++ b/hv_func.h @@ -507,29 +507,29 @@ PERL_STATIC_INLINE U32 S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) { const unsigned char * const end = (const unsigned char *)str + len; U32 hash = *((U32*)seed) + len; - + while (str < end) { hash += (hash << 10); hash ^= (hash >> 6); hash += *str++; } - + hash += (hash << 10); hash ^= (hash >> 6); hash += seed[4]; - + hash += (hash << 10); hash ^= (hash >> 6); hash += seed[5]; - + hash += (hash << 10); hash ^= (hash >> 6); hash += seed[6]; - + hash += (hash << 10); hash ^= (hash >> 6); hash += seed[7]; - + hash += (hash << 10); hash ^= (hash >> 6); diff --git a/intrpvar.h b/intrpvar.h index 0c7e4d5d008f..37a3f3bafa89 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -1,4 +1,4 @@ -/* intrpvar.h +/* intrpvar.h * * Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, * 2006, 2007, 2008 by Larry Wall and others @@ -737,7 +737,7 @@ PERLVAR(I, debug_pad, struct perl_debug_pad) /* always needed because of the re PERLVARI(I, globhook, globhook_t, NULL) /* The last unconditional member of the interpreter structure when 5.19.12 was - released. The offset of the end of this is baked into a global variable in + released. The offset of the end of this is baked into a global variable in any shared perl library which will allow a sanity test in future perl releases. */ #define PERL_LAST_5_18_0_INTERP_MEMBER Iglobhook diff --git a/madly.c b/madly.c index d70373281633..76d6fa6a4bbf 100644 --- a/madly.c +++ b/madly.c @@ -4,7 +4,7 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * + * * Note that this file is essentially empty, and just #includes perly.c, * to allow compilation of a second parser, Perl_madparse, that is * identical to Perl_yyparse, but which includes extra code for dumping diff --git a/malloc.c b/malloc.c index 79a8c8910797..1af4642aacd5 100644 --- a/malloc.c +++ b/malloc.c @@ -54,7 +54,7 @@ # This is targeted at big allocations, as are common in image # processing. TWO_POT_OPTIMIZE !PLAIN_MALLOC - + # Use intermediate bucket sizes between powers-of-two. This is # generally a memory optimization, and a (small) speed pessimization. BUCKETS_ROOT2 !NO_FANCY_MALLOC @@ -170,28 +170,28 @@ #ifndef NO_FANCY_MALLOC # ifndef SMALL_BUCKET_VIA_TABLE # define SMALL_BUCKET_VIA_TABLE -# endif +# endif # ifndef BUCKETS_ROOT2 # define BUCKETS_ROOT2 -# endif +# endif # ifndef IGNORE_SMALL_BAD_FREE # define IGNORE_SMALL_BAD_FREE -# endif -#endif +# endif +#endif #ifndef PLAIN_MALLOC /* Bulk enable features */ # ifndef PACK_MALLOC # define PACK_MALLOC -# endif +# endif # ifndef TWO_POT_OPTIMIZE # define TWO_POT_OPTIMIZE -# endif +# endif # ifndef PERL_EMERGENCY_SBRK # define PERL_EMERGENCY_SBRK -# endif +# endif # ifndef DEBUGGING_MSTATS # define DEBUGGING_MSTATS -# endif +# endif #endif #define MIN_BUC_POW2 (sizeof(void*) > 4 ? 3 : 2) /* Allow for 4-byte arena. */ @@ -210,21 +210,21 @@ #endif #if defined(RCHECK) && defined(IGNORE_SMALL_BAD_FREE) # undef IGNORE_SMALL_BAD_FREE -#endif +#endif /* * malloc.c (Caltech) 2/21/82 * Chris Kingsley, kingsley@cit-20. * - * This is a very fast storage allocator. It allocates blocks of a small + * This is a very fast storage allocator. It allocates blocks of a small * number of different sizes, and keeps free lists of each size. Blocks that - * don't exactly fit are passed up to the next larger size. In this + * don't exactly fit are passed up to the next larger size. In this * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long. * If PACK_MALLOC is defined, small blocks are 2^n bytes long. * This is designed for use in a program that uses vast quantities of memory, * but bombs when it runs out. - * + * * Modifications Copyright Ilya Zakharevich 1996-99. - * + * * Still very quick, but much more thrifty. (Std config is 10% slower * than it was, and takes 67% of old heap size for typical usage.) * @@ -232,7 +232,7 @@ * buckets. Sizes of really big buckets are increased to accommodate * common size=power-of-2 blocks. Running-out-of-memory is made into * an exception. Deeply configurable and thread-safe. - * + * */ #include "EXTERN.h" @@ -255,23 +255,23 @@ #ifndef MUTEX_LOCK # define MUTEX_LOCK(l) -#endif +#endif #ifndef MUTEX_UNLOCK # define MUTEX_UNLOCK(l) -#endif +#endif #ifndef MALLOC_LOCK # define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) -#endif +#endif #ifndef MALLOC_UNLOCK # define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) -#endif +#endif # ifndef fatalcroak /* make depend */ # define fatalcroak(mess) (write(2, (mess), strlen(mess)), exit(2)) -# endif +# endif #ifdef DEBUGGING # undef DEBUG_m @@ -293,7 +293,7 @@ #else # define PERL_IS_ALIVE TRUE #endif - + /* * Layout of memory: @@ -302,56 +302,56 @@ * generally speaking, have size "close" to a power of 2). The addresses * of such *unused* blocks are kept in nextf[i] with big enough i. (nextf * is an array of linked lists.) (Addresses of used blocks are not known.) - * + * * Moreover, since the algorithm may try to "bite" smaller blocks out * of unused bigger ones, there are also regions of "irregular" size, * managed separately, by a linked list chunk_chain. - * + * * The third type of storage is the sbrk()ed-but-not-yet-used space, its * end and size are kept in last_sbrk_top and sbrked_remains. - * + * * Growing blocks "in place": * ~~~~~~~~~~~~~~~~~~~~~~~~~ * The address of the block with the greatest address is kept in last_op * (if not known, last_op is 0). If it is known that the memory above * last_op is not continuous, or contains a chunk from chunk_chain, * last_op is set to 0. - * + * * The chunk with address last_op may be grown by expanding into * sbrk()ed-but-not-yet-used space, or trying to sbrk() more continuous * memory. - * + * * Management of last_op: * ~~~~~~~~~~~~~~~~~~~~~ - * + * * free() never changes the boundaries of blocks, so is not relevant. - * + * * The only way realloc() may change the boundaries of blocks is if it * grows a block "in place". However, in the case of success such a * chunk is automatically last_op, and it remains last_op. In the case * of failure getpages_adjacent() clears last_op. - * + * * malloc() may change blocks by calling morecore() only. - * + * * morecore() may create new blocks by: * a) biting pieces from chunk_chain (cannot create one above last_op); * b) biting a piece from an unused block (if block was last_op, this * may create a chunk from chain above last_op, thus last_op is * invalidated in such a case). - * c) biting of sbrk()ed-but-not-yet-used space. This creates + * c) biting of sbrk()ed-but-not-yet-used space. This creates * a block which is last_op. * d) Allocating new pages by calling getpages(); - * + * * getpages() creates a new block. It marks last_op at the bottom of * the chunk of memory it returns. - * + * * Active pages footprint: * ~~~~~~~~~~~~~~~~~~~~~~ * Note that we do not need to traverse the lists in nextf[i], just take * the first element of this list. However, we *need* to traverse the * list in chunk_chain, but most the time it should be a very short one, * so we do not step on a lot of pages we are not going to use. - * + * * Flaws: * ~~~~~ * get_from_bigger_buckets(): forget to increment price => Quite @@ -362,16 +362,16 @@ #define u_char unsigned char #define u_int unsigned int -/* +/* * I removed the definition of u_bigint which appeared to be u_bigint = UV - * u_bigint was only used in TWOK_MASKED and TWOK_SHIFT + * u_bigint was only used in TWOK_MASKED and TWOK_SHIFT * where I have used PTR2UV. RMB */ #define u_short unsigned short #if defined(RCHECK) && defined(PACK_MALLOC) # undef PACK_MALLOC -#endif +#endif /* * The description below is applicable if PACK_MALLOC is not defined. @@ -422,14 +422,14 @@ union overhead { # define MAX_SHORT_BUCKET (12 * BUCKETS_PER_POW2) /* size-1 fits in short */ # else # define MAX_SHORT_BUCKET (13 * BUCKETS_PER_POW2) -# endif +# endif #else # define RMAGIC_SZ 0 #endif #if !defined(PACK_MALLOC) && defined(BUCKETS_ROOT2) # undef BUCKETS_ROOT2 -#endif +#endif #ifdef BUCKETS_ROOT2 # define BUCKET_TABLE_SHIFT 2 @@ -439,7 +439,7 @@ union overhead { # define BUCKET_TABLE_SHIFT MIN_BUC_POW2 # define BUCKET_POW2_SHIFT 0 # define BUCKETS_PER_POW2 1 -#endif +#endif #if !defined(MEM_ALIGNBYTES) || ((MEM_ALIGNBYTES > 4) && !defined(STRICT_ALIGNMENT)) /* Figure out the alignment of void*. */ @@ -456,8 +456,8 @@ struct aligner { #ifdef BUCKETS_ROOT2 # define MAX_BUCKET_BY_TABLE 13 -static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = - { +static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = + { 0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80, }; # define BUCKET_SIZE_NO_SURPLUS(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT))) @@ -470,7 +470,7 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = # define BUCKET_SIZE_NO_SURPLUS(i) (1 << ((i) >> BUCKET_POW2_SHIFT)) # define BUCKET_SIZE(i) (BUCKET_SIZE_NO_SURPLUS(i) + POW2_OPTIMIZE_SURPLUS(i)) # define BUCKET_SIZE_REAL(i) (BUCKET_SIZE(i) - MEM_OVERHEAD(i)) -#endif +#endif #ifdef PACK_MALLOC @@ -541,24 +541,24 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = * INDEX provided ADDOFFSET is >0 if OFFSET1 < 2^SHIFT. MAGIClast * will not overwrite CHUNK1 if OFFSET1 > (OFFSETlast >> SHIFT) + * ADDOFFSET. - * + * * Make SHIFT the maximal possible (there is no point in making it * smaller). Since OFFSETlast is 2K - CHUNKSIZE, above restrictions * give restrictions on OFFSET1 and on ADDOFFSET. - * + * * In particular, for chunks of size 2^k with k>=6 we can put * ADDOFFSET to be from 0 to 2^k - 2^(11-k), and have * OFFSET1==chunksize. For chunks of size 80 OFFSET1 of 2K%80=48 is * large enough to have ADDOFFSET between 1 and 16 (similarly for 96, * when ADDOFFSET should be 1). In particular, keeping MAGICs for * these sizes gives no additional size penalty. - * + * * However, for chunks of size 2^k with k<=5 this gives OFFSET1 >= * ADDOFSET + 2^(11-k). Keeping ADDOFFSET 0 allows for 2^(11-k)-2^(11-2k) * chunks per arena. This is smaller than 2^(11-k) - 1 which are * needed if no MAGIC is kept. [In fact, having a negative ADDOFFSET * would allow for slightly more buckets per arena for k=2,3.] - * + * * Similarly, for chunks of size 3/2*2^k with k<=5 MAGICs would span * the area up to 2^(11-k)+ADDOFFSET. For k=4 this give optimal * ADDOFFSET as -7..0. For k=3 ADDOFFSET can go up to 4 (with tiny @@ -573,9 +573,9 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = * This is what we do. In this case one needs ADDOFFSET>=1 also for * chunksizes 12, 24, and 48, unless one gets one less chunk per * arena. - * + * * The algo of OV_MAGIC(block,bucket) keeps ADDOFFSET 0 until - * chunksize of 64, then makes it 1. + * chunksize of 64, then makes it 1. * * This allows for an additional optimization: the above scheme leads * to giant overheads for sizes 128 or more (one whole chunk needs to @@ -607,7 +607,7 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = # define MIN_NEEDS_SHIFT (7*BUCKETS_PER_POW2 - 1) /* Shift 80 greater than chunk 64. */ # else # define MIN_NEEDS_SHIFT (7*BUCKETS_PER_POW2) /* Shift 128 greater than chunk 32. */ -# endif +# endif # define CHUNK_SHIFT 0 /* Number of active buckets of given ordinal. */ @@ -618,7 +618,7 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = : n_blks[bucket] ) #else # define N_BLKS(bucket) n_blks[bucket] -#endif +#endif static const u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = { @@ -641,27 +641,27 @@ static const u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = : blk_shift[bucket]) #else # define BLK_SHIFT(bucket) blk_shift[bucket] -#endif +#endif static const u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = - { + { # if BUCKETS_PER_POW2==1 0, 0, (MIN_BUC_POW2==2 ? 512 : 0), 256, 128, 64, 64, /* 8 to 64 */ - 16*sizeof(union overhead), - 8*sizeof(union overhead), - 4*sizeof(union overhead), - 2*sizeof(union overhead), + 16*sizeof(union overhead), + 8*sizeof(union overhead), + 4*sizeof(union overhead), + 2*sizeof(union overhead), # else 0, 0, 0, 0, (MIN_BUC_POW2==2 ? 512 : 0), (MIN_BUC_POW2==2 ? 512 : 0), 256, 260, 128, 128, 64, 80, 64, 48, /* 8 to 96 */ - 16*sizeof(union overhead), 16*sizeof(union overhead), - 8*sizeof(union overhead), 8*sizeof(union overhead), - 4*sizeof(union overhead), 4*sizeof(union overhead), - 2*sizeof(union overhead), 2*sizeof(union overhead), -# endif + 16*sizeof(union overhead), 16*sizeof(union overhead), + 8*sizeof(union overhead), 8*sizeof(union overhead), + 4*sizeof(union overhead), 4*sizeof(union overhead), + 2*sizeof(union overhead), 2*sizeof(union overhead), +# endif }; # define NEEDED_ALIGNMENT 0x800 /* 2k boundaries */ @@ -690,7 +690,7 @@ static const u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = # define SIZE_TABLE_MAX 80 # else # define SIZE_TABLE_MAX 64 -# endif +# endif static const char bucket_of[] = { # ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */ @@ -706,8 +706,8 @@ static const char bucket_of[] = # else /* !BUCKETS_ROOT2 */ /* 0 to 15 in 4-byte increments. */ (sizeof(void*) > 4 ? 3 : 2), - 3, - 4, 4, + 3, + 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6 @@ -721,7 +721,7 @@ static const char bucket_of[] = # define MEM_OVERHEAD(bucket) M_OVERHEAD # ifdef SMALL_BUCKET_VIA_TABLE # undef SMALL_BUCKET_VIA_TABLE -# endif +# endif # define START_SHIFTS_BUCKET MIN_BUCKET # define START_SHIFT (MIN_BUC_POW2 - 1) #endif /* !PACK_MALLOC */ @@ -735,7 +735,7 @@ static const char bucket_of[] = # ifndef PERL_PAGESIZE # define PERL_PAGESIZE 4096 -# endif +# endif # ifndef FIRST_BIG_POW2 # define FIRST_BIG_POW2 15 /* 32K, 16K is used too often. */ # endif @@ -759,24 +759,24 @@ static const char bucket_of[] = #ifndef MIN_SBRK # define MIN_SBRK 2048 -#endif +#endif #ifndef FIRST_SBRK # define FIRST_SBRK (48*1024) -#endif +#endif /* Minimal sbrk in percents of what is already alloced. */ #ifndef MIN_SBRK_FRAC # define MIN_SBRK_FRAC 3 -#endif +#endif #ifndef SBRK_ALLOW_FAILURES # define SBRK_ALLOW_FAILURES 3 -#endif +#endif #ifndef SBRK_FAILURE_PRICE # define SBRK_FAILURE_PRICE 50 -#endif +#endif static void morecore (int bucket); # if defined(DEBUGGING) @@ -963,7 +963,7 @@ perl_get_emergency_buffer(IV *size) GV **gvp = (GV**)hv_fetchs(PL_defstash, "^M", FALSE); if (!gvp) gvp = (GV**)hv_fetchs(PL_defstash, "\015", FALSE); - if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) + if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) || (SvLEN(sv) < (1<= rsize) { char *old = emergency_buffer; - + emergency_buffer_size -= rsize; emergency_buffer += rsize; return old; - } else { + } else { /* First offense, give a possibility to recover by dieing. */ /* No malloc involved here: */ IV Size; @@ -1233,11 +1233,11 @@ S_adjust_size_and_find_bucket(size_t *nbytes_p) if (nbytes <= MAX_POW2_ALGO) goto do_shifts; else # endif -#endif +#endif { POW2_OPTIMIZE_ADJUST(nbytes); nbytes += M_OVERHEAD; - nbytes = (nbytes + 3) &~ 3; + nbytes = (nbytes + 3) &~ 3; #if defined(PACK_MALLOC) && !defined(SMALL_BUCKET_VIA_TABLE) do_shifts: #endif @@ -1274,7 +1274,7 @@ Perl_malloc(size_t nbytes) * If nothing in hash bucket right now, * request more memory from the system. */ - if (nextf[bucket] == NULL) + if (nextf[bucket] == NULL) morecore(bucket); if ((p = nextf[bucket]) == NULL) { MALLOC_UNLOCK; @@ -1293,7 +1293,7 @@ Perl_malloc(size_t nbytes) #if defined(DEBUGGING) || defined(RCHECK) n = size; #endif - *s = 0; + *s = 0; do { *--s = '0' + (n % 10); } while (n /= 10); @@ -1346,7 +1346,7 @@ Perl_malloc(size_t nbytes) #ifdef IGNORE_SMALL_BAD_FREE if (bucket >= FIRST_BUCKET_WITH_CHECK) -#endif +#endif OV_MAGIC(p, bucket) = MAGIC; #ifndef PACK_MALLOC OV_INDEX(p) = bucket; @@ -1359,8 +1359,8 @@ Perl_malloc(size_t nbytes) p->ov_rmagic = RMAGIC; if (bucket <= MAX_SHORT_BUCKET) { int i; - - nbytes = size + M_OVERHEAD; + + nbytes = size + M_OVERHEAD; p->ov_size = nbytes - 1; if ((i = nbytes & (RMAGIC_SZ-1))) { i = RMAGIC_SZ - i; @@ -1382,7 +1382,7 @@ static MEM_SIZE sbrked_remains; #ifdef DEBUGGING_MSTATS static int sbrks; -#endif +#endif struct chunk_chain_s { struct chunk_chain_s *next; @@ -1418,7 +1418,7 @@ get_from_chain(MEM_SIZE size) if (min_remain) { void *ret = *oldgoodp; struct chunk_chain_s *next = (*oldgoodp)->next; - + *oldgoodp = (struct chunk_chain_s *)((char*)ret + size); (*oldgoodp)->size = min_remain; (*oldgoodp)->next = next; @@ -1436,7 +1436,7 @@ add_to_chain(void *p, MEM_SIZE size, MEM_SIZE chip) { struct chunk_chain_s *next = chunk_chain; char *cp = (char*)p; - + cp += chip; chunk_chain = (struct chunk_chain_s *)cp; chunk_chain->size = size - chip; @@ -1463,9 +1463,9 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size) #ifdef DEBUGGING_MSTATS nmalloc[bucket]--; start_slack -= M_OVERHEAD; -#endif +#endif add_to_chain(ret, (BUCKET_SIZE_NO_SURPLUS(bucket) + - POW2_OPTIMIZE_SURPLUS(bucket)), + POW2_OPTIMIZE_SURPLUS(bucket)), size); return ret; } @@ -1486,7 +1486,7 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) MEM_SIZE slack = 0; if (sbrk_goodness > 0) { - if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK) + if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK) require = FIRST_SBRK; else if (require < (MEM_SIZE)MIN_SBRK) require = MIN_SBRK; @@ -1499,13 +1499,13 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) sbrked_remains = 0; } - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk(%ld) for %ld-byte-long arena\n", (long)require, (long) needed)); cp = (char *)sbrk(require); #ifdef DEBUGGING_MSTATS sbrks++; -#endif +#endif if (cp == last_sbrk_top) { /* Common case, anything is fine. */ sbrk_goodness++; @@ -1539,9 +1539,9 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) slack = WANTED_ALIGNMENT - (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)); add += slack; } - + if (add) { - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignement,\t%ld were assumed to come from the tail of the previous sbrk\n", (long)add, (long) slack, (long) sbrked_remains)); @@ -1552,7 +1552,7 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) #endif if (newcp != cp + require) { /* Too bad: even rounding sbrk() is not continuous.*/ - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "failed to fix bad sbrk()\n")); #ifdef PACK_MALLOC if (slack) { @@ -1566,13 +1566,13 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) sbrk_slack += require; #endif require = needed; - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "straight sbrk(%ld)\n", (long)require)); cp = (char *)sbrk(require); #ifdef DEBUGGING_MSTATS sbrks++; -#endif +#endif if (cp == (char *)-1) return 0; } @@ -1600,7 +1600,7 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) else # endif if (PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)) { - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "fixing sbrk(): %d bytes off machine alignment\n", (int)(PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)))); ovp = INT2PTR(union overhead *,(PTR2UV(ovp) + MEM_ALIGNBYTES) & @@ -1621,13 +1621,13 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) last_sbrk_top = cp + require; #ifdef DEBUGGING_MSTATS goodsbrk += require; -#endif +#endif return ovp; } static int getpages_adjacent(MEM_SIZE require) -{ +{ if (require <= sbrked_remains) { sbrked_remains -= require; } else { @@ -1639,7 +1639,7 @@ getpages_adjacent(MEM_SIZE require) #ifdef DEBUGGING_MSTATS sbrks++; goodsbrk += require; -#endif +#endif if (cp == last_sbrk_top) { sbrked_remains = 0; last_sbrk_top = cp + require; @@ -1662,7 +1662,7 @@ getpages_adjacent(MEM_SIZE require) return 0; } } - + return 1; } @@ -1723,8 +1723,8 @@ morecore(int bucket) if (bucket > max_bucket) max_bucket = bucket; - rnu = ( (bucket <= (LOG_OF_MIN_ARENA << BUCKET_POW2_SHIFT)) - ? LOG_OF_MIN_ARENA + rnu = ( (bucket <= (LOG_OF_MIN_ARENA << BUCKET_POW2_SHIFT)) + ? LOG_OF_MIN_ARENA : (bucket >> BUCKET_POW2_SHIFT) ); /* This may be overwritten later: */ nblks = 1 << (rnu - (bucket >> BUCKET_POW2_SHIFT)); /* how many blocks to get */ @@ -1736,26 +1736,26 @@ morecore(int bucket) #ifdef DEBUGGING_MSTATS nmalloc[rnu << BUCKET_POW2_SHIFT]--; start_slack -= M_OVERHEAD; -#endif - DEBUG_m(PerlIO_printf(Perl_debug_log, +#endif + DEBUG_m(PerlIO_printf(Perl_debug_log, "stealing %ld bytes from %ld arena\n", (long) needed, (long) rnu << BUCKET_POW2_SHIFT)); - } else if (chunk_chain + } else if (chunk_chain && (ovp = (union overhead*) get_from_chain(needed))) { - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "stealing %ld bytes from chain\n", (long) needed)); } else if ( (ovp = (union overhead*) get_from_bigger_buckets((rnu << BUCKET_POW2_SHIFT) + 1, needed)) ) { - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "stealing %ld bytes from bigger buckets\n", (long) needed)); } else if (needed <= sbrked_remains) { ovp = (union overhead *)(last_sbrk_top - sbrked_remains); sbrked_remains -= needed; last_op = (char*)ovp; - } else + } else ovp = getpages(needed, &nblks, bucket); if (!ovp) @@ -1786,7 +1786,7 @@ morecore(int bucket) if (bucket > MAX_PACKED) { start_slack += M_OVERHEAD * nblks; } -#endif +#endif while (--nblks > 0) { ovp->ov_next = (union overhead *)((caddr_t)ovp + siz); @@ -1797,8 +1797,8 @@ morecore(int bucket) #ifdef PACK_MALLOC if (bucket == 7*BUCKETS_PER_POW2) { /* Special case, explanation is above. */ union overhead *n_op = nextf[7*BUCKETS_PER_POW2]->ov_next; - nextf[7*BUCKETS_PER_POW2] = - (union overhead *)((caddr_t)nextf[7*BUCKETS_PER_POW2] + nextf[7*BUCKETS_PER_POW2] = + (union overhead *)((caddr_t)nextf[7*BUCKETS_PER_POW2] - sizeof(union overhead)); nextf[7*BUCKETS_PER_POW2]->ov_next = n_op; } @@ -1814,9 +1814,9 @@ Perl_mfree(Malloc_t where) char *cp = (char*)where; #ifdef PACK_MALLOC u_char bucket; -#endif +#endif - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05lu) free\n", PTR2UV(cp), (unsigned long)(PL_an++))); @@ -1826,17 +1826,17 @@ Perl_mfree(Malloc_t where) if (PTR2UV(cp) & (MEM_ALIGNBYTES - 1)) croak("%s", "wrong alignment in free()"); #endif - ovp = (union overhead *)((caddr_t)cp + ovp = (union overhead *)((caddr_t)cp - sizeof (union overhead) * CHUNK_SHIFT); #ifdef PACK_MALLOC bucket = OV_INDEX(ovp); -#endif +#endif #ifdef IGNORE_SMALL_BAD_FREE - if ((bucket >= FIRST_BUCKET_WITH_CHECK) + if ((bucket >= FIRST_BUCKET_WITH_CHECK) && (OV_MAGIC(ovp, bucket) != MAGIC)) #else if (OV_MAGIC(ovp, bucket) != MAGIC) -#endif +#endif { static int bad_free_warn = -1; if (bad_free_warn == -1) { @@ -1879,7 +1879,7 @@ Perl_mfree(Malloc_t where) /* Same at RMAGIC_SZ-aligned RMAGIC */ nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1); ASSERT(((u_int *)((caddr_t)ovp + nbytes))[-1] == RMAGIC, - "chunk's tail overwrite"); + "chunk's tail overwrite"); FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nbytes), BUCKET_SIZE(OV_INDEX(ovp)) - nbytes); } @@ -1925,16 +1925,16 @@ Perl_realloc(void *mp, size_t nbytes) if (!cp) return Perl_malloc(nbytes); - ovp = (union overhead *)((caddr_t)cp + ovp = (union overhead *)((caddr_t)cp - sizeof (union overhead) * CHUNK_SHIFT); bucket = OV_INDEX(ovp); #ifdef IGNORE_SMALL_BAD_FREE - if ((bucket >= FIRST_BUCKET_WITH_CHECK) + if ((bucket >= FIRST_BUCKET_WITH_CHECK) && (OV_MAGIC(ovp, bucket) != MAGIC)) #else if (OV_MAGIC(ovp, bucket) != MAGIC) -#endif +#endif { static int bad_free_warn = -1; if (bad_free_warn == -1) { @@ -1965,7 +1965,7 @@ Perl_realloc(void *mp, size_t nbytes) } onb = BUCKET_SIZE_REAL(bucket); - /* + /* * avoid the copy if same size block. * We are not aggressive with boundary cases. Note that it might * (for a small number of cases) give false negative if @@ -1981,10 +1981,10 @@ Perl_realloc(void *mp, size_t nbytes) nbytes > ( (onb >> 1) - M_OVERHEAD ) # ifdef TWO_POT_OPTIMIZE || (bucket == FIRST_BIG_POW2 && nbytes >= LAST_SMALL_BOUND ) -# endif +# endif ) #else /* !DO_NOT_TRY_HARDER_WHEN_SHRINKING */ - prev_bucket = ( (bucket > MAX_PACKED + 1) + prev_bucket = ( (bucket > MAX_PACKED + 1) ? bucket - BUCKETS_PER_POW2 : bucket - 1); if (nbytes > BUCKET_SIZE_REAL(prev_bucket)) @@ -2043,11 +2043,11 @@ Perl_realloc(void *mp, size_t nbytes) } #endif res = cp; - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n", PTR2UV(res),(unsigned long)(PL_an++), (long)size)); - } else if (incr == 1 && (cp - M_OVERHEAD == last_op) + } else if (incr == 1 && (cp - M_OVERHEAD == last_op) && (onb > (1 << LOG_OF_MIN_ARENA))) { MEM_SIZE require, newarena = nbytes, pow; int shiftr; @@ -2062,26 +2062,26 @@ Perl_realloc(void *mp, size_t nbytes) pow++; newarena = (1 << pow) + POW2_OPTIMIZE_SURPLUS(pow * BUCKETS_PER_POW2); require = newarena - onb - M_OVERHEAD; - + MALLOC_LOCK; if (cp - M_OVERHEAD == last_op /* We *still* are the last chunk */ && getpages_adjacent(require)) { #ifdef DEBUGGING_MSTATS nmalloc[bucket]--; nmalloc[pow * BUCKETS_PER_POW2]++; -#endif +#endif if (pow * BUCKETS_PER_POW2 > (MEM_SIZE)max_bucket) max_bucket = pow * BUCKETS_PER_POW2; *(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */ MALLOC_UNLOCK; goto inplace_label; } else { - MALLOC_UNLOCK; + MALLOC_UNLOCK; goto hard_way; } } else { hard_way: - DEBUG_m(PerlIO_printf(Perl_debug_log, + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n", PTR2UV(cp),(unsigned long)(PL_an++), (long)size)); @@ -2175,7 +2175,7 @@ Perl_malloc_good_size(size_t wanted) # define MIN_EVEN_REPORT 6 # else # define MIN_EVEN_REPORT MIN_BUCKET -# endif +# endif int Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) @@ -2187,7 +2187,7 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) PERL_ARGS_ASSERT_GET_MSTATS; - buf->topbucket = buf->topbucket_ev = buf->topbucket_odd + buf->topbucket = buf->topbucket_ev = buf->topbucket_odd = buf->totfree = buf->total = buf->total_chain = 0; buf->minbucket = MIN_BUCKET; @@ -2198,7 +2198,7 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) if (i < buflen) { buf->nfree[i] = j; buf->ntotal[i] = nmalloc[i]; - } + } buf->totfree += j * BUCKET_SIZE_REAL(i); buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i); if (nmalloc[i]) { @@ -2234,7 +2234,7 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) } /* * mstats - print out statistics about malloc - * + * * Prints two lines of numbers, one showing the length of the free list * for each size category, the second showing the number of mallocs - * frees for each size category. @@ -2257,47 +2257,47 @@ Perl_dump_mstats(pTHX_ const char *s) if (s) PerlIO_printf(Perl_error_log, "Memory allocation statistics %s (buckets %"IVdf"(%"IVdf")..%"IVdf"(%"IVdf")\n", - s, - (IV)BUCKET_SIZE_REAL(MIN_BUCKET), + s, + (IV)BUCKET_SIZE_REAL(MIN_BUCKET), (IV)BUCKET_SIZE_NO_SURPLUS(MIN_BUCKET), - (IV)BUCKET_SIZE_REAL(buffer.topbucket), + (IV)BUCKET_SIZE_REAL(buffer.topbucket), (IV)BUCKET_SIZE_NO_SURPLUS(buffer.topbucket)); PerlIO_printf(Perl_error_log, "%8"IVdf" free:", buffer.totfree); for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5"UVuf + ? " %5"UVuf : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)), buffer.nfree[i]); } #ifdef BUCKETS_ROOT2 PerlIO_printf(Perl_error_log, "\n\t "); for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5"UVuf + ? " %5"UVuf : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)), buffer.nfree[i]); } -#endif +#endif PerlIO_printf(Perl_error_log, "\n%8"IVdf" used:", buffer.total - buffer.totfree); for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5"IVdf - : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)), + : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)), buffer.ntotal[i] - buffer.nfree[i]); } #ifdef BUCKETS_ROOT2 PerlIO_printf(Perl_error_log, "\n\t "); for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5"IVdf + ? " %5"IVdf : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)), buffer.ntotal[i] - buffer.nfree[i]); } -#endif +#endif PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %"IVdf"/%"IVdf":%"IVdf". Odd ends: pad+heads+chain+tail: %"IVdf"+%"IVdf"+%"IVdf"+%"IVdf".\n", buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good, buffer.sbrk_slack, buffer.start_slack, diff --git a/mathoms.c b/mathoms.c index 73f1e8d38b8a..42a9c6f1e28d 100644 --- a/mathoms.c +++ b/mathoms.c @@ -19,10 +19,10 @@ -/* +/* * This file contains mathoms, various binary artifacts from previous * versions of Perl. For binary or source compatibility reasons, though, - * we cannot completely remove them from the core code. + * we cannot completely remove them from the core code. * * SMP - Oct. 24, 2005 * @@ -913,7 +913,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash) { PERL_ARGS_ASSERT_HV_FETCH_ENT; - return (HE *)hv_common(hv, keysv, NULL, 0, 0, + return (HE *)hv_common(hv, keysv, NULL, 0, 0, (lval ? HV_FETCH_LVALUE : 0), NULL, hash); } @@ -1031,7 +1031,7 @@ Perl_newHV(pTHX) } void -Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, +Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen) { PERL_ARGS_ASSERT_SV_INSERT; diff --git a/mg.c b/mg.c index 76912bd9cea1..57f95a717a9e 100644 --- a/mg.c +++ b/mg.c @@ -519,7 +519,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic) const MGVTBL* const vtbl = mg->mg_virtual; if (PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type)) continue; - + if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local) (void)vtbl->svt_local(aTHX_ nsv, mg); else @@ -537,7 +537,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic) SvSETMAGIC(nsv); PL_localizing = 0; } - } + } } #define mg_free_struct(sv, mg) S_mg_free_struct(aTHX_ sv, mg) @@ -1967,7 +1967,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) SV *retval; SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg); HV * const pkg = SvSTASH((const SV *)SvRV(tied)); - + PERL_ARGS_ASSERT_MAGIC_SCALARPACK; if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) { @@ -1981,7 +1981,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) HvEITER_set(hv, NULL); /* need to reset iterator */ return SvOK(key) ? &PL_sv_yes : &PL_sv_no; } - + /* there is a SCALAR method that we can call */ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST(SCALAR), 0, 0); if (!retval) diff --git a/mro.c b/mro.c index 1b37ca7cd629..d51fe1571658 100644 --- a/mro.c +++ b/mro.c @@ -67,13 +67,13 @@ Perl_mro_set_private_data(pTHX_ struct mro_meta *const smeta, } else { HV *const hv = newHV(); /* Start with 2 buckets. It's unlikely we'll need more. */ - HvMAX(hv) = 1; + HvMAX(hv) = 1; smeta->mro_linear_all = hv; if (smeta->mro_linear_current) { /* If we were storing something directly, put it in the hash before we lose it. */ - Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which, + Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which, smeta->mro_linear_current); } } @@ -127,7 +127,7 @@ Perl_mro_register(pTHX_ const struct mro_alg *mro) { PERL_ARGS_ASSERT_MRO_REGISTER; - + if (!Perl_hv_common(aTHX_ PL_registered_mros, NULL, mro->name, mro->length, mro->kflags, HV_FETCH_ISSTORE, wrapper, mro->hash)) { @@ -633,7 +633,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) so on aggregate we expect to save time by not making two calls to the common HV code for the case where it doesn't exist. */ - + (void) hv_storehek(mroisarev, namehek, &PL_sv_yes); } @@ -675,7 +675,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) almost as cheap as calling hv_exists, so on aggregate we expect to save time by not making two calls to the common HV code for the case where it doesn't exist. */ - + (void)hv_storehek(mroisarev, stashhek, &PL_sv_yes); } @@ -867,7 +867,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, mro_gather_and_rename set aside for us) this way, in case one class in this list is a superclass of a another class that we have already encountered. In such a case, meta->isa - will have been overwritten without old entries being deleted + will have been overwritten without old entries being deleted from PL_isarev. */ struct mro_meta * const meta = HvMROMETA(stash); if(meta->isa != (HV *)HeVAL(iter)){ @@ -1114,7 +1114,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, ing that here, as we want to avoid resetting the hash iterator. */ /* Skip the entire loop if the hash is empty. */ - if(oldstash && HvUSEDKEYS(oldstash)) { + if(oldstash && HvUSEDKEYS(oldstash)) { xhv = (XPVHV*)SvANY(oldstash); seen = (HV *) sv_2mortal((SV *)newHV()); @@ -1369,7 +1369,7 @@ void Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name) { const struct mro_alg *const which = Perl_mro_get_from_name(aTHX_ name); - + PERL_ARGS_ASSERT_MRO_SET_MRO; if (!which) @@ -1379,7 +1379,7 @@ Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name) if (meta->mro_linear_current && !meta->mro_linear_all) { /* If we were storing something directly, put it in the hash before we lose it. */ - Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, + Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, MUTABLE_SV(meta->mro_linear_current)); } meta->mro_which = which; @@ -1417,7 +1417,7 @@ XS(XS_mro_method_changed_in) if(items != 1) croak_xs_usage(cv, "classname"); - + classname = ST(0); class_stash = gv_stashsv(classname, 0); diff --git a/numeric.c b/numeric.c index d4317289b5b0..1d5bc985f54c 100644 --- a/numeric.c +++ b/numeric.c @@ -208,7 +208,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) "Illegal binary digit '%c' ignored", *s); break; } - + if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 || (!overflowed && value > 0xffffffff @@ -330,7 +330,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) "Illegal hexadecimal digit '%c' ignored", *s); break; } - + if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 || (!overflowed && value > 0xffffffff @@ -437,7 +437,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) } break; } - + if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 || (!overflowed && value > 0xffffffff @@ -533,7 +533,7 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) const char * const radix = SvPV(PL_numeric_radix_sv, len); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; - return TRUE; + return TRUE; } } /* always try "." if numeric radix didn't match because @@ -780,11 +780,11 @@ S_mulexp10(NV value, I32 exponent) /* On OpenVMS VAX we by default use the D_FLOAT double format, * and that format does not have *easy* capabilities [1] for - * overflowing doubles 'silently' as IEEE fp does. We also need - * to support G_FLOAT on both VAX and Alpha, and though the exponent - * range is much larger than D_FLOAT it still doesn't do silent - * overflow. Therefore we need to detect early whether we would - * overflow (this is the behaviour of the native string-to-float + * overflowing doubles 'silently' as IEEE fp does. We also need + * to support G_FLOAT on both VAX and Alpha, and though the exponent + * range is much larger than D_FLOAT it still doesn't do silent + * overflow. Therefore we need to detect early whether we would + * overflow (this is the behaviour of the native string-to-float * conversion routines, and therefore of native applications, too). * * [1] Trying to establish a condition handler to trap floating point @@ -835,7 +835,7 @@ S_mulexp10(NV value, I32 exponent) exponent ^= bit; result *= power; /* Floating point exceptions are supposed to be turned off, - * but if we're obviously done, don't risk another iteration. + * but if we're obviously done, don't risk another iteration. */ if (exponent == 0) break; } @@ -1095,7 +1095,7 @@ Perl_my_frexpl(long double x, int *e) { =for apidoc Perl_signbit Return a non-zero integer if the sign bit on an NV is set, and 0 if -it is not. +it is not. If Configure detects this system has a signbit() that will work with our NVs, then we just use it via the #define in perl.h. Otherwise, diff --git a/op.c b/op.c index 716c684ccce1..8f3570796122 100644 --- a/op.c +++ b/op.c @@ -523,7 +523,7 @@ S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags) yyerror_pv(Perl_form(aTHX_ "Not enough arguments for %s", name), flags); return o; } - + STATIC OP * S_too_many_arguments_pv(pTHX_ OP *o, const char *name, U32 flags) { @@ -557,7 +557,7 @@ S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid) { SV * const namesv = gv_ename(gv); PERL_ARGS_ASSERT_BAD_TYPE_GV; - + yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)", (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv) | flags); } @@ -707,7 +707,7 @@ Perl_op_free(pTHX_ OP *o) /* Though ops may be freed twice, freeing the op after its slab is a big no-no. */ - assert(!o || !o->op_slabbed || OpSLAB(o)->opslab_refcnt != ~(size_t)0); + assert(!o || !o->op_slabbed || OpSLAB(o)->opslab_refcnt != ~(size_t)0); /* During the forced freeing of ops after compilation failure, kidops may be freed before their parents. */ if (!o || o->op_type == OP_FREED) @@ -783,7 +783,7 @@ Perl_op_clear(pTHX_ OP *o) #ifdef PERL_MAD mad_free(o->op_madprop); o->op_madprop = 0; -#endif +#endif retry: switch (o->op_type) { @@ -857,7 +857,7 @@ Perl_op_clear(pTHX_ OP *o) /** Bug #15654 Even if op_clear does a pad_free for the target of the op, pad_free doesn't actually remove the sv that exists in the pad; - instead it lives on. This results in that it could be reused as + instead it lives on. This results in that it could be reused as a target later on when the pad was reallocated. **/ if(o->op_targ) { @@ -988,7 +988,7 @@ S_forget_pmop(pTHX_ PMOP *const o } } } - if (PL_curpm == o) + if (PL_curpm == o) PL_curpm = NULL; } @@ -1402,7 +1402,7 @@ Perl_scalarvoid(pTHX_ OP *o) for (sib = o->op_sibling; sib && sib->op_type == OP_NULL; sib = sib->op_sibling) ; - + if (!sib) return o; } @@ -1566,7 +1566,7 @@ Perl_scalarvoid(pTHX_ OP *o) no_bareword_allowed(o); else { if (ckWARN(WARN_VOID)) { - /* don't warn on optimised away booleans, eg + /* don't warn on optimised away booleans, eg * use constant Foo, 5; Foo || print; */ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT) useless = NULL; @@ -1990,7 +1990,7 @@ S_finalize_op(pTHX_ OP* o) rop = (UNOP*)((LISTOP*)o)->op_last; - check_keys: + check_keys: if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV) rop = NULL; else if (rop->op_first->op_type == OP_PADSV) @@ -2036,8 +2036,8 @@ S_finalize_op(pTHX_ OP* o) if (check_fields && !hv_fetch_ent(GvHV(*fields), *svp, FALSE, 0)) { - Perl_croak(aTHX_ "No such class field \"%"SVf"\" " - "in variable %"SVf" of type %"HEKf, + Perl_croak(aTHX_ "No such class field \"%"SVf"\" " + "in variable %"SVf" of type %"HEKf, SVfARG(*svp), SVfARG(lexname), HEKfARG(HvNAME_HEK(SvSTASH(lexname)))); } @@ -2977,7 +2977,7 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs) /* The listop in rops might have a pushmark at the beginning, which will mess up list assignment. */ LISTOP * const lrops = (LISTOP *)rops; /* for brevity */ - if (rops->op_type == OP_LIST && + if (rops->op_type == OP_LIST && lrops->op_first && lrops->op_first->op_type == OP_PUSHMARK) { OP * const pushmark = lrops->op_first; @@ -3721,7 +3721,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o) op_null(cLISTOPo->op_first); kid2->op_private |= OPpCOREARGS_PUSHMARK; } - } + } o->op_type = (OPCODE)type; o->op_ppaddr = PL_ppaddr[type]; @@ -3878,7 +3878,7 @@ Perl_op_prepend_elem(pTHX_ I32 type, OP *first, OP *last) /* Constructors */ #ifdef PERL_MAD - + TOKEN * Perl_newTOKEN(pTHX_ I32 optype, YYSTYPE lval, MADPROP* madprop) { @@ -4640,7 +4640,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) else if (j >= (I32)rlen) j = rlen - 1; else { - tbl = + tbl = (short *) PerlMemShared_realloc(tbl, (0x101+rlen-j) * sizeof(short)); @@ -4680,7 +4680,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) } if(del && rlen == tlen) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); } else if(rlen > tlen && !complement) { Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list"); } @@ -6906,7 +6906,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) SvPV_nolen_const(((SVOP*)label)->op_sv))); } } - + /* If we have already created an op, we do not need the label. */ if (o) #ifdef PERL_MAD @@ -7016,7 +7016,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block, - a filetest operator, with the exception of -s -M -A -C - defined(), exists() or eof() - /$re/ or $foo =~ /$re/ - + [*] possibly surprising */ STATIC bool @@ -7054,9 +7054,9 @@ S_looks_like_bool(pTHX_ const OP *o) case OP_SEQ: case OP_SNE: case OP_SLT: case OP_SGT: case OP_SLE: case OP_SGE: - + case OP_SMARTMATCH: - + case OP_FTRREAD: case OP_FTRWRITE: case OP_FTREXEC: case OP_FTEREAD: case OP_FTEWRITE: case OP_FTEEXEC: case OP_FTIS: case OP_FTEOWNED: case OP_FTROWNED: @@ -7065,19 +7065,19 @@ S_looks_like_bool(pTHX_ const OP *o) case OP_FTPIPE: case OP_FTLINK: case OP_FTSUID: case OP_FTSGID: case OP_FTSVTX: case OP_FTTTY: case OP_FTTEXT: case OP_FTBINARY: - + case OP_DEFINED: case OP_EXISTS: case OP_MATCH: case OP_EOF: case OP_FLOP: return TRUE; - + case OP_CONST: /* Detect comparisons that have been optimized away */ if (cSVOPo->op_sv == &PL_sv_yes || cSVOPo->op_sv == &PL_sv_no) - + return TRUE; else return FALSE; @@ -7141,7 +7141,7 @@ Perl_newWHENOP(pTHX_ OP *cond, OP *block) newDEFSVOP(), scalar(ref_array_or_hash(cond))); } - + return newGIVWHENOP(cond_op, block, OP_ENTERWHEN, OP_LEAVEWHEN, 0); } @@ -7193,7 +7193,7 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p, if (name) Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name)); if (cvp) - Perl_sv_catpvf(aTHX_ msg, " (%"UTF8f")", + Perl_sv_catpvf(aTHX_ msg, " (%"UTF8f")", UTF8fARG(SvUTF8(cv),clen,cvp) ); else @@ -7513,7 +7513,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) age sub (my sub foo; sub bar { sub foo { ... } }), outcv points to the package sub. So check PadnameOUTER(name) too. */ - if (outcv == CvOUTSIDE(compcv) && !PadnameOUTER(name)) { + if (outcv == CvOUTSIDE(compcv) && !PadnameOUTER(name)) { assert(!CvWEAKOUTSIDE(compcv)); SvREFCNT_dec(CvOUTSIDE(compcv)); CvWEAKOUTSIDE_on(compcv); @@ -7596,7 +7596,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) the debugger could be able to set a breakpoint in, so signal to pp_entereval that it should not throw away any saved lines at scope exit. */ - + PL_breakable_sub_gen++; /* This makes sub {}; work as expected. */ if (block->op_type == OP_STUB) { @@ -7949,7 +7949,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, the debugger could be able to set a breakpoint in, so signal to pp_entereval that it should not throw away any saved lines at scope exit. */ - + PL_breakable_sub_gen++; /* This makes sub {}; work as expected. */ if (block->op_type == OP_STUB) { @@ -8218,10 +8218,10 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, name ? len : PL_curstash ? sizeof("__ANON__") - 1: sizeof("__ANON__::__ANON__") - 1, GV_ADDMULTI | flags, SVt_PVCV); - + if (!subaddr) Perl_croak(aTHX_ "panic: no address for '%s' in '%s'", name, filename); - + if ((cv = (name ? GvCV(gv) : NULL))) { if (GvCVGEN(gv)) { /* just a cached method */ @@ -8244,7 +8244,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, cv = NULL; } } - + if (cv) /* must reuse cv if autoloaded */ cv_undef(cv); else { @@ -8265,7 +8265,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */ CvISXSUB_on(cv); CvXSUB(cv) = subaddr; - + if (name) process_special_blocks(0, name, gv, cv); } @@ -9167,7 +9167,7 @@ Perl_ck_fun(pTHX_ OP *o) *tokid = kid; } else if (kid->op_type == OP_CONST - && ( !SvROK(cSVOPx_sv(kid)) + && ( !SvROK(cSVOPx_sv(kid)) || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV ) ) bad_type_pv(numargs, "array", PL_op_desc[type], 0, kid); @@ -9634,12 +9634,12 @@ Perl_ck_smartmatch(pTHX_ OP *o) if (0 == (o->op_flags & OPf_SPECIAL)) { OP *first = cBINOPo->op_first; OP *second = first->op_sibling; - + /* Implicitly take a reference to an array or hash */ first->op_sibling = NULL; first = cBINOPo->op_first = ref_array_or_hash(first); second = first->op_sibling = ref_array_or_hash(second); - + /* Implicitly take a reference to a regular expression */ if (first->op_type == OP_MATCH) { first->op_type = OP_QR; @@ -9650,7 +9650,7 @@ Perl_ck_smartmatch(pTHX_ OP *o) second->op_ppaddr = PL_ppaddr[OP_QR]; } } - + return o; } @@ -9848,7 +9848,7 @@ Perl_ck_require(pTHX_ OP *o) if (was_readonly) { SvREADONLY_off(sv); - } + } if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0); s = SvPVX(sv); @@ -10691,7 +10691,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) } if (aop != cvop) (void)too_many_arguments_pv(entersubop, GvNAME(namegv), 0); - + op_free(entersubop); switch(GvNAME(namegv)[2]) { case 'F': return newSVOP(OP_CONST, 0, @@ -10719,7 +10719,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) #endif if (!aop->op_sibling) aop = cUNOPx(aop)->op_first; - + prev = aop; aop = aop->op_sibling; prev->op_sibling = NULL; @@ -10740,7 +10740,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) if (opnum == OP_ENTEREVAL && GvNAMELEN(namegv)==9 && strnEQ(GvNAME(namegv), "evalbytes", 9)) flags |= OPpEVAL_BYTES <<8; - + switch (PL_opargs[opnum] & OA_CLASS_MASK) { case OA_UNOP: case OA_BASEOP_OR_UNOP: @@ -11802,11 +11802,11 @@ Perl_rpeep(pTHX_ OP *o) } break; - + { OP *fop; OP *sop; - + #define HV_OR_SCALARHV(op) \ ( (op)->op_type == OP_PADHV || (op)->op_type == OP_RV2HV \ ? (op) \ @@ -11847,12 +11847,12 @@ Perl_rpeep(pTHX_ OP *o) o->op_next = ((LOGOP*)o->op_next)->op_other; } DEFER(cLOGOP->op_other); - + o->op_opt = 1; fop = HV_OR_SCALARHV(fop); if (sop) sop = HV_OR_SCALARHV(sop); if (fop || sop - ){ + ){ OP * nop = o; OP * lop = o; if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) { @@ -11871,7 +11871,7 @@ Perl_rpeep(pTHX_ OP *o) nop = NULL; break; } - } + } } if (fop) { if ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID @@ -11883,17 +11883,17 @@ Perl_rpeep(pTHX_ OP *o) if ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID && sop) sop->op_private |= OPpTRUEBOOL; - } - - + } + + break; - + case OP_COND_EXPR: if ((fop = HV_OR_SCALARHV(cLOGOP->op_first))) fop->op_private |= OPpTRUEBOOL; #undef HV_OR_SCALARHV /* GERONIMO! */ - } + } case OP_MAPWHILE: case OP_GREPWHILE: @@ -12028,7 +12028,7 @@ Perl_rpeep(pTHX_ OP *o) iter = enter->op_next; if (!iter || iter->op_type != OP_ITER) break; - + expushmark = enter->op_first; if (!expushmark || expushmark->op_type != OP_NULL || expushmark->op_targ != OP_PUSHMARK) @@ -12080,7 +12080,7 @@ Perl_rpeep(pTHX_ OP *o) op_null(o); enter->op_private |= OPpITER_REVERSED; iter->op_private |= OPpITER_REVERSED; - + break; } @@ -12145,13 +12145,13 @@ Perl_rpeep(pTHX_ OP *o) break; case OP_CUSTOM: { - Perl_cpeep_t cpeep = + Perl_cpeep_t cpeep = XopENTRYCUSTOM(o, xop_peep); if (cpeep) cpeep(aTHX_ o, oldop); break; } - + } /* did we just null the current op? If so, re-process it to handle * eliding "empty" ops from the chain */ diff --git a/op.h b/op.h index a1c3c5934088..cf149d399d79 100644 --- a/op.h +++ b/op.h @@ -339,14 +339,14 @@ is no conversion of op type. /* Private for OP_(MAP|GREP)(WHILE|START) */ #define OPpGREP_LEX 2 /* iterate over lexical $_ */ - + /* Private for OP_ENTEREVAL */ #define OPpEVAL_HAS_HH 2 /* Does it have a copy of %^H */ #define OPpEVAL_UNICODE 4 #define OPpEVAL_BYTES 8 #define OPpEVAL_COPHH 16 /* Construct %^H from cop hints */ #define OPpEVAL_RE_REPARSING 32 /* eval_sv(..., G_RE_REPARSING) */ - + /* Private for OP_CALLER, OP_WANTARRAY and OP_RUNCV */ #define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */ @@ -926,7 +926,7 @@ Reenable a member of the XOP which has been disabled. */ struct custom_op { - U32 xop_flags; + U32 xop_flags; const char *xop_name; const char *xop_desc; U32 xop_class; diff --git a/os2/os2.c b/os2/os2.c index 4ae39e7f2d7e..e9cc51b8b063 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -153,7 +153,7 @@ static struct perlos2_state_t { int po2_pwent_cnt; char po2_pthreads_state_buf[80]; char po2_os2error_buf[300]; -/* There is no big sense to make it thread-specific, since signals +/* There is no big sense to make it thread-specific, since signals are delivered to thread 1 only. XXXX Maybe make it into an array? */ int po2_spawn_pid; int po2_spawn_killed; @@ -196,7 +196,7 @@ static struct perlos2_state_t { #define _my_pwent (Perl_po2()->po2__my_pwent) #define pthreads_state_buf (Perl_po2()->po2_pthreads_state_buf) #define os2error_buf (Perl_po2()->po2_os2error_buf) -/* There is no big sense to make it thread-specific, since signals +/* There is no big sense to make it thread-specific, since signals are delivered to thread 1 only. XXXX Maybe make it into an array? */ #define spawn_pid (Perl_po2()->po2_spawn_pid) #define spawn_killed (Perl_po2()->po2_spawn_killed) @@ -221,10 +221,10 @@ typedef void (*emx_startroutine)(void *); typedef void* (*pthreads_startroutine)(void *); enum pthreads_state { - pthreads_st_none = 0, + pthreads_st_none = 0, pthreads_st_run, - pthreads_st_exited, - pthreads_st_detached, + pthreads_st_exited, + pthreads_st_detached, pthreads_st_waited, pthreads_st_norun, pthreads_st_exited_waited, @@ -281,7 +281,7 @@ pthread_join(perl_os_thread tid, void **status) thread_join_data[tid].state = pthreads_st_exited_waited; *status = thread_join_data[tid].status; MUTEX_UNLOCK(&start_thread_mutex); - COND_SIGNAL(&thread_join_data[tid].cond); + COND_SIGNAL(&thread_join_data[tid].cond); break; case pthreads_st_waited: MUTEX_UNLOCK(&start_thread_mutex); @@ -313,7 +313,7 @@ pthread_join(perl_os_thread tid, void **status) } default: MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: join with thread in unknown thread state: '%s'", + Perl_croak_nocontext("panic: join with thread in unknown thread state: '%s'", pthreads_state_string(thread_join_data[tid].state)); break; } @@ -354,7 +354,7 @@ pthread_startit(void *arg1) PERL_SET_CONTEXT(0); if (tid >= thread_join_count) { int oc = thread_join_count; - + thread_join_count = tid + 5 + tid/5; if (thread_join_data) { Renew(thread_join_data, thread_join_count, thread_join_t); @@ -410,7 +410,7 @@ pthread_startit(void *arg1) } int -pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr, +pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr, void *(*start_routine)(void*), void *arg) { dTHX; @@ -423,7 +423,7 @@ pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr, MUTEX_LOCK(&start_thread_mutex); /* Test suite creates 31 extra threads; on machine without shared-memory-hogs this stack sizeis OK with 31: */ - *tidp = _beginthread(pthread_startit, /*stack*/ NULL, + *tidp = _beginthread(pthread_startit, /*stack*/ NULL, /*stacksize*/ 4*1024*1024, (void*)&args); if (*tidp == -1) { *tidp = pthread_not_existant; @@ -435,7 +435,7 @@ pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr, return 0; } -int +int pthread_detach(perl_os_thread tid) { MUTEX_LOCK(&start_thread_mutex); @@ -457,7 +457,7 @@ pthread_detach(perl_os_thread tid) break; case pthreads_st_exited: MUTEX_UNLOCK(&start_thread_mutex); - COND_SIGNAL(&thread_join_data[tid].cond); + COND_SIGNAL(&thread_join_data[tid].cond); break; case pthreads_st_detached: MUTEX_UNLOCK(&start_thread_mutex); @@ -476,7 +476,7 @@ pthread_detach(perl_os_thread tid) } default: MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: detach of a thread with unknown thread state: '%s'", + Perl_croak_nocontext("panic: detach of a thread with unknown thread state: '%s'", pthreads_state_string(thread_join_data[tid].state)); break; } @@ -486,20 +486,20 @@ pthread_detach(perl_os_thread tid) /* This is a very bastardized version; may be OK due to edge trigger of Wait */ int os2_cond_wait(perl_cond *c, perl_mutex *m) -{ +{ int rc; STRLEN n_a; if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET)) Perl_rc = CheckOSError(rc), croak_with_os2error("panic: COND_WAIT-reset"); - if (m) MUTEX_UNLOCK(m); + if (m) MUTEX_UNLOCK(m); if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT)) && (rc != ERROR_INTERRUPT)) - croak_with_os2error("panic: COND_WAIT"); + croak_with_os2error("panic: COND_WAIT"); if (rc == ERROR_INTERRUPT) errno = EINTR; if (m) MUTEX_LOCK(m); return 0; -} +} #endif static int exe_is_aout(void); @@ -646,7 +646,7 @@ loadModule(const char *modname, int fail) HMODULE h = (HMODULE)dlopen(modname, 0); if (!h && fail) - Perl_croak_nocontext("Error loading module '%s': %s", + Perl_croak_nocontext("Error loading module '%s': %s", modname, dlerror()); return h; } @@ -659,11 +659,11 @@ my_type() int rc; TIB *tib; PIB *pib; - + if (!(_emx_env & 0x200)) return 1; /* not OS/2. */ - if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) - return -1; - + if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) + return -1; + return (pib->pib_ultype); } @@ -673,10 +673,10 @@ my_type_set(int type) int rc; TIB *tib; PIB *pib; - + if (!(_emx_env & 0x200)) Perl_croak_nocontext("Can't set type on DOS"); /* not OS/2. */ - if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) + if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) croak_with_os2error("Error getting info blocks"); pib->pib_ultype = type; } @@ -686,7 +686,7 @@ loadByOrdinal(enum entries_ordinals ord, int fail) { if (sizeof(loadOrdinals)/sizeof(loadOrdinals[0]) != ORD_NENTRIES) Perl_croak_nocontext( - "Wrong size of loadOrdinals array: expected %d, actual %d", + "Wrong size of loadOrdinals array: expected %d, actual %d", sizeof(loadOrdinals)/sizeof(loadOrdinals[0]), ORD_NENTRIES); if (ExtFCN[ord] == NULL) { PFN fcn = (PFN)-1; @@ -695,7 +695,7 @@ loadByOrdinal(enum entries_ordinals ord, int fail) if (!loadOrdinals[ord].dll->handle) { if (loadOrdinals[ord].dll->requires_pm && my_type() < 2) { /* FS */ char *s = getenv("PERL_ASIF_PM"); - + if (!s || !atoi(s)) { /* The module will not function well without PM. The usual way to detect PM is the existence of the mutex @@ -726,17 +726,17 @@ loadByOrdinal(enum entries_ordinals ord, int fail) if (!s) sprintf(s = buf, "%d", loadOrdinals[ord].entrypoint); Perl_croak_nocontext( - "This version of OS/2 does not support %s.%s", + "This version of OS/2 does not support %s.%s", loadOrdinals[ord].dll->modname, s); } ExtFCN[ord] = fcn; - } + } if ((long)ExtFCN[ord] == -1) Perl_croak_nocontext("panic queryaddr"); return ExtFCN[ord]; } -void +void init_PMWIN_entries(void) { int i; @@ -827,7 +827,7 @@ sys_prio(pid) return prio; } -int +int setpriority(int which, int pid, int val) { ULONG rc, prio = sys_prio(pid); @@ -835,33 +835,33 @@ setpriority(int which, int pid, int val) if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */ if (priors[(32 - val) >> 5] + 1 == (prio >> 8)) { /* Do not change class. */ - return CheckOSError(DosSetPriority((pid < 0) + return CheckOSError(DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS, - 0, - (32 - val) % 32 - (prio & 0xFF), + 0, + (32 - val) % 32 - (prio & 0xFF), abs(pid))) ? -1 : 0; } else /* if ((32 - val) % 32 == (prio & 0xFF)) */ { /* Documentation claims one can change both class and basevalue, * but I find it wrong. */ /* Change class, but since delta == 0 denotes absolute 0, correct. */ - if (CheckOSError(DosSetPriority((pid < 0) + if (CheckOSError(DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS, - priors[(32 - val) >> 5] + 1, - 0, - abs(pid)))) + priors[(32 - val) >> 5] + 1, + 0, + abs(pid)))) return -1; if ( ((32 - val) % 32) == 0 ) return 0; - return CheckOSError(DosSetPriority((pid < 0) + return CheckOSError(DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS, - 0, - (32 - val) % 32, + 0, + (32 - val) % 32, abs(pid))) ? -1 : 0; - } + } } -int +int getpriority(int which /* ignored */, int pid) { ULONG ret; @@ -884,13 +884,13 @@ spawn_sighandler(int sig) { /* Some programs do not arrange for the keyboard signals to be delivered to them. We need to deliver the signal manually. */ - /* We may get a signal only if + /* We may get a signal only if a) kid does not receive keyboard signal: deliver it; b) kid already died, and we get a signal. We may only hope that the pid number was not reused. */ - - if (spawn_killed) + + if (spawn_killed) sig = SIGKILL; /* Try harder. */ kill(spawn_pid, sig); spawn_killed = 1; @@ -950,8 +950,8 @@ file_type(char *path) { int rc; ULONG apptype; - - if (!(_emx_env & 0x200)) + + if (!(_emx_env & 0x200)) Perl_croak_nocontext("file_type not implemented on DOS"); /* not OS/2. */ if (CheckOSError(DosQueryAppType(path, &apptype))) { switch (rc) { @@ -965,7 +965,7 @@ file_type(char *path) read error. */ return -2; } - } + } return apptype; } @@ -984,7 +984,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) int rc, pass = 1; char *real_name = NULL; /* Shut down the warning */ char const * args[4]; - static const char * const fargs[4] + static const char * const fargs[4] = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", }; const char * const *argsp = fargs; int nargs = 4; @@ -994,28 +994,28 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) STRLEN n_a; char *buf; PerlIO *file; - + if (flag == P_WAIT) flag = P_NOWAIT; if (really && !*(real_name = SvPV(really, n_a))) really = NULL; retry: - if (strEQ(PL_Argv[0],"/bin/sh")) + if (strEQ(PL_Argv[0],"/bin/sh")) PL_Argv[0] = PL_sh_path; /* We should check PERL_SH* and PERLLIB_* as well? */ if (!really || pass >= 2) real_name = PL_Argv[0]; if (real_name[0] != '/' && real_name[0] != '\\' - && !(real_name[0] && real_name[1] == ':' + && !(real_name[0] && real_name[1] == ':' && (real_name[2] == '/' || real_name[2] != '\\')) ) /* will spawnvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ reread: force_shell = 0; - if (_emx_env & 0x200) { /* OS/2. */ + if (_emx_env & 0x200) { /* OS/2. */ int type = file_type(real_name); type_again: if (type == -1) { /* Not found */ @@ -1040,14 +1040,14 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) if (type >= -3) goto type_again; } - + errno = ENOEXEC; rc = -1; goto do_script; } switch (type & 7) { /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */ - case FAPPTYP_WINDOWAPI: + case FAPPTYP_WINDOWAPI: { /* Apparently, kids are started basing on startup type, not the morphed type */ if (os2_mytype != 3) { /* not PM */ if (flag == P_NOWAIT) @@ -1058,7 +1058,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) } } break; - case FAPPTYP_NOTWINDOWCOMPAT: + case FAPPTYP_NOTWINDOWCOMPAT: { if (os2_mytype != 0) { /* not full screen */ if (flag == P_NOWAIT) @@ -1069,7 +1069,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) } } break; - case FAPPTYP_NOTSPEC: + case FAPPTYP_NOTSPEC: /* Let the shell handle this... */ force_shell = 1; buf = ""; /* Pacify a warning */ @@ -1109,9 +1109,9 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) else if (execf == EXECF_SYNC) rc = spawnvp(trueflag,real_name,PL_Argv); else /* EXECF_SPAWN, EXECF_SPAWN_BYFLAG */ - rc = result(aTHX_ trueflag, + rc = result(aTHX_ trueflag, spawnvp(flag,real_name,PL_Argv)); -#endif +#endif if (rc < 0 && pass == 1) { do_script: if (real_name == PL_Argv[0]) { @@ -1161,7 +1161,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) if (PerlIO_close(file) != 0) { /* Failure */ panic_file: if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Error reading \"%s\": %s", + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Error reading \"%s\": %s", scr, Strerror(errno)); buf = ""; /* Not #! */ goto doshell_args; @@ -1170,7 +1170,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) if (buf[1] == '!') s = buf + 2; } else if (buf[0] == 'e') { - if (strnEQ(buf, "extproc", 7) + if (strnEQ(buf, "extproc", 7) && isSPACE(buf[7])) s = buf + 8; } else if (buf[0] == 'E') { @@ -1182,7 +1182,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) buf = ""; /* Not #! */ goto doshell_args; } - + s1 = s; nargs = 0; argsp = args; @@ -1191,7 +1191,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) strip trailing whitespace. */ while (isSPACE(*s)) s++; - if (*s == 0) + if (*s == 0) break; if (nargs == 4) { nargs = -1; @@ -1200,7 +1200,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) args[nargs++] = s; while (*s && !isSPACE(*s)) s++; - if (*s == 0) + if (*s == 0) break; *s++ = 0; } @@ -1216,7 +1216,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) char **a = PL_Argv; const char *exec_args[2]; - if (force_shell + if (force_shell || (!buf[0] && file)) { /* File without magic */ /* In fact we tried all what pdksh would try. There is no point in calling @@ -1240,18 +1240,18 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) } if (!inicmd) { s = PL_Argv[0]; - while (*s) { + while (*s) { /* Dosish shells will choke on slashes in paths, fortunately, this is important for zeroth arg only. */ - if (*s == '/') + if (*s == '/') *s = '\\'; s++; } } } /* If EXECSHELL is set, we do not set */ - + if (!shell) shell = ((_emx_env & 0x200) ? "c:/os2/cmd.exe" @@ -1275,7 +1275,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) PL_Argv[0] = inicmd; PL_Argv[1] = NULL; nargs = 2; /* shell -c */ - } + } while (a[1]) /* Get to the end */ a++; @@ -1297,15 +1297,15 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) } } else if (errno == ENOEXEC) { /* Cannot transfer `real_name' via shell. */ if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) ? "spawn" : "exec"), real_name, PL_Argv[0]); goto warned; } else if (errno == ENOENT) { /* Cannot transfer `real_name' via shell. */ if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) ? "spawn" : "exec"), real_name, PL_Argv[0]); goto warned; @@ -1322,13 +1322,13 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) } } if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) ? "spawn" : "exec"), real_name, Strerror(errno)); warned: - if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) - && ((trueflag & 0xFF) == P_WAIT)) + if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) + && ((trueflag & 0xFF) == P_WAIT)) rc = -1; finish: @@ -1362,18 +1362,18 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) #else /* Consensus on perl5-porters is that it is _very_ important to have a shell which will not change between computers with the - same architecture, to avoid "action on a distance". + same architecture, to avoid "action on a distance". And to have simple build, this shell should be sh. */ shell = PL_sh_path; copt = "-c"; -#endif +#endif while (*cmd && isSPACE(*cmd)) cmd++; if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) { STRLEN l = strlen(PL_sh_path); - + Newx(news, strlen(cmd) - 7 + l + 1, char); strcpy(news, PL_sh_path); strcpy(news + l, cmd + 7); @@ -1432,7 +1432,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) rc = result(aTHX_ P_WAIT, spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", (execf == EXECF_SPAWN ? "spawn" : "exec"), shell, Strerror(errno)); if (rc < 0) @@ -1507,7 +1507,7 @@ os2_aspawn_4(pTHX_ SV *really, SV **args, I32 cnt, int execing) rc = do_spawn3(aTHX_ a[-1], EXECF_SPAWN_BYFLAG, flag); } else { const int execf[3] = {EXECF_SPAWN, EXECF_EXEC, EXECF_SPAWN_NOWAIT}; - + rc = do_spawn_ve(aTHX_ really, flag, execf[execing], NULL, 0); } } else @@ -1564,7 +1564,7 @@ my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args) I32 pid; SV *sv; int fh_fl = 0; /* Pacify the warning */ - + /* `this' is what we use in the parent, `that' in the child. */ this = (*mode == 'w'); that = !this; @@ -1584,7 +1584,7 @@ my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args) p[this] = new; } newfd = dup(*mode == 'r'); /* Preserve std* */ - if (newfd == -1) { + if (newfd == -1) { /* This cannot happen due to fh being bad after pipe(), since pipe() should have created fh 0 and 1 even if they were initially closed. But we closed p[this] before. */ @@ -1649,7 +1649,7 @@ my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args) my_setenv("EMXSHELL", PL_sh_path); res = popen(cmd, mode); my_setenv("EMXSHELL", shell); -# endif +# endif sv = *av_fetch(PL_fdpid, PerlIO_fileno(res), TRUE); (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = -1; /* A cooky. */ @@ -1809,7 +1809,7 @@ sys_alloc(int size) { if (rc == ERROR_NOT_ENOUGH_MEMORY) { return (void *) -1; - } else if ( rc ) + } else if ( rc ) Perl_croak_nocontext("Got an error from DosAllocMem: %li", (long)rc); return got; } @@ -2008,11 +2008,11 @@ mod2fname(pTHX_ SV *sv) if (!SvROK(sv)) Perl_croak_nocontext("Not a reference given to mod2fname"); sv = SvRV(sv); - if (SvTYPE(sv) != SVt_PVAV) + if (SvTYPE(sv) != SVt_PVAV) Perl_croak_nocontext("Not array reference given to mod2fname"); avlen = av_tindex((AV*)sv); - if (avlen < 0) + if (avlen < 0) Perl_croak_nocontext("Empty array reference given to mod2fname"); s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); @@ -2082,7 +2082,7 @@ os2error(int rc) s = os2error_buf + strlen(os2error_buf); } else s = os2error_buf; - if (DosGetMessage(NULL, 0, s, sizeof(os2error_buf) - 1 - (s-os2error_buf), + if (DosGetMessage(NULL, 0, s, sizeof(os2error_buf) - 1 - (s-os2error_buf), rc, "OSO001.MSG", &len)) { char *name = ""; @@ -2122,7 +2122,7 @@ os2error(int rc) name = "PMERR_ATOM_NAME_NOT_FOUND"; break; } - sprintf(s, "%s%s[No description found in OSO001.MSG]", + sprintf(s, "%s%s[No description found in OSO001.MSG]", name, (*name ? "=" : "")); } else { s[len] = '\0'; @@ -2188,7 +2188,7 @@ execname2buffer(char *buf, STRLEN l, char *oname) if (ok && *oname != '/' && *oname != '\\') ok = 0; } else if (ok && tolower(*oname) != tolower(*p)) - ok = 0; + ok = 0; p++; oname++; } @@ -2199,7 +2199,7 @@ execname2buffer(char *buf, STRLEN l, char *oname) if (*p == '\\') *p = '/'; p++; - } + } } return buf; } @@ -2409,7 +2409,7 @@ perllib_mangle(char *s, unsigned int l) newp = getenv(name = "PERLLIB_PREFIX"); if (newp) { char *s, b[300]; - + oldp = newp; while (*newp && !isSPACE(*newp) && *newp != ';') newp++; /* Skip old name. */ @@ -2437,7 +2437,7 @@ perllib_mangle(char *s, unsigned int l) return mangle_ret; } -unsigned long +unsigned long Perl_hab_GET() /* Needed if perl.h cannot be included */ { return perl_hab_GET(); @@ -2477,11 +2477,11 @@ Perl_Register_MQ(int serve) Perl_hmq_refcnt = 0; /* Be extra safe */ DosGetInfoBlocks(&tib, &pib); - if (!Perl_morph_refcnt) { + if (!Perl_morph_refcnt) { Perl_os2_initial_mode = pib->pib_ultype; /* Try morphing into a PM application. */ if (pib->pib_ultype != 3) /* 2 is VIO */ - pib->pib_ultype = 3; /* 3 is PM */ + pib->pib_ultype = 3; /* 3 is PM */ } Create_HMQ(-1, /* We do CancelShutdown ourselves */ "Cannot create a message queue, or morph to a PM application"); @@ -2622,7 +2622,7 @@ XS(XS_OS2_Errors2Drive) if (suppress && !isALPHA(drive)) Perl_croak_nocontext("Non-char argument '%c' to OS2::Errors2Drive()", drive); if (CheckOSError(DosSuppressPopUps((suppress - ? SPU_ENABLESUPPRESSION + ? SPU_ENABLESUPPRESSION : SPU_DISABLESUPPRESSION), drive))) Perl_croak_nocontext("DosSuppressPopUps(%c) failed: %s", drive, @@ -2663,10 +2663,10 @@ async_mssleep(ULONG ms, int switch_priority) { if (ms >= switch_priority) switch_priority = 0; if (switch_priority) { - if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) + if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) switch_priority = 0; else { - /* In Warp3, to switch scheduling to 8ms step, one needs to do + /* In Warp3, to switch scheduling to 8ms step, one needs to do DosAsyncTimer() in time-critical thread. On laters versions, more and more cases of wait-for-something are covered. @@ -2759,7 +2759,7 @@ XS(XS_OS2_Timer) } if (CheckOSError(pDosTmrQueryTime(&count))) croak_with_os2error("DosTmrQueryTime"); - { + { dXSTARG; XSprePUSH; PUSHn(((NV)count)/freq); @@ -2773,7 +2773,7 @@ XS(XS_OS2_msCounter) if (items != 0) Perl_croak_nocontext("Usage: OS2::msCounter()"); - { + { dXSTARG; XSprePUSH; PUSHu(msCounter()); @@ -2790,7 +2790,7 @@ XS(XS_OS2__InfoTable) Perl_croak_nocontext("Usage: OS2::_infoTable([isLocal])"); if (items == 1) is_local = (int)SvIV(ST(0)); - { + { dXSTARG; XSprePUSH; PUSHu(InfoTable(is_local)); @@ -2921,7 +2921,7 @@ XS(XS_OS2_DevCap) ST(j) = sv_newmortal(); sv_setiv(ST(j++), l); i++; - } + } } if (!items && CheckWinError(pDevCloseDC(hScreenDC))) Perl_warn_nocontext("DevCloseDC() failed: %s", os2error(Perl_rc)); @@ -3081,7 +3081,7 @@ XS(XS_OS2_SysValues) break; /* May be not present on older systems */ croak_with_os2error("SysValues():"); } - + } ST(j) = sv_newmortal(); sv_setpv(ST(j++), sv_keys[i]); @@ -3247,7 +3247,7 @@ XS(XS_OS2_BootDrive) APIRET rc = NO_ERROR; /* Return code */ char c; dXSTARG; - + if (CheckOSError(DosQuerySysInfo(QSV_BOOT_DRIVE, QSV_BOOT_DRIVE, (PVOID)si, sizeof(si)))) croak_with_os2error("DosQuerySysInfo() failed"); @@ -3333,7 +3333,7 @@ XS(XS_OS2_Process_Messages) I32 cntr; SV *sv = ST(1); - (void)SvIV(sv); /* Force SvIVX */ + (void)SvIV(sv); /* Force SvIVX */ if (!SvIOK(sv)) Perl_croak_nocontext("Can't upgrade count to IV"); cntr = SvIVX(sv); @@ -3525,15 +3525,15 @@ XS(XS_Cwd_sys_abspath) } else { /* Either path is relative, or starts with a drive letter. */ /* If the path starts with a drive letter, then dir is - relevant only if - a/b) it is absolute/x:relative on the same drive. + relevant only if + a/b) it is absolute/x:relative on the same drive. c) path is on current drive, and dir is rooted In all the cases it is safe to drop the drive part of the path. */ if ( !sys_is_relative(path) ) { if ( ( ( sys_is_absolute(dir) - || (isALPHA(dir[0]) && dir[1] == ':' - && strnicmp(dir, path,1) == 0)) + || (isALPHA(dir[0]) && dir[1] == ':' + && strnicmp(dir, path,1) == 0)) && strnicmp(dir, path,1) == 0) || ( !(isALPHA(dir[0]) && dir[1] == ':') && toupper(path[0]) == current_drive())) { @@ -3859,7 +3859,7 @@ XS(XS_OS2__headerInfo) SvGROW(ST(0), size + 1); sv_2mortal(ST(0)); - if (!_Dos32QueryHeaderInfo(handle, offset, SvPV(ST(0), n_a), size, req)) + if (!_Dos32QueryHeaderInfo(handle, offset, SvPV(ST(0), n_a), size, req)) Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", req, size, handle, offset, os2error(Perl_rc)); SvCUR_set(ST(0), size); @@ -3880,8 +3880,8 @@ XS(XS_OS2_libPath) ULONG size; STRLEN n_a; - if (!_Dos32QueryHeaderInfo(0, 0, &size, sizeof(size), - DQHI_QUERYLIBPATHSIZE)) + if (!_Dos32QueryHeaderInfo(0, 0, &size, sizeof(size), + DQHI_QUERYLIBPATHSIZE)) Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", DQHI_QUERYLIBPATHSIZE, sizeof(size), 0, 0, os2error(Perl_rc)); @@ -3893,7 +3893,7 @@ XS(XS_OS2_libPath) pay attention to the size argument, so may overwrite unrelated data! */ if (!_Dos32QueryHeaderInfo(0, 0, SvPV(ST(0), n_a), size, - DQHI_QUERYLIBPATH)) + DQHI_QUERYLIBPATH)) Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", DQHI_QUERYLIBPATH, size, 0, 0, os2error(Perl_rc)); SvCUR_set(ST(0), size); @@ -4146,7 +4146,7 @@ XS(XS_OS2_pipe) sv_2mortal(sv); ll = lll; b = SvPVX(sv); - } + } os2cp_croak(DosCallNPipe(pszName, s, l, b, ll, &got, ms), "DosCallNPipe()"); @@ -4229,7 +4229,7 @@ XS(XS_OS2_pipe) ulPipeMode = count; if (items < 7) - ulPipeMode |= (NP_WAIT + ulPipeMode |= (NP_WAIT | (message ? NP_TYPE_MESSAGE : NP_TYPE_BYTE) | (message_r ? NP_READMODE_MESSAGE : NP_READMODE_BYTE)); else @@ -4283,7 +4283,7 @@ XS(XS_OS2_pipeCntl) int peek = 0, state = 0, info = 0; if (fn < 0) - Perl_croak(aTHX_ "OS2::pipeCntl(): not a pipe"); + Perl_croak(aTHX_ "OS2::pipeCntl(): not a pipe"); if (items == 3) wait = (SvTRUE(ST(2)) ? 1 : -1); @@ -4662,7 +4662,7 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) oldstack = tib->tib_pstack; oldstackend = tib->tib_pstacklimit; - if ( (char*)&s < (char*)oldstack + 4*1024 + if ( (char*)&s < (char*)oldstack + 4*1024 || (char *)oldstackend < (char*)oldstack + 52*1024 ) early_error("It is a lunacy to try to run EMX Perl ", "with less than 64K of stack;\r\n", @@ -4699,17 +4699,17 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) "panic: ExceptionHandler misplaced: not %#lx <= %#lx < %#lx\n", (unsigned long)tib->tib_pstack, (unsigned long)tib->tib_pexchain, - (unsigned long)tib->tib_pstacklimit); + (unsigned long)tib->tib_pstacklimit); goto finish; } if (tib->tib_pexchain != &(newstack->xreg)) { sprintf(buf, "ExceptionHandler misplaced: %#lx != %#lx\n", (unsigned long)tib->tib_pexchain, - (unsigned long)&(newstack->xreg)); + (unsigned long)&(newstack->xreg)); } rc = DosUnsetExceptionHandler((EXCEPTIONREGISTRATIONRECORD *)tib->tib_pexchain); if (rc) - sprintf(buf + strlen(buf), + sprintf(buf + strlen(buf), "warning: DosUnsetExceptionHandler rc=%#lx=%lu\n", rc, rc); if (preg) { @@ -4831,7 +4831,7 @@ check_emx_runtime(char **env, EXCEPTIONREGISTRATIONRECORD *preg) ULONG out; sprintf(buf, - "panic: EMX backdoor init: DosRequestMutexSem error: %lu=%#lx\n", rc, rc); + "panic: EMX backdoor init: DosRequestMutexSem error: %lu=%#lx\n", rc, rc); DosWrite(2, buf, strlen(buf), &out); return; } @@ -4853,9 +4853,9 @@ check_emx_runtime(char **env, EXCEPTIONREGISTRATIONRECORD *preg) __os_version(). */ v_crt = (_osmajor | _osminor); - if ((_emx_env & 0x200) && !(v_emx & 0xFFFF)) { /* OS/2, EMX uninit. */ + if ((_emx_env & 0x200) && !(v_emx & 0xFFFF)) { /* OS/2, EMX uninit. */ force_init_emx_runtime( preg, - FORCE_EMX_INIT_CONTRACT_ARGV + FORCE_EMX_INIT_CONTRACT_ARGV | FORCE_EMX_INIT_INSTALL_ATEXIT ); emx_wasnt_initialized = 1; /* Update CRTL data basing on now-valid EMX runtime data */ @@ -4904,7 +4904,7 @@ exe_is_aout(void) struct layout_table_t *layout; if (emx_wasnt_initialized) return 0; - /* Now we know that the principal executable is an EMX application + /* Now we know that the principal executable is an EMX application - unless somebody did already play with delayed initialization... */ /* With EMX applications to determine whether it is AOUT one needs to examine the start of the executable to find "layout" */ @@ -4915,7 +4915,7 @@ exe_is_aout(void) return 0; /* ! EMX executable */ /* Fix alignment */ Copy((char*)(ENTRY_POINT+1), &layout, 1, struct layout_table_t*); - return !(layout->flags & 2); + return !(layout->flags & 2); } void @@ -5112,7 +5112,7 @@ my_mkdir (__const__ char *s, long perm) #undef flock /* This code was contributed by Rocco Caputo. */ -int +int my_flock(int handle, int o) { FILELOCK rNull, rFull; @@ -5127,14 +5127,14 @@ my_flock(int handle, int o) char *s = getenv("USE_PERL_FLOCK"); if (s) use_my_flock = atoi(s); - else + else use_my_flock = 1; } MUTEX_UNLOCK(&perlos2_state_mutex); } - if (!(_emx_env & 0x200) || !use_my_flock) + if (!(_emx_env & 0x200) || !use_my_flock) return flock(handle, o); /* Delegate to EMX. */ - + /* is this a file? */ if ((DosQueryHType(handle, &handle_type, &flag_word) != 0) || (handle_type & 0xFF)) @@ -5233,7 +5233,7 @@ use_my_pwent(void) char *s = getenv("USE_PERL_PWENT"); if (s) _my_pwent = atoi(s); - else + else _my_pwent = 1; } return _my_pwent; @@ -5310,7 +5310,7 @@ passw_wrap(struct passwd *p) s = (char*)pw_p; /* Make match impossible */ pw.pw_passwd = s; - return &pw; + return &pw; } struct passwd * @@ -5335,7 +5335,7 @@ gcvt_os2 (double value, int digits, char *buffer) absv *= 10000; buggy = (absv < 1000 && (absv >= 10 || (absv > 1 && floor(absv) != absv))); - + if (buggy) { char pat[12]; @@ -5361,7 +5361,7 @@ int fork_with_resources() ALLOC_THREAD_KEY; /* Acquire the thread-local memory */ PERL_SET_CONTEXT(ctx); /* Reinit the thread-local memory */ #endif - + { /* Reload loaded-on-demand DLLs */ struct dll_handle_t *dlls = dll_handles; @@ -5389,7 +5389,7 @@ int fork_with_resources() dlls++; } } - + { /* Support message queue etc. */ os2_mytype = my_type(); /* Apparently, subprocesses (in particular, fork()) do not diff --git a/os2/os2ish.h b/os2/os2ish.h index 70c8cbecf9f6..e8e15f61242d 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -7,7 +7,7 @@ * available to set I/O characteristics */ #define HAS_IOCTL /**/ - + /* HAS_UTIME: * This symbol, if defined, indicates that the routine utime() is * available to update the access and modification times of files. @@ -66,7 +66,7 @@ #define USE_STAT_RDEV /**/ /* ACME_MESS: - * This symbol, if defined, indicates that error messages should be + * This symbol, if defined, indicates that error messages should be * should be generated in a format that allows the use of the Acme * GUI/editor's autofind feature. */ @@ -104,7 +104,7 @@ #if defined(I_SYS_UN) && !defined(TCPIPV4) /* It is not working without TCPIPV4 defined. */ # undef I_SYS_UN -#endif +#endif #ifdef USE_ITHREADS @@ -213,7 +213,7 @@ int pthread_create(pthread_t *tid, const pthread_attr_t *attr, #define do_spawn(a) os2_do_spawn(a) #define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c)) - + void Perl_OS2_init(char **); void Perl_OS2_init3(char **envp, void **excH, int flags); void Perl_OS2_term(void **excH, int exitstatus, int flags); @@ -284,10 +284,10 @@ void Perl_OS2_term(void **excH, int exitstatus, int flags); # ifndef PERL_FOR_X2P # ifdef EMX_BAD_SBRK # define USE_PERL_SBRK -# endif +# endif # else # define PerlIO FILE -# endif +# endif # define SYSTEM_ALLOC(a) sys_alloc(a) void *sys_alloc(int size); @@ -295,7 +295,7 @@ void *sys_alloc(int size); #endif /* !PERL_IS_AOUT */ #if !defined(PERL_CORE) && !defined(PerlIO) /* a2p */ # define PerlIO FILE -#endif +#endif /* os2ish is used from a2p/a2p.h without pTHX/pTHX_ first being * defined. Hack around this to get us to compile. @@ -419,7 +419,7 @@ void *emx_realloc (void *, size_t); #define PERLIO_IS_BINMODE_FD(fd) _PERLIO_IS_BINMODE_FD(fd) #ifdef __GNUG__ -# define HAS_BOOL +# define HAS_BOOL #endif #ifndef HAS_BOOL # define bool char @@ -562,7 +562,7 @@ void init_PMWIN_entries(void); ((expr) ? : (CroakWinError(die,name1 name2), 0)) #define FillOSError(rc) (os2_setsyserrno(rc), \ - Perl_severity = SEVERITY_ERROR) + Perl_severity = SEVERITY_ERROR) #define WinError_2_Perl_rc \ ( init_PMWIN_entries(), \ @@ -588,11 +588,11 @@ enum entries_ordinals { ORD_DosSetExtLibpath, ORD_DosVerifyPidTid, ORD_SETHOSTENT, - ORD_SETNETENT, + ORD_SETNETENT, ORD_SETPROTOENT, ORD_SETSERVENT, ORD_GETHOSTENT, - ORD_GETNETENT, + ORD_GETNETENT, ORD_GETPROTOENT, ORD_GETSERVENT, ORD_ENDHOSTENT, @@ -676,7 +676,7 @@ enum entries_ordinals { ORD_WinSetClipbrdData, ORD_WinSetClipbrdOwner, ORD_WinSetClipbrdViewer, - ORD_WinEnumClipbrdFmts, + ORD_WinEnumClipbrdFmts, ORD_WinEmptyClipbrd, ORD_WinAddAtom, ORD_WinFindAtom, @@ -762,7 +762,7 @@ enum entries_ordinals { void ResetWinError(void); void CroakWinError(int die, char *name); -enum Perlos2_handler { +enum Perlos2_handler { Perlos2_handler_mangle = 1, Perlos2_handler_perl_sh, Perlos2_handler_perllib_from, diff --git a/os2/perlrexx.c b/os2/perlrexx.c index 98a550262a1a..e41fdbe49b2b 100644 --- a/os2/perlrexx.c +++ b/os2/perlrexx.c @@ -124,7 +124,7 @@ ULONG PERL (PCSZ name, LONG rargc, const RXSTRING *rargv, memcpy(buf, rargv[0].strptr, rargv[0].strlength); buf[rargv[0].strlength] = 0; - + exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL); if (!exitstatus) { exitstatus = perl_run(my_perl); diff --git a/pad.c b/pad.c index 419b40338d5c..660094ee9502 100644 --- a/pad.c +++ b/pad.c @@ -109,7 +109,7 @@ write is called (if necessary). The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed, and set on scope exit. This allows the 'Variable $x is not available' warning -to be generated in evals, such as +to be generated in evals, such as { my $x = 1; sub f { eval '$x'} } f(); @@ -617,7 +617,7 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, (UV)flags); namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV); - + if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) { namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8); } @@ -981,7 +981,7 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) offset = pad_findlex(namepv, namelen, flags, PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags); - if ((PADOFFSET)offset != NOT_IN_PAD) + if ((PADOFFSET)offset != NOT_IN_PAD) return offset; /* look for an our that's being introduced; this allows @@ -1250,7 +1250,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n", PTR2UV(cv), (long)offset, (unsigned long)*out_flags, - (unsigned long) PARENT_PAD_INDEX(*out_name_sv) + (unsigned long) PARENT_PAD_INDEX(*out_name_sv) )); } @@ -2087,7 +2087,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv) S_unavailable(aTHX_ namesv); sv = NULL; } - else + else SvREFCNT_inc_simple_void_NN(sv); } if (!sv) { @@ -2312,7 +2312,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); } else { /* our own lexical */ - SV *sv; + SV *sv; if (sigil == '@') sv = MUTABLE_SV(newAV()); else if (sigil == '%') @@ -2447,8 +2447,8 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param) interacts with lexicals. */ pad1a[ix] = sv_dup_inc(oldpad[ix], param); } else { - SV *sv; - + SV *sv; + if (sigil == '@') sv = MUTABLE_SV(newAV()); else if (sigil == '%') diff --git a/parser.h b/parser.h index ff5867e44273..62f2c4408918 100644 --- a/parser.h +++ b/parser.h @@ -4,7 +4,7 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * + * * This file defines the layout of the parser object used by the parser * and lexer (perly.c, toke.c). */ @@ -81,7 +81,7 @@ typedef struct yy_parser { to the next */ char *oldbufptr; /* in yylex, beginning of current token */ char *oldoldbufptr; /* in yylex, beginning of previous token */ - char *bufend; + char *bufend; char *linestart; /* beginning of most recently read line */ char *last_uni; /* position of last named-unary op */ char *last_lop; /* position of last list operator */ diff --git a/perl.c b/perl.c index 27d0d9e75295..37a8d85dbe9d 100644 --- a/perl.c +++ b/perl.c @@ -36,7 +36,7 @@ #include "charclass_invlists.h" #ifdef NETWARE -#include "nwutil.h" +#include "nwutil.h" #endif #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP @@ -85,7 +85,7 @@ static void S_init_tls_and_interp(PerlInterpreter *my_perl) { dVAR; - if (!PL_curinterp) { + if (!PL_curinterp) { PERL_SET_INTERP(my_perl); #if defined(USE_ITHREADS) INIT_THREADS; @@ -681,7 +681,7 @@ perl_destruct(pTHXx) vec[0].iov_base = (void*)⌖ vec[0].iov_len = sizeof(target); - + got = recvmsg(sock, &msg, 0); if(got == 0) @@ -762,7 +762,7 @@ perl_destruct(pTHXx) close(fd[1]); } #endif - + /* We must account for everything. */ /* Destroy the main CV and syntax tree */ @@ -839,7 +839,7 @@ perl_destruct(pTHXx) safesysfree(environ[i]); /* Must use safesysfree() when working with environ. */ - safesysfree(environ); + safesysfree(environ); environ = PL_origenviron; } @@ -1517,7 +1517,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) if ((PL_origargv[i] == s + 1 #ifdef OS2 || PL_origargv[i] == s + 2 -#endif +#endif ) || (aligned && @@ -1657,7 +1657,7 @@ S_Internals_V(pTHX_ CV *cv) #endif const int entries = 3 + local_patch_count; int i; - static const char non_bincompat_options[] = + static const char non_bincompat_options[] = # ifdef DEBUGGING " DEBUGGING" # endif @@ -1750,7 +1750,7 @@ S_Internals_V(pTHX_ CV *cv) # endif # ifdef USE_FAST_STDIO " USE_FAST_STDIO" -# endif +# endif # ifdef USE_HASH_SEED_EXPLICIT " USE_HASH_SEED_EXPLICIT" # endif @@ -1762,10 +1762,10 @@ S_Internals_V(pTHX_ CV *cv) # endif # ifdef USE_PERL_ATOF " USE_PERL_ATOF" -# endif +# endif # ifdef USE_SITECUSTOMIZE " USE_SITECUSTOMIZE" -# endif +# endif ; PERL_UNUSED_ARG(cv); PERL_UNUSED_ARG(items); @@ -2491,7 +2491,7 @@ Perl_get_sv(pTHX_ const char *name, I32 flags) =for apidoc p||get_av Returns the AV of the specified Perl global or package array with the given -name (so it won't work on lexical variables). C are passed +name (so it won't work on lexical variables). C are passed to C. If C is set and the Perl variable does not exist then it will be created. If C is zero and the variable does not exist then NULL is returned. @@ -2596,7 +2596,7 @@ Perl_get_cv(pTHX_ const char *name, I32 flags) =for apidoc p||call_argv -Performs a callback to the specified named and package-scoped Perl subroutine +Performs a callback to the specified named and package-scoped Perl subroutine with C (a NULL-terminated array of strings) as arguments. See L. @@ -3233,7 +3233,7 @@ Perl_moreswitches(pTHX_ const char *s) } return s; case 'D': - { + { #ifdef DEBUGGING forbid_setid('D', FALSE); s++; @@ -3245,7 +3245,7 @@ Perl_moreswitches(pTHX_ const char *s) for (s++; isWORDCHAR(*s); s++) ; #endif return s; - } + } case 'h': usage(); case 'i': @@ -3337,7 +3337,7 @@ Perl_moreswitches(pTHX_ const char *s) /* We allow -M'Module qw(Foo Bar)' */ while(isWORDCHAR(*s) || *s==':') { if( *s++ == ':' ) { - if( *s == ':' ) + if( *s == ':' ) s++; else colon = TRUE; @@ -3346,7 +3346,7 @@ Perl_moreswitches(pTHX_ const char *s) if (s == start) Perl_croak(aTHX_ "Module name required with -%c option", option); - if (colon) + if (colon) Perl_croak(aTHX_ "Invalid module name %.*s with -%c option: " "contains single ':'", (int)(s - start), start, option); @@ -3717,7 +3717,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) * suidperl? */ *suidscript = TRUE; - /* PSz 20 Feb 04 + /* PSz 20 Feb 04 * Be supersafe and do some sanity-checks. * Still, can we be sure we got the right thing? */ @@ -3753,7 +3753,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) * filter magic is used to implement it. ) This is *not* a general * replacement for a /dev/null. What we do here is create a temp * file (an empty file), open up that as the script, and then - * immediately close and unlink it. Close enough for jazz. */ + * immediately close and unlink it. Close enough for jazz. */ #define FAKE_BIT_BUCKET_PREFIX "/tmp/perlnull-" #define FAKE_BIT_BUCKET_SUFFIX "XXXXXXXX" #define FAKE_BIT_BUCKET_TEMPLATE FAKE_BIT_BUCKET_PREFIX FAKE_BIT_BUCKET_SUFFIX @@ -4143,7 +4143,7 @@ S_init_predump_symbols(pTHX) So a compromise is to set up the correct @IO::File::ISA, so that code that does C; will still work. */ - + Perl_populate_isa(aTHX_ STR_WITH_LEN("IO::File::ISA"), STR_WITH_LEN("IO::Handle::"), STR_WITH_LEN("IO::Seekable::"), diff --git a/perlio.c b/perlio.c index d4c43d091e66..eb74462aa607 100644 --- a/perlio.c +++ b/perlio.c @@ -3103,7 +3103,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) # elif defined(__GLIBC__) /* There may be a better way for GLIBC: - libio.h defines a flag to not close() on cleanup - */ + */ f->_fileno = -1; return 1; # elif defined(__sun) @@ -3836,7 +3836,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, Stat_t st; if (PerlLIO_fstat(fd, &st) == 0 && S_ISREG(st.st_mode) - && (st.st_fab_rfm == FAB$C_VAR + && (st.st_fab_rfm == FAB$C_VAR || st.st_fab_rfm == FAB$C_VFC)) { PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; } @@ -4072,7 +4072,7 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) if (PerlIO_flush(f) != 0) { return 0; } - } + } if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) { flushptr = buf + count; while (flushptr > buf && *(flushptr - 1) != '\n') @@ -4131,9 +4131,9 @@ PerlIOBuf_tell(pTHX_ PerlIO *f) #if 1 /* As O_APPEND files are normally shared in some sense it is better to flush : - */ + */ PerlIO_flush(f); -#else +#else /* when file is NOT shared then this is sufficient */ PerlIO_seek(PerlIONext(f),0, SEEK_END); #endif diff --git a/perliol.h b/perliol.h index 236932616df0..56c5e7337f86 100644 --- a/perliol.h +++ b/perliol.h @@ -89,7 +89,7 @@ struct _PerlIO { #define PERLIO_F_OPEN 0x00200000 #define PERLIO_F_FASTGETS 0x00400000 #define PERLIO_F_TTY 0x00800000 -#define PERLIO_F_NOTREG 0x01000000 +#define PERLIO_F_NOTREG 0x01000000 #define PERLIO_F_CLEARED 0x02000000 /* layer cleared but not freed */ #define PerlIOBase(f) (*(f)) @@ -99,7 +99,7 @@ struct _PerlIO { /*--------------------------------------------------------------------------------------*/ /* Data exports - EXTCONST rather than extern is needed for Cygwin */ -#undef EXTPERLIO +#undef EXTPERLIO #ifdef PERLIO_FUNCS_CONST #define EXTPERLIO EXTCONST #else diff --git a/perlvars.h b/perlvars.h index 7bafa40882fb..7a5615ad8e94 100644 --- a/perlvars.h +++ b/perlvars.h @@ -135,7 +135,7 @@ Instead, use the function L. #if defined(USE_ITHREADS) PERLVAR(G, check_mutex, perl_mutex) /* Mutex for PL_check */ #endif -#ifdef PERL_GLOBAL_STRUCT +#ifdef PERL_GLOBAL_STRUCT PERLVAR(G, ppaddr, Perl_ppaddr_t *) /* or opcode.h */ PERLVAR(G, check, Perl_check_t *) /* or opcode.h */ PERLVARA(G, fold_locale, 256, unsigned char) /* or perl.h */ diff --git a/perly.c b/perly.c index a7115b3625aa..bb6f37a4359f 100644 --- a/perly.c +++ b/perly.c @@ -5,7 +5,7 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * + * * Note that this file was originally generated as an output from * GNU bison version 1.875, but now the code is statically maintained * and edited; the bits that are dependent on perly.y are now diff --git a/plan9/plan9.c b/plan9/plan9.c index ebdac27dcb57..be298e149272 100644 --- a/plan9/plan9.c +++ b/plan9/plan9.c @@ -6,7 +6,7 @@ int getsockopt(int a, int b, int c, void *d, int *e) { croak("Function \"getsockopt\" not implemented in this version of perl."); - return (int)NULL; + return (int)NULL; } int setsockopt(int a, int b, int c, void *d, int *e) @@ -20,13 +20,13 @@ int recvmsg(int a, struct msghdr *b, int c) { croak("Function \"recvmsg\" not implemented in this version of perl."); return (int)NULL; -} +} int sendmsg(int a, struct msghdr *b, int c) { croak("Function \"sendmsg\" not implemented in this version of perl."); return (int)NULL; -} +} /* Functions mentioned in but not implemented */ diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h index 0fdce125be83..b6ea228e83d9 100644 --- a/plan9/plan9ish.h +++ b/plan9/plan9ish.h @@ -13,7 +13,7 @@ * available to set I/O characteristics */ #define HAS_IOCTL /**/ - + /* HAS_UTIME: * This symbol, if defined, indicates that the routine utime() is * available to update the access and modification times of files. @@ -36,7 +36,7 @@ #define HAS_KILL #define HAS_WAIT - + /* UNLINK_ALL_VERSIONS: * This symbol, if defined, indicates that the program should arrange * to remove all versions of a file if unlink() is called. This is @@ -46,7 +46,7 @@ /* PLAN9: * This symbol, if defined, indicates that the program is running under - * Plan 9. + * Plan 9. */ #ifndef PLAN9 #define PLAN9 /**/ @@ -75,7 +75,7 @@ #undef USE_STAT_RDEV /**/ /* ACME_MESS: - * This symbol, if defined, indicates that error messages should be + * This symbol, if defined, indicates that error messages should be * should be generated in a format that allows the use of the Acme * GUI/editor's autofind feature. */ diff --git a/pp.c b/pp.c index 4ec6887dfd6e..0c1de3441385 100644 --- a/pp.c +++ b/pp.c @@ -473,7 +473,7 @@ PP(pp_rv2cv) if (cv) NOOP; else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) { cv = MUTABLE_CV(gv); - } + } else cv = MUTABLE_CV(&PL_sv_undef); SETs(MUTABLE_SV(cv)); @@ -1196,18 +1196,18 @@ PP(pp_pow) else if (result <= (UV)IV_MAX) /* answer negative, fits in IV */ SETi( -(IV)result ); - else if (result == (UV)IV_MIN) + else if (result == (UV)IV_MIN) /* 2's complement assumption: special case IV_MIN */ SETi( IV_MIN ); else /* answer negative, doesn't fit */ SETn( -(NV)result ); RETURN; - } + } } } float_it: -#endif +#endif { NV right = SvNV_nomg(svr); NV left = SvNV_nomg(svl); @@ -1815,7 +1815,7 @@ PP(pp_subtract) UV result; UV buv; bool buvok = SvUOK(svr); - + if (buvok) buv = SvUVX(svr); else { @@ -2739,7 +2739,7 @@ PP(pp_rand) dSP; NV value; EXTEND(SP, 1); - + if (MAXARG < 1) value = 1.0; else { @@ -2898,7 +2898,7 @@ PP(pp_oct) /* If Unicode, try to downgrade * If not possible, croak. */ SV* const tsv = sv_2mortal(newSVsv(sv)); - + SvUTF8_on(tsv); sv_utf8_downgrade(tsv, FALSE); tmps = SvPV_const(tsv, len); @@ -3455,7 +3455,7 @@ PP(pp_crypt) #endif } -/* Generally UTF-8 and UTF-EBCDIC are indistinguishable at this level. So +/* Generally UTF-8 and UTF-EBCDIC are indistinguishable at this level. So * most comments below say UTF-8, when in fact they mean UTF-EBCDIC as well */ PP(pp_ucfirst) @@ -3518,7 +3518,7 @@ PP(pp_ucfirst) } else { /* Non-zero length, non-UTF-8, Need to consider locale and if * latin1 is treated as caseless. Note that a locale takes - * precedence */ + * precedence */ ulen = 1; /* Original character is 1 byte */ tculen = 1; /* Most characters will require one byte, but this will * need to be overridden for the tricky ones */ @@ -3847,14 +3847,14 @@ PP(pp_uc) /* The mainstream case is the tight loop above. To avoid * extra tests in that, all three characters that require * special handling are mapped by the MOD to the one tested - * just above. + * just above. * Use the source to distinguish between the three cases */ if (*s == LATIN_SMALL_LETTER_SHARP_S) { /* uc() of this requires 2 characters, but they are * ASCII. If not enough room, grow the string */ - if (SvLEN(dest) < ++min) { + if (SvLEN(dest) < ++min) { const UV o = d - (U8*)SvPVX_const(dest); SvGROW(dest, min); d = (U8*)SvPVX(dest) + o; @@ -5113,7 +5113,7 @@ PP(pp_splice) i = -diff; while (i) dst[--i] = NULL; - + if (newlen) { Copy( tmparyval, AvARRAY(ary) + offset, newlen, SV* ); Safefree(tmparyval); @@ -5530,7 +5530,7 @@ PP(pp_split) } else { while (m < strend && !isSPACE(*m)) ++m; - } + } if (m >= strend) break; @@ -5564,7 +5564,7 @@ PP(pp_split) } else { while (s < strend && isSPACE(*s)) ++s; - } + } } } else if (RX_EXTFLAGS(rx) & RXf_START_ONLY) { diff --git a/pp.h b/pp.h index 97738c2d8d49..0067c106d352 100644 --- a/pp.h +++ b/pp.h @@ -175,7 +175,7 @@ C. =for apidoc Am|void|PUSHi|IV iv Push an integer onto the stack. The stack must have room for this element. Handles 'set' magic. Uses C, so C or C should be -called to declare it. Do not call multiple C-oriented macros to +called to declare it. Do not call multiple C-oriented macros to return lists from XSUB's - see C instead. See also C and C. diff --git a/pp_ctl.c b/pp_ctl.c index 380a7fe7f255..29d168b5dc5b 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -337,7 +337,7 @@ PP(pp_substcont) ) (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */ - if (cx->sb_iters > 1 && (cx->sb_rxtainted & + if (cx->sb_iters > 1 && (cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL))) SvTAINTED_on((pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ); @@ -3062,7 +3062,7 @@ PP(pp_goto) /* also pp_dump */ PL_lastgotoprobe = gotoprobe; } if (!retop) - DIE(aTHX_ "Can't find label %"UTF8f, + DIE(aTHX_ "Can't find label %"UTF8f, UTF8fARG(label_flags, label_len, label)); /* if we're leaving an eval, check before we pop any frames @@ -3778,7 +3778,7 @@ PP(pp_require) * To prevent this, the key must be stored in UNIX format if the VMS * name can be translated to UNIX. */ - + if ((unixname = tounixspec(name, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1))))) != NULL) { @@ -3992,7 +3992,7 @@ PP(pp_require) "%s\\%s", dir, name); # else - /* The equivalent of + /* The equivalent of Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); but without the need to parse the format string, or call strlen on either pointer, and with the correct @@ -4269,7 +4269,7 @@ PP(pp_entereval) SAVEDELETE(PL_defstash, safestr, len); saved_delete = TRUE; } - + PUTBACK; if (doeval(gimme, runcv, seq, saved_hh)) { @@ -4358,7 +4358,7 @@ Perl_delete_eval_scope(pTHX) I32 gimme; PERL_CONTEXT *cx; I32 optype; - + POPBLOCK(cx,newpm); POPEVAL(cx); PL_curpm = newpm; @@ -4375,7 +4375,7 @@ Perl_create_eval_scope(pTHX_ U32 flags) { PERL_CONTEXT *cx; const I32 gimme = GIMME_V; - + ENTER_with_name("eval_scope"); SAVETMPS; @@ -4392,7 +4392,7 @@ Perl_create_eval_scope(pTHX_ U32 flags) } return cx; } - + PP(pp_entertry) { dVAR; @@ -4430,7 +4430,7 @@ PP(pp_entergiven) dVAR; dSP; PERL_CONTEXT *cx; const I32 gimme = GIMME_V; - + ENTER_with_name("given"); SAVETMPS; @@ -4495,7 +4495,7 @@ S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv) dSP; PERL_ARGS_ASSERT_MATCHER_MATCHES_SV; - + PL_op = (OP *) matcher; XPUSHs(sv); PUTBACK; @@ -4531,7 +4531,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) { dVAR; dSP; - + bool object_on_left = FALSE; SV *e = TOPs; /* e is for 'expression' */ SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */ @@ -4715,13 +4715,13 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) DEBUG_M(Perl_deb(aTHX_ " comparing hash key...\n")); ++ this_key_count; - + if(!hv_exists_ent(other_hv, key, 0)) { (void) hv_iterinit(hv); /* reset iterator */ RETPUSHNO; } } - + if (other_tied) { (void) hv_iterinit(other_hv); while ( hv_iternext(other_hv) ) @@ -4729,7 +4729,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) } else other_key_count = HvUSEDKEYS(other_hv); - + if (this_key_count != other_key_count) RETPUSHNO; else @@ -4847,13 +4847,13 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) &PL_sv_undef, 0); PUSHs(*other_elem); PUSHs(*this_elem); - + PUTBACK; DEBUG_M(Perl_deb(aTHX_ " recursively comparing array element...\n")); (void) do_smartmatch(seen_this, seen_other, 0); SPAGAIN; DEBUG_M(Perl_deb(aTHX_ " recursion finished\n")); - + if (!SvTRUEx(POPs)) RETPUSHNO; } @@ -4991,7 +4991,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) else RETPUSHNO; } - + /* As a last resort, use string comparison */ DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Any\n")); PUSHs(d); PUSHs(e); @@ -5081,14 +5081,14 @@ PP(pp_continue) PMOP *newpm; PERL_UNUSED_VAR(gimme); - - cxix = dopoptowhen(cxstack_ix); - if (cxix < 0) + + cxix = dopoptowhen(cxstack_ix); + if (cxix < 0) DIE(aTHX_ "Can't \"continue\" outside a when block"); if (cxix < cxstack_ix) dounwind(cxix); - + POPBLOCK(cx,newpm); assert(CxTYPE(cx) == CXt_WHEN); @@ -5101,11 +5101,11 @@ PP(pp_continue) PP(pp_break) { - dVAR; + dVAR; I32 cxix; PERL_CONTEXT *cx; - cxix = dopoptogiven(cxstack_ix); + cxix = dopoptogiven(cxstack_ix); if (cxix < 0) DIE(aTHX_ "Can't \"break\" outside a given block"); @@ -5474,7 +5474,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) upstream = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv)) ? sv_newmortal() : buf_sv; SvUPGRADE(upstream, SVt_PV); - + if (filter_has_file) { status = FILTER_READ(idx+1, upstream, 0); } diff --git a/pp_hot.c b/pp_hot.c index ac69bc72085e..832af6278f14 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -545,14 +545,14 @@ PP(pp_defined) } if (is_dor) { - if(defined) - RETURN; + if(defined) + RETURN; if(op_type == OP_DOR) --SP; RETURNOP(cLOGOP->op_other); } /* assuming OP_DEFINED */ - if(defined) + if(defined) RETPUSHYES; RETPUSHNO; } @@ -648,7 +648,7 @@ PP(pp_add) UV result; UV buv; bool buvok = SvUOK(svr); - + if (buvok) buv = SvUVX(svr); else { @@ -890,7 +890,7 @@ PP(pp_rv2av) } else if (UNLIKELY(SvTYPE(sv) != type)) { GV *gv; - + if (!isGV_with_GP(sv)) { gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash, type, &sp); @@ -1984,7 +1984,7 @@ There are three possible sources of taint * the source string * the pattern (both compile- and run-time, RXf_TAINTED / RXf_TAINTED_SEEN) * the replacement string (or expression under /e) - + There are four destinations of taint and they are affected by the sources according to the rules below: @@ -2162,7 +2162,7 @@ PP(pp_subst) c = NULL; doutf8 = FALSE; } - + /* can do inplace substitution? */ if (c #ifdef PERL_ANY_COW @@ -2702,7 +2702,7 @@ PP(pp_entersub) Copy(MARK+1,AvARRAY(av),items,SV*); AvFILLp(av) = items - 1; - + MARK = AvARRAY(av); while (items--) { if (*MARK) @@ -2768,7 +2768,7 @@ PP(pp_entersub) } } SP += items; - PUTBACK ; + PUTBACK ; } } else { @@ -3018,8 +3018,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) PL_stashcache, NULL, packname, packlen, packname_is_utf8 ? HVhek_UTF8 : 0, 0, NULL, 0 ); - - if (he) { + + if (he) { stash = INT2PTR(HV*,SvIV(HeVAL(he))); DEBUG_o(Perl_deb(aTHX_ "PL_stashcache hit %p for '%"SVf"'\n", stash, sv)); diff --git a/pp_pack.c b/pp_pack.c index 3aa7a73f50e5..7e3b298bb734 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -32,7 +32,7 @@ #define PERL_IN_PP_PACK_C #include "perl.h" -/* Types used by pack/unpack */ +/* Types used by pack/unpack */ typedef enum { e_no_len, /* no length */ e_number, /* number, [] */ @@ -46,7 +46,7 @@ typedef struct tempsym { const char* grpend; /* end of ()-group */ I32 code; /* template code (!<>) */ I32 length; /* length/repeat count */ - howlen_t howlen; /* how length is given */ + howlen_t howlen; /* how length is given */ int level; /* () nesting level */ U32 flags; /* /=4, comma=2, pack=1 */ /* and group modifiers */ diff --git a/pp_sort.c b/pp_sort.c index 0fe0411347f2..a15d98076578 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -271,7 +271,7 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp) * * By contrast, consider how the original mergesort algorithm worked. * Suppose we have five runs (each typically of length 2 after dynprep). - * + * * pass base aux * 0 1 2 3 4 5 * 1 12 34 5 @@ -305,7 +305,7 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp) * } * mgsort2(0, $runs, $base, $aux, $base); * - * For our 5 runs, the tree of calls looks like + * For our 5 runs, the tree of calls looks like * * 5 * 3 2 @@ -1700,7 +1700,7 @@ PP(pp_sort) } } cx->cx_type |= CXp_MULTICALL; - + start = p1 - max; sortsvp(aTHX_ start, max, (is_xsub ? S_sortcv_xsub : hasargs ? S_sortcv_stacked : S_sortcv), @@ -1778,7 +1778,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b) PMOP * const pm = PL_curpm; OP * const sortop = PL_op; COP * const cop = PL_curcop; - + PERL_ARGS_ASSERT_SORTCV; GvSV(PL_firstgv) = a; diff --git a/pp_sys.c b/pp_sys.c index 9f971773f4be..9d56e6619d0e 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2698,7 +2698,7 @@ PP(pp_getpeername) if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET && !memcmp(SvPVX_const(sv) + sizeof(u_short), nowhere, sizeof(u_short) + sizeof(struct in_addr))) { - goto nuts2; + goto nuts2; } } #endif @@ -2764,8 +2764,8 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + PL_laststatval = + PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); havefp = TRUE; } else if (IoDIRP(io)) { PL_laststatval = @@ -2784,13 +2784,13 @@ PP(pp_stat) } } else { - if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { io = MUTABLE_IO(SvRV(sv)); if (PL_op->op_type == OP_LSTAT) goto do_fstat_warning_check; - goto do_fstat_have_io; + goto do_fstat_have_io; } - + SvTAINTED_off(PL_statname); /* previous tainting irrelevant */ sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); PL_statgv = NULL; @@ -2833,7 +2833,7 @@ PP(pp_stat) #endif mPUSHu(PL_statcache.st_mode); mPUSHu(PL_statcache.st_nlink); - + sv_setuid(PUSHmortal, PL_statcache.st_uid); sv_setgid(PUSHmortal, PL_statcache.st_gid); @@ -3492,7 +3492,7 @@ PP(pp_chdir) DIE(aTHX_ PL_no_func, "fchdir"); #endif } - else + else PUSHi( PerlDir_chdir(tmps) >= 0 ); #ifdef VMS /* Clear the DEFAULT element of ENV so we'll get the new value diff --git a/regcomp.h b/regcomp.h index 3bb1a533f69c..c004913c289f 100644 --- a/regcomp.h +++ b/regcomp.h @@ -116,7 +116,7 @@ regnode program[1]; /* Unwarranted chumminess with compiler. */ } regexp_internal; -#define RXi_SET(x,y) (x)->pprivate = (void*)(y) +#define RXi_SET(x,y) (x)->pprivate = (void*)(y) #define RXi_GET(x) ((regexp_internal *)((x)->pprivate)) #define RXi_GET_DECL(r,ri) regexp_internal *ri = RXi_GET(r) /* @@ -157,7 +157,7 @@ struct regnode_string { char string[1]; }; -/* Argument bearing node - workhorse, +/* Argument bearing node - workhorse, arg1 is often for the data field */ struct regnode_1 { U8 flags; @@ -597,11 +597,11 @@ START_EXTERN_C #ifndef DOINIT EXTCONST regexp_engine PL_core_reg_engine; #else /* DOINIT */ -EXTCONST regexp_engine PL_core_reg_engine = { +EXTCONST regexp_engine PL_core_reg_engine = { Perl_re_compile, Perl_regexec_flags, Perl_re_intuit_start, - Perl_re_intuit_string, + Perl_re_intuit_string, Perl_regfree_internal, Perl_reg_numbered_buff_fetch, Perl_reg_numbered_buff_store, @@ -609,9 +609,9 @@ EXTCONST regexp_engine PL_core_reg_engine = { Perl_reg_named_buff, Perl_reg_named_buff_iter, Perl_reg_qr_package, -#if defined(USE_ITHREADS) +#if defined(USE_ITHREADS) Perl_regdupe_internal, -#endif +#endif Perl_re_op_compile }; #endif /* DOINIT */ @@ -729,7 +729,7 @@ struct _reg_trie_data { reg_trie_state *states; /* state data */ reg_trie_trans *trans; /* array of transition elements */ char *bitmap; /* stclass bitmap */ - U16 *jump; /* optional 1 indexed array of offsets before tail + U16 *jump; /* optional 1 indexed array of offsets before tail for the node following a given word. */ reg_trie_wordinfo *wordinfo; /* array of info per word */ U16 uniquecharcount; /* unique chars in trie (width of trans table) */ @@ -737,7 +737,7 @@ struct _reg_trie_data { STRLEN minlen; /* minimum length of words in trie - build/opt only? */ STRLEN maxlen; /* maximum length of words in trie - build/opt only? */ U32 prefixlen; /* #chars in common prefix */ - U32 statecount; /* Build only - number of states in the states array + U32 statecount; /* Build only - number of states in the states array (including the unused zero state) */ U32 wordcount; /* Build only */ #ifdef DEBUGGING @@ -808,7 +808,7 @@ The three groups are: Compile, Execute, Extra. There is room for a further group, as currently only the low three bytes are used. Compile Options: - + PARSE PEEP TRIE @@ -953,7 +953,7 @@ re.pm, especially to the documentation. #define RE_SV_DUMPLEN(ItEm) (SvCUR(ItEm) - (SvTAIL(ItEm)!=0)) #define RE_SV_TAIL(ItEm) (SvTAIL(ItEm) ? "$" : "") - + #else /* if not DEBUGGING */ #define GET_RE_DEBUG_FLAGS_DECL diff --git a/regen/reentr.pl b/regen/reentr.pl index e4cbde3bf284..e7b27179b4a1 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# +# # Regenerate (overwriting only if changed): # # reentr.h @@ -29,7 +29,7 @@ BEGIN my %map = ( V => "void", A => "char*", # as an input argument - B => "char*", # as an output argument + B => "char*", # as an output argument C => "const char*", # as a read-only input argument I => "int", L => "long", @@ -81,7 +81,7 @@ sub open_print_header { #endif #ifdef USE_REENTRANT_API - + /* Deprecations: some platforms have the said reentrant interfaces * but they are declared obsolete and are not to be used. Often this * means that the platform has threadsafed the interfaces (hopefully). @@ -115,7 +115,7 @@ sub open_print_header { # define REENTR_MEMZERO(a,b) memzero(a,b) #else # define REENTR_MEMZERO(a,b) 0 -#endif +#endif #ifdef NETDB_R_OBSOLETE # undef HAS_ENDHOSTENT_R @@ -322,7 +322,7 @@ sub open_print_header { esac EOF - close(U); + close(U); } } @@ -545,7 +545,7 @@ sub define { PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # endif # endif -# endif +# endif EOF pushinitfree $genfunc; pushssif $endif; @@ -574,7 +574,7 @@ sub define { push @struct, <flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \ else rn += NEXT_OFF(rn); \ } \ -} STMT_END +} STMT_END /* These constants are for finding GCB=LV and GCB=LVT in the CLUMP regnode. * These are for the pre-composed Hangul syllables, which are all in a @@ -311,7 +311,7 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) (long)parenfloor); SSGROW(total_elems + REGCP_FRAME_ELEMS); - + DEBUG_BUFFERS_r( if ((int)maxopenparen > (int)parenfloor) PerlIO_printf(Perl_debug_log, @@ -799,7 +799,7 @@ Perl_re_intuit_start(pTHX_ /* Substring at constant offset from beg-of-str... */ SSize_t slen = SvCUR(check); char *s = HOP3c(strpos, prog->check_offset_min, strend); - + DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " Looking for check substr at fixed offset %"IVdf"...\n", (IV)prog->check_offset_min)); @@ -844,7 +844,7 @@ Perl_re_intuit_start(pTHX_ #endif restart: - + /* This is the (re)entry point of the main loop in this function. * The goal of this loop is to: * 1) find the "check" substring in the region rx_origin..strend @@ -885,7 +885,7 @@ Perl_re_intuit_start(pTHX_ (IV)end_shift, (IV)prog->check_end_shift); }); - + if (prog->intflags & PREGf_CANY_SEEN) { start_point= (U8*)(rx_origin + start_shift); end_point= (U8*)(strend - end_shift); @@ -930,7 +930,7 @@ Perl_re_intuit_start(pTHX_ DEBUG_OPTIMISE_MORE_r({ PerlIO_printf(Perl_debug_log, " fbm_instr len=%d str=<%.*s>\n", (int)(end_point - start_point), - (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point), + (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point), start_point); }); @@ -1274,9 +1274,9 @@ Perl_re_intuit_start(pTHX_ rx_max_float = HOP3c(check_at, -start_shift, strbeg); endpos= HOP3c(rx_max_float, cl_l, strend); } - else + else endpos= strend; - + DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " looking for class: start_shift: %"IVdf" check_at: %"IVdf " rx_origin: %"IVdf" endpos: %"IVdf"\n", @@ -1566,7 +1566,7 @@ if ((reginfo->intuit || regtry(reginfo, &s))) \ else { \ REXEC_FBC_CLASS_SCAN(CoNd); \ } - + #define DUMP_EXEC_POS(li,s,doutf8) \ dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \ startpos, doutf8) @@ -1658,7 +1658,7 @@ if ((reginfo->intuit || regtry(reginfo, &s))) \ in regmatch. /grrr */ STATIC char * -S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, +S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char *strend, regmatch_info *reginfo) { dVAR; @@ -2572,13 +2572,13 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, } multiline = prog->extflags & RXf_PMf_MULTILINE; - + if (strend - s < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too short [regexec_flags]...\n")); goto phooey; } - + /* Check validity of program. */ if (UCHARAT(progi->program) != REG_MAGIC) { Perl_croak(aTHX_ "corrupted regexp program"); @@ -2864,7 +2864,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, back_max = prog->float_max_offset; back_min = prog->float_min_offset; } - + if (back_min<0) { last = strend; } else { @@ -2923,7 +2923,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, ((must == prog->anchored_substr || must == prog->anchored_utf8) ? "anchored" : "floating"), quoted, RE_SV_TAIL(must)); - }); + }); goto phooey; } else if ( (c = progi->regstclass) ) { @@ -3100,7 +3100,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, LEAVE_SCOPE(oldsave); - if (RXp_PAREN_NAMES(prog)) + if (RXp_PAREN_NAMES(prog)) (void)hv_iterinit(RXp_PAREN_NAMES(prog)); RX_MATCH_UTF8_set(rx, utf8_target); @@ -3211,7 +3211,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp) #define sayNO goto no #define sayNO_SILENT goto no_silent -/* we dont use STMT_START/END here because it leads to +/* we dont use STMT_START/END here because it leads to "unreachable code" warnings, which are bogus, but distracting. */ #define CACHEsayNO \ if (ST.cache_mask) \ @@ -3219,7 +3219,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp) sayNO /* this is used to determine how far from the left messages like - 'failed...' are printed. It should be set such that messages + 'failed...' are printed. It should be set such that messages are inline with the regop output that created them. */ #define REPORT_CODE_OFF 32 @@ -3391,7 +3391,7 @@ end of the pattern, rather than at X in the following: The only exceptions to this are lookahead/behind assertions and the cut, (?>A), which pop all the backtrack states associated with A before continuing. - + Backtrack state structs are allocated in slabs of about 4K in size. PL_regmatch_state and st always point to the currently active state, and PL_regmatch_slab points to the slab currently containing @@ -3401,7 +3401,7 @@ is full, a new one is allocated and chained to the end. At exit from regmatch(), slabs allocated since entry are freed. */ - + #define DEBUG_STATE_pp(pp) \ DEBUG_STATE_r({ \ @@ -3430,33 +3430,33 @@ S_debug_start_match(pTHX_ const REGEXP *prog, const bool utf8_target, PERL_ARGS_ASSERT_DEBUG_START_MATCH; - if (!PL_colorset) - reginitcolors(); + if (!PL_colorset) + reginitcolors(); { - RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), - RX_PRECOMP_const(prog), RX_PRELEN(prog), 60); - + RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), + RX_PRECOMP_const(prog), RX_PRELEN(prog), 60); + RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1), - start, end - start, 60); - - PerlIO_printf(Perl_debug_log, - "%s%s REx%s %s against %s\n", - PL_colors[4], blurb, PL_colors[5], s0, s1); - + start, end - start, 60); + + PerlIO_printf(Perl_debug_log, + "%s%s REx%s %s against %s\n", + PL_colors[4], blurb, PL_colors[5], s0, s1); + if (utf8_target||utf8_pat) PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n", utf8_pat ? "pattern" : "", utf8_pat && utf8_target ? " and " : "", utf8_target ? "string" : "" - ); + ); } } STATIC void -S_dump_exec_pos(pTHX_ const char *locinput, - const regnode *scan, - const char *loc_regeol, - const char *loc_bostr, +S_dump_exec_pos(pTHX_ const char *locinput, + const regnode *scan, + const char *loc_regeol, + const char *loc_bostr, const char *loc_reg_starttry, const bool utf8_target) { @@ -3492,11 +3492,11 @@ S_dump_exec_pos(pTHX_ const char *locinput, RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0), (locinput - pref_len),pref0_len, 60, 4, 5); - + RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1), (locinput - pref_len + pref0_len), pref_len - pref0_len, 60, 2, 3); - + RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2), locinput, loc_regeol - locinput, 10, 0, 1); @@ -3516,7 +3516,7 @@ S_dump_exec_pos(pTHX_ const char *locinput, #endif /* reg_check_named_buff_matched() - * Checks to see if a named buffer has matched. The data array of + * Checks to see if a named buffer has matched. The data array of * buffer numbers corresponding to the buffer is expected to reside * in the regexp->data->data array in the slot stored in the ARG() of * node involved. Note that this routine doesn't actually care about the @@ -3892,7 +3892,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) 3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH; regmatch_state *yes_state = NULL; /* state to pop to on success of subpattern */ - /* mark_state piggy backs on the yes_state logic so that when we unwind + /* mark_state piggy backs on the yes_state logic so that when we unwind the stack on success we can update the mark_state as we go */ regmatch_state *mark_state = NULL; /* last mark state we have seen */ regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */ @@ -3903,10 +3903,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) char *startpoint = locinput; SV *popmark = NULL; /* are we looking for a mark? */ SV *sv_commit = NULL; /* last mark name seen in failure */ - SV *sv_yes_mark = NULL; /* last mark name we have seen + SV *sv_yes_mark = NULL; /* last mark name we have seen during a successful match */ U32 lastopen = 0; /* last open we saw */ - bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0; + bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0; SV* const oreplsv = GvSVn(PL_replgv); /* these three flags are set by various ops to signal information to * the very next op. They have a useful lifetime of exactly one loop @@ -3966,12 +3966,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) regnode *rnext=regnext(scan); DUMP_EXEC_POS( locinput, scan, utf8_target ); regprop(rex, prop, scan, reginfo); - + PerlIO_printf(Perl_debug_log, "%3"IVdf":%*s%s(%"IVdf")\n", (IV)(scan - rexi->program), depth*2, "", SvPVX_const(prop), - (PL_regkind[OP(scan)] == END || !rnext) ? + (PL_regkind[OP(scan)] == END || !rnext) ? 0 : (IV)(rnext - rexi->program)); }); @@ -4058,7 +4058,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) #define ST st->u.trie case TRIEC: /* (ab|cd) with known charclass */ /* In this case the charclass data is available inline so - we can fail fast without a lot of extra overhead. + we can fail fast without a lot of extra overhead. */ if(!NEXTCHR_IS_EOS && !ANYOF_BITMAP_TEST(scan, nextchr)) { DEBUG_EXECUTE_r( @@ -4146,7 +4146,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } } - { + { U8 *uc = ( U8* )locinput; STRLEN len = 0; @@ -4267,7 +4267,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) DEBUG_EXECUTE_r({ PerlIO_printf( Perl_debug_log, "%*s %sTRIE failed...%s\n", - REPORT_CODE_OFF+depth*2, "", + REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5] ); }); @@ -4359,7 +4359,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) DEBUG_EXECUTE_r({ PerlIO_printf( Perl_debug_log, "%*s %sTRIE matched word #%d, continuing%s\n", - REPORT_CODE_OFF+depth*2, "", + REPORT_CODE_OFF+depth*2, "", PL_colors[4], ST.nextword, PL_colors[5] @@ -4385,7 +4385,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0, PL_colors[0], PL_colors[1], (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)|PERL_PV_ESCAPE_NONASCII - ) + ) : "not compiled under -Dr", PL_colors[5] ); }); @@ -5019,7 +5019,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (locinput > reginfo->strend) sayNO; } break; - + case NREFFL: /* /\g{name}/il */ { /* The capture buffer cases. The ones beginning with N for the named buffers just convert to the equivalent numbered and @@ -5175,10 +5175,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) case GOSTART: /* (?R) */ case GOSUB: /* /(...(?1))/ /(...(?&foo))/ */ if (cur_eval && cur_eval->locinput==locinput) { - if (cur_eval->u.eval.close_paren == (U32)ARG(scan)) + if (cur_eval->u.eval.close_paren == (U32)ARG(scan)) Perl_croak(aTHX_ "Infinite recursion in regex"); if ( ++nochange_depth > max_nochange_depth ) - Perl_croak(aTHX_ + Perl_croak(aTHX_ "Pattern subroutine nesting without pos change" " exceeded limit in regex"); } else { @@ -5204,13 +5204,13 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) assert(0); /* NOTREACHED */ - case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */ + case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */ if (cur_eval && cur_eval->locinput==locinput) { if ( ++nochange_depth > max_nochange_depth ) Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex"); } else { nochange_depth = 0; - } + } { /* execute the code in the {...} */ @@ -5308,7 +5308,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } nop = nop->op_next; - DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, + DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, " re EVAL PL_op=0x%"UVxf"\n", PTR2UV(nop)) ); rex->offs[0].end = locinput - reginfo->strbeg; @@ -5444,7 +5444,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) DEBUG_EXECUTE_r( debug_start_match(re_sv, utf8_target, locinput, reginfo->strend, "Matching embedded"); - ); + ); startpoint = rei->program + 1; ST.close_paren = 0; /* only used for GOSUB */ /* Save all the seen positions so far. */ @@ -5517,7 +5517,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv)); SET_reg_curpm(rex_sv); rex = ReANY(rex_sv); - rexi = RXi_GET(rex); + rexi = RXi_GET(rex); REGCP_UNWIND(ST.lastcp); regcppop(rex, &maxopenparen); @@ -5567,15 +5567,15 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) rex->lastcloseparen = n; if (cur_eval && cur_eval->u.eval.close_paren == n) { goto fake_end; - } + } break; case ACCEPT: /* (*ACCEPT) */ if (ARG(scan)){ regnode *cursor; for (cursor=scan; - cursor && OP(cursor)!=END; - cursor=regnext(cursor)) + cursor && OP(cursor)!=END; + cursor=regnext(cursor)) { if ( OP(cursor)==CLOSE ){ n = ARG(cursor); @@ -5592,7 +5592,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } } goto fake_end; - /*NOTREACHED*/ + /*NOTREACHED*/ case GROUPP: /* (?(1)) */ n = ARG(scan); /* which paren pair */ @@ -5695,19 +5695,19 @@ I and O refer to inner and outer, C and W refer to CURLYX and WHILEM: cur_ curlyx backtrack stack ------ --------------- -NULL +NULL CO -CI ai -CO ai bi +CI ai +CO ai bi NULL ai bi bo At this point the pattern succeeds, and we work back down the stack to clean up, restoring as we go: -CO ai bi -CI ai +CO ai bi +CI ai CO -NULL +NULL *******************************************************************/ @@ -5717,7 +5717,7 @@ NULL { /* No need to save/restore up to this paren */ I32 parenfloor = scan->flags; - + assert(next); /* keep Coverity happy */ if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */ next += ARG(next); @@ -5773,7 +5773,7 @@ NULL ST.save_lastloc = cur_curlyx->u.curlyx.lastloc; ST.cache_offset = 0; ST.cache_mask = 0; - + DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "%*s whilem: matched %ld out of %d..%d\n", @@ -6037,7 +6037,7 @@ NULL no_final = 1; if (st->u.mark.mark_name) sv_commit = st->u.mark.mark_name; - sayNO; + sayNO; assert(0); /* NOTREACHED */ case BRANCH_next: @@ -6057,7 +6057,7 @@ NULL DEBUG_EXECUTE_r({ PerlIO_printf( Perl_debug_log, "%*s %sBRANCH failed...%s\n", - REPORT_CODE_OFF+depth*2, "", + REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5] ); }); @@ -6065,7 +6065,7 @@ NULL } continue; /* execute next BRANCH[J] op */ assert(0); /* NOTREACHED */ - + case MINMOD: /* next op will be non-greedy, e.g. A*? */ minmod = 1; break; @@ -6134,10 +6134,10 @@ NULL (IV) ST.count, (IV)ST.alen) ); - if (cur_eval && cur_eval->u.eval.close_paren && - cur_eval->u.eval.close_paren == (U32)ST.me->flags) + if (cur_eval && cur_eval->u.eval.close_paren && + cur_eval->u.eval.close_paren == (U32)ST.me->flags) goto fake_end; - + { I32 max = (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)); if ( max == REG_INFTY || ST.count < max ) @@ -6148,7 +6148,7 @@ NULL case CURLYM_A_fail: /* just failed to match an A */ REGCP_UNWIND(ST.cp); - if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ + if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ || (cur_eval && cur_eval->u.eval.close_paren && cur_eval->u.eval.close_paren == (U32)ST.me->flags)) sayNO; @@ -6162,13 +6162,13 @@ NULL regnode *text_node = ST.B; if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); - /* this used to be - + /* this used to be + (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT) - + But the former is redundant in light of the latter. - - if this changes back then the macro for + + if this changes back then the macro for IS_TEXT and friends need to change. */ if (PL_regkind[OP(text_node)] == EXACT) { @@ -6233,15 +6233,15 @@ NULL else rex->offs[paren].end = -1; if (cur_eval && cur_eval->u.eval.close_paren && - cur_eval->u.eval.close_paren == (U32)ST.me->flags) + cur_eval->u.eval.close_paren == (U32)ST.me->flags) { - if (ST.count) + if (ST.count) goto fake_end; else sayNO; } } - + PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */ assert(0); /* NOTREACHED */ @@ -6332,7 +6332,7 @@ NULL else { regnode *text_node = next; - if (! HAS_TEXT(text_node)) + if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); if (! HAS_TEXT(text_node)) @@ -6342,12 +6342,12 @@ NULL ST.c1 = ST.c2 = CHRTEST_VOID; } else { - - /* Currently we only get here when - + + /* Currently we only get here when + PL_rekind[OP(text_node)] == EXACT - - if this changes back then the macro for IS_TEXT and + + if this changes back then the macro for IS_TEXT and friends need to change. */ if (! S_setup_EXACTISH_ST_c1_c2(aTHX_ text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8, @@ -6491,7 +6491,7 @@ NULL assert(n == REG_INFTY || locinput == li); } CURLY_SETPAREN(ST.paren, ST.count); - if (cur_eval && cur_eval->u.eval.close_paren && + if (cur_eval && cur_eval->u.eval.close_paren && cur_eval->u.eval.close_paren == (U32)ST.paren) { goto fake_end; } @@ -6623,7 +6623,7 @@ NULL (long)(locinput - startpos), (long)(reginfo->till - startpos), PL_colors[5])); - + sayNO_SILENT; /* Cannot match: too short. */ } sayYES; /* Success! */ @@ -6644,7 +6644,7 @@ NULL case SUSPEND: /* (?>A) */ ST.wanted = 1; newstart = locinput; - goto do_ifmatch; + goto do_ifmatch; case UNLESSM: /* -ve lookaround: (?!A), or with flags, (?u.mark case MARKPOINT: /* (*MARK:foo) */ ST.prev_mark = mark_state; - ST.mark_name = sv_commit = sv_yes_mark + ST.mark_name = sv_commit = sv_yes_mark = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); mark_state = st; ST.mark_loc = locinput; @@ -6746,7 +6746,7 @@ NULL assert(0); /* NOTREACHED */ case MARKPOINT_next_fail: - if (popmark && sv_eq(ST.mark_name,popmark)) + if (popmark && sv_eq(ST.mark_name,popmark)) { if (ST.mark_loc > startpoint) reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1); @@ -6756,12 +6756,12 @@ NULL DEBUG_EXECUTE_r({ PerlIO_printf(Perl_debug_log, "%*s %ssetting cutpoint to mark:%"SVf"...%s\n", - REPORT_CODE_OFF+depth*2, "", + REPORT_CODE_OFF+depth*2, "", PL_colors[4], SVfARG(sv_commit), PL_colors[5]); }); } mark_state = ST.prev_mark; - sv_yes_mark = mark_state ? + sv_yes_mark = mark_state ? mark_state->u.mark.mark_name : NULL; sayNO; assert(0); /* NOTREACHED */ @@ -6773,41 +6773,41 @@ NULL ST.mark_loc = locinput; PUSH_STATE_GOTO(SKIP_next,next, locinput); } else { - /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was, - otherwise do nothing. Meaning we need to scan + /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was, + otherwise do nothing. Meaning we need to scan */ regmatch_state *cur = mark_state; SV *find = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); - + while (cur) { - if ( sv_eq( cur->u.mark.mark_name, - find ) ) + if ( sv_eq( cur->u.mark.mark_name, + find ) ) { ST.mark_name = find; PUSH_STATE_GOTO( SKIP_next, next, locinput); } cur = cur->u.mark.prev_mark; } - } + } /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */ - break; + break; case SKIP_next_fail: if (ST.mark_name) { - /* (*CUT:NAME) - Set up to search for the name as we + /* (*CUT:NAME) - Set up to search for the name as we collapse the stack*/ - popmark = ST.mark_name; + popmark = ST.mark_name; } else { /* (*CUT) - No name, we cut here.*/ if (ST.mark_loc > startpoint) reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1); /* but we set sv_commit to latest mark_name if there is one so they can test to see how things lead to this - cut */ - if (mark_state) - sv_commit=mark_state->u.mark.mark_name; - } - no_final = 1; + cut */ + if (mark_state) + sv_commit=mark_state->u.mark.mark_name; + } + no_final = 1; sayNO; assert(0); /* NOTREACHED */ #undef ST @@ -6837,8 +6837,8 @@ NULL else locinput++; break; - - } /* end switch */ + + } /* end switch */ /* switch break jumps here */ scan = next; /* prepare to execute the next op and ... */ @@ -6873,12 +6873,12 @@ NULL if (curyes == cur) curyes = cur->u.yes.prev_yes_state; } - } else + } else DEBUG_STATE_pp("push") ); depth++; st->locinput = locinput; - newst = st+1; + newst = st+1; if (newst > SLAB_LAST(PL_regmatch_slab)) newst = S_push_slab(aTHX); PL_regmatch_state = newst; @@ -6912,7 +6912,7 @@ NULL } DEBUG_STATE_r({ if (no_final) { - DEBUG_STATE_pp("pop (no final)"); + DEBUG_STATE_pp("pop (no final)"); } else { DEBUG_STATE_pp("pop (yes)"); } @@ -6933,7 +6933,7 @@ NULL st = yes_state; yes_state = st->u.yes.prev_yes_state; PL_regmatch_state = st; - + if (no_final) locinput= st->locinput; state_num = st->resume_state + no_final; @@ -6963,7 +6963,7 @@ NULL DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "%*s %sfailed...%s\n", - REPORT_CODE_OFF+depth*2, "", + REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]) ); @@ -6974,7 +6974,7 @@ NULL } else { goto final_exit; } - } + } if (depth) { /* there's a previous state to backtrack to */ st--; @@ -7001,10 +7001,10 @@ NULL SV *sv_mrk = get_sv("REGMARK", 1); if (result) { sv_commit = &PL_sv_no; - if (!sv_yes_mark) + if (!sv_yes_mark) sv_yes_mark = &PL_sv_yes; } else { - if (!sv_commit) + if (!sv_commit) sv_commit = &PL_sv_yes; sv_yes_mark = &PL_sv_no; } @@ -7604,7 +7604,7 @@ Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog, AV * const av = MUTABLE_AV(SvRV(rv)); SV **const ary = AvARRAY(av); U8 swash_init_flags = _CORE_SWASH_INIT_ACCEPT_INVLIST; - + si = *ary; /* ary[0] = the string to initialize the swash with */ /* Elements 3 and 4 are either both present or both absent. [3] is @@ -7651,7 +7651,7 @@ Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog, } } } - + /* If requested, return a printable version of what this swash matches */ if (listsvp) { SV* matches_string = newSVpvn("", 0); @@ -7681,7 +7681,7 @@ Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog, /* - reginclass - determine if a character falls into a character class - + n is the ANYOF regnode p is the target string p_end points to one byte beyond the end of the target string diff --git a/regexp.h b/regexp.h index d32e669a4ccd..d0dafaf7777a 100644 --- a/regexp.h +++ b/regexp.h @@ -646,7 +646,7 @@ typedef struct { bool is_utf8_target; /* string being matched is utf8 */ bool warned; /* we have issued a recursion warning; no need for more */ } regmatch_info; - + /* structures for holding and saving the state maintained by regmatch() */ @@ -701,16 +701,16 @@ typedef struct regmatch_state { U32 lastparen; U32 lastcloseparen; CHECKPOINT cp; - + } branchlike; - + struct { /* the first elements must match u.branchlike */ struct regmatch_state *prev_yes_state; U32 lastparen; U32 lastcloseparen; CHECKPOINT cp; - + regnode *next_branch; /* next branch node */ } branch; @@ -752,7 +752,7 @@ typedef struct regmatch_state { I32 logical; /* saved copy of 'logical' var */ regnode *me; /* the IFMATCH/SUSPEND/UNLESSM node */ } ifmatch; /* and SUSPEND/UNLESSM */ - + struct { /* this first element must match u.yes */ struct regmatch_state *prev_yes_state; @@ -760,7 +760,7 @@ typedef struct regmatch_state { SV* mark_name; char *mark_loc; } mark; - + struct { int val; } keeper; @@ -830,7 +830,7 @@ typedef struct regmatch_state { /* how many regmatch_state structs to allocate as a single slab. * We do it in 4K blocks for efficiency. The "3" is 2 for the next/prev * pointers, plus 1 for any mythical malloc overhead. */ - + #define PERL_REGMATCH_SLAB_SLOTS \ ((4096 - 3 * sizeof (void*)) / sizeof(regmatch_state)) diff --git a/sv.c b/sv.c index 85f91f1d42b0..ac60e746495c 100644 --- a/sv.c +++ b/sv.c @@ -937,7 +937,7 @@ static const struct body_details bodies_by_type[] = { { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVGV)) }, - + { sizeof(XPVLV), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVLV)) }, @@ -1055,11 +1055,11 @@ Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size, curr = aroot->curr++; adesc = &(aroot->set[curr]); assert(!adesc->arena); - + Newx(adesc->arena, good_arena_size, char); adesc->size = good_arena_size; adesc->utype = sv_type; - DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n", + DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n", curr, (void*)adesc->arena, (UV)good_arena_size)); start = (char *) adesc->arena; @@ -1288,7 +1288,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) case SVt_PVAV: assert(new_type_details->body_size); -#ifndef PURIFY +#ifndef PURIFY assert(new_type_details->arena); assert(new_type_details->arena_size); /* This points to the start of the allocated area. */ @@ -1382,7 +1382,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) length -= difference; } assert (length >= 0); - + Copy((char *)old_body + offset, (char *)new_body + offset, length, char); } @@ -1461,7 +1461,7 @@ Perl_sv_backoff(pTHX_ SV *const sv) assert(SvTYPE(sv) != SVt_PVAV); SvOOK_offset(sv, delta); - + SvLEN_set(sv, SvLEN(sv) + delta); SvPV_set(sv, SvPVX(sv) - delta); Move(s, SvPVX(sv), SvCUR(sv)+1, char); @@ -1742,7 +1742,7 @@ S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) { const char * const limit = tmpbuf + tmpbuf_size - 8; /* each *s can expand to 4 chars + "...\0", i.e. need room for 8 chars */ - + const char *s = SvPVX_const(sv); const char * const end = s + SvCUR(sv); for ( ; s < end && d < limit; s++ ) { @@ -2120,7 +2120,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv) (eg 123.456 can shortcut to the IV 123 with atol(), but we must be careful to ensure that the value with the .456 is around if the NV value is requested in the future). - + This means that if we cache such an IV/a UV, we need to cache the NV as well. Moreover, we trade speed for space, and do not cache the NV if we are sure it's not needed. @@ -2177,7 +2177,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv) /* For !NV_PRESERVES_UV and IS_NUMBER_IN_UV and IS_NUMBER_NOT_INT we will be in the previous block to set the IV slot, and the next block to set the NV slot. So no else here. */ - + if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) != IS_NUMBER_IN_UV) { /* It wasn't an (integer that doesn't overflow the UV). */ @@ -2415,7 +2415,7 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags) if (SvVALID(sv) || isREGEXP(sv)) { /* FBMs use the space for SvIVX and SvNVX for other purposes, and use - the same flag bit as SVf_IVisUV, so must not let them cache IVs. + the same flag bit as SVf_IVisUV, so must not let them cache IVs. Regexps have no SvIVX and SvNVX fields. */ assert(isREGEXP(sv) || SvPOKp(sv)); { @@ -2834,17 +2834,17 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent); assert(re); - + /* If the regex is UTF-8 we want the containing scalar to have an UTF-8 flag too */ if (RX_UTF8(re)) SvUTF8_on(sv); else - SvUTF8_off(sv); + SvUTF8_off(sv); if (lp) *lp = RX_WRAPLEN(re); - + return RX_WRAPPED(re); } else { const char *const typestr = sv_reftype(referent, 0); @@ -3013,7 +3013,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) { const STRLEN len = s - SvPVX_const(sv); - if (lp) + if (lp) *lp = len; SvCUR_set(sv, len); } @@ -3312,7 +3312,7 @@ Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extr U8 * e = (U8 *) SvEND(sv); U8 *t = s; STRLEN two_byte_count = 0; - + if (flags & SV_FORCE_UTF8_UPGRADE) goto must_be_utf8; /* See if really will need to convert to utf8. We mustn't rely on our @@ -4347,7 +4347,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) * 1. Swipe * 2. Copy-on-write * 3. Actual copy - * + * * Which we choose is based on various factors. The following * things are listed in order of speed, fastest to slowest: * - Swipe @@ -4355,31 +4355,31 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) * - Copy-on-write bookkeeping * - malloc * - Copying a long string - * + * * We swipe the string (steal the string buffer) if the SV on the * rhs is about to be freed anyway (TEMP and refcnt==1). This is a * big win on long strings. It should be a win on short strings if - * SvPVX_const(dstr) has to be allocated. If not, it should not + * SvPVX_const(dstr) has to be allocated. If not, it should not * slow things down, as SvPVX_const(sstr) would have been freed * soon anyway. - * + * * We also steal the buffer from a PADTMP (operator target) if it * is ‘long enough’. For short strings, a swipe does not help * here, as it causes more malloc calls the next time the target * is used. Benchmarks show that even if SvPVX_const(dstr) has to * be allocated it is still not worth swiping PADTMPs for short * strings, as the savings here are small. - * + * * If the rhs is already flagged as a copy-on-write string and COW * is possible here, we use copy-on-write and make both SVs share * the string buffer. - * + * * If the rhs is not flagged as copy-on-write, then we see whether * it is worth upgrading it to such. If the lhs already has a buf- * fer big enough and the string is short, we skip it and fall back * to method 3, since memcpy is faster for short strings than the * later bookkeeping overhead that copy-on-write entails. - * + * * If there is no buffer on the left, or the buffer is too small, * then we use copy-on-write. */ @@ -4633,7 +4633,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) # ifdef PERL_OLD_COPY_ON_WRITE SV_COW_NEXT_SV_SET(dstr, sstr); # else - CowREFCNT(sstr) = 0; + CowREFCNT(sstr) = 0; # endif } # ifdef PERL_OLD_COPY_ON_WRITE @@ -4642,7 +4642,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) # ifdef PERL_DEBUG_READONLY_COW if (already) sv_buf_to_rw(sstr); # endif - CowREFCNT(sstr)++; + CowREFCNT(sstr)++; # endif new_pv = SvPVX_mutable(sstr); sv_buf_to_ro(sstr); @@ -4866,7 +4866,7 @@ Perl_sv_usepvn_flags(pTHX_ SV *const sv, char *ptr, const STRLEN len, const U32 ? len + 1 : #ifdef Perl_safesysmalloc_size len + 1; -#else +#else PERL_STRLEN_ROUNDUP(len + 1); #endif if (flags & SV_HAS_TRAILING_NUL) { @@ -4993,7 +4993,7 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags) else # endif { - + /* This SV doesn't own the buffer, so need to Newx() a new one: */ # ifdef PERL_NEW_COPY_ON_WRITE /* Must do this first, since the macro uses SvPVX. */ @@ -5304,7 +5304,7 @@ void Perl_sv_catsv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags) { dVAR; - + PERL_ARGS_ASSERT_SV_CATSV_FLAGS; if (ssv) { @@ -5437,8 +5437,8 @@ to contain an C and is stored as-is with its REFCNT incremented. =cut */ -MAGIC * -Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how, +MAGIC * +Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how, const MGVTBL *const vtable, const char *const name, const I32 namlen) { dVAR; @@ -6171,7 +6171,7 @@ Perl_sv_replace(pTHX_ SV *const sv, SV *const nsv) SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv)); } - + #ifdef PERL_OLD_COPY_ON_WRITE if (SvIsCOW_normal(nsv)) { @@ -6896,7 +6896,7 @@ Perl_sv_len_utf8_nomg(pTHX_ SV * const sv) ulen = cache[0] + Perl_utf8_length(aTHX_ s + cache[1], s + len); } - + if (PL_utf8cache < 0) { const STRLEN real = Perl_utf8_length(aTHX_ s, s + len); assert_uft8_cache_coherent("sv_len_utf8", ulen, real, sv); @@ -7224,7 +7224,7 @@ S_utf8_mg_len_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, the code that uses it doesn't need to worry if only 1 entry has actually been set to non-zero. It also makes the "position beyond the end of the cache" logic much simpler, as the first slot is always the one to start - from. + from. */ static void S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN byte, @@ -7267,7 +7267,7 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b /* Cache is held with the later position first, to simplify the code that deals with unbounded ends. */ - + ASSERT_UTF8_CACHE(cache); if (cache[1] == 0) { /* Cache is totally empty */ @@ -7617,7 +7617,7 @@ Perl_sv_eq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags) if (cur1 == cur2) eq = (pv1 == pv2) || memEQ(pv1, pv2, cur1); - + SvREFCNT_dec(svrecode); return eq; @@ -7888,7 +7888,7 @@ S_sv_gets_read_record(pTHX_ SV *const sv, PerlIO *const fp, I32 append) const STRLEN recsize = SvUV(SvRV(PL_rs)); /* RsRECORD() guarantees > 0. */ /* Grab the size of the record we're getting */ char *buffer = SvGROW(sv, (STRLEN)(recsize + append + 1)) + append; - + /* Go yank in */ #ifdef VMS #include @@ -7964,7 +7964,7 @@ S_sv_gets_read_record(pTHX_ SV *const sv, PerlIO *const fp, I32 append) */ if (charstart) readsize = recsize - charcount; - else + else readsize = skip - (bend - bufp) + recsize - charcount - 1; buffer = SvGROW(sv, append + bytesread + readsize + 1) + append; bend = buffer + bytesread; @@ -8194,7 +8194,7 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) goto cannot_be_shortbuffered; } } - + if (shortbuffered) { /* oh well, must extend */ cnt = shortbuffered; shortbuffered = 0; @@ -8417,7 +8417,7 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) else { (void)SvIOK_only(sv); SvIV_set(sv, SvIVX(sv) + 1); - } + } } return; } @@ -8458,7 +8458,7 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) so $a="9.22337203685478e+18"; $a+0; $a++ needs to be the same as $a="9.22337203685478e+18"; $a++ or we go insane. */ - + (void) sv_2iv(sv); if (SvIOK(sv)) goto oops_its_int; @@ -8591,7 +8591,7 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) else { (void)SvIOK_only_UV(sv); SvUV_set(sv, SvUVX(sv) - 1); - } + } } else { if (SvIVX(sv) == IV_MIN) { sv_setnv(sv, (NV)IV_MIN); @@ -8600,7 +8600,7 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) else { (void)SvIOK_only(sv); SvIV_set(sv, SvIVX(sv) - 1); - } + } } return; } @@ -8637,7 +8637,7 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) so $a="9.22337203685478e+18"; $a+0; $a-- needs to be the same as $a="9.22337203685478e+18"; $a-- or we go insane. */ - + (void) sv_2iv(sv); if (SvIOK(sv)) goto oops_its_int; @@ -9489,7 +9489,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) else { char *s; STRLEN len; - + if (SvTYPE(sv) > SVt_PVLV || isGV_with_GP(sv)) /* diag_listed_as: Can't coerce %s to %s in %s */ @@ -10642,7 +10642,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p \d+\$ explicit format parameter index [-+ 0#]+ flags v|\*(\d+\$)?v vector with optional (optionally specified) arg - 0 flag (as above): repeated to allow "v02" + 0 flag (as above): repeated to allow "v02" \d+|\*(\d+\$)? width using optional (optionally specified) arg \.(\d*|\*(\d+\$)?) precision using optional (optionally specified) arg [hlqLV] size @@ -10650,7 +10650,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p */ if (args) { -/* +/* As of perl5.9.3, printf format checking is on by default. Internally, perl uses %p formats to provide an escape to some extended formatting. This block deals with those @@ -10658,9 +10658,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p the normal format processing code is used. Currently defined extensions are: - %p include pointer address (standard) + %p include pointer address (standard) %-p (SVf) include an SV (previously %_) - %-p include an SV with precision + %-p include an SV with precision %2p include a HEK %3p include a HEK with precision of 256 %4p char* preceded by utf8 flag and length @@ -10671,8 +10671,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p %1p (VDf) removed. RMB 2007-10-19 */ - char* r = q; - bool sv = FALSE; + char* r = q; + bool sv = FALSE; STRLEN n = 0; if (*q == '-') sv = *q++; @@ -10711,7 +10711,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p "internal %%p might conflict with future printf extensions"); } } - q = r; + q = r; } if ( (width = expect_number(&q)) ) { @@ -10804,7 +10804,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p sv_utf8_upgrade(vecsv); dotstr = SvPV_const(vecsv, dotstrlen); is_utf8 = TRUE; - } + } } if (asterisk) { @@ -12269,7 +12269,7 @@ Perl_rvpv_dup(pTHX_ SV *const dstr, const SV *const sstr, CLONE_PARAMS *const pa } else { /* Some other special case - random pointer */ - SvPV_set(dstr, (char *) SvPVX_const(sstr)); + SvPV_set(dstr, (char *) SvPVX_const(sstr)); } } } @@ -13369,7 +13369,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_body_arenas = NULL; Zero(&PL_body_roots, 1, PL_body_roots); - + PL_sv_count = 0; PL_sv_root = NULL; PL_sv_arenaroot = NULL; @@ -13670,7 +13670,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, sv_setpvs(PERL_DEBUG_PAD(1), ""); /* ext/re needs these */ sv_setpvs(PERL_DEBUG_PAD(2), ""); /* even without DEBUGGING. */ - + /* Clone the regex array */ /* ORANGE FIXME for plugins, probably in the SV dup code. newSViv(PTR2IV(CALLREGDUPE( @@ -13989,7 +13989,7 @@ static void S_unreferenced_to_tmp_stack(pTHX_ AV *const unreferenced) { PERL_ARGS_ASSERT_UNREFERENCED_TO_TMP_STACK; - + if (AvFILLp(unreferenced) > -1) { SV **svp = AvARRAY(unreferenced); SV **const last = svp + AvFILLp(unreferenced); @@ -14820,7 +14820,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, if (!(obase->op_flags & OPf_KIDS)) break; o = cUNOPx(obase)->op_first; - + do_op2: if (!o) break; diff --git a/sv.h b/sv.h index 8760ec49e6ed..f89606dbb025 100644 --- a/sv.h +++ b/sv.h @@ -470,7 +470,7 @@ perform the upgrade if necessary. See C. union { \ STRLEN xpvlenu_len; /* allocated size */ \ char * xpvlenu_pv; /* regexp string */ \ - } xpv_len_u + } xpv_len_u #define xpv_len xpv_len_u.xpvlenu_len @@ -785,7 +785,7 @@ Returns the stash of the SV. =for apidoc Am|void|SvIV_set|SV* sv|IV val Set the value of the IV pointer in sv to val. It is possible to perform the same function of this macro with an lvalue assignment to C. -With future Perls, however, it will be more efficient to use +With future Perls, however, it will be more efficient to use C instead of the lvalue assignment to C. =for apidoc Am|void|SvNV_set|SV* sv|NV val @@ -1746,7 +1746,7 @@ Like sv_utf8_upgrade, but doesn't do magic on C. (SvPOK_byte_nog(sv) \ ? SvPVX(sv) : sv_2pvbyte(sv, 0)) - + /* define FOOx(): idempotent versions of FOO(). If possible, use a local * var to evaluate the arg once; failing that, use a global if possible; * failing that, call a function to do the work diff --git a/symbian/PerlRecog.cpp b/symbian/PerlRecog.cpp index d2db54491b67..ea2ff7f9264c 100644 --- a/symbian/PerlRecog.cpp +++ b/symbian/PerlRecog.cpp @@ -1,5 +1,5 @@ /* Copyright (c) 2004-2005 Nokia. All rights reserved. */ - + /* The PerlRecog application is licensed under the same terms as Perl itself. */ #include @@ -54,4 +54,4 @@ GLDEF_C TInt E32Dll(TDllReason /* aReason */) } - + diff --git a/symbian/PerlUi.cpp b/symbian/PerlUi.cpp index 01be136d09f6..e65c4b5dc750 100644 --- a/symbian/PerlUi.cpp +++ b/symbian/PerlUi.cpp @@ -6,7 +6,7 @@ #ifdef __SERIES60__ # include -# include +# include # include # ifndef __SERIES60_1X__ # include diff --git a/symbian/PerlUtil.cpp b/symbian/PerlUtil.cpp index b97907274998..9e9bb7259e4b 100644 --- a/symbian/PerlUtil.cpp +++ b/symbian/PerlUtil.cpp @@ -1,5 +1,5 @@ /* Copyright (c) 2004-2005 Nokia. All rights reserved. */ - + /* The PerlUtil class is licensed under the same terms as Perl itself. */ /* See PerlUtil.pod for documentation. */ diff --git a/symbian/symbian_dll.cpp b/symbian/symbian_dll.cpp index a1e61a460388..9508fa62544c 100644 --- a/symbian/symbian_dll.cpp +++ b/symbian/symbian_dll.cpp @@ -10,7 +10,7 @@ #include #include "PerlBase.h" -#ifdef __SERIES60_3X__ +#ifdef __SERIES60_3X__ EXPORT_C GLDEF_C TInt E32Dll(/*TDllReason aReason*/) { return KErrNone; } #else EXPORT_C GLDEF_C TInt E32Dll(TDllReason /*aReason*/) { return KErrNone; } diff --git a/symbian/symbian_stubs.c b/symbian/symbian_stubs.c index c997446cfd12..80aa2c23226f 100644 --- a/symbian/symbian_stubs.c +++ b/symbian/symbian_stubs.c @@ -93,7 +93,7 @@ struct protoent* getprotobyname(const char* name) { return (struct protoent*)(&(protocols[i])); return 0; } - + struct servent* getservbyname(const char* name, const char* proto) { int i; for (i = 0; i < sizeof(services)/sizeof(struct servent); i++) diff --git a/symbian/symbian_utils.cpp b/symbian/symbian_utils.cpp index 9749361ed0ef..b76b22b5e75b 100644 --- a/symbian/symbian_utils.cpp +++ b/symbian/symbian_utils.cpp @@ -171,7 +171,7 @@ extern "C" { ckerr.Copy(kerrp); cdesc.Copy(descp); buf8.Format(_L8("K%S (%d) %S"), &ckerr, error, &cdesc); - + } else { buf8.Format(_L8("Symbian error %d"), error); } @@ -224,7 +224,7 @@ extern "C" { } #define SEC_USEC_TO_CLK_TCK(s, u) \ (((s) * PERL_SYMBIAN_CLK_TCK) + (u / (1000000 / PERL_SYMBIAN_CLK_TCK))) - EXPORT_C clock_t symbian_times(struct tms *tmsbuf) + EXPORT_C clock_t symbian_times(struct tms *tmsbuf) { long s, u; if (symbian_get_cpu_time(&s, &u) == -1) { @@ -296,7 +296,7 @@ extern "C" { error = proc.Create(aFilename, func, KStackSize, -#ifdef __SERIES60_3X__ +#ifdef __SERIES60_3X__ KHeapMin, KHeapMax, (TAny*)command, @@ -306,7 +306,7 @@ extern "C" { RThread().Heap(), KHeapMin, KHeapMax, -#endif +#endif EOwnerProcess); else error = KErrNotFound; @@ -355,7 +355,7 @@ extern "C" { aFilename.Append(p[1]); p++; } - + } else aFilename.Append(*p); diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h index 18804d55ba3f..9ec4c76232c3 100644 --- a/t/lib/h2ph.h +++ b/t/lib/h2ph.h @@ -1,6 +1,6 @@ -/* +/* * Test header file for h2ph - * + * * Try to test as many constructs as possible * For example, the multi-line comment :) */ @@ -35,7 +35,7 @@ #define MIN(a,b) ((a) < (b) ? (a) : (b)) #endif /* __SOME_UNIMPORTANT_PROPERTY */ -/* +/* * Test #if, #elif, #else, #endif, #warn and #error, and '!' * Also test whitespace between the '#' and the command */ @@ -65,7 +65,7 @@ function Tru64_Pascal(n: Integer): Integer; #endif -/* +/* * Test #include, #import and #include_next * #include_next is difficult to test, it really depends on the actual * circumstances - for example, '#include_next ' on a Linux system @@ -85,7 +85,7 @@ typedef struct a_struct { long as_well; } a_typedef; -/* +/* * however, typedefs of enums and just plain enums should end up being treated * like a bunch of #defines... */ @@ -93,7 +93,7 @@ typedef struct a_struct { typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon, Tue, Wed, Thu, Fri, Sat } days_of_week; -/* +/* * Some moderate flexing of tri-graph pre substitution. */ ??=ifndef _SOMETHING_TRIGRAPHIC @@ -121,7 +121,7 @@ typdef struct empty_struct { enum { /* foo; can't - */ + */ }; enum flimflam { @@ -129,7 +129,7 @@ enum flimflam { /* foo; can't */ - flam + flam } flamflim; static __inline__ int blli_in_use(struct atm_blli blli) diff --git a/time64_config.h b/time64_config.h index 42cc12c88e42..f15796b57267 100644 --- a/time64_config.h +++ b/time64_config.h @@ -15,7 +15,7 @@ /* INT_64_T - A numeric type to store time and others. + A numeric type to store time and others. Must be defined. */ #define INT_64_T NV diff --git a/toke.c b/toke.c index 3d992f6471be..94bd64df6d9c 100644 --- a/toke.c +++ b/toke.c @@ -1904,7 +1904,7 @@ S_skipspace2(pTHX_ char *s, SV **svp) sv_free(PL_skipwhite); PL_skipwhite = 0; } - + return s; } #endif @@ -2695,7 +2695,7 @@ S_sublex_push(pTHX) if (is_heredoc) CopLINE_set(PL_curcop, (line_t)PL_multi_start); PL_copline = NOLINE; - + Newxz(shared, 1, LEXSHARED); shared->ls_prev = PL_parser->lex_shared; PL_parser->lex_shared = shared; @@ -3089,7 +3089,7 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) } (end if backslash) handle regular character } (end while character to read) - + */ STATIC char * @@ -3123,7 +3123,7 @@ S_scan_const(pTHX_ char *start) * the needed size, SvGROW() is called. Its size parameter each time is * based on the best guess estimate at the time, namely the length used so * far, plus the length the current construct will occupy, plus room for - * the trailing NUL, plus one byte for every input byte still unscanned */ + * the trailing NUL, plus one byte for every input byte still unscanned */ UV uv = UV_MAX; /* Initialize to weird value to try to catch any uses before set */ @@ -3240,7 +3240,7 @@ S_scan_const(pTHX_ char *start) else #endif *d++ = (char)i; - + #ifdef EBCDIC if (uvmax) { d = (char*)uvchr_to_utf8((U8*)d, 0x100); @@ -3483,14 +3483,14 @@ S_scan_const(pTHX_ char *start) * enough room in sv since such escapes will be longer than any * UTF-8 sequence they can end up as, except if they force us * to recode the rest of the string into utf8 */ - + /* Here uv is the ordinal of the next character being added */ if (!UVCHR_IS_INVARIANT(uv)) { if (!has_utf8 && uv > 255) { /* Might need to recode whatever we have accumulated so * far if it contains any chars variant in utf8 or * utf-ebcdic. */ - + SvCUR_set(sv, d - SvPVX_const(sv)); SvPOK_on(sv); *d = '\0'; @@ -3552,7 +3552,7 @@ S_scan_const(pTHX_ char *start) * requires braces */ s++; if (*s != '{') { - yyerror("Missing braces on \\N{}"); + yyerror("Missing braces on \\N{}"); continue; } s++; @@ -3767,7 +3767,7 @@ S_scan_const(pTHX_ char *start) } /* End \N{NAME} */ #ifdef EBCDIC - if (!dorange) + if (!dorange) native_range = FALSE; /* \N{} is defined to be Unicode */ #endif s = e + 1; /* Point to just after the '}' */ @@ -4262,7 +4262,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) STRLEN const last_lop_pos = PL_parser->last_lop ? PL_parser->last_lop - buf : 0; av_push(PL_rsfp_filters, linestr); - PL_parser->linestr = + PL_parser->linestr = newSVpvn(SvPVX(linestr), ++s-SvPVX(linestr)); buf = SvPVX(PL_parser->linestr); PL_parser->bufend = buf + SvCUR(PL_parser->linestr); @@ -4458,7 +4458,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len) return gv_stashpvn(pkgname, len, UTF ? SVf_UTF8 : 0); } -#ifdef PERL_MAD +#ifdef PERL_MAD /* * Perl_madlex * The intent of this yylex wrapper is to minimize the changes to the @@ -4584,7 +4584,7 @@ Perl_madlex(pTHX) case '}': if (PL_faketokens) break; - /* remember any fake bracket that lexer is about to discard */ + /* remember any fake bracket that lexer is about to discard */ if (PL_lex_brackets == 1 && ((expectation)PL_lex_brackstack[0] & XFAKEBRACK)) { @@ -7942,7 +7942,7 @@ Perl_yylex(pTHX) case KEY_exists: UNI(OP_EXISTS); - + case KEY_exit: if (PL_madskills) UNI(OP_INT); @@ -8186,7 +8186,7 @@ Perl_yylex(pTHX) PL_expect = XOPERATOR; s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_LAST); - + case KEY_lc: UNI(OP_LC); @@ -8369,7 +8369,7 @@ Perl_yylex(pTHX) case KEY_pos: UNIDOR(OP_POS); - + case KEY_pack: LOP(OP_PACK,XTERM); @@ -8490,7 +8490,7 @@ Perl_yylex(pTHX) orig_keyword = 0; pl_yylval.ival = 1; } - else + else pl_yylval.ival = 0; PL_expect = XTERM; PL_bufptr = s; @@ -8559,7 +8559,7 @@ Perl_yylex(pTHX) case KEY_chomp: UNI(OP_CHOMP); - + case KEY_scalar: UNI(OP_SCALAR); @@ -9226,7 +9226,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, || ! SvOK(*cvp)) { char *msg; - + /* Here haven't found what we're looking for. If it is charnames, * perhaps it needs to be loaded. Try doing that before giving up */ if (*key == 'c') { @@ -9479,7 +9479,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) if ( isCNTRL_A((U8)*s) ) { deprecate("literal control characters in variable names"); } - + if (is_utf8) { const STRLEN skip = UTF8SKIP(s); STRLEN i; @@ -9554,7 +9554,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) if (s < PL_bufend && isSPACE(*s)) { s = PEEKSPACE(s); } - + /* Expect to find a closing } after consuming any trailing whitespace. */ if (*s == '}') { @@ -9774,7 +9774,7 @@ S_scan_pat(pTHX_ char *start, I32 type) /* issue a warning if /c is specified,but /g is not */ if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)) { - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" ); } @@ -10030,7 +10030,7 @@ S_scan_heredoc(pTHX_ char *s) #ifdef PERL_MAD I32 stuffstart = s - SvPVX(PL_linestr); char *tstart; - + PL_realtokenstart = -1; #endif @@ -10506,7 +10506,7 @@ S_scan_inputsymbol(pTHX_ char *start) ($*@) sub prototypes sub foo ($) (stuff) sub attr parameters sub foo : attr(stuff) <> readline or globs , <>, <$fh>, or <*.c> - + In most of these cases (all but <>, patterns and transliterate) yylex() calls scan_str(). m// makes yylex() call scan_pat() which calls scan_str(). s/// makes yylex() call scan_subst() which calls @@ -10768,7 +10768,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse, *to = *s; } } - + /* if the terminator isn't the same as the start character (e.g., matched brackets), we have to allow more in the quoting, and be prepared for nested brackets. @@ -10873,7 +10873,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse, else if (to - SvPVX_const(sv) == 1 && to[-1] == '\r') to[-1] = '\n'; #endif - + read_more_line: /* if we're out of file, or a read fails, bail and reset the current line marker so we can report where the unterminated string began @@ -12470,7 +12470,7 @@ Perl_parse_subsignature(pTHX) !(defexpr->op_flags & OPf_KIDS)) { op_free(defexpr); } else { - OP *ifop = + OP *ifop = newBINOP(OP_GE, 0, scalar(newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv))), diff --git a/universal.c b/universal.c index bccc8fb45ae9..16fec0e04afc 100644 --- a/universal.c +++ b/universal.c @@ -59,7 +59,7 @@ S_isa_lookup(pTHX_ HV *stash, const char * const name, STRLEN len, U32 flags) return TRUE; } - /* A stash/class can go by many names (ie. User == main::User), so + /* A stash/class can go by many names (ie. User == main::User), so we use the HvENAME in the stash itself, which is canonical, falling back to HvNAME if necessary. */ our_stash = gv_stashpvn(name, len, flags); @@ -130,7 +130,7 @@ Perl_sv_derived_from(pTHX_ SV *sv, const char *const name) /* =for apidoc sv_derived_from_pv -Exactly like L, but takes a nul-terminated string +Exactly like L, but takes a nul-terminated string instead of a string/length pair. =cut @@ -640,7 +640,7 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ /* we free one ref on exit */ (SvREFCNT(sv) = SvUV(ST(1)) + 1) : SvREFCNT(sv); - XSRETURN_UV(refcnt - 1); /* Minus the ref created for us. */ + XSRETURN_UV(refcnt - 1); /* Minus the ref created for us. */ } @@ -689,7 +689,7 @@ XS(XS_PerlIO_get_layers) break; } goto fail; - case 'o': + case 'o': if (klen == 6 && memEQ(key, "output", 6)) { input = !SvTRUE(*valp); break; @@ -724,7 +724,7 @@ XS(XS_PerlIO_get_layers) SSize_t i; const SSize_t last = av_tindex(av); SSize_t nitem = 0; - + for (i = last; i >= 0; i -= 3) { SV * const * const namsvp = av_fetch(av, i - 2, FALSE); SV * const * const argsvp = av_fetch(av, i - 1, FALSE); @@ -789,7 +789,7 @@ XS(XS_PerlIO_get_layers) XS(XS_re_is_regexp); /* prototype to pass -Wmissing-prototypes */ XS(XS_re_is_regexp) { - dVAR; + dVAR; dXSARGS; PERL_UNUSED_VAR(cv); @@ -808,7 +808,7 @@ XS(XS_re_regnames_count) { REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; SV * ret; - dVAR; + dVAR; dXSARGS; if (items != 0) @@ -903,7 +903,7 @@ XS(XS_re_regnames) EXTEND(SP, length+1); /* better extend stack just once */ for (i = 0; i <= length; i++) { entry = av_fetch(av, i, FALSE); - + if (!entry) Perl_croak(aTHX_ "NULL array element in re::regnames()"); diff --git a/unixish.h b/unixish.h index c129ed18b30f..2845ef77a168 100644 --- a/unixish.h +++ b/unixish.h @@ -22,7 +22,7 @@ * available to set I/O characteristics */ #define HAS_IOCTL /**/ - + /* HAS_UTIME: * This symbol, if defined, indicates that the routine utime() is * available to update the access and modification times of files. @@ -47,7 +47,7 @@ #define HAS_WAIT #endif /* !PERL_MICRO */ - + /* USEMYBINMODE * This symbol, if defined, indicates that the program should * use the routine my_binmode(FILE *fp, char iotype) to insure @@ -71,7 +71,7 @@ #define USE_STAT_RDEV /**/ /* ACME_MESS: - * This symbol, if defined, indicates that error messages should be + * This symbol, if defined, indicates that error messages should be * should be generated in a format that allows the use of the Acme * GUI/editor's autofind feature. */ diff --git a/util.c b/util.c index 0a0ee4065479..06b9a17199ea 100644 --- a/util.c +++ b/util.c @@ -349,7 +349,7 @@ Perl_safesysfree(Malloc_t where) if (munmap(where, size)) { perror("munmap failed"); abort(); - } + } # endif } #endif @@ -1447,9 +1447,9 @@ Perl_write_to_stderr(pTHX_ SV* msv) PERL_ARGS_ASSERT_WRITE_TO_STDERR; - if (PL_stderrgv && SvREFCNT(PL_stderrgv) + if (PL_stderrgv && SvREFCNT(PL_stderrgv) && (io = GvIO(PL_stderrgv)) - && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) + && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, SV_CONST(PRINT), G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv); else { @@ -1830,7 +1830,7 @@ Perl_warn(pTHX_ const char *pat, ...) void Perl_warner_nocontext(U32 err, const char *pat, ...) { - dTHX; + dTHX; va_list args; PERL_ARGS_ASSERT_WARNER_NOCONTEXT; va_start(args, pat); @@ -1937,7 +1937,7 @@ S_ckwarn_common(pTHX_ U32 w) } else if (!unpackWARN3(w)) { assert(!unpackWARN4(w)); } - + /* Right, dealt with all the special cases, which are implemented as non- pointers, so there is a pointer to a real warnings mask. */ do { @@ -2489,7 +2489,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) filedescriptors directly, need to manually switch to the default, binary, low-level mode; see PerlIOBuf_open(). */ PerlLIO_setmode((*mode == 'r'), O_BINARY); -#endif +#endif PL_forkprocess = 0; #ifdef PERL_USES_PL_PIDSTATUS hv_clear(PL_pidstatus); /* we have no children */ @@ -4610,8 +4610,8 @@ Perl_init_global_struct(pTHX) PerlMem_malloc(ncheck * sizeof(Perl_check_t)); if (!plvarsp->Gcheck) exit(1); - Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t); - Copy(Gcheck, plvarsp->Gcheck, ncheck, Perl_check_t); + Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t); + Copy(Gcheck, plvarsp->Gcheck, ncheck, Perl_check_t); # endif # ifdef PERL_SET_VARS PERL_SET_VARS(plvarsp); @@ -4692,7 +4692,7 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) # endif static void -S_mem_log_common(enum mem_log_type mlt, const UV n, +S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *type_name, const SV *sv, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, @@ -4791,7 +4791,7 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, Malloc_t Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name, - Malloc_t newalloc, + Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname) { @@ -4803,28 +4803,28 @@ Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name, Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *type_name, - Malloc_t oldalloc, Malloc_t newalloc, - const char *filename, const int linenumber, + Malloc_t oldalloc, Malloc_t newalloc, + const char *filename, const int linenumber, const char *funcname) { mem_log_common_if(MLT_REALLOC, n, typesize, type_name, - NULL, oldalloc, newalloc, + NULL, oldalloc, newalloc, filename, linenumber, funcname); return newalloc; } Malloc_t -Perl_mem_log_free(Malloc_t oldalloc, - const char *filename, const int linenumber, +Perl_mem_log_free(Malloc_t oldalloc, + const char *filename, const int linenumber, const char *funcname) { - mem_log_common_if(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, + mem_log_common_if(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, filename, linenumber, funcname); return oldalloc; } void -Perl_mem_log_new_sv(const SV *sv, +Perl_mem_log_new_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname) { @@ -4834,10 +4834,10 @@ Perl_mem_log_new_sv(const SV *sv, void Perl_mem_log_del_sv(const SV *sv, - const char *filename, const int linenumber, + const char *filename, const int linenumber, const char *funcname) { - mem_log_common_if(MLT_DEL_SV, 0, 0, "", sv, NULL, NULL, + mem_log_common_if(MLT_DEL_SV, 0, 0, "", sv, NULL, NULL, filename, linenumber, funcname); } @@ -4895,7 +4895,7 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...) #ifdef HAS_VSNPRINTF /* vsnprintf() shows failure with >= len */ || - (len > 0 && (Size_t)retval >= len) + (len > 0 && (Size_t)retval >= len) #endif ) Perl_croak_nocontext("panic: my_snprintf buffer overflow"); @@ -4940,7 +4940,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap #ifdef HAS_VSNPRINTF /* vsnprintf() shows failure with >= len */ || - (len > 0 && (Size_t)retval >= len) + (len > 0 && (Size_t)retval >= len) #endif ) Perl_croak_nocontext("panic: my_vsnprintf buffer overflow"); @@ -4984,7 +4984,7 @@ Perl_my_clearenv(pTHX) (void)safesysfree(buf); bsiz = l + 1; /* + 1 for the \0. */ buf = (char*)safesysmalloc(bsiz); - } + } memcpy(buf, *environ, l); buf[l] = '\0'; (void)unsetenv(buf); @@ -5027,7 +5027,7 @@ Perl_my_cxt_init(pTHX_ int *index, size_t size) MUTEX_UNLOCK(&PL_my_ctx_mutex); #endif } - + /* make sure the array is big enough */ if (PL_my_cxt_size <= *index) { if (PL_my_cxt_size) { @@ -5312,7 +5312,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((const GV *)*svp) == cv) /* Use GV from the stack as a fallback. */ - && S_gv_has_usable_name(aTHX_ gv = (GV *)*svp) + && S_gv_has_usable_name(aTHX_ gv = (GV *)*svp) ) ) ) { @@ -5358,7 +5358,7 @@ Perl_my_dirfd(pTHX_ DIR * dir) { Perl_die(aTHX_ PL_no_func, "dirfd"); assert(0); /* NOT REACHED */ return 0; -#endif +#endif } REGEXP * @@ -5372,7 +5372,7 @@ Perl_get_re_arg(pTHX_ SV *sv) { if (SvTYPE(sv) == SVt_REGEXP) return (REGEXP*) sv; } - + return NULL; } @@ -5473,7 +5473,7 @@ Perl_drand48_r(perl_drand48_t *random_state) } #endif } - + /* * Local variables: diff --git a/vms/munchconfig.c b/vms/munchconfig.c index c76809a6fe83..84a10ff379fa 100644 --- a/vms/munchconfig.c +++ b/vms/munchconfig.c @@ -49,7 +49,7 @@ main(int argc, char *argv[]) { int c, i; char *ifile = NULL; - char WorkString[LINEBUFFERSIZE]; + char WorkString[LINEBUFFERSIZE]; FILE *ConfigSH, *Config_H, *Extra_Subs; char LineBuffer[LINEBUFFERSIZE], *TempValue, *StartTilde, *EndTilde; char SecondaryLineBuffer[LINEBUFFERSIZE], OutBuf[LINEBUFFERSIZE]; @@ -87,7 +87,7 @@ main(int argc, char *argv[]) printf("Error %i trying to open config.sh file %s\n", errno, argv[1]); exit(EXIT_FAILURE); } - + if (NULL == (Config_H = fopen(argv[2], "r"))) { printf("Error %i trying to open config_h.sh file %s\n", errno, argv[2]); exit(EXIT_FAILURE); @@ -173,7 +173,7 @@ main(int argc, char *argv[]) *TempValue++ = '\0'; /* And another over the leading ', which better be there */ *TempValue++ = '\0'; - + /* Check to see if there's a trailing ' or ". If not, add a newline to the buffer and grab another line. */ TempLength = strlen(TempValue); @@ -191,14 +191,14 @@ main(int argc, char *argv[]) /* Refigure the length */ TempLength = strlen(TempValue); - + /* Chop trailing control characters */ while((TempLength > 0) && (TempValue[TempLength-1] < ' ')) { TempValue[TempLength - 1] = '\0'; TempLength--; } } - + /* And finally one over the trailing ' */ TempValue[TempLength-1] = '\0'; @@ -217,7 +217,7 @@ main(int argc, char *argv[]) /* Okay, we've read in all the substitutions from our config.sh */ /* equivalent. Read in the config_h.sh equiv and start the substitution */ - + /* First, eat all the lines until we get to one with !GROK!THIS! in it */ while(!strstr(fgets(LineBuffer, LINEBUFFERSIZE, Config_H), "!GROK!THIS!")) { @@ -234,12 +234,12 @@ main(int argc, char *argv[]) "!GROK!THIS!")) { /* Force a trailing null, just in case */ LineBuffer[LINEBUFFERSIZE - 1] = '\0'; - + /* Tilde Substitute */ tilde_sub(LineBuffer, TildeSub, TildeSubCount); LineBufferLength = strlen(LineBuffer); - + /* Chop trailing control characters */ while((LineBufferLength > 0) && (LineBuffer[LineBufferLength-1] < ' ')) { LineBuffer[LineBufferLength - 1] = '\0'; @@ -278,7 +278,7 @@ main(int argc, char *argv[]) /* Back the line buffer pointer up one */ LineBufferLoop--; - + /* Right, we're done grabbing a token. Check to make sure we got */ /* something */ if (TokenBufferLoop) { @@ -302,15 +302,15 @@ main(int argc, char *argv[]) OutBuf[OutBufPos++] = '$'; while (*cp) OutBuf[OutBufPos++] = *(cp++); } - + } else { /* Just a bare $. Spit it out */ OutBuf[OutBufPos++] = '$'; - } + } } } } - + /* If we've created an #undef line, make sure we don't output anything * after the "#undef FOO" besides comments. We could do this as we * go by recognizing the #undef as it goes by, and thus avoid another @@ -336,13 +336,13 @@ main(int argc, char *argv[]) } LineBuffer[LineBufferLoop] = '\0'; puts(LineBuffer); - } + } else { OutBuf[OutBufPos] = '\0'; puts(OutBuf); } } - + /* Close the files */ fclose(ConfigSH); fclose(Config_H); @@ -381,7 +381,7 @@ tilde_sub(char LineBuffer[], Translate TildeSub[], int TildeSubCount) CopiedBufferLength = strlen(TempBuffer); } } - + /* Did we find anything? */ if (GotIt == 0) { /* Guess not. Copy the whole thing out verbatim */ @@ -392,7 +392,7 @@ tilde_sub(char LineBuffer[], Translate TildeSub[], int TildeSubCount) strcat(TempBuffer, "~"); CopiedBufferLength = strlen(TempBuffer); } - + } else { /* 'Kay, not a tilde. Is it a word character? */ if (isalnum(LineBuffer[TildeLoop]) || @@ -422,7 +422,7 @@ tilde_sub(char LineBuffer[], Translate TildeSub[], int TildeSubCount) } } } - + /* Out of the loop. First, double-check to see if there was anything */ /* pending. */ if (InTilde) { diff --git a/vms/vms.c b/vms/vms.c index 324cfa109290..7092a06ec8ec 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -19,7 +19,7 @@ * * [p.162 of _The Lays of Beleriand_] */ - + #include #include #include @@ -91,9 +91,9 @@ struct item_list_3 { #endif /* We implement I/O here, so we will be mixing PerlIO and stdio calls. */ -#define PERLIO_NOT_STDIO 0 +#define PERLIO_NOT_STDIO 0 -/* Don't replace system definitions of vfork, getenv, lstat, and stat, +/* Don't replace system definitions of vfork, getenv, lstat, and stat, * code below needs to get to the underlying CRTL routines. */ #define DONT_MASK_RTL_CALLS #include "EXTERN.h" @@ -230,9 +230,9 @@ static char *__mystrtolower(char *str) return str; } -static struct dsc$descriptor_s fildevdsc = +static struct dsc$descriptor_s fildevdsc = { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" }; -static struct dsc$descriptor_s crtlenvdsc = +static struct dsc$descriptor_s crtlenvdsc = { 8, DSC$K_DTYPE_T, DSC$K_CLASS_S, "CRTL_ENV" }; static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL }; static struct dsc$descriptor_s *defenv[] = { &fildevdsc, &crtlenvdsc, NULL }; @@ -240,7 +240,7 @@ static struct dsc$descriptor_s **env_tables = defenv; static bool will_taint = FALSE; /* tainting active, but no PL_curinterp yet */ /* True if we shouldn't treat barewords as logicals during directory */ -/* munching */ +/* munching */ static int no_translate_barewords; /* DECC Features that may need to affect how Perl interprets @@ -409,7 +409,7 @@ int utf8_flag; } } else if ((*inspec & 0xF0) == 0xE0) { /* 3 byte Unicode */ - ucs_char = ((inspec[0] & 0xF) << 12) + + ucs_char = ((inspec[0] & 0xF) << 12) + ((inspec[1] & 0x3f) << 6) + (inspec[2] & 0x3f); if (ucs_char >= 0x800) { @@ -535,7 +535,7 @@ int utf8_flag; case '%': case '^': case '\\': - /* Don't escape again if following character is + /* Don't escape again if following character is * already something we escape. */ if (strchr(".~!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) { @@ -589,7 +589,7 @@ int scnt; if (*inspec == '^') { inspec++; switch (*inspec) { - /* Spaces and non-trailing dots should just be passed through, + /* Spaces and non-trailing dots should just be passed through, * but eat the escape character. */ case '.': @@ -795,7 +795,7 @@ const int verspec = 7; * The parser can not tell the difference when a "." is a version * delimiter or a part of the file specification. */ - if ((decc_efs_charset) && + if ((decc_efs_charset) && (item_list[verspec].length > 0) && (item_list[verspec].component[0] == '.')) { *name = item_list[namespec].component; @@ -946,7 +946,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, char *eq; int i; if (!environ) { - ivenv = 1; + ivenv = 1; #if defined(PERL_IMPLICIT_CONTEXT) if (aTHX == NULL) { fprintf(stderr, @@ -957,8 +957,8 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, continue; } retsts = SS$_NOLOGNAM; - for (i = 0; environ[i]; i++) { - if ((eq = strchr(environ[i],'=')) && + for (i = 0; environ[i]; i++) { + if ((eq = strchr(environ[i],'=')) && lnmdsc.dsc$w_length == (eq - environ[i]) && !strncmp(environ[i],uplnm,eq - environ[i])) { eq++; @@ -979,7 +979,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, /* dynamic dsc to accommodate possible long value */ _ckvmssts_noperl(lib$sget1_dd(&deflen,&eqvdsc)); retsts = lib$get_symbol(&lnmdsc,&eqvdsc,&eqvlen,0); - if (retsts & 1) { + if (retsts & 1) { if (eqvlen > MAX_DCL_SYMBOL) { set_errno(EVMSERR); set_vaxc_errno(LIB$_STRTRU); eqvlen = MAX_DCL_SYMBOL; @@ -1098,7 +1098,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) else { Newx(__my_getenv_eqv,LNM$C_NAMLENGTH*midx+1,char); } - eqv = __my_getenv_eqv; + eqv = __my_getenv_eqv; } for (cp1 = lnm, cp2 = eqv; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1); @@ -1133,7 +1133,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) secure = 0; } - flags = + flags = #ifdef SECURE_INTERNAL_GETENV secure ? PERL__TRNENV_SECURE : 0 #else @@ -1148,7 +1148,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) flags |= PERL__TRNENV_JOIN_SEARCHLIST; /* If the name contains a semicolon-delimited index, parse it - * off and make sure we only retrieve the equivalence name for + * off and make sure we only retrieve the equivalence name for * that index. */ if ((cp2 = strchr(lnm,';')) != NULL) { my_strlcpy(uplnm, lnm, cp2 - lnm + 1); @@ -1181,7 +1181,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) static char *__my_getenv_len_eqv = NULL; int secure, saverr, savvmserr; SV *tmpsv; - + midx = my_maxidx(lnm) + 1; if (PL_curinterp) { /* Perl interpreter running -- may be threaded */ @@ -1199,7 +1199,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) else { Newx(__my_getenv_len_eqv,LNM$C_NAMLENGTH*midx+1,char); } - buf = __my_getenv_len_eqv; + buf = __my_getenv_len_eqv; } for (cp1 = lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1); @@ -1232,7 +1232,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) secure = 0; } - flags = + flags = #ifdef SECURE_INTERNAL_GETENV secure ? PERL__TRNENV_SECURE : 0 #else @@ -1301,7 +1301,7 @@ prime_env_iter(void) $DESCRIPTOR(cmddsc,cmd); $DESCRIPTOR(nldsc,"_NLA0:"); $DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(clitabdsc,"DCLTABLES"); $DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM"); - $DESCRIPTOR(local,"_LOCAL"); $DESCRIPTOR(mbxdsc,mbxnam); + $DESCRIPTOR(local,"_LOCAL"); $DESCRIPTOR(mbxdsc,mbxnam); #if defined(PERL_IMPLICIT_CONTEXT) pTHX; #endif @@ -1352,9 +1352,9 @@ prime_env_iter(void) if (!str$case_blind_compare(env_tables[i],&crtlenv)) { char *start; int j; - for (j = 0; environ[j]; j++) { + for (j = 0; environ[j]; j++) { if (!(start = strchr(environ[j],'='))) { - if (ckWARN(WARN_INTERNAL)) + if (ckWARN(WARN_INTERNAL)) Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Ill-formed CRTL environ value \"%s\"\n",environ[j]); } else { @@ -1384,7 +1384,7 @@ prime_env_iter(void) else cmddsc.dsc$w_length = 14; /* N.B. We test this below */ flags = defflags | CLI$M_NOCLISYM; } - + /* Create a new subprocess to execute each command, to exclude the * remote possibility that someone could subvert a mbx or file used * to write multiple commands to a single subprocess. @@ -1414,7 +1414,7 @@ prime_env_iter(void) break; } _ckvmssts(sts); - retlen = iosb[0] >> 16; + retlen = iosb[0] >> 16; if (!retlen) continue; /* blank line */ buf[retlen] = '\0'; if (iosb[1] != subpid) { @@ -1535,7 +1535,7 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * if (!ivenv && !str$case_blind_compare(tabvec[curtab],&crtlenv)) { int i; for (i = 0; environ[i]; i++) { /* If it's an environ elt, reset */ - if ((cp1 = strchr(environ[i],'=')) && + if ((cp1 = strchr(environ[i],'=')) && lnmdsc.dsc$w_length == (cp1 - environ[i]) && !strncmp(environ[i],lnm,cp1 - environ[i])) { #ifdef HAS_SETENV @@ -1557,7 +1557,7 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * unsigned int symtype; if (tabvec[curtab]->dsc$w_length == 12 && (tmpdsc.dsc$a_pointer = tabvec[curtab]->dsc$a_pointer + 6) && - !str$case_blind_compare(&tmpdsc,&local)) + !str$case_blind_compare(&tmpdsc,&local)) symtype = LIB$K_CLI_LOCAL_SYM; else symtype = LIB$K_CLI_GLOBAL_SYM; retsts = lib$delete_symbol(&lnmdsc,&symtype); @@ -1592,7 +1592,7 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * unsigned int symtype; if (tabvec[0]->dsc$w_length == 12 && (tmpdsc.dsc$a_pointer = tabvec[0]->dsc$a_pointer + 6) && - !str$case_blind_compare(&tmpdsc,&local)) + !str$case_blind_compare(&tmpdsc,&local)) symtype = LIB$K_CLI_LOCAL_SYM; else symtype = LIB$K_CLI_GLOBAL_SYM; retsts = lib$set_symbol(&lnmdsc,&eqvdsc,&symtype); @@ -1644,7 +1644,7 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * case LIB$_AMBSYMDEF: case LIB$_INSCLIMEM: case SS$_NOLOGTAB: case SS$_TOOMANYLNAM: case SS$_IVLOGTAB: set_errno(EVMSERR); break; - case LIB$_INVARG: case LIB$_INVSYMNAM: case SS$_IVLOGNAM: + case LIB$_INVARG: case LIB$_INVSYMNAM: case SS$_IVLOGNAM: case LIB$_NOSUCHSYM: case SS$_NOLOGNAM: set_errno(EINVAL); break; case SS$_NOPRIV: @@ -1662,7 +1662,7 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * * previously exist, we've got a leftover error message. (Of course, * this fails in the face of * $foo = $ENV{nonexistent}; $ENV{existent} = 'foo'; - * in that the error reported in $! isn't spurious, + * in that the error reported in $! isn't spurious, * but it's right more often than not.) */ set_errno(0); set_vaxc_errno(retsts); @@ -1687,7 +1687,7 @@ Perl_my_setenv(pTHX_ const char *lnm, const char *eqv) if (eqv && *eqv) my_chdir(eqv); return; } - } + } } (void) vmssetenv(lnm,eqv,NULL); } @@ -2217,13 +2217,13 @@ my_tmpfile(void) /* - * The C RTL's sigaction fails to check for invalid signal numbers so we + * The C RTL's sigaction fails to check for invalid signal numbers so we * help it out a bit. The docs are correct, but the actual routine doesn't * do what the docs say it will. */ /*{{{int Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*);*/ int -Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, +Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, struct sigaction* oact) { if (sig == SIGKILL || sig == SIGSTOP || sig == SIGCONT) { @@ -2241,7 +2241,7 @@ Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, sys$sigprc for one of two reasons: 1.) If the kill() in an older CRTL uses sys$forcex, causing the - target process to do a sys$exit, which usually can't be handled + target process to do a sys$exit, which usually can't be handled gracefully...certainly not by Perl and the %SIG{} mechanism. 2.) If the kill() in the CRTL can't be called from a signal @@ -2254,7 +2254,7 @@ Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, Note that distinguishing SIGSEGV from SIGBUS requires an extra arg on the ACCVIO condition, which sys$sigprc (and sys$forcex) don't provide. On VMS 7.0+ this is taken care of by doing sys$sigprc - with condition codes C$_SIG0+nsig*8, catching the exception on the + with condition codes C$_SIG0+nsig*8, catching the exception on the target process and resignaling with appropriate arguments. But we don't have that VMS 7.0+ exception handler, so if you @@ -2274,7 +2274,7 @@ Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, static unsigned int Perl_sig_to_vmscondition_int(int sig) { - static unsigned int sig_code[_MY_SIG_MAX+1] = + static unsigned int sig_code[_MY_SIG_MAX+1] = { 0, /* 0 ZERO */ SS$_HANGUP, /* 1 SIGHUP */ @@ -2284,11 +2284,11 @@ Perl_sig_to_vmscondition_int(int sig) SS$_BREAK, /* 5 SIGTRAP */ SS$_OPCCUS, /* 6 SIGABRT */ SS$_COMPAT, /* 7 SIGEMT */ -#ifdef __VAX +#ifdef __VAX SS$_FLTOVF, /* 8 SIGFPE VAX */ -#else +#else SS$_HPARITH, /* 8 SIGFPE AXP */ -#endif +#endif SS$_ABORT, /* 9 SIGKILL */ SS$_ACCVIO, /* 10 SIGBUS */ SS$_ACCVIO, /* 11 SIGSEGV */ @@ -2391,7 +2391,7 @@ Perl_my_kill(int pid, int sig) * signals are to be sent to multiple processes. * pid = 0 - all processes in group except ones that the system exempts * pid = -1 - all processes except ones that the system exempts - * pid = -n - all processes in group (abs(n)) except ... + * pid = -n - all processes in group (abs(n)) except ... * For now, just report as not supported. */ @@ -2406,7 +2406,7 @@ Perl_my_kill(int pid, int sig) switch (iss) { case SS$_NOPRIV: set_errno(EPERM); break; - case SS$_NONEXPR: + case SS$_NONEXPR: case SS$_NOSUCHNODE: case SS$_UNREACHABLE: set_errno(ESRCH); break; @@ -2415,9 +2415,9 @@ Perl_my_kill(int pid, int sig) default: _ckvmssts_noperl(iss); set_errno(EVMSERR); - } + } set_vaxc_errno(iss); - + return -1; } #endif @@ -2618,7 +2618,7 @@ int unix_status; } return unix_status; -} +} /* Try to guess at what VMS error status should go with a UNIX errno * value. This is hard to do as there could be many possible VMS @@ -2746,7 +2746,7 @@ int test_unix_status; default: return SS$_ABORT; /* punt */ } -} +} /* default piping mailbox size */ @@ -2772,7 +2772,7 @@ create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc) * Get the SYSGEN parameter MAXBUF * * If the logical 'PERL_MBX_SIZE' is defined - * use the value of the logical instead of PERL_BUFSIZ, but + * use the value of the logical instead of PERL_BUFSIZ, but * keep the size between 128 and MAXBUF. * */ @@ -2884,7 +2884,7 @@ struct exit_control_block unsigned long int arg_count; unsigned long int *status_address; unsigned long int exit_status; -}; +}; typedef struct _closed_pipes Xpipe; typedef struct _closed_pipes* pXpipe; @@ -2919,7 +2919,7 @@ pipe_exit_routine(void) unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT; int sts, did_stuff, j; - /* + /* * Flush any pending i/o, but since we are in process run-down, be * careful about referencing PerlIO structures that may already have * been deallocated. We may not even have an interpreter anymore. @@ -2943,17 +2943,17 @@ pipe_exit_routine(void) && my_perl #endif #ifdef USE_PERLIO - && PL_perlio_fd_refcnt + && PL_perlio_fd_refcnt #endif ) PerlIO_flush(info->fp); - else + else fflush((FILE *)info->fp); } info = info->next; } - /* + /* next we try sending an EOF...ignore if doesn't work, make sure we don't hang */ @@ -2980,14 +2980,14 @@ pipe_exit_routine(void) info = open_pipes; while (info) { _ckvmssts_noperl(sys$setast(0)); - if (info->waiting && info->done) + if (info->waiting && info->done) info->waiting = 0; nwait += info->waiting; _ckvmssts_noperl(sys$setast(1)); info = info->next; } if (!nwait) break; - sleep(1); + sleep(1); } did_stuff = 0; @@ -2996,7 +2996,7 @@ pipe_exit_routine(void) _ckvmssts_noperl(sys$setast(0)); if (!info->done) { /* Tap them gently on the shoulder . . .*/ sts = sys$forcex(&info->pid,0,&abort); - if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts_noperl(sts); + if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts_noperl(sts); did_stuff = 1; } _ckvmssts_noperl(sys$setast(1)); @@ -3011,14 +3011,14 @@ pipe_exit_routine(void) info = open_pipes; while (info) { _ckvmssts_noperl(sys$setast(0)); - if (info->waiting && info->done) + if (info->waiting && info->done) info->waiting = 0; nwait += info->waiting; _ckvmssts_noperl(sys$setast(1)); info = info->next; } if (!nwait) break; - sleep(1); + sleep(1); } info = open_pipes; @@ -3026,7 +3026,7 @@ pipe_exit_routine(void) _ckvmssts_noperl(sys$setast(0)); if (!info->done) { /* We tried to be nice . . . */ sts = sys$delprc(&info->pid,0); - if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts_noperl(sts); + if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts_noperl(sts); info->done = 1; /* sys$delprc is as done as we're going to get. */ } _ckvmssts_noperl(sys$setast(1)); @@ -3052,7 +3052,7 @@ pipe_exit_routine(void) return retsts; } -static struct exit_control_block pipe_exitblock = +static struct exit_control_block pipe_exitblock = {(struct exit_control_block *) 0, pipe_exit_routine, 0, &pipe_exitblock.exit_status, 0}; @@ -3070,7 +3070,7 @@ popen_completion_ast(pInfo info) closed_list[closed_index].pid = info->pid; closed_list[closed_index].completion = info->completion; closed_index++; - if (closed_index == NKEEPCLOSED) + if (closed_index == NKEEPCLOSED) closed_index = 0; closed_num++; @@ -3577,7 +3577,7 @@ store_pipelocs(pTHX) char temp[NAM$C_MAXRSS+1]; STRLEN n_a; - if (head_PLOC) + if (head_PLOC) free_pipelocs(aTHX_ &head_PLOC); /* the . directory from @INC comes last */ @@ -3777,11 +3777,11 @@ vmspipe_tempfile(pTHX) fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define/user/name_attributes=confine sys$error 'perl_popen_err'\n"); fprintf(fp,"$ pif perl_popen_out .nes. \"\" then perl_define sys$output 'perl_popen_out'\n"); fprintf(fp,"$! --- build command line to get max possible length\n"); - fprintf(fp,"$c=perl_popen_cmd0\n"); - fprintf(fp,"$c=c+perl_popen_cmd1\n"); - fprintf(fp,"$c=c+perl_popen_cmd2\n"); - fprintf(fp,"$x=perl_popen_cmd3\n"); - fprintf(fp,"$c=c+x\n"); + fprintf(fp,"$c=perl_popen_cmd0\n"); + fprintf(fp,"$c=c+perl_popen_cmd1\n"); + fprintf(fp,"$c=c+perl_popen_cmd2\n"); + fprintf(fp,"$x=perl_popen_cmd3\n"); + fprintf(fp,"$c=c+x\n"); fprintf(fp,"$ perl_on\n"); fprintf(fp,"$ 'c'\n"); fprintf(fp,"$ perl_status = $STATUS\n"); @@ -3811,10 +3811,10 @@ vmspipe_tempfile(pTHX) static int vms_is_syscommand_xterm(void) { - const static struct dsc$descriptor_s syscommand_dsc = + const static struct dsc$descriptor_s syscommand_dsc = { 11, DSC$K_DTYPE_T, DSC$K_CLASS_S, "SYS$COMMAND" }; - const static struct dsc$descriptor_s decwdisplay_dsc = + const static struct dsc$descriptor_s decwdisplay_dsc = { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "DECW$DISPLAY" }; struct item_list_3 items[2]; @@ -4167,7 +4167,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) vmspipedsc.dsc$a_pointer = tfilebuf; sts = setup_cmddsc(aTHX_ cmd,0,0,&vmscmd); - if (!(sts & 1)) { + if (!(sts & 1)) { switch (sts) { case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; @@ -4184,18 +4184,18 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */ _ckvmssts_noperl(sts); /* fall through */ default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */ - set_errno(EVMSERR); + set_errno(EVMSERR); } set_vaxc_errno(sts); if (*in_mode != 'n' && ckWARN(WARN_PIPE)) { Perl_warner(aTHX_ packWARN(WARN_PIPE),"Can't pipe \"%*s\": %s", strlen(cmd), cmd, Strerror(errno)); } *psts = sts; - return NULL; + return NULL; } n = sizeof(Info); _ckvmssts_noperl(lib$get_vm(&n, &info)); - + my_strlcpy(mode, in_mode, sizeof(mode)); info->mode = *mode; info->done = FALSE; @@ -4248,7 +4248,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) if (!info->fp && info->out) { sys$cancel(info->out->chan_out); - + while (!info->out_done) { int done; _ckvmssts_noperl(sys$setast(0)); @@ -4333,7 +4333,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) *psts = RMS$_FNF; return NULL; } - + } else if (*mode == 'n') { /* separate subprocess, no Perl i/o */ /* Let the child inherit standard input, unless it's a directory. */ @@ -4418,9 +4418,9 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) _ckvmssts_noperl(lib$delete_symbol(&d_sym_err, &table)); _ckvmssts_noperl(lib$delete_symbol(&d_sym_out, &table)); vms_execfree(vmscmd); - + #ifdef PERL_IMPLICIT_CONTEXT - if (aTHX) + if (aTHX) #endif PL_forkprocess = info->pid; @@ -4448,7 +4448,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) } RESTORE_ERRNO; - } else { + } else { *psts = info->pid; } return ret_fp; @@ -4490,11 +4490,11 @@ static I32 my_pclose_pinfo(pTHX_ pInfo info) { && my_perl #endif #ifdef USE_PERLIO - && PL_perlio_fd_refcnt + && PL_perlio_fd_refcnt #endif ) PerlIO_flush(info->fp); - else + else fflush((FILE *)info->fp); } @@ -4524,7 +4524,7 @@ static I32 my_pclose_pinfo(pTHX_ pInfo info) { #endif ) PerlIO_close(info->fp); - else + else fclose((FILE *)info->fp); } /* @@ -4594,7 +4594,7 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp) { pInfo info, last = NULL; I32 ret_status; - + /* Fixme - need ast and mutex protection here */ for (info = open_pipes; info != NULL; last = info, info = info->next) if (info->fp == fp) break; @@ -4625,8 +4625,8 @@ extern "C" { #endif #endif -/* sort-of waitpid; special handling of pipe clean-up for subprocesses - created with popen(); otherwise partially emulate waitpid() unless +/* sort-of waitpid; special handling of pipe clean-up for subprocesses + created with popen(); otherwise partially emulate waitpid() unless we have a suitable one from the CRTL that came with VMS 7.2 and later. Also check processes not considered by the CRTL waitpid(). */ @@ -4638,9 +4638,9 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags) int done; int sts; int j; - + if (statusp) *statusp = 0; - + for (info = open_pipes; info != NULL; info = info->next) if (info->pid == pid) break; @@ -4677,13 +4677,13 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags) sts = __vms_waitpid( pid, statusp, flags ); - if ( sts == 0 || !(sts == -1 && errno == ECHILD) ) + if ( sts == 0 || !(sts == -1 && errno == ECHILD) ) return sts; - /* If the real waitpid tells us the child does not exist, we - * fall through here to implement waiting for a child that + /* If the real waitpid tells us the child does not exist, we + * fall through here to implement waiting for a child that * was created by some means other than exec() (say, spawned - * from DCL) or to wait for a process that is not a subprocess + * from DCL) or to wait for a process that is not a subprocess * of the current process. */ @@ -4695,22 +4695,22 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags) unsigned long int pidcode = JPI$_PID, mypid; unsigned long int interval[2]; unsigned int jpi_iosb[2]; - struct itmlst_3 jpilist[2] = { + struct itmlst_3 jpilist[2] = { {sizeof(ownerpid), JPI$_OWNER, &ownerpid, 0}, - { 0, 0, 0, 0} + { 0, 0, 0, 0} }; if (pid <= 0) { - /* Sorry folks, we don't presently implement rooting around for + /* Sorry folks, we don't presently implement rooting around for the first child we can find, and we definitely don't want to pass a pid of -1 to $getjpi, where it is a wildcard operation. */ - set_errno(ENOTSUP); + set_errno(ENOTSUP); return -1; } - /* Get the owner of the child so I can warn if it's not mine. If the - * process doesn't exist or I don't have the privs to look at it, + /* Get the owner of the child so I can warn if it's not mine. If the + * process doesn't exist or I don't have the privs to look at it, * I can go home early. */ sts = sys$getjpiw(0,&pid,NULL,&jpilist,&jpi_iosb,NULL,NULL); @@ -5512,7 +5512,7 @@ int_rmsexpand retsts == RMS$_PRV) { retsts = sys$parse(&myfab,0,0); if (retsts & STS$K_SUCCESS) goto int_expanded; - } + } /* Still could not parse the file specification */ /*----------------------------------------------*/ @@ -5524,7 +5524,7 @@ int_rmsexpand if (outbufl != NULL) PerlMem_free(outbufl); PerlMem_free(esa); - if (esal != NULL) + if (esal != NULL) PerlMem_free(esal); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); @@ -5543,7 +5543,7 @@ int_rmsexpand if (outbufl != NULL) PerlMem_free(outbufl); PerlMem_free(esa); - if (esal != NULL) + if (esal != NULL) PerlMem_free(esal); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); @@ -5614,12 +5614,12 @@ int_rmsexpand if (defesal == NULL) _ckvmssts_noperl(SS$_INSFMEM); #endif rms_setup_nam(defnam); - + rms_bind_fab_nam(deffab, defnam); - /* Cast ok */ + /* Cast ok */ rms_set_fna - (deffab, defnam, (char *)defspec, rms_nam_dns(myfab, mynam)); + (deffab, defnam, (char *)defspec, rms_nam_dns(myfab, mynam)); /* RMS needs the esa/esal as a work area if wildcards are involved */ rms_set_esal(defnam, defesa, NAM$C_MAXRSS, defesal, VMS_MAXRSS - 1); @@ -5639,7 +5639,7 @@ int_rmsexpand trimver = !rms_is_nam_fnb(defnam, NAM$M_EXP_VER); } if (trimtype) { - trimtype = !rms_is_nam_fnb(defnam, NAM$M_EXP_TYPE); + trimtype = !rms_is_nam_fnb(defnam, NAM$M_EXP_TYPE); } } if (defesal != NULL) @@ -5791,17 +5791,17 @@ int_rmsexpand } /* Common simple case - Expand an already VMS spec */ -static char * +static char * int_rmsexpand_vms(const char * filespec, char * outbuf, unsigned opts) { opts |= PERL_RMSEXPAND_M_VMS_IN; - return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); + return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); } /* Common simple case - Expand to a VMS spec */ -static char * +static char * int_rmsexpand_tovms(const char * filespec, char * outbuf, unsigned opts) { opts |= PERL_RMSEXPAND_M_VMS; - return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); + return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); } @@ -5931,7 +5931,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) strcpy(trndir,*dir == '/' ? dir + 1: dir); trnlnm_iter_count = 0; while (!strpbrk(trndir,"/]>:") && simple_trnlnm(trndir,trndir,VMS_MAXRSS-1)) { - trnlnm_iter_count++; + trnlnm_iter_count++; if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break; } dirlen = strlen(trndir); @@ -6108,7 +6108,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) if (decc_efs_charset && !strchr(trndir,'/')) { /* Dots are allowed in dir names, so escape them if input not in Unix syntax. */ char *cp4 = is_dir ? (cp2 - 1) : cp2; - + for (; cp4 > cp1; cp4--) { if (*cp4 == '.') { if ((cp4 - 1 > trndir) && (*(cp4 - 1) != '^')) { @@ -6188,7 +6188,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) else { savnam = dirnam; /* Does the file really exist? */ - if (sys$search(&dirfab)& STS$K_SUCCESS) { + if (sys$search(&dirfab)& STS$K_SUCCESS) { /* Yes; fake the fnb bits so we'll check type below */ rms_set_nam_fnb(dirnam, (NAM$M_EXP_TYPE | NAM$M_EXP_VER)); } @@ -6197,7 +6197,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) || dirfab.fab$l_sts == RMS$_DNF || dirfab.fab$l_sts == RMS$_FND) dirnam = savnam; - else { + else { int fab_sts; fab_sts = dirfab.fab$l_sts; sts = rms_free_search_context(&dirfab); @@ -6236,7 +6236,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) if (rms_is_nam_fnb(dirnam, NAM$M_EXP_TYPE)) { /* Was type specified? */ /* Yep; check version while we're at it, if it's there. */ cmplen = rms_is_nam_fnb(dirnam, NAM$M_EXP_VER) ? 6 : 4; - if (strncmp(rms_nam_typel(dirnam), ".DIR;1", cmplen)) { + if (strncmp(rms_nam_typel(dirnam), ".DIR;1", cmplen)) { /* Something other than .DIR[;1]. Bzzt. */ sts = rms_free_search_context(&dirfab); PerlMem_free(esa); @@ -6489,7 +6489,7 @@ static char * int_pathify_dirspec_simple(const char * dir, char * buf, len += n_len; if (e_len > 0) { if (decc_efs_charset) { - if (e_len == 4 + if (e_len == 4 && (toupper(e_spec[1]) == 'D') && (toupper(e_spec[2]) == 'I') && (toupper(e_spec[3]) == 'R')) { @@ -6575,7 +6575,7 @@ static char *int_pathify_dirspec(const char *dir, char *buf) trnlnm_iter_count = 0; while (!strpbrk(trndir,"/]:>") && !no_translate_barewords && simple_trnlnm(trndir, trndir, VMS_MAXRSS)) { - trnlnm_iter_count++; + trnlnm_iter_count++; need_to_lower = 1; if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break; @@ -6807,7 +6807,7 @@ static char *int_pathify_dirspec(const char *dir, char *buf) } if (!dir_start && (*str == '.')) { *str = '_'; - } + } } } PerlMem_free(trndir); @@ -6828,7 +6828,7 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int { static char __pathify_retbuf[VMS_MAXRSS]; char * pathified, *ret_spec, *ret_buf; - + pathified = NULL; ret_buf = buf; if (ret_buf == NULL) { @@ -6976,7 +6976,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl) cp2 += copy_expand_vms_filename_escape(cp1, cp2, &outchars_added); cp1 += outchars_added; } - *cp1 = '\0'; + *cp1 = '\0'; if (vms_debug_fileify) { fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt); } @@ -6991,7 +6991,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl) cp2 += copy_expand_vms_filename_escape(cp1, cp2, &outchars_added); cp1 += outchars_added; } - *cp1 = '\0'; + *cp1 = '\0'; if (vms_debug_fileify) { fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt); } @@ -7064,7 +7064,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl) while (*cp3 != ':' && *cp3) cp3++; *(cp3++) = '\0'; if (strchr(cp3,']') != NULL) break; - trnlnm_iter_count++; + trnlnm_iter_count++; if (trnlnm_iter_count >= PERL_LNM_MAX_ITER+1) break; } while (vmstrnenv(tmp,tmp,0,fildev,0)); cp1 = rslt; @@ -7332,7 +7332,7 @@ int unixlen; } else #endif - { + { int path_len; int i,j; @@ -7377,7 +7377,7 @@ int unixlen; vmspath[path_len] = ']'; path_len++; vmspath[path_len] = '\0'; - + } vmspath[vmspath_len] = 0; if (unixpath[unixlen - 1] == '/') @@ -7427,7 +7427,7 @@ int unixlen; } specdsc.dsc$a_pointer = vmspath; specdsc.dsc$w_length = vmspath_len; - + dvidsc.dsc$a_pointer = &mynam.naml$t_dvi[1]; dvidsc.dsc$w_length = mynam.naml$t_dvi[0]; sts = lib$fid_to_name @@ -7505,7 +7505,7 @@ int unixlen; like /dev/tty which may need to be mapped to something. */ -static int +static int slash_dev_special_to_vms (const char * unixptr, char * vmspath, @@ -7797,7 +7797,7 @@ int sts, v_len, r_len, d_len, n_len, e_len, vs_len; *vmsptr++ = '['; vmslen = 1; dir_start = 1; - + /* if not backing up, then it is relative forward. */ if (!((*unixptr == '.') && (unixptr[1] == '.') && ((unixptr[2] == '/') || (&unixptr[2] == unixend)))) { @@ -8567,7 +8567,7 @@ static char *int_tovmsspec (*(cp2+3) == '/' || *(cp2+3) == '\0') ) { if (cp1 > rslt && *(cp1-1) != '.') *(cp1++) = '.'; /* May already have 1 from '/' */ *(cp1++) = '.'; *(cp1++) = '.'; /* ".../" --> "..." */ - if (!*(cp2+3)) { + if (!*(cp2+3)) { *(cp1++) = '.'; /* Simulate trailing '/' */ cp2 += 2; /* for loop will incr this to == dirend */ } @@ -8676,7 +8676,7 @@ static char *int_tovmsspec case '#': case '%': case '^': - /* Don't escape again if following character is + /* Don't escape again if following character is * already something we escape. */ if (strchr("\"~`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) { @@ -8807,7 +8807,7 @@ static char * int_tovmspath(const char *path, char *buf, int * utf8_fl) { } ret_spec = int_tovmsspec(pathified, buf, 0, utf8_fl); - + PerlMem_free(pathified); return ret_spec; @@ -8860,7 +8860,7 @@ char *Perl_tovmspath(pTHX_ const char *path, char *buf) { return do_tovmspath(path,buf,0, NULL); } char *Perl_tovmspath_ts(pTHX_ const char *path, char *buf) { return do_tovmspath(path,buf,1, NULL); } -char *Perl_tovmspath_utf8(pTHX_ const char *path, char *buf, int *utf8_fl) +char *Perl_tovmspath_utf8(pTHX_ const char *path, char *buf, int *utf8_fl) { return do_tovmspath(path,buf,0,utf8_fl); } char *Perl_tovmspath_utf8_ts(pTHX_ const char *path, char *buf, int *utf8_fl) { return do_tovmspath(path,buf,1,utf8_fl); } @@ -8939,11 +8939,11 @@ char *Perl_tounixpath_utf8_ts(pTHX_ const char *path, char *buf, int * utf8_fl) /* * getredirection() is intended to aid in porting C programs - * to VMS (Vax-11 C). The native VMS environment does not support - * '>' and '<' I/O redirection, or command line wild card expansion, - * or a command line pipe mechanism using the '|' AND background + * to VMS (Vax-11 C). The native VMS environment does not support + * '>' and '<' I/O redirection, or command line wild card expansion, + * or a command line pipe mechanism using the '|' AND background * command execution '&'. All of these capabilities are provided to any - * C program which calls this procedure as the first thing in the + * C program which calls this procedure as the first thing in the * main program. * The piping mechanism will probably work with almost any 'filter' type * of program. With suitable modification, it may useful for other @@ -9136,7 +9136,7 @@ mp_getredirection(pTHX_ int *ac, char ***av) } pipe_and_fork(aTHX_ cmargv); } - + /* Check for input from a pipe (mailbox) */ if (in == NULL && 1 == isapipe(0)) @@ -9152,7 +9152,7 @@ mp_getredirection(pTHX_ int *ac, char ***av) fgetname(stdin, mbxname, 1); mbxnam.dsc$a_pointer = mbxname; - mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer); + mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer); lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0); mbxdevnam.dsc$a_pointer = mbxname; mbxdevnam.dsc$w_length = sizeof(mbxname); @@ -9174,7 +9174,7 @@ mp_getredirection(pTHX_ int *ac, char ***av) exit(vaxc$errno); } if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2"))) - { + { fprintf(stderr,"Can't open output file %s as stdout",out); exit(vaxc$errno); } @@ -9297,7 +9297,7 @@ int rms_sts; */ had_device = strchr(item, ':'); had_directory = (isunix || NULL != strchr(item, '[')) || (NULL != strchr(item, '<')); - + while ($VMS_STATUS_SUCCESS(sts = lib$find_file (&filespec, &resultspec, &context, &defaultspec, 0, &rms_sts, &lff_flags))) @@ -9396,7 +9396,7 @@ static struct exit_control_block exit_block = 0 }; -static void +static void pipe_and_fork(pTHX_ char **cmargv) { PerlIO *fp; @@ -9410,7 +9410,7 @@ pipe_and_fork(pTHX_ char **cmargv) j = l = 0; p = subcmd; q = cmargv[0]; - ismcr = q && toupper(*q) == 'M' && toupper(*(q+1)) == 'C' + ismcr = q && toupper(*q) == 'M' && toupper(*(q+1)) == 'C' && toupper(*(q+2)) == 'R' && !*(q+3); while (q && l < MAX_DCL_LINE_LENGTH) { @@ -9499,7 +9499,7 @@ int len; #ifndef KGB$M_SUBSYSTEM # define KGB$M_SUBSYSTEM 0x8 #endif - + /* Avoid Newx() in vms_image_init as thread context has not been initialized. */ /*{{{void vms_image_init(int *, char ***)*/ @@ -9573,12 +9573,12 @@ vms_image_init(int *argcp, char ***argvp) * buffer much larger than $GETJPI wants (rsz is size in bytes that * were needed to hold all identifiers at time of last call; we'll * allocate that many unsigned long ints), and go back and get 'em. - * If it gave us less than it wanted to despite ample buffer space, + * If it gave us less than it wanted to despite ample buffer space, * something's broken. Is your system missing a system identifier? */ - if (rsz <= jpilist[1].buflen) { + if (rsz <= jpilist[1].buflen) { /* Perl_croak accvios when used this early in startup. */ - fprintf(stderr, "vms_image_init: $getjpiw refuses to store RIGHTSLIST of %u bytes in buffer of %u bytes.\n%s", + fprintf(stderr, "vms_image_init: $getjpiw refuses to store RIGHTSLIST of %u bytes in buffer of %u bytes.\n%s", rsz, (unsigned long) jpilist[1].buflen, "Check your rights database for corruption.\n"); exit(SS$_ABORT); @@ -9885,7 +9885,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) if (*cp1 == '/' && !segdirs--) { cp1++; break; } for (match = 0; cp1 > lcres;) { resdsc.dsc$a_pointer = cp1; - if (str$match_wild(&wilddsc,&resdsc) == STR$_MATCH) { + if (str$match_wild(&wilddsc,&resdsc) == STR$_MATCH) { match++; if (match == 1) lcfront = cp1; } @@ -10177,7 +10177,7 @@ Perl_readdir(pTHX_ DIR *dd) /* Force the buffer to end with a NUL, and downcase name to match C convention. */ buff[res.dsc$w_length] = '\0'; p = buff + res.dsc$w_length; - while (--p >= buff) if (!isspace(*p)) break; + while (--p >= buff) if (!isspace(*p)) break; *p = '\0'; if (!decc_efs_case_preserve) { for (p = buff; *p; p++) *p = _tolower(*p); @@ -10364,7 +10364,7 @@ my_vfork(void) static void -vms_execfree(struct dsc$descriptor_s *vmscmd) +vms_execfree(struct dsc$descriptor_s *vmscmd) { if (vmscmd) { if (vmscmd->dsc$a_pointer) { @@ -10391,7 +10391,7 @@ setup_argstr(pTHX_ SV *really, SV **mark, SV **sp) idx++; } } - + for (idx++; idx <= sp; idx++) { if (*idx) { junk = SvPVx(*idx,rlen); @@ -10542,7 +10542,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, memmove(rest + clen - cmdlen, rest, s - soff + cmdlen - rest); /* Copy the unquoted and escaped command verb into place. */ - memcpy(r, resspec, cp2 - resspec); + memcpy(r, resspec, cp2 - resspec); cmd[clen] = '\0'; cmdlen = clen; rest = r; /* Rewind for subsequent operations. */ @@ -10554,7 +10554,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, *rest && !isspace(*rest) && cp2 - resspec < (VMS_MAXRSS - 1); rest++, cp2++) *cp2 = *rest; *cp2 = '\0'; - if (int_tovmsspec(resspec, cp, 0, NULL)) { + if (int_tovmsspec(resspec, cp, 0, NULL)) { s = vmsspec; /* When a UNIX spec with no file type is translated to VMS, */ @@ -10800,8 +10800,8 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, PerlMem_free(vmsspec); /* check if it's a symbol (for quoting purposes) */ - if (suggest_quote && !*suggest_quote) { - int iss; + if (suggest_quote && !*suggest_quote) { + int iss; char equiv[LNM$C_NAMLENGTH]; struct dsc$descriptor_s eqvdsc = {sizeof(equiv), DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; eqvdsc.dsc$a_pointer = equiv; @@ -10888,7 +10888,7 @@ Perl_vms_do_exec(pTHX_ const char *cmd) case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */ _ckvmssts_noperl(retsts); /* fall through */ default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */ - set_errno(EVMSERR); + set_errno(EVMSERR); } set_vaxc_errno(retsts); if (ckWARN(WARN_EXEC)) { @@ -10914,7 +10914,7 @@ int flags = 0; if (sp > mark) { - /* We'll copy the (undocumented?) Win32 behavior and allow a + /* We'll copy the (undocumented?) Win32 behavior and allow a * numeric first argument. But the only value we'll support * through do_aspawn is a value of 1, which means spawn without * waiting for completion -- other values are ignored. @@ -11006,7 +11006,7 @@ do_spawn2(pTHX_ const char *cmd, int flags) strcpy(mode, "n"); else strcpy(mode, "nW"); - + fp = safe_popen(aTHX_ cmd, mode, (int *)&sts); if (fp != NULL) my_pclose(fp); @@ -11067,12 +11067,12 @@ int my_fclose(FILE *fp) { /*}}}*/ -/* +/* * A simple fwrite replacement which outputs itmsz*nitm chars without * introducing record boundaries every itmsz chars. * We are using fputs, which depends on a terminating null. We may * well be writing binary data, so we need to accommodate not only - * data with nulls sprinkled in the middle but also data with no null + * data with nulls sprinkled in the middle but also data with no null * byte at the end. */ /*{{{ int my_fwrite(const void *src, size_t itmsz, size_t nitm, FILE *dest)*/ @@ -11128,7 +11128,7 @@ Perl_my_flush(pTHX_ FILE *fp) } /* * If the flush succeeded but set end-of-file, we need to clear - * the error because our caller may check ferror(). BTW, this + * the error because our caller may check ferror(). BTW, this * probably means we just flushed an empty file. */ if (res == 0 && vaxc$errno == RMS$_EOF) clearerr(fp); @@ -11312,7 +11312,7 @@ struct passwd *Perl_my_getpwnam(pTHX_ const char *name) struct dsc$descriptor_s name_desc; union uicdef uic; unsigned long int sts; - + __pwdcache = __passwd_empty; if (!fillpasswd(aTHX_ name, &__pwdcache)) { /* We still may be able to determine pw_uid and pw_gid */ @@ -11649,7 +11649,7 @@ int Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes) struct dsc$descriptor fibdsc = {sizeof(myfib), DSC$K_DTYPE_Z, DSC$K_CLASS_S,(char *) &myfib}, devdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0}, fnmdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0}; - + if (file == NULL || *file == '\0') { SETERRNO(ENOENT, LIB$_INVARG); return -1; @@ -11837,10 +11837,10 @@ static mydev_t encode_dev (pTHX_ const char *dev) status = lib$getdvi(&item, 0, &dev_desc, &lockid, 0, 0); if (!$VMS_STATUS_SUCCESS(status)) { switch (status) { - case SS$_NOSUCHDEV: + case SS$_NOSUCHDEV: SETERRNO(ENODEV, status); return 0; - default: + default: _ckvmssts(status); } } @@ -11935,7 +11935,7 @@ Perl_cando_by_name_int my_strlcpy(fileified, fname, VMS_MAXRSS); trnlnm_iter_count = 0; while (!strpbrk(fileified,"/]>:") && my_trnlnm(fileified,fileified,0)) { - trnlnm_iter_count++; + trnlnm_iter_count++; if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break; } fname = fileified; @@ -11960,8 +11960,8 @@ Perl_cando_by_name_int */ retlen = namdsc.dsc$w_length = strlen(vmsname); - if (vmsname[retlen-1] == ']' - || vmsname[retlen-1] == '>' + if (vmsname[retlen-1] == ']' + || vmsname[retlen-1] == '>' || vmsname[retlen-1] == ':' || (!flex_stat_int(vmsname, &st, 1) && S_ISDIR(st.st_mode))) { @@ -12106,7 +12106,7 @@ Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp) /* Make sure that the saved name fits in 255 characters */ cptr = int_rmsexpand_vms (vms_filename, - statbufp->st_devnam, + statbufp->st_devnam, 0); if (cptr == NULL) statbufp->st_devnam[0] = 0; @@ -12196,7 +12196,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) if (fileified == NULL) _ckvmssts_noperl(SS$_INSFMEM); - ret_spec = int_fileify_dirspec(fspec, fileified, NULL); + ret_spec = int_fileify_dirspec(fspec, fileified, NULL); if (ret_spec != NULL) { if (lstat_flag == 0) retval = stat(fileified, &statbufp->crtl_stat); @@ -12233,7 +12233,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) */ #if __CRTL_VER >= 70300000 && !defined(__VAX) if (!decc_efs_charset && (decc_efs_charset_index > 0)) - decc$feature_set_value(decc_efs_charset_index, 1, 1); + decc$feature_set_value(decc_efs_charset_index, 1, 1); #endif if (lstat_flag == 0) retval = stat(fspec, &statbufp->crtl_stat); @@ -12242,7 +12242,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) save_spec = fspec; #if __CRTL_VER >= 70300000 && !defined(__VAX) if (!decc_efs_charset && (decc_efs_charset_index > 0)) { - decc$feature_set_value(decc_efs_charset_index, 1, 0); + decc$feature_set_value(decc_efs_charset_index, 1, 0); efs_hack = 1; } #endif @@ -12261,7 +12261,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) #if __CRTL_VER >= 70300000 && !defined(__VAX) /* As you were... */ if (!decc_efs_charset) - decc$feature_set_value(decc$feature_get_index("DECC$EFS_CHARSET"),1,0); + decc$feature_set_value(decc$feature_get_index("DECC$EFS_CHARSET"),1,0); #endif if (!retval) { @@ -12293,7 +12293,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) save_spec = fileified; } - cptr = int_rmsexpand(save_spec, + cptr = int_rmsexpand(save_spec, statbufp->st_devnam, NULL, rmsex_flags, @@ -13045,7 +13045,7 @@ hushexit_fromperl(pTHX_ CV *cv) } -PerlIO * +PerlIO * Perl_vms_start_glob (pTHX_ SV *tmpglob, IO *io) @@ -13150,7 +13150,7 @@ Perl_vms_start_glob ok = (wilddsc.dsc$a_pointer != NULL); /* maybe passed 'foo' rather than '[.foo]', thus not detected above */ - hasdir = 1; + hasdir = 1; } else { /* Operate just on the directory, the special stat/fstat for */ /* leaves the fileified specification in the st_devnam */ @@ -13387,7 +13387,7 @@ vmsrealpath_fromperl(pTHX_ CV *cv) #ifdef HAS_SYMLINK /* - * A thin wrapper around decc$symlink to make sure we follow the + * A thin wrapper around decc$symlink to make sure we follow the * standard and do not create a symlink with a zero-length name, * and convert the target to Unix format, as the CRTL can't handle * targets in VMS format. @@ -13427,8 +13427,8 @@ case_tolerant_process_fromperl(pTHX_ CV *cv) #ifdef USE_ITHREADS -void -Perl_sys_intern_dup(pTHX_ struct interp_intern *src, +void +Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) { PERL_ARGS_ASSERT_SYS_INTERN_DUP; @@ -13438,12 +13438,12 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, #endif -void +void Perl_sys_intern_clear(pTHX) { } -void +void Perl_sys_intern_init(pTHX) { unsigned int ix = RAND_MAX; @@ -13488,7 +13488,7 @@ init_os_extras(void) return; } - + #if __CRTL_VER == 80200000 /* This missed getting in to the DECC SDK for 8.2 */ char *realpath(const char *file_name, char * resolved_name, ...); @@ -13519,7 +13519,7 @@ int decc$lstat(const char *name, void * statbuf); /* Realpath is fragile. In 8.3 it does not work if the feature * DECC$POSIX_COMPLIANT_PATHNAMES is not enabled, even though symbolic - * links are implemented in RMS, not the CRTL. It also can fail if the + * links are implemented in RMS, not the CRTL. It also can fail if the * user does not have read/execute access to some of the directories. * So in order for Do What I Mean mode to work, if realpath() fails, * fall back to looking up the filename by the device name and FID. @@ -13556,7 +13556,7 @@ struct statbuf_t { fileified = (char *)PerlMem_malloc(VMS_MAXRSS); if (fileified == NULL) _ckvmssts_noperl(SS$_INSFMEM); - + temp_fspec = (char *)PerlMem_malloc(VMS_MAXRSS); if (temp_fspec == NULL) _ckvmssts_noperl(SS$_INSFMEM); @@ -13565,7 +13565,7 @@ struct statbuf_t { /* First need to try as a directory */ ret_spec = int_tovmspath(name, temp_fspec, NULL); if (ret_spec != NULL) { - ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); + ret_spec = int_fileify_dirspec(temp_fspec, fileified, NULL); if (ret_spec != NULL) { if (lstat_flag == 0) sts = decc$stat(fileified, &statbuf); @@ -13594,7 +13594,7 @@ struct statbuf_t { */ #if __CRTL_VER >= 70300000 && !defined(__VAX) if (!decc_efs_charset && (decc_efs_charset_index > 0)) - decc$feature_set_value(decc_efs_charset_index, 1, 1); + decc$feature_set_value(decc_efs_charset_index, 1, 1); #endif ret_spec = int_tovmspath(name, temp_fspec, NULL); if (lstat_flag == 0) { @@ -13604,7 +13604,7 @@ struct statbuf_t { } #if __CRTL_VER >= 70300000 && !defined(__VAX) if (!decc_efs_charset && (decc_efs_charset_index > 0)) - decc$feature_set_value(decc_efs_charset_index, 1, 0); + decc$feature_set_value(decc_efs_charset_index, 1, 0); #endif } @@ -13719,8 +13719,8 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf, /* The result is expected to be in UNIX format */ rslt = int_tounixspec(vms_spec, outbuf, utf8_fl); - /* Downcase if input had any lower case letters and - * case preservation is not in effect. + /* Downcase if input had any lower case letters and + * case preservation is not in effect. */ if (!decc_efs_case_preserve) { for (cp = filespec; *cp; cp++) @@ -13870,8 +13870,8 @@ mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf, int file_len = v_len + r_len + d_len + n_len + e_len; outbuf[file_len] = 0; - /* Downcase if input had any lower case letters and - * case preservation is not in effect. + /* Downcase if input had any lower case letters and + * case preservation is not in effect. */ if (!decc_efs_case_preserve) { for (cp = filespec; *cp; cp++) @@ -13963,10 +13963,10 @@ set_feature_default(const char *name, int value) #if defined(__DECC) || defined(__DECCXX) -#ifdef __cplusplus -extern "C" { -#endif - +#ifdef __cplusplus +extern "C" { +#endif + extern void vmsperl_set_features(void) { @@ -14230,33 +14230,33 @@ vmsperl_set_features(void) /* Use 32-bit pointers because that's what the image activator * assumes for the LIB$INITIALZE psect. - */ -#if __INITIAL_POINTER_SIZE -#pragma pointer_size save -#pragma pointer_size 32 -#endif - -/* Create a reference to the LIB$INITIALIZE function. */ -extern void LIB$INITIALIZE(void); -extern void (*vmsperl_unused_global_1)(void) = LIB$INITIALIZE; - -/* Create an array of pointers to the init functions in the special + */ +#if __INITIAL_POINTER_SIZE +#pragma pointer_size save +#pragma pointer_size 32 +#endif + +/* Create a reference to the LIB$INITIALIZE function. */ +extern void LIB$INITIALIZE(void); +extern void (*vmsperl_unused_global_1)(void) = LIB$INITIALIZE; + +/* Create an array of pointers to the init functions in the special * LIB$INITIALIZE section. In our case, the array only has one entry. - */ -#pragma extern_model save -#pragma extern_model strict_refdef "LIB$INITIALIZE" nopic,gbl,nowrt,noshr,long -extern void (* const vmsperl_unused_global_2[])() = -{ + */ +#pragma extern_model save +#pragma extern_model strict_refdef "LIB$INITIALIZE" nopic,gbl,nowrt,noshr,long +extern void (* const vmsperl_unused_global_2[])() = +{ vmsperl_set_features, -}; -#pragma extern_model restore - -#if __INITIAL_POINTER_SIZE -#pragma pointer_size restore -#endif - -#ifdef __cplusplus -} +}; +#pragma extern_model restore + +#if __INITIAL_POINTER_SIZE +#pragma pointer_size restore +#endif + +#ifdef __cplusplus +} #endif #endif /* defined(__DECC) || defined(__DECCXX) */ diff --git a/vms/vmsish.h b/vms/vmsish.h index 84931500133c..b0b7c2816995 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -219,7 +219,7 @@ /* Delete if at all possible, changing protections if necessary. */ #define unlink(a) kill_file(a) -/* +/* * Intercept calls to fork, so we know whether subsequent calls to * exec should be handled in VMSish or Unixish style. */ @@ -248,7 +248,7 @@ #define BIG_TIME /* ACME_MESS: - * This symbol, if defined, indicates that error messages should be + * This symbol, if defined, indicates that error messages should be * should be generated in a format that allows the use of the Acme * GUI/editor's autofind feature. */ @@ -361,7 +361,7 @@ struct interp_intern { * available to set I/O characteristics */ #define HAS_IOCTL /**/ - + /* HAS_UTIME: * This symbol, if defined, indicates that the routine utime() is * available to update the access and modification times of files. @@ -388,7 +388,7 @@ struct interp_intern { #define HAS_KILL #define HAS_WAIT - + /* USEMYBINMODE * This symbol, if defined, indicates that the program should * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure @@ -488,7 +488,7 @@ struct utimbuf { #define time(t) my_time(t) /* - * The C RTL's sigaction fails to check for invalid signal numbers so we + * The C RTL's sigaction fails to check for invalid signal numbers so we * help it out a bit. */ #ifndef DONT_MASK_RTL_CALLS @@ -788,8 +788,8 @@ char * my_getlogin (void); /* The C RTL manual says to undef the macro for DEC C 5.2 and lower. */ #if defined(fileno) && defined(__DECC_VER) && __DECC_VER < 50300000 -# undef fileno -#endif +# undef fileno +#endif #define NO_ENVIRON_ARRAY diff --git a/vos/vos.c b/vos/vos.c index 0b3c334e789b..e2e9b16f3e4b 100644 --- a/vos/vos.c +++ b/vos/vos.c @@ -30,7 +30,7 @@ truncate(const char *path, off_t len) int code = -1; if (fd >= 0) { code = ftruncate(fd,len); - close(fd); + close(fd); } return code; } diff --git a/vutil.c b/vutil.c index 200ff73cb659..26ff8b5f6536 100644 --- a/vutil.c +++ b/vutil.c @@ -333,9 +333,9 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) orev = rev; rev += (*s - '0') * mult; mult /= 10; - if ( (PERL_ABS(orev) > PERL_ABS(rev)) + if ( (PERL_ABS(orev) > PERL_ABS(rev)) || (PERL_ABS(rev) > VERSION_MAX )) { - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in version %d",VERSION_MAX); s = end - 1; rev = VERSION_MAX; @@ -351,16 +351,16 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) orev = rev; rev += (*end - '0') * mult; mult *= 10; - if ( (PERL_ABS(orev) > PERL_ABS(rev)) + if ( (PERL_ABS(orev) > PERL_ABS(rev)) || (PERL_ABS(rev) > VERSION_MAX )) { - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in version"); end = s - 1; rev = VERSION_MAX; vinf = 1; } } - } + } } /* Append revision */ @@ -468,7 +468,7 @@ Perl_new_version(pTHX_ SV *ver) AV * const av = newAV(); AV *sav; /* This will get reblessed later if a derived class*/ - SV * const hv = newSVrv(rv, "version"); + SV * const hv = newSVrv(rv, "version"); (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */ #ifndef NODEFAULT_SHAREKEYS HvSHAREKEYS_on(hv); /* key-sharing on by default */ @@ -585,7 +585,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) { STRLEN len; - /* may get too much accuracy */ + /* may get too much accuracy */ char tbuf[64]; SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0; char *buf; @@ -676,8 +676,8 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) } s = SCAN_VERSION(version, ver, qv); - if ( *s != '\0' ) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + if ( *s != '\0' ) + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Version string '%s' contains invalid data; " "ignoring: '%s'", version, s); @@ -954,7 +954,7 @@ Perl_vstringify(pTHX_ SV *vs) /* =for apidoc vcmp -Version object aware cmp. Both operands must already have been +Version object aware cmp. Both operands must already have been converted into version objects. =cut diff --git a/win32/fcrypt.c b/win32/fcrypt.c index ec689e57dfc4..2a5a83a36710 100644 --- a/win32/fcrypt.c +++ b/win32/fcrypt.c @@ -383,7 +383,7 @@ des_set_key(des_cblock *key, des_key_schedule schedule) /* table contained 0213 4657 */ *(k++)=((t<<16)|(s&0x0000ffff))&0xffffffff; s= ((s>>16)|(t&0xffff0000)); - + s=(s<<4)|(s>>28); *(k++)=s&0xffffffff; } @@ -395,7 +395,7 @@ des_set_key(des_cblock *key, des_key_schedule schedule) ******************************************************************/ /* The changes to this macro may help or hinder, depending on the - * compiler and the achitecture. gcc2 always seems to do well :-). + * compiler and the achitecture. gcc2 always seems to do well :-). * Inspired by Dana How * DO NOT use the alternative version on machines with 8 byte longs. */ @@ -526,7 +526,7 @@ des_fcrypt(const char *buf, const char *salt, char *buff) return buff; } -static int +static int body( unsigned long *out0, unsigned long *out1, des_key_schedule ks, diff --git a/win32/include/arpa/inet.h b/win32/include/arpa/inet.h index 0303df0876b7..faadf1c7e863 100644 --- a/win32/include/arpa/inet.h +++ b/win32/include/arpa/inet.h @@ -1,4 +1,4 @@ -/* - * this is a dummy header file for Socket.xs +/* + * this is a dummy header file for Socket.xs */ diff --git a/win32/include/dirent.h b/win32/include/dirent.h index 503782542579..fc3ada43ac1b 100644 --- a/win32/include/dirent.h +++ b/win32/include/dirent.h @@ -22,7 +22,7 @@ #define DIRENT direct /* structure of a directory entry */ -typedef struct direct +typedef struct direct { long d_ino; /* inode number (not used by MS-DOS) */ long d_namlen; /* name length */ diff --git a/win32/perlglob.c b/win32/perlglob.c index 8add30f2a52e..f71238b0987a 100644 --- a/win32/perlglob.c +++ b/win32/perlglob.c @@ -36,10 +36,10 @@ main(int argc, char *argv[]) /* check out the file system characteristics */ if (GetFullPathName(".", MAX_PATH, root, &dummy)) { - dummy = strchr(root,'\\'); + dummy = strchr(root,'\\'); if (dummy) *++dummy = '\0'; - if (GetVolumeInformation(root, volname, MAX_PATH, + if (GetVolumeInformation(root, volname, MAX_PATH, &serial, &maxname, &flags, 0, 0)) { downcase = !(flags & FS_CASE_IS_PRESERVED); } diff --git a/win32/perlhost.h b/win32/perlhost.h index 265328b69b7f..42491fd2b78d 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -978,7 +978,7 @@ PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) int retval; /* mauke says using memcpy avoids alignment issues */ - memcpy(&u_long_arg, data, sizeof u_long_arg); + memcpy(&u_long_arg, data, sizeof u_long_arg); retval = win32_ioctlsocket((SOCKET)i, (long)u, &u_long_arg); memcpy(data, &u_long_arg, sizeof u_long_arg); return retval; @@ -1708,9 +1708,9 @@ win32_start_child(LPVOID arg) #else w32_pseudo_id = GetCurrentThreadId(); #endif -#ifdef PERL_USES_PL_PIDSTATUS +#ifdef PERL_USES_PL_PIDSTATUS hv_clear(PL_pidstatus); -#endif +#endif /* create message window and tell parent about it */ parent_message_hwnd = w32_message_hwnd; @@ -2190,7 +2190,7 @@ CPerlHost::Add(LPCSTR lpStr) // replacing ? lpPtr = Lookup(szBuffer); if (lpPtr != NULL) { - // must allocate things via host memory allocation functions + // must allocate things via host memory allocation functions // rather than perl's Renew() et al, as the perl interpreter // may either not be initialized enough when we allocate these, // or may already be dead when we go to free these diff --git a/win32/perllib.c b/win32/perllib.c index 0e44a247beae..1879227c5736 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -293,7 +293,7 @@ BOOL APIENTRY DllMain(HINSTANCE hModule, /* DLL module handle */ DWORD fdwReason, /* reason called */ LPVOID lpvReserved) /* reserved */ -{ +{ switch (fdwReason) { /* The DLL is attaching to a process due to process * initialization or a call to LoadLibrary. @@ -316,7 +316,7 @@ DllMain(HINSTANCE hModule, /* DLL module handle */ A. Not called at all. B. Called after memory allocation for Heap has been forcibly removed by OS. PerlIO_cleanup() was done here but fails (B). - */ + */ EndSockets(); #if defined(USE_ITHREADS) if (PL_curinterp) @@ -359,6 +359,6 @@ perl_clone_host(PerlInterpreter* proto_perl, UV flags) { proto_perl->Isys_intern.internal_host = h; h->host_perl = proto_perl; return proto_perl; - + } #endif diff --git a/win32/perlmaince.c b/win32/perlmaince.c index ced3b86cc08f..f2915db2cdc0 100644 --- a/win32/perlmaince.c +++ b/win32/perlmaince.c @@ -5,9 +5,9 @@ #ifdef __GNUC__ -/* Mingw32 defaults to globing command line - * This is inconsistent with other Win32 ports and - * seems to cause trouble with passing -DXSVERSION=\"1.6\" +/* Mingw32 defaults to globing command line + * This is inconsistent with other Win32 ports and + * seems to cause trouble with passing -DXSVERSION=\"1.6\" * So we turn it off like this: */ int _CRT_glob = 0; diff --git a/win32/runperl.c b/win32/runperl.c index b76f8ba2d2be..fd647e419847 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -3,9 +3,9 @@ #ifdef __GNUC__ -/* Mingw32 defaults to globing command line - * This is inconsistent with other Win32 ports and - * seems to cause trouble with passing -DXSVERSION=\"1.6\" +/* Mingw32 defaults to globing command line + * This is inconsistent with other Win32 ports and + * seems to cause trouble with passing -DXSVERSION=\"1.6\" * So we turn it off like this, but only when compiling * perlmain.c: perlmainst.c is linked into the same executable * as win32.c, which also does this, so we mustn't do it twice diff --git a/win32/vdir.h b/win32/vdir.h index a4186a1ad9f5..1de8730b137f 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -1,6 +1,6 @@ /* vdir.h * - * (c) 1999 Microsoft Corporation. All rights reserved. + * (c) 1999 Microsoft Corporation. All rights reserved. * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/ * * You may distribute under the terms of either the GNU General Public @@ -392,7 +392,7 @@ char *VDir::MapPathA(const char *pInName) if (length > MAX_PATH) { strncpy(szlBuf, pInName, MAX_PATH); - if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { + if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { /* absolute path - reduce length by 2 for drive specifier */ szlBuf[MAX_PATH-2] = '\0'; } @@ -620,7 +620,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) if (length > MAX_PATH) { wcsncpy(szlBuf, pInName, MAX_PATH); - if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { + if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { /* absolute path - reduce length by 2 for drive specifier */ szlBuf[MAX_PATH-2] = '\0'; } diff --git a/win32/vmem.h b/win32/vmem.h index d691635db591..d947af60b992 100644 --- a/win32/vmem.h +++ b/win32/vmem.h @@ -1,6 +1,6 @@ /* vmem.h * - * (c) 1999 Microsoft Corporation. All rights reserved. + * (c) 1999 Microsoft Corporation. All rights reserved. * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/ * * You may distribute under the terms of either the GNU General Public @@ -40,7 +40,7 @@ inline void MEMODS(char *str) inline void MEMODSlx(char *str, long x) { - char szBuffer[512]; + char szBuffer[512]; sprintf(szBuffer, "%s %lx\n", str, x); OutputDebugString(szBuffer); } @@ -64,7 +64,7 @@ inline void MEMODSlx(char *str, long x) // #define _USE_LINKED_LIST #endif -/* +/* * Pass all memory requests through to the compiler's msvcr*.dll. * Optionaly track by using a doubly linked header. */ @@ -199,10 +199,10 @@ void VMem::Free(void* pMem) #if 1 int *nowhere = NULL; Perl_warn_nocontext("Free to wrong pool %p not %p",this,ptr->owner); - *nowhere = 0; /* this segfault is deliberate, + *nowhere = 0; /* this segfault is deliberate, so you can see the stack trace */ #else - ptr->owner->Free(pMem); + ptr->owner->Free(pMem); #endif } return; @@ -236,7 +236,7 @@ int VMem::IsLocked(void) { #if 0 /* XXX TryEnterCriticalSection() is not available in some versions - * of Windows 95. Since this code is not used anywhere yet, we + * of Windows 95. Since this code is not used anywhere yet, we * skirt the issue for now. */ BOOL bAccessed = TryEnterCriticalSection(&m_cs); if(bAccessed) { @@ -275,7 +275,7 @@ long VMem::AddRef(void) * The size is stored in these tags as a long word, and includes the 8 bytes * of overhead that the boundary tags consume. Blocks are allocated on long * word boundaries, so the size is always multiples of long words. When the - * block is allocated, bit 0, (the tag bit), of the size is set to 1. When + * block is allocated, bit 0, (the tag bit), of the size is set to 1. When * a block is freed, it is merged with adjacent free blocks, and the tag bit * is set to 0. * @@ -286,7 +286,7 @@ long VMem::AddRef(void) * * Since memory allocation may occur on a single threaded, explict locks are not * provided. - * + * */ const long lAllocStart = 0x00020000; /* start at 128K */ @@ -379,7 +379,7 @@ typedef struct _FreeListEntry /* * performance tuning * Use VirtualAlloc() for blocks bigger than nMaxHeapAllocSize since - * Windows 95/98/Me have heap managers that are designed for memory + * Windows 95/98/Me have heap managers that are designed for memory * blocks smaller than four megabytes. */ @@ -475,8 +475,8 @@ class VMem PBLOCK m_pFreeList; // pointer to first block on free list #endif PBLOCK m_pRover; // roving pointer into the free list - HeapRec m_heaps[maxHeaps]; // list of all non-contiguous heap areas - int m_nHeaps; // no. of heaps in m_heaps + HeapRec m_heaps[maxHeaps]; // list of all non-contiguous heap areas + int m_nHeaps; // no. of heaps in m_heaps long m_lAllocSize; // current alloc size long m_lRefCount; // number of current users CRITICAL_SECTION m_cs; // access lock @@ -689,7 +689,7 @@ void* VMem::Malloc(size_t size) lsize = SIZE(ptr); ASSERT((lsize&1)==0); /* is block big enough? */ - if(lsize >= realsize) { + if(lsize >= realsize) { /* if the remainder is too small, don't bother splitting the block. */ rem = lsize - realsize; if(rem < minAllocSize) { @@ -881,7 +881,7 @@ int VMem::IsLocked(void) { #if 0 /* XXX TryEnterCriticalSection() is not available in some versions - * of Windows 95. Since this code is not used anywhere yet, we + * of Windows 95. Since this code is not used anywhere yet, we * skirt the issue for now. */ BOOL bAccessed = TryEnterCriticalSection(&m_cs); if(bAccessed) { @@ -1095,7 +1095,7 @@ void* VMem::Expand(void* block, size_t size) if((int)realsize < minAllocSize || size == 0) return NULL; - PBLOCK ptr = (PBLOCK)block; + PBLOCK ptr = (PBLOCK)block; /* if the current size is the same as requested, do nothing. */ size_t cursize = SIZE(ptr) & ~1; diff --git a/win32/win32.c b/win32/win32.c index bff5b886ac54..425f19213c4d 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -73,7 +73,7 @@ int _CRT_glob = 0; #endif -#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1) +#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1) /* Mingw32-1.1 is missing some prototypes */ START_EXTERN_C FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode); @@ -187,9 +187,9 @@ set_silent_invalid_parameter_handler(BOOL newvalue) static void my_invalid_parameter_handler(const wchar_t* expression, - const wchar_t* function, - const wchar_t* file, - unsigned int line, + const wchar_t* function, + const wchar_t* file, + unsigned int line, uintptr_t pReserved) { # ifdef _DEBUG @@ -1760,14 +1760,14 @@ win32_getenvironmentstrings(void) } /* Get the number of bytes required to store the ACP encoded string */ - aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, + aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, NULL, 0, NULL, NULL); lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char)); if(!lpTmp) out_of_memory(); /* Convert the string from UTF-16 encoding to ACP encoding */ - WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr, + WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr, aenvstrings_len, NULL, NULL); return(lpStr); @@ -2110,7 +2110,7 @@ win32_uname(struct utsname *name) /* Timing related stuff */ int -do_raise(pTHX_ int sig) +do_raise(pTHX_ int sig) { if (sig < SIG_SIZE) { Sighandler_t handler = w32_sighandler[sig]; @@ -2146,8 +2146,8 @@ void sig_terminate(pTHX_ int sig) { Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig); - /* exit() seems to be safe, my_exit() or die() is a problem in ^C - thread + /* exit() seems to be safe, my_exit() or die() is a problem in ^C + thread */ exit(sig); } @@ -2198,7 +2198,7 @@ win32_async_check(pTHX) /* Above or other stuff may have set a signal flag */ if (PL_sig_pending) despatch_signals(); - + return 1; } diff --git a/win32/win32io.c b/win32/win32io.c index d183e3bade56..3f62220449ea 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -296,9 +296,9 @@ PerlIOWin32_close(pTHX_ PerlIO *f) PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); if (s->refcnt == 1) { - IV code = 0; + IV code = 0; #if 0 - /* This does not do pipes etc. correctly */ + /* This does not do pipes etc. correctly */ if (!CloseHandle(s->h)) { s->h = INVALID_HANDLE_VALUE; diff --git a/win32/win32sck.c b/win32/win32sck.c index 674add2efc8f..c257e0845647 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -1,6 +1,6 @@ /* win32sck.c * - * (c) 1995 Microsoft Corporation. All rights reserved. + * (c) 1995 Microsoft Corporation. All rights reserved. * Developed by hip communications inc. * Portions (c) 1993 Intergraph Corporation. All rights reserved. * @@ -329,7 +329,7 @@ get_last_socket_error(void) } void -start_sockets(void) +start_sockets(void) { unsigned short version; WSADATA retdata; @@ -584,7 +584,7 @@ win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optle SOCKET_TEST_ERROR(r = setsockopt(TO_SOCKET(s), level, optname, optval, optlen)); return r; } - + int win32_shutdown(SOCKET s, int how) { @@ -626,12 +626,12 @@ open_ifs_socket(int af, int type, int protocol) && error_code == WSAENOBUFS) { WSAPROTOCOL_INFOW *proto_buffers; - int protocols_available = 0; - + int protocols_available = 0; + Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW), WSAPROTOCOL_INFOW); - if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, + if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, &proto_buffers_len, &error_code)) != SOCKET_ERROR) { int i; @@ -788,7 +788,7 @@ win32_getprotobynumber(int num) struct servent * win32_getservbyname(const char *name, const char *proto) { - dTHXa(NULL); + dTHXa(NULL); struct servent *r; SOCKET_TEST(r = getservbyname(name, proto), NULL); @@ -802,7 +802,7 @@ win32_getservbyname(const char *name, const char *proto) struct servent * win32_getservbyport(int port, const char *proto) { - dTHXa(NULL); + dTHXa(NULL); struct servent *r; SOCKET_TEST(r = getservbyport(port, proto), NULL); @@ -816,19 +816,19 @@ win32_getservbyport(int port, const char *proto) int win32_ioctl(int i, unsigned int u, char *data) { - u_long u_long_arg; + u_long u_long_arg; int retval; - + if (!wsock_started) { Perl_croak_nocontext("ioctl implemented only on sockets"); /* NOTREACHED */ } /* mauke says using memcpy avoids alignment issues */ - memcpy(&u_long_arg, data, sizeof u_long_arg); + memcpy(&u_long_arg, data, sizeof u_long_arg); retval = ioctlsocket(TO_SOCKET(i), (long)u, &u_long_arg); memcpy(data, &u_long_arg, sizeof u_long_arg); - + if (retval == SOCKET_ERROR) { int err = get_last_socket_error(); if (err == ENOTSOCK) { @@ -859,7 +859,7 @@ win32_inet_addr(const char FAR *cp) */ void -win32_endhostent() +win32_endhostent() { win32_croak_not_implemented("endhostent"); } @@ -884,35 +884,35 @@ win32_endservent() struct netent * -win32_getnetent(void) +win32_getnetent(void) { win32_croak_not_implemented("getnetent"); return (struct netent *) NULL; } struct netent * -win32_getnetbyname(char *name) +win32_getnetbyname(char *name) { win32_croak_not_implemented("getnetbyname"); return (struct netent *)NULL; } struct netent * -win32_getnetbyaddr(long net, int type) +win32_getnetbyaddr(long net, int type) { win32_croak_not_implemented("getnetbyaddr"); return (struct netent *)NULL; } struct protoent * -win32_getprotoent(void) +win32_getprotoent(void) { win32_croak_not_implemented("getprotoent"); return (struct protoent *) NULL; } struct servent * -win32_getservent(void) +win32_getservent(void) { win32_croak_not_implemented("getservent"); return (struct servent *) NULL; @@ -958,7 +958,7 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) d->s_proto = (char *)proto; else d->s_proto = "tcp"; - + return d; } diff --git a/win32/wincesck.c b/win32/wincesck.c index 9ef025d46cbd..4a8b06f8aa74 100644 --- a/win32/wincesck.c +++ b/win32/wincesck.c @@ -336,19 +336,19 @@ int win32_ioctl(int i, unsigned int u, char *data) { dTHX; - u_long u_long_arg; + u_long u_long_arg; int retval; - + if (!wsock_started) { Perl_croak_nocontext("ioctl implemented only on sockets"); /* NOTREACHED */ } /* mauke says using memcpy avoids alignment issues */ - memcpy(&u_long_arg, data, sizeof u_long_arg); + memcpy(&u_long_arg, data, sizeof u_long_arg); retval = ioctlsocket(TO_SOCKET(i), (long)u, &u_long_arg); memcpy(data, &u_long_arg, sizeof u_long_arg); - + if (retval == SOCKET_ERROR) { if (WSAGetLastError() == WSAENOTSOCK) { Perl_croak_nocontext("ioctl implemented only on sockets"); diff --git a/x2p/a2p.h b/x2p/a2p.h index 1d2a562744b8..8657f6102d59 100644 --- a/x2p/a2p.h +++ b/x2p/a2p.h @@ -136,7 +136,7 @@ char *strcpy(), *strcat(); #ifdef VMS # include "handy.h" -#else +#else # include "../handy.h" #endif diff --git a/x2p/str.c b/x2p/str.c index e12e5e9c1237..ea7fce46514e 100644 --- a/x2p/str.c +++ b/x2p/str.c @@ -124,7 +124,7 @@ STR * str_new(int len) { STR *str; - + if (freestrroot) { str = freestrroot; freestrroot = str->str_link.str_next; @@ -208,7 +208,7 @@ str_gets(STR *str, FILE *fp) } } } - + FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */ FILE_ptr(fp) = ptr; i = getc(fp); /* get more characters */ diff --git a/x2p/walk.c b/x2p/walk.c index 0197feaa58aa..7272397e6275 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -627,7 +627,7 @@ sub Pick {\n\ else tmpstr = str_make(""); sprintf(tokenbuf," = &Getline%d(%s)",len,tmpstr->str_ptr); - str_cat(str,tokenbuf); + str_cat(str,tokenbuf); str_free(tmpstr); if (useval) str_cat(str,",$getline_ok)");