perl5.005_03 (stock)

12 files changed, 1362 insertions, 466 deletions

diff --git a/gnu/usr.bin/perl/os2/Changes b/gnu/usr.bin/perl/os2/Changes
index 4e0c4d49b53..d15e74e6268 100644
--- a/gnu/usr.bin/perl/os2/Changes
+++ b/gnu/usr.bin/perl/os2/Changes
@@ -163,3 +163,61 @@ after 5.004_03:
 	changes to errno?)
 	$0 may be edited to longer lengths (at least under OS/2).
 	OS2::REXX->loads looks in the OS/2-ish fashion too.
+
+after 5.004_04:
+	Default perl.exe was built with a shorter stack than expected.
+	Strip extensions DLLs too (unless debugging build).
+	./os2.c being RO could stop cp.
+	When starting scripts, Perl will find them on path (using the same
+	  extensions as for -S command-line switch).  If it finds magic
+	  `extproc ' or `#!' cookies, it will start the scripts directly.
+	May use `cmd /c more <' as a pager.
+	If a program could not be started, this might have been hidden.
+	End of pipe was closed twice when `open'ing a pipeline.
+
+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.
+
+5.004_72:
+	Updated OS2::Process (v0.2) included.
+	
+after 5.004_73:
+	Fixed a bug with argv not NULL-terminated when starting scripts.
+	Support all the forms of starting scripts.
+	Support killing a child when receiving a signal during system()
+	(in two stage, on first send the same signal, on the next
+	send SIGKILL).
+	Add the same logic for scripts as in pdksh, including 
+		stripping the path from #! line if needed, 
+		calling EXECSHELL or COMSPEC for magic-less scripts;
+	Now pdksh is called only if one-arg system()/friends contains
+	metachars, or if magic-line asks for sh, or there is no magic
+	line and EXECSHELL is set to sh.
+	Shell is supplied the original command line if possible.
+
+after 5.005_02:
+	Can start PM programs from non-PM sessions by plain system()
+		and friends.  Can start DOS/Win programs.  Can start
+		fullscreen programs from non-fullscreen sessions too.
+	In fact system(P_PM,...) was broken.
+	We mangle the name of perl*.DLL, to allow coexistence of different
+		versions of Perl executables on the system.  Mangling of
+		names of extension DLL is also changed, thus running two
+		different versions of the executable with loaded
+		extensions should not lead to conflicts (since 
+		extension-full-name and Perl-version mangling work in the 
+		same set ot 576 possible keys, this may lead to clashes).
+	$^E was reset on the second read, and contained ".\r\n" at the end.
+after 5.005_53:
+	Would segfault system()ing non-existing program;
+	AOUT build was hosed;
+	warning-test for getpriority() might lock the system hard on 
+		pre-fixpak22 configuration (calling getpriority() on 
+		non-existing process triggers a system-wide bug).
+
+
+	PrfDB was using a bug in processing XSUBs returning U32.
diff --git a/gnu/usr.bin/perl/os2/Makefile.SHs b/gnu/usr.bin/perl/os2/Makefile.SHs
index 493aeab8c59..c9bf39a1e23 100644
--- a/gnu/usr.bin/perl/os2/Makefile.SHs
+++ b/gnu/usr.bin/perl/os2/Makefile.SHs
@@ -6,9 +6,21 @@
 # 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*)	perl_version="${perl_version}-threaded";;
+esac
+
+dll_post="`echo $perl_version | sum | awk '{print $1}'`"
+dll_post="`printf '%x' $dll_post | tr '[a-z]' '[A-Z]'`"
+
 $spitshell >>Makefile <<!GROK!THIS!
 
-AOUT_CCCMD	= \$(CC) $aout_ccflags $optimize
+PERL_VERSION = $perl_version
+
+OPTIMIZE	= $optimize
+AOUT_OPTIMIZE	= \$(OPTIMIZE)
+AOUT_CCCMD	= \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
 AOUT_AR		= $aout_ar
 AOUT_OBJ_EXT	= $aout_obj_ext
 AOUT_LIB_EXT	= $aout_lib_ext
@@ -17,17 +29,21 @@ AOUT_CLDFLAGS	= $aout_ldflags
 
 AOUT_LIBPERL_DLL	= libperl_dll$aout_lib_ext
 AOUT_CCCMD_DLL	= \$(CC) -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK
-AOUT_CLDFLAGS_DLL	= -Zexe -Zmt -Zcrtdll
+AOUT_CLDFLAGS_DLL	= -Zexe -Zmt -Zcrtdll -Zstack 32000
 
 LD_OPT		= $optimize
 
+PERL_DLL_BASE	= perl$dll_post
+PERL_DLL	= \$(PERL_DLL_BASE)\$(DLSUFFIX)
+CONFIG_ARGS	= $config_args
+
 !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
@@ -37,26 +53,18 @@ perl.imp: perl5.def
 	echo	'emx_malloc		emxlibcm	402	?' >> $@
 	echo	'emx_realloc		emxlibcm	403	?' >> $@
 
-perl.dll: $(obj) perl5.def perl$(OBJ_EXT)
+perl_dll: $(PERL_DLL)
+
+$(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, built with $(CONFIG_ARGS)'"	>>$@
 	echo STACKSIZE 32768				>>$@
 	echo CODE LOADONCALL				>>$@
 	echo DATA LOADONCALL NONSHARED MULTIPLE		>>$@
 	echo EXPORTS					>>$@
-	echo '  "ctermid"'				>>$@
-	echo '  "get_sysinfo"'				>>$@
-	echo '  "Perl_OS2_init"'			>>$@
-	echo '  "OS2_Perl_data"'			>>$@
-	echo '  "dlopen"'				>>$@
-	echo '  "dlsym"'				>>$@
-	echo '  "dlerror"'				>>$@
-	echo '  "my_tmpfile"'				>>$@
-	echo '  "my_tmpnam"'				>>$@
-	echo '  "my_flock"'				>>$@
 !NO!SUBS!
 
 if [ ! -z "$myttyname" ] ; then
@@ -77,8 +85,8 @@ perl.exports: perl.exp EXTERN.h perl.h
 		$(CC) -DEMBED  -E - | \
 		awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
 
-perl.linkexp: perl.exports perl.map
-	cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/  "\0"/' > perl.linkexp
+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) 
 
@@ -88,28 +96,39 @@ perl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT)
 	rm miniperl.map
 	@./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
 
-depend: os2ish.h dlfcn.h 
+depend: os2ish.h dlfcn.h os2thread.h os2.c
 
 # Stupid make? Needed...
 os2$(OBJ_EXT) : os2.c
 
 os2.c: os2/os2.c os2ish.h
-	cp $< $@
+	cp -f $< $@
 
 dl_os2.c: os2/dl_os2.c os2ish.h
-	cp $< $@
+	cp -f $< $@
 
 os2ish.h: os2/os2ish.h
-	cp $< $@
+	cp -f $< $@
+
+os2thread.h: os2/os2thread.h
+	cp -f $< $@
 
 dlfcn.h: os2/dlfcn.h
-	cp $< $@
+	cp -f $< $@
 
 # This one is compiled OMF, so cannot fork():
 
 perl___: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
 	$(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl___ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs)
 
+# This one is compiled -Zsys, so cannot do many things:
+
+# Remove -Zcrtdll, add -Zsys
+SYS_CLDFLAGS = -Zexe -Zomf -Zmt -Zsys -Zstack 32000
+
+perl_sys: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(CC) $(LARGE) $(SYS_CLDFLAGS) $(CCDLFLAGS) -o perl_sys perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs)
+
 installcmd : 
 	perl -e 'die qq{Give the option INSTALLCMDDIR=... to make!} if $$ARGV[0] eq ""' $(INSTALLCMDDIR)
 	perl os2/perl2cmd.pl $(INSTALLCMDDIR)
@@ -146,8 +165,8 @@ aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit)
 	sh writemain $(DYNALOADER) $(aout_static_lib) > tmp
 	sh mv-if-diff tmp aout_perlmain.c
 
-miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) ext.libs
-	$(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
+miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL)
+	$(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs)
 
 perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
 	$(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
@@ -175,18 +194,55 @@ aout_install.perl: perl_ installperl
 aout_test: perl_
 	- cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_$(EXE_EXT) perl$(EXE_EXT)) && ./perl TEST </dev/tty
 
-lib/auto/OS2/*/%.a : ext/OS2/%/Makefile.aout
-	cd ext/OS2/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "$make config failed, continuing anyway..."
-	cd ext/OS2/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
+# To test with harness, set HARNESS_BAD_EXITCODE=2
 
-lib/auto/*/%.a : ext/%/Makefile.aout
-	cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "$make config failed, continuing anyway..."
-	cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
+sys_test: perl_sys
+	- cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_sys$(EXE_EXT) perl$(EXE_EXT)) && ./perl TEST </dev/tty
+
+sys_harness: perl_sys
+	- cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_sys$(EXE_EXT) perl$(EXE_EXT)) && env HARNESS_BAD_EXITCODE=2 ./perl harness </dev/tty
+
+!NO!SUBS!
+
+# Now we need to find directories in ./ext/ which are two level deep
+
+dirs=''
+preci='ext/%/Makefile.aout '
+for d in ext/*
+do
+	# echo "Checking '$d'..."
+	f="`echo $d/*/Makefile.PL`"
+	# SDBFile/sdbm, skip kid makefile
+	if test ! -e "$d/Makefile.PL" -a ! "$f" = ""; then
+	    dirs="$dirs $d"
+	    preci="$preci $d/%/Makefile.aout"
+	fi
+done
+
+$spitshell >>Makefile <<!GROK!THIS!
+.PRECIOUS : $preci
+
+!GROK!THIS!
+
+for d in $dirs
+do
+    p=`basename $d`
+    $spitshell >>Makefile <<!GROK!THIS!
+lib/auto/$p/*/%.a : ext/$p/%/Makefile.aout
+	@cd ext/$p/\$(basename \$(notdir \$@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
+	cd ext/$p/\$(basename \$(notdir \$@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
 
-.PRECIOUS : ext/%/Makefile.aout ext/OS2/%/Makefile.aout
+$d/%/Makefile.aout : miniperl_
+	cd \$(dir \$@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl 
 
-ext/OS2/%/Makefile.aout : miniperl_
-	cd $(dir $@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl 
+!GROK!THIS!
+
+done
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+lib/auto/*/%.a : ext/%/Makefile.aout
+	@cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
+	cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
 
 ext/%/Makefile.aout : miniperl_
 	cd $(dir $@) ; ../../miniperl_ -I ../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl 
diff --git a/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs b/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs
index a5b2c89ca6f..2ba836c1833 100644
--- a/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs
+++ b/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs
@@ -20,20 +20,20 @@ Prf_Get(HINI hini, PSZ app, PSZ key) {
     BOOL rc;
     SV *sv;
 
-    if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &sv_undef;
+    if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
     sv = newSVpv("", 0);
-    SvGROW(sv, len);
+    SvGROW(sv, len + 1);
     if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
 	|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
 	SvREFCNT_dec(sv);
-	return &sv_undef;
+	return &PL_sv_undef;
     }
     SvCUR_set(sv, len);
     *SvEND(sv) = 0;
     return sv;
 }
 
-U32
+I32
 Prf_GetLength(HINI hini, PSZ app, PSZ key) {
     U32 len;
 
@@ -59,7 +59,7 @@ Prf_Profiles()
     char system[257];
     PRFPROFILE info = { 257, user, 257, system};
     
-    if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &sv_undef;
+    if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
     if (info.cchUserName > 257 || info.cchSysName > 257)
 	die("Panic: Profile names too long");
     av_push(av, newSVpv(user, info.cchUserName - 1));
@@ -110,7 +110,7 @@ Prf_Set(hini, app, key, s, l = (SvPOK(ST(3)) ? SvCUR(ST(3)): -1))
  PSZ s;
  ULONG l;
 
-U32
+I32
 Prf_GetLength(hini, app, key)
  HINI hini;
  PSZ app;
diff --git a/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap b/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap
index 0b91f3750a6..eb2722bda52 100644
--- a/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap
+++ b/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap
@@ -7,7 +7,7 @@ PSZ			T_PVNULL
 #############################################################################
 INPUT
 T_PVNULL
-	$var = ( SvOK($arg) ? ($type)SvPV($arg,na) : NULL )
+	$var = ( SvOK($arg) ? ($type)SvPV($arg,PL_na) : NULL )
 #############################################################################
 OUTPUT
 T_PVNULL
diff --git a/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL b/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL
index b7a295f8575..d3240631646 100644
--- a/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL
+++ b/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL
@@ -3,9 +3,12 @@ use ExtUtils::MakeMaker;
 # the contents of the Makefile that is written.
 WriteMakefile(
     'NAME'	=> 'OS2::Process',
-    'VERSION'	=> '0.1',
+    VERSION_FROM=> 'Process.pm',
     MAN3PODS 	=> ' ', 	# Pods will be built by installman.
     'LIBS'	=> [''],   # e.g., '-lm' 
     'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
     'INC'	=> '',     # e.g., '-I/usr/include/other' 
+    IMPORTS	=> { _16_DosSmSetTitle => 'sesmgr.DOSSMSETTITLE',
+		     # _16_Win16SetTitle => 'pmshapi.93',
+		   },
 );
diff --git a/gnu/usr.bin/perl/os2/OS2/Process/Process.pm b/gnu/usr.bin/perl/os2/OS2/Process/Process.pm
index 9216bb1e055..88de2bfad5f 100644
--- a/gnu/usr.bin/perl/os2/OS2/Process/Process.pm
+++ b/gnu/usr.bin/perl/os2/OS2/Process/Process.pm
@@ -1,8 +1,10 @@
 package OS2::Process;
 
+$VERSION = 0.2;
+
 require Exporter;
 require DynaLoader;
-require AutoLoader;
+#require AutoLoader;
 
 @ISA = qw(Exporter DynaLoader);
 # Items to export into callers namespace by default. Note: do not export
@@ -28,6 +30,22 @@ require AutoLoader;
 	P_UNRELATED
 	P_WAIT
 	P_WINDOWED
+	my_type
+	file_type
+	T_NOTSPEC
+	T_NOTWINDOWCOMPAT
+	T_WINDOWCOMPAT
+	T_WINDOWAPI
+	T_BOUND
+	T_DLL
+	T_DOS
+	T_PHYSDRV
+	T_VIRTDRV
+	T_PROTDLL
+	T_32BIT
+	process_entry
+	set_title
+	get_title
 );
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -56,6 +74,8 @@ bootstrap OS2::Process;
 
 # Preloaded methods go here.
 
+sub get_title () { (process_entry())[0] }
+
 # Autoload methods go after __END__, and are processed by the autosplit program.
 
 1;
@@ -101,9 +121,170 @@ and optionally add PM and session option bits:
 	P_TILDE		= MKS argument passing convention
 	P_UNRELATED	= do not kill child when father terminates
 
+=head2 Access to process properties
+
+Additionaly, subroutines my_type(), process_entry() and
+C<file_type(file)>, get_title() and C<set_title(newtitle)> are implemented.  
+my_type() returns the type of the current process (one of 
+"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
+
+=over
+
+=item C<file_type(file)> 
+
+returns the type of the executable file C<file>, or
+dies on error.  The bits 0-2 of the result contain one of the values
+
+=over
+
+=item C<T_NOTSPEC> (0)
+
+Application type is not specified in the executable header. 
+
+=item C<T_NOTWINDOWCOMPAT> (1)
+
+Application type is not-window-compatible. 
+
+=item C<T_WINDOWCOMPAT> (2)
+
+Application type is window-compatible. 
+
+=item C<T_WINDOWAPI> (3)
+
+Application type is window-API.
+
+=back
+
+The remaining bits should be masked with the following values to
+determine the type of the executable:
+
+=over
+
+=item C<T_BOUND> (8)
+
+Set to 1 if the executable file has been "bound" (by the BIND command)
+as a Family API application. Bits 0, 1, and 2 still apply.
+
+=item C<T_DLL> (0x10)
+
+Set to 1 if the executable file is a dynamic link library (DLL)
+module. Bits 0, 1, 2, 3, and 5 will be set to 0.
+
+=item C<T_DOS> (0x20)
+
+Set to 1 if the executable file is in PC/DOS format. Bits 0, 1, 2, 3,
+and 4 will be set to 0.
+
+=item C<T_PHYSDRV> (0x40)
+
+Set to 1 if the executable file is a physical device driver. 
+
+=item C<T_VIRTDRV> (0x80)
+
+Set to 1 if the executable file is a virtual device driver. 
+
+=item C<T_PROTDLL> (0x100)
+
+Set to 1 if the executable file is a protected-memory dynamic link
+library module.
+
+=item C<T_32BIT> (0x4000)
+
+Set to 1 for 32-bit executable files. 
+
+=back
+
+file_type() may croak with one of the strings C<"Invalid EXE
+signature"> or C<"EXE marked invalid"> to indicate typical error
+conditions.  If given non-absolute path, will look on C<PATH>, will
+add extention F<.exe> if no extension is present (add extension F<.>
+to suppress).
+
+=item process_entry()
+
+returns a list of the following data:
+
+=over
+
+=item 
+
+Title of the process (in the C<Ctrl-Esc> list);
+
+=item 
+
+window handle of switch entry of the process (in the C<Ctrl-Esc> list);
+
+=item 
+
+window handle of the icon of the process;
+
+=item 
+
+process handle of the owner of the entry in C<Ctrl-Esc> list;
+
+=item 
+
+process id of the owner of the entry in C<Ctrl-Esc> list;
+
+=item 
+
+session id of the owner of the entry in C<Ctrl-Esc> list;
+
+=item 
+
+whether visible in C<Ctrl-Esc> list;
+
+=item
+
+whether item cannot be switched to (note that it is not actually
+grayed in the C<Ctrl-Esc> list));
+
+=item 
+
+whether participates in jump sequence;
+
+=item 
+
+program type.  Possible values are: 
+
+     PROG_DEFAULT                       0 
+     PROG_FULLSCREEN                    1 
+     PROG_WINDOWABLEVIO                 2 
+     PROG_PM                            3 
+     PROG_VDM                           4 
+     PROG_WINDOWEDVDM                   7 
+
+Although there are several other program types for WIN-OS/2 programs,
+these do not show up in this field. Instead, the PROG_VDM or
+PROG_WINDOWEDVDM program types are used. For instance, for
+PROG_31_STDSEAMLESSVDM, PROG_WINDOWEDVDM is used. This is because all
+the WIN-OS/2 programs run in DOS sessions. For example, if a program
+is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM
+session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in
+a PROG_VDM session.
+
+
+=back
+
+=item C<set_title(newtitle)> 
+
+- does not work with some windows (if the title is set from the start).  
+This is a limitation of OS/2, in such a case $^E is set to 372 (type
+
+  help 372
+
+for a funny - and wrong  - explanation ;-).
+
+=item get_title() 
+
+is a shortcut implemented via process_entry().
+
+=back
+
 =head1 AUTHOR
 
-Andreas Kaiser <ak@ananke.s.bawue.de>.
+Andreas Kaiser <ak@ananke.s.bawue.de>, 
+Ilya Zakharevich <ilya@math.ohio-state.edu>.
 
 =head1 SEE ALSO
 
diff --git a/gnu/usr.bin/perl/os2/OS2/Process/Process.xs b/gnu/usr.bin/perl/os2/OS2/Process/Process.xs
index bdb2ece7a08..c16d15d0d0f 100644
--- a/gnu/usr.bin/perl/os2/OS2/Process/Process.xs
+++ b/gnu/usr.bin/perl/os2/OS2/Process/Process.xs
@@ -3,6 +3,9 @@
 #include "XSUB.h"
 
 #include <process.h>
+#define INCL_DOS
+#define INCL_DOSERRORS
+#include <os2.h>
 
 static int
 not_here(s)
@@ -133,6 +136,73 @@ int arg;
 #else
 	    goto not_there;
 #endif
+    } else if (name[0] == 'T' && name[1] == '_') {
+	if (strEQ(name, "FAPPTYP_NOTSPEC"))
+#ifdef FAPPTYP_NOTSPEC
+	    return FAPPTYP_NOTSPEC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_NOTWINDOWCOMPAT"))
+#ifdef FAPPTYP_NOTWINDOWCOMPAT
+	    return FAPPTYP_NOTWINDOWCOMPAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_WINDOWCOMPAT"))
+#ifdef FAPPTYP_WINDOWCOMPAT
+	    return FAPPTYP_WINDOWCOMPAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_WINDOWAPI"))
+#ifdef FAPPTYP_WINDOWAPI
+	    return FAPPTYP_WINDOWAPI;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_BOUND"))
+#ifdef FAPPTYP_BOUND
+	    return FAPPTYP_BOUND;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_DLL"))
+#ifdef FAPPTYP_DLL
+	    return FAPPTYP_DLL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_DOS"))
+#ifdef FAPPTYP_DOS
+	    return FAPPTYP_DOS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_PHYSDRV"))
+#ifdef FAPPTYP_PHYSDRV
+	    return FAPPTYP_PHYSDRV;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_VIRTDRV"))
+#ifdef FAPPTYP_VIRTDRV
+	    return FAPPTYP_VIRTDRV;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_PROTDLL"))
+#ifdef FAPPTYP_PROTDLL
+	    return FAPPTYP_PROTDLL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "T_32BIT"))
+#ifdef FAPPTYP_32BIT
+	    return FAPPTYP_32BIT;
+#else
+	    goto not_there;
+#endif
     }
 
     errno = EINVAL;
@@ -143,6 +213,138 @@ not_there:
     return 0;
 }
 
+const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" };
+
+static char *
+my_type()
+{
+    int rc;
+    TIB *tib;
+    PIB *pib;
+    
+    if (!(_emx_env & 0x200)) return (char*)ptypes[1]; /* not OS/2. */
+    if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) 
+	return NULL; 
+    
+    return (pib->pib_ultype <= 4 ? (char*)ptypes[pib->pib_ultype] : "UNKNOWN");
+}
+
+static ULONG
+file_type(char *path)
+{
+    int rc;
+    ULONG apptype;
+    
+    if (!(_emx_env & 0x200)) 
+	croak("file_type not implemented on DOS"); /* not OS/2. */
+    if (CheckOSError(DosQueryAppType(path, &apptype))) {
+	if (rc == ERROR_INVALID_EXE_SIGNATURE) 
+	    croak("Invalid EXE signature"); 
+	else if (rc == ERROR_EXE_MARKED_INVALID) {
+	    croak("EXE marked invalid"); 
+	}
+	croak("DosQueryAppType err %ld", rc); 
+    }
+    
+    return apptype;
+}
+
+static void
+fill_swcntrl(SWCNTRL *swcntrlp)
+{
+	 int rc;
+	 PTIB ptib;
+	 PPIB ppib;
+	 HSWITCH hSwitch;    
+	 HWND hwndMe;
+
+	 if (!(_emx_env & 0x200)) 
+	     croak("switch_entry not implemented on DOS"); /* not OS/2. */
+	 if (CheckOSError(DosGetInfoBlocks(&ptib, &ppib)))
+	     croak("DosGetInfoBlocks err %ld", rc);
+	 if (CheckWinError(hSwitch = 
+			   WinQuerySwitchHandle(NULLHANDLE, 
+						(PID)ppib->pib_ulpid)))
+	     croak("WinQuerySwitchHandle err %ld", Perl_rc);
+	 if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp)))
+	     croak("WinQuerySwitchEntry err %ld", rc);
+}
+
+/* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */
+ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
+
+#if 0			/*  Does not work.  */
+static ULONG (*pDosSmSetTitle)(ULONG, PSZ);
+
+static void
+set_title(char *s)
+{
+    SWCNTRL swcntrl;
+    static HMODULE hdosc = 0;
+    BYTE buf[20];
+    long rc;
+
+    fill_swcntrl(&swcntrl);
+    if (!pDosSmSetTitle || !hdosc) {
+	if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc)))
+	    croak("Cannot load SESMGR: no `%s'", buf);
+	if (CheckOSError(DosQueryProcAddr(hdosc, 0, "DOSSMSETTITLE",
+					  (PFN*)&pDosSmSetTitle)))
+	    croak("Cannot load SESMGR.DOSSMSETTITLE, err=%ld", rc);
+    }
+/*     (pDosSmSetTitle)(swcntrl.idSession,s); */
+    rc = ((USHORT)
+          (_THUNK_PROLOG (2+4);
+           _THUNK_SHORT (swcntrl.idSession);
+           _THUNK_FLAT (s);
+           _THUNK_CALLI (*pDosSmSetTitle)));
+    if (CheckOSError(rc))
+	warn("*DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x, *paddr=%x", 
+	     rc, swcntrl.idSession, &_THUNK_FUNCTION(DosSmSetTitle),
+	     pDosSmSetTitle);
+}
+
+#else /* !0 */
+
+static bool
+set_title(char *s)
+{
+    SWCNTRL swcntrl;
+    static HMODULE hdosc = 0;
+    BYTE buf[20];
+    long rc;
+
+    fill_swcntrl(&swcntrl);
+    rc = ((USHORT)
+          (_THUNK_PROLOG (2+4);
+           _THUNK_SHORT (swcntrl.idSession);
+           _THUNK_FLAT (s);
+           _THUNK_CALL (DosSmSetTitle)));
+#if 0
+    if (CheckOSError(rc))
+	warn("DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x", 
+	     rc, swcntrl.idSession, _THUNK_FUNCTION(DosSmSetTitle));
+#endif
+    return !CheckOSError(rc);
+}
+#endif /* !0 */
+
+#if 0			/*  Does not work.  */
+USHORT _THUNK_FUNCTION(Win16SetTitle) ();
+
+static void
+set_title2(char *s)
+{
+    long rc;
+
+    rc = ((USHORT)
+          (_THUNK_PROLOG (4);
+           _THUNK_FLAT (s);
+           _THUNK_CALL (Win16SetTitle)));
+    if (CheckWinError(rc))
+	warn("Win16SetTitle: err=%ld", rc);
+}
+#endif
 
 MODULE = OS2::Process		PACKAGE = OS2::Process
 
