nss: upgrade to release 3.73
[LibreOffice.git] / basic / source / runtime / runtime.cxx
blobdd39a133a4506d8aa6859a238d169ca28aab1f3a
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>
35 #include <o3tl/safeint.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 namespace
88 class ScopedWritableGuard
90 public:
91 ScopedWritableGuard(const SbxVariableRef& rVar, bool bMakeWritable)
92 : m_rVar(rVar)
93 , m_bReset(bMakeWritable && !rVar->CanWrite())
95 if (m_bReset)
97 m_rVar->SetFlag(SbxFlagBits::Write);
100 ~ScopedWritableGuard()
102 if (m_bReset)
104 m_rVar->ResetFlag(SbxFlagBits::Write);
108 private:
109 SbxVariableRef m_rVar;
110 bool m_bReset;
114 bool SbiRuntime::isVBAEnabled()
116 bool bResult = false;
117 SbiInstance* pInst = GetSbData()->pInst;
118 if ( pInst && GetSbData()->pInst->pRun )
119 bResult = pInst->pRun->bVBAEnabled;
120 return bResult;
123 void StarBASIC::SetVBAEnabled( bool bEnabled )
125 if ( bDocBasic )
127 bVBAEnabled = bEnabled;
131 bool StarBASIC::isVBAEnabled() const
133 if ( bDocBasic )
135 if( SbiRuntime::isVBAEnabled() )
136 return true;
137 return bVBAEnabled;
139 return false;
142 struct SbiArgv { // Argv stack:
143 SbxArrayRef refArgv; // Argv
144 short nArgc; // Argc
146 SbiArgv(SbxArrayRef const & refArgv_, short nArgc_) :
147 refArgv(refArgv_),
148 nArgc(nArgc_) {}
151 struct SbiGosub { // GOSUB-Stack:
152 const sal_uInt8* pCode; // Return-Pointer
153 sal_uInt16 nStartForLvl; // #118235: For Level in moment of gosub
155 SbiGosub(const sal_uInt8* pCode_, sal_uInt16 nStartForLvl_) :
156 pCode(pCode_),
157 nStartForLvl(nStartForLvl_) {}
160 SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // all opcodes without operands
161 &SbiRuntime::StepNOP,
162 &SbiRuntime::StepEXP,
163 &SbiRuntime::StepMUL,
164 &SbiRuntime::StepDIV,
165 &SbiRuntime::StepMOD,
166 &SbiRuntime::StepPLUS,
167 &SbiRuntime::StepMINUS,
168 &SbiRuntime::StepNEG,
169 &SbiRuntime::StepEQ,
170 &SbiRuntime::StepNE,
171 &SbiRuntime::StepLT,
172 &SbiRuntime::StepGT,
173 &SbiRuntime::StepLE,
174 &SbiRuntime::StepGE,
175 &SbiRuntime::StepIDIV,
176 &SbiRuntime::StepAND,
177 &SbiRuntime::StepOR,
178 &SbiRuntime::StepXOR,
179 &SbiRuntime::StepEQV,
180 &SbiRuntime::StepIMP,
181 &SbiRuntime::StepNOT,
182 &SbiRuntime::StepCAT,
184 &SbiRuntime::StepLIKE,
185 &SbiRuntime::StepIS,
186 // load/save
187 &SbiRuntime::StepARGC, // establish new Argv
188 &SbiRuntime::StepARGV, // TOS ==> current Argv
189 &SbiRuntime::StepINPUT, // Input ==> TOS
190 &SbiRuntime::StepLINPUT, // Line Input ==> TOS
191 &SbiRuntime::StepGET, // touch TOS
192 &SbiRuntime::StepSET, // save object TOS ==> TOS-1
193 &SbiRuntime::StepPUT, // TOS ==> TOS-1
194 &SbiRuntime::StepPUTC, // TOS ==> TOS-1, then ReadOnly
195 &SbiRuntime::StepDIM, // DIM
196 &SbiRuntime::StepREDIM, // REDIM
197 &SbiRuntime::StepREDIMP, // REDIM PRESERVE
198 &SbiRuntime::StepERASE, // delete TOS
199 // branch
200 &SbiRuntime::StepSTOP, // program end
201 &SbiRuntime::StepINITFOR, // initialize FOR-Variable
202 &SbiRuntime::StepNEXT, // increment FOR-Variable
203 &SbiRuntime::StepCASE, // beginning CASE
204 &SbiRuntime::StepENDCASE, // end CASE
205 &SbiRuntime::StepSTDERROR, // standard error handling
206 &SbiRuntime::StepNOERROR, // no error handling
207 &SbiRuntime::StepLEAVE, // leave UP
208 // E/A
209 &SbiRuntime::StepCHANNEL, // TOS = channel number
210 &SbiRuntime::StepPRINT, // print TOS
211 &SbiRuntime::StepPRINTF, // print TOS in field
212 &SbiRuntime::StepWRITE, // write TOS
213 &SbiRuntime::StepRENAME, // Rename Tos+1 to Tos
214 &SbiRuntime::StepPROMPT, // define Input Prompt from TOS
215 &SbiRuntime::StepRESTART, // Set restart point
216 &SbiRuntime::StepCHANNEL0, // set E/A-channel 0
217 &SbiRuntime::StepEMPTY, // empty expression on stack
218 &SbiRuntime::StepERROR, // TOS = error code
219 &SbiRuntime::StepLSET, // save object TOS ==> TOS-1
220 &SbiRuntime::StepRSET, // save object TOS ==> TOS-1
221 &SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
222 &SbiRuntime::StepINITFOREACH,// Init for each loop
223 &SbiRuntime::StepVBASET,// vba-like set statement
224 &SbiRuntime::StepERASE_CLEAR,// vba-like set statement
225 &SbiRuntime::StepARRAYACCESS,// access TOS as array
226 &SbiRuntime::StepBYVAL, // access TOS as array
229 SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // all opcodes with one operand
230 &SbiRuntime::StepLOADNC, // loading a numeric constant (+ID)
231 &SbiRuntime::StepLOADSC, // loading a string constant (+ID)
232 &SbiRuntime::StepLOADI, // Immediate Load (+value)
233 &SbiRuntime::StepARGN, // save a named Args in Argv (+StringID)
234 &SbiRuntime::StepPAD, // bring string to a definite length (+length)
235 // branches
236 &SbiRuntime::StepJUMP, // jump (+Target)
237 &SbiRuntime::StepJUMPT, // evaluate TOS, conditional jump (+Target)
238 &SbiRuntime::StepJUMPF, // evaluate TOS, conditional jump (+Target)
239 &SbiRuntime::StepONJUMP, // evaluate TOS, jump into JUMP-table (+MaxVal)
240 &SbiRuntime::StepGOSUB, // UP-call (+Target)
241 &SbiRuntime::StepRETURN, // UP-return (+0 or Target)
242 &SbiRuntime::StepTESTFOR, // check FOR-variable, increment (+Endlabel)
243 &SbiRuntime::StepCASETO, // Tos+1 <= Case <= Tos), 2xremove (+Target)
244 &SbiRuntime::StepERRHDL, // error handler (+Offset)
245 &SbiRuntime::StepRESUME, // resume after errors (+0 or 1 or Label)
246 // E/A
247 &SbiRuntime::StepCLOSE, // (+channel/0)
248 &SbiRuntime::StepPRCHAR, // (+char)
249 // management
250 &SbiRuntime::StepSETCLASS, // check set + class names (+StringId)
251 &SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId)
252 &SbiRuntime::StepLIB, // lib for declare-call (+StringId)
253 &SbiRuntime::StepBASED, // TOS is incremented by BASE, BASE is pushed before
254 &SbiRuntime::StepARGTYP, // convert last parameter in Argv (+Type)
255 &SbiRuntime::StepVBASETCLASS,// vba-like set statement
258 SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// all opcodes with two operands
259 &SbiRuntime::StepRTL, // load from RTL (+StringID+Typ)
260 &SbiRuntime::StepFIND, // load (+StringID+Typ)
261 &SbiRuntime::StepELEM, // load element (+StringID+Typ)
262 &SbiRuntime::StepPARAM, // Parameter (+Offset+Typ)
263 // branches
264 &SbiRuntime::StepCALL, // Declare-Call (+StringID+Typ)
265 &SbiRuntime::StepCALLC, // CDecl-Declare-Call (+StringID+Typ)
266 &SbiRuntime::StepCASEIS, // Case-Test (+Test-Opcode+False-Target)
267 // management
268 &SbiRuntime::StepSTMNT, // beginning of a statement (+Line+Col)
269 // E/A
270 &SbiRuntime::StepOPEN, // (+StreamMode+Flags)
271 // Objects
272 &SbiRuntime::StepLOCAL, // define local variable (+StringId+Typ)
273 &SbiRuntime::StepPUBLIC, // module global variable (+StringID+Typ)
274 &SbiRuntime::StepGLOBAL, // define global variable (+StringID+Typ)
275 &SbiRuntime::StepCREATE, // create object (+StringId+StringId)
276 &SbiRuntime::StepSTATIC, // static variable (+StringId+StringId)
277 &SbiRuntime::StepTCREATE, // user-defined objects (+StringId+StringId)
278 &SbiRuntime::StepDCREATE, // create object-array (+StringID+StringID)
279 &SbiRuntime::StepGLOBAL_P, // define global variable which is not overwritten
280 // by the Basic on a restart (+StringID+Typ)
281 &SbiRuntime::StepFIND_G, // finds global variable with special treatment because of _GLOBAL_P
282 &SbiRuntime::StepDCREATE_REDIMP, // redimension object array (+StringID+StringID)
283 &SbiRuntime::StepFIND_CM, // Search inside a class module (CM) to enable global search in time
284 &SbiRuntime::StepPUBLIC_P, // Search inside a class module (CM) to enable global search in time
285 &SbiRuntime::StepFIND_STATIC, // Search inside a class module (CM) to enable global search in time
289 // SbiRTLData
291 SbiRTLData::SbiRTLData()
293 nDirFlags = SbAttributes::NONE;
294 nCurDirPos = 0;
297 SbiRTLData::~SbiRTLData()
301 // SbiInstance
303 // 16.10.96: #31460 new concept for StepInto/Over/Out
304 // The decision whether StepPoint shall be called is done with the help of
305 // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl.
306 // The current CallLevel can never be smaller than 1, as it's also incremented
307 // during the call of a method (also main). Therefore a BreakCallLvl from 0
308 // means that the program isn't stopped at all.
309 // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
312 void SbiInstance::CalcBreakCallLevel( BasicDebugFlags nFlags )
315 nFlags &= ~BasicDebugFlags::Break;
317 sal_uInt16 nRet;
318 if (nFlags == BasicDebugFlags::StepInto) {
319 nRet = nCallLvl + 1; // CallLevel+1 is also stopped
320 } else if (nFlags == (BasicDebugFlags::StepOver | BasicDebugFlags::StepInto)) {
321 nRet = nCallLvl; // current CallLevel is stopped
322 } else if (nFlags == BasicDebugFlags::StepOut) {
323 nRet = nCallLvl - 1; // smaller CallLevel is stopped
324 } else {
325 // Basic-IDE returns 0 instead of BasicDebugFlags::Continue, so also default=continue
326 nRet = 0; // CallLevel is always > 0 -> no StepPoint
328 nBreakCallLvl = nRet; // take result
331 SbiInstance::SbiInstance( StarBASIC* p )
332 : pIosys(new SbiIoSystem)
333 , pDdeCtrl(new SbiDdeControl)
334 , pBasic(p)
335 , meFormatterLangType(LANGUAGE_DONTKNOW)
336 , meFormatterDateOrder(DateOrder::YMD)
337 , nStdDateIdx(0)
338 , nStdTimeIdx(0)
339 , nStdDateTimeIdx(0)
340 , nErr(0)
341 , nErl(0)
342 , bReschedule(true)
343 , bCompatibility(false)
344 , pRun(nullptr)
345 , nCallLvl(0)
346 , nBreakCallLvl(0)
350 SbiInstance::~SbiInstance()
352 while( pRun )
354 SbiRuntime* p = pRun->pNext;
355 delete pRun;
356 pRun = p;
361 int nSize = ComponentVector.size();
362 if( nSize )
364 for( int i = nSize - 1 ; i >= 0 ; --i )
366 Reference< XComponent > xDlgComponent = ComponentVector[i];
367 if( xDlgComponent.is() )
368 xDlgComponent->dispose();
372 catch( const Exception& )
374 TOOLS_WARN_EXCEPTION("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components" );
378 SbiDllMgr* SbiInstance::GetDllMgr()
380 if( !pDllMgr )
382 pDllMgr.reset(new SbiDllMgr);
384 return pDllMgr.get();
387 // #39629 create NumberFormatter with the help of a static method now
388 std::shared_ptr<SvNumberFormatter> const & SbiInstance::GetNumberFormatter()
390 LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
391 SvtSysLocale aSysLocale;
392 DateOrder eDate = aSysLocale.GetLocaleData().getDateOrder();
393 if( pNumberFormatter )
395 if( eLangType != meFormatterLangType ||
396 eDate != meFormatterDateOrder )
398 pNumberFormatter.reset();
401 meFormatterLangType = eLangType;
402 meFormatterDateOrder = eDate;
403 if( !pNumberFormatter )
405 pNumberFormatter = PrepareNumberFormatter( nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx,
406 &meFormatterLangType, &meFormatterDateOrder);
408 return pNumberFormatter;
411 // #39629 offer NumberFormatter static too
412 std::shared_ptr<SvNumberFormatter> SbiInstance::PrepareNumberFormatter( sal_uInt32 &rnStdDateIdx,
413 sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
414 LanguageType const * peFormatterLangType, DateOrder const * peFormatterDateOrder )
416 LanguageType eLangType;
417 if( peFormatterLangType )
419 eLangType = *peFormatterLangType;
421 else
423 eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
425 DateOrder eDate;
426 if( peFormatterDateOrder )
428 eDate = *peFormatterDateOrder;
430 else
432 SvtSysLocale aSysLocale;
433 eDate = aSysLocale.GetLocaleData().getDateOrder();
436 std::shared_ptr<SvNumberFormatter> pNumberFormatter =
437 std::make_shared<SvNumberFormatter>( comphelper::getProcessComponentContext(), eLangType );
439 // Several parser methods pass SvNumberFormatter::IsNumberFormat() a number
440 // format index to parse against. Tell the formatter the proper date
441 // evaluation order, which also determines the date acceptance patterns to
442 // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the
443 // format's locale's date patterns/order (no init/system locale match
444 // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0)
445 // (or an unknown) format index was passed.
446 pNumberFormatter->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT);
448 sal_Int32 nCheckPos = 0;
449 SvNumFormatType nType;
450 rnStdTimeIdx = pNumberFormatter->GetStandardFormat( SvNumFormatType::TIME, eLangType );
452 // the formatter's standard templates have only got a two-digit date
453 // -> registering an own format
455 // HACK, because the numberformatter doesn't swap the place holders
456 // for month, day and year according to the system setting.
457 // Problem: Print Year(Date) under engl. BS
458 // also have a look at: basic/source/sbx/sbxdate.cxx
460 OUString aDateStr;
461 switch( eDate )
463 default:
464 case DateOrder::MDY: aDateStr = "MM/DD/YYYY"; break;
465 case DateOrder::DMY: aDateStr = "DD/MM/YYYY"; break;
466 case DateOrder::YMD: aDateStr = "YYYY/MM/DD"; break;
468 OUString aStr( aDateStr ); // PutandConvertEntry() modifies string!
469 pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
470 rnStdDateIdx, LANGUAGE_ENGLISH_US, eLangType, true);
471 nCheckPos = 0;
472 aDateStr += " HH:MM:SS";
473 aStr = aDateStr;
474 pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
475 rnStdDateTimeIdx, LANGUAGE_ENGLISH_US, eLangType, true);
476 return pNumberFormatter;
480 // Let engine run. If Flags == BasicDebugFlags::Continue, take Flags over
482 void SbiInstance::Stop()
484 for( SbiRuntime* p = pRun; p; p = p->pNext )
486 p->Stop();
490 // Allows Basic IDE to set watch mode to suppress errors
491 static bool bWatchMode = false;
493 void setBasicWatchMode( bool bOn )
495 bWatchMode = bOn;
498 void SbiInstance::Error( ErrCode n )
500 Error( n, OUString() );
503 void SbiInstance::Error( ErrCode n, const OUString& rMsg )
505 if( !bWatchMode )
507 aErrorMsg = rMsg;
508 pRun->Error( n );
512 void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const OUString& rMsg )
514 if( !bWatchMode )
516 ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
517 if ( !n )
519 n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors
521 aErrorMsg = rMsg;
522 SbiRuntime::translateErrorToVba( n, aErrorMsg );
524 pRun->Error( ERRCODE_BASIC_COMPAT, true/*bVBATranslationAlreadyDone*/ );
528 void SbiInstance::setErrorVB( sal_Int32 nVBNumber )
530 ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
531 if( !n )
533 n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors
535 aErrorMsg = OUString();
536 SbiRuntime::translateErrorToVba( n, aErrorMsg );
538 nErr = n;
542 void SbiInstance::FatalError( ErrCode n )
544 pRun->FatalError( n );
547 void SbiInstance::FatalError( ErrCode _errCode, const OUString& _details )
549 pRun->FatalError( _errCode, _details );
552 void SbiInstance::Abort()
554 StarBASIC* pErrBasic = GetCurrentBasic( pBasic );
555 pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 );
556 StarBASIC::Stop();
559 // can be unequal to pRTBasic
560 StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic )
562 StarBASIC* pCurBasic = pRTBasic;
563 SbModule* pActiveModule = StarBASIC::GetActiveModule();
564 if( pActiveModule )
566 SbxObject* pParent = pActiveModule->GetParent();
567 if (StarBASIC *pBasic = dynamic_cast<StarBASIC*>(pParent))
568 pCurBasic = pBasic;
570 return pCurBasic;
573 SbModule* SbiInstance::GetActiveModule()
575 if( pRun )
577 return pRun->GetModule();
579 else
581 return nullptr;
585 SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel )
587 SbiRuntime* p = pRun;
588 while( nLevel-- && p )
590 p = p->pNext;
592 return p ? p->GetCaller() : nullptr;
595 // SbiInstance
597 // Attention: pMeth can also be NULL (on a call of the init-code)
599 SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart )
600 : rBasic( *static_cast<StarBASIC*>(pm->pParent) ), pInst( GetSbData()->pInst ),
601 pMod( pm ), pMeth( pe ), pImg( pMod->pImage ), mpExtCaller(nullptr), m_nLastTime(0)
603 nFlags = pe ? pe->GetDebugFlags() : BasicDebugFlags::NONE;
604 pIosys = pInst->GetIoSystem();
605 pForStk = nullptr;
606 pError = nullptr;
607 pErrCode =
608 pErrStmnt =
609 pRestart = nullptr;
610 pNext = nullptr;
611 pCode =
612 pStmnt = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nStart;
613 bRun =
614 bError = true;
615 bInError = false;
616 bBlocked = false;
617 nLine = 0;
618 nCol1 = 0;
619 nCol2 = 0;
620 nExprLvl = 0;
621 nArgc = 0;
622 nError = ERRCODE_NONE;
623 nForLvl = 0;
624 nOps = 0;
625 refExprStk = new SbxArray;
626 SetVBAEnabled( pMod->IsVBACompat() );
627 SetParameters( pe ? pe->GetParameters() : nullptr );
630 SbiRuntime::~SbiRuntime()
632 ClearArgvStack();
633 ClearForStack();
636 void SbiRuntime::SetVBAEnabled(bool bEnabled )
638 bVBAEnabled = bEnabled;
639 if ( bVBAEnabled )
641 if ( pMeth )
643 mpExtCaller = pMeth->mCaller;
646 else
648 mpExtCaller = nullptr;
652 // tdf#79426, tdf#125180 - adds the information about a missing parameter
653 void SbiRuntime::SetIsMissing( SbxVariable* pVar )
655 SbxInfo* pInfo = pVar->GetInfo() ? pVar->GetInfo() : new SbxInfo();
656 pInfo->AddParam( pVar->GetName(), SbxMISSING, pVar->GetFlags() );
657 pVar->SetInfo( pInfo );
660 // tdf#79426, tdf#125180 - checks if a variable contains the information about a missing parameter
661 bool SbiRuntime::IsMissing( SbxVariable* pVar, sal_uInt16 nIdx )
663 return pVar->GetInfo() && pVar->GetInfo()->GetParam( nIdx ) && pVar->GetInfo()->GetParam( nIdx )->eType & SbxMISSING;
666 // Construction of the parameter list. All ByRef-parameters are directly
667 // taken over; copies of ByVal-parameters are created. If a particular
668 // data type is requested, it is converted.
670 void SbiRuntime::SetParameters( SbxArray* pParams )
672 refParams = new SbxArray;
673 // for the return value
674 refParams->Put32( pMeth, 0 );
676 SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : nullptr;
677 sal_uInt32 nParamCount = pParams ? pParams->Count32() : 1;
678 assert(nParamCount <= std::numeric_limits<sal_uInt16>::max());
679 if( nParamCount > 1 )
681 for( sal_uInt32 i = 1 ; i < nParamCount ; i++ )
683 const SbxParamInfo* p = pInfo ? pInfo->GetParam( sal::static_int_cast<sal_uInt16>(i) ) : nullptr;
685 // #111897 ParamArray
686 if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
688 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
689 sal_uInt32 nParamArrayParamCount = nParamCount - i;
690 pArray->unoAddDim32( 0, nParamArrayParamCount - 1 );
691 for (sal_uInt32 j = i; j < nParamCount ; ++j)
693 SbxVariable* v = pParams->Get32( j );
694 sal_Int32 aDimIndex[1];
695 aDimIndex[0] = j - i;
696 pArray->Put32(v, aDimIndex);
698 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
699 pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
700 pArrayVar->PutObject( pArray );
701 refParams->Put32( pArrayVar, i );
703 // Block ParamArray for missing parameter
704 pInfo = nullptr;
705 break;
708 SbxVariable* v = pParams->Get32( i );
709 // methods are always byval!
710 bool bByVal = dynamic_cast<const SbxMethod *>(v) != nullptr;
711 SbxDataType t = v->GetType();
712 bool bTargetTypeIsArray = false;
713 if( p )
715 bByVal |= ( p->eType & SbxBYREF ) == 0;
716 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
717 if ( !IsMissing( v, 1 ) )
719 t = static_cast<SbxDataType>( p->eType & 0x0FFF );
722 if( !bByVal && t != SbxVARIANT &&
723 (!v->IsFixed() || static_cast<SbxDataType>(v->GetType() & 0x0FFF ) != t) )
725 bByVal = true;
728 bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0;
730 if( bByVal )
732 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
733 if( bTargetTypeIsArray && !IsMissing( v, 1 ) )
735 t = SbxOBJECT;
737 SbxVariable* v2 = new SbxVariable( t );
738 v2->SetFlag( SbxFlagBits::ReadWrite );
739 // tdf#79426, tdf#125180 - if parameter was missing, readd additional information about a missing parameter
740 if ( IsMissing( v, 1 ) )
742 SetIsMissing( v2 );
744 *v2 = *v;
745 refParams->Put32( v2, i );
747 else
749 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
750 if( t != SbxVARIANT && !IsMissing( v, 1 ) && t != ( v->GetType() & 0x0FFF ) )
752 if( p && (p->eType & SbxARRAY) )
754 Error( ERRCODE_BASIC_CONVERSION );
756 else
758 v->Convert( t );
761 refParams->Put32( v, i );
763 if( p )
765 refParams->PutAlias32( p->aName, i );
770 // ParamArray for missing parameter
771 if( !pInfo )
772 return;
774 // #111897 Check first missing parameter for ParamArray
775 const SbxParamInfo* p = pInfo->GetParam(sal::static_int_cast<sal_uInt16>(nParamCount));
776 if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
778 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
779 pArray->unoAddDim32( 0, -1 );
780 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
781 pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
782 pArrayVar->PutObject( pArray );
783 refParams->Put32( pArrayVar, nParamCount );
788 // execute a P-Code
790 bool SbiRuntime::Step()
792 if( bRun )
794 // in any case check casually!
795 if( !( ++nOps & 0xF ) && pInst->IsReschedule() )
797 sal_uInt32 nTime = osl_getGlobalTimer();
798 if (nTime - m_nLastTime > 5 ) // 20 ms
800 Application::Reschedule();
801 m_nLastTime = nTime;
805 // #i48868 blocked by next call level?
806 while( bBlocked )
808 if( pInst->IsReschedule() )
810 Application::Reschedule();
814 SbiOpcode eOp = static_cast<SbiOpcode>( *pCode++ );
815 sal_uInt32 nOp1;
816 if (eOp <= SbiOpcode::SbOP0_END)
818 (this->*( aStep0[ int(eOp) ] ) )();
820 else if (eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END)
822 nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
824 (this->*( aStep1[ int(eOp) - int(SbiOpcode::SbOP1_START) ] ) )( nOp1 );
826 else if (eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END)
828 nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
829 sal_uInt32 nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24;
830 (this->*( aStep2[ int(eOp) - int(SbiOpcode::SbOP2_START) ] ) )( nOp1, nOp2 );
832 else
834 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
837 ErrCode nErrCode = SbxBase::GetError();
838 Error( nErrCode.IgnoreWarning() );
840 // from 13.2.1997, new error handling:
841 // ATTENTION: nError can be set already even if !nErrCode
842 // since nError can now also be set from other RT-instances
844 if( nError )
846 SbxBase::ResetError();
849 // from 15.3.96: display errors only if BASIC is still active
850 // (especially not after compiler errors at the runtime)
851 if( nError && bRun )
853 ErrCode err = nError;
854 ClearExprStack();
855 nError = ERRCODE_NONE;
856 pInst->nErr = err;
857 pInst->nErl = nLine;
858 pErrCode = pCode;
859 pErrStmnt = pStmnt;
860 // An error occurred in an error handler
861 // force parent handler ( if there is one )
862 // to handle the error
863 bool bLetParentHandleThis = false;
865 // in the error handler? so std-error
866 if ( !bInError )
868 bInError = true;
870 if( !bError ) // On Error Resume Next
872 StepRESUME( 1 );
874 else if( pError ) // On Error Goto ...
876 pCode = pError;
878 else
880 bLetParentHandleThis = true;
883 else
885 bLetParentHandleThis = true;
886 pError = nullptr; //terminate the handler
888 if ( bLetParentHandleThis )
890 // from 13.2.1997, new error handling:
891 // consider superior error handlers
893 // there's no error handler -> find one farther above
894 SbiRuntime* pRtErrHdl = nullptr;
895 SbiRuntime* pRt = this;
896 while( (pRt = pRt->pNext) != nullptr )
898 if( !pRt->bError || pRt->pError != nullptr )
900 pRtErrHdl = pRt;
901 break;
906 if( pRtErrHdl )
908 // manipulate all the RTs that are below in the call-stack
909 pRt = this;
912 pRt->nError = err;
913 if( pRt != pRtErrHdl )
915 pRt->bRun = false;
917 else
919 break;
921 pRt = pRt->pNext;
923 while( pRt );
925 // no error-hdl found -> old behaviour
926 else
928 pInst->Abort();
933 return bRun;
936 void SbiRuntime::Error( ErrCode n, bool bVBATranslationAlreadyDone )
938 if( !n )
939 return;
941 nError = n;
942 if( !isVBAEnabled() || bVBATranslationAlreadyDone )
943 return;
945 OUString aMsg = pInst->GetErrorMsg();
946 sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
947 SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject().get();
948 SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
949 if( pGlobErr != nullptr )
951 pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
953 pInst->aErrorMsg = aMsg;
954 nError = ERRCODE_BASIC_COMPAT;
957 void SbiRuntime::Error( ErrCode _errCode, const OUString& _details )
959 if ( !_errCode )
960 return;
962 // Not correct for class module usage, remove for now
963 //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" );
964 if ( pInst->pRun == this )
966 pInst->Error( _errCode, _details );
967 //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" );
969 else
971 nError = _errCode;
975 void SbiRuntime::FatalError( ErrCode n )
977 StepSTDERROR();
978 Error( n );
981 void SbiRuntime::FatalError( ErrCode _errCode, const OUString& _details )
983 StepSTDERROR();
984 Error( _errCode, _details );
987 sal_Int32 SbiRuntime::translateErrorToVba( ErrCode nError, OUString& rMsg )
989 // If a message is defined use that ( in preference to
990 // the defined one for the error ) NB #TODO
991 // if there is an error defined it more than likely
992 // is not the one you want ( some are the same though )
993 // we really need a new vba compatible error list
994 if ( rMsg.isEmpty() )
996 StarBASIC::MakeErrorText( nError, rMsg );
997 rMsg = StarBASIC::GetErrorText();
998 if ( rMsg.isEmpty() ) // no message for err no, need localized resource here
1000 rMsg = "Internal Object Error:";
1003 // no num? most likely then it *is* really a vba err
1004 sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
1005 sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? sal_uInt32(nError) : nVBErrorCode;
1006 return nVBAErrorNumber;
1009 // Stacks
1011 // The expression-stack is available for the continuous evaluation
1012 // of expressions.
1014 void SbiRuntime::PushVar( SbxVariable* pVar )
1016 if( pVar )
1018 refExprStk->Put32( pVar, nExprLvl++ );
1022 SbxVariableRef SbiRuntime::PopVar()
1024 #ifdef DBG_UTIL
1025 if( !nExprLvl )
1027 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1028 return new SbxVariable;
1030 #endif
1031 SbxVariableRef xVar = refExprStk->Get32( --nExprLvl );
1032 SAL_INFO_IF( xVar->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
1033 // methods hold themselves in parameter 0
1034 if( dynamic_cast<const SbxMethod *>(xVar.get()) != nullptr )
1036 xVar->SetParameters(nullptr);
1038 return xVar;
1041 void SbiRuntime::ClearExprStack()
1043 // Attention: Clear() doesn't suffice as methods must be deleted
1044 while ( nExprLvl )
1046 PopVar();
1048 refExprStk->Clear();
1051 // Take variable from the expression-stack without removing it
1052 // n counts from 0
1054 SbxVariable* SbiRuntime::GetTOS()
1056 short n = nExprLvl - 1;
1057 #ifdef DBG_UTIL
1058 if( n < 0 )
1060 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1061 return new SbxVariable;
1063 #endif
1064 return refExprStk->Get32( static_cast<sal_uInt32>(n) );
1068 void SbiRuntime::TOSMakeTemp()
1070 SbxVariable* p = refExprStk->Get32( nExprLvl - 1 );
1071 if ( p->GetType() == SbxEMPTY )
1073 p->Broadcast( SfxHintId::BasicDataWanted );
1076 SbxVariable* pDflt = nullptr;
1077 if ( bVBAEnabled && ( p->GetType() == SbxOBJECT || p->GetType() == SbxVARIANT ) && ((pDflt = getDefaultProp(p)) != nullptr) )
1079 pDflt->Broadcast( SfxHintId::BasicDataWanted );
1080 // replacing new p on stack causes object pointed by
1081 // pDft->pParent to be deleted, when p2->Compute() is
1082 // called below pParent is accessed (but it's deleted)
1083 // so set it to NULL now
1084 pDflt->SetParent( nullptr );
1085 p = new SbxVariable( *pDflt );
1086 p->SetFlag( SbxFlagBits::ReadWrite );
1087 refExprStk->Put32( p, nExprLvl - 1 );
1089 else if( p->GetRefCount() != 1 )
1091 SbxVariable* pNew = new SbxVariable( *p );
1092 pNew->SetFlag( SbxFlagBits::ReadWrite );
1093 refExprStk->Put32( pNew, nExprLvl - 1 );
1097 // the GOSUB-stack collects return-addresses for GOSUBs
1098 void SbiRuntime::PushGosub( const sal_uInt8* pc )
1100 if( pGosubStk.size() >= MAXRECURSION )
1102 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
1104 pGosubStk.emplace_back(pc, nForLvl);
1107 void SbiRuntime::PopGosub()
1109 if( pGosubStk.empty() )
1111 Error( ERRCODE_BASIC_NO_GOSUB );
1113 else
1115 pCode = pGosubStk.back().pCode;
1116 pGosubStk.pop_back();
1120 // the Argv-stack collects current argument-vectors
1122 void SbiRuntime::PushArgv()
1124 pArgvStk.emplace_back(refArgv, nArgc);
1125 nArgc = 1;
1126 refArgv.clear();
1129 void SbiRuntime::PopArgv()
1131 if( !pArgvStk.empty() )
1133 refArgv = pArgvStk.back().refArgv;
1134 nArgc = pArgvStk.back().nArgc;
1135 pArgvStk.pop_back();
1140 void SbiRuntime::ClearArgvStack()
1142 while( !pArgvStk.empty() )
1144 PopArgv();
1148 // Push of the for-stack. The stack has increment, end, begin and variable.
1149 // After the creation of the stack-element the stack's empty.
1151 void SbiRuntime::PushFor()
1153 SbiForStack* p = new SbiForStack;
1154 p->eForType = ForType::To;
1155 p->pNext = pForStk;
1156 pForStk = p;
1158 p->refInc = PopVar();
1159 p->refEnd = PopVar();
1160 SbxVariableRef xBgn = PopVar();
1161 p->refVar = PopVar();
1162 // tdf#85371 - grant explicitly write access to the index variable
1163 // since it could be the name of a method itself used in the next statement.
1164 ScopedWritableGuard aGuard(p->refVar, p->refVar.get() == pMeth);
1165 *(p->refVar) = *xBgn;
1166 nForLvl++;
1169 void SbiRuntime::PushForEach()
1171 SbiForStack* p = new SbiForStack;
1172 // Set default value in case of error which is ignored in Resume Next
1173 p->eForType = ForType::EachArray;
1174 p->pNext = pForStk;
1175 pForStk = p;
1177 SbxVariableRef xObjVar = PopVar();
1178 SbxBase* pObj = xObjVar && xObjVar->GetFullType() == SbxOBJECT ? xObjVar->GetObject() : nullptr;
1180 if (SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj))
1182 p->refEnd = reinterpret_cast<SbxVariable*>(pArray);
1184 sal_Int32 nDims = pArray->GetDims32();
1185 p->pArrayLowerBounds.reset( new sal_Int32[nDims] );
1186 p->pArrayUpperBounds.reset( new sal_Int32[nDims] );
1187 p->pArrayCurIndices.reset( new sal_Int32[nDims] );
1188 sal_Int32 lBound, uBound;
1189 for( sal_Int32 i = 0 ; i < nDims ; i++ )
1191 pArray->GetDim32( i+1, lBound, uBound );
1192 p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
1193 p->pArrayUpperBounds[i] = uBound;
1196 else if (BasicCollection* pCollection = dynamic_cast<BasicCollection*>(pObj))
1198 p->eForType = ForType::EachCollection;
1199 p->refEnd = pCollection;
1200 p->nCurCollectionIndex = 0;
1202 else if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
1204 // XEnumerationAccess?
1205 Any aAny = pUnoObj->getUnoAny();
1206 Reference< XEnumerationAccess > xEnumerationAccess;
1207 if( aAny >>= xEnumerationAccess )
1209 p->xEnumeration = xEnumerationAccess->createEnumeration();
1210 p->eForType = ForType::EachXEnumeration;
1212 else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
1214 uno::Reference< script::XInvocation > xInvocation;
1215 if ( ( aAny >>= xInvocation ) && xInvocation.is() )
1219 p->xEnumeration = new ComEnumerationWrapper( xInvocation );
1220 p->eForType = ForType::EachXEnumeration;
1222 catch(const uno::Exception& )
1228 // Container variable
1229 p->refVar = PopVar();
1230 nForLvl++;
1234 void SbiRuntime::PopFor()
1236 if( pForStk )
1238 SbiForStack* p = pForStk;
1239 pForStk = p->pNext;
1240 delete p;
1241 nForLvl--;
1246 void SbiRuntime::ClearForStack()
1248 while( pForStk )
1250 PopFor();
1254 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection const * pCollection )
1256 for (SbiForStack *p = pForStk; p; p = p->pNext)
1258 SbxVariable* pVar = p->refEnd.is() ? p->refEnd.get() : nullptr;
1259 if( p->eForType == ForType::EachCollection
1260 && pVar != nullptr
1261 && dynamic_cast<BasicCollection*>( pVar) == pCollection )
1263 return p;
1267 return nullptr;
1271 // DLL-calls
1273 void SbiRuntime::DllCall
1274 ( const OUString& aFuncName,
1275 const OUString& aDLLName,
1276 SbxArray* pArgs, // parameter (from index 1, can be NULL)
1277 SbxDataType eResType, // return value
1278 bool bCDecl ) // true: according to C-conventions
1280 // NOT YET IMPLEMENTED
1282 SbxVariable* pRes = new SbxVariable( eResType );
1283 SbiDllMgr* pDllMgr = pInst->GetDllMgr();
1284 ErrCode nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
1285 if( nErr )
1287 Error( nErr );
1289 PushVar( pRes );
1292 bool SbiRuntime::IsImageFlag( SbiImageFlags n ) const
1294 return pImg->IsFlag( n );
1297 sal_uInt16 SbiRuntime::GetBase() const
1299 return pImg->GetBase();
1302 void SbiRuntime::StepNOP()
1305 void SbiRuntime::StepArith( SbxOperator eOp )
1307 SbxVariableRef p1 = PopVar();
1308 TOSMakeTemp();
1309 SbxVariable* p2 = GetTOS();
1311 p2->ResetFlag( SbxFlagBits::Fixed );
1312 p2->Compute( eOp, *p1 );
1314 checkArithmeticOverflow( p2 );
1317 void SbiRuntime::StepUnary( SbxOperator eOp )
1319 TOSMakeTemp();
1320 SbxVariable* p = GetTOS();
1321 p->Compute( eOp, *p );
1324 void SbiRuntime::StepCompare( SbxOperator eOp )
1326 SbxVariableRef p1 = PopVar();
1327 SbxVariableRef p2 = PopVar();
1329 // Make sure objects with default params have
1330 // values ( and type ) set as appropriate
1331 SbxDataType p1Type = p1->GetType();
1332 SbxDataType p2Type = p2->GetType();
1333 if ( p1Type == SbxEMPTY )
1335 p1->Broadcast( SfxHintId::BasicDataWanted );
1336 p1Type = p1->GetType();
1338 if ( p2Type == SbxEMPTY )
1340 p2->Broadcast( SfxHintId::BasicDataWanted );
1341 p2Type = p2->GetType();
1343 if ( p1Type == p2Type )
1345 // if both sides are an object and have default props
1346 // then we need to use the default props
1347 // we don't need to worry if only one side ( lhs, rhs ) is an
1348 // object ( object side will get coerced to correct type in
1349 // Compare )
1350 if ( p1Type == SbxOBJECT )
1352 SbxVariable* pDflt = getDefaultProp( p1.get() );
1353 if ( pDflt )
1355 p1 = pDflt;
1356 p1->Broadcast( SfxHintId::BasicDataWanted );
1358 pDflt = getDefaultProp( p2.get() );
1359 if ( pDflt )
1361 p2 = pDflt;
1362 p2->Broadcast( SfxHintId::BasicDataWanted );
1367 static SbxVariable* pTRUE = nullptr;
1368 static SbxVariable* pFALSE = nullptr;
1369 // why do this on non-windows ?
1370 // why do this at all ?
1371 // I dumbly follow the pattern :-/
1372 if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
1374 static SbxVariable* pNULL = [&]() {
1375 SbxVariable* p = new SbxVariable;
1376 p->PutNull();
1377 p->AddFirstRef();
1378 return p;
1379 }();
1380 PushVar( pNULL );
1382 else if( p2->Compare( eOp, *p1 ) )
1384 if( !pTRUE )
1386 pTRUE = new SbxVariable;
1387 pTRUE->PutBool( true );
1388 pTRUE->AddFirstRef();
1390 PushVar( pTRUE );
1392 else
1394 if( !pFALSE )
1396 pFALSE = new SbxVariable;
1397 pFALSE->PutBool( false );
1398 pFALSE->AddFirstRef();
1400 PushVar( pFALSE );
1404 void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
1405 void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
1406 void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
1407 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
1408 void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
1409 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
1410 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
1411 void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
1412 void SbiRuntime::StepAND() { StepArith( SbxAND ); }
1413 void SbiRuntime::StepOR() { StepArith( SbxOR ); }
1414 void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
1415 void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
1416 void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
1418 void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
1419 void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
1421 void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
1422 void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
1423 void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
1424 void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
1425 void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
1426 void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
1428 namespace
1430 bool NeedEsc(sal_Unicode cCode)
1432 if(!rtl::isAscii(cCode))
1434 return false;
1436 switch(cCode)
1438 case '.':
1439 case '^':
1440 case '$':
1441 case '+':
1442 case '\\':
1443 case '|':
1444 case '{':
1445 case '}':
1446 case '(':
1447 case ')':
1448 return true;
1449 default:
1450 return false;
1454 OUString VBALikeToRegexp(const OUString &rIn)
1456 OUStringBuffer sResult;
1457 const sal_Unicode *start = rIn.getStr();
1458 const sal_Unicode *end = start + rIn.getLength();
1460 int seenright = 0;
1462 sResult.append('^');
1464 while (start < end)
1466 switch (*start)
1468 case '?':
1469 sResult.append('.');
1470 start++;
1471 break;
1472 case '*':
1473 sResult.append(".*");
1474 start++;
1475 break;
1476 case '#':
1477 sResult.append("[0-9]");
1478 start++;
1479 break;
1480 case ']':
1481 sResult.append('\\');
1482 sResult.append(*start++);
1483 break;
1484 case '[':
1485 sResult.append(*start++);
1486 seenright = 0;
1487 while (start < end && !seenright)
1489 switch (*start)
1491 case '[':
1492 case '?':
1493 case '*':
1494 sResult.append('\\');
1495 sResult.append(*start);
1496 break;
1497 case ']':
1498 sResult.append(*start);
1499 seenright = 1;
1500 break;
1501 case '!':
1502 sResult.append('^');
1503 break;
1504 default:
1505 if (NeedEsc(*start))
1507 sResult.append('\\');
1509 sResult.append(*start);
1510 break;
1512 start++;
1514 break;
1515 default:
1516 if (NeedEsc(*start))
1518 sResult.append('\\');
1520 sResult.append(*start++);
1524 sResult.append('$');
1526 return sResult.makeStringAndClear();
1530 void SbiRuntime::StepLIKE()
1532 SbxVariableRef refVar1 = PopVar();
1533 SbxVariableRef refVar2 = PopVar();
1535 OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
1536 OUString value = refVar2->GetOUString();
1538 i18nutil::SearchOptions2 aSearchOpt;
1540 aSearchOpt.AlgorithmType2 = css::util::SearchAlgorithms2::REGEXP;
1542 aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
1543 aSearchOpt.searchString = pattern;
1545 bool bTextMode(true);
1546 bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
1547 if( bCompatibility )
1549 bTextMode = IsImageFlag( SbiImageFlags::COMPARETEXT );
1551 if( bTextMode )
1553 aSearchOpt.transliterateFlags |= TransliterationFlags::IGNORE_CASE;
1555 SbxVariable* pRes = new SbxVariable;
1556 utl::TextSearch aSearch( aSearchOpt);
1557 sal_Int32 nStart=0, nEnd=value.getLength();
1558 bool bRes = aSearch.SearchForward(value, &nStart, &nEnd);
1559 pRes->PutBool( bRes );
1561 PushVar( pRes );
1564 // TOS and TOS-1 are both object variables and contain the same pointer
1566 void SbiRuntime::StepIS()
1568 SbxVariableRef refVar1 = PopVar();
1569 SbxVariableRef refVar2 = PopVar();
1571 SbxDataType eType1 = refVar1->GetType();
1572 SbxDataType eType2 = refVar2->GetType();
1573 if ( eType1 == SbxEMPTY )
1575 refVar1->Broadcast( SfxHintId::BasicDataWanted );
1576 eType1 = refVar1->GetType();
1578 if ( eType2 == SbxEMPTY )
1580 refVar2->Broadcast( SfxHintId::BasicDataWanted );
1581 eType2 = refVar2->GetType();
1584 bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
1585 if ( bVBAEnabled && !bRes )
1587 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1589 bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
1590 SbxVariable* pRes = new SbxVariable;
1591 pRes->PutBool( bRes );
1592 PushVar( pRes );
1595 // update the value of TOS
1597 void SbiRuntime::StepGET()
1599 SbxVariable* p = GetTOS();
1600 p->Broadcast( SfxHintId::BasicDataWanted );
1603 // #67607 copy Uno-Structs
1604 static bool checkUnoStructCopy( bool bVBA, SbxVariableRef const & refVal, SbxVariableRef const & refVar )
1606 SbxDataType eVarType = refVar->GetType();
1607 SbxDataType eValType = refVal->GetType();
1609 if ( ( bVBA && ( eVarType == SbxEMPTY ) ) || !refVar->CanWrite() )
1610 return false;
1612 if ( eValType != SbxOBJECT )
1613 return false;
1614 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1615 // there :-/ not sure if for every '=' we would want struct handling
1616 if( eVarType != SbxOBJECT )
1618 if ( refVar->IsFixed() )
1619 return false;
1621 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1622 else if( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr )
1623 return false;
1625 SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject());
1626 if( !xValObj.is() || dynamic_cast<const SbUnoAnyObject*>( xValObj.get() ) != nullptr )
1627 return false;
1629 SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() );
1630 SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() );
1631 Any aAny;
1632 // make doubly sure value is either a Uno object or
1633 // a uno struct
1634 if ( pUnoVal || pUnoStructVal )
1635 aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
1636 else
1637 return false;
1638 if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
1640 refVar->SetType( SbxOBJECT );
1641 ErrCode eOldErr = SbxBase::GetError();
1642 // There are some circumstances when calling GetObject
1643 // will trigger an error, we need to squash those here.
1644 // Alternatively it is possible that the same scenario
1645 // could overwrite and existing error. Lets prevent that
1646 SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject());
1647 if ( eOldErr != ERRCODE_NONE )
1648 SbxBase::SetError( eOldErr );
1649 else
1650 SbxBase::ResetError();
1652 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( xVarObj.get() );
1654 OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
1655 OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
1657 if ( pUnoStructObj )
1659 StructRefInfo aInfo = pUnoStructObj->getStructInfo();
1660 aInfo.setValue( aAny );
1662 else
1664 SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
1665 // #70324: adopt ClassName
1666 pNewUnoObj->SetClassName( sClassName );
1667 refVar->PutObject( pNewUnoObj );
1669 return true;
1671 return false;
1675 // laying down TOS in TOS-1
1677 void SbiRuntime::StepPUT()
1679 SbxVariableRef refVal = PopVar();
1680 SbxVariableRef refVar = PopVar();
1681 // store on its own method (inside a function)?
1682 bool bFlagsChanged = false;
1683 SbxFlagBits n = SbxFlagBits::NONE;
1684 if( refVar.get() == pMeth )
1686 bFlagsChanged = true;
1687 n = refVar->GetFlags();
1688 refVar->SetFlag( SbxFlagBits::Write );
1691 // if left side arg is an object or variant and right handside isn't
1692 // either an object or a variant then try and see if a default
1693 // property exists.
1694 // to use e.g. Range{"A1") = 34
1695 // could equate to Range("A1").Value = 34
1696 if ( bVBAEnabled )
1698 // yet more hacking at this, I feel we don't quite have the correct
1699 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1700 // obj1 ) has default member/property ) ) It seems that default props
1701 // aren't dealt with if the object is a member of some parent object
1702 bool bObjAssign = false;
1703 if ( refVar->GetType() == SbxEMPTY )
1704 refVar->Broadcast( SfxHintId::BasicDataWanted );
1705 if ( refVar->GetType() == SbxOBJECT )
1707 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
1709 SbxVariable* pDflt = getDefaultProp( refVar.get() );
1711 if ( pDflt )
1712 refVar = pDflt;
1714 else
1715 bObjAssign = true;
1717 if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( dynamic_cast<const SbxMethod *>(refVal.get()) != nullptr || ! refVal->GetParent() ) )
1719 SbxVariable* pDflt = getDefaultProp( refVal.get() );
1720 if ( pDflt )
1721 refVal = pDflt;
1725 if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
1726 *refVar = *refVal;
1728 if( bFlagsChanged )
1729 refVar->SetFlags( n );
1732 namespace {
1734 // VBA Dim As New behavior handling, save init object information
1735 struct DimAsNewRecoverItem
1737 OUString m_aObjClass;
1738 OUString m_aObjName;
1739 SbxObject* m_pObjParent;
1740 SbModule* m_pClassModule;
1742 DimAsNewRecoverItem()
1743 : m_pObjParent( nullptr )
1744 , m_pClassModule( nullptr )
1747 DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
1748 SbxObject* pObjParent, SbModule* pClassModule )
1749 : m_aObjClass( rObjClass )
1750 , m_aObjName( rObjName )
1751 , m_pObjParent( pObjParent )
1752 , m_pClassModule( pClassModule )
1758 struct SbxVariablePtrHash
1760 size_t operator()( SbxVariable* pVar ) const
1761 { return reinterpret_cast<size_t>(pVar); }
1766 typedef std::unordered_map< SbxVariable*, DimAsNewRecoverItem,
1767 SbxVariablePtrHash > DimAsNewRecoverHash;
1769 namespace {
1771 class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
1775 void removeDimAsNewRecoverItem( SbxVariable* pVar )
1777 DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1778 DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
1779 if( it != rDimAsNewRecoverHash.end() )
1781 rDimAsNewRecoverHash.erase( it );
1786 // saving object variable
1787 // not-object variables will cause errors
1789 const char pCollectionStr[] = "Collection";
1791 void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
1793 // #67733 types with array-flag are OK too
1795 // Check var, !object is no error for sure if, only if type is fixed
1796 SbxDataType eVarType = refVar->GetType();
1797 if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
1799 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1800 return;
1803 // Check value, !object is no error for sure if, only if type is fixed
1804 SbxDataType eValType = refVal->GetType();
1805 if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
1807 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1808 return;
1811 // Getting in here causes problems with objects with default properties
1812 // if they are SbxEMPTY I guess
1813 if ( !bHandleDefaultProp || eValType == SbxOBJECT )
1815 // activate GetObject for collections on refVal
1816 SbxBase* pObjVarObj = refVal->GetObject();
1817 if( pObjVarObj )
1819 SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj );
1821 if( refObjVal.is() )
1823 refVal = refObjVal;
1825 else if( !(eValType & SbxARRAY) )
1827 refVal = nullptr;
1832 // #52896 refVal can be invalid here, if uno-sequences - or more
1833 // general arrays - are assigned to variables that are declared
1834 // as an object!
1835 if( !refVal.is() )
1837 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1839 else
1841 bool bFlagsChanged = false;
1842 SbxFlagBits n = SbxFlagBits::NONE;
1843 if( refVar.get() == pMeth )
1845 bFlagsChanged = true;
1846 n = refVar->GetFlags();
1847 refVar->SetFlag( SbxFlagBits::Write );
1849 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() );
1850 if( pProcProperty )
1852 pProcProperty->setSet( true );
1854 if ( bHandleDefaultProp )
1856 // get default properties for lhs & rhs where necessary
1857 // SbxVariable* defaultProp = NULL; unused variable
1858 // LHS try determine if a default prop exists
1859 // again like in StepPUT (see there too ) we are tweaking the
1860 // heuristics again for when to assign an object reference or
1861 // use default members if they exist
1862 // #FIXME we really need to get to the bottom of this mess
1863 bool bObjAssign = false;
1864 if ( refVar->GetType() == SbxOBJECT )
1866 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
1868 SbxVariable* pDflt = getDefaultProp( refVar.get() );
1869 if ( pDflt )
1871 refVar = pDflt;
1874 else
1875 bObjAssign = true;
1877 // RHS only get a default prop is the rhs has one
1878 if ( refVal->GetType() == SbxOBJECT )
1880 // check if lhs is a null object
1881 // if it is then use the object not the default property
1882 SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() );
1884 // calling GetObject on a SbxEMPTY variable raises
1885 // object not set errors, make sure it's an Object
1886 if ( !pObj && refVar->GetType() == SbxOBJECT )
1888 SbxBase* pObjVarObj = refVar->GetObject();
1889 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
1891 SbxVariable* pDflt = nullptr;
1892 if ( pObj && !bObjAssign )
1894 // lhs is either a valid object || or has a defaultProp
1895 pDflt = getDefaultProp( refVal.get() );
1897 if ( pDflt )
1899 refVal = pDflt;
1904 // Handle Dim As New
1905 bool bDimAsNew = bVBAEnabled && refVar->IsSet( SbxFlagBits::DimAsNew );
1906 SbxBaseRef xPrevVarObj;
1907 if( bDimAsNew )
1909 xPrevVarObj = refVar->GetObject();
1911 // Handle withevents
1912 bool bWithEvents = refVar->IsSet( SbxFlagBits::WithEvents );
1913 if ( bWithEvents )
1915 Reference< XInterface > xComListener;
1917 SbxBase* pObj = refVal->GetObject();
1918 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
1919 if( pUnoObj != nullptr )
1921 Any aControlAny = pUnoObj->getUnoAny();
1922 OUString aDeclareClassName = refVar->GetDeclareClassName();
1923 OUString aPrefix = refVar->GetName();
1924 SbxObjectRef xScopeObj = refVar->GetParent();
1925 xComListener = createComListener( aControlAny, aDeclareClassName, aPrefix, xScopeObj );
1927 refVal->SetDeclareClassName( aDeclareClassName );
1928 refVal->SetComListener( xComListener, &rBasic ); // Hold reference
1933 // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1934 // in this case if there is a default prop involved the value of the
1935 // default property may in fact be void so the type will also be SbxEMPTY
1936 // in this case we do not want to call checkUnoStructCopy 'cause that will
1937 // cause an error also
1938 if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
1940 *refVar = *refVal;
1942 if ( bDimAsNew )
1944 if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr )
1946 SbxBase* pValObjBase = refVal->GetObject();
1947 if( pValObjBase == nullptr )
1949 if( xPrevVarObj.is() )
1951 // Object is overwritten with NULL, instantiate init object
1952 DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1953 DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar.get() );
1954 if( it != rDimAsNewRecoverHash.end() )
1956 const DimAsNewRecoverItem& rItem = it->second;
1957 if( rItem.m_pClassModule != nullptr )
1959 SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
1960 pNewObj->SetName( rItem.m_aObjName );
1961 pNewObj->SetParent( rItem.m_pObjParent );
1962 refVar->PutObject( pNewObj );
1964 else if( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) )
1966 BasicCollection* pNewCollection = new BasicCollection( pCollectionStr );
1967 pNewCollection->SetName( rItem.m_aObjName );
1968 pNewCollection->SetParent( rItem.m_pObjParent );
1969 refVar->PutObject( pNewCollection );
1974 else
1976 // Does old value exist?
1977 bool bFirstInit = !xPrevVarObj.is();
1978 if( bFirstInit )
1980 // Store information to instantiate object later
1981 SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase );
1982 if( pValObj != nullptr )
1984 OUString aObjClass = pValObj->GetClassName();
1986 SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pValObjBase );
1987 DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1988 if( pClassModuleObj != nullptr )
1990 SbModule* pClassModule = pClassModuleObj->getClassModule();
1991 rDimAsNewRecoverHash[refVar.get()] =
1992 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
1994 else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
1996 rDimAsNewRecoverHash[refVar.get()] =
1997 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), nullptr );
2005 if( bFlagsChanged )
2007 refVar->SetFlags( n );
2012 void SbiRuntime::StepSET()
2014 SbxVariableRef refVal = PopVar();
2015 SbxVariableRef refVar = PopVar();
2016 StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assignment
2019 void SbiRuntime::StepVBASET()
2021 SbxVariableRef refVal = PopVar();
2022 SbxVariableRef refVar = PopVar();
2023 // don't handle default property
2024 StepSET_Impl( refVal, refVar ); // set obj = something
2028 void SbiRuntime::StepLSET()
2030 SbxVariableRef refVal = PopVar();
2031 SbxVariableRef refVar = PopVar();
2032 if( refVar->GetType() != SbxSTRING ||
2033 refVal->GetType() != SbxSTRING )
2035 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
2037 else
2039 SbxFlagBits n = refVar->GetFlags();
2040 if( refVar.get() == pMeth )
2042 refVar->SetFlag( SbxFlagBits::Write );
2044 OUString aRefVarString = refVar->GetOUString();
2045 OUString aRefValString = refVal->GetOUString();
2047 sal_Int32 nVarStrLen = aRefVarString.getLength();
2048 sal_Int32 nValStrLen = aRefValString.getLength();
2049 OUString aNewStr;
2050 if( nVarStrLen > nValStrLen )
2052 OUStringBuffer buf(aRefValString);
2053 comphelper::string::padToLength(buf, nVarStrLen, ' ');
2054 aNewStr = buf.makeStringAndClear();
2056 else
2058 aNewStr = aRefValString.copy( 0, nVarStrLen );
2061 refVar->PutString(aNewStr);
2062 refVar->SetFlags( n );
2066 void SbiRuntime::StepRSET()
2068 SbxVariableRef refVal = PopVar();
2069 SbxVariableRef refVar = PopVar();
2070 if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
2072 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
2074 else
2076 SbxFlagBits n = refVar->GetFlags();
2077 if( refVar.get() == pMeth )
2079 refVar->SetFlag( SbxFlagBits::Write );
2081 OUString aRefVarString = refVar->GetOUString();
2082 OUString aRefValString = refVal->GetOUString();
2083 sal_Int32 nVarStrLen = aRefVarString.getLength();
2084 sal_Int32 nValStrLen = aRefValString.getLength();
2086 OUStringBuffer aNewStr(nVarStrLen);
2087 if (nVarStrLen > nValStrLen)
2089 comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
2090 aNewStr.append(aRefValString);
2092 else
2094 aNewStr.append(std::u16string_view(aRefValString).substr(0, nVarStrLen));
2096 refVar->PutString(aNewStr.makeStringAndClear());
2098 refVar->SetFlags( n );
2102 // laying down TOS in TOS-1, then set ReadOnly-Bit
2104 void SbiRuntime::StepPUTC()
2106 SbxVariableRef refVal = PopVar();
2107 SbxVariableRef refVar = PopVar();
2108 refVar->SetFlag( SbxFlagBits::Write );
2109 *refVar = *refVal;
2110 refVar->ResetFlag( SbxFlagBits::Write );
2111 refVar->SetFlag( SbxFlagBits::Const );
2114 // DIM
2115 // TOS = variable for the array with dimension information as parameter
2117 void SbiRuntime::StepDIM()
2119 SbxVariableRef refVar = PopVar();
2120 DimImpl( refVar );
2123 // #56204 swap out DIM-functionality into a help method (step0.cxx)
2124 void SbiRuntime::DimImpl(const SbxVariableRef& refVar)
2126 // If refDim then this DIM statement is terminating a ReDIM and
2127 // previous StepERASE_CLEAR for an array, the following actions have
2128 // been delayed from ( StepERASE_CLEAR ) 'till here
2129 if ( refRedim.is() )
2131 if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve
2133 lcl_eraseImpl( refVar, bVBAEnabled );
2135 SbxDataType eType = refVar->GetType();
2136 lcl_clearImpl( refVar, eType );
2137 refRedim = nullptr;
2139 SbxArray* pDims = refVar->GetParameters();
2140 // must have an even number of arguments
2141 // have in mind that Arg[0] does not count!
2142 if( pDims && !( pDims->Count32() & 1 ) )
2144 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2146 else
2148 SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
2149 SbxDimArray* pArray = new SbxDimArray( eType );
2150 // allow arrays without dimension information, too (VB-compatible)
2151 if( pDims )
2153 refVar->ResetFlag( SbxFlagBits::VarToDim );
2155 for( sal_uInt32 i = 1; i < pDims->Count32(); )
2157 sal_Int32 lb = pDims->Get32( i++ )->GetLong();
2158 sal_Int32 ub = pDims->Get32( i++ )->GetLong();
2159 if( ub < lb )
2161 Error( ERRCODE_BASIC_OUT_OF_RANGE );
2162 ub = lb;
2164 pArray->AddDim32( lb, ub );
2165 if ( lb != ub )
2167 pArray->setHasFixedSize( true );
2171 else
2173 // #62867 On creating an array of the length 0, create
2174 // a dimension (like for Uno-Sequences of the length 0)
2175 pArray->unoAddDim32( 0, -1 );
2177 SbxFlagBits nSavFlags = refVar->GetFlags();
2178 refVar->ResetFlag( SbxFlagBits::Fixed );
2179 refVar->PutObject( pArray );
2180 refVar->SetFlags( nSavFlags );
2181 refVar->SetParameters( nullptr );
2185 // REDIM
2186 // TOS = variable for the array
2187 // argv = dimension information
2189 void SbiRuntime::StepREDIM()
2191 // Nothing different than dim at the moment because
2192 // a double dim is already recognized by the compiler.
2193 StepDIM();
2197 // Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true
2198 static void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, sal_Int32 nMaxDimIndex,
2199 sal_Int32 nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
2201 sal_Int32& ri = pActualIndices[nActualDim];
2202 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
2204 if( nActualDim < nMaxDimIndex )
2206 implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
2207 pActualIndices, pLowerBounds, pUpperBounds );
2209 else
2211 SbxVariable* pSource = pOldArray->Get32( pActualIndices );
2212 if (pSource && pOldArray->GetRefCount() > 1)
2213 // tdf#134692: old array will stay alive after the redim - we need to copy deep
2214 pSource = new SbxVariable(*pSource);
2215 pNewArray->Put32(pSource, pActualIndices);
2220 // Returns true when actually restored
2221 static bool implRestorePreservedArray(SbxDimArray* pNewArray, SbxArrayRef& rrefRedimpArray, bool* pbWasError = nullptr)
2223 assert(pNewArray);
2224 bool bResult = false;
2225 if (pbWasError)
2226 *pbWasError = false;
2227 if (rrefRedimpArray)
2229 SbxDimArray* pOldArray = static_cast<SbxDimArray*>(rrefRedimpArray.get());
2230 const sal_Int32 nDimsNew = pNewArray->GetDims32();
2231 const sal_Int32 nDimsOld = pOldArray->GetDims32();
2233 if (nDimsOld != nDimsNew)
2235 StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE);
2236 if (pbWasError)
2237 *pbWasError = true;
2239 else if (nDimsNew > 0)
2241 // Store dims to use them for copying later
2242 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDimsNew]);
2243 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDimsNew]);
2244 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDimsNew]);
2245 bool bNeedsPreallocation = true;
2247 // Compare bounds
2248 for (sal_Int32 i = 1; i <= nDimsNew; i++)
2250 sal_Int32 lBoundNew, uBoundNew;
2251 sal_Int32 lBoundOld, uBoundOld;
2252 pNewArray->GetDim32(i, lBoundNew, uBoundNew);
2253 pOldArray->GetDim32(i, lBoundOld, uBoundOld);
2254 lBoundNew = std::max(lBoundNew, lBoundOld);
2255 uBoundNew = std::min(uBoundNew, uBoundOld);
2256 sal_Int32 j = i - 1;
2257 pActualIndices[j] = pLowerBounds[j] = lBoundNew;
2258 pUpperBounds[j] = uBoundNew;
2259 if (lBoundNew > uBoundNew) // No elements in the dimension -> no elements to restore
2260 bNeedsPreallocation = false;
2263 // Optimization: pre-allocate underlying container
2264 if (bNeedsPreallocation)
2265 pNewArray->Put32(nullptr, pUpperBounds.get());
2267 // Copy data from old array by going recursively through all dimensions
2268 // (It would be faster to work on the flat internal data array of an
2269 // SbyArray but this solution is clearer and easier)
2270 implCopyDimArray(pNewArray, pOldArray, nDimsNew - 1, 0, pActualIndices.get(),
2271 pLowerBounds.get(), pUpperBounds.get());
2272 bResult = true;
2275 rrefRedimpArray.clear();
2277 return bResult;
2280 // REDIM PRESERVE
2281 // TOS = variable for the array
2282 // argv = dimension information
2284 void SbiRuntime::StepREDIMP()
2286 SbxVariableRef refVar = PopVar();
2287 DimImpl( refVar );
2289 // Now check, if we can copy from the old array
2290 if( refRedimpArray.is() )
2292 if (SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>(refVar->GetObject()))
2293 implRestorePreservedArray(pNewArray, refRedimpArray);
2297 // REDIM_COPY
2298 // TOS = Array-Variable, Reference to array is copied
2299 // Variable is cleared as in ERASE
2301 void SbiRuntime::StepREDIMP_ERASE()
2303 SbxVariableRef refVar = PopVar();
2304 refRedim = refVar;
2305 SbxDataType eType = refVar->GetType();
2306 if( eType & SbxARRAY )
2308 SbxBase* pElemObj = refVar->GetObject();
2309 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
2310 if( pDimArray )
2312 refRedimpArray = pDimArray;
2316 else if( refVar->IsFixed() )
2318 refVar->Clear();
2320 else
2322 refVar->SetType( SbxEMPTY );
2326 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType )
2328 SbxFlagBits nSavFlags = refVar->GetFlags();
2329 refVar->ResetFlag( SbxFlagBits::Fixed );
2330 refVar->SetType( SbxDataType(eType & 0x0FFF) );
2331 refVar->SetFlags( nSavFlags );
2332 refVar->Clear();
2335 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled )
2337 SbxDataType eType = refVar->GetType();
2338 if( eType & SbxARRAY )
2340 if ( bVBAEnabled )
2342 SbxBase* pElemObj = refVar->GetObject();
2343 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
2344 if( pDimArray )
2346 if ( pDimArray->hasFixedSize() )
2348 // Clear all Value(s)
2349 pDimArray->SbxArray::Clear();
2351 else
2353 pDimArray->Clear(); // clear dims and values
2356 else
2358 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
2359 if ( pArray )
2361 pArray->Clear();
2365 else
2367 // Arrays have on an erase to VB quite a complex behaviour. Here are
2368 // only the type problems at REDIM (#26295) removed at first:
2369 // Set type hard onto the array-type, because a variable with array is
2370 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2371 // the original type is lost -> runtime error
2372 lcl_clearImpl( refVar, eType );
2375 else if( refVar->IsFixed() )
2377 refVar->Clear();
2379 else
2381 refVar->SetType( SbxEMPTY );
2385 // delete variable
2386 // TOS = variable
2388 void SbiRuntime::StepERASE()
2390 SbxVariableRef refVar = PopVar();
2391 lcl_eraseImpl( refVar, bVBAEnabled );
2394 void SbiRuntime::StepERASE_CLEAR()
2396 refRedim = PopVar();
2399 void SbiRuntime::StepARRAYACCESS()
2401 if( !refArgv.is() )
2403 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2405 SbxVariableRef refVar = PopVar();
2406 refVar->SetParameters( refArgv.get() );
2407 PopArgv();
2408 PushVar( CheckArray( refVar.get() ) );
2411 void SbiRuntime::StepBYVAL()
2413 // Copy variable on stack to break call by reference
2414 SbxVariableRef pVar = PopVar();
2415 SbxDataType t = pVar->GetType();
2417 SbxVariable* pCopyVar = new SbxVariable( t );
2418 pCopyVar->SetFlag( SbxFlagBits::ReadWrite );
2419 *pCopyVar = *pVar;
2421 PushVar( pCopyVar );
2424 // establishing an argv
2425 // nOp1 stays as it is -> 1st element is the return value
2427 void SbiRuntime::StepARGC()
2429 PushArgv();
2430 refArgv = new SbxArray;
2431 nArgc = 1;
2434 // storing an argument in Argv
2436 void SbiRuntime::StepARGV()
2438 if( !refArgv.is() )
2440 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2442 else
2444 SbxVariableRef pVal = PopVar();
2446 // Before fix of #94916:
2447 if( dynamic_cast<const SbxMethod*>( pVal.get() ) != nullptr
2448 || dynamic_cast<const SbUnoProperty*>( pVal.get() ) != nullptr
2449 || dynamic_cast<const SbProcedureProperty*>( pVal.get() ) != nullptr )
2451 // evaluate methods and properties!
2452 SbxVariable* pRes = new SbxVariable( *pVal );
2453 pVal = pRes;
2455 refArgv->Put32( pVal.get(), nArgc++ );
2459 // Input to Variable. The variable is on TOS and is
2460 // is removed afterwards.
2461 void SbiRuntime::StepINPUT()
2463 OUStringBuffer sin;
2464 char ch = 0;
2465 ErrCode err;
2466 // Skip whitespace
2467 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2469 ch = pIosys->Read();
2470 if( ch != ' ' && ch != '\t' && ch != '\n' )
2472 break;
2475 if( !err )
2477 // Scan until comma or whitespace
2478 char sep = ( ch == '"' ) ? ch : 0;
2479 if( sep )
2481 ch = pIosys->Read();
2483 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2485 if( ch == sep )
2487 ch = pIosys->Read();
2488 if( ch != sep )
2490 break;
2493 else if( !sep && (ch == ',' || ch == '\n') )
2495 break;
2497 sin.append( ch );
2498 ch = pIosys->Read();
2500 // skip whitespace
2501 if( ch == ' ' || ch == '\t' )
2503 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2505 if( ch != ' ' && ch != '\t' && ch != '\n' )
2507 break;
2509 ch = pIosys->Read();
2513 if( !err )
2515 OUString s = sin.makeStringAndClear();
2516 SbxVariableRef pVar = GetTOS();
2517 // try to fill the variable with a numeric value first,
2518 // then with a string value
2519 if( !pVar->IsFixed() || pVar->IsNumeric() )
2521 sal_uInt16 nLen = 0;
2522 if( !pVar->Scan( s, &nLen ) )
2524 err = SbxBase::GetError();
2525 SbxBase::ResetError();
2527 // the value has to be scanned in completely
2528 else if( nLen != s.getLength() && !pVar->PutString( s ) )
2530 err = SbxBase::GetError();
2531 SbxBase::ResetError();
2533 else if( nLen != s.getLength() && pVar->IsNumeric() )
2535 err = SbxBase::GetError();
2536 SbxBase::ResetError();
2537 if( !err )
2539 err = ERRCODE_BASIC_CONVERSION;
2543 else
2545 pVar->PutString( s );
2546 err = SbxBase::GetError();
2547 SbxBase::ResetError();
2550 if( err == ERRCODE_BASIC_USER_ABORT )
2552 Error( err );
2554 else if( err )
2556 if( pRestart && !pIosys->GetChannel() )
2558 pCode = pRestart;
2560 else
2562 Error( err );
2565 else
2567 PopVar();
2571 // Line Input to Variable. The variable is on TOS and is
2572 // deleted afterwards.
2574 void SbiRuntime::StepLINPUT()
2576 OString aInput;
2577 pIosys->Read( aInput );
2578 Error( pIosys->GetError() );
2579 SbxVariableRef p = PopVar();
2580 p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
2583 // end of program
2585 void SbiRuntime::StepSTOP()
2587 pInst->Stop();
2591 void SbiRuntime::StepINITFOR()
2593 PushFor();
2596 void SbiRuntime::StepINITFOREACH()
2598 PushForEach();
2601 // increment FOR-variable
2603 void SbiRuntime::StepNEXT()
2605 if( !pForStk )
2607 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2608 return;
2610 if (pForStk->eForType != ForType::To)
2611 return;
2612 if (!pForStk->refVar)
2614 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2615 return;
2617 // tdf#85371 - grant explicitly write access to the index variable
2618 // since it could be the name of a method itself used in the next statement.
2619 ScopedWritableGuard aGuard(pForStk->refVar, pForStk->refVar.get() == pMeth);
2620 pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
2623 // beginning CASE: TOS in CASE-stack
2625 void SbiRuntime::StepCASE()
2627 if( !refCaseStk.is() )
2629 refCaseStk = new SbxArray;
2631 SbxVariableRef xVar = PopVar();
2632 refCaseStk->Put32( xVar.get(), refCaseStk->Count32() );
2635 // end CASE: free variable
2637 void SbiRuntime::StepENDCASE()
2639 if( !refCaseStk.is() || !refCaseStk->Count32() )
2641 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2643 else
2645 refCaseStk->Remove( refCaseStk->Count32() - 1 );
2650 void SbiRuntime::StepSTDERROR()
2652 pError = nullptr; bError = true;
2653 pInst->aErrorMsg.clear();
2654 pInst->nErr = ERRCODE_NONE;
2655 pInst->nErl = 0;
2656 nError = ERRCODE_NONE;
2657 SbxErrObject::getUnoErrObject()->Clear();
2660 void SbiRuntime::StepNOERROR()
2662 pInst->aErrorMsg.clear();
2663 pInst->nErr = ERRCODE_NONE;
2664 pInst->nErl = 0;
2665 nError = ERRCODE_NONE;
2666 SbxErrObject::getUnoErrObject()->Clear();
2667 bError = false;
2670 // leave UP
2672 void SbiRuntime::StepLEAVE()
2674 bRun = false;
2675 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2676 if ( bInError && pError )
2678 SbxErrObject::getUnoErrObject()->Clear();
2682 void SbiRuntime::StepCHANNEL() // TOS = channel number
2684 SbxVariableRef pChan = PopVar();
2685 short nChan = pChan->GetInteger();
2686 pIosys->SetChannel( nChan );
2687 Error( pIosys->GetError() );
2690 void SbiRuntime::StepCHANNEL0()
2692 pIosys->ResetChannel();
2695 void SbiRuntime::StepPRINT() // print TOS
2697 SbxVariableRef p = PopVar();
2698 OUString s1 = p->GetOUString();
2699 OUString s;
2700 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2702 s = " "; // one blank before
2704 s += s1;
2705 pIosys->Write( s );
2706 Error( pIosys->GetError() );
2709 void SbiRuntime::StepPRINTF() // print TOS in field
2711 SbxVariableRef p = PopVar();
2712 OUString s1 = p->GetOUString();
2713 OUStringBuffer s;
2714 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2716 s.append(' ');
2718 s.append(s1);
2719 comphelper::string::padToLength(s, 14, ' ');
2720 pIosys->Write( s.makeStringAndClear() );
2721 Error( pIosys->GetError() );
2724 void SbiRuntime::StepWRITE() // write TOS
2726 SbxVariableRef p = PopVar();
2727 // Does the string have to be encapsulated?
2728 char ch = 0;
2729 switch (p->GetType() )
2731 case SbxSTRING: ch = '"'; break;
2732 case SbxCURRENCY:
2733 case SbxBOOL:
2734 case SbxDATE: ch = '#'; break;
2735 default: break;
2737 OUString s;
2738 if( ch )
2740 s += OUString(ch);
2742 s += p->GetOUString();
2743 if( ch )
2745 s += OUString(ch);
2747 pIosys->Write( s );
2748 Error( pIosys->GetError() );
2751 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2753 SbxVariableRef pTos1 = PopVar();
2754 SbxVariableRef pTos = PopVar();
2755 OUString aDest = pTos1->GetOUString();
2756 OUString aSource = pTos->GetOUString();
2758 if( hasUno() )
2760 implStepRenameUCB( aSource, aDest );
2762 else
2764 implStepRenameOSL( aSource, aDest );
2768 // TOS = Prompt
2770 void SbiRuntime::StepPROMPT()
2772 SbxVariableRef p = PopVar();
2773 OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
2774 pIosys->SetPrompt( aStr );
2777 // Set Restart point
2779 void SbiRuntime::StepRESTART()
2781 pRestart = pCode;
2784 // empty expression on stack for missing parameter
2786 void SbiRuntime::StepEMPTY()
2788 // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2789 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
2790 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2791 // to simplify matters.
2792 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
2793 xVar->PutErr( 448 );
2794 // tdf#79426, tdf#125180 - add additional information about a missing parameter
2795 SetIsMissing( xVar.get() );
2796 PushVar( xVar.get() );
2799 // TOS = error code
2801 void SbiRuntime::StepERROR()
2803 SbxVariableRef refCode = PopVar();
2804 sal_uInt16 n = refCode->GetUShort();
2805 ErrCode error = StarBASIC::GetSfxFromVBError( n );
2806 if ( bVBAEnabled )
2808 pInst->Error( error );
2810 else
2812 Error( error );
2816 // loading a numeric constant (+ID)
2818 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
2820 // #57844 use localized function
2821 OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
2822 // also allow , !!!
2823 sal_Int32 iComma = aStr.indexOf(',');
2824 if( iComma >= 0 )
2826 aStr = aStr.replaceAt(iComma, 1, ".");
2828 sal_Int32 nParseEnd = 0;
2829 rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
2830 double n = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd );
2832 // tdf#131296 - retrieve data type put in SbiExprNode::Gen
2833 SbxDataType eType = SbxDOUBLE;
2834 if ( nParseEnd < aStr.getLength() )
2836 switch ( aStr[nParseEnd] )
2838 // See GetSuffixType in basic/source/comp/scanner.cxx for type characters
2839 case '%': eType = SbxINTEGER; break;
2840 case '&': eType = SbxLONG; break;
2841 case '!': eType = SbxSINGLE; break;
2842 case '@': eType = SbxCURRENCY; break;
2845 SbxVariable* p = new SbxVariable( eType );
2846 p->PutDouble( n );
2847 // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors
2848 p->ResetFlag( SbxFlagBits::Fixed );
2849 PushVar( p );
2852 // loading a string constant (+ID)
2854 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
2856 SbxVariable* p = new SbxVariable;
2857 p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
2858 PushVar( p );
2861 // Immediate Load (+value)
2862 // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images
2864 void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
2866 SbxVariable* p = new SbxVariable;
2867 p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
2868 PushVar( p );
2871 // store a named argument in Argv (+Arg-no. from 1!)
2873 void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
2875 if( !refArgv.is() )
2876 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2877 else
2879 OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
2880 SbxVariableRef pVal = PopVar();
2881 if( bVBAEnabled &&
2882 ( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr
2883 || dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr
2884 || dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) )
2886 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2887 if ( pVal->GetType() == SbxEMPTY )
2888 pVal->Broadcast( SfxHintId::BasicDataWanted );
2889 // evaluate methods and properties!
2890 SbxVariable* pRes = new SbxVariable( *pVal );
2891 pVal = pRes;
2893 refArgv->Put32( pVal.get(), nArgc );
2894 refArgv->PutAlias32( aAlias, nArgc++ );
2898 // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2900 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
2902 if( !refArgv.is() )
2903 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2904 else
2906 bool bByVal = (nOp1 & 0x8000) != 0; // Is BYVAL requested?
2907 SbxDataType t = static_cast<SbxDataType>(nOp1 & 0x7FFF);
2908 SbxVariable* pVar = refArgv->Get32( refArgv->Count32() - 1 ); // last Arg
2910 // check BYVAL
2911 if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
2913 // parameter is a reference
2914 if( bByVal )
2916 // Call by Value is requested -> create a copy
2917 pVar = new SbxVariable( *pVar );
2918 pVar->SetFlag( SbxFlagBits::ReadWrite );
2919 refExprStk->Put32( pVar, refArgv->Count32() - 1 );
2921 else
2922 pVar->SetFlag( SbxFlagBits::Reference ); // Ref-Flag for DllMgr
2924 else
2926 // parameter is NO reference
2927 if( bByVal )
2928 pVar->ResetFlag( SbxFlagBits::Reference ); // no reference -> OK
2929 else
2930 Error( ERRCODE_BASIC_BAD_PARAMETERS ); // reference needed
2933 if( pVar->GetType() != t )
2935 // variant for correct conversion
2936 // besides error, if SbxBYREF
2937 pVar->Convert( SbxVARIANT );
2938 pVar->Convert( t );
2943 // bring string to a definite length (+length)
2945 void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
2947 SbxVariable* p = GetTOS();
2948 OUString s = p->GetOUString();
2949 sal_Int32 nLen(nOp1);
2950 if( s.getLength() == nLen )
2951 return;
2953 OUStringBuffer aBuf(s);
2954 if (aBuf.getLength() > nLen)
2956 comphelper::string::truncateToLength(aBuf, nLen);
2958 else
2960 comphelper::string::padToLength(aBuf, nLen, ' ');
2962 s = aBuf.makeStringAndClear();
2965 // jump (+target)
2967 void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
2969 #ifdef DBG_UTIL
2970 // #QUESTION shouldn't this be
2971 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
2972 if( nOp1 >= pImg->GetCodeSize() )
2973 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2974 #endif
2975 pCode = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
2978 // evaluate TOS, conditional jump (+target)
2980 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
2982 SbxVariableRef p = PopVar();
2983 if( p->GetBool() )
2984 StepJUMP( nOp1 );
2987 // evaluate TOS, conditional jump (+target)
2989 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
2991 SbxVariableRef p = PopVar();
2992 // In a test e.g. If Null then
2993 // will evaluate Null will act as if False
2994 if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
2995 StepJUMP( nOp1 );
2998 // evaluate TOS, jump into JUMP-table (+MaxVal)
2999 // looks like this:
3000 // ONJUMP 2
3001 // JUMP target1
3002 // JUMP target2
3004 // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
3006 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
3008 SbxVariableRef p = PopVar();
3009 sal_Int16 n = p->GetInteger();
3010 if( nOp1 & 0x8000 )
3012 nOp1 &= 0x7FFF;
3013 PushGosub( pCode + 5 * nOp1 );
3015 if( n < 1 || o3tl::make_unsigned(n) > nOp1 )
3016 n = static_cast<sal_Int16>( nOp1 + 1 );
3017 nOp1 = static_cast<sal_uInt32>( reinterpret_cast<const char*>(pCode) - pImg->GetCode() ) + 5 * --n;
3018 StepJUMP( nOp1 );
3021 // UP-call (+target)
3023 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
3025 PushGosub( pCode );
3026 if( nOp1 >= pImg->GetCodeSize() )
3027 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3028 pCode = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
3031 // UP-return (+0 or target)
3033 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
3035 PopGosub();
3036 if( nOp1 )
3037 StepJUMP( nOp1 );
3040 // check FOR-variable (+Endlabel)
3042 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
3044 if( !pForStk )
3046 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3047 return;
3050 bool bEndLoop = false;
3051 switch( pForStk->eForType )
3053 case ForType::To:
3055 SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
3056 if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
3057 bEndLoop = true;
3058 if (SbxBase::IsError())
3059 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3060 break;
3062 case ForType::EachArray:
3064 SbiForStack* p = pForStk;
3065 if (!p->refEnd)
3067 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3068 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3070 else if (p->pArrayCurIndices == nullptr)
3072 bEndLoop = true;
3074 else
3076 SbxDimArray* pArray = reinterpret_cast<SbxDimArray*>(p->refEnd.get());
3077 sal_Int32 nDims = pArray->GetDims32();
3079 // Empty array?
3080 if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
3082 bEndLoop = true;
3083 break;
3085 SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices.get() );
3086 *(p->refVar) = *pVal;
3088 bool bFoundNext = false;
3089 for(sal_Int32 i = 0 ; i < nDims ; i++ )
3091 if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
3093 bFoundNext = true;
3094 p->pArrayCurIndices[i]++;
3095 for( sal_Int32 j = i - 1 ; j >= 0 ; j-- )
3096 p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
3097 break;
3100 if( !bFoundNext )
3102 p->pArrayCurIndices.reset();
3105 break;
3107 case ForType::EachCollection:
3109 if (!pForStk->refEnd)
3111 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3112 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3113 break;
3116 BasicCollection* pCollection = static_cast<BasicCollection*>(pForStk->refEnd.get());
3117 SbxArrayRef xItemArray = pCollection->xItemArray;
3118 sal_Int32 nCount = xItemArray->Count32();
3119 if( pForStk->nCurCollectionIndex < nCount )
3121 SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
3122 pForStk->nCurCollectionIndex++;
3123 (*pForStk->refVar) = *pRes;
3125 else
3127 bEndLoop = true;
3129 break;
3131 case ForType::EachXEnumeration:
3133 SbiForStack* p = pForStk;
3134 if (!p->xEnumeration)
3136 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3137 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3139 else if (p->xEnumeration->hasMoreElements())
3141 Any aElem = p->xEnumeration->nextElement();
3142 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
3143 unoToSbxValue( xVar.get(), aElem );
3144 (*pForStk->refVar) = *xVar;
3146 else
3148 bEndLoop = true;
3150 break;
3152 case ForType::Error:
3154 // We are in Resume Next mode after failed loop initialization
3155 bEndLoop = true;
3156 Error(ERRCODE_BASIC_BAD_PARAMETER);
3157 break;
3160 if( bEndLoop )
3162 PopFor();
3163 StepJUMP( nOp1 );
3167 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3169 void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
3171 if( !refCaseStk.is() || !refCaseStk->Count32() )
3172 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3173 else
3175 SbxVariableRef xTo = PopVar();
3176 SbxVariableRef xFrom = PopVar();
3177 SbxVariableRef xCase = refCaseStk->Get32( refCaseStk->Count32() - 1 );
3178 if( *xCase >= *xFrom && *xCase <= *xTo )
3179 StepJUMP( nOp1 );
3184 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
3186 const sal_uInt8* p = pCode;
3187 StepJUMP( nOp1 );
3188 pError = pCode;
3189 pCode = p;
3190 pInst->aErrorMsg.clear();
3191 pInst->nErr = ERRCODE_NONE;
3192 pInst->nErl = 0;
3193 nError = ERRCODE_NONE;
3194 SbxErrObject::getUnoErrObject()->Clear();
3197 // Resume after errors (+0=statement, 1=next or Label)
3199 void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
3201 // #32714 Resume without error? -> error
3202 if( !bInError )
3204 Error( ERRCODE_BASIC_BAD_RESUME );
3205 return;
3207 if( nOp1 )
3209 // set Code-pointer to the next statement
3210 sal_uInt16 n1, n2;
3211 pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg );
3213 else
3214 pCode = pErrStmnt;
3215 if ( pError ) // current in error handler ( and got a Resume Next statement )
3216 SbxErrObject::getUnoErrObject()->Clear();
3218 if( nOp1 > 1 )
3219 StepJUMP( nOp1 );
3220 pInst->aErrorMsg.clear();
3221 pInst->nErr = ERRCODE_NONE;
3222 pInst->nErl = 0;
3223 nError = ERRCODE_NONE;
3224 bInError = false;
3227 // close channel (+channel, 0=all)
3228 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
3230 ErrCode err;
3231 if( !nOp1 )
3232 pIosys->Shutdown();
3233 else
3235 err = pIosys->GetError();
3236 if( !err )
3238 pIosys->Close();
3241 err = pIosys->GetError();
3242 Error( err );
3245 // output character (+char)
3247 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
3249 OUString s(static_cast<sal_Unicode>(nOp1));
3250 pIosys->Write( s );
3251 Error( pIosys->GetError() );
3254 // check whether TOS is a certain object class (+StringID)
3256 bool SbiRuntime::implIsClass( SbxObject const * pObj, const OUString& aClass )
3258 bool bRet = true;
3260 if( !aClass.isEmpty() )
3262 bRet = pObj->IsClass( aClass );
3263 if( !bRet )
3264 bRet = aClass.equalsIgnoreAsciiCase( "object" );
3265 if( !bRet )
3267 const OUString& aObjClass = pObj->GetClassName();
3268 SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
3269 if( pClassMod )
3271 SbClassData* pClassData = pClassMod->pClassData.get();
3272 if (pClassData != nullptr )
3274 SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxClassType::DontCare );
3275 bRet = (pClassVar != nullptr);
3280 return bRet;
3283 bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
3284 const OUString& aClass, bool bRaiseErrors, bool bDefault )
3286 bool bOk = bDefault;
3288 SbxDataType t = refVal->GetType();
3289 SbxVariable* pVal = refVal.get();
3290 // we don't know the type of uno properties that are (maybevoid)
3291 if ( t == SbxEMPTY )
3293 if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) )
3295 t = pProp->getRealType();
3298 if( t == SbxOBJECT || bVBAEnabled )
3300 SbxObject* pObj = dynamic_cast<SbxObject*>(pVal);
3301 if (!pObj)
3303 pObj = dynamic_cast<SbxObject*>(refVal->GetObject());
3305 if( pObj )
3307 if( !implIsClass( pObj, aClass ) )
3309 SbUnoObject* pUnoObj(nullptr);
3310 if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration())
3312 pUnoObj = dynamic_cast<SbUnoObject*>(pObj);
3315 if (pUnoObj)
3316 bOk = checkUnoObjectType(*pUnoObj, aClass);
3317 else
3318 bOk = false;
3319 if ( !bOk && bRaiseErrors )
3320 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
3322 else
3324 bOk = true;
3326 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pObj );
3327 if( pClassModuleObject != nullptr )
3328 pClassModuleObject->triggerInitializeEvent();
3332 else
3334 if( bRaiseErrors )
3335 Error( ERRCODE_BASIC_NEEDS_OBJECT );
3336 bOk = false;
3338 return bOk;
3341 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
3343 SbxVariableRef refVal = PopVar();
3344 SbxVariableRef refVar = PopVar();
3345 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3347 bool bOk = checkClass_Impl( refVal, aClass, true, true );
3348 if( bOk )
3350 StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set
3354 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
3356 StepSETCLASS_impl( nOp1, false );
3359 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
3361 StepSETCLASS_impl( nOp1, true );
3364 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
3366 SbxVariableRef xObjVal = PopVar();
3367 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3368 bool bDefault = !bVBAEnabled;
3369 bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
3371 SbxVariable* pRet = new SbxVariable;
3372 pRet->PutBool( bOk );
3373 PushVar( pRet );
3376 // define library for following declare-call
3378 void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
3380 aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
3383 // TOS is incremented by BASE, BASE is pushed before (+BASE)
3384 // This opcode is pushed before DIM/REDIM-commands,
3385 // if there's been only one index named.
3387 void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
3389 SbxVariable* p1 = new SbxVariable;
3390 SbxVariableRef x2 = PopVar();
3392 // #109275 Check compatibility mode
3393 bool bCompatible = ((nOp1 & 0x8000) != 0);
3394 sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
3395 p1->PutInteger( uBase );
3396 if( !bCompatible )
3398 // tdf#85371 - grant explicitly write access to the dimension variable
3399 // since in Star/OpenOffice Basic the upper index border is affected,
3400 // and the dimension variable could be the name of the method itself.
3401 ScopedWritableGuard aGuard(x2, x2.get() == pMeth);
3402 x2->Compute( SbxPLUS, *p1 );
3404 PushVar( x2.get() ); // first the Expr
3405 PushVar( p1 ); // then the Base
3408 // the bits in the String-ID:
3409 // 0x8000 - Argv is reserved
3411 SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
3412 ErrCode nNotFound, bool bLocal, bool bStatic )
3414 bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
3415 if( bIsVBAInterOp )
3417 StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
3418 if( pMSOMacroRuntimeLib != nullptr )
3420 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::ExtSearch );
3424 SbxVariable* pElem = nullptr;
3425 if( !pObj )
3427 Error( ERRCODE_BASIC_NO_OBJECT );
3428 pElem = new SbxVariable;
3430 else
3432 bool bFatalError = false;
3433 SbxDataType t = static_cast<SbxDataType>(nOp2);
3434 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
3435 // Hacky capture of Evaluate [] syntax
3436 // this should be tackled I feel at the pcode level
3437 if ( bIsVBAInterOp && aName.startsWith("[") )
3439 // emulate pcode here
3440 StepARGC();
3441 // pseudo StepLOADSC
3442 OUString sArg = aName.copy( 1, aName.getLength() - 2 );
3443 SbxVariable* p = new SbxVariable;
3444 p->PutString( sArg );
3445 PushVar( p );
3446 StepARGV();
3447 nOp1 = nOp1 | 0x8000; // indicate params are present
3448 aName = "Evaluate";
3450 if( bLocal )
3452 if ( bStatic && pMeth )
3454 pElem = pMeth->GetStatics()->Find( aName, SbxClassType::DontCare );
3457 if ( !pElem )
3459 pElem = refLocals->Find( aName, SbxClassType::DontCare );
3462 if( !pElem )
3464 bool bSave = rBasic.bNoRtl;
3465 rBasic.bNoRtl = true;
3466 pElem = pObj->Find( aName, SbxClassType::DontCare );
3468 // #110004, #112015: Make private really private
3469 if( bLocal && pElem ) // Local as flag for global search
3471 if( pElem->IsSet( SbxFlagBits::Private ) )
3473 SbiInstance* pInst_ = GetSbData()->pInst;
3474 if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
3476 pElem = nullptr; // Found but in wrong module!
3478 // Interfaces: Use SbxFlagBits::ExtFound
3481 rBasic.bNoRtl = bSave;
3483 // is it a global uno-identifier?
3484 if( bLocal && !pElem )
3486 bool bSetName = true; // preserve normal behaviour
3488 // i#i68894# if VBAInterOp favour searching vba globals
3489 // over searching for uno classes
3490 if ( bVBAEnabled )
3492 // Try Find in VBA symbols space
3493 pElem = rBasic.VBAFind( aName, SbxClassType::DontCare );
3494 if ( pElem )
3496 bSetName = false; // don't overwrite uno name
3498 else
3500 pElem = VBAConstantHelper::instance().getVBAConstant( aName );
3504 if( !pElem )
3506 // #72382 ATTENTION! ALWAYS returns a result now
3507 // because of unknown modules!
3508 SbUnoClass* pUnoClass = findUnoClass( aName );
3509 if( pUnoClass )
3511 pElem = new SbxVariable( t );
3512 SbxValues aRes( SbxOBJECT );
3513 aRes.pObj = pUnoClass;
3514 pElem->SbxVariable::Put( aRes );
3518 // #62939 If a uno-class has been found, the wrapper
3519 // object has to be held, because the uno-class, e. g.
3520 // "stardiv", has to be read out of the registry
3521 // every time again otherwise
3522 if( pElem )
3524 // #63774 May not be saved too!!!
3525 pElem->SetFlag( SbxFlagBits::DontStore );
3526 pElem->SetFlag( SbxFlagBits::NoModify);
3528 // #72382 save locally, all variables that have been declared
3529 // implicit would become global automatically otherwise!
3530 if ( bSetName )
3532 pElem->SetName( aName );
3534 refLocals->Put32( pElem, refLocals->Count32() );
3538 if( !pElem )
3540 // not there and not in the object?
3541 // don't establish if that thing has parameters!
3542 if( nOp1 & 0x8000 )
3544 bFatalError = true;
3547 // else, if there are parameters, use different error code
3548 if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) )
3550 // #39108 if explicit and as ELEM always a fatal error
3551 bFatalError = true;
3554 if( !( nOp1 & 0x8000 ) && nNotFound == ERRCODE_BASIC_PROC_UNDEFINED )
3556 nNotFound = ERRCODE_BASIC_VAR_UNDEFINED;
3559 if( bFatalError )
3561 // #39108 use dummy variable instead of fatal error
3562 if( !xDummyVar.is() )
3564 xDummyVar = new SbxVariable( SbxVARIANT );
3566 pElem = xDummyVar.get();
3568 ClearArgvStack();
3570 Error( nNotFound, aName );
3572 else
3574 if ( bStatic )
3576 pElem = StepSTATIC_Impl( aName, t, 0 );
3578 if ( !pElem )
3580 pElem = new SbxVariable( t );
3581 if( t != SbxVARIANT )
3583 pElem->SetFlag( SbxFlagBits::Fixed );
3585 pElem->SetName( aName );
3586 refLocals->Put32( pElem, refLocals->Count32() );
3591 // #39108 Args can already be deleted!
3592 if( !bFatalError )
3594 SetupArgs( pElem, nOp1 );
3596 // because a particular call-type is requested
3597 if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem))
3599 // shall the type be converted?
3600 SbxDataType t2 = pElem->GetType();
3601 bool bSet = false;
3602 if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE )
3604 if( t != SbxVARIANT && t != t2 &&
3605 t >= SbxINTEGER && t <= SbxSTRING )
3607 pElem->SetType( t );
3608 bSet = true;
3611 // assign pElem to a Ref, to delete a temp-var if applicable
3612 SbxVariableRef xDeleteRef = pElem;
3614 // remove potential rests of the last call of the SbxMethod
3615 // free Write before, so that there's no error
3616 SbxFlagBits nSavFlags = pElem->GetFlags();
3617 pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast );
3618 pElem->SbxValue::Clear();
3619 pElem->SetFlags( nSavFlags );
3621 // don't touch before setting, as e. g. LEFT()
3622 // has to know the difference between Left$() and Left()
3624 // because the methods' parameters are cut away in PopVar()
3625 SbxVariable* pNew = new SbxMethod(*pMethod);
3626 //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3628 pElem->SetParameters(nullptr);
3629 pNew->SetFlag( SbxFlagBits::ReadWrite );
3631 if( bSet )
3633 pElem->SetType( t2 );
3635 pElem = pNew;
3637 // consider index-access for UnoObjects
3638 // definitely we want this for VBA where properties are often
3639 // collections ( which need index access ), but lets only do
3640 // this if we actually have params following
3641 else if( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() )
3643 SbxVariableRef xDeleteRef = pElem;
3645 // dissolve the notify while copying variable
3646 SbxVariable* pNew = new SbxVariable( *pElem );
3647 pElem->SetParameters( nullptr );
3648 pElem = pNew;
3651 return CheckArray( pElem );
3654 // for current scope (e. g. query from BASIC-IDE)
3655 SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
3657 // don't expect pMeth to be != 0, as there are none set
3658 // in the RunInit yet
3660 SbxVariable* pElem = nullptr;
3661 if( !pMod || rName.isEmpty() )
3663 return nullptr;
3665 if( refLocals.is() )
3667 pElem = refLocals->Find( rName, SbxClassType::DontCare );
3669 if ( !pElem && pMeth )
3671 // for statics, set the method's name in front
3672 OUString aMethName = pMeth->GetName() + ":" + rName;
3673 pElem = pMod->Find(aMethName, SbxClassType::DontCare);
3676 // search in parameter list
3677 if( !pElem && pMeth )
3679 SbxInfo* pInfo = pMeth->GetInfo();
3680 if( pInfo && refParams.is() )
3682 sal_uInt32 nParamCount = refParams->Count32();
3683 assert(nParamCount <= std::numeric_limits<sal_uInt16>::max());
3684 sal_uInt16 j = 1;
3685 const SbxParamInfo* pParam = pInfo->GetParam( j );
3686 while( pParam )
3688 if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
3690 if( j >= nParamCount )
3692 // Parameter is missing
3693 pElem = new SbxVariable( SbxSTRING );
3694 pElem->PutString( "<missing parameter>");
3696 else
3698 pElem = refParams->Get32( j );
3700 break;
3702 pParam = pInfo->GetParam( ++j );
3707 // search in module
3708 if( !pElem )
3710 bool bSave = rBasic.bNoRtl;
3711 rBasic.bNoRtl = true;
3712 pElem = pMod->Find( rName, SbxClassType::DontCare );
3713 rBasic.bNoRtl = bSave;
3715 return pElem;
3719 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
3721 if( nOp1 & 0x8000 )
3723 if( !refArgv.is() )
3725 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3727 bool bHasNamed = false;
3728 sal_uInt32 i;
3729 sal_uInt32 nArgCount = refArgv->Count32();
3730 for( i = 1 ; i < nArgCount ; i++ )
3732 if( !refArgv->GetAlias32(i).isEmpty() )
3734 bHasNamed = true; break;
3737 if( bHasNamed )
3739 SbxInfo* pInfo = p->GetInfo();
3740 if( !pInfo )
3742 bool bError_ = true;
3744 SbUnoMethod* pUnoMethod = dynamic_cast<SbUnoMethod*>( p );
3745 SbUnoProperty* pUnoProperty = dynamic_cast<SbUnoProperty*>( p );
3746 if( pUnoMethod || pUnoProperty )
3748 SbUnoObject* pParentUnoObj = dynamic_cast<SbUnoObject*>( p->GetParent() );
3749 if( pParentUnoObj )
3751 Any aUnoAny = pParentUnoObj->getUnoAny();
3752 Reference< XInvocation > xInvocation;
3753 aUnoAny >>= xInvocation;
3754 if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() )
3756 bError_ = false;
3758 sal_uInt32 nCurPar = 1;
3759 AutomationNamedArgsSbxArray* pArg =
3760 new AutomationNamedArgsSbxArray( nArgCount );
3761 OUString* pNames = pArg->getNames().getArray();
3762 for( i = 1 ; i < nArgCount ; i++ )
3764 SbxVariable* pVar = refArgv->Get32( i );
3765 OUString aName = refArgv->GetAlias32(i);
3766 if (!aName.isEmpty())
3768 pNames[i] = aName;
3770 pArg->Put32( pVar, nCurPar++ );
3772 refArgv = pArg;
3776 else if( bVBAEnabled && p->GetType() == SbxOBJECT && (dynamic_cast<const SbxMethod*>( p) == nullptr || !p->IsBroadcaster()) )
3778 // Check for default method with named parameters
3779 SbxBaseRef xObj = p->GetObject();
3780 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( xObj.get() ))
3782 Any aAny = pUnoObj->getUnoAny();
3784 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3786 Reference< XDefaultMethod > xDfltMethod( aAny, UNO_QUERY );
3788 OUString sDefaultMethod;
3789 if ( xDfltMethod.is() )
3791 sDefaultMethod = xDfltMethod->getDefaultMethodName();
3793 if ( !sDefaultMethod.isEmpty() )
3795 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
3796 if( meth != nullptr )
3798 pInfo = meth->GetInfo();
3800 if( pInfo )
3802 bError_ = false;
3808 if( bError_ )
3810 Error( ERRCODE_BASIC_NO_NAMED_ARGS );
3813 else
3815 sal_uInt32 nCurPar = 1;
3816 SbxArray* pArg = new SbxArray;
3817 for( i = 1 ; i < nArgCount ; i++ )
3819 SbxVariable* pVar = refArgv->Get32( i );
3820 OUString aName = refArgv->GetAlias32(i);
3821 if (!aName.isEmpty())
3823 // nCurPar is set to the found parameter
3824 sal_uInt16 j = 1;
3825 const SbxParamInfo* pParam = pInfo->GetParam( j );
3826 while( pParam )
3828 if( pParam->aName.equalsIgnoreAsciiCase( aName ) )
3830 nCurPar = j;
3831 break;
3833 pParam = pInfo->GetParam( ++j );
3835 if( !pParam )
3837 Error( ERRCODE_BASIC_NAMED_NOT_FOUND ); break;
3840 pArg->Put32( pVar, nCurPar++ );
3842 refArgv = pArg;
3845 // own var as parameter 0
3846 refArgv->Put32( p, 0 );
3847 p->SetParameters( refArgv.get() );
3848 PopArgv();
3850 else
3852 p->SetParameters( nullptr );
3856 // getting an array element
3858 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
3860 SbxArray* pPar;
3861 if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem )
3863 SbxBase* pElemObj = pElem->GetObject();
3864 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
3865 pPar = pElem->GetParameters();
3866 if( pDimArray )
3868 // parameters may be missing, if an array is
3869 // passed as an argument
3870 if( pPar )
3871 pElem = pDimArray->Get( pPar );
3873 else
3875 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
3876 if( pArray )
3878 if( !pPar )
3880 Error( ERRCODE_BASIC_OUT_OF_RANGE );
3881 pElem = new SbxVariable;
3883 else
3885 pElem = pArray->Get32( pPar->Get32( 1 )->GetInteger() );
3890 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3891 if( pPar )
3893 pPar->Put32( nullptr, 0 );
3896 // consider index-access for UnoObjects
3897 else if( pElem->GetType() == SbxOBJECT &&
3898 dynamic_cast<const SbxMethod*>( pElem) == nullptr &&
3899 ( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) )
3901 pPar = pElem->GetParameters();
3902 if ( pPar )
3904 // is it a uno-object?
3905 SbxBaseRef pObj = pElem->GetObject();
3906 if( pObj.is() )
3908 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get()))
3910 Any aAny = pUnoObj->getUnoAny();
3912 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3914 Reference< XIndexAccess > xIndexAccess( aAny, UNO_QUERY );
3915 if ( !bVBAEnabled )
3917 if( xIndexAccess.is() )
3919 sal_uInt32 nParamCount = pPar->Count32() - 1;
3920 if( nParamCount != 1 )
3922 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3923 return pElem;
3926 // get index
3927 sal_Int32 nIndex = pPar->Get32( 1 )->GetLong();
3928 Reference< XInterface > xRet;
3931 Any aAny2 = xIndexAccess->getByIndex( nIndex );
3932 aAny2 >>= xRet;
3934 catch (const IndexOutOfBoundsException&)
3936 // usually expect converting problem
3937 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
3940 // #57847 always create a new variable, else error
3941 // due to PutObject(NULL) at ReadOnly-properties
3942 pElem = new SbxVariable( SbxVARIANT );
3943 if( xRet.is() )
3945 aAny <<= xRet;
3947 // #67173 don't specify a name so that the real class name is entered
3948 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny ));
3949 pElem->PutObject( xWrapper.get() );
3951 else
3953 pElem->PutObject( nullptr );
3957 else
3959 // check if there isn't a default member between the current variable
3960 // and the params, e.g.
3961 // Dim rst1 As New ADODB.Recordset
3962 // "
3963 // val = rst1("FirstName")
3964 // has the default 'Fields' member between rst1 and '("FirstName")'
3965 Any x = aAny;
3966 SbxVariable* pDflt = getDefaultProp( pElem );
3967 if ( pDflt )
3969 pDflt->Broadcast( SfxHintId::BasicDataWanted );
3970 SbxBaseRef pDfltObj = pDflt->GetObject();
3971 if( pDfltObj.is() )
3973 if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get()))
3975 pUnoObj = pSbObj;
3976 Any aUnoAny = pUnoObj->getUnoAny();
3978 if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3979 x = aUnoAny;
3980 pElem = pDflt;
3984 OUString sDefaultMethod;
3986 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
3988 if ( xDfltMethod.is() )
3990 sDefaultMethod = xDfltMethod->getDefaultMethodName();
3992 else if( xIndexAccess.is() )
3994 sDefaultMethod = "getByIndex";
3996 if ( !sDefaultMethod.isEmpty() )
3998 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
3999 SbxVariableRef refTemp = meth;
4000 if ( refTemp.is() )
4002 meth->SetParameters( pPar );
4003 SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) );
4004 pElem = pNew;
4010 // #42940, set parameter 0 to NULL so that var doesn't contain itself
4011 pPar->Put32( nullptr, 0 );
4013 else if (BasicCollection* pCol = dynamic_cast<BasicCollection*>(pObj.get()))
4015 pElem = new SbxVariable( SbxVARIANT );
4016 pPar->Put32( pElem, 0 );
4017 pCol->CollItem( pPar );
4020 else if( bVBAEnabled ) // !pObj
4022 SbxArray* pParam = pElem->GetParameters();
4023 if( pParam != nullptr && !pElem->IsSet( SbxFlagBits::VarToDim ) )
4025 Error( ERRCODE_BASIC_NO_OBJECT );
4031 return pElem;
4034 // loading an element from the runtime-library (+StringID+type)
4036 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4038 PushVar( FindElement( rBasic.pRtl.get(), nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, false ) );
4041 void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
4042 ErrCode nNotFound, bool bStatic )
4044 if( !refLocals.is() )
4046 refLocals = new SbxArray;
4048 PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, true/*bLocal*/, bStatic ) );
4050 // loading a local/global variable (+StringID+type)
4052 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4054 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED );
4057 // Search inside a class module (CM) to enable global search in time
4058 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4061 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pMod );
4062 if( pClassModuleObject )
4064 pMod->SetFlag( SbxFlagBits::GlobalSearch );
4066 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED);
4068 if( pClassModuleObject )
4070 pMod->ResetFlag( SbxFlagBits::GlobalSearch );
4074 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4076 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, true );
4079 // loading an object-element (+StringID+type)
4080 // the object lies on TOS
4082 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4084 SbxVariableRef pObjVar = PopVar();
4086 SbxObject* pObj = dynamic_cast<SbxObject*>( pObjVar.get() );
4087 if( !pObj )
4089 SbxBase* pObjVarObj = pObjVar->GetObject();
4090 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
4093 // #56368 save reference at StepElem, otherwise objects could
4094 // lose their reference too early in qualification chains like
4095 // ActiveComponent.Selection(0).Text
4096 // #74254 now per list
4097 if( pObj )
4099 aRefSaved.emplace_back(pObj );
4101 PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) );
4104 /** Loading of a parameter (+offset+type)
4105 If the data type is wrong, create a copy and search for optionals including
4106 the default value. The data type SbxEMPTY shows that no parameters are given.
4107 Get( 0 ) may be EMPTY
4109 @param nOp1
4110 the index of the current parameter being processed,
4111 where the entry of the index 0 is for the return value.
4113 @param nOp2
4114 the data type of the parameter.
4116 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4118 sal_uInt16 nIdx = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
4119 SbxDataType eType = static_cast<SbxDataType>(nOp2);
4120 SbxVariable* pVar;
4122 // #57915 solve missing in a cleaner way
4123 sal_uInt32 nParamCount = refParams->Count32();
4124 if( nIdx >= nParamCount )
4126 sal_uInt16 iLoop = nIdx;
4127 while( iLoop >= nParamCount )
4129 pVar = new SbxVariable();
4130 pVar->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
4131 // tdf#79426, tdf#125180 - add additional information about a missing parameter
4132 SetIsMissing( pVar );
4133 refParams->Put32( pVar, iLoop );
4134 iLoop--;
4137 pVar = refParams->Get32( nIdx );
4139 // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing
4140 if( pVar->GetType() == SbxERROR && IsMissing( pVar, 1 ) && nIdx )
4142 // if there's a parameter missing, it can be OPTIONAL
4143 bool bOpt = false;
4144 if( pMeth )
4146 SbxInfo* pInfo = pMeth->GetInfo();
4147 if ( pInfo )
4149 const SbxParamInfo* pParam = pInfo->GetParam( nIdx );
4150 if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) )
4152 // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors
4153 pVar->ResetFlag( SbxFlagBits::Fixed );
4154 // Default value?
4155 sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff);
4156 if( nDefaultId > 0 )
4158 OUString aDefaultStr = pImg->GetString( nDefaultId );
4159 pVar = new SbxVariable(pParam-> eType);
4160 pVar->PutString( aDefaultStr );
4161 refParams->Put32( pVar, nIdx );
4163 else if ( SbiRuntime::isVBAEnabled() && eType != SbxVARIANT )
4165 // tdf#36737 - initialize the parameter with the default value of its type
4166 pVar = new SbxVariable( pParam->eType );
4167 refParams->Put32( pVar, nIdx );
4169 bOpt = true;
4173 if( !bOpt )
4175 Error( ERRCODE_BASIC_NOT_OPTIONAL );
4178 else if( eType != SbxVARIANT && static_cast<SbxDataType>(pVar->GetType() & 0x0FFF ) != eType )
4180 // tdf#43003 - convert parameter to the requested type
4181 pVar->Convert(eType);
4183 SetupArgs( pVar, nOp1 );
4184 PushVar( CheckArray( pVar ) );
4187 // Case-Test (+True-Target+Test-Opcode)
4189 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4191 if( !refCaseStk.is() || !refCaseStk->Count32() )
4193 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
4195 else
4197 SbxVariableRef xComp = PopVar();
4198 SbxVariableRef xCase = refCaseStk->Get32( refCaseStk->Count32() - 1 );
4199 if( xCase->Compare( static_cast<SbxOperator>(nOp2), *xComp ) )
4201 StepJUMP( nOp1 );
4206 // call of a DLL-procedure (+StringID+type)
4207 // the StringID's MSB shows that Argv is occupied
4209 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4211 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4212 SbxArray* pArgs = nullptr;
4213 if( nOp1 & 0x8000 )
4215 pArgs = refArgv.get();
4217 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), false );
4218 aLibName.clear();
4219 if( nOp1 & 0x8000 )
4221 PopArgv();
4225 // call of a DLL-procedure after CDecl (+StringID+type)
4227 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4229 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4230 SbxArray* pArgs = nullptr;
4231 if( nOp1 & 0x8000 )
4233 pArgs = refArgv.get();
4235 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), true );
4236 aLibName.clear();
4237 if( nOp1 & 0x8000 )
4239 PopArgv();
4244 // beginning of a statement (+Line+Col)
4246 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4248 // If the Expr-Stack at the beginning of a statement contains a variable,
4249 // some fool has called X as a function, although it's a variable!
4250 bool bFatalExpr = false;
4251 OUString sUnknownMethodName;
4252 if( nExprLvl > 1 )
4254 bFatalExpr = true;
4256 else if( nExprLvl )
4258 SbxVariable* p = refExprStk->Get32( 0 );
4259 if( p->GetRefCount() > 1 &&
4260 refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) )
4262 sUnknownMethodName = p->GetName();
4263 bFatalExpr = true;
4267 ClearExprStack();
4269 aRefSaved.clear();
4271 // We have to cancel hard here because line and column
4272 // would be wrong later otherwise!
4273 if( bFatalExpr)
4275 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName );
4276 return;
4278 pStmnt = pCode - 9;
4279 sal_uInt16 nOld = nLine;
4280 nLine = static_cast<short>( nOp1 );
4282 // #29955 & 0xFF, to filter out for-loop-level
4283 nCol1 = static_cast<short>( nOp2 & 0xFF );
4285 // find the next STMNT-command to set the final column
4286 // of this statement
4288 nCol2 = 0xffff;
4289 sal_uInt16 n1, n2;
4290 const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
4291 if( p )
4293 if( n1 == nOp1 )
4295 // #29955 & 0xFF, to filter out for-loop-level
4296 nCol2 = (n2 & 0xFF) - 1;
4300 // #29955 correct for-loop-level, #67452 NOT in the error-handler
4301 if( !bInError )
4303 // (there's a difference here in case of a jump out of a loop)
4304 sal_uInt16 nExpectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
4305 if( !pGosubStk.empty() )
4307 nExpectedForLevel = nExpectedForLevel + pGosubStk.back().nStartForLvl;
4310 // if the actual for-level is too small it'd jump out
4311 // of a loop -> corrected
4312 while( nForLvl > nExpectedForLevel )
4314 PopFor();
4318 // 16.10.96: #31460 new concept for StepInto/Over/Out
4319 // see explanation at _ImplGetBreakCallLevel
4320 if( pInst->nCallLvl <= pInst->nBreakCallLvl )
4322 StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
4323 BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
4325 pInst->CalcBreakCallLevel( nNewFlags );
4328 // break points only at STMNT-commands in a new line!
4329 else if( ( nOp1 != nOld )
4330 && ( nFlags & BasicDebugFlags::Break )
4331 && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
4333 StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
4334 BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
4336 pInst->CalcBreakCallLevel( nNewFlags );
4340 // (+StreamMode+Flags)
4341 // Stack: block length
4342 // channel number
4343 // file name
4345 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4347 SbxVariableRef pName = PopVar();
4348 SbxVariableRef pChan = PopVar();
4349 SbxVariableRef pLen = PopVar();
4350 short nBlkLen = pLen->GetInteger();
4351 short nChan = pChan->GetInteger();
4352 OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
4353 pIosys->Open( nChan, aName, static_cast<StreamMode>( nOp1 ),
4354 static_cast<SbiStreamFlags>( nOp2 ), nBlkLen );
4355 Error( pIosys->GetError() );
4358 // create object (+StringID+StringID)
4360 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4362 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4363 SbxObject *pObj = SbxBase::CreateObject( aClass );
4364 if( !pObj )
4366 Error( ERRCODE_BASIC_INVALID_OBJECT );
4368 else
4370 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4371 pObj->SetName( aName );
4372 // the object must be able to call the BASIC
4373 pObj->SetParent( &rBasic );
4374 SbxVariable* pNew = new SbxVariable;
4375 pNew->PutObject( pObj );
4376 PushVar( pNew );
4380 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4382 StepDCREATE_IMPL( nOp1, nOp2 );
4385 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4387 StepDCREATE_IMPL( nOp1, nOp2 );
4390 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4391 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4393 SbxVariableRef refVar = PopVar();
4395 DimImpl( refVar );
4397 // fill the array with instances of the requested class
4398 SbxBase* pObj = refVar->GetObject();
4399 if (!pObj)
4401 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT );
4402 return;
4405 SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj);
4406 if (!pArray)
4407 return;
4409 const sal_Int32 nDims = pArray->GetDims32();
4410 sal_Int32 nTotalSize = nDims > 0 ? 1 : 0;
4412 // must be a one-dimensional array
4413 sal_Int32 nLower, nUpper;
4414 for( sal_Int32 i = 0 ; i < nDims ; ++i )
4416 pArray->GetDim32( i+1, nLower, nUpper );
4417 const sal_Int32 nSize = nUpper - nLower + 1;
4418 nTotalSize *= nSize;
4421 // Optimization: pre-allocate underlying container
4422 if (nTotalSize > 0)
4423 pArray->SbxArray::GetRef32(nTotalSize - 1);
4425 // First, fill those parts of the array that are preserved
4426 bool bWasError = false;
4427 const bool bRestored = implRestorePreservedArray(pArray, refRedimpArray, &bWasError);
4428 if (bWasError)
4429 nTotalSize = 0; // on error, don't create objects
4431 // create objects and insert them into the array
4432 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4433 OUString aName;
4434 for( sal_Int32 i = 0 ; i < nTotalSize ; ++i )
4436 if (!bRestored || !pArray->SbxArray::GetRef32(i)) // For those left unset after preserve
4438 SbxObject* pClassObj = SbxBase::CreateObject(aClass);
4439 if (!pClassObj)
4441 Error(ERRCODE_BASIC_INVALID_OBJECT);
4442 break;
4444 else
4446 if (aName.isEmpty())
4447 aName = pImg->GetString(static_cast<short>(nOp1));
4448 pClassObj->SetName(aName);
4449 // the object must be able to call the basic
4450 pClassObj->SetParent(&rBasic);
4451 pArray->SbxArray::Put32(pClassObj, i);
4457 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4459 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4460 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4462 SbxObject* pCopyObj = createUserTypeImpl( aClass );
4463 if( pCopyObj )
4465 pCopyObj->SetName( aName );
4467 SbxVariable* pNew = new SbxVariable;
4468 pNew->PutObject( pCopyObj );
4469 pNew->SetDeclareClassName( aClass );
4470 PushVar( pNew );
4473 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
4475 bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
4476 if( bWithEvents )
4478 pVar->SetFlag( SbxFlagBits::WithEvents );
4480 bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
4481 if( bDimAsNew )
4483 pVar->SetFlag( SbxFlagBits::DimAsNew );
4485 bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
4486 if( bFixedString )
4488 sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000
4489 OUStringBuffer aBuf;
4490 comphelper::string::padToLength(aBuf, nCount);
4491 pVar->PutString(aBuf.makeStringAndClear());
4494 bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
4495 if( bVarToDim )
4497 pVar->SetFlag( SbxFlagBits::VarToDim );
4501 // establishing a local variable (+StringID+type)
4503 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4505 if( !refLocals.is() )
4507 refLocals = new SbxArray;
4509 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4510 if( refLocals->Find( aName, SbxClassType::DontCare ) == nullptr )
4512 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4513 SbxVariable* p = new SbxVariable( t );
4514 p->SetName( aName );
4515 implHandleSbxFlags( p, t, nOp2 );
4516 refLocals->Put32( p, refLocals->Count32() );
4520 // establishing a module-global variable (+StringID+type)
4522 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
4524 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4525 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4526 bool bFlag = pMod->IsSet( SbxFlagBits::NoModify );
4527 pMod->SetFlag( SbxFlagBits::NoModify );
4528 SbxVariableRef p = pMod->Find( aName, SbxClassType::Property );
4529 if( p.is() )
4531 pMod->Remove (p.get());
4533 SbProperty* pProp = pMod->GetProperty( aName, t );
4534 if( !bUsedForClassModule )
4536 pProp->SetFlag( SbxFlagBits::Private );
4538 if( !bFlag )
4540 pMod->ResetFlag( SbxFlagBits::NoModify );
4542 if( pProp )
4544 pProp->SetFlag( SbxFlagBits::DontStore );
4545 // from 2.7.1996: HACK because of 'reference can't be saved'
4546 pProp->SetFlag( SbxFlagBits::NoModify);
4548 implHandleSbxFlags( pProp, t, nOp2 );
4552 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4554 StepPUBLIC_Impl( nOp1, nOp2, false );
4557 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4559 // Creates module variable that isn't reinitialised when
4560 // between invocations ( for VBASupport & document basic only )
4561 if( pMod->pImage->bFirstInit )
4563 bool bUsedForClassModule = pImg->IsFlag( SbiImageFlags::CLASSMODULE );
4564 StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
4568 // establishing a global variable (+StringID+type)
4570 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4572 if( pImg->IsFlag( SbiImageFlags::CLASSMODULE ) )
4574 StepPUBLIC_Impl( nOp1, nOp2, true );
4576 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4577 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4579 // Store module scope variables at module scope
4580 // in non vba mode these are stored at the library level :/
4581 // not sure if this really should not be enabled for ALL basic
4582 SbxObject* pStorage = &rBasic;
4583 if ( SbiRuntime::isVBAEnabled() )
4585 pStorage = pMod;
4586 pMod->AddVarName( aName );
4589 bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify );
4590 rBasic.SetFlag( SbxFlagBits::NoModify );
4591 SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property );
4592 if( p.is() )
4594 pStorage->Remove (p.get());
4596 p = pStorage->Make( aName, SbxClassType::Property, t );
4597 if( !bFlag )
4599 pStorage->ResetFlag( SbxFlagBits::NoModify );
4601 if( p.is() )
4603 p->SetFlag( SbxFlagBits::DontStore );
4604 // from 2.7.1996: HACK because of 'reference can't be saved'
4605 p->SetFlag( SbxFlagBits::NoModify);
4610 // Creates global variable that isn't reinitialised when
4611 // basic is restarted, P=PERSIST (+StringID+Typ)
4613 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4615 if( pMod->pImage->bFirstInit )
4617 StepGLOBAL( nOp1, nOp2 );
4622 // Searches for global variable, behavior depends on the fact
4623 // if the variable is initialised for the first time
4625 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4627 if( pMod->pImage->bFirstInit )
4629 // Behave like always during first init
4630 StepFIND( nOp1, nOp2 );
4632 else
4634 // Return dummy variable
4635 SbxDataType t = static_cast<SbxDataType>(nOp2);
4636 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
4638 SbxVariable* pDummyVar = new SbxVariable( t );
4639 pDummyVar->SetName( aName );
4640 PushVar( pDummyVar );
4645 SbxVariable* SbiRuntime::StepSTATIC_Impl(
4646 OUString const & aName, SbxDataType t, sal_uInt32 nOp2 )
4648 SbxVariable* p = nullptr;
4649 if ( pMeth )
4651 SbxArray* pStatics = pMeth->GetStatics();
4652 if( pStatics && ( pStatics->Find( aName, SbxClassType::DontCare ) == nullptr ) )
4654 p = new SbxVariable( t );
4655 if( t != SbxVARIANT )
4657 p->SetFlag( SbxFlagBits::Fixed );
4659 p->SetName( aName );
4660 implHandleSbxFlags( p, t, nOp2 );
4661 pStatics->Put32( p, pStatics->Count32() );
4664 return p;
4666 // establishing a static variable (+StringID+type)
4667 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4669 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4670 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4671 StepSTATIC_Impl( aName, t, nOp2 );
4674 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */