This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid using space to create 2 functions just to force mathoms to be
[perl5.git] / mathoms.c
index ce2022e..2acdb42 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -1,6 +1,6 @@
 /*    mathoms.c
  *
- *    Copyright (C) 2005, by Larry Wall and others
+ *    Copyright (C) 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -14,6 +14,8 @@
  * hand to hand were of that sort." 
  */
 
+#ifndef NO_MATHOMS
+
 /* 
  * This file contains mathoms, various binary artifacts from previous
  * versions of Perl.  For binary or source compatibility reasons, though,
@@ -406,58 +408,6 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
 }
 
-/*
-=for apidoc A|U8 *|uvchr_to_utf8|U8 *d|UV uv
-
-Adds the UTF-8 representation of the Native codepoint C<uv> to the end
-of the string C<d>; C<d> should be have at least C<UTF8_MAXBYTES+1> free
-bytes available. The return value is the pointer to the byte after the
-end of the new character. In other words,
-
-    d = uvchr_to_utf8(d, uv);
-
-is the recommended wide native character-aware way of saying
-
-    *(d++) = uv;
-
-=cut
-*/
-
-/* On ASCII machines this is normally a macro but we want a
-   real function in case XS code wants it
-*/
-#undef Perl_uvchr_to_utf8
-U8 *
-Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv)
-{
-    return Perl_uvuni_to_utf8_flags(aTHX_ d, NATIVE_TO_UNI(uv), 0);
-}
-
-
-/*
-=for apidoc A|UV|utf8n_to_uvchr|U8 *s|STRLEN curlen|STRLEN *retlen|U32 
-flags
-
-Returns the native character value of the first character in the string 
-C<s>
-which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
-length, in bytes, of that character.
-
-Allows length and flags to be passed to low level routine.
-
-=cut
-*/
-/* On ASCII machines this is normally a macro but we want
-   a real function in case XS code wants it
-*/
-#undef Perl_utf8n_to_uvchr
-UV
-Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, 
-U32 flags)
-{
-    const UV uv = Perl_utf8n_to_uvuni(aTHX_ s, curlen, retlen, flags);
-    return UNI_TO_NATIVE(uv);
-}
 int
 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 {
@@ -492,69 +442,6 @@ Perl_huge(void)
 }
 #endif
 
-#ifndef USE_SFIO
-int
-perlsio_binmode(FILE *fp, int iotype, int mode)
-{
-    /*
-     * This used to be contents of do_binmode in doio.c
-     */
-#ifdef DOSISH
-#  if defined(atarist) || defined(__MINT__)
-    if (!fflush(fp)) {
-        if (mode & O_BINARY)
-            ((FILE *) fp)->_flag |= _IOBIN;
-        else
-            ((FILE *) fp)->_flag &= ~_IOBIN;
-        return 1;
-    }
-    return 0;
-#  else
-    dTHX;
-#ifdef NETWARE
-    if (PerlLIO_setmode(fp, mode) != -1) {
-#else
-    if (PerlLIO_setmode(fileno(fp), mode) != -1) {
-#endif
-#    if defined(WIN32) && defined(__BORLANDC__)
-        /*
-         * The translation mode of the stream is maintained independent 
-of
-         * the translation mode of the fd in the Borland RTL (heavy
-         * digging through their runtime sources reveal).  User has to 
-set
-         * the mode explicitly for the stream (though they don't 
-document
-         * this anywhere). GSAR 97-5-24
-         */
-        fseek(fp, 0L, 0);
-        if (mode & O_BINARY)
-            fp->flags |= _F_BIN;
-        else
-            fp->flags &= ~_F_BIN;
-#    endif
-        return 1;
-    }
-    else
-        return 0;
-#  endif
-#else
-#  if defined(USEMYBINMODE)
-    dTHX;
-    if (my_binmode(fp, iotype, mode) != FALSE)
-        return 1;
-    else
-        return 0;
-#  else
-    PERL_UNUSED_ARG(fp);
-    PERL_UNUSED_ARG(iotype);
-    PERL_UNUSED_ARG(mode);
-    return 1;
-#  endif
-#endif
-}
-#endif /* sfio */
-
 /* compatibility with versions <= 5.003. */
 void
 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
@@ -595,11 +482,33 @@ Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
     return gv_fetchmethod_autoload(stash, name, TRUE);
 }
 