@@ -152,3 +354,33 @@ constant(name,arg)
 	char *		name
 	int		arg
 
+char *
+my_type()
+
+U32
+file_type(path)
+    char *path
+
+U32
+process_entry()
+    PPCODE:
+     {
+	 SWCNTRL swcntrl;
+
+	 fill_swcntrl(&swcntrl);
+	 EXTEND(sp,9);
+	 PUSHs(sv_2mortal(newSVpv(swcntrl.szSwtitle, 0)));
+	 PUSHs(sv_2mortal(newSVnv(swcntrl.hwnd)));
+	 PUSHs(sv_2mortal(newSVnv(swcntrl.hwndIcon)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.hprog)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.idProcess)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.idSession)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility != SWL_INVISIBLE)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility == SWL_GRAYED)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.fbJump == SWL_JUMPABLE)));
+	 PUSHs(sv_2mortal(newSViv(swcntrl.bProgType)));
+     }
+
+bool
+set_title(s)
+    char *s
diff --git a/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs b/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs
index df7646c42e7..60266f4f16f 100644
--- a/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs
+++ b/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs
@@ -46,6 +46,7 @@ static long incompartment;
 static SV*
 exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
 {
+    dTHR;
     HMODULE hRexx, hRexxAPI;
     BYTE    buf[200];
     LONG    APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING, 
@@ -93,9 +94,10 @@ exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
     } else {
 	res = NEWSV(729,0);
     }
-    if (rc || SvTRUE(GvSV(errgv))) {
-	if (SvTRUE(GvSV(errgv))) {
-	    die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(errgv), na)) ;
+    if (rc || SvTRUE(GvSV(PL_errgv))) {
+	if (SvTRUE(GvSV(PL_errgv))) {
+	    STRLEN n_a;
+	    die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
 	}
 	die ("REXX compartment returned non-zero status %li", rc);
     }
@@ -132,7 +134,7 @@ PERLCALL(PSZ name, ULONG argc, PRXSTRING argv, PSZ queue, PRXSTRING ret)
 
     ENTER;
     SAVETMPS;
-    PUSHMARK(sp);
+    PUSHMARK(SP);
 
 #if 0
     if (!my_perl) {
@@ -338,7 +340,7 @@ _fetch(name, ...)
    {
        int   i;
        ULONG rc;
-       EXTEND(sp, items);
+       EXTEND(SP, items);
        needvars(items);
        if (trace)
 	   fprintf(stderr, "REXXCALL::_fetch");
@@ -373,7 +375,7 @@ _fetch(name, ...)
 			   var->shvname.strlength, var->shvname.strptr,
 			   namelen, var->shvvalue.strptr);
 	       if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
-		   PUSHs(&sv_undef);
+		   PUSHs(&PL_sv_undef);
 	       else
 		   PUSHs(sv_2mortal(newSVpv(var->shvvalue.strptr,
 					    namelen)));
@@ -409,7 +411,7 @@ _next(stem)
 	   rc = RexxVariablePool(&sv);
        } while (!rc && memcmp(stem, sv.shvname.strptr, len) != 0);
        if (!rc) {
-	   EXTEND(sp, 2);
+	   EXTEND(SP, 2);
 	   /* returned lengths appear to be swapped */
 	   /* but beware of "future bug fixes" */
 	   namelen = sv.shvname.strlength; /* should be */
@@ -427,7 +429,7 @@ _next(stem)
 	       PUSHs(sv_2mortal(newSVpv(sv.shvvalue.strptr, valuelen)));
 				DosFreeMem(sv.shvvalue.strptr);
 	   } else	
-	       PUSHs(&sv_undef);
+	       PUSHs(&PL_sv_undef);
        } else if (rc != RXSHV_LVAR) {
 	   die("Error %i when in _next", rc);
        } else {
diff --git a/gnu/usr.bin/perl/os2/diff.configure b/gnu/usr.bin/perl/os2/diff.configure
index 9f42dc139fe..62cf1d20315 100644
--- a/gnu/usr.bin/perl/os2/diff.configure
+++ b/gnu/usr.bin/perl/os2/diff.configure
@@ -1,6 +1,6 @@
---- Configure.orig	Fri Aug  1 23:12:26 1997
-+++ Configure	Fri Aug  1 23:20:24 1997
-@@ -1489,7 +1489,7 @@
+--- Configure	Wed Feb 25 16:52:55 1998
++++ Configure.os2	Wed Feb 25 16:52:58 1998
+@@ -1602,7 +1602,7 @@
  	*)
  		echo "I don't know where '$file' is, and my life depends on it." >&4
  		echo "Go find a public domain implementation or fix your PATH setting!" >&4
@@ -9,18 +9,7 @@
  		;;
  	esac
  done
