#/* Verilog.xs -- Verilog Booter -*- C++ -*-
#* $Revision: #11 $$Date: 2002/08/07 $$Author: wsnyder $
#*********************************************************************
#*
#* DESCRIPTION: Verilog::Preproc Perl XS interface
#*
#* Author: Wilson Snyder <wsnyder@wsnyder.org>
#*
#* Code available from: http://veripool.com/
#*
#*********************************************************************
#*
#* This program is free software; you can redistribute it and/or modify
#* it under the terms of either the GNU General Public License or the
#* Perl Artistic License.
#*
#* This program is distributed in the hope that it will be useful,
#* but WITHOUT ANY WARRANTY; without even the implied warranty of
#* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#* GNU General Public License for more details.
#*
#* You should have received a copy of the Perl Artistic License
#* along with this module; see the file COPYING. If not, see
#* www.cpan.org
#*
#***********************************************************************
#* Note with C++ XS libraries, the CLASS parameter is implied...
#***********************************************************************/
/* Mine: */
#include "VPreproc.h"
/* Perl */
extern "C" {
# include "EXTERN.h"
# include "perl.h"
# include "XSUB.h"
}
#//**********************************************************************
#// Preprocessor derrived classes, so we can override the callbacks to call perl.
class VPreprocXs : public VPreproc {
public:
SV* m_self; // Class called from
int m_keepComments;
bool m_lineDirectives;
bool m_pedantic;
VPreprocXs(VFileLine* filelinep) : VPreproc(filelinep) {}
virtual ~VPreprocXs() {}
// Control methods
virtual int keepComments() { return m_keepComments; } // Return comments
virtual bool lineDirectives() { return m_lineDirectives; } // Insert `line directives
virtual bool pedantic() { return m_pedantic; } // Obey standard; Don't substitute `__FILE__ and `__LINE__
// Callback methods
virtual void comment(string filename); // Comment for keepComments=>sub
virtual void include(string filename); // Request a include file be processed
virtual void define(string name, string value); // `define without any parameters
virtual void undef(string name); // Remove a definition
virtual bool defExists(string name); // Return true if define exists
virtual string defValue(string name); // Return value of given define (should exist)
void call(string* rtnStrp, int params, const char* method, ...);
void unreadback(char* text);
};
class VFileLineXs : public VFileLine {
VPreprocXs* m_vPreprocp; // Parser handling the errors
public:
VFileLineXs(int called_only_for_default) : VFileLine(called_only_for_default) {}
virtual ~VFileLineXs() { }
virtual VFileLine* create(const string filename, int lineno);
virtual void error(const string msg); // Report a error at given location
void setPreproc(VPreprocXs* pp) { m_vPreprocp=pp; }
};
#//**********************************************************************
#// Overrides error handling virtual functions to invoke callbacks
VFileLine* VFileLineXs::create(const string filename, int lineno) {
VFileLineXs* filelp = new VFileLineXs(true);
filelp->init(filename, lineno);
filelp->m_vPreprocp = m_vPreprocp;
return filelp;
}
void VFileLineXs::error(string msg) {
static string holdmsg; holdmsg = msg;
m_vPreprocp->call(NULL, 1,"error",holdmsg.c_str());
}
#//**********************************************************************
#// Overrides of virtual functions to invoke callbacks
void VPreprocXs::comment(string cmt) {
static string holdcmt; holdcmt = cmt;
call(NULL, 1,"comment",holdcmt.c_str());
}
void VPreprocXs::include(string filename) {
static string holdfilename; holdfilename = filename;
call(NULL, 1,"include",holdfilename.c_str());
}
void VPreprocXs::undef(string define) {
static string holddefine; holddefine = define;
call(NULL, 1,"undef", holddefine.c_str());
}
void VPreprocXs::define(string define, string value) {
static string holddefine; holddefine = define;
static string holdvalue; holdvalue = value;
call(NULL, 2,"define", holddefine.c_str(), holdvalue.c_str());
}
bool VPreprocXs::defExists(string define) {
static string holddefine; holddefine = define;
string existStr;
call(&existStr, 1,"def_exists", holddefine.c_str());
return (existStr.length()>0); // True if not null
}
string VPreprocXs::defValue(string define) {
static string holddefine; holddefine = define;
string valueStr;
call(&valueStr, 1,"def_value", holddefine.c_str());
return valueStr;
}
void VPreprocXs::call (
string* rtnStrp, /* If non-null, load return value here */
int params, /* Number of parameters. Negative frees the parameters */
const char* method, /* Name of method to call */
...) /* Arguments to pass to method's @_ */
{
// Call $perlself->method (passedparam1, parsedparam2)
va_list ap;
va_start(ap, method);
{
dSP; /* Initialize stack pointer */
ENTER; /* everything created after here */
SAVETMPS; /* ...is a temporary variable. */
PUSHMARK(SP); /* remember the stack pointer */
XPUSHs(m_self); /* $self-> */
while (params--) {
char *text;
SV *sv;
text = va_arg(ap, char *);
sv = newSVpv (text, 0);
XPUSHs(sv); /* token */
}
PUTBACK; /* make local stack pointer global */
if (rtnStrp) {
int rtnCount = perl_call_method ((char*)method, G_SCALAR);
SPAGAIN; /* refresh stack pointer */
if (rtnCount > 0) {
SV* sv = POPs;
//printf("RTN %ld %d %s\n", SvTYPE(sv),SvTRUE(sv),SvPV_nolen(sv));
#ifdef SvPV_nolen // Perl 5.6 and later
*rtnStrp = SvPV_nolen(sv);
#else
*rtnStrp = SvPV(sv,PL_na);
#endif
}
PUTBACK;
} else {
perl_call_method ((char*)method, G_DISCARD | G_VOID);
}
FREETMPS; /* free that return value */
LEAVE; /* ...and the XPUSHed "mortal" args.*/
}
va_end(ap);
}
#//**********************************************************************
MODULE = Verilog::Preproc PACKAGE = Verilog::Preproc
#//**********************************************************************
#// self->_new (class, keepcmt, linedir, pedantic)
static VPreprocXs *
VPreprocXs::_new (SELF, keepcmt, linedir, pedantic)
SV *SELF
int keepcmt
int linedir
int pedantic
PROTOTYPE: $$$$$
CODE:
{
VFileLineXs* filelinep = new VFileLineXs(1/*ok,for initial*/);
VPreprocXs* preprocp = new VPreprocXs(filelinep);
filelinep->setPreproc(preprocp);
preprocp->m_self = newSVsv(SELF);
preprocp->m_keepComments = keepcmt;
preprocp->m_lineDirectives = linedir;
preprocp->m_pedantic = pedantic;
RETVAL = preprocp;
}
OUTPUT: RETVAL
#//**********************************************************************
#// self->_DESTROY()
void
VPreprocXs::_DESTROY()
CODE:
{
delete THIS;
}
#//**********************************************************************
#// self->debug()
void
VPreprocXs::_debug (level)
int level
PROTOTYPE: $$
CODE:
{
THIS->debug(level);
}
#//**********************************************************************
#// self->lineno()
int
VPreprocXs::lineno ()
PROTOTYPE: $
CODE:
{
if (!THIS) XSRETURN_UNDEF;
RETVAL = (THIS->filelinep()->lineno());
}
OUTPUT: RETVAL
#//**********************************************************************
#// self->filename()
const char *
VPreprocXs::filename ()
PROTOTYPE: $
CODE:
{
if (!THIS) XSRETURN_UNDEF;
RETVAL = THIS->filelinep()->filename().c_str();
}
OUTPUT: RETVAL
#//**********************************************************************
#// self->unreadback()
void
VPreprocXs::unreadback (text)
char* text
PROTOTYPE: $$
CODE:
{
if (!THIS) XSRETURN_UNDEF;
THIS->insertUnreadback((string)text);
}
#//**********************************************************************
#// self->getline()
const char *
VPreprocXs::getline ()
PROTOTYPE: $
CODE:
{
static string holdline;
if (!THIS || THIS->isEof()) XSRETURN_UNDEF;
string lastline = THIS->getline();
holdline = lastline; // Stash it so c_str() doesn't disappear immediately
RETVAL = lastline.c_str();
}
OUTPUT: RETVAL
#//**********************************************************************
#// self->eof()
int
VPreprocXs::eof ()
PROTOTYPE: $
CODE:
{
RETVAL = THIS->isEof();
}
OUTPUT: RETVAL
#//**********************************************************************
#// self->_open (filename)
int
VPreprocXs::_open (filename)
const char *filename
PROTOTYPE: $$
CODE:
{
if (!THIS) XSRETURN_UNDEF;
THIS->open(filename);
RETVAL = 1;
}
OUTPUT: RETVAL