+HE *
+Perl_hv_iternext(pTHX_ HV *hv)
+{
+    return hv_iternext_flags(hv, 0);
+}
+
+void
+Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
+{
+    sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
+}
+
+#if 0 /* use the macro from hv.h instead */
+
+char*  
+Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
+{
+    return HEK_KEY(share_hek(sv, len, hash));
+}
+
+#endif
+
 AV *
 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
 {
     register SV** ary;
-    register AV * const av = (AV*)NEWSV(9,0);
+    register AV * const av = (AV*)newSV(0);
 
     sv_upgrade((SV *)av, SVt_PVAV);
     Newx(ary,size+1,SV*);
@@ -670,6 +579,7 @@ Perl_do_exec(pTHX_ const char *cmd)
 void
 Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
 {
+    dVAR;
     register IO *rstio;
     register IO *wstio;
     int fd[2];
@@ -712,6 +622,473 @@ badexit:
 }
 #endif
 
+/* Backwards compatibility. */
+int
+Perl_init_i18nl14n(pTHX_ int printwarn)
+{
+    return init_i18nl10n(printwarn);
+}
+
+/* XXX kept for BINCOMPAT only */
+void
+Perl_save_hints(pTHX)
+{
+    Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
+}
+
+#if 0
+OP *
+Perl_ck_retarget(pTHX_ OP *o)
+{
+    Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
+    /* STUB */
+    return o;
+}
+#endif
+
+OP *
+Perl_oopsCV(pTHX_ OP *o)
+{
+    Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
+    /* STUB */
+    PERL_UNUSED_ARG(o);
+    NORETURN_FUNCTION_END;
+}
+
+PP(pp_padany)
+{
+    DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
+}
+
+PP(pp_threadsv)
+{
+    DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
+}
+
+PP(pp_mapstart)
+{
+    DIE(aTHX_ "panic: mapstart");      /* uses grepstart */
+}
+
+/* These ops all have the same body as pp_null.  */
+PP(pp_scalar)
+{
+    dVAR;
+    return NORMAL;
+}
+
+PP(pp_regcmaybe)
+{
+    dVAR;
+    return NORMAL;
+}
+
+PP(pp_lineseq)
+{
+    dVAR;
+    return NORMAL;
+}
+
+PP(pp_scope)
+{
+    dVAR;
+    return NORMAL;
+}
+
+/* Ops that are calls to do_kv.  */
+PP(pp_values)
+{
+    return do_kv();
+}
+
+PP(pp_keys)
+{
+    return do_kv();
+}
+
+/* Ops that are simply calls to other ops.  */
+PP(pp_dump)
+{
+    return pp_goto();
+    /*NOTREACHED*/
+}
+
+PP(pp_dofile)
+{
+    return pp_require();
+}
+
+PP(pp_dbmclose)
+{
+    return pp_untie();
+}
+
+PP(pp_read)
+{
+    return pp_sysread();
+}
+
+PP(pp_recv)
+{
+    return pp_sysread();
+}
+
+PP(pp_seek)
+{
+    return pp_sysseek();
+}
+
+PP(pp_fcntl)
+{
+    return pp_ioctl();
+}
+
+PP(pp_gsockopt)
+{
+    return pp_ssockopt();
+}
+
+PP(pp_getsockname)
+{
+    return pp_getpeername();
+}
+
+PP(pp_lstat)
+{
+    return pp_stat();
+}
+
+PP(pp_fteowned)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftbinary)
+{
+    return pp_fttext();
+}
+
+PP(pp_localtime)
+{
+    return pp_gmtime();
+}
+
+PP(pp_shmget)
+{
+    return pp_semget();
+}
+
+PP(pp_shmctl)
+{
+    return pp_semctl();
+}
+
+PP(pp_shmread)
+{
+    return pp_shmwrite();
+}
+
+PP(pp_msgget)
+{
+    return pp_semget();
+}
+
+PP(pp_msgctl)
+{
+    return pp_semctl();
+}
+
+PP(pp_ghbyname)
+{
+    return pp_ghostent();
+}
+
+PP(pp_ghbyaddr)
+{
+    return pp_ghostent();
+}
+
+PP(pp_gnbyname)
+{
+    return pp_gnetent();
+}
+
+PP(pp_gnbyaddr)
+{
+    return pp_gnetent();
+}
+
+PP(pp_gpbyname)
+{
+    return pp_gprotoent();
+}
+
+PP(pp_gpbynumber)
+{
+    return pp_gprotoent();
+}
+
+PP(pp_gsbyname)
+{
+    return pp_gservent();
+}
+
+PP(pp_gsbyport)
+{
+    return pp_gservent();
+}
+
+PP(pp_gpwnam)
+{
+    return pp_gpwent();
+}
+
+PP(pp_gpwuid)
+{
+    return pp_gpwent();
+}
+
+PP(pp_ggrnam)
+{
+    return pp_ggrent();
+}
+
+PP(pp_ggrgid)
+{
+    return pp_ggrent();
+}
+
+PP(pp_ftsize)
+{
+    return pp_ftis();
+}
+
+PP(pp_ftmtime)
+{
+    return pp_ftis();
+}
+
+PP(pp_ftatime)
+{
+    return pp_ftis();
+}
+
+PP(pp_ftctime)
+{
+    return pp_ftis();
+}
+
+PP(pp_ftzero)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftsock)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftchr)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftblk)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftfile)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftdir)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftpipe)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftsuid)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftsgid)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_ftsvtx)
+{
+    return pp_ftrowned();
+}
+
+PP(pp_unlink)
+{
+    return pp_chown();
+}
+
+PP(pp_chmod)
+{
+    return pp_chown();
+}
+
+PP(pp_utime)
+{
+    return pp_chown();
+}
+
+PP(pp_kill)
+{
+    return pp_chown();
+}
+
+PP(pp_symlink)
+{
+    return pp_link();
+}
+
+PP(pp_ftrwrite)
+{
+    return pp_ftrread();
+}
+
+PP(pp_ftrexec)
+{
+    return pp_ftrread();
+}
+
+PP(pp_fteread)
+{
+    return pp_ftrread();
+}
+
+PP(pp_ftewrite)
+{
+    return pp_ftrread();
+}
+
+PP(pp_fteexec)
+{
+    return pp_ftrread();
+}
+
+PP(pp_msgsnd)
+{
+    return pp_shmwrite();
+}
+
+PP(pp_msgrcv)
+{
+    return pp_shmwrite();
+}
+
+PP(pp_syswrite)
+{
+    return pp_send();
+}
+
+PP(pp_semop)
+{
+    return pp_shmwrite();
+}
+
+PP(pp_dor)
+{
+    return pp_defined();
+}
+
+PP(pp_andassign)
+{
+    return pp_and();
+}
+
+PP(pp_orassign)
+{
+    return pp_or();
+}
+
+PP(pp_dorassign)
+{
+    return pp_defined();
+} 
+
+PP(pp_lcfirst)
+{
+    return pp_ucfirst();
+}
+
+PP(pp_slt)
+{
+    return pp_sle();
+}
+
+PP(pp_sgt)
+{
+    return pp_sle();
+}
+
+PP(pp_sge)
+{
+    return pp_sle();
+}
+
+U8 *
+Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
+{
+    return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
+}
+
+bool
+Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
+{
+    return is_utf8_string_loclen(s, len, ep, 0);
+}
+
+/*
+=for apidoc sv_nolocking
+
+Dummy routine which "locks" an SV when there is no locking module present.
+Exists to avoid test for a NULL function pointer and because it could
+potentially warn under some level of strict-ness.
+
+"Superseded" by sv_nosharing().
+
+=cut
+*/
+
+void
+Perl_sv_nolocking(pTHX_ SV *sv)
+{
+    PERL_UNUSED_ARG(sv);
+}
+
+
+/*
+=for apidoc sv_nounlocking
+
+Dummy routine which "unlocks" an SV when there is no locking module present.
+Exists to avoid test for a NULL function pointer and because it could
+potentially warn under some level of strict-ness.
+
+"Superseded" by sv_nosharing().
+
+=cut
+*/
+
+void
+Perl_sv_nounlocking(pTHX_ SV *sv)
+{
+    PERL_UNUSED_ARG(sv);
+}
+
+#endif /* NO_MATHOMS */
+
 /*
  * Local variables:
  * c-indentation-style: bsd