## IEXT char * Isplitstr IINIT(" ");
## dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
## PP(pp_const)
+## PERLVARI(Grsfp, PerlIO *, Nullfp)
+## PERLVAR(cvcache, HV *)
set x -d -l c \
-r '/[dI]?EXT\(CONST\)?[ \t*]+\([a-zA-Z_0-9]+[ \t*]+\)*\([a-zA-Z_0-9]+\)[ \t]*\($\|;\|\[\|[ \t]I+NIT[ \t]*(\|\/\*\)/\3/' \
-r '/IEXT[ \t][^\/]*[ \t*]I\([a-zA-Z_][a-zA-Z_0-9]*\)[\[; \t]/\1/' \
+ -r '/PERLVAR[a-zA-Z_0-9]*[ \t]*([ \t]*[GIT]?\([a-zA-Z_][a-zA-Z_0-9]*\)[ \t]*,/\1/' \
-r '/PP[ \t]*([ \t]*\([^ \t()]*\)[ \t]*)/\1/'
shift
'", "DLBASE" => "',$self->{DLBASE},
'", "DL_FUNCS" => ',neatvalue($funcs),
', "IMPORTS" => ',neatvalue($imports),
- ', "DL_VARS" => ', neatvalue($vars), ');\'
+ ', "VERSION" => "',$self->{VERSION},
+ '", "DL_VARS" => ', neatvalue($vars), ');\'
');
}
join('',@m);
use vars qw( @ISA @EXPORT $VERSION );
@ISA = 'Exporter';
@EXPORT = '&Mksymlists';
-$VERSION = substr q$Revision: 1.16 $, 10;
+$VERSION = substr q$Revision: 1.17 $, 10;
sub Mksymlists {
my(%spec) = @_;
sub _write_os2 {
my($data) = @_;
+ require Config;
+ my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
if (not $data->{DLBASE}) {
($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
open(DEF,">$data->{FILE}.def")
or croak("Can't create $data->{FILE}.def: $!\n");
print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
+ print DEF "DESCRIPTION 'Perl (v$]$threaded) module $data->{NAME} v$data->{VERSION}'\n";
print DEF "CODE LOADONCALL\n";
print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
print DEF "EXPORTS\n ";
globPrint PrintRet UsageOnly frame AutoTrace
TTY noTTY ReadLine NonStop LineInfo maxTraceLen
recallCommand ShellBang pager tkRunning ornaments
- signalLevel warnLevel dieLevel inhibit_exit);
+ signalLevel warnLevel dieLevel inhibit_exit
+ ImmediateStop);
%optionVars = (
hashDepth => \$dumpvar::hashDepth,
AutoTrace => \$trace,
inhibit_exit => \$inhibit_exit,
maxTraceLen => \$maxtrace,
+ ImmediateStop => \$ImmediateStop,
);
%optionAction = (
}
$single = 0;
# return; # Would not print trace!
+ } elsif ($ImmediateStop) {
+ $ImmediateStop = 0;
+ $signal = 1;
}
}
$runnonstop = 0 if $single or $signal; # Disable it if interactive.
}
sub postponed {
+ if ($ImmediateStop) {
+ $ImmediateStop = 0;
+ $signal = 1;
+ }
return &postponed_sub
unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
# Cannot be done before the file is compiled
I<tkRunning>: run Tk while prompting (with ReadLine);
I<signalLevel> I<warnLevel> I<dieLevel>: level of verbosity;
I<inhibit_exit> Allows stepping off the end of the script.
+ I<ImmediateStop> Debugger should stop as early as possible.
The following options affect what happens with B<V>, B<X>, and B<x> commands:
I<arrayDepth>, I<hashDepth>: print only first N elements ('' for all);
I<compactDump>, I<veryCompact>: change style of array and hash dump;
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.
# Additional rules supported: perl_, aout_test, aout_install, use them
# for a.out style perl (which may fork).
+perl_version="5.00${PATCHLEVEL}_$SUBVERSION"
+case "$archname" in
+ *-thread) dll_post=_thr
+ perl_version="${perl_version}-threaded";;
+ *) dll_post='' ;;
+esac
+
$spitshell >>Makefile <<!GROK!THIS!
+PERL_VERSION = $perl_version
+
AOUT_OPTIMIZE = $optimize
AOUT_CCCMD = \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
AOUT_AR = $aout_ar
LD_OPT = $optimize
+PERL_DLL_BASE = perl$dll_post
+PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX)
+
!GROK!THIS!
$spitshell >>Makefile <<'!NO!SUBS!'
-$(LIBPERL): perl.imp perl.dll perl5.def
+$(LIBPERL): perl.imp $(PERL_DLL) perl5.def
emximp -o $(LIBPERL) perl.imp
-$(AOUT_LIBPERL_DLL): perl.imp perl.dll perl5.def
+$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
emximp -o $(AOUT_LIBPERL_DLL) perl.imp
perl.imp: perl5.def
echo 'emx_malloc emxlibcm 402 ?' >> $@
echo 'emx_realloc emxlibcm 403 ?' >> $@
-perl.dll: $(obj) perl5.def perl$(OBJ_EXT)
+$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
$(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def
perl5.def: perl.linkexp
- echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE" > $@
- echo DESCRIPTION "'Perl interpreter, export autogenerated'" >>$@
+ echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@
+ echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated'" >>$@
echo STACKSIZE 32768 >>$@
echo CODE LOADONCALL >>$@
echo DATA LOADONCALL NONSHARED MULTIPLE >>$@
$(CC) -DEMBED -E - | \
awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
-perl.linkexp: perl.exports perl.map
+perl.linkexp: perl.exports perl.map os2/os2.sym
cat perl.exports os2/os2.sym perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp
# We link miniperl statically, since .DLL depends on $(DYNALOADER)
typedef struct {
void *status;
- pthread_cond_t cond;
+ perl_cond cond;
enum pthreads_state state;
} thread_join_t;
thread_join_t *thread_join_data;
int thread_join_count;
-pthread_mutex_t start_thread_mutex;
+perl_mutex start_thread_mutex;
int
-pthread_join(pthread_t tid, void **status)
+pthread_join(perl_os_thread tid, void **status)
{
MUTEX_LOCK(&start_thread_mutex);
switch (thread_join_data[tid].state) {
}
int
-pthread_create(pthread_t *tid, const pthread_attr_t *attr,
+pthread_create(perl_os_thread *tid, const pthread_attr_t *attr,
void *(*start_routine)(void*), void *arg)
{
void *args[2];
}
int
-pthread_detach(pthread_t tid)
+pthread_detach(perl_os_thread tid)
{
MUTEX_LOCK(&start_thread_mutex);
switch (thread_join_data[tid].state) {
/* This is a very bastardized version: */
int
-os2_cond_wait(pthread_cond_t *c, pthread_mutex_t *m)
+os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET))
}
avlen --;
}
+#ifdef USE_THREADS
+ sum++; /* Avoid conflict of DLLs in memory. */
+#endif
fname[pos] = 'A' + (sum % 26);
fname[pos + 1] = 'A' + (sum / 26 % 26);
fname[pos + 2] = '\0';
#include <sys/builtin.h>
#include <sys/fmutex.h>
#include <sys/rmutex.h>
-typedef int pthread_t;
-typedef _rmutex pthread_mutex_t;
-/*typedef HEV pthread_cond_t;*/
-typedef unsigned long pthread_cond_t;
-typedef int pthread_key_t;
+typedef int perl_os_thread;
+
+typedef _rmutex perl_mutex;
+
+/*typedef HEV perl_cond;*/ /* Will include os2.h into all C files. */
+typedef unsigned long perl_cond;
+
+typedef int perl_key;
+
typedef unsigned long pthread_attr_t;
#define PTHREADS_INCLUDED
+#define pthread_attr_init(arg) 0
+#define pthread_attr_setdetachstate(arg1,arg2) 0
$nothing = 1;
}
+or, using experimental C<EVAL blocks> of regular expressions
+(see L<perlre/"(?{ code })">),
+
+ / ^abc (?{ $abc = 1 })
+ |
+ ^def (?{ $def = 1 })
+ |
+ ^xyz (?{ $xyz = 1 })
+ |
+ (?{ $nothing = 1 })
+ /x;
+
or even, horrors,
if (/^abc/)
print "1..12\n";
-unlink <Op_dbmx.*>;
+unlink <Op_dbmx*>;
umask(0);
print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
$Dfile = "Op_dbmx.pag";
if (! -e $Dfile) {
- ($Dfile) = <Op_dbmx.*>;
+ ($Dfile) = <Op_dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
print "ok 2 # Skipped: different file permission semantics\n";
while (($key,$value) = each(%h)) {
$i++;
}
-print (!$i ? "ok 3\n" : "not ok 3\n");
+print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
$h{'goner1'} = 'snork';
projects / p5sagit/p5-mst-13.2.git / commitdiff