#!/usr/local/bin/perl ## ## make.CursesVar.c -- make CursesVar.c ## ## Copyright (c) 2000 William Setzer ## ## You may distribute under the terms of either the Artistic License ## or the GNU General Public License, as specified in the README file. use lib 'gen'; use Gen; open OUT, "> CursesVar.c" or die "Can't open CursesVar.c: $!\n"; process_DATA_chunk \&print_line; process_variables \&print_function; process_DATA_chunk \&print_line; process_variables \&print_fetch; process_DATA_chunk \&print_line; process_variables \&print_store; process_DATA_chunk \&print_line; close OUT; ### ## Helpers # sub print_line { print OUT @_ } sub print_function { my $var = shift; return unless $var->{DOIT}; my $A = "ST(0)"; my $N = $var->{NAME}; my $body = eval qq("$var->{M_RETN}"); print OUT Q<{NAME}) # { # dXSARGS; # #ifdef \UC_$var->{NAME}\E # c_exactargs("$var->{NAME}", items, 0); # { # ST(0) = sv_newmortal(); # $body; # } # XSRETURN(1); # #else # c_var_not_there("$var->{NAME}"); # XSRETURN(0); # #endif # } # ################ AAA } sub print_fetch { my $var = shift; return unless $var->{DOIT}; my $A = "ST(0)"; my $N = $var->{NAME}; my $body = eval qq("$var->{M_RETN}"); print OUT Q<{NUM}: # #ifdef \UC_$var->{NAME}\E # $body; # #else # c_var_not_there("$var->{NAME}"); # #endif # break; ################ AAA } sub print_store { my $var = shift; return unless $var->{DOIT}; my $A = "ST(1)"; my $B = -1; my $N = $var->{NAME}; my $body = eval qq("$var->{M_DECL}"); print OUT Q<{NUM}: # #ifdef \UC_$var->{NAME}\E # $var->{NAME} = $body; # #else # c_var_not_there("$var->{NAME}"); # #endif # break; ################ AAA } ### ## Templates # __END__ /* This file can be automatically generated; changes may be lost. ** ** ** CursesVar.c -- the variables ** ** Copyright (c) 1994-2000 William Setzer ** ** You may distribute under the terms of either the Artistic License ** or the GNU General Public License, as specified in the README file. */ PAUSE XS(XS_Curses_Vars_TIESCALAR) { dXSARGS; c_exactargs("TIESCALAR", items, 2); { char * pack = (char *)SvPV(ST(0),PL_na); int n = (int)SvIV(ST(1)); ST(0) = sv_newmortal(); sv_setref_iv(ST(0), pack, n); } XSRETURN(1); } XS(XS_Curses_Vars_FETCH) { dXSARGS; { int num = (int)SvIV(SvRV((SV*)ST(0))); ST(0) = sv_newmortal(); switch (num) { PAUSE default: croak("Curses::Vars::FETCH called with bad index"); /* NOTREACHED */ } } XSRETURN(1); } XS(XS_Curses_Vars_STORE) { dXSARGS; { int num = (int)SvIV((SV*)SvRV(ST(0))); switch (num) { PAUSE default: croak("Curses::Vars::STORE called with bad index"); /* NOTREACHED */ } ST(0) = &PL_sv_yes; } XSRETURN(1); } XS(XS_Curses_Vars_DESTROY) { dXSARGS; { SV * rv = ST(0); ST(0) = &PL_sv_yes; } XSRETURN(1); }