summaryrefslogtreecommitdiff
path: root/basic/source/comp
diff options
context:
space:
mode:
Diffstat (limited to 'basic/source/comp')
-rw-r--r--basic/source/comp/dim.cxx3
-rw-r--r--basic/source/comp/exprtree.cxx31
-rwxr-xr-xbasic/source/comp/sbcomp.cxx247
-rw-r--r--basic/source/comp/scanner.cxx24
-rw-r--r--basic/source/comp/symtbl.cxx5
5 files changed, 292 insertions, 18 deletions
diff --git a/basic/source/comp/dim.cxx b/basic/source/comp/dim.cxx
index 59d77e3f3757..4d188ec1ca8a 100644
--- a/basic/source/comp/dim.cxx
+++ b/basic/source/comp/dim.cxx
@@ -375,6 +375,9 @@ void SbiParser::DefVar( SbiOpcode eOp, BOOL bStatic )
if( pDef->IsWithEvents() )
nOpnd2 |= SBX_TYPE_WITH_EVENTS_FLAG;
+ if( bCompatible && pDef->IsNew() )
+ nOpnd2 |= SBX_TYPE_DIM_AS_NEW_FLAG;
+
short nFixedStringLength = pDef->GetFixedStringLength();
if( nFixedStringLength >= 0 )
nOpnd2 |= (SBX_FIXED_LEN_STRING_FLAG + (UINT32(nFixedStringLength) << 17)); // len = all bits above 0x10000
diff --git a/basic/source/comp/exprtree.cxx b/basic/source/comp/exprtree.cxx
index 7a4ea5965558..69f9ea553529 100644
--- a/basic/source/comp/exprtree.cxx
+++ b/basic/source/comp/exprtree.cxx
@@ -578,10 +578,20 @@ SbiExprNode* SbiExpression::Unary()
{
case MINUS:
eTok = NEG;
- case NOT:
pParser->Next();
pNd = new SbiExprNode( pParser, Unary(), eTok, NULL );
break;
+ case NOT:
+ if( pParser->IsVBASupportOn() )
+ {
+ pNd = Operand();
+ }
+ else
+ {
+ pParser->Next();
+ pNd = new SbiExprNode( pParser, Unary(), eTok, NULL );
+ }
+ break;
case PLUS:
pParser->Next();
pNd = Unary();
@@ -725,9 +735,26 @@ SbiExprNode* SbiExpression::Comp()
return pNd;
}
+SbiExprNode* SbiExpression::VBA_Not()
+{
+ SbiExprNode* pNd = NULL;
+
+ SbiToken eTok = pParser->Peek();
+ if( eTok == NOT )
+ {
+ pParser->Next();
+ pNd = new SbiExprNode( pParser, VBA_Not(), eTok, NULL );
+ }
+ else
+ {
+ pNd = Comp();
+ }
+ return pNd;
+}
+
SbiExprNode* SbiExpression::Like()
{
- SbiExprNode* pNd = Comp();
+ SbiExprNode* pNd = pParser->IsVBASupportOn() ? VBA_Not() : Comp();
if( m_eMode != EXPRMODE_EMPTY_PAREN )
{
short nCount = 0;
diff --git a/basic/source/comp/sbcomp.cxx b/basic/source/comp/sbcomp.cxx
index 5b7e5c70591d..c8fe782487e3 100755
--- a/basic/source/comp/sbcomp.cxx
+++ b/basic/source/comp/sbcomp.cxx
@@ -32,6 +32,7 @@
#include "sbcomp.hxx"
#include "image.hxx"
#include "sbtrace.hxx"
+#include <basic/sbobjmod.hxx>
//==========================================================================
@@ -42,11 +43,145 @@
#include <hash_map>
-// Trace Settings
-static const char* GpTraceFileName = "d:\\zBasic.Asm\\BasicTrace.txt";
-static const bool GbIncludePCodes = false;
-static const int GnIndentPerCallLevel = 4;
-static const int GnIndentForPCode = 2;
+// Trace ini file (set NULL to ignore)
+static char GpTraceIniFile[] = "d:\\zBasic.Asm\\BasicTrace.ini";
+//static char* GpTraceIniFile = NULL;
+
+
+// Trace Settings, used if no ini file / not found in ini file
+static char GpTraceFileNameDefault[] = "d:\\zBasic.Asm\\BasicTrace.txt";
+static char* GpTraceFileName = GpTraceFileNameDefault;
+
+// GbTraceOn:
+// true = tracing is active, false = tracing is disabled, default = true
+// Set to false initially if you want to activate tracing on demand with
+// TraceCommand( "TraceOn" ), see below
+static bool GbTraceOn = true;
+
+// GbIncludePCodes:
+// true = PCodes are written to trace, default = false, correspondents
+// with TraceCommand( "PCodeOn" / "PCodeOff" ), see below
+static bool GbIncludePCodes = false;
+
+static int GnIndentPerCallLevel = 4;
+static int GnIndentForPCode = 2;
+
+/*
+ With trace enabled the runtime function TraceCommand
+ can be used to influence the trace functionality
+ from within the running Basic macro.
+
+ Format: TraceCommand( command as String [, param as Variant] )
+
+ Supported commands (command is NOT case sensitive):
+ TraceCommand "TraceOn" sets GbTraceOn = true
+ TraceCommand "TraceOff" sets GbTraceOn = false
+
+ TraceCommand "PCodeOn" sets GbIncludePCodes = true
+ TraceCommand "PCodeOff" sets GbIncludePCodes = false
+
+ TraceCommand "Print", aVal writes aVal into the trace file as
+ long as it can be converted to string
+*/
+
+static void lcl_skipWhites( char*& rpc )
+{
+ while( *rpc == ' ' || *rpc == '\t' )
+ ++rpc;
+}
+
+inline void lcl_findNextLine( char*& rpc, char* pe )
+{
+ // Find line end
+ while( rpc < pe && *rpc != 13 && *rpc != 10 )
+ ++rpc;
+
+ // Read all
+ while( rpc < pe && (*rpc == 13 || *rpc == 10) )
+ ++rpc;
+}
+
+inline bool lcl_isAlpha( char c )
+{
+ bool bRet = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z');
+ return bRet;
+}
+
+static void lcl_ReadIniFile( const char* pIniFileName )
+{
+ const int BUF_SIZE = 1000;
+ static sal_Char TraceFileNameBuffer[BUF_SIZE];
+ sal_Char Buffer[BUF_SIZE];
+ sal_Char VarNameBuffer[BUF_SIZE];
+ sal_Char ValBuffer[BUF_SIZE];
+
+ FILE* pFile = fopen( pIniFileName ,"rb" );
+ if( pFile == NULL )
+ return;
+
+ size_t nRead = fread( Buffer, 1, BUF_SIZE, pFile );
+
+ // Scan
+ char* pc = Buffer;
+ char* pe = Buffer + nRead;
+ while( pc < pe )
+ {
+ lcl_skipWhites( pc ); if( pc == pe ) break;
+
+ // Read variable
+ char* pVarStart = pc;
+ while( pc < pe && lcl_isAlpha( *pc ) )
+ ++pc;
+ int nVarLen = pc - pVarStart;
+ if( nVarLen == 0 )
+ {
+ lcl_findNextLine( pc, pe );
+ continue;
+ }
+ strncpy( VarNameBuffer, pVarStart, nVarLen );
+ VarNameBuffer[nVarLen] = '\0';
+
+ // Check =
+ lcl_skipWhites( pc ); if( pc == pe ) break;
+ if( *pc != '=' )
+ continue;
+ ++pc;
+ lcl_skipWhites( pc ); if( pc == pe ) break;
+
+ // Read value
+ char* pValStart = pc;
+ while( pc < pe && *pc != 13 && *pc != 10 )
+ ++pc;
+ int nValLen = pc - pValStart;
+ if( nValLen == 0 )
+ {
+ lcl_findNextLine( pc, pe );
+ continue;
+ }
+ strncpy( ValBuffer, pValStart, nValLen );
+ ValBuffer[nValLen] = '\0';
+
+ // Match variables
+ if( strcmp( VarNameBuffer, "GpTraceFileName") == 0 )
+ {
+ strcpy( TraceFileNameBuffer, ValBuffer );
+ GpTraceFileName = TraceFileNameBuffer;
+ }
+ else
+ if( strcmp( VarNameBuffer, "GbTraceOn") == 0 )
+ GbTraceOn = (strcmp( ValBuffer, "true" ) == 0);
+ else
+ if( strcmp( VarNameBuffer, "GbIncludePCodes") == 0 )
+ GbIncludePCodes = (strcmp( ValBuffer, "true" ) == 0);
+ else
+ if( strcmp( VarNameBuffer, "GnIndentPerCallLevel") == 0 )
+ GnIndentPerCallLevel = strtol( ValBuffer, NULL, 10 );
+ else
+ if( strcmp( VarNameBuffer, "GnIndentForPCode") == 0 )
+ GnIndentForPCode = strtol( ValBuffer, NULL, 10 );
+ }
+ fclose( pFile );
+}
struct TraceTextData
{
@@ -122,7 +257,7 @@ static rtl::OString lcl_toOStringSkipLeadingWhites( const String& aStr )
return aORetStr;
}
-String dumpMethodParameters( SbMethod* pMethod )
+String lcl_dumpMethodParameters( SbMethod* pMethod )
{
String aStr;
if( pMethod == NULL )
@@ -149,9 +284,10 @@ String dumpMethodParameters( SbMethod* pMethod )
aStr += pParam->aName;
}
aStr += '=';
- if( pVar->GetType() & SbxARRAY )
+ SbxDataType eType = pVar->GetType();
+ if( eType & SbxARRAY )
aStr += String( RTL_CONSTASCII_USTRINGPARAM( "..." ) );
- else
+ else if( eType != SbxOBJECT )
aStr += pVar->GetString();
if ( nParam < ( pParams->Count() - 1 ) )
aStr += String( RTL_CONSTASCII_USTRINGPARAM( ", " ) );
@@ -166,16 +302,36 @@ String dumpMethodParameters( SbMethod* pMethod )
return aStr;
}
+
// Public functions
+
+static bool GbSavTraceOn = false;
void dbg_InitTrace( void )
{
+ if( GpTraceIniFile != NULL )
+ lcl_ReadIniFile( GpTraceIniFile );
+
FILE* pFile = fopen( GpTraceFileName, "w" );
if( pFile != NULL )
fclose( pFile );
+ GbSavTraceOn = GbTraceOn;
+ if( !GbTraceOn )
+ lcl_lineOut( GpTraceFileName, "### Program started with trace off ###" );
+}
+
+void dbg_DeInitTrace( void )
+{
+ GbTraceOn = GbSavTraceOn;
}
+static INT32 GnLastCallLvl = 0;
+
void dbg_traceStep( SbModule* pModule, UINT32 nPC, INT32 nCallLvl )
{
+ if( !GbTraceOn )
+ return;
+ GnLastCallLvl = nCallLvl;
+
SbModule* pTraceMod = pModule;
if( pTraceMod->ISA(SbClassModuleObject) )
{
@@ -206,14 +362,11 @@ void dbg_traceStep( SbModule* pModule, UINT32 nPC, INT32 nCallLvl )
{
const char* pModuleNameStr = OUStringToOString( rtl::OUString( aModuleName ), RTL_TEXTENCODING_ASCII_US ).getStr();
char Buffer[200];
- sprintf( Buffer, "TRACE ERROR: No info for PC = %d in module \"%s\"", nPC, pModuleNameStr );
+ sprintf( Buffer, "TRACE ERROR: No info for PC = %d in module \"%s\"", (int)nPC, pModuleNameStr );
lcl_lineOut( GpTraceFileName, Buffer );
return;
}
- //nCallLvl--;
- //if( nCallLvl < 0 )
- // nCallLvl = 0;
int nIndent = nCallLvl * GnIndentPerCallLevel;
const TraceTextData& rTraceTextData = itInner->second;
@@ -234,6 +387,10 @@ void dbg_traceNotifyCall( SbModule* pModule, SbMethod* pMethod, INT32 nCallLvl,
{
static const char* pSeparator = "' ================================================================================";
+ if( !GbTraceOn )
+ return;
+ GnLastCallLvl = nCallLvl;
+
SbModule* pTraceMod = pModule;
SbClassModuleObject* pClassModuleObj = NULL;
if( pTraceMod->ISA(SbClassModuleObject) )
@@ -281,7 +438,7 @@ void dbg_traceNotifyCall( SbModule* pModule, SbMethod* pMethod, INT32 nCallLvl,
aStr.AppendAscii( "]" );
}
if( !bLeave )
- aStr += dumpMethodParameters( pMethod );
+ aStr += lcl_dumpMethodParameters( pMethod );
lcl_lineOut( GpTraceFileName, OUStringToOString( rtl::OUString( aStr ), RTL_TEXTENCODING_ASCII_US ).getStr(), lcl_getSpaces( nIndent ) );
if( !bLeave )
@@ -293,6 +450,10 @@ void dbg_traceNotifyCall( SbModule* pModule, SbMethod* pMethod, INT32 nCallLvl,
void dbg_traceNotifyError( SbError nTraceErr, const String& aTraceErrMsg, bool bTraceErrHandled, INT32 nCallLvl )
{
+ if( !GbTraceOn )
+ return;
+ GnLastCallLvl = nCallLvl;
+
rtl::OString aOTraceErrMsg = OUStringToOString( rtl::OUString( aTraceErrMsg ), RTL_TEXTENCODING_ASCII_US );
char Buffer[200];
@@ -329,6 +490,63 @@ void dbg_RegisterTraceTextForPC( SbModule* pModule, UINT32 nPC,
(*pInnerMap)[nPC] = aData;
}
+void RTL_Impl_TraceCommand( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
+{
+ (void)pBasic;
+ (void)bWrite;
+
+ if ( rPar.Count() < 2 )
+ {
+ StarBASIC::Error( SbERR_BAD_ARGUMENT );
+ return;
+ }
+
+ String aCommand = rPar.Get(1)->GetString();
+
+ if( aCommand.EqualsIgnoreCaseAscii( "TraceOn" ) )
+ GbTraceOn = true;
+ else
+ if( aCommand.EqualsIgnoreCaseAscii( "TraceOff" ) )
+ GbTraceOn = false;
+ else
+ if( aCommand.EqualsIgnoreCaseAscii( "PCodeOn" ) )
+ GbIncludePCodes = true;
+ else
+ if( aCommand.EqualsIgnoreCaseAscii( "PCodeOff" ) )
+ GbIncludePCodes = false;
+ else
+ if( aCommand.EqualsIgnoreCaseAscii( "Print" ) )
+ {
+ if ( rPar.Count() < 3 )
+ {
+ StarBASIC::Error( SbERR_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxError eOld = SbxBase::GetError();
+ if( eOld != SbxERR_OK )
+ SbxBase::ResetError();
+
+ String aValStr = rPar.Get(2)->GetString();
+ SbxError eErr = SbxBase::GetError();
+ if( eErr != SbxERR_OK )
+ {
+ aValStr = String( RTL_CONSTASCII_USTRINGPARAM( "<ERROR converting value to String>" ) );
+ SbxBase::ResetError();
+ }
+
+ char Buffer[500];
+ const char* pValStr = OUStringToOString( rtl::OUString( aValStr ), RTL_TEXTENCODING_ASCII_US ).getStr();
+
+ sprintf( Buffer, "### TRACE_PRINT: %s ###", pValStr );
+ int nIndent = GnLastCallLvl * GnIndentPerCallLevel;
+ lcl_lineOut( GpTraceFileName, Buffer, lcl_getSpaces( nIndent ) );
+
+ if( eOld != SbxERR_OK )
+ SbxBase::SetError( eOld );
+ }
+}
+
#endif
@@ -431,7 +649,8 @@ BOOL SbModule::Compile()
BOOL bRet = IsCompiled();
if( bRet )
{
- pBasic->ClearAllModuleVars();
+ if( !this->ISA(SbObjModule) )
+ pBasic->ClearAllModuleVars();
RemoveVars(); // remove 'this' Modules variables
// clear all method statics
for( USHORT i = 0; i < pMethods->Count(); i++ )
diff --git a/basic/source/comp/scanner.cxx b/basic/source/comp/scanner.cxx
index dd68f20893f5..26c6af53cc56 100644
--- a/basic/source/comp/scanner.cxx
+++ b/basic/source/comp/scanner.cxx
@@ -224,6 +224,30 @@ BOOL SbiScanner::NextSym()
for ( ; (BasicSimpleCharClass::isAlphaNumeric( *pLine, bCompatible ) || ( *pLine == '_' ) ); pLine++ )
nCol++;
aSym = aLine.copy( n, nCol - n );
+
+ // Special handling for "go to"
+ if( bCompatible && *pLine && aSym.EqualsIgnoreCaseAscii( "go" ) )
+ {
+ const sal_Unicode* pTestLine = pLine;
+ short nTestCol = nCol;
+ while( *pTestLine && (( *pTestLine == ' ' ) || ( *pTestLine == '\t' )) )
+ {
+ pTestLine++;
+ nTestCol++;
+ }
+
+ if( *pTestLine && *(pTestLine + 1) )
+ {
+ String aTestSym = aLine.copy( nTestCol, 2 );
+ if( aTestSym.EqualsIgnoreCaseAscii( "to" ) )
+ {
+ aSym = String::CreateFromAscii( "goto" );
+ pLine = pTestLine + 2;
+ nCol = nTestCol + 2;
+ }
+ }
+ }
+
// Abschliessendes '_' durch Space ersetzen, wenn Zeilenende folgt
// (sonst falsche Zeilenfortsetzung)
if( !bUsedForHilite && !*pLine && *(pLine-1) == '_' )
diff --git a/basic/source/comp/symtbl.cxx b/basic/source/comp/symtbl.cxx
index d6b3dbb878fc..9df91a5748b9 100644
--- a/basic/source/comp/symtbl.cxx
+++ b/basic/source/comp/symtbl.cxx
@@ -206,9 +206,10 @@ void SbiSymPool::Add( SbiSymDef* pDef )
SbiSymDef* SbiSymPool::Find( const String& rName ) const
{
- for( USHORT i = 0; i < aData.Count(); i++ )
+ USHORT nCount = aData.Count();
+ for( USHORT i = 0; i < nCount; i++ )
{
- SbiSymDef* p = aData.GetObject( i );
+ SbiSymDef* p = aData.GetObject( nCount - i - 1 );
if( ( !p->nProcId || ( p->nProcId == nProcId ) )
&& ( p->aName.EqualsIgnoreCaseAscii( rName ) ) )
return p;
generated by cgit (git 2.34.1) at 2025-01-29 08:19:14 +0000