On Sat, 24 Oct 1998, "Felix S. Gallo" <[EMAIL PROTECTED]> wrote: > Chip writes: > >According to Felix S. Gallo: > >> 1. Describe the goal. I don't believe Perl can be usefully rewritten in > >> C++ [*] before the next Perl conference in any case [...] > > > >Yes, that's the target. > >> [*] as if > >We shall see. (Were I a betting man I'd clean up. :-)) > > Never bet against a British pedant -- I can always win by redefining > usefully. For my current claim, I think 'usefully' means that it's written > in C++ style; Perl is right now written in C++ if you make a few > minor changes. Below are those minor changes (with gratuitous Linux dependencies), for anyone wishing to play around. I'm interested in Joel Spolsky's article, <URL:http://joel.editthispage.com/stories/storyReader$47>, on not rewriting big programs from scratch. Apologies for straying from the path. :-) -John This is not a proper patch and requires care and feeding. Here is how I apply it, more or less: cd perl-5.6.0 chmod u+w hints/linux.sh echo timetype=time_t >> hints/linux.sh ./Configure -ds !patch -p0 < patchfile make all test Then do stuff like this until it's Perl 6: inline NV& sv::NVX () { return ((XPVNV*)sv_any)->xnv_nv; } #define SvNVX(sv) ((sv)->NVX()) --- gv.h~ Sun Feb 6 14:32:59 2000 +++ gv.h Sun Jun 25 11:17:29 2000 @@ -19,7 +19,7 @@ U32 gp_cvgen; /* generational validity of cached gv_cv */ U32 gp_flags; /* XXX unused */ line_t gp_line; /* line first declared at (for -w) */ - char * gp_file; /* file first declared in (for -w) */ + const char *gp_file; /* file first declared in (for -w) */ }; #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) --- gv.c~ Tue Mar 21 00:28:10 2000 +++ gv.c Sun Jun 25 01:22:20 2000 @@ -982,7 +982,7 @@ gv_check(hv); /* nested package */ } else if (isALPHA(*HeKEY(entry))) { - char *file; + const char *file; gv = (GV*)HeVAL(entry); if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) continue; --- mg.c~ Fri Mar 17 20:24:04 2000 +++ mg.c Sun Jun 25 11:54:19 2000 @@ -21,6 +21,10 @@ # include <unistd.h> #endif +#ifdef I_GRP +# include <grp.h> +#endif + #if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) # ifndef NGROUPS # define NGROUPS 32 @@ -688,9 +692,7 @@ break; case '~': s = IoFMT_NAME(GvIOp(PL_defoutgv)); - if (!s) - s = GvENAME(PL_defoutgv); - sv_setpv(sv,s); + sv_setpv(sv,s ? s : GvENAME(PL_defoutgv)); break; #ifndef lint case '=': --- pp_hot.c~ Fri Mar 17 22:11:42 2000 +++ pp_hot.c Sun Jun 25 10:10:29 2000 @@ -836,60 +836,52 @@ } if (PL_delaymagic & ~DM_DELAY) { if (PL_delaymagic & DM_UID) { -#ifdef HAS_SETRESUID - (void)setresuid(PL_uid,PL_euid,(Uid_t)-1); -#else -# ifdef HAS_SETREUID +#ifdef HAS_SETREUID (void)setreuid(PL_uid,PL_euid); -# else -# ifdef HAS_SETRUID +#else +# ifdef HAS_SETRUID if ((PL_delaymagic & DM_UID) == DM_RUID) { (void)setruid(PL_uid); PL_delaymagic &= ~DM_RUID; } -# endif /* HAS_SETRUID */ -# ifdef HAS_SETEUID +# endif /* HAS_SETRUID */ +# ifdef HAS_SETEUID if ((PL_delaymagic & DM_UID) == DM_EUID) { (void)seteuid(PL_uid); PL_delaymagic &= ~DM_EUID; } -# endif /* HAS_SETEUID */ +# endif /* HAS_SETEUID */ if (PL_delaymagic & DM_UID) { if (PL_uid != PL_euid) DIE(aTHX_ "No setreuid available"); (void)PerlProc_setuid(PL_uid); } -# endif /* HAS_SETREUID */ -#endif /* HAS_SETRESUID */ +#endif /* HAS_SETREUID */ PL_uid = PerlProc_getuid(); PL_euid = PerlProc_geteuid(); } if (PL_delaymagic & DM_GID) { -#ifdef HAS_SETRESGID - (void)setresgid(PL_gid,PL_egid,(Gid_t)-1); -#else -# ifdef HAS_SETREGID +#ifdef HAS_SETREGID (void)setregid(PL_gid,PL_egid); -# else -# ifdef HAS_SETRGID +#else +# ifdef HAS_SETRGID if ((PL_delaymagic & DM_GID) == DM_RGID) { (void)setrgid(PL_gid); PL_delaymagic &= ~DM_RGID; } -# endif /* HAS_SETRGID */ -# ifdef HAS_SETEGID +# endif /* HAS_SETRGID */ +# ifdef HAS_SETEGID if ((PL_delaymagic & DM_GID) == DM_EGID) { (void)setegid(PL_gid); PL_delaymagic &= ~DM_EGID; } -# endif /* HAS_SETEGID */ +# endif /* HAS_SETEGID */ if (PL_delaymagic & DM_GID) { if (PL_gid != PL_egid) DIE(aTHX_ "No setregid available"); (void)PerlProc_setgid(PL_gid); } -# endif /* HAS_SETREGID */ -#endif /* HAS_SETRESGID */ +#endif /* HAS_SETREGID */ PL_gid = PerlProc_getgid(); PL_egid = PerlProc_getegid(); } --- sv.c~ Wed Mar 22 21:44:37 2000 +++ sv.c Sun Jun 25 11:55:29 2000 @@ -15,6 +15,11 @@ #define PERL_IN_SV_C #include "perl.h" +/* XXX If this causes problems, set i_unistd=undef in the hint file. */ +#ifdef I_UNISTD +#include <unistd.h> +#endif + #define FCALL *f #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv) @@ -2540,7 +2545,7 @@ if (dtype <= SVt_PVGV) { glob_assign: if (dtype != SVt_PVGV) { - char *name = GvNAME(sstr); + const char *name = GvNAME(sstr); STRLEN len = GvNAMELEN(sstr); sv_upgrade(dstr, SVt_PVGV); sv_magic(dstr, dstr, '*', name, len); --- pp_sys.c~ Sun Mar 19 02:18:10 2000 +++ pp_sys.c Sun Jun 25 12:53:08 2000 @@ -36,10 +36,16 @@ #endif #ifdef HAS_SYSCALL -#ifdef __cplusplus +#ifdef __cplusplus +#ifndef __GLIBC__ +/* XXX Who put this here? Is someone compiling Perl with a C++ compiler + on a system that has syscall and doesn't declare it in a header file? + Really?? This breaks g++ on Linux because syscall returns long. + Hence my GNU Libc exclusion. -jtobey */ extern "C" int syscall(unsigned long,...); #endif #endif +#endif #ifdef I_SYS_WAIT # include <sys/wait.h> @@ -3971,7 +3977,13 @@ #ifdef HAS_GETPRIORITY who = POPi; which = TOPi; +#if defined(__GLIBC__) && defined(__cplusplus) + /* XXX GNU Libc documents `which' as int but declares it as enum + __priority_which in <sys/resource.h>, so let's not take chances. */ + SETi( ((int (*)(int, int))getpriority)(which, who) ); +#else SETi( getpriority(which, who) ); +#endif RETURN; #else DIE(aTHX_ PL_no_func, "getpriority()"); @@ -3989,7 +4001,13 @@ who = POPi; which = TOPi; TAINT_PROPER("setpriority"); +#if defined(__GLIBC__) && defined(__cplusplus) + /* XXX GNU Libc documents `which' as int but declares it as enum + __priority_which in <sys/resource.h>, so let's not take chances. */ + SETi( ((int (*)(int, int, int))setpriority)(which, who, niceval) >= 0 ); +#else SETi( setpriority(which, who, niceval) >= 0 ); +#endif RETURN; #else DIE(aTHX_ PL_no_func, "setpriority()"); --- sv.h~ Thu Mar 9 12:40:40 2000 +++ sv.h Sun Jun 25 11:49:08 2000 @@ -290,7 +290,7 @@ HV* xmg_stash; /* class package */ GP* xgv_gp; - char* xgv_name; + const char* xgv_name; STRLEN xgv_namelen; HV* xgv_stash; U8 xgv_flags; --- op.c~ Tue Mar 21 00:06:34 2000 +++ op.c Sun Jun 25 11:51:36 2000 @@ -5498,7 +5498,7 @@ /* is this op a FH constructor? */ if (is_handle_constructor(o,numargs)) { - char *name = Nullch; + const char *name = Nullch; STRLEN len; flags = 0; --- ext/DB_File/DB_File.xs~ Tue Feb 15 00:42:40 2000 +++ ext/DB_File/DB_File.xs Sun Jun 25 12:38:45 2000 @@ -140,6 +140,10 @@ #include <fcntl.h> +#ifdef __cplusplus +extern "C" void __getBerkeleyDBInfo(); +#endif + /* #define TRACE */ #define DBM_FILTERING @@ -380,7 +384,7 @@ #endif /* DBM_FILTERING */ -#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s) +#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? (const char*)d : ""), s) #define OutputValue(arg, name) \ { if (RETVAL == 0) { \ @@ -507,8 +511,8 @@ PUSHMARK(SP) ; EXTEND(SP,2) ; - PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); - PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUSHs(sv_2mortal(newSVpvn((const char *)data1,key1->size))); + PUSHs(sv_2mortal(newSVpvn((const char *)data2,key2->size))); PUTBACK ; count = perl_call_sv(CurrentDB->compare, G_SCALAR); @@ -563,8 +567,8 @@ PUSHMARK(SP) ; EXTEND(SP,2) ; - PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); - PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUSHs(sv_2mortal(newSVpvn((const char *)data1,key1->size))); + PUSHs(sv_2mortal(newSVpvn((const char *)data2,key2->size))); PUTBACK ; count = perl_call_sv(CurrentDB->prefix, G_SCALAR); @@ -768,7 +772,6 @@ SV ** svp; HV * action ; DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; - void * openinfo = NULL ; INFO * info = &RETVAL->info ; STRLEN n_a; @@ -808,7 +811,6 @@ croak("DB_File can only tie an associative array to a DB_HASH database") ; RETVAL->type = DB_HASH ; - openinfo = (void*)info ; svp = hv_fetch(action, "hash", 4, FALSE); @@ -843,7 +845,6 @@ croak("DB_File can only tie an associative array to a DB_BTREE database"); RETVAL->type = DB_BTREE ; - openinfo = (void*)info ; svp = hv_fetch(action, "compare", 7, FALSE); if (svp && SvOK(*svp)) @@ -892,7 +893,6 @@ croak("DB_File can only tie an array to a DB_RECNO database"); RETVAL->type = DB_RECNO ; - openinfo = (void *)info ; info->db_RE_flags = 0 ; @@ -1011,7 +1011,7 @@ Flags |= DB_TRUNCATE ; #endif - status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ; + status = db_open(name, RETVAL->type, Flags, mode, NULL, info, &RETVAL->dbp) ; if (status == 0) #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ; @@ -1027,9 +1027,9 @@ #else #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2 - RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; + RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, info) ; #else - RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; + RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, info) ; #endif /* DB_LIBRARY_COMPATIBILITY_API */ #endif --- ext/DB_File/version.c~ Sun Jan 23 08:15:45 2000 +++ ext/DB_File/version.c Sun Jun 25 12:34:01 2000 @@ -25,7 +25,7 @@ #include <db.h> -void +EXTERN_C void __getBerkeleyDBInfo() { SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ; --- ext/B/B.xs~ Thu Feb 24 20:49:18 2000 +++ ext/B/B.xs Sun Jun 25 11:23:20 2000 @@ -1054,7 +1054,7 @@ GvLINE(gv) B::GV gv -char * +const char * GvFILE(gv) B::GV gv --- ext/B/typemap~ Thu Oct 28 17:35:07 1999 +++ ext/B/typemap Sun Jun 25 11:18:38 2000 @@ -31,6 +31,7 @@ SSize_t T_IV STRLEN T_IV PADOFFSET T_UV +const char * T_PV INPUT T_OP_OBJ --- config.sh.orig Sun Jun 25 13:43:19 2000 +++ config.sh Sun Jun 25 13:49:12 2000 @@ -52,7 +52,7 @@ c='' castflags='0' cat='cat' -cc='cc' +cc='g++' cccdlflags='-fpic' ccdlflags='-rdynamic' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' @@ -76,8 +76,8 @@ cppflags='-fno-strict-aliasing -I/usr/local/include' cpplast='-' cppminus='-' -cpprun='cc -E' -cppstdin='cc -E' +cpprun='g++ -E' +cppstdin='g++ -E' cppsymbols='_FILE_OFFSET_BITS=64 __GNUC_MINOR__=95 _LARGEFILE_SOURCE=1 _POSIX_C_SOURCE=199506 _POSIX_SOURCE=1 __STDC__=1 __i386=1 __i386__=1 __linux=1 __linux__=1 __unix=1 __unix__=1' crosscompile='undef' cryptlib='' @@ -383,7 +383,7 @@ dlsrc='dl_dlopen.xs' doublesize='8' drand01='drand48()' -dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog attrs re' +dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob +GDBM_File IO IPC/SysV Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog attrs re' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -392,7 +392,7 @@ eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog attrs re Errno' +extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob +GDBM_File IO IPC/SysV Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog attrs re +Errno' fflushNULL='define' fflushall='undef' find='' @@ -532,7 +532,7 @@ known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re' ksh='' large='' -ld='cc' +ld='g++' lddlflags='-shared -L/usr/local/lib' ldflags=' -L/usr/local/lib' ldlibpthname='LD_LIBRARY_PATH' --- ext/Devel/DProf/DProf.xs~ Fri Feb 4 11:43:02 2000 +++ ext/Devel/DProf/DProf.xs Sun Jun 25 11:59:02 2000 @@ -3,6 +3,11 @@ #include "perl.h" #include "XSUB.h" +/* XXX If this causes problems, set i_unistd=undef in the hint file. */ +#ifdef I_UNISTD +#include <unistd.h> +#endif + /* For older Perls */ #ifndef dTHR # define dTHR int dummy_thr @@ -60,7 +65,7 @@ clock_t tms_utime; /* cpu time spent in user space */ clock_t tms_stime; /* cpu time spent in system */ clock_t realtime; /* elapsed real time, in ticks */ - char *name; + const char *name; U32 id; opcode ptype; }; @@ -210,7 +215,7 @@ } static void -prof_dumps(pTHX_ U32 id, char *pname, char *gname) +prof_dumps(pTHX_ U32 id, const char *pname, const char *gname) { PerlIO_printf(g_fp,"& %"UVxf" %s %s\n", (UV)id, pname, gname); } @@ -241,8 +246,8 @@ } else if (ptype == OP_GV) { U32 id = g_profstack[base++].id; - char *pname = g_profstack[base++].name; - char *gname = g_profstack[base++].name; + const char *pname = g_profstack[base++].name; + const char *gname = g_profstack[base++].name; prof_dumps(aTHX_ id, pname, gname); } @@ -318,7 +323,8 @@ { SV **svp; - char *gname, *pname; + const char *gname; + const char *pname; CV *cv; cv = INT2PTR(CV*,SvIVX(Sub)); --- ext/File/Glob/bsd_glob.c~ Thu Mar 2 12:53:17 2000 +++ ext/File/Glob/bsd_glob.c Sun Jun 25 12:08:02 2000 @@ -63,6 +63,11 @@ #include <perl.h> #include <XSUB.h> +/* XXX If this causes problems, set i_unistd=undef in the hint file. */ +#ifdef I_UNISTD +#include <unistd.h> +#endif + #include "bsd_glob.h" #ifdef I_PWD # include <pwd.h> @@ -637,6 +642,12 @@ /* NOTREACHED */ } +#ifdef __cplusplus +typedef Direntry_t *(*readdirfunc_t)(DIR*); +#else +typedef Direntry_t *(*readdirfunc_t)(); +#endif + static int glob3(Char *pathbuf, Char *pathend, Char *pattern, Char *restpattern, glob_t *pglob) @@ -646,14 +657,7 @@ int err; int nocase; char buf[MAXPATHLEN]; - - /* - * The readdirfunc declaration can't be prototyped, because it is - * assigned, below, to two functions which are prototyped in glob.h - * and dirent.h as taking pointers to differently typed opaque - * structures. - */ - Direntry_t *(*readdirfunc)(); + readdirfunc_t readdirfunc; *pathend = BG_EOS; errno = 0; @@ -689,9 +693,9 @@ /* Search directory for matching names. */ if (pglob->gl_flags & GLOB_ALTDIRFUNC) - readdirfunc = pglob->gl_readdir; + readdirfunc = (readdirfunc_t)pglob->gl_readdir; else - readdirfunc = my_readdir; + readdirfunc = (readdirfunc_t)my_readdir; while ((dp = (*readdirfunc)(dirp))) { register U8 *sc; register Char *dc; @@ -859,7 +863,7 @@ g_Ctoc(str, buf); if (pglob->gl_flags & GLOB_ALTDIRFUNC) - return((*pglob->gl_opendir)(buf)); + return((DIR*)(*pglob->gl_opendir)(buf)); else return(PerlDir_open(buf)); } -- John Tobey, late nite hacker <[EMAIL PROTECTED]> \\\ /// ]]] With enough bugs, all eyes are shallow. [[[ /// \\\