-@@ -1498,7 +1498,9 @@
- say=offhand
- for file in $trylist; do
- 	xxx=`./loc $file $file $pth`
--	eval $file=$xxx
-+	if test "X$file" != "X$xxx" ; then
-+		eval $file=$xxx
-+	fi
- 	eval _$file=$xxx
- 	case "$xxx" in
- 	/*)
-@@ -3198,7 +3200,7 @@
+@@ -3637,7 +3637,7 @@
  	exit(0);
  }
  EOM
@@ -29,20 +18,7 @@
  	gccversion=`./gccvers`
  	case "$gccversion" in
  	'') echo "You are not using GNU cc." ;;
-@@ -3401,6 +3403,12 @@
- 		*"-l$thislib "*);;
- 		*) dflt="$dflt -l$thislib";;
- 		esac
-+	elif xxx=`./loc $thislib.lib X $libpth`; $test -f "$xxx"; then
-+		echo "Found -l$thislib."
-+		case " $dflt " in
-+		*"-l$thislib "*);;
-+		*) dflt="$dflt -l$thislib";;
-+		esac
- 	else
- 		echo "No -l$thislib."
- 	fi
-@@ -3950,7 +3958,7 @@
+@@ -4434,7 +4434,7 @@
  	esac
  	;;
  esac
@@ -51,224 +27,3 @@
  case "$libs" in
  '') ;;
  *)  for thislib in $libs; do
-@@ -3972,6 +3980,8 @@
- 			:
- 		elif try=`./loc $thislib X $libpth`; $test -f "$try"; then
- 			:
-+		elif try=`./loc $thislib$lib_ext X $libpth`; $test -f "$try"; then
-+			:
- 		elif try=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$try"; then
- 			:
- 		else
-@@ -4156,6 +4166,10 @@
- 	eval $xscan;\
- 	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
- 		eval $xrun
-+elif com="$sed -n -e 's/^[-0-9a-f ]*_\(.*\)=.*/\1/p'";\
-+	eval $xscan;\
-+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
-+		eval $xrun
- else
- 	nm -p $* 2>/dev/null >libc.tmp
- 	$grep fprintf libc.tmp > libc.ptf
-@@ -4166,23 +4180,33 @@
- 		eval $xrun
- 	else
- 		echo " "
--		echo "nm didn't seem to work right. Trying ar instead..." >&4
-+		echo "nm didn't seem to work right. Trying $ar instead..." >&4
- 		com=''
--		if ar t $libc > libc.tmp; then
--			for thisname in $libnames; do
--				ar t $thisname >>libc.tmp
-+		if test "X$osname" = "Xos2"; then ar_opt=tv ; else ar_opt=t ;fi
-+		if $ar $ar_opt $libc > libc.tmp; then
-+			echo \; > libc.tmp
-+			for thisname in $libnames $libc; do
-+  				$ar $ar_opt $thisname >>libc.tmp
-+				if test "X$osname" = "Xos2"; then
-+				    # Revision 50 of EMX has bug in $ar:
-+				    emximp -o tmp.imp $thisname \
-+					2>/dev/null && \
-+					$sed -e 's/^\([_a-zA-Z0-9]*\) .*$/\1/p' \
-+					< tmp.imp >>libc.tmp
-+				    $rm tmp.imp
-+				fi
- 			done
--			$sed -e 's/\.o$//' < libc.tmp > libc.list
-+			$sed -e 's/\.o$//' -e 's/^ \+//' < libc.tmp | grep -v "^IMPORT#" > libc.list
- 			echo "Ok." >&4
- 		else
--			echo "ar didn't seem to work right." >&4
-+			echo "$ar didn't seem to work right." >&4
- 			echo "Maybe this is a Cray...trying bld instead..." >&4
- 			if bld t $libc | $sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list
- 			then
- 				for thisname in $libnames; do
- 					bld t $libnames | \
- 					$sed -e 's/.*\///' -e 's/\.o:.*$//' >>libc.list
--					ar t $thisname >>libc.tmp
-+					$ar t $thisname >>libc.tmp
- 				done
- 				echo "Ok." >&4
- 			else
-@@ -5611,15 +5635,15 @@
- EOCP
- 	: check sys/file.h first, no particular reason here
- 	if $test `./findhdr sys/file.h` && \
--		$cc $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
-+		$cc $ldflags $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
- 		h_sysfile=true;
- 		echo "<sys/file.h> defines the *_OK access constants." >&4
- 	elif $test `./findhdr fcntl.h` && \
--		$cc $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
-+		$cc $ldflags $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
- 		h_fcntl=true;
- 		echo "<fcntl.h> defines the *_OK access constants." >&4
- 	elif $test `./findhdr unistd.h` && \
--		$cc $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
-+		$cc $ldflags $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
- 		echo "<unistd.h> defines the *_OK access constants." >&4
- 	else
- 		echo "I can't find the four *_OK access constants--I'll use mine." >&4
-@@ -5913,7 +5937,7 @@
- 	exit(result);
- }
- EOCP
--if $cc -o try $ccflags try.c >/dev/null 2>&1; then
-+if $cc -o try $ccflags try.c $ldflags >/dev/null 2>&1; then
- 	./try
- 	yyy=$?
- else
-@@ -5994,7 +6018,7 @@
- 
- }
- EOCP
--if $cc -o try $ccflags try.c >/dev/null 2>&1; then
-+if $cc -o try $ccflags try.c $ldflags >/dev/null 2>&1; then
- 	./try
- 	castflags=$?
- else
-@@ -6033,7 +6057,7 @@
- 	exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
- }
- EOF
--	if $cc $ccflags vprintf.c -o vprintf >/dev/null 2>&1 && ./vprintf; then
-+	if $cc $ccflags vprintf.c $ldflags -o vprintf >/dev/null 2>&1 && ./vprintf; then
- 		echo "Your vsprintf() returns (int)." >&4
- 		val2="$undef"
- 	else
-@@ -6381,7 +6405,7 @@
- EOCP
- : check sys/file.h first to get FREAD on Sun
- if $test `./findhdr sys/file.h` && \
--        $cc $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
-+        $cc $ldflags $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
- 	h_sysfile=true;
- 	echo "<sys/file.h> defines the O_* constants..." >&4
- 	if ./open3; then
-@@ -6392,7 +6416,7 @@
- 		val="$undef"
- 	fi
- elif $test `./findhdr fcntl.h` && \
--        $cc $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
-+        $cc $ldflags $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
- 	h_fcntl=true;
- 	echo "<fcntl.h> defines the O_* constants..." >&4
- 	if ./open3; then
-@@ -6898,7 +6922,7 @@
- y*|true)
- 	usemymalloc='y'
- 	mallocsrc='malloc.c'
--	mallocobj='malloc.o'
-+	mallocobj="malloc$obj_ext"
- 	d_mymalloc="$define"
- 	case "$libs" in
- 	*-lmalloc*)
-@@ -8156,7 +8180,7 @@
- 	printf("%d\n", (char *)&try.bar - (char *)&try.foo);
- }
- EOCP
--	if $cc $ccflags try.c -o try >/dev/null 2>&1; then
-+	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
- 		dflt=`./try`
- 	else
- 		dflt='8'
-@@ -8204,7 +8228,7 @@
- }
- EOCP
- 	xxx_prompt=y
--	if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
-+	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
- 		dflt=`./try`
- 		case "$dflt" in
- 		[1-4][1-4][1-4][1-4]|12345678|87654321)
-@@ -8711,18 +8735,18 @@
- $cc $ccflags -c bar1.c >/dev/null 2>&1
- $cc $ccflags -c bar2.c >/dev/null 2>&1
- $cc $ccflags -c foo.c >/dev/null 2>&1
--ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1
-+$ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1
- if $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 &&
- 	./foobar >/dev/null 2>&1; then
--	echo "ar appears to generate random libraries itself."
-+	echo "$ar appears to generate random libraries itself."
- 	orderlib=false
- 	ranlib=":"
--elif ar ts bar$lib_ext >/dev/null 2>&1 &&
-+elif $ar ts bar$lib_ext >/dev/null 2>&1 &&
- 	$cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 &&
- 	./foobar >/dev/null 2>&1; then
--		echo "a table of contents needs to be added with 'ar ts'."
-+		echo "a table of contents needs to be added with '$ar ts'."
- 		orderlib=false
--		ranlib="ar ts"
-+		ranlib="$ar ts"
- else
- 	case "$ranlib" in
- 	:) ranlib='';;
-@@ -8794,7 +8818,7 @@
- 	'') $echo $n ".$c"
- 		if $cc $ccflags \
- 		$i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
--		try.c -o try >/dev/null 2>&1 ; then
-+		try.c -o try $ldflags >/dev/null 2>&1 ; then
- 			set X $i_time $i_systime $i_systimek $sysselect $s_timeval
- 			shift
- 			flags="$*"
-@@ -8863,7 +8887,7 @@
- #endif
- }
- EOCP
--if $cc $ccflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
-+if $cc $ccflags $ldflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
- 	d_fds_bits="$define"
- 	d_fd_set="$define"
- 	echo "Well, your system knows about the normal fd_set typedef..." >&4
-@@ -8880,7 +8904,7 @@
- 	$cat <<'EOM'
- Hmm, your compiler has some difficulty with fd_set.  Checking further...
- EOM
--	if $cc $ccflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
-+	if $cc $ccflags $ldflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
- 		d_fds_bits="$undef"
- 		d_fd_set="$define"
- 		echo "Well, your system has some sort of fd_set available..." >&4
-@@ -9627,7 +9651,7 @@
- else
- 	echo "false"
- fi
--$rm -f varargs.o
-+$rm -f varargs$obj_ext
- EOP
- chmod +x varargs
- 
-@@ -9954,7 +9978,7 @@
- 	echo " "
- 	echo "Stripping down executable paths..." >&4
- 	for file in $loclist $trylist; do
--		eval $file="\$file"
-+		if test X$file != Xln -o X$osname != Xos2; then eval $file="\$file"; fi
- 	done
- 	;;
- esac
diff --git a/gnu/usr.bin/perl/os2/os2.c b/gnu/usr.bin/perl/os2/os2.c
index 8a292e30f25..28751ffa888 100644
--- a/gnu/usr.bin/perl/os2/os2.c
+++ b/gnu/usr.bin/perl/os2/os2.c
@@ -5,6 +5,8 @@
 #define INCL_DOSERRORS
 #include <os2.h>
 
+#include <sys/uflags.h>
+
 /*
  * Various Unix compatibility functions for OS/2
  */
