dslinux/user/perl/epoc config.sh createpkg.pl epoc.c epoc_stubs.c epocish.c epocish.h link.pl
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:06 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/epoc
In directory antilope:/tmp/cvs-serv17422/epoc
Added Files:
config.sh createpkg.pl epoc.c epoc_stubs.c epocish.c epocish.h
link.pl
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: epoc_stubs.c ---
/*
* Copyright (c) 1999 Olaf Flebbe o.flebbe at gmx.de
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
int setgid() {return -1;}
int setuid() {return -1;}
int execv() { return -1;}
int execvp() { return -1;}
void Perl_do_exec() {}
--- NEW FILE: config.sh ---
#!/bin/sh
#
# This file is manually maintained.
#
# It is NOT produced by running the Configure script.
#
# Package name : perl5
# Source directory : .
# Configuration time:
# Configured by : Olaf Flebbe
# Target system : EPOC
Author=''
Date='$Date'
Header=''
Id='$Id'
Locker=''
Log='$Log'
[...1114 lines suppressed...]
nvsize='16'
issymlink=''
installarchlib='/home/of/PERL/perl/lib/5.6.0/epoc'
installbin='/home/of/PERL/System/Programs/'
installman1dir='/home/of/PERL/man1'
installman3dir='/home/of/PERL/man3'
installprefix=''
installprefixexp=''
installprivlib='/home/of/PERL/perl/lib/5.6.0/'
installscript='/home/of/PERL/bin/'
installsitearch='/home/of/PERL/site/lib/site_perl/5.6.0/epoc'
installsitelib='/home/of/PERL/perl/lib/site_perl/5.6.0'
installstyle=''
installusrbinperl='undef'
installvendorlib=''
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
sSCNfldbl=''
uquadtype='uint64_t'
--- NEW FILE: link.pl ---
#!/usr/bin/perl -w
$epoc="/usr/local/epoc";
@objs=@ARGV;
$basname=$objs[0];
$basname =~ s/.o//;
$baspe = $basname . "pe";
system("arm-pe-ld -s -e _E32Startup --base-file $basname.bas " .
"-o $baspe.exe $epoc/lib/eexe.o @objs " .
"$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib");
system("arm-pe-dlltool --as=arm-pe-as --output-exp $basname.exp " .
"--base-file $basname.bas $epoc/lib/eexe.o @objs " .
"$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib");
system("arm-pe-ld -s -e _E32Startup $basname.exp " .
"-o $baspe.exe $epoc/lib/eexe.o @objs " .
"$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib");
system( "wine $epoc/bin/petran.exe \"$baspe.exe $basname.exe " .
"-nocall -heap 0x00000400 0x00400000 -stack 0x0000c000 " .
"-uid1 0x1000007a -uid2 0x100051d8 -uid3 0x00000000\" ");
--- NEW FILE: epoc.c ---
/*
* Copyright (c) 1999 Olaf Flebbe o.flebbe at gmx.de
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <sys/unistd.h>
#include <process.h>
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
int
do_spawn( char *cmd) {
dTHX;
return system( cmd);
}
int
do_aspawn ( void *vreally, void **vmark, void **vsp) {
dTHX;
SV *really = (SV*)vreally;
SV **mark = (SV**)vmark;
SV **sp = (SV**)vsp;
char **argv;
char *str;
char *p2, **ptr;
char *cmd;
int rc;
int index = 0;
if (sp<=mark)
return -1;
ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*));
while (++mark <= sp) {
if (*mark && (str = SvPV_nolen(*mark)))
argv[index] = str;
else
argv[index] = "";
}
argv[index++] = 0;
cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0]));
rc = spawnvp( P_WAIT, cmd, argv);
free( argv);
free( cmd);
return rc;
}
static
XS(epoc_getcwd) /* more or less stolen from win32.c */
{
dXSARGS;
/* Make the host for current directory */
char *buffer;
int buflen = 256;
char *ptr;
buffer = (char *) malloc( buflen);
if (buffer == NULL) {
XSRETURN_UNDEF;
}
while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) {
buflen *= 2;
if (NULL == realloc( buffer, buflen)) {
XSRETURN_UNDEF;
}
}
/*
* If ptr != Nullch
* then it worked, set PV valid,
* else return 'undef'
*/
if (ptr) {
SV *sv = sv_newmortal();
char *tptr;
for (tptr = ptr; *tptr != '\0'; tptr++) {
if (*tptr == '\\') {
*tptr = '/';
}
}
sv_setpv(sv, ptr);
free( buffer);
EXTEND(SP,1);
SvPOK_on(sv);
ST(0) = sv;
#ifndef INCOMPLETE_TAINTS
SvTAINTED_on(ST(0));
#endif
XSRETURN(1);
}
free( buffer);
XSRETURN_UNDEF;
}
void
Perl_init_os_extras(void)
{
dTHX;
char *file = __FILE__;
newXS("EPOC::getcwd", epoc_getcwd, file);
}
--- NEW FILE: epocish.c ---
/*
* Copyright (c) 1999 Olaf Flebbe o.flebbe at gmx.de
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* This is C++ Code !! */
#include <e32std.h>
#include <stdlib.h>
#include <estlib.h>
#include <string.h>
extern "C" {
/* Workaround for defect strtoul(). Values with leading + are zero */
unsigned long int epoc_strtoul(const char *nptr, char **endptr,
int base) {
if (nptr && *nptr == '+')
nptr++;
return strtoul( nptr, endptr, base);
}
void epoc_gcvt( double x, int digits, unsigned char *buf) {
TRealFormat trel;
trel.iPlaces = digits;
trel.iPoint = TChar( '.');
TPtr result( buf, 80);
result.Num( x, trel);
result.Append( TChar( 0));
}
}
--- NEW FILE: createpkg.pl ---
#!/usr/bin/perl
use File::Find;
use Cwd;
$VERSION="5.8.8";
$EPOC_VERSION=1;
sub filefound {
my $f = $File::Find::name;
return if ( $f =~ /CVS|Unicode|unicore|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$|\.pod$|\.t$/i);
my $back = $f;
my $psiback = $back;
$psiback =~ s|.*/lib/|\\emx\\lib\\perl\\$VERSION\\|;
$psiback =~ s|/|\\|g;
print OUT "\"$back\"-\"!:$psiback\"\n" if ( -f $f );
}
open OUT,">perl.pkg";
print OUT "#{\"perl$VERSION\"},(0x100051d8),0,$EPOC_VERSION,0\n";
print OUT "\"" . cwd . "/Artistic.txt\"-\"\",FT,TC\n";
print OUT "\"" . cwd . "/perl\"-\"!:\\emx\\bin\\perl.exe\"\n";
find(\&filefound, cwd.'/lib');
open IN, "<Artistic";
open OUT, ">Artistic.txt";
while (my $line = <IN>) {
chomp $line;
print OUT "$line\r\n";
}
close IN;
close OUT;
--- NEW FILE: epocish.h ---
/*
* The following symbols are defined if your operating system supports
* functions by that name. All Unixes I know of support them, thus they
* are not checked by the configuration script, but are directly defined
* here.
*/
/* HAS_IOCTL:
* This symbol, if defined, indicates that the ioctl() routine is
* available to set I/O characteristics
*/
#define HAS_IOCTL /**/
/* HAS_UTIME:
* This symbol, if defined, indicates that the routine utime() is
* available to update the access and modification times of files.
*/
/* #define HAS_UTIME / **/
/* HAS_GROUP
* This symbol, if defined, indicates that the getgrnam() and
* getgrgid() routines are available to get group entries.
* The getgrent() has a separate definition, HAS_GETGRENT.
*/
/* #define HAS_GROUP / **/
/* HAS_PASSWD
* This symbol, if defined, indicates that the getpwnam() and
* getpwuid() routines are available to get password entries.
* The getpwent() has a separate definition, HAS_GETPWENT.
*/
/* #define HAS_PASSWD / **/
/* #define HAS_KILL */
#define HAS_WAIT
/* USEMYBINMODE
* This symbol, if defined, indicates that the program should
* use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
* that a file is in "binary" mode -- that is, that no translation
* of bytes occurs on read or write operations.
*/
#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
*/
#define USE_STAT_RDEV /**/
/* ACME_MESS:
* This symbol, if defined, indicates that error messages should be
* should be generated in a format that allows the use of the Acme
* GUI/editor's autofind feature.
*/
#undef ACME_MESS /**/
/* UNLINK_ALL_VERSIONS:
* This symbol, if defined, indicates that the program should arrange
* to remove all versions of a file if unlink() is called. This is
* probably only relevant for VMS.
*/
/* #define UNLINK_ALL_VERSIONS / **/
/* VMS:
* This symbol, if defined, indicates that the program is running under
* VMS. It is currently automatically set by cpps running under VMS,
* and is included here for completeness only.
*/
/* #define VMS / **/
/* ALTERNATE_SHEBANG:
* This symbol, if defined, contains a "magic" string which may be used
* as the first line of a Perl program designed to be executed directly
* by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
* begins with a character other then #, then Perl will only treat
* it as a command line if if finds the string "perl" in the first
* word; otherwise it's treated as the first line of code in the script.
* (IOW, Perl won't hand off to another interpreter via an alternate
* shebang sequence that might be legal Perl code.)
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
#define ABORT() abort();
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
* but which outputs all of the bytes requested as a single stream (unlike
* fwrite() itself, which on some systems outputs several distinct records
* if the number_of_items parameter is >1).
*/
#define fwrite1 fwrite
#define Stat(fname,bufptr) stat((fname),(bufptr))
#define Fstat(fd,bufptr) fstat((fd),(bufptr))
#define Fflush(fp) fflush(fp)
#define Mkdir(path,mode) mkdir((path),(mode))
/* epocemx setenv bug workaround */
#ifndef PERL_SYS_INIT
# define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) putenv(".dummy=foo"); putenv(".dummy"); MALLOC_INIT
#endif
#ifndef PERL_SYS_TERM
#define PERL_SYS_TERM() MALLOC_TERM
#endif
#define BIT_BUCKET "/dev/null"
#define dXSUB_SYS
/* getsockname returns the size of struct sockaddr_in *without* padding */
#define BOGUS_GETNAME_RETURN 8
/*
read() on a socket is unimplemented in current epocemx
use recv() instead
*/
#define PERL_SOCK_SYSREAD_IS_RECV
/* write ditto, use send */
#define PERL_SOCK_SYSWRITE_IS_SEND
/* No /dev/random available*/
#define PERL_NO_DEV_RANDOM
/*
work around for buggy atof():
atof() in ER5 stdlib depends on locale.
*/
#define strtoul(a,b,c) epoc_strtoul(a,b,c)
#define init_os_extras Perl_init_os_extras
#define ARG_MAX 4096
#define ECONNABORTED 0xdead
/* For environ */
#include <emx.h>
#define PERL_USE_SAFE_PUTENV
More information about the dslinux-commit
mailing list