In perl.git, the branch smoke-me/MPEiX_wheear-we-get-us-ooan-back has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/9fe05cc4e1fbd19615d327f0c94abf6ea70210f8?hp=ad0dc73b97f22a660d0022d35f64ccd4ff7bfde6> - Log ----------------------------------------------------------------- commit 9fe05cc4e1fbd19615d327f0c94abf6ea70210f8 Author: Nicholas Clark <n...@ccl4.org> Date: Thu Sep 20 12:04:24 2012 +0200 Remove the MPE/iX port. MPE/iX was a business-oriented minicomputer operating system made by Hewlett-Packard. Support from HP terminated at the end of 2010. ----------------------------------------------------------------------- Summary of changes: MANIFEST | 9 - Porting/exec-bit.txt | 2 - Porting/perlhist_calculate.pl | 2 +- README.mpeix | 711 ------------------------------------ ext/DynaLoader/dl_mpeix.xs | 146 -------- ext/File-Glob/t/basic.t | 2 +- ext/POSIX/t/posix.t | 2 - ext/re/hints/mpeix.pl | 3 - hints/mpeix.sh | 136 ------- installperl | 27 +-- lib/File/Copy.pm | 10 +- lib/FileHandle.t | 4 - lib/perl5db.pl | 3 +- mpeix/mpeix.c | 802 ----------------------------------------- mpeix/mpeix_setjmp.c | 355 ------------------ mpeix/mpeixish.h | 193 ---------- mpeix/nm | 33 -- mpeix/relink | 49 --- perl.c | 4 - perl.h | 5 - pod/perl.pod | 1 - pod/perl5005delta.pod | 2 +- pod/perlport.pod | 20 +- pp_sys.c | 4 +- t/io/pipe.t | 5 +- t/op/die_exit.t | 2 - t/op/fork.t | 3 - t/op/magic.t | 3 +- t/op/pack.t | 2 - t/op/stat.t | 1 - t/op/sysio.t | 3 +- win32/Makefile | 11 +- win32/makefile.mk | 11 +- 33 files changed, 30 insertions(+), 2536 deletions(-) delete mode 100644 README.mpeix delete mode 100644 ext/DynaLoader/dl_mpeix.xs delete mode 100644 ext/re/hints/mpeix.pl delete mode 100644 hints/mpeix.sh delete mode 100644 mpeix/mpeix.c delete mode 100644 mpeix/mpeix_setjmp.c delete mode 100644 mpeix/mpeixish.h delete mode 100755 mpeix/nm delete mode 100755 mpeix/relink diff --git a/MANIFEST b/MANIFEST index a7935fc..e1a8d62 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3701,7 +3701,6 @@ ext/DynaLoader/dl_dllload.xs S/390 dllload() style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_dyld.xs NeXT/Apple dyld implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation -ext/DynaLoader/dl_mpeix.xs MPE/iX implementation ext/DynaLoader/dl_next.xs NeXT implementation ext/DynaLoader/dl_none.xs Stub implementation ext/DynaLoader/dl_symbian.xs Symbian implementation @@ -3905,7 +3904,6 @@ ext/POSIX/t/usage.t Test the diagnostics for usage messages ext/POSIX/t/waitpid.t See if waitpid works ext/POSIX/t/wrappers.t Test the POSIX wrapper subroutines ext/POSIX/typemap POSIX extension interface types -ext/re/hints/mpeix.pl Hints for re for named architecture ext/re/Makefile.PL re extension makefile writer ext/re/re_comp.h re extension wrapper for regcomp.h ext/re/re.pm re extension Perl module @@ -4151,7 +4149,6 @@ hints/midnightbsd.sh Hints for named architecture hints/mips.sh Hints for named architecture hints/mirbsd.sh Hints for named architecture hints/mpc.sh Hints for named architecture -hints/mpeix.sh Hints for named architecture hints/ncr_tower.sh Hints for named architecture hints/netbsd.sh Hints for named architecture hints/newsos4.sh Hints for named architecture @@ -4486,11 +4483,6 @@ minimod.pl Writes lib/ExtUtils/Miniperl.pm miniperlmain.c Basic perl w/o dynamic loading or extensions mkppport A script that distributes ppport.h mkppport.lst List of extensions that need a ppport.h -mpeix/mpeix.c MPE/iX port -mpeix/mpeixish.h MPE/iX port -mpeix/mpeix_setjmp.c MPE/iX port -mpeix/nm MPE/iX port -mpeix/relink MPE/iX port mro.c Method Resolution Order code myconfig.SH Prints summary of the current configuration mydtrace.h Support for optional DTrace probes @@ -4881,7 +4873,6 @@ README.linux Perl notes for Linux README.macos Perl notes for Mac OS (Classic) README.macosx Perl notes for Mac OS X README.micro Notes about microperl -README.mpeix Perl notes for MPE/iX README.netware Perl notes for NetWare README.openbsd Perl notes for OpenBSD README.os2 Perl notes for OS/2 diff --git a/Porting/exec-bit.txt b/Porting/exec-bit.txt index 05a8967..ce7bd91 100644 --- a/Porting/exec-bit.txt +++ b/Porting/exec-bit.txt @@ -56,7 +56,5 @@ Porting/perlhist_calculate.pl Porting/sort_perldiag.pl Porting/sync-with-cpan Porting/valgrindpp.pl -mpeix/nm -mpeix/relink Cross/generate_config_sh Cross/warp diff --git a/Porting/perlhist_calculate.pl b/Porting/perlhist_calculate.pl index 8cbc3d9..bd49507 100755 --- a/Porting/perlhist_calculate.pl +++ b/Porting/perlhist_calculate.pl @@ -147,7 +147,7 @@ sub calc_longtable { emit Configure => $configure_size, 1; - foreach my $dir (qw(Cross djgpp emacs epoc h2pl hints mad mint mpeix NetWare os2 plan9 Porting qnx symbian utils vms vos win32 x2p)) { + foreach my $dir (qw(Cross djgpp emacs epoc h2pl hints mad mint NetWare os2 plan9 Porting qnx symbian utils vms vos win32 x2p)) { calc_dir($dir); } } diff --git a/README.mpeix b/README.mpeix deleted file mode 100644 index c382c46..0000000 --- a/README.mpeix +++ /dev/null @@ -1,711 +0,0 @@ -If you read this file _as_is_, just ignore the funny characters you -see. It is written in the POD format (see perlpod manpage) which is -specially designed to be readable as is. - -=head1 NAME - -perlmpeix - Perl/iX for HP e3000 MPE - -=head1 SYNOPSIS - - http://www.bixby.org/mark/perlix.html - Perl language for MPE - Last updated January 12, 2006 @ 2100 UTC - - -=head1 NOTE - -This is a podified version of what used to be on the above-mentioned web page, -podified by Jarkko Hietaniemi 2001-Jan-01. - -=head1 What's New in Perl for MPE/iX - -January 12, 2006 - -=over 4 - -=item * - -Updated for perl-5.8.8 and perl-5.9.3 by Ken Hirsch. - -Simplified the build process by using the MPEAUTOCONF -functionality in Mark Klein's ld. - -If you build this from scratch, make sure you have a version -of ld which supports it. In the shell, type - - ld --help - and look for AUTOCONF or MPEAUTOCONF near the bottom - - or do this: - ld --help 2>&1 | grep AUTOCONF - -If you see don't see AUTOCONF or MPEAUTOCONF, make sure you get a new -version. - -You also do not have to use mpeix/relink after building, so the -recommend sequence is: - - ./Configure -de - - # or ./Configure -de -Dusedevel - # if you're building a development version - - make - make test - # if you run this in a job, do "make test_notty" - - make install - -Be prepared for a wait. These take much longer on MPE/iX than on a Unix -system, because of a slow forking, mostly. On a lightly-loaded HP3000 -Series 979 running MPE/iX 7.5: - - Configure: 1 hour - make: 1 hour 15 minutes - make test 1 hour 45 minutes - -Various socket problems were fixed in mpeix.c. - -Mark Klein provided a fixed sigsetjmp (that works with dynamic -libraries) in mpeix_setjmp.c - -=back - -June 1, 2000 - -=over 4 - -=item * - -Rebuilt to be compatible with mod_perl. If you plan on using -mod_perl, you MUST download and install this version of Perl/iX! - -=item * - -uselargefiles="undef": not available in MPE for POSIX files yet. - -=item * - -Now bundled with various add-on packages: - -=over 8 - -=item * - -libnet (as seen on CPAN) - -=item * - -libwww-perl (LWP) which lets Perl programs behave like web browsers: - -=item * - -mod_perl (just the perl portion; the actual DSO will be released -soon with Apache/iX 1.3.12 from bixby.org). This module allows you to -write high performance persistent Perl CGI scripts and all sorts of -cool things. (L<http://perl.apache.org/>) - -and much much more hiding under /PERL/PUB/.cpan/ - -=item * - -The CPAN module now works for automatic downloading and -installing of add-on packages: - - 1. export FTP_PASSIVE=1 - 2. perl -MCPAN -e shell - 3. Ignore any terminal I/O related complaints! - -(L<http://search.cpan.org/dist/CPAN/>) - -=back - -=back - -May 20, 2000 - -=over 4 - -=item * - -Updated to version 5.6.0. Builds straight out of the box on MPE/iX. - -=item * - -Perl's getpwnam() function which had regressed to being -unimplemented on MPE is now implemented once again. - -=back - -September 17, 1999 - -=over 4 - -=item * - -Migrated from cccd.edu to bixby.org. - -=back - -=head1 Welcome to Perl/iX - -This is the official home page for the HP e3000 MPE/iX -( L<http://www.hp.com/go/e3000> ) port of the Perl scripting -language ( L<http://www.perl.com/> ) which gives you all of the power of C, -awk, sed, and sh in a single language. Check here for the latest news, -implemented functionality, known bugs, to-do list, etc. Status reports -about major milestones will also be posted to the HP3000-L mailing list -( L<http://www.lsoft.com/scripts/wl.exe?SL1=HP3000-L&H=RAVEN.UTC.EDU> ) and -its associated gatewayed newsgroup comp.sys.hp.mpe. - -I'm doing this port because I can't live without Perl on the Unix -machines that I administer, and I want to have the same power -available to me on MPE. - -Please send your comments, questions, and bug reports directly to me, -Mark Bixby ( L<http://www.bixby.org/mark/> ). Or just post them to HP3000-L. - -The platform I'm using to do this port is an HP 3000 957RX running -MPE/iX 6.0 and using the GNU gcc C compiler -( L<http://jazz.external.hp.com/src/gnu/gnuframe.html> ). - -The combined porting wisdom from all of my ports can be found in my -MPE/iX Porting Guide (L<http://www.bixby.org/mark/porting.html>). - -IMPORTANT NOTICE: Yes, I do work for the HP CSY R&D lab, but ALL of -the software you download from bixby.org is my personal freeware that -is NOT supported by HP. - -=head1 System Requirements for Perl/iX - -=over 4 - -=item * - -MPE/iX 5.5 or later. This version of Perl/iX does NOT run on -MPE/iX 5.0 or earlier, nor does it run on "classic" MPE/V machines. - -=item * - -If you wish to recompile Perl, you must install both GNUCORE and -GNUGCC from jazz (L<http://jazz.external.hp.com/src/gnu/gnuframe.html>). - -=item * - -Perl/iX will be happier on MPE/iX 5.5 if you install the MPEKX40B -extended POSIX filename characters patch, but this is optional. - -=item * - -Patch LBCJXT6A is required on MPE/iX 5.5 machines in order to -prevent Perl/iX from dying with an unresolved external reference -to _getenv_libc. - -=item * - -If you will be compiling Perl/iX yourself, you will also need -Syslog/iX ( L<http://www.bixby.org/mark/syslogix.html> ) and the -/BIND/PUB/include and /BIND/PUB/lib portions of BIND/iX -( L<http://www.bixby.org/mark/bindix.html> ). - -=back - -=head1 How to Obtain Perl/iX - -=over 4 - -=item 1. - -Download Perl using either FTP.ARPA.SYS or some other client - -=item 2. - -Extract the installation script - -=item 3. - -Edit the installation script - -=item 4. - -Run the installation script - -=item 5. - -Convert your *.a system archive libraries to *.sl shared libraries - -=back - -Download Perl using FTP.ARPA.SYS from your HP 3000 (the preferred -method)..... - - :HELLO MANAGER.SYS - :XEQ FTP.ARPA.SYS - open ftp.bixby.org - anonymous - your@email.address - bytestream - cd /pub/mpe - get perl-5.6.0-mpe.tar.Z /tmp/perl.tar.Z;disc=2147483647 - exit - -.....Or download using some other generic web or ftp client (the alternate -method) - -Download the following files (make sure that you use "binary mode" or -whatever client feature that is 8-bit clean): - -=over 4 - -=item * - -Perl from - - http://www.bixby.org/ftp/pub/mpe/perl-5.6.0-mpe.tar.Z - -or - - ftp://ftp.bixby.org/pub/mpe/perl-5.6.0-mpe.tar.Z - -=item * - -Upload those files to your HP 3000 in an 8-bit clean bytestream manner to: - - /tmp/perl.tar.Z - -=item * - -Then extract the installation script (after both download methods) - - :CHDIR /tmp - :XEQ TAR.HPBIN.SYS 'xvfopz /tmp/perl.tar.Z INSTALL' - -=item * - -Edit the installation script - -Examine the accounting structure creation commands and modify if -necessary (adding additional capabilities, choosing a non-system -volume set, etc). - - :XEQ VI.HPBIN.SYS /tmp/INSTALL - -=item * - -Run the installation script. - -The accounting structure will be created and then all files will be -extracted from the archive. - - :XEQ SH.HPBIN.SYS /tmp/INSTALL - -=item * - -Convert your *.a system archive libraries to *.sl shared libraries - -You only have to do this ONCE on your MPE/iX 5.5 machine in order to -convert /lib/lib*.a and /usr/lib/lib*.a libraries to their *.sl -equivalents. This step should not be necessary on MPE/iX 6.0 or later -machines because the 6.0 or later update process does it for you. - - :XEQ SH.HPBIN.SYS /PERL/PUB/LIBSHP3K - -=back - -=head1 Perl/iX Distribution Contents Highlights - -=over 4 - -=item README - -The file you're reading now. - -=item INSTALL - -Perl/iX Installation script. - -=item LIBSHP3K - -Script to convert *.a system archive libraries to *.sl shared libraries. - -=item PERL - -Perl NMPRG executable. A version-numbered backup copy also -exists. You might wish to "ln -s /PERL/PUB/PERL /usr/local/bin/perl". - -=item .cpan/ - -Much add-on source code downloaded with the CPAN module. - -=item lib/ - -Perl libraries, both core and add-on. - -=item man/ - -Perl man page documentation. - -=item public_html/feedback.cgi - -Sample feedback CGI form written in Perl. - -=item src/perl-5.6.0-mpe - -Source code. - -=back - -=head1 How to Compile Perl/iX - -=over 4 - -=item 1. - -cd src/perl-5.6.0-mpe - -=item 2. - -Read the INSTALL file for the official instructions - -=item 3. - -./Configure -d - -=item 4. - -make - -=item 5. - -./mpeix/relink - -=item 6. - -make test (expect approximately 15 out of 11306 subtests to fail, -mostly due to MPE not supporting hard links, UDP socket problems, -and handling exit() return codes improperly) - -=item 7. - -make install - -=item 8. - -Optionally create symbolic links that point to the Perl -executable, i.e. ln -s /PERL/PUB/PERL /usr/local/bin/perl - -=back - -The summary test results from "cd t; ./perl -I../lib harness": - - Failed Test Status Wstat Total Fail Failed List of failed - --------------------------------------------------------------------------- - io/fs.t 29 8 27.59% 2-5, 7-9, 11 - io/openpid.t 10 1 10.00% 7 - lib/io_sock.t 14 1 7.14% 13 - lib/io_udp.t 7 2 28.57% 3, 5 - lib/posix.t 27 1 3.70% 12 - op/lex_assign.t 187 1 0.53% 13 - op/stat.t 58 1 1.72% 3 - 15 tests and 94 subtests skipped. - Failed 7/236 test scripts, 97.03% okay. 15/11306 subtests failed, 99.87% okay. - -=head1 Getting Started with Perl/iX - -Create your Perl script files with "#!/PERL/PUB/perl" (or an -equivalent symbolic link) as the first line. Use the chmod command to -make sure that your script has execute permission. Run your script! - -Be sure to take a look at the CPAN module list -( L<http://www.cpan.org/CPAN.html> ). A wide variety of free Perl software -is available. You can automatically download these packages by using -the CPAN module ( L<http://search.cpan.org/dist/CPAN/> ). - -=head1 MPE/iX Implementation Considerations - -There some minor functionality issues to be aware of when comparing -Perl for Unix (Perl/UX) to Perl/iX: - -=over 4 - -=item * - -MPE gcc/ld doesn't properly support linking NMPRG executables against -NMXL dynamic libraries, so you must manually run mpeix/relink after -each re-build of Perl. - -=item * - -Perl/iX File::Copy will use MPE's /bin/cp command to copy files by -name in order to preserve file attributes like file code. - -=item * - -MPE (and thus Perl/iX) lacks support for setgrent(), endgrent(), -setpwent(), endpwent(). - -=item * - -MPE (and thus Perl/iX) lacks support for hard links. - -=item * - -MPE requires GETPRIVMODE() in order to bind() to ports less than 1024. -Perl/iX will call GETPRIVMODE() automatically on your behalf if you -attempt to bind() to these low-numbered ports. Note that the Perl/iX -executable and the PERL account do not normally have CAP=PM, so if you -will be bind()-ing to these privileged ports, you will manually need -to add PM capability as appropriate. - -=item * - -MPE requires that you bind() to an IP address of zero. Perl/iX -automatically replaces the IP address that you pass to bind() with -a zero. - -=item * - -MPE requires GETPRIVMODE() in order to setuid(). There are too many -calls to setuid() within Perl/iX, so I have not attempted an automatic -GETPRIVMODE() solution similar to bind(). - -=back - -=head1 Known Perl/iX Bugs Under Investigation - -None. - -=head1 Perl/iX To-Do List - -=over 4 - -=item * - -Make setuid()/setgid() support work. - -=item * - -Make sure that fcntl() against a socket descriptor is redirected to sfcntl(). - -=item * - -Add support for Berkeley DB once I've finished porting Berkeley DB. - -=item * - -Write an MPE XS extension library containing miscellaneous important -MPE functions like GETPRIVMODE(), GETUSERMODE(), and sfcntl(). - -=back - -=head1 Perl/iX Change History - -May 6, 1999 - -=over 4 - -=item * - -Patch LBCJXT6A is required on MPE/iX 5.5 machines in order to prevent -Perl/iX from dying with an unresolved external reference to _getenv_libc. - -=back - -April 7, 1999 - -=over 4 - -=item * - -Updated to version 5.005_03. - -=item * - -The official source distribution once again compiles "straight out -of the box" for MPE. - -=item * - -The current incarnation of the 5.5 POSIX filename extended -characters patch is now MPEKX40B. - -=item * - -The LIBSHP3K *.a -> *.sl library conversion script is now included -as /PERL/PUB/LIBSHP3K. - -=back - -November 20, 1998 - -=over 4 - -=item * - -Updated to version 5.005_02. - -=item * - -Fixed a DynaLoader bug that was unable to load symbols from relative -path name libraries. - -=item * - -Fixed a .xs compilation bug where the mpeixish.sh include file wasn't -being installed into the proper directory. - -=item * - -All bugfixes will be submitted back to the official Perl developers. - -=item * - -The current incarnation of the POSIX filename extended characters -patch is now MPEKXJ3A. - -=back - -August 14, 1998 - -=over 4 - -=item * - -The previous POSIX filename extended characters patch MPEKX44C has -been superseded by MPEKXB5A. - -=back - -August 7, 1998 - -=over 4 - -=item * - -The previous POSIX filename extended characters patch MPEKX76A has -been superseded by MPEKX44C. - -=back - -July 28, 1998 - -=over 4 - -=item * - -Updated to version 5.005_01. - -=back - -July 23, 1998 - -=over 4 - -=item * - -Updated to version 5.005 (production release). The public -freeware sources are now 100% MPE-ready "straight out of the box". - -=back - -July 17, 1998 - -=over 4 - -=item * - -Updated to version 5.005b1 (public beta release). The public -freeware sources are now 99.9% MPE-ready. By installing and -testing this beta on your own HP3000, you will be helping to -insure that the final release of 5.005 will be 100% MPE-ready and -100% bug free. - -=item * - -My MPE binary release is now extracted using my standard INSTALL script. - -=back - -July 15, 1998 - -=over 4 - -=item * - -Changed startperl to #!/PERL/PUB/perl so that Perl will recognize -scripts more easily and efficiently. - -=back - -July 8, 1998 - -=over 4 - -=item * - -Updated to version 5.004_70 (internal developer release) which is now -MPE-ready. The next public freeware release of Perl should compile -"straight out of the box" on MPE. Note that this version of Perl/iX -was strictly internal to me and never publicly released. Note that -[21]BIND/iX is now required (well, the include files and libbind.a) if -you wish to compile Perl/iX. - -=back - -November 6, 1997 - -=over 4 - -=item * - -Updated to version 5.004_04. No changes in MPE-specific functionality. - -=back - -October 16, 1997 - -=over 4 - -=item * - -Added Demos section to the Perl/iX home page so you can see some -sample Perl applications running on my 3000. - -=back - -October 3, 1997 - -=over 4 - -=item * - -Added System Requirements section to the Perl/iX home page just so the -prerequisites stand out more. Various other home page tweaks. - -=back - -October 2, 1997 - -=over 4 - -=item * - -Initial public release. - -=back - -September 1997 - -=over 4 - -=item * - -Porting begins. - -=back - -=head1 AUTHOR - -Mark Bixby, L<http://www.bixby.org/mark/> - diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs deleted file mode 100644 index be75698..0000000 --- a/ext/DynaLoader/dl_mpeix.xs +++ /dev/null @@ -1,146 +0,0 @@ -/* - * Author: Mark Klein (mkl...@dis.com) - * Version: 2.1, 1996/07/25 - * Version: 2.2, 1997/09/25 Mark Bixby (ma...@cccd.edu) - * Version: 2.3, 1998/11/19 Mark Bixby (ma...@cccd.edu) - * Version: 2.4, 2002/03/24 Mark Bixby (m...@bixby.org) - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef __GNUC__ -extern void HPGETPROCPLABEL( int parms, - char * procname, - void * plabel, - int * status, - char * firstfile, - int casesensitive, - int symboltype, - int * datasize, - int position, - int searchpath, - int binding); -#else -#pragma intrinsic HPGETPROCPLABEL -#endif -#include "dlutils.c" /* for SaveError() etc */ - -typedef struct { - char filename[PATH_MAX + 3]; - } t_mpe_dld, *p_mpe_dld; - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - -void -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - char buf[PATH_MAX + 3]; - p_mpe_dld obj = NULL; - - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename, -flags)); - if (flags & 0x01) - Perl_warn(aTHX_ -"Can't make loaded symbols global on this platform while loading %s",filename); - obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld)); - memzero(obj, sizeof(t_mpe_dld)); - if (filename[0] != '/') - { - getcwd(buf,sizeof(buf)); - sprintf(obj->filename," %s/%s ",buf,filename); - } - else - sprintf(obj->filename," %s ",filename); - - DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj)); - - ST(0) = sv_newmortal() ; - if (obj == NULL) - SaveError(aTHX_"%s",Strerror(errno)); - else - sv_setiv( ST(0), PTR2IV(obj) ); - -void -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - int datalen; - p_mpe_dld obj = (p_mpe_dld) libhandle; - char symname[PATH_MAX + 3]; - void * symaddr = NULL; - int status; - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - ST(0) = sv_newmortal() ; - errno = 0; - - sprintf(symname, " %s ", symbolname); - HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1, - 0, &datalen, 1, 0, 0); - - DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); - - if (status != 0) { - SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ; - } else { - sv_setiv( ST(0), PTR2IV(symaddr) ); - } - -void -dl_undef_symbols() - CODE: - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - const char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, - (void(*)(pTHX_ CV *))symref, - filename, NULL, - XS_DYNAMIC_FILENAME))); - -char * -dl_error() - CODE: - dMY_CXT; - RETVAL = dl_last_error ; - OUTPUT: - RETVAL - -#if defined(USE_ITHREADS) - -void -CLONE(...) - CODE: - MY_CXT_CLONE; - - /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid - * using Perl variables that belong to another thread, we create our - * own for this thread. - */ - MY_CXT.x_dl_last_error = newSVpvn("", 0); - -#endif - -# end. diff --git a/ext/File-Glob/t/basic.t b/ext/File-Glob/t/basic.t index bcd9999..497241f 100644 --- a/ext/File-Glob/t/basic.t +++ b/ext/File-Glob/t/basic.t @@ -130,7 +130,7 @@ SKIP: { # check bad protections # should return an empty list, and set ERROR SKIP: { - skip $^O, 2 if $^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' + skip $^O, 2 if $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin'; skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s; skip "running as root", 2 if not $>; diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t index be804c24..a397933 100644 --- a/ext/POSIX/t/posix.t +++ b/ext/POSIX/t/posix.t @@ -23,7 +23,6 @@ $| = 1; $Is_W32 = $^O eq 'MSWin32'; $Is_Dos = $^O eq 'dos'; -$Is_MPE = $^O eq 'mpeix'; $Is_MacOS = $^O eq 'MacOS'; $Is_VMS = $^O eq 'VMS'; $Is_OS2 = $^O eq 'os2'; @@ -141,7 +140,6 @@ SKIP: { } SKIP: { - skip("_POSIX_OPEN_MAX is inaccurate on MPE", 1) if $Is_MPE; skip("_POSIX_OPEN_MAX undefined ($fds[1])", 1) unless &_POSIX_OPEN_MAX; cmp_ok(&_POSIX_OPEN_MAX, '>=', 16, diff --git a/ext/re/hints/mpeix.pl b/ext/re/hints/mpeix.pl deleted file mode 100644 index d1fbb91..0000000 --- a/ext/re/hints/mpeix.pl +++ /dev/null @@ -1,3 +0,0 @@ -# Fall back to -O optimization to avoid known gcc 2.8.0 -O2 problems on MPE/iX. -# Mark Bixby <ma...@cccd.edu> -$self->{OPTIMIZE} = '-O'; diff --git a/hints/mpeix.sh b/hints/mpeix.sh deleted file mode 100644 index afa6cf8..0000000 --- a/hints/mpeix.sh +++ /dev/null @@ -1,136 +0,0 @@ -# Created for 5.003 by Mark Klein, mkl...@dis.com. -# Substantially revised for 5.004_01 by Mark Bixby, ma...@cccd.edu. -# Revised again for 5.004_69 by Mark Bixby, ma...@cccd.edu. -# Revised for 5.6.0 by Mark Bixby, mbi...@power.net. -# Revised for 5.7.3 by Mark Bixby, m...@bixby.org. -# Revised for 5.8.0 by Mark Bixby, m...@bixby.org. -# Revised for 5.8.8/5.9.3 by Ken Hirsch, kenhir...@ftml.net -# -osname='mpeix' -osvers=`uname -r | sed -e 's/.[A-Z]\.\([0-9]\)\([0-9]\)\.[0-9][0-9]/\1.\2/'` - -# -# Don't use nm. Instead, we'll use the MPEAUTOCONF environment variable -# to force error for unresolved externals. -# This is slower than nm (about 70 minutes instead of 35 minutes), -# but much more reliable. - -usenm='false' -export AUTOCONF=1 MPEAUTOCONF=1 - -# Work around the broken inline cat bug that corrupts here docs -# -alias -x cat=/bin/cat -# -# Various directory locations. -# -# Which ones of these does Configure get wrong? -test -z "$prefix" && prefix="/$HPACCOUNT/$HPGROUP" -archname='PA-RISC1.1' -bin="$prefix" -installman1dir="$prefix/man/man1" -installman3dir="$prefix/man/man3" -man1dir="$prefix/man/man1" -man3dir="$prefix/man/man3" -perlpath="$prefix/PERL" -scriptdir="$prefix" -startperl="#!$prefix/perl" -startsh='#!/bin/sh' - -# -# Compiling. -# -test -z "$cc" && cc='gcc' -cccdlflags='none' -ccdlflags='-Xlinker -WL,xl=/usr/lib/libcurses.sl,/lib/libsvipc.sl,/usr/lib/libsocket.sl,/usr/lib/libstr.sl,/lib/libm.sl,/lib/libc.sl' -ccflags="$ccflags -DMPE -D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL" -locincpth="$locincpth /usr/local/include /usr/contrib/include /BIND/CURRENT/include /SYSLOG/PUB" -test -z "$optimize" && optimize="-O2" -ranlib='/bin/true' -# Special compiling options for certain source files. -# But what if you want -g? -regcomp_cflags='optimize=-O' -toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' - -# -# Linking. -# -# Build a fixed sigsetjmp that can be used in dynamic libraries -# This needs to be compiled with -O2, so I do it here, rather -# than with make -gcc -c -O2 mpeix/mpeix_setjmp.c -lddlflags="-b $PWD/mpeix_setjmp.o" - -# Delete bsd and BSD from the library list. Remove other randomly ordered -# libraries and then re-add them in their proper order (the MPE linker is -# order-sensitive). Add additional MPE-specific libraries. -for mpe_remove in bind bsd BSD c curses m socket str svipc syslog; do - set `echo " $libswanted " | sed -e 's/ / /g' -e "s/ $mpe_remove //"` - libswanted="$*" -done -libswanted="$libswanted bind syslog curses svipc socket str m c" -loclibpth="$loclibpth /usr/local/lib /usr/contrib/lib /BIND/CURRENT/lib /SYSLOG/PUB" -# -# External functions and data items. -# -# Q: Does Configure *really* get *all* of these wrong? -# -# A: Yes. There are two MPE problems here. The 'undef' functions exist on MPE, -# but are merely dummy routines that return ENOTIMPL or ESYSERR. Since they're -# useless, let's just tell Perl to avoid them. Also, a few data items are -# 'undef' because while they may exist in structures, they are uninitialized. - -d_Gconvert='gcvt((x),(n),(b))' - -d_inetaton='undef' - -# these fields exist, but are uninitialized -d_pwage='undef' -d_pwcomment='undef' -d_pwgecos='undef' -d_pwpasswd='undef' -d_statblks='undef' - -# These functions exist, -# but either return ENOSYS/ESYSERR/ENOSYS or work so differently -# that it is not helpful to include them - -d_lchown='undef' -d_link='undef' -d_setegid='undef' -d_seteuid='undef' -d_setitimer='undef' -d_setpgid='undef' -d_setsid='undef' - - -# These are defined in mpeix/mpeix.c -d_gettimeod='define' -d_truncate='define' - -# Include files. -# -#??i_gdbm='undef' # the port is currently incomplete - -i_termios='undef' # we have termios, but not the full set (just tcget/setattr) - -i_time='define' -i_systime='undef' -i_systimek='undef' -timeincl='/usr/include/time.h' -# -# Data types. -# -timetype='time_t' - -# Functionality. -# -uselargefiles="$undef" - -# Expected functionality provided in mpeix.c. -# - -# Help gmake find mpeix.c -test -h mpeix.c || ln -s mpeix/mpeix.c mpeix.c - -archobjs='mpeix.o mpeix_setjmp.o' diff --git a/installperl b/installperl index c19bff1..64a94ab 100755 --- a/installperl +++ b/installperl @@ -299,16 +299,6 @@ if ($Is_VMS) { chmod(0755, "$installbin/${dbg}a2p$exe_ext"); } } -elsif ($^O eq 'mpeix') { - # MPE lacks hard links and requires that executables with special - # capabilities reside in the MPE namespace. - safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath}); - # Install the primary executable into the MPE namespace as perlpath. - copy("perl$exe_ext", $Config{perlpath}); - chmod(0755, $Config{perlpath}); - # Create a backup copy with the version number. - link($Config{perlpath}, "$installbin/perl$ver$exe_ext"); -} elsif ($^O ne 'dos') { if (!$Is_NetWare) { safe_unlink("$installbin/$perl_verbase$ver$exe_ext"); @@ -389,11 +379,6 @@ elsif ($Is_Cygwin) { # On Cygwin symlink it to CORE to make Makefile happy # AIX needs perl.exp installed as well. push(@corefiles,'perl.exp') if $^O eq 'aix'; - if ($^O eq 'mpeix') { - # MPE needs mpeixish.h installed as well. - mkpath("$installarchlib/CORE/mpeix", $opts{verbose}, 0777); - push(@corefiles,'mpeix/mpeixish.h'); - } } foreach my $file (@corefiles) { # HP-UX (at least) needs to maintain execute permissions @@ -413,11 +398,7 @@ foreach my $file (@corefiles) { if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS && ! $Is_NetWare) { safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext"); - if ($^O eq 'mpeix') { - # MPE doesn't support hard links, so use a symlink. - # We don't want another cloned copy. - symlink($Config{perlpath}, "$installbin/perl$exe_ext"); - } elsif ($^O eq 'vos') { + if ($^O eq 'vos') { # VOS doesn't support hard links, so use a symlink. symlink("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$perl$exe_ext"); @@ -432,11 +413,7 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM if ($archname && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) { my $archperl = "$perl_verbase$ver-$Config{archname}$exe_ext"; safe_unlink("$installbin/$archperl"); - if ($^O eq 'mpeix') { - # MPE doesn't support hard links, so use a symlink. - # We don't want another cloned copy. - symlink($Config{perlpath}, "$installbin/$archperl"); - } elsif ($^O eq 'vos') { + if ($^O eq 'vos') { # VOS doesn't support hard links, so use a symlink. symlink("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$archperl"); diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index ef27037..c34670c 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -22,7 +22,7 @@ sub syscopy; sub cp; sub mv; -$VERSION = '2.24'; +$VERSION = '2.25'; require Exporter; @ISA = qw(Exporter); @@ -154,7 +154,6 @@ sub copy { if (defined &syscopy && !$Syscopy_is_copy && !$to_a_handle && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles - && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX. && !($from_a_handle && $^O eq 'MSWin32') && !($from_a_handle && $^O eq 'NetWare') ) @@ -412,13 +411,6 @@ sub mv { _move(@_,\&cp); } unless (defined &syscopy) { if ($^O eq 'VMS') { *syscopy = \&rmscopy; - } elsif ($^O eq 'mpeix') { - *syscopy = sub { - return 0 unless @_ == 2; - # Use the MPE cp program in order to - # preserve MPE file attributes. - return system('/bin/cp', '-f', $_[0], $_[1]) == 0; - }; } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) { # Win32::CopyFile() fill only work if we can load Win32.xs *syscopy = sub { diff --git a/lib/FileHandle.t b/lib/FileHandle.t index ddbd944..aeae754 100644 --- a/lib/FileHandle.t +++ b/lib/FileHandle.t @@ -8,10 +8,6 @@ BEGIN { print "1..0\n"; exit 0; } - if ($^O eq 'mpeix') { - print "1..0 # Skip: broken on MPE/iX\n"; - exit 0; - } } use FileHandle; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index c8596df..4f517d0 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -523,7 +523,7 @@ BEGIN { # Debugger for Perl 5.00x; perl5db.pl patch level: use vars qw($VERSION $header); -$VERSION = '1.39_03'; +$VERSION = '1.39_04'; $header = "perl5db.pl version $VERSION"; @@ -8276,7 +8276,6 @@ my @pods = qw( modlib mod modstyle - mpeix netware newmod number diff --git a/mpeix/mpeix.c b/mpeix/mpeix.c deleted file mode 100644 index f289a4b..0000000 --- a/mpeix/mpeix.c +++ /dev/null @@ -1,802 +0,0 @@ - -/* - * gcc long pointer support code for HPPA. - * Copyright 1998, DIS International, Ltd. - * This code is free software; you may redistribute it and/or modify - * it under the same terms as Perl itself. (Relicensed for Perl in - * in April 2002 by Mark Klein.) - */ -typedef struct { - int spaceid; - unsigned int offset; - } LONGPOINTER, longpointer; - -/* - * gcc long pointer support code for HPPA. - * Copyright 1998, DIS International, Ltd. - * This code is free software; you may redistribute it and/or modify - * it under the same terms as Perl itself. (Relicensed for Perl in - * in April 2002 by Mark Klein.) - */ - -int __perl_mpe_getspaceid(void *source) - { - int val; - /* - * Given the short pointer, determine it's space ID. - */ - - /* - * The colons separate output from input parameters. In this case, - * the output of the instruction (output indicated by the "=" in the - * constraint) is to a memory location (indicated by the "m"). The - * input constraint indicates that the source to the instruction - * is a register reference (indicated by the "r"). - * The general format is: - * asm("<instruction template>" : <output> : <input> : <clobbers>); - * where <output> and <input> are: - * "<constraint>" (<token>) - * <instruction template> is the PA-RISC instruction in template fmt. - * <clobbers> indicates those registers clobbered by the instruction - * and provides hints to the optimizer. - * - * Refer to the gcc documentation - */ - __asm__ __volatile__ ( - " comiclr,= 0,%1,%%r28\n" - "\t ldsid (%%r0,%1),%%r28\n" - "\t stw %%r28, %0" - : "=m" (val) // Output to val - : "r" (source) // Source must be gen reg - : "%r28"); // Clobbers %r28 - return (val); - }; - -LONGPOINTER __perl_mpe_longaddr(void *source) - { - LONGPOINTER lptr; - /* - * Return the long pointer for the address in sr5 space. - */ - - __asm__ __volatile__ ( - " comiclr,= 0,%2,%%r28\n" - "\t ldsid (%%r0,%2),%%r28\n" - "\t stw %%r28, %0\n" - "\t stw %2, %1" - : "=m" (lptr.spaceid), - "=m" (lptr.offset) // Store to lptr - : "r" (source) // Source must be gen reg - : "%r28"); // Clobbers %r28 - return (lptr); - }; - -LONGPOINTER __perl_mpe_addtopointer(LONGPOINTER source, // %r26 == source offset - // %r25 == source space - int len) // %r24 == length in bytes - { - /* - * Increment a longpointer. - */ - - __asm__ __volatile__ ( - " copy %0,%%r28\n" // copy space to r28 - "\t add %1,%2,%%r29" // Increment the pointer - : // No output - : "r" (source.spaceid), // Source address - "r" (source.offset), - "r" (len) // Length - : "%r28", // Clobbers - "%r29"); - }; - -void __perl_mpe_longmove(int len, // %r26 == byte length - LONGPOINTER source, // %r23 == source space, %r24 == off - LONGPOINTER target) // sp-#56 == target space, sp-#52== off - { - /* - * Move data between two buffers in long pointer space. - */ - - __asm__ __volatile__ ( - " .import $$lr_unk_unk_long,MILLICODE\n" - "\t mtsp %0,%%sr1\n" // copy source space to sr1 - "\t copy %1,%%r26\n" // load source offset to r26 - "\t copy %4,%%r24\n" // load length to r24 - "\t copy %3,%%r25\n" // load target offset to r25 - "\t bl $$lr_unk_unk_long,%%r31\n" // start branch to millicode - "\t mtsp %2,%%sr2" // copy target space to sr2 - : // No output - : "r" (source.spaceid), // Source address - "r" (source.offset), - "r" (target.spaceid), // Target address - "r" (target.offset), - "r" (len) // Byte length - : "%r1", // Clobbers - "%r24", - "%r25", - "%r26", - "%r31"); - }; - -int __perl_mpe_longpeek(LONGPOINTER source) - { - /* - * Fetch the int in long pointer space. - */ - unsigned int val; - - __asm__ __volatile__ ( - " mtsp %1, %%sr1\n" - "\t copy %2, %%r28\n" - "\t ldw 0(%%sr1, %%r28), %%r28\n" - "\t stw %%r28, %0" - : "=m" (val) // Output val - : "r" (source.spaceid), // Source space ID - "r" (source.offset) // Source offset - : "%r28"); // Clobbers %r28 - - return (val); - }; - -void __perl_mpe_longpoke(LONGPOINTER target, // %r25 == spaceid, %r26 == offset - unsigned int val) // %r24 == value - { - /* - * Store the val into long pointer space. - */ - __asm__ __volatile__ ( - " mtsp %0,%%sr1\n" - "\t copy %1, %%r28\n" - "\t stw %2, 0(%%sr1, %%r28)" - : // No output - : "r" (target.spaceid), // Target space ID - "r" (target.offset), // Target offset - "r" (val) // Value to store - : "%r28" // Clobbers %r28 - ); // Copy space to %sr1 - }; - -void __perl_mpe_move_fast(int len, // %r26 == byte length - void *source, // %r25 == source addr - void *target) // %r24 == target addr - { - /* - * Move using short pointers. - */ - __asm__ __volatile__ ( - " .import $$lr_unk_unk,MILLICODE\n" - "\t copy %1, %%r26\n" // Move source addr into pos - "\t copy %2, %%r25\n" // Move target addr into pos - "\t bl $$lr_unk_unk,%%r31\n" // Start branch to millicode - "\t copy %0, %%r24" // Move length into position - : // No output - : "r" (len), // Byte length - "r" (source), // Source address - "r" (target) // Target address - : "%r24", // Clobbers - "%r25", - "%r26", - "%r31"); - }; - -/* - * ftruncate - set file size, BSD Style - * - * shortens or enlarges the file as neeeded - * uses some undocumented locking call. It is known to work on SCO unix, - * other vendors should try. - * The #error directive prevents unsupported OSes - * - * ftruncate/truncate code by Mark Bixby. - * This code is free software; you may redistribute it and/or modify - * it under the same terms as Perl itself. - * - */ - -#ifndef _POSIX_SOURCE -# define _POSIX_SOURCE -#endif -#ifndef _SOCKET_SOURCE -# define _SOCKET_SOURCE -#endif -#include <unistd.h> -#include <errno.h> -#include <fcntl.h> -#include <stdio.h> -#include <string.h> -#include <sys/socket.h> -#include <limits.h> -#include <mpe.h> - -extern void FCONTROL(short, short, longpointer); -extern void PRINTFILEINFO(int); - -int ftruncate(int fd, long wantsize); - -int -ftruncate(int fd, long wantsize) -{ - int ccode_return,dummy=0; - - if (lseek(fd, wantsize, SEEK_SET) < 0) - { - return (-1); - } - - FCONTROL(_mpe_fileno(fd),6,__perl_mpe_longaddr(&dummy)); /* Write new EOF */ - if ((ccode_return=ccode()) != CCE) - { - fprintf(stderr, - "MPE ftruncate failed, ccode=%d, wantsize=%ld\n", - ccode_return, wantsize); - PRINTFILEINFO(_mpe_fileno(fd)); - errno = ESYSERR; - return (-1); - } - - return (0); -} - -/* - wrapper for truncate(): - - truncate() is UNIX, not POSIX. - - This function requires ftruncate(). - - - - NAME - truncate - - - SYNOPSIS - #include <unistd.h> - - int truncate(const char *pathname, off_t length); - - Returns: 0 if OK, -1 on error - - from: Stevens' Advanced Programming in the UNIX Environment, p. 92 - - - - ERRORS - EACCES - EBADF - EDQUOT (not POSIX) <- not implemented here - EFAULT - EINVAL - EISDIR - ELOOP (not POSIX) <- not implemented here - ENAMETOOLONG - ENOTDIR - EROFS - ETXTBSY (not POSIX) <- not implemented here - - from: HP-UX man page - - - - Compile directives: - PRINT_ERROR - make this function print an error message to stderr -*/ - - -#include <sys/types.h> /* off_t, required by open() */ -#include <sys/stat.h> /* required by open() */ -#include <fcntl.h> /* open() */ -#include <unistd.h> /* close() */ -#include <stdio.h> /* perror(), sprintf() */ - - - -int -truncate(const char *pathname, off_t length) -{ - int fd; -#ifdef PRINT_ERROR - char error_msg[80+1]; -#endif - - if (length == 0) - { - if ( (fd = open(pathname, O_WRONLY | O_TRUNC)) < 0) - { - /* errno already set */ -#ifdef PRINT_ERROR - sprintf(error_msg, - "truncate(): open(%s, O_WRONLY | OTRUNC)\0", - pathname); - perror(error_msg); -#endif - return -1; - } - } - else - { - if ( (fd = open(pathname, O_WRONLY)) < 0) - { - /* errno already set */ -#ifdef PRINT_ERROR - sprintf(error_msg, - "truncate(): open(%s, O_WRONLY)\0", - pathname); - perror(error_msg); -#endif - return -1; - } - - if (ftruncate(fd, length) < 0) - { - /* errno already set */ -#ifdef PRINT_ERROR - perror("truncate(): ftruncate()"); -#endif - return -1; - } - } - - if (close(fd) < 0) - { - /* errno already set */ -#ifdef PRINT_ERROR - perror("truncate(): close()"); -#endif - return -1; - } - - return 0; -} /* truncate() */ - -/* - wrapper for gettimeofday(): - gettimeofday() is UNIX, not POSIX. - gettimeofday() is a BSD function. - - NAME - gettimeofday - - - SYNOPSIS - #include <sys/time.h> - - int gettimeofday(struct timeval *tp, struct timezone *tzp); - - DESCRIPTION - This function returns seconds and microseconds since midnight - January 1, 1970. The microseconds is actually only accurate to - the millisecond. - - Note: To pick up the definitions of structs timeval and timezone - from the <time.h> include file, the directive - _SOCKET_SOURCE must be used. - - RETURN VALUE - A 0 return value indicates that the call succeeded. A -1 return - value indicates an error occurred; errno is set to indicate the - error. - - ERRORS - EFAULT not implemented - - Changes: - 2-91 DR. Created. -*/ - - -/* need _SOCKET_SOURCE to pick up structs timeval and timezone in time.h */ -#ifndef _SOCKET_SOURCE -# define _SOCKET_SOURCE -#endif - -#include <time.h> /* structs timeval & timezone, - difftime(), localtime(), mktime(), time() */ - -extern int TIMER(); - -/* - * gettimeofday code by Mark Bixby. - * This code is free software; you may redistribute it and/or modify - * it under the same terms as Perl itself. - */ - -#ifdef __STDC__ -int gettimeofday( struct timeval *tp, struct timezone *tpz ) -#else -int gettimeofday( tp, tpz ) -struct timeval *tp; -struct timezone *tpz; -#endif -{ - static unsigned long basetime = 0; - static int dsttime = 0; - static int minuteswest = 0; - static int oldtime = 0; - int newtime; - - - /*-------------------------------------------------------------------*/ - /* Setup a base from which all future time will be computed. */ - /*-------------------------------------------------------------------*/ - if ( basetime == 0 ) - { - time_t gmt_time; - time_t loc_time; - struct tm *loc_time_tm; - - gmt_time = time( NULL ); - loc_time_tm = localtime( &gmt_time ) ; - loc_time = mktime( loc_time_tm ); - - oldtime = TIMER(); - basetime = (unsigned long) ( loc_time - (oldtime/1000) ); - - /*----------------------------------------------------------------*/ - /* The calling process must be restarted if timezone or dst */ - /* changes. */ - /*----------------------------------------------------------------*/ - minuteswest = (int) (difftime( loc_time, gmt_time ) / 60); - dsttime = loc_time_tm->tm_isdst; - } - - /*-------------------------------------------------------------------*/ - /* Get the new time value. The timer value rolls over every 24 days, */ - /* so if the delta is negative, the basetime value is adjusted. */ - /*-------------------------------------------------------------------*/ - newtime = TIMER(); - if ( newtime < oldtime ) basetime += 2073600; - oldtime = newtime; - - /*-------------------------------------------------------------------*/ - /* Return the timestamp info. */ - /*-------------------------------------------------------------------*/ - tp->tv_sec = basetime + newtime/1000; - tp->tv_usec = (newtime%1000) * 1000; /* only accurate to milli */ - if (tpz) - { - tpz->tz_minuteswest = minuteswest; - tpz->tz_dsttime = dsttime; - } - - return 0; - -} /* gettimeofday() */ - -/* -** MPE_FCNTL -- shadow function for fcntl() -** -** MPE requires sfcntl() for sockets, and fcntl() for everything -** else. This shadow routine determines the descriptor type and -** makes the appropriate call. -** -** Parameters: -** same as fcntl(). -** -** Returns: -** same as fcntl(). -*/ - -#include <stdarg.h> -#include <sys/socket.h> - -int -mpe_fcntl(int fildes, int cmd, ...) -{ - int len, result; - struct sockaddr sa; - - void *arg; - va_list ap; - - va_start(ap, cmd); - arg = va_arg(ap, void *); - va_end(ap); - - len = sizeof sa; - if (getsockname(fildes, &sa, &len) == -1) - { - if (errno == EAFNOSUPPORT) - /* AF_UNIX socket */ - return sfcntl(fildes, cmd, arg); - - if (errno == ENOTSOCK) - /* file or pipe */ - return fcntl(fildes, cmd, arg); - - /* unknown getsockname() failure */ - return (-1); - } - else - { - /* AF_INET socket */ - if ((result = sfcntl(fildes, cmd, arg)) != -1 && cmd == F_GETFL) - result |= O_RDWR; /* fill in some missing flags */ - return result; - } -} - - - -/* - * Stuff from here on down is written by Ken Hirsch - * and you may use it for any purpose. - * No warranty, express or implied. - */ - -#include <stddef.h> -#include <sys/ioctl.h> -#include <netinet/in.h> - -#ifndef _SOCKLEN_T -typedef unsigned int socklen_t; -#define _SOCKLEN_T -#endif - -static int max_io_size(int filedes); - -ssize_t -mpe_read(int filedes, void *buffer, size_t len) -{ - int maxio; - if (len > 4096 && (len > (maxio = max_io_size(filedes)))) - len = maxio; - - return read(filedes, buffer, len); -} - -ssize_t -mpe_write(int filedes, const void *buffer, size_t len) -{ - int written = 0; - int orig_len = len; - int maxio = (len>4096)?max_io_size(filedes):INT_MAX; - const char *buf = (const char *)buffer; - - do { - written = write(filedes, buf, len>maxio?maxio:len); - if (written < 0) - break; - len -= written; - buf += written; - } while (len > 0); - - if (written < 0 && len == orig_len) - return -1; - else - return orig_len - len; -} - - -ssize_t -mpe_send(int socket, const void *buffer, size_t len, int flags) -{ - int written = 0; - int orig_len = len; - int maxio = (len>4096)?max_io_size(socket):INT_MAX; - const char *buf = (const char *)buffer; - - do { - written = send(socket, buf, len>maxio?maxio:len, flags); - if (written < 0) - break; - len -= written; - buf += written; - } while (len > 0); - - if (written < 0 && len == orig_len) - return -1; - else - return orig_len - len; -} - -ssize_t -mpe_sendto(int socket, const void *buffer, size_t len, - int flags, const struct sockaddr *dest_addr, - socklen_t dest_len) -{ - int written = 0; - int orig_len = len; - int maxio = (len>4096)?max_io_size(socket):INT_MAX; - const char *buf = (const char *)buffer; - - do { - written = - sendto(socket, buf, len>maxio?maxio:len, flags, dest_addr, dest_len); - if (written < 0) - break; - len -= written; - buf += written; - } while (len > 0); - - if (written < 0 && len == orig_len) - return -1; - else - return orig_len - len; -} - - -ssize_t -mpe_recv(int socket, void *buffer, size_t len, int flags) -{ - int maxio; - if (len > 4096 && (len > (maxio = max_io_size(socket)))) - len = maxio; - return recv(socket, buffer, len, flags); -} - -ssize_t -mpe_recvfrom(int socket, void *buffer, size_t len, - int flags, struct sockaddr *address, - socklen_t *address_len) -{ - int maxio; - if (len > 4096 && (len > (maxio = max_io_size(socket)))) - len = maxio; - return recvfrom(socket, buffer, len, flags, address, address_len); -} - -/* - I didn't do thse two: -ssize_t mpe_recvmsg(int, struct msghdr *, int); -ssize_t mpe_sendmsg(int, const struct msghdr *, int); -*/ - -/* - * On MPE/iX (at least version 6.0), a getsockname() - * performed on a socket that is listening - * will return INADDR_ANY, even if you used - * bind to bind it to a particular IP address. - * - * (In fact, it appears that the socket always acts as - * if you used INADDR_ANY.) - * - * Here I save the IP address used in bind - * So I can get it in getsockname() - * - */ - -/* I just save 40. Usually one or two should be enough - */ - -int -mpe_connect(int socket, - const struct sockaddr *address, - socklen_t address_len) -{ - int ret = connect(socket, address, address_len); - if (ret < 0 && errno == EINPROGRESS) - { - /* Need to call getsockopt to clear socket error */ - int socket_error; - socklen_t err_size = sizeof(socket_error); - (void)getsockopt(socket, SOL_SOCKET, SO_ERROR, - &socket_error, &err_size); - errno = EINPROGRESS; - } - return ret; -} - -static struct { - int fd; - struct in_addr holdaddr; -} holdbind[40]; -#define HOLDBINDLAST ((sizeof(holdbind))/(sizeof(holdbind[0]))) -static int nextbind; - -/* - * Fix peculiarities of bind() on MPE - * 1. call GETPRIVMODE to bind to ports < 1024 - * 2. save IP address for future calls to getsockname - * 3. set IP address to 0 (INADDR_ANY) - */ - -int -mpe_bind(int socket, const struct sockaddr *address, socklen_t address_len) -{ - int i; - int result; - int mpeprivmode=0; - extern void GETPRIVMODE(void); - extern void GETUSERMODE(void); - - for (i = 0; i<HOLDBINDLAST; i++) { - if (holdbind[i].fd == socket) - break; - } - /* If we didn't find previously used slot, use next */ - if (i == HOLDBINDLAST) - i = nextbind; - - holdbind[i].fd = socket; - - memset(&holdbind[i].holdaddr, '\0', sizeof(holdbind[i].holdaddr)); - if (address->sa_family == AF_INET - && address_len >= offsetof(struct sockaddr_in, sin_addr) - +sizeof(struct in_addr)) { - holdbind[i].holdaddr = ((struct sockaddr_in *)address)->sin_addr; - } - if (i == nextbind) - { - if (++nextbind >= HOLDBINDLAST) - nextbind = 0; - } - - if (address->sa_family == AF_INET) - { - /* The address *MUST* stupidly be zero. */ - ((struct sockaddr_in *)address)->sin_addr.s_addr = INADDR_ANY; - /* PRIV mode is required to bind() to ports < 1024. */ - if (((struct sockaddr_in *)address)->sin_port < 1024 && - ((struct sockaddr_in *)address)->sin_port > 0) { - GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */ - mpeprivmode = 1; - } - } - result = bind(socket, address, address_len); - if (mpeprivmode) - { - GETUSERMODE(); **** PATCH TRUNCATED AT 2000 LINES -- 1040 NOT SHOWN **** -- Perl5 Master Repository