@@ -18,6 +20,161 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef USE_THREADS
+
+typedef void (*emx_startroutine)(void *);
+typedef void* (*pthreads_startroutine)(void *);
+
+enum pthreads_state {
+    pthreads_st_none = 0, 
+    pthreads_st_run,
+    pthreads_st_exited, 
+    pthreads_st_detached, 
+    pthreads_st_waited,
+};
+const char *pthreads_states[] = {
+    "uninit",
+    "running",
+    "exited",
+    "detached",
+    "waited for",
+};
+
+typedef struct {
+    void *status;
+    perl_cond cond;
+    enum pthreads_state state;
+} thread_join_t;
+
+thread_join_t *thread_join_data;
+int thread_join_count;
+perl_mutex start_thread_mutex;
+
+int
+pthread_join(perl_os_thread tid, void **status)
+{
+    MUTEX_LOCK(&start_thread_mutex);
+    switch (thread_join_data[tid].state) {
+    case pthreads_st_exited:
+	thread_join_data[tid].state = pthreads_st_none;	/* Ready to reuse */
+	MUTEX_UNLOCK(&start_thread_mutex);
+	*status = thread_join_data[tid].status;
+	break;
+    case pthreads_st_waited:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("join with a thread with a waiter");
+	break;
+    case pthreads_st_run:
+	thread_join_data[tid].state = pthreads_st_waited;
+	COND_INIT(&thread_join_data[tid].cond);
+	MUTEX_UNLOCK(&start_thread_mutex);
+	COND_WAIT(&thread_join_data[tid].cond, NULL);    
+	COND_DESTROY(&thread_join_data[tid].cond);
+	thread_join_data[tid].state = pthreads_st_none;	/* Ready to reuse */
+	*status = thread_join_data[tid].status;
+	break;
+    default:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("join: unknown thread state: '%s'", 
+	      pthreads_states[thread_join_data[tid].state]);
+	break;
+    }
+    return 0;
+}
+
+void
+pthread_startit(void *arg)
+{
+    /* Thread is already started, we need to transfer control only */
+    pthreads_startroutine start_routine = *((pthreads_startroutine*)arg);
+    int tid = pthread_self();
+    void *retval;
+    
+    arg = ((void**)arg)[1];
+    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);
+	    Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t);
+	} else {
+	    Newz(1323, thread_join_data, thread_join_count, thread_join_t);
+	}
+    }
+    if (thread_join_data[tid].state != pthreads_st_none)
+	croak("attempt to reuse thread id %i", tid);
+    thread_join_data[tid].state = pthreads_st_run;
+    /* Now that we copied/updated the guys, we may release the caller... */
+    MUTEX_UNLOCK(&start_thread_mutex);
+    thread_join_data[tid].status = (*start_routine)(arg);
+    switch (thread_join_data[tid].state) {
+    case pthreads_st_waited:
+	COND_SIGNAL(&thread_join_data[tid].cond);    
+	break;
+    default:
+	thread_join_data[tid].state = pthreads_st_exited;
+	break;
+    }
+}
+
+int
+pthread_create(perl_os_thread *tid, const pthread_attr_t *attr, 
+	       void *(*start_routine)(void*), void *arg)
+{
+    void *args[2];
+
+    args[0] = (void*)start_routine;
+    args[1] = arg;
+
+    MUTEX_LOCK(&start_thread_mutex);
+    *tid = _beginthread(pthread_startit, /*stack*/ NULL, 
+			/*stacksize*/ 10*1024*1024, (void*)args);
+    MUTEX_LOCK(&start_thread_mutex);
+    MUTEX_UNLOCK(&start_thread_mutex);
+    return *tid ? 0 : EINVAL;
+}
+
+int 
+pthread_detach(perl_os_thread tid)
+{
+    MUTEX_LOCK(&start_thread_mutex);
+    switch (thread_join_data[tid].state) {
+    case pthreads_st_waited:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("detach on a thread with a waiter");
+	break;
+    case pthreads_st_run:
+	thread_join_data[tid].state = pthreads_st_detached;
+	MUTEX_UNLOCK(&start_thread_mutex);
+	break;
+    default:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("detach: unknown thread state: '%s'", 
+	      pthreads_states[thread_join_data[tid].state]);
+	break;
+    }
+    return 0;
+}
+
+/* This is a very bastardized version: */
+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))
+	croak("panic: COND_WAIT-reset: rc=%i", rc);		
+    if (m) MUTEX_UNLOCK(m);					
+    if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
+	&& (rc != ERROR_INTERRUPT))
+	croak("panic: COND_WAIT: rc=%i", rc);		
+    if (rc == ERROR_INTERRUPT)
+	errno = EINTR;
+    if (m) MUTEX_LOCK(m);					
+} 
+#endif 
+
 /*****************************************************************************/
 /* 2.1 would not resolve symbols on demand, and has no ExtLIBPATH. */
 static PFN ExtFCN[2];			/* Labeled by ord below. */
@@ -156,7 +313,28 @@ getpriority(int which /* ignored */, int pid)
 
 /*****************************************************************************/
 /* spawn */
-typedef void (*Sigfunc) _((int));
+
+/* 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? */
+static int spawn_pid;
+static int spawn_killed;
+
+static Signal_t
+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 
+       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) 
+	sig = SIGKILL;			/* Try harder. */
+    kill(spawn_pid, sig);
+    spawn_killed = 1;
+}
 
 static int
 result(int flag, int pid)
@@ -173,15 +351,17 @@ result(int flag, int pid)
 		return pid;
 
 #ifdef __EMX__
-	ihand = rsignal(SIGINT, SIG_IGN);
-	qhand = rsignal(SIGQUIT, SIG_IGN);
+	spawn_pid = pid;
+	spawn_killed = 0;
+	ihand = rsignal(SIGINT, &spawn_sighandler);
+	qhand = rsignal(SIGQUIT, &spawn_sighandler);
 	do {
 	    r = wait4pid(pid, &status, 0);
 	} while (r == -1 && errno == EINTR);
 	rsignal(SIGINT, ihand);
 	rsignal(SIGQUIT, qhand);
 
-	statusvalue = (U16)status;
+	PL_statusvalue = (U16)status;
 	if (r < 0)
 		return -1;
 	return status & 0xFFFF;
@@ -189,27 +369,406 @@ result(int flag, int pid)
 	ihand = rsignal(SIGINT, SIG_IGN);
 	r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid);
 	rsignal(SIGINT, ihand);
-	statusvalue = res.codeResult << 8 | res.codeTerminate;
+	PL_statusvalue = res.codeResult << 8 | res.codeTerminate;
 	if (r)
 		return -1;
-	return statusvalue;
+	return PL_statusvalue;
 #endif
 }
 
