X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=embed.pl;h=3d4f3bb76bdca952d46710b53cce247f659a65b1;hb=f805f8cce32dfd1ced3ebf12975766f50f88ec0c;hp=8a8910338021d5c2583afd35db83e86b11351d7f;hpb=f4dd75d9918abbf789a5eca453b89168cad18ff0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/embed.pl b/embed.pl
index 8a89103..3d4f3bb 100755
--- a/embed.pl
+++ b/embed.pl
@@ -916,6 +916,9 @@ START_EXTERN_C
 			{ return &(PL_##v); }
 #define PERLVARA(v,n,t)	PL_##v##_t* Perl_##v##_ptr(pTHXo)		\
 			{ return &(PL_##v); }
+#undef PERLVARIC
+#define PERLVARIC(v,t,i)	const t* Perl_##v##_ptr(pTHXo)		\
+			{ return (const t *)&(PL_##v); }
 #include "perlvars.h"
 
 #undef PERLVAR
@@ -1078,12 +1081,12 @@ my %apidocs;
 my %gutsdocs;
 my %docfuncs;
 
-sub autodoc ($) { # parse a file and extract documentation info
-    my($fh) = @_;
-    my($in, $doc);
-
+sub autodoc ($$) { # parse a file and extract documentation info
+    my($fh,$file) = @_;
+    my($in, $doc, $line);
 FUNC:
     while (defined($in = <$fh>)) {
+	$line++;
 	if ($in =~ /^=for\s+apidoc\s+(.*)\n/) {
 	    my $proto = $1;
 	    $proto = "||$proto" unless $proto =~ /\|/;
@@ -1091,24 +1094,33 @@ FUNC:
 	    my $docs = "";
 DOC:
 	    while (defined($doc = <$fh>)) {
+		$line++;
 		last DOC if $doc =~ /^=\w+/;
+		if ($doc =~ m:^\*/$:) {
+		    warn "=cut missing? $file:$line:$doc";;
+		    last DOC;
+		}
 		$docs .= $doc;
 	    }
 	    $docs = "\n$docs" if $docs and $docs !~ /^\n/;
 	    if ($flags =~ /m/) {
 		if ($flags =~ /A/) {
-		    $apidocs{$name} = [$flags, $docs, $ret, @args];
+		    $apidocs{$name} = [$flags, $docs, $ret, $file, @args];
 		}
 		else {
-		    $gutsdocs{$name} = [$flags, $docs, $ret, @args];
+		    $gutsdocs{$name} = [$flags, $docs, $ret, $file, @args];
 		}
 	    }
 	    else {
-		$docfuncs{$name} = [$flags, $docs, $ret, @args];
+		$docfuncs{$name} = [$flags, $docs, $ret, $file, @args];
 	    }
-	    if ($doc =~ /^=for/) {
-		$in = $doc;
-		redo FUNC;
+	    if (defined $doc) {
+		if ($doc =~ /^=for/) {
+		    $in = $doc;
+		    redo FUNC;
+		}
+	    } else {
+		warn "$file:$line:$in";
 	    }
 	}
     }
@@ -1116,7 +1128,7 @@ DOC:
 
 sub docout ($$$) { # output the docs for one function
     my($fh, $name, $docref) = @_;
-    my($flags, $docs, $ret, @args) = @$docref;
+    my($flags, $docs, $ret, $file, @args) = @$docref;
 
     $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" 
 	if $flags =~ /p/;
@@ -1134,12 +1146,13 @@ sub docout ($$$) { # output the docs for one function
 	print $fh "(" . join(", ", @args) . ")";
 	print $fh "\n\n";
     }
+    print $fh "=for hackers\nFound in file $file\n\n";
 }
 
 my $file;
 for $file (glob('*.c'), glob('*.h')) {
     open F, "< $file" or die "Cannot open $file for docs: $!\n";
-    autodoc(\*F);
+    autodoc(\*F,$file);
     close F or die "Error closing $file: $!\n";
 }
 
@@ -1156,16 +1169,20 @@ walk_table {	# load documented functions into approriate hash
 	if ($flags =~ /A/) {
 	    my $docref = delete $docfuncs{$func};
 	    warn "no docs for $func\n" unless $docref and @$docref;
-	    $apidocs{$func} = [$docref->[0] . 'A', $docref->[1], $retval, @args];
+	    $apidocs{$func} = [$docref->[0] . 'A', $docref->[1], $retval,
+			       $docref->[3], @args];
 	} else {
 	    my $docref = delete $docfuncs{$func};
-	    $gutsdocs{$func} = [$docref->[0], $docref->[1], $retval, @args];
+	    $gutsdocs{$func} = [$docref->[0], $docref->[1], $retval,
+				$docref->[3], @args];
 	}
     }
     return "";
 } \*DOC;
 
 for (sort keys %docfuncs) {
+    # Have you used a full for apidoc or just a func name?  
+    # Have you used Ap instead of Am in the for apidoc?
     warn "Unable to place $_!\n";
 }
 
@@ -1358,6 +1375,7 @@ Ap	|bool	|Gv_AMupdate	|HV* stash
 p	|OP*	|append_elem	|I32 optype|OP* head|OP* tail
 p	|OP*	|append_list	|I32 optype|LISTOP* first|LISTOP* last
 p	|I32	|apply		|I32 type|SV** mark|SV** sp
+Afp	|void	|apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len
 Ap	|SV*	|avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash
 Ap	|bool	|avhv_exists_ent|AV *ar|SV* keysv|U32 hash
 Ap	|SV**	|avhv_fetch_ent	|AV *ar|SV* keysv|I32 lval|U32 hash
@@ -1603,6 +1621,7 @@ Ap	|U32	|to_uni_upper_lc|U32 c
 Ap	|U32	|to_uni_title_lc|U32 c
 Ap	|U32	|to_uni_lower_lc|U32 c
 Ap	|int	|is_utf8_char	|U8 *p
+Ap	|bool	|is_utf8_string	|U8 *s|STRLEN len
 Ap	|bool	|is_utf8_alnum	|U8 *p
 Ap	|bool	|is_utf8_alnumc	|U8 *p
 Ap	|bool	|is_utf8_idfirst|U8 *p
@@ -2045,6 +2064,8 @@ Ap	|U8*	|utf16_to_utf8	|U16* p|U8 *d|I32 bytelen
 Ap	|U8*	|utf16_to_utf8_reversed|U16* p|U8 *d|I32 bytelen
 Ap	|I32	|utf8_distance	|U8 *a|U8 *b
 Ap	|U8*	|utf8_hop	|U8 *s|I32 off
+Ap	|U8*	|utf8_to_bytes	|U8 *s|STRLEN len
+Ap	|U8*	|bytes_to_utf8	|U8 *s|STRLEN *len
 Ap	|UV	|utf8_to_uv	|U8 *s|I32* retlen
 Ap	|U8*	|uv_to_utf8	|U8 *d|UV uv
 p	|void	|vivify_defelem	|SV* sv
@@ -2085,6 +2106,9 @@ Ap	|struct perl_vars *|GetVars
 #endif
 Ap	|int	|runops_standard
 Ap	|int	|runops_debug
+#if defined(USE_THREADS)
+Ap	|SV*	|sv_lock	|SV *sv
+#endif
 Afpd	|void	|sv_catpvf_mg	|SV *sv|const char* pat|...
 Ap	|void	|sv_vcatpvf_mg	|SV* sv|const char* pat|va_list* args
 Apd	|void	|sv_catpv_mg	|SV *sv|const char *ptr
@@ -2164,6 +2188,7 @@ Ap	|void	|ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
 Ap	|void	|ptr_table_split|PTR_TBL_t *tbl
 #endif
 #if defined(HAVE_INTERP_INTERN)
+Ap	|void	|sys_intern_clear
 Ap	|void	|sys_intern_init
 #endif
 
@@ -2179,16 +2204,12 @@ s	|I32	|avhv_index	|AV* av|SV* sv|U32 hash
 #endif
 
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
-s	|I32	|do_trans_CC_simple	|SV *sv
-s	|I32	|do_trans_CC_count	|SV *sv
-s	|I32	|do_trans_CC_complex	|SV *sv
-s	|I32	|do_trans_UU_simple	|SV *sv
-s	|I32	|do_trans_UU_count	|SV *sv
-s	|I32	|do_trans_UU_complex	|SV *sv
-s	|I32	|do_trans_UC_simple	|SV *sv
-s	|I32	|do_trans_CU_simple	|SV *sv
-s	|I32	|do_trans_UC_trivial	|SV *sv
-s	|I32	|do_trans_CU_trivial	|SV *sv
+s	|I32	|do_trans_simple	|SV *sv
+s	|I32	|do_trans_count		|SV *sv
+s	|I32	|do_trans_complex	|SV *sv
+s	|I32	|do_trans_simple_utf8	|SV *sv
+s	|I32	|do_trans_count_utf8	|SV *sv
+s	|I32	|do_trans_complex_utf8	|SV *sv
 #endif
 
 #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
@@ -2235,6 +2256,7 @@ s	|char*	|gv_ename	|GV *gv
 s	|void	|cv_dump	|CV *cv
 s	|CV*	|cv_clone2	|CV *proto|CV *outside
 s	|bool	|scalar_mod_type|OP *o|I32 type
+s	|OP *	|method_2entersub|OP *o|OP *o2|OP *svop
 s	|OP *	|my_kid		|OP *o|OP *attrs
 s	|OP *	|dup_attrlist	|OP *o
 s	|void	|apply_attrs	|HV *stash|SV *target|OP *attrs
@@ -2453,6 +2475,7 @@ s	|char*	|scan_trans	|char *start
 s	|char*	|scan_word	|char *s|char *dest|STRLEN destlen \
 				|int allow_package|STRLEN *slp
 s	|char*	|skipspace	|char *s
+s	|char*	|swallow_bom	|char *s
 s	|void	|checkcomma	|char *s|char *name|char *what
 s	|void	|force_ident	|char *s|int kind
 s	|void	|incline	|char *s
@@ -2466,6 +2489,7 @@ s	|I32	|sublex_done
 s	|I32	|sublex_push
 s	|I32	|sublex_start
 s	|char *	|filter_gets	|SV *sv|PerlIO *fp|STRLEN append
+s	|HV *	|find_in_my_stash|char *pkgname|I32 len
 s	|SV*	|new_constant	|char *s|STRLEN len|const char *key|SV *sv \
 				|SV *pv|const char *type
 s	|int	|ao		|int toketype