# No compat3.sym here since and including the 5.004_50.
# No interp.sym since 5.005_03.
-SYM = global.sym interp.sym perlio.sym thread.sym
+SYM = global.sym perlio.sym thread.sym
SYMH = perlvars.h thrdvar.h
aout_ar='ar'
aout_plibext='.a'
aout_lddlflags="-Zdll $ld_dll_optimize"
+# Cannot have 32000K stack: get SYS0170 ?!
if [ $emxcrtrev -ge 50 ]; then
- aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000'
+ aout_ldflags='-Zexe -Zsmall-conv -Zstack 16000'
else
- aout_ldflags='-Zexe -Zstack 32000'
+ aout_ldflags='-Zexe -Zstack 16000'
fi
# To get into config.sh:
Mksymlists("NAME" => "', $self->{NAME},
'", "DLBASE" => "',$self->{DLBASE},
'", "DL_FUNCS" => ',neatvalue($funcs),
- '", "FUNCLIST" => ',neatvalue($funclist),
+ ', "FUNCLIST" => ',neatvalue($funclist),
', "IMPORTS" => ',neatvalue($imports),
', "VERSION" => "',$self->{VERSION},
'", "DL_VARS" => ', neatvalue($vars), ');\'
');
}
+ if (%{$self->{IMPORTS}}) {
+ # Make import files (needed for static build)
+ -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp";
+ open IMP, '>tmpimp.imp' or die "Can't open tmpimp.imp";
+ my ($name, $exp);
+ while (($name, $exp)= each %{$self->{IMPORTS}}) {
+ my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'";
+ print IMP "$name $lib $id ?\n";
+ }
+ close IMP or die "Can't close tmpimp.imp";
+ # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n";
+ system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp"
+ and die "Cannot make import library: $!, \$?=$?";
+ unlink <tmp_imp/*>;
+ system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}"
+ and die "Cannot extract import objects: $!, \$?=$?";
+ }
join('',@m);
}
+sub static_lib {
+ my($self) = @_;
+ my $old = $self->ExtUtils::MM_Unix::static_lib();
+ return $old unless %{$self->{IMPORTS}};
+
+ my @chunks = split /\n{2,}/, $old;
+ shift @chunks unless length $chunks[0]; # Empty lines at the start
+ $chunks[0] .= <<'EOC';
+
+ $(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@
+EOC
+ return join "\n\n". '', @chunks;
+}
+
sub replace_manpage_separator {
my($self,$man) = @_;
$man =~ s,/+,.,g;
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
- if (errno != errno_isOS2)
- Perl_rc = _syserrno();
+ if (errno != errno_isOS2) {
+ int tmp = _syserrno();
+ if (tmp) /* 2nd call to _syserrno() makes it 0 */
+ Perl_rc = tmp;
+ }
sv_setnv(sv, (double)Perl_rc);
sv_setpv(sv, os2error(Perl_rc));
}
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.
perl_version="5.00${PATCHLEVEL}_$SUBVERSION"
case "$archname" in
- *-thread) dll_post=_thr
- perl_version="${perl_version}-threaded";;
- *) dll_post='' ;;
+ *-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!
PERL_VERSION = $perl_version
PERL_DLL_BASE = perl$dll_post
PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX)
+CONFIG_ARGS = $config_args
!GROK!THIS!
echo 'emx_malloc emxlibcm 402 ?' >> $@
echo 'emx_realloc emxlibcm 403 ?' >> $@
+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_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@
- echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated'" >>$@
+ echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated, built with $(CONFIG_ARGS)'" >>$@
echo STACKSIZE 32768 >>$@
echo CODE LOADONCALL >>$@
echo DATA LOADONCALL NONSHARED MULTIPLE >>$@
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)
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
-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=
+!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=
+# 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=
+
+$d/%/Makefile.aout : miniperl_
+ cd \$(dir \$@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
+
+!GROK!THIS!
-.PRECIOUS : ext/%/Makefile.aout ext/OS2/%/Makefile.aout
+done
-ext/OS2/%/Makefile.aout : miniperl_
- cd $(dir $@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
+$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
#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. */
= { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
char **argsp = fargs;
char nargs = 4;
+ int force_shell;
if (flag == P_WAIT)
flag = P_NOWAIT;
/* We should check PERL_SH* and PERLLIB_* as well? */
if (!really || !*(tmps = SvPV(really, PL_na)))
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
else if (execf == EXECF_EXEC)
rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
- rc = spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv);
+ rc = spawnvp(flag,tmps,PL_Argv);
else /* EXECF_SPAWN */
rc = result(trueflag,
- spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv));
+ 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) {
PL_Argv[0] = scr;
if (!file)
goto panic_file;
- if (!fgets(buf, sizeof buf, file)) {
+ if (!fgets(buf, sizeof buf, file)) { /* Empty... */
+ int l = strlen(scr);
+
+ buf[0] = 0;
fclose(file);
- goto panic_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 < 512) { /* size of buffer in find_script */
+ strcpy(scr + l, ".exe");
+ if (PerlLIO_stat(scr,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
+ /* Found */
+ tmps = scr;
+ pass++;
+ goto reread;
+ } else {
+ scr[l] = 0;
+ }
+ }
}
if (fclose(file) != 0) { /* Failure */
panic_file:
char **a = PL_Argv;
char *exec_args[2];
- if (!buf[0] && file) { /* File without magic */
+ 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. */
/* 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_exec(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_EXEC);
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
}
bool
XSRETURN(1);
}
+#include "patchlevel.h"
+
char *
mod2fname(sv)
SV *sv;
#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';
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;
}
}
}
MUTEX_INIT(&start_thread_mutex);
+ os2_mytype = my_type(); /* Do it before morphing. Needed? */
}
#undef tmpnam
perl_eval_pv
perl_eval_sv
perl_require_pv
+cast_i32
+cast_iv
+cast_uv
END
case "$ccflags" in
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log,
"Looking for %s\n",cur));
- if (PerlLIO_stat(cur,&PL_statbuf) >= 0) {
+ if (PerlLIO_stat(cur,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
dosearch = 0;
scriptname = cur;
#ifdef SEARCH_EXTS
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
retval = PerlLIO_stat(tmpbuf,&PL_statbuf);
+ if (S_ISDIR(PL_statbuf.st_mode)) {
+ retval = -1;
+ }
#ifdef SEARCH_EXTS
} while ( retval < 0 /* not there */
&& extidx>=0 && ext[extidx] /* try an extension? */
xfailed = savepv(tmpbuf);
}
#ifndef DOSISH
- if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&PL_statbuf) < 0))
+ if (!xfound && !seen_dot && !xfailed &&
+ (PerlLIO_stat(scriptname,&PL_statbuf) < 0
+ || S_ISDIR(PL_statbuf.st_mode)))
#endif
seen_dot = 1; /* Disable message. */
if (!xfound) {
projects / p5sagit/p5-mst-13.2.git / commitdiff