+#define EXECF_SPAWN 0
+#define EXECF_EXEC 1
+#define EXECF_TRUEEXEC 2
+#define EXECF_SPAWN_NOWAIT 3
+
+/* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
+
+static int
+my_type()
+{
+    int rc;
+    TIB *tib;
+    PIB *pib;
+    
+    if (!(_emx_env & 0x200)) return 1; /* not OS/2. */
+    if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) 
+	return -1; 
+    
+    return (pib->pib_ultype);
+}
+
+static ULONG
+file_type(char *path)
+{
+    int rc;
+    ULONG apptype;
+    
+    if (!(_emx_env & 0x200)) 
+	croak("file_type not implemented on DOS"); /* not OS/2. */
+    if (CheckOSError(DosQueryAppType(path, &apptype))) {
+	switch (rc) {
+	case ERROR_FILE_NOT_FOUND:
+	case ERROR_PATH_NOT_FOUND:
+	    return -1;
+	case ERROR_ACCESS_DENIED:	/* Directory with this name found? */
+	    return -3;
+	default:			/* Found, but not an
+					   executable, or some other
+					   read error. */
+	    return -2;
+	}
+    }    
+    return apptype;
+}
+
+static ULONG os2_mytype;
+
+/* Spawn/exec a program, revert to shell if needed. */
+/* global PL_Argv[] contains arguments. */
+
+int
+do_spawn_ve(really, flag, execf, inicmd)
+SV *really;
+U32 flag;
+U32 execf;
+char *inicmd;
+{
+    dTHR;
+	int trueflag = flag;
+	int rc, pass = 1;
+	char *tmps;
+	char buf[256], *s = 0, scrbuf[280];
+	char *args[4];
+	static char * fargs[4] 
+	    = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
+	char **argsp = fargs;
+	char nargs = 4;
+	int force_shell;
+	STRLEN n_a;
+	
+	if (flag == P_WAIT)
+		flag = P_NOWAIT;
+
+      retry:
+	if (strEQ(PL_Argv[0],"/bin/sh")) 
+	    PL_Argv[0] = PL_sh_path;
+
+	if (PL_Argv[0][0] != '/' && PL_Argv[0][0] != '\\'
+	    && !(PL_Argv[0][0] && PL_Argv[0][1] == ':' 
+		 && (PL_Argv[0][2] == '/' || PL_Argv[0][2] != '\\'))
+	    ) /* will spawnvp use PATH? */
+	    TAINT_ENV();	/* testing IFS here is overkill, probably */
+	/* We should check PERL_SH* and PERLLIB_* as well? */
+	if (!really || !*(tmps = SvPV(really, n_a)))
+	    tmps = PL_Argv[0];
+
+      reread:
+	force_shell = 0;
+	if (_emx_env & 0x200) { /* OS/2. */ 
+	    int type = file_type(tmps);
+	  type_again:
+	    if (type == -1) {		/* Not found */
+		errno = ENOENT;
+		rc = -1;
+		goto do_script;
+	    }
+	    else if (type == -2) {		/* Not an EXE */
+		errno = ENOEXEC;
+		rc = -1;
+		goto do_script;
+	    }
+	    else if (type == -3) {		/* Is a directory? */
+		/* Special-case this */
+		char tbuf[512];
+		int l = strlen(tmps);
+
+		if (l + 5 <= sizeof tbuf) {
+		    strcpy(tbuf, tmps);
+		    strcpy(tbuf + l, ".exe");
+		    type = file_type(tbuf);
+		    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: 
+	    {
+		if (os2_mytype != 3) {	/* not PM */
+		    if (flag == P_NOWAIT)
+			flag = P_PM;
+		    else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION)
+			warn("Starting PM process with flag=%d, mytype=%d",
+			     flag, os2_mytype);
+		}
+	    }
+	    break;
+	    case FAPPTYP_NOTWINDOWCOMPAT: 
+	    {
+		if (os2_mytype != 0) {	/* not full screen */
+		    if (flag == P_NOWAIT)
+			flag = P_SESSION;
+		    else if ((flag & 7) != P_SESSION)
+			warn("Starting Full Screen process with flag=%d, mytype=%d",
+			     flag, os2_mytype);
+		}
+	    }
+	    break;
+	    case FAPPTYP_NOTSPEC: 
+		/* Let the shell handle this... */
+		force_shell = 1;
+		goto doshell_args;
+		break;
+	    }
+	}
+
+#if 0
+	rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
+#else
+	if (execf == EXECF_TRUEEXEC)
+	    rc = execvp(tmps,PL_Argv);
+	else if (execf == EXECF_EXEC)
+	    rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
+	else if (execf == EXECF_SPAWN_NOWAIT)
+	    rc = spawnvp(flag,tmps,PL_Argv);
+        else				/* EXECF_SPAWN */
+	    rc = result(trueflag, 
+			spawnvp(flag,tmps,PL_Argv));
+#endif 
+	if (rc < 0 && pass == 1
+	    && (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
+	      do_script:
+	    {
+	    int err = errno;
+
+	    if (err == ENOENT || err == ENOEXEC) {
+		/* No such file, or is a script. */
+		/* Try adding script extensions to the file name, and
+		   search on PATH. */
+		char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
+
+		if (scr) {
+		    FILE *file;
+		    char *s = 0, *s1;
+		    int l;
+
+                    l = strlen(scr);
+		
+                    if (l >= sizeof scrbuf) {
+                       Safefree(scr);
+                     longbuf:
+                       croak("Size of scriptname too big: %d", l);
+                    }
+                    strcpy(scrbuf, scr);
+                    Safefree(scr);
+                    scr = scrbuf;
+
+		    file = fopen(scr, "r");
+		    PL_Argv[0] = scr;
+		    if (!file)
+			goto panic_file;
+		    if (!fgets(buf, sizeof buf, file)) { /* Empty... */
+
+			buf[0] = 0;
+			fclose(file);
+			/* Special case: maybe from -Zexe build, so
+			   there is an executable around (contrary to
+			   documentation, DosQueryAppType sometimes (?)
+			   does not append ".exe", so we could have
+			   reached this place). */
+			if (l + 5 < sizeof scrbuf) {
+			    strcpy(scrbuf + l, ".exe");
+			    if (PerlLIO_stat(scrbuf,&PL_statbuf) >= 0
+				&& !S_ISDIR(PL_statbuf.st_mode)) {
+				/* Found */
+				tmps = scr;
+				pass++;
+				goto reread;
+			    } else
+				scrbuf[l] = 0;
+			} else
+			    goto longbuf;
+		    }
+		    if (fclose(file) != 0) { /* Failure */
+		      panic_file:
+			warn("Error reading \"%s\": %s", 
+			     scr, Strerror(errno));
+			buf[0] = 0;	/* Not #! */
+			goto doshell_args;
+		    }
+		    if (buf[0] == '#') {
+			if (buf[1] == '!')
+			    s = buf + 2;
+		    } else if (buf[0] == 'e') {
+			if (strnEQ(buf, "extproc", 7) 
+			    && isSPACE(buf[7]))
+			    s = buf + 8;
+		    } else if (buf[0] == 'E') {
+			if (strnEQ(buf, "EXTPROC", 7)
+			    && isSPACE(buf[7]))
+			    s = buf + 8;
+		    }
+		    if (!s) {
+			buf[0] = 0;	/* Not #! */
+			goto doshell_args;
+		    }
+		    
+		    s1 = s;
+		    nargs = 0;
+		    argsp = args;
+		    while (1) {
+			/* Do better than pdksh: allow a few args,
+			   strip trailing whitespace.  */
+			while (isSPACE(*s))
+			    s++;
+			if (*s == 0) 
+			    break;
+			if (nargs == 4) {
+			    nargs = -1;
+			    break;
+			}
+			args[nargs++] = s;
+			while (*s && !isSPACE(*s))
+			    s++;
+			if (*s == 0) 
+			    break;
+			*s++ = 0;
+		    }
+		    if (nargs == -1) {
+			warn("Too many args on %.*s line of \"%s\"",
+			     s1 - buf, buf, scr);
+			nargs = 4;
+			argsp = fargs;
+		    }
+		  doshell_args:
+		    {
+			char **a = PL_Argv;
+			char *exec_args[2];
+
+			if (force_shell 
+			    || (!buf[0] && file)) { /* File without magic */
+			    /* In fact we tried all what pdksh would
+			       try.  There is no point in calling
+			       pdksh, we may just emulate its logic. */
+			    char *shell = getenv("EXECSHELL");
+			    char *shell_opt = NULL;
+
+			    if (!shell) {
+				char *s;
+
+				shell_opt = "/c";
+				shell = getenv("OS2_SHELL");
+				if (inicmd) { /* No spaces at start! */
+				    s = inicmd;
+				    while (*s && !isSPACE(*s)) {
+					if (*s++ = '/') {
+					    inicmd = NULL; /* Cannot use */
+					    break;
+					}
+				    }
+				}
+				if (!inicmd) {
+				    s = PL_Argv[0];
+				    while (*s) { 
+					/* Dosish shells will choke on slashes
+					   in paths, fortunately, this is
+					   important for zeroth arg only. */
+					if (*s == '/') 
+					    *s = '\\';
+					s++;
+				    }
+				}
+			    }
+			    /* If EXECSHELL is set, we do not set */
+			    
+			    if (!shell)
+				shell = ((_emx_env & 0x200)
+					 ? "c:/os2/cmd.exe"
+					 : "c:/command.com");
+			    nargs = shell_opt ? 2 : 1;	/* shell file args */
+			    exec_args[0] = shell;
+			    exec_args[1] = shell_opt;
+			    argsp = exec_args;
+			    if (nargs == 2 && inicmd) {
+				/* Use the original cmd line */
+				/* XXXX This is good only until we refuse
+				        quoted arguments... */
+				PL_Argv[0] = inicmd;
+				PL_Argv[1] = Nullch;
+			    }
+			} else if (!buf[0] && inicmd) { /* No file */
+			    /* Start with the original cmdline. */
+			    /* XXXX This is good only until we refuse
+			            quoted arguments... */
+
+			    PL_Argv[0] = inicmd;
+			    PL_Argv[1] = Nullch;
+			    nargs = 2;	/* shell -c */
+			} 
+
+			while (a[1])		/* Get to the end */
+			    a++;
+			a++;			/* Copy finil NULL too */
+			while (a >= PL_Argv) {
+			    *(a + nargs) = *a;	/* PL_Argv was preallocated to be
+						   long enough. */
+			    a--;
+			}
+			while (nargs-- >= 0)
+			    PL_Argv[nargs] = argsp[nargs];
+			/* Enable pathless exec if #! (as pdksh). */
+			pass = (buf[0] == '#' ? 2 : 3);
+			goto retry;
+		    }
+		}
+		/* Not found: restore errno */
+		errno = err;
+	    }
+	  }
+	} else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */
+	    char *no_dir = strrchr(PL_Argv[0], '/');
+
+	    /* Do as pdksh port does: if not found with /, try without
+	       path. */
+	    if (no_dir) {
+		PL_Argv[0] = no_dir + 1;
+		pass++;
+		goto retry;
+	    }
+	}
+	if (rc < 0 && PL_dowarn)
+	    warn("Can't %s \"%s\": %s\n", 
+		 ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) 
+		  ? "spawn" : "exec"),
+		 PL_Argv[0], Strerror(errno));
+	if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) 
+	    && ((trueflag & 0xFF) == P_WAIT)) 
+	    rc = 255 << 8; /* Emulate the fork(). */
+
+    return rc;
+}
+
+/* Array spawn.  */
 int
 do_aspawn(really,mark,sp)
 SV *really;
 register SV **mark;
 register SV **sp;
 {
+    dTHR;
     register char **a;
     char *tmps = NULL;
     int rc;
     int flag = P_WAIT, trueflag, err, secondtry = 0;
+    STRLEN n_a;
 
     if (sp > mark) {
-	New(1301,Argv, sp - mark + 3, char*);
-	a = Argv;
+	New(1301,PL_Argv, sp - mark + 3, char*);
+	a = PL_Argv;
 
 	if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
 		++mark;
@@ -218,73 +777,20 @@ register SV **sp;
 
 	while (++mark <= sp) {
 	    if (*mark)
-		*a++ = SvPVx(*mark, na);
+		*a++ = SvPVx(*mark, n_a);
 	    else
 		*a++ = "";
 	}
 	*a = Nullch;
 
-	trueflag = flag;
-	if (flag == P_WAIT)
-		flag = P_NOWAIT;
-
-	if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path;
-
-	if (Argv[0][0] != '/' && Argv[0][0] != '\\'
-	    && !(Argv[0][0] && Argv[0][1] == ':' 
-		 && (Argv[0][2] == '/' || Argv[0][2] != '\\'))
-	    ) /* will swawnvp use PATH? */
-	    TAINT_ENV();	/* testing IFS here is overkill, probably */
-	/* We should check PERL_SH* and PERLLIB_* as well? */
-      retry:
-	if (really && *(tmps = SvPV(really, na)))
-	    rc = result(trueflag, spawnvp(flag,tmps,Argv));
-	else
-	    rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
-
-	if (rc < 0 && secondtry == 0 
-	    && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */
-	    err = errno;
-	    if (err == ENOENT) {	/* No such file. */
-		/* One reason may be that EMX added .exe. We suppose
-		   that .exe-less files are automatically shellable. */
-		char *no_dir;
-		(no_dir = strrchr(Argv[0], '/')) 
-		    || (no_dir = strrchr(Argv[0], '\\'))
-		    || (no_dir = Argv[0]);
-		if (!strchr(no_dir, '.')) {
-		    struct stat buffer;
-		    if (stat(Argv[0], &buffer) != -1) { /* File exists. */
-			/* Maybe we need to specify the full name here? */
-			goto doshell;
-		    }
-		}
-	    } else if (err == ENOEXEC) { /* Need to send to shell. */
-	      doshell:
-		while (a >= Argv) {
-		    *(a + 2) = *a;
-		    a--;
-		}
-		*Argv = sh_path;
-		*(Argv + 1) = "-c";
-		secondtry = 1;
-		goto retry;
-	    }
-	}
-	if (rc < 0 && dowarn)
-	    warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
-	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+	rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL);
     } else
     	rc = -1;
     do_execfree();
     return rc;
 }
 
-#define EXECF_SPAWN 0
-#define EXECF_EXEC 1
-#define EXECF_TRUEEXEC 2
-#define EXECF_SPAWN_NOWAIT 3
-
+/* Try converting 1-arg form to (usually shell-less) multi-arg form. */
 int
 do_spawn2(cmd, execf)
 char *cmd;
@@ -294,7 +800,7 @@ int execf;
     register char *s;
     char flags[10];
     char *shell, *copt, *news = NULL;
-    int rc, added_shell = 0, err, seenspace = 0;
+    int rc, err, seenspace = 0;
     char fullcmd[MAXNAMLEN + 1];
 
 #ifdef TRYSHELL
@@ -311,7 +817,7 @@ int execf;
        have a shell which will not change between computers with the
        same architecture, to avoid "action on a distance". 
        And to have simple build, this shell should be sh. */
