LanguageTool: don't crash if REST protocol isn't set
[LibreOffice.git] / basic / source / runtime / runtime.cxx
blobbad307f27dd6bfa7d58763970f37b1a7db8e00db
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/math.hxx>
45 #include <rtl/ustrbuf.hxx>
46 #include <rtl/character.hxx>
48 #include <svl/numformat.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 const 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 const 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 const 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()
292 : nDirFlags(SbAttributes::NONE)
293 , 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.get() ), 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 = 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->Put(pMeth, 0);
676 SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : nullptr;
677 sal_uInt32 nParamCount = pParams ? pParams->Count() : 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->unoAddDim(0, nParamArrayParamCount - 1);
691 for (sal_uInt32 j = i; j < nParamCount ; ++j)
693 SbxVariable* v = pParams->Get(j);
694 sal_Int32 aDimIndex[1];
695 aDimIndex[0] = j - i;
696 pArray->Put(v, aDimIndex);
698 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
699 pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
700 pArrayVar->PutObject( pArray );
701 refParams->Put(pArrayVar, i);
703 // Block ParamArray for missing parameter
704 pInfo = nullptr;
705 break;
708 SbxVariable* v = pParams->Get(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->Put(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->Put(v, i);
763 if( p )
765 refParams->PutAlias(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->unoAddDim(0, -1);
780 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
781 pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
782 pArrayVar->PutObject( pArray );
783 refParams->Put(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 // tdf#123144 - always translate an error number to a vba error message
995 StarBASIC::MakeErrorText( nError, rMsg );
996 rMsg = StarBASIC::GetErrorText();
997 // no num? most likely then it *is* really a vba err
998 sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
999 sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? sal_uInt32(nError) : nVBErrorCode;
1000 return nVBAErrorNumber;
1003 // Stacks
1005 // The expression-stack is available for the continuous evaluation
1006 // of expressions.
1008 void SbiRuntime::PushVar( SbxVariable* pVar )
1010 if( pVar )
1012 refExprStk->Put(pVar, nExprLvl++);
1016 SbxVariableRef SbiRuntime::PopVar()
1018 #ifdef DBG_UTIL
1019 if( !nExprLvl )
1021 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1022 return new SbxVariable;
1024 #endif
1025 SbxVariableRef xVar = refExprStk->Get(--nExprLvl);
1026 SAL_INFO_IF( xVar->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
1027 // methods hold themselves in parameter 0
1028 if( dynamic_cast<const SbxMethod *>(xVar.get()) != nullptr )
1030 xVar->SetParameters(nullptr);
1032 return xVar;
1035 void SbiRuntime::ClearExprStack()
1037 // Attention: Clear() doesn't suffice as methods must be deleted
1038 while ( nExprLvl )
1040 PopVar();
1042 refExprStk->Clear();
1045 // Take variable from the expression-stack without removing it
1046 // n counts from 0
1048 SbxVariable* SbiRuntime::GetTOS()
1050 short n = nExprLvl - 1;
1051 #ifdef DBG_UTIL
1052 if( n < 0 )
1054 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1055 return new SbxVariable;
1057 #endif
1058 return refExprStk->Get(static_cast<sal_uInt32>(n));
1062 void SbiRuntime::TOSMakeTemp()
1064 SbxVariable* p = refExprStk->Get(nExprLvl - 1);
1065 if ( p->GetType() == SbxEMPTY )
1067 p->Broadcast( SfxHintId::BasicDataWanted );
1070 SbxVariable* pDflt = nullptr;
1071 if ( bVBAEnabled && ( p->GetType() == SbxOBJECT || p->GetType() == SbxVARIANT ) && ((pDflt = getDefaultProp(p)) != nullptr) )
1073 pDflt->Broadcast( SfxHintId::BasicDataWanted );
1074 // replacing new p on stack causes object pointed by
1075 // pDft->pParent to be deleted, when p2->Compute() is
1076 // called below pParent is accessed (but it's deleted)
1077 // so set it to NULL now
1078 pDflt->SetParent( nullptr );
1079 p = new SbxVariable( *pDflt );
1080 p->SetFlag( SbxFlagBits::ReadWrite );
1081 refExprStk->Put(p, nExprLvl - 1);
1083 else if( p->GetRefCount() != 1 )
1085 SbxVariable* pNew = new SbxVariable( *p );
1086 pNew->SetFlag( SbxFlagBits::ReadWrite );
1087 refExprStk->Put(pNew, nExprLvl - 1);
1091 // the GOSUB-stack collects return-addresses for GOSUBs
1092 void SbiRuntime::PushGosub( const sal_uInt8* pc )
1094 if( pGosubStk.size() >= MAXRECURSION )
1096 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
1098 pGosubStk.emplace_back(pc, nForLvl);
1101 void SbiRuntime::PopGosub()
1103 if( pGosubStk.empty() )
1105 Error( ERRCODE_BASIC_NO_GOSUB );
1107 else
1109 pCode = pGosubStk.back().pCode;
1110 pGosubStk.pop_back();
1114 // the Argv-stack collects current argument-vectors
1116 void SbiRuntime::PushArgv()
1118 pArgvStk.emplace_back(refArgv, nArgc);
1119 nArgc = 1;
1120 refArgv.clear();
1123 void SbiRuntime::PopArgv()
1125 if( !pArgvStk.empty() )
1127 refArgv = pArgvStk.back().refArgv;
1128 nArgc = pArgvStk.back().nArgc;
1129 pArgvStk.pop_back();
1134 void SbiRuntime::ClearArgvStack()
1136 while( !pArgvStk.empty() )
1138 PopArgv();
1142 // Push of the for-stack. The stack has increment, end, begin and variable.
1143 // After the creation of the stack-element the stack's empty.
1145 void SbiRuntime::PushFor()
1147 SbiForStack* p = new SbiForStack;
1148 p->eForType = ForType::To;
1149 p->pNext = pForStk;
1150 pForStk = p;
1152 p->refInc = PopVar();
1153 p->refEnd = PopVar();
1154 SbxVariableRef xBgn = PopVar();
1155 p->refVar = PopVar();
1156 // tdf#85371 - grant explicitly write access to the index variable
1157 // since it could be the name of a method itself used in the next statement.
1158 ScopedWritableGuard aGuard(p->refVar, p->refVar.get() == pMeth);
1159 *(p->refVar) = *xBgn;
1160 nForLvl++;
1163 void SbiRuntime::PushForEach()
1165 SbiForStack* p = new SbiForStack;
1166 // Set default value in case of error which is ignored in Resume Next
1167 p->eForType = ForType::EachArray;
1168 p->pNext = pForStk;
1169 pForStk = p;
1171 SbxVariableRef xObjVar = PopVar();
1172 SbxBase* pObj = xObjVar && xObjVar->GetFullType() == SbxOBJECT ? xObjVar->GetObject() : nullptr;
1174 if (SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj))
1176 p->refEnd = reinterpret_cast<SbxVariable*>(pArray);
1178 sal_Int32 nDims = pArray->GetDims();
1179 p->pArrayLowerBounds.reset( new sal_Int32[nDims] );
1180 p->pArrayUpperBounds.reset( new sal_Int32[nDims] );
1181 p->pArrayCurIndices.reset( new sal_Int32[nDims] );
1182 sal_Int32 lBound, uBound;
1183 for( sal_Int32 i = 0 ; i < nDims ; i++ )
1185 pArray->GetDim(i + 1, lBound, uBound);
1186 p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
1187 p->pArrayUpperBounds[i] = uBound;
1190 else if (BasicCollection* pCollection = dynamic_cast<BasicCollection*>(pObj))
1192 p->eForType = ForType::EachCollection;
1193 p->refEnd = pCollection;
1194 p->nCurCollectionIndex = 0;
1196 else if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
1198 // XEnumerationAccess or XIndexAccess?
1199 Any aAny = pUnoObj->getUnoAny();
1200 Reference<XIndexAccess> xIndexAccess;
1201 Reference< XEnumerationAccess > xEnumerationAccess;
1202 if( aAny >>= xEnumerationAccess )
1204 p->xEnumeration = xEnumerationAccess->createEnumeration();
1205 p->eForType = ForType::EachXEnumeration;
1207 // tdf#130307 - support for each loop for objects exposing XIndexAccess
1208 else if (aAny >>= xIndexAccess)
1210 p->eForType = ForType::EachXIndexAccess;
1211 p->xIndexAccess = xIndexAccess;
1212 p->nCurCollectionIndex = 0;
1214 else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
1216 uno::Reference< script::XInvocation > xInvocation;
1217 if ( ( aAny >>= xInvocation ) && xInvocation.is() )
1221 p->xEnumeration = new ComEnumerationWrapper( xInvocation );
1222 p->eForType = ForType::EachXEnumeration;
1224 catch(const uno::Exception& )
1230 // Container variable
1231 p->refVar = PopVar();
1232 nForLvl++;
1236 void SbiRuntime::PopFor()
1238 if( pForStk )
1240 SbiForStack* p = pForStk;
1241 pForStk = p->pNext;
1242 delete p;
1243 nForLvl--;
1248 void SbiRuntime::ClearForStack()
1250 while( pForStk )
1252 PopFor();
1256 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection const * pCollection )
1258 for (SbiForStack *p = pForStk; p; p = p->pNext)
1260 SbxVariable* pVar = p->refEnd.is() ? p->refEnd.get() : nullptr;
1261 if( p->eForType == ForType::EachCollection
1262 && pVar != nullptr
1263 && dynamic_cast<BasicCollection*>( pVar) == pCollection )
1265 return p;
1269 return nullptr;
1273 // DLL-calls
1275 void SbiRuntime::DllCall
1276 ( std::u16string_view aFuncName,
1277 std::u16string_view aDLLName,
1278 SbxArray* pArgs, // parameter (from index 1, can be NULL)
1279 SbxDataType eResType, // return value
1280 bool bCDecl ) // true: according to C-conventions
1282 // NOT YET IMPLEMENTED
1284 SbxVariable* pRes = new SbxVariable( eResType );
1285 SbiDllMgr* pDllMgr = pInst->GetDllMgr();
1286 ErrCode nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
1287 if( nErr )
1289 Error( nErr );
1291 PushVar( pRes );
1294 bool SbiRuntime::IsImageFlag( SbiImageFlags n ) const
1296 return pImg->IsFlag( n );
1299 sal_uInt16 SbiRuntime::GetBase() const
1301 return pImg->GetBase();
1304 void SbiRuntime::StepNOP()
1307 void SbiRuntime::StepArith( SbxOperator eOp )
1309 SbxVariableRef p1 = PopVar();
1310 TOSMakeTemp();
1311 SbxVariable* p2 = GetTOS();
1313 // tdf#144353 - do not compute any operation with a missing optional variable
1314 if ((p1->GetType() == SbxERROR && IsMissing(p1.get(), 1))
1315 || (p2->GetType() == SbxERROR && IsMissing(p2, 1)))
1317 Error(ERRCODE_BASIC_NOT_OPTIONAL);
1318 return;
1321 p2->ResetFlag( SbxFlagBits::Fixed );
1322 p2->Compute( eOp, *p1 );
1324 checkArithmeticOverflow( p2 );
1327 void SbiRuntime::StepUnary( SbxOperator eOp )
1329 TOSMakeTemp();
1330 SbxVariable* p = GetTOS();
1331 // tdf#144353 - do not compute any operation with a missing optional variable
1332 if (p->GetType() == SbxERROR && IsMissing(p, 1))
1334 Error(ERRCODE_BASIC_NOT_OPTIONAL);
1335 return;
1337 p->Compute( eOp, *p );
1340 void SbiRuntime::StepCompare( SbxOperator eOp )
1342 SbxVariableRef p1 = PopVar();
1343 SbxVariableRef p2 = PopVar();
1345 // tdf#144353 - do not compare a missing optional variable
1346 if ((p1->GetType() == SbxERROR && SbiRuntime::IsMissing(p1.get(), 1))
1347 || (p2->GetType() == SbxERROR && SbiRuntime::IsMissing(p2.get(), 1)))
1349 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL);
1350 return;
1353 // Make sure objects with default params have
1354 // values ( and type ) set as appropriate
1355 SbxDataType p1Type = p1->GetType();
1356 SbxDataType p2Type = p2->GetType();
1357 if ( p1Type == SbxEMPTY )
1359 p1->Broadcast( SfxHintId::BasicDataWanted );
1360 p1Type = p1->GetType();
1362 if ( p2Type == SbxEMPTY )
1364 p2->Broadcast( SfxHintId::BasicDataWanted );
1365 p2Type = p2->GetType();
1367 if ( p1Type == p2Type )
1369 // if both sides are an object and have default props
1370 // then we need to use the default props
1371 // we don't need to worry if only one side ( lhs, rhs ) is an
1372 // object ( object side will get coerced to correct type in
1373 // Compare )
1374 if ( p1Type == SbxOBJECT )
1376 SbxVariable* pDflt = getDefaultProp( p1.get() );
1377 if ( pDflt )
1379 p1 = pDflt;
1380 p1->Broadcast( SfxHintId::BasicDataWanted );
1382 pDflt = getDefaultProp( p2.get() );
1383 if ( pDflt )
1385 p2 = pDflt;
1386 p2->Broadcast( SfxHintId::BasicDataWanted );
1391 static SbxVariable* pTRUE = nullptr;
1392 static SbxVariable* pFALSE = nullptr;
1393 // why do this on non-windows ?
1394 // why do this at all ?
1395 // I dumbly follow the pattern :-/
1396 if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
1398 static SbxVariable* pNULL = []() {
1399 SbxVariable* p = new SbxVariable;
1400 p->PutNull();
1401 p->AddFirstRef();
1402 return p;
1403 }();
1404 PushVar( pNULL );
1406 else if( p2->Compare( eOp, *p1 ) )
1408 if( !pTRUE )
1410 pTRUE = new SbxVariable;
1411 pTRUE->PutBool( true );
1412 pTRUE->AddFirstRef();
1414 PushVar( pTRUE );
1416 else
1418 if( !pFALSE )
1420 pFALSE = new SbxVariable;
1421 pFALSE->PutBool( false );
1422 pFALSE->AddFirstRef();
1424 PushVar( pFALSE );
1428 void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
1429 void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
1430 void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
1431 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
1432 void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
1433 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
1434 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
1435 void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
1436 void SbiRuntime::StepAND() { StepArith( SbxAND ); }
1437 void SbiRuntime::StepOR() { StepArith( SbxOR ); }
1438 void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
1439 void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
1440 void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
1442 void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
1443 void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
1445 void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
1446 void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
1447 void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
1448 void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
1449 void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
1450 void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
1452 namespace
1454 bool NeedEsc(sal_Unicode cCode)
1456 if(!rtl::isAscii(cCode))
1458 return false;
1460 switch(cCode)
1462 case '.':
1463 case '^':
1464 case '$':
1465 case '+':
1466 case '\\':
1467 case '|':
1468 case '{':
1469 case '}':
1470 case '(':
1471 case ')':
1472 return true;
1473 default:
1474 return false;
1478 OUString VBALikeToRegexp(const OUString &rIn)
1480 OUStringBuffer sResult;
1481 const sal_Unicode *start = rIn.getStr();
1482 const sal_Unicode *end = start + rIn.getLength();
1484 int seenright = 0;
1486 sResult.append('^');
1488 while (start < end)
1490 switch (*start)
1492 case '?':
1493 sResult.append('.');
1494 start++;
1495 break;
1496 case '*':
1497 sResult.append(".*");
1498 start++;
1499 break;
1500 case '#':
1501 sResult.append("[0-9]");
1502 start++;
1503 break;
1504 case ']':
1505 sResult.append('\\');
1506 sResult.append(*start++);
1507 break;
1508 case '[':
1509 sResult.append(*start++);
1510 seenright = 0;
1511 while (start < end && !seenright)
1513 switch (*start)
1515 case '[':
1516 case '?':
1517 case '*':
1518 sResult.append('\\');
1519 sResult.append(*start);
1520 break;
1521 case ']':
1522 sResult.append(*start);
1523 seenright = 1;
1524 break;
1525 case '!':
1526 sResult.append('^');
1527 break;
1528 default:
1529 if (NeedEsc(*start))
1531 sResult.append('\\');
1533 sResult.append(*start);
1534 break;
1536 start++;
1538 break;
1539 default:
1540 if (NeedEsc(*start))
1542 sResult.append('\\');
1544 sResult.append(*start++);
1548 sResult.append('$');
1550 return sResult.makeStringAndClear();
1554 void SbiRuntime::StepLIKE()
1556 SbxVariableRef refVar1 = PopVar();
1557 SbxVariableRef refVar2 = PopVar();
1559 OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
1560 OUString value = refVar2->GetOUString();
1562 i18nutil::SearchOptions2 aSearchOpt;
1564 aSearchOpt.AlgorithmType2 = css::util::SearchAlgorithms2::REGEXP;
1566 aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
1567 aSearchOpt.searchString = pattern;
1569 bool bTextMode(true);
1570 bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
1571 if( bCompatibility )
1573 bTextMode = IsImageFlag( SbiImageFlags::COMPARETEXT );
1575 if( bTextMode )
1577 aSearchOpt.transliterateFlags |= TransliterationFlags::IGNORE_CASE;
1579 SbxVariable* pRes = new SbxVariable;
1580 utl::TextSearch aSearch( aSearchOpt);
1581 sal_Int32 nStart=0, nEnd=value.getLength();
1582 bool bRes = aSearch.SearchForward(value, &nStart, &nEnd);
1583 pRes->PutBool( bRes );
1585 PushVar( pRes );
1588 // TOS and TOS-1 are both object variables and contain the same pointer
1590 void SbiRuntime::StepIS()
1592 SbxVariableRef refVar1 = PopVar();
1593 SbxVariableRef refVar2 = PopVar();
1595 SbxDataType eType1 = refVar1->GetType();
1596 SbxDataType eType2 = refVar2->GetType();
1597 if ( eType1 == SbxEMPTY )
1599 refVar1->Broadcast( SfxHintId::BasicDataWanted );
1600 eType1 = refVar1->GetType();
1602 if ( eType2 == SbxEMPTY )
1604 refVar2->Broadcast( SfxHintId::BasicDataWanted );
1605 eType2 = refVar2->GetType();
1608 bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
1609 if ( bVBAEnabled && !bRes )
1611 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1613 bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
1614 SbxVariable* pRes = new SbxVariable;
1615 pRes->PutBool( bRes );
1616 PushVar( pRes );
1619 // update the value of TOS
1621 void SbiRuntime::StepGET()
1623 SbxVariable* p = GetTOS();
1624 p->Broadcast( SfxHintId::BasicDataWanted );
1627 // #67607 copy Uno-Structs
1628 static bool checkUnoStructCopy( bool bVBA, SbxVariableRef const & refVal, SbxVariableRef const & refVar )
1630 SbxDataType eVarType = refVar->GetType();
1631 SbxDataType eValType = refVal->GetType();
1633 // tdf#144353 - do not assign a missing optional variable to a property
1634 if (refVal->GetType() == SbxERROR && SbiRuntime::IsMissing(refVal.get(), 1))
1636 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL);
1637 return true;
1640 if ( ( bVBA && ( eVarType == SbxEMPTY ) ) || !refVar->CanWrite() )
1641 return false;
1643 if ( eValType != SbxOBJECT )
1644 return false;
1645 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1646 // there :-/ not sure if for every '=' we would want struct handling
1647 if( eVarType != SbxOBJECT )
1649 if ( refVar->IsFixed() )
1650 return false;
1652 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1653 else if( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr )
1654 return false;
1656 SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject());
1657 if( !xValObj.is() || dynamic_cast<const SbUnoAnyObject*>( xValObj.get() ) != nullptr )
1658 return false;
1660 SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() );
1661 SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() );
1662 Any aAny;
1663 // make doubly sure value is either a Uno object or
1664 // a uno struct
1665 if ( pUnoVal || pUnoStructVal )
1666 aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
1667 else
1668 return false;
1669 if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
1671 refVar->SetType( SbxOBJECT );
1672 ErrCode eOldErr = SbxBase::GetError();
1673 // There are some circumstances when calling GetObject
1674 // will trigger an error, we need to squash those here.
1675 // Alternatively it is possible that the same scenario
1676 // could overwrite and existing error. Lets prevent that
1677 SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject());
1678 if ( eOldErr != ERRCODE_NONE )
1679 SbxBase::SetError( eOldErr );
1680 else
1681 SbxBase::ResetError();
1683 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( xVarObj.get() );
1685 OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
1686 OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
1688 if ( pUnoStructObj )
1690 StructRefInfo aInfo = pUnoStructObj->getStructInfo();
1691 aInfo.setValue( aAny );
1693 else
1695 SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
1696 // #70324: adopt ClassName
1697 pNewUnoObj->SetClassName( sClassName );
1698 refVar->PutObject( pNewUnoObj );
1700 return true;
1702 return false;
1706 // laying down TOS in TOS-1
1708 void SbiRuntime::StepPUT()
1710 SbxVariableRef refVal = PopVar();
1711 SbxVariableRef refVar = PopVar();
1712 // store on its own method (inside a function)?
1713 bool bFlagsChanged = false;
1714 SbxFlagBits n = SbxFlagBits::NONE;
1715 if( refVar.get() == pMeth )
1717 bFlagsChanged = true;
1718 n = refVar->GetFlags();
1719 refVar->SetFlag( SbxFlagBits::Write );
1722 // if left side arg is an object or variant and right handside isn't
1723 // either an object or a variant then try and see if a default
1724 // property exists.
1725 // to use e.g. Range{"A1") = 34
1726 // could equate to Range("A1").Value = 34
1727 if ( bVBAEnabled )
1729 // yet more hacking at this, I feel we don't quite have the correct
1730 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1731 // obj1 ) has default member/property ) ) It seems that default props
1732 // aren't dealt with if the object is a member of some parent object
1733 bool bObjAssign = false;
1734 if ( refVar->GetType() == SbxEMPTY )
1735 refVar->Broadcast( SfxHintId::BasicDataWanted );
1736 if ( refVar->GetType() == SbxOBJECT )
1738 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
1740 SbxVariable* pDflt = getDefaultProp( refVar.get() );
1742 if ( pDflt )
1743 refVar = pDflt;
1745 else
1746 bObjAssign = true;
1748 if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( dynamic_cast<const SbxMethod *>(refVal.get()) != nullptr || ! refVal->GetParent() ) )
1750 SbxVariable* pDflt = getDefaultProp( refVal.get() );
1751 if ( pDflt )
1752 refVal = pDflt;
1756 if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
1757 *refVar = *refVal;
1759 if( bFlagsChanged )
1760 refVar->SetFlags( n );
1763 namespace {
1765 // VBA Dim As New behavior handling, save init object information
1766 struct DimAsNewRecoverItem
1768 OUString m_aObjClass;
1769 OUString m_aObjName;
1770 SbxObject* m_pObjParent;
1771 SbModule* m_pClassModule;
1773 DimAsNewRecoverItem()
1774 : m_pObjParent( nullptr )
1775 , m_pClassModule( nullptr )
1778 DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
1779 SbxObject* pObjParent, SbModule* pClassModule )
1780 : m_aObjClass( rObjClass )
1781 , m_aObjName( rObjName )
1782 , m_pObjParent( pObjParent )
1783 , m_pClassModule( pClassModule )
1789 struct SbxVariablePtrHash
1791 size_t operator()( SbxVariable* pVar ) const
1792 { return reinterpret_cast<size_t>(pVar); }
1797 typedef std::unordered_map< SbxVariable*, DimAsNewRecoverItem,
1798 SbxVariablePtrHash > DimAsNewRecoverHash;
1800 namespace {
1802 DimAsNewRecoverHash gaDimAsNewRecoverHash;
1806 void removeDimAsNewRecoverItem( SbxVariable* pVar )
1808 DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( pVar );
1809 if( it != gaDimAsNewRecoverHash.end() )
1811 gaDimAsNewRecoverHash.erase( it );
1816 // saving object variable
1817 // not-object variables will cause errors
1819 constexpr OUStringLiteral pCollectionStr = u"Collection";
1821 void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
1823 // #67733 types with array-flag are OK too
1825 // Check var, !object is no error for sure if, only if type is fixed
1826 SbxDataType eVarType = refVar->GetType();
1827 if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
1829 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1830 return;
1833 // Check value, !object is no error for sure if, only if type is fixed
1834 SbxDataType eValType = refVal->GetType();
1835 if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
1837 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1838 return;
1841 // Getting in here causes problems with objects with default properties
1842 // if they are SbxEMPTY I guess
1843 if ( !bHandleDefaultProp || eValType == SbxOBJECT )
1845 // activate GetObject for collections on refVal
1846 SbxBase* pObjVarObj = refVal->GetObject();
1847 if( pObjVarObj )
1849 SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj );
1851 if( refObjVal.is() )
1853 refVal = refObjVal;
1855 else if( !(eValType & SbxARRAY) )
1857 refVal = nullptr;
1862 // #52896 refVal can be invalid here, if uno-sequences - or more
1863 // general arrays - are assigned to variables that are declared
1864 // as an object!
1865 if( !refVal.is() )
1867 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
1869 else
1871 bool bFlagsChanged = false;
1872 SbxFlagBits n = SbxFlagBits::NONE;
1873 if( refVar.get() == pMeth )
1875 bFlagsChanged = true;
1876 n = refVar->GetFlags();
1877 refVar->SetFlag( SbxFlagBits::Write );
1879 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() );
1880 if( pProcProperty )
1882 pProcProperty->setSet( true );
1884 if ( bHandleDefaultProp )
1886 // get default properties for lhs & rhs where necessary
1887 // SbxVariable* defaultProp = NULL; unused variable
1888 // LHS try determine if a default prop exists
1889 // again like in StepPUT (see there too ) we are tweaking the
1890 // heuristics again for when to assign an object reference or
1891 // use default members if they exist
1892 // #FIXME we really need to get to the bottom of this mess
1893 bool bObjAssign = false;
1894 if ( refVar->GetType() == SbxOBJECT )
1896 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
1898 SbxVariable* pDflt = getDefaultProp( refVar.get() );
1899 if ( pDflt )
1901 refVar = pDflt;
1904 else
1905 bObjAssign = true;
1907 // RHS only get a default prop is the rhs has one
1908 if ( refVal->GetType() == SbxOBJECT )
1910 // check if lhs is a null object
1911 // if it is then use the object not the default property
1912 SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() );
1914 // calling GetObject on a SbxEMPTY variable raises
1915 // object not set errors, make sure it's an Object
1916 if ( !pObj && refVar->GetType() == SbxOBJECT )
1918 SbxBase* pObjVarObj = refVar->GetObject();
1919 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
1921 SbxVariable* pDflt = nullptr;
1922 if ( pObj && !bObjAssign )
1924 // lhs is either a valid object || or has a defaultProp
1925 pDflt = getDefaultProp( refVal.get() );
1927 if ( pDflt )
1929 refVal = pDflt;
1934 // Handle Dim As New
1935 bool bDimAsNew = bVBAEnabled && refVar->IsSet( SbxFlagBits::DimAsNew );
1936 SbxBaseRef xPrevVarObj;
1937 if( bDimAsNew )
1939 xPrevVarObj = refVar->GetObject();
1941 // Handle withevents
1942 bool bWithEvents = refVar->IsSet( SbxFlagBits::WithEvents );
1943 if ( bWithEvents )
1945 Reference< XInterface > xComListener;
1947 SbxBase* pObj = refVal->GetObject();
1948 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
1949 if( pUnoObj != nullptr )
1951 Any aControlAny = pUnoObj->getUnoAny();
1952 OUString aDeclareClassName = refVar->GetDeclareClassName();
1953 OUString aPrefix = refVar->GetName();
1954 SbxObjectRef xScopeObj = refVar->GetParent();
1955 xComListener = createComListener( aControlAny, aDeclareClassName, aPrefix, xScopeObj );
1957 refVal->SetDeclareClassName( aDeclareClassName );
1958 refVal->SetComListener( xComListener, &rBasic ); // Hold reference
1963 // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1964 // in this case if there is a default prop involved the value of the
1965 // default property may in fact be void so the type will also be SbxEMPTY
1966 // in this case we do not want to call checkUnoStructCopy 'cause that will
1967 // cause an error also
1968 if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
1970 *refVar = *refVal;
1972 if ( bDimAsNew )
1974 if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr )
1976 SbxBase* pValObjBase = refVal->GetObject();
1977 if( pValObjBase == nullptr )
1979 if( xPrevVarObj.is() )
1981 // Object is overwritten with NULL, instantiate init object
1982 DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( refVar.get() );
1983 if( it != gaDimAsNewRecoverHash.end() )
1985 const DimAsNewRecoverItem& rItem = it->second;
1986 if( rItem.m_pClassModule != nullptr )
1988 SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
1989 pNewObj->SetName( rItem.m_aObjName );
1990 pNewObj->SetParent( rItem.m_pObjParent );
1991 refVar->PutObject( pNewObj );
1993 else if( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) )
1995 BasicCollection* pNewCollection = new BasicCollection( pCollectionStr );
1996 pNewCollection->SetName( rItem.m_aObjName );
1997 pNewCollection->SetParent( rItem.m_pObjParent );
1998 refVar->PutObject( pNewCollection );
2003 else
2005 // Does old value exist?
2006 bool bFirstInit = !xPrevVarObj.is();
2007 if( bFirstInit )
2009 // Store information to instantiate object later
2010 SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase );
2011 if( pValObj != nullptr )
2013 OUString aObjClass = pValObj->GetClassName();
2015 SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pValObjBase );
2016 if( pClassModuleObj != nullptr )
2018 SbModule* pClassModule = pClassModuleObj->getClassModule();
2019 gaDimAsNewRecoverHash[refVar.get()] =
2020 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
2022 else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
2024 gaDimAsNewRecoverHash[refVar.get()] =
2025 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), nullptr );
2033 if( bFlagsChanged )
2035 refVar->SetFlags( n );
2040 void SbiRuntime::StepSET()
2042 SbxVariableRef refVal = PopVar();
2043 SbxVariableRef refVar = PopVar();
2044 StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assignment
2047 void SbiRuntime::StepVBASET()
2049 SbxVariableRef refVal = PopVar();
2050 SbxVariableRef refVar = PopVar();
2051 // don't handle default property
2052 StepSET_Impl( refVal, refVar ); // set obj = something
2056 void SbiRuntime::StepLSET()
2058 SbxVariableRef refVal = PopVar();
2059 SbxVariableRef refVar = PopVar();
2060 if( refVar->GetType() != SbxSTRING ||
2061 refVal->GetType() != SbxSTRING )
2063 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
2065 else
2067 SbxFlagBits n = refVar->GetFlags();
2068 if( refVar.get() == pMeth )
2070 refVar->SetFlag( SbxFlagBits::Write );
2072 OUString aRefVarString = refVar->GetOUString();
2073 OUString aRefValString = refVal->GetOUString();
2075 sal_Int32 nVarStrLen = aRefVarString.getLength();
2076 sal_Int32 nValStrLen = aRefValString.getLength();
2077 OUString aNewStr;
2078 if( nVarStrLen > nValStrLen )
2080 OUStringBuffer buf(aRefValString);
2081 comphelper::string::padToLength(buf, nVarStrLen, ' ');
2082 aNewStr = buf.makeStringAndClear();
2084 else
2086 aNewStr = aRefValString.copy( 0, nVarStrLen );
2089 refVar->PutString(aNewStr);
2090 refVar->SetFlags( n );
2094 void SbiRuntime::StepRSET()
2096 SbxVariableRef refVal = PopVar();
2097 SbxVariableRef refVar = PopVar();
2098 if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
2100 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
2102 else
2104 SbxFlagBits n = refVar->GetFlags();
2105 if( refVar.get() == pMeth )
2107 refVar->SetFlag( SbxFlagBits::Write );
2109 OUString aRefVarString = refVar->GetOUString();
2110 OUString aRefValString = refVal->GetOUString();
2111 sal_Int32 nVarStrLen = aRefVarString.getLength();
2112 sal_Int32 nValStrLen = aRefValString.getLength();
2114 OUStringBuffer aNewStr(nVarStrLen);
2115 if (nVarStrLen > nValStrLen)
2117 comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
2118 aNewStr.append(aRefValString);
2120 else
2122 aNewStr.append(aRefValString.subView(0, nVarStrLen));
2124 refVar->PutString(aNewStr.makeStringAndClear());
2126 refVar->SetFlags( n );
2130 // laying down TOS in TOS-1, then set ReadOnly-Bit
2132 void SbiRuntime::StepPUTC()
2134 SbxVariableRef refVal = PopVar();
2135 SbxVariableRef refVar = PopVar();
2136 refVar->SetFlag( SbxFlagBits::Write );
2137 *refVar = *refVal;
2138 refVar->ResetFlag( SbxFlagBits::Write );
2139 refVar->SetFlag( SbxFlagBits::Const );
2142 // DIM
2143 // TOS = variable for the array with dimension information as parameter
2145 void SbiRuntime::StepDIM()
2147 SbxVariableRef refVar = PopVar();
2148 DimImpl( refVar );
2151 // #56204 swap out DIM-functionality into a help method (step0.cxx)
2152 void SbiRuntime::DimImpl(const SbxVariableRef& refVar)
2154 // If refDim then this DIM statement is terminating a ReDIM and
2155 // previous StepERASE_CLEAR for an array, the following actions have
2156 // been delayed from ( StepERASE_CLEAR ) 'till here
2157 if ( refRedim.is() )
2159 if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve
2161 lcl_eraseImpl( refVar, bVBAEnabled );
2163 SbxDataType eType = refVar->GetType();
2164 lcl_clearImpl( refVar, eType );
2165 refRedim = nullptr;
2167 SbxArray* pDims = refVar->GetParameters();
2168 // must have an even number of arguments
2169 // have in mind that Arg[0] does not count!
2170 if (pDims && !(pDims->Count() & 1))
2172 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2174 else
2176 SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
2177 SbxDimArray* pArray = new SbxDimArray( eType );
2178 // allow arrays without dimension information, too (VB-compatible)
2179 if( pDims )
2181 refVar->ResetFlag( SbxFlagBits::VarToDim );
2183 for (sal_uInt32 i = 1; i < pDims->Count();)
2185 sal_Int32 lb = pDims->Get(i++)->GetLong();
2186 sal_Int32 ub = pDims->Get(i++)->GetLong();
2187 if( ub < lb )
2189 Error( ERRCODE_BASIC_OUT_OF_RANGE );
2190 ub = lb;
2192 pArray->AddDim(lb, ub);
2193 if ( lb != ub )
2195 pArray->setHasFixedSize( true );
2199 else
2201 // #62867 On creating an array of the length 0, create
2202 // a dimension (like for Uno-Sequences of the length 0)
2203 pArray->unoAddDim(0, -1);
2205 SbxFlagBits nSavFlags = refVar->GetFlags();
2206 refVar->ResetFlag( SbxFlagBits::Fixed );
2207 refVar->PutObject( pArray );
2208 refVar->SetFlags( nSavFlags );
2209 refVar->SetParameters( nullptr );
2213 // REDIM
2214 // TOS = variable for the array
2215 // argv = dimension information
2217 void SbiRuntime::StepREDIM()
2219 // Nothing different than dim at the moment because
2220 // a double dim is already recognized by the compiler.
2221 StepDIM();
2225 // Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true
2226 static void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, sal_Int32 nMaxDimIndex,
2227 sal_Int32 nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
2229 sal_Int32& ri = pActualIndices[nActualDim];
2230 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
2232 if( nActualDim < nMaxDimIndex )
2234 implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
2235 pActualIndices, pLowerBounds, pUpperBounds );
2237 else
2239 SbxVariable* pSource = pOldArray->Get(pActualIndices);
2240 if (pSource && pOldArray->GetRefCount() > 1)
2241 // tdf#134692: old array will stay alive after the redim - we need to copy deep
2242 pSource = new SbxVariable(*pSource);
2243 pNewArray->Put(pSource, pActualIndices);
2248 // Returns true when actually restored
2249 static bool implRestorePreservedArray(SbxDimArray* pNewArray, SbxArrayRef& rrefRedimpArray, bool* pbWasError = nullptr)
2251 assert(pNewArray);
2252 bool bResult = false;
2253 if (pbWasError)
2254 *pbWasError = false;
2255 if (rrefRedimpArray)
2257 SbxDimArray* pOldArray = static_cast<SbxDimArray*>(rrefRedimpArray.get());
2258 const sal_Int32 nDimsNew = pNewArray->GetDims();
2259 const sal_Int32 nDimsOld = pOldArray->GetDims();
2261 if (nDimsOld != nDimsNew)
2263 StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE);
2264 if (pbWasError)
2265 *pbWasError = true;
2267 else if (nDimsNew > 0)
2269 // Store dims to use them for copying later
2270 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDimsNew]);
2271 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDimsNew]);
2272 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDimsNew]);
2273 bool bNeedsPreallocation = true;
2275 // Compare bounds
2276 for (sal_Int32 i = 1; i <= nDimsNew; i++)
2278 sal_Int32 lBoundNew, uBoundNew;
2279 sal_Int32 lBoundOld, uBoundOld;
2280 pNewArray->GetDim(i, lBoundNew, uBoundNew);
2281 pOldArray->GetDim(i, lBoundOld, uBoundOld);
2282 lBoundNew = std::max(lBoundNew, lBoundOld);
2283 uBoundNew = std::min(uBoundNew, uBoundOld);
2284 sal_Int32 j = i - 1;
2285 pActualIndices[j] = pLowerBounds[j] = lBoundNew;
2286 pUpperBounds[j] = uBoundNew;
2287 if (lBoundNew > uBoundNew) // No elements in the dimension -> no elements to restore
2288 bNeedsPreallocation = false;
2291 // Optimization: pre-allocate underlying container
2292 if (bNeedsPreallocation)
2293 pNewArray->Put(nullptr, pUpperBounds.get());
2295 // Copy data from old array by going recursively through all dimensions
2296 // (It would be faster to work on the flat internal data array of an
2297 // SbyArray but this solution is clearer and easier)
2298 implCopyDimArray(pNewArray, pOldArray, nDimsNew - 1, 0, pActualIndices.get(),
2299 pLowerBounds.get(), pUpperBounds.get());
2300 bResult = true;
2303 rrefRedimpArray.clear();
2305 return bResult;
2308 // REDIM PRESERVE
2309 // TOS = variable for the array
2310 // argv = dimension information
2312 void SbiRuntime::StepREDIMP()
2314 SbxVariableRef refVar = PopVar();
2315 DimImpl( refVar );
2317 // Now check, if we can copy from the old array
2318 if( refRedimpArray.is() )
2320 if (SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>(refVar->GetObject()))
2321 implRestorePreservedArray(pNewArray, refRedimpArray);
2325 // REDIM_COPY
2326 // TOS = Array-Variable, Reference to array is copied
2327 // Variable is cleared as in ERASE
2329 void SbiRuntime::StepREDIMP_ERASE()
2331 SbxVariableRef refVar = PopVar();
2332 refRedim = refVar;
2333 SbxDataType eType = refVar->GetType();
2334 if( eType & SbxARRAY )
2336 SbxBase* pElemObj = refVar->GetObject();
2337 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
2338 if( pDimArray )
2340 refRedimpArray = pDimArray;
2344 else if( refVar->IsFixed() )
2346 refVar->Clear();
2348 else
2350 refVar->SetType( SbxEMPTY );
2354 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType )
2356 SbxFlagBits nSavFlags = refVar->GetFlags();
2357 refVar->ResetFlag( SbxFlagBits::Fixed );
2358 refVar->SetType( SbxDataType(eType & 0x0FFF) );
2359 refVar->SetFlags( nSavFlags );
2360 refVar->Clear();
2363 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled )
2365 SbxDataType eType = refVar->GetType();
2366 if( eType & SbxARRAY )
2368 if ( bVBAEnabled )
2370 SbxBase* pElemObj = refVar->GetObject();
2371 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
2372 if( pDimArray )
2374 if ( pDimArray->hasFixedSize() )
2376 // Clear all Value(s)
2377 pDimArray->SbxArray::Clear();
2379 else
2381 pDimArray->Clear(); // clear dims and values
2384 else
2386 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
2387 if ( pArray )
2389 pArray->Clear();
2393 else
2395 // Arrays have on an erase to VB quite a complex behaviour. Here are
2396 // only the type problems at REDIM (#26295) removed at first:
2397 // Set type hard onto the array-type, because a variable with array is
2398 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2399 // the original type is lost -> runtime error
2400 lcl_clearImpl( refVar, eType );
2403 else if( refVar->IsFixed() )
2405 refVar->Clear();
2407 else
2409 refVar->SetType( SbxEMPTY );
2413 // delete variable
2414 // TOS = variable
2416 void SbiRuntime::StepERASE()
2418 SbxVariableRef refVar = PopVar();
2419 lcl_eraseImpl( refVar, bVBAEnabled );
2422 void SbiRuntime::StepERASE_CLEAR()
2424 refRedim = PopVar();
2427 void SbiRuntime::StepARRAYACCESS()
2429 if( !refArgv.is() )
2431 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2433 SbxVariableRef refVar = PopVar();
2434 refVar->SetParameters( refArgv.get() );
2435 PopArgv();
2436 PushVar( CheckArray( refVar.get() ) );
2439 void SbiRuntime::StepBYVAL()
2441 // Copy variable on stack to break call by reference
2442 SbxVariableRef pVar = PopVar();
2443 SbxDataType t = pVar->GetType();
2445 SbxVariable* pCopyVar = new SbxVariable( t );
2446 pCopyVar->SetFlag( SbxFlagBits::ReadWrite );
2447 *pCopyVar = *pVar;
2449 PushVar( pCopyVar );
2452 // establishing an argv
2453 // nOp1 stays as it is -> 1st element is the return value
2455 void SbiRuntime::StepARGC()
2457 PushArgv();
2458 refArgv = new SbxArray;
2459 nArgc = 1;
2462 // storing an argument in Argv
2464 void SbiRuntime::StepARGV()
2466 if( !refArgv.is() )
2468 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2470 else
2472 SbxVariableRef pVal = PopVar();
2474 // Before fix of #94916:
2475 if( dynamic_cast<const SbxMethod*>( pVal.get() ) != nullptr
2476 || dynamic_cast<const SbUnoProperty*>( pVal.get() ) != nullptr
2477 || dynamic_cast<const SbProcedureProperty*>( pVal.get() ) != nullptr )
2479 // evaluate methods and properties!
2480 SbxVariable* pRes = new SbxVariable( *pVal );
2481 pVal = pRes;
2483 refArgv->Put(pVal.get(), nArgc++);
2487 // Input to Variable. The variable is on TOS and is
2488 // is removed afterwards.
2489 void SbiRuntime::StepINPUT()
2491 OUStringBuffer sin;
2492 char ch = 0;
2493 ErrCode err;
2494 // Skip whitespace
2495 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2497 ch = pIosys->Read();
2498 if( ch != ' ' && ch != '\t' && ch != '\n' )
2500 break;
2503 if( !err )
2505 // Scan until comma or whitespace
2506 char sep = ( ch == '"' ) ? ch : 0;
2507 if( sep )
2509 ch = pIosys->Read();
2511 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2513 if( ch == sep )
2515 ch = pIosys->Read();
2516 if( ch != sep )
2518 break;
2521 else if( !sep && (ch == ',' || ch == '\n') )
2523 break;
2525 sin.append( ch );
2526 ch = pIosys->Read();
2528 // skip whitespace
2529 if( ch == ' ' || ch == '\t' )
2531 while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
2533 if( ch != ' ' && ch != '\t' && ch != '\n' )
2535 break;
2537 ch = pIosys->Read();
2541 if( !err )
2543 OUString s = sin.makeStringAndClear();
2544 SbxVariableRef pVar = GetTOS();
2545 // try to fill the variable with a numeric value first,
2546 // then with a string value
2547 if( !pVar->IsFixed() || pVar->IsNumeric() )
2549 sal_uInt16 nLen = 0;
2550 if( !pVar->Scan( s, &nLen ) )
2552 err = SbxBase::GetError();
2553 SbxBase::ResetError();
2555 // the value has to be scanned in completely
2556 else if( nLen != s.getLength() && !pVar->PutString( s ) )
2558 err = SbxBase::GetError();
2559 SbxBase::ResetError();
2561 else if( nLen != s.getLength() && pVar->IsNumeric() )
2563 err = SbxBase::GetError();
2564 SbxBase::ResetError();
2565 if( !err )
2567 err = ERRCODE_BASIC_CONVERSION;
2571 else
2573 pVar->PutString( s );
2574 err = SbxBase::GetError();
2575 SbxBase::ResetError();
2578 if( err == ERRCODE_BASIC_USER_ABORT )
2580 Error( err );
2582 else if( err )
2584 if( pRestart && !pIosys->GetChannel() )
2586 pCode = pRestart;
2588 else
2590 Error( err );
2593 else
2595 PopVar();
2599 // Line Input to Variable. The variable is on TOS and is
2600 // deleted afterwards.
2602 void SbiRuntime::StepLINPUT()
2604 OString aInput;
2605 pIosys->Read( aInput );
2606 Error( pIosys->GetError() );
2607 SbxVariableRef p = PopVar();
2608 p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
2611 // end of program
2613 void SbiRuntime::StepSTOP()
2615 pInst->Stop();
2619 void SbiRuntime::StepINITFOR()
2621 PushFor();
2624 void SbiRuntime::StepINITFOREACH()
2626 PushForEach();
2629 // increment FOR-variable
2631 void SbiRuntime::StepNEXT()
2633 if( !pForStk )
2635 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2636 return;
2638 if (pForStk->eForType != ForType::To)
2639 return;
2640 if (!pForStk->refVar)
2642 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2643 return;
2645 // tdf#85371 - grant explicitly write access to the index variable
2646 // since it could be the name of a method itself used in the next statement.
2647 ScopedWritableGuard aGuard(pForStk->refVar, pForStk->refVar.get() == pMeth);
2648 pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
2651 // beginning CASE: TOS in CASE-stack
2653 void SbiRuntime::StepCASE()
2655 if( !refCaseStk.is() )
2657 refCaseStk = new SbxArray;
2659 SbxVariableRef xVar = PopVar();
2660 refCaseStk->Put(xVar.get(), refCaseStk->Count());
2663 // end CASE: free variable
2665 void SbiRuntime::StepENDCASE()
2667 if (!refCaseStk.is() || !refCaseStk->Count())
2669 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2671 else
2673 refCaseStk->Remove(refCaseStk->Count() - 1);
2678 void SbiRuntime::StepSTDERROR()
2680 pError = nullptr; bError = true;
2681 pInst->aErrorMsg.clear();
2682 pInst->nErr = ERRCODE_NONE;
2683 pInst->nErl = 0;
2684 nError = ERRCODE_NONE;
2685 SbxErrObject::getUnoErrObject()->Clear();
2688 void SbiRuntime::StepNOERROR()
2690 pInst->aErrorMsg.clear();
2691 pInst->nErr = ERRCODE_NONE;
2692 pInst->nErl = 0;
2693 nError = ERRCODE_NONE;
2694 SbxErrObject::getUnoErrObject()->Clear();
2695 bError = false;
2698 // leave UP
2700 void SbiRuntime::StepLEAVE()
2702 bRun = false;
2703 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2704 if ( bInError && pError )
2706 SbxErrObject::getUnoErrObject()->Clear();
2710 void SbiRuntime::StepCHANNEL() // TOS = channel number
2712 SbxVariableRef pChan = PopVar();
2713 short nChan = pChan->GetInteger();
2714 pIosys->SetChannel( nChan );
2715 Error( pIosys->GetError() );
2718 void SbiRuntime::StepCHANNEL0()
2720 pIosys->ResetChannel();
2723 void SbiRuntime::StepPRINT() // print TOS
2725 SbxVariableRef p = PopVar();
2726 OUString s1 = p->GetOUString();
2727 OUString s;
2728 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2730 s = " "; // one blank before
2732 s += s1;
2733 pIosys->Write( s );
2734 Error( pIosys->GetError() );
2737 void SbiRuntime::StepPRINTF() // print TOS in field
2739 SbxVariableRef p = PopVar();
2740 OUString s1 = p->GetOUString();
2741 OUStringBuffer s;
2742 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2744 s.append(' ');
2746 s.append(s1);
2747 comphelper::string::padToLength(s, 14, ' ');
2748 pIosys->Write( s.makeStringAndClear() );
2749 Error( pIosys->GetError() );
2752 void SbiRuntime::StepWRITE() // write TOS
2754 SbxVariableRef p = PopVar();
2755 // Does the string have to be encapsulated?
2756 char ch = 0;
2757 switch (p->GetType() )
2759 case SbxSTRING: ch = '"'; break;
2760 case SbxCURRENCY:
2761 case SbxBOOL:
2762 case SbxDATE: ch = '#'; break;
2763 default: break;
2765 OUString s;
2766 if( ch )
2768 s += OUStringChar(ch);
2770 s += p->GetOUString();
2771 if( ch )
2773 s += OUStringChar(ch);
2775 pIosys->Write( s );
2776 Error( pIosys->GetError() );
2779 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2781 SbxVariableRef pTos1 = PopVar();
2782 SbxVariableRef pTos = PopVar();
2783 OUString aDest = pTos1->GetOUString();
2784 OUString aSource = pTos->GetOUString();
2786 if( hasUno() )
2788 implStepRenameUCB( aSource, aDest );
2790 else
2792 implStepRenameOSL( aSource, aDest );
2796 // TOS = Prompt
2798 void SbiRuntime::StepPROMPT()
2800 SbxVariableRef p = PopVar();
2801 OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
2802 pIosys->SetPrompt( aStr );
2805 // Set Restart point
2807 void SbiRuntime::StepRESTART()
2809 pRestart = pCode;
2812 // empty expression on stack for missing parameter
2814 void SbiRuntime::StepEMPTY()
2816 // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2817 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
2818 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2819 // to simplify matters.
2820 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
2821 xVar->PutErr( 448 );
2822 // tdf#79426, tdf#125180 - add additional information about a missing parameter
2823 SetIsMissing( xVar.get() );
2824 PushVar( xVar.get() );
2827 // TOS = error code
2829 void SbiRuntime::StepERROR()
2831 SbxVariableRef refCode = PopVar();
2832 sal_uInt16 n = refCode->GetUShort();
2833 ErrCode error = StarBASIC::GetSfxFromVBError( n );
2834 if ( bVBAEnabled )
2836 pInst->Error( error );
2838 else
2840 Error( error );
2844 // loading a numeric constant (+ID)
2846 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
2848 // tdf#143707 - check if the data type character was added after the string termination symbol
2849 SbxDataType eTypeStr;
2850 // #57844 use localized function
2851 OUString aStr = pImg->GetString(static_cast<short>(nOp1), &eTypeStr);
2852 // also allow , !!!
2853 sal_Int32 iComma = aStr.indexOf(',');
2854 if( iComma >= 0 )
2856 aStr = aStr.replaceAt(iComma, 1, u".");
2858 sal_Int32 nParseEnd = 0;
2859 rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
2860 double n = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd );
2862 // tdf#131296 - retrieve data type put in SbiExprNode::Gen
2863 SbxDataType eType = SbxDOUBLE;
2864 if ( nParseEnd < aStr.getLength() )
2866 // tdf#143707 - Check if there was a data type character after the numeric constant,
2867 // added by older versions of the fix of the default values for strings.
2868 switch ( aStr[nParseEnd] )
2870 // See GetSuffixType in basic/source/comp/scanner.cxx for type characters
2871 case '%': eType = SbxINTEGER; break;
2872 case '&': eType = SbxLONG; break;
2873 case '!': eType = SbxSINGLE; break;
2874 case '@': eType = SbxCURRENCY; break;
2875 // tdf#142460 - properly handle boolean values in string pool
2876 case 'b': eType = SbxBOOL; break;
2879 // tdf#143707 - if the data type character is different from the default value, it was added
2880 // in basic/source/comp/symtbl.cxx. Hence, change the type of the numeric constant to be loaded.
2881 else if (eTypeStr != SbxSTRING)
2883 eType = eTypeStr;
2885 SbxVariable* p = new SbxVariable( eType );
2886 p->PutDouble( n );
2887 // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors
2888 p->ResetFlag( SbxFlagBits::Fixed );
2889 PushVar( p );
2892 // loading a string constant (+ID)
2894 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
2896 SbxVariable* p = new SbxVariable;
2897 p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
2898 PushVar( p );
2901 // Immediate Load (+value)
2902 // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images
2904 void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
2906 SbxVariable* p = new SbxVariable;
2907 p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
2908 PushVar( p );
2911 // store a named argument in Argv (+Arg-no. from 1!)
2913 void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
2915 if( !refArgv.is() )
2916 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2917 else
2919 OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
2920 SbxVariableRef pVal = PopVar();
2921 if( bVBAEnabled &&
2922 ( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr
2923 || dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr
2924 || dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) )
2926 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2927 if ( pVal->GetType() == SbxEMPTY )
2928 pVal->Broadcast( SfxHintId::BasicDataWanted );
2929 // evaluate methods and properties!
2930 SbxVariable* pRes = new SbxVariable( *pVal );
2931 pVal = pRes;
2933 refArgv->Put(pVal.get(), nArgc);
2934 refArgv->PutAlias(aAlias, nArgc++);
2938 // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2940 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
2942 if( !refArgv.is() )
2943 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
2944 else
2946 bool bByVal = (nOp1 & 0x8000) != 0; // Is BYVAL requested?
2947 SbxDataType t = static_cast<SbxDataType>(nOp1 & 0x7FFF);
2948 SbxVariable* pVar = refArgv->Get(refArgv->Count() - 1); // last Arg
2950 // check BYVAL
2951 if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
2953 // parameter is a reference
2954 if( bByVal )
2956 // Call by Value is requested -> create a copy
2957 pVar = new SbxVariable( *pVar );
2958 pVar->SetFlag( SbxFlagBits::ReadWrite );
2959 refExprStk->Put(pVar, refArgv->Count() - 1);
2961 else
2962 pVar->SetFlag( SbxFlagBits::Reference ); // Ref-Flag for DllMgr
2964 else
2966 // parameter is NO reference
2967 if( bByVal )
2968 pVar->ResetFlag( SbxFlagBits::Reference ); // no reference -> OK
2969 else
2970 Error( ERRCODE_BASIC_BAD_PARAMETERS ); // reference needed
2973 if( pVar->GetType() != t )
2975 // variant for correct conversion
2976 // besides error, if SbxBYREF
2977 pVar->Convert( SbxVARIANT );
2978 pVar->Convert( t );
2983 // bring string to a definite length (+length)
2985 void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
2987 SbxVariable* p = GetTOS();
2988 OUString s = p->GetOUString();
2989 sal_Int32 nLen(nOp1);
2990 if( s.getLength() == nLen )
2991 return;
2993 OUStringBuffer aBuf(s);
2994 if (aBuf.getLength() > nLen)
2996 comphelper::string::truncateToLength(aBuf, nLen);
2998 else
3000 comphelper::string::padToLength(aBuf, nLen, ' ');
3002 s = aBuf.makeStringAndClear();
3005 // jump (+target)
3007 void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
3009 #ifdef DBG_UTIL
3010 // #QUESTION shouldn't this be
3011 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
3012 if( nOp1 >= pImg->GetCodeSize() )
3013 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3014 #endif
3015 pCode = pImg->GetCode() + nOp1;
3018 bool SbiRuntime::EvaluateTopOfStackAsBool()
3020 SbxVariableRef tos = PopVar();
3021 // In a test e.g. If Null then
3022 // will evaluate Null will act as if False
3023 if ( bVBAEnabled && tos->IsNull() )
3025 return false;
3027 if ( tos->IsObject() )
3029 //GetBool applied to an Object attempts to dereference and evaluate
3030 //the underlying value as Bool. Here, we're checking rather that
3031 //it is not null
3032 return tos->GetObject();
3034 else
3036 return tos->GetBool();
3040 // evaluate TOS, conditional jump (+target)
3042 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
3044 if ( EvaluateTopOfStackAsBool() )
3046 StepJUMP( nOp1 );
3050 // evaluate TOS, conditional jump (+target)
3052 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
3054 if ( !EvaluateTopOfStackAsBool() )
3056 StepJUMP( nOp1 );
3060 // evaluate TOS, jump into JUMP-table (+MaxVal)
3061 // looks like this:
3062 // ONJUMP 2
3063 // JUMP target1
3064 // JUMP target2
3066 // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
3068 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
3070 SbxVariableRef p = PopVar();
3071 sal_Int16 n = p->GetInteger();
3072 if( nOp1 & 0x8000 )
3074 nOp1 &= 0x7FFF;
3075 PushGosub( pCode + 5 * nOp1 );
3077 if( n < 1 || o3tl::make_unsigned(n) > nOp1 )
3078 n = static_cast<sal_Int16>( nOp1 + 1 );
3079 nOp1 = static_cast<sal_uInt32>(pCode - pImg->GetCode()) + 5 * --n;
3080 StepJUMP( nOp1 );
3083 // UP-call (+target)
3085 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
3087 PushGosub( pCode );
3088 if( nOp1 >= pImg->GetCodeSize() )
3089 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3090 pCode = pImg->GetCode() + nOp1;
3093 // UP-return (+0 or target)
3095 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
3097 PopGosub();
3098 if( nOp1 )
3099 StepJUMP( nOp1 );
3102 // check FOR-variable (+Endlabel)
3104 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
3106 if( !pForStk )
3108 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3109 return;
3112 bool bEndLoop = false;
3113 switch( pForStk->eForType )
3115 case ForType::To:
3117 SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
3118 if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
3119 bEndLoop = true;
3120 if (SbxBase::IsError())
3121 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3122 break;
3124 case ForType::EachArray:
3126 SbiForStack* p = pForStk;
3127 if (!p->refEnd)
3129 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3130 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3132 else if (p->pArrayCurIndices == nullptr)
3134 bEndLoop = true;
3136 else
3138 SbxDimArray* pArray = reinterpret_cast<SbxDimArray*>(p->refEnd.get());
3139 sal_Int32 nDims = pArray->GetDims();
3141 // Empty array?
3142 if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
3144 bEndLoop = true;
3145 break;
3147 SbxVariable* pVal = pArray->Get(p->pArrayCurIndices.get());
3148 *(p->refVar) = *pVal;
3150 bool bFoundNext = false;
3151 for(sal_Int32 i = 0 ; i < nDims ; i++ )
3153 if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
3155 bFoundNext = true;
3156 p->pArrayCurIndices[i]++;
3157 for( sal_Int32 j = i - 1 ; j >= 0 ; j-- )
3158 p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
3159 break;
3162 if( !bFoundNext )
3164 p->pArrayCurIndices.reset();
3167 break;
3169 case ForType::EachCollection:
3171 if (!pForStk->refEnd)
3173 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3174 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3175 break;
3178 BasicCollection* pCollection = static_cast<BasicCollection*>(pForStk->refEnd.get());
3179 SbxArrayRef xItemArray = pCollection->xItemArray;
3180 sal_Int32 nCount = xItemArray->Count();
3181 if( pForStk->nCurCollectionIndex < nCount )
3183 SbxVariable* pRes = xItemArray->Get(pForStk->nCurCollectionIndex);
3184 pForStk->nCurCollectionIndex++;
3185 (*pForStk->refVar) = *pRes;
3187 else
3189 bEndLoop = true;
3191 break;
3193 case ForType::EachXEnumeration:
3195 SbiForStack* p = pForStk;
3196 if (!p->xEnumeration)
3198 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3199 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3201 else if (p->xEnumeration->hasMoreElements())
3203 Any aElem = p->xEnumeration->nextElement();
3204 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
3205 unoToSbxValue( xVar.get(), aElem );
3206 (*pForStk->refVar) = *xVar;
3208 else
3210 bEndLoop = true;
3212 break;
3214 // tdf#130307 - support for each loop for objects exposing XIndexAccess
3215 case ForType::EachXIndexAccess:
3217 SbiForStack* p = pForStk;
3218 if (!p->xIndexAccess)
3220 SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
3221 pForStk->eForType = ForType::Error; // terminate loop at the next iteration
3223 else if (pForStk->nCurCollectionIndex < p->xIndexAccess->getCount())
3225 Any aElem = p->xIndexAccess->getByIndex(pForStk->nCurCollectionIndex);
3226 pForStk->nCurCollectionIndex++;
3227 SbxVariableRef xVar = new SbxVariable(SbxVARIANT);
3228 unoToSbxValue(xVar.get(), aElem);
3229 (*pForStk->refVar) = *xVar;
3231 else
3233 bEndLoop = true;
3235 break;
3237 case ForType::Error:
3239 // We are in Resume Next mode after failed loop initialization
3240 bEndLoop = true;
3241 Error(ERRCODE_BASIC_BAD_PARAMETER);
3242 break;
3245 if( bEndLoop )
3247 PopFor();
3248 StepJUMP( nOp1 );
3252 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3254 void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
3256 if (!refCaseStk.is() || !refCaseStk->Count())
3257 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3258 else
3260 SbxVariableRef xTo = PopVar();
3261 SbxVariableRef xFrom = PopVar();
3262 SbxVariableRef xCase = refCaseStk->Get(refCaseStk->Count() - 1);
3263 if( *xCase >= *xFrom && *xCase <= *xTo )
3264 StepJUMP( nOp1 );
3269 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
3271 const sal_uInt8* p = pCode;
3272 StepJUMP( nOp1 );
3273 pError = pCode;
3274 pCode = p;
3275 pInst->aErrorMsg.clear();
3276 pInst->nErr = ERRCODE_NONE;
3277 pInst->nErl = 0;
3278 nError = ERRCODE_NONE;
3279 SbxErrObject::getUnoErrObject()->Clear();
3282 // Resume after errors (+0=statement, 1=next or Label)
3284 void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
3286 // #32714 Resume without error? -> error
3287 if( !bInError )
3289 Error( ERRCODE_BASIC_BAD_RESUME );
3290 return;
3292 if( nOp1 )
3294 // set Code-pointer to the next statement
3295 sal_uInt16 n1, n2;
3296 pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg );
3298 else
3299 pCode = pErrStmnt;
3300 if ( pError ) // current in error handler ( and got a Resume Next statement )
3301 SbxErrObject::getUnoErrObject()->Clear();
3303 if( nOp1 > 1 )
3304 StepJUMP( nOp1 );
3305 pInst->aErrorMsg.clear();
3306 pInst->nErr = ERRCODE_NONE;
3307 pInst->nErl = 0;
3308 nError = ERRCODE_NONE;
3309 bInError = false;
3312 // close channel (+channel, 0=all)
3313 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
3315 ErrCode err;
3316 if( !nOp1 )
3317 pIosys->Shutdown();
3318 else
3320 err = pIosys->GetError();
3321 if( !err )
3323 pIosys->Close();
3326 err = pIosys->GetError();
3327 Error( err );
3330 // output character (+char)
3332 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
3334 OUString s(static_cast<sal_Unicode>(nOp1));
3335 pIosys->Write( s );
3336 Error( pIosys->GetError() );
3339 // check whether TOS is a certain object class (+StringID)
3341 bool SbiRuntime::implIsClass( SbxObject const * pObj, const OUString& aClass )
3343 bool bRet = true;
3345 if( !aClass.isEmpty() )
3347 bRet = pObj->IsClass( aClass );
3348 if( !bRet )
3349 bRet = aClass.equalsIgnoreAsciiCase( "object" );
3350 if( !bRet )
3352 const OUString& aObjClass = pObj->GetClassName();
3353 SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
3354 if( pClassMod )
3356 SbClassData* pClassData = pClassMod->pClassData.get();
3357 if (pClassData != nullptr )
3359 SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxClassType::DontCare );
3360 bRet = (pClassVar != nullptr);
3365 return bRet;
3368 bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
3369 const OUString& aClass, bool bRaiseErrors, bool bDefault )
3371 bool bOk = bDefault;
3373 SbxDataType t = refVal->GetType();
3374 SbxVariable* pVal = refVal.get();
3375 // we don't know the type of uno properties that are (maybevoid)
3376 if ( t == SbxEMPTY )
3378 if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) )
3380 t = pProp->getRealType();
3383 if( t == SbxOBJECT || bVBAEnabled )
3385 SbxObject* pObj = dynamic_cast<SbxObject*>(pVal);
3386 if (!pObj)
3388 pObj = dynamic_cast<SbxObject*>(refVal->GetObject());
3390 if( pObj )
3392 if( !implIsClass( pObj, aClass ) )
3394 SbUnoObject* pUnoObj(nullptr);
3395 if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration())
3397 pUnoObj = dynamic_cast<SbUnoObject*>(pObj);
3400 if (pUnoObj)
3401 bOk = checkUnoObjectType(*pUnoObj, aClass);
3402 else
3403 bOk = false;
3404 if ( !bOk && bRaiseErrors )
3405 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
3407 else
3409 bOk = true;
3411 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pObj );
3412 if( pClassModuleObject != nullptr )
3413 pClassModuleObject->triggerInitializeEvent();
3417 else
3419 if( bRaiseErrors )
3420 Error( ERRCODE_BASIC_NEEDS_OBJECT );
3421 bOk = false;
3423 return bOk;
3426 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
3428 SbxVariableRef refVal = PopVar();
3429 SbxVariableRef refVar = PopVar();
3430 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3432 bool bOk = checkClass_Impl( refVal, aClass, true, true );
3433 if( bOk )
3435 StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set
3439 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
3441 StepSETCLASS_impl( nOp1, false );
3444 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
3446 StepSETCLASS_impl( nOp1, true );
3449 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
3451 SbxVariableRef xObjVal = PopVar();
3452 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3453 bool bDefault = !bVBAEnabled;
3454 bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
3456 SbxVariable* pRet = new SbxVariable;
3457 pRet->PutBool( bOk );
3458 PushVar( pRet );
3461 // define library for following declare-call
3463 void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
3465 aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
3468 // TOS is incremented by BASE, BASE is pushed before (+BASE)
3469 // This opcode is pushed before DIM/REDIM-commands,
3470 // if there's been only one index named.
3472 void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
3474 SbxVariable* p1 = new SbxVariable;
3475 SbxVariableRef x2 = PopVar();
3477 // #109275 Check compatibility mode
3478 bool bCompatible = ((nOp1 & 0x8000) != 0);
3479 sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
3480 p1->PutInteger( uBase );
3481 if( !bCompatible )
3483 // tdf#85371 - grant explicitly write access to the dimension variable
3484 // since in Star/OpenOffice Basic the upper index border is affected,
3485 // and the dimension variable could be the name of the method itself.
3486 ScopedWritableGuard aGuard(x2, x2.get() == pMeth);
3487 x2->Compute( SbxPLUS, *p1 );
3489 PushVar( x2.get() ); // first the Expr
3490 PushVar( p1 ); // then the Base
3493 // the bits in the String-ID:
3494 // 0x8000 - Argv is reserved
3496 SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
3497 ErrCode nNotFound, bool bLocal, bool bStatic )
3499 bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
3500 if( bIsVBAInterOp )
3502 StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
3503 if( pMSOMacroRuntimeLib != nullptr )
3505 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::ExtSearch );
3509 SbxVariable* pElem = nullptr;
3510 if( !pObj )
3512 Error( ERRCODE_BASIC_NO_OBJECT );
3513 pElem = new SbxVariable;
3515 else
3517 bool bFatalError = false;
3518 SbxDataType t = static_cast<SbxDataType>(nOp2);
3519 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
3520 // Hacky capture of Evaluate [] syntax
3521 // this should be tackled I feel at the pcode level
3522 if ( bIsVBAInterOp && aName.startsWith("[") )
3524 // emulate pcode here
3525 StepARGC();
3526 // pseudo StepLOADSC
3527 OUString sArg = aName.copy( 1, aName.getLength() - 2 );
3528 SbxVariable* p = new SbxVariable;
3529 p->PutString( sArg );
3530 PushVar( p );
3531 StepARGV();
3532 nOp1 = nOp1 | 0x8000; // indicate params are present
3533 aName = "Evaluate";
3535 if( bLocal )
3537 if ( bStatic && pMeth )
3539 pElem = pMeth->GetStatics()->Find( aName, SbxClassType::DontCare );
3542 if ( !pElem )
3544 pElem = refLocals->Find( aName, SbxClassType::DontCare );
3547 if( !pElem )
3549 bool bSave = rBasic.bNoRtl;
3550 rBasic.bNoRtl = true;
3551 pElem = pObj->Find( aName, SbxClassType::DontCare );
3553 // #110004, #112015: Make private really private
3554 if( bLocal && pElem ) // Local as flag for global search
3556 if( pElem->IsSet( SbxFlagBits::Private ) )
3558 SbiInstance* pInst_ = GetSbData()->pInst;
3559 if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
3561 pElem = nullptr; // Found but in wrong module!
3563 // Interfaces: Use SbxFlagBits::ExtFound
3566 rBasic.bNoRtl = bSave;
3568 // is it a global uno-identifier?
3569 if( bLocal && !pElem )
3571 bool bSetName = true; // preserve normal behaviour
3573 // i#i68894# if VBAInterOp favour searching vba globals
3574 // over searching for uno classes
3575 if ( bVBAEnabled )
3577 // Try Find in VBA symbols space
3578 pElem = rBasic.VBAFind( aName, SbxClassType::DontCare );
3579 if ( pElem )
3581 bSetName = false; // don't overwrite uno name
3583 else
3585 pElem = VBAConstantHelper::instance().getVBAConstant( aName );
3589 if( !pElem )
3591 // #72382 ATTENTION! ALWAYS returns a result now
3592 // because of unknown modules!
3593 SbUnoClass* pUnoClass = findUnoClass( aName );
3594 if( pUnoClass )
3596 pElem = new SbxVariable( t );
3597 SbxValues aRes( SbxOBJECT );
3598 aRes.pObj = pUnoClass;
3599 pElem->SbxVariable::Put( aRes );
3603 // #62939 If a uno-class has been found, the wrapper
3604 // object has to be held, because the uno-class, e. g.
3605 // "stardiv", has to be read out of the registry
3606 // every time again otherwise
3607 if( pElem )
3609 // #63774 May not be saved too!!!
3610 pElem->SetFlag( SbxFlagBits::DontStore );
3611 pElem->SetFlag( SbxFlagBits::NoModify);
3613 // #72382 save locally, all variables that have been declared
3614 // implicit would become global automatically otherwise!
3615 if ( bSetName )
3617 pElem->SetName( aName );
3619 refLocals->Put(pElem, refLocals->Count());
3623 if( !pElem )
3625 // not there and not in the object?
3626 // don't establish if that thing has parameters!
3627 if( nOp1 & 0x8000 )
3629 bFatalError = true;
3632 // else, if there are parameters, use different error code
3633 if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) )
3635 // #39108 if explicit and as ELEM always a fatal error
3636 bFatalError = true;
3639 if( !( nOp1 & 0x8000 ) && nNotFound == ERRCODE_BASIC_PROC_UNDEFINED )
3641 nNotFound = ERRCODE_BASIC_VAR_UNDEFINED;
3644 if( bFatalError )
3646 // #39108 use dummy variable instead of fatal error
3647 if( !xDummyVar.is() )
3649 xDummyVar = new SbxVariable( SbxVARIANT );
3651 pElem = xDummyVar.get();
3653 ClearArgvStack();
3655 Error( nNotFound, aName );
3657 else
3659 if ( bStatic )
3661 pElem = StepSTATIC_Impl( aName, t, 0 );
3663 if ( !pElem )
3665 pElem = new SbxVariable( t );
3666 if( t != SbxVARIANT )
3668 pElem->SetFlag( SbxFlagBits::Fixed );
3670 pElem->SetName( aName );
3671 refLocals->Put(pElem, refLocals->Count());
3676 // #39108 Args can already be deleted!
3677 if( !bFatalError )
3679 SetupArgs( pElem, nOp1 );
3681 // because a particular call-type is requested
3682 if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem))
3684 // shall the type be converted?
3685 SbxDataType t2 = pElem->GetType();
3686 bool bSet = false;
3687 if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE )
3689 if( t != SbxVARIANT && t != t2 &&
3690 t >= SbxINTEGER && t <= SbxSTRING )
3692 pElem->SetType( t );
3693 bSet = true;
3696 // assign pElem to a Ref, to delete a temp-var if applicable
3697 SbxVariableRef xDeleteRef = pElem;
3699 // remove potential rests of the last call of the SbxMethod
3700 // free Write before, so that there's no error
3701 SbxFlagBits nSavFlags = pElem->GetFlags();
3702 pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast );
3703 pElem->SbxValue::Clear();
3704 pElem->SetFlags( nSavFlags );
3706 // don't touch before setting, as e. g. LEFT()
3707 // has to know the difference between Left$() and Left()
3709 // because the methods' parameters are cut away in PopVar()
3710 SbxVariable* pNew = new SbxMethod(*pMethod);
3711 //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3713 pElem->SetParameters(nullptr);
3714 pNew->SetFlag( SbxFlagBits::ReadWrite );
3716 if( bSet )
3718 pElem->SetType( t2 );
3720 pElem = pNew;
3722 // consider index-access for UnoObjects
3723 // definitely we want this for VBA where properties are often
3724 // collections ( which need index access ), but lets only do
3725 // this if we actually have params following
3726 else if( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() )
3728 SbxVariableRef xDeleteRef = pElem;
3730 // dissolve the notify while copying variable
3731 SbxVariable* pNew = new SbxVariable( *pElem );
3732 pElem->SetParameters( nullptr );
3733 pElem = pNew;
3736 return CheckArray( pElem );
3739 // for current scope (e. g. query from BASIC-IDE)
3740 SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
3742 // don't expect pMeth to be != 0, as there are none set
3743 // in the RunInit yet
3745 SbxVariable* pElem = nullptr;
3746 if( !pMod || rName.isEmpty() )
3748 return nullptr;
3750 if( refLocals.is() )
3752 pElem = refLocals->Find( rName, SbxClassType::DontCare );
3754 if ( !pElem && pMeth )
3756 const OUString aMethName = pMeth->GetName();
3757 // tdf#57308 - check if the name is the current method instance
3758 if (pMeth->GetName() == rName)
3760 pElem = pMeth;
3762 else
3764 // for statics, set the method's name in front
3765 pElem = pMod->Find(aMethName + ":" + rName, SbxClassType::DontCare);
3770 // search in parameter list
3771 if( !pElem && pMeth )
3773 SbxInfo* pInfo = pMeth->GetInfo();
3774 if( pInfo && refParams.is() )
3776 sal_uInt32 nParamCount = refParams->Count();
3777 assert(nParamCount <= std::numeric_limits<sal_uInt16>::max());
3778 sal_uInt16 j = 1;
3779 const SbxParamInfo* pParam = pInfo->GetParam( j );
3780 while( pParam )
3782 if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
3784 if( j >= nParamCount )
3786 // Parameter is missing
3787 pElem = new SbxVariable( SbxSTRING );
3788 pElem->PutString( "<missing parameter>");
3790 else
3792 pElem = refParams->Get(j);
3794 break;
3796 pParam = pInfo->GetParam( ++j );
3801 // search in module
3802 if( !pElem )
3804 bool bSave = rBasic.bNoRtl;
3805 rBasic.bNoRtl = true;
3806 pElem = pMod->Find( rName, SbxClassType::DontCare );
3807 rBasic.bNoRtl = bSave;
3809 return pElem;
3813 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
3815 if( nOp1 & 0x8000 )
3817 if( !refArgv.is() )
3819 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
3821 bool bHasNamed = false;
3822 sal_uInt32 i;
3823 sal_uInt32 nArgCount = refArgv->Count();
3824 for( i = 1 ; i < nArgCount ; i++ )
3826 if (!refArgv->GetAlias(i).isEmpty())
3828 bHasNamed = true; break;
3831 if( bHasNamed )
3833 SbxInfo* pInfo = p->GetInfo();
3834 if( !pInfo )
3836 bool bError_ = true;
3838 SbUnoMethod* pUnoMethod = dynamic_cast<SbUnoMethod*>( p );
3839 SbUnoProperty* pUnoProperty = dynamic_cast<SbUnoProperty*>( p );
3840 if( pUnoMethod || pUnoProperty )
3842 SbUnoObject* pParentUnoObj = dynamic_cast<SbUnoObject*>( p->GetParent() );
3843 if( pParentUnoObj )
3845 Any aUnoAny = pParentUnoObj->getUnoAny();
3846 Reference< XInvocation > xInvocation;
3847 aUnoAny >>= xInvocation;
3848 if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() )
3850 bError_ = false;
3852 sal_uInt32 nCurPar = 1;
3853 AutomationNamedArgsSbxArray* pArg =
3854 new AutomationNamedArgsSbxArray( nArgCount );
3855 OUString* pNames = pArg->getNames().getArray();
3856 for( i = 1 ; i < nArgCount ; i++ )
3858 SbxVariable* pVar = refArgv->Get(i);
3859 OUString aName = refArgv->GetAlias(i);
3860 if (!aName.isEmpty())
3862 pNames[i] = aName;
3864 pArg->Put(pVar, nCurPar++);
3866 refArgv = pArg;
3870 else if( bVBAEnabled && p->GetType() == SbxOBJECT && (dynamic_cast<const SbxMethod*>( p) == nullptr || !p->IsBroadcaster()) )
3872 // Check for default method with named parameters
3873 SbxBaseRef xObj = p->GetObject();
3874 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( xObj.get() ))
3876 Any aAny = pUnoObj->getUnoAny();
3878 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3880 Reference< XDefaultMethod > xDfltMethod( aAny, UNO_QUERY );
3882 OUString sDefaultMethod;
3883 if ( xDfltMethod.is() )
3885 sDefaultMethod = xDfltMethod->getDefaultMethodName();
3887 if ( !sDefaultMethod.isEmpty() )
3889 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
3890 if( meth != nullptr )
3892 pInfo = meth->GetInfo();
3894 if( pInfo )
3896 bError_ = false;
3902 if( bError_ )
3904 Error( ERRCODE_BASIC_NO_NAMED_ARGS );
3907 else
3909 sal_uInt32 nCurPar = 1;
3910 SbxArray* pArg = new SbxArray;
3911 for( i = 1 ; i < nArgCount ; i++ )
3913 SbxVariable* pVar = refArgv->Get(i);
3914 OUString aName = refArgv->GetAlias(i);
3915 if (!aName.isEmpty())
3917 // nCurPar is set to the found parameter
3918 sal_uInt16 j = 1;
3919 const SbxParamInfo* pParam = pInfo->GetParam( j );
3920 while( pParam )
3922 if( pParam->aName.equalsIgnoreAsciiCase( aName ) )
3924 nCurPar = j;
3925 break;
3927 pParam = pInfo->GetParam( ++j );
3929 if( !pParam )
3931 Error( ERRCODE_BASIC_NAMED_NOT_FOUND ); break;
3934 pArg->Put(pVar, nCurPar++);
3936 refArgv = pArg;
3939 // own var as parameter 0
3940 refArgv->Put(p, 0);
3941 p->SetParameters( refArgv.get() );
3942 PopArgv();
3944 else
3946 p->SetParameters( nullptr );
3950 // getting an array element
3952 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
3954 SbxArray* pPar;
3955 if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem )
3957 SbxBase* pElemObj = pElem->GetObject();
3958 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
3959 pPar = pElem->GetParameters();
3960 if( pDimArray )
3962 // parameters may be missing, if an array is
3963 // passed as an argument
3964 if( pPar )
3965 pElem = pDimArray->Get( pPar );
3967 else
3969 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
3970 if( pArray )
3972 if( !pPar )
3974 Error( ERRCODE_BASIC_OUT_OF_RANGE );
3975 pElem = new SbxVariable;
3977 else
3979 pElem = pArray->Get(pPar->Get(1)->GetInteger());
3984 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3985 if( pPar )
3987 pPar->Put(nullptr, 0);
3990 // consider index-access for UnoObjects
3991 else if( pElem->GetType() == SbxOBJECT &&
3992 dynamic_cast<const SbxMethod*>( pElem) == nullptr &&
3993 ( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) )
3995 pPar = pElem->GetParameters();
3996 if ( pPar )
3998 // is it a uno-object?
3999 SbxBaseRef pObj = pElem->GetObject();
4000 if( pObj.is() )
4002 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get()))
4004 Any aAny = pUnoObj->getUnoAny();
4006 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
4008 Reference< XIndexAccess > xIndexAccess( aAny, UNO_QUERY );
4009 if ( !bVBAEnabled )
4011 if( xIndexAccess.is() )
4013 sal_uInt32 nParamCount = pPar->Count() - 1;
4014 if( nParamCount != 1 )
4016 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4017 return pElem;
4020 // get index
4021 sal_Int32 nIndex = pPar->Get(1)->GetLong();
4022 Reference< XInterface > xRet;
4025 Any aAny2 = xIndexAccess->getByIndex( nIndex );
4026 aAny2 >>= xRet;
4028 catch (const IndexOutOfBoundsException&)
4030 // usually expect converting problem
4031 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
4034 // #57847 always create a new variable, else error
4035 // due to PutObject(NULL) at ReadOnly-properties
4036 pElem = new SbxVariable( SbxVARIANT );
4037 if( xRet.is() )
4039 aAny <<= xRet;
4041 // #67173 don't specify a name so that the real class name is entered
4042 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny ));
4043 pElem->PutObject( xWrapper.get() );
4045 else
4047 pElem->PutObject( nullptr );
4051 else
4053 // check if there isn't a default member between the current variable
4054 // and the params, e.g.
4055 // Dim rst1 As New ADODB.Recordset
4056 // "
4057 // val = rst1("FirstName")
4058 // has the default 'Fields' member between rst1 and '("FirstName")'
4059 Any x = aAny;
4060 SbxVariable* pDflt = getDefaultProp( pElem );
4061 if ( pDflt )
4063 pDflt->Broadcast( SfxHintId::BasicDataWanted );
4064 SbxBaseRef pDfltObj = pDflt->GetObject();
4065 if( pDfltObj.is() )
4067 if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get()))
4069 pUnoObj = pSbObj;
4070 Any aUnoAny = pUnoObj->getUnoAny();
4072 if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
4073 x = aUnoAny;
4074 pElem = pDflt;
4078 OUString sDefaultMethod;
4080 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
4082 if ( xDfltMethod.is() )
4084 sDefaultMethod = xDfltMethod->getDefaultMethodName();
4086 else if( xIndexAccess.is() )
4088 sDefaultMethod = "getByIndex";
4090 if ( !sDefaultMethod.isEmpty() )
4092 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
4093 SbxVariableRef refTemp = meth;
4094 if ( refTemp.is() )
4096 meth->SetParameters( pPar );
4097 SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) );
4098 pElem = pNew;
4104 // #42940, set parameter 0 to NULL so that var doesn't contain itself
4105 pPar->Put(nullptr, 0);
4107 else if (BasicCollection* pCol = dynamic_cast<BasicCollection*>(pObj.get()))
4109 pElem = new SbxVariable( SbxVARIANT );
4110 pPar->Put(pElem, 0);
4111 pCol->CollItem( pPar );
4114 else if( bVBAEnabled ) // !pObj
4116 SbxArray* pParam = pElem->GetParameters();
4117 if( pParam != nullptr && !pElem->IsSet( SbxFlagBits::VarToDim ) )
4119 Error( ERRCODE_BASIC_NO_OBJECT );
4125 return pElem;
4128 // loading an element from the runtime-library (+StringID+type)
4130 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4132 PushVar( FindElement( rBasic.pRtl.get(), nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, false ) );
4135 void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
4136 ErrCode nNotFound, bool bStatic )
4138 if( !refLocals.is() )
4140 refLocals = new SbxArray;
4142 PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, true/*bLocal*/, bStatic ) );
4144 // loading a local/global variable (+StringID+type)
4146 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4148 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED );
4151 // Search inside a class module (CM) to enable global search in time
4152 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4155 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pMod );
4156 if( pClassModuleObject )
4158 pMod->SetFlag( SbxFlagBits::GlobalSearch );
4160 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED);
4162 if( pClassModuleObject )
4164 pMod->ResetFlag( SbxFlagBits::GlobalSearch );
4168 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4170 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, true );
4173 // loading an object-element (+StringID+type)
4174 // the object lies on TOS
4176 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4178 SbxVariableRef pObjVar = PopVar();
4180 SbxObject* pObj = dynamic_cast<SbxObject*>( pObjVar.get() );
4181 if( !pObj )
4183 SbxBase* pObjVarObj = pObjVar->GetObject();
4184 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
4187 // #56368 save reference at StepElem, otherwise objects could
4188 // lose their reference too early in qualification chains like
4189 // ActiveComponent.Selection(0).Text
4190 // #74254 now per list
4191 if( pObj )
4193 aRefSaved.emplace_back(pObj );
4195 PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) );
4198 /** Loading of a parameter (+offset+type)
4199 If the data type is wrong, create a copy and search for optionals including
4200 the default value. The data type SbxEMPTY shows that no parameters are given.
4201 Get( 0 ) may be EMPTY
4203 @param nOp1
4204 the index of the current parameter being processed,
4205 where the entry of the index 0 is for the return value.
4207 @param nOp2
4208 the data type of the parameter.
4210 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4212 sal_uInt16 nIdx = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
4213 SbxDataType eType = static_cast<SbxDataType>(nOp2);
4214 SbxVariable* pVar;
4216 // #57915 solve missing in a cleaner way
4217 sal_uInt32 nParamCount = refParams->Count();
4218 if( nIdx >= nParamCount )
4220 sal_uInt16 iLoop = nIdx;
4221 while( iLoop >= nParamCount )
4223 pVar = new SbxVariable();
4224 pVar->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
4225 // tdf#79426, tdf#125180 - add additional information about a missing parameter
4226 SetIsMissing( pVar );
4227 refParams->Put(pVar, iLoop);
4228 iLoop--;
4231 pVar = refParams->Get(nIdx);
4233 // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing
4234 if( pVar->GetType() == SbxERROR && IsMissing( pVar, 1 ) && nIdx )
4236 // if there's a parameter missing, it can be OPTIONAL
4237 bool bOpt = false;
4238 if( pMeth )
4240 SbxInfo* pInfo = pMeth->GetInfo();
4241 if ( pInfo )
4243 const SbxParamInfo* pParam = pInfo->GetParam( nIdx );
4244 if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) )
4246 // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors
4247 pVar->ResetFlag( SbxFlagBits::Fixed );
4248 // Default value?
4249 sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff);
4250 if( nDefaultId > 0 )
4252 // tdf#143707 - check if the data type character was added after the string
4253 // termination symbol, and convert the variable if it was present. The
4254 // data type character was added in basic/source/comp/symtbl.cxx.
4255 SbxDataType eTypeStr;
4256 OUString aDefaultStr = pImg->GetString( nDefaultId, &eTypeStr );
4257 pVar = new SbxVariable(pParam-> eType);
4258 pVar->PutString( aDefaultStr );
4259 if (eTypeStr != SbxSTRING)
4260 pVar->Convert(eTypeStr);
4261 refParams->Put(pVar, nIdx);
4263 else if ( SbiRuntime::isVBAEnabled() && eType != SbxVARIANT )
4265 // tdf#36737 - initialize the parameter with the default value of its type
4266 pVar = new SbxVariable( pParam->eType );
4267 refParams->Put(pVar, nIdx);
4269 bOpt = true;
4273 if( !bOpt )
4275 Error( ERRCODE_BASIC_NOT_OPTIONAL );
4278 else if( eType != SbxVARIANT && static_cast<SbxDataType>(pVar->GetType() & 0x0FFF ) != eType )
4280 // tdf#43003 - convert parameter to the requested type
4281 pVar->Convert(eType);
4283 SetupArgs( pVar, nOp1 );
4284 PushVar( CheckArray( pVar ) );
4287 // Case-Test (+True-Target+Test-Opcode)
4289 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4291 if (!refCaseStk.is() || !refCaseStk->Count())
4293 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
4295 else
4297 SbxVariableRef xComp = PopVar();
4298 SbxVariableRef xCase = refCaseStk->Get(refCaseStk->Count() - 1);
4299 if( xCase->Compare( static_cast<SbxOperator>(nOp2), *xComp ) )
4301 StepJUMP( nOp1 );
4306 // call of a DLL-procedure (+StringID+type)
4307 // the StringID's MSB shows that Argv is occupied
4309 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4311 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4312 SbxArray* pArgs = nullptr;
4313 if( nOp1 & 0x8000 )
4315 pArgs = refArgv.get();
4317 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), false );
4318 aLibName.clear();
4319 if( nOp1 & 0x8000 )
4321 PopArgv();
4325 // call of a DLL-procedure after CDecl (+StringID+type)
4327 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4329 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4330 SbxArray* pArgs = nullptr;
4331 if( nOp1 & 0x8000 )
4333 pArgs = refArgv.get();
4335 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), true );
4336 aLibName.clear();
4337 if( nOp1 & 0x8000 )
4339 PopArgv();
4344 // beginning of a statement (+Line+Col)
4346 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4348 // If the Expr-Stack at the beginning of a statement contains a variable,
4349 // some fool has called X as a function, although it's a variable!
4350 bool bFatalExpr = false;
4351 OUString sUnknownMethodName;
4352 if( nExprLvl > 1 )
4354 bFatalExpr = true;
4356 else if( nExprLvl )
4358 SbxVariable* p = refExprStk->Get(0);
4359 if( p->GetRefCount() > 1 &&
4360 refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) )
4362 sUnknownMethodName = p->GetName();
4363 bFatalExpr = true;
4367 ClearExprStack();
4369 aRefSaved.clear();
4371 // We have to cancel hard here because line and column
4372 // would be wrong later otherwise!
4373 if( bFatalExpr)
4375 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName );
4376 return;
4378 pStmnt = pCode - 9;
4379 sal_uInt16 nOld = nLine;
4380 nLine = static_cast<short>( nOp1 );
4382 // #29955 & 0xFF, to filter out for-loop-level
4383 nCol1 = static_cast<short>( nOp2 & 0xFF );
4385 // find the next STMNT-command to set the final column
4386 // of this statement
4388 nCol2 = 0xffff;
4389 sal_uInt16 n1, n2;
4390 const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
4391 if( p )
4393 if( n1 == nOp1 )
4395 // #29955 & 0xFF, to filter out for-loop-level
4396 nCol2 = (n2 & 0xFF) - 1;
4400 // #29955 correct for-loop-level, #67452 NOT in the error-handler
4401 if( !bInError )
4403 // (there's a difference here in case of a jump out of a loop)
4404 sal_uInt16 nExpectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
4405 if( !pGosubStk.empty() )
4407 nExpectedForLevel = nExpectedForLevel + pGosubStk.back().nStartForLvl;
4410 // if the actual for-level is too small it'd jump out
4411 // of a loop -> corrected
4412 while( nForLvl > nExpectedForLevel )
4414 PopFor();
4418 // 16.10.96: #31460 new concept for StepInto/Over/Out
4419 // see explanation at _ImplGetBreakCallLevel
4420 if( pInst->nCallLvl <= pInst->nBreakCallLvl )
4422 StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
4423 BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
4425 pInst->CalcBreakCallLevel( nNewFlags );
4428 // break points only at STMNT-commands in a new line!
4429 else if( ( nOp1 != nOld )
4430 && ( nFlags & BasicDebugFlags::Break )
4431 && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
4433 StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
4434 BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
4436 pInst->CalcBreakCallLevel( nNewFlags );
4440 // (+StreamMode+Flags)
4441 // Stack: block length
4442 // channel number
4443 // file name
4445 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4447 SbxVariableRef pName = PopVar();
4448 SbxVariableRef pChan = PopVar();
4449 SbxVariableRef pLen = PopVar();
4450 short nBlkLen = pLen->GetInteger();
4451 short nChan = pChan->GetInteger();
4452 OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
4453 pIosys->Open( nChan, aName, static_cast<StreamMode>( nOp1 ),
4454 static_cast<SbiStreamFlags>( nOp2 ), nBlkLen );
4455 Error( pIosys->GetError() );
4458 // create object (+StringID+StringID)
4460 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4462 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4463 SbxObjectRef pObj = SbxBase::CreateObject( aClass );
4464 if( !pObj )
4466 Error( ERRCODE_BASIC_INVALID_OBJECT );
4468 else
4470 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4471 pObj->SetName( aName );
4472 // the object must be able to call the BASIC
4473 pObj->SetParent( &rBasic );
4474 SbxVariableRef pNew = new SbxVariable;
4475 pNew->PutObject( pObj.get() );
4476 PushVar( pNew.get() );
4480 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4482 StepDCREATE_IMPL( nOp1, nOp2 );
4485 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4487 StepDCREATE_IMPL( nOp1, nOp2 );
4490 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4491 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4493 SbxVariableRef refVar = PopVar();
4495 DimImpl( refVar );
4497 // fill the array with instances of the requested class
4498 SbxBase* pObj = refVar->GetObject();
4499 if (!pObj)
4501 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT );
4502 return;
4505 SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj);
4506 if (!pArray)
4507 return;
4509 const sal_Int32 nDims = pArray->GetDims();
4510 sal_Int32 nTotalSize = nDims > 0 ? 1 : 0;
4512 // must be a one-dimensional array
4513 sal_Int32 nLower, nUpper;
4514 for( sal_Int32 i = 0 ; i < nDims ; ++i )
4516 pArray->GetDim(i + 1, nLower, nUpper);
4517 const sal_Int32 nSize = nUpper - nLower + 1;
4518 nTotalSize *= nSize;
4521 // Optimization: pre-allocate underlying container
4522 if (nTotalSize > 0)
4523 pArray->SbxArray::GetRef(nTotalSize - 1);
4525 // First, fill those parts of the array that are preserved
4526 bool bWasError = false;
4527 const bool bRestored = implRestorePreservedArray(pArray, refRedimpArray, &bWasError);
4528 if (bWasError)
4529 nTotalSize = 0; // on error, don't create objects
4531 // create objects and insert them into the array
4532 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4533 OUString aName;
4534 for( sal_Int32 i = 0 ; i < nTotalSize ; ++i )
4536 if (!bRestored || !pArray->SbxArray::GetRef(i)) // For those left unset after preserve
4538 SbxObjectRef pClassObj = SbxBase::CreateObject(aClass);
4539 if (!pClassObj)
4541 Error(ERRCODE_BASIC_INVALID_OBJECT);
4542 break;
4544 else
4546 if (aName.isEmpty())
4547 aName = pImg->GetString(static_cast<short>(nOp1));
4548 pClassObj->SetName(aName);
4549 // the object must be able to call the basic
4550 pClassObj->SetParent(&rBasic);
4551 pArray->SbxArray::Put(pClassObj.get(), i);
4557 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4559 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4560 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4562 SbxObjectRef pCopyObj = createUserTypeImpl( aClass );
4563 if( pCopyObj )
4565 pCopyObj->SetName( aName );
4567 SbxVariableRef pNew = new SbxVariable;
4568 pNew->PutObject( pCopyObj.get() );
4569 pNew->SetDeclareClassName( aClass );
4570 PushVar( pNew.get() );
4573 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
4575 bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
4576 if( bWithEvents )
4578 pVar->SetFlag( SbxFlagBits::WithEvents );
4580 bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
4581 if( bDimAsNew )
4583 pVar->SetFlag( SbxFlagBits::DimAsNew );
4585 bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
4586 if( bFixedString )
4588 sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000
4589 OUStringBuffer aBuf;
4590 comphelper::string::padToLength(aBuf, nCount);
4591 pVar->PutString(aBuf.makeStringAndClear());
4594 bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
4595 if( bVarToDim )
4597 pVar->SetFlag( SbxFlagBits::VarToDim );
4601 // establishing a local variable (+StringID+type)
4603 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4605 if( !refLocals.is() )
4607 refLocals = new SbxArray;
4609 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4610 if( refLocals->Find( aName, SbxClassType::DontCare ) == nullptr )
4612 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4613 SbxVariable* p = new SbxVariable( t );
4614 p->SetName( aName );
4615 implHandleSbxFlags( p, t, nOp2 );
4616 refLocals->Put(p, refLocals->Count());
4620 // establishing a module-global variable (+StringID+type)
4622 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
4624 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4625 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4626 bool bFlag = pMod->IsSet( SbxFlagBits::NoModify );
4627 pMod->SetFlag( SbxFlagBits::NoModify );
4628 SbxVariableRef p = pMod->Find( aName, SbxClassType::Property );
4629 if( p.is() )
4631 pMod->Remove (p.get());
4633 SbProperty* pProp = pMod->GetProperty( aName, t );
4634 if( !bUsedForClassModule )
4636 pProp->SetFlag( SbxFlagBits::Private );
4638 if( !bFlag )
4640 pMod->ResetFlag( SbxFlagBits::NoModify );
4642 if( pProp )
4644 pProp->SetFlag( SbxFlagBits::DontStore );
4645 // from 2.7.1996: HACK because of 'reference can't be saved'
4646 pProp->SetFlag( SbxFlagBits::NoModify);
4648 implHandleSbxFlags( pProp, t, nOp2 );
4652 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4654 StepPUBLIC_Impl( nOp1, nOp2, false );
4657 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4659 // Creates module variable that isn't reinitialised when
4660 // between invocations ( for VBASupport & document basic only )
4661 if( pMod->pImage->bFirstInit )
4663 bool bUsedForClassModule = pImg->IsFlag( SbiImageFlags::CLASSMODULE );
4664 StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
4668 // establishing a global variable (+StringID+type)
4670 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4672 if( pImg->IsFlag( SbiImageFlags::CLASSMODULE ) )
4674 StepPUBLIC_Impl( nOp1, nOp2, true );
4676 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4677 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4679 // Store module scope variables at module scope
4680 // in non vba mode these are stored at the library level :/
4681 // not sure if this really should not be enabled for ALL basic
4682 SbxObject* pStorage = &rBasic;
4683 if ( SbiRuntime::isVBAEnabled() )
4685 pStorage = pMod;
4686 pMod->AddVarName( aName );
4689 bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify );
4690 rBasic.SetFlag( SbxFlagBits::NoModify );
4691 SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property );
4692 if( p.is() )
4694 pStorage->Remove (p.get());
4696 p = pStorage->Make( aName, SbxClassType::Property, t );
4697 if( !bFlag )
4699 pStorage->ResetFlag( SbxFlagBits::NoModify );
4701 if( p.is() )
4703 p->SetFlag( SbxFlagBits::DontStore );
4704 // from 2.7.1996: HACK because of 'reference can't be saved'
4705 p->SetFlag( SbxFlagBits::NoModify);
4710 // Creates global variable that isn't reinitialised when
4711 // basic is restarted, P=PERSIST (+StringID+Typ)
4713 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4715 if( pMod->pImage->bFirstInit )
4717 StepGLOBAL( nOp1, nOp2 );
4722 // Searches for global variable, behavior depends on the fact
4723 // if the variable is initialised for the first time
4725 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4727 if( pMod->pImage->bFirstInit )
4729 // Behave like always during first init
4730 StepFIND( nOp1, nOp2 );
4732 else
4734 // Return dummy variable
4735 SbxDataType t = static_cast<SbxDataType>(nOp2);
4736 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
4738 SbxVariable* pDummyVar = new SbxVariable( t );
4739 pDummyVar->SetName( aName );
4740 PushVar( pDummyVar );
4745 SbxVariable* SbiRuntime::StepSTATIC_Impl(
4746 OUString const & aName, SbxDataType t, sal_uInt32 nOp2 )
4748 SbxVariable* p = nullptr;
4749 if ( pMeth )
4751 SbxArray* pStatics = pMeth->GetStatics();
4752 if( pStatics && ( pStatics->Find( aName, SbxClassType::DontCare ) == nullptr ) )
4754 p = new SbxVariable( t );
4755 if( t != SbxVARIANT )
4757 p->SetFlag( SbxFlagBits::Fixed );
4759 p->SetName( aName );
4760 implHandleSbxFlags( p, t, nOp2 );
4761 pStatics->Put(p, pStatics->Count());
4764 return p;
4766 // establishing a static variable (+StringID+type)
4767 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4769 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4770 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
4771 StepSTATIC_Impl( aName, t, nOp2 );
4774 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */