From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Sat, 4 Apr 1998 01:39:03 +0000 (-0500)
Subject: [PATCH 5.004_64] anydbm.t
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3aefca0416eab0f2104345964c03107793baf1d6;p=p5sagit%2Fp5-mst-13.2.git

[PATCH 5.004_64] anydbm.t
Date: Sat, 4 Apr 1998 01:39:03 -0500 (EST)
Subject: [PATCH 5.004_64] threads on OS/2
Date: Sat, 4 Apr 1998 01:44:29 -0500 (EST)
Subject: [PATCH 5.004_64] Better handling of Perl DLLs under OS/2
Date: Sat, 4 Apr 1998 01:47:58 -0500 (EST)
Subject: [PATCH 5.004_64] Immediate stop in debugger
Date: Sat, 11 Apr 1998 19:50:58 -0400 (EDT)
Subject: [PATCH 5.005_64] ptags broken
Date: Sat, 11 Apr 1998 22:08:21 -0400 (EDT)
Subject: [PATCH 5.004_64] Document switch syntax via RE
Date: Sun, 12 Apr 1998 01:12:33 -0400 (EDT)

p4raw-id: //depot/perl@941
---

diff --git a/emacs/ptags b/emacs/ptags
index 8831988..d71d1b3 100755
--- a/emacs/ptags
+++ b/emacs/ptags
@@ -29,10 +29,13 @@ xsfiles="`find . -name '*.xs' -print | sort`"
 ## IEXT char *     Isplitstr IINIT(" ");
 ## dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
 ## PP(pp_const)
+## PERLVARI(Grsfp, PerlIO *, Nullfp)
+## PERLVAR(cvcache,      HV *)
 
 set x	-d -l c \
 	-r '/[dI]?EXT\(CONST\)?[ \t*]+\([a-zA-Z_0-9]+[ \t*]+\)*\([a-zA-Z_0-9]+\)[ \t]*\($\|;\|\[\|[ \t]I+NIT[ \t]*(\|\/\*\)/\3/' \
 	-r '/IEXT[ \t][^\/]*[ \t*]I\([a-zA-Z_][a-zA-Z_0-9]*\)[\[; \t]/\1/'  \
+	-r '/PERLVAR[a-zA-Z_0-9]*[ \t]*([ \t]*[GIT]?\([a-zA-Z_][a-zA-Z_0-9]*\)[ \t]*,/\1/'  \
 	-r '/PP[ \t]*([ \t]*\([^ \t()]*\)[ \t]*)/\1/'
 
 shift
diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm
index 65abfc2..44daa52 100644
--- a/lib/ExtUtils/MM_OS2.pm
+++ b/lib/ExtUtils/MM_OS2.pm
@@ -29,7 +29,8 @@ $self->{BASEEXT}.def: Makefile.PL
      '", "DLBASE" => "',$self->{DLBASE},
      '", "DL_FUNCS" => ',neatvalue($funcs),
      ', "IMPORTS" => ',neatvalue($imports),
-     ', "DL_VARS" => ', neatvalue($vars), ');\'
+     ', "VERSION" => "',$self->{VERSION},
+     '", "DL_VARS" => ', neatvalue($vars), ');\'
 ');
     }
     join('',@m);
diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm
index 4ec091d..48a4b15 100644
--- a/lib/ExtUtils/Mksymlists.pm
+++ b/lib/ExtUtils/Mksymlists.pm
@@ -7,7 +7,7 @@ use Exporter;
 use vars qw( @ISA @EXPORT $VERSION );
 @ISA = 'Exporter';
 @EXPORT = '&Mksymlists';
-$VERSION = substr q$Revision: 1.16 $, 10;
+$VERSION = substr q$Revision: 1.17 $, 10;
 
 sub Mksymlists {
     my(%spec) = @_;
@@ -69,6 +69,8 @@ sub _write_aix {
 
 sub _write_os2 {
     my($data) = @_;
+    require Config;
+    my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
 
     if (not $data->{DLBASE}) {
         ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
@@ -79,6 +81,7 @@ sub _write_os2 {
     open(DEF,">$data->{FILE}.def")
         or croak("Can't create $data->{FILE}.def: $!\n");
     print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
+    print DEF "DESCRIPTION 'Perl (v$]$threaded) module $data->{NAME} v$data->{VERSION}'\n";
     print DEF "CODE LOADONCALL\n";
     print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
     print DEF "EXPORTS\n  ";
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index a4a1b1a..3ca0adc 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -178,7 +178,8 @@ $inhibit_exit = $option{PrintRet} = 1;
 		  globPrint PrintRet UsageOnly frame AutoTrace
 		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
 		  recallCommand ShellBang pager tkRunning ornaments
-		  signalLevel warnLevel dieLevel inhibit_exit);
+		  signalLevel warnLevel dieLevel inhibit_exit
+		  ImmediateStop);
 
 %optionVars    = (
 		 hashDepth	=> \$dumpvar::hashDepth,
@@ -194,6 +195,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		 AutoTrace      => \$trace,
 		 inhibit_exit   => \$inhibit_exit,
 		 maxTraceLen	=> \$maxtrace,
+		 ImmediateStop	=> \$ImmediateStop,
 );
 
 %optionAction  = (
@@ -363,6 +365,9 @@ sub DB {
 	}
 	$single = 0;
 	# return;			# Would not print trace!
+      } elsif ($ImmediateStop) {
+	$ImmediateStop = 0;
+	$signal = 1;
       }
     }
     $runnonstop = 0 if $single or $signal; # Disable it if interactive.
@@ -1255,6 +1260,10 @@ sub postponed_sub {
 }
 
 sub postponed {
+  if ($ImmediateStop) {
+    $ImmediateStop = 0;
+    $signal = 1;
+  }
   return &postponed_sub
     unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
   # Cannot be done before the file is compiled
@@ -1795,6 +1804,7 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
     I<tkRunning>:			run Tk while prompting (with ReadLine);
     I<signalLevel> I<warnLevel> I<dieLevel>:	level of verbosity;
     I<inhibit_exit>		Allows stepping off the end of the script.
+    I<ImmediateStop>		Debugger should stop as early as possible.
   The following options affect what happens with B<V>, B<X>, and B<x> commands:
     I<arrayDepth>, I<hashDepth>:	print only first N elements ('' for all);
     I<compactDump>, I<veryCompact>:	change style of array and hash dump;
diff --git a/os2/Changes b/os2/Changes
index a46b7a5..344939c 100644
--- a/os2/Changes
+++ b/os2/Changes
@@ -166,3 +166,7 @@ after 5.004_03:
 
 after 5.004_53:
 	Minimal thread support added.  One needs to manually move pthread.h
+
+after 5.004_64:
+	Make DLL names different if thread-enabled.
+	Emit more informative internal DLL descriptions.
diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs
index 57d4260..4ba7a7f 100644
--- a/os2/Makefile.SHs
+++ b/os2/Makefile.SHs
@@ -6,8 +6,17 @@
 # Additional rules supported: perl_, aout_test, aout_install, use them
 # for a.out style perl (which may fork).
 
+perl_version="5.00${PATCHLEVEL}_$SUBVERSION"
+case "$archname" in
+ *-thread)	dll_post=_thr 
+		perl_version="${perl_version}-threaded";;
+ *)		dll_post='' ;;
+esac
+
 $spitshell >>Makefile <<!GROK!THIS!
 
+PERL_VERSION = $perl_version
+
 AOUT_OPTIMIZE = $optimize
 AOUT_CCCMD	= \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
 AOUT_AR		= $aout_ar
@@ -22,13 +31,16 @@ AOUT_CLDFLAGS_DLL	= -Zexe -Zmt -Zcrtdll
 
 LD_OPT		= $optimize
 
+PERL_DLL_BASE	= perl$dll_post
+PERL_DLL	= \$(PERL_DLL_BASE)\$(DLSUFFIX)
+
 !GROK!THIS!
 
 $spitshell >>Makefile <<'!NO!SUBS!'
-$(LIBPERL): perl.imp perl.dll perl5.def
+$(LIBPERL): perl.imp $(PERL_DLL) perl5.def
 	emximp -o $(LIBPERL) perl.imp
 
-$(AOUT_LIBPERL_DLL): perl.imp perl.dll perl5.def
+$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
 	emximp -o $(AOUT_LIBPERL_DLL) perl.imp
 
 perl.imp: perl5.def
@@ -38,12 +50,12 @@ perl.imp: perl5.def
 	echo	'emx_malloc		emxlibcm	402	?' >> $@
 	echo	'emx_realloc		emxlibcm	403	?' >> $@
 
-perl.dll: $(obj) perl5.def perl$(OBJ_EXT)
+$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
 	$(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def
 
 perl5.def: perl.linkexp
-	echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE"	> $@
-	echo DESCRIPTION "'Perl interpreter, export autogenerated'"	>>$@
+	echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE"	> $@
+	echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated'"	>>$@
 	echo STACKSIZE 32768				>>$@
 	echo CODE LOADONCALL				>>$@
 	echo DATA LOADONCALL NONSHARED MULTIPLE		>>$@
@@ -68,7 +80,7 @@ perl.exports: perl.exp EXTERN.h perl.h
 		$(CC) -DEMBED  -E - | \
 		awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
 
-perl.linkexp: perl.exports perl.map
+perl.linkexp: perl.exports perl.map  os2/os2.sym
 	cat perl.exports os2/os2.sym perl.map | sort | uniq -d | sed -e 's/\w\+/  "\0"/' > perl.linkexp
 
 # We link miniperl statically, since .DLL depends on $(DYNALOADER) 
diff --git a/os2/os2.c b/os2/os2.c
index f24c3af..cb83736 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -40,16 +40,16 @@ const char *pthreads_states[] = {
 
 typedef struct {
     void *status;
-    pthread_cond_t cond;
+    perl_cond cond;
     enum pthreads_state state;
 } thread_join_t;
 
 thread_join_t *thread_join_data;
 int thread_join_count;
-pthread_mutex_t start_thread_mutex;
+perl_mutex start_thread_mutex;
 
 int
-pthread_join(pthread_t tid, void **status)
+pthread_join(perl_os_thread tid, void **status)
 {
     MUTEX_LOCK(&start_thread_mutex);
     switch (thread_join_data[tid].state) {
@@ -117,7 +117,7 @@ pthread_startit(void *arg)
 }
 
 int
-pthread_create(pthread_t *tid, const pthread_attr_t *attr, 
+pthread_create(perl_os_thread *tid, const pthread_attr_t *attr, 
 	       void *(*start_routine)(void*), void *arg)
 {
     void *args[2];
@@ -134,7 +134,7 @@ pthread_create(pthread_t *tid, const pthread_attr_t *attr,
 }
 
 int 
-pthread_detach(pthread_t tid)
+pthread_detach(perl_os_thread tid)
 {
     MUTEX_LOCK(&start_thread_mutex);
     switch (thread_join_data[tid].state) {
@@ -157,7 +157,7 @@ pthread_detach(pthread_t tid)
 
 /* This is a very bastardized version: */
 int
-os2_cond_wait(pthread_cond_t *c, pthread_mutex_t *m)
+os2_cond_wait(perl_cond *c, perl_mutex *m)
 {						
     int rc;
     if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET))
@@ -881,6 +881,9 @@ mod2fname(sv)
 	}
 	avlen --;
     }
+#ifdef USE_THREADS
+    sum++;				/* Avoid conflict of DLLs in memory. */
+#endif 
     fname[pos] = 'A' + (sum % 26);
     fname[pos + 1] = 'A' + (sum / 26 % 26);
     fname[pos + 2] = '\0';
diff --git a/os2/os2thread.h b/os2/os2thread.h
index 44dec3f..d56fe16 100644
--- a/os2/os2thread.h
+++ b/os2/os2thread.h
@@ -1,10 +1,16 @@
 #include <sys/builtin.h>
 #include <sys/fmutex.h>
 #include <sys/rmutex.h>
-typedef int pthread_t;
-typedef _rmutex pthread_mutex_t;
-/*typedef HEV pthread_cond_t;*/
-typedef unsigned long pthread_cond_t;
-typedef int pthread_key_t;
+typedef int perl_os_thread;
+
+typedef _rmutex perl_mutex;
+
+/*typedef HEV perl_cond;*/	/* Will include os2.h into all C files.  */
+typedef unsigned long perl_cond;
+
+typedef int perl_key;
+
 typedef unsigned long pthread_attr_t;
 #define PTHREADS_INCLUDED
+#define pthread_attr_init(arg) 0
+#define pthread_attr_setdetachstate(arg1,arg2) 0
diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod
index 205be7d..f791370 100644
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -409,6 +409,18 @@ or
 	$nothing = 1;
     }
 
+or, using experimental C<EVAL blocks> of regular expressions
+(see L<perlre/"(?{ code })">),
+
+	/ ^abc (?{ $abc = 1 })
+         |
+	  ^def (?{  $def = 1 })
+	 |
+	  ^xyz (?{ $xyz = 1 })
+	 |
+	  (?{ $nothing = 1 })
+	/x;
+
 or even, horrors,
 
     if (/^abc/)
diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index 3ab609c..0391b7b 100755
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -12,7 +12,7 @@ use Fcntl;
 
 print "1..12\n";
 
-unlink <Op_dbmx.*>;
+unlink <Op_dbmx*>;
 
 umask(0);
 print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
@@ -20,7 +20,7 @@ print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
 
 $Dfile = "Op_dbmx.pag";
 if (! -e $Dfile) {
-	($Dfile) = <Op_dbmx.*>;
+	($Dfile) = <Op_dbmx*>;
 }
 if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
@@ -33,7 +33,7 @@ else {
 while (($key,$value) = each(%h)) {
     $i++;
 }
-print (!$i ? "ok 3\n" : "not ok 3\n");
+print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
 
 $h{'goner1'} = 'snork';