-    shell = sh_path;
+    shell = PL_sh_path;
     copt = "-c";
 #endif 
 
@@ -319,13 +825,12 @@ int execf;
 	cmd++;
 
     if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
-	STRLEN l = strlen(sh_path);
+	STRLEN l = strlen(PL_sh_path);
 	
 	New(1302, news, strlen(cmd) - 7 + l + 1, char);
-	strcpy(news, sh_path);
+	strcpy(news, PL_sh_path);
 	strcpy(news + l, cmd + 7);
 	cmd = news;
-	added_shell = 1;
     }
 
     /* save an extra exec if possible */
@@ -349,32 +854,38 @@ int execf;
 	    } else if (*s == '\\' && !seenspace) {
 		continue;		/* Allow backslashes in names */
 	    }
+	    /* We do not convert this to do_spawn_ve since shell
+	       should be smart enough to start itself gloriously. */
 	  doshell:
 	    if (execf == EXECF_TRUEEXEC)
-                return execl(shell,shell,copt,cmd,(char*)0);
+                rc = execl(shell,shell,copt,cmd,(char*)0);		
 	    else if (execf == EXECF_EXEC)
-                return spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
+                rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
 	    else if (execf == EXECF_SPAWN_NOWAIT)
-                return spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
-	    /* In the ak code internal P_NOWAIT is P_WAIT ??? */
-	    rc = result(P_WAIT,
-			spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
-	    if (rc < 0 && dowarn)
-		warn("Can't %s \"%s\": %s", 
-		     (execf == EXECF_SPAWN ? "spawn" : "exec"),
-		     shell, Strerror(errno));
-	    if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
-	    if (news) Safefree(news);
+                rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
+	    else {
+		/* In the ak code internal P_NOWAIT is P_WAIT ??? */
+		rc = result(P_WAIT,
+			    spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
+		if (rc < 0 && PL_dowarn)
+		    warn("Can't %s \"%s\": %s", 
+			 (execf == EXECF_SPAWN ? "spawn" : "exec"),
+			 shell, Strerror(errno));
+		if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+	    }
+	    if (news)
+		Safefree(news);
 	    return rc;
 	} else if (*s == ' ' || *s == '\t') {
 	    seenspace = 1;
 	}
     }
 
-    New(1303,Argv, (s - cmd) / 2 + 2, char*);
-    Cmd = savepvn(cmd, s-cmd);
-    a = Argv;
-    for (s = Cmd; *s;) {
+    /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */
+    New(1303,PL_Argv, (s - cmd + 11) / 2, char*);
+    PL_Cmd = savepvn(cmd, s-cmd);
+    a = PL_Argv;
+    for (s = PL_Cmd; *s;) {
 	while (*s && isSPACE(*s)) s++;
 	if (*s)
 	    *(a++) = s;
@@ -383,46 +894,12 @@ int execf;
 	    *s++ = '\0';
     }
     *a = Nullch;
-    if (Argv[0]) {
-	int err;
-	
-	if (execf == EXECF_TRUEEXEC)
-	    rc = execvp(Argv[0],Argv);
-	else if (execf == EXECF_EXEC)
-	    rc = spawnvp(P_OVERLAY,Argv[0],Argv);
-	else if (execf == EXECF_SPAWN_NOWAIT)
-	    rc = spawnvp(P_NOWAIT,Argv[0],Argv);
-        else
-	    rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
-	if (rc < 0) {
-	    err = errno;
-	    if (err == ENOENT) {	/* No such file. */
-		/* One reason may be that EMX added .exe. We suppose
-		   that .exe-less files are automatically shellable. */
-		char *no_dir;
-		(no_dir = strrchr(Argv[0], '/')) 
-		    || (no_dir = strrchr(Argv[0], '\\'))
-		    || (no_dir = Argv[0]);
-		if (!strchr(no_dir, '.')) {
-		    struct stat buffer;
-		    if (stat(Argv[0], &buffer) != -1) { /* File exists. */
-			/* Maybe we need to specify the full name here? */
-			goto doshell;
-		    }
-		}
-	    } else if (err == ENOEXEC) { /* Need to send to shell. */
-		goto doshell;
-	    }
-	}
-	if (rc < 0 && dowarn)
-	    warn("Can't %s \"%s\": %s", 
-		 ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) 
-		  ? "spawn" : "exec"),
-		 Argv[0], Strerror(err));
-	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
-    } else
+    if (PL_Argv[0])
+	rc = do_spawn_ve(NULL, 0, execf, cmd);
+    else
     	rc = -1;
-    if (news) Safefree(news);
+    if (news)
+	Safefree(news);
     do_execfree();
     return rc;
 }
@@ -445,7 +922,8 @@ bool
 do_exec(cmd)
 char *cmd;
 {
-    return do_spawn2(cmd, EXECF_EXEC);
+    do_spawn2(cmd, EXECF_EXEC);
+    return FALSE;
 }
 
 bool
@@ -468,15 +946,15 @@ char	*mode;
     PerlIO *res;
     SV *sv;
     
-    if (pipe(p) < 0)
-	return Nullfp;
     /* `this' is what we use in the parent, `that' in the child. */
     this = (*mode == 'w');
     that = !this;
-    if (tainting) {
+    if (PL_tainting) {
 	taint_env();
 	taint_proper("Insecure %s%s", "EXEC");
     }
+    if (pipe(p) < 0)
+	return Nullfp;
     /* Now we need to spawn the child. */
     newfd = dup(*mode == 'r');		/* Preserve std* */
     if (p[that] != (*mode == 'r')) {
@@ -491,7 +969,8 @@ char	*mode;
 	dup2(newfd, *mode == 'r');	/* Return std* back. */
 	close(newfd);
     }
-    close(p[that]);
+    if (p[that] == (*mode == 'r'))
+	close(p[that]);
     if (pid == -1) {
 	close(p[this]);
 	return NULL;
@@ -501,10 +980,10 @@ char	*mode;
 	close(p[this]);
 	p[this] = p[that];
     }
-    sv = *av_fetch(fdpid,p[this],TRUE);
+    sv = *av_fetch(PL_fdpid,p[this],TRUE);
     (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = pid;
-    forkprocess = pid;
+    PL_forkprocess = pid;
     return PerlIO_fdopen(p[this], mode);
 
 #else  /* USE_POPEN */
@@ -517,11 +996,11 @@ char	*mode;
 #  else
     char *shell = getenv("EMXSHELL");
 
-    my_setenv("EMXSHELL", sh_path);
+    my_setenv("EMXSHELL", PL_sh_path);
     res = popen(cmd, mode);
     my_setenv("EMXSHELL", shell);
 #  endif 
-    sv = *av_fetch(fdpid, PerlIO_fileno(res), TRUE);
+    sv = *av_fetch(PL_fdpid, PerlIO_fileno(res), TRUE);
     (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = -1;			/* A cooky. */
     return res;
@@ -536,7 +1015,7 @@ char	*mode;
 int
 fork(void)
 {
-    die(no_func, "Unsupported function fork");
+    die(PL_no_func, "Unsupported function fork");
     errno = EINVAL;
     return -1;
 }
@@ -675,8 +1154,9 @@ XS(XS_File__Copy_syscopy)
     if (items < 2 || items > 3)
 	croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
     {
-	char *	src = (char *)SvPV(ST(0),na);
-	char *	dst = (char *)SvPV(ST(1),na);
+	STRLEN n_a;
+	char *	src = (char *)SvPV(ST(0),n_a);
+	char *	dst = (char *)SvPV(ST(1),n_a);
 	U32	flag;
 	int	RETVAL, rc;
 
@@ -693,6 +1173,8 @@ XS(XS_File__Copy_syscopy)
     XSRETURN(1);
 }
 
+#include "patchlevel.h"
+
 char *
 mod2fname(sv)
      SV   *sv;
@@ -703,6 +1185,7 @@ mod2fname(sv)
     AV  *av;
     SV  *svp;
     char *s;
+    STRLEN n_a;
 
     if (!SvROK(sv)) croak("Not a reference given to mod2fname");
     sv = SvRV(sv);
@@ -713,7 +1196,7 @@ mod2fname(sv)
     if (avlen < 0) 
       croak("Empty array reference given to mod2fname");
 
-    s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+    s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
     strncpy(fname, s, 8);
     len = strlen(s);
     if (len < 6) pos = len;
@@ -723,12 +1206,16 @@ mod2fname(sv)
     }
     avlen --;
     while (avlen >= 0) {
-	s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+	s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
 	while (*s) {
 	    sum = 33 * sum + *(s++);	/* 7 is primitive mod 13. */
 	}
 	avlen --;
     }
+#ifdef USE_THREADS
+    sum++;				/* Avoid conflict of DLLs in memory. */
+#endif 
+    sum += PATCHLEVEL * 200 + SUBVERSION * 2;  /*  */
     fname[pos] = 'A' + (sum % 26);
     fname[pos + 1] = 'A' + (sum / 26 % 26);
     fname[pos + 2] = '\0';
@@ -764,6 +1251,12 @@ os2error(int rc)
 		sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc);
 	else
 		buf[len] = '\0';
+	if (len > 0 && buf[len - 1] == '\n')
+	    buf[len - 1] = '\0';
+	if (len > 1 && buf[len - 2] == '\r')
+	    buf[len - 2] = '\0';
+	if (len > 2 && buf[len - 3] == '.')
+	    buf[len - 3] = '\0';
 	return buf;
 }
 
