summaryrefslogtreecommitdiff
path: root/basic
diff options
context:
space:
mode:
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 (git 2.34.1) at 2024-07-01 15:26:59 +0000