blob: d0c160ecba41da0353e8c506bf6e62c8643cee59 [file] [log] [blame]
/**************************************************************
*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*
*************************************************************/
// MARKER(update_precomp.py): autogen include statement, do not remove
#include "precompiled_basic.hxx"
#include "runtime.hxx"
#ifndef GCC
#endif
#include "iosys.hxx"
#include "image.hxx"
#include "sbintern.hxx"
#include "sbunoobj.hxx"
#include "opcodes.hxx"
#include <com/sun/star/container/XIndexAccess.hpp>
#include <com/sun/star/script/XDefaultMethod.hpp>
#include <com/sun/star/beans/XPropertySet.hpp>
#include <com/sun/star/uno/Any.hxx>
#include <comphelper/processfactory.hxx>
using namespace com::sun::star::uno;
using namespace com::sun::star::container;
using namespace com::sun::star::lang;
using namespace com::sun::star::beans;
using namespace com::sun::star::script;
using com::sun::star::uno::Reference;
SbxVariable* getVBAConstant( const String& rName );
// Suchen eines Elements
// Die Bits im String-ID:
// 0x8000 - Argv ist belegt
SbxVariable* SbiRuntime::FindElement
( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, SbError nNotFound, sal_Bool bLocal, sal_Bool bStatic )
{
bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
if( bIsVBAInterOp )
{
StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
if( pMSOMacroRuntimeLib != NULL )
pMSOMacroRuntimeLib->ResetFlag( SBX_EXTSEARCH );
}
SbxVariable* pElem = NULL;
if( !pObj )
{
Error( SbERR_NO_OBJECT );
pElem = new SbxVariable;
}
else
{
sal_Bool bFatalError = sal_False;
SbxDataType t = (SbxDataType) nOp2;
String aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
// Hacky capture of Evaluate [] syntax
// this should be tackled I feel at the pcode level
if ( bIsVBAInterOp && aName.Search('[') == 0 )
{
// emulate pcode here
StepARGC();
// psuedo StepLOADSC
String sArg = aName.Copy( 1, aName.Len() - 2 );
SbxVariable* p = new SbxVariable;
p->PutString( sArg );
PushVar( p );
//
StepARGV();
nOp1 = nOp1 | 0x8000; // indicate params are present
aName = String::CreateFromAscii("Evaluate");
}
if( bLocal )
{
if ( bStatic )
{
if ( pMeth )
pElem = pMeth->GetStatics()->Find( aName, SbxCLASS_DONTCARE );
}
if ( !pElem )
pElem = refLocals->Find( aName, SbxCLASS_DONTCARE );
}
if( !pElem )
{
// Die RTL brauchen wir nicht mehr zu durchsuchen!
sal_Bool bSave = rBasic.bNoRtl;
rBasic.bNoRtl = sal_True;
pElem = pObj->Find( aName, SbxCLASS_DONTCARE );
// #110004, #112015: Make private really private
if( bLocal && pElem ) // Local as flag for global search
{
if( pElem->IsSet( SBX_PRIVATE ) )
{
SbiInstance* pInst_ = pINST;
if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
pElem = NULL; // Found but in wrong module!
// Interfaces: Use SBX_EXTFOUND
}
}
rBasic.bNoRtl = bSave;
// Ist es ein globaler Uno-Bezeichner?
if( bLocal && !pElem )
{
bool bSetName = true; // preserve normal behaviour
// i#i68894# if VBAInterOp favour searching vba globals
// over searching for uno classess
if ( bVBAEnabled )
{
// Try Find in VBA symbols space
pElem = rBasic.VBAFind( aName, SbxCLASS_DONTCARE );
if ( pElem )
bSetName = false; // don't overwrite uno name
else
pElem = getVBAConstant( aName );
}
if( !pElem )
{
// #72382 VORSICHT! Liefert jetzt wegen unbekannten
// Modulen IMMER ein Ergebnis!
SbUnoClass* pUnoClass = findUnoClass( aName );
if( pUnoClass )
{
pElem = new SbxVariable( t );
SbxValues aRes( SbxOBJECT );
aRes.pObj = pUnoClass;
pElem->SbxVariable::Put( aRes );
}
}
// #62939 Wenn eine Uno-Klasse gefunden wurde, muss
// das Wrapper-Objekt gehalten werden, da sonst auch
// die Uno-Klasse, z.B. "stardiv" immer wieder neu
// aus der Registry gelesen werden muss
if( pElem )
{
// #63774 Darf nicht mit gespeichert werden!!!
pElem->SetFlag( SBX_DONTSTORE );
pElem->SetFlag( SBX_NO_MODIFY);
// #72382 Lokal speichern, sonst werden alle implizit
// deklarierten Vars automatisch global !
if ( bSetName )
pElem->SetName( aName );
refLocals->Put( pElem, refLocals->Count() );
}
}
if( !pElem )
{
// Nicht da und nicht im Objekt?
// Hat das Ding Parameter, nicht einrichten!
if( nOp1 & 0x8000 )
bFatalError = sal_True;
// ALT: StarBASIC::FatalError( nNotFound );
// Sonst, falls keine Parameter sind, anderen Error Code verwenden
if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) )
{
// #39108 Bei explizit und als ELEM immer ein Fatal Error
bFatalError = sal_True;
// Falls keine Parameter sind, anderen Error Code verwenden
if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED )
nNotFound = SbERR_VAR_UNDEFINED;
}
if( bFatalError )
{
// #39108 Statt FatalError zu setzen, Dummy-Variable liefern
if( !xDummyVar.Is() )
xDummyVar = new SbxVariable( SbxVARIANT );
pElem = xDummyVar;
// Parameter von Hand loeschen
ClearArgvStack();
// Normalen Error setzen
Error( nNotFound, aName );
}
else
{
if ( bStatic )
pElem = StepSTATIC_Impl( aName, t );
if ( !pElem )
{
// Sonst Variable neu anlegen
pElem = new SbxVariable( t );
if( t != SbxVARIANT )
pElem->SetFlag( SBX_FIXED );
pElem->SetName( aName );
refLocals->Put( pElem, refLocals->Count() );
}
}
}
}
// #39108 Args koennen schon geloescht sein!
if( !bFatalError )
SetupArgs( pElem, nOp1 );
// Ein bestimmter Call-Type wurde gewuenscht, daher muessen
// wir hier den Typ setzen und das Ding anfassen, um den
// korrekten Returnwert zu erhalten!
if( pElem->IsA( TYPE(SbxMethod) ) )
{
// Soll der Typ konvertiert werden?
SbxDataType t2 = pElem->GetType();
sal_Bool bSet = sal_False;
if( !( pElem->GetFlags() & SBX_FIXED ) )
{
if( t != SbxVARIANT && t != t2 &&
t >= SbxINTEGER && t <= SbxSTRING )
pElem->SetType( t ), bSet = sal_True;
}
// pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen
SbxVariableRef refTemp = pElem;
// Moegliche Reste vom letzten Aufruf der SbxMethod beseitigen
// Vorher Schreiben freigeben, damit kein Error gesetzt wird.
sal_uInt16 nSavFlags = pElem->GetFlags();
pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST );
pElem->SbxValue::Clear();
pElem->SetFlags( nSavFlags );
// Erst nach dem Setzen anfassen, da z.B. LEFT()
// den Unterschied zwischen Left$() und Left() kennen muss
// AB 12.8.96: Da in PopVar() die Parameter von Methoden weggehauen
// werden, muessen wir hier explizit eine neue SbxMethod anlegen
SbxVariable* pNew = new SbxMethod( *((SbxMethod*)pElem) ); // das ist der Call!
//ALT: SbxVariable* pNew = new SbxVariable( *pElem ); // das ist der Call!
pElem->SetParameters(0); // sonst bleibt Ref auf sich selbst
pNew->SetFlag( SBX_READWRITE );
// den Datentypen zuruecksetzen?
if( bSet )
pElem->SetType( t2 );
pElem = pNew;
}
// Index-Access bei UnoObjekten beruecksichtigen
// definitely we want this for VBA where properties are often
// collections ( which need index access ), but lets only do
// this if we actually have params following
else if( bVBAEnabled && pElem->ISA(SbUnoProperty) && pElem->GetParameters() )
{
// pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen
SbxVariableRef refTemp = pElem;
// Variable kopieren und dabei den Notify aufloesen
SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) ); // das ist der Call!
pElem->SetParameters( NULL ); // sonst bleibt Ref auf sich selbst
pElem = pNew;
}
}
return CheckArray( pElem );
}
// Find-Funktion ueber Name fuer aktuellen Scope (z.B. Abfrage aus BASIC-IDE)
SbxBase* SbiRuntime::FindElementExtern( const String& rName )
{
// Hinweis zu #35281#: Es darf nicht davon ausgegangen werden, dass
// pMeth != null, da im RunInit noch keine gesetzt ist.
SbxVariable* pElem = NULL;
if( !pMod || !rName.Len() )
return NULL;
// Lokal suchen
if( refLocals )
pElem = refLocals->Find( rName, SbxCLASS_DONTCARE );
// In Statics suchen
if ( !pElem && pMeth )
{
// Bei Statics, Name der Methode davor setzen
String aMethName = pMeth->GetName();
aMethName += ':';
aMethName += rName;
pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE);
}
// In Parameter-Liste suchen
if( !pElem && pMeth )
{
SbxInfo* pInfo = pMeth->GetInfo();
if( pInfo && refParams )
{
sal_uInt16 nParamCount = refParams->Count();
sal_uInt16 j = 1;
const SbxParamInfo* pParam = pInfo->GetParam( j );
while( pParam )
{
if( pParam->aName.EqualsIgnoreCaseAscii( rName ) )
{
if( j >= nParamCount )
{
// Parameter is missing
pElem = new SbxVariable( SbxSTRING );
pElem->PutString( String( RTL_CONSTASCII_USTRINGPARAM("<missing parameter>" ) ) );
}
else
{
pElem = refParams->Get( j );
}
break;
}
pParam = pInfo->GetParam( ++j );
}
}
}
// Im Modul suchen
if( !pElem )
{
// RTL nicht durchsuchen!
sal_Bool bSave = rBasic.bNoRtl;
rBasic.bNoRtl = sal_True;
pElem = pMod->Find( rName, SbxCLASS_DONTCARE );
rBasic.bNoRtl = bSave;
}
return pElem;
}
// Argumente eines Elements setzen
// Dabei auch die Argumente umsetzen, falls benannte Parameter
// verwendet wurden
void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
{
if( nOp1 & 0x8000 )
{
if( !refArgv )
StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
sal_Bool bHasNamed = sal_False;
sal_uInt16 i;
sal_uInt16 nArgCount = refArgv->Count();
for( i = 1 ; i < nArgCount ; i++ )
{
if( refArgv->GetAlias( i ).Len() )
{
bHasNamed = sal_True; break;
}
}
if( bHasNamed )
{
// Wir haben mindestens einen benannten Parameter!
// Wir muessen also umsortieren
// Gibt es Parameter-Infos?
SbxInfo* pInfo = p->GetInfo();
if( !pInfo )
{
bool bError_ = true;
SbUnoMethod* pUnoMethod = PTR_CAST(SbUnoMethod,p);
SbUnoProperty* pUnoProperty = PTR_CAST(SbUnoProperty,p);
if( pUnoMethod || pUnoProperty )
{
SbUnoObject* pParentUnoObj = PTR_CAST( SbUnoObject,p->GetParent() );
if( pParentUnoObj )
{
Any aUnoAny = pParentUnoObj->getUnoAny();
Reference< XInvocation > xInvocation;
aUnoAny >>= xInvocation;
if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() )
{
bError_ = false;
sal_uInt16 nCurPar = 1;
AutomationNamedArgsSbxArray* pArg =
new AutomationNamedArgsSbxArray( nArgCount );
::rtl::OUString* pNames = pArg->getNames().getArray();
for( i = 1 ; i < nArgCount ; i++ )
{
SbxVariable* pVar = refArgv->Get( i );
const String& rName = refArgv->GetAlias( i );
if( rName.Len() )
pNames[i] = rName;
pArg->Put( pVar, nCurPar++ );
}
refArgv = pArg;
}
}
}
else if( bVBAEnabled && p->GetType() == SbxOBJECT && (!p->ISA(SbxMethod) || !p->IsBroadcaster()) )
{
// Check for default method with named parameters
SbxBaseRef pObj = (SbxBase*)p->GetObject();
if( pObj && pObj->ISA(SbUnoObject) )
{
SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj;
Any aAny = pUnoObj->getUnoAny();
if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
{
Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
rtl::OUString sDefaultMethod;
if ( xDfltMethod.is() )
sDefaultMethod = xDfltMethod->getDefaultMethodName();
if ( !sDefaultMethod.isEmpty() )
{
SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD );
if( meth != NULL )
pInfo = meth->GetInfo();
if( pInfo )
bError_ = false;
}
}
}
}
if( bError_ )
Error( SbERR_NO_NAMED_ARGS );
}
else
{
sal_uInt16 nCurPar = 1;
SbxArray* pArg = new SbxArray;
for( i = 1 ; i < nArgCount ; i++ )
{
SbxVariable* pVar = refArgv->Get( i );
const String& rName = refArgv->GetAlias( i );
if( rName.Len() )
{
// nCurPar wird auf den gefundenen Parameter gesetzt
sal_uInt16 j = 1;
const SbxParamInfo* pParam = pInfo->GetParam( j );
while( pParam )
{
if( pParam->aName.EqualsIgnoreCaseAscii( rName ) )
{
nCurPar = j;
break;
}
pParam = pInfo->GetParam( ++j );
}
if( !pParam )
{
Error( SbERR_NAMED_NOT_FOUND ); break;
}
}
pArg->Put( pVar, nCurPar++ );
}
refArgv = pArg;
}
}
// Eigene Var als Parameter 0
refArgv->Put( p, 0 );
p->SetParameters( refArgv );
PopArgv();
}
else
p->SetParameters( NULL );
}
// Holen eines Array-Elements
SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
{
// Falls wir ein Array haben, wollen wir bitte das Array-Element!
SbxArray* pPar;
if( pElem->GetType() & SbxARRAY )
{
SbxBase* pElemObj = pElem->GetObject();
SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
pPar = pElem->GetParameters();
if( pDimArray )
{
// Die Parameter koennen fehlen, wenn ein Array als
// Argument uebergeben wird.
if( pPar )
pElem = pDimArray->Get( pPar );
}
else
{
SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
if( pArray )
{
if( !pPar )
{
Error( SbERR_OUT_OF_RANGE );
pElem = new SbxVariable;
}
else
pElem = pArray->Get( pPar->Get( 1 )->GetInteger() );
}
}
// #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt
if( pPar )
pPar->Put( NULL, 0 );
}
// Index-Access bei UnoObjekten beruecksichtigen
else if( pElem->GetType() == SbxOBJECT && (!pElem->ISA(SbxMethod) || (bVBAEnabled && !pElem->IsBroadcaster()) ) )
{
pPar = pElem->GetParameters();
if ( pPar )
{
// Ist es ein Uno-Objekt?
SbxBaseRef pObj = (SbxBase*)pElem->GetObject();
if( pObj )
{
if( pObj->ISA(SbUnoObject) )
{
SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj;
Any aAny = pUnoObj->getUnoAny();
if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
{
Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
Reference< XIndexAccess > xIndexAccess( x, UNO_QUERY );
if ( !bVBAEnabled )
{
// Haben wir Index-Access?
if( xIndexAccess.is() )
{
sal_uInt32 nParamCount = (sal_uInt32)pPar->Count() - 1;
if( nParamCount != 1 )
{
StarBASIC::Error( SbERR_BAD_ARGUMENT );
return pElem;
}
// Index holen
sal_Int32 nIndex = pPar->Get( 1 )->GetLong();
Reference< XInterface > xRet;
try
{
Any aAny2 = xIndexAccess->getByIndex( nIndex );
TypeClass eType = aAny2.getValueType().getTypeClass();
if( eType == TypeClass_INTERFACE )
xRet = *(Reference< XInterface >*)aAny2.getValue();
}
catch (IndexOutOfBoundsException&)
{
// Bei Exception erstmal immer von Konvertierungs-Problem ausgehen
StarBASIC::Error( SbERR_OUT_OF_RANGE );
}
// #57847 Immer neue Variable anlegen, sonst Fehler
// durch PutObject(NULL) bei ReadOnly-Properties.
pElem = new SbxVariable( SbxVARIANT );
if( xRet.is() )
{
aAny <<= xRet;
// #67173 Kein Namen angeben, damit echter Klassen-Namen eintragen wird
String aName;
SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny );
pElem->PutObject( xWrapper );
}
else
{
pElem->PutObject( NULL );
}
}
}
else
{
rtl::OUString sDefaultMethod;
Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
if ( xDfltMethod.is() )
sDefaultMethod = xDfltMethod->getDefaultMethodName();
else if( xIndexAccess.is() )
sDefaultMethod = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "getByIndex" ) );
if ( !sDefaultMethod.isEmpty() )
{
SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD );
SbxVariableRef refTemp = meth;
if ( refTemp )
{
meth->SetParameters( pPar );
SbxVariable* pNew = new SbxMethod( *(SbxMethod*)meth );
pElem = pNew;
}
}
}
}
// #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt
pPar->Put( NULL, 0 );
}
else if( pObj->ISA(BasicCollection) )
{
BasicCollection* pCol = (BasicCollection*)(SbxBase*)pObj;
pElem = new SbxVariable( SbxVARIANT );
pPar->Put( pElem, 0 );
pCol->CollItem( pPar );
}
}
else if( bVBAEnabled ) // !pObj
{
SbxArray* pParam = pElem->GetParameters();
if( pParam != NULL && !pElem->IsSet( SBX_VAR_TO_DIM ) )
Error( SbERR_NO_OBJECT );
}
}
}
return pElem;
}
// Laden eines Elements aus der Runtime-Library (+StringID+Typ)
void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_False ) );
}
void
SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, SbError nNotFound, sal_Bool bLocal, sal_Bool bStatic )
{
if( !refLocals )
refLocals = new SbxArray;
PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, bLocal, bStatic ) );
}
// Laden einer lokalen/globalen Variablen (+StringID+Typ)
void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True );
}
// Search inside a class module (CM) to enable global search in time
void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pMod);
if( pClassModuleObject )
pMod->SetFlag( SBX_GBLSEARCH );
StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True );
if( pClassModuleObject )
pMod->ResetFlag( SBX_GBLSEARCH );
}
void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True, sal_True );
}
// Laden eines Objekt-Elements (+StringID+Typ)
// Das Objekt liegt auf TOS
void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
// Liegt auf dem TOS ein Objekt?
SbxVariableRef pObjVar = PopVar();
SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar);
if( !pObj )
{
SbxBase* pObjVarObj = pObjVar->GetObject();
pObj = PTR_CAST(SbxObject,pObjVarObj);
}
// #56368 Bei StepElem Referenz sichern, sonst koennen Objekte
// in Qualifizierungsketten wie ActiveComponent.Selection(0).Text
// zu fueh die Referenz verlieren
// #74254 Jetzt per Liste
if( pObj )
SaveRef( (SbxVariable*)pObj );
PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, sal_False ) );
}
// Laden eines Parameters (+Offset+Typ)
// Wenn der Datentyp nicht stimmen sollte, eine Kopie anlegen
// Der Datentyp SbxEMPTY zeigt an, daa kein Parameter angegeben ist.
// Get( 0 ) darf EMPTY sein
void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
sal_uInt16 i = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
SbxDataType t = (SbxDataType) nOp2;
SbxVariable* p;
// #57915 Missing sauberer loesen
sal_uInt16 nParamCount = refParams->Count();
if( i >= nParamCount )
{
sal_Int16 iLoop = i;
while( iLoop >= nParamCount )
{
p = new SbxVariable();
if( SbiRuntime::isVBAEnabled() &&
(t == SbxOBJECT || t == SbxSTRING) )
{
if( t == SbxOBJECT )
p->PutObject( NULL );
else
p->PutString( String() );
}
else
p->PutErr( 448 ); // Wie in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND)
refParams->Put( p, iLoop );
iLoop--;
}
}
p = refParams->Get( i );
if( p->GetType() == SbxERROR && ( i ) )
//if( p->GetType() == SbxEMPTY && ( i ) )
{
// Wenn ein Parameter fehlt, kann er OPTIONAL sein
sal_Bool bOpt = sal_False;
if( pMeth )
{
SbxInfo* pInfo = pMeth->GetInfo();
if ( pInfo )
{
const SbxParamInfo* pParam = pInfo->GetParam( i );
if( pParam && ( (pParam->nFlags & SBX_OPTIONAL) != 0 ) )
{
// Default value?
sal_uInt16 nDefaultId = sal::static_int_cast< sal_uInt16 >(
pParam->nUserData & 0xffff );
if( nDefaultId > 0 )
{
String aDefaultStr = pImg->GetString( nDefaultId );
p = new SbxVariable();
p->PutString( aDefaultStr );
refParams->Put( p, i );
}
bOpt = sal_True;
}
}
}
if( bOpt == sal_False )
Error( SbERR_NOT_OPTIONAL );
}
else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t )
{
SbxVariable* q = new SbxVariable( t );
SaveRef( q );
*q = *p;
p = q;
}
SetupArgs( p, nOp1 );
PushVar( CheckArray( p ) );
}
// Case-Test (+True-Target+Test-Opcode)
void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
if( !refCaseStk || !refCaseStk->Count() )
StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
else
{
SbxVariableRef xComp = PopVar();
SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
if( xCase->Compare( (SbxOperator) nOp2, *xComp ) )
StepJUMP( nOp1 );
}
}
// Aufruf einer DLL-Prozedur (+StringID+Typ)
// Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist
void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
String aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
SbxArray* pArgs = NULL;
if( nOp1 & 0x8000 )
pArgs = refArgv;
DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, sal_False );
aLibName = String();
if( nOp1 & 0x8000 )
PopArgv();
}
// Aufruf einer DLL-Prozedur nach CDecl (+StringID+Typ)
// Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist
void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
String aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
SbxArray* pArgs = NULL;
if( nOp1 & 0x8000 )
pArgs = refArgv;
DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, sal_True );
aLibName = String();
if( nOp1 & 0x8000 )
PopArgv();
}
// Beginn eines Statements (+Line+Col)
void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
// Wenn der Expr-Stack am Anfang einen Statements eine Variable enthaelt,
// hat ein Trottel X als Funktion aufgerufen, obwohl es eine Variable ist!
sal_Bool bFatalExpr = sal_False;
String sUnknownMethodName;
if( nExprLvl > 1 )
bFatalExpr = sal_True;
else if( nExprLvl )
{
SbxVariable* p = refExprStk->Get( 0 );
if( p->GetRefCount() > 1
&& refLocals.Is() && refLocals->Find( p->GetName(), p->GetClass() ) )
{
sUnknownMethodName = p->GetName();
bFatalExpr = sal_True;
}
}
// Der Expr-Stack ist nun nicht mehr notwendig
ClearExprStack();
// #56368 Kuenstliche Referenz fuer StepElem wieder freigeben,
// damit sie nicht ueber ein Statement hinaus erhalten bleibt
//refSaveObj = NULL;
// #74254 Jetzt per Liste
ClearRefs();
// Wir muessen hier hart abbrechen, da sonst Zeile und Spalte nicht mehr
// stimmen!
if( bFatalExpr)
{
StarBASIC::FatalError( SbERR_NO_METHOD, sUnknownMethodName );
return;
}
pStmnt = pCode - 9;
sal_uInt16 nOld = nLine;
nLine = static_cast<short>( nOp1 );
// #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern
nCol1 = static_cast<short>( nOp2 & 0xFF );
// Suchen des naechsten STMNT-Befehls,
// um die End-Spalte dieses Statements zu setzen
// Searches of the next STMNT instruction,
// around the final column of this statement to set
nCol2 = 0xffff;
sal_uInt16 n1, n2;
const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
if( p )
{
if( n1 == nOp1 )
{
// #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern
nCol2 = (n2 & 0xFF) - 1;
}
}
// #29955 for-Schleifen-Ebene korrigieren, #67452 NICHT im Error-Handler sonst Chaos
if( !bInError )
{
// (Bei Sprüngen aus Schleifen tritt hier eine Differenz auf)
sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
if( pGosubStk )
nExspectedForLevel = nExspectedForLevel + pGosubStk->nStartForLvl;
// Wenn der tatsaechliche For-Level zu klein ist, wurde aus
// einer Schleife heraus gesprungen -> korrigieren
while( nForLvl > nExspectedForLevel )
PopFor();
}
// 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out
// Erklärung siehe bei _ImplGetBreakCallLevel.
if( pInst->nCallLvl <= pInst->nBreakCallLvl )
//if( nFlags & SbDEBUG_STEPINTO )
{
StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
sal_uInt16 nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
// Neuen BreakCallLevel ermitteln
pInst->CalcBreakCallLevel( nNewFlags );
}
// Breakpoints nur bei STMNT-Befehlen in neuer Zeile!
else if( ( nOp1 != nOld )
&& ( nFlags & SbDEBUG_BREAK )
&& pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
{
StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
sal_uInt16 nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
// Neuen BreakCallLevel ermitteln
pInst->CalcBreakCallLevel( nNewFlags );
//16.10.96, ALT:
//if( nNewFlags != SbDEBUG_CONTINUE )
// nFlags = nNewFlags;
}
}
// (+SvStreamFlags+Flags)
// Stack: Blocklaenge
// Kanalnummer
// Dateiname
void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
SbxVariableRef pName = PopVar();
SbxVariableRef pChan = PopVar();
SbxVariableRef pLen = PopVar();
short nBlkLen = pLen->GetInteger();
short nChan = pChan->GetInteger();
ByteString aName( pName->GetString(), gsl_getSystemTextEncoding() );
pIosys->Open( nChan, aName, static_cast<short>( nOp1 ),
static_cast<short>( nOp2 ), nBlkLen );
Error( pIosys->GetError() );
}
// Objekt kreieren (+StringID+StringID)
void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
SbxObject *pObj = SbxBase::CreateObject( aClass );
if( !pObj )
Error( SbERR_INVALID_OBJECT );
else
{
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
pObj->SetName( aName );
// Das Objekt muss BASIC rufen koennen
pObj->SetParent( &rBasic );
SbxVariable* pNew = new SbxVariable;
pNew->PutObject( pObj );
PushVar( pNew );
}
}
void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
StepDCREATE_IMPL( nOp1, nOp2 );
}
void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
StepDCREATE_IMPL( nOp1, nOp2 );
}
// Helper function for StepDCREATE_IMPL / bRedimp = true
void implCopyDimArray_DCREATE( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
{
sal_Int32& ri = pActualIndices[nActualDim];
for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
{
if( nActualDim < nMaxDimIndex )
{
implCopyDimArray_DCREATE( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
pActualIndices, pLowerBounds, pUpperBounds );
}
else
{
SbxVariable* pSource = pOldArray->Get32( pActualIndices );
pNewArray->Put32( pSource, pActualIndices );
}
}
}
// #56204 Objekt-Array kreieren (+StringID+StringID), DCREATE == Dim-Create
void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
SbxVariableRef refVar = PopVar();
DimImpl( refVar );
// Das Array mit Instanzen der geforderten Klasse fuellen
SbxBaseRef xObj = (SbxBase*)refVar->GetObject();
if( !xObj )
{
StarBASIC::Error( SbERR_INVALID_OBJECT );
return;
}
SbxDimArray* pArray = 0;
if( xObj->ISA(SbxDimArray) )
{
SbxBase* pObj = (SbxBase*)xObj;
pArray = (SbxDimArray*)pObj;
// Dimensionen auswerten
short nDims = pArray->GetDims();
sal_Int32 nTotalSize = 0;
// es muss ein eindimensionales Array sein
sal_Int32 nLower, nUpper, nSize;
sal_Int32 i;
for( i = 0 ; i < nDims ; i++ )
{
pArray->GetDim32( i+1, nLower, nUpper );
nSize = nUpper - nLower + 1;
if( i == 0 )
nTotalSize = nSize;
else
nTotalSize *= nSize;
}
// Objekte anlegen und ins Array eintragen
String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
for( i = 0 ; i < nTotalSize ; i++ )
{
SbxObject *pClassObj = SbxBase::CreateObject( aClass );
if( !pClassObj )
{
Error( SbERR_INVALID_OBJECT );
break;
}
else
{
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
pClassObj->SetName( aName );
// Das Objekt muss BASIC rufen koennen
pClassObj->SetParent( &rBasic );
pArray->SbxArray::Put32( pClassObj, i );
}
}
}
SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
if( pArray && pOldArray )
{
short nDimsNew = pArray->GetDims();
short nDimsOld = pOldArray->GetDims();
short nDims = nDimsNew;
sal_Bool bRangeError = sal_False;
// Store dims to use them for copying later
sal_Int32* pLowerBounds = new sal_Int32[nDims];
sal_Int32* pUpperBounds = new sal_Int32[nDims];
sal_Int32* pActualIndices = new sal_Int32[nDims];
if( nDimsOld != nDimsNew )
{
bRangeError = sal_True;
}
else
{
// Compare bounds
for( short i = 1 ; i <= nDims ; i++ )
{
sal_Int32 lBoundNew, uBoundNew;
sal_Int32 lBoundOld, uBoundOld;
pArray->GetDim32( i, lBoundNew, uBoundNew );
pOldArray->GetDim32( i, lBoundOld, uBoundOld );
lBoundNew = std::max( lBoundNew, lBoundOld );
uBoundNew = std::min( uBoundNew, uBoundOld );
short j = i - 1;
pActualIndices[j] = pLowerBounds[j] = lBoundNew;
pUpperBounds[j] = uBoundNew;
}
}
if( bRangeError )
{
StarBASIC::Error( SbERR_OUT_OF_RANGE );
}
else
{
// Copy data from old array by going recursively through all dimensions
// (It would be faster to work on the flat internal data array of an
// SbyArray but this solution is clearer and easier)
implCopyDimArray_DCREATE( pArray, pOldArray, nDims - 1,
0, pActualIndices, pLowerBounds, pUpperBounds );
}
delete [] pUpperBounds;
delete [] pLowerBounds;
delete [] pActualIndices;
refRedimpArray = NULL;
}
}
// Objekt aus User-Type kreieren (+StringID+StringID)
SbxObject* createUserTypeImpl( const String& rClassName ); // sb.cxx
void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
SbxObject* pCopyObj = createUserTypeImpl( aClass );
if( pCopyObj )
pCopyObj->SetName( aName );
SbxVariable* pNew = new SbxVariable;
pNew->PutObject( pCopyObj );
pNew->SetDeclareClassName( aClass );
PushVar( pNew );
}
void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
{
bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
if( bWithEvents )
pVar->SetFlag( SBX_WITH_EVENTS );
bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
if( bDimAsNew )
pVar->SetFlag( SBX_DIM_AS_NEW );
bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
if( bFixedString )
{
sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000
String aStr;
aStr.Fill( nCount, 0 );
pVar->PutString( aStr );
}
bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
if( bVarToDim )
pVar->SetFlag( SBX_VAR_TO_DIM );
}
// Einrichten einer lokalen Variablen (+StringID+Typ)
void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
if( !refLocals.Is() )
refLocals = new SbxArray;
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
if( refLocals->Find( aName, SbxCLASS_DONTCARE ) == NULL )
{
SbxDataType t = (SbxDataType)(nOp2 & 0xffff);
SbxVariable* p = new SbxVariable( t );
p->SetName( aName );
implHandleSbxFlags( p, t, nOp2 );
refLocals->Put( p, refLocals->Count() );
}
}
// Einrichten einer modulglobalen Variablen (+StringID+Typ)
void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
{
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
SbxDataType t = (SbxDataType)(SbxDataType)(nOp2 & 0xffff);;
sal_Bool bFlag = pMod->IsSet( SBX_NO_MODIFY );
pMod->SetFlag( SBX_NO_MODIFY );
SbxVariableRef p = pMod->Find( aName, SbxCLASS_PROPERTY );
if( p.Is() )
pMod->Remove (p);
SbProperty* pProp = pMod->GetProperty( aName, t );
if( !bUsedForClassModule )
pProp->SetFlag( SBX_PRIVATE );
if( !bFlag )
pMod->ResetFlag( SBX_NO_MODIFY );
if( pProp )
{
pProp->SetFlag( SBX_DONTSTORE );
// AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden'
pProp->SetFlag( SBX_NO_MODIFY);
implHandleSbxFlags( pProp, t, nOp2 );
}
}
void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
StepPUBLIC_Impl( nOp1, nOp2, false );
}
void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
// Creates module variable that isn't reinitialised when
// between invocations ( for VBASupport & document basic only )
if( pMod->pImage->bFirstInit )
{
bool bUsedForClassModule = pImg->GetFlag( SBIMG_CLASSMODULE );
StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
}
}
// Einrichten einer globalen Variablen (+StringID+Typ)
void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
if( pImg->GetFlag( SBIMG_CLASSMODULE ) )
StepPUBLIC_Impl( nOp1, nOp2, true );
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
SbxDataType t = (SbxDataType)(nOp2 & 0xffff);
// Store module scope variables at module scope
// in non vba mode these are stored at the library level :/
// not sure if this really should not be enabled for ALL basic
SbxObject* pStorage = &rBasic;
if ( SbiRuntime::isVBAEnabled() )
{
pStorage = pMod;
pMod->AddVarName( aName );
}
sal_Bool bFlag = pStorage->IsSet( SBX_NO_MODIFY );
rBasic.SetFlag( SBX_NO_MODIFY );
SbxVariableRef p = pStorage->Find( aName, SbxCLASS_PROPERTY );
if( p.Is() )
pStorage->Remove (p);
p = pStorage->Make( aName, SbxCLASS_PROPERTY, t );
if( !bFlag )
pStorage->ResetFlag( SBX_NO_MODIFY );
if( p )
{
p->SetFlag( SBX_DONTSTORE );
// AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden'
p->SetFlag( SBX_NO_MODIFY);
}
}
// Creates global variable that isn't reinitialised when
// basic is restarted, P=PERSIST (+StringID+Typ)
void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
if( pMod->pImage->bFirstInit )
{
StepGLOBAL( nOp1, nOp2 );
}
}
// Searches for global variable, behavior depends on the fact
// if the variable is initialised for the first time
void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
if( pMod->pImage->bFirstInit )
{
// Behave like always during first init
StepFIND( nOp1, nOp2 );
}
else
{
// Return dummy variable
SbxDataType t = (SbxDataType) nOp2;
String aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
SbxVariable* pDummyVar = new SbxVariable( t );
pDummyVar->SetName( aName );
PushVar( pDummyVar );
}
}
SbxVariable* SbiRuntime::StepSTATIC_Impl( String& aName, SbxDataType& t )
{
SbxVariable* p = NULL;
if ( pMeth )
{
SbxArray* pStatics = pMeth->GetStatics();
if( pStatics && ( pStatics->Find( aName, SbxCLASS_DONTCARE ) == NULL ) )
{
p = new SbxVariable( t );
if( t != SbxVARIANT )
p->SetFlag( SBX_FIXED );
p->SetName( aName );
pStatics->Put( p, pStatics->Count() );
}
}
return p;
}
// Einrichten einer statischen Variablen (+StringID+Typ)
void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
SbxDataType t = (SbxDataType) nOp2;
StepSTATIC_Impl( aName, t );
}