/*
@file Delphi2cpp.cpp
@brief Main program for a delphi2cpp conversion utility.
@author Ivan Vecerina, (C) 2003
@par CHANGE HISTORY
20031013 (some suggestions of Jorgen Bodde - others pending)
- added additional identifier mappings (i.e. PChar)
- restored proper handling of the # operator (char given as ASCII value)
20031126 (some problems reported by Mark Philip Erikson, while trying to translate sources of DevCPP)
- fixed parsing error with pascal strings of a specified size (e.g. var a: string[255] ).
- appendPlusOne: directly increment all decimal ordinal values (
- added missing support for the 'published' member access specification in delphi classes (simply -> public)
- fixed failures on DEFAULT property, ASM functions, MESSAGE and STDCALL function labels.
also a request from Grzegorz Majcher [GM]:
- allowed 'forward' keyword to be applied to a routine declaration in a unit's interface
@par PENDING CHANGE REQUESTS
- Read the list of default-mapped identifiers in a configuration/text file, to allow easy customization. [JB]
- Keep trace of type identifiers that are of a pointer type, vs. of value/struct type [JB]
- Keep info about types, so that, for example, Delphi's TObject-derived parameters [JB]
can be passed by pointer instead of by value in the translated C++ code.
Would also allow to translate '.' into '->' when appropriate.
- Support for translating 'case' within records into C unions [GM]
*/
#include "delphi_yy.h" ///< handles the reading of the pascal/delphi input file
#include "string_utils.h" ///< string manipulation utilities (path/identifier)
#include "Pasic.h"
#include <fstream>
#include <sstream>
#include <iostream>
#include <map>
#include <vector>
#include <stdexcept>
using namespace std;
// INTERNAL UTILITIES AND GLOBALS
ofstream hdst; ///< output to the written .h file
ofstream cdst; ///< output to the written .cpp file
/** Current output file (usually points to hdst or cdst).
By default, indentation, spaces and comments encountered during source file
reading are automatically forwarded to pdst -- to try to preserve code layout.
Can be set to NULL to disable this automated output. */
ostream* pdst;
bool sTokPendingIsValid = false; ///< false if sTokPending must be read
EToken sTokPending = eEOF; ///< Next token (if have been peeked/pushed back)
/// When parsing declarations, indicates the kind of scope we are in
enum EDeclScope { eUnitInterf, eUnitImpl, eFuncBody, eFuncParam, eInRecord, eInClass, eInInterf };
bool sInFunc; ///< True when parsing a function body (vs. false for a Pascal PROCEDURE).
#define QMARK "/*?*/" ///< written to output when we know something is not properly translated
#define TMARK "<###>" ///< used as a temporary token when constructing composite type definitions
/** Temporarily redirects the default output (see pdst global variable above).
Constructor sets pdst to the specified target.
Destructor restores the previous value of pdst.
*/
class pdstRedirect
{
public:
pdstRedirect(ostream& dst) : prev_(pdst) { pdst = &dst; }
pdstRedirect(ostream* dst) : prev_(pdst) { pdst = dst; }
~pdstRedirect() { pdst = prev_; }
ostream* prev() const { return prev_; }
private:
ostream* const prev_;
pdstRedirect(pdstRedirect const&); ///< Disabled copy constructor
};
/** Changes a value and automatically restore it at scope exit.
The previous value of a variable is restored upon destruction of a ScopedSet instance.
*/
template<class T>
class ScopedSet
{
public:
ScopedSet(T& var, T const& tempVal) : var_(var), oldVal_(var) { var = tempVal; }
~ScopedSet() { var_ = oldVal_; }
private:
T& var_; ///< variable whose value will be restored
T oldVal_; ///< value to be restored upon destruction
ScopedSet(ScopedSet const&); ///< Disabled copy constructor
};
/// Abort the translation of the file with 'msg' as an error description
void fail(char const* msg)
{
throw msg; // quick-and-dirty way to pass a message string
}
/// Handling of failed assertions ( calls fail() ).
void assertFail(char const* msg, const char* file, int line)
{
static char buf[1024]; // UNSAFE... but ok for this app...
sprintf(buf,"ASSERT failure: %s -- on line %d of %s",msg,line,file);
fail(buf);
}
/// Simple implementation of an assertion-handling macro...
#define ASSERT( test ) if(test);else assertFail( #test , __FILE__, __LINE__ );
/// Returns (or 'ungets') the last input token that was read using nextToken().
void putBackToken()
{
ASSERT( !sTokPendingIsValid );
sTokPendingIsValid = true;
}
/** Returns the next token from the input file.
Automatically copies whitespace and comments from the input file
to the current destination file -- if one is specified by the pdst global.
One last read token can be put back using putBackToken() -- the next
call to EToken will then read the same token again.
@return A token identifier.
@note The textual representation of the read token can
be accessed using the delphi_yytext global variable.
*/
EToken nextToken()
{
if( sTokPendingIsValid )
{ sTokPendingIsValid = false; return sTokPending; }
for(;;)
{
switch( sTokPending = delphi_yylex() ) {
case eBlanks:
case eCommentLine: // copy blanks and comments to destination
if(!!pdst) pdst->write(delphi_yytext, delphi_yyleng);
continue;
case ePRE_IFDEF:
case ePRE_IFNDEF:
case ePRE_ELSE:
case ePRE_ENDIF:
if(!!pdst) *pdst << QMARK;
case eCommentBlock: // transfer contents of comment blocks
if(!!pdst) { //TODO: should check for */ and replace it...
int skip = (delphi_yytext[0]=='{') ? 1 : 2;
pdst->write("/*",2).write(delphi_yytext+skip,delphi_yyleng-2*skip).write("*/",2);
}
continue;
default:
return sTokPending;
}
}
}
/** Require a token of type @a tok, and return its textual representation.
fail() is called if the next token does not match @a tok.
*/
char const* requireToken(EToken tok)
{
if( nextToken() != tok )
fail( ("Unexpected token: "+std::string(delphi_yytext)).c_str() );
return delphi_yytext;
}
/** Attempts to retrieve a token of type @a tok from the input.
@return true if the token was found, false if the following token is not a match and was not read.
*/
bool tryGetToken(EToken tok)
{
if( nextToken() == tok )
return true;
putBackToken();
return false;
}
/// Returns the type of the next token, without actually reading it.
EToken peekToken()
{
EToken ans = nextToken();
putBackToken();
return ans;
}
/// Returns true if the next token is an identifier (not an operator or keyword).
bool peekNextIsIdentifier()
{
EToken const tok = nextToken();
putBackToken();
return ( tok == eID || (tok>=eFirstSemiKeyword && tok<=eLastSemiKeyword) );
}
/** Require an identifier as the next token and return it as a string.
The returned identifier string is filtered (see filterID() ).
fail() is called if the next token is not an identifier.
*/
char const* requireIdentifier()
{
EToken const tok = nextToken();
if( tok != eID && (tok<eFirstSemiKeyword || tok>eLastSemiKeyword) )
fail( "Identifier was expected" );
return filterID(delphi_yytext);
}
/// Gets next identifier, absorbs any scoping (using ".") and converts it to "::".
string requireScopedIdentifier()
{
string id = requireIdentifier();
while( tryGetToken(eDot) )
id.append("::"), id.append( requireIdentifier() );
return id;
}
/** Appends a +1 to the provided expression, but tries to remove a redundant trailing -1 instead if possible.
Such a modification is commonly needed in for loops and array bounds,
because they are handled differently in Pascal and C.
*/
string appendPlusOne(string const& str)
{
string::size_type const sz = str.size();
string s = trimmed(str);
long l; char* end;
// just try to avoid a classic and ugly "Count-1+1" output.
if ( sz>2 && s.substr(sz-2)=="-1" ) s.erase(sz-2);
else if( sz>3 && s.substr(sz-3)=="- 1" ) s.erase(sz-3);
else if( (l = strtol( s.c_str(), &end, 10 )), ! *end ) //ivec20031126: directly increment all decimal ordinal values
{ // successfully interpreted as an ordinal value => increment
s = stringof(l+1);
}
else s += "+1";
return rtrimmed(s);
}
//-----------------------------------------------------------------------------------
/// Simple description of the type of an expression
enum EType { tyUndef, tyInt, tyFloat, tyString, tyChar, tyClass, tyRecord };
/** Translates the following expression from the source file.
Reads and translates an expression (part of a pascal source statement or declaration).
Attempts to guess the type of the expression and return it in @a outHint -- but this is not functioning well.
@param outHint On output, receives a guess at the type of the expression (DOES NOT WORK WELL)
@param isInType If true, prevents the handling of some operators (e.g. = )
stops the processing of the input (useful in some declarations...).
*/
string readExpr( EType& outHint, bool isInType=false )
{
//FIXME: operators precedence
outHint = tyUndef;
ostringstream dst(ios_base::out|ios_base::binary);
peekToken();
pdstRedirect temp(dst);
for(;;) {
EToken const tok = nextToken();
switch( tok ) {
case eCharString: {
dst.put('"');
for( int i = 1 ; i != delphi_yyleng-1 ; ++i )
switch( char c = delphi_yytext[i] ) {
case '\'': ++i; //fallthru after skipping doubled inner single quote
case '\"':
case '\\': dst.put('\\'); //fallthru to put the actual char
default: dst.put(c);
}
dst.put('"');
} break;
case eNumInt: {
char const* s = delphi_yytext;
if( s[0]=='$' ) { dst<<"0x"; ++s; } // special handling if hex number
dst << s;
} break;
case eCharCoded: dst << "(char)"; break; //NB: discard, or /*char*/ would be ok too
case eTRUE: //dst << "true"; break;
case eFALSE: //dst << "false"; break;
case eRESULT: //dst << "result"; break;
case eID: putBackToken(); dst << requireIdentifier(); break;
case eEqual: if(isInType) goto put_back_and_exit;
dst << "=="; break;
case eUnequal: dst << "!="; break;
case eAND: dst << "&&"; break;
case eOR: dst << "||"; break;
case eNOT: dst << "!"; break;
case eAt: dst << "&"; break;
case eDIV: dst << "/*div*//"; break;
case eDiv: dst << "*1.0/"; break;
case eInto: dst << "->"; break;
case eCirc: dst << QMARK "^"; break;
case eSHL: dst << "<<"; break;
case eSHR: dst << ">>"; break;
case eMOD: dst << "%"; break;
case eNIL: dst << "00"; break;
case eASSIGNED:{ if( !tryGetToken(eParIn) ) goto dflt;
string const& svar = readExpr(outHint);
dst << "!! " << svar << " ";
requireToken(eParOut);
break;
}
case eINC:
case eDEC: { if( !tryGetToken(eParIn) ) goto dflt;
string const& svar = readExpr(outHint);
if( tryGetToken(eParOut) ) {
dst << (tok==eINC ? "++":"--" ) << svar;
break;
}
requireToken(eComma);
string const& sdif = readExpr(outHint);
dst << svar << (tok==eINC ? " += ":" -= ") << sdif;
requireToken(eParOut);
break;
}
dflt: default: dst.write(delphi_yytext,delphi_yyleng);
break;
case eParIn: dst << "( " << readExpr(outHint);
while( tryGetToken(eComma) )
dst << ", " << readExpr(outHint);
dst << " )";
requireToken(eParOut);
break;
case eBrackIn: dst << "[ " << readExpr(outHint);
for(;;) {
if( tryGetToken(eComma) )
dst << ", " << readExpr(outHint);
else if( tryGetToken(eRange) )
dst << " .. " << readExpr(outHint);
else break;
}
dst << " ]";
requireToken(eBrackOut);
break;
case eColon: case eSemic: case eAssign: case eComma:
case eBrackOut: case eParOut: case eRange:
case eELSE: case eTHEN: case eUNTIL:
case eEND: case eEXCEPT: case eFINALLY:
case eTO: case eDOWNTO: case eDO: case eOF:
put_back_and_exit: putBackToken();
return trimmed(dst.str());
}
}
}
/// Read the signature/type of a function (parameters and return type).
string readFuncSig(bool isFunc, string* retTypeSig=0);
/** Translate a type signature into a declaration.
The occurrence of string TMARK within @a typeDecl is replaced with @a id.
*/
string makeTypeDecl(string const& typeDecl, string const& id)
{
string ans = typeDecl;
bool subst = replaceFirst(ans,TMARK,id);
ASSERT( subst );
return ans;
}
/** Read a type signature.
The returned string is a type declaration, where the TMARK string is
inserted instead of a specific identifier (to allow later substitution).
*/
string readTypeDecl()
{
string id = TMARK;
pdstRedirect temp(00);
EType th;
bool isFunc = tryGetToken(eFUNCTION);
if( isFunc || tryGetToken(ePROCEDURE) ) {
id = readFuncSig(isFunc);
// convert to a function-pointer type
id = makeTypeDecl( id, "(*" TMARK ")" );
if( tryGetToken(eOF) ) { // proc/func of object declaration -- not properly translated
//NB: translation to something like boost::function would make sense...
id = id + " /* of class: " + requireScopedIdentifier() + " */" QMARK;
}
return id;
}
while( tryGetToken(eCirc) ) // ^ => pointer decl
id = "*" + id;
while( tryGetToken(ePACKED)/*skip*/, tryGetToken(eARRAY) )
{
if( tryGetToken(eBrackIn) ) {
string slo = readExpr(th);
requireToken(eRange);
string shi = readExpr(th);//requireToken(eNumInt);
requireToken(eBrackOut);
char* end;
long lo = strtol( slo.c_str(), &end, 10 );
bool oklo = ! *end;
long hi = strtol( shi.c_str(), &end, 10 );
bool okhi = ! *end;
if( oklo && lo==0 ) {
id = id + "[" + ( okhi ? stringof(hi-lo+1) : appendPlusOne(shi) ) + "]";
}
else {
id = id + "[ " QMARK "/*" + slo + ".." + shi + "*/ (" + shi + ")-(" + slo + ")+1 ]";
}
}
else {
id = id + "[ " QMARK " ]";
}
requireToken(eOF);
}
if( tryGetToken(eSTRING) ) {
if( tryGetToken(eBrackIn) ) { //ivec20031126: support for fixed-size strings
string slen = readExpr(th);
requireToken(eBrackOut);
id = "char" QMARK "/*string*/ "+id+"["+appendPlusOne(slen)+"]";
}
else
id = "std::string " + id;
}
else if( tryGetToken(eParIn) )
{
id = "enum "+id+" { "+requireIdentifier();
while( tryGetToken(eComma) ) {
id = id + ", " + requireIdentifier();
}
requireToken(eParOut);
id = id+" }";
}
else if( tryGetToken(eSET) )
{
requireToken(eOF);
string const ty = requireScopedIdentifier();
id = "unsigned long" QMARK "/*set of: " + ty + " */ "+id;
}
else {
EType th2;
string const ty_or_expr = readExpr(th2,true);
if(!tryGetToken(eRange))
id = ty_or_expr + " " + id;
else {
string const expr2 = readExpr(th2);
id = "int" QMARK "/*range: " + ty_or_expr + " .. " + expr2 + " */ "+id;
}
}
return id;
}
//-----------------------------------------------------------------
/**
* Return tokens, eBlank and even comments.
* Comments are printed to output file.
*/
EToken nextAnyToken()
{
if( sTokPendingIsValid ) {
sTokPendingIsValid = false;
return sTokPending;
}
switch( sTokPending = delphi_yylex() ) {
case eCommentLine: // copy comments to destination
if(!!pdst) {
pdst->put('\n');
pdst->write(delphi_yytext, delphi_yyleng);
}
case eCommentBlock: // transfer contents of comment blocks
if(!!pdst) { //TODO: should check for */ and replace it...
int skip = (delphi_yytext[0]=='{') ? 1 : 2;
pdst->put('\n');
pdst->write("/*",2).write(delphi_yytext+skip,delphi_yyleng-2*skip).write("*/",2);
}
default:
break;
}
return sTokPending;
}
//-----------------------------------------------------------------
/** Translate a sequence of statements.
Repeatedly calls transStatement() until a block end is encountered.
*/
void transStatements()
{
//NOTE: global parser
static Pasic pasic;
ASSERT( !! pdst );
std::string buffer;
EToken tok;
int nesting = 1;
while (nesting > 0) {
tok = nextAnyToken();
switch (tok) {
case eBEGIN:
case eTRY:
case eCASE:
++nesting;
break;
case eEND:
--nesting;
break;
default:
break;
}
if (nesting > 0) {
buffer.append(delphi_yytext, delphi_yyleng);
}
}
putBackToken();
//call PASIC
*pdst << "\n\n";
*pdst << pasic.convertStmt(buffer);
}
//-----------------------------------------------------------------------------------
void transFunc(EDeclScope scope, bool isFunc);
void transDecls(EDeclScope scope);
/// Translate a uses section into #include instructions (dumb path translation).
void transUsesSection(EDeclScope scope)
{
if( scope!=eUnitInterf && scope!=eUnitImpl )
fail( "Uses section is only allowed within interface or implementation" );
do {
char const* u = requireIdentifier();
*pdst << "\n#include \""<<u<<".h\"";
} while ( tryGetToken(eComma) );
requireToken(eSemic);
}
/// Translate a Pascal/Delphi CONST declaration section.
void transConstSection(EDeclScope scope)
{
string id, decl, val;
while( peekNextIsIdentifier() ) {
{
pdstRedirect temp(00);
id = string("const ")+requireIdentifier();
if( tryGetToken(eColon) )
decl = readTypeDecl();
else
decl.erase();
requireToken(eEqual);
EType et;
val = readExpr(et);
if( decl.empty() )
{
switch(et) { // try to guess the type of the non-typed constant
case tyString: decl = "const char* ";
case tyInt: decl = "long ";
case tyFloat: decl = "float ";
case tyChar: decl = "char ";
default: decl = "double" QMARK " ";
}
decl = decl + id;
}
else
decl = makeTypeDecl(decl, id);
}
*pdst << "static " << decl << " = " << val;
requireToken(eSemic);
*pdst << ";";
}
}
/// Translate a Pascal VAR declaration section.
void transVarSection(EDeclScope const scope)
{
ostream& dst = *pdst;
string id, decl;
vector<string> ids;
for(;;) {
if( scope==eInClass || scope==eInInterf ) {
EToken tok = nextToken();
switch( tok )
{
case ePUBLISHED: dst << "\npublic/*published*/:"; continue; //ivec20031126: support "published"
case ePUBLIC: dst << "\npublic:"; continue;
case ePROTECTED: dst << "\nprotected:"; continue;
case ePRIVATE: dst << "\nprivate:"; continue;
case eCLASS: dst<<"static"; continue; //e.g. CLASS FUNCTION...
// within a class, the following do NOT end a variable section (they may, actually, if PUBLIC/... start a new one)
case ePROCEDURE: transFunc(scope, false); continue;
case eFUNCTION: transFunc(scope, true); continue;
case eCONSTRUCTOR:dst<<QMARK "static/*CONSTRUCTOR*/"; transFunc(scope, false); continue;
case eDESTRUCTOR: dst<<QMARK "static/*DESTRUCTOR*/"; transFunc(scope, false); continue;
case ePROPERTY: { // for now, pass property definitions through as a comment...
dst << QMARK << "/*PROPERTY ";
do{ tok = nextToken(); dst << delphi_yytext; } while( tok != eSemic );
if( tryGetToken(eDEFAULT) ) { dst << " DEFAULT => operator[]() "; requireToken(eSemic); }
dst << " */";
continue;
}
default: putBackToken(); break;
}
}
if( peekNextIsIdentifier()
|| ( scope==eFuncParam && (sTokPending==eCONST||sTokPending==eVAR) )
)
{
bool isConst = false;
bool isVar = false;
if( sTokPending==eCONST) {
isConst = true;
nextToken();
}
else if( sTokPending==eVAR ) {
isVar = true;
nextToken();
}
ids.clear();
id = requireIdentifier();
{ pdstRedirect temp(00);
do {
if( isConst )
id = "const& "+id;
else if( isVar )
id = "& "+id;
ids.push_back(string());
ids.back().swap(id);
if( tryGetToken(eComma) )
id = requireIdentifier();
} while( ! id.empty() );
requireToken(eColon);
decl = readTypeDecl();
}
if( tryGetToken(eEqual) )
{
decl += " = ";
EType et;
decl += readExpr(et);
}
for( unsigned i = 0 ; i!=ids.size() ; ++i ) {
if( i>0 )
dst << ( (scope == eFuncParam) ? ", " : "; " );
dst << makeTypeDecl( decl, ids[i] );
}
if( scope != eFuncParam ) {
if( peekToken()!=eEND ) // last semic is optional before eEND
requireToken(eSemic);
dst << ";";
}
else {
if( tryGetToken(eSemic) ) //Q should require following param consistency ?
dst << ", ";
}
continue;
}
break; // no option was handled here...
}
}
/// Translate a Pascal TYPE declaration section.
void transTypeSection(EDeclScope scope)
{
string name, base;
ostream& dst = *pdst;
while( peekNextIsIdentifier() )
{
{
pdstRedirect temp(00);
name = requireIdentifier();
requireToken(eEqual);
peekToken(); // to read next token within our null redirect.
}
if( tryGetToken(ePACKED)/*skip*/, tryGetToken(eRECORD) ) {
cout << "Record Decl: " << name << endl;
dst << "struct " << name << " {";
transVarSection(eInRecord);
//TODO: handle case switches --> union ??
dst << "};";
requireToken(eEND);
requireToken(eSemic);
continue;
}
bool isInterface = tryGetToken(eINTERFACE);
if( isInterface || tryGetToken(eCLASS) ) {
std::string const desc = ( isInterface ? "Interface" : "Class" );
if( tryGetToken(eSemic) ) // forward-declaration
{
cout << desc<<" Forward-Decl: "<<name<<endl;
if(isInterface)
dst<< "\nclass/*interface*/ "<<name<<";";
else
dst<< "\nstruct "<<name<<";";
continue;
}
cout << desc<<" Decl: " << name << endl;
{
pdstRedirect temp(00);
if( tryGetToken(eParIn) ) {
base = requireScopedIdentifier();
while( tryGetToken(eComma) )
base.append(", public "), base.append(requireScopedIdentifier());
requireToken(eParOut);
}
else if(!isInterface)
base = "TObject";
}
dst<< "\nstruct/*"<<(isInterface ? "interface" : "class" ) <<"*/ " << name;
if( !base.empty() ) dst << ": public " << base;
dst << "\n{";
transVarSection(isInterface?eInInterf:eInClass);
requireToken(eEND);
requireToken(eSemic);
dst<< "\n};\n";
continue;
}
/*else*/ {
dst << "typedef " << makeTypeDecl(readTypeDecl(), name);
requireToken(eSemic);
dst << ";";
}
}
}
/** Read the type signature of a function or procedure.
@param isFunc true if a non-void return type is to be retrieved.
@param retTypeSig OPTIONAL pointer to a string to be set to the function's return type.
*/
string readFuncSig(bool isFunc, string* retTypeSig)
{
ostringstream dst(ios_base::out|ios_base::binary);
pdstRedirect temp(dst);
if( tryGetToken(eParIn) ) {
dst << "(";
transVarSection(eFuncParam);
requireToken(eParOut);
dst << ")";
}
else dst << "()";
std::string const params = TMARK + dst.str();
string decl;
if( isFunc ) {
pdstRedirect temp2(00);
if( tryGetToken(eColon) )
decl = readTypeDecl();
else
decl = "/* MISSING PARAM/RESULT */" QMARK " " TMARK;
}
else decl = "void " TMARK;
if( !! retTypeSig ) *retTypeSig = decl;
return makeTypeDecl( decl, params );
}
/** Translate a function (or pascal procedure).
@param scope Gives information on the context of the function's definition.
@param isFunc true if the function has a non-void return value.
*/
void transFunc(EDeclScope scope, bool isFunc)
{
if( scope==eFuncBody )
*pdst << QMARK "/*SUB-FUNCTION TO BE EXTRACTED*/"; //fail( "Sub-functions cannot be translated" );
ScopedSet<bool> stateTemp(sInFunc, isFunc);
string name, retType;
{
pdstRedirect discardBlanks(00);
name = requireScopedIdentifier();
}
string decl = readFuncSig( isFunc, &retType );
requireToken(eSemic);
string blanksStr;
bool hasBody;
{
ostringstream blanksCapture(ios_base::out|ios_base::binary);
pdstRedirect redirect(blanksCapture);
string prefix, suffix;
if( scope==eInInterf )
suffix += " =0";
hasBody = (scope==eUnitImpl || scope==eFuncBody);
for(;;)
{
if( tryGetToken(eOVERLOAD) )
{
suffix += "/*overload*/";
}
else if( tryGetToken(eVIRTUAL) || tryGetToken(eDYNAMIC) )
{
prefix += "virtual ";
}
else if( tryGetToken(eOVERRIDE) )
{
suffix += "/*override*/";
}
else if( tryGetToken(eABSTRACT) )
{
if(!eInInterf) suffix += "=0";
}
else if( tryGetToken(eFORWARD) )
{
hasBody = false;
}
else if( tryGetToken(eMESSAGE) )
{
suffix += "/* MESSAGE "+std::string(requireIdentifier())+" */";
}
else if( tryGetToken(eSTDCALL) )
{
prefix = "/*__stdcall*/ " + prefix;
}
else break;
tryGetToken(eSemic);
}
*redirect.prev() << prefix << makeTypeDecl(decl,name) << suffix;
blanksStr = blanksCapture.str();
}
cerr << (isFunc?"Func ":"Proc ") << (hasBody?"impl: ":"decl: ") << name << endl;
if( !hasBody ) {
*pdst << ';' << blanksStr;
return;
}
*pdst << blanksStr << '{';
if( isFunc )
*pdst << " " << makeTypeDecl(retType,"result") << ';'; // declare result variable
transDecls(eFuncBody);
if( tryGetToken(eASM) )
{
*pdst << ";"QMARK"/* ASM";
while( nextToken() != eEND ) *pdst << delphi_yytext;
*pdst << "ASM END */";
requireToken(eSemic);
return;
}
requireToken(eBEGIN);
transStatements();
requireToken(eEND);
requireToken(eSemic);
if( isFunc )
*pdst << "return result;\n";
*pdst << "}";
}
/// Translate a Delphi resourcestring section into a comment block.
void transResourceString(EDeclScope scope)
{
*pdst << "#if 0//resourcestring " QMARK ;
transConstSection(scope);
*pdst << "\n#endif\n";
}
/// Translate a declaration block (e.g. unit interface/implementation, class body, etc).
void transDecls(EDeclScope scope)
{
for(;;) {
switch( nextToken() )
{
case eUSES: transUsesSection(scope); continue;
case eCONST: transConstSection(scope); continue;
case eVAR: transVarSection(scope); continue;
case eTYPE: transTypeSection(scope); continue;
case ePROCEDURE: transFunc(scope,false); continue;
case eFUNCTION: transFunc(scope,true); continue;
case eRESOURCESTRING:
transResourceString(scope); continue;
case eCONSTRUCTOR:*pdst<<QMARK "/*CONSTRUCTOR*/"; transFunc(scope, false); continue;
case eDESTRUCTOR: *pdst<<QMARK "/*DESTRUCTOR*/"; transFunc(scope, false); continue;
default: putBackToken(); return;
}
}
}
/// Translate a complete unit.
void transUnit()
{
pdst = &hdst;
requireToken( eUNIT );
cout << "Unit name: " << requireIdentifier() << endl;
requireToken( eSemic );
requireToken( eINTERFACE );
cout << "--------------- PROCESSING UNIT INTERFACE\n";
transDecls(eUnitInterf);
requireToken( eIMPLEMENTATION );
cout << "--------------- PROCESSING UNIT IMPLEMENTATION\n";
pdst = &cdst;
transDecls(eUnitImpl);
if( tryGetToken(eINITIALIZATION) ) {
cdst << "\n#if 0 //INITIALIZATION\n";
transStatements();
cdst << "\n#endif//INITIALIZATION\n";
}
if( tryGetToken(eFINALIZATION) ) {
cdst << "\n#if 0 //FINALIZATION\n";
transStatements();
cdst << "\n#endif//FINALIZATION\n";
}
cout << "--------------- COMPLETED UNIT PROCESSING\n";
requireToken(eEND);
requireToken(eDot);
}
/// Main program.
int main(int argc, char* argv[])
{
if(argc<2) {
cerr << "Usage: "<<(argc?argv[0]:"delphi2cpp")<<" srcPath.pas [ srcPath2.pas ]...\n";
return 0;
}
// Global Configuration
addIDFilterTable(baseIDFilterTable);
for(int indFile=1;indFile<argc;++indFile) {
char const* const srcPath = argv[indFile];
delphi_yyin = fopen( srcPath, "r" );
if( ! delphi_yyin ) {
cerr << "Could not open source file: " << srcPath << endl;
return 1;
}
sTokPendingIsValid = false;
hdst.open( changeFileExt(srcPath,".h").c_str() );
if( ! hdst.is_open() ) {
cerr << "Could not open destination file: " << changeFileExt(srcPath,".h") << endl;
return 1;
}
cdst.open( changeFileExt(srcPath,".cpp").c_str() );
if( ! cdst.is_open() ) {
cerr << "Could not open destination file: " << changeFileExt(srcPath,".cpp") << endl;
return 1;
}
std::string errTxt;
try {
std::string guard = "INCLUDED_"+toupper(baseName(srcPath))+"_H";
hdst<<"/** @file \n"
" @brief \n"
"*/\n"
"#ifndef "<<guard<<"\n"
"#define "<<guard<<"\n";
cdst<<"/** @file \n"
" @brief \n"
"*/\n"
"#include \"" << baseName(srcPath) << ".h\"\n\n";
transUnit();
cdst<<"\n\n//END\n";
hdst<<"\n\n#endif//"<<guard<<"\n//END\n";
}
catch( char const* msg ) { errTxt = msg; } // easy way to throw exceptions...
catch( std::exception& x ) { errTxt = x.what(); }
catch(...) { errTxt = "***UNKNOWN ERROR***"; }
fclose(delphi_yyin);
hdst.close();
cdst.close();
if( ! errTxt.empty() )
{
cerr << "\n\nERROR ENCOUNTERED: " << errTxt
<< "\n on line "<<delphi_yylineno<<" at token '"
<< (delphi_yytext?delphi_yytext:"*unknown*")<<"'.\n\n";
}
}
return 0;
}
