diff options
| author | Nicholas Clark <nick@ccl4.org> | 2012-01-13 17:33:24 +0100 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2012-01-13 17:35:32 +0100 |
| commit | 8deb7dbdfbd6e133d6cde85839a8acacd2185e32 (patch) | |
| tree | c098c14b0bf9e5f51624a5274827e7bfe86e1ed8 | |
| parent | 9e6704a9c88bca9a5eec456e14f7afa3a21f2181 (diff) | |
| parent | cc5038fb0fb4077cf2d3724595ce66f81c7eb10a (diff) | |
| download | perl-nicholas/re-instate.tar.gz | |
Revert "EPOC is special biologist word. [Do not merge to blead]"nicholas/re-instate
This reverts commit 9a35cdd44afd0278caefb55a0bb28e5b14175002.
35 files changed, 1 insertions, 4563 deletions
@@ -3,9 +3,6 @@ AUTHORS Contact info for contributors autodoc.pl Creates pod/perlintern.pod and pod/perlapi.pod av.c Array value code av.h Array value header -beos/beos.c BeOS port -beos/beosish.h BeOS port -beos/nm.c BeOS port cflags.SH A script that emits C compilation flags per file Changes Describe how to peruse changes between releases config_h.SH Produces config.h @@ -3567,12 +3564,6 @@ dist/Tie-File/t/42_offset.t Unit tests for the offset method dist/XSLoader/Makefile.PL Dynamic Loader makefile writer dist/XSLoader/t/XSLoader.t See if XSLoader works dist/XSLoader/XSLoader_pm.PL Simple XS Loader perl module -djgpp/config.over DOS/DJGPP port -djgpp/configure.bat DOS/DJGPP port -djgpp/djgpp.c DOS/DJGPP port -djgpp/djgpp.h DOS/DJGPP port -djgpp/djgppsed.sh DOS/DJGPP port -djgpp/fixpmain DOS/DJGPP port doio.c I/O operations doop.c Support code for various operations dosish.h Some defines for MS/DOSish machines @@ -3645,18 +3636,15 @@ ext/Devel-Peek/Peek.pm Data debugging tool, module and pod ext/Devel-Peek/Peek.xs Data debugging tool, externals ext/Devel-Peek/t/Peek.t See if Devel::Peek works ext/DynaLoader/dl_aix.xs AIX implementation -ext/DynaLoader/dl_beos.xs BeOS implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation 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 ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files -ext/DynaLoader/dl_vmesa.xs VM/ESA implementation ext/DynaLoader/dl_vms.xs VMS implementation ext/DynaLoader/dl_win32.xs Win32 implementation ext/DynaLoader/DynaLoader_pm.PL Dynamic Loader perl module @@ -3827,7 +3815,6 @@ ext/POSIX/hints/next_3.pl Hint for POSIX for named architecture ext/POSIX/hints/openbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/sunos_4.pl Hint for POSIX for named architecture ext/POSIX/hints/svr4.pl Hint for POSIX for named architecture -ext/POSIX/hints/uts.pl Hint for POSIX for named architecture ext/POSIX/lib/POSIX.pm POSIX extension Perl module ext/POSIX/lib/POSIX.pod POSIX extension documentation ext/POSIX/Makefile.PL POSIX extension makefile writer @@ -3847,7 +3834,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 @@ -4047,7 +4033,6 @@ hints/altos486.sh Hints for named architecture hints/amigaos.sh Hints for named architecture hints/atheos.sh Hints for named architecture hints/aux_3.sh Hints for named architecture -hints/beos.sh Hints for named architecture hints/broken-db.msg Warning message for systems with broken DB library hints/bsdos.sh Hints for named architecture hints/catamount.sh Hints for named architecture @@ -4058,7 +4043,6 @@ hints/darwin.sh Hints for named architecture hints/dcosx.sh Hints for named architecture hints/dec_osf.sh Hints for named architecture hints/dgux.sh Hints for named architecture -hints/dos_djgpp.sh Hints for named architecture hints/dragonfly.sh Hints for named architecture hints/dynixptx.sh Hints for named architecture hints/dynix.sh Hints for named architecture @@ -4088,7 +4072,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 @@ -4129,9 +4112,7 @@ hints/unicosmk.sh Hints for named architecture hints/unicos.sh Hints for named architecture hints/unisysdynix.sh Hints for named architecture hints/utekv.sh Hints for named architecture -hints/uts.sh Hints for named architecture hints/uwin.sh Hints for named architecture -hints/vmesa.sh Hints for named architecture hints/vos.sh Hints for named architecture hv.c Hash value code hv.h Hash value header @@ -4419,11 +4400,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 @@ -5505,11 +5481,6 @@ utils/shasum.PL filter for computing SHA digests (analogous to md5sum) utils/splain.PL Stand-alone version of diagnostics.pm utils/xsubpp.PL External subroutine preprocessor utils/zipdetails.PL display the internal structure of zip files -uts/sprintf_wrap.c sprintf wrapper for UTS -uts/strtol_wrap.c strtol wrapper for UTS -vmesa/Makefile VM/ESA Makefile -vmesa/vmesa.c VM/ESA-specific C code for Perl core -vmesa/vmesaish.h VM/ESA-specific C header for Perl core vms/descrip_mms.template Template MM[SK] description file for build vms/ext/Filespec.pm VMS-Unix file syntax interconversion vms/ext/filespec.t See if VMS::Filespec functions work diff --git a/Porting/curliff.pl b/Porting/curliff.pl index d7c7591d95..60d2a72540 100755 --- a/Porting/curliff.pl +++ b/Porting/curliff.pl @@ -12,7 +12,6 @@ use vars qw($r); # This list is also in makerel. my @FILES = qw( - djgpp/configure.bat README.ce README.dos README.symbian diff --git a/Porting/exec-bit.txt b/Porting/exec-bit.txt index 379be4760c..5dda7ebb04 100644 --- a/Porting/exec-bit.txt +++ b/Porting/exec-bit.txt @@ -54,7 +54,5 @@ Porting/newtests-perldelta.pl Porting/perlhist_calculate.pl Porting/sort_perldiag.pl Porting/valgrindpp.pl -mpeix/nm -mpeix/relink Cross/generate_config_sh Cross/warp diff --git a/beos/beos.c b/beos/beos.c deleted file mode 100644 index 5769abcdf7..0000000000 --- a/beos/beos.c +++ /dev/null @@ -1,67 +0,0 @@ -#include "beos/beosish.h" - -#undef waitpid -#undef kill -#undef sigaction - -#include <errno.h> -#include <signal.h> -#include <stdio.h> -#include <stdlib.h> -#include <unistd.h> -#include <sys/wait.h> - -#include <OS.h> - -/* In BeOS 5.0 the waitpid() seems to misbehave in that the status - * has the upper and lower bytes swapped compared with the usual - * POSIX/UNIX implementations. To undo the surprise effect to the - * rest of Perl we need this wrapper. (The rest of BeOS might be - * surprised because of this, though.) */ - -pid_t beos_waitpid(pid_t process_id, int *status_location, int options) { - pid_t got = waitpid(process_id, status_location, options); - if (status_location) - *status_location = - (*status_location & 0x00FF) << 8 | - (*status_location & 0xFF00) >> 8; - return got; -} - - -/* BeOS kill() doesn't like the combination of the pseudo-signal 0 and - * specifying a process group (i.e. pid < -1 || pid == 0). We work around - * by changing pid to the respective process group leader. That should work - * well enough in most cases. */ - -int beos_kill(pid_t pid, int sig) -{ - if (sig == 0) { - if (pid == 0) { - /* it's our process group */ - pid = getpgrp(); - } else if (pid < -1) { - /* just address the process group leader */ - pid = -pid; - } - } - - return kill(pid, sig); -} - -/* sigaction() should fail, if trying to ignore or install a signal handler - * for a signal that cannot be caught or ignored. The BeOS R5 sigaction() - * doesn't return an error, though. */ -int beos_sigaction(int sig, const struct sigaction *act, - struct sigaction *oact) -{ - int result = sigaction(sig, act, oact); - - if (result == 0 && act && act->sa_handler != SIG_DFL - && act->sa_handler != SIG_ERR && (sig == SIGKILL || sig == SIGSTOP)) { - result = -1; - errno = EINVAL; - } - - return result; -} diff --git a/beos/beosish.h b/beos/beosish.h deleted file mode 100644 index 7aab15f402..0000000000 --- a/beos/beosish.h +++ /dev/null @@ -1,38 +0,0 @@ -#ifndef PERL_BEOS_BEOSISH_H -#define PERL_BEOS_BEOSISH_H - -#include "../unixish.h" - -#undef waitpid -#define waitpid beos_waitpid - -pid_t beos_waitpid(pid_t process_id, int *status_location, int options); - -/* This seems to be protoless. */ -char *gcvt(double value, int num_digits, char *buffer); - -/* flock support, if available */ -#ifdef HAS_FLOCK - -#include <flock.h> - -#undef close -#define close flock_close - -#undef dup2 -#define dup2 flock_dup2 - -#endif /* HAS_FLOCK */ - - -#undef kill -#define kill beos_kill -int beos_kill(pid_t pid, int sig); - -#undef sigaction -#define sigaction(sig, act, oact) beos_sigaction((sig), (act), (oact)) -int beos_sigaction(int sig, const struct sigaction *act, - struct sigaction *oact); - -#endif - diff --git a/beos/nm.c b/beos/nm.c deleted file mode 100644 index 4f53f743b2..0000000000 --- a/beos/nm.c +++ /dev/null @@ -1,53 +0,0 @@ -/* nm.c - a feeble shared-lib library parser - * Copyright 1997, 1998 Tom Spindler - * This software is covered under perl's Artistic license. - */ - -/* $Id: nm.c,v 1.1 1998/02/16 03:51:26 dogcow Exp $ */ - -#include <be/kernel/image.h> -#include <malloc.h> -#include <string.h> -#include <unistd.h> -#include <stdio.h> -#include <stdlib.h> - -main(int argc, char **argv) { -char *path, *symname; -image_id img; -int32 n = 0; -volatile int32 symnamelen, symtype; -void *symloc; - -if (argc != 2) { printf("more args, bozo\n"); exit(1); } - -path = (void *) malloc((size_t) 2048); -symname = (void *) malloc((size_t) 2048); - -if (!getcwd(path, 2048)) { printf("aiee!\n"); exit(1); } -if (!strcat(path, "/")) {printf("naah.\n"); exit (1); } -/*printf("%s\n",path);*/ - -if ('/' != argv[1][0]) { - if (!strcat(path, argv[1])) { printf("feh1\n"); exit(1); } -} else { - if (!strcpy(path, argv[1])) { printf("gah!\n"); exit(1); } -} -/*printf("%s\n",path);*/ - -img = load_add_on(path); -if (B_ERROR == img) {printf("Couldn't load_add_on() %s.\n", path); exit(2); } - -symnamelen=2047; - -while (B_BAD_INDEX != get_nth_image_symbol(img, n++, symname, &symnamelen, - &symtype, &symloc)) { - printf("%s |%s |GLOB %Lx | \n", symname, - ((B_SYMBOL_TYPE_ANY == symtype) || (B_SYMBOL_TYPE_TEXT == symtype)) ? "FUNC" : "VAR ", symloc); - symnamelen=2047; -} -printf("number of symbols: %d\n", n); -if (B_ERROR == unload_add_on(img)) {printf("err while closing.\n"); exit(3); } -free(path); -return(0); -} diff --git a/djgpp/config.over b/djgpp/config.over deleted file mode 100644 index bd757c7c1f..0000000000 --- a/djgpp/config.over +++ /dev/null @@ -1,64 +0,0 @@ -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=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=unicode/collate=Unicode/Collate=' \ - -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' diff --git a/djgpp/configure.bat b/djgpp/configure.bat deleted file mode 100644 index db08fc256d..0000000000 --- a/djgpp/configure.bat +++ /dev/null @@ -1,37 +0,0 @@ -@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
diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c deleted file mode 100644 index 9370a2901c..0000000000 --- a/djgpp/djgpp.c +++ /dev/null @@ -1,475 +0,0 @@ -#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 = NULL; - - 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=NULL; - 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_ const 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; -} - diff --git a/djgpp/djgpp.h b/djgpp/djgpp.h deleted file mode 100644 index bb792e204e..0000000000 --- a/djgpp/djgpp.h +++ /dev/null @@ -1,55 +0,0 @@ -#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_ const 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 diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh deleted file mode 100644 index f84452e636..0000000000 --- a/djgpp/djgppsed.sh +++ /dev/null @@ -1,49 +0,0 @@ -#! /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 diff --git a/djgpp/fixpmain b/djgpp/fixpmain deleted file mode 100644 index 3f965f1c5b..0000000000 --- a/djgpp/fixpmain +++ /dev/null @@ -1,33 +0,0 @@ -#!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; @@ -13,26 +13,7 @@ #define SH_PATH "/bin/sh" #endif -#ifdef DJGPP -# define BIT_BUCKET "nul" -# define OP_BINARY O_BINARY -# define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v); PERLIO_INIT -# define init_os_extras Perl_init_os_extras -# define HAS_UTIME -# define HAS_KILL - char *djgpp_pathexp (const char*); - void Perl_DJGPP_init (int *argcp,char ***argvp); -# if (DJGPP==2 && DJGPP_MINOR < 2) -# define NO_LOCALECONV_MON_THOUSANDS_SEP -# endif -# ifndef PERL_CORE -# define PERL_FS_VER_FMT "%d_%d_%d" -# endif -# define PERL_FS_VERSION STRINGIFY(PERL_REVISION) "_" \ - STRINGIFY(PERL_VERSION) "_" \ - STRINGIFY(PERL_SUBVERSION) -#else /* DJGPP */ +/* !DJGPP */ # ifdef WIN32 # define PERL_SYS_INIT_BODY(c,v) \ MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v); PERLIO_INIT @@ -49,7 +30,6 @@ # define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */ # endif /* NETWARE */ # endif -#endif /* DJGPP */ #ifndef PERL_SYS_TERM_BODY # define PERL_SYS_TERM_BODY() HINTS_REFCNT_TERM; OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM @@ -133,11 +113,7 @@ #define fwrite1 fwrite #define Fstat(fd,bufptr) fstat((fd),(bufptr)) -#ifdef DJGPP -# define Fflush(fp) djgpp_fflush(fp) -#else # define Fflush(fp) fflush(fp) -#endif #define Mkdir(path,mode) mkdir((path),(mode)) #ifndef WIN32 @@ -150,51 +126,6 @@ # define HAS_CHOWN #endif /* WIN32 */ -/* - * <rich@phekda.freeserve.co.uk>: The DJGPP port has code that converts - * the return code of system() into the form that Unixy wait usually - * returns: - * - * - signal number in bits 0-6; - * - core dump flag in bit 7; - * - exit code in bits 8-15. - * - * Bits 0-7 are always zero for DJGPP, because it uses system(). - * See djgpp.c. - * - * POSIX::W* use the W* macros from <sys/wait.h> to decode - * the return code. Unfortunately the W* macros for DJGPP use - * a different format than Unixy wait does. So there's a mismatch - * and, say, WEXITSTATUS($?) will return bogus values. - * - * So here we add hack to redefine the W* macros from DJGPP's <sys/wait.h> - * to work with our return-code conversion. - */ - -#ifdef DJGPP - -#include <sys/wait.h> - -#undef WEXITSTATUS -#undef WIFEXITED -#undef WIFSIGNALED -#undef WIFSTOPPED -#undef WNOHANG -#undef WSTOPSIG -#undef WTERMSIG -#undef WUNTRACED - -#define WEXITSTATUS(stat_val) ((stat_val) >> 8) -#define WIFEXITED(stat_val) 0 -#define WIFSIGNALED(stat_val) 0 -#define WIFSTOPPED(stat_val) 0 -#define WNOHANG 0 -#define WSTOPSIG(stat_val) 0 -#define WTERMSIG(stat_val) 0 -#define WUNTRACED 0 - -#endif - /* Don't go reading from /dev/urandom */ #define PERL_NO_DEV_RANDOM diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs deleted file mode 100644 index 964a34a409..0000000000 --- a/ext/DynaLoader/dl_beos.xs +++ /dev/null @@ -1,133 +0,0 @@ -/* - * dl_beos.xs, by Tom Spindler - * based on dl_dlopen.xs, by Paul Marquess - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <be/kernel/image.h> -#include <OS.h> -#include <stdlib.h> -#include <limits.h> - -#define dlerror() strerror(errno) - -#include "dlutils.c" /* SaveError() etc */ - -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 - CODE: -{ image_id bogo; - char *path; - path = malloc(PATH_MAX); - if (*filename != '/') { - getcwd(path, PATH_MAX); - strcat(path, "/"); - strcat(path, filename); - } else { - strcpy(path, filename); - } - - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags)); - bogo = load_add_on(path); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (bogo < 0) { - SaveError(aTHX_ "%s", strerror(bogo)); - PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); - } else { - RETVAL = (void *) bogo; - sv_setiv( ST(0), PTR2IV(RETVAL) ); - } - free(path); -} - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - status_t retcode; - void *adr = 0; -#ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = Perl_form_nocontext("_%s", symbolname); -#endif - RETVAL = NULL; - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - retcode = get_image_symbol((image_id) libhandle, symbolname, - B_SYMBOL_TYPE_TEXT, (void **) &adr); - RETVAL = adr; - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) { - SaveError(aTHX_ "%s", strerror(retcode)) ; - PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode)); - } else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# 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=%lx)\n", - perl_name, (unsigned long) 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/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs deleted file mode 100644 index 0c810adf7b..0000000000 --- a/ext/DynaLoader/dl_mpeix.xs +++ /dev/null @@ -1,146 +0,0 @@ -/* - * Author: Mark Klein (mklein@dis.com) - * Version: 2.1, 1996/07/25 - * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu) - * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu) - * Version: 2.4, 2002/03/24 Mark Bixby (mark@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() - PPCODE: - -# 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/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs deleted file mode 100644 index bf84322849..0000000000 --- a/ext/DynaLoader/dl_vmesa.xs +++ /dev/null @@ -1,192 +0,0 @@ -/* dl_vmesa.xs - * - * Platform: VM/ESA, possibly others which use dllload etc. - * Author: Neale Ferguson (neale@mailbox.tabnsw.com.au) - * Created: 23rd September, 1998 - * - * - */ - -/* Porting notes: - - - Definition of VM/ESA dynamic Linking functions - ============================================== - In order to make this implementation easier to understand here is a - quick definition of the VM/ESA Dynamic Linking functions which are - used here. - - dlopen - ------ - void * - dlopen(const char *path) - - This function takes the name of a dynamic object file and returns - a descriptor which can be used by dlsym later. It returns NULL on - error. - - - dllsym - ------ - void * - dlsym(void *handle, char *symbol) - - Takes the handle returned from dlopen and the name of a symbol to - get the address of. If the symbol was found a pointer is - returned. It returns NULL on error. - - dlerror - ------- - char * dlerror() - - Returns a null-terminated string which describes the last error - that occurred with the other dll functions. After each call to - dlerror the error message will be reset to a null pointer. The - SaveError function is used to save the error as soo as it happens. - - - Return Types - ============ - In this implementation the two functions, dl_load_file & - dl_find_symbol, return void *. This is because the underlying SunOS - dynamic linker calls also return void *. This is not necessarily - the case for all architectures. For example, some implementation - will want to return a char * for dl_load_file. - - If void * is not appropriate for your architecture, you will have to - change the void * to whatever you require. If you are not certain of - how Perl handles C data types, I suggest you start by consulting - Dean Roerich's Perl 5 API document. Also, have a look in the typemap - file (in the ext directory) for a fairly comprehensive list of types - that are already supported. If you are completely stuck, I suggest you - post a message to perl5-porters, comp.lang.perl.misc or if you are really - desperate to me. - - Remember when you are making any changes that the return value from - dl_load_file is used as a parameter in the dl_find_symbol - function. Also the return value from find_symbol is used as a parameter - to install_xsub. - - - Dealing with Error Messages - ============================ - In order to make the handling of dynamic linking errors as generic as - possible you should store any error messages associated with your - implementation with the StoreError function. - - In the case of VM/ESA the function dlerror returns the error message - associated with the last dynamic link error. As the VM/ESA dynamic - linker functions return NULL on error every call to a VM/ESA dynamic - dynamic link routine is coded like this - - RETVAL = dlopen(filename) ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - - Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain and % characters. - -*/ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include <dll.h> - - -#include "dlutils.c" /* SaveError() etc */ - - -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 - CODE: - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - RETVAL = dlopen(filename) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void -dl_undef_symbols() - PPCODE: - - - -# 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=%lx)\n", - perl_name, (unsigned long) 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/POSIX/hints/uts.pl b/ext/POSIX/hints/uts.pl deleted file mode 100644 index 7a18b4a91e..0000000000 --- a/ext/POSIX/hints/uts.pl +++ /dev/null @@ -1,9 +0,0 @@ -# UTS - Leaving -lm in there results in death of make with the message: -# LD_RUN_PATH="/usr/ccs/lib" ld -G -z text POSIX.o \ -# -o ../../lib/auto/POS IX/POSIX.so -lm -# relocations referenced -# from file(s) -# /usr/ccs/lib/libm.a(acos.o) -# ... - -$self->{LIBS} = ['']; diff --git a/ext/re/hints/mpeix.pl b/ext/re/hints/mpeix.pl deleted file mode 100644 index d1fbb91f8f..0000000000 --- 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 <markb@cccd.edu> -$self->{OPTIMIZE} = '-O'; diff --git a/hints/beos.sh b/hints/beos.sh deleted file mode 100644 index 1224ec1cc4..0000000000 --- a/hints/beos.sh +++ /dev/null @@ -1,82 +0,0 @@ -# BeOS hints file - -if [ ! -f beos/nm ]; then mwcc -w all -o beos/nm beos/nm.c 2>/dev/null; fi -# If this fails, that's all right - it's only for PPC. - -prefix="/boot/home/config" - -#cpp="mwcc -e" - -libpth='/boot/beos/system/lib /boot/home/config/lib' -usrinc='/boot/develop/headers/posix' -locinc='/boot/develop/headers/ /boot/home/config/include' - -libc='/boot/beos/system/lib/libroot.so' -libs=' ' - -d_bcmp='define' -d_bcopy='define' -d_bzero='define' -d_index='define' -#d_htonl='define' # It exists, but much hackery would be required to support. -# a bunch of extra includes would have to be added, and it's only used at -# one place in the non-socket perl code. - -#these are all in libdll.a, which my version of nm doesn't know how to parse. -#if I can get it to both do that, and scan multiple library files, perhaps -#these can be gotten rid of. - -usemymalloc='n' -# Hopefully, Be's malloc knows better than perl's. - -d_link='undef' -dont_use_nlink='define' -# no posix (aka hard) links for us! - -d_syserrlst='undef' -# the array syserrlst[] is useless for the most part. -# large negative numbers really kind of suck in arrays. - -# Sockets didn't use to be real sockets but BONE changes this. -if [ ! -f /boot/develop/headers/be/bone/sys/socket.h ]; then - d_socket='undef' - d_gethbyaddr='undef' - d_gethbyname='undef' - d_getsbyname='undef' - - libs='-lnet' -fi - -# There's a third party flock() emulation. Check, if it is available. -echo "#include <flock.h>" > try.c -if cc -E $CFLAGS try.c 2> /dev/null | grep "flock.*("; then - d_flock='define' - d_flockproto='define' - libs="$libs -lflock" - ldflags="$ldflags -L/boot/home/config/lib" -else - cat << 'EOM' >&4 - -I couldn't find a <flock.h> header defining a flock() prototype. That header -comes with the flock server package (available on BeBits). You have to add -the path to the directory containing the header via the environment variable -CFLAGS (should contain -I</path/to/dir/of/flock/header>). Perl will be compiled -without flock() support, if the flock server package is not installed or the -header not found. - -EOM - -fi -rm try.c - -ld='gcc' - -export PATH="$PATH:$PWD/beos" - -case "$ldlibpthname" in -'') ldlibpthname=LIBRARY_PATH ;; -esac - -# the waitpid() wrapper (among other things) -archobjs="beos.o" -test -f beos.c || cp beos/beos.c . diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh deleted file mode 100644 index 2b032cdece..0000000000 --- a/hints/dos_djgpp.sh +++ /dev/null @@ -1,81 +0,0 @@ -# hints file for dos/djgpp v2.xx -# Original by Laszlo Molnar <molnarl@cdata.tvnet.hu> - -# 971015 - archname changed from 'djgpp' to 'dos-djgpp' -# 971210 - threads support -# 000222 - added -DPERL_EXTERNAL_GLOB to ccflags - -archname='dos-djgpp' -archobjs='djgpp.o' -path_sep=\; -startsh="#! /bin/sh" - -cc='gcc' -ld='gcc' -usrinc="$DJDIR/include" - -libpth="$DJDIR/lib" -libc="$libpth/libc.a" - -so='none' -usedl='n' - -firstmakefile='GNUmakefile' -exe_ext='.exe' - -randbits=31 -lns='cp' - -usenm='true' - -# this reportedly causes compile errors in system includes -i_ieeefp='undef' - -d_link='undef' # these are empty functions in libc.a -d_symlink='undef' -d_fork='undef' -d_pipe='undef' - -startperl='#!perl' - -case "X$optimize" in - X) - case `gcc -v 2>&1|grep "gcc version"` in - "gcc version 3."*) - optimize="-O2 -falign-loops=2 -falign-jumps=2 -falign-functions=2" ;; - *) - optimize="-O2 -malign-loops=2 -malign-jumps=2 -malign-functions=2" ;; - esac - ldflags='-s' - ;; - X*) - ldflags=' ' - ;; -esac -ccflags="$ccflags -DPERL_EXTERNAL_GLOB" -usemymalloc='n' -timetype='time_t' - -prefix=$DJDIR -privlib=$prefix/lib/perl5 -archlib=$privlib -sitelib=$privlib/site -sitearch=$sitelib - -eagain='EAGAIN' -rd_nodata='-1' - -# This script UU/usethreads.cbu will get 'called-back' by Configure -# after it has prompted the user for whether to use threads. -cat > UU/usethreads.cbu <<'EOCBU' -case "$usethreads" in -$define|true|[yY]*) - set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'` - shift - libswanted="$*" - ;; -esac -EOCBU - -useperlio='undef' -uselargefiles='undef' diff --git a/hints/mpeix.sh b/hints/mpeix.sh deleted file mode 100644 index afa6cf8de1..0000000000 --- a/hints/mpeix.sh +++ /dev/null @@ -1,136 +0,0 @@ -# Created for 5.003 by Mark Klein, mklein@dis.com. -# Substantially revised for 5.004_01 by Mark Bixby, markb@cccd.edu. -# Revised again for 5.004_69 by Mark Bixby, markb@cccd.edu. -# Revised for 5.6.0 by Mark Bixby, mbixby@power.net. -# Revised for 5.7.3 by Mark Bixby, mark@bixby.org. -# Revised for 5.8.0 by Mark Bixby, mark@bixby.org. -# Revised for 5.8.8/5.9.3 by Ken Hirsch, kenhirsch@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/hints/uts.sh b/hints/uts.sh deleted file mode 100644 index 2ac5221ca6..0000000000 --- a/hints/uts.sh +++ /dev/null @@ -1,32 +0,0 @@ -archname='s390' -archobjs='uts/strtol_wrap.o uts/sprintf_wrap.o' -cc='cc -Xa' -ccflags='-XTSTRINGS=1500000 -DStrtol=strtol_wrap32 -DStrtoul=strtoul_wrap32 -DSPRINTF_E_BUG' -cccdlflags='-pic' -d_bincompat3='undef' -d_csh='undef' -d_lstat='define' -d_suidsafe='define' -dlsrc='dl_dlopen.xs' -i_ieeefp='undef' -ld='ld' -lddlflags='-G -z text' -libperl='libperl.so' -libpth='/lib /usr/lib /usr/ccs/lib' -libs='-lsocket -lnsl -ldl -lm' -libswanted='m' -prefix='/usr/local' -toke_cflags='optimize=""' -useshrplib='true' - -################################# -# Some less routine stuff: -################################# -cc -g -Xa -c -pic -O uts/strtol_wrap.c -o uts/strtol_wrap.o -cc -g -Xa -c -pic -O uts/sprintf_wrap.c -o uts/sprintf_wrap.o -# Make POSIX a static extension. -cat <<'EOSH' > config.over -static_ext='POSIX B' -dynamic_ext=`echo " $dynamic_ext " | - sed -e 's/ POSIX / /' -e 's/ B / /'` -EOSH diff --git a/hints/vmesa.sh b/hints/vmesa.sh deleted file mode 100644 index 430ded9c48..0000000000 --- a/hints/vmesa.sh +++ /dev/null @@ -1,342 +0,0 @@ -# hints/vmesa.sh -# -# VM/ESA hints by Neale Ferguson (neale@mailbox.tabnsw.com.au) -# -# Currently (1999-Jan-09) Configure cannot be used in VM/ESA because -# too many things are done differently in the C compiler environment. -# Therefore the hints file is hand-crafted. --jhi@iki.fi -# - -case "$archname" in -'') archname="$osname" ;; -esac -bin='/usr/local/bin' -binexp='/usr/local/bin' -byacc='byacc' -c='\c' -cc='c89' -ccflags="-D_OE_SOCKETS -DOLD_PTHREADS_API -DYYDYNAMIC -DDEBUGGING -I.." \ - "-I/usr/local/include -W c,hwopts\\\(string\\\),langlvl\\\(ansi\\\)" -clocktype='clock_t' -cryptlib="n" -d_Gconvert='gcvt((x),(n),(b))' -d_access='define' -d_alarm='define' -d_archlib='define' -# randbits='15' -archobjs="vmesa.o" -d_attribute_format='undef' -d_attribute_malloc='undef' -d_attribute_nonnull='undef' -d_attribute_noreturn='undef' -d_attribute_pure='undef' -d_attribute_unused='undef' -d_attribute_warn_unused_result='undef' -d_bcmp='define' -d_bcopy='define' -d_bsd='undef' -d_bsdgetpgrp='undef' -d_bsdsetpgrp='undef' -d_bzero='define' -d_casti32='define' -d_castneg='define' -d_charvspr='undef' -d_chown='define' -d_chroot='undef' -d_chsize='undef' -d_closedir='define' -d_const='define' -d_crypt='undef' -d_csh='undef' -d_cuserid='define' -d_dbl_dig='define' -d_difftime='define' -d_dirnamlen='undef' -d_dlerror='define' -d_dlopen='define' -d_dlsymun='define' -d_dosuid='undef' -d_dup2='define' -d_endgrent='undef' -d_endpwent='undef' -d_eofnblk='define' -d_eunice='undef' -d_fchmod='define' -d_fchown='define' -d_fcntl='define' -d_fd_macros='define' -d_fd_set='define' -d_fds_bits='define' -d_fgetpos='define' -d_flexfnam='define' -d_flock='undef' -d_fork='undef' -d_fpathconf='define' -d_fsetpos='define' -d_ftime='undef' -d_getgrent='undef' -d_gethent='define' -d_gethname='undef' -d_getlogin='define' -d_getpgid='undef' -d_getpgrp='define' -d_getpgrp2='undef' -d_getppid='define' -d_getprior='undef' -d_getpwent='undef' -d_gettimeod='define' -d_gnulibc='undef' -d_htonl='define' -d_index='define' -d_inetaton='undef' -d_isascii='define' -d_killpg='define' -d_link='define' -d_locconv='define' -d_lockf='define' -d_longdbl='undef' -d_longllong='undef' -d_lstat='define' -d_mblen='define' -d_mbstowcs='define' -d_mbtowc='define' -d_memcmp='define' -d_memcpy='define' -d_memmove='define' -d_memset='define' -d_mkdir='define' -d_mkfifo='define' -d_mktime='define' -d_msg='define' -d_msgctl='define' -d_msgget='define' -d_msgrcv='define' -d_msgsnd='define' -d_mymalloc='undef' -d_nice='undef' -d_oldsock='undef' -d_open3='define' -d_pathconf='define' -d_pause='define' -d_phostname='undef' -d_pipe='define' -d_poll='undef' -d_portable='define' -d_pwage='undef' -d_pwchange='undef' -d_pwclass='undef' -d_pwcomment='undef' -d_pwexpire='undef' -d_pwquota='undef' -d_readdir='define' -d_readlink='define' -d_rename='define' -d_rewinddir='define' -d_rmdir='define' -d_safebcpy='define' -d_safemcpy='undef' -d_sanemcmp='define' -d_sched_yield='undef' -d_seekdir='undef' -d_select='define' -d_sem='define' -d_semctl='define' -d_semctl_semid_ds='define' -d_semget='define' -d_semop='define' -d_setegid='define' -d_seteuid='define' -d_setgrent='undef' -d_setgrps='undef' -d_setlinebuf='undef' -d_setlocale='define' -d_setpgid='define' -d_setpgrp='define' -d_setpgrp2='undef' -d_setprior='undef' -d_setpwent='undef' -d_setregid='undef' -d_setresgid='undef' -d_setresuid='undef' -d_setreuid='undef' -d_setrgid='undef' -d_setruid='undef' -d_setsid='define' -d_sfio='undef' -d_shm='define' -d_shmat='define' -d_shmatprototype='define' -d_shmctl='define' -d_shmdt='define' -d_shmget='define' -d_sigaction='define' -d_sigsetjmp='define' -d_socket='define' -d_sockpair='undef' -d_statblks='undef' -d_stdio_cnt_lval='undef' -d_stdio_ptr_lval='undef' -d_stdiobase='undef' -d_stdstdio='undef' -d_strchr='define' -d_strcoll='define' -d_strctcpy='undef' -d_strerrm='strerror(e)' -d_strerror='define' -d_strtod='define' -d_strtol='define' -d_strtoul='define' -d_strxfrm='define' -d_suidsafe='undef' -d_symlink='define' -d_syscall='undef' -d_sysconf='define' -d_sysernlst="n" -d_syserrlst='undef' -d_system='define' -d_tcgetpgrp='define' -d_tcsetpgrp='define' -d_telldir='undef' -d_time='define' -d_times='define' -d_truncate='define' -d_tzname='define' -d_umask='define' -d_uname='define' -d_union_semun='undef' -d_vfork='define' -d_void_closedir='undef' -d_voidsig='define' -d_voidtty="n" -d_volatile='define' -d_vprintf='define' -d_waitpid='define' -d_wait4='undef' -d_wcstombs='define' -d_wctomb='define' -d_xenix='undef' -db_hashtype='u_int32_t' -db_prefixtype='size_t' -direntrytype='struct dirent' -dlext='none' -dlsrc='dl_vmesa.xs' -dynamic_ext='' -eagain='EAGAIN' -ebcdic='define' -exe_ext='' -fpostype='fpos_t' -freetype='void' -groupstype='gid_t' -h_fcntl='false' -h_sysfile='true' -hint='recommended' -i_arpainet="define" -i_bsdioctl="n" -i_db='undef' -i_dbm='define' -i_dirent='define' -i_dld='define' -i_dlfcn='define' -i_fcntl='undef' -i_float='define' -i_gdbm='define' -i_grp='define' -i_limits='define' -i_locale='define' -i_malloc='undef' -i_math='define' -i_memory='define' -i_ndbm='define' -i_neterrno='undef' -i_niin='define' -i_pwd='define' -i_rpcsvcdbm='undef' -i_sfio='undef' -i_sgtty='undef' -i_stdarg='define' -i_stddef='define' -i_stdlib='define' -i_string='define' -i_sysdir='define' -i_sysfile='define' -i_sysfilio='undef' -i_sysin='undef' -i_sysioctl='define' -i_sysndir='undef' -i_sysparam='undef' -i_sysresrc='define' -i_sysselct='undef' -i_syssockio="n" -i_sysstat='define' -i_systime='define' -i_systimek='undef' -i_systimes='define' -i_systypes='define' -i_sysun='define' -i_syswait='define' -i_termio='undef' -i_termios='define' -i_time='undef' -i_unistd='define' -i_utime='define' -i_values='undef' -i_varargs='undef' -i_varhdr='stdarg.h' -i_vfork='undef' -ld='c89' -ldflags='-L/usr/local/lib -L.' -lib_ext='.a' -libc='' -libperl='libperl.a' -libpth='/usr/local/lib /lib /usr/lib' -libs='-l//posxsock -l//vmmtlib -lgdbm -lxpg4' -libswanted='gdbm' -lint="n" -locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include' -loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib' -make_set_make='#' -make='gnumake' -mallocobj='' -mallocsrc='' -malloctype='void *' -netdb_hlen_type='size_t' -netdb_host_type='char *' -netdb_name_type='const char *' -netdb_net_type='in_addr_t' -o_nonblock='O_NONBLOCK' -obj_ext='.o' -optimize='undef' -prefix='/usr/local' -prefixexp='/usr/local' -prototype='define' -ranlib=':' -rd_nodata='-1' -scriptdir='/usr/local/bin' -scriptdirexp='/usr/local/bin' -selecttype='fd_set *' -shmattype='void *' -shrpenv='' -signal_t='void' -sig_name_init='"ZERO","HUP","INT","ABRT","ILL","POLL","URG","STOP","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","NUM18","CONT","CHLD","TTIN","TTOU","IO","QUIT","TSTP","TRAP","NUM27","WINCH","XCPU","XFSZ","VTALRM","PROF","NUM33","NUM34","NUM35","NUM36","NUM3","NUM38","NUM39","NUM40","NUM41","NUM42","NUM43","NUM44","NUM45","NUM46","NUM47","NUM48","NUM49","CLD"' -sig_num_init='0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,20 ' -sizetype='size_t' -so='.a' -ssizetype='ssize_t' -static_ext='Data/Dumper Digest/MD5 Fcntl Filter/Util/Call GDBM_File IO IPC/SysV List/Util MIME/Base64 NDBM_File Opcode PerlIO/scalar POSIX Socket Storable Time/HiRes Time/Piece attributes re' -stdchar='char' -stdio_cnt='(fp)->__countIn' -stdio_ptr='(fp)->__bufPtr' -timeincl='sys/time.h ' -timetype='time_t' -uidtype='uid_t' -usedl='define' -usemymalloc='n' -usenm='false' -useopcode='true' -useperlio='undef' -useposix='true' -usesfio='false' -useshrplib='false' -usethreads='y' -usevfork='true' -vi='x' diff --git a/mpeix/mpeix.c b/mpeix/mpeix.c deleted file mode 100644 index 90f5af0856..0000000000 --- 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; - register 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(); - } - return result; - -} - -int -mpe_getsockname(int socket, struct sockaddr *address, socklen_t *address_len) -{ - int ret; - ret = getsockname(socket, address, address_len); - if (ret == 0 - && address->sa_family == AF_INET - && *address_len >= offsetof(struct sockaddr_in, sin_addr) - +sizeof(struct in_addr) - && ((struct sockaddr_in *)address)->sin_addr.s_addr == INADDR_ANY) { - int i; - for (i=0; i<HOLDBINDLAST; i++) { - if (holdbind[i].fd == socket) - { - ((struct sockaddr_in *)address)->sin_addr.s_addr - = holdbind[i].holdaddr.s_addr; - break; - } - } - } - return ret; -} - -int -mpe_getpeername(int socket, struct sockaddr *address, socklen_t *address_len) -{ - int ret; - ret = getpeername(socket, address, address_len); - if (ret == 0) - { - /* Try a zero-length write to see if socket really connected */ - int written = write(socket, "", 0); - if (written < 0) - ret = -1; - } - return ret; -} - - -static int -max_io_size(int filedes) -{ - int save_errno; - struct sockaddr sa; - int len; - int result = INT_MAX; /* all other files */ - - save_errno = errno; - len = sizeof sa; - if (getsockname(filedes, &sa, &len) == -1) - { - if (errno == EAFNOSUPPORT) /* AF_UNIX socket */ - result = 4096; - errno = save_errno; - } else { - result = 30000; /* AF_INET sock max */ - } - return result; -} diff --git a/mpeix/mpeix_setjmp.c b/mpeix/mpeix_setjmp.c deleted file mode 100644 index 491c71664e..0000000000 --- a/mpeix/mpeix_setjmp.c +++ /dev/null @@ -1,355 +0,0 @@ -/* Workaround for CR JAGab60546 setjmp/longjmp and - JAGad55982 sigsetjmp/siglongjmp from shared libraries. */ - -/* - * tabstop=4 - * - * _setjmp/setjmp/sigsetjmp and - *_longjmp/longjmp/siglongjmp. - * - * Written by Mark Klein, 10 October, 2000 - * Updated for gcc 3.x 6 October, 2005 - * - * These routines are GCC specific and MUST BE COMPILED - * WITH -O2 - * - * The existing setjmp/longjmp code in both libc.a and XL.PUB.SYS - * are not SR4 aware and cause problems when working with shared - * libraries (XLs), especially when executing a longjmp between - * XLs. This code preserves SR4 and will successfully handle - * a cross space longjmp. However, the setjmp code must be - * bound into each XL from which it will be called as well as - * being bound into the main program. - */ - -/* - * The following macro takes the contents of the jmpbuf and - * restores the registers from them. There is other code - * elsewhere that ensures that __jmpbuf is %r26 at this - * point in time. If it becomes some other register, that - * register must be the last restored. At the end will - * be a branch external that will cause a cross space - * return if needed. - */ -#define RESTORE_REGS_AND_RETURN(__jmpbuf, __retval) \ -({ \ - __asm__ __volatile__ ( \ - " ldw 0(%%sr0, %0), %%rp\n" \ - "\t ldw 4(%%sr0, %0), %%sp\n" \ - "\t ldw 16(%%sr0, %0), %%r3\n" \ - "\t ldw 20(%%sr0, %0), %%r4\n" \ - "\t ldw 24(%%sr0, %0), %%r5\n" \ - "\t ldw 28(%%sr0, %0), %%r6\n" \ - "\t ldw 32(%%sr0, %0), %%r7\n" \ - "\t ldw 36(%%sr0, %0), %%r8\n" \ - "\t ldw 40(%%sr0, %0), %%r9\n" \ - "\t ldw 44(%%sr0, %0), %%r10\n" \ - "\t ldw 48(%%sr0, %0), %%r11\n" \ - "\t ldw 52(%%sr0, %0), %%r12\n" \ - "\t ldw 56(%%sr0, %0), %%r13\n" \ - "\t ldw 60(%%sr0, %0), %%r14\n" \ - "\t ldw 64(%%sr0, %0), %%r15\n" \ - "\t ldw 68(%%sr0, %0), %%r16\n" \ - "\t ldw 72(%%sr0, %0), %%r17\n" \ - "\t ldw 76(%%sr0, %0), %%r18\n" \ - "\t ldw 80(%%sr0, %0), %%r19\n" \ - "\t ldw 84(%%sr0, %0), %%r20\n" \ - "\t ldw 88(%%sr0, %0), %%r21\n" \ - "\t ldw 92(%%sr0, %0), %%r22\n" \ - "\t ldw 96(%%sr0, %0), %%r23\n" \ - "\t ldw 100(%%sr0, %0), %%r24\n" \ - "\t ldw 104(%%sr0, %0), %%r25\n" \ - "\t ldw 112(%%sr0, %0), %%r27\n" \ - "\t ldw 116(%%sr0, %0), %%r1\n" \ - "\t mtsp %%r1, %%sr3\n" \ - "\t ldw 120(%%sr0, %0), %%r1\n" \ - "\t mtsp %%r1, %%sr1\n" \ - "\t or,<> %%r0, %1, %%r0\n" \ - "\t ldi 1, %%r28\n" \ - "\t ldw 108(%%sr0, %0), %%r26\n" \ - "\t be 0(%%sr1, %%rp)\n" \ - "\t mtsp %%r1, %%sr4\n" \ - : \ - : "r" (__jmpbuf), \ - "r" (__retval)); \ -}) - -/* - * The following macro extracts the signal mask - * from __jmpbuf from the 3rd and 4th words and - * if non-zero, calls sigprocmask with that value - * to set the signal mask. This macro is usually - * invoked before the registers are restored in - * the longjmp routines and it can clobber things - * without needing to spill them as a result. - * A quick frame is built before making the - * call and cut back just afterwards. - * The ldi 2, %r26 is actually SIG_SETMASK from - * /usr/include/signal.h. - */ -#define RESTORE_SIGNAL_MASK(__jmpbuf) \ -({ \ - __asm__ __volatile__ ( \ - " ldw 8(%0), %%r26\n" \ - "\t comibt,=,n 0,%%r26,.+36\n" \ - "\t ldo 64(%%sp), %%sp\n" \ - "\t stw %0, -28(%%sp)\n" \ - "\t ldi 0, %%r24\n" \ - "\t ldo 8(%0), %%r25\n" \ - "\t .import sigprocmask,code\n" \ - "\t bl sigprocmask,%%rp\n" \ - "\t ldi 2, %%r26\n" \ - "\t ldw -28(%%sr0, %%sp), %0\n" \ - "\t ldo -64(%%sp), %%sp\n" \ - : \ - : "r" (__jmpbuf)); \ -}) - -/* - * This macro saves the current contents of the - * registers to __jmpbuf. Note that __jmpbuf is - * guaranteed elsewhere to be in %r26. We do not - * want it spilled, nor do we want a new frame - * built. - */ -#define SAVE_REGS(__jmpbuf) \ -({ \ - __asm__ __volatile__ ( \ - " stw %%rp, 0(%%sr0, %0)\n" \ - "\t stw %%sp, 4(%%sr0, %0)\n" \ - "\t stw %%r0, 8(%%sr0, %0)\n" \ - "\t stw %%r3, 16(%%sr0, %0)\n" \ - "\t stw %%r4, 20(%%sr0, %0)\n" \ - "\t stw %%r5, 24(%%sr0, %0)\n" \ - "\t stw %%r6, 28(%%sr0, %0)\n" \ - "\t stw %%r7, 32(%%sr0, %0)\n" \ - "\t stw %%r8, 36(%%sr0, %0)\n" \ - "\t stw %%r9, 40(%%sr0, %0)\n" \ - "\t stw %%r10, 44(%%sr0, %0)\n" \ - "\t stw %%r11, 48(%%sr0, %0)\n" \ - "\t stw %%r12, 52(%%sr0, %0)\n" \ - "\t stw %%r13, 56(%%sr0, %0)\n" \ - "\t stw %%r14, 60(%%sr0, %0)\n" \ - "\t stw %%r15, 64(%%sr0, %0)\n" \ - "\t stw %%r16, 68(%%sr0, %0)\n" \ - "\t stw %%r17, 72(%%sr0, %0)\n" \ - "\t stw %%r18, 76(%%sr0, %0)\n" \ - "\t stw %%r19, 80(%%sr0, %0)\n" \ - "\t stw %%r20, 84(%%sr0, %0)\n" \ - "\t stw %%r21, 88(%%sr0, %0)\n" \ - "\t stw %%r22, 92(%%sr0, %0)\n" \ - "\t stw %%r23, 96(%%sr0, %0)\n" \ - "\t stw %%r24, 100(%%sr0, %0)\n" \ - "\t stw %%r25, 104(%%sr0, %0)\n" \ - "\t stw %%r26, 108(%%sr0, %0)\n" \ - "\t stw %%r27, 112(%%sr0, %0)\n" \ - "\t mfsp %%sr3, %%r1\n" \ - "\t stw %%r1, 116(%%sr0, %0)\n" \ - "\t mfsp %%sr4, %%r1\n" \ - "\t stw %%r1, 120(%%sr0, %0)\n" \ - : \ - : "r" (__jmpbuf)); \ -}) - -/* - * This macro will save the signal mask to the - * __jmpbuf if __savemask is non-zero. By this - * point in time, the other resisters have been - * saved into the __jmpbuf. - * The ldi 0, %r26 is actually SIG_BLOCK from - * /usr/include/signal.h. Since the block is - * an OR of the bits, this does not change the - * mask, but returns it into the double word at - * the address in %r24. - */ -#define SAVE_SIGNAL_MASK(__jmpbuf,__savemask) \ -({ \ - __asm__ __volatile__ ( \ - " comibt,=,n 0,%1,.+36\n" \ - "\t stw %%rp, -20(%%sr0, %%sp)\n" \ - "\t ldo 64(%%sp), %%sp\n" \ - "\t ldo 8(%0), %%r24\n" \ - "\t ldi 0, %%r25\n" \ - "\t .import sigprocmask,code\n" \ - "\t bl sigprocmask,%%rp\n" \ - "\t ldi 0, %%r26\n" \ - "\t ldo -64(%%sp), %%sp\n" \ - "\t ldw -20(%%sr0, %%sp), %%rp\n" \ - : \ - : "r" (__jmpbuf), \ - "r" (__savemask)); \ -}) - -/* - * Construct a jump buffer and unconditionally save - * the signal mask. Return a 0 unconditionally. - * Care is taken here and in the macros to assume - * the __jumpbuf is in %r26 and that the return - * value will be in %r28. It is done this way to - * prevent a frame from being built and any registers - * from being spilled. - */ -int setjmp(register void *jmpbuf) -{ - register int __jmpbuf asm ("%r26"); - - SAVE_REGS(__jmpbuf); - SAVE_SIGNAL_MASK(__jmpbuf, 1); - return 0; -} - -/* - * Construct a jump buffer but do not save the - * signal mask. - */ -int _setjmp(register void *jmpbuf) -{ - register int __jmpbuf asm ("%r26"); - - SAVE_REGS(__jmpbuf); - return 0; -} - -/* - * Construct a jump buffer and conditionally save - * the signal mask. The mask is saved if the - * savemask parameter is non-zero. - */ -int sigsetjmp(register void *jmpbuf, register int savemask) -{ - register int __jmpbuf asm ("%r26"); - register int __savemask asm ("%r25"); - - SAVE_REGS(__jmpbuf); - SAVE_SIGNAL_MASK(__jmpbuf, __savemask); - return 0; -} - -/* - * Return to the location established in the jmpbuf, - * and place the value in i2 in %r28. Registers - * %r4 and %r5 are co-opted to save the address and - * value of jmpbuf and the return value. The signal - * mask is re-established if needed, then the - * address of jmpbuf and value of retval are placed - * into %r26 and %r28 correspondingly. This routine - * will never return to its caller and the stack - * will be cut back to whatever exists in the jmpbuf. - */ -void longjmp(register void *jmpbuf, register int i2) -{ - register int __jmpbuf asm ("%r26"); - register int __retval asm ("%r28"); - - __asm__ __volatile__ ( - " copy %0, %%r4\n" - "\t copy %1, %%r5\n" - : - : "r" (jmpbuf), - "r" (i2)); - - RESTORE_SIGNAL_MASK (__jmpbuf); - - __asm__ __volatile__ ( - " copy %%r4, %0\n" - "\t copy %%r5, %1\n" - : "=r" (__jmpbuf), - "=r" (__retval)); - - RESTORE_REGS_AND_RETURN (__jmpbuf, __retval); -} - -/* - * Return to the location established in the jmpbuf, - * but do not restore the signal mask. - */ -void _longjmp(register void *jmpbuf, register int i2) -{ - register int __retval asm ("%r28"); - register int __jmpbuf asm ("%r26"); - - __jmpbuf = (int)jmpbuf; - __retval = i2; - - RESTORE_REGS_AND_RETURN (__jmpbuf, __retval); -} - -/* - * Return to the location established in the jmpbuf, - * and conditionally re-establish the signal mask. - */ -void siglongjmp(register void *jmpbuf, register int i2) -{ - register int __jmpbuf asm ("%r26"); - register int __retval asm ("%r28"); - - __asm__ __volatile__ ( - " copy %0, %%r4\n" - "\t copy %1, %%r5\n" - : - : "r" (jmpbuf), - "r" (i2)); - - RESTORE_SIGNAL_MASK (__jmpbuf); - - __asm__ __volatile__ ( - " copy %%r4, %0\n" - "\t copy %%r5, %1\n" - : "=r" (__jmpbuf), - "=r" (__retval)); - - RESTORE_REGS_AND_RETURN (__jmpbuf, __retval); -} - -#ifdef TEST -int buf1[50]; -int buf2[50]; - -foo() { - printf("In routine foo(). Doing Longjmp.\n"); - longjmp(buf1, 123); - printf("This is in foo after the longjmp() call. Should not reach here.\n"); -} - -bar(int ret) { - printf("In routine bar(%d). Doing siglongjmp.\n",ret); - siglongjmp(buf2, ret); - printf("This is in bar after the siglongjmp() call. Should not reach here.\n"); -} - -main() { - int i; - if ((i = setjmp(buf1))) - { - printf("This is the return from the longjmp. i: %d\n",i); - } - else - { - printf("Jump buffer established, i: %d. Calling foo()\n",i); - foo(); - printf("This is in main after the foo() call. Should not reach here.\n "); - } - - if ((i = sigsetjmp(buf2,0))) - { - printf("This is the return from the longjmp. i: %d\n",i); - } - else - { - printf("Jump buffer established, i: %d. Calling bar(456)\n",i); - bar(456); - printf("This is in main after the bar(456) call. Should not reach here.\n"); - } - - if ((i = sigsetjmp(buf2,1))) - { - printf("This is the return from the longjmp. i: %d\n",i); - } - else - { - printf("Jump buffer established, i: %d. Calling bar(789)\n",i); - bar(789); - printf("This is in main after the bar(789) call. Should not reach here.\n"); - } -} -#endif diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h deleted file mode 100644 index f4ce38ebb3..0000000000 --- a/mpeix/mpeixish.h +++ /dev/null @@ -1,193 +0,0 @@ -/* - * 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. - */ -#define HAS_GROUP /**/ - -/* HAS_PASSWD - * This symbol, if defined, indicates that the getpwnam() and - * getpwuid() routines are available to get password entries. - */ -#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 "#!" / **/ - -#include <signal.h> - -#ifndef SIGABRT -# define SIGABRT SIGILL -#endif -#ifndef SIGILL -# define SIGILL 6 /* blech */ -#endif -#define ABORT() kill(PerlProc_getpid(),SIGABRT); - -/* - * 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)) - -#ifndef PERL_SYS_INIT_BODY -# define PERL_SYS_INIT_BODY(c,v) PERL_FPU_INIT; PERLIO_INIT; MALLOC_INIT -#endif - -#ifndef PERL_SYS_TERM_BODY -#define PERL_SYS_TERM_BODY() PERLIO_TERM; MALLOC_TERM -#endif - -#define BIT_BUCKET "/dev/null" - -#define dXSUB_SYS - -/* pw_passwd, pw_gecos, pw_age, pw_comment exist in the struct passwd - * but they contain uninitialized (as in "accessing them will crash perl") - * pointers. Stay away from them. */ - -#undef PWGECOS -#undef PRPASSWD -#undef PWAGE -#undef PWCOMMENT - -/* various missing external function declarations */ - -#include <sys/ipc.h> -extern key_t ftok (char *pathname, char id); -extern char *gcvt (double value, int ndigit, char *buf); -extern int isnan (double value); -extern void srand48(long int seedval); -extern double drand48(void); -extern double erand48(unsigned short xsubi[3]); -extern long jrand48(unsigned short xsubi[3]); -extern void lcong48(unsigned short param[7]); -extern long lrand48(void); -extern long mrand48(void); -extern long nrand48(unsigned short xsubi[3]); -extern unsigned short *seed48(unsigned short seed16v[3]); - -/* various missing constants -- define 'em */ - -#define PF_UNSPEC 0 - -/* declarations for wrappers in mpeix.c */ - -#include <time.h> -#include <sys/wait.h> -#include <sys/socket.h> -#include <netinet/in.h> - - -extern int ftruncate(int fd, long wantsize); -extern int gettimeofday( struct timeval *tp, struct timezone *tpz ); -extern int truncate(const char *pathname, off_t length); - -extern int mpe_read(int filedes, void *buffer, size_t len); -extern int mpe_write(int filedes, const void *buffer, size_t len); -extern int mpe_send(int socket, const void *buffer, size_t len, int flags); -extern int mpe_sendto(int socket, const void *buffer, size_t len, - int flags, const struct sockaddr *dest_addr, - size_t dest_len); -extern int mpe_recv(int socket, void *buffer, size_t length, int flags); -extern int mpe_recvfrom(int socket, void *buffer, size_t length, - int flags, struct sockaddr *address, - size_t *address_len) ; -extern int mpe_bind(int socket, const struct sockaddr *address, - size_t address_len); -extern int mpe_getsockname(int socket, struct sockaddr *address, - size_t *address_len); -extern int mpe_getpeername(int socket, struct sockaddr *address, - size_t *address_len); - -/* Replacements to fix various socket problems -- see mpeix.c */ -#define fcntl mpe_fcntl -#define read mpe_read -#define write mpe_write -#define send mpe_send -#define sendto mpe_sendto -#define recv mpe_recv -#define recvfrom mpe_recvfrom -#define bind mpe_bind -#define getsockname mpe_getsockname -#define getpeername mpe_getpeername diff --git a/mpeix/nm b/mpeix/nm deleted file mode 100755 index 64e58be4d8..0000000000 --- a/mpeix/nm +++ /dev/null @@ -1,33 +0,0 @@ -#!/bin/sh - -# MPE doesn't have a native nm, and the gcc nm isn't quite fully functional. -# -# If Perl Configure is calling us, then use the native linker to extract the -# symbol table and reformat it into something nm-like. -# -# Else it must be gcc calling us during the final link phase, so call gcc nm. - -if [ "$1" != "-configperl" ]; then - # Oops, the caller must be expecting gcc nm. Give it to them. - /usr/local/bin/nm $@ - exit $? -fi - -case $2 in - *.a) LIST="LISTRL RL=$2;DATA;ENTRYSYM" ;; - *.sl) LIST="LISTXL XL=$2;DATA;ENTRYSYM" ;; - *) exit 0 ;; -esac - -# I wanted to pipe this into awk, but it fell victim to a known pipe/streams -# bug on my multiprocessor machine. - -callci xeq linkedit.pub.sys \"$LIST\" >nm.$$ - -/bin/awk '\ - / data univ / { printf "%-20s|%10s|%-6s|%-7s|%s\n",$1,$5,"extern","data","?"} \ - / entry univ / { printf "%-20s|%10s|%-6s|%-7s|%s\n",$1,$7,"extern","entry","?"}' nm.$$ - -rm -f nm.$$ - -exit 0 diff --git a/mpeix/relink b/mpeix/relink deleted file mode 100755 index 2984bcecfe..0000000000 --- a/mpeix/relink +++ /dev/null @@ -1,49 +0,0 @@ -#!/bin/sh - -# The MPE POSIX libc archive library contains rand(), but this function has -# been omitted from the libc shared library on the mistaken assumption that -# the rand() function in the kernel library /SYS/PUB/XL could be used instead. -# However, rand() in /SYS/PUB/XL is a Fortran function with different semantics -# from the C version that we expect. - -# So in order to get the correct rand() function and to make it available to -# the dynamically loaded perl extensions, we will build our own mini rand() -# shared library and add this to the perl NMPRG's XL list. - -RAND=/$HPACCOUNT/$HPGROUP/libcrand - -echo "Creating $RAND.sl...\n" - -TEMP=./perlmpe.$$ - -rm -f $TEMP $RAND.a $RAND.sl - -/bin/cat - >$TEMP <<EOF -buildrl $RAND.a -copyrl from=/lib/libc.a;to=$RAND.a;module=rand -revealrl rl=$RAND.a;all -buildxl $RAND.sl;limit=1 -addxl from=$RAND.a;to=$RAND.sl;share -listxl xl=$RAND.sl -EOF - -callci "xeq LINKEDIT.PUB.SYS <$TEMP" - -rm -f $TEMP $RAND.a - -# MPE/iX as of 5.5 does not yet properly support linking against dynamic -# libraries via gcc or ld. For now, re-run gcc without the external library -# list, and then run the native linker with the list of dynamic libraries. - -echo "Creating the perl executable NMPRG..." - -gcc -o perl perlmain.o \ - lib/auto/DynaLoader/DynaLoader.a \ - libperl.a \ - `cat ext.libs` \ - -L/BINDFW/CURRENT/lib -lbind \ - -L/SYSLOG/PUB -lsyslog - -echo "Modifying the perl executable NMPRG XL list...\n" - -callci "xeq LINKEDIT.PUB.SYS 'altprog ./perl;xl=/usr/lib/libcurses.sl,/lib/libsvipc.sl,/usr/lib/libsocket.sl,/usr/lib/libstr.sl,/lib/libm.sl,$RAND.sl,/lib/libc.sl'" @@ -2563,11 +2563,6 @@ typedef struct clone_params CLONE_PARAMS; # include "iperlsys.h" #endif -#if defined(__OPEN_VM) -# include "vmesa/vmesaish.h" -# define ISHISH "vmesa" -#endif - #ifdef DOSISH # if defined(OS2) # include "os2ish.h" @@ -2587,11 +2582,6 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "plan9" #endif -#if defined(MPE) -# include "mpeix/mpeixish.h" -# define ISHISH "mpeix" -#endif - #if defined(__VOS__) # ifdef __GNUC__ # include "./vos/vosish.h" @@ -2615,9 +2605,6 @@ typedef struct clone_params CLONE_PARAMS; #if defined(__HAIKU__) # include "haiku/haikuish.h" # define ISHISH "haiku" -#elif defined(__BEOS__) -# include "beos/beosish.h" -# define ISHISH "beos" #endif #ifndef ISHISH diff --git a/pod/perlport.pod b/pod/perlport.pod index 5f266f9537..13de9b57eb 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1448,8 +1448,6 @@ in the "OTHER" category include: OS $^O $Config{'archname'} ------------------------------------------ Amiga DOS amigaos m68k-amigos - BeOS beos - MPE/iX mpeix PA-RISC1.1 See also: diff --git a/uts/sprintf_wrap.c b/uts/sprintf_wrap.c deleted file mode 100644 index e86eae084b..0000000000 --- a/uts/sprintf_wrap.c +++ /dev/null @@ -1,196 +0,0 @@ -#include <stdlib.h> -#include <stdio.h> -#include <assert.h> -#include <string.h> - -char *UTS_sprintf_wrap(); -char *do_efmt(); -char *do_gfmt(); -char *Fill(); - -/* main(argc, argv) - * char **argv; - * { - * double d; - * char *Fmt, *Ret; - * char obuf[200]; - * - * assert(argc > 2); - * Fmt = argv[1]; - * d = strtod(argv[2], (char **)0); - * - * putchar('{'); - * printf(Fmt, d); - * printf("}\n"); - * - * Ret = UTS_sprintf_wrap(obuf, Fmt, d); - * assert(Ret == obuf); - * - * printf("{%s}\n", obuf); - * } - */ - -char * -UTS_sprintf_wrap(obuf, fmt, d, - a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) -char *obuf, *fmt; -double d; -{ - int fmtlen, Width=0, Precision=6, Alt=0, Plus=0, Minus=0, - Zero = 0; - int FmtChar, BaseFmt = 0; - char *f = fmt, *AfterWidth = 0, *AfterPrecision = 0; - char *Dot; - - if(*f++ != '%') { - return -sprintf(obuf, fmt, d, a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15); - } - fmtlen = strlen(fmt); - FmtChar = fmt[fmtlen - 1]; - switch(FmtChar) { - case 'f': - case 'F': - return -sprintf(obuf, fmt, d, a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15); - case 'e': - case 'E': - BaseFmt = 'e'; - goto BaseFmt_IsSet; - case 'g': - case 'G': - BaseFmt = 'g'; -BaseFmt_IsSet: - if(*f == '#') { Alt = 1; ++f; } /* Always has '.' */ - if(*f == '+') { Plus = 1; ++f; } /* Force explicit sign */ - if(*f == '-') { Minus = 1; ++f; } /* Left justify */ - if(*f == '0') { Zero = 1; ++f;} /* Fill using 0s*/ - if(Dot = strchr(f, '.')) { - Precision = strtol(Dot+1, &AfterPrecision, 0); - } - if(!Dot || (Dot && Dot > f)) { /* Next char=='.' => no width*/ - Width = strtol(f, &AfterWidth, 0); - } - if(Dot) { f = AfterPrecision; } - else if(AfterWidth) { f = AfterWidth; } - if(*f != FmtChar) goto regular_sprintf; - /* It doesn't look like a f.p. sprintf call */ - /* from Perl_sv_vcatpvfn */ - - if(BaseFmt == 'e') { - return do_efmt(d, obuf, Width, Precision, Alt, - Plus, Minus, Zero, FmtChar == 'E'); - } else { - return do_gfmt(d, obuf, Width, Precision, Alt, - Plus, Minus, Zero, FmtChar == 'G'); - } - default: -regular_sprintf: - return -sprintf(obuf, fmt, d, a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15); - } -} - -char * -do_efmt(d, obuf, Width, Precision, Alt, Plus, Minus, Zero, UpperCase) -char *obuf; -double d; -{ - char *Ecvt; - char *ob; - int decpt, sign, E; - int len; - int AllZeroes = 0; - - Ecvt = ecvt( d , Precision+1, &decpt, &sign); - - /* fprintf(stderr, "decpt=%d, sign=%d\n", decpt, sign); */ - - len = strlen(Ecvt); - if(strspn(Ecvt, "0") == len) AllZeroes = 1; - - ob = obuf; - if(sign) *ob++ = '-'; - else if(Plus) *ob++ = '+'; - - *ob++ = Ecvt[0]; - - if(Precision > 0 || Alt) *ob++ = '.'; - strcpy(ob, &Ecvt[1]); - - ob += strlen(ob); /* ADVANCE TO END OF WHAT WE JUST ADDED */ - *ob++ = UpperCase ? 'E' : 'e'; - - if(AllZeroes) E = 0; - else E = decpt - 1; - - if(E < 0) { *ob++ = '-'; E = -E; } - else { *ob++ = '+'; } - - sprintf(ob, "%.2d", E); /* Too much horsepower used here */ - - if(Width > strlen(obuf)) return Fill(obuf, Width, Minus, Zero); - else return obuf; -} - -char * -do_gfmt(d, obuf, Width, Precision, Alt, Plus, Minus, Zero, UpperCase) -char *obuf; -double d; -{ - char *Ecvt = gcvt(d, Precision ? Precision : 1, obuf); - int len = strlen(obuf); - - /* gcvt fails (maybe give a warning? For now return empty string): */ - if(!Ecvt) { *obuf = '\0'; return obuf; } - - /* printf("Ecvt='%s'\n", Ecvt); */ - if(Plus && (Ecvt[0] != '-')) { - memmove(obuf+1, obuf, len+1); /* "+1" to get '\0' at end */ - obuf[0] = '+'; - ++len; - } - if(Alt && !strchr(Ecvt, '.')) { - int LenUpTo_E = strcspn(obuf, "eE"); - int E_etc_len = strlen(&obuf[LenUpTo_E]); - /* ABOVE: Will be 0 if there's no E/e because */ - /* strcspn will return length of whole string */ - - if(E_etc_len) - memmove(obuf+LenUpTo_E+1, obuf+LenUpTo_E, E_etc_len); - obuf[LenUpTo_E] = '.'; - obuf[LenUpTo_E + 1 + E_etc_len ] = '\0'; - } - { char *E_loc; - if(UpperCase && (E_loc = strchr(obuf, 'e'))) { *E_loc = 'E'; } - } - if(Width > len) - return Fill(obuf, Width, Minus, Zero); - else - return obuf; -} - -char * -Fill(obuf, Width, LeftJustify, Zero) -char *obuf; -{ - int W = strlen(obuf); - int diff = Width - W; - /* LeftJustify means there was a '-' flag, and in that case, */ - /* printf man page (UTS4.4) says ignore '0' */ - char FillChar = (Zero && !LeftJustify) ? '0' : ' '; - int i; - int LeftFill = ! LeftJustify; - - if(Width <= W) return obuf; - - if(LeftFill) { - memmove(obuf+diff, obuf, W+1); /* "+1" to get '\0' at end */ - for(i=0 ; i < diff ; ++i) { obuf[i] = FillChar; } - } else { - for(i=W ; i < Width ; ++i) - obuf[i] = FillChar; - obuf[Width] = '\0'; - } - return obuf; -} diff --git a/uts/strtol_wrap.c b/uts/strtol_wrap.c deleted file mode 100644 index 24bb05542f..0000000000 --- a/uts/strtol_wrap.c +++ /dev/null @@ -1,174 +0,0 @@ -/* A wrapper around strtol() and strtoul() to correct some - * "out of bounds" cases that don't work well on at least UTS. - * If a value is Larger than the max, strto[u]l should return - * the max value, and set errno to ERANGE - * The same if a value is smaller than the min value (only - * relevant for strtol(); not strtoul()), except the minimum - * value is returned (and errno == ERANGE). - */ - -#include <ctype.h> -#include <string.h> -#include <sys/errno.h> -#include <stdlib.h> - -extern int errno; - -#undef I32 -#undef U32 - -#define I32 int -#define U32 unsigned int - -struct base_info { - char *ValidChars; - - char *Ulong_max_str; - char *Long_max_str; - char *Long_min_str; /* Absolute value */ - - int Ulong_max_str_len; - int Long_max_str_len; - int Long_min_str_len; /* Absolute value */ - - U32 Ulong_max; - I32 Long_max; - I32 Long_min; /* NOT Absolute value */ -}; -static struct base_info Base_info[37]; - -static struct base_info Base_info_16 = { - "0123456789abcdefABCDEF", - "4294967295", "2147483648" /* <== ABS VAL */ , "2147483647", - 10, 10, 10, - 4294967295, 2147483647, - 2147483648, -}; - -static struct base_info Base_info_10 = { - "0123456789", - "4294967295", "2147483648" /* <== ABS VAL */ , "2147483647", - 10, 10, 10, - 4294967295, 2147483647, - 2147483648, -}; - - /* Used eventually (if this is fully developed) to hold info - * for processing bases 2-36. So that we can just plug the - * base in as a selector for its info, we sacrifice - * Base_info[0] and Base_info[1] (unless they are used - * at some point for special information). - */ - -/* This may be replaced later by something more universal */ -static void -init_Base_info() -{ - if(Base_info[10].ValidChars) return; - Base_info[10] = Base_info_10; - Base_info[16] = Base_info_16; -} - -unsigned int -strtoul_wrap32(char *s, char **pEnd, int base) -{ - int Len; - int isNegated = 0; - char *sOrig = s; - - init_Base_info(); - - while(*s && isspace(*s)) ++s; - - if(*s == '-') { - ++isNegated; - ++s; - while(*s && isspace(*s)) ++s; - } - if(base == 0) { - if(*s == '0') { - if(s[1] == 'x' || s[1] == 'X') { - s += 2; - base = 16; - } else { - ++s; - base = 8; - } - } else if(isdigit(*s)) { - base = 10; - } - } - if(base != 10) { - return strtoul(sOrig, pEnd, base); - } - - Len = strspn(s, Base_info[base].ValidChars); - - if(Len > Base_info[base].Ulong_max_str_len - || - (Len == Base_info[base].Ulong_max_str_len - && - strncmp(Base_info[base].Ulong_max_str, s, Len) < 0) - ) { - /* In case isNegated is set - what to do?? */ - /* Mightn't we say a negative number is ERANGE for strtoul? */ - errno = ERANGE; - return Base_info[base].Ulong_max; - } - - return strtoul(sOrig, pEnd, base); -} - -int -strtol_wrap32(char *s, char **pEnd, int base) -{ - int Len; - int isNegated = 0; - char *sOrig = s; - - init_Base_info(); - - while(*s && isspace(*s)) ++s; - - if(*s == '-') { - ++isNegated; - ++s; - while(*s && isspace(*s)) ++s; - } - if(base == 0) { - if(*s == '0') { - if(s[1] == 'x' || s[1] == 'X') { - s += 2; - base = 16; - } else { - ++s; - base = 8; - } - } else if(isdigit(*s)) { - base = 10; - } - } - if(base != 10) { - return strtol(sOrig, pEnd, base); - } - - Len = strspn(s, Base_info[base].ValidChars); - - if(Len > Base_info[base].Long_max_str_len - || - (!isNegated && Len == Base_info[base].Long_max_str_len - && - strncmp(Base_info[base].Long_max_str, s, Len) < 0) - || - (isNegated && Len == Base_info[base].Long_min_str_len - && - strncmp(Base_info[base].Long_min_str, s, Len) < 0) - ) { - /* In case isNegated is set - what to do?? */ - /* Mightn't we say a negative number is ERANGE for strtol? */ - errno = ERANGE; - return(isNegated ? Base_info[base].Long_min - : - Base_info[base].Long_min); - } - - return strtol(sOrig, pEnd, base); -} diff --git a/vmesa/Makefile b/vmesa/Makefile deleted file mode 100644 index d06a2da078..0000000000 --- a/vmesa/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -CCCMD=`sh $(shellflags) ../cflags $@` - -all : vm perl - -depend : - cd .. && $(MAKE) depend - -vm : vmesa.o - cp vmesa.o ../vmesa.o - -perl : - cd .. && $(MAKE) - -vmesa.o : vmesa.c - $(CCCMD) vmesa.c diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c deleted file mode 100644 index 59dd19b6c1..0000000000 --- a/vmesa/vmesa.c +++ /dev/null @@ -1,592 +0,0 @@ -/************************************************************/ -/* */ -/* Module ID - vmesa.c */ -/* */ -/* Function - Provide operating system dependent process- */ -/* ing for perl under VM/ESA. */ -/* */ -/* Parameters - See individual entry points. */ -/* */ -/* Called By - N/A - see individual entry points. */ -/* */ -/* Calling To - N/A - see individual entry points. */ -/* */ -/* Notes - (1) ....................................... */ -/* */ -/* (2) ....................................... */ -/* */ -/* Name - Neale Ferguson. */ -/* */ -/* Date - August, 1998. */ -/* */ -/* */ -/* Associated - (1) Refer To ........................... */ -/* Documentation */ -/* (2) Refer To ........................... */ -/* */ -/************************************************************/ -/************************************************************/ -/* */ -/* MODULE MAINTENANCE HISTORY */ -/* -------------------------- */ -/* */ -static char REQ_REL_WHO [13] = -/*-------------- -------------------------------------*/ - "9999_99 NAF "; /* Original module */ -/* */ -/*============ End of Module Maintenance History ===========*/ - -/************************************************************/ -/* */ -/* DEFINES */ -/* ------- */ -/* */ -/************************************************************/ - -#define FAIL 65280 - -/*=============== END OF DEFINES ===========================*/ - -/************************************************************/ -/* */ -/* INCLUDE STATEMENTS */ -/* ------------------ */ -/* */ -/************************************************************/ - -#include <stdio.h> -#include <stdlib.h> -#include <spawn.h> -#include <fcntl.h> -#include <unistd.h> -#include <pthread.h> -#include <dll.h> -#include "EXTERN.h" -#include "perl.h" -#pragma map(truncate, "@@TRUNC") - -/*================== End of Include Statements =============*/ - -/************************************************************/ -/* */ -/* Global Variables */ -/* ---------------- */ -/* */ -/************************************************************/ - -static int Perl_stdin_fd = STDIN_FILENO, - Perl_stdout_fd = STDOUT_FILENO; - -static long dl_retcode = 0; - -/*================== End of Global Variables ===============*/ - -/************************************************************/ -/* */ -/* FUNCTION PROTOTYPES */ -/* ------------------- */ -/* */ -/************************************************************/ - -int do_aspawn(SV *, SV **, SV **); -int do_spawn(char *, int); -static int spawnit(char *); -static pid_t spawn_cmd(char *, int, int); -struct perl_thread * getTHR(void); - -/*================== End of Prototypes =====================*/ - -/************************************************************/ -/* */ -/* D O _ A S P A W N */ -/* ----------------- */ -/* */ -/************************************************************/ - -int -do_aspawn(SV* really, SV **mark, SV **sp) -{ - char **a, - *tmps; - struct inheritance inherit; - pid_t pid; - int status, - fd, - nFd, - fdMap[3]; - SV *sv, - **p_sv; - STRLEN n_a; - - status = FAIL; - if (sp > mark) - { - Newx(PL_Argv, sp - mark + 1, char*); - a = PL_Argv; - while (++mark <= sp) - { - if (*mark) - *a++ = SvPVx(*mark, n_a); - else - *a++ = ""; - } - inherit.flags = SPAWN_SETGROUP; - inherit.pgroup = SPAWN_NEWPGROUP; - fdMap[STDIN_FILENO] = Perl_stdin_fd; - fdMap[STDOUT_FILENO] = Perl_stdout_fd; - fdMap[STDERR_FILENO] = STDERR_FILENO; - nFd = 3; - *a = NULL; - /*-----------------------------------------------------*/ - /* Will execvp() use PATH? */ - /*-----------------------------------------------------*/ - if (*PL_Argv[0] != '/') - TAINT_ENV(); - if (really && *(tmps = SvPV(really, n_a))) - pid = spawnp(tmps, nFd, fdMap, &inherit, - (const char **) PL_Argv, - (const char **) environ); - else - pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit, - (const char **) PL_Argv, - (const char **) environ); - if (pid < 0) - { - status = FAIL; - if (ckWARN(WARN_EXEC)) - warner(WARN_EXEC,"Can't exec \"%s\": %s", - PL_Argv[0], - Strerror(errno)); - } - else - { - /*------------------------------------------------*/ - /* If the file descriptors have been remapped then*/ - /* we've been called following a my_popen request */ - /* therefore we don't want to wait for spawnned */ - /* program to complete. We need to set the fdpid */ - /* value to the value of the spawnned process' pid*/ - /*------------------------------------------------*/ - fd = 0; - if (Perl_stdin_fd != STDIN_FILENO) - fd = Perl_stdin_fd; - else - if (Perl_stdout_fd != STDOUT_FILENO) - fd = Perl_stdout_fd; - if (fd != 0) - { - /*---------------------------------------------*/ - /* Get the fd of the other end of the pipe, */ - /* use this to reference the fdpid which will */ - /* be used by my_pclose */ - /*---------------------------------------------*/ - close(fd); - MUTEX_LOCK(&PL_fdpid_mutex); - p_sv = av_fetch(PL_fdpid,fd,TRUE); - fd = (int) SvIVX(*p_sv); - SvREFCNT_dec(*p_sv); - *p_sv = &PL_sv_undef; - sv = *av_fetch(PL_fdpid,fd,TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); - (void) SvUPGRADE(sv, SVt_IV); - SvIVX(sv) = pid; - status = 0; - } - else - wait4pid(pid, &status, 0); - } - do_execfree(); - } - return (status); -} - -/*===================== End of do_aspawn ===================*/ - -/************************************************************/ -/* */ -/* D O _ S P A W N */ -/* --------------- */ -/* */ -/************************************************************/ - -int -do_spawn(char *cmd, int execf) -{ - char **a, - *s, - flags[10]; - int status, - nFd, - fdMap[3]; - struct inheritance inherit; - pid_t pid; - - while (*cmd && isSPACE(*cmd)) - cmd++; - - /*------------------------------------------------------*/ - /* See if there are shell metacharacters in it */ - /*------------------------------------------------------*/ - - if (*cmd == '.' && isSPACE(cmd[1])) - return (spawnit(cmd)); - else - { - if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4])) - return (spawnit(cmd)); - else - { - /*------------------------------------------------*/ - /* Catch VAR=val gizmo */ - /*------------------------------------------------*/ - for (s = cmd; *s && isALPHA(*s); s++); - if (*s != '=') - { - for (s = cmd; *s; s++) - { - if (*s != ' ' && - !isALPHA(*s) && - strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) - { - if (*s == '\n' && !s[1]) - { - *s = '\0'; - break; - } - return(spawnit(cmd)); - } - } - } - } - } - - 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 = NULL; - fdMap[STDIN_FILENO] = Perl_stdin_fd; - fdMap[STDOUT_FILENO] = Perl_stdout_fd; - fdMap[STDERR_FILENO] = STDERR_FILENO; - nFd = 3; - inherit.flags = 0; - if (PL_Argv[0]) - { - pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit, - (const char **) PL_Argv, - (const char **) environ); - if (pid < 0) - { - status = FAIL; - if (ckWARN(WARN_EXEC)) - warner(WARN_EXEC,"Can't exec \"%s\": %s", - PL_Argv[0], - Strerror(errno)); - } - else - wait4pid(pid, &status, 0); - } - do_execfree(); - return (status); -} - -/*===================== End of do_spawn ====================*/ - -/************************************************************/ -/* */ -/* Name - spawnit. */ -/* */ -/* Function - Spawn command and return status. */ -/* */ -/* On Entry - cmd - command to be spawned. */ -/* */ -/* On Exit - status returned. */ -/* */ -/************************************************************/ - -int -spawnit(char *cmd) -{ - pid_t pid; - int status; - - pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO); - if (pid < 0) - status = FAIL; - else - wait4pid(pid, &status, 0); - - return (status); -} - -/*===================== End of spawnit =====================*/ - -/************************************************************/ -/* */ -/* Name - spawn_cmd. */ -/* */ -/* Function - Spawn command and return pid. */ -/* */ -/* On Entry - cmd - command to be spawned. */ -/* */ -/* On Exit - pid returned. */ -/* */ -/************************************************************/ - -pid_t -spawn_cmd(char *cmd, int inFd, int outFd) -{ - struct inheritance inherit; - pid_t pid; - const char *argV[4] = {"/bin/sh","-c",NULL,NULL}; - int nFd, - fdMap[3]; - - argV[2] = cmd; - fdMap[STDIN_FILENO] = inFd; - fdMap[STDOUT_FILENO] = outFd; - fdMap[STDERR_FILENO] = STDERR_FILENO; - nFd = 3; - inherit.flags = SPAWN_SETGROUP; - inherit.pgroup = SPAWN_NEWPGROUP; - pid = spawn(argV[0], nFd, fdMap, &inherit, - argV, (const char **) environ); - return (pid); -} - -/*===================== End of spawnit =====================*/ - -/************************************************************/ -/* */ -/* Name - my_popen. */ -/* */ -/* Function - Use popen to execute a command return a */ -/* file descriptor. */ -/* */ -/* On Entry - cmd - command to be executed. */ -/* */ -/* On Exit - FILE * returned. */ -/* */ -/************************************************************/ - -#include <ctest.h> -PerlIO * -my_popen(char *cmd, char *mode) -{ - FILE *fd; - int pFd[2], - this, - that, - pid; - SV *sv; - - if (PerlProc_pipe(pFd) >= 0) - { - this = (*mode == 'w'); - that = !this; - /*-------------------------------------------------*/ - /* If this is a read mode pipe */ - /* - map the write end of the pipe to STDOUT */ - /* - return the *FILE for the read end of the pipe */ - /*-------------------------------------------------*/ - if (!this) - Perl_stdout_fd = pFd[that]; - /*-------------------------------------------------*/ - /* Else */ - /* - map the read end of the pipe to STDIN */ - /* - return the *FILE for the write end of the pipe*/ - /*-------------------------------------------------*/ - else - Perl_stdin_fd = pFd[that]; - if (strNE(cmd,"-")) - { - PERL_FLUSHALL_FOR_CHILD; - pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd); - if (pid >= 0) - { - MUTEX_LOCK(&PL_fdpid_mutex); - sv = *av_fetch(PL_fdpid,pFd[this],TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); - (void) SvUPGRADE(sv, SVt_IV); - SvIVX(sv) = pid; - fd = PerlIO_fdopen(pFd[this], mode); - close(pFd[that]); - } - else - fd = NULL; - } - else - { - MUTEX_LOCK(&PL_fdpid_mutex); - sv = *av_fetch(PL_fdpid,pFd[that],TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); - (void) SvUPGRADE(sv, SVt_IV); - SvIVX(sv) = pFd[this]; - fd = PerlIO_fdopen(pFd[this], mode); - } - } - else - fd = NULL; - return (fd); -} - -/*===================== End of my_popen ====================*/ - -/************************************************************/ -/* */ -/* Name - my_pclose. */ -/* */ -/* Function - Use pclose to terminate a piped command */ -/* file stream. */ -/* */ -/* On Entry - fd - FILE pointer. */ -/* */ -/* On Exit - Status returned. */ -/* */ -/************************************************************/ - -long -my_pclose(FILE *fp) -{ - int pid, - saveErrno, - status; - long rc, - wRc; - SV **sv; - FILE *other; - - MUTEX_LOCK(&PL_fdpid_mutex); - sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); - pid = (int) SvIVX(*sv); - SvREFCNT_dec(*sv); - *sv = &PL_sv_undef; - rc = PerlIO_close(fp); - saveErrno = errno; - do - { - wRc = waitpid(pid, &status, 0); - } while ((wRc == -1) && (errno == EINTR)); - Perl_stdin_fd = STDIN_FILENO; - Perl_stdout_fd = STDOUT_FILENO; - errno = saveErrno; - if (rc != 0) - SETERRNO(errno, garbage); - return (rc); - -} - -/************************************************************/ -/* */ -/* Name - dlopen. */ -/* */ -/* Function - Load a DLL. */ -/* */ -/* On Exit - */ -/* */ -/************************************************************/ - -void * -dlopen(const char *path) -{ - dllhandle *handle; - -fprintf(stderr,"Loading %s\n",path); - handle = dllload(path); - dl_retcode = errno; -fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno)); - return ((void *) handle); -} - -/*===================== End of dlopen ======================*/ - -/************************************************************/ -/* */ -/* Name - dlsym. */ -/* */ -/* Function - Locate a DLL symbol. */ -/* */ -/* On Exit - */ -/* */ -/************************************************************/ - -void * -dlsym(void *handle, const char *symbol) -{ - void *symLoc; - -fprintf(stderr,"Finding %s\n",symbol); - symLoc = dllqueryvar((dllhandle *) handle, (char *) symbol); - if (symLoc == NULL) - symLoc = (void *) dllqueryfn((dllhandle *) handle, - (char *) symbol); - dl_retcode = errno; - return(symLoc); -} - -/*===================== End of dlsym =======================*/ - -/************************************************************/ -/* */ -/* Name - dlerror. */ -/* */ -/* Function - Return the last errno pertaining to a DLL */ -/* operation. */ -/* */ -/* On Exit - */ -/* */ -/************************************************************/ - -void * -dlerror(void) -{ - char * dlEmsg; - - dlEmsg = strerror(dl_retcode); - dl_retcode = 0; - return(dlEmsg); -} - -/*===================== End of dlerror =====================*/ - -/************************************************************/ -/* */ -/* Name - TRUNCATE. */ -/* */ -/* Function - Truncate a file identified by 'path' to */ -/* a given length. */ -/* */ -/* On Entry - path - Path of file to be truncated. */ -/* length - length of truncated file. */ -/* */ -/* On Exit - retC - return code. */ -/* */ -/************************************************************/ - -int -truncate(const unsigned char *path, off_t length) -{ - int fd, - retC; - - fd = open((const char *) path, O_RDWR); - if (fd > 0) - { - retC = ftruncate(fd, length); - close(fd); - } - else - retC = fd; - return(retC); -} - -/*===================== End of trunc =======================*/ diff --git a/vmesa/vmesaish.h b/vmesa/vmesaish.h deleted file mode 100644 index a6bd901cdb..0000000000 --- a/vmesa/vmesaish.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef _VMESA_INCLUDED -# define _VMESA_INCLUDED 1 -# include <string.h> -# include <ctype.h> -# include <vmsock.h> - void * dlopen(const char *); - void * dlsym(void *, const char *); - void * dlerror(void); -# define OLD_PTHREADS_API -#endif |