This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Protect sv_collxfrm in mathoms.c with a USE_LOCALE_COLLATE ifdef
[perl5.git] / mathoms.c
index 44e1a0d..0b67ae9 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -8,13 +8,15 @@
  */
 
 /*
- * "Anything that Hobbits had no immediate use for, but were unwilling to 
- * throw away, they called a mathom. Their dwellings were apt to become
- * rather crowded with mathoms, and many of the presents that passed from
- * hand to hand were of that sort." 
+ *  Anything that Hobbits had no immediate use for, but were unwilling to
+ *  throw away, they called a mathom.  Their dwellings were apt to become
+ *  rather crowded with mathoms, and many of the presents that passed from
+ *  hand to hand were of that sort.
+ *
+ *     [p.5 of _The Lord of the Rings_: "Prologue"]
  */
 
-#ifndef NO_MATHOMS
+
 
 /* 
  * This file contains mathoms, various binary artifacts from previous
 #define PERL_IN_MATHOMS_C
 #include "perl.h"
 
+#ifdef NO_MATHOMS
+/* ..." warning: ISO C forbids an empty source file"
+   So make sure we have something in here by processing the headers anyway.
+ */
+#else
+
 PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
 PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
 PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
 PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv);
 PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv);
+PERL_CALLCONV NV Perl_sv_2nv(pTHX_ register SV *sv);
 PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp);
 PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv);
 PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv);
@@ -68,6 +77,13 @@ PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
 PERL_CALLCONV AV * Perl_newAV(pTHX);
 PERL_CALLCONV HV * Perl_newHV(pTHX);
+PERL_CALLCONV IO * Perl_newIO(pTHX);
+PERL_CALLCONV I32 Perl_my_stat(pTHX);
+PERL_CALLCONV I32 Perl_my_lstat(pTHX);
+PERL_CALLCONV I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2);
+PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
+PERL_CALLCONV bool Perl_sv_2bool(pTHX_ register SV *const sv);
+PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
 
 /* ref() is now a macro using Perl_doref;
  * this version provided for binary compatibility only.
@@ -132,6 +148,17 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     return sv_2uv_flags(sv, SV_GMAGIC);
 }
 
+/* sv_2nv() is now a macro using Perl_sv_2nv_flags();
+ * this function provided for binary compatibility only
+ */
+
+NV
+Perl_sv_2nv(pTHX_ register SV *sv)
+{
+    return sv_2nv_flags(sv, SV_GMAGIC);
+}
+
+
 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
  * this function provided for binary compatibility only
  */
@@ -153,6 +180,7 @@ use the macro wrapper C<SvPV_nolen(sv)> instead.
 char *
 Perl_sv_2pv_nolen(pTHX_ register SV *sv)
 {
+    PERL_ARGS_ASSERT_SV_2PV_NOLEN;
     return sv_2pv(sv, NULL);
 }
 
@@ -605,29 +633,6 @@ Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 }
 
-AV *
-Perl_av_fake(pTHX_ register I32 size, register SV **strp)
-{
-    register SV** ary;
-    register AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
-
-    PERL_ARGS_ASSERT_AV_FAKE;
-
-    Newx(ary,size+1,SV*);
-    AvALLOC(av) = ary;
-    Copy(strp,ary,size,SV*);
-    AvREIFY_only(av);
-    AvARRAY(av) = ary;
-    AvFILLp(av) = size - 1;
-    AvMAX(av) = size - 1;
-    while (size--) {
-        assert (*strp);
-        SvTEMP_off(*strp);
-        strp++;
-    }
-    return av;
-}
-
 bool
 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
@@ -695,440 +700,6 @@ Perl_init_i18nl14n(pTHX_ int printwarn)
     return init_i18nl10n(printwarn);
 }
 
-OP *
-Perl_oopsCV(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_OOPSCV;
-
-    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_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();
-}
-
-PP(pp_rindex)
-{
-    return pp_index();
-}
-
-PP(pp_hex)
-{
-    return pp_oct();
-}
-
-PP(pp_pop)
-{
-    return pp_shift();
-}
-
-PP(pp_cos)
-{
-    return pp_sin();
-}
-
-PP(pp_exp)
-{
-    return pp_sin();
-}
-
-PP(pp_log)
-{
-    return pp_sin();
-}
-
-PP(pp_sqrt)
-{
-    return pp_sin();
-}
-
-PP(pp_bit_xor)
-{
-    return pp_bit_or();
-}
-
-PP(pp_rv2hv)
-{
-    return Perl_pp_rv2av(aTHX);
-}
-
 U8 *
 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 {
@@ -1194,7 +765,7 @@ Perl_save_long(pTHX_ long int *longp)
     SSCHECK(3);
     SSPUSHLONG(*longp);
     SSPUSHPTR(longp);
-    SSPUSHINT(SAVEt_LONG);
+    SSPUSHUV(SAVEt_LONG);
 }
 
 void
