summaryrefslogtreecommitdiff
path: root/basic
diff options
context:
space:
mode:
authorTor Lillqvist <tml@iki.fi>2013-04-23 18:25:56 +0300
committerTor Lillqvist <tml@iki.fi>2013-04-24 11:07:15 +0300
commitd12a3e8b760c3b104b0adbf7b7adafd1498a836e (patch)
treef9d022508ec59ca28c06d9a1bcaab2cb8faa90a5 /basic
parente4e9fba5f471141b14cff6d27586d37e28fc38c0 (diff)
Combine fairly pointlessly split source code for SbiRuntime into one file
Insert basic/source/runtime/step[012].cxx into basic/source/runtime/runtime.cxx. Follow-up to https://gerrit.libreoffice.org/#/c/3373/ . In many cases the sources for some class have been split up into several source files, typically suffixed with a number 0, 1, 2 etc. Presumably this has been done because some compiler years ago was not capable of compiling all the source for that class at one time, or some other no longer relevant reason. It would be nice to get rid of this convention, so that clever compilers have a better chance of noticing unused private fields in a class, for instance. Just combining the source files in question into one source file and removing the old source files from git leads to a discontinuity in version control history. But the consensus seems to be that this is not such a big deal. I picked these sources just because they happened to be the first ones I came across when looking for files called *0.cxx. Change-Id: Ia7e8ece9a4374721bbcce6b0e2aba5721436faae
Diffstat (limited to 'basic')
-rw-r--r--basic/Library_sb.mk3
-rw-r--r--basic/source/inc/sbunoobj.hxx10
-rw-r--r--basic/source/runtime/runtime.cxx3446
-rw-r--r--basic/source/runtime/step0.cxx1540
-rw-r--r--basic/source/runtime/step1.cxx582
-rw-r--r--basic/source/runtime/step2.cxx1400
6 files changed, 3443 insertions, 3538 deletions
diff --git a/basic/Library_sb.mk b/basic/Library_sb.mk
index 98eea5c81dac..c89214389b8b 100644
--- a/basic/Library_sb.mk
+++ b/basic/Library_sb.mk
@@ -98,9 +98,6 @@ $(eval $(call gb_Library_add_exception_objects,sb,\
basic/source/runtime/sbdiagnose \
basic/source/runtime/stdobj \
basic/source/runtime/stdobj1 \
- basic/source/runtime/step0 \
- basic/source/runtime/step1 \
- basic/source/runtime/step2 \
))
endif
diff --git a/basic/source/inc/sbunoobj.hxx b/basic/source/inc/sbunoobj.hxx
index 9bf887654645..12b62e5907a5 100644
--- a/basic/source/inc/sbunoobj.hxx
+++ b/basic/source/inc/sbunoobj.hxx
@@ -411,7 +411,15 @@ public:
bool isVBAConstantType( const OUString& rName );
};
-#endif
+SbxVariable* getDefaultProp( SbxVariable* pRef );
+
+::com::sun::star::uno::Reference< ::com::sun::star::uno::XInterface > createComListener( const ::com::sun::star::uno::Any& aControlAny,
+ const OUString& aVBAType,
+ const OUString& aPrefix,
+ SbxObjectRef xScopeObj );
+bool checkUnoObjectType( SbUnoObject* refVal, const OUString& aClass );
+
+#endif
/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx
index d1f026d5cf95..4c2ffa97e661 100644
--- a/basic/source/runtime/runtime.cxx
+++ b/basic/source/runtime/runtime.cxx
@@ -17,30 +17,67 @@
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
*/
-#include <vcl/svapp.hxx>
+#include <stdlib.h>
+
+#include <algorithm>
+
+#include <boost/unordered_map.hpp>
+
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/container/XEnumerationAccess.hpp>
+#include <com/sun/star/container/XIndexAccess.hpp>
+#include <com/sun/star/script/XDefaultMethod.hpp>
+#include <com/sun/star/uno/Any.hxx>
+#include <com/sun/star/util/SearchOptions.hpp>
+
+#include <comphelper/processfactory.hxx>
+#include <comphelper/string.hxx>
+
+#include <sal/log.hxx>
+
#include <tools/wldcrd.hxx>
+
+#include <vcl/msgbox.hxx>
+#include <vcl/svapp.hxx>
+
+#include <rtl/instance.hxx>
+#include <rtl/math.hxx>
+#include <rtl/ustrbuf.hxx>
+
#include <svl/zforlist.hxx>
+
#include <unotools/syslocale.hxx>
-#include "runtime.hxx"
-#include "sbintern.hxx"
-#include "opcodes.hxx"
+#include <unotools/textsearch.hxx>
+
+#include <basic/sbuno.hxx>
+
+#include "basrid.hxx"
#include "codegen.hxx"
-#include "iosys.hxx"
-#include "image.hxx"
+#include "comenumwrapper.hxx"
#include "ddectrl.hxx"
#include "dllmgr.hxx"
-#include <comphelper/processfactory.hxx>
-#include <com/sun/star/container/XEnumerationAccess.hpp>
-#include "sbunoobj.hxx"
#include "errobject.hxx"
-#include "sal/log.hxx"
+#include "image.hxx"
+#include "iosys.hxx"
+#include "opcodes.hxx"
+#include "runtime.hxx"
+#include "sb.hrc"
+#include "sbintern.hxx"
+#include "sbunoobj.hxx"
-#include "comenumwrapper.hxx"
+using com::sun::star::uno::Reference;
-SbxVariable* getDefaultProp( SbxVariable* pRef );
+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 namespace ::com::sun::star;
+static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType );
+static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled );
+
bool SbiRuntime::isVBAEnabled()
{
bool result = false;
@@ -1290,4 +1327,3389 @@ sal_uInt16 SbiRuntime::GetBase()
return pImg->GetBase();
}
+void SbiRuntime::StepNOP()
+{}
+
+void SbiRuntime::StepArith( SbxOperator eOp )
+{
+ SbxVariableRef p1 = PopVar();
+ TOSMakeTemp();
+ SbxVariable* p2 = GetTOS();
+
+ p2->ResetFlag( SBX_FIXED );
+ p2->Compute( eOp, *p1 );
+
+ checkArithmeticOverflow( p2 );
+}
+
+void SbiRuntime::StepUnary( SbxOperator eOp )
+{
+ TOSMakeTemp();
+ SbxVariable* p = GetTOS();
+ p->Compute( eOp, *p );
+}
+
+void SbiRuntime::StepCompare( SbxOperator eOp )
+{
+ SbxVariableRef p1 = PopVar();
+ SbxVariableRef p2 = PopVar();
+
+ // Make sure objects with default params have
+ // values ( and type ) set as appropriate
+ SbxDataType p1Type = p1->GetType();
+ SbxDataType p2Type = p2->GetType();
+ if ( p1Type == SbxEMPTY )
+ {
+ p1->Broadcast( SBX_HINT_DATAWANTED );
+ p1Type = p1->GetType();
+ }
+ if ( p2Type == SbxEMPTY )
+ {
+ p2->Broadcast( SBX_HINT_DATAWANTED );
+ p2Type = p2->GetType();
+ }
+ if ( p1Type == p2Type )
+ {
+ // if both sides are an object and have default props
+ // then we need to use the default props
+ // we don't need to worry if only one side ( lhs, rhs ) is an
+ // object ( object side will get coerced to correct type in
+ // Compare )
+ if ( p1Type == SbxOBJECT )
+ {
+ SbxVariable* pDflt = getDefaultProp( p1 );
+ if ( pDflt )
+ {
+ p1 = pDflt;
+ p1->Broadcast( SBX_HINT_DATAWANTED );
+ }
+ pDflt = getDefaultProp( p2 );
+ if ( pDflt )
+ {
+ p2 = pDflt;
+ p2->Broadcast( SBX_HINT_DATAWANTED );
+ }
+ }
+
+ }
+ static SbxVariable* pTRUE = NULL;
+ static SbxVariable* pFALSE = NULL;
+ static SbxVariable* pNULL = NULL;
+ // why do this on non-windows ?
+ // why do this at all ?
+ // I dumbly follow the pattern :-/
+ if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
+ {
+ if( !pNULL )
+ {
+ pNULL = new SbxVariable;
+ pNULL->PutNull();
+ pNULL->AddRef();
+ }
+ PushVar( pNULL );
+ }
+ else if( p2->Compare( eOp, *p1 ) )
+ {
+ if( !pTRUE )
+ {
+ pTRUE = new SbxVariable;
+ pTRUE->PutBool( sal_True );
+ pTRUE->AddRef();
+ }
+ PushVar( pTRUE );
+ }
+ else
+ {
+ if( !pFALSE )
+ {
+ pFALSE = new SbxVariable;
+ pFALSE->PutBool( sal_False );
+ pFALSE->AddRef();
+ }
+ PushVar( pFALSE );
+ }
+}
+
+void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
+void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
+void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
+void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
+void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
+void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
+void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
+void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
+void SbiRuntime::StepAND() { StepArith( SbxAND ); }
+void SbiRuntime::StepOR() { StepArith( SbxOR ); }
+void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
+void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
+void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
+
+void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
+void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
+
+void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
+void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
+void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
+void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
+void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
+void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
+
+namespace
+{
+ bool NeedEsc(sal_Unicode cCode)
+ {
+ if((cCode & 0xFF80))
+ {
+ return false;
+ }
+ switch((sal_uInt8)(cCode & 0x07F))
+ {
+ case '.':
+ case '^':
+ case '$':
+ case '+':
+ case '\\':
+ case '|':
+ case '{':
+ case '}':
+ case '(':
+ case ')':
+ return true;
+ default:
+ return false;
+ }
+ }
+
+ OUString VBALikeToRegexp(const OUString &rIn)
+ {
+ OUStringBuffer sResult;
+ const sal_Unicode *start = rIn.getStr();
+ const sal_Unicode *end = start + rIn.getLength();
+
+ int seenright = 0;
+
+ sResult.append('^');
+
+ while (start < end)
+ {
+ switch (*start)
+ {
+ case '?':
+ sResult.append('.');
+ start++;
+ break;
+ case '*':
+ sResult.append(".*");
+ start++;
+ break;
+ case '#':
+ sResult.append("[0-9]");
+ start++;
+ break;
+ case ']':
+ sResult.append('\\');
+ sResult.append(*start++);
+ break;
+ case '[':
+ sResult.append(*start++);
+ seenright = 0;
+ while (start < end && !seenright)
+ {
+ switch (*start)
+ {
+ case '[':
+ case '?':
+ case '*':
+ sResult.append('\\');
+ sResult.append(*start);
+ break;
+ case ']':
+ sResult.append(*start);
+ seenright = 1;
+ break;
+ case '!':
+ sResult.append('^');
+ break;
+ default:
+ if (NeedEsc(*start))
+ {
+ sResult.append('\\');
+ }
+ sResult.append(*start);
+ break;
+ }
+ start++;
+ }
+ break;
+ default:
+ if (NeedEsc(*start))
+ {
+ sResult.append('\\');
+ }
+ sResult.append(*start++);
+ }
+ }
+
+ sResult.append('$');
+
+ return sResult.makeStringAndClear();
+ }
+}
+
+void SbiRuntime::StepLIKE()
+{
+ SbxVariableRef refVar1 = PopVar();
+ SbxVariableRef refVar2 = PopVar();
+
+ OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
+ OUString value = refVar2->GetOUString();
+
+ com::sun::star::util::SearchOptions aSearchOpt;
+
+ aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
+
+ aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
+ aSearchOpt.searchString = pattern;
+
+ int bTextMode(1);
+ bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
+ }
+ if( bTextMode )
+ {
+ aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
+ }
+ SbxVariable* pRes = new SbxVariable;
+ utl::TextSearch aSearch(aSearchOpt);
+ sal_uInt16 nStart=0, nEnd=value.getLength();
+ int bRes = aSearch.SearchFrwrd(value, &nStart, &nEnd);
+ pRes->PutBool( bRes != 0 );
+
+ PushVar( pRes );
+}
+
+// TOS and TOS-1 are both object variables and contain the same pointer
+
+void SbiRuntime::StepIS()
+{
+ SbxVariableRef refVar1 = PopVar();
+ SbxVariableRef refVar2 = PopVar();
+
+ SbxDataType eType1 = refVar1->GetType();
+ SbxDataType eType2 = refVar2->GetType();
+ if ( eType1 == SbxEMPTY )
+ {
+ refVar1->Broadcast( SBX_HINT_DATAWANTED );
+ eType1 = refVar1->GetType();
+ }
+ if ( eType2 == SbxEMPTY )
+ {
+ refVar2->Broadcast( SBX_HINT_DATAWANTED );
+ eType2 = refVar2->GetType();
+ }
+
+ sal_Bool bRes = sal_Bool( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
+ if ( bVBAEnabled && !bRes )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ }
+ bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
+ SbxVariable* pRes = new SbxVariable;
+ pRes->PutBool( bRes );
+ PushVar( pRes );
+}
+
+// update the value of TOS
+
+void SbiRuntime::StepGET()
+{
+ SbxVariable* p = GetTOS();
+ p->Broadcast( SBX_HINT_DATAWANTED );
+}
+
+// #67607 copy Uno-Structs
+inline bool checkUnoStructCopy( bool bVBA, SbxVariableRef& refVal, SbxVariableRef& refVar )
+{
+ SbxDataType eVarType = refVar->GetType();
+ SbxDataType eValType = refVal->GetType();
+
+ if ( !( !bVBA|| ( bVBA && refVar->GetType() != SbxEMPTY ) ) || !refVar->CanWrite() )
+ return false;
+
+ if ( eValType != SbxOBJECT )
+ return false;
+ // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
+ // there :-/ not sure if for every '=' we would want struct handling
+ if( eVarType != SbxOBJECT )
+ {
+ if ( refVar->IsFixed() )
+ return false;
+ }
+ // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
+ else if( refVar->ISA(SbProcedureProperty) )
+ return false;
+
+ SbxObjectRef xValObj = (SbxObject*)refVal->GetObject();
+ if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
+ return false;
+
+ SbUnoObject* pUnoVal = PTR_CAST(SbUnoObject,(SbxObject*)xValObj);
+ SbUnoStructRefObject* pUnoStructVal = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xValObj);
+ Any aAny;
+ // make doubly sure value is either an Uno object or
+ // an uno struct
+ if ( pUnoVal || pUnoStructVal )
+ aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
+ else
+ return false;
+ if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
+ {
+ refVar->SetType( SbxOBJECT );
+ SbxError eOldErr = refVar->GetError();
+ // There are some circumstances when calling GetObject
+ // will trigger an error, we need to squash those here.
+ // Alternatively it is possible that the same scenario
+ // could overwrite and existing error. Lets prevent that
+ SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject();
+ if ( eOldErr != SbxERR_OK )
+ refVar->SetError( eOldErr );
+ else
+ refVar->ResetError();
+
+ SbUnoStructRefObject* pUnoStructObj = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xVarObj);
+
+ OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
+ OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
+
+ if ( pUnoStructObj )
+ {
+ StructRefInfo aInfo = pUnoStructObj->getStructInfo();
+ aInfo.setValue( aAny );
+ }
+ else
+ {
+ SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
+ // #70324: adopt ClassName
+ pNewUnoObj->SetClassName( sClassName );
+ refVar->PutObject( pNewUnoObj );
+ }
+ return true;
+ }
+ return false;
+}
+
+
+// laying down TOS in TOS-1
+
+void SbiRuntime::StepPUT()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ // store on its own method (inside a function)?
+ bool bFlagsChanged = false;
+ sal_uInt16 n = 0;
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ {
+ bFlagsChanged = true;
+ n = refVar->GetFlags();
+ refVar->SetFlag( SBX_WRITE );
+ }
+
+ // if left side arg is an object or variant and right handside isn't
+ // either an object or a variant then try and see if a default
+ // property exists.
+ // to use e.g. Range{"A1") = 34
+ // could equate to Range("A1").Value = 34
+ if ( bVBAEnabled )
+ {
+ // yet more hacking at this, I feel we don't quite have the correct
+ // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
+ // obj1 ) has default member/property ) ) It seems that default props
+ // aren't dealt with if the object is a member of some parent object
+ bool bObjAssign = false;
+ if ( refVar->GetType() == SbxEMPTY )
+ refVar->Broadcast( SBX_HINT_DATAWANTED );
+ if ( refVar->GetType() == SbxOBJECT )
+ {
+ if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVar );
+
+ if ( pDflt )
+ refVar = pDflt;
+ }
+ else
+ bObjAssign = true;
+ }
+ if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( refVal->IsA( TYPE(SbxMethod) ) || ! refVal->GetParent() ) )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVal );
+ if ( pDflt )
+ refVal = pDflt;
+ }
+ }
+
+ if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
+ *refVar = *refVal;
+
+ if( bFlagsChanged )
+ refVar->SetFlags( n );
+}
+
+
+// VBA Dim As New behavior handling, save init object information
+struct DimAsNewRecoverItem
+{
+ OUString m_aObjClass;
+ OUString m_aObjName;
+ SbxObject* m_pObjParent;
+ SbModule* m_pClassModule;
+
+ DimAsNewRecoverItem( void )
+ : m_pObjParent( NULL )
+ , m_pClassModule( NULL )
+ {}
+
+ DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
+ SbxObject* pObjParent, SbModule* pClassModule )
+ : m_aObjClass( rObjClass )
+ , m_aObjName( rObjName )
+ , m_pObjParent( pObjParent )
+ , m_pClassModule( pClassModule )
+ {}
+
+};
+
+
+struct SbxVariablePtrHash
+{
+ size_t operator()( SbxVariable* pVar ) const
+ { return (size_t)pVar; }
+};
+
+typedef boost::unordered_map< SbxVariable*, DimAsNewRecoverItem,
+ SbxVariablePtrHash > DimAsNewRecoverHash;
+
+class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
+
+void removeDimAsNewRecoverItem( SbxVariable* pVar )
+{
+ DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
+ DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
+ if( it != rDimAsNewRecoverHash.end() )
+ {
+ rDimAsNewRecoverHash.erase( it );
+ }
+}
+
+
+// saving object variable
+// not-object variables will cause errors
+
+static const char pCollectionStr[] = "Collection";
+
+void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
+{
+ // #67733 types with array-flag are OK too
+
+ // Check var, !object is no error for sure if, only if type is fixed
+ SbxDataType eVarType = refVar->GetType();
+ if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ return;
+ }
+
+ // Check value, !object is no error for sure if, only if type is fixed
+ SbxDataType eValType = refVal->GetType();
+ if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ return;
+ }
+
+ // Getting in here causes problems with objects with default properties
+ // if they are SbxEMPTY I guess
+ if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
+ {
+ // activate GetOject for collections on refVal
+ SbxBase* pObjVarObj = refVal->GetObject();
+ if( pObjVarObj )
+ {
+ SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
+
+ if( refObjVal )
+ {
+ refVal = refObjVal;
+ }
+ else if( !(eValType & SbxARRAY) )
+ {
+ refVal = NULL;
+ }
+ }
+ }
+
+ // #52896 refVal can be invalid here, if uno-sequences - or more
+ // general arrays - are assigned to variables that are declared
+ // as an object!
+ if( !refVal )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ bool bFlagsChanged = false;
+ sal_uInt16 n = 0;
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ {
+ bFlagsChanged = true;
+ n = refVar->GetFlags();
+ refVar->SetFlag( SBX_WRITE );
+ }
+ SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
+ if( pProcProperty )
+ {
+ pProcProperty->setSet( true );
+ }
+ if ( bHandleDefaultProp )
+ {
+ // get default properties for lhs & rhs where necessary
+ // SbxVariable* defaultProp = NULL; unused variable
+ // LHS try determine if a default prop exists
+ // again like in StepPUT (see there too ) we are tweaking the
+ // heursitics again for when to assign an object reference or
+ // use default memebers if they exists
+ // #FIXME we really need to get to the bottom of this mess
+ bool bObjAssign = false;
+ if ( refVar->GetType() == SbxOBJECT )
+ {
+ if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVar );
+ if ( pDflt )
+ {
+ refVar = pDflt;
+ }
+ }
+ else
+ bObjAssign = true;
+ }
+ // RHS only get a default prop is the rhs has one
+ if ( refVal->GetType() == SbxOBJECT )
+ {
+ // check if lhs is a null object
+ // if it is then use the object not the default property
+ SbxObject* pObj = NULL;
+
+
+ pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
+
+ // calling GetObject on a SbxEMPTY variable raises
+ // object not set errors, make sure its an Object
+ if ( !pObj && refVar->GetType() == SbxOBJECT )
+ {
+ SbxBase* pObjVarObj = refVar->GetObject();
+ pObj = PTR_CAST(SbxObject,pObjVarObj);
+ }
+ SbxVariable* pDflt = NULL;
+ if ( pObj && !bObjAssign )
+ {
+ // lhs is either a valid object || or has a defaultProp
+ pDflt = getDefaultProp( refVal );
+ }
+ if ( pDflt )
+ {
+ refVal = pDflt;
+ }
+ }
+ }
+
+ // Handle Dim As New
+ bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
+ SbxBaseRef xPrevVarObj;
+ if( bDimAsNew )
+ {
+ xPrevVarObj = refVar->GetObject();
+ }
+ // Handle withevents
+ sal_Bool bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
+ if ( bWithEvents )
+ {
+ Reference< XInterface > xComListener;
+
+ SbxBase* pObj = refVal->GetObject();
+ SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
+ if( pUnoObj != NULL )
+ {
+ Any aControlAny = pUnoObj->getUnoAny();
+ OUString aDeclareClassName = refVar->GetDeclareClassName();
+ OUString aVBAType = aDeclareClassName;
+ OUString aPrefix = refVar->GetName();
+ SbxObjectRef xScopeObj = refVar->GetParent();
+ xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
+
+ refVal->SetDeclareClassName( aDeclareClassName );
+ refVal->SetComListener( xComListener, &rBasic ); // Hold reference
+ }
+
+ }
+
+ // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
+ // in this case if there is a default prop involved the value of the
+ // default property may infact be void so the type will also be SbxEMPTY
+ // in this case we do not want to call checkUnoStructCopy 'cause that will
+ // cause an error also
+ if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
+ {
+ *refVar = *refVal;
+ }
+ if ( bDimAsNew )
+ {
+ if( !refVar->ISA(SbxObject) )
+ {
+ SbxBase* pValObjBase = refVal->GetObject();
+ if( pValObjBase == NULL )
+ {
+ if( xPrevVarObj.Is() )
+ {
+ // Object is overwritten with NULL, instantiate init object
+ DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
+ DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar );
+ if( it != rDimAsNewRecoverHash.end() )
+ {
+ const DimAsNewRecoverItem& rItem = it->second;
+ if( rItem.m_pClassModule != NULL )
+ {
+ SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
+ pNewObj->SetName( rItem.m_aObjName );
+ pNewObj->SetParent( rItem.m_pObjParent );
+ refVar->PutObject( pNewObj );
+ }
+ else if( rItem.m_aObjClass.equalsIgnoreAsciiCaseAscii( pCollectionStr ) )
+ {
+ BasicCollection* pNewCollection = new BasicCollection( OUString(pCollectionStr) );
+ pNewCollection->SetName( rItem.m_aObjName );
+ pNewCollection->SetParent( rItem.m_pObjParent );
+ refVar->PutObject( pNewCollection );
+ }
+ }
+ }
+ }
+ else
+ {
+ // Does old value exist?
+ bool bFirstInit = !xPrevVarObj.Is();
+ if( bFirstInit )
+ {
+ // Store information to instantiate object later
+ SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
+ if( pValObj != NULL )
+ {
+ OUString aObjClass = pValObj->GetClassName();
+
+ SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
+ DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
+ if( pClassModuleObj != NULL )
+ {
+ SbModule* pClassModule = pClassModuleObj->getClassModule();
+ rDimAsNewRecoverHash[refVar] =
+ DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
+ }
+ else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
+ {
+ rDimAsNewRecoverHash[refVar] =
+ DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
+ }
+ }
+ }
+ }
+ }
+ }
+
+ if( bFlagsChanged )
+ {
+ refVar->SetFlags( n );
+ }
+ }
+}
+
+void SbiRuntime::StepSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
+}
+
+void SbiRuntime::StepVBASET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ // don't handle default property
+ StepSET_Impl( refVal, refVar, false ); // set obj = something
+}
+
+
+void SbiRuntime::StepLSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ if( refVar->GetType() != SbxSTRING ||
+ refVal->GetType() != SbxSTRING )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ sal_uInt16 n = refVar->GetFlags();
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ {
+ refVar->SetFlag( SBX_WRITE );
+ }
+ OUString aRefVarString = refVar->GetOUString();
+ OUString aRefValString = refVal->GetOUString();
+
+ sal_Int32 nVarStrLen = aRefVarString.getLength();
+ sal_Int32 nValStrLen = aRefValString.getLength();
+ OUStringBuffer aNewStr;
+ if( nVarStrLen > nValStrLen )
+ {
+ aNewStr.append(aRefValString);
+ comphelper::string::padToLength(aNewStr, nVarStrLen, ' ');
+ }
+ else
+ {
+ aNewStr = aRefValString.copy( 0, nVarStrLen );
+ }
+
+ refVar->PutString(aNewStr.makeStringAndClear());
+ refVar->SetFlags( n );
+ }
+}
+
+void SbiRuntime::StepRSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ sal_uInt16 n = refVar->GetFlags();
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ {
+ refVar->SetFlag( SBX_WRITE );
+ }
+ OUString aRefVarString = refVar->GetOUString();
+ OUString aRefValString = refVal->GetOUString();
+ sal_Int32 nVarStrLen = aRefVarString.getLength();
+ sal_Int32 nValStrLen = aRefValString.getLength();
+
+ OUStringBuffer aNewStr(nVarStrLen);
+ if (nVarStrLen > nValStrLen)
+ {
+ comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
+ aNewStr.append(aRefValString);
+ }
+ else
+ {
+ aNewStr.append(aRefValString.copy(0, nVarStrLen));
+ }
+ refVar->PutString(aNewStr.makeStringAndClear());
+
+ refVar->SetFlags( n );
+ }
+}
+
+// laying down TOS in TOS-1, then set ReadOnly-Bit
+
+void SbiRuntime::StepPUTC()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ refVar->SetFlag( SBX_WRITE );
+ *refVar = *refVal;
+ refVar->ResetFlag( SBX_WRITE );
+ refVar->SetFlag( SBX_CONST );
+}
+
+// DIM
+// TOS = variable for the array with dimension information as parameter
+
+void SbiRuntime::StepDIM()
+{
+ SbxVariableRef refVar = PopVar();
+ DimImpl( refVar );
+}
+
+// #56204 swap out DIM-functionality into a help method (step0.cxx)
+void SbiRuntime::DimImpl( SbxVariableRef refVar )
+{
+ // If refDim then this DIM statement is terminating a ReDIM and
+ // previous StepERASE_CLEAR for an array, the following actions have
+ // been delayed from ( StepERASE_CLEAR ) 'till here
+ if ( refRedim )
+ {
+ if ( !refRedimpArray ) // only erase the array not ReDim Preserve
+ {
+ lcl_eraseImpl( refVar, bVBAEnabled );
+ }
+ SbxDataType eType = refVar->GetType();
+ lcl_clearImpl( refVar, eType );
+ refRedim = NULL;
+ }
+ SbxArray* pDims = refVar->GetParameters();
+ // must have an even number of arguments
+ // have in mind that Arg[0] does not count!
+ if( pDims && !( pDims->Count() & 1 ) )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ }
+ else
+ {
+ SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
+ SbxDimArray* pArray = new SbxDimArray( eType );
+ // allow arrays without dimension information, too (VB-compatible)
+ if( pDims )
+ {
+ refVar->ResetFlag( SBX_VAR_TO_DIM );
+
+ for( sal_uInt16 i = 1; i < pDims->Count(); )
+ {
+ sal_Int32 lb = pDims->Get( i++ )->GetLong();
+ sal_Int32 ub = pDims->Get( i++ )->GetLong();
+ if( ub < lb )
+ {
+ Error( SbERR_OUT_OF_RANGE ), ub = lb;
+ }
+ pArray->AddDim32( lb, ub );
+ if ( lb != ub )
+ {
+ pArray->setHasFixedSize( true );
+ }
+ }
+ }
+ else
+ {
+ // #62867 On creating an array of the length 0, create
+ // a dimension (like for Uno-Sequences of the length 0)
+ pArray->unoAddDim( 0, -1 );
+ }
+ sal_uInt16 nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SBX_FIXED );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nSavFlags );
+ refVar->SetParameters( NULL );
+ }
+}
+
+// REDIM
+// TOS = variable for the array
+// argv = dimension information
+
+void SbiRuntime::StepREDIM()
+{
+ // Nothing different than dim at the moment because
+ // a double dim is already recognized by the compiler.
+ StepDIM();
+}
+
+
+// Helper function for StepREDIMP
+void implCopyDimArray( 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( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
+ pActualIndices, pLowerBounds, pUpperBounds );
+ }
+ else
+ {
+ SbxVariable* pSource = pOldArray->Get32( pActualIndices );
+ SbxVariable* pDest = pNewArray->Get32( pActualIndices );
+ if( pSource && pDest )
+ {
+ *pDest = *pSource;
+ }
+ }
+ }
+}
+
+// REDIM PRESERVE
+// TOS = variable for the array
+// argv = dimension information
+
+void SbiRuntime::StepREDIMP()
+{
+ SbxVariableRef refVar = PopVar();
+ DimImpl( refVar );
+
+ // Now check, if we can copy from the old array
+ if( refRedimpArray.Is() )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
+ SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
+ if( pNewArray )
+ {
+ short nDimsNew = pNewArray->GetDims();
+ short nDimsOld = pOldArray->GetDims();
+ short nDims = nDimsNew;
+
+ if( nDimsOld != nDimsNew )
+ {
+ StarBASIC::Error( SbERR_OUT_OF_RANGE );
+ }
+ else
+ {
+ // 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];
+
+ // Compare bounds
+ for( short i = 1 ; i <= nDims ; i++ )
+ {
+ sal_Int32 lBoundNew, uBoundNew;
+ sal_Int32 lBoundOld, uBoundOld;
+ pNewArray->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;
+ }
+ // 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( pNewArray, pOldArray, nDims - 1,
+ 0, pActualIndices, pLowerBounds, pUpperBounds );
+ delete[] pUpperBounds;
+ delete[] pLowerBounds;
+ delete[] pActualIndices;
+ }
+
+ refRedimpArray = NULL;
+ }
+ }
+
+}
+
+// REDIM_COPY
+// TOS = Array-Variable, Reference to array is copied
+// Variable is cleared as in ERASE
+
+void SbiRuntime::StepREDIMP_ERASE()
+{
+ SbxVariableRef refVar = PopVar();
+ refRedim = refVar;
+ SbxDataType eType = refVar->GetType();
+ if( eType & SbxARRAY )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
+ if( pDimArray )
+ {
+ refRedimpArray = pDimArray;
+ }
+
+ }
+ else if( refVar->IsFixed() )
+ {
+ refVar->Clear();
+ }
+ else
+ {
+ refVar->SetType( SbxEMPTY );
+ }
+}
+
+static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
+{
+ sal_uInt16 nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SBX_FIXED );
+ refVar->SetType( SbxDataType(eType & 0x0FFF) );
+ refVar->SetFlags( nSavFlags );
+ refVar->Clear();
+}
+
+static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
+{
+ SbxDataType eType = refVar->GetType();
+ if( eType & SbxARRAY )
+ {
+ if ( bVBAEnabled )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
+ bool bClearValues = true;
+ if( pDimArray )
+ {
+ if ( pDimArray->hasFixedSize() )
+ {
+ // Clear all Value(s)
+ pDimArray->SbxArray::Clear();
+ bClearValues = false;
+ }
+ else
+ {
+ pDimArray->Clear(); // clear Dims
+ }
+ }
+ if ( bClearValues )
+ {
+ SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
+ if ( pArray )
+ {
+ pArray->Clear();
+ }
+ }
+ }
+ else
+ {
+ // Arrays have on an erase to VB quite a complex behaviour. Here are
+ // only the type problems at REDIM (#26295) removed at first:
+ // Set type hard onto the array-type, because a variable with array is
+ // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
+ // the original type is lost -> runtime error
+ lcl_clearImpl( refVar, eType );
+ }
+ }
+ else if( refVar->IsFixed() )
+ {
+ refVar->Clear();
+ }
+ else
+ {
+ refVar->SetType( SbxEMPTY );
+ }
+}
+
+// delete variable
+// TOS = variable
+
+void SbiRuntime::StepERASE()
+{
+ SbxVariableRef refVar = PopVar();
+ lcl_eraseImpl( refVar, bVBAEnabled );
+}
+
+void SbiRuntime::StepERASE_CLEAR()
+{
+ refRedim = PopVar();
+}
+
+void SbiRuntime::StepARRAYACCESS()
+{
+ if( !refArgv )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ }
+ SbxVariableRef refVar = PopVar();
+ refVar->SetParameters( refArgv );
+ PopArgv();
+ PushVar( CheckArray( refVar ) );
+}
+
+void SbiRuntime::StepBYVAL()
+{
+ // Copy variable on stack to break call by reference
+ SbxVariableRef pVar = PopVar();
+ SbxDataType t = pVar->GetType();
+
+ SbxVariable* pCopyVar = new SbxVariable( t );
+ pCopyVar->SetFlag( SBX_READWRITE );
+ *pCopyVar = *pVar;
+
+ PushVar( pCopyVar );
+}
+
+// establishing an argv
+// nOp1 stays as it is -> 1st element is the return value
+
+void SbiRuntime::StepARGC()
+{
+ PushArgv();
+ refArgv = new SbxArray;
+ nArgc = 1;
+}
+
+// storing an argument in Argv
+
+void SbiRuntime::StepARGV()
+{
+ if( !refArgv )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ }
+ else
+ {
+ SbxVariableRef pVal = PopVar();
+
+ // Before fix of #94916:
+ if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
+ {
+ // evaluate methods and properties!
+ SbxVariable* pRes = new SbxVariable( *pVal );
+ pVal = pRes;
+ }
+ refArgv->Put( pVal, nArgc++ );
+ }
+}
+
+// Input to Variable. The variable is on TOS and is
+// is removed afterwards.
+void SbiRuntime::StepINPUT()
+{
+ OUStringBuffer sin;
+ OUString s;
+ char ch = 0;
+ SbError err;
+ // Skip whitespace
+ while( ( err = pIosys->GetError() ) == 0 )
+ {
+ ch = pIosys->Read();
+ if( ch != ' ' && ch != '\t' && ch != '\n' )
+ {
+ break;
+ }
+ }
+ if( !err )
+ {
+ // Scan until comma or whitespace
+ char sep = ( ch == '"' ) ? ch : 0;
+ if( sep )
+ {
+ ch = pIosys->Read();
+ }
+ while( ( err = pIosys->GetError() ) == 0 )
+ {
+ if( ch == sep )
+ {
+ ch = pIosys->Read();
+ if( ch != sep )
+ {
+ break;
+ }
+ }
+ else if( !sep && (ch == ',' || ch == '\n') )
+ {
+ break;
+ }
+ sin.append( ch );
+ ch = pIosys->Read();
+ }
+ // skip whitespace
+ if( ch == ' ' || ch == '\t' )
+ {
+ while( ( err = pIosys->GetError() ) == 0 )
+ {
+ if( ch != ' ' && ch != '\t' && ch != '\n' )
+ {
+ break;
+ }
+ ch = pIosys->Read();
+ }
+ }
+ }
+ if( !err )
+ {
+ s = sin.makeStringAndClear();
+ SbxVariableRef pVar = GetTOS();
+ // try to fill the variable with a numeric value first,
+ // then with a string value
+ if( !pVar->IsFixed() || pVar->IsNumeric() )
+ {
+ sal_uInt16 nLen = 0;
+ if( !pVar->Scan( s, &nLen ) )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ // the value has to be scanned in completely
+ else if( nLen != s.getLength() && !pVar->PutString( s ) )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ else if( nLen != s.getLength() && pVar->IsNumeric() )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ if( !err )
+ {
+ err = SbERR_CONVERSION;
+ }
+ }
+ }
+ else
+ {
+ pVar->PutString( s );
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ }
+ if( err == SbERR_USER_ABORT )
+ {
+ Error( err );
+ }
+ else if( err )
+ {
+ if( pRestart && !pIosys->GetChannel() )
+ {
+ pCode = pRestart;
+ }
+ else
+ {
+ Error( err );
+ }
+ }
+ else
+ {
+ PopVar();
+ }
+}
+
+// Line Input to Variable. The variable is on TOS and is
+// deleted afterwards.
+
+void SbiRuntime::StepLINPUT()
+{
+ OString aInput;
+ pIosys->Read( aInput );
+ Error( pIosys->GetError() );
+ SbxVariableRef p = PopVar();
+ p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
+}
+
+// end of program
+
+void SbiRuntime::StepSTOP()
+{
+ pInst->Stop();
+}
+
+
+void SbiRuntime::StepINITFOR()
+{
+ PushFor();
+}
+
+void SbiRuntime::StepINITFOREACH()
+{
+ PushForEach();
+}
+
+// increment FOR-variable
+
+void SbiRuntime::StepNEXT()
+{
+ if( !pForStk )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ return;
+ }
+ if( pForStk->eForType == FOR_TO )
+ {
+ pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
+ }
+}
+
+// beginning CASE: TOS in CASE-stack
+
+void SbiRuntime::StepCASE()
+{
+ if( !refCaseStk.Is() )
+ {
+ refCaseStk = new SbxArray;
+ }
+ SbxVariableRef xVar = PopVar();
+ refCaseStk->Put( xVar, refCaseStk->Count() );
+}
+
+// end CASE: free variable
+
+void SbiRuntime::StepENDCASE()
+{
+ if( !refCaseStk || !refCaseStk->Count() )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ }
+ else
+ {
+ refCaseStk->Remove( refCaseStk->Count() - 1 );
+ }
+}
+
+
+void SbiRuntime::StepSTDERROR()
+{
+ pError = NULL; bError = true;
+ pInst->aErrorMsg = OUString();
+ pInst->nErr = 0L;
+ pInst->nErl = 0;
+ nError = 0L;
+ SbxErrObject::getUnoErrObject()->Clear();
+}
+
+void SbiRuntime::StepNOERROR()
+{
+ pInst->aErrorMsg = OUString();
+ pInst->nErr = 0L;
+ pInst->nErl = 0;
+ nError = 0L;
+ SbxErrObject::getUnoErrObject()->Clear();
+ bError = false;
+}
+
+// leave UP
+
+void SbiRuntime::StepLEAVE()
+{
+ bRun = false;
+ // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
+ if ( bInError && pError )
+ {
+ SbxErrObject::getUnoErrObject()->Clear();
+ }
+}
+
+void SbiRuntime::StepCHANNEL() // TOS = channel number
+{
+ SbxVariableRef pChan = PopVar();
+ short nChan = pChan->GetInteger();
+ pIosys->SetChannel( nChan );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepCHANNEL0()
+{
+ pIosys->ResetChannel();
+}
+
+void SbiRuntime::StepPRINT() // print TOS
+{
+ SbxVariableRef p = PopVar();
+ OUString s1 = p->GetOUString();
+ OUString s;
+ if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
+ {
+ s = " "; // one blank before
+ }
+ s += s1;
+ OString aByteStr(OUStringToOString(s, osl_getThreadTextEncoding()));
+ pIosys->Write( aByteStr );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepPRINTF() // print TOS in field
+{
+ SbxVariableRef p = PopVar();
+ OUString s1 = p->GetOUString();
+ OUStringBuffer s;
+ if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
+ {
+ s.append(' ');
+ }
+ s.append(s1);
+ comphelper::string::padToLength(s, 14, ' ');
+ OString aByteStr(OUStringToOString(s.makeStringAndClear(), osl_getThreadTextEncoding()));
+ pIosys->Write( aByteStr );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepWRITE() // write TOS
+{
+ SbxVariableRef p = PopVar();
+ // Does the string have to be encapsulated?
+ char ch = 0;
+ switch (p->GetType() )
+ {
+ case SbxSTRING: ch = '"'; break;
+ case SbxCURRENCY:
+ case SbxBOOL:
+ case SbxDATE: ch = '#'; break;
+ default: break;
+ }
+ OUString s;
+ if( ch )
+ {
+ s += OUString(ch);
+ }
+ s += p->GetOUString();
+ if( ch )
+ {
+ s += OUString(ch);
+ }
+ OString aByteStr(OUStringToOString(s, osl_getThreadTextEncoding()));
+ pIosys->Write( aByteStr );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
+{
+ SbxVariableRef pTos1 = PopVar();
+ SbxVariableRef pTos = PopVar();
+ OUString aDest = pTos1->GetOUString();
+ OUString aSource = pTos->GetOUString();
+
+ if( hasUno() )
+ {
+ implStepRenameUCB( aSource, aDest );
+ }
+ else
+ {
+ implStepRenameOSL( aSource, aDest );
+ }
+}
+
+// TOS = Prompt
+
+void SbiRuntime::StepPROMPT()
+{
+ SbxVariableRef p = PopVar();
+ OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
+ pIosys->SetPrompt( aStr );
+}
+
+// Set Restart point
+
+void SbiRuntime::StepRESTART()
+{
+ pRestart = pCode;
+}
+
+// empty expression on stack for missing parameter
+
+void SbiRuntime::StepEMPTY()
+{
+ // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
+ // This is represented by the value 448 (SbERR_NAMED_NOT_FOUND) of the type error
+ // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
+ // to simplify matters.
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ xVar->PutErr( 448 );
+ PushVar( xVar );
+}
+
+// TOS = error code
+
+void SbiRuntime::StepERROR()
+{
+ SbxVariableRef refCode = PopVar();
+ sal_uInt16 n = refCode->GetUShort();
+ SbError error = StarBASIC::GetSfxFromVBError( n );
+ if ( bVBAEnabled )
+ {
+ pInst->Error( error );
+ }
+ else
+ {
+ Error( error );
+ }
+}
+
+// loading a numeric constant (+ID)
+
+void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = new SbxVariable( SbxDOUBLE );
+
+ // #57844 use localized function
+ OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
+ // also allow , !!!
+ sal_Int32 iComma = aStr.indexOf((sal_Unicode)',');
+ if( iComma >= 0 )
+ {
+ aStr = aStr.replaceAt(iComma, 1, OUString("."));
+ }
+ double n = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
+
+ p->PutDouble( n );
+ PushVar( p );
+}
+
+// loading a string constant (+ID)
+
+void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = new SbxVariable;
+ p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ PushVar( p );
+}
+
+// Immediate Load (+Wert)
+
+void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = new SbxVariable;
+ p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
+ PushVar( p );
+}
+
+// stora a named argument in Argv (+Arg-no. from 1!)
+
+void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
+{
+ if( !refArgv )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ else
+ {
+ OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ SbxVariableRef pVal = PopVar();
+ if( bVBAEnabled && ( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) ) )
+ {
+ // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
+ if ( pVal->GetType() == SbxEMPTY )
+ pVal->Broadcast( SBX_HINT_DATAWANTED );
+ // evaluate methods and properties!
+ SbxVariable* pRes = new SbxVariable( *pVal );
+ pVal = pRes;
+ }
+ refArgv->Put( pVal, nArgc );
+ refArgv->PutAlias( aAlias, nArgc++ );
+ }
+}
+
+// converting the type of an argument in Argv for DECLARE-Fkt. (+type)
+
+void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
+{
+ if( !refArgv )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ else
+ {
+ bool bByVal = (nOp1 & 0x8000) != 0; // Ist BYVAL requested?
+ SbxDataType t = (SbxDataType) (nOp1 & 0x7FFF);
+ SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // last Arg
+
+ // check BYVAL
+ if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
+ {
+ // parameter is a reference
+ if( bByVal )
+ {
+ // Call by Value is requested -> create a copy
+ pVar = new SbxVariable( *pVar );
+ pVar->SetFlag( SBX_READWRITE );
+ refExprStk->Put( pVar, refArgv->Count() - 1 );
+ }
+ else
+ pVar->SetFlag( SBX_REFERENCE ); // Ref-Flag for DllMgr
+ }
+ else
+ {
+ // parameter is NO reference
+ if( bByVal )
+ pVar->ResetFlag( SBX_REFERENCE ); // no reference -> OK
+ else
+ Error( SbERR_BAD_PARAMETERS ); // reference needed
+ }
+
+ if( pVar->GetType() != t )
+ {
+ // variant for correct conversion
+ // besides error, if SbxBYREF
+ pVar->Convert( SbxVARIANT );
+ pVar->Convert( t );
+ }
+ }
+}
+
+// bring string to a definite length (+length)
+
+void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = GetTOS();
+ OUString s = p->GetOUString();
+ sal_Int32 nLen(nOp1);
+ if( s.getLength() != nLen )
+ {
+ OUStringBuffer aBuf(s);
+ if (aBuf.getLength() > nLen)
+ {
+ comphelper::string::truncateToLength(aBuf, nLen);
+ }
+ else
+ {
+ comphelper::string::padToLength(aBuf, nLen, ' ');
+ }
+ s = aBuf.makeStringAndClear();
+ }
+}
+
+// jump (+target)
+
+void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
+{
+#ifdef DBG_UTIL
+ // #QUESTION shouln't this be
+ // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
+ if( nOp1 >= pImg->GetCodeSize() )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+#endif
+ pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
+}
+
+// evaluate TOS, conditional jump (+target)
+
+void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
+{
+ SbxVariableRef p = PopVar();
+ if( p->GetBool() )
+ StepJUMP( nOp1 );
+}
+
+// evaluate TOS, conditional jump (+target)
+
+void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
+{
+ SbxVariableRef p = PopVar();
+ // In a test e.g. If Null then
+ // will evaluate Null will act as if False
+ if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
+ StepJUMP( nOp1 );
+}
+
+// evaluate TOS, jump into JUMP-table (+MaxVal)
+// looks like this:
+// ONJUMP 2
+// JUMP target1
+// JUMP target2
+// ...
+// if 0x8000 is set in the operand, push the return address (ON..GOSUB)
+
+void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
+{
+ SbxVariableRef p = PopVar();
+ sal_Int16 n = p->GetInteger();
+ if( nOp1 & 0x8000 )
+ {
+ nOp1 &= 0x7FFF;
+ PushGosub( pCode + 5 * nOp1 );
+ }
+ if( n < 1 || static_cast<sal_uInt32>(n) > nOp1 )
+ n = static_cast<sal_Int16>( nOp1 + 1 );
+ nOp1 = (sal_uInt32) ( (const char*) pCode - pImg->GetCode() ) + 5 * --n;
+ StepJUMP( nOp1 );
+}
+
+// UP-call (+target)
+
+void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
+{
+ PushGosub( pCode );
+ if( nOp1 >= pImg->GetCodeSize() )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
+}
+
+// UP-return (+0 or target)
+
+void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
+{
+ PopGosub();
+ if( nOp1 )
+ StepJUMP( nOp1 );
+}
+
+// check FOR-variable (+Endlabel)
+
+void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
+{
+ if( !pForStk )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ return;
+ }
+
+ bool bEndLoop = false;
+ switch( pForStk->eForType )
+ {
+ case FOR_TO:
+ {
+ SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
+ if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
+ bEndLoop = true;
+ break;
+ }
+ case FOR_EACH_ARRAY:
+ {
+ SbiForStack* p = pForStk;
+ if( p->pArrayCurIndices == NULL )
+ {
+ bEndLoop = true;
+ }
+ else
+ {
+ SbxDimArray* pArray = (SbxDimArray*)(SbxVariable*)p->refEnd;
+ short nDims = pArray->GetDims();
+
+ // Empty array?
+ if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
+ {
+ bEndLoop = true;
+ break;
+ }
+ SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices );
+ *(p->refVar) = *pVal;
+
+ bool bFoundNext = false;
+ for( short i = 0 ; i < nDims ; i++ )
+ {
+ if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
+ {
+ bFoundNext = true;
+ p->pArrayCurIndices[i]++;
+ for( short j = i - 1 ; j >= 0 ; j-- )
+ p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
+ break;
+ }
+ }
+ if( !bFoundNext )
+ {
+ delete[] p->pArrayCurIndices;
+ p->pArrayCurIndices = NULL;
+ }
+ }
+ break;
+ }
+ case FOR_EACH_COLLECTION:
+ {
+ BasicCollection* pCollection = (BasicCollection*)(SbxVariable*)pForStk->refEnd;
+ SbxArrayRef xItemArray = pCollection->xItemArray;
+ sal_Int32 nCount = xItemArray->Count32();
+ if( pForStk->nCurCollectionIndex < nCount )
+ {
+ SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
+ pForStk->nCurCollectionIndex++;
+ (*pForStk->refVar) = *pRes;
+ }
+ else
+ {
+ bEndLoop = true;
+ }
+ break;
+ }
+ case FOR_EACH_XENUMERATION:
+ {
+ SbiForStack* p = pForStk;
+ if( p->xEnumeration->hasMoreElements() )
+ {
+ Any aElem = p->xEnumeration->nextElement();
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( (SbxVariable*)xVar, aElem );
+ (*pForStk->refVar) = *xVar;
+ }
+ else
+ {
+ bEndLoop = true;
+ }
+ break;
+ }
+ }
+ if( bEndLoop )
+ {
+ PopFor();
+ StepJUMP( nOp1 );
+ }
+}
+
+// Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
+
+void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
+{
+ if( !refCaseStk || !refCaseStk->Count() )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ else
+ {
+ SbxVariableRef xTo = PopVar();
+ SbxVariableRef xFrom = PopVar();
+ SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
+ if( *xCase >= *xFrom && *xCase <= *xTo )
+ StepJUMP( nOp1 );
+ }
+}
+
+
+void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
+{
+ const sal_uInt8* p = pCode;
+ StepJUMP( nOp1 );
+ pError = pCode;
+ pCode = p;
+ pInst->aErrorMsg = OUString();
+ pInst->nErr = 0;
+ pInst->nErl = 0;
+ nError = 0;
+ SbxErrObject::getUnoErrObject()->Clear();
+}
+
+// Resume after errors (+0=statement, 1=next or Label)
+
+void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
+{
+ // #32714 Resume without error? -> error
+ if( !bInError )
+ {
+ Error( SbERR_BAD_RESUME );
+ return;
+ }
+ if( nOp1 )
+ {
+ // set Code-pointer to the next statement
+ sal_uInt16 n1, n2;
+ pCode = pMod->FindNextStmnt( pErrCode, n1, n2, sal_True, pImg );
+ }
+ else
+ pCode = pErrStmnt;
+ if ( pError ) // current in error handler ( and got a Resume Next statement )
+ SbxErrObject::getUnoErrObject()->Clear();
+
+ if( nOp1 > 1 )
+ StepJUMP( nOp1 );
+ pInst->aErrorMsg = OUString();
+ pInst->nErr = 0;
+ pInst->nErl = 0;
+ nError = 0;
+ bInError = false;
+}
+
+// close channel (+channel, 0=all)
+void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
+{
+ SbError err;
+ if( !nOp1 )
+ pIosys->Shutdown();
+ else
+ {
+ err = pIosys->GetError();
+ if( !err )
+ {
+ pIosys->Close();
+ }
+ }
+ err = pIosys->GetError();
+ Error( err );
+}
+
+// output character (+char)
+
+void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
+{
+ OString s(static_cast<sal_Char>(nOp1));
+ pIosys->Write( s );
+ Error( pIosys->GetError() );
+}
+
+// check whether TOS is a certain object class (+StringID)
+
+bool SbiRuntime::implIsClass( SbxObject* pObj, const OUString& aClass )
+{
+ bool bRet = true;
+
+ if( !aClass.isEmpty() )
+ {
+ bRet = pObj->IsClass( aClass );
+ if( !bRet )
+ bRet = aClass.equalsIgnoreAsciiCase( "object" );
+ if( !bRet )
+ {
+ OUString aObjClass = pObj->GetClassName();
+ SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
+ SbClassData* pClassData;
+ if( pClassMod && (pClassData=pClassMod->pClassData) != NULL )
+ {
+ SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxCLASS_DONTCARE );
+ bRet = (pClassVar != NULL);
+ }
+ }
+ }
+ return bRet;
+}
+
+bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
+ const OUString& aClass, bool bRaiseErrors, bool bDefault )
+{
+ bool bOk = bDefault;
+
+ SbxDataType t = refVal->GetType();
+ SbxVariable* pVal = (SbxVariable*)refVal;
+ // we don't know the type of uno properties that are (maybevoid)
+ if ( t == SbxEMPTY && refVal->ISA(SbUnoProperty) )
+ {
+ SbUnoProperty* pProp = (SbUnoProperty*)pVal;
+ t = pProp->getRealType();
+ }
+ if( t == SbxOBJECT )
+ {
+ SbxObject* pObj;
+ if( pVal->IsA( TYPE(SbxObject) ) )
+ pObj = (SbxObject*) pVal;
+ else
+ {
+ pObj = (SbxObject*) refVal->GetObject();
+ if( pObj && !pObj->IsA( TYPE(SbxObject) ) )
+ pObj = NULL;
+ }
+ if( pObj )
+ {
+ if( !implIsClass( pObj, aClass ) )
+ {
+ if ( bVBAEnabled && pObj->IsA( TYPE(SbUnoObject) ) )
+ {
+ SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
+ bOk = checkUnoObjectType( pUnoObj, aClass );
+ }
+ else
+ bOk = false;
+ if ( !bOk )
+ {
+ if( bRaiseErrors )
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ }
+ }
+ else
+ {
+ bOk = true;
+
+ SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pObj);
+ if( pClassModuleObject != NULL )
+ pClassModuleObject->triggerInitializeEvent();
+ }
+ }
+ }
+ else
+ {
+ if ( !bVBAEnabled )
+ {
+ if( bRaiseErrors )
+ Error( SbERR_NEEDS_OBJECT );
+ bOk = false;
+ }
+ }
+ return bOk;
+}
+
+void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
+
+ bool bOk = checkClass_Impl( refVal, aClass, true );
+ if( bOk )
+ {
+ StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle dflt prop for a "proper" set
+ }
+}
+
+void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
+{
+ StepSETCLASS_impl( nOp1, false );
+}
+
+void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
+{
+ StepSETCLASS_impl( nOp1, true );
+}
+
+void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
+{
+ SbxVariableRef xObjVal = PopVar();
+ OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ bool bDefault = !bVBAEnabled;
+ bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
+
+ SbxVariable* pRet = new SbxVariable;
+ pRet->PutBool( bOk );
+ PushVar( pRet );
+}
+
+// define library for following declare-call
+
+void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
+{
+ aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
+}
+
+// TOS is incremented by BASE, BASE is pushed before (+BASE)
+// This opcode is pushed before DIM/REDIM-commands,
+// if there's been only one index named.
+
+void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
+{
+ SbxVariable* p1 = new SbxVariable;
+ SbxVariableRef x2 = PopVar();
+
+ // #109275 Check compatiblity mode
+ bool bCompatible = ((nOp1 & 0x8000) != 0);
+ sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
+ p1->PutInteger( uBase );
+ if( !bCompatible )
+ x2->Compute( SbxPLUS, *p1 );
+ PushVar( x2 ); // first the Expr
+ PushVar( p1 ); // then the Base
+}
+
+// the bits in the String-ID:
+// 0x8000 - Argv is reserved
+
+SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
+ SbError nNotFound, bool bLocal, 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
+ {
+ bool bFatalError = false;
+ SbxDataType t = (SbxDataType) nOp2;
+ OUString 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.indexOf((sal_Unicode)'[') == 0 )
+ {
+ // emulate pcode here
+ StepARGC();
+ // psuedo StepLOADSC
+ OUString sArg = aName.copy( 1, aName.getLength() - 2 );
+ SbxVariable* p = new SbxVariable;
+ p->PutString( sArg );
+ PushVar( p );
+ StepARGV();
+ nOp1 = nOp1 | 0x8000; // indicate params are present
+ aName = OUString("Evaluate");
+ }
+ if( bLocal )
+ {
+ if ( bStatic )
+ {
+ if ( pMeth )
+ {
+ pElem = pMeth->GetStatics()->Find( aName, SbxCLASS_DONTCARE );
+ }
+ }
+
+ if ( !pElem )
+ {
+ pElem = refLocals->Find( aName, SbxCLASS_DONTCARE );
+ }
+ }
+ if( !pElem )
+ {
+ bool bSave = rBasic.bNoRtl;
+ rBasic.bNoRtl = 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_ = GetSbData()->pInst;
+ if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
+ {
+ pElem = NULL; // Found but in wrong module!
+ }
+ // Interfaces: Use SBX_EXTFOUND
+ }
+ }
+ rBasic.bNoRtl = bSave;
+
+ // is it a global uno-identifier?
+ 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 = VBAConstantHelper::instance().getVBAConstant( aName );
+ }
+ }
+
+ if( !pElem )
+ {
+ // #72382 ATTENTION! ALWAYS returns a result now
+ // because of unknown modules!
+ SbUnoClass* pUnoClass = findUnoClass( aName );
+ if( pUnoClass )
+ {
+ pElem = new SbxVariable( t );
+ SbxValues aRes( SbxOBJECT );
+ aRes.pObj = pUnoClass;
+ pElem->SbxVariable::Put( aRes );
+ }
+ }
+
+ // #62939 If an uno-class has been found, the wrapper
+ // object has to be held, because the uno-class, e. g.
+ // "stardiv", has to be read out of the registry
+ // every time again otherwise
+ if( pElem )
+ {
+ // #63774 May not be saved too!!!
+ pElem->SetFlag( SBX_DONTSTORE );
+ pElem->SetFlag( SBX_NO_MODIFY);
+
+ // #72382 save locally, all variables that have been declared
+ // implicit would become global automatically otherwise!
+ if ( bSetName )
+ {
+ pElem->SetName( aName );
+ }
+ refLocals->Put( pElem, refLocals->Count() );
+ }
+ }
+
+ if( !pElem )
+ {
+ // not there and not in the object?
+ // don't establish if that thing has parameters!
+ if( nOp1 & 0x8000 )
+ {
+ bFatalError = true;
+ }
+
+ // else, if there are parameters, use different error code
+ if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) )
+ {
+ // #39108 if explicit and as ELEM always a fatal error
+ bFatalError = true;
+
+
+ if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED )
+ {
+ nNotFound = SbERR_VAR_UNDEFINED;
+ }
+ }
+ if( bFatalError )
+ {
+ // #39108 use dummy variable instead of fatal error
+ if( !xDummyVar.Is() )
+ {
+ xDummyVar = new SbxVariable( SbxVARIANT );
+ }
+ pElem = xDummyVar;
+
+ ClearArgvStack();
+
+ Error( nNotFound, aName );
+ }
+ else
+ {
+ if ( bStatic )
+ {
+ pElem = StepSTATIC_Impl( aName, t );
+ }
+ if ( !pElem )
+ {
+ pElem = new SbxVariable( t );
+ if( t != SbxVARIANT )
+ {
+ pElem->SetFlag( SBX_FIXED );
+ }
+ pElem->SetName( aName );
+ refLocals->Put( pElem, refLocals->Count() );
+ }
+ }
+ }
+ }
+ // #39108 Args can already be deleted!
+ if( !bFatalError )
+ {
+ SetupArgs( pElem, nOp1 );
+ }
+ // because a particular call-type is requested
+ if( pElem->IsA( TYPE(SbxMethod) ) )
+ {
+ // shall the type be converted?
+ SbxDataType t2 = pElem->GetType();
+ bool bSet = false;
+ if( !( pElem->GetFlags() & SBX_FIXED ) )
+ {
+ if( t != SbxVARIANT && t != t2 &&
+ t >= SbxINTEGER && t <= SbxSTRING )
+ {
+ pElem->SetType( t ), bSet = true;
+ }
+ }
+ // assign pElem to a Ref, to delete a temp-var if applicable
+ SbxVariableRef refTemp = pElem;
+
+ // remove potential rests of the last call of the SbxMethod
+ // free Write before, so that there's no error
+ sal_uInt16 nSavFlags = pElem->GetFlags();
+ pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST );
+ pElem->SbxValue::Clear();
+ pElem->SetFlags( nSavFlags );
+
+ // don't touch before setting, as e. g. LEFT()
+ // has to know the difference between Left$() and Left()
+
+ // because the methods' parameters are cut away in PopVar()
+ SbxVariable* pNew = new SbxMethod( *((SbxMethod*)pElem) );
+ //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
+
+ pElem->SetParameters(0);
+ pNew->SetFlag( SBX_READWRITE );
+
+ if( bSet )
+ {
+ pElem->SetType( t2 );
+ }
+ pElem = pNew;
+ }
+ // consider index-access for UnoObjects
+ // 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() )
+ {
+ SbxVariableRef refTemp = pElem;
+
+ // dissolve the notify while copying variable
+ SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) );
+ pElem->SetParameters( NULL );
+ pElem = pNew;
+ }
+ }
+ return CheckArray( pElem );
+}
+
+// for current scope (e. g. query from BASIC-IDE)
+SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
+{
+ // don't expect pMeth to be != 0, as there are none set
+ // in the RunInit yet
+
+ SbxVariable* pElem = NULL;
+ if( !pMod || rName.isEmpty() )
+ {
+ return NULL;
+ }
+ if( refLocals )
+ {
+ pElem = refLocals->Find( rName, SbxCLASS_DONTCARE );
+ }
+ if ( !pElem && pMeth )
+ {
+ // for statics, set the method's name in front
+ OUString aMethName = pMeth->GetName();
+ aMethName += ":";
+ aMethName += rName;
+ pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE);
+ }
+
+ // search in parameter list
+ 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.equalsIgnoreAsciiCase( rName ) )
+ {
+ if( j >= nParamCount )
+ {
+ // Parameter is missing
+ pElem = new SbxVariable( SbxSTRING );
+ pElem->PutString( OUString("<missing parameter>"));
+ }
+ else
+ {
+ pElem = refParams->Get( j );
+ }
+ break;
+ }
+ pParam = pInfo->GetParam( ++j );
+ }
+ }
+ }
+
+ // search in module
+ if( !pElem )
+ {
+ bool bSave = rBasic.bNoRtl;
+ rBasic.bNoRtl = true;
+ pElem = pMod->Find( rName, SbxCLASS_DONTCARE );
+ rBasic.bNoRtl = bSave;
+ }
+ return pElem;
+}
+
+
+
+void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
+{
+ if( nOp1 & 0x8000 )
+ {
+ if( !refArgv )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ }
+ bool bHasNamed = false;
+ sal_uInt16 i;
+ sal_uInt16 nArgCount = refArgv->Count();
+ for( i = 1 ; i < nArgCount ; i++ )
+ {
+ if( !refArgv->GetAlias(i).isEmpty() )
+ {
+ bHasNamed = true; break;
+ }
+ }
+ if( bHasNamed )
+ {
+ 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 );
+ OUString* pNames = pArg->getNames().getArray();
+ for( i = 1 ; i < nArgCount ; i++ )
+ {
+ SbxVariable* pVar = refArgv->Get( i );
+ const OUString& rName = refArgv->GetAlias( i );
+ if( !rName.isEmpty() )
+ {
+ 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 );
+
+ 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 OUString& rName = refArgv->GetAlias( i );
+ if( !rName.isEmpty() )
+ {
+ // nCurPar is set to the found parameter
+ sal_uInt16 j = 1;
+ const SbxParamInfo* pParam = pInfo->GetParam( j );
+ while( pParam )
+ {
+ if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
+ {
+ nCurPar = j;
+ break;
+ }
+ pParam = pInfo->GetParam( ++j );
+ }
+ if( !pParam )
+ {
+ Error( SbERR_NAMED_NOT_FOUND ); break;
+ }
+ }
+ pArg->Put( pVar, nCurPar++ );
+ }
+ refArgv = pArg;
+ }
+ }
+ // own var as parameter 0
+ refArgv->Put( p, 0 );
+ p->SetParameters( refArgv );
+ PopArgv();
+ }
+ else
+ {
+ p->SetParameters( NULL );
+ }
+}
+
+// getting an array element
+
+SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
+{
+ SbxArray* pPar;
+ if( ( pElem->GetType() & SbxARRAY ) && (SbxVariable*)refRedim != pElem )
+ {
+ SbxBase* pElemObj = pElem->GetObject();
+ SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
+ pPar = pElem->GetParameters();
+ if( pDimArray )
+ {
+ // parameters may be missing, if an array is
+ // passed as an argument
+ 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, set parameter 0 to NULL so that var doesn't contain itself
+ if( pPar )
+ {
+ pPar->Put( NULL, 0 );
+ }
+ }
+ // consider index-access for UnoObjects
+ else if( pElem->GetType() == SbxOBJECT && !pElem->ISA(SbxMethod) && ( !bVBAEnabled || ( bVBAEnabled && !pElem->ISA(SbxProperty) ) ) )
+ {
+ pPar = pElem->GetParameters();
+ if ( pPar )
+ {
+ // is it an uno-object?
+ 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 )
+ {
+ if( xIndexAccess.is() )
+ {
+ sal_uInt32 nParamCount = (sal_uInt32)pPar->Count() - 1;
+ if( nParamCount != 1 )
+ {
+ StarBASIC::Error( SbERR_BAD_ARGUMENT );
+ return pElem;
+ }
+
+ // get index
+ 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 (const IndexOutOfBoundsException&)
+ {
+ // usually expect converting problem
+ StarBASIC::Error( SbERR_OUT_OF_RANGE );
+ }
+
+ // #57847 always create a new variable, else error
+ // due to PutObject(NULL) at ReadOnly-properties
+ pElem = new SbxVariable( SbxVARIANT );
+ if( xRet.is() )
+ {
+ aAny <<= xRet;
+
+ // #67173 don't specify a name so that the real class name is entered
+ OUString aName;
+ SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny );
+ pElem->PutObject( xWrapper );
+ }
+ else
+ {
+ pElem->PutObject( NULL );
+ }
+ }
+ }
+ else
+ {
+ // check if there isn't a default member between the current variable
+ // and the params, e.g.
+ // Dim rst1 As New ADODB.Recordset
+ // "
+ // val = rst1("FirstName")
+ // has the default 'Fields' member between rst1 and '("FirstName")'
+ SbxVariable* pDflt = getDefaultProp( pElem );
+ if ( pDflt )
+ {
+ pDflt->Broadcast( SBX_HINT_DATAWANTED );
+ SbxBaseRef pDfltObj = (SbxBase*)pDflt->GetObject();
+ if( pDfltObj )
+ {
+ if( pDfltObj->ISA(SbUnoObject) )
+ {
+ pUnoObj = (SbUnoObject*)(SbxBase*)pDfltObj;
+ Any aUnoAny = pUnoObj->getUnoAny();
+
+ if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
+ x = *(Reference< XInterface >*)aUnoAny.getValue();
+ pElem = pDflt;
+ }
+ }
+ }
+ OUString sDefaultMethod;
+
+ Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
+
+ if ( xDfltMethod.is() )
+ {
+ sDefaultMethod = xDfltMethod->getDefaultMethodName();
+ }
+ else if( xIndexAccess.is() )
+ {
+ sDefaultMethod = OUString( "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, set parameter 0 to NULL so that var doesn't contain itself
+ 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;
+}
+
+// loading an element from the runtime-library (+StringID+type)
+
+void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, false ) );
+}
+
+void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
+ SbError nNotFound, bool bLocal, bool bStatic )
+{
+ if( !refLocals )
+ {
+ refLocals = new SbxArray;
+ }
+ PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, bLocal, bStatic ) );
+}
+// loading a local/global variable (+StringID+type)
+
+void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, 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, 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, true, true );
+}
+
+// loading an object-element (+StringID+type)
+// the object lies on TOS
+
+void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ SbxVariableRef pObjVar = PopVar();
+
+ SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar);
+ if( !pObj )
+ {
+ SbxBase* pObjVarObj = pObjVar->GetObject();
+ pObj = PTR_CAST(SbxObject,pObjVarObj);
+ }
+
+ // #56368 save reference at StepElem, otherwise objects could
+ // lose their reference too early in qualification chains like
+ // ActiveComponent.Selection(0).Text
+ // #74254 now per list
+ if( pObj )
+ {
+ SaveRef( (SbxVariable*)pObj );
+ }
+ PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, false ) );
+}
+
+// loading a parameter (+offset+type)
+// If the data type is wrong, create a copy.
+// The data type SbxEMPTY shows that no parameters are given.
+// Get( 0 ) may be EMPTY
+
+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 solve missing in a cleaner way
+ 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( OUString() );
+ }
+ }
+ else
+ {
+ p->PutErr( 448 ); // like in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND)
+ }
+ refParams->Put( p, iLoop );
+ iLoop--;
+ }
+ }
+ p = refParams->Get( i );
+
+ if( p->GetType() == SbxERROR && ( i ) )
+ {
+ // if there's a parameter missing, it can be OPTIONAL
+ bool bOpt = 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_uInt16)(pParam->nUserData & 0x0ffff);
+ if( nDefaultId > 0 )
+ {
+ OUString aDefaultStr = pImg->GetString( nDefaultId );
+ p = new SbxVariable();
+ p->PutString( aDefaultStr );
+ refParams->Put( p, i );
+ }
+ bOpt = true;
+ }
+ }
+ }
+ if( !bOpt )
+ {
+ Error( SbERR_NOT_OPTIONAL );
+ }
+ }
+ else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t )
+ {
+ SbxVariable* q = new SbxVariable( t );
+ SaveRef( q );
+ *q = *p;
+ p = q;
+ if ( i )
+ {
+ refParams->Put( p, i );
+ }
+ }
+ 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 );
+ }
+ }
+}
+
+// call of a DLL-procedure (+StringID+type)
+// the StringID's MSB shows that Argv is occupied
+
+void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
+ SbxArray* pArgs = NULL;
+ if( nOp1 & 0x8000 )
+ {
+ pArgs = refArgv;
+ }
+ DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, false );
+ aLibName = OUString();
+ if( nOp1 & 0x8000 )
+ {
+ PopArgv();
+ }
+}
+
+// call of a DLL-procedure after CDecl (+StringID+type)
+
+void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
+ SbxArray* pArgs = NULL;
+ if( nOp1 & 0x8000 )
+ {
+ pArgs = refArgv;
+ }
+ DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, true );
+ aLibName = OUString();
+ if( nOp1 & 0x8000 )
+ {
+ PopArgv();
+ }
+}
+
+
+// beginning of a statement (+Line+Col)
+
+void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ // If the Expr-Stack at the beginning of a statement constains a variable,
+ // some fool has called X as a function, although it's a variable!
+ bool bFatalExpr = false;
+ OUString sUnknownMethodName;
+ if( nExprLvl > 1 )
+ {
+ bFatalExpr = 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 = true;
+ }
+ }
+
+ ClearExprStack();
+
+ ClearRefs();
+
+ // We have to cancel hard here because line and column
+ // would be wrong later otherwise!
+ if( bFatalExpr)
+ {
+ StarBASIC::FatalError( SbERR_NO_METHOD, sUnknownMethodName );
+ return;
+ }
+ pStmnt = pCode - 9;
+ sal_uInt16 nOld = nLine;
+ nLine = static_cast<short>( nOp1 );
+
+ // #29955 & 0xFF, to filter out for-loop-level
+ nCol1 = static_cast<short>( nOp2 & 0xFF );
+
+ // find the next STMNT-command to set the final column
+ // of this statement
+
+ nCol2 = 0xffff;
+ sal_uInt16 n1, n2;
+ const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
+ if( p )
+ {
+ if( n1 == nOp1 )
+ {
+ // #29955 & 0xFF, to filter out for-loop-level
+ nCol2 = (n2 & 0xFF) - 1;
+ }
+ }
+
+ // #29955 correct for-loop-level, #67452 NOT in the error-handler
+ if( !bInError )
+ {
+ // (there's a difference here in case of a jump out of a loop)
+ sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
+ if( pGosubStk )
+ {
+ nExspectedForLevel = nExspectedForLevel + pGosubStk->nStartForLvl;
+ }
+
+ // if the actual for-level is too small it'd jump out
+ // of a loop -> corrected
+ while( nForLvl > nExspectedForLevel )
+ {
+ PopFor();
+ }
+ }
+
+ // 16.10.96: #31460 new concept for StepInto/Over/Out
+ // see explanation at _ImplGetBreakCallLevel
+ if( pInst->nCallLvl <= pInst->nBreakCallLvl )
+ {
+ StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
+ sal_uInt16 nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
+
+ pInst->CalcBreakCallLevel( nNewFlags );
+ }
+
+ // break points only at STMNT-commands in a new line!
+ 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 );
+
+ pInst->CalcBreakCallLevel( nNewFlags );
+ }
+}
+
+// (+SvStreamFlags+Flags)
+// Stack: block length
+// channel number
+// file name
+
+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();
+ OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
+ pIosys->Open( nChan, aName, static_cast<short>( nOp1 ),
+ static_cast<short>( nOp2 ), nBlkLen );
+ Error( pIosys->GetError() );
+}
+
+// create object (+StringID+StringID)
+
+void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
+ SbxObject *pObj = SbxBase::CreateObject( aClass );
+ if( !pObj )
+ {
+ Error( SbERR_INVALID_OBJECT );
+ }
+ else
+ {
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ pObj->SetName( aName );
+ // the object must be able to call the BASIC
+ 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 create object array (+StringID+StringID), DCREATE == Dim-Create
+void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ SbxVariableRef refVar = PopVar();
+
+ DimImpl( refVar );
+
+ // fill the array with instances of the requested class
+ 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;
+
+ short nDims = pArray->GetDims();
+ sal_Int32 nTotalSize = 0;
+
+ // must be a one-dimensional array
+ 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;
+ }
+ }
+
+ // create objects and insert them into the array
+ OUString 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
+ {
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ pClassObj->SetName( aName );
+ // the object must be able to call the basic
+ 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;
+ bool bRangeError = 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 = 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;
+ }
+}
+
+// create object from user-type (+StringID+StringID)
+
+SbxObject* createUserTypeImpl( const OUString& rClassName ); // sb.cxx
+
+void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ OUString 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
+ OUStringBuffer aBuf;
+ comphelper::string::padToLength(aBuf, nCount, 0);
+ pVar->PutString(aBuf.makeStringAndClear());
+ }
+
+ bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
+ if( bVarToDim )
+ {
+ pVar->SetFlag( SBX_VAR_TO_DIM );
+ }
+}
+
+// establishing a local variable (+StringID+type)
+
+void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( !refLocals.Is() )
+ {
+ refLocals = new SbxArray;
+ }
+ OUString 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() );
+ }
+}
+
+// establishing a module-global variable (+StringID+type)
+
+void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
+{
+ OUString 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 );
+ // from 2.7.1996: HACK because of 'reference can't be saved'
+ 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 );
+ }
+}
+
+// establishing a global variable (+StringID+type)
+
+void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( pImg->GetFlag( SBIMG_CLASSMODULE ) )
+ {
+ StepPUBLIC_Impl( nOp1, nOp2, true );
+ }
+ OUString 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 );
+ // from 2.7.1996: HACK because of 'reference can't be saved'
+ 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;
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
+
+ SbxVariable* pDummyVar = new SbxVariable( t );
+ pDummyVar->SetName( aName );
+ PushVar( pDummyVar );
+ }
+}
+
+
+SbxVariable* SbiRuntime::StepSTATIC_Impl( OUString& 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;
+}
+// establishing a static variable (+StringID+type)
+void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ SbxDataType t = (SbxDataType) nOp2;
+ StepSTATIC_Impl( aName, t );
+}
+
/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx
deleted file mode 100644
index 37e21162c353..000000000000
--- a/basic/source/runtime/step0.cxx
+++ /dev/null
@@ -1,1540 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
-/*
- * This file is part of the LibreOffice project.
- *
- * This Source Code Form is subject to the terms of the Mozilla Public
- * License, v. 2.0. If a copy of the MPL was not distributed with this
- * file, You can obtain one at http://mozilla.org/MPL/2.0/.
- *
- * This file incorporates work covered by the following license notice:
- *
- * 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 .
- */
-
-#include <comphelper/string.hxx>
-#include <vcl/msgbox.hxx>
-
-#include "errobject.hxx"
-#include "runtime.hxx"
-#include "sbintern.hxx"
-#include "iosys.hxx"
-#include <sb.hrc>
-#include <basrid.hxx>
-#include "sbunoobj.hxx"
-#include "image.hxx"
-#include <com/sun/star/uno/Any.hxx>
-#include <com/sun/star/util/SearchOptions.hpp>
-#include <rtl/instance.hxx>
-#include <vcl/svapp.hxx>
-#include <unotools/textsearch.hxx>
-
-Reference< XInterface > createComListener( const Any& aControlAny, const OUString& aVBAType,
- const OUString& aPrefix, SbxObjectRef xScopeObj );
-
-#include <algorithm>
-#include <boost/unordered_map.hpp>
-
-// for a patch forward declaring these methods below makes sense
-// but, #FIXME lets really just move the methods to the top
-static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType );
-static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled );
-
-SbxVariable* getDefaultProp( SbxVariable* pRef );
-
-void SbiRuntime::StepNOP()
-{}
-
-void SbiRuntime::StepArith( SbxOperator eOp )
-{
- SbxVariableRef p1 = PopVar();
- TOSMakeTemp();
- SbxVariable* p2 = GetTOS();
-
- p2->ResetFlag( SBX_FIXED );
- p2->Compute( eOp, *p1 );
-
- checkArithmeticOverflow( p2 );
-}
-
-void SbiRuntime::StepUnary( SbxOperator eOp )
-{
- TOSMakeTemp();
- SbxVariable* p = GetTOS();
- p->Compute( eOp, *p );
-}
-
-void SbiRuntime::StepCompare( SbxOperator eOp )
-{
- SbxVariableRef p1 = PopVar();
- SbxVariableRef p2 = PopVar();
-
- // Make sure objects with default params have
- // values ( and type ) set as appropriate
- SbxDataType p1Type = p1->GetType();
- SbxDataType p2Type = p2->GetType();
- if ( p1Type == SbxEMPTY )
- {
- p1->Broadcast( SBX_HINT_DATAWANTED );
- p1Type = p1->GetType();
- }
- if ( p2Type == SbxEMPTY )
- {
- p2->Broadcast( SBX_HINT_DATAWANTED );
- p2Type = p2->GetType();
- }
- if ( p1Type == p2Type )
- {
- // if both sides are an object and have default props
- // then we need to use the default props
- // we don't need to worry if only one side ( lhs, rhs ) is an
- // object ( object side will get coerced to correct type in
- // Compare )
- if ( p1Type == SbxOBJECT )
- {
- SbxVariable* pDflt = getDefaultProp( p1 );
- if ( pDflt )
- {
- p1 = pDflt;
- p1->Broadcast( SBX_HINT_DATAWANTED );
- }
- pDflt = getDefaultProp( p2 );
- if ( pDflt )
- {
- p2 = pDflt;
- p2->Broadcast( SBX_HINT_DATAWANTED );
- }
- }
-
- }
- static SbxVariable* pTRUE = NULL;
- static SbxVariable* pFALSE = NULL;
- static SbxVariable* pNULL = NULL;
- // why do this on non-windows ?
- // why do this at all ?
- // I dumbly follow the pattern :-/
- if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
- {
- if( !pNULL )
- {
- pNULL = new SbxVariable;
- pNULL->PutNull();
- pNULL->AddRef();
- }
- PushVar( pNULL );
- }
- else if( p2->Compare( eOp, *p1 ) )
- {
- if( !pTRUE )
- {
- pTRUE = new SbxVariable;
- pTRUE->PutBool( sal_True );
- pTRUE->AddRef();
- }
- PushVar( pTRUE );
- }
- else
- {
- if( !pFALSE )
- {
- pFALSE = new SbxVariable;
- pFALSE->PutBool( sal_False );
- pFALSE->AddRef();
- }
- PushVar( pFALSE );
- }
-}
-
-void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
-void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
-void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
-void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
-void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
-void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
-void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
-void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
-void SbiRuntime::StepAND() { StepArith( SbxAND ); }
-void SbiRuntime::StepOR() { StepArith( SbxOR ); }
-void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
-void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
-void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
-
-void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
-void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
-
-void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
-void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
-void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
-void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
-void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
-void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
-
-namespace
-{
- bool NeedEsc(sal_Unicode cCode)
- {
- if((cCode & 0xFF80))
- {
- return false;
- }
- switch((sal_uInt8)(cCode & 0x07F))
- {
- case '.':
- case '^':
- case '$':
- case '+':
- case '\\':
- case '|':
- case '{':
- case '}':
- case '(':
- case ')':
- return true;
- default:
- return false;
- }
- }
-
- OUString VBALikeToRegexp(const OUString &rIn)
- {
- OUStringBuffer sResult;
- const sal_Unicode *start = rIn.getStr();
- const sal_Unicode *end = start + rIn.getLength();
-
- int seenright = 0;
-
- sResult.append('^');
-
- while (start < end)
- {
- switch (*start)
- {
- case '?':
- sResult.append('.');
- start++;
- break;
- case '*':
- sResult.append(".*");
- start++;
- break;
- case '#':
- sResult.append("[0-9]");
- start++;
- break;
- case ']':
- sResult.append('\\');
- sResult.append(*start++);
- break;
- case '[':
- sResult.append(*start++);
- seenright = 0;
- while (start < end && !seenright)
- {
- switch (*start)
- {
- case '[':
- case '?':
- case '*':
- sResult.append('\\');
- sResult.append(*start);
- break;
- case ']':
- sResult.append(*start);
- seenright = 1;
- break;
- case '!':
- sResult.append('^');
- break;
- default:
- if (NeedEsc(*start))
- {
- sResult.append('\\');
- }
- sResult.append(*start);
- break;
- }
- start++;
- }
- break;
- default:
- if (NeedEsc(*start))
- {
- sResult.append('\\');
- }
- sResult.append(*start++);
- }
- }
-
- sResult.append('$');
-
- return sResult.makeStringAndClear();
- }
-}
-
-void SbiRuntime::StepLIKE()
-{
- SbxVariableRef refVar1 = PopVar();
- SbxVariableRef refVar2 = PopVar();
-
- OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
- OUString value = refVar2->GetOUString();
-
- com::sun::star::util::SearchOptions aSearchOpt;
-
- aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
-
- aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
- aSearchOpt.searchString = pattern;
-
- int bTextMode(1);
- bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
- if( bCompatibility )
- {
- bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
- }
- if( bTextMode )
- {
- aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
- }
- SbxVariable* pRes = new SbxVariable;
- utl::TextSearch aSearch(aSearchOpt);
- sal_uInt16 nStart=0, nEnd=value.getLength();
- int bRes = aSearch.SearchFrwrd(value, &nStart, &nEnd);
- pRes->PutBool( bRes != 0 );
-
- PushVar( pRes );
-}
-
-// TOS and TOS-1 are both object variables and contain the same pointer
-
-void SbiRuntime::StepIS()
-{
- SbxVariableRef refVar1 = PopVar();
- SbxVariableRef refVar2 = PopVar();
-
- SbxDataType eType1 = refVar1->GetType();
- SbxDataType eType2 = refVar2->GetType();
- if ( eType1 == SbxEMPTY )
- {
- refVar1->Broadcast( SBX_HINT_DATAWANTED );
- eType1 = refVar1->GetType();
- }
- if ( eType2 == SbxEMPTY )
- {
- refVar2->Broadcast( SBX_HINT_DATAWANTED );
- eType2 = refVar2->GetType();
- }
-
- sal_Bool bRes = sal_Bool( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
- if ( bVBAEnabled && !bRes )
- {
- Error( SbERR_INVALID_USAGE_OBJECT );
- }
- bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
- SbxVariable* pRes = new SbxVariable;
- pRes->PutBool( bRes );
- PushVar( pRes );
-}
-
-// update the value of TOS
-
-void SbiRuntime::StepGET()
-{
- SbxVariable* p = GetTOS();
- p->Broadcast( SBX_HINT_DATAWANTED );
-}
-
-// #67607 copy Uno-Structs
-inline bool checkUnoStructCopy( bool bVBA, SbxVariableRef& refVal, SbxVariableRef& refVar )
-{
- SbxDataType eVarType = refVar->GetType();
- SbxDataType eValType = refVal->GetType();
-
- if ( !( !bVBA|| ( bVBA && refVar->GetType() != SbxEMPTY ) ) || !refVar->CanWrite() )
- return false;
-
- if ( eValType != SbxOBJECT )
- return false;
- // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
- // there :-/ not sure if for every '=' we would want struct handling
- if( eVarType != SbxOBJECT )
- {
- if ( refVar->IsFixed() )
- return false;
- }
- // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
- else if( refVar->ISA(SbProcedureProperty) )
- return false;
-
- SbxObjectRef xValObj = (SbxObject*)refVal->GetObject();
- if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
- return false;
-
- SbUnoObject* pUnoVal = PTR_CAST(SbUnoObject,(SbxObject*)xValObj);
- SbUnoStructRefObject* pUnoStructVal = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xValObj);
- Any aAny;
- // make doubly sure value is either an Uno object or
- // an uno struct
- if ( pUnoVal || pUnoStructVal )
- aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
- else
- return false;
- if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
- {
- refVar->SetType( SbxOBJECT );
- SbxError eOldErr = refVar->GetError();
- // There are some circumstances when calling GetObject
- // will trigger an error, we need to squash those here.
- // Alternatively it is possible that the same scenario
- // could overwrite and existing error. Lets prevent that
- SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject();
- if ( eOldErr != SbxERR_OK )
- refVar->SetError( eOldErr );
- else
- refVar->ResetError();
-
- SbUnoStructRefObject* pUnoStructObj = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xVarObj);
-
- OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
- OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
-
- if ( pUnoStructObj )
- {
- StructRefInfo aInfo = pUnoStructObj->getStructInfo();
- aInfo.setValue( aAny );
- }
- else
- {
- SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
- // #70324: adopt ClassName
- pNewUnoObj->SetClassName( sClassName );
- refVar->PutObject( pNewUnoObj );
- }
- return true;
- }
- return false;
-}
-
-
-// laying down TOS in TOS-1
-
-void SbiRuntime::StepPUT()
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- // store on its own method (inside a function)?
- bool bFlagsChanged = false;
- sal_uInt16 n = 0;
- if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
- {
- bFlagsChanged = true;
- n = refVar->GetFlags();
- refVar->SetFlag( SBX_WRITE );
- }
-
- // if left side arg is an object or variant and right handside isn't
- // either an object or a variant then try and see if a default
- // property exists.
- // to use e.g. Range{"A1") = 34
- // could equate to Range("A1").Value = 34
- if ( bVBAEnabled )
- {
- // yet more hacking at this, I feel we don't quite have the correct
- // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
- // obj1 ) has default member/property ) ) It seems that default props
- // aren't dealt with if the object is a member of some parent object
- bool bObjAssign = false;
- if ( refVar->GetType() == SbxEMPTY )
- refVar->Broadcast( SBX_HINT_DATAWANTED );
- if ( refVar->GetType() == SbxOBJECT )
- {
- if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() )
- {
- SbxVariable* pDflt = getDefaultProp( refVar );
-
- if ( pDflt )
- refVar = pDflt;
- }
- else
- bObjAssign = true;
- }
- if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( refVal->IsA( TYPE(SbxMethod) ) || ! refVal->GetParent() ) )
- {
- SbxVariable* pDflt = getDefaultProp( refVal );
- if ( pDflt )
- refVal = pDflt;
- }
- }
-
- if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
- *refVar = *refVal;
-
- if( bFlagsChanged )
- refVar->SetFlags( n );
-}
-
-
-// VBA Dim As New behavior handling, save init object information
-struct DimAsNewRecoverItem
-{
- OUString m_aObjClass;
- OUString m_aObjName;
- SbxObject* m_pObjParent;
- SbModule* m_pClassModule;
-
- DimAsNewRecoverItem( void )
- : m_pObjParent( NULL )
- , m_pClassModule( NULL )
- {}
-
- DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
- SbxObject* pObjParent, SbModule* pClassModule )
- : m_aObjClass( rObjClass )
- , m_aObjName( rObjName )
- , m_pObjParent( pObjParent )
- , m_pClassModule( pClassModule )
- {}
-
-};
-
-
-struct SbxVariablePtrHash
-{
- size_t operator()( SbxVariable* pVar ) const
- { return (size_t)pVar; }
-};
-
-typedef boost::unordered_map< SbxVariable*, DimAsNewRecoverItem,
- SbxVariablePtrHash > DimAsNewRecoverHash;
-
-class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
-
-void removeDimAsNewRecoverItem( SbxVariable* pVar )
-{
- DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
- DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
- if( it != rDimAsNewRecoverHash.end() )
- {
- rDimAsNewRecoverHash.erase( it );
- }
-}
-
-
-// saving object variable
-// not-object variables will cause errors
-
-static const char pCollectionStr[] = "Collection";
-
-void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
-{
- // #67733 types with array-flag are OK too
-
- // Check var, !object is no error for sure if, only if type is fixed
- SbxDataType eVarType = refVar->GetType();
- if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
- {
- Error( SbERR_INVALID_USAGE_OBJECT );
- return;
- }
-
- // Check value, !object is no error for sure if, only if type is fixed
- SbxDataType eValType = refVal->GetType();
- if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
- {
- Error( SbERR_INVALID_USAGE_OBJECT );
- return;
- }
-
- // Getting in here causes problems with objects with default properties
- // if they are SbxEMPTY I guess
- if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
- {
- // activate GetOject for collections on refVal
- SbxBase* pObjVarObj = refVal->GetObject();
- if( pObjVarObj )
- {
- SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
-
- if( refObjVal )
- {
- refVal = refObjVal;
- }
- else if( !(eValType & SbxARRAY) )
- {
- refVal = NULL;
- }
- }
- }
-
- // #52896 refVal can be invalid here, if uno-sequences - or more
- // general arrays - are assigned to variables that are declared
- // as an object!
- if( !refVal )
- {
- Error( SbERR_INVALID_USAGE_OBJECT );
- }
- else
- {
- bool bFlagsChanged = false;
- sal_uInt16 n = 0;
- if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
- {
- bFlagsChanged = true;
- n = refVar->GetFlags();
- refVar->SetFlag( SBX_WRITE );
- }
- SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
- if( pProcProperty )
- {
- pProcProperty->setSet( true );
- }
- if ( bHandleDefaultProp )
- {
- // get default properties for lhs & rhs where necessary
- // SbxVariable* defaultProp = NULL; unused variable
- // LHS try determine if a default prop exists
- // again like in StepPUT (see there too ) we are tweaking the
- // heursitics again for when to assign an object reference or
- // use default memebers if they exists
- // #FIXME we really need to get to the bottom of this mess
- bool bObjAssign = false;
- if ( refVar->GetType() == SbxOBJECT )
- {
- if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() )
- {
- SbxVariable* pDflt = getDefaultProp( refVar );
- if ( pDflt )
- {
- refVar = pDflt;
- }
- }
- else
- bObjAssign = true;
- }
- // RHS only get a default prop is the rhs has one
- if ( refVal->GetType() == SbxOBJECT )
- {
- // check if lhs is a null object
- // if it is then use the object not the default property
- SbxObject* pObj = NULL;
-
-
- pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
-
- // calling GetObject on a SbxEMPTY variable raises
- // object not set errors, make sure its an Object
- if ( !pObj && refVar->GetType() == SbxOBJECT )
- {
- SbxBase* pObjVarObj = refVar->GetObject();
- pObj = PTR_CAST(SbxObject,pObjVarObj);
- }
- SbxVariable* pDflt = NULL;
- if ( pObj && !bObjAssign )
- {
- // lhs is either a valid object || or has a defaultProp
- pDflt = getDefaultProp( refVal );
- }
- if ( pDflt )
- {
- refVal = pDflt;
- }
- }
- }
-
- // Handle Dim As New
- bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
- SbxBaseRef xPrevVarObj;
- if( bDimAsNew )
- {
- xPrevVarObj = refVar->GetObject();
- }
- // Handle withevents
- sal_Bool bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
- if ( bWithEvents )
- {
- Reference< XInterface > xComListener;
-
- SbxBase* pObj = refVal->GetObject();
- SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
- if( pUnoObj != NULL )
- {
- Any aControlAny = pUnoObj->getUnoAny();
- OUString aDeclareClassName = refVar->GetDeclareClassName();
- OUString aVBAType = aDeclareClassName;
- OUString aPrefix = refVar->GetName();
- SbxObjectRef xScopeObj = refVar->GetParent();
- xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
-
- refVal->SetDeclareClassName( aDeclareClassName );
- refVal->SetComListener( xComListener, &rBasic ); // Hold reference
- }
-
- }
-
- // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
- // in this case if there is a default prop involved the value of the
- // default property may infact be void so the type will also be SbxEMPTY
- // in this case we do not want to call checkUnoStructCopy 'cause that will
- // cause an error also
- if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
- {
- *refVar = *refVal;
- }
- if ( bDimAsNew )
- {
- if( !refVar->ISA(SbxObject) )
- {
- SbxBase* pValObjBase = refVal->GetObject();
- if( pValObjBase == NULL )
- {
- if( xPrevVarObj.Is() )
- {
- // Object is overwritten with NULL, instantiate init object
- DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
- DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar );
- if( it != rDimAsNewRecoverHash.end() )
- {
- const DimAsNewRecoverItem& rItem = it->second;
- if( rItem.m_pClassModule != NULL )
- {
- SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
- pNewObj->SetName( rItem.m_aObjName );
- pNewObj->SetParent( rItem.m_pObjParent );
- refVar->PutObject( pNewObj );
- }
- else if( rItem.m_aObjClass.equalsIgnoreAsciiCaseAscii( pCollectionStr ) )
- {
- BasicCollection* pNewCollection = new BasicCollection( OUString(pCollectionStr) );
- pNewCollection->SetName( rItem.m_aObjName );
- pNewCollection->SetParent( rItem.m_pObjParent );
- refVar->PutObject( pNewCollection );
- }
- }
- }
- }
- else
- {
- // Does old value exist?
- bool bFirstInit = !xPrevVarObj.Is();
- if( bFirstInit )
- {
- // Store information to instantiate object later
- SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
- if( pValObj != NULL )
- {
- OUString aObjClass = pValObj->GetClassName();
-
- SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
- DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
- if( pClassModuleObj != NULL )
- {
- SbModule* pClassModule = pClassModuleObj->getClassModule();
- rDimAsNewRecoverHash[refVar] =
- DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
- }
- else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
- {
- rDimAsNewRecoverHash[refVar] =
- DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
- }
- }
- }
- }
- }
- }
-
- if( bFlagsChanged )
- {
- refVar->SetFlags( n );
- }
- }
-}
-
-void SbiRuntime::StepSET()
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
-}
-
-void SbiRuntime::StepVBASET()
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- // don't handle default property
- StepSET_Impl( refVal, refVar, false ); // set obj = something
-}
-
-
-void SbiRuntime::StepLSET()
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- if( refVar->GetType() != SbxSTRING ||
- refVal->GetType() != SbxSTRING )
- {
- Error( SbERR_INVALID_USAGE_OBJECT );
- }
- else
- {
- sal_uInt16 n = refVar->GetFlags();
- if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
- {
- refVar->SetFlag( SBX_WRITE );
- }
- OUString aRefVarString = refVar->GetOUString();
- OUString aRefValString = refVal->GetOUString();
-
- sal_Int32 nVarStrLen = aRefVarString.getLength();
- sal_Int32 nValStrLen = aRefValString.getLength();
- OUStringBuffer aNewStr;
- if( nVarStrLen > nValStrLen )
- {
- aNewStr.append(aRefValString);
- comphelper::string::padToLength(aNewStr, nVarStrLen, ' ');
- }
- else
- {
- aNewStr = aRefValString.copy( 0, nVarStrLen );
- }
-
- refVar->PutString(aNewStr.makeStringAndClear());
- refVar->SetFlags( n );
- }
-}
-
-void SbiRuntime::StepRSET()
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
- {
- Error( SbERR_INVALID_USAGE_OBJECT );
- }
- else
- {
- sal_uInt16 n = refVar->GetFlags();
- if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
- {
- refVar->SetFlag( SBX_WRITE );
- }
- OUString aRefVarString = refVar->GetOUString();
- OUString aRefValString = refVal->GetOUString();
- sal_Int32 nVarStrLen = aRefVarString.getLength();
- sal_Int32 nValStrLen = aRefValString.getLength();
-
- OUStringBuffer aNewStr(nVarStrLen);
- if (nVarStrLen > nValStrLen)
- {
- comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
- aNewStr.append(aRefValString);
- }
- else
- {
- aNewStr.append(aRefValString.copy(0, nVarStrLen));
- }
- refVar->PutString(aNewStr.makeStringAndClear());
-
- refVar->SetFlags( n );
- }
-}
-
-// laying down TOS in TOS-1, then set ReadOnly-Bit
-
-void SbiRuntime::StepPUTC()
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- refVar->SetFlag( SBX_WRITE );
- *refVar = *refVal;
- refVar->ResetFlag( SBX_WRITE );
- refVar->SetFlag( SBX_CONST );
-}
-
-// DIM
-// TOS = variable for the array with dimension information as parameter
-
-void SbiRuntime::StepDIM()
-{
- SbxVariableRef refVar = PopVar();
- DimImpl( refVar );
-}
-
-// #56204 swap out DIM-functionality into a help method (step0.cxx)
-void SbiRuntime::DimImpl( SbxVariableRef refVar )
-{
- // If refDim then this DIM statement is terminating a ReDIM and
- // previous StepERASE_CLEAR for an array, the following actions have
- // been delayed from ( StepERASE_CLEAR ) 'till here
- if ( refRedim )
- {
- if ( !refRedimpArray ) // only erase the array not ReDim Preserve
- {
- lcl_eraseImpl( refVar, bVBAEnabled );
- }
- SbxDataType eType = refVar->GetType();
- lcl_clearImpl( refVar, eType );
- refRedim = NULL;
- }
- SbxArray* pDims = refVar->GetParameters();
- // must have an even number of arguments
- // have in mind that Arg[0] does not count!
- if( pDims && !( pDims->Count() & 1 ) )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- }
- else
- {
- SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
- SbxDimArray* pArray = new SbxDimArray( eType );
- // allow arrays without dimension information, too (VB-compatible)
- if( pDims )
- {
- refVar->ResetFlag( SBX_VAR_TO_DIM );
-
- for( sal_uInt16 i = 1; i < pDims->Count(); )
- {
- sal_Int32 lb = pDims->Get( i++ )->GetLong();
- sal_Int32 ub = pDims->Get( i++ )->GetLong();
- if( ub < lb )
- {
- Error( SbERR_OUT_OF_RANGE ), ub = lb;
- }
- pArray->AddDim32( lb, ub );
- if ( lb != ub )
- {
- pArray->setHasFixedSize( true );
- }
- }
- }
- else
- {
- // #62867 On creating an array of the length 0, create
- // a dimension (like for Uno-Sequences of the length 0)
- pArray->unoAddDim( 0, -1 );
- }
- sal_uInt16 nSavFlags = refVar->GetFlags();
- refVar->ResetFlag( SBX_FIXED );
- refVar->PutObject( pArray );
- refVar->SetFlags( nSavFlags );
- refVar->SetParameters( NULL );
- }
-}
-
-// REDIM
-// TOS = variable for the array
-// argv = dimension information
-
-void SbiRuntime::StepREDIM()
-{
- // Nothing different than dim at the moment because
- // a double dim is already recognized by the compiler.
- StepDIM();
-}
-
-
-// Helper function for StepREDIMP
-void implCopyDimArray( 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( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
- pActualIndices, pLowerBounds, pUpperBounds );
- }
- else
- {
- SbxVariable* pSource = pOldArray->Get32( pActualIndices );
- SbxVariable* pDest = pNewArray->Get32( pActualIndices );
- if( pSource && pDest )
- {
- *pDest = *pSource;
- }
- }
- }
-}
-
-// REDIM PRESERVE
-// TOS = variable for the array
-// argv = dimension information
-
-void SbiRuntime::StepREDIMP()
-{
- SbxVariableRef refVar = PopVar();
- DimImpl( refVar );
-
- // Now check, if we can copy from the old array
- if( refRedimpArray.Is() )
- {
- SbxBase* pElemObj = refVar->GetObject();
- SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
- SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
- if( pNewArray )
- {
- short nDimsNew = pNewArray->GetDims();
- short nDimsOld = pOldArray->GetDims();
- short nDims = nDimsNew;
-
- if( nDimsOld != nDimsNew )
- {
- StarBASIC::Error( SbERR_OUT_OF_RANGE );
- }
- else
- {
- // 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];
-
- // Compare bounds
- for( short i = 1 ; i <= nDims ; i++ )
- {
- sal_Int32 lBoundNew, uBoundNew;
- sal_Int32 lBoundOld, uBoundOld;
- pNewArray->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;
- }
- // 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( pNewArray, pOldArray, nDims - 1,
- 0, pActualIndices, pLowerBounds, pUpperBounds );
- delete[] pUpperBounds;
- delete[] pLowerBounds;
- delete[] pActualIndices;
- }
-
- refRedimpArray = NULL;
- }
- }
-
-}
-
-// REDIM_COPY
-// TOS = Array-Variable, Reference to array is copied
-// Variable is cleared as in ERASE
-
-void SbiRuntime::StepREDIMP_ERASE()
-{
- SbxVariableRef refVar = PopVar();
- refRedim = refVar;
- SbxDataType eType = refVar->GetType();
- if( eType & SbxARRAY )
- {
- SbxBase* pElemObj = refVar->GetObject();
- SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
- if( pDimArray )
- {
- refRedimpArray = pDimArray;
- }
-
- }
- else if( refVar->IsFixed() )
- {
- refVar->Clear();
- }
- else
- {
- refVar->SetType( SbxEMPTY );
- }
-}
-
-static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
-{
- sal_uInt16 nSavFlags = refVar->GetFlags();
- refVar->ResetFlag( SBX_FIXED );
- refVar->SetType( SbxDataType(eType & 0x0FFF) );
- refVar->SetFlags( nSavFlags );
- refVar->Clear();
-}
-
-static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
-{
- SbxDataType eType = refVar->GetType();
- if( eType & SbxARRAY )
- {
- if ( bVBAEnabled )
- {
- SbxBase* pElemObj = refVar->GetObject();
- SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
- bool bClearValues = true;
- if( pDimArray )
- {
- if ( pDimArray->hasFixedSize() )
- {
- // Clear all Value(s)
- pDimArray->SbxArray::Clear();
- bClearValues = false;
- }
- else
- {
- pDimArray->Clear(); // clear Dims
- }
- }
- if ( bClearValues )
- {
- SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
- if ( pArray )
- {
- pArray->Clear();
- }
- }
- }
- else
- {
- // Arrays have on an erase to VB quite a complex behaviour. Here are
- // only the type problems at REDIM (#26295) removed at first:
- // Set type hard onto the array-type, because a variable with array is
- // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
- // the original type is lost -> runtime error
- lcl_clearImpl( refVar, eType );
- }
- }
- else if( refVar->IsFixed() )
- {
- refVar->Clear();
- }
- else
- {
- refVar->SetType( SbxEMPTY );
- }
-}
-
-// delete variable
-// TOS = variable
-
-void SbiRuntime::StepERASE()
-{
- SbxVariableRef refVar = PopVar();
- lcl_eraseImpl( refVar, bVBAEnabled );
-}
-
-void SbiRuntime::StepERASE_CLEAR()
-{
- refRedim = PopVar();
-}
-
-void SbiRuntime::StepARRAYACCESS()
-{
- if( !refArgv )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- }
- SbxVariableRef refVar = PopVar();
- refVar->SetParameters( refArgv );
- PopArgv();
- PushVar( CheckArray( refVar ) );
-}
-
-void SbiRuntime::StepBYVAL()
-{
- // Copy variable on stack to break call by reference
- SbxVariableRef pVar = PopVar();
- SbxDataType t = pVar->GetType();
-
- SbxVariable* pCopyVar = new SbxVariable( t );
- pCopyVar->SetFlag( SBX_READWRITE );
- *pCopyVar = *pVar;
-
- PushVar( pCopyVar );
-}
-
-// establishing an argv
-// nOp1 stays as it is -> 1st element is the return value
-
-void SbiRuntime::StepARGC()
-{
- PushArgv();
- refArgv = new SbxArray;
- nArgc = 1;
-}
-
-// storing an argument in Argv
-
-void SbiRuntime::StepARGV()
-{
- if( !refArgv )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- }
- else
- {
- SbxVariableRef pVal = PopVar();
-
- // Before fix of #94916:
- if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
- {
- // evaluate methods and properties!
- SbxVariable* pRes = new SbxVariable( *pVal );
- pVal = pRes;
- }
- refArgv->Put( pVal, nArgc++ );
- }
-}
-
-// Input to Variable. The variable is on TOS and is
-// is removed afterwards.
-void SbiRuntime::StepINPUT()
-{
- OUStringBuffer sin;
- OUString s;
- char ch = 0;
- SbError err;
- // Skip whitespace
- while( ( err = pIosys->GetError() ) == 0 )
- {
- ch = pIosys->Read();
- if( ch != ' ' && ch != '\t' && ch != '\n' )
- {
- break;
- }
- }
- if( !err )
- {
- // Scan until comma or whitespace
- char sep = ( ch == '"' ) ? ch : 0;
- if( sep )
- {
- ch = pIosys->Read();
- }
- while( ( err = pIosys->GetError() ) == 0 )
- {
- if( ch == sep )
- {
- ch = pIosys->Read();
- if( ch != sep )
- {
- break;
- }
- }
- else if( !sep && (ch == ',' || ch == '\n') )
- {
- break;
- }
- sin.append( ch );
- ch = pIosys->Read();
- }
- // skip whitespace
- if( ch == ' ' || ch == '\t' )
- {
- while( ( err = pIosys->GetError() ) == 0 )
- {
- if( ch != ' ' && ch != '\t' && ch != '\n' )
- {
- break;
- }
- ch = pIosys->Read();
- }
- }
- }
- if( !err )
- {
- s = sin.makeStringAndClear();
- SbxVariableRef pVar = GetTOS();
- // try to fill the variable with a numeric value first,
- // then with a string value
- if( !pVar->IsFixed() || pVar->IsNumeric() )
- {
- sal_uInt16 nLen = 0;
- if( !pVar->Scan( s, &nLen ) )
- {
- err = SbxBase::GetError();
- SbxBase::ResetError();
- }
- // the value has to be scanned in completely
- else if( nLen != s.getLength() && !pVar->PutString( s ) )
- {
- err = SbxBase::GetError();
- SbxBase::ResetError();
- }
- else if( nLen != s.getLength() && pVar->IsNumeric() )
- {
- err = SbxBase::GetError();
- SbxBase::ResetError();
- if( !err )
- {
- err = SbERR_CONVERSION;
- }
- }
- }
- else
- {
- pVar->PutString( s );
- err = SbxBase::GetError();
- SbxBase::ResetError();
- }
- }
- if( err == SbERR_USER_ABORT )
- {
- Error( err );
- }
- else if( err )
- {
- if( pRestart && !pIosys->GetChannel() )
- {
- pCode = pRestart;
- }
- else
- {
- Error( err );
- }
- }
- else
- {
- PopVar();
- }
-}
-
-// Line Input to Variable. The variable is on TOS and is
-// deleted afterwards.
-
-void SbiRuntime::StepLINPUT()
-{
- OString aInput;
- pIosys->Read( aInput );
- Error( pIosys->GetError() );
- SbxVariableRef p = PopVar();
- p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
-}
-
-// end of program
-
-void SbiRuntime::StepSTOP()
-{
- pInst->Stop();
-}
-
-
-void SbiRuntime::StepINITFOR()
-{
- PushFor();
-}
-
-void SbiRuntime::StepINITFOREACH()
-{
- PushForEach();
-}
-
-// increment FOR-variable
-
-void SbiRuntime::StepNEXT()
-{
- if( !pForStk )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- return;
- }
- if( pForStk->eForType == FOR_TO )
- {
- pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
- }
-}
-
-// beginning CASE: TOS in CASE-stack
-
-void SbiRuntime::StepCASE()
-{
- if( !refCaseStk.Is() )
- {
- refCaseStk = new SbxArray;
- }
- SbxVariableRef xVar = PopVar();
- refCaseStk->Put( xVar, refCaseStk->Count() );
-}
-
-// end CASE: free variable
-
-void SbiRuntime::StepENDCASE()
-{
- if( !refCaseStk || !refCaseStk->Count() )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- }
- else
- {
- refCaseStk->Remove( refCaseStk->Count() - 1 );
- }
-}
-
-
-void SbiRuntime::StepSTDERROR()
-{
- pError = NULL; bError = true;
- pInst->aErrorMsg = OUString();
- pInst->nErr = 0L;
- pInst->nErl = 0;
- nError = 0L;
- SbxErrObject::getUnoErrObject()->Clear();
-}
-
-void SbiRuntime::StepNOERROR()
-{
- pInst->aErrorMsg = OUString();
- pInst->nErr = 0L;
- pInst->nErl = 0;
- nError = 0L;
- SbxErrObject::getUnoErrObject()->Clear();
- bError = false;
-}
-
-// leave UP
-
-void SbiRuntime::StepLEAVE()
-{
- bRun = false;
- // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
- if ( bInError && pError )
- {
- SbxErrObject::getUnoErrObject()->Clear();
- }
-}
-
-void SbiRuntime::StepCHANNEL() // TOS = channel number
-{
- SbxVariableRef pChan = PopVar();
- short nChan = pChan->GetInteger();
- pIosys->SetChannel( nChan );
- Error( pIosys->GetError() );
-}
-
-void SbiRuntime::StepCHANNEL0()
-{
- pIosys->ResetChannel();
-}
-
-void SbiRuntime::StepPRINT() // print TOS
-{
- SbxVariableRef p = PopVar();
- OUString s1 = p->GetOUString();
- OUString s;
- if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
- {
- s = " "; // one blank before
- }
- s += s1;
- OString aByteStr(OUStringToOString(s, osl_getThreadTextEncoding()));
- pIosys->Write( aByteStr );
- Error( pIosys->GetError() );
-}
-
-void SbiRuntime::StepPRINTF() // print TOS in field
-{
- SbxVariableRef p = PopVar();
- OUString s1 = p->GetOUString();
- OUStringBuffer s;
- if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
- {
- s.append(' ');
- }
- s.append(s1);
- comphelper::string::padToLength(s, 14, ' ');
- OString aByteStr(OUStringToOString(s.makeStringAndClear(), osl_getThreadTextEncoding()));
- pIosys->Write( aByteStr );
- Error( pIosys->GetError() );
-}
-
-void SbiRuntime::StepWRITE() // write TOS
-{
- SbxVariableRef p = PopVar();
- // Does the string have to be encapsulated?
- char ch = 0;
- switch (p->GetType() )
- {
- case SbxSTRING: ch = '"'; break;
- case SbxCURRENCY:
- case SbxBOOL:
- case SbxDATE: ch = '#'; break;
- default: break;
- }
- OUString s;
- if( ch )
- {
- s += OUString(ch);
- }
- s += p->GetOUString();
- if( ch )
- {
- s += OUString(ch);
- }
- OString aByteStr(OUStringToOString(s, osl_getThreadTextEncoding()));
- pIosys->Write( aByteStr );
- Error( pIosys->GetError() );
-}
-
-void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
-{
- SbxVariableRef pTos1 = PopVar();
- SbxVariableRef pTos = PopVar();
- OUString aDest = pTos1->GetOUString();
- OUString aSource = pTos->GetOUString();
-
- if( hasUno() )
- {
- implStepRenameUCB( aSource, aDest );
- }
- else
- {
- implStepRenameOSL( aSource, aDest );
- }
-}
-
-// TOS = Prompt
-
-void SbiRuntime::StepPROMPT()
-{
- SbxVariableRef p = PopVar();
- OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
- pIosys->SetPrompt( aStr );
-}
-
-// Set Restart point
-
-void SbiRuntime::StepRESTART()
-{
- pRestart = pCode;
-}
-
-// empty expression on stack for missing parameter
-
-void SbiRuntime::StepEMPTY()
-{
- // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
- // This is represented by the value 448 (SbERR_NAMED_NOT_FOUND) of the type error
- // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
- // to simplify matters.
- SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
- xVar->PutErr( 448 );
- PushVar( xVar );
-}
-
-// TOS = error code
-
-void SbiRuntime::StepERROR()
-{
- SbxVariableRef refCode = PopVar();
- sal_uInt16 n = refCode->GetUShort();
- SbError error = StarBASIC::GetSfxFromVBError( n );
- if ( bVBAEnabled )
- {
- pInst->Error( error );
- }
- else
- {
- Error( error );
- }
-}
-
-/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/step1.cxx b/basic/source/runtime/step1.cxx
deleted file mode 100644
index 7b721294df5b..000000000000
--- a/basic/source/runtime/step1.cxx
+++ /dev/null
@@ -1,582 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
-/*
- * This file is part of the LibreOffice project.
- *
- * This Source Code Form is subject to the terms of the Mozilla Public
- * License, v. 2.0. If a copy of the MPL was not distributed with this
- * file, You can obtain one at http://mozilla.org/MPL/2.0/.
- *
- * This file incorporates work covered by the following license notice:
- *
- * 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 .
- */
-
-
-#include <stdlib.h>
-#include <comphelper/string.hxx>
-#include <rtl/math.hxx>
-#include <rtl/ustrbuf.hxx>
-#include <basic/sbuno.hxx>
-#include "runtime.hxx"
-#include "sbintern.hxx"
-#include "iosys.hxx"
-#include "image.hxx"
-#include "sbunoobj.hxx"
-#include "errobject.hxx"
-
-bool checkUnoObjectType( SbUnoObject* refVal, const OUString& aClass );
-
-// loading a numeric constant (+ID)
-
-void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
-{
- SbxVariable* p = new SbxVariable( SbxDOUBLE );
-
- // #57844 use localized function
- OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
- // also allow , !!!
- sal_Int32 iComma = aStr.indexOf((sal_Unicode)',');
- if( iComma >= 0 )
- {
- aStr = aStr.replaceAt(iComma, 1, OUString("."));
- }
- double n = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
-
- p->PutDouble( n );
- PushVar( p );
-}
-
-// loading a string constant (+ID)
-
-void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
-{
- SbxVariable* p = new SbxVariable;
- p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
- PushVar( p );
-}
-
-// Immediate Load (+Wert)
-
-void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
-{
- SbxVariable* p = new SbxVariable;
- p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
- PushVar( p );
-}
-
-// stora a named argument in Argv (+Arg-no. from 1!)
-
-void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
-{
- if( !refArgv )
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- else
- {
- OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
- SbxVariableRef pVal = PopVar();
- if( bVBAEnabled && ( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) ) )
- {
- // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
- if ( pVal->GetType() == SbxEMPTY )
- pVal->Broadcast( SBX_HINT_DATAWANTED );
- // evaluate methods and properties!
- SbxVariable* pRes = new SbxVariable( *pVal );
- pVal = pRes;
- }
- refArgv->Put( pVal, nArgc );
- refArgv->PutAlias( aAlias, nArgc++ );
- }
-}
-
-// converting the type of an argument in Argv for DECLARE-Fkt. (+type)
-
-void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
-{
- if( !refArgv )
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- else
- {
- bool bByVal = (nOp1 & 0x8000) != 0; // Ist BYVAL requested?
- SbxDataType t = (SbxDataType) (nOp1 & 0x7FFF);
- SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // last Arg
-
- // check BYVAL
- if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
- {
- // parameter is a reference
- if( bByVal )
- {
- // Call by Value is requested -> create a copy
- pVar = new SbxVariable( *pVar );
- pVar->SetFlag( SBX_READWRITE );
- refExprStk->Put( pVar, refArgv->Count() - 1 );
- }
- else
- pVar->SetFlag( SBX_REFERENCE ); // Ref-Flag for DllMgr
- }
- else
- {
- // parameter is NO reference
- if( bByVal )
- pVar->ResetFlag( SBX_REFERENCE ); // no reference -> OK
- else
- Error( SbERR_BAD_PARAMETERS ); // reference needed
- }
-
- if( pVar->GetType() != t )
- {
- // variant for correct conversion
- // besides error, if SbxBYREF
- pVar->Convert( SbxVARIANT );
- pVar->Convert( t );
- }
- }
-}
-
-// bring string to a definite length (+length)
-
-void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
-{
- SbxVariable* p = GetTOS();
- OUString s = p->GetOUString();
- sal_Int32 nLen(nOp1);
- if( s.getLength() != nLen )
- {
- OUStringBuffer aBuf(s);
- if (aBuf.getLength() > nLen)
- {
- comphelper::string::truncateToLength(aBuf, nLen);
- }
- else
- {
- comphelper::string::padToLength(aBuf, nLen, ' ');
- }
- s = aBuf.makeStringAndClear();
- }
-}
-
-// jump (+target)
-
-void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
-{
-#ifdef DBG_UTIL
- // #QUESTION shouln't this be
- // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
- if( nOp1 >= pImg->GetCodeSize() )
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
-#endif
- pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
-}
-
-// evaluate TOS, conditional jump (+target)
-
-void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
-{
- SbxVariableRef p = PopVar();
- if( p->GetBool() )
- StepJUMP( nOp1 );
-}
-
-// evaluate TOS, conditional jump (+target)
-
-void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
-{
- SbxVariableRef p = PopVar();
- // In a test e.g. If Null then
- // will evaluate Null will act as if False
- if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
- StepJUMP( nOp1 );
-}
-
-// evaluate TOS, jump into JUMP-table (+MaxVal)
-// looks like this:
-// ONJUMP 2
-// JUMP target1
-// JUMP target2
-// ...
-// if 0x8000 is set in the operand, push the return address (ON..GOSUB)
-
-void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
-{
- SbxVariableRef p = PopVar();
- sal_Int16 n = p->GetInteger();
- if( nOp1 & 0x8000 )
- {
- nOp1 &= 0x7FFF;
- PushGosub( pCode + 5 * nOp1 );
- }
- if( n < 1 || static_cast<sal_uInt32>(n) > nOp1 )
- n = static_cast<sal_Int16>( nOp1 + 1 );
- nOp1 = (sal_uInt32) ( (const char*) pCode - pImg->GetCode() ) + 5 * --n;
- StepJUMP( nOp1 );
-}
-
-// UP-call (+target)
-
-void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
-{
- PushGosub( pCode );
- if( nOp1 >= pImg->GetCodeSize() )
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
-}
-
-// UP-return (+0 or target)
-
-void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
-{
- PopGosub();
- if( nOp1 )
- StepJUMP( nOp1 );
-}
-
-// check FOR-variable (+Endlabel)
-
-void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
-{
- if( !pForStk )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- return;
- }
-
- bool bEndLoop = false;
- switch( pForStk->eForType )
- {
- case FOR_TO:
- {
- SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
- if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
- bEndLoop = true;
- break;
- }
- case FOR_EACH_ARRAY:
- {
- SbiForStack* p = pForStk;
- if( p->pArrayCurIndices == NULL )
- {
- bEndLoop = true;
- }
- else
- {
- SbxDimArray* pArray = (SbxDimArray*)(SbxVariable*)p->refEnd;
- short nDims = pArray->GetDims();
-
- // Empty array?
- if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
- {
- bEndLoop = true;
- break;
- }
- SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices );
- *(p->refVar) = *pVal;
-
- bool bFoundNext = false;
- for( short i = 0 ; i < nDims ; i++ )
- {
- if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
- {
- bFoundNext = true;
- p->pArrayCurIndices[i]++;
- for( short j = i - 1 ; j >= 0 ; j-- )
- p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
- break;
- }
- }
- if( !bFoundNext )
- {
- delete[] p->pArrayCurIndices;
- p->pArrayCurIndices = NULL;
- }
- }
- break;
- }
- case FOR_EACH_COLLECTION:
- {
- BasicCollection* pCollection = (BasicCollection*)(SbxVariable*)pForStk->refEnd;
- SbxArrayRef xItemArray = pCollection->xItemArray;
- sal_Int32 nCount = xItemArray->Count32();
- if( pForStk->nCurCollectionIndex < nCount )
- {
- SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
- pForStk->nCurCollectionIndex++;
- (*pForStk->refVar) = *pRes;
- }
- else
- {
- bEndLoop = true;
- }
- break;
- }
- case FOR_EACH_XENUMERATION:
- {
- SbiForStack* p = pForStk;
- if( p->xEnumeration->hasMoreElements() )
- {
- Any aElem = p->xEnumeration->nextElement();
- SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
- unoToSbxValue( (SbxVariable*)xVar, aElem );
- (*pForStk->refVar) = *xVar;
- }
- else
- {
- bEndLoop = true;
- }
- break;
- }
- }
- if( bEndLoop )
- {
- PopFor();
- StepJUMP( nOp1 );
- }
-}
-
-// Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
-
-void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
-{
- if( !refCaseStk || !refCaseStk->Count() )
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- else
- {
- SbxVariableRef xTo = PopVar();
- SbxVariableRef xFrom = PopVar();
- SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
- if( *xCase >= *xFrom && *xCase <= *xTo )
- StepJUMP( nOp1 );
- }
-}
-
-
-void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
-{
- const sal_uInt8* p = pCode;
- StepJUMP( nOp1 );
- pError = pCode;
- pCode = p;
- pInst->aErrorMsg = OUString();
- pInst->nErr = 0;
- pInst->nErl = 0;
- nError = 0;
- SbxErrObject::getUnoErrObject()->Clear();
-}
-
-// Resume after errors (+0=statement, 1=next or Label)
-
-void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
-{
- // #32714 Resume without error? -> error
- if( !bInError )
- {
- Error( SbERR_BAD_RESUME );
- return;
- }
- if( nOp1 )
- {
- // set Code-pointer to the next statement
- sal_uInt16 n1, n2;
- pCode = pMod->FindNextStmnt( pErrCode, n1, n2, sal_True, pImg );
- }
- else
- pCode = pErrStmnt;
- if ( pError ) // current in error handler ( and got a Resume Next statement )
- SbxErrObject::getUnoErrObject()->Clear();
-
- if( nOp1 > 1 )
- StepJUMP( nOp1 );
- pInst->aErrorMsg = OUString();
- pInst->nErr = 0;
- pInst->nErl = 0;
- nError = 0;
- bInError = false;
-}
-
-// close channel (+channel, 0=all)
-void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
-{
- SbError err;
- if( !nOp1 )
- pIosys->Shutdown();
- else
- {
- err = pIosys->GetError();
- if( !err )
- {
- pIosys->Close();
- }
- }
- err = pIosys->GetError();
- Error( err );
-}
-
-// output character (+char)
-
-void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
-{
- OString s(static_cast<sal_Char>(nOp1));
- pIosys->Write( s );
- Error( pIosys->GetError() );
-}
-
-// check whether TOS is a certain object class (+StringID)
-
-bool SbiRuntime::implIsClass( SbxObject* pObj, const OUString& aClass )
-{
- bool bRet = true;
-
- if( !aClass.isEmpty() )
- {
- bRet = pObj->IsClass( aClass );
- if( !bRet )
- bRet = aClass.equalsIgnoreAsciiCase( "object" );
- if( !bRet )
- {
- OUString aObjClass = pObj->GetClassName();
- SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
- SbClassData* pClassData;
- if( pClassMod && (pClassData=pClassMod->pClassData) != NULL )
- {
- SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxCLASS_DONTCARE );
- bRet = (pClassVar != NULL);
- }
- }
- }
- return bRet;
-}
-
-bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
- const OUString& aClass, bool bRaiseErrors, bool bDefault )
-{
- bool bOk = bDefault;
-
- SbxDataType t = refVal->GetType();
- SbxVariable* pVal = (SbxVariable*)refVal;
- // we don't know the type of uno properties that are (maybevoid)
- if ( t == SbxEMPTY && refVal->ISA(SbUnoProperty) )
- {
- SbUnoProperty* pProp = (SbUnoProperty*)pVal;
- t = pProp->getRealType();
- }
- if( t == SbxOBJECT )
- {
- SbxObject* pObj;
- if( pVal->IsA( TYPE(SbxObject) ) )
- pObj = (SbxObject*) pVal;
- else
- {
- pObj = (SbxObject*) refVal->GetObject();
- if( pObj && !pObj->IsA( TYPE(SbxObject) ) )
- pObj = NULL;
- }
- if( pObj )
- {
- if( !implIsClass( pObj, aClass ) )
- {
- if ( bVBAEnabled && pObj->IsA( TYPE(SbUnoObject) ) )
- {
- SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
- bOk = checkUnoObjectType( pUnoObj, aClass );
- }
- else
- bOk = false;
- if ( !bOk )
- {
- if( bRaiseErrors )
- Error( SbERR_INVALID_USAGE_OBJECT );
- }
- }
- else
- {
- bOk = true;
-
- SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pObj);
- if( pClassModuleObject != NULL )
- pClassModuleObject->triggerInitializeEvent();
- }
- }
- }
- else
- {
- if ( !bVBAEnabled )
- {
- if( bRaiseErrors )
- Error( SbERR_NEEDS_OBJECT );
- bOk = false;
- }
- }
- return bOk;
-}
-
-void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
-{
- SbxVariableRef refVal = PopVar();
- SbxVariableRef refVar = PopVar();
- OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
-
- bool bOk = checkClass_Impl( refVal, aClass, true );
- if( bOk )
- {
- StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle dflt prop for a "proper" set
- }
-}
-
-void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
-{
- StepSETCLASS_impl( nOp1, false );
-}
-
-void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
-{
- StepSETCLASS_impl( nOp1, true );
-}
-
-void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
-{
- SbxVariableRef xObjVal = PopVar();
- OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
- bool bDefault = !bVBAEnabled;
- bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
-
- SbxVariable* pRet = new SbxVariable;
- pRet->PutBool( bOk );
- PushVar( pRet );
-}
-
-// define library for following declare-call
-
-void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
-{
- aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
-}
-
-// TOS is incremented by BASE, BASE is pushed before (+BASE)
-// This opcode is pushed before DIM/REDIM-commands,
-// if there's been only one index named.
-
-void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
-{
- SbxVariable* p1 = new SbxVariable;
- SbxVariableRef x2 = PopVar();
-
- // #109275 Check compatiblity mode
- bool bCompatible = ((nOp1 & 0x8000) != 0);
- sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
- p1->PutInteger( uBase );
- if( !bCompatible )
- x2->Compute( SbxPLUS, *p1 );
- PushVar( x2 ); // first the Expr
- PushVar( p1 ); // then the Base
-}
-
-
-
-
-
-/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/step2.cxx b/basic/source/runtime/step2.cxx
deleted file mode 100644
index 168307538330..000000000000
--- a/basic/source/runtime/step2.cxx
+++ /dev/null
@@ -1,1400 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
-/*
- * This file is part of the LibreOffice project.
- *
- * This Source Code Form is subject to the terms of the Mozilla Public
- * License, v. 2.0. If a copy of the MPL was not distributed with this
- * file, You can obtain one at http://mozilla.org/MPL/2.0/.
- *
- * This file incorporates work covered by the following license notice:
- *
- * 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 .
- */
-
-
-#include "runtime.hxx"
-#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>
-#include <comphelper/string.hxx>
-#include <rtl/ustrbuf.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 OUString& rName );
-
-SbxVariable* getDefaultProp( SbxVariable* pRef );
-
-// the bits in the String-ID:
-// 0x8000 - Argv is reserved
-
-SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
- SbError nNotFound, bool bLocal, 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
- {
- bool bFatalError = false;
- SbxDataType t = (SbxDataType) nOp2;
- OUString 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.indexOf((sal_Unicode)'[') == 0 )
- {
- // emulate pcode here
- StepARGC();
- // psuedo StepLOADSC
- OUString sArg = aName.copy( 1, aName.getLength() - 2 );
- SbxVariable* p = new SbxVariable;
- p->PutString( sArg );
- PushVar( p );
- StepARGV();
- nOp1 = nOp1 | 0x8000; // indicate params are present
- aName = OUString("Evaluate");
- }
- if( bLocal )
- {
- if ( bStatic )
- {
- if ( pMeth )
- {
- pElem = pMeth->GetStatics()->Find( aName, SbxCLASS_DONTCARE );
- }
- }
-
- if ( !pElem )
- {
- pElem = refLocals->Find( aName, SbxCLASS_DONTCARE );
- }
- }
- if( !pElem )
- {
- bool bSave = rBasic.bNoRtl;
- rBasic.bNoRtl = 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_ = GetSbData()->pInst;
- if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
- {
- pElem = NULL; // Found but in wrong module!
- }
- // Interfaces: Use SBX_EXTFOUND
- }
- }
- rBasic.bNoRtl = bSave;
-
- // is it a global uno-identifier?
- 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 = VBAConstantHelper::instance().getVBAConstant( aName );
- }
- }
-
- if( !pElem )
- {
- // #72382 ATTENTION! ALWAYS returns a result now
- // because of unknown modules!
- SbUnoClass* pUnoClass = findUnoClass( aName );
- if( pUnoClass )
- {
- pElem = new SbxVariable( t );
- SbxValues aRes( SbxOBJECT );
- aRes.pObj = pUnoClass;
- pElem->SbxVariable::Put( aRes );
- }
- }
-
- // #62939 If an uno-class has been found, the wrapper
- // object has to be held, because the uno-class, e. g.
- // "stardiv", has to be read out of the registry
- // every time again otherwise
- if( pElem )
- {
- // #63774 May not be saved too!!!
- pElem->SetFlag( SBX_DONTSTORE );
- pElem->SetFlag( SBX_NO_MODIFY);
-
- // #72382 save locally, all variables that have been declared
- // implicit would become global automatically otherwise!
- if ( bSetName )
- {
- pElem->SetName( aName );
- }
- refLocals->Put( pElem, refLocals->Count() );
- }
- }
-
- if( !pElem )
- {
- // not there and not in the object?
- // don't establish if that thing has parameters!
- if( nOp1 & 0x8000 )
- {
- bFatalError = true;
- }
-
- // else, if there are parameters, use different error code
- if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) )
- {
- // #39108 if explicit and as ELEM always a fatal error
- bFatalError = true;
-
-
- if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED )
- {
- nNotFound = SbERR_VAR_UNDEFINED;
- }
- }
- if( bFatalError )
- {
- // #39108 use dummy variable instead of fatal error
- if( !xDummyVar.Is() )
- {
- xDummyVar = new SbxVariable( SbxVARIANT );
- }
- pElem = xDummyVar;
-
- ClearArgvStack();
-
- Error( nNotFound, aName );
- }
- else
- {
- if ( bStatic )
- {
- pElem = StepSTATIC_Impl( aName, t );
- }
- if ( !pElem )
- {
- pElem = new SbxVariable( t );
- if( t != SbxVARIANT )
- {
- pElem->SetFlag( SBX_FIXED );
- }
- pElem->SetName( aName );
- refLocals->Put( pElem, refLocals->Count() );
- }
- }
- }
- }
- // #39108 Args can already be deleted!
- if( !bFatalError )
- {
- SetupArgs( pElem, nOp1 );
- }
- // because a particular call-type is requested
- if( pElem->IsA( TYPE(SbxMethod) ) )
- {
- // shall the type be converted?
- SbxDataType t2 = pElem->GetType();
- bool bSet = false;
- if( !( pElem->GetFlags() & SBX_FIXED ) )
- {
- if( t != SbxVARIANT && t != t2 &&
- t >= SbxINTEGER && t <= SbxSTRING )
- {
- pElem->SetType( t ), bSet = true;
- }
- }
- // assign pElem to a Ref, to delete a temp-var if applicable
- SbxVariableRef refTemp = pElem;
-
- // remove potential rests of the last call of the SbxMethod
- // free Write before, so that there's no error
- sal_uInt16 nSavFlags = pElem->GetFlags();
- pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST );
- pElem->SbxValue::Clear();
- pElem->SetFlags( nSavFlags );
-
- // don't touch before setting, as e. g. LEFT()
- // has to know the difference between Left$() and Left()
-
- // because the methods' parameters are cut away in PopVar()
- SbxVariable* pNew = new SbxMethod( *((SbxMethod*)pElem) );
- //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
-
- pElem->SetParameters(0);
- pNew->SetFlag( SBX_READWRITE );
-
- if( bSet )
- {
- pElem->SetType( t2 );
- }
- pElem = pNew;
- }
- // consider index-access for UnoObjects
- // 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() )
- {
- SbxVariableRef refTemp = pElem;
-
- // dissolve the notify while copying variable
- SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) );
- pElem->SetParameters( NULL );
- pElem = pNew;
- }
- }
- return CheckArray( pElem );
-}
-
-// for current scope (e. g. query from BASIC-IDE)
-SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
-{
- // don't expect pMeth to be != 0, as there are none set
- // in the RunInit yet
-
- SbxVariable* pElem = NULL;
- if( !pMod || rName.isEmpty() )
- {
- return NULL;
- }
- if( refLocals )
- {
- pElem = refLocals->Find( rName, SbxCLASS_DONTCARE );
- }
- if ( !pElem && pMeth )
- {
- // for statics, set the method's name in front
- OUString aMethName = pMeth->GetName();
- aMethName += ":";
- aMethName += rName;
- pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE);
- }
-
- // search in parameter list
- 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.equalsIgnoreAsciiCase( rName ) )
- {
- if( j >= nParamCount )
- {
- // Parameter is missing
- pElem = new SbxVariable( SbxSTRING );
- pElem->PutString( OUString("<missing parameter>"));
- }
- else
- {
- pElem = refParams->Get( j );
- }
- break;
- }
- pParam = pInfo->GetParam( ++j );
- }
- }
- }
-
- // search in module
- if( !pElem )
- {
- bool bSave = rBasic.bNoRtl;
- rBasic.bNoRtl = true;
- pElem = pMod->Find( rName, SbxCLASS_DONTCARE );
- rBasic.bNoRtl = bSave;
- }
- return pElem;
-}
-
-
-
-void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
-{
- if( nOp1 & 0x8000 )
- {
- if( !refArgv )
- {
- StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
- }
- bool bHasNamed = false;
- sal_uInt16 i;
- sal_uInt16 nArgCount = refArgv->Count();
- for( i = 1 ; i < nArgCount ; i++ )
- {
- if( !refArgv->GetAlias(i).isEmpty() )
- {
- bHasNamed = true; break;
- }
- }
- if( bHasNamed )
- {
- 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 );
- OUString* pNames = pArg->getNames().getArray();
- for( i = 1 ; i < nArgCount ; i++ )
- {
- SbxVariable* pVar = refArgv->Get( i );
- const OUString& rName = refArgv->GetAlias( i );
- if( !rName.isEmpty() )
- {
- 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 );
-
- 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 OUString& rName = refArgv->GetAlias( i );
- if( !rName.isEmpty() )
- {
- // nCurPar is set to the found parameter
- sal_uInt16 j = 1;
- const SbxParamInfo* pParam = pInfo->GetParam( j );
- while( pParam )
- {
- if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
- {
- nCurPar = j;
- break;
- }
- pParam = pInfo->GetParam( ++j );
- }
- if( !pParam )
- {
- Error( SbERR_NAMED_NOT_FOUND ); break;
- }
- }
- pArg->Put( pVar, nCurPar++ );
- }
- refArgv = pArg;
- }
- }
- // own var as parameter 0
- refArgv->Put( p, 0 );
- p->SetParameters( refArgv );
- PopArgv();
- }
- else
- {
- p->SetParameters( NULL );
- }
-}
-
-// getting an array element
-
-SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
-{
- SbxArray* pPar;
- if( ( pElem->GetType() & SbxARRAY ) && (SbxVariable*)refRedim != pElem )
- {
- SbxBase* pElemObj = pElem->GetObject();
- SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
- pPar = pElem->GetParameters();
- if( pDimArray )
- {
- // parameters may be missing, if an array is
- // passed as an argument
- 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, set parameter 0 to NULL so that var doesn't contain itself
- if( pPar )
- {
- pPar->Put( NULL, 0 );
- }
- }
- // consider index-access for UnoObjects
- else if( pElem->GetType() == SbxOBJECT && !pElem->ISA(SbxMethod) && ( !bVBAEnabled || ( bVBAEnabled && !pElem->ISA(SbxProperty) ) ) )
- {
- pPar = pElem->GetParameters();
- if ( pPar )
- {
- // is it an uno-object?
- 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 )
- {
- if( xIndexAccess.is() )
- {
- sal_uInt32 nParamCount = (sal_uInt32)pPar->Count() - 1;
- if( nParamCount != 1 )
- {
- StarBASIC::Error( SbERR_BAD_ARGUMENT );
- return pElem;
- }
-
- // get index
- 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 (const IndexOutOfBoundsException&)
- {
- // usually expect converting problem
- StarBASIC::Error( SbERR_OUT_OF_RANGE );
- }
-
- // #57847 always create a new variable, else error
- // due to PutObject(NULL) at ReadOnly-properties
- pElem = new SbxVariable( SbxVARIANT );
- if( xRet.is() )
- {
- aAny <<= xRet;
-
- // #67173 don't specify a name so that the real class name is entered
- OUString aName;
- SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny );
- pElem->PutObject( xWrapper );
- }
- else
- {
- pElem->PutObject( NULL );
- }
- }
- }
- else
- {
- // check if there isn't a default member between the current variable
- // and the params, e.g.
- // Dim rst1 As New ADODB.Recordset
- // "
- // val = rst1("FirstName")
- // has the default 'Fields' member between rst1 and '("FirstName")'
- SbxVariable* pDflt = getDefaultProp( pElem );
- if ( pDflt )
- {
- pDflt->Broadcast( SBX_HINT_DATAWANTED );
- SbxBaseRef pDfltObj = (SbxBase*)pDflt->GetObject();
- if( pDfltObj )
- {
- if( pDfltObj->ISA(SbUnoObject) )
- {
- pUnoObj = (SbUnoObject*)(SbxBase*)pDfltObj;
- Any aUnoAny = pUnoObj->getUnoAny();
-
- if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
- x = *(Reference< XInterface >*)aUnoAny.getValue();
- pElem = pDflt;
- }
- }
- }
- OUString sDefaultMethod;
-
- Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
-
- if ( xDfltMethod.is() )
- {
- sDefaultMethod = xDfltMethod->getDefaultMethodName();
- }
- else if( xIndexAccess.is() )
- {
- sDefaultMethod = OUString( "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, set parameter 0 to NULL so that var doesn't contain itself
- 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;
-}
-
-// loading an element from the runtime-library (+StringID+type)
-
-void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, false ) );
-}
-
-void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
- SbError nNotFound, bool bLocal, bool bStatic )
-{
- if( !refLocals )
- {
- refLocals = new SbxArray;
- }
- PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, bLocal, bStatic ) );
-}
-// loading a local/global variable (+StringID+type)
-
-void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, 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, 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, true, true );
-}
-
-// loading an object-element (+StringID+type)
-// the object lies on TOS
-
-void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- SbxVariableRef pObjVar = PopVar();
-
- SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar);
- if( !pObj )
- {
- SbxBase* pObjVarObj = pObjVar->GetObject();
- pObj = PTR_CAST(SbxObject,pObjVarObj);
- }
-
- // #56368 save reference at StepElem, otherwise objects could
- // lose their reference too early in qualification chains like
- // ActiveComponent.Selection(0).Text
- // #74254 now per list
- if( pObj )
- {
- SaveRef( (SbxVariable*)pObj );
- }
- PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, false ) );
-}
-
-// loading a parameter (+offset+type)
-// If the data type is wrong, create a copy.
-// The data type SbxEMPTY shows that no parameters are given.
-// Get( 0 ) may be EMPTY
-
-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 solve missing in a cleaner way
- 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( OUString() );
- }
- }
- else
- {
- p->PutErr( 448 ); // like in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND)
- }
- refParams->Put( p, iLoop );
- iLoop--;
- }
- }
- p = refParams->Get( i );
-
- if( p->GetType() == SbxERROR && ( i ) )
- {
- // if there's a parameter missing, it can be OPTIONAL
- bool bOpt = 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_uInt16)(pParam->nUserData & 0x0ffff);
- if( nDefaultId > 0 )
- {
- OUString aDefaultStr = pImg->GetString( nDefaultId );
- p = new SbxVariable();
- p->PutString( aDefaultStr );
- refParams->Put( p, i );
- }
- bOpt = true;
- }
- }
- }
- if( !bOpt )
- {
- Error( SbERR_NOT_OPTIONAL );
- }
- }
- else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t )
- {
- SbxVariable* q = new SbxVariable( t );
- SaveRef( q );
- *q = *p;
- p = q;
- if ( i )
- {
- refParams->Put( p, i );
- }
- }
- 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 );
- }
- }
-}
-
-// call of a DLL-procedure (+StringID+type)
-// the StringID's MSB shows that Argv is occupied
-
-void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
- SbxArray* pArgs = NULL;
- if( nOp1 & 0x8000 )
- {
- pArgs = refArgv;
- }
- DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, false );
- aLibName = OUString();
- if( nOp1 & 0x8000 )
- {
- PopArgv();
- }
-}
-
-// call of a DLL-procedure after CDecl (+StringID+type)
-
-void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
- SbxArray* pArgs = NULL;
- if( nOp1 & 0x8000 )
- {
- pArgs = refArgv;
- }
- DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, true );
- aLibName = OUString();
- if( nOp1 & 0x8000 )
- {
- PopArgv();
- }
-}
-
-
-// beginning of a statement (+Line+Col)
-
-void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- // If the Expr-Stack at the beginning of a statement constains a variable,
- // some fool has called X as a function, although it's a variable!
- bool bFatalExpr = false;
- OUString sUnknownMethodName;
- if( nExprLvl > 1 )
- {
- bFatalExpr = 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 = true;
- }
- }
-
- ClearExprStack();
-
- ClearRefs();
-
- // We have to cancel hard here because line and column
- // would be wrong later otherwise!
- if( bFatalExpr)
- {
- StarBASIC::FatalError( SbERR_NO_METHOD, sUnknownMethodName );
- return;
- }
- pStmnt = pCode - 9;
- sal_uInt16 nOld = nLine;
- nLine = static_cast<short>( nOp1 );
-
- // #29955 & 0xFF, to filter out for-loop-level
- nCol1 = static_cast<short>( nOp2 & 0xFF );
-
- // find the next STMNT-command to set the final column
- // of this statement
-
- nCol2 = 0xffff;
- sal_uInt16 n1, n2;
- const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
- if( p )
- {
- if( n1 == nOp1 )
- {
- // #29955 & 0xFF, to filter out for-loop-level
- nCol2 = (n2 & 0xFF) - 1;
- }
- }
-
- // #29955 correct for-loop-level, #67452 NOT in the error-handler
- if( !bInError )
- {
- // (there's a difference here in case of a jump out of a loop)
- sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
- if( pGosubStk )
- {
- nExspectedForLevel = nExspectedForLevel + pGosubStk->nStartForLvl;
- }
-
- // if the actual for-level is too small it'd jump out
- // of a loop -> corrected
- while( nForLvl > nExspectedForLevel )
- {
- PopFor();
- }
- }
-
- // 16.10.96: #31460 new concept for StepInto/Over/Out
- // see explanation at _ImplGetBreakCallLevel
- if( pInst->nCallLvl <= pInst->nBreakCallLvl )
- {
- StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
- sal_uInt16 nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
-
- pInst->CalcBreakCallLevel( nNewFlags );
- }
-
- // break points only at STMNT-commands in a new line!
- 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 );
-
- pInst->CalcBreakCallLevel( nNewFlags );
- }
-}
-
-// (+SvStreamFlags+Flags)
-// Stack: block length
-// channel number
-// file name
-
-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();
- OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
- pIosys->Open( nChan, aName, static_cast<short>( nOp1 ),
- static_cast<short>( nOp2 ), nBlkLen );
- Error( pIosys->GetError() );
-}
-
-// create object (+StringID+StringID)
-
-void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
- SbxObject *pObj = SbxBase::CreateObject( aClass );
- if( !pObj )
- {
- Error( SbERR_INVALID_OBJECT );
- }
- else
- {
- OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
- pObj->SetName( aName );
- // the object must be able to call the BASIC
- 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 create object array (+StringID+StringID), DCREATE == Dim-Create
-void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- SbxVariableRef refVar = PopVar();
-
- DimImpl( refVar );
-
- // fill the array with instances of the requested class
- 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;
-
- short nDims = pArray->GetDims();
- sal_Int32 nTotalSize = 0;
-
- // must be a one-dimensional array
- 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;
- }
- }
-
- // create objects and insert them into the array
- OUString 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
- {
- OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
- pClassObj->SetName( aName );
- // the object must be able to call the basic
- 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;
- bool bRangeError = 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 = 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;
- }
-}
-
-// create object from user-type (+StringID+StringID)
-
-SbxObject* createUserTypeImpl( const OUString& rClassName ); // sb.cxx
-
-void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
- OUString 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
- OUStringBuffer aBuf;
- comphelper::string::padToLength(aBuf, nCount, 0);
- pVar->PutString(aBuf.makeStringAndClear());
- }
-
- bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
- if( bVarToDim )
- {
- pVar->SetFlag( SBX_VAR_TO_DIM );
- }
-}
-
-// establishing a local variable (+StringID+type)
-
-void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- if( !refLocals.Is() )
- {
- refLocals = new SbxArray;
- }
- OUString 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() );
- }
-}
-
-// establishing a module-global variable (+StringID+type)
-
-void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
-{
- OUString 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 );
- // from 2.7.1996: HACK because of 'reference can't be saved'
- 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 );
- }
-}
-
-// establishing a global variable (+StringID+type)
-
-void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- if( pImg->GetFlag( SBIMG_CLASSMODULE ) )
- {
- StepPUBLIC_Impl( nOp1, nOp2, true );
- }
- OUString 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 );
- // from 2.7.1996: HACK because of 'reference can't be saved'
- 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;
- OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
-
- SbxVariable* pDummyVar = new SbxVariable( t );
- pDummyVar->SetName( aName );
- PushVar( pDummyVar );
- }
-}
-
-
-SbxVariable* SbiRuntime::StepSTATIC_Impl( OUString& 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;
-}
-// establishing a static variable (+StringID+type)
-void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
-{
- OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
- SbxDataType t = (SbxDataType) nOp2;
- StepSTATIC_Impl( aName, t );
-}
-
-/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-22 12:58:31 +0000