dslinux/user/perl/djgpp config.over configure.bat djgpp.c djgpp.h djgppsed.sh fixpmain
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:05 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/djgpp
In directory antilope:/tmp/cvs-serv17422/djgpp
Added Files:
config.over configure.bat djgpp.c djgpp.h djgppsed.sh fixpmain
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: djgpp.h ---
#ifndef PERL_DJGPP_DJGPP_H
#define PERL_DJGPP_DJGPP_H
#include <libc/stubs.h>
#include <io.h>
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <libc/file.h>
#include <process.h>
#include <fcntl.h>
#include <glob.h>
#include <sys/fsext.h>
#include <crt0.h>
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
FILE *
djgpp_popen (const char *cm, const char *md);
int
djgpp_pclose (FILE *pp);
int
do_aspawn (pTHX_ SV *really,SV **mark,SV **sp);
int
do_spawn2 (pTHX_ char *cmd,int execf);
int
do_spawn (pTHX_ char *cmd);
bool
Perl_do_exec (pTHX_ char *cmd);
void
Perl_init_os_extras(pTHX);
char
*djgpp_pathexp (const char *p);
void
Perl_DJGPP_init (int *argcp,char ***argvp);
int
djgpp_fflush (FILE *fp);
/* DJGPP utility functions without prototypes? */
int _is_unixy_shell(char *s);
#endif
--- NEW FILE: config.over ---
ln='cp'
pager='${DJDIR}/bin/less.exe'
# fix extension names under DOS
repair()
{
echo "$1" | \
sed \
-e 's/^b/B/'\
-e 's=\([^a-z_]\)b=\1B='\
-e 's=data/dumper=Data/Dumper='\
-e 's/db_file/DB_File/'\
-e 's/dynaload/DynaLoader/'\
-e 's/errno/Errno/'\
-e 's/fcntl/Fcntl/'\
-e 's/gdbm_fil/GDBM_File/'\
-e 's/io/IO/'\
-e 's/SysV//'\
-e 's/sysv//'\
-e 's=ipc/=='\
-e 's=IPC/=='\
-e 's/ndbm_fil/NDBM_File/'\
-e 's/odbm_fil/ODBM_File/'\
-e 's/opcode/Opcode/'\
-e 's/posix/POSIX/'\
-e 's/sdbm_fil/SDBM_File/'\
-e 's/socket/Socket/'\
-e 's=[tT]hread[/a-zA-Z]*==g'\
-e 's/byteload/ByteLoader/'\
-e 's=devel/peek=Devel/Peek='\
-e 's=devel/dprof=Devel/DProf='\
-e 's=sys/sys=Sys/Sys='\
-e 's=sys/hos=Sys/Hos='\
-e 's=file/=='\
-e 's=File/=='\
-e 's=glob=='\
-e 's=Glob=='\
-e 's/storable/Storable/'\
-e 's/encode/Encode/'\
-e 's=filter/util/call=Filter/Util/Call=' \
-e 's=digest/md5=Digest/MD5=' \
-e 's=perlio/scalar=PerlIO/scalar=' \
-e 's=mime/base64=MIME/Base64=' \
-e 's=time/hires=Time/HiRes=' \
-e 's=list/util=List/Util=' \
-e 's=cwd=Cwd=' \
-e 's=perlio/via=PerlIO/via=' \
-e 's=perlio/encoding=PerlIO/encoding=' \
-e 's=xs/apitest=XS/APItest=' \
-e 's=xs/typemap=XS/Typemap=' \
-e 's=unicode/normaliz=Unicode/Normalize=' \
-e 's=i18n/langinfo=I18N/Langinfo=' \
-e 's=devel/ppport=Devel/PPPort='
}
static_ext=$(repair "$static_ext")
extensions=$(repair "$extensions")
known_extensions=$(repair "$known_extensions")
nonxs_ext=$(repair "$nonxs_ext")
# I use Dos::UseLFN in AutoSplit.pm to override this under win0.95
d_flexfnam='undef'
# with W95 + bash the test program returns bogus result
d_casti32='undef'
--- NEW FILE: configure.bat ---
@echo off
set CONFIG=
set PATH_SEPARATOR=;
set PATH_EXPAND=y
sh -c 'if test $PATH_SEPARATOR = ";"; then exit 1; fi'
if ERRORLEVEL 1 goto path_sep_ok
echo Error:
echo Make sure the environment variable PATH_SEPARATOR=; while building perl!
echo Please check your DJGPP.ENV!
goto end
:path_sep_ok
sh -c 'if test $PATH_EXPAND = "Y" -o $PATH_EXPAND = "y"; then exit 1; fi'
if ERRORLEVEL 1 goto path_exp_ok
echo Error:
echo Make sure the environment variable PATH_EXPAND=Y while building perl!
echo Please check your DJGPP.ENV!
goto end
:path_exp_ok
sh -c '$SHELL -c "exit 128"'
if ERRORLEVEL 128 goto shell_ok
echo Error:
echo The SHELL environment variable must be set to the full path of your sh.exe!
goto end
:shell_ok
sh -c 'if test ! -d /tmp; then mkdir /tmp; fi'
cp djgpp.[hc] config.over ..
cd ..
echo Running sed...
sh djgpp/djgppsed.sh
echo Running Configure...
sh Configure %1 %2 %3 %4 %5 %6 %7 %8 %9
:end
--- NEW FILE: djgpp.c ---
#define PERLIO_NOT_STDIO 0
#include "djgpp.h"
/* hold file pointer, command, mode, and the status of the command */
struct pipe_list {
FILE *fp;
int exit_status;
struct pipe_list *next;
char *command, mode;
};
/* static, global list pointer */
static struct pipe_list *pl = NULL;
FILE *
djgpp_popen (const char *cm, const char *md) /* program name, pipe mode */
{
struct pipe_list *l1;
int fd;
char *temp_name=NULL;
/* make new node */
if ((l1 = (struct pipe_list *) malloc (sizeof (*l1)))
&& (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
{
l1->fp = NULL;
l1->command = NULL;
l1->next = pl;
l1->exit_status = -1;
l1->mode = md[0];
/* if caller wants to read */
if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
{
if ((l1->fp = freopen (temp_name, "wb", stdout)))
{
l1->exit_status = system (cm);
if (dup2 (fd, fileno (stdout)) >= 0)
l1->fp = fopen (temp_name, md);
}
close (fd);
}
/* if caller wants to write */
else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
{
strcpy (l1->command, cm);
l1->fp = fopen (temp_name, md);
}
if (l1->fp)
{
l1->fp->_flag |= _IORMONCL; /* remove on close */
l1->fp->_name_to_remove = temp_name;
return (pl = l1)->fp;
}
free (l1->command);
}
free (temp_name);
free (l1);
return NULL;
}
int
djgpp_pclose (FILE *pp)
{
struct pipe_list *l1, **l2; /* list pointers */
int retval=-1; /* function return value */
for (l2 = &pl; *l2 && (*l2)->fp != pp; l2 = &((*l2)->next))
;
if (!(l1 = *l2))
return retval;
*l2 = l1->next;
/* if pipe was opened to write */
if (l1->mode == 'w')
{
int fd;
fflush (l1->fp);
close (fileno (l1->fp));
if ((fd = dup (fileno (stdin))) >= 0
&& (freopen (l1->fp->_name_to_remove, "rb", stdin)))
{
retval = system (l1->command);
dup2 (fd, fileno (stdin));
}
close (fd);
free (l1->command);
}
else
/* if pipe was opened to read, return the exit status we saved */
retval = l1->exit_status;
fclose (l1->fp); /* this removes the temp file */
free (l1);
return retval; /* retval==0 ? OK : ERROR */
}
/**/
#define EXECF_SPAWN 0
#define EXECF_EXEC 1
static int
convretcode (pTHX_ int rc,char *prog,int fl)
{
if (rc < 0 && ckWARN(WARN_EXEC))
Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s",
fl ? "exec" : "spawn",prog,Strerror (errno));
if (rc >= 0)
return rc << 8;
return -1;
}
int
do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
{
int rc;
char **a,*tmps,**argv;
STRLEN n_a;
if (sp<=mark)
return -1;
a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
while (++mark <= sp)
if (*mark)
*a++ = SvPVx(*mark, n_a);
else
*a++ = "";
*a = Nullch;
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 */
if (really && *(tmps = SvPV(really, n_a)))
rc=spawnvp (P_WAIT,tmps,argv);
else
rc=spawnvp (P_WAIT,argv[0],argv);
return convretcode (rc,argv[0],EXECF_SPAWN);
}
#define EXTRA "\x00\x00\x00\x00\x00\x00"
int
do_spawn2 (pTHX_ char *cmd,int execf)
{
char **a,*s,*shell,*metachars;
int rc,unixysh;
if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
shell="c:\\command.com" EXTRA;
unixysh=_is_unixy_shell (shell);
metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA;
while (*cmd && isSPACE(*cmd))
cmd++;
if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
cmd+=5;
/* save an extra exec if possible */
/* see if there are shell metacharacters in it */
if (strstr (cmd,"..."))
goto doshell;
if (unixysh)
{
if (*cmd=='.' && isSPACE (cmd[1]))
goto doshell;
if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
goto doshell;
for (s=cmd; *s && isALPHA (*s); s++) ; /* catch VAR=val gizmo */
if (*s=='=')
goto doshell;
}
for (s=cmd; *s; s++)
if (strchr (metachars,*s))
{
if (*s=='\n' && s[1]=='\0')
{
*s='\0';
break;
}
doshell:
if (execf==EXECF_EXEC)
return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
return convretcode (system (cmd),cmd,execf);
}
Newx (PL_Argv,(s-cmd)/2+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;
while (*s && !isSPACE (*s)) s++;
if (*s)
*s++='\0';
}
*a=Nullch;
if (!PL_Argv[0])
return -1;
if (execf==EXECF_EXEC)
rc=execvp (PL_Argv[0],PL_Argv);
else
rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
return convretcode (rc,PL_Argv[0],execf);
}
int
do_spawn (pTHX_ char *cmd)
{
return do_spawn2 (aTHX_ cmd,EXECF_SPAWN);
}
bool
Perl_do_exec (pTHX_ char *cmd)
{
do_spawn2 (aTHX_ cmd,EXECF_EXEC);
return FALSE;
}
/**/
struct globinfo
{
int fd;
char *matches;
size_t size;
fpos_t pos;
};
#define MAXOPENGLOBS 10
static struct globinfo myglobs[MAXOPENGLOBS];
static struct globinfo *
searchfd (int fd)
{
int ic;
for (ic=0; ic<MAXOPENGLOBS; ic++)
if (myglobs[ic].fd==fd)
return myglobs+ic;
return NULL;
}
static int
glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
{
unsigned ic;
struct globinfo *gi;
switch (n)
{
case __FSEXT_open:
{
char *p1,*pattern,*name=va_arg (args,char*);
STRLEN len;
glob_t pglob;
if (strnNE (name,"/dev/dosglob/",13))
break;
if ((gi=searchfd (-1)) == NULL)
break;
gi->pos=0;
pattern=alloca (strlen (name+=13)+1);
strcpy (pattern,name);
if (!_USE_LFN)
strlwr (pattern);
ic=pglob.gl_pathc=0;
pglob.gl_pathv=NULL;
while (pattern)
{
if ((p1=strchr (pattern,' '))!=NULL)
*p1=0;
glob (pattern,ic,0,&pglob);
ic=GLOB_APPEND;
if ((pattern=p1)!=NULL)
pattern++;
}
for (ic=len=0; ic<pglob.gl_pathc; ic++)
len+=1+strlen (pglob.gl_pathv[ic]);
if (len)
{
if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
break;
for (ic=0; ic<pglob.gl_pathc; ic++)
{
strcpy (p1,pglob.gl_pathv[ic]);
p1+=strlen (p1)+1;
}
}
else
{
if ((gi->matches=strdup (name))==NULL)
break;
gi->size=strlen (name)+1;
}
globfree (&pglob);
gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
return 1;
}
case __FSEXT_read:
{
int fd=va_arg (args,int);
char *buf=va_arg (args,char*);
size_t siz=va_arg (args,size_t);
if ((gi=searchfd (fd))==NULL)
break;
if (siz+gi->pos > gi->size)
siz = gi->size - gi->pos;
memcpy (buf,gi->pos+gi->matches,siz);
gi->pos += siz;
*rv=siz;
return 1;
}
case __FSEXT_close:
{
int fd=va_arg (args,int);
if ((gi=searchfd (fd))==NULL)
break;
free (gi->matches);
gi->fd=-1;
break;
}
default:
break;
}
return 0;
}
static
XS(dos_GetCwd)
{
dXSARGS;
if (items)
Perl_croak (aTHX_ "Usage: Dos::GetCwd()");
{
char tmp[PATH_MAX+2];
ST(0)=sv_newmortal ();
if (getcwd (tmp,PATH_MAX+1)!=NULL)
sv_setpv ((SV*)ST(0),tmp);
#ifndef INCOMPLETE_TAINTS
SvTAINTED_on(ST(0));
#endif
}
XSRETURN (1);
}
static
XS(dos_UseLFN)
{
dXSARGS;
XSRETURN_IV (_USE_LFN);
}
XS(XS_Cwd_sys_cwd)
{
dXSARGS;
if (items != 0)
Perl_croak_nocontext("Usage: Cwd::sys_cwd()");
{
char p[MAXPATHLEN];
char * RETVAL;
RETVAL = getcwd(p, MAXPATHLEN);
ST(0) = sv_newmortal();
sv_setpv((SV*)ST(0), RETVAL);
#ifndef INCOMPLETE_TAINTS
SvTAINTED_on(ST(0));
#endif
}
XSRETURN(1);
}
void
Perl_init_os_extras(pTHX)
{
char *file = __FILE__;
dXSUB_SYS;
newXS ("Dos::GetCwd",dos_GetCwd,file);
newXS ("Dos::UseLFN",dos_UseLFN,file);
newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file);
/* install my File System Extension for globbing */
__FSEXT_add_open_handler (glob_handler);
memset (myglobs,-1,sizeof (myglobs));
}
static char *perlprefix;
#define PERL5 "/perl5"
char *
djgpp_pathexp (const char *p)
{
static char expp[PATH_MAX];
strcpy (expp,perlprefix);
switch (p[0])
{
case 'B':
strcat (expp,"/bin");
break;
case 'S':
strcat (expp,"/lib" PERL5 "/site");
break;
default:
strcat (expp,"/lib" PERL5);
break;
}
return expp;
}
void
Perl_DJGPP_init (int *argcp,char ***argvp)
{
char *p;
perlprefix=strdup (**argvp);
strlwr (perlprefix);
if ((p=strrchr (perlprefix,'/'))!=NULL)
{
*p=0;
if (strEQ (p-4,"/bin"))
p[-4]=0;
}
else
strcpy (perlprefix,"..");
}
int
djgpp_fflush (FILE *fp)
{
int res;
if ((res = fflush(fp)) == 0 && fp) {
Stat_t s;
if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
res = fsync(fileno(fp));
}
/*
* If the flush succeeded but set end-of-file, we need to clear
* the error because our caller may check ferror(). BTW, this
* probably means we just flushed an empty file.
*/
if (res == 0 && fp && ferror(fp) == EOF) clearerr(fp);
return res;
}
int djgpp_get_stream_mode(FILE *f)
{
extern char *__file_handle_modes;
int mode = __file_handle_modes[fileno(f)];
if (f->_flag & _IORW)
return mode | O_RDWR;
if (f->_flag & _IOWRT)
return mode | O_WRONLY;
return mode | O_RDONLY;
}
--- NEW FILE: fixpmain ---
#!perl -w
# Fix perlmain.c under DOS (short & case insensitive filenames).
# Called from Makefile.aperl when needed.
# You don't need this when LFN=y.
use Config;
open (PERLM,"<perlmain.c") or die "Can't load perlmain.c: $!";
open (MAKEFILE,"<makefile.pl") or die "Can't load makefile.pl: $!";
undef $/;
$perlmain=<PERLM>;
$makefile=<MAKEFILE>;
($_) = $makefile =~ /\bNAME\b.*=>\W*([\w\:]+)/; # extract module name
$badname=join ("__",map {lc substr ($_,0,8)} split /:+/); # dosify
$perlmain =~ s/^.*boot_$badname.*$//gm if $badname; # delete bad lines
@exts=('DynaLoader',split (" ",$Config{known_extensions}));
for $realname (@exts)
{
$dosname=join ("__",map {lc substr ($_,0,8)} split /\//,$realname);
$realname =~ s!/!__!g;
$perlmain =~ s/\bboot_$dosname\b/boot_$realname/gm;
$dosname =~ s/__/::/;
$realname =~ s/__/::/;
$perlmain =~ s/\b$dosname(::bootstrap)/$realname$1/gm;
}
#DynaLoader is special
$perlmain =~ s/(DynaLoader:\:boot)strap/$1_DynaLoader/gm;
open (PERLM,">perlmain.c") or die "Can't write perlmain.c: $!";
print PERLM $perlmain;
--- NEW FILE: djgppsed.sh ---
#! /bin/sh
# Change some files to work under DOS
# Most of this stuff does .xx -> _xx and aa.bb.ccc -> aa_bb.cc conversion
SCONFIG='s=\.\(config\)=_\1=g'
SLIST='s=\.\([a-z]\+list\)=_\1=g'
SGREPTMP='s=\.\(greptmp\)=_\1=g'
SECHOTMP='s=\.\(echotmp\)=_\1=g'
SDDC='s=\.\($$\.c\)=_\1=g'
SOUT='s=\([^a-z1-9?]\)\.\(out\)=\1_\2=g'
SEXISTS='s=\.\(exists\)=_\1=g'
SPOD2HTML='s=pod2html-=pod2html.=g'
SCC='s=\.c\.c=.c_c=g'
SFILEC="s=\(\$file\)\.c=\\1'_c'=g"
SCOR='s=c\\\.c|=c\_c|=g'
SHSED='s=\.\(hsed\)=_\1=g'
SDEPTMP='s=\.\(deptmp\)=_\1=g'
SCPP='s=\.\(cpp\.\)=_\1=g'
SARGV='s=Io_argv\(.\)\.=i\1_=g'
SABC='s=\.\([abc][^a]\)=_\1=g'
SDBMX='s=\.\(dbmx\)=_\1=g'
SDBHASH='s=dbhash\.tmp=dbhash_tmp=g'
SSTAT='s=\.\(stat\.\)=_\1=g'
STMP2='s=tmp2=tm2=g'
SPACKLIST='s=\.\(packlist\)=_\1=g'
SDOTTMP='s=\.tmp=_tmp=g'
sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT -e 's=\.\( \./\$file\)$=sh\1=g' Configure |tr -d '\r' >s; mv -f s Configure
sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH
sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/Install.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/Install.pm
sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/MM_Unix.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/MM_Unix.pm
sed -e $SEXISTS -e $SPACKLIST installperl >s; mv -f s installperl
sed -e $SPOD2HTML lib/Pod/Html.pm |tr -d '\r' >s; mv -f s lib/Pod/Html.pm
sed -e $SCC -e $SLIST -e $SFILEC -e $SCOR -e $SDEPTMP -e $SHSED makedepend.SH |tr -d '\r' >s; mv -f s makedepend.SH
sed -e $SCPP t/comp/cpp.aux |tr -d '\r' >s; mv -f s t/comp/cpp.aux
sed -e $SARGV -e $SDOTTMP t/io/argv.t >s; mv -f s t/io/argv.t
sed -e $SABC t/io/inplace.t >s; mv -f s t/io/inplace.t
sed -e $SDBMX -e $SDBHASH ext/GDBM_File/t/gdbm.t >s; mv -f s ext/GDBM_File/t/gdbm.t
sed -e $SSTAT -e $STMP2 t/op/stat.t >s; mv -f s t/op/stat.t
sed -e $SLIST x2p/Makefile.SH |tr -d '\r' >s; mv -f s x2p/Makefile.SH
#sed -e 's=^#define.\([A-Z]\+\)_EXP.*$=#define \1_EXP djgpp_pathexp("\1")=g' config_h.SH >s; mv -f s config_h.SH
sed -e 's=:^/:={^([a-z]:)?[\\\\/]}=g' lib/termcap.pl >s; mv -f s lib/termcap.pl
sed -e $SPACKLIST installman >s; mv -f s installman
sed -e $SPACKLIST lib/ExtUtils/Installed.pm >s; mv -f s lib/ExtUtils/Installed.pm
sed -e $SPACKLIST lib/ExtUtils/Packlist.pm >s; mv -f s lib/ExtUtils/Packlist.pm
sed -e $SABC t/io/iprefix.t >s; mv -f s t/io/iprefix.t
sed -e 's=L_ctermid==g' ext/POSIX/Makefile.PL >s; mv -f s ext/POSIX/Makefile.PL
sed -e $SPACKLIST lib/ExtUtils/t/Installed.t >s; mv -f s lib/ExtUtils/t/Installed.t
More information about the dslinux-commit
mailing list