@@ -1207,7 +778,7 @@ Perl_save_iv(pTHX_ IV *ivp)
     SSCHECK(3);
     SSPUSHIV(*ivp);
     SSPUSHPTR(ivp);
-    SSPUSHINT(SAVEt_IV);
+    SSPUSHUV(SAVEt_IV);
 }
 
 void
@@ -1219,7 +790,7 @@ Perl_save_nogv(pTHX_ GV *gv)
 
     SSCHECK(2);
     SSPUSHPTR(gv);
-    SSPUSHINT(SAVEt_NSTAB);
+    SSPUSHUV(SAVEt_NSTAB);
 }
 
 void
@@ -1236,7 +807,7 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
        SSCHECK(3);
        SSPUSHPTR(sarg[i]);             /* remember the pointer */
        SSPUSHPTR(sv);                  /* remember the value */
-       SSPUSHINT(SAVEt_ITEM);
+       SSPUSHUV(SAVEt_ITEM);
     }
 }
 
@@ -1274,14 +845,6 @@ Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
     sv_usepvn_flags(sv,ptr,len, 0);
 }
 
-void
-Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
-{
-    PERL_ARGS_ASSERT_CV_CKPROTO;
-
-    cv_ckproto_len(cv, gv, p, p ? strlen(p) : 0);
-}
-
 /*
 =for apidoc unpack_str
 
@@ -1469,6 +1032,142 @@ Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
 }
 
+void
+Perl_save_freesv(pTHX_ SV *sv)
+{
+    dVAR;
+    save_freesv(sv);
+}
+
+void
+Perl_save_mortalizesv(pTHX_ SV *sv)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
+
+    save_mortalizesv(sv);
+}
+
+void
+Perl_save_freeop(pTHX_ OP *o)
+{
+    dVAR;
+    save_freeop(o);
+}
+
+void
+Perl_save_freepv(pTHX_ char *pv)
+{
+    dVAR;
+    save_freepv(pv);
+}
+
+void
+Perl_save_op(pTHX)
+{
+    dVAR;
+    save_op();
+}
+
+#ifdef PERL_DONT_CREATE_GVSV
+GV *
+Perl_gv_SVadd(pTHX_ GV *gv)
+{
+    return gv_SVadd(gv);
+}
+#endif
+
+GV *
+Perl_gv_AVadd(pTHX_ GV *gv)
+{
+    return gv_AVadd(gv);
+}
+
+GV *
+Perl_gv_HVadd(pTHX_ register GV *gv)
+{
+    return gv_HVadd(gv);
+}
+
+GV *
+Perl_gv_IOadd(pTHX_ register GV *gv)
+{
+    return gv_IOadd(gv);
+}
+
+IO *
+Perl_newIO(pTHX)
+{
+    return MUTABLE_IO(newSV_type(SVt_PVIO));
+}
+
+I32
+Perl_my_stat(pTHX)
+{
+    return my_stat_flags(SV_GMAGIC);
+}
+
+I32
+Perl_my_lstat(pTHX)
+{
+    return my_lstat_flags(SV_GMAGIC);
+}
+
+I32
+Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
+{
+    return sv_eq_flags(sv1, sv2, SV_GMAGIC);
+}
+
+#ifdef USE_LOCALE_COLLATE
+char *
+Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
+{
+    return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
+}
+#endif
+
+bool
+Perl_sv_2bool(pTHX_ register SV *const sv)
+{
+    return sv_2bool_flags(sv, SV_GMAGIC);
+}
+
+
+/*
+=for apidoc custom_op_name
+Return the name for a given custom op. This was once used by the OP_NAME
+macro, but is no longer: it has only been kept for compatibility, and
+should not be used.
+
+=for apidoc custom_op_desc
+Return the description of a given custom op. This was once used by the
+OP_DESC macro, but is no longer: it has only been kept for
+compatibility, and should not be used.
+
+=cut
+*/
+
+const char*
+Perl_custom_op_name(pTHX_ const OP* o)
+{
+    PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
+    return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name);
+}
+
+const char*
+Perl_custom_op_desc(pTHX_ const OP* o)
+{
+    PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
+    return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_desc);
+}
+
+CV *
+Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
+{
+    return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block);
+}
 #endif /* NO_MATHOMS */
 
 /*