@@ -850,7 +1343,8 @@ XS(XS_Cwd_sys_chdir)
     if (items != 1)
 	croak("Usage: Cwd::sys_chdir(path)");
     {
-	char *	path = (char *)SvPV(ST(0),na);
+	STRLEN n_a;
+	char *	path = (char *)SvPV(ST(0),n_a);
 	bool	RETVAL;
 
 	RETVAL = sys_chdir(path);
@@ -866,7 +1360,8 @@ XS(XS_Cwd_change_drive)
     if (items != 1)
 	croak("Usage: Cwd::change_drive(d)");
     {
-	char	d = (char)*SvPV(ST(0),na);
+	STRLEN n_a;
+	char	d = (char)*SvPV(ST(0),n_a);
 	bool	RETVAL;
 
 	RETVAL = change_drive(d);
@@ -882,7 +1377,8 @@ XS(XS_Cwd_sys_is_absolute)
     if (items != 1)
 	croak("Usage: Cwd::sys_is_absolute(path)");
     {
-	char *	path = (char *)SvPV(ST(0),na);
+	STRLEN n_a;
+	char *	path = (char *)SvPV(ST(0),n_a);
 	bool	RETVAL;
 
 	RETVAL = sys_is_absolute(path);
@@ -898,7 +1394,8 @@ XS(XS_Cwd_sys_is_rooted)
     if (items != 1)
 	croak("Usage: Cwd::sys_is_rooted(path)");
     {
-	char *	path = (char *)SvPV(ST(0),na);
+	STRLEN n_a;
+	char *	path = (char *)SvPV(ST(0),n_a);
 	bool	RETVAL;
 
 	RETVAL = sys_is_rooted(path);
@@ -914,7 +1411,8 @@ XS(XS_Cwd_sys_is_relative)
     if (items != 1)
 	croak("Usage: Cwd::sys_is_relative(path)");
     {
-	char *	path = (char *)SvPV(ST(0),na);
+	STRLEN n_a;
+	char *	path = (char *)SvPV(ST(0),n_a);
 	bool	RETVAL;
 
 	RETVAL = sys_is_relative(path);
@@ -945,7 +1443,8 @@ XS(XS_Cwd_sys_abspath)
     if (items < 1 || items > 2)
 	croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
     {
-	char *	path = (char *)SvPV(ST(0),na);
+	STRLEN n_a;
+	char *	path = (char *)SvPV(ST(0),n_a);
 	char *	dir;
 	char p[MAXPATHLEN];
 	char *	RETVAL;
@@ -953,7 +1452,7 @@ XS(XS_Cwd_sys_abspath)
 	if (items < 2)
 	    dir = NULL;
 	else {
-	    dir = (char *)SvPV(ST(1),na);
+	    dir = (char *)SvPV(ST(1),n_a);
 	}
 	if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
 	    path += 2;
@@ -1093,7 +1592,8 @@ XS(XS_Cwd_extLibpath_set)
     if (items < 1 || items > 2)
 	croak("Usage: Cwd::extLibpath_set(s, type = 0)");
     {
-	char *	s = (char *)SvPV(ST(0),na);
+	STRLEN n_a;
+	char *	s = (char *)SvPV(ST(0),n_a);
 	bool	type;
 	U32	rc;
 	bool	RETVAL;
@@ -1147,27 +1647,31 @@ Perl_OS2_init(char **env)
 {
     char *shell;
 
+    MALLOC_INIT;
     settmppath();
     OS2_Perl_data.xs_init = &Xs_OS2_init;
+    _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY);
     if (environ == NULL) {
 	environ = env;
     }
     if ( (shell = getenv("PERL_SH_DRIVE")) ) {
-	New(1304, sh_path, strlen(SH_PATH) + 1, char);
-	strcpy(sh_path, SH_PATH);
-	sh_path[0] = shell[0];
+	New(1304, PL_sh_path, strlen(SH_PATH) + 1, char);
+	strcpy(PL_sh_path, SH_PATH);
+	PL_sh_path[0] = shell[0];
     } else if ( (shell = getenv("PERL_SH_DIR")) ) {
 	int l = strlen(shell), i;
 	if (shell[l-1] == '/' || shell[l-1] == '\\') {
 	    l--;
 	}
-	New(1304, sh_path, l + 8, char);
-	strncpy(sh_path, shell, l);
-	strcpy(sh_path + l, "/sh.exe");
+	New(1304, PL_sh_path, l + 8, char);
+	strncpy(PL_sh_path, shell, l);
+	strcpy(PL_sh_path + l, "/sh.exe");
 	for (i = 0; i < l; i++) {
-	    if (sh_path[i] == '\\') sh_path[i] = '/';
+	    if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/';
 	}
     }
+    MUTEX_INIT(&start_thread_mutex);
+    os2_mytype = my_type();		/* Do it before morphing.  Needed? */
 }
 
 #undef tmpnam
@@ -1205,7 +1709,7 @@ my_tmpfile ()
 
 /* This code was contributed by Rocco Caputo. */
 int 
-my_flock(int handle, int op)
+my_flock(int handle, int o)
 {
   FILELOCK      rNull, rFull;
   ULONG         timeout, handle_type, flag_word;
@@ -1221,7 +1725,7 @@ my_flock(int handle, int op)
 	use_my = 1;
   }
   if (!(_emx_env & 0x200) || !use_my) 
-    return flock(handle, op);	/* Delegate to EMX. */
+    return flock(handle, o);	/* Delegate to EMX. */
   
                                         // is this a file?
   if ((DosQueryHType(handle, &handle_type, &flag_word) != 0) ||
@@ -1234,11 +1738,11 @@ my_flock(int handle, int op)
   rNull.lOffset = rNull.lRange = rFull.lOffset = 0;
   rFull.lRange = 0x7FFFFFFF;
                                         // set timeout for blocking
-  timeout = ((blocking = !(op & LOCK_NB))) ? 100 : 1;
+  timeout = ((blocking = !(o & LOCK_NB))) ? 100 : 1;
                                         // shared or exclusive?
-  shared = (op & LOCK_SH) ? 1 : 0;
+  shared = (o & LOCK_SH) ? 1 : 0;
                                         // do not block the unlock
-  if (op & (LOCK_UN | LOCK_SH | LOCK_EX)) {
+  if (o & (LOCK_UN | LOCK_SH | LOCK_EX)) {
     rc = DosSetFileLocks(handle, &rFull, &rNull, timeout, shared);
     switch (rc) {
       case 0:
@@ -1266,7 +1770,7 @@ my_flock(int handle, int op)
     }
   }
                                         // lock may block
-  if (op & (LOCK_SH | LOCK_EX)) {
+  if (o & (LOCK_SH | LOCK_EX)) {
                                         // for blocking operations
     for (;;) {
       rc =
diff --git a/gnu/usr.bin/perl/os2/os2ish.h b/gnu/usr.bin/perl/os2/os2ish.h
index b62e3d04d4b..1f6b4aba6c6 100644
--- a/gnu/usr.bin/perl/os2/os2ish.h
+++ b/gnu/usr.bin/perl/os2/os2ish.h
@@ -25,6 +25,14 @@
  */
 #undef USEMYBINMODE
 
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+#define Stat_t struct stat
+
 /* USE_STAT_RDEV:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_rdev
@@ -64,17 +72,114 @@
 /* It is not working without TCPIPV4 defined. */
 # undef I_SYS_UN
 #endif 
+
+#ifdef USE_THREADS
+
+#define OS2_ERROR_ALREADY_POSTED 299	/* Avoid os2.h */
+
+extern int rc;
+
+#define MUTEX_INIT(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_create(m,0)))				\
+	    croak("panic: MUTEX_INIT: rc=%i", rc);		\
+    } STMT_END
+#define MUTEX_LOCK(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_request(m,_FMR_IGNINT)))		\
+	    croak("panic: MUTEX_LOCK: rc=%i", rc);		\
+    } STMT_END
+#define MUTEX_UNLOCK(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_release(m)))				\
+	    croak("panic: MUTEX_UNLOCK: rc=%i", rc);		\
+    } STMT_END
+#define MUTEX_DESTROY(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_close(m)))				\
+	    croak("panic: MUTEX_DESTROY: rc=%i", rc);		\
+    } STMT_END
+
+#define COND_INIT(c) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = DosCreateEventSem(NULL,c,0,0)))		\
+	    croak("panic: COND_INIT: rc=%i", rc);		\
+    } STMT_END
+#define COND_SIGNAL(c) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)		\
+	    croak("panic: COND_SIGNAL, rc=%ld", rc);		\
+    } STMT_END
+#define COND_BROADCAST(c) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
+	    croak("panic: COND_BROADCAST, rc=%i", rc);		\
+    } STMT_END
+/* #define COND_WAIT(c, m) \
+    STMT_START {						\
+	if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED)	\
+	    croak("panic: COND_WAIT");				\
+    } STMT_END
+*/
+#define COND_WAIT(c, m) os2_cond_wait(c,m)
+
+#define COND_WAIT_win32(c, m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE)))\
+	    croak("panic: COND_WAIT");				\
+	else							\
+	    MUTEX_LOCK(m);					\
+    } STMT_END
+#define COND_DESTROY(c) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = DosCloseEventSem(*(c))))			\
+	    croak("panic: COND_DESTROY, rc=%i", rc);		\
+    } STMT_END
+/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
+#define dTHR struct thread *thr = THR
+*/
+
+#define pthread_getspecific(k)		(*_threadstore())
+#define pthread_setspecific(k,v)	(*_threadstore()=v,0)
+#define pthread_self()			_gettid()
+#define pthread_key_create(keyp,flag)	(*keyp=_gettid(),0)
+#define YIELD				DosSleep(0)
+
+#ifdef PTHREADS_INCLUDED		/* For ./x2p stuff. */
+int pthread_join(pthread_t tid, void **status);
+int pthread_detach(pthread_t tid);
+int pthread_create(pthread_t *tid, const pthread_attr_t *attr,
+		   void *(*start_routine)(void*), void *arg);
+#endif 
+
+#define THREADS_ELSEWHERE
+
+#endif 
  
 void Perl_OS2_init(char **);
 
 /* XXX This code hideously puts env inside: */
 
-#define PERL_SYS_INIT(argcp, argvp) STMT_START {	\
+#ifdef __EMX__
+#  define PERL_SYS_INIT(argcp, argvp) STMT_START {	\
     _response(argcp, argvp);			\
     _wildcard(argcp, argvp);			\
     Perl_OS2_init(env);	} STMT_END
-
-#define PERL_SYS_TERM()
+#else  /* Compiling embedded Perl with non-EMX compiler */
+#  define PERL_SYS_INIT(argcp, argvp) STMT_START {	\
+    Perl_OS2_init(env);	} STMT_END
+#  define PERL_CALLCONV _System
+#endif
+#define PERL_SYS_TERM()		MALLOC_TERM
 
 /* #define PERL_SYS_TERM() STMT_START {	\
     if (Perl_HAB_set) WinTerminate(Perl_hab);	} STMT_END */
diff --git a/gnu/usr.bin/perl/os2/perl2cmd.pl b/gnu/usr.bin/perl/os2/perl2cmd.pl
index e774f773d03..f9cc03bdac2 100644
--- a/gnu/usr.bin/perl/os2/perl2cmd.pl
+++ b/gnu/usr.bin/perl/os2/perl2cmd.pl
@@ -23,7 +23,7 @@ foreach $file (<$idir/*>) {
   $base =~ s|.*/||;
   $file =~ s|/|\\|g ;
   print "Processing $file => $dir\\$base.cmd\n";
-  system 'cmd.exe', '/c', "echo extproc perl -S >$dir\\$base.cmd";
+  system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd";
   system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd";
 }