Version 6.4.0.3, tag libreoffice-6.4.0.3
[LibreOffice.git] / basic / source / runtime / runtime.cxx
blobfaf2b1daf88ae7f9c0117ca463b67b0648bfa6bb
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
3 * This file is part of the LibreOffice project.
5 * This Source Code Form is subject to the terms of the Mozilla Public
6 * License, v. 2.0. If a copy of the MPL was not distributed with this
7 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 * This file incorporates work covered by the following license notice:
11 * Licensed to the Apache Software Foundation (ASF) under one or more
12 * contributor license agreements. See the NOTICE file distributed
13 * with this work for additional information regarding copyright
14 * ownership. The ASF licenses this file to you under the Apache
15 * License, Version 2.0 (the "License"); you may not use this file
16 * except in compliance with the License. You may obtain a copy of
17 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
20 #include <stdlib.h>
22 #include <algorithm>
23 #include <string_view>
24 #include <unordered_map>
26 #include <com/sun/star/beans/XPropertySet.hpp>
27 #include <com/sun/star/container/XEnumerationAccess.hpp>
28 #include <com/sun/star/container/XIndexAccess.hpp>
29 #include <com/sun/star/script/XDefaultMethod.hpp>
30 #include <com/sun/star/uno/Any.hxx>
31 #include <com/sun/star/util/SearchAlgorithms2.hpp>
33 #include <comphelper/processfactory.hxx>
34 #include <comphelper/string.hxx>
36 #include <sal/log.hxx>
38 #include <tools/wldcrd.hxx>
39 #include <tools/diagnose_ex.h>
41 #include <vcl/svapp.hxx>
42 #include <vcl/settings.hxx>
44 #include <rtl/instance.hxx>
45 #include <rtl/math.hxx>
46 #include <rtl/ustrbuf.hxx>
47 #include <rtl/character.hxx>
49 #include <svl/zforlist.hxx>
51 #include <i18nutil/searchopt.hxx>
52 #include <unotools/syslocale.hxx>
53 #include <unotools/textsearch.hxx>
55 #include <basic/sbuno.hxx>
57 #include <codegen.hxx>
58 #include "comenumwrapper.hxx"
59 #include "ddectrl.hxx"
60 #include "dllmgr.hxx"
61 #include <errobject.hxx>
62 #include <image.hxx>
63 #include <iosys.hxx>
64 #include <opcodes.hxx>
65 #include <runtime.hxx>
66 #include <sb.hxx>
67 #include <sbintern.hxx>
68 #include <sbprop.hxx>
69 #include <sbunoobj.hxx>
70 #include <basic/codecompletecache.hxx>
71 #include <memory>
73 using com::sun::star::uno::Reference;
75 using namespace com::sun::star::uno;
76 using namespace com::sun::star::container;
77 using namespace com::sun::star::lang;
78 using namespace com::sun::star::beans;
79 using namespace com::sun::star::script;
81 using namespace ::com::sun::star;
83 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType );
84 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled );
86 bool SbiRuntime::isVBAEnabled()
88 bool bResult = false;
89 SbiInstance* pInst = GetSbData()->pInst;
90 if ( pInst && GetSbData()->pInst->pRun )
91 bResult = pInst->pRun->bVBAEnabled;
92 return bResult;
95 void StarBASIC::SetVBAEnabled( bool bEnabled )
97 if ( bDocBasic )
99 bVBAEnabled = bEnabled;
103 bool StarBASIC::isVBAEnabled() const
105 if ( bDocBasic )
107 if( SbiRuntime::isVBAEnabled() )
108 return true;
109 return bVBAEnabled;
111 return false;
114 struct SbiArgv { // Argv stack:
115 SbxArrayRef refArgv; // Argv
116 short nArgc; // Argc
118 SbiArgv(SbxArrayRef const & refArgv_, short nArgc_) :
119 refArgv(refArgv_),
120 nArgc(nArgc_) {}
123 struct SbiGosub { // GOSUB-Stack:
124 const sal_uInt8* pCode; // Return-Pointer
125 sal_uInt16 nStartForLvl; // #118235: For Level in moment of gosub
127 SbiGosub(const sal_uInt8* pCode_, sal_uInt16 nStartForLvl_) :
128 pCode(pCode_),
129 nStartForLvl(nStartForLvl_) {}
132 SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // all opcodes without operands
133 &SbiRuntime::StepNOP,
134 &SbiRuntime::StepEXP,
135 &SbiRuntime::StepMUL,
136 &SbiRuntime::StepDIV,
137 &SbiRuntime::StepMOD,
138 &SbiRuntime::StepPLUS,
139 &SbiRuntime::StepMINUS,
140 &SbiRuntime::StepNEG,
141 &SbiRuntime::StepEQ,
142 &SbiRuntime::StepNE,
143 &SbiRuntime::StepLT,
144 &SbiRuntime::StepGT,
145 &SbiRuntime::StepLE,
146 &SbiRuntime::StepGE,
147 &SbiRuntime::StepIDIV,
148 &SbiRuntime::StepAND,
149 &SbiRuntime::StepOR,
150 &SbiRuntime::StepXOR,
151 &SbiRuntime::StepEQV,
152 &SbiRuntime::StepIMP,
153 &SbiRuntime::StepNOT,
154 &SbiRuntime::StepCAT,
156 &SbiRuntime::StepLIKE,
157 &SbiRuntime::StepIS,
158 // load/save
159 &SbiRuntime::StepARGC, // establish new Argv
160 &SbiRuntime::StepARGV, // TOS ==> current Argv
161 &SbiRuntime::StepINPUT, // Input ==> TOS
162 &SbiRuntime::StepLINPUT, // Line Input ==> TOS
163 &SbiRuntime::StepGET, // touch TOS
164 &SbiRuntime::StepSET, // save object TOS ==> TOS-1
165 &SbiRuntime::StepPUT, // TOS ==> TOS-1
166 &SbiRuntime::StepPUTC, // TOS ==> TOS-1, then ReadOnly
167 &SbiRuntime::StepDIM, // DIM
168 &SbiRuntime::StepREDIM, // REDIM
169 &SbiRuntime::StepREDIMP, // REDIM PRESERVE
170 &SbiRuntime::StepERASE, // delete TOS
171 // branch
172 &SbiRuntime::StepSTOP, // program end
173 &SbiRuntime::StepINITFOR, // initialize FOR-Variable
174 &SbiRuntime::StepNEXT, // increment FOR-Variable
175 &SbiRuntime::StepCASE, // beginning CASE
176 &SbiRuntime::StepENDCASE, // end CASE
177 &SbiRuntime::StepSTDERROR, // standard error handling
178 &SbiRuntime::StepNOERROR, // no error handling
179 &SbiRuntime::StepLEAVE, // leave UP
180 // E/A
181 &SbiRuntime::StepCHANNEL, // TOS = channel number
182 &SbiRuntime::StepPRINT, // print TOS
183 &SbiRuntime::StepPRINTF, // print TOS in field
184 &SbiRuntime::StepWRITE, // write TOS
185 &SbiRuntime::StepRENAME, // Rename Tos+1 to Tos
186 &SbiRuntime::StepPROMPT, // define Input Prompt from TOS
187 &SbiRuntime::StepRESTART, // Set restart point
188 &SbiRuntime::StepCHANNEL0, // set E/A-channel 0
189 &SbiRuntime::StepEMPTY, // empty expression on stack
190 &SbiRuntime::StepERROR, // TOS = error code
191 &SbiRuntime::StepLSET, // save object TOS ==> TOS-1
192 &SbiRuntime::StepRSET, // save object TOS ==> TOS-1
193 &SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
194 &SbiRuntime::StepINITFOREACH,// Init for each loop
195 &SbiRuntime::StepVBASET,// vba-like set statement
196 &SbiRuntime::StepERASE_CLEAR,// vba-like set statement
197 &SbiRuntime::StepARRAYACCESS,// access TOS as array
198 &SbiRuntime::StepBYVAL, // access TOS as array
201 SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // all opcodes with one operand
202 &SbiRuntime::StepLOADNC, // loading a numeric constant (+ID)
203 &SbiRuntime::StepLOADSC, // loading a string constant (+ID)
204 &SbiRuntime::StepLOADI, // Immediate Load (+value)
205 &SbiRuntime::StepARGN, // save a named Args in Argv (+StringID)
206 &SbiRuntime::StepPAD, // bring string to a definite length (+length)
207 // branches
208 &SbiRuntime::StepJUMP, // jump (+Target)
209 &SbiRuntime::StepJUMPT, // evaluate TOS, conditional jump (+Target)
210 &SbiRuntime::StepJUMPF, // evaluate TOS, conditional jump (+Target)
211 &SbiRuntime::StepONJUMP, // evaluate TOS, jump into JUMP-table (+MaxVal)
212 &SbiRuntime::StepGOSUB, // UP-call (+Target)
213 &SbiRuntime::StepRETURN, // UP-return (+0 or Target)
214 &SbiRuntime::StepTESTFOR, // check FOR-variable, increment (+Endlabel)
215 &SbiRuntime::StepCASETO, // Tos+1 <= Case <= Tos), 2xremove (+Target)
216 &SbiRuntime::StepERRHDL, // error handler (+Offset)
217 &SbiRuntime::StepRESUME, // resume after errors (+0 or 1 or Label)
218 // E/A
219 &SbiRuntime::StepCLOSE, // (+channel/0)
220 &SbiRuntime::StepPRCHAR, // (+char)
221 // management
222 &SbiRuntime::StepSETCLASS, // check set + class names (+StringId)
223 &SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId)
224 &SbiRuntime::StepLIB, // lib for declare-call (+StringId)
225 &SbiRuntime::StepBASED, // TOS is incremented by BASE, BASE is pushed before
226 &SbiRuntime::StepARGTYP, // convert last parameter in Argv (+Type)
227 &SbiRuntime::StepVBASETCLASS,// vba-like set statement
230 SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// all opcodes with two operands
231 &SbiRuntime::StepRTL, // load from RTL (+StringID+Typ)
232 &SbiRuntime::StepFIND, // load (+StringID+Typ)
233 &SbiRuntime::StepELEM, // load element (+StringID+Typ)
234 &SbiRuntime::StepPARAM, // Parameter (+Offset+Typ)
235 // branches
236 &SbiRuntime::StepCALL, // Declare-Call (+StringID+Typ)
237 &SbiRuntime::StepCALLC, // CDecl-Declare-Call (+StringID+Typ)
238 &SbiRuntime::StepCASEIS, // Case-Test (+Test-Opcode+False-Target)
239 // management
240 &SbiRuntime::StepSTMNT, // beginning of a statement (+Line+Col)
241 // E/A
242 &SbiRuntime::StepOPEN, // (+StreamMode+Flags)
243 // Objects
244 &SbiRuntime::StepLOCAL, // define local variable (+StringId+Typ)
245 &SbiRuntime::StepPUBLIC, // module global variable (+StringID+Typ)
246 &SbiRuntime::StepGLOBAL, // define global variable (+StringID+Typ)
247 &SbiRuntime::StepCREATE, // create object (+StringId+StringId)
248 &SbiRuntime::StepSTATIC, // static variable (+StringId+StringId)
249 &SbiRuntime::StepTCREATE, // user-defined objects (+StringId+StringId)
250 &SbiRuntime::StepDCREATE, // create object-array (+StringID+StringID)
251 &SbiRuntime::StepGLOBAL_P, // define global variable which is not overwritten
252 // by the Basic on a restart (+StringID+Typ)
253 &SbiRuntime::StepFIND_G, // finds global variable with special treatment because of _GLOBAL_P
254 &SbiRuntime::StepDCREATE_REDIMP, // redimension object array (+StringID+StringID)
255 &SbiRuntime::StepFIND_CM, // Search inside a class module (CM) to enable global search in time
256 &SbiRuntime::StepPUBLIC_P, // Search inside a class module (CM) to enable global search in time
257 &SbiRuntime::StepFIND_STATIC, // Search inside a class module (CM) to enable global search in time
261 // SbiRTLData
263 SbiRTLData::SbiRTLData()
265 nDirFlags = SbAttributes::NONE;
266 nCurDirPos = 0;
269 SbiRTLData::~SbiRTLData()
273 // SbiInstance
275 // 16.10.96: #31460 new concept for StepInto/Over/Out
276 // The decision whether StepPoint shall be called is done with the help of
277 // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl.
278 // The current CallLevel can never be smaller than 1, as it's also incremented
279 // during the call of a method (also main). Therefore a BreakCallLvl from 0
280 // means that the program isn't stopped at all.
281 // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
284 void SbiInstance::CalcBreakCallLevel( BasicDebugFlags nFlags )
287 nFlags &= ~BasicDebugFlags::Break;
289 sal_uInt16 nRet;
290 if (nFlags == BasicDebugFlags::StepInto) {
291 nRet = nCallLvl + 1; // CallLevel+1 is also stopped
292 } else if (nFlags == (BasicDebugFlags::StepOver | BasicDebugFlags::StepInto)) {
293 nRet = nCallLvl; // current CallLevel is stopped
294 } else if (nFlags == BasicDebugFlags::StepOut) {
295 nRet = nCallLvl - 1; // smaller CallLevel is stopped
296 } else {
297 // Basic-IDE returns 0 instead of BasicDebugFlags::Continue, so also default=continue
298 nRet = 0; // CallLevel is always > 0 -> no StepPoint
300 nBreakCallLvl = nRet; // take result
303 SbiInstance::SbiInstance( StarBASIC* p )
304 : pIosys(new SbiIoSystem)
305 , pDdeCtrl(new SbiDdeControl)
306 , pBasic(p)
307 , meFormatterLangType(LANGUAGE_DONTKNOW)
308 , meFormatterDateOrder(DateOrder::YMD)
309 , nStdDateIdx(0)
310 , nStdTimeIdx(0)
311 , nStdDateTimeIdx(0)
312 , nErr(0)
313 , nErl(0)
314 , bReschedule(true)
315 , bCompatibility(false)
316 , pRun(nullptr)
317 , nCallLvl(0)
318 , nBreakCallLvl(0)
322 SbiInstance::~SbiInstance()
324 while( pRun )
326 SbiRuntime* p = pRun->pNext;
327 delete pRun;
328 pRun = p;
333 int nSize = ComponentVector.size();
334 if( nSize )
336 for( int i = nSize - 1 ; i >= 0 ; --i )
338 Reference< XComponent > xDlgComponent = ComponentVector[i];
339 if( xDlgComponent.is() )
340 xDlgComponent->dispose();
344 catch( const Exception& )
346 TOOLS_WARN_EXCEPTION("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components" );
350 SbiDllMgr* SbiInstance::GetDllMgr()
352 if( !pDllMgr )
354 pDllMgr.reset(new SbiDllMgr);
356 return pDllMgr.get();
359 // #39629 create NumberFormatter with the help of a static method now
360 std::shared_ptr<SvNumberFormatter> const & SbiInstance::GetNumberFormatter()
362 LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
363 SvtSysLocale aSysLocale;
364 DateOrder eDate = aSysLocale.GetLocaleData().getDateOrder();
365 if( pNumberFormatter )
367 if( eLangType != meFormatterLangType ||
368 eDate != meFormatterDateOrder )
370 pNumberFormatter.reset();
373 meFormatterLangType = eLangType;
374 meFormatterDateOrder = eDate;
375 if( !pNumberFormatter )
377 pNumberFormatter = PrepareNumberFormatter( nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx,
378 &meFormatterLangType, &meFormatterDateOrder);
380 return pNumberFormatter;
383 // #39629 offer NumberFormatter static too
384 std::shared_ptr<SvNumberFormatter> SbiInstance::PrepareNumberFormatter( sal_uInt32 &rnStdDateIdx,
385 sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
386 LanguageType const * peFormatterLangType, DateOrder const * peFormatterDateOrder )
388 LanguageType eLangType;
389 if( peFormatterLangType )
391 eLangType = *peFormatterLangType;
393 else
395 eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
397 DateOrder eDate;
398 if( peFormatterDateOrder )
400 eDate = *peFormatterDateOrder;
402 else
404 SvtSysLocale aSysLocale;
405 eDate = aSysLocale.GetLocaleData().getDateOrder();
408 std::shared_ptr<SvNumberFormatter> pNumberFormatter(
409 new SvNumberFormatter( comphelper::getProcessComponentContext(), eLangType ));
411 // Several parser methods pass SvNumberFormatter::IsNumberFormat() a number
412 // format index to parse against. Tell the formatter the proper date
413 // evaluation order, which also determines the date acceptance patterns to
414 // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the
415 // format's locale's date patterns/order (no init/system locale match
416 // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0)
417 // (or an unknown) format index was passed.
418 pNumberFormatter->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT);
420 sal_Int32 nCheckPos = 0;
421 SvNumFormatType nType;
422 rnStdTimeIdx = pNumberFormatter->GetStandardFormat( SvNumFormatType::TIME, eLangType );
424 // the formatter's standard templates have only got a two-digit date
425 // -> registering an own format
427 // HACK, because the numberformatter doesn't swap the place holders
428 // for month, day and year according to the system setting.
429 // Problem: Print Year(Date) under engl. BS
430 // also have a look at: basic/source/sbx/sbxdate.cxx
432 OUString aDateStr;
433 switch( eDate )
435 default:
436 case DateOrder::MDY: aDateStr = "MM/DD/YYYY"; break;
437 case DateOrder::DMY: aDateStr = "DD/MM/YYYY"; break;
438 case DateOrder::YMD: aDateStr = "YYYY/MM/DD"; break;
440 OUString aStr( aDateStr ); // PutandConvertEntry() modifies string!
441 pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
442 rnStdDateIdx, LANGUAGE_ENGLISH_US, eLangType, true);
443 nCheckPos = 0;
444 aDateStr += " HH:MM:SS";
445 aStr = aDateStr;
446 pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
447 rnStdDateTimeIdx, LANGUAGE_ENGLISH_US, eLangType, true);
448 return pNumberFormatter;
452 // Let engine run. If Flags == BasicDebugFlags::Continue, take Flags over
454 void SbiInstance::Stop()
456 for( SbiRuntime* p = pRun; p; p = p->pNext )
458 p->Stop();
462 // Allows Basic IDE to set watch mode to suppress errors
463 static bool bWatchMode = false;
465 void setBasicWatchMode( bool bOn )
467 bWatchMode = bOn;
470 void SbiInstance::Error( ErrCode n )
472 Error( n, OUString() );
475 void SbiInstance::Error( ErrCode n, const OUString& rMsg )
477 if( !bWatchMode )
479 aErrorMsg = rMsg;
480 pRun->Error( n );
484 void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const OUString& rMsg )
486 if( !bWatchMode )
488 ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
489 if ( !n )
491 n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors
493 aErrorMsg = rMsg;
494 SbiRuntime::translateErrorToVba( n, aErrorMsg );
496 pRun->Error( ERRCODE_BASIC_COMPAT, true/*bVBATranslationAlreadyDone*/ );
500 void SbiInstance::setErrorVB( sal_Int32 nVBNumber )
502 ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
503 if( !n )
505 n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors
507 aErrorMsg = OUString();
508 SbiRuntime::translateErrorToVba( n, aErrorMsg );
510 nErr = n;
514 void SbiInstance::FatalError( ErrCode n )
516 pRun->FatalError( n );
519 void SbiInstance::FatalError( ErrCode _errCode, const OUString& _details )
521 pRun->FatalError( _errCode, _details );
524 void SbiInstance::Abort()
526 StarBASIC* pErrBasic = GetCurrentBasic( pBasic );
527 pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 );
528 StarBASIC::Stop();
531 // can be unequal to pRTBasic
532 StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic )
534 StarBASIC* pCurBasic = pRTBasic;
535 SbModule* pActiveModule = StarBASIC::GetActiveModule();
536 if( pActiveModule )
538 SbxObject* pParent = pActiveModule->GetParent();
539 if (StarBASIC *pBasic = dynamic_cast<StarBASIC*>(pParent))
540 pCurBasic = pBasic;
542 return pCurBasic;
545 SbModule* SbiInstance::GetActiveModule()
547 if( pRun )
549 return pRun->GetModule();
551 else
553 return nullptr;
557 SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel )
559 SbiRuntime* p = pRun;
560 while( nLevel-- && p )
562 p = p->pNext;
564 return p ? p->GetCaller() : nullptr;
567 // SbiInstance
569 // Attention: pMeth can also be NULL (on a call of the init-code)
571 SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart )
572 : rBasic( *static_cast<StarBASIC*>(pm->pParent) ), pInst( GetSbData()->pInst ),
573 pMod( pm ), pMeth( pe ), pImg( pMod->pImage ), mpExtCaller(nullptr), m_nLastTime(0)
575 nFlags = pe ? pe->GetDebugFlags() : BasicDebugFlags::NONE;
576 pIosys = pInst->GetIoSystem();
577 pForStk = nullptr;
578 pError = nullptr;
579 pErrCode =
580 pErrStmnt =
581 pRestart = nullptr;
582 pNext = nullptr;
583 pCode =
584 pStmnt = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nStart;
585 bRun =
586 bError = true;
587 bInError = false;
588 bBlocked = false;
589 nLine = 0;
590 nCol1 = 0;
591 nCol2 = 0;
592 nExprLvl = 0;
593 nArgc = 0;
594 nError = ERRCODE_NONE;
595 nForLvl = 0;
596 nOps = 0;
597 refExprStk = new SbxArray;
598 SetVBAEnabled( pMod->IsVBACompat() );
599 SetParameters( pe ? pe->GetParameters() : nullptr );
602 SbiRuntime::~SbiRuntime()
604 ClearArgvStack();
605 ClearForStack();
608 void SbiRuntime::SetVBAEnabled(bool bEnabled )
610 bVBAEnabled = bEnabled;
611 if ( bVBAEnabled )
613 if ( pMeth )
615 mpExtCaller = pMeth->mCaller;
618 else
620 mpExtCaller = nullptr;
624 // Construction of the parameter list. All ByRef-parameters are directly
625 // taken over; copies of ByVal-parameters are created. If a particular
626 // data type is requested, it is converted.
628 void SbiRuntime::SetParameters( SbxArray* pParams )
630 refParams = new SbxArray;
631 // for the return value
632 refParams->Put( pMeth, 0 );
634 SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : nullptr;
635 sal_uInt16 nParamCount = pParams ? pParams->Count() : 1;
636 if( nParamCount > 1 )
638 for( sal_uInt16 i = 1 ; i < nParamCount ; i++ )
640 const SbxParamInfo* p = pInfo ? pInfo->GetParam( i ) : nullptr;
642 // #111897 ParamArray
643 if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
645 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
646 sal_uInt16 nParamArrayParamCount = nParamCount - i;
647 pArray->unoAddDim( 0, nParamArrayParamCount - 1 );
648 for (sal_uInt16 j = i; j < nParamCount ; ++j)
650 SbxVariable* v = pParams->Get( j );
651 short aDimIndex[1];
652 aDimIndex[0] = j - i;
653 pArray->Put(v, aDimIndex);
655 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
656 pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
657 pArrayVar->PutObject( pArray );
658 refParams->Put( pArrayVar, i );
660 // Block ParamArray for missing parameter
661 pInfo = nullptr;
662 break;
665 SbxVariable* v = pParams->Get( i );
666 // methods are always byval!
667 bool bByVal = dynamic_cast<const SbxMethod *>(v) != nullptr;
668 SbxDataType t = v->GetType();
669 bool bTargetTypeIsArray = false;
670 if( p )
672 bByVal |= ( p->eType & SbxBYREF ) == 0;
673 t = static_cast<SbxDataType>( p->eType & 0x0FFF );
675 if( !bByVal && t != SbxVARIANT &&
676 (!v->IsFixed() || static_cast<SbxDataType>(v->GetType() & 0x0FFF ) != t) )
678 bByVal = true;
681 bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0;
683 if( bByVal )
685 if( bTargetTypeIsArray )
687 t = SbxOBJECT;
689 SbxVariable* v2 = new SbxVariable( t );
690 v2->SetFlag( SbxFlagBits::ReadWrite );
691 *v2 = *v;
692 refParams->Put( v2, i );
694 else
696 if( t != SbxVARIANT && t != ( v->GetType() & 0x0FFF ) )
698 if( p && (p->eType & SbxARRAY) )
700 Error( ERRCODE_BASIC_CONVERSION );
702 else
704 v->Convert( t );
707 refParams->Put( v, i );
709 if( p )
711 refParams->PutAlias( p->aName, i );
716 // ParamArray for missing parameter
717 if( pInfo )
719 // #111897 Check first missing parameter for ParamArray
720 const SbxParamInfo* p = pInfo->GetParam( nParamCount );
721 if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
723 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
724 pArray->unoAddDim( 0, -1 );
725 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
726 pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
727 pArrayVar->PutObject( pArray );
728 refParams->Put( pArrayVar, nParamCount );
734 // execute a P-Code
736 bool SbiRuntime::Step()
738 if( bRun )
740 // in any case check casually!
741 if( !( ++nOps & 0xF ) && pInst->IsReschedule() )
743 sal_uInt32 nTime = osl_getGlobalTimer();
744 if (nTime - m_nLastTime > 5 ) // 20 ms
746 Application::Reschedule();
747 m_nLastTime = nTime;
751 // #i48868 blocked by next call level?
752 while( bBlocked )
754 if( pInst->IsReschedule() )
756 Application::Reschedule();
760 SbiOpcode eOp = static_cast<SbiOpcode>( *pCode++ );
761 sal_uInt32 nOp1, nOp2;
762 if (eOp <= SbiOpcode::SbOP0_END)
764 (this->*( aStep0[ int(eOp) ] ) )();
766 else if (eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END)
768 nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
770 (this->*( aStep1[ int(eOp) - int(SbiOpcode::SbOP1_START) ] ) )( nOp1 );
772 else if (eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END)
774 nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
775 nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24;
776 (this->*( aStep2[ int(eOp) - int(SbiOpcode::SbOP2_START) ] ) )( nOp1, nOp2 );
778 else
780 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
783 ErrCode nErrCode = SbxBase::GetError();
784 Error( nErrCode.IgnoreWarning() );
786 // from 13.2.1997, new error handling:
787 // ATTENTION: nError can be set already even if !nErrCode
788 // since nError can now also be set from other RT-instances
790 if( nError )
792 SbxBase::ResetError();
795 // from 15.3.96: display errors only if BASIC is still active
796 // (especially not after compiler errors at the runtime)
797 if( nError && bRun )
799 ErrCode err = nError;
800 ClearExprStack();
801 nError = ERRCODE_NONE;
802 pInst->nErr = err;
803 pInst->nErl = nLine;
804 pErrCode = pCode;
805 pErrStmnt = pStmnt;
806 // An error occurred in an error handler
807 // force parent handler ( if there is one )
808 // to handle the error
809 bool bLetParentHandleThis = false;
811 // in the error handler? so std-error
812 if ( !bInError )
814 bInError = true;
816 if( !bError ) // On Error Resume Next
818 StepRESUME( 1 );
820 else if( pError ) // On Error Goto ...
822 pCode = pError;
824 else
826 bLetParentHandleThis = true;
829 else
831 bLetParentHandleThis = true;
832 pError = nullptr; //terminate the handler
834 if ( bLetParentHandleThis )
836 // from 13.2.1997, new error handling:
837 // consider superior error handlers
839 // there's no error handler -> find one farther above
840 SbiRuntime* pRtErrHdl = nullptr;
841 SbiRuntime* pRt = this;
842 while( (pRt = pRt->pNext) != nullptr )
844 if( !pRt->bError || pRt->pError != nullptr )
846 pRtErrHdl = pRt;
847 break;
852 if( pRtErrHdl )
854 // manipulate all the RTs that are below in the call-stack
855 pRt = this;
858 pRt->nError = err;
859 if( pRt != pRtErrHdl )
861 pRt->bRun = false;
863 else
865 break;
867 pRt = pRt->pNext;
869 while( pRt );
871 // no error-hdl found -> old behaviour
872 else
874 pInst->Abort();
879 return bRun;
882 void SbiRuntime::Error( ErrCode n, bool bVBATranslationAlreadyDone )
884 if( n )
886 nError = n;
887 if( isVBAEnabled() && !bVBATranslationAlreadyDone )
889 OUString aMsg = pInst->GetErrorMsg();
890 sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
891 SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject().get();
892 SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
893 if( pGlobErr != nullptr )
895 pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
897 pInst->aErrorMsg = aMsg;
898 nError = ERRCODE_BASIC_COMPAT;
903 void SbiRuntime::Error( ErrCode _errCode, const OUString& _details )
905 if ( _errCode )
907 // Not correct for class module usage, remove for now
908 //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" );
909 if ( pInst->pRun == this )
911 pInst->Error( _errCode, _details );
912 //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" );
914 else
916 nError = _errCode;
921 void SbiRuntime::FatalError( ErrCode n )
923 StepSTDERROR();
924 Error( n );
927 void SbiRuntime::FatalError( ErrCode _errCode, const OUString& _details )
929 StepSTDERROR();
930 Error( _errCode, _details );
933 sal_Int32 SbiRuntime::translateErrorToVba( ErrCode nError, OUString& rMsg )
935 // If a message is defined use that ( in preference to
936 // the defined one for the error ) NB #TODO
937 // if there is an error defined it more than likely
938 // is not the one you want ( some are the same though )
939 // we really need a new vba compatible error list
940 if ( rMsg.isEmpty() )
942 StarBASIC::MakeErrorText( nError, rMsg );
943 rMsg = StarBASIC::GetErrorText();
944 if ( rMsg.isEmpty() ) // no message for err no, need localized resource here
946 rMsg = "Internal Object Error:";
949 // no num? most likely then it *is* really a vba err
950 sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
951 sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? sal_uInt32(nError) : nVBErrorCode;
952 return nVBAErrorNumber;
955 // Stacks
957 // The expression-stack is available for the continuous evaluation
958 // of expressions.
960 void SbiRuntime::PushVar( SbxVariable* pVar )
962 if( pVar )
964 refExprStk->Put( pVar, nExprLvl++ );
968 SbxVariableRef SbiRuntime::PopVar()
970 #ifdef DBG_UTIL
971 if( !nExprLvl )
973 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
974 return new SbxVariable;
976 #endif
977 SbxVariableRef xVar = refExprStk->Get( --nExprLvl );
978 SAL_INFO_IF( xVar->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
979 // methods hold themselves in parameter 0
980 if( dynamic_cast<const SbxMethod *>(xVar.get()) != nullptr )
982 xVar->SetParameters(nullptr);
984 return xVar;
987 void SbiRuntime::ClearExprStack()
989 // Attention: Clear() doesn't suffice as methods must be deleted
990 while ( nExprLvl )
992 PopVar();
994 refExprStk->Clear();
997 // Take variable from the expression-stack without removing it
998 // n counts from 0
1000 SbxVariable* SbiRuntime::GetTOS()
1002 short n = nExprLvl - 1;
1003 #ifdef DBG_UTIL
1004 if( n < 0 )
1006 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1007 return new SbxVariable;
1009 #endif
1010 return refExprStk->Get( static_cast<sal_uInt16>(n) );
1014 void SbiRuntime::TOSMakeTemp()
1016 SbxVariable* p = refExprStk->Get( nExprLvl - 1 );
1017 if ( p->GetType() == SbxEMPTY )
1019 p->Broadcast( SfxHintId::BasicDataWanted );
1022 SbxVariable* pDflt = nullptr;
1023 if ( bVBAEnabled && ( p->GetType() == SbxOBJECT || p->GetType() == SbxVARIANT ) && ((pDflt = getDefaultProp(p)) != nullptr) )
1025 pDflt->Broadcast( SfxHintId::BasicDataWanted );
1026 // replacing new p on stack causes object pointed by
1027 // pDft->pParent to be deleted, when p2->Compute() is
1028 // called below pParent is accessed (but it's deleted)
1029 // so set it to NULL now
1030 pDflt->SetParent( nullptr );
1031 p = new SbxVariable( *pDflt );
1032 p->SetFlag( SbxFlagBits::ReadWrite );
1033 refExprStk->Put( p, nExprLvl - 1 );
1035 else if( p->GetRefCount() != 1 )
1037 SbxVariable* pNew = new SbxVariable( *p );
1038 pNew->SetFlag( SbxFlagBits::ReadWrite );
1039 refExprStk->Put( pNew, nExprLvl - 1 );
1043 // the GOSUB-stack collects return-addresses for GOSUBs
1044 void SbiRuntime::PushGosub( const sal_uInt8* pc )
1046 if( pGosubStk.size() >= MAXRECURSION )
1048 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
1050 pGosubStk.emplace_back(pc, nForLvl);
1053 void SbiRuntime::PopGosub()
1055 if( pGosubStk.empty() )
1057 Error( ERRCODE_BASIC_NO_GOSUB );
1059 else
1061 pCode = pGosubStk.back().pCode;
1062 pGosubStk.pop_back();
1066 // the Argv-stack collects current argument-vectors
1068 void SbiRuntime::PushArgv()
1070 pArgvStk.emplace_back(refArgv, nArgc);
1071 nArgc = 1;
1072 refArgv.clear();
1075 void SbiRuntime::PopArgv()
1077 if( !pArgvStk.empty() )
1079 refArgv = pArgvStk.back().refArgv;
1080 nArgc = pArgvStk.back().nArgc;
1081 pArgvStk.pop_back();
1086 void SbiRuntime::ClearArgvStack()
1088 while( !pArgvStk.empty() )
1090 PopArgv();
1094 // Push of the for-stack. The stack has increment, end, begin and variable.
1095 // After the creation of the stack-element the stack's empty.
1097 void SbiRuntime::PushFor()
1099 SbiForStack* p = new SbiForStack;
1100 p->eForType = ForType::To;
1101 p->pNext = pForStk;
1102 pForStk = p;
1104 p->refInc = PopVar();
1105 p->refEnd = PopVar();
1106 SbxVariableRef xBgn = PopVar();
1107 p->refVar = PopVar();
1108 *(p->refVar) = *xBgn;
1109 nForLvl++;
1112 void SbiRuntime::PushForEach()
1114 SbiForStack* p = new SbiForStack;
1115 p->pNext = pForStk;
1116 pForStk = p;
1118 SbxVariableRef xObjVar = PopVar();
1119 SbxBase* pObj = xObjVar.is() ? xObjVar->GetObject() : nullptr;
1120 if( pObj == nullptr )
1122 Error( ERRCODE_BASIC_NO_OBJECT );
1123 return;
1126 bool bError_ = false;
1127 if (SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj))
1129 p->eForType = ForType::EachArray;
1130 p->refEnd = reinterpret_cast<SbxVariable*>(pArray);
1132 short nDims = pArray->GetDims();
1133 p->pArrayLowerBounds.reset( new sal_Int32[nDims] );
1134 p->pArrayUpperBounds.reset( new sal_Int32[nDims] );
1135 p->pArrayCurIndices.reset( new sal_Int32[nDims] );
1136 sal_Int32 lBound, uBound;
1137 for( short i = 0 ; i < nDims ; i++ )
1139 pArray->GetDim32( i+1, lBound, uBound );
1140 p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
1141 p->pArrayUpperBounds[i] = uBound;
1144 else if (BasicCollection* pCollection = dynamic_cast<BasicCollection*>(pObj))
1146 p->eForType = ForType::EachCollection;
1147 p->refEnd = pCollection;
1148 p->nCurCollectionIndex = 0;
1150 else if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
1152 // XEnumerationAccess?
1153 Any aAny = pUnoObj->getUnoAny();
1154 Reference< XEnumerationAccess > xEnumerationAccess;
1155 if( aAny >>= xEnumerationAccess )
1157 p->xEnumeration = xEnumerationAccess->createEnumeration();
1158 p->eForType = ForType::EachXEnumeration;
1160 else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
1162 uno::Reference< script::XInvocation > xInvocation;
1163 if ( ( aAny >>= xInvocation ) && xInvocation.is() )
1167 p->xEnumeration = new ComEnumerationWrapper( xInvocation );
1168 p->eForType = ForType::EachXEnumeration;
1170 catch(const uno::Exception& )
1173 if ( !p->xEnumeration.is() )
1175 bError_ = true;
1178 else
1180 bError_ = true;
1183 else
1185 bError_ = true;
1188 if( bError_ )
1190 Error( ERRCODE_BASIC_CONVERSION );
1191 return;
1194 // Container variable
1195 p->refVar = PopVar();
1196 nForLvl++;
1200 void SbiRuntime::PopFor()
1202 if( pForStk )
1204 SbiForStack* p = pForStk;
1205 pForStk = p->pNext;
1206 delete p;
1207 nForLvl--;
1212 void SbiRuntime::ClearForStack()
1214 while( pForStk )
1216 PopFor();
1220 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection const * pCollection )
1222 for (SbiForStack *p = pForStk; p; p = p->pNext)
1224 SbxVariable* pVar = p->refEnd.is() ? p->refEnd.get() : nullptr;
1225 if( p->eForType == ForType::EachCollection
1226 && pVar != nullptr
1227 && dynamic_cast<BasicCollection*>( pVar) == pCollection )
1229 return p;
1233 return nullptr;
1237 // DLL-calls
1239 void SbiRuntime::DllCall
1240 ( const OUString& aFuncName,
1241 const OUString& aDLLName,
1242 SbxArray* pArgs, // parameter (from index 1, can be NULL)
1243 SbxDataType eResType, // return value
1244 bool bCDecl ) // true: according to C-conventions
1246 // NOT YET IMPLEMENTED
1248 SbxVariable* pRes = new SbxVariable( eResType );
1249 SbiDllMgr* pDllMgr = pInst->GetDllMgr();
1250 ErrCode nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
1251 if( nErr )
1253 Error( nErr );
1255 PushVar( pRes );
1258 bool SbiRuntime::IsImageFlag( SbiImageFlags n ) const
1260 return pImg->IsFlag( n );
1263 sal_uInt16 SbiRuntime::GetBase() const
1265 return pImg->GetBase();
1268 void SbiRuntime::StepNOP()
1271 void SbiRuntime::StepArith( SbxOperator eOp )
1273 SbxVariableRef p1 = PopVar();
1274 TOSMakeTemp();
1275 SbxVariable* p2 = GetTOS();
1277 p2->ResetFlag( SbxFlagBits::Fixed );
1278 p2->Compute( eOp, *p1 );
1280 checkArithmeticOverflow( p2 );
1283 void SbiRuntime::StepUnary( SbxOperator eOp )
1285 TOSMakeTemp();
1286 SbxVariable* p = GetTOS();
1287 p->Compute( eOp, *p );
1290 void SbiRuntime::StepCompare( SbxOperator eOp )
1292 SbxVariableRef p1 = PopVar();
1293 SbxVariableRef p2 = PopVar();
1295 // Make sure objects with default params have
1296 // values ( and type ) set as appropriate
1297 SbxDataType p1Type = p1->GetType();
1298 SbxDataType p2Type = p2->GetType();
1299 if ( p1Type == SbxEMPTY )
1301 p1->Broadcast( SfxHintId::BasicDataWanted );
1302 p1Type = p1->GetType();
1304 if ( p2Type == SbxEMPTY )
1306 p2->Broadcast( SfxHintId::BasicDataWanted );
1307 p2Type = p2->GetType();
1309 if ( p1Type == p2Type )
1311 // if both sides are an object and have default props
1312 // then we need to use the default props
1313 // we don't need to worry if only one side ( lhs, rhs ) is an
1314 // object ( object side will get coerced to correct type in
1315 // Compare )
1316 if ( p1Type == SbxOBJECT )
1318 SbxVariable* pDflt = getDefaultProp( p1.get() );
1319 if ( pDflt )
1321 p1 = pDflt;
1322 p1->Broadcast( SfxHintId::BasicDataWanted );
1324 pDflt = getDefaultProp( p2.get() );
1325 if ( pDflt )
1327 p2 = pDflt;
1328 p2->Broadcast( SfxHintId::BasicDataWanted );
1333 static SbxVariable* pTRUE = nullptr;
1334 static SbxVariable* pFALSE = nullptr;
1335 // why do this on non-windows ?
1336 // why do this at all ?
1337 // I dumbly follow the pattern :-/
1338 if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
1340 static SbxVariable* pNULL = [&]() {
1341 SbxVariable* p = new SbxVariable;
1342 p->PutNull();
1343 p->AddFirstRef();
1344 return p;
1345 }();
1346 PushVar( pNULL );
1348 else if( p2->Compare( eOp, *p1 ) )
1350 if( !pTRUE )
1352 pTRUE = new SbxVariable;
1353 pTRUE->PutBool( true );
1354 pTRUE->AddFirstRef();
1356 PushVar( pTRUE );
1358 else
1360 if( !pFALSE )
1362 pFALSE = new SbxVariable;
1363 pFALSE->PutBool( false );
1364 pFALSE->AddFirstRef();
1366 PushVar( pFALSE );
1370 void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
1371 void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
1372 void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
1373 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
1374 void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
1375 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
1376 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
1377 void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
1378 void SbiRuntime::StepAND() { StepArith( SbxAND ); }
1379 void SbiRuntime::StepOR() { StepArith( SbxOR ); }
1380 void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
1381 void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
1382 void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
1384 void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
1385 void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
1387 void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
1388 void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
1389 void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
1390 void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
1391 void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
1392 void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
1394 namespace
1396 bool NeedEsc(sal_Unicode cCode)
1398 if(!rtl::isAscii(cCode))
1400 return false;
1402 switch(cCode)
1404 case '.':
1405 case '^':
1406 case '$':
1407 case '+':
1408 case '\\':
1409 case '|':
1410 case '{':
1411 case '}':
1412 case '(':
1413 case ')':
1414 return true;
1415 default:
1416 return false;
1420 OUString VBALikeToRegexp(const OUString &rIn)
1422 OUStringBuffer sResult;
1423 const sal_Unicode *start = rIn.getStr();
1424 const sal_Unicode *end = start + rIn.getLength();
1426 int seenright = 0;
1428 sResult.append('^');
1430 while (start < end)
1432 switch (*start)
1434 case '?':
1435 sResult.append('.');
1436 start++;
1437 break;
1438 case '*':
1439 sResult.append(".*");
1440 start++;
1441 break;
1442 case '#':
1443 sResult.append("[0-9]");
1444 start++;
1445 break;
1446 case ']':
1447 sResult.append('\\');
1448 sResult.append(*start++);
1449 break;
1450 case '[':
1451 sResult.append(*start++);
1452 seenright = 0;
1453 while (start < end && !seenright)
1455 switch (*start)
1457 case '[':
1458 case '?':
1459 case '*':
1460 sResult.append('\\');
1461 sResult.append(*start);
1462 break;
1463 case ']':
1464 sResult.append(*start);
1465 seenright = 1;
1466 break;
1467 case '!':
1468 sResult.append('^');
1469 break;
1470 default:
1471 if (NeedEsc(*start))
1473 sResult.append('\\');
1475 sResult.append(*start);
1476 break;
1478 start++;
1480 break;
1481 default:
1482 if (NeedEsc(*start))
1484 sResult.append('\\');
1486 sResult.append(*start++);
1490 sResult.append('$');
1492 return sResult.makeStringAndClear();
1496 void SbiRuntime::StepLIKE()
1498 SbxVariableRef refVar1 = PopVar();
1499 SbxVariableRef refVar2 = PopVar();
1501 OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
1502 OUString value = refVar2->GetOUString();
1504 i18nutil::SearchOptions2 aSearchOpt;
1506 aSearchOpt.AlgorithmType2 = css::util::SearchAlgorithms2::REGEXP;
1508 aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
1509 aSearchOpt.searchString = pattern;
1511 bool bTextMode(true);
1512 bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
1513 if( bCompatibility )
1515 bTextMode = IsImageFlag( SbiImageFlags::COMPARETEXT );
1517 if( bTextMode )
1519 aSearchOpt.transliterateFlags |= TransliterationFlags::IGNORE_CASE;
1521 SbxVariable* pRes = new SbxVariable;
1522 utl::TextSearch aSearch( aSearchOpt);
1523 sal_Int32 nStart=0, nEnd=value.getLength();
1524 bool bRes = aSearch.SearchForward(value, &nStart, &nEnd);
1525 pRes->PutBool( bRes );
1527 PushVar( pRes );
1530 // TOS and TOS-1 are both object variables and contain the same pointer
1532 void SbiRuntime::StepIS()
1534 SbxVariableRef refVar1 = PopVar();
1535 SbxVariableRef refVar2 = PopVar();
1537 SbxDataType eType1 = refVar1->GetType();
1538 SbxDataType eType2 = refVar2->GetType();
1539 if ( eType1 == SbxEMPTY )
1541 refVar1->Broadcast( SfxHintId::BasicDataWanted );
1542 eType1 = refVar1->GetType();
1544 if ( eType2 == SbxEMPTY )
1546 refVar2->Broadcast( SfxHintId::BasicDataWanted );
1547 eType2 = refVar2->GetType();
1550 bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
1551 if ( bVBAEnabled && !bRes )
1553 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1555 bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
1556 SbxVariable* pRes = new SbxVariable;
1557 pRes->PutBool( bRes );
1558 PushVar( pRes );
1561 // update the value of TOS
1563 void SbiRuntime::StepGET()
1565 SbxVariable* p = GetTOS();
1566 p->Broadcast( SfxHintId::BasicDataWanted );
1569 // #67607 copy Uno-Structs
1570 static bool checkUnoStructCopy( bool bVBA, SbxVariableRef const & refVal, SbxVariableRef const & refVar )
1572 SbxDataType eVarType = refVar->GetType();
1573 SbxDataType eValType = refVal->GetType();
1575 if ( ( bVBA && ( eVarType == SbxEMPTY ) ) || !refVar->CanWrite() )
1576 return false;
1578 if ( eValType != SbxOBJECT )
1579 return false;
1580 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1581 // there :-/ not sure if for every '=' we would want struct handling
1582 if( eVarType != SbxOBJECT )
1584 if ( refVar->IsFixed() )
1585 return false;
1587 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1588 else if( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr )
1589 return false;
1591 SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject());
1592 if( !xValObj.is() || dynamic_cast<const SbUnoAnyObject*>( xValObj.get() ) != nullptr )
1593 return false;
1595 SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() );
1596 SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() );
1597 Any aAny;
1598 // make doubly sure value is either a Uno object or
1599 // a uno struct
1600 if ( pUnoVal || pUnoStructVal )
1601 aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
1602 else
1603 return false;
1604 if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
1606 refVar->SetType( SbxOBJECT );
1607 ErrCode eOldErr = SbxBase::GetError();
1608 // There are some circumstances when calling GetObject
1609 // will trigger an error, we need to squash those here.
1610 // Alternatively it is possible that the same scenario
1611 // could overwrite and existing error. Lets prevent that
1612 SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject());
1613 if ( eOldErr != ERRCODE_NONE )
1614 SbxBase::SetError( eOldErr );
1615 else
1616 SbxBase::ResetError();
1618 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( xVarObj.get() );
1620 OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
1621 OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
1623 if ( pUnoStructObj )
1625 StructRefInfo aInfo = pUnoStructObj->getStructInfo();
1626 aInfo.setValue( aAny );
1628 else
1630 SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
1631 // #70324: adopt ClassName
1632 pNewUnoObj->SetClassName( sClassName );
1633 refVar->PutObject( pNewUnoObj );
1635 return true;
1637 return false;
1641 // laying down TOS in TOS-1
1643 void SbiRuntime::StepPUT()
1645 SbxVariableRef refVal = PopVar();
1646 SbxVariableRef refVar = PopVar();
1647 // store on its own method (inside a function)?
1648 bool bFlagsChanged = false;
1649 SbxFlagBits n = SbxFlagBits::NONE;
1650 if( refVar.get() == pMeth )
1652 bFlagsChanged = true;
1653 n = refVar->GetFlags();
1654 refVar->SetFlag( SbxFlagBits::Write );
1657 // if left side arg is an object or variant and right handside isn't
1658 // either an object or a variant then try and see if a default
1659 // property exists.
1660 // to use e.g. Range{"A1") = 34
1661 // could equate to Range("A1").Value = 34
1662 if ( bVBAEnabled )
1664 // yet more hacking at this, I feel we don't quite have the correct
1665 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1666 // obj1 ) has default member/property ) ) It seems that default props
1667 // aren't dealt with if the object is a member of some parent object
1668 bool bObjAssign = false;
1669 if ( refVar->GetType() == SbxEMPTY )
1670 refVar->Broadcast( SfxHintId::BasicDataWanted );
1671 if ( refVar->GetType() == SbxOBJECT )
1673 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
1675 SbxVariable* pDflt = getDefaultProp( refVar.get() );
1677 if ( pDflt )
1678 refVar = pDflt;
1680 else
1681 bObjAssign = true;
1683 if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( dynamic_cast<const SbxMethod *>(refVal.get()) != nullptr || ! refVal->GetParent() ) )
1685 SbxVariable* pDflt = getDefaultProp( refVal.get() );
1686 if ( pDflt )
1687 refVal = pDflt;
1691 if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
1692 *refVar = *refVal;
1694 if( bFlagsChanged )
1695 refVar->SetFlags( n );
1699 // VBA Dim As New behavior handling, save init object information
1700 struct DimAsNewRecoverItem
1702 OUString m_aObjClass;
1703 OUString m_aObjName;
1704 SbxObject* m_pObjParent;
1705 SbModule* m_pClassModule;
1707 DimAsNewRecoverItem()
1708 : m_pObjParent( nullptr )
1709 , m_pClassModule( nullptr )
1712 DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
1713 SbxObject* pObjParent, SbModule* pClassModule )
1714 : m_aObjClass( rObjClass )
1715 , m_aObjName( rObjName )
1716 , m_pObjParent( pObjParent )
1717 , m_pClassModule( pClassModule )
1723 struct SbxVariablePtrHash
1725 size_t operator()( SbxVariable* pVar ) const
1726 { return reinterpret_cast<size_t>(pVar); }
1729 typedef std::unordered_map< SbxVariable*, DimAsNewRecoverItem,
1730 SbxVariablePtrHash > DimAsNewRecoverHash;
1732 class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
1734 void removeDimAsNewRecoverItem( SbxVariable* pVar )
1736 DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1737 DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
1738 if( it != rDimAsNewRecoverHash.end() )
1740 rDimAsNewRecoverHash.erase( it );
1745 // saving object variable
1746 // not-object variables will cause errors
1748 static const char pCollectionStr[] = "Collection";
1750 void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
1752 // #67733 types with array-flag are OK too
1754 // Check var, !object is no error for sure if, only if type is fixed
1755 SbxDataType eVarType = refVar->GetType();
1756 if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
1758 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1759 return;
1762 // Check value, !object is no error for sure if, only if type is fixed
1763 SbxDataType eValType = refVal->GetType();
1764 if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
1766 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1767 return;
1770 // Getting in here causes problems with objects with default properties
1771 // if they are SbxEMPTY I guess
1772 if ( !bHandleDefaultProp || eValType == SbxOBJECT )
1774 // activate GetObject for collections on refVal
1775 SbxBase* pObjVarObj = refVal->GetObject();
1776 if( pObjVarObj )
1778 SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj );
1780 if( refObjVal.is() )
1782 refVal = refObjVal;
1784 else if( !(eValType & SbxARRAY) )
1786 refVal = nullptr;
1791 // #52896 refVal can be invalid here, if uno-sequences - or more
1792 // general arrays - are assigned to variables that are declared
1793 // as an object!
1794 if( !refVal.is() )
1796 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1798 else
1800 bool bFlagsChanged = false;
1801 SbxFlagBits n = SbxFlagBits::NONE;
1802 if( refVar.get() == pMeth )
1804 bFlagsChanged = true;
1805 n = refVar->GetFlags();
1806 refVar->SetFlag( SbxFlagBits::Write );
1808 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() );
1809 if( pProcProperty )
1811 pProcProperty->setSet( true );
1813 if ( bHandleDefaultProp )
1815 // get default properties for lhs & rhs where necessary
1816 // SbxVariable* defaultProp = NULL; unused variable
1817 // LHS try determine if a default prop exists
1818 // again like in StepPUT (see there too ) we are tweaking the
1819 // heuristics again for when to assign an object reference or
1820 // use default members if they exist
1821 // #FIXME we really need to get to the bottom of this mess
1822 bool bObjAssign = false;
1823 if ( refVar->GetType() == SbxOBJECT )
1825 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
1827 SbxVariable* pDflt = getDefaultProp( refVar.get() );
1828 if ( pDflt )
1830 refVar = pDflt;
1833 else
1834 bObjAssign = true;
1836 // RHS only get a default prop is the rhs has one
1837 if ( refVal->GetType() == SbxOBJECT )
1839 // check if lhs is a null object
1840 // if it is then use the object not the default property
1841 SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() );
1843 // calling GetObject on a SbxEMPTY variable raises
1844 // object not set errors, make sure it's an Object
1845 if ( !pObj && refVar->GetType() == SbxOBJECT )
1847 SbxBase* pObjVarObj = refVar->GetObject();
1848 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
1850 SbxVariable* pDflt = nullptr;
1851 if ( pObj && !bObjAssign )
1853 // lhs is either a valid object || or has a defaultProp
1854 pDflt = getDefaultProp( refVal.get() );
1856 if ( pDflt )
1858 refVal = pDflt;
1863 // Handle Dim As New
1864 bool bDimAsNew = bVBAEnabled && refVar->IsSet( SbxFlagBits::DimAsNew );
1865 SbxBaseRef xPrevVarObj;
1866 if( bDimAsNew )
1868 xPrevVarObj = refVar->GetObject();
1870 // Handle withevents
1871 bool bWithEvents = refVar->IsSet( SbxFlagBits::WithEvents );
1872 if ( bWithEvents )
1874 Reference< XInterface > xComListener;
1876 SbxBase* pObj = refVal->GetObject();
1877 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
1878 if( pUnoObj != nullptr )
1880 Any aControlAny = pUnoObj->getUnoAny();
1881 OUString aDeclareClassName = refVar->GetDeclareClassName();
1882 OUString aPrefix = refVar->GetName();
1883 SbxObjectRef xScopeObj = refVar->GetParent();
1884 xComListener = createComListener( aControlAny, aDeclareClassName, aPrefix, xScopeObj );
1886 refVal->SetDeclareClassName( aDeclareClassName );
1887 refVal->SetComListener( xComListener, &rBasic ); // Hold reference
1892 // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1893 // in this case if there is a default prop involved the value of the
1894 // default property may in fact be void so the type will also be SbxEMPTY
1895 // in this case we do not want to call checkUnoStructCopy 'cause that will
1896 // cause an error also
1897 if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
1899 *refVar = *refVal;
1901 if ( bDimAsNew )
1903 if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr )
1905 SbxBase* pValObjBase = refVal->GetObject();
1906 if( pValObjBase == nullptr )
1908 if( xPrevVarObj.is() )
1910 // Object is overwritten with NULL, instantiate init object
1911 DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1912 DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar.get() );
1913 if( it != rDimAsNewRecoverHash.end() )
1915 const DimAsNewRecoverItem& rItem = it->second;
1916 if( rItem.m_pClassModule != nullptr )
1918 SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
1919 pNewObj->SetName( rItem.m_aObjName );
1920 pNewObj->SetParent( rItem.m_pObjParent );
1921 refVar->PutObject( pNewObj );
1923 else if( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) )
1925 BasicCollection* pNewCollection = new BasicCollection( pCollectionStr );
1926 pNewCollection->SetName( rItem.m_aObjName );
1927 pNewCollection->SetParent( rItem.m_pObjParent );
1928 refVar->PutObject( pNewCollection );
1933 else
1935 // Does old value exist?
1936 bool bFirstInit = !xPrevVarObj.is();
1937 if( bFirstInit )
1939 // Store information to instantiate object later
1940 SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase );
1941 if( pValObj != nullptr )
1943 OUString aObjClass = pValObj->GetClassName();
1945 SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pValObjBase );
1946 DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1947 if( pClassModuleObj != nullptr )
1949 SbModule* pClassModule = pClassModuleObj->getClassModule();
1950 rDimAsNewRecoverHash[refVar.get()] =
1951 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
1953 else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
1955 rDimAsNewRecoverHash[refVar.get()] =
1956 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), nullptr );
1964 if( bFlagsChanged )
1966 refVar->SetFlags( n );
1971 void SbiRuntime::StepSET()
1973 SbxVariableRef refVal = PopVar();
1974 SbxVariableRef refVar = PopVar();
1975 StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assignment
1978 void SbiRuntime::StepVBASET()
1980 SbxVariableRef refVal = PopVar();
1981 SbxVariableRef refVar = PopVar();
1982 // don't handle default property
1983 StepSET_Impl( refVal, refVar ); // set obj = something
1987 void SbiRuntime::StepLSET()
1989 SbxVariableRef refVal = PopVar();
1990 SbxVariableRef refVar = PopVar();
1991 if( refVar->GetType() != SbxSTRING ||
1992 refVal->GetType() != SbxSTRING )
1994 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1996 else
1998 SbxFlagBits n = refVar->GetFlags();
1999 if( refVar.get() == pMeth )
2001 refVar->SetFlag( SbxFlagBits::Write );
2003 OUString aRefVarString = refVar->GetOUString();
2004 OUString aRefValString = refVal->GetOUString();
2006 sal_Int32 nVarStrLen = aRefVarString.getLength();
2007 sal_Int32 nValStrLen = aRefValString.getLength();
2008 OUString aNewStr;
2009 if( nVarStrLen > nValStrLen )
2011 OUStringBuffer buf(aRefValString);
2012 comphelper::string::padToLength(buf, nVarStrLen, ' ');
2013 aNewStr = buf.makeStringAndClear();
2015 else
2017 aNewStr = aRefValString.copy( 0, nVarStrLen );
2020 refVar->PutString(aNewStr);
2021 refVar->SetFlags( n );
2025 void SbiRuntime::StepRSET()
2027 SbxVariableRef refVal = PopVar();
2028 SbxVariableRef refVar = PopVar();
2029 if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
2031 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
2033 else
2035 SbxFlagBits n = refVar->GetFlags();
2036 if( refVar.get() == pMeth )
2038 refVar->SetFlag( SbxFlagBits::Write );
2040 OUString aRefVarString = refVar->GetOUString();
2041 OUString aRefValString = refVal->GetOUString();
2042 sal_Int32 nVarStrLen = aRefVarString.getLength();
2043 sal_Int32 nValStrLen = aRefValString.getLength();
2045 OUStringBuffer aNewStr(nVarStrLen);
2046 if (nVarStrLen > nValStrLen)
2048 comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
2049 aNewStr.append(aRefValString);
2051 else
2053 aNewStr.append(std::u16string_view(aRefValString).substr(0, nVarStrLen));
2055 refVar->PutString(aNewStr.makeStringAndClear());
2057 refVar->SetFlags( n );
2061 // laying down TOS in TOS-1, then set ReadOnly-Bit
2063 void SbiRuntime::StepPUTC()
2065 SbxVariableRef refVal = PopVar();
2066 SbxVariableRef refVar = PopVar();
2067 refVar->SetFlag( SbxFlagBits::Write );
2068 *refVar = *refVal;
2069 refVar->ResetFlag( SbxFlagBits::Write );
2070 refVar->SetFlag( SbxFlagBits::Const );
2073 // DIM
2074 // TOS = variable for the array with dimension information as parameter
2076 void SbiRuntime::StepDIM()
2078 SbxVariableRef refVar = PopVar();
2079 DimImpl( refVar );
2082 // #56204 swap out DIM-functionality into a help method (step0.cxx)
2083 void SbiRuntime::DimImpl(const SbxVariableRef& refVar)
2085 // If refDim then this DIM statement is terminating a ReDIM and
2086 // previous StepERASE_CLEAR for an array, the following actions have
2087 // been delayed from ( StepERASE_CLEAR ) 'till here
2088 if ( refRedim.is() )
2090 if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve
2092 lcl_eraseImpl( refVar, bVBAEnabled );
2094 SbxDataType eType = refVar->GetType();
2095 lcl_clearImpl( refVar, eType );
2096 refRedim = nullptr;
2098 SbxArray* pDims = refVar->GetParameters();
2099 // must have an even number of arguments
2100 // have in mind that Arg[0] does not count!
2101 if( pDims && !( pDims->Count() & 1 ) )
2103 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2105 else
2107 SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
2108 SbxDimArray* pArray = new SbxDimArray( eType );
2109 // allow arrays without dimension information, too (VB-compatible)
2110 if( pDims )
2112 refVar->ResetFlag( SbxFlagBits::VarToDim );
2114 for( sal_uInt16 i = 1; i < pDims->Count(); )
2116 sal_Int32 lb = pDims->Get( i++ )->GetLong();
2117 sal_Int32 ub = pDims->Get( i++ )->GetLong();
2118 if( ub < lb )
2120 Error( ERRCODE_BASIC_OUT_OF_RANGE );
2121 ub = lb;
2123 pArray->AddDim32( lb, ub );
2124 if ( lb != ub )
2126 pArray->setHasFixedSize( true );
2130 else
2132 // #62867 On creating an array of the length 0, create
2133 // a dimension (like for Uno-Sequences of the length 0)
2134 pArray->unoAddDim( 0, -1 );
2136 SbxFlagBits nSavFlags = refVar->GetFlags();
2137 refVar->ResetFlag( SbxFlagBits::Fixed );
2138 refVar->PutObject( pArray );
2139 refVar->SetFlags( nSavFlags );
2140 refVar->SetParameters( nullptr );
2144 // REDIM
2145 // TOS = variable for the array
2146 // argv = dimension information
2148 void SbiRuntime::StepREDIM()
2150 // Nothing different than dim at the moment because
2151 // a double dim is already recognized by the compiler.
2152 StepDIM();
2156 // Helper function for StepREDIMP
2157 static void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
2158 short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
2160 sal_Int32& ri = pActualIndices[nActualDim];
2161 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
2163 if( nActualDim < nMaxDimIndex )
2165 implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
2166 pActualIndices, pLowerBounds, pUpperBounds );
2168 else
2170 SbxVariable* pSource = pOldArray->Get32( pActualIndices );
2171 SbxVariable* pDest = pNewArray->Get32( pActualIndices );
2172 if( pSource && pDest )
2174 *pDest = *pSource;
2180 // REDIM PRESERVE
2181 // TOS = variable for the array
2182 // argv = dimension information
2184 void SbiRuntime::StepREDIMP()
2186 SbxVariableRef refVar = PopVar();
2187 DimImpl( refVar );
2189 // Now check, if we can copy from the old array
2190 if( refRedimpArray.is() )
2192 SbxBase* pElemObj = refVar->GetObject();
2193 SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>( pElemObj );
2194 SbxDimArray* pOldArray = static_cast<SbxDimArray*>(refRedimpArray.get());
2195 if( pNewArray )
2197 short nDimsNew = pNewArray->GetDims();
2198 short nDimsOld = pOldArray->GetDims();
2199 short nDims = nDimsNew;
2201 if( nDimsOld != nDimsNew )
2203 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
2205 else if (nDims > 0)
2207 // Store dims to use them for copying later
2208 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDims]);
2209 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDims]);
2210 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDims]);
2212 // Compare bounds
2213 for( short i = 1 ; i <= nDims ; i++ )
2215 sal_Int32 lBoundNew, uBoundNew;
2216 sal_Int32 lBoundOld, uBoundOld;
2217 pNewArray->GetDim32( i, lBoundNew, uBoundNew );
2218 pOldArray->GetDim32( i, lBoundOld, uBoundOld );
2219 lBoundNew = std::max( lBoundNew, lBoundOld );
2220 uBoundNew = std::min( uBoundNew, uBoundOld );
2221 short j = i - 1;
2222 pActualIndices[j] = pLowerBounds[j] = lBoundNew;
2223 pUpperBounds[j] = uBoundNew;
2225 // Copy data from old array by going recursively through all dimensions
2226 // (It would be faster to work on the flat internal data array of an
2227 // SbyArray but this solution is clearer and easier)
2228 implCopyDimArray( pNewArray, pOldArray, nDims - 1,
2229 0, pActualIndices.get(), pLowerBounds.get(), pUpperBounds.get() );
2232 refRedimpArray = nullptr;
2238 // REDIM_COPY
2239 // TOS = Array-Variable, Reference to array is copied
2240 // Variable is cleared as in ERASE
2242 void SbiRuntime::StepREDIMP_ERASE()
2244 SbxVariableRef refVar = PopVar();
2245 refRedim = refVar;
2246 SbxDataType eType = refVar->GetType();
2247 if( eType & SbxARRAY )
2249 SbxBase* pElemObj = refVar->GetObject();
2250 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
2251 if( pDimArray )
2253 refRedimpArray = pDimArray;
2257 else if( refVar->IsFixed() )
2259 refVar->Clear();
2261 else
2263 refVar->SetType( SbxEMPTY );
2267 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType )
2269 SbxFlagBits nSavFlags = refVar->GetFlags();
2270 refVar->ResetFlag( SbxFlagBits::Fixed );
2271 refVar->SetType( SbxDataType(eType & 0x0FFF) );
2272 refVar->SetFlags( nSavFlags );
2273 refVar->Clear();
2276 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled )
2278 SbxDataType eType = refVar->GetType();
2279 if( eType & SbxARRAY )
2281 if ( bVBAEnabled )
2283 SbxBase* pElemObj = refVar->GetObject();
2284 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
2285 if( pDimArray )
2287 if ( pDimArray->hasFixedSize() )
2289 // Clear all Value(s)
2290 pDimArray->SbxArray::Clear();
2292 else
2294 pDimArray->Clear(); // clear dims and values
2297 else
2299 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
2300 if ( pArray )
2302 pArray->Clear();
2306 else
2308 // Arrays have on an erase to VB quite a complex behaviour. Here are
2309 // only the type problems at REDIM (#26295) removed at first:
2310 // Set type hard onto the array-type, because a variable with array is
2311 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2312 // the original type is lost -> runtime error
2313 lcl_clearImpl( refVar, eType );
2316 else if( refVar->IsFixed() )
2318 refVar->Clear();
2320 else
2322 refVar->SetType( SbxEMPTY );
2326 // delete variable
2327 // TOS = variable
2329 void SbiRuntime::StepERASE()
2331 SbxVariableRef refVar = PopVar();
2332 lcl_eraseImpl( refVar, bVBAEnabled );
2335 void SbiRuntime::StepERASE_CLEAR()
2337 refRedim = PopVar();
2340 void SbiRuntime::StepARRAYACCESS()
2342 if( !refArgv.is() )
2344 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2346 SbxVariableRef refVar = PopVar();
2347 refVar->SetParameters( refArgv.get() );
2348 PopArgv();
2349 PushVar( CheckArray( refVar.get() ) );
2352 void SbiRuntime::StepBYVAL()
2354 // Copy variable on stack to break call by reference
2355 SbxVariableRef pVar = PopVar();
2356 SbxDataType t = pVar->GetType();
2358 SbxVariable* pCopyVar = new SbxVariable( t );
2359 pCopyVar->SetFlag( SbxFlagBits::ReadWrite );
2360 *pCopyVar = *pVar;
2362 PushVar( pCopyVar );
2365 // establishing an argv
2366 // nOp1 stays as it is -> 1st element is the return value
2368 void SbiRuntime::StepARGC()
2370 PushArgv();
2371 refArgv = new SbxArray;
2372 nArgc = 1;
2375 // storing an argument in Argv
2377 void SbiRuntime::StepARGV()
2379 if( !refArgv.is() )
2381 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2383 else
2385 SbxVariableRef pVal = PopVar();
2387 // Before fix of #94916:
2388 if( dynamic_cast<const SbxMethod*>( pVal.get() ) != nullptr
2389 || dynamic_cast<const SbUnoProperty*>( pVal.get() ) != nullptr
2390 || dynamic_cast<const SbProcedureProperty*>( pVal.get() ) != nullptr )
2392 // evaluate methods and properties!
2393 SbxVariable* pRes = new SbxVariable( *pVal );
2394 pVal = pRes;
2396 refArgv->Put( pVal.get(), nArgc++ );
2400 // Input to Variable. The variable is on TOS and is
2401 // is removed afterwards.
2402 void SbiRuntime::StepINPUT()
2404 OUStringBuffer sin;
2405 OUString s;
2406 char ch = 0;
2407 ErrCode err;
2408 // Skip whitespace
2409 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2411 ch = pIosys->Read();
2412 if( ch != ' ' && ch != '\t' && ch != '\n' )
2414 break;
2417 if( !err )
2419 // Scan until comma or whitespace
2420 char sep = ( ch == '"' ) ? ch : 0;
2421 if( sep )
2423 ch = pIosys->Read();
2425 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2427 if( ch == sep )
2429 ch = pIosys->Read();
2430 if( ch != sep )
2432 break;
2435 else if( !sep && (ch == ',' || ch == '\n') )
2437 break;
2439 sin.append( ch );
2440 ch = pIosys->Read();
2442 // skip whitespace
2443 if( ch == ' ' || ch == '\t' )
2445 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2447 if( ch != ' ' && ch != '\t' && ch != '\n' )
2449 break;
2451 ch = pIosys->Read();
2455 if( !err )
2457 s = sin.makeStringAndClear();
2458 SbxVariableRef pVar = GetTOS();
2459 // try to fill the variable with a numeric value first,
2460 // then with a string value
2461 if( !pVar->IsFixed() || pVar->IsNumeric() )
2463 sal_uInt16 nLen = 0;
2464 if( !pVar->Scan( s, &nLen ) )
2466 err = SbxBase::GetError();
2467 SbxBase::ResetError();
2469 // the value has to be scanned in completely
2470 else if( nLen != s.getLength() && !pVar->PutString( s ) )
2472 err = SbxBase::GetError();
2473 SbxBase::ResetError();
2475 else if( nLen != s.getLength() && pVar->IsNumeric() )
2477 err = SbxBase::GetError();
2478 SbxBase::ResetError();
2479 if( !err )
2481 err = ERRCODE_BASIC_CONVERSION;
2485 else
2487 pVar->PutString( s );
2488 err = SbxBase::GetError();
2489 SbxBase::ResetError();
2492 if( err == ERRCODE_BASIC_USER_ABORT )
2494 Error( err );
2496 else if( err )
2498 if( pRestart && !pIosys->GetChannel() )
2500 pCode = pRestart;
2502 else
2504 Error( err );
2507 else
2509 PopVar();
2513 // Line Input to Variable. The variable is on TOS and is
2514 // deleted afterwards.
2516 void SbiRuntime::StepLINPUT()
2518 OString aInput;
2519 pIosys->Read( aInput );
2520 Error( pIosys->GetError() );
2521 SbxVariableRef p = PopVar();
2522 p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
2525 // end of program
2527 void SbiRuntime::StepSTOP()
2529 pInst->Stop();
2533 void SbiRuntime::StepINITFOR()
2535 PushFor();
2538 void SbiRuntime::StepINITFOREACH()
2540 PushForEach();
2543 // increment FOR-variable
2545 void SbiRuntime::StepNEXT()
2547 if( !pForStk )
2549 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2550 return;
2552 if( pForStk->eForType == ForType::To )
2554 pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
2558 // beginning CASE: TOS in CASE-stack
2560 void SbiRuntime::StepCASE()
2562 if( !refCaseStk.is() )
2564 refCaseStk = new SbxArray;
2566 SbxVariableRef xVar = PopVar();
2567 refCaseStk->Put( xVar.get(), refCaseStk->Count() );
2570 // end CASE: free variable
2572 void SbiRuntime::StepENDCASE()
2574 if( !refCaseStk.is() || !refCaseStk->Count() )
2576 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2578 else
2580 refCaseStk->Remove( refCaseStk->Count() - 1 );
2585 void SbiRuntime::StepSTDERROR()
2587 pError = nullptr; bError = true;
2588 pInst->aErrorMsg.clear();
2589 pInst->nErr = ERRCODE_NONE;
2590 pInst->nErl = 0;
2591 nError = ERRCODE_NONE;
2592 SbxErrObject::getUnoErrObject()->Clear();
2595 void SbiRuntime::StepNOERROR()
2597 pInst->aErrorMsg.clear();
2598 pInst->nErr = ERRCODE_NONE;
2599 pInst->nErl = 0;
2600 nError = ERRCODE_NONE;
2601 SbxErrObject::getUnoErrObject()->Clear();
2602 bError = false;
2605 // leave UP
2607 void SbiRuntime::StepLEAVE()
2609 bRun = false;
2610 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2611 if ( bInError && pError )
2613 SbxErrObject::getUnoErrObject()->Clear();
2617 void SbiRuntime::StepCHANNEL() // TOS = channel number
2619 SbxVariableRef pChan = PopVar();
2620 short nChan = pChan->GetInteger();
2621 pIosys->SetChannel( nChan );
2622 Error( pIosys->GetError() );
2625 void SbiRuntime::StepCHANNEL0()
2627 pIosys->ResetChannel();
2630 void SbiRuntime::StepPRINT() // print TOS
2632 SbxVariableRef p = PopVar();
2633 OUString s1 = p->GetOUString();
2634 OUString s;
2635 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2637 s = " "; // one blank before
2639 s += s1;
2640 pIosys->Write( s );
2641 Error( pIosys->GetError() );
2644 void SbiRuntime::StepPRINTF() // print TOS in field
2646 SbxVariableRef p = PopVar();
2647 OUString s1 = p->GetOUString();
2648 OUStringBuffer s;
2649 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2651 s.append(' ');
2653 s.append(s1);
2654 comphelper::string::padToLength(s, 14, ' ');
2655 pIosys->Write( s.makeStringAndClear() );
2656 Error( pIosys->GetError() );
2659 void SbiRuntime::StepWRITE() // write TOS
2661 SbxVariableRef p = PopVar();
2662 // Does the string have to be encapsulated?
2663 char ch = 0;
2664 switch (p->GetType() )
2666 case SbxSTRING: ch = '"'; break;
2667 case SbxCURRENCY:
2668 case SbxBOOL:
2669 case SbxDATE: ch = '#'; break;
2670 default: break;
2672 OUString s;
2673 if( ch )
2675 s += OUString(ch);
2677 s += p->GetOUString();
2678 if( ch )
2680 s += OUString(ch);
2682 pIosys->Write( s );
2683 Error( pIosys->GetError() );
2686 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2688 SbxVariableRef pTos1 = PopVar();
2689 SbxVariableRef pTos = PopVar();
2690 OUString aDest = pTos1->GetOUString();
2691 OUString aSource = pTos->GetOUString();
2693 if( hasUno() )
2695 implStepRenameUCB( aSource, aDest );
2697 else
2699 implStepRenameOSL( aSource, aDest );
2703 // TOS = Prompt
2705 void SbiRuntime::StepPROMPT()
2707 SbxVariableRef p = PopVar();
2708 OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
2709 pIosys->SetPrompt( aStr );
2712 // Set Restart point
2714 void SbiRuntime::StepRESTART()
2716 pRestart = pCode;
2719 // empty expression on stack for missing parameter
2721 void SbiRuntime::StepEMPTY()
2723 // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2724 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
2725 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2726 // to simplify matters.
2727 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
2728 xVar->PutErr( 448 );
2729 PushVar( xVar.get() );
2732 // TOS = error code
2734 void SbiRuntime::StepERROR()
2736 SbxVariableRef refCode = PopVar();
2737 sal_uInt16 n = refCode->GetUShort();
2738 ErrCode error = StarBASIC::GetSfxFromVBError( n );
2739 if ( bVBAEnabled )
2741 pInst->Error( error );
2743 else
2745 Error( error );
2749 // loading a numeric constant (+ID)
2751 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
2753 SbxVariable* p = new SbxVariable( SbxDOUBLE );
2755 // #57844 use localized function
2756 OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
2757 // also allow , !!!
2758 sal_Int32 iComma = aStr.indexOf(',');
2759 if( iComma >= 0 )
2761 aStr = aStr.replaceAt(iComma, 1, ".");
2763 double n = ::rtl::math::stringToDouble( aStr, '.', ',' );
2765 p->PutDouble( n );
2766 PushVar( p );
2769 // loading a string constant (+ID)
2771 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
2773 SbxVariable* p = new SbxVariable;
2774 p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
2775 PushVar( p );
2778 // Immediate Load (+value)
2780 void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
2782 SbxVariable* p = new SbxVariable;
2783 p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
2784 PushVar( p );
2787 // store a named argument in Argv (+Arg-no. from 1!)
2789 void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
2791 if( !refArgv.is() )
2792 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2793 else
2795 OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
2796 SbxVariableRef pVal = PopVar();
2797 if( bVBAEnabled &&
2798 ( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr
2799 || dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr
2800 || dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) )
2802 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2803 if ( pVal->GetType() == SbxEMPTY )
2804 pVal->Broadcast( SfxHintId::BasicDataWanted );
2805 // evaluate methods and properties!
2806 SbxVariable* pRes = new SbxVariable( *pVal );
2807 pVal = pRes;
2809 refArgv->Put( pVal.get(), nArgc );
2810 refArgv->PutAlias( aAlias, nArgc++ );
2814 // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2816 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
2818 if( !refArgv.is() )
2819 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2820 else
2822 bool bByVal = (nOp1 & 0x8000) != 0; // Is BYVAL requested?
2823 SbxDataType t = static_cast<SbxDataType>(nOp1 & 0x7FFF);
2824 SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // last Arg
2826 // check BYVAL
2827 if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
2829 // parameter is a reference
2830 if( bByVal )
2832 // Call by Value is requested -> create a copy
2833 pVar = new SbxVariable( *pVar );
2834 pVar->SetFlag( SbxFlagBits::ReadWrite );
2835 refExprStk->Put( pVar, refArgv->Count() - 1 );
2837 else
2838 pVar->SetFlag( SbxFlagBits::Reference ); // Ref-Flag for DllMgr
2840 else
2842 // parameter is NO reference
2843 if( bByVal )
2844 pVar->ResetFlag( SbxFlagBits::Reference ); // no reference -> OK
2845 else
2846 Error( ERRCODE_BASIC_BAD_PARAMETERS ); // reference needed
2849 if( pVar->GetType() != t )
2851 // variant for correct conversion
2852 // besides error, if SbxBYREF
2853 pVar->Convert( SbxVARIANT );
2854 pVar->Convert( t );
2859 // bring string to a definite length (+length)
2861 void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
2863 SbxVariable* p = GetTOS();
2864 OUString s = p->GetOUString();
2865 sal_Int32 nLen(nOp1);
2866 if( s.getLength() != nLen )
2868 OUStringBuffer aBuf(s);
2869 if (aBuf.getLength() > nLen)
2871 comphelper::string::truncateToLength(aBuf, nLen);
2873 else
2875 comphelper::string::padToLength(aBuf, nLen, ' ');
2877 s = aBuf.makeStringAndClear();
2881 // jump (+target)
2883 void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
2885 #ifdef DBG_UTIL
2886 // #QUESTION shouldn't this be
2887 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
2888 if( nOp1 >= pImg->GetCodeSize() )
2889 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2890 #endif
2891 pCode = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
2894 // evaluate TOS, conditional jump (+target)
2896 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
2898 SbxVariableRef p = PopVar();
2899 if( p->GetBool() )
2900 StepJUMP( nOp1 );
2903 // evaluate TOS, conditional jump (+target)
2905 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
2907 SbxVariableRef p = PopVar();
2908 // In a test e.g. If Null then
2909 // will evaluate Null will act as if False
2910 if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
2911 StepJUMP( nOp1 );
2914 // evaluate TOS, jump into JUMP-table (+MaxVal)
2915 // looks like this:
2916 // ONJUMP 2
2917 // JUMP target1
2918 // JUMP target2
2920 // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
2922 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
2924 SbxVariableRef p = PopVar();
2925 sal_Int16 n = p->GetInteger();
2926 if( nOp1 & 0x8000 )
2928 nOp1 &= 0x7FFF;
2929 PushGosub( pCode + 5 * nOp1 );
2931 if( n < 1 || static_cast<sal_uInt32>(n) > nOp1 )
2932 n = static_cast<sal_Int16>( nOp1 + 1 );
2933 nOp1 = static_cast<sal_uInt32>( reinterpret_cast<const char*>(pCode) - pImg->GetCode() ) + 5 * --n;
2934 StepJUMP( nOp1 );
2937 // UP-call (+target)
2939 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
2941 PushGosub( pCode );
2942 if( nOp1 >= pImg->GetCodeSize() )
2943 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2944 pCode = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
2947 // UP-return (+0 or target)
2949 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
2951 PopGosub();
2952 if( nOp1 )
2953 StepJUMP( nOp1 );
2956 // check FOR-variable (+Endlabel)
2958 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
2960 if( !pForStk )
2962 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2963 return;
2966 bool bEndLoop = false;
2967 switch( pForStk->eForType )
2969 case ForType::To:
2971 SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
2972 if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
2973 bEndLoop = true;
2974 break;
2976 case ForType::EachArray:
2978 SbiForStack* p = pForStk;
2979 if( p->pArrayCurIndices == nullptr )
2981 bEndLoop = true;
2983 else
2985 SbxDimArray* pArray = reinterpret_cast<SbxDimArray*>(p->refEnd.get());
2986 short nDims = pArray->GetDims();
2988 // Empty array?
2989 if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
2991 bEndLoop = true;
2992 break;
2994 SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices.get() );
2995 *(p->refVar) = *pVal;
2997 bool bFoundNext = false;
2998 for( short i = 0 ; i < nDims ; i++ )
3000 if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
3002 bFoundNext = true;
3003 p->pArrayCurIndices[i]++;
3004 for( short j = i - 1 ; j >= 0 ; j-- )
3005 p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
3006 break;
3009 if( !bFoundNext )
3011 p->pArrayCurIndices.reset();
3014 break;
3016 case ForType::EachCollection:
3018 BasicCollection* pCollection = static_cast<BasicCollection*>(pForStk->refEnd.get());
3019 SbxArrayRef xItemArray = pCollection->xItemArray;
3020 sal_Int32 nCount = xItemArray->Count32();
3021 if( pForStk->nCurCollectionIndex < nCount )
3023 SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
3024 pForStk->nCurCollectionIndex++;
3025 (*pForStk->refVar) = *pRes;
3027 else
3029 bEndLoop = true;
3031 break;
3033 case ForType::EachXEnumeration:
3035 SbiForStack* p = pForStk;
3036 if( p->xEnumeration->hasMoreElements() )
3038 Any aElem = p->xEnumeration->nextElement();
3039 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
3040 unoToSbxValue( xVar.get(), aElem );
3041 (*pForStk->refVar) = *xVar;
3043 else
3045 bEndLoop = true;
3047 break;
3050 if( bEndLoop )
3052 PopFor();
3053 StepJUMP( nOp1 );
3057 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3059 void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
3061 if( !refCaseStk.is() || !refCaseStk->Count() )
3062 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3063 else
3065 SbxVariableRef xTo = PopVar();
3066 SbxVariableRef xFrom = PopVar();
3067 SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
3068 if( *xCase >= *xFrom && *xCase <= *xTo )
3069 StepJUMP( nOp1 );
3074 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
3076 const sal_uInt8* p = pCode;
3077 StepJUMP( nOp1 );
3078 pError = pCode;
3079 pCode = p;
3080 pInst->aErrorMsg.clear();
3081 pInst->nErr = ERRCODE_NONE;
3082 pInst->nErl = 0;
3083 nError = ERRCODE_NONE;
3084 SbxErrObject::getUnoErrObject()->Clear();
3087 // Resume after errors (+0=statement, 1=next or Label)
3089 void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
3091 // #32714 Resume without error? -> error
3092 if( !bInError )
3094 Error( ERRCODE_BASIC_BAD_RESUME );
3095 return;
3097 if( nOp1 )
3099 // set Code-pointer to the next statement
3100 sal_uInt16 n1, n2;
3101 pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg );
3103 else
3104 pCode = pErrStmnt;
3105 if ( pError ) // current in error handler ( and got a Resume Next statement )
3106 SbxErrObject::getUnoErrObject()->Clear();
3108 if( nOp1 > 1 )
3109 StepJUMP( nOp1 );
3110 pInst->aErrorMsg.clear();
3111 pInst->nErr = ERRCODE_NONE;
3112 pInst->nErl = 0;
3113 nError = ERRCODE_NONE;
3114 bInError = false;
3117 // close channel (+channel, 0=all)
3118 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
3120 ErrCode err;
3121 if( !nOp1 )
3122 pIosys->Shutdown();
3123 else
3125 err = pIosys->GetError();
3126 if( !err )
3128 pIosys->Close();
3131 err = pIosys->GetError();
3132 Error( err );
3135 // output character (+char)
3137 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
3139 OUString s(static_cast<sal_Unicode>(nOp1));
3140 pIosys->Write( s );
3141 Error( pIosys->GetError() );
3144 // check whether TOS is a certain object class (+StringID)
3146 bool SbiRuntime::implIsClass( SbxObject const * pObj, const OUString& aClass )
3148 bool bRet = true;
3150 if( !aClass.isEmpty() )
3152 bRet = pObj->IsClass( aClass );
3153 if( !bRet )
3154 bRet = aClass.equalsIgnoreAsciiCase( "object" );
3155 if( !bRet )
3157 const OUString& aObjClass = pObj->GetClassName();
3158 SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
3159 SbClassData* pClassData;
3160 if( pClassMod && (pClassData=pClassMod->pClassData.get()) != nullptr )
3162 SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxClassType::DontCare );
3163 bRet = (pClassVar != nullptr);
3167 return bRet;
3170 bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
3171 const OUString& aClass, bool bRaiseErrors, bool bDefault )
3173 bool bOk = bDefault;
3175 SbxDataType t = refVal->GetType();
3176 SbxVariable* pVal = refVal.get();
3177 // we don't know the type of uno properties that are (maybevoid)
3178 if ( t == SbxEMPTY )
3180 if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) )
3182 t = pProp->getRealType();
3185 if( t == SbxOBJECT || bVBAEnabled )
3187 SbxObject* pObj = dynamic_cast<SbxObject*>(pVal);
3188 if (!pObj)
3190 pObj = dynamic_cast<SbxObject*>(refVal->GetObject());
3192 if( pObj )
3194 if( !implIsClass( pObj, aClass ) )
3196 SbUnoObject* pUnoObj(nullptr);
3197 if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration())
3199 pUnoObj = dynamic_cast<SbUnoObject*>(pObj);
3202 if (pUnoObj)
3203 bOk = checkUnoObjectType(*pUnoObj, aClass);
3204 else
3205 bOk = false;
3206 if ( !bOk && bRaiseErrors )
3207 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
3209 else
3211 bOk = true;
3213 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pObj );
3214 if( pClassModuleObject != nullptr )
3215 pClassModuleObject->triggerInitializeEvent();
3219 else
3221 if( bRaiseErrors )
3222 Error( ERRCODE_BASIC_NEEDS_OBJECT );
3223 bOk = false;
3225 return bOk;
3228 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
3230 SbxVariableRef refVal = PopVar();
3231 SbxVariableRef refVar = PopVar();
3232 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3234 bool bOk = checkClass_Impl( refVal, aClass, true, true );
3235 if( bOk )
3237 StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set
3241 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
3243 StepSETCLASS_impl( nOp1, false );
3246 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
3248 StepSETCLASS_impl( nOp1, true );
3251 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
3253 SbxVariableRef xObjVal = PopVar();
3254 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3255 bool bDefault = !bVBAEnabled;
3256 bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
3258 SbxVariable* pRet = new SbxVariable;
3259 pRet->PutBool( bOk );
3260 PushVar( pRet );
3263 // define library for following declare-call
3265 void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
3267 aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
3270 // TOS is incremented by BASE, BASE is pushed before (+BASE)
3271 // This opcode is pushed before DIM/REDIM-commands,
3272 // if there's been only one index named.
3274 void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
3276 SbxVariable* p1 = new SbxVariable;
3277 SbxVariableRef x2 = PopVar();
3279 // #109275 Check compatibility mode
3280 bool bCompatible = ((nOp1 & 0x8000) != 0);
3281 sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
3282 p1->PutInteger( uBase );
3283 if( !bCompatible )
3284 x2->Compute( SbxPLUS, *p1 );
3285 PushVar( x2.get() ); // first the Expr
3286 PushVar( p1 ); // then the Base
3289 // the bits in the String-ID:
3290 // 0x8000 - Argv is reserved
3292 SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
3293 ErrCode nNotFound, bool bLocal, bool bStatic )
3295 bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
3296 if( bIsVBAInterOp )
3298 StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
3299 if( pMSOMacroRuntimeLib != nullptr )
3301 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::ExtSearch );
3305 SbxVariable* pElem = nullptr;
3306 if( !pObj )
3308 Error( ERRCODE_BASIC_NO_OBJECT );
3309 pElem = new SbxVariable;
3311 else
3313 bool bFatalError = false;
3314 SbxDataType t = static_cast<SbxDataType>(nOp2);
3315 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
3316 // Hacky capture of Evaluate [] syntax
3317 // this should be tackled I feel at the pcode level
3318 if ( bIsVBAInterOp && aName.startsWith("[") )
3320 // emulate pcode here
3321 StepARGC();
3322 // pseudo StepLOADSC
3323 OUString sArg = aName.copy( 1, aName.getLength() - 2 );
3324 SbxVariable* p = new SbxVariable;
3325 p->PutString( sArg );
3326 PushVar( p );
3327 StepARGV();
3328 nOp1 = nOp1 | 0x8000; // indicate params are present
3329 aName = "Evaluate";
3331 if( bLocal )
3333 if ( bStatic && pMeth )
3335 pElem = pMeth->GetStatics()->Find( aName, SbxClassType::DontCare );
3338 if ( !pElem )
3340 pElem = refLocals->Find( aName, SbxClassType::DontCare );
3343 if( !pElem )
3345 bool bSave = rBasic.bNoRtl;
3346 rBasic.bNoRtl = true;
3347 pElem = pObj->Find( aName, SbxClassType::DontCare );
3349 // #110004, #112015: Make private really private
3350 if( bLocal && pElem ) // Local as flag for global search
3352 if( pElem->IsSet( SbxFlagBits::Private ) )
3354 SbiInstance* pInst_ = GetSbData()->pInst;
3355 if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
3357 pElem = nullptr; // Found but in wrong module!
3359 // Interfaces: Use SbxFlagBits::ExtFound
3362 rBasic.bNoRtl = bSave;
3364 // is it a global uno-identifier?
3365 if( bLocal && !pElem )
3367 bool bSetName = true; // preserve normal behaviour
3369 // i#i68894# if VBAInterOp favour searching vba globals
3370 // over searching for uno classes
3371 if ( bVBAEnabled )
3373 // Try Find in VBA symbols space
3374 pElem = rBasic.VBAFind( aName, SbxClassType::DontCare );
3375 if ( pElem )
3377 bSetName = false; // don't overwrite uno name
3379 else
3381 pElem = VBAConstantHelper::instance().getVBAConstant( aName );
3385 if( !pElem )
3387 // #72382 ATTENTION! ALWAYS returns a result now
3388 // because of unknown modules!
3389 SbUnoClass* pUnoClass = findUnoClass( aName );
3390 if( pUnoClass )
3392 pElem = new SbxVariable( t );
3393 SbxValues aRes( SbxOBJECT );
3394 aRes.pObj = pUnoClass;
3395 pElem->SbxVariable::Put( aRes );
3399 // #62939 If a uno-class has been found, the wrapper
3400 // object has to be held, because the uno-class, e. g.
3401 // "stardiv", has to be read out of the registry
3402 // every time again otherwise
3403 if( pElem )
3405 // #63774 May not be saved too!!!
3406 pElem->SetFlag( SbxFlagBits::DontStore );
3407 pElem->SetFlag( SbxFlagBits::NoModify);
3409 // #72382 save locally, all variables that have been declared
3410 // implicit would become global automatically otherwise!
3411 if ( bSetName )
3413 pElem->SetName( aName );
3415 refLocals->Put( pElem, refLocals->Count() );
3419 if( !pElem )
3421 // not there and not in the object?
3422 // don't establish if that thing has parameters!
3423 if( nOp1 & 0x8000 )
3425 bFatalError = true;
3428 // else, if there are parameters, use different error code
3429 if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) )
3431 // #39108 if explicit and as ELEM always a fatal error
3432 bFatalError = true;
3435 if( !( nOp1 & 0x8000 ) && nNotFound == ERRCODE_BASIC_PROC_UNDEFINED )
3437 nNotFound = ERRCODE_BASIC_VAR_UNDEFINED;
3440 if( bFatalError )
3442 // #39108 use dummy variable instead of fatal error
3443 if( !xDummyVar.is() )
3445 xDummyVar = new SbxVariable( SbxVARIANT );
3447 pElem = xDummyVar.get();
3449 ClearArgvStack();
3451 Error( nNotFound, aName );
3453 else
3455 if ( bStatic )
3457 pElem = StepSTATIC_Impl( aName, t, 0 );
3459 if ( !pElem )
3461 pElem = new SbxVariable( t );
3462 if( t != SbxVARIANT )
3464 pElem->SetFlag( SbxFlagBits::Fixed );
3466 pElem->SetName( aName );
3467 refLocals->Put( pElem, refLocals->Count() );
3472 // #39108 Args can already be deleted!
3473 if( !bFatalError )
3475 SetupArgs( pElem, nOp1 );
3477 // because a particular call-type is requested
3478 if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem))
3480 // shall the type be converted?
3481 SbxDataType t2 = pElem->GetType();
3482 bool bSet = false;
3483 if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE )
3485 if( t != SbxVARIANT && t != t2 &&
3486 t >= SbxINTEGER && t <= SbxSTRING )
3488 pElem->SetType( t );
3489 bSet = true;
3492 // assign pElem to a Ref, to delete a temp-var if applicable
3493 SbxVariableRef refTemp = pElem;
3495 // remove potential rests of the last call of the SbxMethod
3496 // free Write before, so that there's no error
3497 SbxFlagBits nSavFlags = pElem->GetFlags();
3498 pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast );
3499 pElem->SbxValue::Clear();
3500 pElem->SetFlags( nSavFlags );
3502 // don't touch before setting, as e. g. LEFT()
3503 // has to know the difference between Left$() and Left()
3505 // because the methods' parameters are cut away in PopVar()
3506 SbxVariable* pNew = new SbxMethod(*pMethod);
3507 //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3509 pElem->SetParameters(nullptr);
3510 pNew->SetFlag( SbxFlagBits::ReadWrite );
3512 if( bSet )
3514 pElem->SetType( t2 );
3516 pElem = pNew;
3518 // consider index-access for UnoObjects
3519 // definitely we want this for VBA where properties are often
3520 // collections ( which need index access ), but lets only do
3521 // this if we actually have params following
3522 else if( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() )
3524 SbxVariableRef refTemp = pElem;
3526 // dissolve the notify while copying variable
3527 SbxVariable* pNew = new SbxVariable( *pElem );
3528 pElem->SetParameters( nullptr );
3529 pElem = pNew;
3532 return CheckArray( pElem );
3535 // for current scope (e. g. query from BASIC-IDE)
3536 SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
3538 // don't expect pMeth to be != 0, as there are none set
3539 // in the RunInit yet
3541 SbxVariable* pElem = nullptr;
3542 if( !pMod || rName.isEmpty() )
3544 return nullptr;
3546 if( refLocals.is() )
3548 pElem = refLocals->Find( rName, SbxClassType::DontCare );
3550 if ( !pElem && pMeth )
3552 // for statics, set the method's name in front
3553 OUString aMethName = pMeth->GetName() + ":" + rName;
3554 pElem = pMod->Find(aMethName, SbxClassType::DontCare);
3557 // search in parameter list
3558 if( !pElem && pMeth )
3560 SbxInfo* pInfo = pMeth->GetInfo();
3561 if( pInfo && refParams.is() )
3563 sal_uInt16 nParamCount = refParams->Count();
3564 sal_uInt16 j = 1;
3565 const SbxParamInfo* pParam = pInfo->GetParam( j );
3566 while( pParam )
3568 if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
3570 if( j >= nParamCount )
3572 // Parameter is missing
3573 pElem = new SbxVariable( SbxSTRING );
3574 pElem->PutString( "<missing parameter>");
3576 else
3578 pElem = refParams->Get( j );
3580 break;
3582 pParam = pInfo->GetParam( ++j );
3587 // search in module
3588 if( !pElem )
3590 bool bSave = rBasic.bNoRtl;
3591 rBasic.bNoRtl = true;
3592 pElem = pMod->Find( rName, SbxClassType::DontCare );
3593 rBasic.bNoRtl = bSave;
3595 return pElem;
3599 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
3601 if( nOp1 & 0x8000 )
3603 if( !refArgv.is() )
3605 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3607 bool bHasNamed = false;
3608 sal_uInt16 i;
3609 sal_uInt16 nArgCount = refArgv->Count();
3610 for( i = 1 ; i < nArgCount ; i++ )
3612 if( !refArgv->GetAlias(i).isEmpty() )
3614 bHasNamed = true; break;
3617 if( bHasNamed )
3619 SbxInfo* pInfo = p->GetInfo();
3620 if( !pInfo )
3622 bool bError_ = true;
3624 SbUnoMethod* pUnoMethod = dynamic_cast<SbUnoMethod*>( p );
3625 SbUnoProperty* pUnoProperty = dynamic_cast<SbUnoProperty*>( p );
3626 if( pUnoMethod || pUnoProperty )
3628 SbUnoObject* pParentUnoObj = dynamic_cast<SbUnoObject*>( p->GetParent() );
3629 if( pParentUnoObj )
3631 Any aUnoAny = pParentUnoObj->getUnoAny();
3632 Reference< XInvocation > xInvocation;
3633 aUnoAny >>= xInvocation;
3634 if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() )
3636 bError_ = false;
3638 sal_uInt16 nCurPar = 1;
3639 AutomationNamedArgsSbxArray* pArg =
3640 new AutomationNamedArgsSbxArray( nArgCount );
3641 OUString* pNames = pArg->getNames().getArray();
3642 for( i = 1 ; i < nArgCount ; i++ )
3644 SbxVariable* pVar = refArgv->Get( i );
3645 OUString aName = refArgv->GetAlias(i);
3646 if (!aName.isEmpty())
3648 pNames[i] = aName;
3650 pArg->Put( pVar, nCurPar++ );
3652 refArgv = pArg;
3656 else if( bVBAEnabled && p->GetType() == SbxOBJECT && (dynamic_cast<const SbxMethod*>( p) == nullptr || !p->IsBroadcaster()) )
3658 // Check for default method with named parameters
3659 SbxBaseRef xObj = p->GetObject();
3660 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( xObj.get() ))
3662 Any aAny = pUnoObj->getUnoAny();
3664 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3666 Reference< XDefaultMethod > xDfltMethod( aAny, UNO_QUERY );
3668 OUString sDefaultMethod;
3669 if ( xDfltMethod.is() )
3671 sDefaultMethod = xDfltMethod->getDefaultMethodName();
3673 if ( !sDefaultMethod.isEmpty() )
3675 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
3676 if( meth != nullptr )
3678 pInfo = meth->GetInfo();
3680 if( pInfo )
3682 bError_ = false;
3688 if( bError_ )
3690 Error( ERRCODE_BASIC_NO_NAMED_ARGS );
3693 else
3695 sal_uInt16 nCurPar = 1;
3696 SbxArray* pArg = new SbxArray;
3697 for( i = 1 ; i < nArgCount ; i++ )
3699 SbxVariable* pVar = refArgv->Get( i );
3700 OUString aName = refArgv->GetAlias(i);
3701 if (!aName.isEmpty())
3703 // nCurPar is set to the found parameter
3704 sal_uInt16 j = 1;
3705 const SbxParamInfo* pParam = pInfo->GetParam( j );
3706 while( pParam )
3708 if( pParam->aName.equalsIgnoreAsciiCase( aName ) )
3710 nCurPar = j;
3711 break;
3713 pParam = pInfo->GetParam( ++j );
3715 if( !pParam )
3717 Error( ERRCODE_BASIC_NAMED_NOT_FOUND ); break;
3720 pArg->Put( pVar, nCurPar++ );
3722 refArgv = pArg;
3725 // own var as parameter 0
3726 refArgv->Put( p, 0 );
3727 p->SetParameters( refArgv.get() );
3728 PopArgv();
3730 else
3732 p->SetParameters( nullptr );
3736 // getting an array element
3738 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
3740 SbxArray* pPar;
3741 if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem )
3743 SbxBase* pElemObj = pElem->GetObject();
3744 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
3745 pPar = pElem->GetParameters();
3746 if( pDimArray )
3748 // parameters may be missing, if an array is
3749 // passed as an argument
3750 if( pPar )
3751 pElem = pDimArray->Get( pPar );
3753 else
3755 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
3756 if( pArray )
3758 if( !pPar )
3760 Error( ERRCODE_BASIC_OUT_OF_RANGE );
3761 pElem = new SbxVariable;
3763 else
3765 pElem = pArray->Get( pPar->Get( 1 )->GetInteger() );
3770 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3771 if( pPar )
3773 pPar->Put( nullptr, 0 );
3776 // consider index-access for UnoObjects
3777 else if( pElem->GetType() == SbxOBJECT &&
3778 dynamic_cast<const SbxMethod*>( pElem) == nullptr &&
3779 ( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) )
3781 pPar = pElem->GetParameters();
3782 if ( pPar )
3784 // is it a uno-object?
3785 SbxBaseRef pObj = pElem->GetObject();
3786 if( pObj.is() )
3788 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get()))
3790 Any aAny = pUnoObj->getUnoAny();
3792 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3794 Reference< XIndexAccess > xIndexAccess( aAny, UNO_QUERY );
3795 if ( !bVBAEnabled )
3797 if( xIndexAccess.is() )
3799 sal_uInt32 nParamCount = static_cast<sal_uInt32>(pPar->Count()) - 1;
3800 if( nParamCount != 1 )
3802 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3803 return pElem;
3806 // get index
3807 sal_Int32 nIndex = pPar->Get( 1 )->GetLong();
3808 Reference< XInterface > xRet;
3811 Any aAny2 = xIndexAccess->getByIndex( nIndex );
3812 aAny2 >>= xRet;
3814 catch (const IndexOutOfBoundsException&)
3816 // usually expect converting problem
3817 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
3820 // #57847 always create a new variable, else error
3821 // due to PutObject(NULL) at ReadOnly-properties
3822 pElem = new SbxVariable( SbxVARIANT );
3823 if( xRet.is() )
3825 aAny <<= xRet;
3827 // #67173 don't specify a name so that the real class name is entered
3828 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny ));
3829 pElem->PutObject( xWrapper.get() );
3831 else
3833 pElem->PutObject( nullptr );
3837 else
3839 // check if there isn't a default member between the current variable
3840 // and the params, e.g.
3841 // Dim rst1 As New ADODB.Recordset
3842 // "
3843 // val = rst1("FirstName")
3844 // has the default 'Fields' member between rst1 and '("FirstName")'
3845 Any x = aAny;
3846 SbxVariable* pDflt = getDefaultProp( pElem );
3847 if ( pDflt )
3849 pDflt->Broadcast( SfxHintId::BasicDataWanted );
3850 SbxBaseRef pDfltObj = pDflt->GetObject();
3851 if( pDfltObj.is() )
3853 if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get()))
3855 pUnoObj = pSbObj;
3856 Any aUnoAny = pUnoObj->getUnoAny();
3858 if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3859 x = aUnoAny;
3860 pElem = pDflt;
3864 OUString sDefaultMethod;
3866 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
3868 if ( xDfltMethod.is() )
3870 sDefaultMethod = xDfltMethod->getDefaultMethodName();
3872 else if( xIndexAccess.is() )
3874 sDefaultMethod = "getByIndex";
3876 if ( !sDefaultMethod.isEmpty() )
3878 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
3879 SbxVariableRef refTemp = meth;
3880 if ( refTemp.is() )
3882 meth->SetParameters( pPar );
3883 SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) );
3884 pElem = pNew;
3890 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3891 pPar->Put( nullptr, 0 );
3893 else if (BasicCollection* pCol = dynamic_cast<BasicCollection*>(pObj.get()))
3895 pElem = new SbxVariable( SbxVARIANT );
3896 pPar->Put( pElem, 0 );
3897 pCol->CollItem( pPar );
3900 else if( bVBAEnabled ) // !pObj
3902 SbxArray* pParam = pElem->GetParameters();
3903 if( pParam != nullptr && !pElem->IsSet( SbxFlagBits::VarToDim ) )
3905 Error( ERRCODE_BASIC_NO_OBJECT );
3911 return pElem;
3914 // loading an element from the runtime-library (+StringID+type)
3916 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
3918 PushVar( FindElement( rBasic.pRtl.get(), nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, false ) );
3921 void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
3922 ErrCode nNotFound, bool bStatic )
3924 if( !refLocals.is() )
3926 refLocals = new SbxArray;
3928 PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, true/*bLocal*/, bStatic ) );
3930 // loading a local/global variable (+StringID+type)
3932 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
3934 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED );
3937 // Search inside a class module (CM) to enable global search in time
3938 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
3941 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pMod );
3942 if( pClassModuleObject )
3944 pMod->SetFlag( SbxFlagBits::GlobalSearch );
3946 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED);
3948 if( pClassModuleObject )
3950 pMod->ResetFlag( SbxFlagBits::GlobalSearch );
3954 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
3956 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, true );
3959 // loading an object-element (+StringID+type)
3960 // the object lies on TOS
3962 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
3964 SbxVariableRef pObjVar = PopVar();
3966 SbxObject* pObj = dynamic_cast<SbxObject*>( pObjVar.get() );
3967 if( !pObj )
3969 SbxBase* pObjVarObj = pObjVar->GetObject();
3970 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
3973 // #56368 save reference at StepElem, otherwise objects could
3974 // lose their reference too early in qualification chains like
3975 // ActiveComponent.Selection(0).Text
3976 // #74254 now per list
3977 if( pObj )
3979 aRefSaved.emplace_back(pObj );
3981 PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) );
3984 // loading a parameter (+offset+type)
3985 // If the data type is wrong, create a copy.
3986 // The data type SbxEMPTY shows that no parameters are given.
3987 // Get( 0 ) may be EMPTY
3989 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
3991 sal_uInt16 i = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
3992 SbxDataType t = static_cast<SbxDataType>(nOp2);
3993 SbxVariable* p;
3995 // #57915 solve missing in a cleaner way
3996 sal_uInt16 nParamCount = refParams->Count();
3997 if( i >= nParamCount )
3999 sal_Int16 iLoop = i;
4000 while( iLoop >= nParamCount )
4002 p = new SbxVariable();
4004 if( SbiRuntime::isVBAEnabled() &&
4005 (t == SbxOBJECT || t == SbxSTRING) )
4007 if( t == SbxOBJECT )
4009 p->PutObject( nullptr );
4011 else
4013 p->PutString( OUString() );
4016 else
4018 p->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
4020 refParams->Put( p, iLoop );
4021 iLoop--;
4024 p = refParams->Get( i );
4026 if( p->GetType() == SbxERROR && i )
4028 // if there's a parameter missing, it can be OPTIONAL
4029 bool bOpt = false;
4030 if( pMeth )
4032 SbxInfo* pInfo = pMeth->GetInfo();
4033 if ( pInfo )
4035 const SbxParamInfo* pParam = pInfo->GetParam( i );
4036 if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) )
4038 // Default value?
4039 sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff);
4040 if( nDefaultId > 0 )
4042 OUString aDefaultStr = pImg->GetString( nDefaultId );
4043 p = new SbxVariable(pParam-> eType);
4044 p->PutString( aDefaultStr );
4045 refParams->Put( p, i );
4047 bOpt = true;
4051 if( !bOpt )
4053 Error( ERRCODE_BASIC_NOT_OPTIONAL );
4056 else if( t != SbxVARIANT && static_cast<SbxDataType>(p->GetType() & 0x0FFF ) != t )
4058 SbxVariable* q = new SbxVariable( t );
4059 aRefSaved.emplace_back(q );
4060 *q = *p;
4061 p = q;
4062 if ( i )
4064 refParams->Put( p, i );
4067 SetupArgs( p, nOp1 );
4068 PushVar( CheckArray( p ) );
4071 // Case-Test (+True-Target+Test-Opcode)
4073 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4075 if( !refCaseStk.is() || !refCaseStk->Count() )
4077 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
4079 else
4081 SbxVariableRef xComp = PopVar();
4082 SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
4083 if( xCase->Compare( static_cast<SbxOperator>(nOp2), *xComp ) )
4085 StepJUMP( nOp1 );
4090 // call of a DLL-procedure (+StringID+type)
4091 // the StringID's MSB shows that Argv is occupied
4093 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4095 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4096 SbxArray* pArgs = nullptr;
4097 if( nOp1 & 0x8000 )
4099 pArgs = refArgv.get();
4101 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), false );
4102 aLibName.clear();
4103 if( nOp1 & 0x8000 )
4105 PopArgv();
4109 // call of a DLL-procedure after CDecl (+StringID+type)
4111 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4113 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4114 SbxArray* pArgs = nullptr;
4115 if( nOp1 & 0x8000 )
4117 pArgs = refArgv.get();
4119 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), true );
4120 aLibName.clear();
4121 if( nOp1 & 0x8000 )
4123 PopArgv();
4128 // beginning of a statement (+Line+Col)
4130 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4132 // If the Expr-Stack at the beginning of a statement contains a variable,
4133 // some fool has called X as a function, although it's a variable!
4134 bool bFatalExpr = false;
4135 OUString sUnknownMethodName;
4136 if( nExprLvl > 1 )
4138 bFatalExpr = true;
4140 else if( nExprLvl )
4142 SbxVariable* p = refExprStk->Get( 0 );
4143 if( p->GetRefCount() > 1 &&
4144 refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) )
4146 sUnknownMethodName = p->GetName();
4147 bFatalExpr = true;
4151 ClearExprStack();
4153 aRefSaved.clear();
4155 // We have to cancel hard here because line and column
4156 // would be wrong later otherwise!
4157 if( bFatalExpr)
4159 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName );
4160 return;
4162 pStmnt = pCode - 9;
4163 sal_uInt16 nOld = nLine;
4164 nLine = static_cast<short>( nOp1 );
4166 // #29955 & 0xFF, to filter out for-loop-level
4167 nCol1 = static_cast<short>( nOp2 & 0xFF );
4169 // find the next STMNT-command to set the final column
4170 // of this statement
4172 nCol2 = 0xffff;
4173 sal_uInt16 n1, n2;
4174 const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
4175 if( p )
4177 if( n1 == nOp1 )
4179 // #29955 & 0xFF, to filter out for-loop-level
4180 nCol2 = (n2 & 0xFF) - 1;
4184 // #29955 correct for-loop-level, #67452 NOT in the error-handler
4185 if( !bInError )
4187 // (there's a difference here in case of a jump out of a loop)
4188 sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
4189 if( !pGosubStk.empty() )
4191 nExspectedForLevel = nExspectedForLevel + pGosubStk.back().nStartForLvl;
4194 // if the actual for-level is too small it'd jump out
4195 // of a loop -> corrected
4196 while( nForLvl > nExspectedForLevel )
4198 PopFor();
4202 // 16.10.96: #31460 new concept for StepInto/Over/Out
4203 // see explanation at _ImplGetBreakCallLevel
4204 if( pInst->nCallLvl <= pInst->nBreakCallLvl )
4206 StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
4207 BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
4209 pInst->CalcBreakCallLevel( nNewFlags );
4212 // break points only at STMNT-commands in a new line!
4213 else if( ( nOp1 != nOld )
4214 && ( nFlags & BasicDebugFlags::Break )
4215 && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
4217 StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
4218 BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
4220 pInst->CalcBreakCallLevel( nNewFlags );
4224 // (+StreamMode+Flags)
4225 // Stack: block length
4226 // channel number
4227 // file name
4229 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4231 SbxVariableRef pName = PopVar();
4232 SbxVariableRef pChan = PopVar();
4233 SbxVariableRef pLen = PopVar();
4234 short nBlkLen = pLen->GetInteger();
4235 short nChan = pChan->GetInteger();
4236 OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
4237 pIosys->Open( nChan, aName, static_cast<StreamMode>( nOp1 ),
4238 static_cast<SbiStreamFlags>( nOp2 ), nBlkLen );
4239 Error( pIosys->GetError() );
4242 // create object (+StringID+StringID)
4244 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4246 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4247 SbxObject *pObj = SbxBase::CreateObject( aClass );
4248 if( !pObj )
4250 Error( ERRCODE_BASIC_INVALID_OBJECT );
4252 else
4254 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4255 pObj->SetName( aName );
4256 // the object must be able to call the BASIC
4257 pObj->SetParent( &rBasic );
4258 SbxVariable* pNew = new SbxVariable;
4259 pNew->PutObject( pObj );
4260 PushVar( pNew );
4264 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4266 StepDCREATE_IMPL( nOp1, nOp2 );
4269 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4271 StepDCREATE_IMPL( nOp1, nOp2 );
4275 // Helper function for StepDCREATE_IMPL / bRedimp = true
4276 static void implCopyDimArray_DCREATE( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
4277 short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
4279 sal_Int32& ri = pActualIndices[nActualDim];
4280 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
4282 if( nActualDim < nMaxDimIndex )
4284 implCopyDimArray_DCREATE( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
4285 pActualIndices, pLowerBounds, pUpperBounds );
4287 else
4289 SbxVariable* pSource = pOldArray->Get32( pActualIndices );
4290 pNewArray->Put32( pSource, pActualIndices );
4295 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4296 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4298 SbxVariableRef refVar = PopVar();
4300 DimImpl( refVar );
4302 // fill the array with instances of the requested class
4303 SbxBaseRef xObj = refVar->GetObject();
4304 if( !xObj.is() )
4306 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT );
4307 return;
4310 SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(xObj.get());
4311 if (pArray)
4313 short nDims = pArray->GetDims();
4314 sal_Int32 nTotalSize = 0;
4316 // must be a one-dimensional array
4317 sal_Int32 nLower, nUpper;
4318 for( sal_Int32 i = 0 ; i < nDims ; ++i )
4320 pArray->GetDim32( i+1, nLower, nUpper );
4321 sal_Int32 nSize = nUpper - nLower + 1;
4322 if( i == 0 )
4324 nTotalSize = nSize;
4326 else
4328 nTotalSize *= nSize;
4332 // create objects and insert them into the array
4333 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4334 for( sal_Int32 i = 0 ; i < nTotalSize ; ++i )
4336 SbxObject *pClassObj = SbxBase::CreateObject( aClass );
4337 if( !pClassObj )
4339 Error( ERRCODE_BASIC_INVALID_OBJECT );
4340 break;
4342 else
4344 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4345 pClassObj->SetName( aName );
4346 // the object must be able to call the basic
4347 pClassObj->SetParent( &rBasic );
4348 pArray->SbxArray::Put32( pClassObj, i );
4353 SbxDimArray* pOldArray = static_cast<SbxDimArray*>(refRedimpArray.get());
4354 if( pArray && pOldArray )
4356 short nDimsNew = pArray->GetDims();
4357 short nDimsOld = pOldArray->GetDims();
4358 short nDims = nDimsNew;
4359 bool bRangeError = false;
4361 // Store dims to use them for copying later
4362 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDims]);
4363 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDims]);
4364 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDims]);
4365 if( nDimsOld != nDimsNew )
4367 bRangeError = true;
4369 else
4371 // Compare bounds
4372 for( short i = 1 ; i <= nDims ; i++ )
4374 sal_Int32 lBoundNew, uBoundNew;
4375 sal_Int32 lBoundOld, uBoundOld;
4376 pArray->GetDim32( i, lBoundNew, uBoundNew );
4377 pOldArray->GetDim32( i, lBoundOld, uBoundOld );
4379 lBoundNew = std::max( lBoundNew, lBoundOld );
4380 uBoundNew = std::min( uBoundNew, uBoundOld );
4381 short j = i - 1;
4382 pActualIndices[j] = pLowerBounds[j] = lBoundNew;
4383 pUpperBounds[j] = uBoundNew;
4387 if( bRangeError )
4389 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
4391 else
4393 // Copy data from old array by going recursively through all dimensions
4394 // (It would be faster to work on the flat internal data array of an
4395 // SbyArray but this solution is clearer and easier)
4396 implCopyDimArray_DCREATE( pArray, pOldArray, nDims - 1,
4397 0, pActualIndices.get(), pLowerBounds.get(), pUpperBounds.get() );
4399 refRedimpArray = nullptr;
4403 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4405 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4406 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4408 SbxObject* pCopyObj = createUserTypeImpl( aClass );
4409 if( pCopyObj )
4411 pCopyObj->SetName( aName );
4413 SbxVariable* pNew = new SbxVariable;
4414 pNew->PutObject( pCopyObj );
4415 pNew->SetDeclareClassName( aClass );
4416 PushVar( pNew );
4419 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
4421 bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
4422 if( bWithEvents )
4424 pVar->SetFlag( SbxFlagBits::WithEvents );
4426 bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
4427 if( bDimAsNew )
4429 pVar->SetFlag( SbxFlagBits::DimAsNew );
4431 bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
4432 if( bFixedString )
4434 sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000
4435 OUStringBuffer aBuf;
4436 comphelper::string::padToLength(aBuf, nCount);
4437 pVar->PutString(aBuf.makeStringAndClear());
4440 bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
4441 if( bVarToDim )
4443 pVar->SetFlag( SbxFlagBits::VarToDim );
4447 // establishing a local variable (+StringID+type)
4449 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4451 if( !refLocals.is() )
4453 refLocals = new SbxArray;
4455 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4456 if( refLocals->Find( aName, SbxClassType::DontCare ) == nullptr )
4458 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4459 SbxVariable* p = new SbxVariable( t );
4460 p->SetName( aName );
4461 implHandleSbxFlags( p, t, nOp2 );
4462 refLocals->Put( p, refLocals->Count() );
4466 // establishing a module-global variable (+StringID+type)
4468 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
4470 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4471 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4472 bool bFlag = pMod->IsSet( SbxFlagBits::NoModify );
4473 pMod->SetFlag( SbxFlagBits::NoModify );
4474 SbxVariableRef p = pMod->Find( aName, SbxClassType::Property );
4475 if( p.is() )
4477 pMod->Remove (p.get());
4479 SbProperty* pProp = pMod->GetProperty( aName, t );
4480 if( !bUsedForClassModule )
4482 pProp->SetFlag( SbxFlagBits::Private );
4484 if( !bFlag )
4486 pMod->ResetFlag( SbxFlagBits::NoModify );
4488 if( pProp )
4490 pProp->SetFlag( SbxFlagBits::DontStore );
4491 // from 2.7.1996: HACK because of 'reference can't be saved'
4492 pProp->SetFlag( SbxFlagBits::NoModify);
4494 implHandleSbxFlags( pProp, t, nOp2 );
4498 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4500 StepPUBLIC_Impl( nOp1, nOp2, false );
4503 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4505 // Creates module variable that isn't reinitialised when
4506 // between invocations ( for VBASupport & document basic only )
4507 if( pMod->pImage->bFirstInit )
4509 bool bUsedForClassModule = pImg->IsFlag( SbiImageFlags::CLASSMODULE );
4510 StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
4514 // establishing a global variable (+StringID+type)
4516 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4518 if( pImg->IsFlag( SbiImageFlags::CLASSMODULE ) )
4520 StepPUBLIC_Impl( nOp1, nOp2, true );
4522 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4523 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4525 // Store module scope variables at module scope
4526 // in non vba mode these are stored at the library level :/
4527 // not sure if this really should not be enabled for ALL basic
4528 SbxObject* pStorage = &rBasic;
4529 if ( SbiRuntime::isVBAEnabled() )
4531 pStorage = pMod;
4532 pMod->AddVarName( aName );
4535 bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify );
4536 rBasic.SetFlag( SbxFlagBits::NoModify );
4537 SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property );
4538 if( p.is() )
4540 pStorage->Remove (p.get());
4542 p = pStorage->Make( aName, SbxClassType::Property, t );
4543 if( !bFlag )
4545 pStorage->ResetFlag( SbxFlagBits::NoModify );
4547 if( p.is() )
4549 p->SetFlag( SbxFlagBits::DontStore );
4550 // from 2.7.1996: HACK because of 'reference can't be saved'
4551 p->SetFlag( SbxFlagBits::NoModify);
4556 // Creates global variable that isn't reinitialised when
4557 // basic is restarted, P=PERSIST (+StringID+Typ)
4559 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4561 if( pMod->pImage->bFirstInit )
4563 StepGLOBAL( nOp1, nOp2 );
4568 // Searches for global variable, behavior depends on the fact
4569 // if the variable is initialised for the first time
4571 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4573 if( pMod->pImage->bFirstInit )
4575 // Behave like always during first init
4576 StepFIND( nOp1, nOp2 );
4578 else
4580 // Return dummy variable
4581 SbxDataType t = static_cast<SbxDataType>(nOp2);
4582 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
4584 SbxVariable* pDummyVar = new SbxVariable( t );
4585 pDummyVar->SetName( aName );
4586 PushVar( pDummyVar );
4591 SbxVariable* SbiRuntime::StepSTATIC_Impl(
4592 OUString const & aName, SbxDataType t, sal_uInt32 nOp2 )
4594 SbxVariable* p = nullptr;
4595 if ( pMeth )
4597 SbxArray* pStatics = pMeth->GetStatics();
4598 if( pStatics && ( pStatics->Find( aName, SbxClassType::DontCare ) == nullptr ) )
4600 p = new SbxVariable( t );
4601 if( t != SbxVARIANT )
4603 p->SetFlag( SbxFlagBits::Fixed );
4605 p->SetName( aName );
4606 implHandleSbxFlags( p, t, nOp2 );
4607 pStatics->Put( p, pStatics->Count() );
4610 return p;
4612 // establishing a static variable (+StringID+type)
4613 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4615 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4616 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4617 StepSTATIC_Impl( aName, t, nOp2 );
4620 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */