From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 4 Nov 1999 08:01:25 +0000 (+0000)
Subject: Incremental Mac integration from Matthias.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=da9274502cf796d52a9875e4c9f650b53901ad73;p=p5sagit%2Fp5-mst-13.2.git

Incremental Mac integration from Matthias.

p4raw-id: //depot/cfgperl@4512
---

diff --git a/perl.c b/perl.c
index 0651279..e7b6771 100644
--- a/perl.c
+++ b/perl.c
@@ -1131,7 +1131,7 @@ S_run_body(pTHX_ va_list args)
 
 	if (PL_minus_c) {
 #ifdef MACOS_TRADITIONAL
-	    PerlIO_printf(PerlIO_stderr(), "# %s syntax OK\n", MPWFileName(PL_origfilename));
+	    PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", MPWFileName(PL_origfilename));
 #else
 	    PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
 #endif	    
diff --git a/perl.h b/perl.h
index a4737af..bf8b842 100644
--- a/perl.h
+++ b/perl.h
@@ -3033,6 +3033,34 @@ typedef struct am_table_short AMTS;
 #endif
 
 /*
+ * Some operating systems are stingy with stack allocation,
+ * so perl may have to guard against stack overflow.
+ */
+#ifndef PERL_STACK_OVERFLOW_CHECK
+#define PERL_STACK_OVERFLOW_CHECK()  0
+#endif
+
+/*
+ * Some nonpreemptive operating systems find it convenient to
+ * check for asynchronous conditions after each op execution.
+ * Keep this check simple, or it may slow down execution
+ * massively.
+ */
+#ifndef PERL_ASYNC_CHECK
+#define PERL_ASYNC_CHECK()  0
+#endif
+
+/*
+ * On some operating systems, a memory allocation may succeed,
+ * but put the process too close to the system's comfort limit.
+ * In this case, PERL_ALLOC_CHECK frees the pointer and sets
+ * it to NULL.
+ */
+#ifndef PERL_ALLOC_CHECK
+#define PERL_ALLOC_CHECK(p)  0
+#endif
+
+/*
  * nice_chunk and nice_chunk size need to be set
  * and queried under the protection of sv_mutex
  */
diff --git a/pp_ctl.c b/pp_ctl.c
index e9a4f75..3ae6b34 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2112,9 +2112,7 @@ PP(pp_goto)
 		if (CvDEPTH(cv) < 2)
 		    (void)SvREFCNT_inc(cv);
 		else {	/* save temporaries on recursion? */
-#ifdef MACOS_TRADITIONAL
-		    MacStackAttack();
-#endif
+		    PERL_STACK_OVERFLOW_CHECK();
 		    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
 			sub_crush_depth(cv);
 		    if (CvDEPTH(cv) > AvFILLp(padlist)) {
diff --git a/pp_hot.c b/pp_hot.c
index 60dcd7d..6f6780e 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2477,9 +2477,7 @@ try_autoload:
 	if (CvDEPTH(cv) < 2)
 	    (void)SvREFCNT_inc(cv);
 	else {	/* save temporaries on recursion? */
-#ifdef MACOS_TRADITIONAL
-	    MacStackAttack();
-#endif
+	    PERL_STACK_OVERFLOW_CHECK();
 	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
 		AV *av;
 		AV *newpad = newAV();
diff --git a/run.c b/run.c
index cd831cb..5734fdb 100644
--- a/run.c
+++ b/run.c
@@ -23,9 +23,7 @@ Perl_runops_standard(pTHX)
     dTHR;
 
     while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) {
-#ifdef MACOS_TRADITIONAL
-	MACPERL_DO_ASYNC_TASKS();
-#endif	
+	PERL_ASYNC_CHECK();
     }
 
     TAINT_NOT;
@@ -44,9 +42,7 @@ Perl_runops_debug(pTHX)
     }
 
     do {
-#ifdef MACOS_TRADITIONAL
-	MACPERL_DO_ASYNC_TASKS();
-#endif	
+	PERL_ASYNC_CHECK();
 	if (PL_debug) {
 	    if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
 		PerlIO_printf(Perl_debug_log,
diff --git a/sv.c b/sv.c
index c107df4..0ec8029 100644
--- a/sv.c
+++ b/sv.c
@@ -5204,6 +5204,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		eptr = va_arg(*args, char*);
 		if (eptr)
 #ifdef MACOS_TRADITIONAL
+		  /* On MacOS, %#s format is used for Pascal strings */
 		  if (alt)
 		    elen = *eptr++;
 		  else
diff --git a/t/pod/testpchk.pl b/t/pod/testpchk.pl
index 07236e6..640226b 100644
--- a/t/pod/testpchk.pl
+++ b/t/pod/testpchk.pl
@@ -30,20 +30,7 @@ sub stripname( $ ) {
 }
 
 sub msgcmp( $ $ ) {
-   ## filter out platform-dependent aspects of error messages
    my ($line1, $line2) = @_;
-   for ($line1, $line2) {
-      if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) {
-          my $fname = $1;
-          s/^#*\s*//  if ($^O eq 'MacOS');
-          s/^\s*\Q$fname\E/stripname($fname)/e;
-      }
-      elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) {
-          s/^#*\s*//  if ($^O eq 'MacOS');
-          s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e;
-          s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e;
-      }
-   }
    return $line1 ne $line2;
 }
 
diff --git a/toke.c b/toke.c
index 197609a..69e2873 100644
--- a/toke.c
+++ b/toke.c
@@ -456,9 +456,7 @@ S_incline(pTHX_ char *s)
     char ch;
     int sawline = 0;
 
-#ifdef MACOS_TRADITIONAL
-    MACPERL_DO_ASYNC_TASKS();
-#endif	
+    PERL_ASYNC_CHECK();
     PL_curcop->cop_line++;
     if (*s++ != '#')
 	return;
@@ -2558,7 +2556,7 @@ Perl_yylex(pTHX)
 #endif
     case ' ': case '\t': case '\f': case 013:
 #ifdef MACOS_TRADITIONAL
-    case '\312':
+    case '\312': /* Them nonbreaking spaces again */
 #endif
 	s++;
 	goto retry;
@@ -6996,35 +6994,20 @@ Perl_yyerror(pTHX_ char *s)
 	    Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
 	where = SvPVX(where_sv);
     }
-#ifdef MACOS_TRADITIONAL
-    msg = sv_2mortal(newSVpv("# ", 0));
-    sv_catpvf(msg, "%s, ", s);
-#else
     msg = sv_2mortal(newSVpv(s, 0));
     Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
               GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
-#endif
     if (context)
 	Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
     else
 	Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
     if (PL_multi_start < PL_multi_end &&
 	(U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
-#ifdef MACOS_TRADITIONAL
-        Perl_sv_catpvf(aTHX_ msg,
-        "#   (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
-                (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
-#else
         Perl_sv_catpvf(aTHX_ msg,
         "   (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
                 (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
-#endif
         PL_multi_end = 0;
     }
-#ifdef MACOS_TRADITIONAL
-    MacPosIndication(msg, SvPVX(GvSV(PL_curcop->cop_filegv)), PL_curcop->cop_line);
-    sv_catpvn(msg, "\n", 1);
-#endif
     if (PL_in_eval & EVAL_WARNONLY)
 	Perl_warn(aTHX_ "%_", msg);
     else
diff --git a/util.c b/util.c
index cc09a64..22a287f 100644
--- a/util.c
+++ b/util.c
@@ -78,11 +78,6 @@ long lastxycount[MAXXCOUNT][MAXYCOUNT];
  * XXX This advice seems to be widely ignored :-(   --AD  August 1996.
  */
 
-#ifdef MACOS_TRADITIONAL
-extern void * gSacrificialGoat;
-#define MAC_CHECK_GOAT(p) if (!gSacrificialGoat && p) { PerlMem_free(p); p = NULL; } else 
-#endif
-
 Malloc_t
 Perl_safesysmalloc(MEM_SIZE size)
 {
@@ -100,9 +95,7 @@ Perl_safesysmalloc(MEM_SIZE size)
 	Perl_croak_nocontext("panic: malloc");
 #endif
     ptr = PerlMem_malloc(size?size:1);	/* malloc(0) is NASTY on our system */
-#ifdef MACOS_TRADITIONAL
-    MAC_CHECK_GOAT(ptr);
-#endif
+    PERL_ALLOC_CHECK(ptr);
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) malloc %ld bytes\n",PTR2UV(ptr),PL_an++,(long)size));
     if (ptr != Nullch)
 	return ptr;
@@ -146,10 +139,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 	Perl_croak_nocontext("panic: realloc");
 #endif
     ptr = PerlMem_realloc(where,size);
-
-#ifdef MACOS_TRADITIONAL
-    MAC_CHECK_GOAT(ptr);
-#endif
+    PERL_ALLOC_CHECK(ptr);
  
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) rfree\n",PTR2UV(where),PL_an++));
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) realloc %ld bytes\n",PTR2UV(ptr),PL_an++,(long)size));
@@ -200,9 +190,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 #endif
     size *= count;
     ptr = PerlMem_malloc(size?size:1);	/* malloc(0) is NASTY on our system */
-#ifdef MACOS_TRADITIONAL
-    MAC_CHECK_GOAT(ptr);
-#endif
+    PERL_ALLOC_CHECK(ptr);
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) calloc %ld x %ld bytes\n",PTR2UV(ptr),PL_an++,(long)count,(long)size));
     if (ptr != Nullch) {
 	memset((void*)ptr, 0, size);
@@ -1428,14 +1416,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
     SV *sv = mess_alloc();
     static char dgd[] = " during global destruction.\n";
 
-#ifdef MACOS_TRADITIONAL
-    sv_setpv(sv, "# ");
-    sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
-    if (SvPVX(sv)[2] == '#')
-	sv_insert(sv, 0, 2, "", 0);
-#else
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
-#endif
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
 	dTHR;
 	if (PL_curcop->cop_line)
@@ -1454,12 +1435,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 	    Perl_sv_catpvf(aTHX_ sv, " thread %ld", thr->tid);
 #endif
 	sv_catpv(sv, PL_dirty ? dgd : ".\n");
-#ifdef MACOS_TRADITIONAL
-	    if (PL_curcop->cop_line) {
-	    	MPWPosIndication(sv, SvPVX(GvSV(PL_curcop->cop_filegv)), PL_curcop->cop_line);
-	    	sv_catpv(sv, "\n");
-	    }
-#endif
     }
     return sv;
 }
@@ -1629,9 +1604,6 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
 	errno = e;
 #endif
     }
-#ifdef MACOS_TRADITIONAL
-    MacPosCommit();
-#endif
     my_failure_exit();
 }