From: Nick Ing-Simmons Date: Thu, 6 Jun 2002 18:51:48 +0000 (+0000) Subject: Integrate mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=91c549175fa6d9c1a6279d23a256266b7fbe4be9;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline p4raw-id: //depot/perlio@17043 --- diff --git a/NetWare/Makefile b/NetWare/Makefile index bb40515..f563cd1 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -33,7 +33,6 @@ REL_DIR = Release DEB_DIR = Debug -!ifndef MAKE_TYPE !ifndef NLMSDKBASE !message "Run bat\SetNWBld.bat to set the NetWare SDK before continuing.\n" !error @@ -115,17 +114,17 @@ BLDMESG = Debug version, BS_CFLAGS = -opt off -inline off -sym on -sym codeview4 -sym internal -DDEBUGGING -DDKFBPON BLDMESG = $(BLDMESG) Using /d2 option !ifdef NLM_NAME8 -LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(NLM_NAME8).sym +LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(MAKE_TYPE)\$(NLM_NAME8).sym !else # !ifdef NLM_NAME8 -LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(NLM_NAME).sym +LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(MAKE_TYPE)\$(NLM_NAME).sym !endif # !ifdef NLM_NAME8 !else # !ifdef USE_D2 BS_CFLAGS = -opt off -inline off -sym on -sym codeview4 -sym internal -DDEBUGGING -DDKFBPON BLDMESG = $(BLDMESG) Using /d1 option !ifdef NLM_NAME8 -LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(NLM_NAME8).sym +LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(MAKE_TYPE)\$(NLM_NAME8).sym !else # !ifdef NLM_NAME8 -LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(NLM_NAME).sym +LDFLAGS = $(LDFLAGS) -sym on -sym codeview4 -sym internal -osym $(MAKE_TYPE)\$(NLM_NAME).sym !endif # !ifdef NLM_NAME8 !endif # !ifdef USE_D2 !else # !if "$(MAKE_TYPE)"=="Debug" @@ -927,7 +926,7 @@ $(MINIMOD) : $(MINIPERL) ..\minimod.pl @echo $(MPKMESSAGE)...$(BLDMESG)...$@ $(C_COMPILER) $(COMPLER_FLAGS) $(NLM_INCLUDES) -I..\x2p $(ADD_LOCDEFS) $(ERROR_FLAG) $*.c -o $@ @echo Built $(@) - + ..\x2p\hash$(o) : ..\x2p\hash.c @echo $(MPKMESSAGE)...$(BLDMESG)...$@ $(C_COMPILER) $(COMPLER_FLAGS) $(NLM_INCLUDES) -I..\x2p $(ADD_LOCDEFS) $(ERROR_FLAG) $*.c -o $@ @@ -1072,14 +1071,6 @@ $(NLM_NAME): MESSAGE HEADERS $(BLDDIR)\nul $(NLM_OBJ) $(NEWTARE_OBJ_DEP) $(NEWTA $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) @echo ========Linked $@ ========== -!if "$(MAKE_TYPE)"=="Debug" -!ifdef NLM_NAME8 - .\bat\cvpack $(BLDDIR)\$(NLM_NAME8).sym -!else - .\bat\cvpack $(BLDDIR)\$(NLM_NAME).sym -!endif -!endif - @echo======= Finished building $(BUILT). # Create the debug or release directory if not existing @@ -1396,11 +1387,11 @@ nwclean: @if exist .\config.h del /f /q .\config.h @if exist .\config.nw5 del /f /q .\config.nw5 @if exist .\perl.imp del /f /q .\perl.imp - -del /f /q *.obj *.lib *.def *.sym *.map *.xdc *.err + -del /f /q *.obj *.lib *.def *.sym *.map *.xdc *.err *.nlm cd testnlm\echo - -del /f /q *.obj *.map *.link *.options *.nlm *.sym *.xdc *.err + -del /f /q *.obj *.map *.link *.options *.nlm *.sym *.xdc *.err *.lib *.def *.pdb *.bs cd ..\type - -del /f /q *.obj *.map *.link *.options *.nlm *.sym *.xdc *.err + -del /f /q *.obj *.map *.link *.options *.nlm *.sym *.xdc *.err *.lib *.def *.pdb *.bs cd ..\..\ utils: $(BLDDIR)\$(NLM_NAME8).$(NLM_EXT) $(X2P) @@ -1457,14 +1448,14 @@ distclean: clean nwclean -del /f /q $(CONFIGPM) -del /f /q bin\*.bat cd $(EXTDIR) - -del /s /f /q *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib *.xdc *.err + -del /s /q /f *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib *.xdc *.err *.obj *.sym cd ..\netware !if "$(NW_EXTNS)"=="yes" cd cgi2perl - -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map + -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.def *.lib *.pdb cd .. cd $(EXTDIR)\Perl2UCS - -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.c + -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.def *.lib *.pdb cd ..\..\netware cd $(EXTDIR)\UCSExt -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.c diff --git a/NetWare/NWUtil.c b/NetWare/NWUtil.c index 5174fe3..f23774a 100644 --- a/NetWare/NWUtil.c +++ b/NetWare/NWUtil.c @@ -472,15 +472,16 @@ void fnAppendArgument(PCOMMANDLINEPARSER pclp, char *new_arg) strcpy(pclp->m_argv[pclp->m_argc], new_arg); // Appended the new argument. pclp->m_argc++; // Increment the number of parameters appended. - // The char array is emptied for all elements upto the end so that there are no junk characters. - // If this is not done, then the issue is like this: + // The char array is emptied for all elements upto the end so that there are no + // junk characters. If this is not done, then the issue is like this: // - Simple perl command like "perl" on the system console works fine for the first time. - // - When it is given the second time, a new blank screen should come up which also - // allows for editing. This was not consistently working well. - // More so when the command was like, "perl ", that is the name "perl" - // followed by a few blank spaces. It used to give error in opening file and - // would give some junk as the filename unable to open. - // Once the below fix was done, it is working fine. + // - When "perl" is executed the second time, a new blank screen should come up + // which allows for editing also. This was not consistently working well. + // More so when the command was like, "perl ", that is the name "perl" followed + // by a few blank spaces, it used to give error in opening file: + // "unable to open the file" since the filename would have some junk characters. + // + // These issues are fixed through the code below. for(i=pclp->m_argc; im_argv_len; i++) strncpy(pclp->m_argv[i], "", (MAX_DN_BYTES * sizeof(char))); // MAX_DN_BYTES is the size of pclp->m_argv[]. diff --git a/NetWare/bat/Buildtype.bat b/NetWare/bat/Buildtype.bat index 9f39da7..7ea8cb5 100644 --- a/NetWare/bat/Buildtype.bat +++ b/NetWare/bat/Buildtype.bat @@ -17,7 +17,7 @@ if "%1" == "R" goto set_type_rel if "%1" == "d" goto set_type_dbg if "%1" == "D" goto set_type_dbg -Rem Invalid input, display help message +Rem Invalid input and so display the help message goto Usage :set_type_rel @@ -39,14 +39,14 @@ goto exit :now if "%MAKE_TYPE%" == "" echo MAKE_TYPE is not set, hence it defaults to Release build -if not "%MAKE_TYPE%" == "" echo Current build type is - %MAKE_TYPE% +if not "%MAKE_TYPE%" == "" echo Current build type is - %MAKE_TYPE% call ToggleD2 /now goto exit :Usage @echo on @echo "Usage: buildtype r/R|d/D [on/off]" - @echo on/off - Toggling D2 flag for debug build + @echo on/off - Toggling only for D2 flag during debug build @echo "Usage: buildtype /now" - To display current setting @echo Ex. buildtype d on diff --git a/NetWare/bat/SetCodeWar.bat b/NetWare/bat/SetCodeWar.bat index c70ff02..19ca59c 100644 --- a/NetWare/bat/SetCodeWar.bat +++ b/NetWare/bat/SetCodeWar.bat @@ -41,46 +41,3 @@ goto exit @echo Ex. setCodeWar d:\CodeWar :exit -@echo off -@rem AUTHOR: sgp & apc -@rem CREATED: 24th July 2000 -@rem LAST REVISED: 6th April 2001 -@rem LAST REVISED: 22nd May 2002 -@rem AUTHOR: apc -@rem Batch file to set the path to CodeWarrior directories -@rem This file is called from SetNWBld.bat. - -if "%1" == "/now" goto now -if "%1" == "" goto Usage -if "%1" == "/?" goto usage -if "%1" == "/h" goto usage - -set CODEWAR=%1 -ECHO CODEWAR=%1 - -call buildtype r -@echo Buildtype set to Release type - -set MWCIncludes=%1\include -@echo MWCIncludes=%1\include -set MWLibraries=%1\lib -@echo MWLibraries=%1\lib -set MWLibraryFiles=%1\lib\nwpre.obj;%1\lib\mwcrtld.lib -@echo MWLibraryFiles=%1\lib\nwpre.obj;%1\lib\mwcrtld.lib - -set PATH=%PATH%;%1\bin; -@echo PATH=%PATH%;%1\bin; - -goto exit - -:now -@echo CODEWAR=%CODEWAR% -goto exit - -:Usage - @echo on - @echo "Usage: setCodeWar " - @echo "Usage: setCodeWar /now" - To display current setting - @echo Ex. setCodeWar d:\CodeWar - -:exit diff --git a/NetWare/bat/SetNWBld.bat b/NetWare/bat/SetNWBld.bat index 062c531..851d90e 100644 --- a/NetWare/bat/SetNWBld.bat +++ b/NetWare/bat/SetNWBld.bat @@ -1,9 +1,10 @@ @echo off -@rem AUTHOR: sgp +@rem AUTHOR: apc @rem CREATED: Thu 18th Jan 2001 09:18:08 @rem LAST REVISED: 6th April 2001 -@rem Batch file to set the path to NetWare SDK, Watcom directories & MPK SDK -@rem This file calls setnlmsdk.bat, setwatcom.bat & setmpksdk.bat +@rem LAST REVISED: 22nd May 2002 +@rem Batch file to set the path to Default Buildtype,NetWare SDK, CodeWarrior directories +@rem This file calls buildtype with release as defualt,setnlmsdk.bat, setCodeWar.bat & setmpksdk.bat and MpkBuild with off as default REM If no parameters are passed, display usage if "%1" == "" goto Usage @@ -15,48 +16,44 @@ if "%1" == "/now" goto now REM If na is passed, don't set that parameter if "%1" == "na" goto skip_nlmsdk_msg + :setnwsdk call setnlmsdk %1 goto skip_nlmsdk_nomsg :skip_nlmsdk_msg @echo Retaining NLMSDKBASE=%NLMSDKBASE% -:skip_nlmsdk_nomsg -if "%2" == "" goto exit -if "%2" == "na" goto skip_watcom_msg -:setwatcom -call setwatcom %2 -goto skip_watcom_nomsg - -:skip_watcom_msg -@echo Retaining WATCOM=%WATCOM% -:skip_watcom_nomsg +:skip_nlmsdk_nomsg +if "%2" == "" goto err_exit +if "%2" == "na" goto skip_cw_msg -if "%3" == "" goto exit -if "%3" == "na" goto skip_mpksdk_msg -:setmpk -call setmpksdk %3 -goto skip_mpksdk_nomsg +:setcodewar +call setcodewar %2 +goto skip_cw_nomsg -:skip_mpksdk_msg -@echo Retaining MPKBASE=%MPKBASE% -:skip_mpksdk_nomsg +:skip_cw_msg +@echo Retaining CODEWAR=%CODEWAR% +goto exit +:skip_cw_nomsg goto exit +:err_exit +@echo Not Enough Parameters +goto Usage + :now @echo NLMSDKBASE=%NLMSDKBASE% -@echo WATCOM=%WATCOM% -@echo MPKBASE=%MPKBASE% +@echo CODEWAR=%CODEWAR% goto exit -goto exit :Usage @echo on - @echo "Usage: setnwbld [] []" - @echo "Usage: setnwbld /now" - To display current setting + @echo "Usage: setnwdef " + @echo "Usage: setnwdef /now" - To display current setting @echo Pass na if you don't want to change a setting - @echo Ex. setnwbld d:\ndk\nwsdk na p:\mpk - @echo Ex. setnwbld d:\ndk\ + @echo Ex. setnwbld d:\ndk\nwsdk na + @echo Ex. setnwbld na d:\codewar + :exit diff --git a/NetWare/bat/Setnlmsdk.bat b/NetWare/bat/Setnlmsdk.bat index 82fcf8b..96c77af 100644 --- a/NetWare/bat/Setnlmsdk.bat +++ b/NetWare/bat/Setnlmsdk.bat @@ -24,5 +24,5 @@ goto exit @echo "Usage: setnlmsdk " @echo "Usage: setnlmsdk /now" - To display current setting @echo Ex. setnlmsdk e:\sdkcd14\nwsdk -:exit +:exit diff --git a/NetWare/bat/ToggleD2.bat b/NetWare/bat/ToggleD2.bat index d3f5d2c..89b69e3 100644 --- a/NetWare/bat/ToggleD2.bat +++ b/NetWare/bat/ToggleD2.bat @@ -13,7 +13,9 @@ if "%1" == "on" goto yes if "%1" == "off" goto no if "%1" == "/?" goto usage if "%1" == "/h" goto usage -goto dontknow + +Rem Invalid input and so display the help message +goto Usage :now if "%USE_D2%" == "" echo USE_D2 is removed, uses /d1 @@ -30,11 +32,9 @@ Set USE_D2= echo ....USE_D2 is removed. uses /d1 goto exit -:dontknow -goto Usage - :Usage @echo on @echo "Usage: ToggleD2 [on|off]" @echo "Usage: ToggleD2 /now" - To display current setting + :exit diff --git a/NetWare/t/NWScripts.pl b/NetWare/t/NWScripts.pl index 2c18c38..d5094e3 100644 --- a/NetWare/t/NWScripts.pl +++ b/NetWare/t/NWScripts.pl @@ -11,7 +11,7 @@ $DirName = "t"; # These scripts have problems (either abend or hang) as of now (11 May 2001). # So, they are commented out in the corresponding auto scripts, io.pl and lib.pl -@ScriptsNotUsed = ("t/io/openpid.t", "t/lib/filehandle.t", "t/lib/memoize/t/expire_module_t.t", "t/lib/NEXT/t/next.t", "t/lib/Math/BigInt/t/require.t", "t/ext/B/t/debug.t","t/lib/IPC/Open3.t", "t/ext/B/t/showlex.t", "t/op/subst_wamp.t", "t/uni/upper.t", "t/lib/Net/t/ftp.t"); +@ScriptsNotUsed = ("t/io/openpid.t", "t/lib/filehandle.t", "t/lib/memoize/t/expire_module_t.t", "t/lib/NEXT/t/next.t", "t/lib/Math/BigInt/t/require.t", "t/ext/B/t/debug.t","t/lib/IPC/Open3.t", "t/ext/B/t/showlex.t", "t/op/subst_wamp.t", "t/uni/upper.t", "t/lib/Net/t/ftp.t", "t/op/sort.t, ", "t/ext/POSIX/t/posix.t"); opendir(DIR, $DirName); @Dirs = readdir(DIR); diff --git a/lib/Thread.pm b/lib/Thread.pm index 7173ac2..fe277e8 100644 --- a/lib/Thread.pm +++ b/lib/Thread.pm @@ -19,7 +19,7 @@ our(@ISA, @EXPORT, @EXPORT_OK); BEGIN { if ($ithreads) { - @EXPORT = qw(cond_wait cond_broadcast cond_signal unlock) + @EXPORT = qw(cond_wait cond_broadcast cond_signal) } elsif ($othreads) { @EXPORT_OK = qw(cond_signal cond_broadcast cond_wait); } @@ -107,8 +107,6 @@ use ithreads instead. my @list = Thread->list; # not available with ithreads - unlock(...); # not available with the 5.005 threads - use Thread 'async'; =head1 DESCRIPTION @@ -132,8 +130,7 @@ thread. =item lock VARIABLE -C places a lock on a variable until the lock goes out of scope -(with ithreads you can also explicitly unlock()). +C places a lock on a variable until the lock goes out of scope. If the variable is locked by another thread, the C call will block until it's available. C is recursive, so multiple calls @@ -323,7 +320,7 @@ BEGIN { *{"Thread::$m"} = \&{"threads::$m"}; } require 'threads/shared.pm'; - for my $m (qw(cond_signal cond_broadcast cond_wait unlock)) { + for my $m (qw(cond_signal cond_broadcast cond_wait)) { no strict 'refs'; *{"Thread::$m"} = \&{"threads::shared::${m}_enabled"}; } @@ -331,7 +328,6 @@ BEGIN { unimplement(qw(done flags)); } elsif ($othreads) { XSLoader::load 'Thread'; - unimplement(qw(unlock)); } else { require Carp; Carp::croak("This Perl has neither ithreads nor 5005threads"); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 9102420..2d287ba 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2992,10 +2992,14 @@ The following tests are known to fail due to fundamental problems in the 5.005 threading implementation. These are not new failures--Perl 5.005_0x has the same bugs, but didn't have these tests. + ../ext/B/t/xref.t 255 65280 14 12 85.71% 3-14 ../ext/List/Util/t/first.t 255 65280 7 4 57.14% 2 5-7 ../lib/English.t 2 512 54 2 3.70% 2-3 + ../lib/ExtUtils/t/basic.t 1 256 17 1 5.88% 14 + ../lib/FileCache.t 5 1 20.00% 5 ../lib/Filter/Simple/t/data.t 6 3 50.00% 1-3 - ../lib/Filter/Simple/t/filter_only 9 3 33.33% 1-2 5 + ../lib/Filter/Simple/t/filter_onl 9 3 33.33% 1-2 5 + ../lib/Tie/File/t/31_autodefer.t 255 65280 65 32 49.23% 34-65 ../lib/autouse.t 10 1 10.00% 4 op/flip.t 15 1 6.67% 15 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index f746220..a416b5a 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -817,6 +817,11 @@ the file, say, by doing C. functioning as a class, but that package doesn't define that particular method, nor does any of its base classes. See L. +=item Can't locate PerlIO%s + +(F) You tried to use in open() a PerlIO layer that does not exist, +e.g. open(FH, ">:nosuchlayer", "somefile"). + =item (perhaps you forgot to load "%s"?) (F) This is an educated guess made in conjunction with the message diff --git a/pod/perlguts.pod b/pod/perlguts.pod index cdccb34..d93eadf 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -29,24 +29,34 @@ Additionally, there is the UV, which is simply an unsigned IV. Perl also uses two special typedefs, I32 and I16, which will always be at least 32-bits and 16-bits long, respectively. (Again, there are U32 and U16, -as well.) +as well.) They will usually be exactly 32 and 16 bits long, but on Crays +they will both be 64 bits. =head2 Working with SVs -An SV can be created and loaded with one command. There are four types of -values that can be loaded: an integer value (IV), a double (NV), -a string (PV), and another scalar (SV). +An SV can be created and loaded with one command. There are five types of +values that can be loaded: an integer value (IV), an unsigned integer +value (UV), a double (NV), a string (PV), and another scalar (SV). -The six routines are: +The seven routines are: SV* newSViv(IV); + SV* newSVuv(UV); SV* newSVnv(double); SV* newSVpv(const char*, int); SV* newSVpvn(const char*, int); SV* newSVpvf(const char*, ...); SV* newSVsv(SV*); -To change the value of an *already-existing* SV, there are seven routines: +If you require more complex initialisation you can create an empty SV with +newSV(len). If C is 0 an empty SV of type NULL is returned, else an +SV of type PV is returned with len + 1 (for the NUL) bytes of storage +allocated, accessible via SvPVX. In both cases the SV has value undef. + + SV* newSV(0); /* no storage allocated */ + SV* newSV(10); /* 10 (+1) bytes of uninitialised storage allocated */ + +To change the value of an *already-existing* SV, there are eight routines: void sv_setiv(SV*, IV); void sv_setuv(SV*, UV); diff --git a/pod/perlthrtut.pod b/pod/perlthrtut.pod index 6fda10f..10a7c39 100644 --- a/pod/perlthrtut.pod +++ b/pod/perlthrtut.pod @@ -272,6 +272,17 @@ messy, it's best to isolate the thread-specific code in its own module. In our example above, that's what MyMod_threaded is, and it's only imported if we're running on a threaded Perl. +=head2 A Note about the Examples + +Although thread support is considered to be stable, there are still a number +of quirks that may startle you when you try out any of the examples below. +In a real situation, care should be taken that all threads are finished +executing before the program exits. That care has B been taken in these +examples in the interest of simplicity. Running these examples "as is" will +produce error messages, usually caused by the fact that there are still +threads running when the program exits. You should not be alarmed by this. +Future versions of Perl may fix this problem. + =head2 Creating Threads The L package provides the tools you need to create new @@ -302,7 +313,7 @@ part of the C call, like this: $Param3 = "foo"; $thr = threads->new(\&sub1, "Param 1", "Param 2", $Param3); $thr = threads->new(\&sub1, @ParamList); - $thr = threads->new(\&sub1, qw(Param1 Param2 $Param3)); + $thr = threads->new(\&sub1, qw(Param1 Param2 Param3)); sub sub1 { my @InboundParameters = @_; @@ -336,7 +347,7 @@ this. yield() is pretty straightforward, and works like this: my $thread = shift; my $foo = 50; while($foo--) { print "in thread $thread\n" } - threads->yield(); + threads->yield; $foo = 50; while($foo--) { print "in thread $thread\n" } } @@ -502,8 +513,8 @@ possibility of error: my $c : shared; my $thr1 = threads->create(sub { $b = $a; $a = $b + 1; }); my $thr2 = threads->create(sub { $c = $a; $a = $c + 1; }); - $thr1->join(); - $thr2->join(); + $thr1->join; + $thr2->join; Two threads both access $a. Each thread can potentially be interrupted at any point, or be executed in any order. At the end, $a could be 3 @@ -531,7 +542,7 @@ techniques such as queues, which remove some of the hard work involved. The lock() function takes a shared variable and puts a lock on it. No other thread may lock the variable until the the variable is unlocked by the thread holding the lock. Unlocking happens automatically -when the locking thread exists the outermost block that contains +when the locking thread exits the outermost block that contains C function. Using lock() is straightforward: this example has several threads doing some calculations in parallel, and occasionally updating a running total: @@ -547,7 +558,7 @@ updating a running total: # (... do some calculations and set $result ...) { lock($total); # block until we obtain the lock - $total += $result + $total += $result; } # lock implicitly released at end of scope last if $result == 0; } @@ -587,7 +598,7 @@ lock() on the variable goes out of scope. For example: { { lock($x); # wait for lock - lock($x): # NOOP - we already have the lock + lock($x); # NOOP - we already have the lock { lock($x); # NOOP { @@ -673,7 +684,7 @@ this: use threads; use threads::shared::queue; - my $DataQueue = threads::shared::queue->new(); + my $DataQueue = threads::shared::queue->new; $thr = threads->new(sub { while ($DataElement = $DataQueue->dequeue) { print "Popped $DataElement off the queue\n"; @@ -685,7 +696,7 @@ this: $DataQueue->enqueue(\$thr); sleep 10; $DataQueue->enqueue(undef); - $thr->join(); + $thr->join; You create the queue with C. Then you can add lists of scalars onto the end with enqueue(), and pop scalars off @@ -738,9 +749,9 @@ gives a quick demonstration: } } - $thr1->join(); - $thr2->join(); - $thr3->join(); + $thr1->join; + $thr2->join; + $thr3->join; The three invocations of the subroutine all operate in sync. The semaphore, though, makes sure that only one thread is accessing the @@ -770,8 +781,8 @@ of these defaults simply by passing in different values: $semaphore->up(5); # Increment the counter by five } - $thr1->detach(); - $thr2->detach(); + $thr1->detach; + $thr2->detach; If down() attempts to decrement the counter below zero, it blocks until the counter is large enough. Note that while a semaphore can be created @@ -881,7 +892,7 @@ things we've covered. This program finds prime numbers using threads. 14 } 15 16 $stream->enqueue(undef); - 17 $kid->join(); + 17 $kid->join; 18 19 sub check_num { 20 my ($upstream, $cur_prime) = @_; @@ -897,7 +908,7 @@ things we've covered. This program finds prime numbers using threads. 30 } 31 } 32 $downstream->enqueue(undef) if $kid; - 33 $kid->join() if $kid; + 33 $kid->join if $kid; 34 } This program uses the pipeline model to generate prime numbers. Each diff --git a/utils/c2ph.PL b/utils/c2ph.PL index 38b259f..f961206 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -3,6 +3,28 @@ use Config; use File::Basename qw(&basename &dirname); use Cwd; +use subs qw(link); + +sub link { # This is a cutdown vesion of installperl:link(). + my($from,$to) = @_; + my($success) = 0; + + eval { + CORE::link($from, $to) + ? $success++ + : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) + ? die "AFS" # okay inside eval {} + : die "Couldn't link $from to $to: $!\n"; + }; + if ($@) { + warn $@; + require File::Copy; + File::Copy::copy($from, $to) + ? $success++ + : warn "Couldn't copy $from to $to: $!\n"; + } + $success; +} # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you diff --git a/x2p/a2p.h b/x2p/a2p.h index 227b706..3457c43 100644 --- a/x2p/a2p.h +++ b/x2p/a2p.h @@ -16,6 +16,8 @@ #ifdef VMS # include "config.h" +#elif defined(NETWARE) +# include "../NetWare/config.h" #else # include "../config.h" #endif diff --git a/x2p/s2p.PL b/x2p/s2p.PL index 9b62caa..7e65401 100644 --- a/x2p/s2p.PL +++ b/x2p/s2p.PL @@ -3,6 +3,28 @@ use Config; use File::Basename qw(&basename &dirname); use Cwd; +use subs qw(link); + +sub link { # This is a cutdown vesion of installperl:link(). + my($from,$to) = @_; + my($success) = 0; + + eval { + CORE::link($from, $to) + ? $success++ + : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) + ? die "AFS" # okay inside eval {} + : die "Couldn't link $from to $to: $!\n"; + }; + if ($@) { + warn $@; + require File::Copy; + File::Copy::copy($from, $to) + ? $success++ + : warn "Couldn't copy $from to $to: $!\n"; + } + $success; +} # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you