if (-f
$file && !-w
$file)
chmod(0666,$file) || warn "Cannot change permissions on $file:$!";
open($fh,">$file") || return 0;
chmod(0444,$file) || warn "Cannot change permissions on $file:$!";
die "Unknown \$win_arch" unless $win_arch eq 'open32'
or $win_arch eq 'MSWin32';
#if (defined(__WIN32__) || defined(__PM__)) && !defined(DO_X_EXCLUDE)
if (/^([A-Za-z][A-Za-z0-9_]*)/)
warn "Cannot open $cfile:$!";
if (/^([A-Za-z][A-Za-z0-9_]*)/)
warn "Cannot open $cfile:$!";
if (/{\s*\"[^\"]+\"\s*,\s*(\w+)\s*}/)
warn "Cannot open $cfile:$!";
open(H
,"<$hfile") || die "Cannot open $hfile:$!";
if (/^\s*(MOVEXT|COREXT|EXTERN|extern)\s*(.*?)\s*(\w+)\s+_ANSI_ARGS_\s*\((TCL_VARARGS)?\(/)
my ($type,$name,$op) = ($2,$3,$4);
if ($1 eq 'MOVEXT' || $1 eq 'COREXT')
$op = "" unless (defined $op);
my $defn = "VFUNC($type,$name,V_$name,_ANSI_ARGS_($op(";
elsif (/^\s*(MOVEXT|COREXT|EXTERN|extern)\s*(.*?)\s*(\w+)\s*;/)
my ($type,$name) = ($2,$3);
if ($1 eq 'MOVEXT
' || $1 eq 'COREXT
')
$VVar{$name} = "VVAR($type,$name,V_$name)\n";
elsif (/\b(EXTERN|extern)\s+[\w_]+\s+[\w_]+\[\];$/)
elsif (/\b(EXTERN|extern)\s*"C"\s*\{\s*$/)
elsif (/\b(EXTERN|extern)\b/)
warn "$hfile:$.: $_" unless (/^\s*\#\s*define/);
if (keys %VFunc || keys %VVar)
my $name = "\u\L${gard}\UV";
$mdef .= 'dmy
' unless $opt{'m
'};
$fdef .= 'dmy
' unless $opt{'t
'};
$htfile =~ s/\..*$/_f.h/;
openRO(\*C,$htfile) || die "Cannot open $htfile:$!";
print C "#ifndef ${gard}_VT\n";
print C "#define ${gard}_VT\n";
print C "typedef struct ${name}tab\n{\n";
print C "#define VFUNC(type,name,mem,args) type (*mem) args;\n";
print C "#define VVAR(type,name,mem) type (*mem);\n";
print C "#include \"$fdef\"\n";
print C "#undef VFUNC\n";
print C "} ${name}tab;\n";
print C "extern ${name}tab *${name}ptr;\n";
print C "extern ${name}tab *${name}Get _ANSI_ARGS_((void));\n";
print C "#endif /* ${gard}_VT */\n";
openRO(\*C,$cfile) || die "Cannot open $cfile:$!";
print C "#include \"$hfile\"\n";
print C "#include \"$htfile\"\n";
print C "static ${name}tab ${name}table =\n{\n";
print C "#define VFUNC(type,name,mem,args) name,\n";
print C "#define VVAR(type,name,mem) &name,\n";
print C "#include \"$fdef\"\n";
print C "#undef VFUNC\n";
print C "${name}tab *${name}ptr;\n";
print C "${name}tab *${name}Get() { return ${name}ptr = &${name}table;}\n";
openRO(\*VFUNC,$fdef) || die "Cannot open $fdef:$!";
openRO(\*VMACRO,$mdef) || die "Cannot open $mdef:$!";
print VFUNC "#ifdef _$gard\n";
print VMACRO "#ifndef _${gard}_VM\n";
print VMACRO "#define _${gard}_VM\n";
print VMACRO "#include \"$htfile\"\n";
print VMACRO "#ifndef NO_VTABLES\n";
print VMACRO $xexcl if %WinIgnore;
print VFUNC $xexcl if %WinIgnore;
foreach my $func (sort keys %VVar)
if (!exists($Exclude{$func}) && !exists($Ignore{$func}))
print VFUNC $VVar{$func};
print VMACRO "#define $func (*${name}ptr->V_$func)\n";
$Ignored{$func} = delete $Ignore{$func} if exists $Ignore{$func};
foreach my $func (sort keys %VFunc)
if (!exists($Exclude{$func}) && !exists($Ignore{$func}))
print VFUNC "#ifndef DO_X_EXCLUDE\n" if exists($WinIgnore{$func});
print VFUNC "#ifndef $func\n";
print VFUNC $VFunc{$func};
print VFUNC "#endif /* !DO_X_EXCLUDE */\n" if exists($WinIgnore{$func});
print VMACRO "#ifndef DO_X_EXCLUDE\n" if exists($WinIgnore{$func});
print VMACRO "#ifndef $func\n";
print VMACRO "# define $func (*${name}ptr->V_$func)\n";
print VMACRO "#endif /* !DO_X_EXCLUDE */\n" if exists($WinIgnore{$func});
$Ignored{$func} = delete $Ignore{$func} if exists $Ignore{$func};
print VMACRO "#endif /* NO_VTABLES */\n";
print VMACRO "#endif /* _${gard}_VM */\n";
print VFUNC "#endif /* _$gard */\n";
close(VFUNC); # Close this last - Makefile dependancy
unlink($mdef) unless $opt{'m
'};
unlink($fdef) unless $opt{'t
'};
die "Usage: $0 <some.h>\n" if (@ARGV != 1);
WinIgnore($x) if (-f $x);
foreach my $s (sort keys %Ignore)
warn "$s is not in $h\n";
rename($x,"$x.old") || die "Cannot rename $x to $x.old:$!";
open(EXC,">$x") || die "Cannot open $x:$!";
foreach my $s (sort keys %Ignored)
mkVFunc - Support for "nested" dynamic loading
B<perl/Tk> is designed so that B<Tk> can be dynamically loaded 'on top of
'
perl. That is the easy bit. What it also does is allow Tk::Xxxx to be
dynamically loaded 'on top of
' the B<perl/Tk> composite. Thus when
you 'require Tk
::HList
' the shared object F<.../HList.so> needs to be
able to call functions defined in perl I<and> functions defined in loadable
.../Tk.so . Now functions in 'base executable
' are a well known problem,
and are solved by DynaLoader. However most of dynamic loading schemes
cannot handle one loadable calling another loadable.
Thus what Tk does is build a table of functions that should be callable.
This table is auto-generated from the .h file by looking for
'extern
' (and EXTERN which is #defined to 'extern
').
Thus any function marked as 'extern
' is 'referenced
' by the table.
The address of the table is then stored in a perl variable when Tk is loaded.
When HList is loaded it looks in the perl variable (via functions
in perl - the 'base executable
') to get the address of the table.
The same utility that builds the table also builds a set of #define's
.
HList
.c
(and any other
.c files which comprise HList
) #include these
(*TkVptr
->V_Tk_SomeFunc)(x
,y
,z
)
Where Tk_ptr is pointer to the table
.
Tk
-b
*/pTk/mkVFunc
- perl script that produces tables
/tk
.h
- basis from which table is generated
/tk
.m
- #define's to include in sub-extension
/tk_f
.h
- #included both sides.
/tk_f
.c
- Actual table definition
.
/tk
.t
- 'shared' set of macros which produce table
included
in tk_f
.c
and tk_f
.h
/tkVMacro
.h
- Wrapper to include
*.m files
In addition to
/tk* there are /tkInt
*, /Lang* and /tix
*