From 10f8581b6171145f56be2c57fd425b0b6a8b4697 Mon Sep 17 00:00:00 2001 From: cvs2svn Date: Sun, 25 Jun 2000 11:04:02 +0000 Subject: This commit was manufactured by cvs2svn to create tag 'perl5-vendor-v5_006'. --- contrib/perl5/Todo-5.005 | 61 -- contrib/perl5/XSlock.h | 38 - contrib/perl5/bytecode.h | 161 --- contrib/perl5/byterun.c | 867 ---------------- contrib/perl5/byterun.h | 184 ---- contrib/perl5/eg/cgi/dna.small.gif.uu | 63 -- contrib/perl5/eg/cgi/wilogo.gif.uu | 13 - contrib/perl5/ext/B/byteperl.c | 110 -- contrib/perl5/ext/DynaLoader/dl_cygwin32.xs | 153 --- contrib/perl5/hints/cygwin32.sh | 50 - contrib/perl5/interp.sym | 211 ---- contrib/perl5/lib/Sys/Hostname.pm | 121 --- contrib/perl5/lib/Sys/Syslog.pm | 276 ----- contrib/perl5/myconfig | 43 - contrib/perl5/objpp.h | 1473 --------------------------- contrib/perl5/perl_exp.SH | 132 --- contrib/perl5/t/lib/thread.t | 73 -- contrib/perl5/t/op/nothread.t | 35 - contrib/perl5/t/pragma/warn-1global | 159 --- contrib/perl5/t/pragma/warning.t | 113 -- contrib/perl5/thread.sym | 1 - 21 files changed, 4337 deletions(-) delete mode 100644 contrib/perl5/Todo-5.005 delete mode 100644 contrib/perl5/XSlock.h delete mode 100644 contrib/perl5/bytecode.h delete mode 100644 contrib/perl5/byterun.c delete mode 100644 contrib/perl5/byterun.h delete mode 100644 contrib/perl5/eg/cgi/dna.small.gif.uu delete mode 100644 contrib/perl5/eg/cgi/wilogo.gif.uu delete mode 100644 contrib/perl5/ext/B/byteperl.c delete mode 100644 contrib/perl5/ext/DynaLoader/dl_cygwin32.xs delete mode 100644 contrib/perl5/hints/cygwin32.sh delete mode 100644 contrib/perl5/interp.sym delete mode 100644 contrib/perl5/lib/Sys/Hostname.pm delete mode 100644 contrib/perl5/lib/Sys/Syslog.pm delete mode 100755 contrib/perl5/myconfig delete mode 100644 contrib/perl5/objpp.h delete mode 100755 contrib/perl5/perl_exp.SH delete mode 100755 contrib/perl5/t/lib/thread.t delete mode 100755 contrib/perl5/t/op/nothread.t delete mode 100644 contrib/perl5/t/pragma/warn-1global delete mode 100755 contrib/perl5/t/pragma/warning.t delete mode 100644 contrib/perl5/thread.sym diff --git a/contrib/perl5/Todo-5.005 b/contrib/perl5/Todo-5.005 deleted file mode 100644 index 7f2dbc957c868..0000000000000 --- a/contrib/perl5/Todo-5.005 +++ /dev/null @@ -1,61 +0,0 @@ -Multi-threading - $AUTOLOAD. Hmm. - consistent semantics for exit/die in threads - SvREFCNT_dec(curstack) in threadstart() in Thread.xs - better support for externally created threads - Thread::Pool - spot-check globals like statcache and global GVs for thread-safety - -Compiler - auto-produce executable - typed lexicals should affect B::CC::load_pad - workarounds to help Win32 - END blocks need saving in compiled output - _AUTOLOAD prodding - fix comppadlist (names in comppad_name can have fake SvCUR - from where newASSIGNOP steals the field) - -Namespace cleanup - CPP-space: restrict what we export from headers - stop malloc()/free() pollution unless asked - header-space: move into CORE/perl/ - API-space: begin list of things that constitute public api - -MULTIPLICITY support - complete work on safe recursive interpreters, Cnew()> - revisit extra implicit arg that provides curthread/curinterp context - -Reliable Signals - alternate runops() for signal despatch - figure out how to die() in delayed sighandler - add tests for Thread::Signal - -Win32 stuff - get PERL_OBJECT building under gcc - get PERL_OBJECT building on non-win32 - automate generation of 'protected' prototypes for CPerlObj - rename new headers to be consistent with the rest - sort out the spawnvp() mess - work out DLL versioning - style-check - -Miscellaneous - rename and alter ISA.pm - magic_setisa should be made to update %FIELDS [???] - add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?) - fix pod2html to generate relative URLs - automate testing with large parts of CPAN - -Ongoing - keep filenames 8.3 friendly, where feasible - upgrade to newer versions of all independently maintained modules - comprehensive perldelta.pod - -Documentation - describe new age patterns - update perl{guts,call,embed,xs} with additions, changes to API - document Win32 choices - spot-check all new modules for completeness - better docs for pack()/unpack() - reorg tutorials vs. reference sections - diff --git a/contrib/perl5/XSlock.h b/contrib/perl5/XSlock.h deleted file mode 100644 index 0b2c8299b917f..0000000000000 --- a/contrib/perl5/XSlock.h +++ /dev/null @@ -1,38 +0,0 @@ -#ifndef __XSlock_h__ -#define __XSlock_h__ - -class XSLockManager -{ -public: - XSLockManager() { InitializeCriticalSection(&cs); }; - ~XSLockManager() { DeleteCriticalSection(&cs); }; - void Enter(void) { EnterCriticalSection(&cs); }; - void Leave(void) { LeaveCriticalSection(&cs); }; -protected: - CRITICAL_SECTION cs; -}; - -XSLockManager g_XSLock; -CPerlObj* pPerl; - -class XSLock -{ -public: - XSLock(CPerlObj *p) { - g_XSLock.Enter(); - ::pPerl = p; - }; - ~XSLock() { g_XSLock.Leave(); }; -}; - -/* PERL_CAPI does its own locking in xs_handler() */ -#if defined(PERL_OBJECT) && !defined(PERL_CAPI) -#undef dXSARGS -#define dXSARGS \ - XSLock localLock(pPerl); \ - dSP; dMARK; \ - I32 ax = mark - PL_stack_base + 1; \ - I32 items = sp - mark -#endif /* PERL_OBJECT && !PERL_CAPI */ - -#endif diff --git a/contrib/perl5/bytecode.h b/contrib/perl5/bytecode.h deleted file mode 100644 index 7f0ab13a490f1..0000000000000 --- a/contrib/perl5/bytecode.h +++ /dev/null @@ -1,161 +0,0 @@ -typedef char *pvcontents; -typedef char *strconst; -typedef U32 PV; -typedef char *op_tr_array; -typedef int comment_t; -typedef SV *svindex; -typedef OP *opindex; -typedef IV IV64; - -#ifdef INDIRECT_BGET_MACROS -#define BGET_FREAD(argp, len, nelem) \ - bs.fread((char*)(argp),(len),(nelem),bs.data) -#define BGET_FGETC() bs.fgetc(bs.data) -#else -#define BGET_FREAD(argp, len, nelem) PerlIO_read(fp, (argp), (len)*(nelem)) -#define BGET_FGETC() PerlIO_getc(fp) -#endif /* INDIRECT_BGET_MACROS */ - -#define BGET_U32(arg) \ - BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) -#define BGET_I32(arg) \ - BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) -#define BGET_U16(arg) \ - BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) -#define BGET_U8(arg) arg = BGET_FGETC() - -#if INDIRECT_BGET_MACROS -#define BGET_PV(arg) STMT_START { \ - BGET_U32(arg); \ - if (arg) \ - bs.freadpv(arg, bs.data); \ - else { \ - PL_bytecode_pv.xpv_pv = 0; \ - PL_bytecode_pv.xpv_len = 0; \ - PL_bytecode_pv.xpv_cur = 0; \ - } \ - } STMT_END -#else -#define BGET_PV(arg) STMT_START { \ - BGET_U32(arg); \ - if (arg) { \ - New(666, PL_bytecode_pv.xpv_pv, arg, char); \ - PerlIO_read(fp, PL_bytecode_pv.xpv_pv, arg); \ - PL_bytecode_pv.xpv_len = arg; \ - PL_bytecode_pv.xpv_cur = arg - 1; \ - } else { \ - PL_bytecode_pv.xpv_pv = 0; \ - PL_bytecode_pv.xpv_len = 0; \ - PL_bytecode_pv.xpv_cur = 0; \ - } \ - } STMT_END -#endif /* INDIRECT_BGET_MACROS */ - -#define BGET_comment_t(arg) \ - do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) - -/* - * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV - * machines such that 32-bit machine compilers don't whine about the shift - * count being too high even though the code is never reached there. - */ -#define BGET_IV64(arg) STMT_START { \ - U32 hi, lo; \ - BGET_U32(hi); \ - BGET_U32(lo); \ - if (sizeof(IV) == 8) \ - arg = ((IV)hi << (sizeof(IV)*4) | lo); \ - else if (((I32)hi == -1 && (I32)lo < 0) \ - || ((I32)hi == 0 && (I32)lo >= 0)) { \ - arg = (I32)lo; \ - } \ - else { \ - PL_bytecode_iv_overflows++; \ - arg = 0; \ - } \ - } STMT_END - -#define BGET_op_tr_array(arg) do { \ - unsigned short *ary; \ - int i; \ - New(666, ary, 256, unsigned short); \ - BGET_FREAD(ary, 256, 2); \ - for (i = 0; i < 256; i++) \ - ary[i] = PerlSock_ntohs(ary[i]); \ - arg = (char *) ary; \ - } while (0) - -#define BGET_pvcontents(arg) arg = PL_bytecode_pv.xpv_pv -#define BGET_strconst(arg) STMT_START { \ - for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ - arg = PL_tokenbuf; \ - } STMT_END - -#define BGET_double(arg) STMT_START { \ - char *str; \ - BGET_strconst(str); \ - arg = atof(str); \ - } STMT_END - -#define BGET_objindex(arg, type) STMT_START { \ - U32 ix; \ - BGET_U32(ix); \ - arg = (type)PL_bytecode_obj_list[ix]; \ - } STMT_END -#define BGET_svindex(arg) BGET_objindex(arg, svindex) -#define BGET_opindex(arg) BGET_objindex(arg, opindex) - -#define BSET_ldspecsv(sv, arg) sv = PL_specialsv_list[arg] - -#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg -#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg -#define BSET_gp_share(sv, arg) STMT_START { \ - gp_free((GV*)sv); \ - GvGP(sv) = GvGP(arg); \ - } STMT_END - -#define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) -#define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) -#define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) -#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = PL_bytecode_pv.xpv_cur -#define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) -#define BSET_xpv(sv) do { \ - SvPV_set(sv, PL_bytecode_pv.xpv_pv); \ - SvCUR_set(sv, PL_bytecode_pv.xpv_cur); \ - SvLEN_set(sv, PL_bytecode_pv.xpv_len); \ - } while (0) -#define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) - -#define BSET_av_push(sv, arg) av_push((AV*)sv, arg) -#define BSET_hv_store(sv, arg) \ - hv_store((HV*)sv, PL_bytecode_pv.xpv_pv, PL_bytecode_pv.xpv_cur, arg, 0) -#define BSET_pv_free(pv) Safefree(pv.xpv_pv) -#define BSET_pregcomp(o, arg) \ - ((PMOP*)o)->op_pmregexp = arg ? \ - CALLREGCOMP(arg, arg + PL_bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 -#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) -#define BSET_newop(o, arg) o = (OP*)safemalloc(optype_size[arg]) -#define BSET_newopn(o, arg) STMT_START { \ - OP *oldop = o; \ - BSET_newop(o, arg); \ - oldop->op_next = o; \ - } STMT_END - -#define BSET_ret(foo) return - -/* - * Kludge special-case workaround for OP_MAPSTART - * which needs the ppaddr for OP_GREPSTART. Blech. - */ -#define BSET_op_type(o, arg) STMT_START { \ - o->op_type = arg; \ - if (arg == OP_MAPSTART) \ - arg = OP_GREPSTART; \ - o->op_ppaddr = ppaddr[arg]; \ - } STMT_END -#define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented") -#define BSET_curpad(pad, arg) pad = AvARRAY(arg) - -#define BSET_OBJ_STORE(obj, ix) \ - (I32)ix > PL_bytecode_obj_list_fill ? \ - bset_obj_store(obj, (I32)ix) : (PL_bytecode_obj_list[ix] = obj) diff --git a/contrib/perl5/byterun.c b/contrib/perl5/byterun.c deleted file mode 100644 index 34beaf4f4b965..0000000000000 --- a/contrib/perl5/byterun.c +++ /dev/null @@ -1,867 +0,0 @@ -/* - * Copyright (c) 1996-1998 Malcolm Beattie - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - */ -/* - * This file is autogenerated from bytecode.pl. Changes made here will be lost. - */ - -#include "EXTERN.h" -#include "perl.h" - -void * -bset_obj_store(void *obj, I32 ix) -{ - if (ix > PL_bytecode_obj_list_fill) { - if (PL_bytecode_obj_list_fill == -1) - New(666, PL_bytecode_obj_list, ix + 1, void*); - else - Renew(PL_bytecode_obj_list, ix + 1, void*); - PL_bytecode_obj_list_fill = ix; - } - PL_bytecode_obj_list[ix] = obj; - return obj; -} - -#ifdef INDIRECT_BGET_MACROS -void byterun(struct bytestream bs) -#else -void byterun(PerlIO *fp) -#endif /* INDIRECT_BGET_MACROS */ -{ - dTHR; - int insn; - while ((insn = BGET_FGETC()) != EOF) { - switch (insn) { - case INSN_COMMENT: /* 35 */ - { - comment_t arg; - BGET_comment_t(arg); - arg = arg; - break; - } - case INSN_NOP: /* 10 */ - { - break; - } - case INSN_RET: /* 0 */ - { - BSET_ret(none); - break; - } - case INSN_LDSV: /* 1 */ - { - svindex arg; - BGET_svindex(arg); - PL_bytecode_sv = arg; - break; - } - case INSN_LDOP: /* 2 */ - { - opindex arg; - BGET_opindex(arg); - PL_op = arg; - break; - } - case INSN_STSV: /* 3 */ - { - U32 arg; - BGET_U32(arg); - BSET_OBJ_STORE(PL_bytecode_sv, arg); - break; - } - case INSN_STOP: /* 4 */ - { - U32 arg; - BGET_U32(arg); - BSET_OBJ_STORE(PL_op, arg); - break; - } - case INSN_LDSPECSV: /* 5 */ - { - U8 arg; - BGET_U8(arg); - BSET_ldspecsv(PL_bytecode_sv, arg); - break; - } - case INSN_NEWSV: /* 6 */ - { - U8 arg; - BGET_U8(arg); - BSET_newsv(PL_bytecode_sv, arg); - break; - } - case INSN_NEWOP: /* 7 */ - { - U8 arg; - BGET_U8(arg); - BSET_newop(PL_op, arg); - break; - } - case INSN_NEWOPN: /* 8 */ - { - U8 arg; - BGET_U8(arg); - BSET_newopn(PL_op, arg); - break; - } - case INSN_NEWPV: /* 9 */ - { - PV arg; - BGET_PV(arg); - break; - } - case INSN_PV_CUR: /* 11 */ - { - STRLEN arg; - BGET_U32(arg); - PL_bytecode_pv.xpv_cur = arg; - break; - } - case INSN_PV_FREE: /* 12 */ - { - BSET_pv_free(PL_bytecode_pv); - break; - } - case INSN_SV_UPGRADE: /* 13 */ - { - char arg; - BGET_U8(arg); - BSET_sv_upgrade(PL_bytecode_sv, arg); - break; - } - case INSN_SV_REFCNT: /* 14 */ - { - U32 arg; - BGET_U32(arg); - SvREFCNT(PL_bytecode_sv) = arg; - break; - } - case INSN_SV_REFCNT_ADD: /* 15 */ - { - I32 arg; - BGET_I32(arg); - BSET_sv_refcnt_add(SvREFCNT(PL_bytecode_sv), arg); - break; - } - case INSN_SV_FLAGS: /* 16 */ - { - U32 arg; - BGET_U32(arg); - SvFLAGS(PL_bytecode_sv) = arg; - break; - } - case INSN_XRV: /* 17 */ - { - svindex arg; - BGET_svindex(arg); - SvRV(PL_bytecode_sv) = arg; - break; - } - case INSN_XPV: /* 18 */ - { - BSET_xpv(PL_bytecode_sv); - break; - } - case INSN_XIV32: /* 19 */ - { - I32 arg; - BGET_I32(arg); - SvIVX(PL_bytecode_sv) = arg; - break; - } - case INSN_XIV64: /* 20 */ - { - IV64 arg; - BGET_IV64(arg); - SvIVX(PL_bytecode_sv) = arg; - break; - } - case INSN_XNV: /* 21 */ - { - double arg; - BGET_double(arg); - SvNVX(PL_bytecode_sv) = arg; - break; - } - case INSN_XLV_TARGOFF: /* 22 */ - { - STRLEN arg; - BGET_U32(arg); - LvTARGOFF(PL_bytecode_sv) = arg; - break; - } - case INSN_XLV_TARGLEN: /* 23 */ - { - STRLEN arg; - BGET_U32(arg); - LvTARGLEN(PL_bytecode_sv) = arg; - break; - } - case INSN_XLV_TARG: /* 24 */ - { - svindex arg; - BGET_svindex(arg); - LvTARG(PL_bytecode_sv) = arg; - break; - } - case INSN_XLV_TYPE: /* 25 */ - { - char arg; - BGET_U8(arg); - LvTYPE(PL_bytecode_sv) = arg; - break; - } - case INSN_XBM_USEFUL: /* 26 */ - { - I32 arg; - BGET_I32(arg); - BmUSEFUL(PL_bytecode_sv) = arg; - break; - } - case INSN_XBM_PREVIOUS: /* 27 */ - { - U16 arg; - BGET_U16(arg); - BmPREVIOUS(PL_bytecode_sv) = arg; - break; - } - case INSN_XBM_RARE: /* 28 */ - { - U8 arg; - BGET_U8(arg); - BmRARE(PL_bytecode_sv) = arg; - break; - } - case INSN_XFM_LINES: /* 29 */ - { - I32 arg; - BGET_I32(arg); - FmLINES(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_LINES: /* 30 */ - { - long arg; - BGET_I32(arg); - IoLINES(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_PAGE: /* 31 */ - { - long arg; - BGET_I32(arg); - IoPAGE(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_PAGE_LEN: /* 32 */ - { - long arg; - BGET_I32(arg); - IoPAGE_LEN(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_LINES_LEFT: /* 33 */ - { - long arg; - BGET_I32(arg); - IoLINES_LEFT(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_TOP_NAME: /* 34 */ - { - pvcontents arg; - BGET_pvcontents(arg); - IoTOP_NAME(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_TOP_GV: /* 36 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&IoTOP_GV(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_FMT_NAME: /* 37 */ - { - pvcontents arg; - BGET_pvcontents(arg); - IoFMT_NAME(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_FMT_GV: /* 38 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&IoFMT_GV(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_BOTTOM_NAME: /* 39 */ - { - pvcontents arg; - BGET_pvcontents(arg); - IoBOTTOM_NAME(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_BOTTOM_GV: /* 40 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&IoBOTTOM_GV(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_SUBPROCESS: /* 41 */ - { - short arg; - BGET_U16(arg); - IoSUBPROCESS(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_TYPE: /* 42 */ - { - char arg; - BGET_U8(arg); - IoTYPE(PL_bytecode_sv) = arg; - break; - } - case INSN_XIO_FLAGS: /* 43 */ - { - char arg; - BGET_U8(arg); - IoFLAGS(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_STASH: /* 44 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&CvSTASH(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_START: /* 45 */ - { - opindex arg; - BGET_opindex(arg); - CvSTART(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_ROOT: /* 46 */ - { - opindex arg; - BGET_opindex(arg); - CvROOT(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_GV: /* 47 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&CvGV(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_FILEGV: /* 48 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&CvFILEGV(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_DEPTH: /* 49 */ - { - long arg; - BGET_I32(arg); - CvDEPTH(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_PADLIST: /* 50 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&CvPADLIST(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_OUTSIDE: /* 51 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&CvOUTSIDE(PL_bytecode_sv) = arg; - break; - } - case INSN_XCV_FLAGS: /* 52 */ - { - U8 arg; - BGET_U8(arg); - CvFLAGS(PL_bytecode_sv) = arg; - break; - } - case INSN_AV_EXTEND: /* 53 */ - { - SSize_t arg; - BGET_I32(arg); - BSET_av_extend(PL_bytecode_sv, arg); - break; - } - case INSN_AV_PUSH: /* 54 */ - { - svindex arg; - BGET_svindex(arg); - BSET_av_push(PL_bytecode_sv, arg); - break; - } - case INSN_XAV_FILL: /* 55 */ - { - SSize_t arg; - BGET_I32(arg); - AvFILLp(PL_bytecode_sv) = arg; - break; - } - case INSN_XAV_MAX: /* 56 */ - { - SSize_t arg; - BGET_I32(arg); - AvMAX(PL_bytecode_sv) = arg; - break; - } - case INSN_XAV_FLAGS: /* 57 */ - { - U8 arg; - BGET_U8(arg); - AvFLAGS(PL_bytecode_sv) = arg; - break; - } - case INSN_XHV_RITER: /* 58 */ - { - I32 arg; - BGET_I32(arg); - HvRITER(PL_bytecode_sv) = arg; - break; - } - case INSN_XHV_NAME: /* 59 */ - { - pvcontents arg; - BGET_pvcontents(arg); - HvNAME(PL_bytecode_sv) = arg; - break; - } - case INSN_HV_STORE: /* 60 */ - { - svindex arg; - BGET_svindex(arg); - BSET_hv_store(PL_bytecode_sv, arg); - break; - } - case INSN_SV_MAGIC: /* 61 */ - { - char arg; - BGET_U8(arg); - BSET_sv_magic(PL_bytecode_sv, arg); - break; - } - case INSN_MG_OBJ: /* 62 */ - { - svindex arg; - BGET_svindex(arg); - SvMAGIC(PL_bytecode_sv)->mg_obj = arg; - break; - } - case INSN_MG_PRIVATE: /* 63 */ - { - U16 arg; - BGET_U16(arg); - SvMAGIC(PL_bytecode_sv)->mg_private = arg; - break; - } - case INSN_MG_FLAGS: /* 64 */ - { - U8 arg; - BGET_U8(arg); - SvMAGIC(PL_bytecode_sv)->mg_flags = arg; - break; - } - case INSN_MG_PV: /* 65 */ - { - pvcontents arg; - BGET_pvcontents(arg); - BSET_mg_pv(SvMAGIC(PL_bytecode_sv), arg); - break; - } - case INSN_XMG_STASH: /* 66 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&SvSTASH(PL_bytecode_sv) = arg; - break; - } - case INSN_GV_FETCHPV: /* 67 */ - { - strconst arg; - BGET_strconst(arg); - BSET_gv_fetchpv(PL_bytecode_sv, arg); - break; - } - case INSN_GV_STASHPV: /* 68 */ - { - strconst arg; - BGET_strconst(arg); - BSET_gv_stashpv(PL_bytecode_sv, arg); - break; - } - case INSN_GP_SV: /* 69 */ - { - svindex arg; - BGET_svindex(arg); - GvSV(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_REFCNT: /* 70 */ - { - U32 arg; - BGET_U32(arg); - GvREFCNT(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_REFCNT_ADD: /* 71 */ - { - I32 arg; - BGET_I32(arg); - BSET_gp_refcnt_add(GvREFCNT(PL_bytecode_sv), arg); - break; - } - case INSN_GP_AV: /* 72 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvAV(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_HV: /* 73 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvHV(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_CV: /* 74 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvCV(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_FILEGV: /* 75 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvFILEGV(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_IO: /* 76 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvIOp(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_FORM: /* 77 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvFORM(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_CVGEN: /* 78 */ - { - U32 arg; - BGET_U32(arg); - GvCVGEN(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_LINE: /* 79 */ - { - line_t arg; - BGET_U16(arg); - GvLINE(PL_bytecode_sv) = arg; - break; - } - case INSN_GP_SHARE: /* 80 */ - { - svindex arg; - BGET_svindex(arg); - BSET_gp_share(PL_bytecode_sv, arg); - break; - } - case INSN_XGV_FLAGS: /* 81 */ - { - U8 arg; - BGET_U8(arg); - GvFLAGS(PL_bytecode_sv) = arg; - break; - } - case INSN_OP_NEXT: /* 82 */ - { - opindex arg; - BGET_opindex(arg); - PL_op->op_next = arg; - break; - } - case INSN_OP_SIBLING: /* 83 */ - { - opindex arg; - BGET_opindex(arg); - PL_op->op_sibling = arg; - break; - } - case INSN_OP_PPADDR: /* 84 */ - { - strconst arg; - BGET_strconst(arg); - BSET_op_ppaddr(PL_op->op_ppaddr, arg); - break; - } - case INSN_OP_TARG: /* 85 */ - { - PADOFFSET arg; - BGET_U32(arg); - PL_op->op_targ = arg; - break; - } - case INSN_OP_TYPE: /* 86 */ - { - OPCODE arg; - BGET_U16(arg); - BSET_op_type(PL_op, arg); - break; - } - case INSN_OP_SEQ: /* 87 */ - { - U16 arg; - BGET_U16(arg); - PL_op->op_seq = arg; - break; - } - case INSN_OP_FLAGS: /* 88 */ - { - U8 arg; - BGET_U8(arg); - PL_op->op_flags = arg; - break; - } - case INSN_OP_PRIVATE: /* 89 */ - { - U8 arg; - BGET_U8(arg); - PL_op->op_private = arg; - break; - } - case INSN_OP_FIRST: /* 90 */ - { - opindex arg; - BGET_opindex(arg); - cUNOP->op_first = arg; - break; - } - case INSN_OP_LAST: /* 91 */ - { - opindex arg; - BGET_opindex(arg); - cBINOP->op_last = arg; - break; - } - case INSN_OP_OTHER: /* 92 */ - { - opindex arg; - BGET_opindex(arg); - cLOGOP->op_other = arg; - break; - } - case INSN_OP_TRUE: /* 93 */ - { - opindex arg; - BGET_opindex(arg); - cCONDOP->op_true = arg; - break; - } - case INSN_OP_FALSE: /* 94 */ - { - opindex arg; - BGET_opindex(arg); - cCONDOP->op_false = arg; - break; - } - case INSN_OP_CHILDREN: /* 95 */ - { - U32 arg; - BGET_U32(arg); - cLISTOP->op_children = arg; - break; - } - case INSN_OP_PMREPLROOT: /* 96 */ - { - opindex arg; - BGET_opindex(arg); - cPMOP->op_pmreplroot = arg; - break; - } - case INSN_OP_PMREPLROOTGV: /* 97 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&cPMOP->op_pmreplroot = arg; - break; - } - case INSN_OP_PMREPLSTART: /* 98 */ - { - opindex arg; - BGET_opindex(arg); - cPMOP->op_pmreplstart = arg; - break; - } - case INSN_OP_PMNEXT: /* 99 */ - { - opindex arg; - BGET_opindex(arg); - *(OP**)&cPMOP->op_pmnext = arg; - break; - } - case INSN_PREGCOMP: /* 100 */ - { - pvcontents arg; - BGET_pvcontents(arg); - BSET_pregcomp(PL_op, arg); - break; - } - case INSN_OP_PMFLAGS: /* 101 */ - { - U16 arg; - BGET_U16(arg); - cPMOP->op_pmflags = arg; - break; - } - case INSN_OP_PMPERMFLAGS: /* 102 */ - { - U16 arg; - BGET_U16(arg); - cPMOP->op_pmpermflags = arg; - break; - } - case INSN_OP_SV: /* 103 */ - { - svindex arg; - BGET_svindex(arg); - cSVOP->op_sv = arg; - break; - } - case INSN_OP_GV: /* 104 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&cGVOP->op_gv = arg; - break; - } - case INSN_OP_PV: /* 105 */ - { - pvcontents arg; - BGET_pvcontents(arg); - cPVOP->op_pv = arg; - break; - } - case INSN_OP_PV_TR: /* 106 */ - { - op_tr_array arg; - BGET_op_tr_array(arg); - cPVOP->op_pv = arg; - break; - } - case INSN_OP_REDOOP: /* 107 */ - { - opindex arg; - BGET_opindex(arg); - cLOOP->op_redoop = arg; - break; - } - case INSN_OP_NEXTOP: /* 108 */ - { - opindex arg; - BGET_opindex(arg); - cLOOP->op_nextop = arg; - break; - } - case INSN_OP_LASTOP: /* 109 */ - { - opindex arg; - BGET_opindex(arg); - cLOOP->op_lastop = arg; - break; - } - case INSN_COP_LABEL: /* 110 */ - { - pvcontents arg; - BGET_pvcontents(arg); - cCOP->cop_label = arg; - break; - } - case INSN_COP_STASH: /* 111 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&cCOP->cop_stash = arg; - break; - } - case INSN_COP_FILEGV: /* 112 */ - { - svindex arg; - BGET_svindex(arg); - *(SV**)&cCOP->cop_filegv = arg; - break; - } - case INSN_COP_SEQ: /* 113 */ - { - U32 arg; - BGET_U32(arg); - cCOP->cop_seq = arg; - break; - } - case INSN_COP_ARYBASE: /* 114 */ - { - I32 arg; - BGET_I32(arg); - cCOP->cop_arybase = arg; - break; - } - case INSN_COP_LINE: /* 115 */ - { - line_t arg; - BGET_U16(arg); - cCOP->cop_line = arg; - break; - } - case INSN_MAIN_START: /* 116 */ - { - opindex arg; - BGET_opindex(arg); - PL_main_start = arg; - break; - } - case INSN_MAIN_ROOT: /* 117 */ - { - opindex arg; - BGET_opindex(arg); - PL_main_root = arg; - break; - } - case INSN_CURPAD: /* 118 */ - { - svindex arg; - BGET_svindex(arg); - BSET_curpad(PL_curpad, arg); - break; - } - default: - croak("Illegal bytecode instruction %d\n", insn); - /* NOTREACHED */ - } - } -} diff --git a/contrib/perl5/byterun.h b/contrib/perl5/byterun.h deleted file mode 100644 index bd54c76e7635f..0000000000000 --- a/contrib/perl5/byterun.h +++ /dev/null @@ -1,184 +0,0 @@ -/* - * Copyright (c) 1996-1998 Malcolm Beattie - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - */ -/* - * This file is autogenerated from bytecode.pl. Changes made here will be lost. - */ -#ifdef INDIRECT_BGET_MACROS -struct bytestream { - void *data; - int (*fgetc)(void *); - int (*fread)(char *, size_t, size_t, void*); - void (*freadpv)(U32, void*); -}; -#endif /* INDIRECT_BGET_MACROS */ - -void *bset_obj_store _((void *, I32)); - -enum { - INSN_RET, /* 0 */ - INSN_LDSV, /* 1 */ - INSN_LDOP, /* 2 */ - INSN_STSV, /* 3 */ - INSN_STOP, /* 4 */ - INSN_LDSPECSV, /* 5 */ - INSN_NEWSV, /* 6 */ - INSN_NEWOP, /* 7 */ - INSN_NEWOPN, /* 8 */ - INSN_NEWPV, /* 9 */ - INSN_NOP, /* 10 */ - INSN_PV_CUR, /* 11 */ - INSN_PV_FREE, /* 12 */ - INSN_SV_UPGRADE, /* 13 */ - INSN_SV_REFCNT, /* 14 */ - INSN_SV_REFCNT_ADD, /* 15 */ - INSN_SV_FLAGS, /* 16 */ - INSN_XRV, /* 17 */ - INSN_XPV, /* 18 */ - INSN_XIV32, /* 19 */ - INSN_XIV64, /* 20 */ - INSN_XNV, /* 21 */ - INSN_XLV_TARGOFF, /* 22 */ - INSN_XLV_TARGLEN, /* 23 */ - INSN_XLV_TARG, /* 24 */ - INSN_XLV_TYPE, /* 25 */ - INSN_XBM_USEFUL, /* 26 */ - INSN_XBM_PREVIOUS, /* 27 */ - INSN_XBM_RARE, /* 28 */ - INSN_XFM_LINES, /* 29 */ - INSN_XIO_LINES, /* 30 */ - INSN_XIO_PAGE, /* 31 */ - INSN_XIO_PAGE_LEN, /* 32 */ - INSN_XIO_LINES_LEFT, /* 33 */ - INSN_XIO_TOP_NAME, /* 34 */ - INSN_COMMENT, /* 35 */ - INSN_XIO_TOP_GV, /* 36 */ - INSN_XIO_FMT_NAME, /* 37 */ - INSN_XIO_FMT_GV, /* 38 */ - INSN_XIO_BOTTOM_NAME, /* 39 */ - INSN_XIO_BOTTOM_GV, /* 40 */ - INSN_XIO_SUBPROCESS, /* 41 */ - INSN_XIO_TYPE, /* 42 */ - INSN_XIO_FLAGS, /* 43 */ - INSN_XCV_STASH, /* 44 */ - INSN_XCV_START, /* 45 */ - INSN_XCV_ROOT, /* 46 */ - INSN_XCV_GV, /* 47 */ - INSN_XCV_FILEGV, /* 48 */ - INSN_XCV_DEPTH, /* 49 */ - INSN_XCV_PADLIST, /* 50 */ - INSN_XCV_OUTSIDE, /* 51 */ - INSN_XCV_FLAGS, /* 52 */ - INSN_AV_EXTEND, /* 53 */ - INSN_AV_PUSH, /* 54 */ - INSN_XAV_FILL, /* 55 */ - INSN_XAV_MAX, /* 56 */ - INSN_XAV_FLAGS, /* 57 */ - INSN_XHV_RITER, /* 58 */ - INSN_XHV_NAME, /* 59 */ - INSN_HV_STORE, /* 60 */ - INSN_SV_MAGIC, /* 61 */ - INSN_MG_OBJ, /* 62 */ - INSN_MG_PRIVATE, /* 63 */ - INSN_MG_FLAGS, /* 64 */ - INSN_MG_PV, /* 65 */ - INSN_XMG_STASH, /* 66 */ - INSN_GV_FETCHPV, /* 67 */ - INSN_GV_STASHPV, /* 68 */ - INSN_GP_SV, /* 69 */ - INSN_GP_REFCNT, /* 70 */ - INSN_GP_REFCNT_ADD, /* 71 */ - INSN_GP_AV, /* 72 */ - INSN_GP_HV, /* 73 */ - INSN_GP_CV, /* 74 */ - INSN_GP_FILEGV, /* 75 */ - INSN_GP_IO, /* 76 */ - INSN_GP_FORM, /* 77 */ - INSN_GP_CVGEN, /* 78 */ - INSN_GP_LINE, /* 79 */ - INSN_GP_SHARE, /* 80 */ - INSN_XGV_FLAGS, /* 81 */ - INSN_OP_NEXT, /* 82 */ - INSN_OP_SIBLING, /* 83 */ - INSN_OP_PPADDR, /* 84 */ - INSN_OP_TARG, /* 85 */ - INSN_OP_TYPE, /* 86 */ - INSN_OP_SEQ, /* 87 */ - INSN_OP_FLAGS, /* 88 */ - INSN_OP_PRIVATE, /* 89 */ - INSN_OP_FIRST, /* 90 */ - INSN_OP_LAST, /* 91 */ - INSN_OP_OTHER, /* 92 */ - INSN_OP_TRUE, /* 93 */ - INSN_OP_FALSE, /* 94 */ - INSN_OP_CHILDREN, /* 95 */ - INSN_OP_PMREPLROOT, /* 96 */ - INSN_OP_PMREPLROOTGV, /* 97 */ - INSN_OP_PMREPLSTART, /* 98 */ - INSN_OP_PMNEXT, /* 99 */ - INSN_PREGCOMP, /* 100 */ - INSN_OP_PMFLAGS, /* 101 */ - INSN_OP_PMPERMFLAGS, /* 102 */ - INSN_OP_SV, /* 103 */ - INSN_OP_GV, /* 104 */ - INSN_OP_PV, /* 105 */ - INSN_OP_PV_TR, /* 106 */ - INSN_OP_REDOOP, /* 107 */ - INSN_OP_NEXTOP, /* 108 */ - INSN_OP_LASTOP, /* 109 */ - INSN_COP_LABEL, /* 110 */ - INSN_COP_STASH, /* 111 */ - INSN_COP_FILEGV, /* 112 */ - INSN_COP_SEQ, /* 113 */ - INSN_COP_ARYBASE, /* 114 */ - INSN_COP_LINE, /* 115 */ - INSN_MAIN_START, /* 116 */ - INSN_MAIN_ROOT, /* 117 */ - INSN_CURPAD, /* 118 */ - MAX_INSN = 118 -}; - -enum { - OPt_OP, /* 0 */ - OPt_UNOP, /* 1 */ - OPt_BINOP, /* 2 */ - OPt_LOGOP, /* 3 */ - OPt_CONDOP, /* 4 */ - OPt_LISTOP, /* 5 */ - OPt_PMOP, /* 6 */ - OPt_SVOP, /* 7 */ - OPt_GVOP, /* 8 */ - OPt_PVOP, /* 9 */ - OPt_LOOP, /* 10 */ - OPt_COP /* 11 */ -}; - -EXT int optype_size[] -#ifdef DOINIT -= { - sizeof(OP), - sizeof(UNOP), - sizeof(BINOP), - sizeof(LOGOP), - sizeof(CONDOP), - sizeof(LISTOP), - sizeof(PMOP), - sizeof(SVOP), - sizeof(GVOP), - sizeof(PVOP), - sizeof(LOOP), - sizeof(COP) -} -#endif /* DOINIT */ -; - -#define INIT_SPECIALSV_LIST STMT_START { \ - PL_specialsv_list[0] = Nullsv; \ - PL_specialsv_list[1] = &PL_sv_undef; \ - PL_specialsv_list[2] = &PL_sv_yes; \ - PL_specialsv_list[3] = &PL_sv_no; \ - } STMT_END diff --git a/contrib/perl5/eg/cgi/dna.small.gif.uu b/contrib/perl5/eg/cgi/dna.small.gif.uu deleted file mode 100644 index d3ce24c18dce9..0000000000000 --- a/contrib/perl5/eg/cgi/dna.small.gif.uu +++ /dev/null @@ -1,63 +0,0 @@ -begin 444 dna.small.gif -M1TE&.#=A)0`J`.<``+9%&Y@_&A$_5`Y#3$=2"=#59M((H88,GP\/]X^&+$R -M$"(79"DF33(93"$86=%;&"T4/=Y"&\\A$Q4Z4!`62*T4-Q4B9+X1*BH96SP? -M1<0D/3(F<-TM$!`=5:H.(!<64C$W?#8J3*`S(S<@3=8V%K$](QT.6Q`43AL4 -M1:$D,;<0,\X9&,8])\@=$A(U244S5U,D6Q=/#YH> -M08$I1B,09S$35R(:4C0?<19$75!()-;4702M`=;56)A`25,0K%"X< -M83`N>K`H'HDS*1`40,M&%!<@7M,_$AE+#%0>0S0/:4PJ9I,F-6DG420Y<"@09R,0 -M-V$R/R4M<:\H0!(H410Z:AT27&4Q9"L@;=1%(MA-$M5+#RL4+M8Z&AT<7[<: -M(-QA&2,36R$++B(84!0:5ALO:K$A.]X?&!$84V@;/SX<6Q`;2$(B2QD21W4J -M1=TW&@```````````````"P`````)0`J```(_@!]:(N'18\W%15T$1N'C)V? -M0_HH,<$G9YBX!C6<3;+T@AZ-)K@\O*"!KP^$>"KVA`L3*8P3)^5ZA)@B:AH+ -M9];F7.$Q+!`!0=*.%",&P7J"9XB82L5,48F5K,:" -M'94FU='6;!*R3T->E"%&95DR"`/6P,I0PDF)0SG8($$RJN0R`FI(H7$A2]VD -M*^^L_6(T3U*V%XH"_AB:HDS8H$AO5@R:P,8.I%^.:*AC(>Z!'":6RC`1L@W- -M%1Q/,%(.'5+1``/"*]=90`PD.F'3SR@-AG)`&_A=3'"**#[J(P<0^C0&S/#1""(ZI)'&*6,,$842N%Q!@3NK -M"R'%%4KP0D(Q?"`S!3)BVE(/$+)#-80 -M<+,`-[QH$LP+0_P!1C>=S("!,N>8XP<8H6131!B;3`#&#)"DTH(L5#P0S#W+ -MQ)*`$K1HHD4^;E!2QP%:B``&4H$,/Y2C$Y*(1%0(00A)@```77B"*$0@#3>P -MP&PU4`,^H!","P!!$')0P^H6((I5L"$'.;``';[Q!@-\PP"$0?)M$`<92!%OG8Q3#@(`U2C*)%9-!`&`K`!!EP0@80 -M2,0M;I$.:"C#"D.@P#UJ``]GT"*,K%B&*0+!@TFH8VV*0$(:_/`)?7@#'.'0 -M@R[H8``\:&`,=NC"*"B@!2TTHP5]N((TEH&`<)B"!PU`0RQ(P8MNS``9K6@% -M'W31AG%$(BZ2&((PA-&#'I"A&`F8!DD\\`H6-,.,X'B'%,+R#FX4`PS&_L!$ -M.4R0#7W<0@%O2,07$($#9@C3"%C8P!5H88\]J$,"-E!;(.X@C5T<`!65V,40 -M,'&(0C!"`1JP@"3TH`T9=&,5JRC$-]+1`U%TP@@[^,$>Z$&*0%1A%XFK`BFD -MX0L6Y"(#A_A$#[JPC@%\@1@02`(SJ#&&.`A@'\&$!AALX(4Y="`/TA"",UA! -M@%W<8!*\$`$@C%""+G1A"9AP!"<>9@ME*)$0F\C!$I8`B3\TP@%'@$(QH$`" -M)8@#'(B0ACB`P`,@%&,'9"##)S`1!&)\`0)^&,,^+$`("QC"#D\X!":HX0!< -ML(`&-O!%,&H@BS#F0AI'`!LO^"`,/OS!%KJ0_H0HEA`E27Q#%T%X0"%"@`1E -M2,`!:F!%+Q#A!G)40A!HP`4OFK`#-13#`?I(QCW38(Q/9&``%0#!);01BE>$ -M@!TZNL81$G`!-]2!&&5@A1N&T0Q<,$$$%*!``BR1A5$PPPH<74$%]*`#$.RA -M`(VP@#`X$(`7``(%T=@`.5Q`C@:0`P[)D$4'$H`."MB#"908Q=X@,01B9$(7 -MG'A%`#8!"QSL@PUAL,0==M"")CQCP4)0QQUDP806H&,!T]A!`EH@AC2P`P,^ -MT`,*NN%-&&T!&L@X!!Y^<(4.D(,%E>A`,T20C#IXL`6-:,`5F+"#!W"@'%OH -MA`IJ$5(#;`(;AV/'FA103(EV+(,>GHB&&ZJ`!D'P!57`X1F9D`4<0!]FB(F*(A55\BX%UEI^;OJ8N%(*Z^4G -M.OJJ>8HZ.(>;JRMD>X" -M%A1XSM]!A?T8/C0T$1XMJG\B&G+,"-&C/(VS0(842;`)M'S>_OE8F#"=2S#* -M8LHLAS'D1Y,42UGY9O,F-T:X@@JEE@D1RW>/D@8R.DZ-+*E0CQ:9JJ5JU!SQ -MR&BU2D.;E*4'ER0TNY%G2A/Y.G[=VG%81+5K_UG$21-GQW55;$8L\RW6J8-9>QM7<^A/SMZK!ESY$,+ -(KPA.EJ```#L` -end diff --git a/contrib/perl5/ext/B/byteperl.c b/contrib/perl5/ext/B/byteperl.c deleted file mode 100644 index 6b53e3b174a58..0000000000000 --- a/contrib/perl5/ext/B/byteperl.c +++ /dev/null @@ -1,110 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#ifndef PATCHLEVEL -#include "patchlevel.h" -#endif - -static void xs_init _((void)); -static PerlInterpreter *my_perl; - -int -#ifndef CAN_PROTOTYPE -main(argc, argv, env) -int argc; -char **argv; -char **env; -#else /* def(CAN_PROTOTYPE) */ -main(int argc, char **argv, char **env) -#endif /* def(CAN_PROTOTYPE) */ -{ - int exitstatus; - int i; - char **fakeargv; - FILE *fp; -#ifdef INDIRECT_BGET_MACROS - struct bytestream bs; -#endif /* INDIRECT_BGET_MACROS */ - - INIT_SPECIALSV_LIST; - PERL_SYS_INIT(&argc,&argv); - -#if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1) - perl_init_i18nl10n(1); -#else - perl_init_i18nl14n(1); -#endif - - if (!PL_do_undump) { - my_perl = perl_alloc(); - if (!my_perl) -#ifdef VMS - exit(vaxc$errno); -#else - exit(1); -#endif - perl_construct( my_perl ); - } - -#ifdef CSH - if (!PL_cshlen) - PL_cshlen = strlen(PL_cshname); -#endif - - if (argc < 2) - fp = stdin; - else { -#ifdef WIN32 - fp = fopen(argv[1], "rb"); -#else - fp = fopen(argv[1], "r"); -#endif - if (!fp) { - perror(argv[1]); -#ifdef VMS - exit(vaxc$errno); -#else - exit(1); -#endif - } - argv++; - argc--; - } - New(666, fakeargv, argc + 4, char *); - fakeargv[0] = argv[0]; - fakeargv[1] = "-e"; - fakeargv[2] = ""; - fakeargv[3] = "--"; - for (i = 1; i < argc; i++) - fakeargv[i + 3] = argv[i]; - fakeargv[argc + 3] = 0; - - exitstatus = perl_parse(my_perl, xs_init, argc + 3, fakeargv, NULL); - if (exitstatus) - exit( exitstatus ); - - sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]); - PL_main_cv = PL_compcv; - PL_compcv = 0; - -#ifdef INDIRECT_BGET_MACROS - bs.data = fp; - bs.fgetc = (int(*) _((void*)))fgetc; - bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread; - bs.freadpv = freadpv; - byterun(bs); -#else - byterun(fp); -#endif /* INDIRECT_BGET_MACROS */ - - exitstatus = perl_run( my_perl ); - - perl_destruct( my_perl ); - perl_free( my_perl ); - - exit( exitstatus ); -} - -static void -xs_init() -{ -} diff --git a/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs deleted file mode 100644 index b64ab3e345657..0000000000000 --- a/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs +++ /dev/null @@ -1,153 +0,0 @@ -/* dl_cygwin32.xs - * - * Platform: Win32 (Windows NT/Windows 95) - * Author: Wei-Yuen Tan (wyt@hip.com) - * Created: A warm day in June, 1995 - * - * Modified: - * August 23rd 1995 - rewritten after losing everything when I - * wiped off my NT partition (eek!) - */ -/* Modified from the original dl_win32.xs to work with cygwin32 - -John Cerney 3/26/97 -*/ -/* Porting notes: - -I merely took Paul's dl_dlopen.xs, took out extraneous stuff and -replaced the appropriate SunOS calls with the corresponding Win32 -calls. - -*/ - -#define WIN32_LEAN_AND_MEAN -// Defines from windows needed for this function only. Can't include full -// Cygwin32 windows headers because of problems with CONTEXT redefinition -// Removed logic to tell not dynamically load static modules. It is assumed that all -// modules are dynamically built. This should be similar to the behavoir on sunOS. -// Leaving in the logic would have required changes to the standard perlmain.c code -// -// // Includes call a dll function to initialize it's impure_ptr. -#include -void (*impure_setupptr)(struct _reent *); // pointer to the impure_setup routine - -//#include -#define LOAD_WITH_ALTERED_SEARCH_PATH (8) -typedef void *HANDLE; -typedef HANDLE HINSTANCE; -#define STDCALL __attribute__ ((stdcall)) -typedef int STDCALL (*FARPROC)(); - -HINSTANCE -STDCALL -LoadLibraryExA( - char* lpLibFileName, - HANDLE hFile, - unsigned int dwFlags - ); -unsigned int -STDCALL -GetLastError( - void - ); -FARPROC -STDCALL -GetProcAddress( - HINSTANCE hModule, - char* lpProcName - ); - -#include - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "dlutils.c" /* SaveError() etc */ - -static void -dl_private_init() -{ - (void)dl_generic_private_init(); -} - - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(); - -void * -dl_load_file(filename,flags=0) - char * filename - int flags - PREINIT: - CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); - - RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL){ - SaveError("%d",GetLastError()) ; - } - else{ - // setup the dll's impure_ptr: - impure_setupptr = GetProcAddress(RETVAL, "impure_setup"); - if( impure_setupptr == NULL){ - printf( - "Cygwin32 dynaloader error: could not load impure_setup symbol\n"); - RETVAL = NULL; - } - else{ - // setup the DLLs impure_ptr: - (*impure_setupptr)(_impure_ptr); - sv_setiv( ST(0), (IV)RETVAL); - } - } - - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError("%d",GetLastError()) ; - else - sv_setiv( ST(0), (IV)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 - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/hints/cygwin32.sh b/contrib/perl5/hints/cygwin32.sh deleted file mode 100644 index 5853499954a73..0000000000000 --- a/contrib/perl5/hints/cygwin32.sh +++ /dev/null @@ -1,50 +0,0 @@ -#! /bin/sh -# cygwin32.sh - hintsfile for building perl on Windows NT using the -# Cygnus Win32 Development Kit. -# See "http://www.cygnus.com/misc/gnu-win32/" to learn about the kit. -# -path_sep=\; -exe_ext='.exe' -firstmakefile='GNUmakefile' -if test -f $sh.exe; then sh=$sh.exe; fi -startsh="#!$sh" -cc='gcc2' -ld='ld2' -usrinc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/include' -libpth='/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib /gnuwin32/H-i386-cygwin32/lib' -libs='-lcygwin -lm -lc -lkernel32' -# dynamic lib stuff -so='dll' -#i_dlfcn='define' -dlsrc='dl_cygwin32.xs' -usedl='y' -# flag to include the perl.exe export variable translation file cw32imp.h -# when building extension libs -cccdlflags='-DCYGWIN32 -DDLLIMPORT ' -# flag that signals gcc2 to build exportable perl -ccdlflags='-buildperl ' -lddlflags='-L../.. -L/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib -lperlexp -lcygwin' -d_voidsig='undef' -extensions='Fcntl IO Opcode SDBM_File' -lns='cp' -signal_t='int' -useposix='false' -rd_nodata='0' -eagain='EAGAIN' -archname='cygwin32' -# - -installbin='/usr/local/bin' -installman1dir='' -installman3dir='' -installprivlib='/usr/local/lib/perl5' -installscript='/usr/local/bin' - -installsitelib='/usr/local/lib/perl5/site_perl' -libc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib/libc.a' - -perlpath='/usr/local/bin/perl' - -sitelib='/usr/local/lib/perl5/site_perl' -sitelibexp='/usr/local/lib/perl5/site_perl' -usrinc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/include' diff --git a/contrib/perl5/interp.sym b/contrib/perl5/interp.sym deleted file mode 100644 index fbbe2a7c9c63d..0000000000000 --- a/contrib/perl5/interp.sym +++ /dev/null @@ -1,211 +0,0 @@ -Argv -Cmd -DBcv -DBgv -DBline -DBsignal -DBsingle -DBsub -DBtrace -ampergv -archpat_auto -argvgv -argvoutgv -basetime -beginav -bodytarget -bostr -cddir -chopset -colors -colorset -compcv -compiling -comppad -comppad_name -comppad_name_fill -comppad_name_floor -copline -curcop -curcopdb -curpm -curstack -curstash -curstname -dbargs -debdelim -debname -debstash -defgv -defoutgv -defstash -delaymagic -diehook -dirty -dlevel -dlmax -doextract -doswitches -dowarn -dumplvl -e_script -endav -envgv -errgv -eval_root -eval_start -exitlist -exitlistlen -extralen -fdpid -filemode -firstgv -forkprocess -formfeed -formtarget -generation -gensym -globalstash -hintgv -in_clean_all -in_clean_objs -in_eval -incgv -initav -inplace -bytecode_iv_overflows -sys_intern -last_in_gv -last_proto -lastfd -lastgotoprobe -lastscream -lastsize -lastspbase -laststatval -laststype -leftgv -lineary -linestart -localizing -localpatches -main_cv -main_root -main_start -mainstack -maxscream -maxsysfd -mess_sv -minus_F -minus_a -minus_c -minus_l -minus_n -minus_p -modglobal -modcount -multiline -mystrk -nrs -bytecode_obj_list -bytecode_obj_list_fill -ofmt -ofs -ofslen -oldlastpm -oldname -op_mask -origargc -origargv -origfilename -ors -orslen -parsehook -patchlevel -pending_ident -perldb -perl_destruct_level -preambled -preambleav -preprocess -profiledata -bytecode_pv -reg_eval_set -reg_flags -reg_start_tmp -reg_start_tmpl -regbol -regcc -regcode -regcompp -regexecp -regdata -regdummy -regendp -regeol -regflags -regindent -reginput -reginterp_cnt -reglastparen -regnarrate -regnaughty -regnpar -regcomp_parse -regprecomp -regprev -regprogram -regsawback -regseen -regsize -regstartp -regtill -regxend -replgv -restartop -rightgv -rs -rsfp -rsfp_filters -regcomp_rx -sawampersand -sawstudy -sawvec -screamfirst -screamnext -secondgv -seen_zerolen -seen_evals -siggv -sortcop -sortcxix -sortstash -splitstr -start_env -statcache -statgv -statname -statusvalue -statusvalue_vms -stdingv -strchop -strtab -sub_generation -sublex_info -bytecode_sv -sv_count -sv_objcount -sv_root -sv_arenaroot -tainted -tainting -threadnum -thrsv -tmps_floor -tmps_ix -tmps_max -tmps_stack -top_env -toptarget -unsafe -warnhook diff --git a/contrib/perl5/lib/Sys/Hostname.pm b/contrib/perl5/lib/Sys/Hostname.pm deleted file mode 100644 index 95f9a99a7abf2..0000000000000 --- a/contrib/perl5/lib/Sys/Hostname.pm +++ /dev/null @@ -1,121 +0,0 @@ -package Sys::Hostname; - -use Carp; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(hostname); - -=head1 NAME - -Sys::Hostname - Try every conceivable way to get hostname - -=head1 SYNOPSIS - - use Sys::Hostname; - $host = hostname; - -=head1 DESCRIPTION - -Attempts several methods of getting the system hostname and -then caches the result. It tries C, -C<`hostname`>, C<`uname -n`>, and the file F. -If all that fails it Cs. - -All nulls, returns, and newlines are removed from the result. - -=head1 AUTHOR - -David Sundstrom EFE - -Texas Instruments - -=cut - -sub hostname { - - # method 1 - we already know it - return $host if defined $host; - - if ($^O eq 'VMS') { - - # method 2 - no sockets ==> return DECnet node name - eval { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] }; - if ($@) { return $host = $ENV{'SYS$NODE'}; } - - # method 3 - has someone else done the job already? It's common for the - # TCP/IP stack to advertise the hostname via a logical name. (Are - # there any other logicals which TCP/IP stacks use for the host name?) - $host = $ENV{'ARPANET_HOST_NAME'} || $ENV{'INTERNET_HOST_NAME'} || - $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'} || - $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'}; - return $host if $host; - - # method 4 - does hostname happen to work? - my($rslt) = `hostname`; - if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; } - return $host if $host; - - # rats! - $host = ''; - Carp::croak "Cannot get host name of local machine"; - - } - elsif ($^O eq 'MSWin32') { - ($host) = gethostbyname('localhost'); - chomp($host = `hostname 2> NUL`) unless defined $host; - return $host; - } - else { # Unix - - # method 2 - syscall is preferred since it avoids tainting problems - eval { - local $SIG{__DIE__}; - { - package main; - require "syscall.ph"; - } - $host = "\0" x 65; ## preload scalar - syscall(&main::SYS_gethostname, $host, 65) == 0; - } - - # method 2a - syscall using systeminfo instead of gethostname - # -- needed on systems like Solaris - || eval { - local $SIG{__DIE__}; - { - package main; - require "sys/syscall.ph"; - require "sys/systeminfo.ph"; - } - $host = "\0" x 65; ## preload scalar - syscall(&main::SYS_systeminfo, &main::SI_HOSTNAME, $host, 65) != -1; - } - - # method 3 - trusty old hostname command - || eval { - local $SIG{__DIE__}; - $host = `(hostname) 2>/dev/null`; # bsdish - } - - # method 4 - sysV uname command (may truncate) - || eval { - local $SIG{__DIE__}; - $host = `uname -n 2>/dev/null`; ## sysVish - } - - # method 5 - Apollo pre-SR10 - || eval { - local $SIG{__DIE__}; - ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); - } - - # bummer - || Carp::croak "Cannot get host name of local machine"; - - # remove garbage - $host =~ tr/\0\r\n//d; - $host; - } -} - -1; diff --git a/contrib/perl5/lib/Sys/Syslog.pm b/contrib/perl5/lib/Sys/Syslog.pm deleted file mode 100644 index e8faac71262ec..0000000000000 --- a/contrib/perl5/lib/Sys/Syslog.pm +++ /dev/null @@ -1,276 +0,0 @@ -package Sys::Syslog; -require 5.000; -require Exporter; -use Carp; - -@ISA = qw(Exporter); -@EXPORT = qw(openlog closelog setlogmask syslog); -@EXPORT_OK = qw(setlogsock); - -use Socket; -use Sys::Hostname; - -# adapted from syslog.pl -# -# Tom Christiansen -# modified to use sockets by Larry Wall -# NOTE: openlog now takes three arguments, just like openlog(3) -# Modified to add UNIX domain sockets by Sean Robinson -# with support from Tim Bunce and the perl5-porters mailing list - -# Todo: enable connect to try all three types before failing (auto setlogsock)? - -=head1 NAME - -Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls - -=head1 SYNOPSIS - - use Sys::Syslog; # all except setlogsock, or: - use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock - - setlogsock $sock_type; - openlog $ident, $logopt, $facility; - syslog $priority, $format, @args; - $oldmask = setlogmask $mask_priority; - closelog; - -=head1 DESCRIPTION - -Sys::Syslog is an interface to the UNIX C program. -Call C with a string priority and a list of C args -just like C. - -Syslog provides the functions: - -=over - -=item openlog $ident, $logopt, $facility - -I<$ident> is prepended to every message. -I<$logopt> contains zero or more of the words I, I, I, I. -I<$facility> specifies the part of the system - -=item syslog $priority, $format, @args - -If I<$priority> permits, logs I<($format, @args)> -printed as by C, with the addition that I<%m> -is replaced with C<"$!"> (the latest error message). - -=item setlogmask $mask_priority - -Sets log mask I<$mask_priority> and returns the old mask. - -=item setlogsock $sock_type (added in 5.004_02) - -Sets the socket type to be used for the next call to -C or C and returns TRUE on success, -undef on failure. - -A value of 'unix' will connect to the UNIX domain socket returned by -C<_PATH_LOG> in F. A value of 'inet' will connect to an -INET socket returned by getservbyname(). Any other value croaks. - -The default is for the INET socket to be used. - -=item closelog - -Closes the log file. - -=back - -Note that C now takes three arguments, just like C. - -=head1 EXAMPLES - - openlog($program, 'cons,pid', 'user'); - syslog('info', 'this is another test'); - syslog('mail|warning', 'this is a better test: %d', time); - closelog(); - - syslog('debug', 'this is the last test'); - - setlogsock('unix'); - openlog("$program $$", 'ndelay', 'user'); - syslog('notice', 'fooprogram: this is really done'); - - setlogsock('inet'); - $! = 55; - syslog('info', 'problem was %m'); # %m == $! in syslog(3) - -=head1 DEPENDENCIES - -B needs F, which can be created with C. - -=head1 SEE ALSO - -L - -=head1 AUTHOR - -Tom Christiansen EFE and Larry Wall EFE. -UNIX domain sockets added by Sean Robinson EFE -with support from Tim Bunce and the perl5-porters mailing list. - -=cut - -require 'syslog.ph'; - -$maskpri = &LOG_UPTO(&LOG_DEBUG); - -sub openlog { - ($ident, $logopt, $facility) = @_; # package vars - $lo_pid = $logopt =~ /\bpid\b/; - $lo_ndelay = $logopt =~ /\bndelay\b/; - $lo_cons = $logopt =~ /\bcons\b/; - $lo_nowait = $logopt =~ /\bnowait\b/; - &connect if $lo_ndelay; -} - -sub closelog { - $facility = $ident = ''; - &disconnect; -} - -sub setlogmask { - local($oldmask) = $maskpri; - $maskpri = shift; - $oldmask; -} - -sub setlogsock { - local($setsock) = shift; - &disconnect if $connected; - if (lc($setsock) eq 'unix') { - if (defined &_PATH_LOG) { - $sock_type = 1; - } else { - return undef; - } - } elsif (lc($setsock) eq 'inet') { - if (getservbyname('syslog','udp')) { - undef($sock_type); - } else { - return undef; - } - } else { - croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'"; - } - return 1; -} - -sub syslog { - local($priority) = shift; - local($mask) = shift; - local($message, $whoami); - local(@words, $num, $numpri, $numfac, $sum); - local($facility) = $facility; # may need to change temporarily. - - croak "syslog: expected both priority and mask" unless $mask && $priority; - - @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility". - undef $numpri; - undef $numfac; - foreach (@words) { - $num = &xlate($_); # Translate word to number. - if (/^kern$/ || $num < 0) { - croak "syslog: invalid level/facility: $_"; - } - elsif ($num <= &LOG_PRIMASK) { - croak "syslog: too many levels given: $_" if defined($numpri); - $numpri = $num; - return 0 unless &LOG_MASK($numpri) & $maskpri; - } - else { - croak "syslog: too many facilities given: $_" if defined($numfac); - $facility = $_; - $numfac = $num; - } - } - - croak "syslog: level must be given" unless defined($numpri); - - if (!defined($numfac)) { # Facility not specified in this call. - $facility = 'user' unless $facility; - $numfac = &xlate($facility); - } - - &connect unless $connected; - - $whoami = $ident; - - if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) { - $whoami = $1; - $mask = $2; - } - - unless ($whoami) { - ($whoami = getlogin) || - ($whoami = getpwuid($<)) || - ($whoami = 'syslog'); - } - - $whoami .= "[$$]" if $lo_pid; - - $mask =~ s/%m/$!/g; - $mask .= "\n" unless $mask =~ /\n$/; - $message = sprintf ($mask, @_); - - $sum = $numpri + $numfac; - unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) { - if ($lo_cons) { - if ($pid = fork) { - unless ($lo_nowait) { - $died = waitpid($pid, 0); - } - } - else { - open(CONS,">/dev/console"); - print CONS "<$facility.$priority>$whoami: $message\r"; - exit if defined $pid; # if fork failed, we're parent - close CONS; - } - } - } -} - -sub xlate { - local($name) = @_; - $name = uc $name; - $name = "LOG_$name" unless $name =~ /^LOG_/; - $name = "Sys::Syslog::$name"; - defined &$name ? &$name : -1; -} - -sub connect { - unless ($host) { - require Sys::Hostname; - my($host_uniq) = Sys::Hostname::hostname(); - ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) - } - unless ( $sock_type ) { - my $udp = getprotobyname('udp'); - my $syslog = getservbyname('syslog','udp'); - my $this = sockaddr_in($syslog, INADDR_ANY); - my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); - socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; - connect(SYSLOG,$that) || croak "connect: $!"; - } else { - my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph"; - my $that = sockaddr_un($syslog) || croak "Can't locate $syslog"; - socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!"; - if (!connect(SYSLOG,$that)) { - socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!"; - connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)"; - } - } - local($old) = select(SYSLOG); $| = 1; select($old); - $connected = 1; -} - -sub disconnect { - close SYSLOG; - $connected = 0; -} - -1; diff --git a/contrib/perl5/myconfig b/contrib/perl5/myconfig deleted file mode 100755 index c143aea6e8d5c..0000000000000 --- a/contrib/perl5/myconfig +++ /dev/null @@ -1,43 +0,0 @@ -#!/bin/sh - -# This script is designed to provide a handy summary of the configuration -# information being used to build perl. This is especially useful if you -# are requesting help from comp.lang.perl.misc on usenet or via mail. - -if test -f config.sh; then TOP=.; -elif test -f ../config.sh; then TOP=..; -elif test -f ../../config.sh; then TOP=../..; -elif test -f ../../../config.sh; then TOP=../../..; -elif test -f ../../../../config.sh; then TOP=../../../..; -else - echo "Can't find the perl config.sh file produced by Configure"; exit 1 -fi -. $TOP/config.sh - -# Note that the text lines /^Summary of/ .. /^\s*$/ are copied into Config.pm. - -$spitshell < -# -# Updated: 1997-8 Jarkko Hietaniemi -# -# Create the export list for perl. -# Needed by AIX to do dynamic linking. -# -# This simple program relies on 'global.sym' and few other *.sym files -# and the *var*.h files being up to date with all of the global -# symbols that a dynamic link library might want to access. -# -# Most symbols have a Perl_ or PL_prefix because that's what embed.h -# sticks in front of them. -# -# AIX requires the list of external symbols (variables or functions) -# that are made available for another executable object file the import. -# The list is called the export file and it is a simple text file. -# The first line must be -#! -# That is, hash-bang, pound-shout, however you want to call it. -# The remainder of the file are the names of the symbols, one per line. -# The file is then given to the system loader (cc/xlc command line) -# as -bE:export.file. - -case $CONFIG in -'') - if test -f config.sh; then TOP=.; - elif test -f ../config.sh; then TOP=..; - elif test -f ../../config.sh; then TOP=../..; - elif test -f ../../../config.sh; then TOP=../../..; - elif test -f ../../../../config.sh; then TOP=../../../..; - else - echo "Can't find config.sh."; exit 1 - fi - . $TOP/config.sh - ;; -esac -: This forces SH files to create target in same directory as SH file. -: This is so that make depend always knows where to find SH derivatives. -case "$0" in -*/*) cd `expr X$0 : 'X\(.*\)/'` ;; -esac - -echo "Extracting perl.exp" - -rm -f perl.exp -echo "#!" > perl.exp - -# No compat3 since 5.004_50. -# No interp.sym since 5.005_03. -# perlio.sym will added later if needed. - -syms="global.sym thread.sym" - -sed -n '/^[A-Za-z]/ s/^/Perl_/p' $syms >> perl.exp - -sed -n 's/^PERLVAR.*(G\([^[,]*\).*/PL_\1/p' perlvars.h >> perl.exp -sed -n 's/^PERLVAR.*(I\([^[,]*\).*/PL_\1/p' intrpvar.h >> perl.exp -sed -n 's/^PERLVAR.*(T\([^[,]*\).*/PL_\1/p' thrdvar.h >> perl.exp - -# -# If we use the PerlIO abstraction layer, add its symbols. -# - -if [ $useperlio = "define" ] -then - grep '^[A-Za-z]' perlio.sym >> perl.exp -fi - -# -# Extra globals not included above (including a few that might -# not actually be defined, but there's no harm in that). -# - -cat >> perl.exp <>perl.exp <>perl.exp < 3; -} -$| = 1; -print "1..14\n"; -use Thread; -print "ok 1\n"; - -sub content -{ - print shift; - return shift; -} - -# create a thread passing args and immedaietly wait for it. -my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000); -print $t->join; - -# check that lock works ... -{lock $foo; - $t = new Thread sub { lock $foo; print "ok 5\n" }; - print "ok 4\n"; -} -$t->join; - -sub dorecurse -{ - my $val = shift; - my $ret; - print $val; - if (@_) - { - $ret = Thread->new(\&dorecurse, @_); - $ret->join; - } -} - -$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10; -$t->join; - -# test that sleep lets other thread run -$t = new Thread \&dorecurse,"ok 11\n"; -sleep 6; -print "ok 12\n"; -$t->join; - -sub islocked -{ - use attrs 'locked'; - my $val = shift; - my $ret; - print $val; - if (@_) - { - $ret = Thread->new(\&islocked, shift); - } - $ret; -} - -$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n"); -$t->join->join; - diff --git a/contrib/perl5/t/op/nothread.t b/contrib/perl5/t/op/nothread.t deleted file mode 100755 index a0d444d90b312..0000000000000 --- a/contrib/perl5/t/op/nothread.t +++ /dev/null @@ -1,35 +0,0 @@ -#!./perl - -# NOTE: Please don't add tests to this file unless they *need* to be run in -# separate executable and can't simply use eval. - -BEGIN - { - chdir 't' if -d 't'; - @INC = "../lib"; - require Config; - import Config; - if ($Config{'usethreads'}) - { - print "1..0\n"; - exit 0; - } - } - - -$|=1; - -print "1..9\n"; -$t = 1; -sub foo { local(@_) = ('p', 'q', 'r'); } -sub bar { unshift @_, 'D'; @_ } -sub baz { push @_, 'E'; return @_ } -for (1..3) - { - print "not " unless join('',foo('a', 'b', 'c')) eq 'pqr'; - print "ok ",$t++,"\n"; - print "not" unless join('',bar('d')) eq 'Dd'; - print "ok ",$t++,"\n"; - print "not" unless join('',baz('e')) eq 'eE'; - print "ok ",$t++,"\n"; - } diff --git a/contrib/perl5/t/pragma/warn-1global b/contrib/perl5/t/pragma/warn-1global deleted file mode 100644 index a7ca6070778c2..0000000000000 --- a/contrib/perl5/t/pragma/warn-1global +++ /dev/null @@ -1,159 +0,0 @@ -Check existing $^W functionality - -__END__ - -# warnable code, warnings disabled -$a =+ 3 ; -EXPECT - -######## --w -# warnable code, warnings enabled via command line switch -$a =+ 3 ; -EXPECT -Reversed += operator at - line 3. -Name "main::a" used only once: possible typo at - line 3. -######## -#! perl -w -# warnable code, warnings enabled via #! line -$a =+ 3 ; -EXPECT -Reversed += operator at - line 3. -Name "main::a" used only once: possible typo at - line 3. -######## - -# warnable code, warnings enabled via compile time $^W -BEGIN { $^W = 1 } -$a =+ 3 ; -EXPECT -Reversed += operator at - line 4. -Name "main::a" used only once: possible typo at - line 4. -######## - -# compile-time warnable code, warnings enabled via runtime $^W -# so no warning printed. -$^W = 1 ; -$a =+ 3 ; -EXPECT - -######## - -# warnable code, warnings enabled via runtime $^W -$^W = 1 ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 4. -######## - -# warnings enabled at compile time, disabled at run time -BEGIN { $^W = 1 } -$^W = 0 ; -my $b ; chop $b ; -EXPECT - -######## - -# warnings disabled at compile time, enabled at run time -BEGIN { $^W = 0 } -$^W = 1 ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 5. -######## --w ---FILE-- abcd -my $b ; chop $b ; -1 ; ---FILE-- -require "./abcd"; -EXPECT -Use of uninitialized value at ./abcd line 1. -######## - ---FILE-- abcd -my $b ; chop $b ; -1 ; ---FILE-- -#! perl -w -require "./abcd"; -EXPECT -Use of uninitialized value at ./abcd line 1. -######## - ---FILE-- abcd -my $b ; chop $b ; -1 ; ---FILE-- -$^W =1 ; -require "./abcd"; -EXPECT -Use of uninitialized value at ./abcd line 1. -######## - ---FILE-- abcd -$^W = 0; -my $b ; chop $b ; -1 ; ---FILE-- -$^W =1 ; -require "./abcd"; -EXPECT - -######## - ---FILE-- abcd -$^W = 1; -1 ; ---FILE-- -$^W =0 ; -require "./abcd"; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 3. -######## - -$^W = 1; -eval "my $b ; chop $b ;" ; -EXPECT -Use of uninitialized value at - line 3. -Use of uninitialized value at - line 3. -######## - -eval "$^W = 1;" ; -my $b ; chop $b ; -EXPECT - -######## - -eval {$^W = 1;} ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 3. -######## - -{ - local ($^W) = 1; -} -my $b ; chop $b ; -EXPECT - -######## - -my $a ; chop $a ; -{ - local ($^W) = 1; - my $b ; chop $b ; -} -my $c ; chop $c ; -EXPECT -Use of uninitialized value at - line 5. -######## --w --e undef -EXPECT -Use of uninitialized value at - line 2. -######## -BEGIN { $^W = 1 } -for (@{[0]}) { "$_" } # check warning isn't duplicated -EXPECT -Useless use of string in void context at - line 2. diff --git a/contrib/perl5/t/pragma/warning.t b/contrib/perl5/t/pragma/warning.t deleted file mode 100755 index 35d9d485e7606..0000000000000 --- a/contrib/perl5/t/pragma/warning.t +++ /dev/null @@ -1,113 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - $ENV{PERL5LIB} = '../lib'; - require Config; import Config; -} - -$| = 1; - -my $Is_VMS = $^O eq 'VMS'; -my $Is_MSWin32 = $^O eq 'MSWin32'; -my $tmpfile = "tmp0000"; -my $i = 0 ; -1 while -f ++$tmpfile; -END { if ($tmpfile) { 1 while unlink $tmpfile} } - -my @prgs = () ; - -foreach (sort glob("pragma/warn-*")) { - - next if /\.orig$/ ; - - next if /(~|\.orig)$/; - - open F, "<$_" or die "Cannot open $_: $!\n" ; - while () { - last if /^__END__/ ; - } - - { - local $/ = undef; - @prgs = (@prgs, split "\n########\n", ) ; - } - close F ; -} - -undef $/; - -print "1..", scalar @prgs, "\n"; - - -for (@prgs){ - my $switch = ""; - my @temps = () ; - if (s/^\s*-\w+//){ - $switch = $&; - $switch =~ s/(-\S*[A-Z]\S*)/"-$1"/ if $Is_VMS; # protect uc switches - } - my($prog,$expected) = split(/\nEXPECT\n/, $_); - if ( $prog =~ /--FILE--/) { - my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ; - shift @files ; - die "Internal error test $i didn't split into pairs, got " . - scalar(@files) . "[" . join("%%%%", @files) ."]\n" - if @files % 2 ; - while (@files > 2) { - my $filename = shift @files ; - my $code = shift @files ; - push @temps, $filename ; - open F, ">$filename" or die "Cannot open $filename: $!\n" ; - print F $code ; - close F ; - } - shift @files ; - $prog = shift @files ; - } - open TEST, ">$tmpfile"; - print TEST $prog,"\n"; - close TEST; - my $results = $Is_VMS ? - `MCR $^X $switch $tmpfile` : - $Is_MSWin32 ? - `.\\perl -I../lib $switch $tmpfile 2>&1` : - `sh -c './perl $switch $tmpfile' 2>&1`; - my $status = $?; - $results =~ s/\n+$//; - # allow expected output to be written as if $prog is on STDIN - $results =~ s/tmp\d+/-/g; - $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg -# bison says 'parse error' instead of 'syntax error', -# various yaccs may or may not capitalize 'syntax'. - $results =~ s/^(syntax|parse) error/syntax error/mig; - $expected =~ s/\n+$//; - my $prefix = ($results =~ s/^PREFIX\n//) ; - # any special options? (OPTIONS foo bar zap) - my $option_regex = 0; - if ($expected =~ s/^OPTIONS? (.+)\n//) { - foreach my $option (split(' ', $1)) { - if ($option eq 'regex') { # allow regular expressions - $option_regex = 1; - } else { - die "$0: Unknown OPTION '$option'\n"; - } - } - } - if ( $results =~ s/^SKIPPED\n//) { - print "$results\n" ; - } - elsif (($prefix && (( $option_regex && $results !~ /^$expected/) || - (!$option_regex && $results !~ /^\Q$expected/))) or - (!$prefix && (( $option_regex && $results !~ /^$expected/) || - (!$option_regex && $results ne $expected)))) { - print STDERR "PROG: $switch\n$prog\n"; - print STDERR "EXPECTED:\n$expected\n"; - print STDERR "GOT:\n$results\n"; - print "not "; - } - print "ok ", ++$i, "\n"; - foreach (@temps) - { unlink $_ if $_ } -} diff --git a/contrib/perl5/thread.sym b/contrib/perl5/thread.sym deleted file mode 100644 index 1e0ca6a5f2c37..0000000000000 --- a/contrib/perl5/thread.sym +++ /dev/null @@ -1 +0,0 @@ -# -- cgit v1.2.3