Malloc_t
Perl_safesysmalloc(MEM_SIZE size)
{
+ dTHX;
Malloc_t ptr;
#ifdef HAS_64K_LIMIT
if (size > 0xffff) {
PerlIO_printf(PerlIO_stderr(),
"Allocation too large: %lx\n", size) FLUSH;
- WITH_THX(my_exit(1));
+ my_exit(1);
}
#endif /* HAS_64K_LIMIT */
#ifdef DEBUGGING
Perl_croak_nocontext("panic: malloc");
#endif
ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
-#if !(defined(I286) || defined(atarist))
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
-#else
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
-#endif
if (ptr != Nullch)
return ptr;
else if (PL_nomemok)
return Nullch;
else {
PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
- WITH_THX(my_exit(1));
+ my_exit(1);
return Nullch;
}
/*NOTREACHED*/
Malloc_t
Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
{
+ dTHX;
Malloc_t ptr;
#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
Malloc_t PerlMem_realloc();
if (size > 0xffff) {
PerlIO_printf(PerlIO_stderr(),
"Reallocation too large: %lx\n", size) FLUSH;
- WITH_THX(my_exit(1));
+ my_exit(1);
}
#endif /* HAS_64K_LIMIT */
if (!size) {
#endif
ptr = PerlMem_realloc(where,size);
-#if !(defined(I286) || defined(atarist))
- DEBUG_m( {
- PerlIO_printf(Perl_debug_log, "0x%x: (%05d) rfree\n",where,PL_an++);
- PerlIO_printf(Perl_debug_log, "0x%x: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size);
- } )
-#else
- DEBUG_m( {
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++);
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size);
- } )
-#endif
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size));
if (ptr != Nullch)
return ptr;
return Nullch;
else {
PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
- WITH_THX(my_exit(1));
+ my_exit(1);
return Nullch;
}
/*NOTREACHED*/
Free_t
Perl_safesysfree(Malloc_t where)
{
-#if !(defined(I286) || defined(atarist))
- DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",(char *) where,PL_an++));
-#else
+ dTHX;
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,PL_an++));
-#endif
if (where) {
/*SUPPRESS 701*/
PerlMem_free(where);
Malloc_t
Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
{
+ dTHX;
Malloc_t ptr;
#ifdef HAS_64K_LIMIT
if (size * count > 0xffff) {
PerlIO_printf(PerlIO_stderr(),
"Allocation too large: %lx\n", size * count) FLUSH;
- WITH_THX(my_exit(1));
+ my_exit(1);
}
#endif /* HAS_64K_LIMIT */
#ifdef DEBUGGING
#endif
size *= count;
ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
-#if !(defined(I286) || defined(atarist))
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
-#else
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
-#endif
if (ptr != Nullch) {
memset((void*)ptr, 0, size);
return ptr;
return Nullch;
else {
PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
- WITH_THX(my_exit(1));
+ my_exit(1);
return Nullch;
}
/*NOTREACHED*/
safesysfree(environ[i]);
environ[i] = (char*)safesysmalloc((strlen(nam)+strlen(val)+2) * sizeof(char));
-#ifndef MSDOS
(void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
-#else
- /* MS-DOS requires environment variable names to be in uppercase */
- /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
- * some utilities and applications may break because they only look
- * for upper case strings. (Fixed strupr() bug here.)]
- */
- strcpy(environ[i],nam); strupr(environ[i]);
- (void)sprintf(environ[i] + strlen(nam),"=%s",val);
-#endif /* MSDOS */
#else /* PERL_USE_SAFE_PUTENV */
char *new_env;
new_env = (char*)safesysmalloc((strlen(nam) + strlen(val) + 2) * sizeof(char));
-#ifndef MSDOS
(void)sprintf(new_env,"%s=%s",nam,val);/* all that work just for this */
-#else
- strcpy(new_env,nam); strupr(new_env);
- (void)sprintf(new_env + strlen(nam),"=%s",val);
-#endif
(void)putenv(new_env);
#endif /* PERL_USE_SAFE_PUTENV */
}
/* Needs work for PerlIO ! */
FILE *f = PerlIO_findFILE(ptr);
I32 result = pclose(f);
+#if defined(DJGPP)
+ result = (result << 8) & 0xff00;
+#endif
PerlIO_releaseFILE(ptr,f);
return result;
}
if (!overflowed)
rnv = (NV) ruv;
if ( ( overflowed && rnv > 4294967295.0)
-#if UV_SIZEOF > 4
+#if UVSIZE > 4
|| (!overflowed && ruv > 0xffffffff )
#endif
) {
if (!overflowed)
rnv = (NV) ruv;
if ( ( overflowed && rnv > 4294967295.0)
-#if UV_SIZEOF > 4
+#if UVSIZE > 4
|| (!overflowed && ruv > 0xffffffff )
#endif
) {
if (!overflowed)
rnv = (NV) ruv;
if ( ( overflowed && rnv > 4294967295.0)
-#if UV_SIZEOF > 4
+#if UVSIZE > 4
|| (!overflowed && ruv > 0xffffffff )
#endif
) {