Change 27310 by [EMAIL PROTECTED] on 2006/02/24 13:20:45 Integrate: [ 25893] Replace gv_fetchmethod() with a macro to call gv_fetchmethod_autoload() with the extra TRUE argument. [ 25895] Replace hv_iternext() with a macro that calls hv_iternext_flags with an extra 0 argument. Move the old body to mathoms.c [ 25897] Replace hv_magic() with a macro to call sv_magic() directly. Move the old body to mathoms.c [ 25898] init_i18nl14n is a mathom. [ 25900] save_hints is a mathom. [ 25901] Functions that die aren't exactly well used code. (ck_retarget, oopsCV, pp_padany, pp_threadsv, pp_mapstart) [ 25903] Replace is_utf8_string_loc() with a macro that passes the extra 0 argument to is_utf8_string_loc(). Correct the description of its parameters in its POD. [ 25905] Replace uvuni_to_utf8() with a macro that passes the extra 0 argument to uvuni_to_utf8_flags(). Move the old body to mathoms.c [ 25906] Given that sv_nosharing performs the same function as sv_nolocking and sv_unnolocking (ie sweet FA), we might as well use the 1 function to initialise all 3 variables, and elimiate the other two. For some reason all 3 are listed as being in the public API. Daft. [ 25907] Perl_is_utf8_* share a lot of common code. Pull that out into a new function S_is_utf8_common. [ 25909] is_utf8_alnum() and is_utf8_alnumc() can use is_utf8_common() too. [ 25910] const const bad bad. gcc bad bad too, because it didn't grumble one bit. (or two, for that matter). [ 25911] perlsio_binmode() is pretty much a mathom on UNIX platforms, but it is used on Cygwin, at least. [ 25916] is_utf8_string_loc() is now a macro, don't use its Perl_-prefixed form [ 25918] Fixed threaded builds following change 25916 [ 25921] uvchr_to_utf8() and utf8n_to_uvchr() are mathoms on ASCII based systems, and not on EBCDIC, so some more thinking is going to be needed here. [ 25926] A more elegant way to deal with utf8n_to_uvchr() and utf8n_to_uvuni(). [ 25946] This should clear up 'Perl_do_exec' undefined; warnings on win32 [ 25947] This *really* should clear up Win32's Perl_do_exec undefined warnings
Affected files ... ... //depot/maint-5.8/perl/embed.fnc#130 integrate ... //depot/maint-5.8/perl/embed.h#98 integrate ... //depot/maint-5.8/perl/global.sym#43 edit ... //depot/maint-5.8/perl/gv.c#64 integrate ... //depot/maint-5.8/perl/gv.h#11 integrate ... //depot/maint-5.8/perl/hv.c#77 integrate ... //depot/maint-5.8/perl/hv.h#21 integrate ... //depot/maint-5.8/perl/intrpvar.h#44 integrate ... //depot/maint-5.8/perl/locale.c#16 integrate ... //depot/maint-5.8/perl/mathoms.c#4 edit ... //depot/maint-5.8/perl/op.c#124 integrate ... //depot/maint-5.8/perl/perl.h#104 integrate ... //depot/maint-5.8/perl/perlio.c#73 integrate ... //depot/maint-5.8/perl/pp.c#87 integrate ... //depot/maint-5.8/perl/pp_ctl.c#111 integrate ... //depot/maint-5.8/perl/pp_hot.c#92 integrate ... //depot/maint-5.8/perl/proto.h#119 edit ... //depot/maint-5.8/perl/utf8.c#51 edit ... //depot/maint-5.8/perl/utf8.h#14 integrate ... //depot/maint-5.8/perl/util.c#96 integrate Differences ... ==== //depot/maint-5.8/perl/embed.fnc#130 (text) ==== Index: perl/embed.fnc --- perl/embed.fnc#129~27308~ 2006-02-24 04:11:35.000000000 -0800 +++ perl/embed.fnc 2006-02-24 05:20:45.000000000 -0800 @@ -194,7 +194,13 @@ p |void |do_chop |NN SV* asv|NN SV* sv Ap |bool |do_close |NN GV* gv|bool not_implicit p |bool |do_eof |NN GV* gv + +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION pmb |bool |do_exec |NN char* cmd +#else +p |bool |do_exec |NN char* cmd +#endif + #if defined(WIN32) Ap |int |do_aspawn |NN SV* really|NN SV** mark|NN SV** sp Ap |int |do_spawn |NN char* cmd @@ -277,7 +283,7 @@ Ap |GV* |gv_fetchfile |NN const char* name Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level -Apd |GV* |gv_fetchmethod |NULLOK HV* stash|NN const char* name +Apdmb |GV* |gv_fetchmethod |NULLOK HV* stash|NN const char* name Apd |GV* |gv_fetchmethod_autoload|NULLOK HV* stash|NN const char* name|I32 autoload Ap |GV* |gv_fetchpv |NN const char* name|I32 add|I32 sv_type Ap |void |gv_fullname |NN SV* sv|NN GV* gv @@ -299,12 +305,12 @@ Apd |I32 |hv_iterinit |NN HV* tb ApdR |char* |hv_iterkey |NN HE* entry|NN I32* retlen ApdR |SV* |hv_iterkeysv |NN HE* entry -ApdR |HE* |hv_iternext |NN HV* tb +ApdRbm |HE* |hv_iternext |NN HV* tb ApdR |SV* |hv_iternextsv |NN HV* hv|NN char** key|NN I32* retlen ApMdR |HE* |hv_iternext_flags|NN HV* tb|I32 flags ApdR |SV* |hv_iterval |NN HV* tb|NN HE* entry Ap |void |hv_ksplit |NN HV* hv|IV newmax -Apd |void |hv_magic |NN HV* hv|NULLOK GV* gv|int how +Apdbm |void |hv_magic |NN HV* hv|NULLOK GV* gv|int how Apd |SV** |hv_store |NULLOK HV* tb|NULLOK const char* key|I32 klen|NULLOK SV* val \ |U32 hash Apd |HE* |hv_store_ent |NULLOK HV* tb|NULLOK SV* key|NULLOK SV* val|U32 hash @@ -362,7 +368,7 @@ ApPR |bool |is_uni_punct_lc|UV c ApPR |bool |is_uni_xdigit_lc|UV c Apd |STRLEN |is_utf8_char |NN U8 *p -Apd |bool |is_utf8_string_loc|NN U8 *s|STRLEN len|NULLOK U8 **p +Apdbm |bool |is_utf8_string_loc|NN U8 *s|STRLEN len|NULLOK U8 **p Apd |bool |is_utf8_string |NN U8 *s|STRLEN len ApR |bool |is_utf8_alnum |NN U8 *p ApR |bool |is_utf8_alnumc |NN U8 *p @@ -859,10 +865,22 @@ ApMd |U8* |bytes_to_utf8 |NN U8 *s|NN STRLEN *len Apd |UV |utf8_to_uvchr |NN U8 *s|NULLOK STRLEN *retlen Apd |UV |utf8_to_uvuni |NN U8 *s|NULLOK STRLEN *retlen + +#ifdef EBCDIC Adp |UV |utf8n_to_uvchr |NN U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +#else +Adpbm |UV |utf8n_to_uvchr |NN U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +#endif + Adp |UV |utf8n_to_uvuni |NN U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags + +#ifdef EBCDIC Apd |U8* |uvchr_to_utf8 |NN U8 *d|UV uv -Ap |U8* |uvuni_to_utf8 |NN U8 *d|UV uv +#else +Apdbm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv +#endif + +Apbm |U8* |uvuni_to_utf8 |NN U8 *d|UV uv Ap |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |char* |pv_uni_display |NN SV *dsv|NN U8 *spv|STRLEN len \ @@ -997,8 +1015,8 @@ ApR |char * |custom_op_desc |NN OP* op Adp |void |sv_nosharing |NULLOK SV * -Adp |void |sv_nolocking |NULLOK SV * -Adp |void |sv_nounlocking |NULLOK SV * +Adpbm |void |sv_nolocking |NULLOK SV * +Adpbm |void |sv_nounlocking |NULLOK SV * Adp |int |nothreadhook END_EXTERN_C ==== //depot/maint-5.8/perl/embed.h#98 (text+w) ==== Index: perl/embed.h --- perl/embed.h#97~27308~ 2006-02-24 04:11:35.000000000 -0800 +++ perl/embed.h 2006-02-24 05:20:45.000000000 -0800 @@ -175,6 +175,12 @@ #ifdef PERL_CORE #define do_eof Perl_do_eof #endif +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +#else +#ifdef PERL_CORE +#define do_exec Perl_do_exec +#endif +#endif #if defined(WIN32) #define do_aspawn Perl_do_aspawn #define do_spawn Perl_do_spawn @@ -270,7 +276,6 @@ #define gv_fetchfile Perl_gv_fetchfile #define gv_fetchmeth Perl_gv_fetchmeth #define gv_fetchmeth_autoload Perl_gv_fetchmeth_autoload -#define gv_fetchmethod Perl_gv_fetchmethod #define gv_fetchmethod_autoload Perl_gv_fetchmethod_autoload #define gv_fetchpv Perl_gv_fetchpv #define gv_fullname Perl_gv_fullname @@ -291,12 +296,10 @@ #define hv_iterinit Perl_hv_iterinit #define hv_iterkey Perl_hv_iterkey #define hv_iterkeysv Perl_hv_iterkeysv -#define hv_iternext Perl_hv_iternext #define hv_iternextsv Perl_hv_iternextsv #define hv_iternext_flags Perl_hv_iternext_flags #define hv_iterval Perl_hv_iterval #define hv_ksplit Perl_hv_ksplit -#define hv_magic Perl_hv_magic #define hv_store Perl_hv_store #define hv_store_ent Perl_hv_store_ent #define hv_store_flags Perl_hv_store_flags @@ -357,7 +360,6 @@ #define is_uni_punct_lc Perl_is_uni_punct_lc #define is_uni_xdigit_lc Perl_is_uni_xdigit_lc #define is_utf8_char Perl_is_utf8_char -#define is_utf8_string_loc Perl_is_utf8_string_loc #define is_utf8_string Perl_is_utf8_string #define is_utf8_alnum Perl_is_utf8_alnum #define is_utf8_alnumc Perl_is_utf8_alnumc @@ -898,10 +900,15 @@ #define bytes_to_utf8 Perl_bytes_to_utf8 #define utf8_to_uvchr Perl_utf8_to_uvchr #define utf8_to_uvuni Perl_utf8_to_uvuni +#ifdef EBCDIC #define utf8n_to_uvchr Perl_utf8n_to_uvchr +#else +#endif #define utf8n_to_uvuni Perl_utf8n_to_uvuni +#ifdef EBCDIC #define uvchr_to_utf8 Perl_uvchr_to_utf8 -#define uvuni_to_utf8 Perl_uvuni_to_utf8 +#else +#endif #define uvchr_to_utf8_flags Perl_uvchr_to_utf8_flags #define uvuni_to_utf8_flags Perl_uvuni_to_utf8_flags #define pv_uni_display Perl_pv_uni_display @@ -1032,8 +1039,6 @@ #define custom_op_name Perl_custom_op_name #define custom_op_desc Perl_custom_op_desc #define sv_nosharing Perl_sv_nosharing -#define sv_nolocking Perl_sv_nolocking -#define sv_nounlocking Perl_sv_nounlocking #define nothreadhook Perl_nothreadhook #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE @@ -2195,6 +2200,14 @@ #ifdef PERL_CORE #define do_eof(a) Perl_do_eof(aTHX_ a) #endif +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +#ifdef PERL_CORE +#endif +#else +#ifdef PERL_CORE +#define do_exec(a) Perl_do_exec(aTHX_ a) +#endif +#endif #if defined(WIN32) #define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c) #define do_spawn(a) Perl_do_spawn(aTHX_ a) @@ -2289,7 +2302,6 @@ #define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a) #define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d) #define gv_fetchmeth_autoload(a,b,c,d) Perl_gv_fetchmeth_autoload(aTHX_ a,b,c,d) -#define gv_fetchmethod(a,b) Perl_gv_fetchmethod(aTHX_ a,b) #define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_ a,b,c) #define gv_fetchpv(a,b,c) Perl_gv_fetchpv(aTHX_ a,b,c) #define gv_fullname(a,b) Perl_gv_fullname(aTHX_ a,b) @@ -2310,12 +2322,10 @@ #define hv_iterinit(a) Perl_hv_iterinit(aTHX_ a) #define hv_iterkey(a,b) Perl_hv_iterkey(aTHX_ a,b) #define hv_iterkeysv(a) Perl_hv_iterkeysv(aTHX_ a) -#define hv_iternext(a) Perl_hv_iternext(aTHX_ a) #define hv_iternextsv(a,b,c) Perl_hv_iternextsv(aTHX_ a,b,c) #define hv_iternext_flags(a,b) Perl_hv_iternext_flags(aTHX_ a,b) #define hv_iterval(a,b) Perl_hv_iterval(aTHX_ a,b) #define hv_ksplit(a,b) Perl_hv_ksplit(aTHX_ a,b) -#define hv_magic(a,b,c) Perl_hv_magic(aTHX_ a,b,c) #define hv_store(a,b,c,d,e) Perl_hv_store(aTHX_ a,b,c,d,e) #define hv_store_ent(a,b,c,d) Perl_hv_store_ent(aTHX_ a,b,c,d) #define hv_store_flags(a,b,c,d,e,f) Perl_hv_store_flags(aTHX_ a,b,c,d,e,f) @@ -2376,7 +2386,6 @@ #define is_uni_punct_lc(a) Perl_is_uni_punct_lc(aTHX_ a) #define is_uni_xdigit_lc(a) Perl_is_uni_xdigit_lc(aTHX_ a) #define is_utf8_char(a) Perl_is_utf8_char(aTHX_ a) -#define is_utf8_string_loc(a,b,c) Perl_is_utf8_string_loc(aTHX_ a,b,c) #define is_utf8_string(a,b) Perl_is_utf8_string(aTHX_ a,b) #define is_utf8_alnum(a) Perl_is_utf8_alnum(aTHX_ a) #define is_utf8_alnumc(a) Perl_is_utf8_alnumc(aTHX_ a) @@ -2911,10 +2920,15 @@ #define bytes_to_utf8(a,b) Perl_bytes_to_utf8(aTHX_ a,b) #define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b) #define utf8_to_uvuni(a,b) Perl_utf8_to_uvuni(aTHX_ a,b) +#ifdef EBCDIC #define utf8n_to_uvchr(a,b,c,d) Perl_utf8n_to_uvchr(aTHX_ a,b,c,d) +#else +#endif #define utf8n_to_uvuni(a,b,c,d) Perl_utf8n_to_uvuni(aTHX_ a,b,c,d) +#ifdef EBCDIC #define uvchr_to_utf8(a,b) Perl_uvchr_to_utf8(aTHX_ a,b) -#define uvuni_to_utf8(a,b) Perl_uvuni_to_utf8(aTHX_ a,b) +#else +#endif #define uvchr_to_utf8_flags(a,b,c) Perl_uvchr_to_utf8_flags(aTHX_ a,b,c) #define uvuni_to_utf8_flags(a,b,c) Perl_uvuni_to_utf8_flags(aTHX_ a,b,c) #define pv_uni_display(a,b,c,d,e) Perl_pv_uni_display(aTHX_ a,b,c,d,e) @@ -3039,8 +3053,6 @@ #define custom_op_name(a) Perl_custom_op_name(aTHX_ a) #define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a) #define sv_nosharing(a) Perl_sv_nosharing(aTHX_ a) -#define sv_nolocking(a) Perl_sv_nolocking(aTHX_ a) -#define sv_nounlocking(a) Perl_sv_nounlocking(aTHX_ a) #define nothreadhook() Perl_nothreadhook(aTHX) #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE ==== //depot/maint-5.8/perl/global.sym#43 (text+w) ==== Index: perl/global.sym --- perl/global.sym#42~27168~ 2006-02-12 13:10:26.000000000 -0800 +++ perl/global.sym 2006-02-24 05:20:45.000000000 -0800 @@ -99,8 +99,10 @@ Perl_delimcpy Perl_die Perl_dounwind +Perl_do_aexec Perl_do_binmode Perl_do_close +Perl_do_exec Perl_do_aspawn Perl_do_spawn Perl_do_spawn_nowait ==== //depot/maint-5.8/perl/gv.c#64 (text) ==== Index: perl/gv.c --- perl/gv.c#63~27305~ 2006-02-24 03:35:40.000000000 -0800 +++ perl/gv.c 2006-02-24 05:20:45.000000000 -0800 @@ -402,20 +402,6 @@ } /* -=for apidoc gv_fetchmethod - -See L<gv_fetchmethod_autoload>. - -=cut -*/ - -GV * -Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name) -{ - return gv_fetchmethod_autoload(stash, name, TRUE); -} - -/* =for apidoc gv_fetchmethod_autoload Returns the glob which contains the subroutine to call to invoke the method ==== //depot/maint-5.8/perl/gv.h#11 (text) ==== Index: perl/gv.h --- perl/gv.h#10~26738~ 2006-01-08 13:30:11.000000000 -0800 +++ perl/gv.h 2006-02-24 05:20:45.000000000 -0800 @@ -164,3 +164,4 @@ #define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE) #define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE) +#define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE) ==== //depot/maint-5.8/perl/hv.c#77 (text) ==== Index: perl/hv.c --- perl/hv.c#76~27266~ 2006-02-21 15:57:15.000000000 -0800 +++ perl/hv.c 2006-02-24 05:20:45.000000000 -0800 @@ -1668,6 +1668,8 @@ return HvTOTALKEYS(hv); } /* +hv_iternext is implemented as a macro in hv.h + =for apidoc hv_iternext Returns entries from a hash iterator. See C<hv_iterinit>. @@ -1680,16 +1682,6 @@ your iterator immediately else the entry will leak - call C<hv_iternext> to trigger the resource deallocation. -=cut -*/ - -HE * -Perl_hv_iternext(pTHX_ HV *hv) -{ - return hv_iternext_flags(hv, 0); -} - -/* =for apidoc hv_iternext_flags Returns entries from a hash iterator. See C<hv_iterinit> and C<hv_iternext>. @@ -1900,6 +1892,9 @@ } /* + +Now a macro in hv.h + =for apidoc hv_magic Adds magic to a hash. See C<sv_magic>. @@ -1907,22 +1902,6 @@ =cut */ -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 - /* possibly free a shared string if no one has access to it * len and hash must both be valid for str. */ ==== //depot/maint-5.8/perl/hv.h#21 (text) ==== Index: perl/hv.h --- perl/hv.h#20~27157~ 2006-02-11 02:48:48.000000000 -0800 +++ perl/hv.h 2006-02-24 05:20:45.000000000 -0800 @@ -339,6 +339,9 @@ /* Flags for hv_iternext_flags. */ #define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */ +#define hv_iternext(hv) hv_iternext_flags(hv, 0) +#define hv_magic(hv, gv, how) sv_magic((SV*)(hv), (SV*)(gv), how, Nullch, 0) + /* available as a function in hv.c */ #define Perl_sharepvn(sv, len, hash) HEK_KEY(share_hek(sv, len, hash)) #define sharepvn(sv, len, hash) Perl_sharepvn(sv, len, hash) ==== //depot/maint-5.8/perl/intrpvar.h#44 (text) ==== Index: perl/intrpvar.h --- perl/intrpvar.h#43~27266~ 2006-02-21 15:57:15.000000000 -0800 +++ perl/intrpvar.h 2006-02-24 05:20:45.000000000 -0800 @@ -544,8 +544,8 @@ /* Hooks to shared SVs and locks. */ PERLVARI(Isharehook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nosharing)) -PERLVARI(Ilockhook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nolocking)) -PERLVARI(Iunlockhook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nounlocking)) +PERLVARI(Ilockhook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nosharing)) +PERLVARI(Iunlockhook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nosharing)) PERLVARI(Ithreadhook, thrhook_proc_t, MEMBER_TO_FPTR(Perl_nothreadhook)) /* Force inclusion of both runops options */ ==== //depot/maint-5.8/perl/locale.c#16 (text) ==== Index: perl/locale.c --- perl/locale.c#15~25673~ 2005-09-30 10:13:04.000000000 -0700 +++ perl/locale.c 2006-02-24 05:20:45.000000000 -0800 @@ -542,13 +542,6 @@ return ok; } -/* Backwards compatibility. */ -int -Perl_init_i18nl14n(pTHX_ int printwarn) -{ - return init_i18nl10n(printwarn); -} - #ifdef USE_LOCALE_COLLATE /* ==== //depot/maint-5.8/perl/mathoms.c#4 (text) ==== Index: perl/mathoms.c --- perl/mathoms.c#3~27308~ 2006-02-24 04:11:35.000000000 -0800 +++ perl/mathoms.c 2006-02-24 05:20:45.000000000 -0800 @@ -27,6 +27,7 @@ #define PERL_IN_MATHOMS_C #include "perl.h" +#if 0 /* ref() is now a macro using Perl_doref; * this version provided for binary compatibility only. */ @@ -35,6 +36,7 @@ { return doref(o, type, TRUE); } +#endif /* =for apidoc sv_unref @@ -66,6 +68,7 @@ sv_magic((sv), Nullsv, PERL_MAGIC_taint, Nullch, 0); } +#if 0 /* sv_2iv() is now a macro using Perl_sv_2iv_flags(); * this function provided for binary compatibility only */ @@ -85,6 +88,7 @@ { return sv_2uv_flags(sv, SV_GMAGIC); } +#endif /* sv_2pv() is now a macro using Perl_sv_2pv_flags(); * this function provided for binary compatibility only @@ -406,57 +410,6 @@ 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_ 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, ...) { @@ -491,69 +444,6 @@ } #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, GV *gv) @@ -580,6 +470,42 @@ gv_efullname4(sv, gv, prefix, TRUE); } +/* +=for apidoc gv_fetchmethod + +See L<gv_fetchmethod_autoload>. + +=cut +*/ + +GV * +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) { @@ -696,6 +622,113 @@ } #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) +{ +#ifdef USE_5005THREADS + dSP; + EXTEND(SP, 1); + if (PL_op->op_private & OPpLVAL_INTRO) + PUSHs(*save_threadsv(PL_op->op_targ)); + else + PUSHs(THREADSV(PL_op->op_targ)); + RETURN; +#else + DIE(aTHX_ "tried to access per-thread data in non-threaded perl"); +#endif /* USE_5005THREADS */ +} + +PP(pp_mapstart) +{ + DIE(aTHX_ "panic: mapstart"); /* uses grepstart */ +} + +bool +Perl_is_utf8_string_loc(pTHX_ U8 *s, STRLEN len, U8 **ep) +{ + return is_utf8_string_loclen(s, len, (const U8 **)ep, 0); +} + +U8 * +Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv) +{ + return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 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); +} + /* * Local variables: * c-indentation-style: bsd ==== //depot/maint-5.8/perl/op.c#124 (text) ==== Index: perl/op.c --- perl/op.c#123~27303~ 2006-02-24 02:56:28.000000000 -0800 +++ perl/op.c 2006-02-24 05:20:45.000000000 -0800 @@ -1896,13 +1896,6 @@ return o; } -/* XXX kept for BINCOMPAT only */ -void -Perl_save_hints(pTHX) -{ - Perl_croak(aTHX_ "internal error: obsolete function save_hints() called"); -} - int Perl_block_start(pTHX_ int full) { @@ -4884,15 +4877,6 @@ } OP * -Perl_oopsCV(pTHX_ OP *o) -{ - Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__); - /* STUB */ - PERL_UNUSED_ARG(o); - NORETURN_FUNCTION_END; -} - -OP * Perl_newCVREF(pTHX_ I32 flags, OP *o) { return newUNOP(OP_RV2CV, flags, scalar(o)); @@ -5936,16 +5920,6 @@ return o; } -#if 0 -OP * -Perl_ck_retarget(pTHX_ OP *o) -{ - Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__); - /* STUB */ - return o; -} -#endif - OP * Perl_ck_select(pTHX_ OP *o) { ==== //depot/maint-5.8/perl/perl.h#104 (text) ==== Index: perl/perl.h --- perl/perl.h#103~27308~ 2006-02-24 04:11:35.000000000 -0800 +++ perl/perl.h 2006-02-24 05:20:45.000000000 -0800 @@ -4865,9 +4865,6 @@ do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0) #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION # define do_exec(cmd) do_exec3(cmd,0,0) -#else -/* do_exec is a real function implemented in a platform specific file. */ -# define do_exec Perl_do_exec #endif #ifdef OS2 # define do_aexec Perl_do_aexec ==== //depot/maint-5.8/perl/perlio.c#73 (text) ==== Index: perl/perlio.c --- perl/perlio.c#72~27303~ 2006-02-24 02:56:28.000000000 -0800 +++ perl/perlio.c 2006-02-24 05:20:45.000000000 -0800 @@ -112,6 +112,69 @@ else \ SETERRNO(EBADF, SS_IVCHAN) +#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 */ + #ifndef O_ACCMODE #define O_ACCMODE 3 /* Assume traditional implementation */ #endif ==== //depot/maint-5.8/perl/pp.c#87 (text) ==== Index: perl/pp.c --- perl/pp.c#86~27284~ 2006-02-23 06:49:22.000000000 -0800 +++ perl/pp.c 2006-02-24 05:20:45.000000000 -0800 @@ -127,11 +127,6 @@ RETURN; } -PP(pp_padany) -{ - DIE(aTHX_ "NOT IMPL LINE %d",__LINE__); -} - /* Translations. */ PP(pp_rv2gv) @@ -4813,21 +4808,6 @@ RETURN; } -PP(pp_threadsv) -{ -#ifdef USE_5005THREADS - dSP; - EXTEND(SP, 1); - if (PL_op->op_private & OPpLVAL_INTRO) - PUSHs(*save_threadsv(PL_op->op_targ)); - else - PUSHs(THREADSV(PL_op->op_targ)); - RETURN; -#else - DIE(aTHX_ "tried to access per-thread data in non-threaded perl"); -#endif /* USE_5005THREADS */ -} - /* * Local variables: * c-indentation-style: bsd ==== //depot/maint-5.8/perl/pp_ctl.c#111 (text) ==== Index: perl/pp_ctl.c --- perl/pp_ctl.c#110~26692~ 2006-01-06 16:24:12.000000000 -0800 +++ perl/pp_ctl.c 2006-02-24 05:20:45.000000000 -0800 @@ -881,11 +881,6 @@ return ((LOGOP*)PL_op->op_next)->op_other; } -PP(pp_mapstart) -{ - DIE(aTHX_ "panic: mapstart"); /* uses grepstart */ -} - PP(pp_mapwhile) { dSP; ==== //depot/maint-5.8/perl/pp_hot.c#92 (text) ==== Index: perl/pp_hot.c --- perl/pp_hot.c#91~26738~ 2006-01-08 13:30:11.000000000 -0800 +++ perl/pp_hot.c 2006-02-24 05:20:45.000000000 -0800 @@ -1655,7 +1655,7 @@ const U8 *f; if (ckWARN(WARN_UTF8) && - !Perl_is_utf8_string_loc(aTHX_ (U8 *) s, len, (U8 **) &f)) + !is_utf8_string_loc((U8 *) s, len, (U8 **) &f)) /* Emulate :encoding(utf8) warning in the same case. */ Perl_warner(aTHX_ packWARN(WARN_UTF8), "utf8 \"\\x%02X\" does not map to Unicode", ==== //depot/maint-5.8/perl/proto.h#119 (text+w) ==== Index: perl/proto.h --- perl/proto.h#118~27308~ 2006-02-24 04:11:35.000000000 -0800 +++ perl/proto.h 2006-02-24 05:20:45.000000000 -0800 @@ -265,7 +265,13 @@ PERL_CALLCONV void Perl_do_chop(pTHX_ SV* asv, SV* sv); PERL_CALLCONV bool Perl_do_close(pTHX_ GV* gv, bool not_implicit); PERL_CALLCONV bool Perl_do_eof(pTHX_ GV* gv); + +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION /* PERL_CALLCONV bool Perl_do_exec(pTHX_ char* cmd); */ +#else +PERL_CALLCONV bool Perl_do_exec(pTHX_ char* cmd); +#endif + #if defined(WIN32) PERL_CALLCONV int Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp); PERL_CALLCONV int Perl_do_spawn(pTHX_ char* cmd); @@ -353,7 +359,7 @@ PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name); PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level); PERL_CALLCONV GV* Perl_gv_fetchmeth_autoload(pTHX_ HV* stash, const char* name, STRLEN len, I32 level); -PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name); +/* PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name); */ PERL_CALLCONV GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload); PERL_CALLCONV GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type); PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, GV* gv); @@ -383,8 +389,8 @@ PERL_CALLCONV SV* Perl_hv_iterkeysv(pTHX_ HE* entry) __attribute__warn_unused_result__; -PERL_CALLCONV HE* Perl_hv_iternext(pTHX_ HV* tb) - __attribute__warn_unused_result__; +/* PERL_CALLCONV HE* Perl_hv_iternext(pTHX_ HV* tb) + __attribute__warn_unused_result__; */ PERL_CALLCONV SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen) __attribute__warn_unused_result__; @@ -396,7 +402,7 @@ __attribute__warn_unused_result__; PERL_CALLCONV void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax); -PERL_CALLCONV void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how); +/* PERL_CALLCONV void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how); */ PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash); PERL_CALLCONV HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash); PERL_CALLCONV SV** Perl_hv_store_flags(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash, int flags); @@ -561,7 +567,7 @@ __attribute__pure__; PERL_CALLCONV STRLEN Perl_is_utf8_char(pTHX_ U8 *p); -PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ U8 *s, STRLEN len, U8 **p); +/* PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ U8 *s, STRLEN len, U8 **p); */ PERL_CALLCONV bool Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len); PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ U8 *p) __attribute__warn_unused_result__; @@ -1231,11 +1237,12 @@ PERL_CALLCONV void Perl_sv_setpv(pTHX_ SV* sv, const char* ptr); PERL_CALLCONV void Perl_sv_setpvn(pTHX_ SV* sv, const char* ptr, STRLEN len); /* PERL_CALLCONV void sv_setsv(pTHX_ SV* dsv, SV* ssv); */ +/* PERL_CALLCONV void sv_taint(pTHX_ SV* sv); */ PERL_CALLCONV bool Perl_sv_tainted(pTHX_ SV* sv) __attribute__warn_unused_result__; PERL_CALLCONV int Perl_sv_unmagic(pTHX_ SV* sv, int type); -/*PERL_CALLCONV void Perl_sv_unref(pTHX_ SV* sv);*/ +/* PERL_CALLCONV void Perl_sv_unref(pTHX_ SV* sv); */ PERL_CALLCONV void Perl_sv_unref_flags(pTHX_ SV* sv, U32 flags); PERL_CALLCONV void Perl_sv_untaint(pTHX_ SV* sv); PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt); @@ -1284,10 +1291,22 @@ PERL_CALLCONV U8* Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN *len); PERL_CALLCONV UV Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen); PERL_CALLCONV UV Perl_utf8_to_uvuni(pTHX_ U8 *s, STRLEN *retlen); + +#ifdef EBCDIC PERL_CALLCONV UV Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags); +#else +/* PERL_CALLCONV UV Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags); */ +#endif + PERL_CALLCONV UV Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags); + +#ifdef EBCDIC PERL_CALLCONV U8* Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv); -PERL_CALLCONV U8* Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv); +#else +/* PERL_CALLCONV U8* Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv); */ +#endif + +/* PERL_CALLCONV U8* Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv); */ PERL_CALLCONV U8* Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); PERL_CALLCONV U8* Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); PERL_CALLCONV char* Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags); @@ -1411,7 +1430,7 @@ PERL_CALLCONV bool Perl_sv_utf8_downgrade(pTHX_ SV *sv, bool fail_ok); PERL_CALLCONV void Perl_sv_utf8_encode(pTHX_ SV *sv); PERL_CALLCONV bool Perl_sv_utf8_decode(pTHX_ SV *sv); -/*PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv);*/ +/* PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv); */ PERL_CALLCONV void Perl_sv_force_normal_flags(pTHX_ SV *sv, U32 flags); PERL_CALLCONV void Perl_tmps_grow(pTHX_ I32 n); PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *sv); @@ -1498,8 +1517,8 @@ PERL_CALLCONV void Perl_sv_nosharing(pTHX_ SV *); -PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *); -PERL_CALLCONV void Perl_sv_nounlocking(pTHX_ SV *); +/* PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *); */ +/* PERL_CALLCONV void Perl_sv_nounlocking(pTHX_ SV *); */ PERL_CALLCONV int Perl_nothreadhook(pTHX); END_EXTERN_C ==== //depot/maint-5.8/perl/utf8.c#51 (text) ==== Index: perl/utf8.c --- perl/utf8.c#50~27303~ 2006-02-24 02:56:28.000000000 -0800 +++ perl/utf8.c 2006-02-24 05:20:45.000000000 -0800 @@ -166,12 +166,6 @@ #endif #endif /* Loop style */ } - -U8 * -Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv) -{ - return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0); -} /* @@ -307,6 +301,16 @@ } /* +Implemented as a macro in utf8.h + +=for apidoc A|bool|is_utf8_string_loc|const U8 *s|STRLEN len|const U8 **ep + +Like is_utf8_string() but stores the location of the failure (in the +case of "utf8ness failure") or the location s+len (in the case of +"utf8ness success") in the C<ep>. + +See also is_utf8_string_loclen() and is_utf8_string(). + =for apidoc A|bool|is_utf8_string_loclen|const U8 *s|STRLEN len|const U8 **ep|const STRLEN *el Like is_utf8_string() but stores the location of the failure (in the @@ -368,24 +372,7 @@ } /* -=for apidoc A|bool|is_utf8_string_loc|const U8 *s|STRLEN len|const U8 **ep|const STRLEN *el - -Like is_utf8_string() but stores the location of the failure (in the -case of "utf8ness failure") or the location s+len (in the case of -"utf8ness success") in the C<ep>. - -See also is_utf8_string_loclen() and is_utf8_string(). - -=cut -*/ - -bool -Perl_is_utf8_string_loc(pTHX_ U8 *s, STRLEN len, U8 **ep) -{ - return is_utf8_string_loclen(s, len, (const U8 **)ep, 0); -} -/* =for apidoc A|UV|utf8n_to_uvuni|U8 *s|STRLEN curlen|STRLEN *retlen|U32 flags Bottom level UTF-8 decode routine. @@ -627,8 +614,8 @@ UV Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen) { - return Perl_utf8n_to_uvchr(aTHX_ s, UTF8_MAXBYTES, retlen, - ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + return utf8n_to_uvchr(s, UTF8_MAXBYTES, retlen, + ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); } /* @@ -1251,40 +1238,29 @@ } bool -Perl_is_utf8_alnum(pTHX_ U8 *p) +S_is_utf8_common(pTHX_ const U8 *const p, SV **swash, + const char *const swashname) { if (!is_utf8_char(p)) return FALSE; - if (!PL_utf8_alnum) - /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true - * descendant of isalnum(3), in other words, it doesn't - * contain the '_'. --jhi */ - PL_utf8_alnum = swash_init("utf8", "IsWord", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_alnum, p, TRUE) != 0; -/* return *p == '_' || is_utf8_alpha(p) || is_utf8_digit(p); */ -#ifdef SURPRISINGLY_SLOWER /* probably because alpha is usually true */ - if (!PL_utf8_alnum) - PL_utf8_alnum = swash_init("utf8", "", - sv_2mortal(newSVpv("+utf8::IsAlpha\n+utf8::IsDigit\n005F\n",0)), 0, 0); - return swash_fetch(PL_utf8_alnum, p, TRUE) != 0; -#endif + if (!*swash) + *swash = swash_init("utf8", swashname, &PL_sv_undef, 0, 0); + return swash_fetch(*swash, p, TRUE) != 0; +} + +bool +Perl_is_utf8_alnum(pTHX_ U8 *p) +{ + /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true + * descendant of isalnum(3), in other words, it doesn't + * contain the '_'. --jhi */ + return S_is_utf8_common(aTHX_ p, &PL_utf8_alnum, "IsWord"); } bool Perl_is_utf8_alnumc(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_alnumc) - PL_utf8_alnumc = swash_init("utf8", "IsAlnumC", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_alnumc, p, TRUE) != 0; -/* return is_utf8_alpha(p) || is_utf8_digit(p); */ -#ifdef SURPRISINGLY_SLOWER /* probably because alpha is usually true */ - if (!PL_utf8_alnum) - PL_utf8_alnum = swash_init("utf8", "", - sv_2mortal(newSVpv("+utf8::IsAlpha\n+utf8::IsDigit\n005F\n",0)), 0, 0); - return swash_fetch(PL_utf8_alnum, p, TRUE) != 0; -#endif + return S_is_utf8_common(aTHX_ p, &PL_utf8_alnumc, "IsAlnumC"); } bool @@ -1292,11 +1268,8 @@ { if (*p == '_') return TRUE; - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_idstart) /* is_utf8_idstart would be more logical. */ - PL_utf8_idstart = swash_init("utf8", "IdStart", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_idstart, p, TRUE) != 0; + /* is_utf8_idstart would be more logical. */ + return S_is_utf8_common(aTHX_ p, &PL_utf8_idstart, "IdStart"); } bool @@ -1304,131 +1277,79 @@ { if (*p == '_') return TRUE; - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_idcont) - PL_utf8_idcont = swash_init("utf8", "IdContinue", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_idcont, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_idcont, "IdContinue"); } bool Perl_is_utf8_alpha(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_alpha) - PL_utf8_alpha = swash_init("utf8", "IsAlpha", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_alpha, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_alpha, "IsAlpha"); } bool Perl_is_utf8_ascii(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_ascii) - PL_utf8_ascii = swash_init("utf8", "IsAscii", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_ascii, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_ascii, "IsAscii"); } bool Perl_is_utf8_space(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_space) - PL_utf8_space = swash_init("utf8", "IsSpacePerl", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_space, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_space, "IsSpacePerl"); } bool Perl_is_utf8_digit(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_digit) - PL_utf8_digit = swash_init("utf8", "IsDigit", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_digit, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_digit, "IsDigit"); } bool Perl_is_utf8_upper(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_upper) - PL_utf8_upper = swash_init("utf8", "IsUppercase", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_upper, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_upper, "IsUppercase"); } bool Perl_is_utf8_lower(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_lower) - PL_utf8_lower = swash_init("utf8", "IsLowercase", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_lower, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_lower, "IsLowercase"); } bool Perl_is_utf8_cntrl(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_cntrl) - PL_utf8_cntrl = swash_init("utf8", "IsCntrl", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_cntrl, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_cntrl, "IsCntrl"); } bool Perl_is_utf8_graph(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_graph) - PL_utf8_graph = swash_init("utf8", "IsGraph", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_graph, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_graph, "IsGraph"); } bool Perl_is_utf8_print(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_print) - PL_utf8_print = swash_init("utf8", "IsPrint", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_print, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_print, "IsPrint"); } bool Perl_is_utf8_punct(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_punct) - PL_utf8_punct = swash_init("utf8", "IsPunct", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_punct, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_punct, "IsPunct"); } bool Perl_is_utf8_xdigit(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_xdigit) - PL_utf8_xdigit = swash_init("utf8", "IsXDigit", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_xdigit, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_xdigit, "Isxdigit"); } bool Perl_is_utf8_mark(pTHX_ U8 *p) { - if (!is_utf8_char(p)) - return FALSE; - if (!PL_utf8_mark) - PL_utf8_mark = swash_init("utf8", "IsM", &PL_sv_undef, 0, 0); - return swash_fetch(PL_utf8_mark, p, TRUE) != 0; + return S_is_utf8_common(aTHX_ p, &PL_utf8_mark, "IsM"); } /* @@ -1830,6 +1751,32 @@ return 0; } +/* +=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 +*/ +U8 * +Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv) +{ + return Perl_uvuni_to_utf8_flags(aTHX_ d, NATIVE_TO_UNI(uv), 0); +} + U8 * Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) { @@ -1837,6 +1784,29 @@ } /* +=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 +*/ +UV +Perl_utf8n_to_uvchr(pTHX_ 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); +} + +/* =for apidoc A|char *|pv_uni_display|SV *dsv|U8 *spv|STRLEN len|STRLEN pvlim|UV flags Build to the scalar dsv a displayable version of the string spv, ==== //depot/maint-5.8/perl/utf8.h#14 (text) ==== Index: perl/utf8.h --- perl/utf8.h#13~26738~ 2006-01-08 13:30:11.000000000 -0800 +++ perl/utf8.h 2006-02-24 05:20:45.000000000 -0800 @@ -58,8 +58,8 @@ #define ASCII_TO_NEED(enc,ch) (ch) /* As there are no translations avoid the function wrapper */ -#define Perl_utf8n_to_uvchr Perl_utf8n_to_uvuni -#define Perl_uvchr_to_utf8 Perl_uvuni_to_utf8 +#define utf8n_to_uvchr utf8n_to_uvuni +#define uvchr_to_utf8 uvuni_to_utf8 /* @@ -332,4 +332,8 @@ #define IS_UTF8_CHAR_FAST(n) ((n) <= 4) +#define is_utf8_string_loc(s, len, ep) is_utf8_string_loclen(s, len, ep, 0) + +#define uvuni_to_utf8(d, uv) uvuni_to_utf8_flags(d, uv, 0) + #endif /* IS_UTF8_CHAR() for UTF-8 */ ==== //depot/maint-5.8/perl/util.c#96 (text) ==== Index: perl/util.c --- perl/util.c#95~26738~ 2006-01-08 13:30:11.000000000 -0800 +++ perl/util.c 2006-02-24 05:20:45.000000000 -0800 @@ -4430,8 +4430,9 @@ =for apidoc sv_nosharing Dummy routine which "shares" an SV when there is no sharing module present. -Exists to avoid test for a NULL function pointer and because it could potentially warn under -some level of strict-ness. +Or "locks" it. Or "unlocks" it. In other words, ignores its single SV argument. +Exists to avoid test for a NULL function pointer and because it could +potentially warn under some level of strict-ness. =cut */ @@ -4442,39 +4443,6 @@ PERL_UNUSED_ARG(sv); } -/* -=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. - -=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. - -=cut -*/ - -void -Perl_sv_nounlocking(pTHX_ SV *sv) -{ - PERL_UNUSED_ARG(sv); -} - U32 Perl_parse_unicode_opts(pTHX_ char **popt) { End of Patch.