Line data Source code
1 : /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 : /*
3 : * This file is part of the LibreOffice project.
4 : *
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/.
8 : *
9 : * This file incorporates work covered by the following license notice:
10 : *
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 .
18 : */
19 :
20 : #include <stdlib.h>
21 :
22 : #include <algorithm>
23 :
24 : #include <boost/unordered_map.hpp>
25 :
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/SearchOptions.hpp>
32 :
33 : #include <comphelper/processfactory.hxx>
34 : #include <comphelper/string.hxx>
35 :
36 : #include <sal/log.hxx>
37 :
38 : #include <tools/wldcrd.hxx>
39 :
40 : #include <vcl/msgbox.hxx>
41 : #include <vcl/svapp.hxx>
42 : #include <vcl/settings.hxx>
43 :
44 : #include <rtl/instance.hxx>
45 : #include <rtl/math.hxx>
46 : #include <rtl/ustrbuf.hxx>
47 :
48 : #include <svl/zforlist.hxx>
49 :
50 : #include <unotools/syslocale.hxx>
51 : #include <unotools/textsearch.hxx>
52 :
53 : #include <basic/sbuno.hxx>
54 :
55 : #include "basrid.hxx"
56 : #include "codegen.hxx"
57 : #include "comenumwrapper.hxx"
58 : #include "ddectrl.hxx"
59 : #include "dllmgr.hxx"
60 : #include "errobject.hxx"
61 : #include "image.hxx"
62 : #include "iosys.hxx"
63 : #include "opcodes.hxx"
64 : #include "runtime.hxx"
65 : #include "sb.hrc"
66 : #include "sb.hxx"
67 : #include "sbintern.hxx"
68 : #include "sbunoobj.hxx"
69 : #include <basic/codecompletecache.hxx>
70 : #include <boost/scoped_array.hpp>
71 :
72 : using com::sun::star::uno::Reference;
73 :
74 : using namespace com::sun::star::uno;
75 : using namespace com::sun::star::container;
76 : using namespace com::sun::star::lang;
77 : using namespace com::sun::star::beans;
78 : using namespace com::sun::star::script;
79 :
80 : using namespace ::com::sun::star;
81 :
82 : static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType );
83 : static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled );
84 :
85 46848 : bool SbiRuntime::isVBAEnabled()
86 : {
87 46848 : bool result = false;
88 46848 : SbiInstance* pInst = GetSbData()->pInst;
89 46848 : if ( pInst && GetSbData()->pInst->pRun )
90 46514 : result = pInst->pRun->bVBAEnabled;
91 46848 : return result;
92 : }
93 :
94 3756 : void StarBASIC::SetVBAEnabled( bool bEnabled )
95 : {
96 3756 : if ( bDocBasic )
97 : {
98 3756 : bVBAEnabled = bEnabled;
99 : }
100 3756 : }
101 :
102 450 : bool StarBASIC::isVBAEnabled()
103 : {
104 450 : if ( bDocBasic )
105 : {
106 324 : if( SbiRuntime::isVBAEnabled() )
107 4 : return true;
108 320 : return bVBAEnabled;
109 : }
110 126 : return false;
111 : }
112 :
113 :
114 14676 : struct SbiArgvStack { // Argv stack:
115 : SbiArgvStack* pNext; // Stack Chain
116 : SbxArrayRef refArgv; // Argv
117 : short nArgc; // Argc
118 : };
119 :
120 : SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // all opcodes without operands
121 : &SbiRuntime::StepNOP,
122 : &SbiRuntime::StepEXP,
123 : &SbiRuntime::StepMUL,
124 : &SbiRuntime::StepDIV,
125 : &SbiRuntime::StepMOD,
126 : &SbiRuntime::StepPLUS,
127 : &SbiRuntime::StepMINUS,
128 : &SbiRuntime::StepNEG,
129 : &SbiRuntime::StepEQ,
130 : &SbiRuntime::StepNE,
131 : &SbiRuntime::StepLT,
132 : &SbiRuntime::StepGT,
133 : &SbiRuntime::StepLE,
134 : &SbiRuntime::StepGE,
135 : &SbiRuntime::StepIDIV,
136 : &SbiRuntime::StepAND,
137 : &SbiRuntime::StepOR,
138 : &SbiRuntime::StepXOR,
139 : &SbiRuntime::StepEQV,
140 : &SbiRuntime::StepIMP,
141 : &SbiRuntime::StepNOT,
142 : &SbiRuntime::StepCAT,
143 :
144 : &SbiRuntime::StepLIKE,
145 : &SbiRuntime::StepIS,
146 : // load/save
147 : &SbiRuntime::StepARGC, // establish new Argv
148 : &SbiRuntime::StepARGV, // TOS ==> current Argv
149 : &SbiRuntime::StepINPUT, // Input ==> TOS
150 : &SbiRuntime::StepLINPUT, // Line Input ==> TOS
151 : &SbiRuntime::StepGET, // touch TOS
152 : &SbiRuntime::StepSET, // save object TOS ==> TOS-1
153 : &SbiRuntime::StepPUT, // TOS ==> TOS-1
154 : &SbiRuntime::StepPUTC, // TOS ==> TOS-1, then ReadOnly
155 : &SbiRuntime::StepDIM, // DIM
156 : &SbiRuntime::StepREDIM, // REDIM
157 : &SbiRuntime::StepREDIMP, // REDIM PRESERVE
158 : &SbiRuntime::StepERASE, // delete TOS
159 : // branch
160 : &SbiRuntime::StepSTOP, // program end
161 : &SbiRuntime::StepINITFOR, // intitialize FOR-Variable
162 : &SbiRuntime::StepNEXT, // increment FOR-Variable
163 : &SbiRuntime::StepCASE, // beginning CASE
164 : &SbiRuntime::StepENDCASE, // end CASE
165 : &SbiRuntime::StepSTDERROR, // standard error handling
166 : &SbiRuntime::StepNOERROR, // no error handling
167 : &SbiRuntime::StepLEAVE, // leave UP
168 : // E/A
169 : &SbiRuntime::StepCHANNEL, // TOS = channel number
170 : &SbiRuntime::StepPRINT, // print TOS
171 : &SbiRuntime::StepPRINTF, // print TOS in field
172 : &SbiRuntime::StepWRITE, // write TOS
173 : &SbiRuntime::StepRENAME, // Rename Tos+1 to Tos
174 : &SbiRuntime::StepPROMPT, // define Input Prompt from TOS
175 : &SbiRuntime::StepRESTART, // Set restart point
176 : &SbiRuntime::StepCHANNEL0, // set E/A-channel 0
177 : &SbiRuntime::StepEMPTY, // empty expression on stack
178 : &SbiRuntime::StepERROR, // TOS = error code
179 : &SbiRuntime::StepLSET, // save object TOS ==> TOS-1
180 : &SbiRuntime::StepRSET, // save object TOS ==> TOS-1
181 : &SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
182 : &SbiRuntime::StepINITFOREACH,// Init for each loop
183 : &SbiRuntime::StepVBASET,// vba-like set statement
184 : &SbiRuntime::StepERASE_CLEAR,// vba-like set statement
185 : &SbiRuntime::StepARRAYACCESS,// access TOS as array
186 : &SbiRuntime::StepBYVAL, // access TOS as array
187 : };
188 :
189 : SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // all opcodes with one operand
190 : &SbiRuntime::StepLOADNC, // loading a numeric constant (+ID)
191 : &SbiRuntime::StepLOADSC, // loading a string constant (+ID)
192 : &SbiRuntime::StepLOADI, // Immediate Load (+Wert)
193 : &SbiRuntime::StepARGN, // save a named Args in Argv (+StringID)
194 : &SbiRuntime::StepPAD, // bring string to a definite length (+length)
195 : // branches
196 : &SbiRuntime::StepJUMP, // jump (+Target)
197 : &SbiRuntime::StepJUMPT, // evaluate TOS, conditional jump (+Target)
198 : &SbiRuntime::StepJUMPF, // evaluate TOS, conditional jump (+Target)
199 : &SbiRuntime::StepONJUMP, // evaluate TOS, jump into JUMP-table (+MaxVal)
200 : &SbiRuntime::StepGOSUB, // UP-call (+Target)
201 : &SbiRuntime::StepRETURN, // UP-return (+0 or Target)
202 : &SbiRuntime::StepTESTFOR, // check FOR-variable, increment (+Endlabel)
203 : &SbiRuntime::StepCASETO, // Tos+1 <= Case <= Tos), 2xremove (+Target)
204 : &SbiRuntime::StepERRHDL, // error handler (+Offset)
205 : &SbiRuntime::StepRESUME, // resume after errors (+0 or 1 or Label)
206 : // E/A
207 : &SbiRuntime::StepCLOSE, // (+channel/0)
208 : &SbiRuntime::StepPRCHAR, // (+char)
209 : // management
210 : &SbiRuntime::StepSETCLASS, // check set + class names (+StringId)
211 : &SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId)
212 : &SbiRuntime::StepLIB, // lib for declare-call (+StringId)
213 : &SbiRuntime::StepBASED, // TOS is incremented by BASE, BASE is pushed before
214 : &SbiRuntime::StepARGTYP, // convert last parameter in Argv (+Type)
215 : &SbiRuntime::StepVBASETCLASS,// vba-like set statement
216 : };
217 :
218 : SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// all opcodes with two operands
219 : &SbiRuntime::StepRTL, // load from RTL (+StringID+Typ)
220 : &SbiRuntime::StepFIND, // load (+StringID+Typ)
221 : &SbiRuntime::StepELEM, // load element (+StringID+Typ)
222 : &SbiRuntime::StepPARAM, // Parameter (+Offset+Typ)
223 : // Verzweigen
224 : &SbiRuntime::StepCALL, // Declare-Call (+StringID+Typ)
225 : &SbiRuntime::StepCALLC, // CDecl-Declare-Call (+StringID+Typ)
226 : &SbiRuntime::StepCASEIS, // Case-Test (+Test-Opcode+False-Target)
227 : // Verwaltung
228 : &SbiRuntime::StepSTMNT, // beginning of a statement (+Line+Col)
229 : // E/A
230 : &SbiRuntime::StepOPEN, // (+SvStreamFlags+Flags)
231 : // Objects
232 : &SbiRuntime::StepLOCAL, // define local variable (+StringId+Typ)
233 : &SbiRuntime::StepPUBLIC, // module global variable (+StringID+Typ)
234 : &SbiRuntime::StepGLOBAL, // define global variable (+StringID+Typ)
235 : &SbiRuntime::StepCREATE, // create object (+StringId+StringId)
236 : &SbiRuntime::StepSTATIC, // static variable (+StringId+StringId)
237 : &SbiRuntime::StepTCREATE, // user-defined objects (+StringId+StringId)
238 : &SbiRuntime::StepDCREATE, // create object-array (+StringID+StringID)
239 : &SbiRuntime::StepGLOBAL_P, // define global variable which is not overwritten
240 : // by the Basic on a restart (+StringID+Typ)
241 : &SbiRuntime::StepFIND_G, // finds global variable with special treatment because of _GLOBAL_P
242 : &SbiRuntime::StepDCREATE_REDIMP, // redimension object array (+StringID+StringID)
243 : &SbiRuntime::StepFIND_CM, // Search inside a class module (CM) to enable global search in time
244 : &SbiRuntime::StepPUBLIC_P, // Search inside a class module (CM) to enable global search in time
245 : &SbiRuntime::StepFIND_STATIC, // Search inside a class module (CM) to enable global search in time
246 : };
247 :
248 :
249 : // SbiRTLData
250 :
251 132 : SbiRTLData::SbiRTLData()
252 : {
253 132 : pDir = 0;
254 132 : nDirFlags = 0;
255 132 : nCurDirPos = 0;
256 132 : pWildCard = NULL;
257 132 : }
258 :
259 264 : SbiRTLData::~SbiRTLData()
260 : {
261 132 : delete pDir;
262 132 : pDir = 0;
263 132 : delete pWildCard;
264 132 : }
265 :
266 : // SbiInstance
267 :
268 : // 16.10.96: #31460 new concept for StepInto/Over/Out
269 : // The decision whether StepPoint shall be called is done with the help of
270 : // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl.
271 : // The current CallLevel can never be smaller than 1, as it's also incremented
272 : // during the call of a method (also main). Therefore a BreakCallLvl from 0
273 : // means that the program isn't stopped at all.
274 : // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
275 :
276 :
277 132 : void SbiInstance::CalcBreakCallLevel( sal_uInt16 nFlags )
278 : {
279 :
280 132 : nFlags &= ~((sal_uInt16)SbDEBUG_BREAK);
281 :
282 : sal_uInt16 nRet;
283 132 : switch( nFlags )
284 : {
285 : case SbDEBUG_STEPINTO:
286 0 : nRet = nCallLvl + 1; // CallLevel+1 is also stopped
287 0 : break;
288 : case SbDEBUG_STEPOVER | SbDEBUG_STEPINTO:
289 0 : nRet = nCallLvl; // current CallLevel is stopped
290 0 : break;
291 : case SbDEBUG_STEPOUT:
292 0 : nRet = nCallLvl - 1; // smaller CallLevel is stopped
293 0 : break;
294 : case SbDEBUG_CONTINUE:
295 : // Basic-IDE returns 0 instead of SbDEBUG_CONTINUE, so also default=continue
296 : default:
297 132 : nRet = 0; // CallLevel is always > 0 -> no StepPoint
298 : }
299 132 : nBreakCallLvl = nRet; // take result
300 132 : }
301 :
302 132 : SbiInstance::SbiInstance( StarBASIC* p )
303 132 : : pIosys(new SbiIoSystem)
304 132 : , pDdeCtrl(new SbiDdeControl)
305 : , pDllMgr(0) // on demand
306 : , pBasic(p)
307 : , pNumberFormatter(0)
308 : , meFormatterLangType(LANGUAGE_DONTKNOW)
309 : , meFormatterDateFormat(YMD)
310 : , nStdDateIdx(0)
311 : , nStdTimeIdx(0)
312 : , nStdDateTimeIdx(0)
313 : , nErr(0)
314 : , nErl(0)
315 : , bReschedule(true)
316 : , bCompatibility(false)
317 : , pRun(NULL)
318 : , pNext(NULL)
319 : , nCallLvl(0)
320 396 : , nBreakCallLvl(0)
321 : {
322 132 : }
323 :
324 264 : SbiInstance::~SbiInstance()
325 : {
326 264 : while( pRun )
327 : {
328 0 : SbiRuntime* p = pRun->pNext;
329 0 : delete pRun;
330 0 : pRun = p;
331 : }
332 132 : delete pIosys;
333 132 : delete pDdeCtrl;
334 132 : delete pDllMgr;
335 132 : delete pNumberFormatter;
336 :
337 : try
338 : {
339 132 : int nSize = ComponentVector.size();
340 132 : if( nSize )
341 : {
342 0 : for( int i = nSize - 1 ; i >= 0 ; --i )
343 : {
344 0 : Reference< XComponent > xDlgComponent = ComponentVector[i];
345 0 : if( xDlgComponent.is() )
346 0 : xDlgComponent->dispose();
347 0 : }
348 : }
349 : }
350 0 : catch( const Exception& )
351 : {
352 : SAL_WARN("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components!" );
353 : }
354 :
355 132 : ComponentVector.clear();
356 132 : }
357 :
358 10 : SbiDllMgr* SbiInstance::GetDllMgr()
359 : {
360 10 : if( !pDllMgr )
361 : {
362 4 : pDllMgr = new SbiDllMgr;
363 : }
364 10 : return pDllMgr;
365 : }
366 :
367 : // #39629 create NumberFormatter with the help of a static method now
368 4 : SvNumberFormatter* SbiInstance::GetNumberFormatter()
369 : {
370 4 : LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
371 4 : SvtSysLocale aSysLocale;
372 4 : DateFormat eDate = aSysLocale.GetLocaleData().getDateFormat();
373 4 : if( pNumberFormatter )
374 : {
375 4 : if( eLangType != meFormatterLangType ||
376 2 : eDate != meFormatterDateFormat )
377 : {
378 0 : delete pNumberFormatter;
379 0 : pNumberFormatter = NULL;
380 : }
381 : }
382 4 : meFormatterLangType = eLangType;
383 4 : meFormatterDateFormat = eDate;
384 4 : if( !pNumberFormatter )
385 : {
386 : PrepareNumberFormatter( pNumberFormatter, nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx,
387 2 : &meFormatterLangType, &meFormatterDateFormat );
388 : }
389 4 : return pNumberFormatter;
390 : }
391 :
392 : // #39629 offer NumberFormatter static too
393 2 : void SbiInstance::PrepareNumberFormatter( SvNumberFormatter*& rpNumberFormatter,
394 : sal_uInt32 &rnStdDateIdx, sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
395 : LanguageType* peFormatterLangType, DateFormat* peFormatterDateFormat )
396 : {
397 : LanguageType eLangType;
398 2 : if( peFormatterLangType )
399 : {
400 2 : eLangType = *peFormatterLangType;
401 : }
402 : else
403 : {
404 0 : eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
405 : }
406 : DateFormat eDate;
407 2 : if( peFormatterDateFormat )
408 : {
409 2 : eDate = *peFormatterDateFormat;
410 : }
411 : else
412 : {
413 0 : SvtSysLocale aSysLocale;
414 0 : eDate = aSysLocale.GetLocaleData().getDateFormat();
415 : }
416 :
417 2 : rpNumberFormatter = new SvNumberFormatter( comphelper::getProcessComponentContext(), eLangType );
418 :
419 2 : sal_Int32 nCheckPos = 0; short nType;
420 2 : rnStdTimeIdx = rpNumberFormatter->GetStandardFormat( NUMBERFORMAT_TIME, eLangType );
421 :
422 : // the formatter's standard templates have only got a two-digit date
423 : // -> registering an own format
424 :
425 : // HACK, because the numberformatter doesn't swap the place holders
426 : // for month, day and year according to the system setting.
427 : // Problem: Print Year(Date) under engl. BS
428 : // also have a look at: basic/source/sbx/sbxdate.cxx
429 :
430 2 : OUString aDateStr;
431 2 : switch( eDate )
432 : {
433 : default:
434 2 : case MDY: aDateStr = "MM/DD/YYYY"; break;
435 0 : case DMY: aDateStr = "DD/MM/YYYY"; break;
436 0 : case YMD: aDateStr = "YYYY/MM/DD"; break;
437 : }
438 2 : OUString aStr( aDateStr ); // PutandConvertEntry() modifies string!
439 : rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
440 2 : rnStdDateIdx, LANGUAGE_ENGLISH_US, eLangType );
441 2 : nCheckPos = 0;
442 4 : OUString aStrHHMMSS(" HH:MM:SS");
443 2 : aDateStr += aStrHHMMSS;
444 2 : aStr = aDateStr;
445 : rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
446 4 : rnStdDateTimeIdx, LANGUAGE_ENGLISH_US, eLangType );
447 2 : }
448 :
449 :
450 : // Let engine run. If Flags == SbDEBUG_CONTINUE, take Flags over
451 :
452 0 : void SbiInstance::Stop()
453 : {
454 0 : for( SbiRuntime* p = pRun; p; p = p->pNext )
455 : {
456 0 : p->Stop();
457 : }
458 0 : }
459 :
460 : // Allows Basic IDE to set watch mode to suppress errors
461 : static bool bWatchMode = false;
462 :
463 0 : void setBasicWatchMode( bool bOn )
464 : {
465 0 : bWatchMode = bOn;
466 0 : }
467 :
468 0 : void SbiInstance::Error( SbError n )
469 : {
470 0 : Error( n, OUString() );
471 0 : }
472 :
473 8 : void SbiInstance::Error( SbError n, const OUString& rMsg )
474 : {
475 8 : if( !bWatchMode )
476 : {
477 8 : aErrorMsg = rMsg;
478 8 : pRun->Error( n );
479 : }
480 8 : }
481 :
482 0 : void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const OUString& rMsg )
483 : {
484 0 : if( !bWatchMode )
485 : {
486 0 : SbError n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
487 0 : if ( !n )
488 : {
489 0 : n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
490 : }
491 0 : aErrorMsg = rMsg;
492 0 : SbiRuntime::translateErrorToVba( n, aErrorMsg );
493 :
494 0 : bool bVBATranslationAlreadyDone = true;
495 0 : pRun->Error( SbERR_BASIC_COMPAT, bVBATranslationAlreadyDone );
496 : }
497 0 : }
498 :
499 0 : void SbiInstance::setErrorVB( sal_Int32 nVBNumber, const OUString& rMsg )
500 : {
501 0 : SbError n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
502 0 : if( !n )
503 : {
504 0 : n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
505 : }
506 0 : aErrorMsg = rMsg;
507 0 : SbiRuntime::translateErrorToVba( n, aErrorMsg );
508 :
509 0 : nErr = n;
510 0 : }
511 :
512 :
513 0 : void SbiInstance::FatalError( SbError n )
514 : {
515 0 : pRun->FatalError( n );
516 0 : }
517 :
518 0 : void SbiInstance::FatalError( SbError _errCode, const OUString& _details )
519 : {
520 0 : pRun->FatalError( _errCode, _details );
521 0 : }
522 :
523 0 : void SbiInstance::Abort()
524 : {
525 0 : StarBASIC* pErrBasic = GetCurrentBasic( pBasic );
526 0 : pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 );
527 0 : StarBASIC::Stop();
528 0 : }
529 :
530 : // can be unequal to pRTBasic
531 0 : StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic )
532 : {
533 0 : StarBASIC* pCurBasic = pRTBasic;
534 0 : SbModule* pActiveModule = StarBASIC::GetActiveModule();
535 0 : if( pActiveModule )
536 : {
537 0 : SbxObject* pParent = pActiveModule->GetParent();
538 0 : if( pParent && pParent->ISA(StarBASIC) )
539 : {
540 0 : pCurBasic = static_cast<StarBASIC*>(pParent);
541 : }
542 : }
543 0 : return pCurBasic;
544 : }
545 :
546 0 : SbModule* SbiInstance::GetActiveModule()
547 : {
548 0 : if( pRun )
549 : {
550 0 : return pRun->GetModule();
551 : }
552 : else
553 : {
554 0 : return NULL;
555 : }
556 : }
557 :
558 0 : SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel )
559 : {
560 0 : SbiRuntime* p = pRun;
561 0 : while( nLevel-- && p )
562 : {
563 0 : p = p->pNext;
564 : }
565 0 : return p ? p->GetCaller() : NULL;
566 : }
567 :
568 : // SbiInstance
569 :
570 : // Attention: pMeth can also be NULL (on a call of the init-code)
571 :
572 2808 : SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart )
573 2808 : : rBasic( *static_cast<StarBASIC*>(pm->pParent) ), pInst( GetSbData()->pInst ),
574 5616 : pMod( pm ), pMeth( pe ), pImg( pMod->pImage ), mpExtCaller(0), m_nLastTime(0)
575 : {
576 2808 : nFlags = pe ? pe->GetDebugFlags() : 0;
577 2808 : pIosys = pInst->pIosys;
578 2808 : pArgvStk = NULL;
579 2808 : pGosubStk = NULL;
580 2808 : pForStk = NULL;
581 2808 : pError = NULL;
582 : pErrCode =
583 : pErrStmnt =
584 2808 : pRestart = NULL;
585 2808 : pNext = NULL;
586 : pCode =
587 2808 : pStmnt = (const sal_uInt8* ) pImg->GetCode() + nStart;
588 : bRun =
589 2808 : bError = true;
590 2808 : bInError = false;
591 2808 : bBlocked = false;
592 2808 : nLine = 0;
593 2808 : nCol1 = 0;
594 2808 : nCol2 = 0;
595 2808 : nExprLvl = 0;
596 2808 : nArgc = 0;
597 2808 : nError = 0;
598 2808 : nGosubLvl = 0;
599 2808 : nForLvl = 0;
600 2808 : nOps = 0;
601 2808 : refExprStk = new SbxArray;
602 2808 : SetVBAEnabled( pMod->IsVBACompat() );
603 : #if defined __GNUC__
604 2808 : SetParameters( pe ? pe->GetParameters() : (class SbxArray *)NULL );
605 : #else
606 : SetParameters( pe ? pe->GetParameters() : NULL );
607 : #endif
608 2808 : pRefSaveList = NULL;
609 2808 : pItemStoreList = NULL;
610 2808 : }
611 :
612 5616 : SbiRuntime::~SbiRuntime()
613 : {
614 2808 : ClearGosubStack();
615 2808 : ClearArgvStack();
616 2808 : ClearForStack();
617 :
618 : // #74254 free items for saving temporary references
619 2808 : ClearRefs();
620 6554 : while( pItemStoreList )
621 : {
622 938 : RefSaveItem* pToDeleteItem = pItemStoreList;
623 938 : pItemStoreList = pToDeleteItem->pNext;
624 938 : delete pToDeleteItem;
625 : }
626 2808 : }
627 :
628 2808 : void SbiRuntime::SetVBAEnabled(bool bEnabled )
629 : {
630 2808 : bVBAEnabled = bEnabled;
631 2808 : if ( bVBAEnabled )
632 : {
633 2100 : if ( pMeth )
634 : {
635 2032 : mpExtCaller = pMeth->mCaller;
636 : }
637 : }
638 : else
639 : {
640 708 : mpExtCaller = 0;
641 : }
642 2808 : }
643 :
644 : // Construction of the parameter list. All ByRef-parameters are directly
645 : // taken over; copies of ByVal-parameters are created. If a particular
646 : // data type is requested, it is converted.
647 :
648 2808 : void SbiRuntime::SetParameters( SbxArray* pParams )
649 : {
650 2808 : refParams = new SbxArray;
651 : // for the return value
652 2808 : refParams->Put( pMeth, 0 );
653 :
654 2808 : SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : NULL;
655 2808 : sal_uInt16 nParamCount = pParams ? pParams->Count() : 1;
656 2808 : if( nParamCount > 1 )
657 : {
658 6876 : for( sal_uInt16 i = 1 ; i < nParamCount ; i++ )
659 : {
660 4632 : const SbxParamInfo* p = pInfo ? pInfo->GetParam( i ) : NULL;
661 :
662 : // #111897 ParamArray
663 4632 : if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
664 : {
665 0 : SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
666 0 : sal_uInt16 nParamArrayParamCount = nParamCount - i;
667 0 : pArray->unoAddDim( 0, nParamArrayParamCount - 1 );
668 0 : for( sal_uInt16 j = i ; j < nParamCount ; j++ )
669 : {
670 0 : SbxVariable* v = pParams->Get( j );
671 0 : short nDimIndex = j - i;
672 : // coverity[array_vs_singleton]
673 0 : pArray->Put( v, &nDimIndex );
674 : }
675 0 : SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
676 0 : pArrayVar->SetFlag( SBX_READWRITE );
677 0 : pArrayVar->PutObject( pArray );
678 0 : refParams->Put( pArrayVar, i );
679 :
680 : // Block ParamArray for missing parameter
681 0 : pInfo = NULL;
682 0 : break;
683 : }
684 :
685 4632 : SbxVariable* v = pParams->Get( i );
686 : // methods are always byval!
687 4632 : bool bByVal = v->IsA( TYPE(SbxMethod) );
688 4632 : SbxDataType t = v->GetType();
689 4632 : bool bTargetTypeIsArray = false;
690 4632 : if( p )
691 : {
692 4540 : bByVal |= ( p->eType & SbxBYREF ) == 0;
693 4540 : t = (SbxDataType) ( p->eType & 0x0FFF );
694 :
695 11912 : if( !bByVal && t != SbxVARIANT &&
696 5400 : (!v->IsFixed() || (SbxDataType)(v->GetType() & 0x0FFF ) != t) )
697 : {
698 3130 : bByVal = true;
699 : }
700 :
701 4540 : bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0;
702 : }
703 4632 : if( bByVal )
704 : {
705 3200 : if( bTargetTypeIsArray )
706 : {
707 0 : t = SbxOBJECT;
708 : }
709 3200 : SbxVariable* v2 = new SbxVariable( t );
710 3200 : v2->SetFlag( SBX_READWRITE );
711 3200 : *v2 = *v;
712 3200 : refParams->Put( v2, i );
713 : }
714 : else
715 : {
716 1432 : if( t != SbxVARIANT && t != ( v->GetType() & 0x0FFF ) )
717 : {
718 0 : if( p && (p->eType & SbxARRAY) )
719 : {
720 0 : Error( SbERR_CONVERSION );
721 : }
722 : else
723 : {
724 0 : v->Convert( t );
725 : }
726 : }
727 1432 : refParams->Put( v, i );
728 : }
729 4632 : if( p )
730 : {
731 4540 : refParams->PutAlias( p->aName, i );
732 : }
733 : }
734 : }
735 :
736 : // ParamArray for missing parameter
737 2808 : if( pInfo )
738 : {
739 : // #111897 Check first missing parameter for ParamArray
740 2734 : const SbxParamInfo* p = pInfo->GetParam( nParamCount );
741 2734 : if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
742 : {
743 0 : SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
744 0 : pArray->unoAddDim( 0, -1 );
745 0 : SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
746 0 : pArrayVar->SetFlag( SBX_READWRITE );
747 0 : pArrayVar->PutObject( pArray );
748 0 : refParams->Put( pArrayVar, nParamCount );
749 : }
750 : }
751 2808 : }
752 :
753 :
754 : // execute a P-Code
755 :
756 130384 : bool SbiRuntime::Step()
757 : {
758 130384 : if( bRun )
759 : {
760 : // in any case check casually!
761 130384 : if( !( ++nOps & 0xF ) && pInst->IsReschedule() )
762 : {
763 6528 : sal_uInt32 nTime = osl_getGlobalTimer();
764 6528 : if (nTime - m_nLastTime > 5 ) // 20 ms
765 : {
766 2677 : Application::Reschedule();
767 2677 : m_nLastTime = nTime;
768 : }
769 : }
770 :
771 : // #i48868 blocked by next call level?
772 260768 : while( bBlocked )
773 : {
774 0 : if( pInst->IsReschedule() )
775 : {
776 0 : Application::Reschedule();
777 : }
778 : }
779 :
780 130384 : SbiOpcode eOp = (SbiOpcode ) ( *pCode++ );
781 : sal_uInt32 nOp1, nOp2;
782 130384 : if (eOp <= SbOP0_END)
783 : {
784 43092 : (this->*( aStep0[ eOp ] ) )();
785 : }
786 87292 : else if (eOp >= SbOP1_START && eOp <= SbOP1_END)
787 : {
788 21498 : nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
789 :
790 21498 : (this->*( aStep1[ eOp - SbOP1_START ] ) )( nOp1 );
791 : }
792 65794 : else if (eOp >= SbOP2_START && eOp <= SbOP2_END)
793 : {
794 65794 : nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
795 65794 : nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24;
796 65794 : (this->*( aStep2[ eOp - SbOP2_START ] ) )( nOp1, nOp2 );
797 : }
798 : else
799 : {
800 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
801 : }
802 :
803 130384 : SbError nSbError = SbxBase::GetError();
804 130384 : Error( ERRCODE_TOERROR(nSbError) );
805 :
806 : // from 13.2.1997, new error handling:
807 : // ATTENTION: nError can be set already even if !nSbError
808 : // since nError can now also be set from other RT-instances
809 :
810 130384 : if( nError )
811 : {
812 48 : SbxBase::ResetError();
813 : }
814 :
815 : // from 15.3.96: display errors only if BASIC is still active
816 : // (especially not after compiler errors at the runtime)
817 130384 : if( nError && bRun )
818 : {
819 48 : SbError err = nError;
820 48 : ClearExprStack();
821 48 : nError = 0;
822 48 : pInst->nErr = err;
823 48 : pInst->nErl = nLine;
824 48 : pErrCode = pCode;
825 48 : pErrStmnt = pStmnt;
826 : // An error occurred in an error handler
827 : // force parent handler ( if there is one )
828 : // to handle the error
829 48 : bool bLetParentHandleThis = false;
830 :
831 : // in the error handler? so std-error
832 48 : if ( !bInError )
833 : {
834 48 : bInError = true;
835 :
836 48 : if( !bError ) // On Error Resume Next
837 : {
838 2 : StepRESUME( 1 );
839 : }
840 46 : else if( pError ) // On Error Goto ...
841 : {
842 44 : pCode = pError;
843 : }
844 : else
845 : {
846 2 : bLetParentHandleThis = true;
847 : }
848 : }
849 : else
850 : {
851 0 : bLetParentHandleThis = true;
852 0 : pError = NULL; //terminate the handler
853 : }
854 48 : if ( bLetParentHandleThis )
855 : {
856 : // from 13.2.1997, new error handling:
857 : // consider superior error handlers
858 :
859 : // there's no error handler -> find one farther above
860 2 : SbiRuntime* pRtErrHdl = NULL;
861 2 : SbiRuntime* pRt = this;
862 4 : while( NULL != (pRt = pRt->pNext) )
863 : {
864 2 : if( !pRt->bError || pRt->pError != NULL )
865 : {
866 2 : pRtErrHdl = pRt;
867 2 : break;
868 : }
869 : }
870 :
871 :
872 2 : if( pRtErrHdl )
873 : {
874 : // manipulate all the RTs that are below in the call-stack
875 2 : pRt = this;
876 2 : do
877 : {
878 4 : pRt->nError = err;
879 4 : if( pRt != pRtErrHdl )
880 : {
881 2 : pRt->bRun = false;
882 : }
883 : else
884 : {
885 2 : break;
886 : }
887 2 : pRt = pRt->pNext;
888 : }
889 : while( pRt );
890 : }
891 : // no error-hdl found -> old behaviour
892 : else
893 : {
894 0 : pInst->Abort();
895 : }
896 : }
897 : }
898 : }
899 130384 : return bRun;
900 : }
901 :
902 130964 : void SbiRuntime::Error( SbError n, bool bVBATranslationAlreadyDone )
903 : {
904 130964 : if( n )
905 : {
906 46 : nError = n;
907 46 : if( isVBAEnabled() && !bVBATranslationAlreadyDone )
908 : {
909 46 : OUString aMsg = pInst->GetErrorMsg();
910 46 : sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
911 46 : SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject();
912 46 : SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
913 46 : if( pGlobErr != NULL )
914 : {
915 46 : pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
916 : }
917 46 : pInst->aErrorMsg = aMsg;
918 46 : nError = SbERR_BASIC_COMPAT;
919 : }
920 : }
921 130964 : }
922 :
923 0 : void SbiRuntime::Error( SbError _errCode, const OUString& _details )
924 : {
925 0 : if ( _errCode )
926 : {
927 : // Not correct for class module usage, remove for now
928 : //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" );
929 0 : if ( pInst->pRun == this )
930 : {
931 0 : pInst->Error( _errCode, _details );
932 : //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expecte to propagate the error code back to me!" );
933 : }
934 : else
935 : {
936 0 : nError = _errCode;
937 : }
938 : }
939 0 : }
940 :
941 0 : void SbiRuntime::FatalError( SbError n )
942 : {
943 0 : StepSTDERROR();
944 0 : Error( n );
945 0 : }
946 :
947 0 : void SbiRuntime::FatalError( SbError _errCode, const OUString& _details )
948 : {
949 0 : StepSTDERROR();
950 0 : Error( _errCode, _details );
951 0 : }
952 :
953 46 : sal_Int32 SbiRuntime::translateErrorToVba( SbError nError, OUString& rMsg )
954 : {
955 : // If a message is defined use that ( in preference to
956 : // the defined one for the error ) NB #TODO
957 : // if there is an error defined it more than likely
958 : // is not the one you want ( some are the same though )
959 : // we really need a new vba compatible error list
960 46 : if ( rMsg.isEmpty() )
961 : {
962 : // TEST, has to be vb here always
963 : #ifdef DBG_UTIL
964 : SbError nTmp = StarBASIC::GetSfxFromVBError( (sal_uInt16)nError );
965 : SAL_WARN_IF( nTmp == 0, "basic", "No VB error!" );
966 : #endif
967 :
968 40 : StarBASIC::MakeErrorText( nError, rMsg );
969 40 : rMsg = StarBASIC::GetErrorText();
970 40 : if ( rMsg.isEmpty() ) // no message for err no, need localized resource here
971 : {
972 0 : rMsg = "Internal Object Error:";
973 : }
974 : }
975 : // no num? most likely then it *is* really a vba err
976 46 : sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
977 46 : sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? nError : nVBErrorCode;
978 46 : return nVBAErrorNumber;
979 : }
980 :
981 : // Stacks
982 :
983 : // The expression-stack is available for the continuous evaluation
984 : // of expressions.
985 :
986 54810 : void SbiRuntime::PushVar( SbxVariable* pVar )
987 : {
988 54810 : if( pVar )
989 : {
990 54810 : refExprStk->Put( pVar, nExprLvl++ );
991 : }
992 54810 : }
993 :
994 54810 : SbxVariableRef SbiRuntime::PopVar()
995 : {
996 : #ifdef DBG_UTIL
997 : if( !nExprLvl )
998 : {
999 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1000 : return new SbxVariable;
1001 : }
1002 : #endif
1003 54810 : SbxVariableRef xVar = refExprStk->Get( --nExprLvl );
1004 : #ifdef DBG_UTIL
1005 : if ( xVar->GetName().equalsAscii( "Cells" ) )
1006 : SAL_INFO("basic", "PopVar: Name equals 'Cells'" );
1007 : #endif
1008 : // methods hold themselves in parameter 0
1009 54810 : if( xVar->IsA( TYPE(SbxMethod) ) )
1010 : {
1011 8856 : xVar->SetParameters(0);
1012 : }
1013 54810 : return xVar;
1014 : }
1015 :
1016 23658 : bool SbiRuntime::ClearExprStack()
1017 : {
1018 : // Attention: Clear() doesn't suffice as methods must be deleted
1019 49450 : while ( nExprLvl )
1020 : {
1021 2134 : PopVar();
1022 : }
1023 23658 : refExprStk->Clear();
1024 23658 : return false;
1025 : }
1026 :
1027 : // Take variable from the expression-stack without removing it
1028 : // n counts from 0
1029 :
1030 7930 : SbxVariable* SbiRuntime::GetTOS( short n )
1031 : {
1032 7930 : n = nExprLvl - n - 1;
1033 : #ifdef DBG_UTIL
1034 : if( n < 0 )
1035 : {
1036 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1037 : return new SbxVariable;
1038 : }
1039 : #endif
1040 7930 : return refExprStk->Get( (sal_uInt16) n );
1041 : }
1042 :
1043 :
1044 5846 : void SbiRuntime::TOSMakeTemp()
1045 : {
1046 5846 : SbxVariable* p = refExprStk->Get( nExprLvl - 1 );
1047 5846 : if ( p->GetType() == SbxEMPTY )
1048 : {
1049 54 : p->Broadcast( SBX_HINT_DATAWANTED );
1050 : }
1051 :
1052 5846 : SbxVariable* pDflt = NULL;
1053 5846 : if ( bVBAEnabled && ( p->GetType() == SbxOBJECT || p->GetType() == SbxVARIANT ) && ((pDflt = getDefaultProp(p)) != NULL) )
1054 : {
1055 40 : pDflt->Broadcast( SBX_HINT_DATAWANTED );
1056 : // replacing new p on stack causes object pointed by
1057 : // pDft->pParent to be deleted, when p2->Compute() is
1058 : // called below pParent is accessed ( but its deleted )
1059 : // so set it to NULL now
1060 40 : pDflt->SetParent( NULL );
1061 40 : p = new SbxVariable( *pDflt );
1062 40 : p->SetFlag( SBX_READWRITE );
1063 40 : refExprStk->Put( p, nExprLvl - 1 );
1064 : }
1065 5806 : else if( p->GetRefCount() != 1 )
1066 : {
1067 3870 : SbxVariable* pNew = new SbxVariable( *p );
1068 3870 : pNew->SetFlag( SBX_READWRITE );
1069 3870 : refExprStk->Put( pNew, nExprLvl - 1 );
1070 : }
1071 5846 : }
1072 :
1073 : // the GOSUB-stack collects return-addresses for GOSUBs
1074 0 : void SbiRuntime::PushGosub( const sal_uInt8* pc )
1075 : {
1076 0 : if( ++nGosubLvl > MAXRECURSION )
1077 : {
1078 0 : StarBASIC::FatalError( SbERR_STACK_OVERFLOW );
1079 : }
1080 0 : SbiGosubStack* p = new SbiGosubStack;
1081 0 : p->pCode = pc;
1082 0 : p->pNext = pGosubStk;
1083 0 : p->nStartForLvl = nForLvl;
1084 0 : pGosubStk = p;
1085 0 : }
1086 :
1087 0 : void SbiRuntime::PopGosub()
1088 : {
1089 0 : if( !pGosubStk )
1090 : {
1091 0 : Error( SbERR_NO_GOSUB );
1092 : }
1093 : else
1094 : {
1095 0 : SbiGosubStack* p = pGosubStk;
1096 0 : pCode = p->pCode;
1097 0 : pGosubStk = p->pNext;
1098 0 : delete p;
1099 0 : nGosubLvl--;
1100 : }
1101 0 : }
1102 :
1103 :
1104 2808 : void SbiRuntime::ClearGosubStack()
1105 : {
1106 : SbiGosubStack* p;
1107 5616 : while(( p = pGosubStk ) != NULL )
1108 : {
1109 0 : pGosubStk = p->pNext, delete p;
1110 : }
1111 2808 : nGosubLvl = 0;
1112 2808 : }
1113 :
1114 : // the Argv-stack collects current argument-vectors
1115 :
1116 7338 : void SbiRuntime::PushArgv()
1117 : {
1118 7338 : SbiArgvStack* p = new SbiArgvStack;
1119 7338 : p->refArgv = refArgv;
1120 7338 : p->nArgc = nArgc;
1121 7338 : nArgc = 1;
1122 7338 : refArgv.Clear();
1123 7338 : p->pNext = pArgvStk;
1124 7338 : pArgvStk = p;
1125 7338 : }
1126 :
1127 7338 : void SbiRuntime::PopArgv()
1128 : {
1129 7338 : if( pArgvStk )
1130 : {
1131 7338 : SbiArgvStack* p = pArgvStk;
1132 7338 : pArgvStk = p->pNext;
1133 7338 : refArgv = p->refArgv;
1134 7338 : nArgc = p->nArgc;
1135 7338 : delete p;
1136 : }
1137 7338 : }
1138 :
1139 :
1140 2808 : void SbiRuntime::ClearArgvStack()
1141 : {
1142 5616 : while( pArgvStk )
1143 : {
1144 0 : PopArgv();
1145 : }
1146 2808 : }
1147 :
1148 : // Push of the for-stack. The stack has increment, end, begin and variable.
1149 : // After the creation of the stack-element the stack's empty.
1150 :
1151 168 : void SbiRuntime::PushFor()
1152 : {
1153 168 : SbiForStack* p = new SbiForStack;
1154 168 : p->eForType = FOR_TO;
1155 168 : p->pNext = pForStk;
1156 168 : pForStk = p;
1157 :
1158 168 : p->refInc = PopVar();
1159 168 : p->refEnd = PopVar();
1160 168 : SbxVariableRef xBgn = PopVar();
1161 168 : p->refVar = PopVar();
1162 168 : *(p->refVar) = *xBgn;
1163 168 : nForLvl++;
1164 168 : }
1165 :
1166 4 : void SbiRuntime::PushForEach()
1167 : {
1168 4 : SbiForStack* p = new SbiForStack;
1169 4 : p->pNext = pForStk;
1170 4 : pForStk = p;
1171 :
1172 4 : SbxVariableRef xObjVar = PopVar();
1173 4 : SbxBase* pObj = xObjVar.Is() ? xObjVar->GetObject() : NULL;
1174 4 : if( pObj == NULL )
1175 : {
1176 0 : Error( SbERR_NO_OBJECT );
1177 0 : return;
1178 : }
1179 :
1180 4 : bool bError_ = false;
1181 : BasicCollection* pCollection;
1182 : SbxDimArray* pArray;
1183 : SbUnoObject* pUnoObj;
1184 4 : if( (pArray = PTR_CAST(SbxDimArray,pObj)) != NULL )
1185 : {
1186 0 : p->eForType = FOR_EACH_ARRAY;
1187 0 : p->refEnd = (SbxVariable*)pArray;
1188 :
1189 0 : short nDims = pArray->GetDims();
1190 0 : p->pArrayLowerBounds = new sal_Int32[nDims];
1191 0 : p->pArrayUpperBounds = new sal_Int32[nDims];
1192 0 : p->pArrayCurIndices = new sal_Int32[nDims];
1193 : sal_Int32 lBound, uBound;
1194 0 : for( short i = 0 ; i < nDims ; i++ )
1195 : {
1196 0 : pArray->GetDim32( i+1, lBound, uBound );
1197 0 : p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
1198 0 : p->pArrayUpperBounds[i] = uBound;
1199 : }
1200 : }
1201 4 : else if( (pCollection = PTR_CAST(BasicCollection,pObj)) != NULL )
1202 : {
1203 0 : p->eForType = FOR_EACH_COLLECTION;
1204 0 : p->refEnd = pCollection;
1205 0 : p->nCurCollectionIndex = 0;
1206 : }
1207 4 : else if( (pUnoObj = PTR_CAST(SbUnoObject,pObj)) != NULL )
1208 : {
1209 : // XEnumerationAccess?
1210 4 : Any aAny = pUnoObj->getUnoAny();
1211 8 : Reference< XEnumerationAccess > xEnumerationAccess;
1212 4 : if( (aAny >>= xEnumerationAccess) )
1213 : {
1214 4 : p->xEnumeration = xEnumerationAccess->createEnumeration();
1215 4 : p->eForType = FOR_EACH_XENUMERATION;
1216 : }
1217 0 : else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
1218 : {
1219 0 : uno::Reference< script::XInvocation > xInvocation;
1220 0 : if ( ( aAny >>= xInvocation ) && xInvocation.is() )
1221 : {
1222 : try
1223 : {
1224 0 : p->xEnumeration = new ComEnumerationWrapper( xInvocation );
1225 0 : p->eForType = FOR_EACH_XENUMERATION;
1226 : }
1227 0 : catch(const uno::Exception& )
1228 : {}
1229 : }
1230 0 : if ( !p->xEnumeration.is() )
1231 : {
1232 0 : bError_ = true;
1233 0 : }
1234 : }
1235 : else
1236 : {
1237 0 : bError_ = true;
1238 4 : }
1239 : }
1240 : else
1241 : {
1242 0 : bError_ = true;
1243 : }
1244 :
1245 4 : if( bError_ )
1246 : {
1247 0 : Error( SbERR_CONVERSION );
1248 0 : return;
1249 : }
1250 :
1251 : // Container variable
1252 4 : p->refVar = PopVar();
1253 4 : nForLvl++;
1254 : }
1255 :
1256 :
1257 172 : void SbiRuntime::PopFor()
1258 : {
1259 172 : if( pForStk )
1260 : {
1261 172 : SbiForStack* p = pForStk;
1262 172 : pForStk = p->pNext;
1263 172 : delete p;
1264 172 : nForLvl--;
1265 : }
1266 172 : }
1267 :
1268 :
1269 2808 : void SbiRuntime::ClearForStack()
1270 : {
1271 5616 : while( pForStk )
1272 : {
1273 0 : PopFor();
1274 : }
1275 2808 : }
1276 :
1277 0 : SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection* pCollection )
1278 : {
1279 0 : for (SbiForStack *p = pForStk; p; p = p->pNext)
1280 : {
1281 0 : SbxVariable* pVar = p->refEnd.Is() ? (SbxVariable*)p->refEnd : NULL;
1282 0 : if( p->eForType == FOR_EACH_COLLECTION && pVar != NULL &&
1283 0 : PTR_CAST(BasicCollection,pVar) == pCollection )
1284 : {
1285 0 : return p;
1286 : }
1287 : }
1288 :
1289 0 : return NULL;
1290 : }
1291 :
1292 :
1293 :
1294 :
1295 : // DLL-calls
1296 :
1297 10 : void SbiRuntime::DllCall
1298 : ( const OUString& aFuncName,
1299 : const OUString& aDLLName,
1300 : SbxArray* pArgs, // parameter (from index 1, can be NULL)
1301 : SbxDataType eResType, // return value
1302 : bool bCDecl ) // true: according to C-conventions
1303 : {
1304 : // No DllCall for "virtual" portal users
1305 10 : if( needSecurityRestrictions() )
1306 : {
1307 0 : StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
1308 10 : return;
1309 : }
1310 :
1311 : // NOT YET IMPLEMENTED
1312 :
1313 10 : SbxVariable* pRes = new SbxVariable( eResType );
1314 10 : SbiDllMgr* pDllMgr = pInst->GetDllMgr();
1315 10 : SbError nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
1316 10 : if( nErr )
1317 : {
1318 0 : Error( nErr );
1319 : }
1320 10 : PushVar( pRes );
1321 : }
1322 :
1323 24 : sal_uInt16 SbiRuntime::GetImageFlag( sal_uInt16 n ) const
1324 : {
1325 24 : return pImg->GetFlag( n );
1326 : }
1327 :
1328 52 : sal_uInt16 SbiRuntime::GetBase()
1329 : {
1330 52 : return pImg->GetBase();
1331 : }
1332 :
1333 0 : void SbiRuntime::StepNOP()
1334 0 : {}
1335 :
1336 5700 : void SbiRuntime::StepArith( SbxOperator eOp )
1337 : {
1338 5700 : SbxVariableRef p1 = PopVar();
1339 5700 : TOSMakeTemp();
1340 5700 : SbxVariable* p2 = GetTOS();
1341 :
1342 5700 : p2->ResetFlag( SBX_FIXED );
1343 5700 : p2->Compute( eOp, *p1 );
1344 :
1345 5700 : checkArithmeticOverflow( p2 );
1346 5700 : }
1347 :
1348 146 : void SbiRuntime::StepUnary( SbxOperator eOp )
1349 : {
1350 146 : TOSMakeTemp();
1351 146 : SbxVariable* p = GetTOS();
1352 146 : p->Compute( eOp, *p );
1353 146 : }
1354 :
1355 3772 : void SbiRuntime::StepCompare( SbxOperator eOp )
1356 : {
1357 3772 : SbxVariableRef p1 = PopVar();
1358 7544 : SbxVariableRef p2 = PopVar();
1359 :
1360 : // Make sure objects with default params have
1361 : // values ( and type ) set as appropriate
1362 3772 : SbxDataType p1Type = p1->GetType();
1363 3772 : SbxDataType p2Type = p2->GetType();
1364 3772 : if ( p1Type == SbxEMPTY )
1365 : {
1366 26 : p1->Broadcast( SBX_HINT_DATAWANTED );
1367 26 : p1Type = p1->GetType();
1368 : }
1369 3772 : if ( p2Type == SbxEMPTY )
1370 : {
1371 356 : p2->Broadcast( SBX_HINT_DATAWANTED );
1372 356 : p2Type = p2->GetType();
1373 : }
1374 3772 : if ( p1Type == p2Type )
1375 : {
1376 : // if both sides are an object and have default props
1377 : // then we need to use the default props
1378 : // we don't need to worry if only one side ( lhs, rhs ) is an
1379 : // object ( object side will get coerced to correct type in
1380 : // Compare )
1381 3202 : if ( p1Type == SbxOBJECT )
1382 : {
1383 0 : SbxVariable* pDflt = getDefaultProp( p1 );
1384 0 : if ( pDflt )
1385 : {
1386 0 : p1 = pDflt;
1387 0 : p1->Broadcast( SBX_HINT_DATAWANTED );
1388 : }
1389 0 : pDflt = getDefaultProp( p2 );
1390 0 : if ( pDflt )
1391 : {
1392 0 : p2 = pDflt;
1393 0 : p2->Broadcast( SBX_HINT_DATAWANTED );
1394 : }
1395 : }
1396 :
1397 : }
1398 : static SbxVariable* pTRUE = NULL;
1399 : static SbxVariable* pFALSE = NULL;
1400 : static SbxVariable* pNULL = NULL;
1401 : // why do this on non-windows ?
1402 : // why do this at all ?
1403 : // I dumbly follow the pattern :-/
1404 3772 : if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
1405 : {
1406 0 : if( !pNULL )
1407 : {
1408 0 : pNULL = new SbxVariable;
1409 0 : pNULL->PutNull();
1410 0 : pNULL->AddFirstRef();
1411 : }
1412 0 : PushVar( pNULL );
1413 : }
1414 3772 : else if( p2->Compare( eOp, *p1 ) )
1415 : {
1416 2392 : if( !pTRUE )
1417 : {
1418 10 : pTRUE = new SbxVariable;
1419 10 : pTRUE->PutBool( true );
1420 10 : pTRUE->AddFirstRef();
1421 : }
1422 2392 : PushVar( pTRUE );
1423 : }
1424 : else
1425 : {
1426 1380 : if( !pFALSE )
1427 : {
1428 10 : pFALSE = new SbxVariable;
1429 10 : pFALSE->PutBool( false );
1430 10 : pFALSE->AddFirstRef();
1431 : }
1432 1380 : PushVar( pFALSE );
1433 3772 : }
1434 3772 : }
1435 :
1436 0 : void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
1437 36 : void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
1438 0 : void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
1439 0 : void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
1440 0 : void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
1441 2488 : void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
1442 74 : void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
1443 2044 : void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
1444 192 : void SbiRuntime::StepAND() { StepArith( SbxAND ); }
1445 866 : void SbiRuntime::StepOR() { StepArith( SbxOR ); }
1446 0 : void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
1447 0 : void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
1448 0 : void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
1449 :
1450 22 : void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
1451 124 : void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
1452 :
1453 2638 : void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
1454 932 : void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
1455 82 : void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
1456 112 : void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
1457 0 : void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
1458 8 : void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
1459 :
1460 : namespace
1461 : {
1462 0 : bool NeedEsc(sal_Unicode cCode)
1463 : {
1464 0 : if((cCode & 0xFF80))
1465 : {
1466 0 : return false;
1467 : }
1468 0 : switch((sal_uInt8)(cCode & 0x07F))
1469 : {
1470 : case '.':
1471 : case '^':
1472 : case '$':
1473 : case '+':
1474 : case '\\':
1475 : case '|':
1476 : case '{':
1477 : case '}':
1478 : case '(':
1479 : case ')':
1480 0 : return true;
1481 : default:
1482 0 : return false;
1483 : }
1484 : }
1485 :
1486 0 : OUString VBALikeToRegexp(const OUString &rIn)
1487 : {
1488 0 : OUStringBuffer sResult;
1489 0 : const sal_Unicode *start = rIn.getStr();
1490 0 : const sal_Unicode *end = start + rIn.getLength();
1491 :
1492 0 : int seenright = 0;
1493 :
1494 0 : sResult.append('^');
1495 :
1496 0 : while (start < end)
1497 : {
1498 0 : switch (*start)
1499 : {
1500 : case '?':
1501 0 : sResult.append('.');
1502 0 : start++;
1503 0 : break;
1504 : case '*':
1505 0 : sResult.append(".*");
1506 0 : start++;
1507 0 : break;
1508 : case '#':
1509 0 : sResult.append("[0-9]");
1510 0 : start++;
1511 0 : break;
1512 : case ']':
1513 0 : sResult.append('\\');
1514 0 : sResult.append(*start++);
1515 0 : break;
1516 : case '[':
1517 0 : sResult.append(*start++);
1518 0 : seenright = 0;
1519 0 : while (start < end && !seenright)
1520 : {
1521 0 : switch (*start)
1522 : {
1523 : case '[':
1524 : case '?':
1525 : case '*':
1526 0 : sResult.append('\\');
1527 0 : sResult.append(*start);
1528 0 : break;
1529 : case ']':
1530 0 : sResult.append(*start);
1531 0 : seenright = 1;
1532 0 : break;
1533 : case '!':
1534 0 : sResult.append('^');
1535 0 : break;
1536 : default:
1537 0 : if (NeedEsc(*start))
1538 : {
1539 0 : sResult.append('\\');
1540 : }
1541 0 : sResult.append(*start);
1542 0 : break;
1543 : }
1544 0 : start++;
1545 : }
1546 0 : break;
1547 : default:
1548 0 : if (NeedEsc(*start))
1549 : {
1550 0 : sResult.append('\\');
1551 : }
1552 0 : sResult.append(*start++);
1553 : }
1554 : }
1555 :
1556 0 : sResult.append('$');
1557 :
1558 0 : return sResult.makeStringAndClear();
1559 : }
1560 : }
1561 :
1562 0 : void SbiRuntime::StepLIKE()
1563 : {
1564 0 : SbxVariableRef refVar1 = PopVar();
1565 0 : SbxVariableRef refVar2 = PopVar();
1566 :
1567 0 : OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
1568 0 : OUString value = refVar2->GetOUString();
1569 :
1570 0 : com::sun::star::util::SearchOptions aSearchOpt;
1571 :
1572 0 : aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
1573 :
1574 0 : aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
1575 0 : aSearchOpt.searchString = pattern;
1576 :
1577 0 : int bTextMode(1);
1578 0 : bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
1579 0 : if( bCompatibility )
1580 : {
1581 0 : bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
1582 : }
1583 0 : if( bTextMode )
1584 : {
1585 0 : aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
1586 : }
1587 0 : SbxVariable* pRes = new SbxVariable;
1588 0 : utl::TextSearch aSearch(aSearchOpt);
1589 0 : sal_Int32 nStart=0, nEnd=value.getLength();
1590 0 : bool bRes = aSearch.SearchForward(value, &nStart, &nEnd);
1591 0 : pRes->PutBool( bRes );
1592 :
1593 0 : PushVar( pRes );
1594 0 : }
1595 :
1596 : // TOS and TOS-1 are both object variables and contain the same pointer
1597 :
1598 32 : void SbiRuntime::StepIS()
1599 : {
1600 32 : SbxVariableRef refVar1 = PopVar();
1601 64 : SbxVariableRef refVar2 = PopVar();
1602 :
1603 32 : SbxDataType eType1 = refVar1->GetType();
1604 32 : SbxDataType eType2 = refVar2->GetType();
1605 32 : if ( eType1 == SbxEMPTY )
1606 : {
1607 0 : refVar1->Broadcast( SBX_HINT_DATAWANTED );
1608 0 : eType1 = refVar1->GetType();
1609 : }
1610 32 : if ( eType2 == SbxEMPTY )
1611 : {
1612 0 : refVar2->Broadcast( SBX_HINT_DATAWANTED );
1613 0 : eType2 = refVar2->GetType();
1614 : }
1615 :
1616 32 : bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
1617 32 : if ( bVBAEnabled && !bRes )
1618 : {
1619 0 : Error( SbERR_INVALID_USAGE_OBJECT );
1620 : }
1621 32 : bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
1622 32 : SbxVariable* pRes = new SbxVariable;
1623 32 : pRes->PutBool( bRes );
1624 64 : PushVar( pRes );
1625 32 : }
1626 :
1627 : // update the value of TOS
1628 :
1629 2084 : void SbiRuntime::StepGET()
1630 : {
1631 2084 : SbxVariable* p = GetTOS();
1632 2084 : p->Broadcast( SBX_HINT_DATAWANTED );
1633 2084 : }
1634 :
1635 : // #67607 copy Uno-Structs
1636 8070 : inline bool checkUnoStructCopy( bool bVBA, SbxVariableRef& refVal, SbxVariableRef& refVar )
1637 : {
1638 8070 : SbxDataType eVarType = refVar->GetType();
1639 8070 : SbxDataType eValType = refVal->GetType();
1640 :
1641 8070 : if ( !( !bVBA|| ( bVBA && refVar->GetType() != SbxEMPTY ) ) || !refVar->CanWrite() )
1642 470 : return false;
1643 :
1644 7600 : if ( eValType != SbxOBJECT )
1645 6662 : return false;
1646 : // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1647 : // there :-/ not sure if for every '=' we would want struct handling
1648 938 : if( eVarType != SbxOBJECT )
1649 : {
1650 98 : if ( refVar->IsFixed() )
1651 0 : return false;
1652 : }
1653 : // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1654 840 : else if( refVar->ISA(SbProcedureProperty) )
1655 0 : return false;
1656 :
1657 938 : SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject());
1658 938 : if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
1659 272 : return false;
1660 :
1661 666 : SbUnoObject* pUnoVal = PTR_CAST(SbUnoObject,(SbxObject*)xValObj);
1662 666 : SbUnoStructRefObject* pUnoStructVal = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xValObj);
1663 1332 : Any aAny;
1664 : // make doubly sure value is either an Uno object or
1665 : // an uno struct
1666 666 : if ( pUnoVal || pUnoStructVal )
1667 662 : aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
1668 : else
1669 4 : return false;
1670 662 : if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
1671 : {
1672 152 : refVar->SetType( SbxOBJECT );
1673 152 : SbxError eOldErr = SbxBase::GetError();
1674 : // There are some circumstances when calling GetObject
1675 : // will trigger an error, we need to squash those here.
1676 : // Alternatively it is possible that the same scenario
1677 : // could overwrite and existing error. Lets prevent that
1678 152 : SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject());
1679 152 : if ( eOldErr != SbxERR_OK )
1680 0 : SbxBase::SetError( eOldErr );
1681 : else
1682 152 : SbxBase::ResetError();
1683 :
1684 152 : SbUnoStructRefObject* pUnoStructObj = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xVarObj);
1685 :
1686 304 : OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
1687 304 : OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
1688 :
1689 152 : if ( pUnoStructObj )
1690 : {
1691 14 : StructRefInfo aInfo = pUnoStructObj->getStructInfo();
1692 14 : aInfo.setValue( aAny );
1693 : }
1694 : else
1695 : {
1696 138 : SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
1697 : // #70324: adopt ClassName
1698 138 : pNewUnoObj->SetClassName( sClassName );
1699 138 : refVar->PutObject( pNewUnoObj );
1700 : }
1701 304 : return true;
1702 : }
1703 1448 : return false;
1704 : }
1705 :
1706 :
1707 : // laying down TOS in TOS-1
1708 :
1709 7150 : void SbiRuntime::StepPUT()
1710 : {
1711 7150 : SbxVariableRef refVal = PopVar();
1712 14300 : SbxVariableRef refVar = PopVar();
1713 : // store on its own method (inside a function)?
1714 7150 : bool bFlagsChanged = false;
1715 7150 : SbxFlagBits n = SBX_NONE;
1716 7150 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
1717 : {
1718 1032 : bFlagsChanged = true;
1719 1032 : n = refVar->GetFlags();
1720 1032 : refVar->SetFlag( SBX_WRITE );
1721 : }
1722 :
1723 : // if left side arg is an object or variant and right handside isn't
1724 : // either an object or a variant then try and see if a default
1725 : // property exists.
1726 : // to use e.g. Range{"A1") = 34
1727 : // could equate to Range("A1").Value = 34
1728 7150 : if ( bVBAEnabled )
1729 : {
1730 : // yet more hacking at this, I feel we don't quite have the correct
1731 : // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1732 : // obj1 ) has default member/property ) ) It seems that default props
1733 : // aren't dealt with if the object is a member of some parent object
1734 5378 : bool bObjAssign = false;
1735 5378 : if ( refVar->GetType() == SbxEMPTY )
1736 768 : refVar->Broadcast( SBX_HINT_DATAWANTED );
1737 5378 : if ( refVar->GetType() == SbxOBJECT )
1738 : {
1739 60 : if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() )
1740 : {
1741 52 : SbxVariable* pDflt = getDefaultProp( refVar );
1742 :
1743 52 : if ( pDflt )
1744 46 : refVar = pDflt;
1745 : }
1746 : else
1747 8 : bObjAssign = true;
1748 : }
1749 5378 : if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( refVal->IsA( TYPE(SbxMethod) ) || ! refVal->GetParent() ) )
1750 : {
1751 16 : SbxVariable* pDflt = getDefaultProp( refVal );
1752 16 : if ( pDflt )
1753 12 : refVal = pDflt;
1754 : }
1755 : }
1756 :
1757 7150 : if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
1758 7082 : *refVar = *refVal;
1759 :
1760 7150 : if( bFlagsChanged )
1761 8182 : refVar->SetFlags( n );
1762 7150 : }
1763 :
1764 :
1765 : // VBA Dim As New behavior handling, save init object information
1766 0 : struct DimAsNewRecoverItem
1767 : {
1768 : OUString m_aObjClass;
1769 : OUString m_aObjName;
1770 : SbxObject* m_pObjParent;
1771 : SbModule* m_pClassModule;
1772 :
1773 0 : DimAsNewRecoverItem( void )
1774 : : m_pObjParent( NULL )
1775 0 : , m_pClassModule( NULL )
1776 0 : {}
1777 :
1778 0 : 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 0 : , m_pClassModule( pClassModule )
1784 0 : {}
1785 :
1786 : };
1787 :
1788 :
1789 : struct SbxVariablePtrHash
1790 : {
1791 2 : size_t operator()( SbxVariable* pVar ) const
1792 2 : { return reinterpret_cast<size_t>(pVar); }
1793 : };
1794 :
1795 : typedef boost::unordered_map< SbxVariable*, DimAsNewRecoverItem,
1796 : SbxVariablePtrHash > DimAsNewRecoverHash;
1797 :
1798 : class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
1799 :
1800 2 : void removeDimAsNewRecoverItem( SbxVariable* pVar )
1801 : {
1802 2 : DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1803 2 : DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
1804 2 : if( it != rDimAsNewRecoverHash.end() )
1805 : {
1806 0 : rDimAsNewRecoverHash.erase( it );
1807 : }
1808 2 : }
1809 :
1810 :
1811 : // saving object variable
1812 : // not-object variables will cause errors
1813 :
1814 : static const char pCollectionStr[] = "Collection";
1815 :
1816 920 : void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
1817 : {
1818 : // #67733 types with array-flag are OK too
1819 :
1820 : // Check var, !object is no error for sure if, only if type is fixed
1821 920 : SbxDataType eVarType = refVar->GetType();
1822 920 : if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
1823 : {
1824 0 : Error( SbERR_INVALID_USAGE_OBJECT );
1825 0 : return;
1826 : }
1827 :
1828 : // Check value, !object is no error for sure if, only if type is fixed
1829 920 : SbxDataType eValType = refVal->GetType();
1830 920 : if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
1831 : {
1832 0 : Error( SbERR_INVALID_USAGE_OBJECT );
1833 0 : return;
1834 : }
1835 :
1836 : // Getting in here causes problems with objects with default properties
1837 : // if they are SbxEMPTY I guess
1838 920 : if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
1839 : {
1840 : // activate GetOject for collections on refVal
1841 846 : SbxBase* pObjVarObj = refVal->GetObject();
1842 846 : if( pObjVarObj )
1843 : {
1844 574 : SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
1845 :
1846 574 : if( refObjVal )
1847 : {
1848 574 : refVal = refObjVal;
1849 : }
1850 0 : else if( !(eValType & SbxARRAY) )
1851 : {
1852 0 : refVal = NULL;
1853 574 : }
1854 : }
1855 : }
1856 :
1857 : // #52896 refVal can be invalid here, if uno-sequences - or more
1858 : // general arrays - are assigned to variables that are declared
1859 : // as an object!
1860 920 : if( !refVal )
1861 : {
1862 0 : Error( SbERR_INVALID_USAGE_OBJECT );
1863 : }
1864 : else
1865 : {
1866 920 : bool bFlagsChanged = false;
1867 920 : SbxFlagBits n = SBX_NONE;
1868 920 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
1869 : {
1870 30 : bFlagsChanged = true;
1871 30 : n = refVar->GetFlags();
1872 30 : refVar->SetFlag( SBX_WRITE );
1873 : }
1874 920 : SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
1875 920 : if( pProcProperty )
1876 : {
1877 0 : pProcProperty->setSet( true );
1878 : }
1879 920 : if ( bHandleDefaultProp )
1880 : {
1881 : // get default properties for lhs & rhs where necessary
1882 : // SbxVariable* defaultProp = NULL; unused variable
1883 : // LHS try determine if a default prop exists
1884 : // again like in StepPUT (see there too ) we are tweaking the
1885 : // heursitics again for when to assign an object reference or
1886 : // use default memebers if they exists
1887 : // #FIXME we really need to get to the bottom of this mess
1888 86 : bool bObjAssign = false;
1889 86 : if ( refVar->GetType() == SbxOBJECT )
1890 : {
1891 86 : if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() )
1892 : {
1893 86 : SbxVariable* pDflt = getDefaultProp( refVar );
1894 86 : if ( pDflt )
1895 : {
1896 74 : refVar = pDflt;
1897 : }
1898 : }
1899 : else
1900 0 : bObjAssign = true;
1901 : }
1902 : // RHS only get a default prop is the rhs has one
1903 86 : if ( refVal->GetType() == SbxOBJECT )
1904 : {
1905 : // check if lhs is a null object
1906 : // if it is then use the object not the default property
1907 12 : SbxObject* pObj = NULL;
1908 :
1909 :
1910 12 : pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
1911 :
1912 : // calling GetObject on a SbxEMPTY variable raises
1913 : // object not set errors, make sure its an Object
1914 12 : if ( !pObj && refVar->GetType() == SbxOBJECT )
1915 : {
1916 8 : SbxBase* pObjVarObj = refVar->GetObject();
1917 8 : pObj = PTR_CAST(SbxObject,pObjVarObj);
1918 : }
1919 12 : SbxVariable* pDflt = NULL;
1920 12 : if ( pObj && !bObjAssign )
1921 : {
1922 : // lhs is either a valid object || or has a defaultProp
1923 8 : pDflt = getDefaultProp( refVal );
1924 : }
1925 12 : if ( pDflt )
1926 : {
1927 0 : refVal = pDflt;
1928 : }
1929 : }
1930 : }
1931 :
1932 : // Handle Dim As New
1933 920 : bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
1934 920 : SbxBaseRef xPrevVarObj;
1935 920 : if( bDimAsNew )
1936 : {
1937 2 : xPrevVarObj = refVar->GetObject();
1938 : }
1939 : // Handle withevents
1940 920 : bool bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
1941 920 : if ( bWithEvents )
1942 : {
1943 0 : Reference< XInterface > xComListener;
1944 :
1945 0 : SbxBase* pObj = refVal->GetObject();
1946 0 : SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
1947 0 : if( pUnoObj != NULL )
1948 : {
1949 0 : Any aControlAny = pUnoObj->getUnoAny();
1950 0 : OUString aDeclareClassName = refVar->GetDeclareClassName();
1951 0 : OUString aVBAType = aDeclareClassName;
1952 0 : OUString aPrefix = refVar->GetName();
1953 0 : SbxObjectRef xScopeObj = refVar->GetParent();
1954 0 : xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
1955 :
1956 0 : refVal->SetDeclareClassName( aDeclareClassName );
1957 0 : refVal->SetComListener( xComListener, &rBasic ); // Hold reference
1958 0 : }
1959 :
1960 : }
1961 :
1962 : // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1963 : // in this case if there is a default prop involved the value of the
1964 : // default property may infact be void so the type will also be SbxEMPTY
1965 : // in this case we do not want to call checkUnoStructCopy 'cause that will
1966 : // cause an error also
1967 920 : if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
1968 : {
1969 836 : *refVar = *refVal;
1970 : }
1971 920 : if ( bDimAsNew )
1972 : {
1973 2 : if( !refVar->ISA(SbxObject) )
1974 : {
1975 2 : SbxBase* pValObjBase = refVal->GetObject();
1976 2 : if( pValObjBase == NULL )
1977 : {
1978 0 : if( xPrevVarObj.Is() )
1979 : {
1980 : // Object is overwritten with NULL, instantiate init object
1981 0 : DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
1982 0 : DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar );
1983 0 : if( it != rDimAsNewRecoverHash.end() )
1984 : {
1985 0 : const DimAsNewRecoverItem& rItem = it->second;
1986 0 : if( rItem.m_pClassModule != NULL )
1987 : {
1988 0 : SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
1989 0 : pNewObj->SetName( rItem.m_aObjName );
1990 0 : pNewObj->SetParent( rItem.m_pObjParent );
1991 0 : refVar->PutObject( pNewObj );
1992 : }
1993 0 : else if( rItem.m_aObjClass.equalsIgnoreAsciiCaseAscii( pCollectionStr ) )
1994 : {
1995 0 : BasicCollection* pNewCollection = new BasicCollection( OUString(pCollectionStr) );
1996 0 : pNewCollection->SetName( rItem.m_aObjName );
1997 0 : pNewCollection->SetParent( rItem.m_pObjParent );
1998 0 : refVar->PutObject( pNewCollection );
1999 : }
2000 : }
2001 : }
2002 : }
2003 : else
2004 : {
2005 : // Does old value exist?
2006 2 : bool bFirstInit = !xPrevVarObj.Is();
2007 2 : if( bFirstInit )
2008 : {
2009 : // Store information to instantiate object later
2010 2 : SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
2011 2 : if( pValObj != NULL )
2012 : {
2013 2 : OUString aObjClass = pValObj->GetClassName();
2014 :
2015 2 : SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
2016 2 : DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
2017 2 : if( pClassModuleObj != NULL )
2018 : {
2019 0 : SbModule* pClassModule = pClassModuleObj->getClassModule();
2020 0 : rDimAsNewRecoverHash[refVar] =
2021 0 : DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
2022 : }
2023 2 : else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
2024 : {
2025 0 : rDimAsNewRecoverHash[refVar] =
2026 0 : DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
2027 2 : }
2028 : }
2029 : }
2030 : }
2031 : }
2032 : }
2033 :
2034 920 : if( bFlagsChanged )
2035 : {
2036 30 : refVar->SetFlags( n );
2037 920 : }
2038 : }
2039 : }
2040 :
2041 302 : void SbiRuntime::StepSET()
2042 : {
2043 302 : SbxVariableRef refVal = PopVar();
2044 604 : SbxVariableRef refVar = PopVar();
2045 604 : StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
2046 302 : }
2047 :
2048 312 : void SbiRuntime::StepVBASET()
2049 : {
2050 312 : SbxVariableRef refVal = PopVar();
2051 624 : SbxVariableRef refVar = PopVar();
2052 : // don't handle default property
2053 624 : StepSET_Impl( refVal, refVar, false ); // set obj = something
2054 312 : }
2055 :
2056 :
2057 0 : void SbiRuntime::StepLSET()
2058 : {
2059 0 : SbxVariableRef refVal = PopVar();
2060 0 : SbxVariableRef refVar = PopVar();
2061 0 : if( refVar->GetType() != SbxSTRING ||
2062 0 : refVal->GetType() != SbxSTRING )
2063 : {
2064 0 : Error( SbERR_INVALID_USAGE_OBJECT );
2065 : }
2066 : else
2067 : {
2068 0 : SbxFlagBits n = refVar->GetFlags();
2069 0 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
2070 : {
2071 0 : refVar->SetFlag( SBX_WRITE );
2072 : }
2073 0 : OUString aRefVarString = refVar->GetOUString();
2074 0 : OUString aRefValString = refVal->GetOUString();
2075 :
2076 0 : sal_Int32 nVarStrLen = aRefVarString.getLength();
2077 0 : sal_Int32 nValStrLen = aRefValString.getLength();
2078 0 : OUStringBuffer aNewStr;
2079 0 : if( nVarStrLen > nValStrLen )
2080 : {
2081 0 : aNewStr.append(aRefValString);
2082 0 : comphelper::string::padToLength(aNewStr, nVarStrLen, ' ');
2083 : }
2084 : else
2085 : {
2086 0 : aNewStr = aRefValString.copy( 0, nVarStrLen );
2087 : }
2088 :
2089 0 : refVar->PutString(aNewStr.makeStringAndClear());
2090 0 : refVar->SetFlags( n );
2091 0 : }
2092 0 : }
2093 :
2094 0 : void SbiRuntime::StepRSET()
2095 : {
2096 0 : SbxVariableRef refVal = PopVar();
2097 0 : SbxVariableRef refVar = PopVar();
2098 0 : if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
2099 : {
2100 0 : Error( SbERR_INVALID_USAGE_OBJECT );
2101 : }
2102 : else
2103 : {
2104 0 : SbxFlagBits n = refVar->GetFlags();
2105 0 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
2106 : {
2107 0 : refVar->SetFlag( SBX_WRITE );
2108 : }
2109 0 : OUString aRefVarString = refVar->GetOUString();
2110 0 : OUString aRefValString = refVal->GetOUString();
2111 0 : sal_Int32 nVarStrLen = aRefVarString.getLength();
2112 0 : sal_Int32 nValStrLen = aRefValString.getLength();
2113 :
2114 0 : OUStringBuffer aNewStr(nVarStrLen);
2115 0 : if (nVarStrLen > nValStrLen)
2116 : {
2117 0 : comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
2118 0 : aNewStr.append(aRefValString);
2119 : }
2120 : else
2121 : {
2122 0 : aNewStr.append(aRefValString.copy(0, nVarStrLen));
2123 : }
2124 0 : refVar->PutString(aNewStr.makeStringAndClear());
2125 :
2126 0 : refVar->SetFlags( n );
2127 0 : }
2128 0 : }
2129 :
2130 : // laying down TOS in TOS-1, then set ReadOnly-Bit
2131 :
2132 174 : void SbiRuntime::StepPUTC()
2133 : {
2134 174 : SbxVariableRef refVal = PopVar();
2135 348 : SbxVariableRef refVar = PopVar();
2136 174 : refVar->SetFlag( SBX_WRITE );
2137 174 : *refVar = *refVal;
2138 174 : refVar->ResetFlag( SBX_WRITE );
2139 348 : refVar->SetFlag( SBX_CONST );
2140 174 : }
2141 :
2142 : // DIM
2143 : // TOS = variable for the array with dimension information as parameter
2144 :
2145 126 : void SbiRuntime::StepDIM()
2146 : {
2147 126 : SbxVariableRef refVar = PopVar();
2148 126 : DimImpl( refVar );
2149 126 : }
2150 :
2151 : // #56204 swap out DIM-functionality into a help method (step0.cxx)
2152 138 : void SbiRuntime::DimImpl( SbxVariableRef refVar )
2153 : {
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 138 : if ( refRedim )
2158 : {
2159 8 : if ( !refRedimpArray ) // only erase the array not ReDim Preserve
2160 : {
2161 8 : lcl_eraseImpl( refVar, bVBAEnabled );
2162 : }
2163 8 : SbxDataType eType = refVar->GetType();
2164 8 : lcl_clearImpl( refVar, eType );
2165 8 : refRedim = NULL;
2166 : }
2167 138 : SbxArray* pDims = refVar->GetParameters();
2168 : // must have an even number of arguments
2169 : // have in mind that Arg[0] does not count!
2170 138 : if( pDims && !( pDims->Count() & 1 ) )
2171 : {
2172 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2173 : }
2174 : else
2175 : {
2176 138 : SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
2177 138 : SbxDimArray* pArray = new SbxDimArray( eType );
2178 : // allow arrays without dimension information, too (VB-compatible)
2179 138 : if( pDims )
2180 : {
2181 72 : refVar->ResetFlag( SBX_VAR_TO_DIM );
2182 :
2183 220 : for( sal_uInt16 i = 1; i < pDims->Count(); )
2184 : {
2185 76 : sal_Int32 lb = pDims->Get( i++ )->GetLong();
2186 76 : sal_Int32 ub = pDims->Get( i++ )->GetLong();
2187 76 : if( ub < lb )
2188 : {
2189 0 : Error( SbERR_OUT_OF_RANGE ), ub = lb;
2190 : }
2191 76 : pArray->AddDim32( lb, ub );
2192 76 : if ( lb != ub )
2193 : {
2194 34 : pArray->setHasFixedSize( true );
2195 : }
2196 : }
2197 : }
2198 : else
2199 : {
2200 : // #62867 On creating an array of the length 0, create
2201 : // a dimension (like for Uno-Sequences of the length 0)
2202 66 : pArray->unoAddDim( 0, -1 );
2203 : }
2204 138 : SbxFlagBits nSavFlags = refVar->GetFlags();
2205 138 : refVar->ResetFlag( SBX_FIXED );
2206 138 : refVar->PutObject( pArray );
2207 138 : refVar->SetFlags( nSavFlags );
2208 138 : refVar->SetParameters( NULL );
2209 : }
2210 138 : }
2211 :
2212 : // REDIM
2213 : // TOS = variable for the array
2214 : // argv = dimension information
2215 :
2216 8 : void SbiRuntime::StepREDIM()
2217 : {
2218 : // Nothing different than dim at the moment because
2219 : // a double dim is already recognized by the compiler.
2220 8 : StepDIM();
2221 8 : }
2222 :
2223 :
2224 : // Helper function for StepREDIMP
2225 0 : void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
2226 : short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
2227 : {
2228 0 : sal_Int32& ri = pActualIndices[nActualDim];
2229 0 : for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
2230 : {
2231 0 : if( nActualDim < nMaxDimIndex )
2232 : {
2233 : implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
2234 0 : pActualIndices, pLowerBounds, pUpperBounds );
2235 : }
2236 : else
2237 : {
2238 0 : SbxVariable* pSource = pOldArray->Get32( pActualIndices );
2239 0 : SbxVariable* pDest = pNewArray->Get32( pActualIndices );
2240 0 : if( pSource && pDest )
2241 : {
2242 0 : *pDest = *pSource;
2243 : }
2244 : }
2245 : }
2246 0 : }
2247 :
2248 : // REDIM PRESERVE
2249 : // TOS = variable for the array
2250 : // argv = dimension information
2251 :
2252 0 : void SbiRuntime::StepREDIMP()
2253 : {
2254 0 : SbxVariableRef refVar = PopVar();
2255 0 : DimImpl( refVar );
2256 :
2257 : // Now check, if we can copy from the old array
2258 0 : if( refRedimpArray.Is() )
2259 : {
2260 0 : SbxBase* pElemObj = refVar->GetObject();
2261 0 : SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
2262 0 : SbxDimArray* pOldArray = static_cast<SbxDimArray*>((SbxArray*)refRedimpArray);
2263 0 : if( pNewArray )
2264 : {
2265 0 : short nDimsNew = pNewArray->GetDims();
2266 0 : short nDimsOld = pOldArray->GetDims();
2267 0 : short nDims = nDimsNew;
2268 :
2269 0 : if( nDimsOld != nDimsNew )
2270 : {
2271 0 : StarBASIC::Error( SbERR_OUT_OF_RANGE );
2272 : }
2273 0 : else if (nDims > 0)
2274 : {
2275 : // Store dims to use them for copying later
2276 0 : boost::scoped_array<sal_Int32> pLowerBounds(new sal_Int32[nDims]);
2277 0 : boost::scoped_array<sal_Int32> pUpperBounds(new sal_Int32[nDims]);
2278 0 : boost::scoped_array<sal_Int32> pActualIndices(new sal_Int32[nDims]);
2279 :
2280 : // Compare bounds
2281 0 : for( short i = 1 ; i <= nDims ; i++ )
2282 : {
2283 : sal_Int32 lBoundNew, uBoundNew;
2284 : sal_Int32 lBoundOld, uBoundOld;
2285 0 : pNewArray->GetDim32( i, lBoundNew, uBoundNew );
2286 0 : pOldArray->GetDim32( i, lBoundOld, uBoundOld );
2287 0 : lBoundNew = std::max( lBoundNew, lBoundOld );
2288 0 : uBoundNew = std::min( uBoundNew, uBoundOld );
2289 0 : short j = i - 1;
2290 0 : pActualIndices[j] = pLowerBounds[j] = lBoundNew;
2291 0 : pUpperBounds[j] = uBoundNew;
2292 : }
2293 : // Copy data from old array by going recursively through all dimensions
2294 : // (It would be faster to work on the flat internal data array of an
2295 : // SbyArray but this solution is clearer and easier)
2296 : implCopyDimArray( pNewArray, pOldArray, nDims - 1,
2297 0 : 0, pActualIndices.get(), pLowerBounds.get(), pUpperBounds.get() );
2298 : }
2299 :
2300 0 : refRedimpArray = NULL;
2301 : }
2302 0 : }
2303 :
2304 0 : }
2305 :
2306 : // REDIM_COPY
2307 : // TOS = Array-Variable, Reference to array is copied
2308 : // Variable is cleared as in ERASE
2309 :
2310 0 : void SbiRuntime::StepREDIMP_ERASE()
2311 : {
2312 0 : SbxVariableRef refVar = PopVar();
2313 0 : refRedim = refVar;
2314 0 : SbxDataType eType = refVar->GetType();
2315 0 : if( eType & SbxARRAY )
2316 : {
2317 0 : SbxBase* pElemObj = refVar->GetObject();
2318 0 : SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
2319 0 : if( pDimArray )
2320 : {
2321 0 : refRedimpArray = pDimArray;
2322 : }
2323 :
2324 : }
2325 0 : else if( refVar->IsFixed() )
2326 : {
2327 0 : refVar->Clear();
2328 : }
2329 : else
2330 : {
2331 0 : refVar->SetType( SbxEMPTY );
2332 0 : }
2333 0 : }
2334 :
2335 8 : static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
2336 : {
2337 8 : SbxFlagBits nSavFlags = refVar->GetFlags();
2338 8 : refVar->ResetFlag( SBX_FIXED );
2339 8 : refVar->SetType( SbxDataType(eType & 0x0FFF) );
2340 8 : refVar->SetFlags( nSavFlags );
2341 8 : refVar->Clear();
2342 8 : }
2343 :
2344 8 : static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
2345 : {
2346 8 : SbxDataType eType = refVar->GetType();
2347 8 : if( eType & SbxARRAY )
2348 : {
2349 8 : if ( bVBAEnabled )
2350 : {
2351 8 : SbxBase* pElemObj = refVar->GetObject();
2352 8 : SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
2353 8 : bool bClearValues = true;
2354 8 : if( pDimArray )
2355 : {
2356 8 : if ( pDimArray->hasFixedSize() )
2357 : {
2358 : // Clear all Value(s)
2359 0 : pDimArray->SbxArray::Clear();
2360 0 : bClearValues = false;
2361 : }
2362 : else
2363 : {
2364 8 : pDimArray->Clear(); // clear Dims
2365 : }
2366 : }
2367 8 : if ( bClearValues )
2368 : {
2369 8 : SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
2370 8 : if ( pArray )
2371 : {
2372 8 : pArray->Clear();
2373 : }
2374 : }
2375 : }
2376 : else
2377 : {
2378 : // Arrays have on an erase to VB quite a complex behaviour. Here are
2379 : // only the type problems at REDIM (#26295) removed at first:
2380 : // Set type hard onto the array-type, because a variable with array is
2381 : // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2382 : // the original type is lost -> runtime error
2383 0 : lcl_clearImpl( refVar, eType );
2384 : }
2385 : }
2386 0 : else if( refVar->IsFixed() )
2387 : {
2388 0 : refVar->Clear();
2389 : }
2390 : else
2391 : {
2392 0 : refVar->SetType( SbxEMPTY );
2393 : }
2394 8 : }
2395 :
2396 : // delete variable
2397 : // TOS = variable
2398 :
2399 0 : void SbiRuntime::StepERASE()
2400 : {
2401 0 : SbxVariableRef refVar = PopVar();
2402 0 : lcl_eraseImpl( refVar, bVBAEnabled );
2403 0 : }
2404 :
2405 8 : void SbiRuntime::StepERASE_CLEAR()
2406 : {
2407 8 : refRedim = PopVar();
2408 8 : }
2409 :
2410 0 : void SbiRuntime::StepARRAYACCESS()
2411 : {
2412 0 : if( !refArgv )
2413 : {
2414 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2415 : }
2416 0 : SbxVariableRef refVar = PopVar();
2417 0 : refVar->SetParameters( refArgv );
2418 0 : PopArgv();
2419 0 : PushVar( CheckArray( refVar ) );
2420 0 : }
2421 :
2422 0 : void SbiRuntime::StepBYVAL()
2423 : {
2424 : // Copy variable on stack to break call by reference
2425 0 : SbxVariableRef pVar = PopVar();
2426 0 : SbxDataType t = pVar->GetType();
2427 :
2428 0 : SbxVariable* pCopyVar = new SbxVariable( t );
2429 0 : pCopyVar->SetFlag( SBX_READWRITE );
2430 0 : *pCopyVar = *pVar;
2431 :
2432 0 : PushVar( pCopyVar );
2433 0 : }
2434 :
2435 : // establishing an argv
2436 : // nOp1 stays as it is -> 1st element is the return value
2437 :
2438 7338 : void SbiRuntime::StepARGC()
2439 : {
2440 7338 : PushArgv();
2441 7338 : refArgv = new SbxArray;
2442 7338 : nArgc = 1;
2443 7338 : }
2444 :
2445 : // storing an argument in Argv
2446 :
2447 11214 : void SbiRuntime::StepARGV()
2448 : {
2449 11214 : if( !refArgv )
2450 : {
2451 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2452 : }
2453 : else
2454 : {
2455 11214 : SbxVariableRef pVal = PopVar();
2456 :
2457 : // Before fix of #94916:
2458 11214 : if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
2459 : {
2460 : // evaluate methods and properties!
2461 590 : SbxVariable* pRes = new SbxVariable( *pVal );
2462 590 : pVal = pRes;
2463 : }
2464 11214 : refArgv->Put( pVal, nArgc++ );
2465 : }
2466 11214 : }
2467 :
2468 : // Input to Variable. The variable is on TOS and is
2469 : // is removed afterwards.
2470 0 : void SbiRuntime::StepINPUT()
2471 : {
2472 0 : OUStringBuffer sin;
2473 0 : OUString s;
2474 0 : char ch = 0;
2475 : SbError err;
2476 : // Skip whitespace
2477 0 : while( ( err = pIosys->GetError() ) == 0 )
2478 : {
2479 0 : ch = pIosys->Read();
2480 0 : if( ch != ' ' && ch != '\t' && ch != '\n' )
2481 : {
2482 0 : break;
2483 : }
2484 : }
2485 0 : if( !err )
2486 : {
2487 : // Scan until comma or whitespace
2488 0 : char sep = ( ch == '"' ) ? ch : 0;
2489 0 : if( sep )
2490 : {
2491 0 : ch = pIosys->Read();
2492 : }
2493 0 : while( ( err = pIosys->GetError() ) == 0 )
2494 : {
2495 0 : if( ch == sep )
2496 : {
2497 0 : ch = pIosys->Read();
2498 0 : if( ch != sep )
2499 : {
2500 0 : break;
2501 : }
2502 : }
2503 0 : else if( !sep && (ch == ',' || ch == '\n') )
2504 : {
2505 : break;
2506 : }
2507 0 : sin.append( ch );
2508 0 : ch = pIosys->Read();
2509 : }
2510 : // skip whitespace
2511 0 : if( ch == ' ' || ch == '\t' )
2512 : {
2513 0 : while( ( err = pIosys->GetError() ) == 0 )
2514 : {
2515 0 : if( ch != ' ' && ch != '\t' && ch != '\n' )
2516 : {
2517 0 : break;
2518 : }
2519 0 : ch = pIosys->Read();
2520 : }
2521 : }
2522 : }
2523 0 : if( !err )
2524 : {
2525 0 : s = sin.makeStringAndClear();
2526 0 : SbxVariableRef pVar = GetTOS();
2527 : // try to fill the variable with a numeric value first,
2528 : // then with a string value
2529 0 : if( !pVar->IsFixed() || pVar->IsNumeric() )
2530 : {
2531 0 : sal_uInt16 nLen = 0;
2532 0 : if( !pVar->Scan( s, &nLen ) )
2533 : {
2534 0 : err = SbxBase::GetError();
2535 0 : SbxBase::ResetError();
2536 : }
2537 : // the value has to be scanned in completely
2538 0 : else if( nLen != s.getLength() && !pVar->PutString( s ) )
2539 : {
2540 0 : err = SbxBase::GetError();
2541 0 : SbxBase::ResetError();
2542 : }
2543 0 : else if( nLen != s.getLength() && pVar->IsNumeric() )
2544 : {
2545 0 : err = SbxBase::GetError();
2546 0 : SbxBase::ResetError();
2547 0 : if( !err )
2548 : {
2549 0 : err = SbERR_CONVERSION;
2550 : }
2551 : }
2552 : }
2553 : else
2554 : {
2555 0 : pVar->PutString( s );
2556 0 : err = SbxBase::GetError();
2557 0 : SbxBase::ResetError();
2558 0 : }
2559 : }
2560 0 : if( err == SbERR_USER_ABORT )
2561 : {
2562 0 : Error( err );
2563 : }
2564 0 : else if( err )
2565 : {
2566 0 : if( pRestart && !pIosys->GetChannel() )
2567 : {
2568 0 : pCode = pRestart;
2569 : }
2570 : else
2571 : {
2572 0 : Error( err );
2573 : }
2574 : }
2575 : else
2576 : {
2577 0 : PopVar();
2578 0 : }
2579 0 : }
2580 :
2581 : // Line Input to Variable. The variable is on TOS and is
2582 : // deleted afterwards.
2583 :
2584 0 : void SbiRuntime::StepLINPUT()
2585 : {
2586 0 : OString aInput;
2587 0 : pIosys->Read( aInput );
2588 0 : Error( pIosys->GetError() );
2589 0 : SbxVariableRef p = PopVar();
2590 0 : p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
2591 0 : }
2592 :
2593 : // end of program
2594 :
2595 0 : void SbiRuntime::StepSTOP()
2596 : {
2597 0 : pInst->Stop();
2598 0 : }
2599 :
2600 :
2601 168 : void SbiRuntime::StepINITFOR()
2602 : {
2603 168 : PushFor();
2604 168 : }
2605 :
2606 4 : void SbiRuntime::StepINITFOREACH()
2607 : {
2608 4 : PushForEach();
2609 4 : }
2610 :
2611 : // increment FOR-variable
2612 :
2613 882 : void SbiRuntime::StepNEXT()
2614 : {
2615 882 : if( !pForStk )
2616 : {
2617 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2618 882 : return;
2619 : }
2620 882 : if( pForStk->eForType == FOR_TO )
2621 : {
2622 872 : pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
2623 : }
2624 : }
2625 :
2626 : // beginning CASE: TOS in CASE-stack
2627 :
2628 172 : void SbiRuntime::StepCASE()
2629 : {
2630 172 : if( !refCaseStk.Is() )
2631 : {
2632 172 : refCaseStk = new SbxArray;
2633 : }
2634 172 : SbxVariableRef xVar = PopVar();
2635 172 : refCaseStk->Put( xVar, refCaseStk->Count() );
2636 172 : }
2637 :
2638 : // end CASE: free variable
2639 :
2640 172 : void SbiRuntime::StepENDCASE()
2641 : {
2642 172 : if( !refCaseStk || !refCaseStk->Count() )
2643 : {
2644 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2645 : }
2646 : else
2647 : {
2648 172 : refCaseStk->Remove( refCaseStk->Count() - 1 );
2649 : }
2650 172 : }
2651 :
2652 :
2653 2 : void SbiRuntime::StepSTDERROR()
2654 : {
2655 2 : pError = NULL; bError = true;
2656 2 : pInst->aErrorMsg = "";
2657 2 : pInst->nErr = 0L;
2658 2 : pInst->nErl = 0;
2659 2 : nError = 0L;
2660 2 : SbxErrObject::getUnoErrObject()->Clear();
2661 2 : }
2662 :
2663 4 : void SbiRuntime::StepNOERROR()
2664 : {
2665 4 : pInst->aErrorMsg = "";
2666 4 : pInst->nErr = 0L;
2667 4 : pInst->nErl = 0;
2668 4 : nError = 0L;
2669 4 : SbxErrObject::getUnoErrObject()->Clear();
2670 4 : bError = false;
2671 4 : }
2672 :
2673 : // leave UP
2674 :
2675 2806 : void SbiRuntime::StepLEAVE()
2676 : {
2677 2806 : bRun = false;
2678 : // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2679 2806 : if ( bInError && pError )
2680 : {
2681 6 : SbxErrObject::getUnoErrObject()->Clear();
2682 : }
2683 2806 : }
2684 :
2685 190 : void SbiRuntime::StepCHANNEL() // TOS = channel number
2686 : {
2687 190 : SbxVariableRef pChan = PopVar();
2688 190 : short nChan = pChan->GetInteger();
2689 190 : pIosys->SetChannel( nChan );
2690 190 : Error( pIosys->GetError() );
2691 190 : }
2692 :
2693 168 : void SbiRuntime::StepCHANNEL0()
2694 : {
2695 168 : pIosys->ResetChannel();
2696 168 : }
2697 :
2698 166 : void SbiRuntime::StepPRINT() // print TOS
2699 : {
2700 166 : SbxVariableRef p = PopVar();
2701 332 : OUString s1 = p->GetOUString();
2702 332 : OUString s;
2703 166 : if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2704 : {
2705 0 : s = " "; // one blank before
2706 : }
2707 166 : s += s1;
2708 166 : pIosys->Write( s );
2709 332 : Error( pIosys->GetError() );
2710 166 : }
2711 :
2712 0 : void SbiRuntime::StepPRINTF() // print TOS in field
2713 : {
2714 0 : SbxVariableRef p = PopVar();
2715 0 : OUString s1 = p->GetOUString();
2716 0 : OUStringBuffer s;
2717 0 : if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
2718 : {
2719 0 : s.append(' ');
2720 : }
2721 0 : s.append(s1);
2722 0 : comphelper::string::padToLength(s, 14, ' ');
2723 0 : pIosys->Write( s.makeStringAndClear() );
2724 0 : Error( pIosys->GetError() );
2725 0 : }
2726 :
2727 0 : void SbiRuntime::StepWRITE() // write TOS
2728 : {
2729 0 : SbxVariableRef p = PopVar();
2730 : // Does the string have to be encapsulated?
2731 0 : char ch = 0;
2732 0 : switch (p->GetType() )
2733 : {
2734 0 : case SbxSTRING: ch = '"'; break;
2735 : case SbxCURRENCY:
2736 : case SbxBOOL:
2737 0 : case SbxDATE: ch = '#'; break;
2738 0 : default: break;
2739 : }
2740 0 : OUString s;
2741 0 : if( ch )
2742 : {
2743 0 : s += OUString(ch);
2744 : }
2745 0 : s += p->GetOUString();
2746 0 : if( ch )
2747 : {
2748 0 : s += OUString(ch);
2749 : }
2750 0 : pIosys->Write( s );
2751 0 : Error( pIosys->GetError() );
2752 0 : }
2753 :
2754 0 : void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2755 : {
2756 0 : SbxVariableRef pTos1 = PopVar();
2757 0 : SbxVariableRef pTos = PopVar();
2758 0 : OUString aDest = pTos1->GetOUString();
2759 0 : OUString aSource = pTos->GetOUString();
2760 :
2761 0 : if( hasUno() )
2762 : {
2763 0 : implStepRenameUCB( aSource, aDest );
2764 : }
2765 : else
2766 : {
2767 0 : implStepRenameOSL( aSource, aDest );
2768 0 : }
2769 0 : }
2770 :
2771 : // TOS = Prompt
2772 :
2773 0 : void SbiRuntime::StepPROMPT()
2774 : {
2775 0 : SbxVariableRef p = PopVar();
2776 0 : OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
2777 0 : pIosys->SetPrompt( aStr );
2778 0 : }
2779 :
2780 : // Set Restart point
2781 :
2782 0 : void SbiRuntime::StepRESTART()
2783 : {
2784 0 : pRestart = pCode;
2785 0 : }
2786 :
2787 : // empty expression on stack for missing parameter
2788 :
2789 0 : void SbiRuntime::StepEMPTY()
2790 : {
2791 : // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2792 : // This is represented by the value 448 (SbERR_NAMED_NOT_FOUND) of the type error
2793 : // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2794 : // to simplify matters.
2795 0 : SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
2796 0 : xVar->PutErr( 448 );
2797 0 : PushVar( xVar );
2798 0 : }
2799 :
2800 : // TOS = error code
2801 :
2802 0 : void SbiRuntime::StepERROR()
2803 : {
2804 0 : SbxVariableRef refCode = PopVar();
2805 0 : sal_uInt16 n = refCode->GetUShort();
2806 0 : SbError error = StarBASIC::GetSfxFromVBError( n );
2807 0 : if ( bVBAEnabled )
2808 : {
2809 0 : pInst->Error( error );
2810 : }
2811 : else
2812 : {
2813 0 : Error( error );
2814 0 : }
2815 0 : }
2816 :
2817 : // loading a numeric constant (+ID)
2818 :
2819 186 : void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
2820 : {
2821 186 : SbxVariable* p = new SbxVariable( SbxDOUBLE );
2822 :
2823 : // #57844 use localized function
2824 186 : OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
2825 : // also allow , !!!
2826 186 : sal_Int32 iComma = aStr.indexOf((sal_Unicode)',');
2827 186 : if( iComma >= 0 )
2828 : {
2829 0 : aStr = aStr.replaceAt(iComma, 1, OUString("."));
2830 : }
2831 186 : double n = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
2832 :
2833 186 : p->PutDouble( n );
2834 186 : PushVar( p );
2835 186 : }
2836 :
2837 : // loading a string constant (+ID)
2838 :
2839 6204 : void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
2840 : {
2841 6204 : SbxVariable* p = new SbxVariable;
2842 6204 : p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
2843 6204 : PushVar( p );
2844 6204 : }
2845 :
2846 : // Immediate Load (+Wert)
2847 :
2848 6090 : void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
2849 : {
2850 6090 : SbxVariable* p = new SbxVariable;
2851 6090 : p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
2852 6090 : PushVar( p );
2853 6090 : }
2854 :
2855 : // stora a named argument in Argv (+Arg-no. from 1!)
2856 :
2857 258 : void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
2858 : {
2859 258 : if( !refArgv )
2860 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2861 : else
2862 : {
2863 258 : OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
2864 516 : SbxVariableRef pVal = PopVar();
2865 258 : if( bVBAEnabled && ( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) ) )
2866 : {
2867 : // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2868 6 : if ( pVal->GetType() == SbxEMPTY )
2869 0 : pVal->Broadcast( SBX_HINT_DATAWANTED );
2870 : // evaluate methods and properties!
2871 6 : SbxVariable* pRes = new SbxVariable( *pVal );
2872 6 : pVal = pRes;
2873 : }
2874 258 : refArgv->Put( pVal, nArgc );
2875 516 : refArgv->PutAlias( aAlias, nArgc++ );
2876 : }
2877 258 : }
2878 :
2879 : // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2880 :
2881 10 : void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
2882 : {
2883 10 : if( !refArgv )
2884 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2885 : else
2886 : {
2887 10 : bool bByVal = (nOp1 & 0x8000) != 0; // Ist BYVAL requested?
2888 10 : SbxDataType t = (SbxDataType) (nOp1 & 0x7FFF);
2889 10 : SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // last Arg
2890 :
2891 : // check BYVAL
2892 10 : if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
2893 : {
2894 : // parameter is a reference
2895 10 : if( bByVal )
2896 : {
2897 : // Call by Value is requested -> create a copy
2898 0 : pVar = new SbxVariable( *pVar );
2899 0 : pVar->SetFlag( SBX_READWRITE );
2900 0 : refExprStk->Put( pVar, refArgv->Count() - 1 );
2901 : }
2902 : else
2903 10 : pVar->SetFlag( SBX_REFERENCE ); // Ref-Flag for DllMgr
2904 : }
2905 : else
2906 : {
2907 : // parameter is NO reference
2908 0 : if( bByVal )
2909 0 : pVar->ResetFlag( SBX_REFERENCE ); // no reference -> OK
2910 : else
2911 0 : Error( SbERR_BAD_PARAMETERS ); // reference needed
2912 : }
2913 :
2914 10 : if( pVar->GetType() != t )
2915 : {
2916 : // variant for correct conversion
2917 : // besides error, if SbxBYREF
2918 0 : pVar->Convert( SbxVARIANT );
2919 0 : pVar->Convert( t );
2920 : }
2921 : }
2922 10 : }
2923 :
2924 : // bring string to a definite length (+length)
2925 :
2926 0 : void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
2927 : {
2928 0 : SbxVariable* p = GetTOS();
2929 0 : OUString s = p->GetOUString();
2930 0 : sal_Int32 nLen(nOp1);
2931 0 : if( s.getLength() != nLen )
2932 : {
2933 0 : OUStringBuffer aBuf(s);
2934 0 : if (aBuf.getLength() > nLen)
2935 : {
2936 0 : comphelper::string::truncateToLength(aBuf, nLen);
2937 : }
2938 : else
2939 : {
2940 0 : comphelper::string::padToLength(aBuf, nLen, ' ');
2941 : }
2942 0 : s = aBuf.makeStringAndClear();
2943 0 : }
2944 0 : }
2945 :
2946 : // jump (+target)
2947 :
2948 5630 : void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
2949 : {
2950 : #ifdef DBG_UTIL
2951 : // #QUESTION shouln't this be
2952 : // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
2953 : if( nOp1 >= pImg->GetCodeSize() )
2954 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
2955 : #endif
2956 5630 : pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
2957 5630 : }
2958 :
2959 : // evaluate TOS, conditional jump (+target)
2960 :
2961 0 : void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
2962 : {
2963 0 : SbxVariableRef p = PopVar();
2964 0 : if( p->GetBool() )
2965 0 : StepJUMP( nOp1 );
2966 0 : }
2967 :
2968 : // evaluate TOS, conditional jump (+target)
2969 :
2970 3238 : void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
2971 : {
2972 3238 : SbxVariableRef p = PopVar();
2973 : // In a test e.g. If Null then
2974 : // will evaluate Null will act as if False
2975 3238 : if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
2976 1450 : StepJUMP( nOp1 );
2977 3238 : }
2978 :
2979 : // evaluate TOS, jump into JUMP-table (+MaxVal)
2980 : // looks like this:
2981 : // ONJUMP 2
2982 : // JUMP target1
2983 : // JUMP target2
2984 :
2985 : // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
2986 :
2987 0 : void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
2988 : {
2989 0 : SbxVariableRef p = PopVar();
2990 0 : sal_Int16 n = p->GetInteger();
2991 0 : if( nOp1 & 0x8000 )
2992 : {
2993 0 : nOp1 &= 0x7FFF;
2994 0 : PushGosub( pCode + 5 * nOp1 );
2995 : }
2996 0 : if( n < 1 || static_cast<sal_uInt32>(n) > nOp1 )
2997 0 : n = static_cast<sal_Int16>( nOp1 + 1 );
2998 0 : nOp1 = (sal_uInt32) ( (const char*) pCode - pImg->GetCode() ) + 5 * --n;
2999 0 : StepJUMP( nOp1 );
3000 0 : }
3001 :
3002 : // UP-call (+target)
3003 :
3004 0 : void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
3005 : {
3006 0 : PushGosub( pCode );
3007 0 : if( nOp1 >= pImg->GetCodeSize() )
3008 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
3009 0 : pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
3010 0 : }
3011 :
3012 : // UP-return (+0 or target)
3013 :
3014 0 : void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
3015 : {
3016 0 : PopGosub();
3017 0 : if( nOp1 )
3018 0 : StepJUMP( nOp1 );
3019 0 : }
3020 :
3021 : // check FOR-variable (+Endlabel)
3022 :
3023 1054 : void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
3024 : {
3025 1054 : if( !pForStk )
3026 : {
3027 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
3028 1054 : return;
3029 : }
3030 :
3031 1054 : bool bEndLoop = false;
3032 1054 : switch( pForStk->eForType )
3033 : {
3034 : case FOR_TO:
3035 : {
3036 1040 : SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
3037 1040 : if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
3038 168 : bEndLoop = true;
3039 1040 : break;
3040 : }
3041 : case FOR_EACH_ARRAY:
3042 : {
3043 0 : SbiForStack* p = pForStk;
3044 0 : if( p->pArrayCurIndices == NULL )
3045 : {
3046 0 : bEndLoop = true;
3047 : }
3048 : else
3049 : {
3050 0 : SbxDimArray* pArray = (SbxDimArray*)(SbxVariable*)p->refEnd;
3051 0 : short nDims = pArray->GetDims();
3052 :
3053 : // Empty array?
3054 0 : if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
3055 : {
3056 0 : bEndLoop = true;
3057 0 : break;
3058 : }
3059 0 : SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices );
3060 0 : *(p->refVar) = *pVal;
3061 :
3062 0 : bool bFoundNext = false;
3063 0 : for( short i = 0 ; i < nDims ; i++ )
3064 : {
3065 0 : if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
3066 : {
3067 0 : bFoundNext = true;
3068 0 : p->pArrayCurIndices[i]++;
3069 0 : for( short j = i - 1 ; j >= 0 ; j-- )
3070 0 : p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
3071 0 : break;
3072 : }
3073 : }
3074 0 : if( !bFoundNext )
3075 : {
3076 0 : delete[] p->pArrayCurIndices;
3077 0 : p->pArrayCurIndices = NULL;
3078 : }
3079 : }
3080 0 : break;
3081 : }
3082 : case FOR_EACH_COLLECTION:
3083 : {
3084 0 : BasicCollection* pCollection = static_cast<BasicCollection*>((SbxVariable*)pForStk->refEnd);
3085 0 : SbxArrayRef xItemArray = pCollection->xItemArray;
3086 0 : sal_Int32 nCount = xItemArray->Count32();
3087 0 : if( pForStk->nCurCollectionIndex < nCount )
3088 : {
3089 0 : SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
3090 0 : pForStk->nCurCollectionIndex++;
3091 0 : (*pForStk->refVar) = *pRes;
3092 : }
3093 : else
3094 : {
3095 0 : bEndLoop = true;
3096 : }
3097 0 : break;
3098 : }
3099 : case FOR_EACH_XENUMERATION:
3100 : {
3101 14 : SbiForStack* p = pForStk;
3102 14 : if( p->xEnumeration->hasMoreElements() )
3103 : {
3104 10 : Any aElem = p->xEnumeration->nextElement();
3105 20 : SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
3106 10 : unoToSbxValue( (SbxVariable*)xVar, aElem );
3107 20 : (*pForStk->refVar) = *xVar;
3108 : }
3109 : else
3110 : {
3111 4 : bEndLoop = true;
3112 : }
3113 14 : break;
3114 : }
3115 : }
3116 1054 : if( bEndLoop )
3117 : {
3118 172 : PopFor();
3119 172 : StepJUMP( nOp1 );
3120 : }
3121 : }
3122 :
3123 : // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3124 :
3125 0 : void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
3126 : {
3127 0 : if( !refCaseStk || !refCaseStk->Count() )
3128 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
3129 : else
3130 : {
3131 0 : SbxVariableRef xTo = PopVar();
3132 0 : SbxVariableRef xFrom = PopVar();
3133 0 : SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
3134 0 : if( *xCase >= *xFrom && *xCase <= *xTo )
3135 0 : StepJUMP( nOp1 );
3136 : }
3137 0 : }
3138 :
3139 :
3140 140 : void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
3141 : {
3142 140 : const sal_uInt8* p = pCode;
3143 140 : StepJUMP( nOp1 );
3144 140 : pError = pCode;
3145 140 : pCode = p;
3146 140 : pInst->aErrorMsg = "";
3147 140 : pInst->nErr = 0;
3148 140 : pInst->nErl = 0;
3149 140 : nError = 0;
3150 140 : SbxErrObject::getUnoErrObject()->Clear();
3151 140 : }
3152 :
3153 : // Resume after errors (+0=statement, 1=next or Label)
3154 :
3155 42 : void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
3156 : {
3157 : // #32714 Resume without error? -> error
3158 42 : if( !bInError )
3159 : {
3160 2 : Error( SbERR_BAD_RESUME );
3161 44 : return;
3162 : }
3163 40 : if( nOp1 )
3164 : {
3165 : // set Code-pointer to the next statement
3166 : sal_uInt16 n1, n2;
3167 40 : pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg );
3168 : }
3169 : else
3170 0 : pCode = pErrStmnt;
3171 40 : if ( pError ) // current in error handler ( and got a Resume Next statement )
3172 38 : SbxErrObject::getUnoErrObject()->Clear();
3173 :
3174 40 : if( nOp1 > 1 )
3175 0 : StepJUMP( nOp1 );
3176 40 : pInst->aErrorMsg = "";
3177 40 : pInst->nErr = 0;
3178 40 : pInst->nErl = 0;
3179 40 : nError = 0;
3180 40 : bInError = false;
3181 : }
3182 :
3183 : // close channel (+channel, 0=all)
3184 22 : void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
3185 : {
3186 : SbError err;
3187 22 : if( !nOp1 )
3188 0 : pIosys->Shutdown();
3189 : else
3190 : {
3191 22 : err = pIosys->GetError();
3192 22 : if( !err )
3193 : {
3194 22 : pIosys->Close();
3195 : }
3196 : }
3197 22 : err = pIosys->GetError();
3198 22 : Error( err );
3199 22 : }
3200 :
3201 : // output character (+char)
3202 :
3203 168 : void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
3204 : {
3205 168 : OUString s(static_cast<sal_Unicode>(nOp1));
3206 168 : pIosys->Write( s );
3207 168 : Error( pIosys->GetError() );
3208 168 : }
3209 :
3210 : // check whether TOS is a certain object class (+StringID)
3211 :
3212 296 : bool SbiRuntime::implIsClass( SbxObject* pObj, const OUString& aClass )
3213 : {
3214 296 : bool bRet = true;
3215 :
3216 296 : if( !aClass.isEmpty() )
3217 : {
3218 296 : bRet = pObj->IsClass( aClass );
3219 296 : if( !bRet )
3220 288 : bRet = aClass.equalsIgnoreAsciiCase( "object" );
3221 296 : if( !bRet )
3222 : {
3223 288 : OUString aObjClass = pObj->GetClassName();
3224 288 : SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
3225 : SbClassData* pClassData;
3226 288 : if( pClassMod && (pClassData=pClassMod->pClassData) != NULL )
3227 : {
3228 0 : SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxCLASS_DONTCARE );
3229 0 : bRet = (pClassVar != NULL);
3230 288 : }
3231 : }
3232 : }
3233 296 : return bRet;
3234 : }
3235 :
3236 306 : bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
3237 : const OUString& aClass, bool bRaiseErrors, bool bDefault )
3238 : {
3239 306 : bool bOk = bDefault;
3240 :
3241 306 : SbxDataType t = refVal->GetType();
3242 306 : SbxVariable* pVal = (SbxVariable*)refVal;
3243 : // we don't know the type of uno properties that are (maybevoid)
3244 306 : if ( t == SbxEMPTY && refVal->ISA(SbUnoProperty) )
3245 : {
3246 0 : SbUnoProperty* pProp = static_cast<SbUnoProperty*>(pVal);
3247 0 : t = pProp->getRealType();
3248 : }
3249 306 : if( t == SbxOBJECT )
3250 : {
3251 : SbxObject* pObj;
3252 298 : if( pVal->IsA( TYPE(SbxObject) ) )
3253 0 : pObj = static_cast<SbxObject*>( pVal );
3254 : else
3255 : {
3256 298 : pObj = static_cast<SbxObject*>( refVal->GetObject() );
3257 298 : if( pObj && !pObj->IsA( TYPE(SbxObject) ) )
3258 0 : pObj = NULL;
3259 : }
3260 298 : if( pObj )
3261 : {
3262 296 : if( !implIsClass( pObj, aClass ) )
3263 : {
3264 288 : if ( ( bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration() ) && pObj->IsA( TYPE(SbUnoObject) ) )
3265 : {
3266 288 : SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
3267 288 : bOk = checkUnoObjectType( pUnoObj, aClass );
3268 : }
3269 : else
3270 0 : bOk = false;
3271 288 : if ( !bOk )
3272 : {
3273 0 : if( bRaiseErrors )
3274 0 : Error( SbERR_INVALID_USAGE_OBJECT );
3275 : }
3276 : }
3277 : else
3278 : {
3279 8 : bOk = true;
3280 :
3281 8 : SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pObj);
3282 8 : if( pClassModuleObject != NULL )
3283 0 : pClassModuleObject->triggerInitializeEvent();
3284 : }
3285 : }
3286 : }
3287 : else
3288 : {
3289 8 : if ( !bVBAEnabled )
3290 : {
3291 0 : if( bRaiseErrors )
3292 0 : Error( SbERR_NEEDS_OBJECT );
3293 0 : bOk = false;
3294 : }
3295 : }
3296 306 : return bOk;
3297 : }
3298 :
3299 306 : void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
3300 : {
3301 306 : SbxVariableRef refVal = PopVar();
3302 612 : SbxVariableRef refVar = PopVar();
3303 612 : OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3304 :
3305 306 : bool bOk = checkClass_Impl( refVal, aClass, true );
3306 306 : if( bOk )
3307 : {
3308 306 : StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set
3309 306 : }
3310 306 : }
3311 :
3312 290 : void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
3313 : {
3314 290 : StepSETCLASS_impl( nOp1, false );
3315 290 : }
3316 :
3317 16 : void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
3318 : {
3319 16 : StepSETCLASS_impl( nOp1, true );
3320 16 : }
3321 :
3322 0 : void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
3323 : {
3324 0 : SbxVariableRef xObjVal = PopVar();
3325 0 : OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
3326 0 : bool bDefault = !bVBAEnabled;
3327 0 : bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
3328 :
3329 0 : SbxVariable* pRet = new SbxVariable;
3330 0 : pRet->PutBool( bOk );
3331 0 : PushVar( pRet );
3332 0 : }
3333 :
3334 : // define library for following declare-call
3335 :
3336 10 : void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
3337 : {
3338 10 : aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
3339 10 : }
3340 :
3341 : // TOS is incremented by BASE, BASE is pushed before (+BASE)
3342 : // This opcode is pushed before DIM/REDIM-commands,
3343 : // if there's been only one index named.
3344 :
3345 76 : void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
3346 : {
3347 76 : SbxVariable* p1 = new SbxVariable;
3348 76 : SbxVariableRef x2 = PopVar();
3349 :
3350 : // #109275 Check compatiblity mode
3351 76 : bool bCompatible = ((nOp1 & 0x8000) != 0);
3352 76 : sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
3353 76 : p1->PutInteger( uBase );
3354 76 : if( !bCompatible )
3355 62 : x2->Compute( SbxPLUS, *p1 );
3356 76 : PushVar( x2 ); // first the Expr
3357 76 : PushVar( p1 ); // then the Base
3358 76 : }
3359 :
3360 : // the bits in the String-ID:
3361 : // 0x8000 - Argv is reserved
3362 :
3363 32470 : SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
3364 : SbError nNotFound, bool bLocal, bool bStatic )
3365 : {
3366 32470 : bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
3367 32470 : if( bIsVBAInterOp )
3368 : {
3369 23742 : StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
3370 23742 : if( pMSOMacroRuntimeLib != NULL )
3371 : {
3372 0 : pMSOMacroRuntimeLib->ResetFlag( SBX_EXTSEARCH );
3373 : }
3374 : }
3375 :
3376 32470 : SbxVariable* pElem = NULL;
3377 32470 : if( !pObj )
3378 : {
3379 0 : Error( SbERR_NO_OBJECT );
3380 0 : pElem = new SbxVariable;
3381 : }
3382 : else
3383 : {
3384 32470 : bool bFatalError = false;
3385 32470 : SbxDataType t = (SbxDataType) nOp2;
3386 32470 : OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
3387 : // Hacky capture of Evaluate [] syntax
3388 : // this should be tackled I feel at the pcode level
3389 32470 : if ( bIsVBAInterOp && aName.startsWith("[") )
3390 : {
3391 : // emulate pcode here
3392 0 : StepARGC();
3393 : // psuedo StepLOADSC
3394 0 : OUString sArg = aName.copy( 1, aName.getLength() - 2 );
3395 0 : SbxVariable* p = new SbxVariable;
3396 0 : p->PutString( sArg );
3397 0 : PushVar( p );
3398 0 : StepARGV();
3399 0 : nOp1 = nOp1 | 0x8000; // indicate params are present
3400 0 : aName = "Evaluate";
3401 : }
3402 32470 : if( bLocal )
3403 : {
3404 23982 : if ( bStatic )
3405 : {
3406 0 : if ( pMeth )
3407 : {
3408 0 : pElem = pMeth->GetStatics()->Find( aName, SbxCLASS_DONTCARE );
3409 : }
3410 : }
3411 :
3412 23982 : if ( !pElem )
3413 : {
3414 23982 : pElem = refLocals->Find( aName, SbxCLASS_DONTCARE );
3415 : }
3416 : }
3417 32470 : if( !pElem )
3418 : {
3419 20080 : bool bSave = rBasic.bNoRtl;
3420 20080 : rBasic.bNoRtl = true;
3421 20080 : pElem = pObj->Find( aName, SbxCLASS_DONTCARE );
3422 :
3423 : // #110004, #112015: Make private really private
3424 20080 : if( bLocal && pElem ) // Local as flag for global search
3425 : {
3426 10762 : if( pElem->IsSet( SBX_PRIVATE ) )
3427 : {
3428 3362 : SbiInstance* pInst_ = GetSbData()->pInst;
3429 3362 : if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
3430 : {
3431 0 : pElem = NULL; // Found but in wrong module!
3432 : }
3433 : // Interfaces: Use SBX_EXTFOUND
3434 : }
3435 : }
3436 20080 : rBasic.bNoRtl = bSave;
3437 :
3438 : // is it a global uno-identifier?
3439 20080 : if( bLocal && !pElem )
3440 : {
3441 830 : bool bSetName = true; // preserve normal behaviour
3442 :
3443 : // i#i68894# if VBAInterOp favour searching vba globals
3444 : // over searching for uno classess
3445 830 : if ( bVBAEnabled )
3446 : {
3447 : // Try Find in VBA symbols space
3448 754 : pElem = rBasic.VBAFind( aName, SbxCLASS_DONTCARE );
3449 754 : if ( pElem )
3450 : {
3451 460 : bSetName = false; // don't overwrite uno name
3452 : }
3453 : else
3454 : {
3455 294 : pElem = VBAConstantHelper::instance().getVBAConstant( aName );
3456 : }
3457 : }
3458 :
3459 830 : if( !pElem )
3460 : {
3461 : // #72382 ATTENTION! ALWAYS returns a result now
3462 : // because of unknown modules!
3463 212 : SbUnoClass* pUnoClass = findUnoClass( aName );
3464 212 : if( pUnoClass )
3465 : {
3466 4 : pElem = new SbxVariable( t );
3467 4 : SbxValues aRes( SbxOBJECT );
3468 4 : aRes.pObj = pUnoClass;
3469 4 : pElem->SbxVariable::Put( aRes );
3470 : }
3471 : }
3472 :
3473 : // #62939 If an uno-class has been found, the wrapper
3474 : // object has to be held, because the uno-class, e. g.
3475 : // "stardiv", has to be read out of the registry
3476 : // every time again otherwise
3477 830 : if( pElem )
3478 : {
3479 : // #63774 May not be saved too!!!
3480 622 : pElem->SetFlag( SBX_DONTSTORE );
3481 622 : pElem->SetFlag( SBX_NO_MODIFY);
3482 :
3483 : // #72382 save locally, all variables that have been declared
3484 : // implicit would become global automatically otherwise!
3485 622 : if ( bSetName )
3486 : {
3487 162 : pElem->SetName( aName );
3488 : }
3489 622 : refLocals->Put( pElem, refLocals->Count() );
3490 : }
3491 : }
3492 :
3493 20080 : if( !pElem )
3494 : {
3495 : // not there and not in the object?
3496 : // don't establish if that thing has parameters!
3497 208 : if( nOp1 & 0x8000 )
3498 : {
3499 0 : bFatalError = true;
3500 : }
3501 :
3502 : // else, if there are parameters, use different error code
3503 208 : if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) )
3504 : {
3505 : // #39108 if explicit and as ELEM always a fatal error
3506 0 : bFatalError = true;
3507 :
3508 :
3509 0 : if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED )
3510 : {
3511 0 : nNotFound = SbERR_VAR_UNDEFINED;
3512 : }
3513 : }
3514 208 : if( bFatalError )
3515 : {
3516 : // #39108 use dummy variable instead of fatal error
3517 0 : if( !xDummyVar.Is() )
3518 : {
3519 0 : xDummyVar = new SbxVariable( SbxVARIANT );
3520 : }
3521 0 : pElem = xDummyVar;
3522 :
3523 0 : ClearArgvStack();
3524 :
3525 0 : Error( nNotFound, aName );
3526 : }
3527 : else
3528 : {
3529 208 : if ( bStatic )
3530 : {
3531 0 : pElem = StepSTATIC_Impl( aName, t );
3532 : }
3533 208 : if ( !pElem )
3534 : {
3535 208 : pElem = new SbxVariable( t );
3536 208 : if( t != SbxVARIANT )
3537 : {
3538 4 : pElem->SetFlag( SBX_FIXED );
3539 : }
3540 208 : pElem->SetName( aName );
3541 208 : refLocals->Put( pElem, refLocals->Count() );
3542 : }
3543 : }
3544 : }
3545 : }
3546 : // #39108 Args can already be deleted!
3547 32470 : if( !bFatalError )
3548 : {
3549 32470 : SetupArgs( pElem, nOp1 );
3550 : }
3551 : // because a particular call-type is requested
3552 32470 : if( pElem->IsA( TYPE(SbxMethod) ) )
3553 : {
3554 : // shall the type be converted?
3555 7830 : SbxDataType t2 = pElem->GetType();
3556 7830 : bool bSet = false;
3557 7830 : if( (pElem->GetFlags() & SBX_FIXED) == SBX_NONE )
3558 : {
3559 4062 : if( t != SbxVARIANT && t != t2 &&
3560 960 : t >= SbxINTEGER && t <= SbxSTRING )
3561 : {
3562 0 : pElem->SetType( t ), bSet = true;
3563 : }
3564 : }
3565 : // assign pElem to a Ref, to delete a temp-var if applicable
3566 7830 : SbxVariableRef refTemp = pElem;
3567 :
3568 : // remove potential rests of the last call of the SbxMethod
3569 : // free Write before, so that there's no error
3570 7830 : SbxFlagBits nSavFlags = pElem->GetFlags();
3571 7830 : pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST );
3572 7830 : pElem->SbxValue::Clear();
3573 7830 : pElem->SetFlags( nSavFlags );
3574 :
3575 : // don't touch before setting, as e. g. LEFT()
3576 : // has to know the difference between Left$() and Left()
3577 :
3578 : // because the methods' parameters are cut away in PopVar()
3579 7830 : SbxVariable* pNew = new SbxMethod( *(static_cast<SbxMethod*>(pElem)) );
3580 : //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3581 :
3582 7830 : pElem->SetParameters(0);
3583 7830 : pNew->SetFlag( SBX_READWRITE );
3584 :
3585 7830 : if( bSet )
3586 : {
3587 0 : pElem->SetType( t2 );
3588 : }
3589 7830 : pElem = pNew;
3590 : }
3591 : // consider index-access for UnoObjects
3592 : // definitely we want this for VBA where properties are often
3593 : // collections ( which need index access ), but lets only do
3594 : // this if we actually have params following
3595 24640 : else if( bVBAEnabled && pElem->ISA(SbUnoProperty) && pElem->GetParameters() )
3596 : {
3597 0 : SbxVariableRef refTemp = pElem;
3598 :
3599 : // dissolve the notify while copying variable
3600 0 : SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) );
3601 0 : pElem->SetParameters( NULL );
3602 0 : pElem = pNew;
3603 32470 : }
3604 : }
3605 32470 : return CheckArray( pElem );
3606 : }
3607 :
3608 : // for current scope (e. g. query from BASIC-IDE)
3609 0 : SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
3610 : {
3611 : // don't expect pMeth to be != 0, as there are none set
3612 : // in the RunInit yet
3613 :
3614 0 : SbxVariable* pElem = NULL;
3615 0 : if( !pMod || rName.isEmpty() )
3616 : {
3617 0 : return NULL;
3618 : }
3619 0 : if( refLocals )
3620 : {
3621 0 : pElem = refLocals->Find( rName, SbxCLASS_DONTCARE );
3622 : }
3623 0 : if ( !pElem && pMeth )
3624 : {
3625 : // for statics, set the method's name in front
3626 0 : OUString aMethName = pMeth->GetName();
3627 0 : aMethName += ":";
3628 0 : aMethName += rName;
3629 0 : pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE);
3630 : }
3631 :
3632 : // search in parameter list
3633 0 : if( !pElem && pMeth )
3634 : {
3635 0 : SbxInfo* pInfo = pMeth->GetInfo();
3636 0 : if( pInfo && refParams )
3637 : {
3638 0 : sal_uInt16 nParamCount = refParams->Count();
3639 0 : sal_uInt16 j = 1;
3640 0 : const SbxParamInfo* pParam = pInfo->GetParam( j );
3641 0 : while( pParam )
3642 : {
3643 0 : if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
3644 : {
3645 0 : if( j >= nParamCount )
3646 : {
3647 : // Parameter is missing
3648 0 : pElem = new SbxVariable( SbxSTRING );
3649 0 : pElem->PutString( OUString("<missing parameter>"));
3650 : }
3651 : else
3652 : {
3653 0 : pElem = refParams->Get( j );
3654 : }
3655 0 : break;
3656 : }
3657 0 : pParam = pInfo->GetParam( ++j );
3658 : }
3659 : }
3660 : }
3661 :
3662 : // search in module
3663 0 : if( !pElem )
3664 : {
3665 0 : bool bSave = rBasic.bNoRtl;
3666 0 : rBasic.bNoRtl = true;
3667 0 : pElem = pMod->Find( rName, SbxCLASS_DONTCARE );
3668 0 : rBasic.bNoRtl = bSave;
3669 : }
3670 0 : return pElem;
3671 : }
3672 :
3673 :
3674 :
3675 38058 : void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
3676 : {
3677 38058 : if( nOp1 & 0x8000 )
3678 : {
3679 7328 : if( !refArgv )
3680 : {
3681 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
3682 : }
3683 7328 : bool bHasNamed = false;
3684 : sal_uInt16 i;
3685 7328 : sal_uInt16 nArgCount = refArgv->Count();
3686 18532 : for( i = 1 ; i < nArgCount ; i++ )
3687 : {
3688 11354 : if( !refArgv->GetAlias(i).isEmpty() )
3689 : {
3690 150 : bHasNamed = true; break;
3691 : }
3692 : }
3693 7328 : if( bHasNamed )
3694 : {
3695 150 : SbxInfo* pInfo = p->GetInfo();
3696 150 : if( !pInfo )
3697 : {
3698 0 : bool bError_ = true;
3699 :
3700 0 : SbUnoMethod* pUnoMethod = PTR_CAST(SbUnoMethod,p);
3701 0 : SbUnoProperty* pUnoProperty = PTR_CAST(SbUnoProperty,p);
3702 0 : if( pUnoMethod || pUnoProperty )
3703 : {
3704 0 : SbUnoObject* pParentUnoObj = PTR_CAST( SbUnoObject,p->GetParent() );
3705 0 : if( pParentUnoObj )
3706 : {
3707 0 : Any aUnoAny = pParentUnoObj->getUnoAny();
3708 0 : Reference< XInvocation > xInvocation;
3709 0 : aUnoAny >>= xInvocation;
3710 0 : if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() )
3711 : {
3712 0 : bError_ = false;
3713 :
3714 0 : sal_uInt16 nCurPar = 1;
3715 : AutomationNamedArgsSbxArray* pArg =
3716 0 : new AutomationNamedArgsSbxArray( nArgCount );
3717 0 : OUString* pNames = pArg->getNames().getArray();
3718 0 : for( i = 1 ; i < nArgCount ; i++ )
3719 : {
3720 0 : SbxVariable* pVar = refArgv->Get( i );
3721 0 : OUString aName = refArgv->GetAlias(i);
3722 0 : if (!aName.isEmpty())
3723 : {
3724 0 : pNames[i] = aName;
3725 : }
3726 0 : pArg->Put( pVar, nCurPar++ );
3727 0 : }
3728 0 : refArgv = pArg;
3729 0 : }
3730 0 : }
3731 : }
3732 0 : else if( bVBAEnabled && p->GetType() == SbxOBJECT && (!p->ISA(SbxMethod) || !p->IsBroadcaster()) )
3733 : {
3734 : // Check for default method with named parameters
3735 0 : SbxBaseRef pObj = (SbxBase*)p->GetObject();
3736 0 : if( pObj && pObj->ISA(SbUnoObject) )
3737 : {
3738 0 : SbUnoObject* pUnoObj = static_cast<SbUnoObject*>((SbxBase*)pObj);
3739 0 : Any aAny = pUnoObj->getUnoAny();
3740 :
3741 0 : if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3742 : {
3743 0 : Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
3744 0 : Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
3745 :
3746 0 : OUString sDefaultMethod;
3747 0 : if ( xDfltMethod.is() )
3748 : {
3749 0 : sDefaultMethod = xDfltMethod->getDefaultMethodName();
3750 : }
3751 0 : if ( !sDefaultMethod.isEmpty() )
3752 : {
3753 0 : SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD );
3754 0 : if( meth != NULL )
3755 : {
3756 0 : pInfo = meth->GetInfo();
3757 : }
3758 0 : if( pInfo )
3759 : {
3760 0 : bError_ = false;
3761 : }
3762 0 : }
3763 0 : }
3764 0 : }
3765 : }
3766 0 : if( bError_ )
3767 : {
3768 0 : Error( SbERR_NO_NAMED_ARGS );
3769 : }
3770 : }
3771 : else
3772 : {
3773 150 : sal_uInt16 nCurPar = 1;
3774 150 : SbxArray* pArg = new SbxArray;
3775 414 : for( i = 1 ; i < nArgCount ; i++ )
3776 : {
3777 264 : SbxVariable* pVar = refArgv->Get( i );
3778 264 : OUString aName = refArgv->GetAlias(i);
3779 264 : if (!aName.isEmpty())
3780 : {
3781 : // nCurPar is set to the found parameter
3782 258 : sal_uInt16 j = 1;
3783 258 : const SbxParamInfo* pParam = pInfo->GetParam( j );
3784 918 : while( pParam )
3785 : {
3786 660 : if( pParam->aName.equalsIgnoreAsciiCase( aName ) )
3787 : {
3788 258 : nCurPar = j;
3789 258 : break;
3790 : }
3791 402 : pParam = pInfo->GetParam( ++j );
3792 : }
3793 258 : if( !pParam )
3794 : {
3795 0 : Error( SbERR_NAMED_NOT_FOUND ); break;
3796 : }
3797 : }
3798 264 : pArg->Put( pVar, nCurPar++ );
3799 264 : }
3800 150 : refArgv = pArg;
3801 : }
3802 : }
3803 : // own var as parameter 0
3804 7328 : refArgv->Put( p, 0 );
3805 7328 : p->SetParameters( refArgv );
3806 7328 : PopArgv();
3807 : }
3808 : else
3809 : {
3810 30730 : p->SetParameters( NULL );
3811 : }
3812 38058 : }
3813 :
3814 : // getting an array element
3815 :
3816 38058 : SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
3817 : {
3818 : SbxArray* pPar;
3819 38058 : if( ( pElem->GetType() & SbxARRAY ) && (SbxVariable*)refRedim != pElem )
3820 : {
3821 1822 : SbxBase* pElemObj = pElem->GetObject();
3822 1822 : SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
3823 1822 : pPar = pElem->GetParameters();
3824 1822 : if( pDimArray )
3825 : {
3826 : // parameters may be missing, if an array is
3827 : // passed as an argument
3828 1822 : if( pPar )
3829 1370 : pElem = pDimArray->Get( pPar );
3830 : }
3831 : else
3832 : {
3833 0 : SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
3834 0 : if( pArray )
3835 : {
3836 0 : if( !pPar )
3837 : {
3838 0 : Error( SbERR_OUT_OF_RANGE );
3839 0 : pElem = new SbxVariable;
3840 : }
3841 : else
3842 : {
3843 0 : pElem = pArray->Get( pPar->Get( 1 )->GetInteger() );
3844 : }
3845 : }
3846 : }
3847 :
3848 : // #42940, set parameter 0 to NULL so that var doesn't contain itself
3849 1822 : if( pPar )
3850 : {
3851 1370 : pPar->Put( NULL, 0 );
3852 : }
3853 : }
3854 : // consider index-access for UnoObjects
3855 36236 : else if( pElem->GetType() == SbxOBJECT && !pElem->ISA(SbxMethod) && ( !bVBAEnabled || ( bVBAEnabled && !pElem->ISA(SbxProperty) ) ) )
3856 : {
3857 2678 : pPar = pElem->GetParameters();
3858 2678 : if ( pPar )
3859 : {
3860 : // is it an uno-object?
3861 52 : SbxBaseRef pObj = (SbxBase*)pElem->GetObject();
3862 52 : if( pObj )
3863 : {
3864 8 : if( pObj->ISA(SbUnoObject) )
3865 : {
3866 8 : SbUnoObject* pUnoObj = static_cast<SbUnoObject*>((SbxBase*)pObj);
3867 8 : Any aAny = pUnoObj->getUnoAny();
3868 :
3869 8 : if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3870 : {
3871 8 : Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
3872 16 : Reference< XIndexAccess > xIndexAccess( x, UNO_QUERY );
3873 8 : if ( !bVBAEnabled )
3874 : {
3875 4 : if( xIndexAccess.is() )
3876 : {
3877 4 : sal_uInt32 nParamCount = (sal_uInt32)pPar->Count() - 1;
3878 4 : if( nParamCount != 1 )
3879 : {
3880 0 : StarBASIC::Error( SbERR_BAD_ARGUMENT );
3881 0 : return pElem;
3882 : }
3883 :
3884 : // get index
3885 4 : sal_Int32 nIndex = pPar->Get( 1 )->GetLong();
3886 4 : Reference< XInterface > xRet;
3887 : try
3888 : {
3889 4 : Any aAny2 = xIndexAccess->getByIndex( nIndex );
3890 4 : TypeClass eType = aAny2.getValueType().getTypeClass();
3891 4 : if( eType == TypeClass_INTERFACE )
3892 : {
3893 4 : xRet = *(Reference< XInterface >*)aAny2.getValue();
3894 4 : }
3895 : }
3896 0 : catch (const IndexOutOfBoundsException&)
3897 : {
3898 : // usually expect converting problem
3899 0 : StarBASIC::Error( SbERR_OUT_OF_RANGE );
3900 : }
3901 :
3902 : // #57847 always create a new variable, else error
3903 : // due to PutObject(NULL) at ReadOnly-properties
3904 4 : pElem = new SbxVariable( SbxVARIANT );
3905 4 : if( xRet.is() )
3906 : {
3907 4 : aAny <<= xRet;
3908 :
3909 : // #67173 don't specify a name so that the real class name is entered
3910 4 : OUString aName;
3911 8 : SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny );
3912 8 : pElem->PutObject( xWrapper );
3913 : }
3914 : else
3915 : {
3916 0 : pElem->PutObject( NULL );
3917 4 : }
3918 : }
3919 : }
3920 : else
3921 : {
3922 : // check if there isn't a default member between the current variable
3923 : // and the params, e.g.
3924 : // Dim rst1 As New ADODB.Recordset
3925 : // "
3926 : // val = rst1("FirstName")
3927 : // has the default 'Fields' member between rst1 and '("FirstName")'
3928 4 : SbxVariable* pDflt = getDefaultProp( pElem );
3929 4 : if ( pDflt )
3930 : {
3931 0 : pDflt->Broadcast( SBX_HINT_DATAWANTED );
3932 0 : SbxBaseRef pDfltObj = (SbxBase*)pDflt->GetObject();
3933 0 : if( pDfltObj )
3934 : {
3935 0 : if( pDfltObj->ISA(SbUnoObject) )
3936 : {
3937 0 : pUnoObj = static_cast<SbUnoObject*>((SbxBase*)pDfltObj);
3938 0 : Any aUnoAny = pUnoObj->getUnoAny();
3939 :
3940 0 : if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
3941 0 : x = *(Reference< XInterface >*)aUnoAny.getValue();
3942 0 : pElem = pDflt;
3943 : }
3944 0 : }
3945 : }
3946 4 : OUString sDefaultMethod;
3947 :
3948 8 : Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
3949 :
3950 4 : if ( xDfltMethod.is() )
3951 : {
3952 4 : sDefaultMethod = xDfltMethod->getDefaultMethodName();
3953 : }
3954 0 : else if( xIndexAccess.is() )
3955 : {
3956 0 : sDefaultMethod = "getByIndex";
3957 : }
3958 4 : if ( !sDefaultMethod.isEmpty() )
3959 : {
3960 4 : SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD );
3961 4 : SbxVariableRef refTemp = meth;
3962 4 : if ( refTemp )
3963 : {
3964 4 : meth->SetParameters( pPar );
3965 4 : SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) );
3966 4 : pElem = pNew;
3967 4 : }
3968 4 : }
3969 8 : }
3970 : }
3971 :
3972 : // #42940, set parameter 0 to NULL so that var doesn't contain itself
3973 8 : pPar->Put( NULL, 0 );
3974 : }
3975 0 : else if( pObj->ISA(BasicCollection) )
3976 : {
3977 0 : BasicCollection* pCol = static_cast<BasicCollection*>((SbxBase*)pObj);
3978 0 : pElem = new SbxVariable( SbxVARIANT );
3979 0 : pPar->Put( pElem, 0 );
3980 0 : pCol->CollItem( pPar );
3981 : }
3982 : }
3983 44 : else if( bVBAEnabled ) // !pObj
3984 : {
3985 4 : SbxArray* pParam = pElem->GetParameters();
3986 4 : if( pParam != NULL && !pElem->IsSet( SBX_VAR_TO_DIM ) )
3987 : {
3988 0 : Error( SbERR_NO_OBJECT );
3989 : }
3990 52 : }
3991 : }
3992 : }
3993 :
3994 38058 : return pElem;
3995 : }
3996 :
3997 : // loading an element from the runtime-library (+StringID+type)
3998 :
3999 3130 : void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4000 : {
4001 3130 : PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, false ) );
4002 3130 : }
4003 :
4004 23982 : void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
4005 : SbError nNotFound, bool bLocal, bool bStatic )
4006 : {
4007 23982 : if( !refLocals )
4008 : {
4009 1638 : refLocals = new SbxArray;
4010 : }
4011 23982 : PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, bLocal, bStatic ) );
4012 23982 : }
4013 : // loading a local/global variable (+StringID+type)
4014 :
4015 23982 : void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4016 : {
4017 23982 : StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, true );
4018 23982 : }
4019 :
4020 : // Search inside a class module (CM) to enable global search in time
4021 0 : void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4022 : {
4023 :
4024 0 : SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pMod);
4025 0 : if( pClassModuleObject )
4026 : {
4027 0 : pMod->SetFlag( SBX_GBLSEARCH );
4028 : }
4029 0 : StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, true );
4030 :
4031 0 : if( pClassModuleObject )
4032 : {
4033 0 : pMod->ResetFlag( SBX_GBLSEARCH );
4034 : }
4035 0 : }
4036 :
4037 0 : void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4038 : {
4039 0 : StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, true, true );
4040 0 : }
4041 :
4042 : // loading an object-element (+StringID+type)
4043 : // the object lies on TOS
4044 :
4045 5358 : void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4046 : {
4047 5358 : SbxVariableRef pObjVar = PopVar();
4048 :
4049 5358 : SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar);
4050 5358 : if( !pObj )
4051 : {
4052 5062 : SbxBase* pObjVarObj = pObjVar->GetObject();
4053 5062 : pObj = PTR_CAST(SbxObject,pObjVarObj);
4054 : }
4055 :
4056 : // #56368 save reference at StepElem, otherwise objects could
4057 : // lose their reference too early in qualification chains like
4058 : // ActiveComponent.Selection(0).Text
4059 : // #74254 now per list
4060 5358 : if( pObj )
4061 : {
4062 5358 : SaveRef( (SbxVariable*)pObj );
4063 : }
4064 5358 : PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, false ) );
4065 5358 : }
4066 :
4067 : // loading a parameter (+offset+type)
4068 : // If the data type is wrong, create a copy.
4069 : // The data type SbxEMPTY shows that no parameters are given.
4070 : // Get( 0 ) may be EMPTY
4071 :
4072 5588 : void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4073 : {
4074 5588 : sal_uInt16 i = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
4075 5588 : SbxDataType t = (SbxDataType) nOp2;
4076 : SbxVariable* p;
4077 :
4078 : // #57915 solve missing in a cleaner way
4079 5588 : sal_uInt16 nParamCount = refParams->Count();
4080 5588 : if( i >= nParamCount )
4081 : {
4082 32 : sal_Int16 iLoop = i;
4083 96 : while( iLoop >= nParamCount )
4084 : {
4085 32 : p = new SbxVariable();
4086 :
4087 34 : if( SbiRuntime::isVBAEnabled() &&
4088 32 : (t == SbxOBJECT || t == SbxSTRING) )
4089 : {
4090 2 : if( t == SbxOBJECT )
4091 : {
4092 0 : p->PutObject( NULL );
4093 : }
4094 : else
4095 : {
4096 2 : p->PutString( OUString() );
4097 : }
4098 : }
4099 : else
4100 : {
4101 30 : p->PutErr( 448 ); // like in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND)
4102 : }
4103 32 : refParams->Put( p, iLoop );
4104 32 : iLoop--;
4105 : }
4106 : }
4107 5588 : p = refParams->Get( i );
4108 :
4109 5588 : if( p->GetType() == SbxERROR && ( i ) )
4110 : {
4111 : // if there's a parameter missing, it can be OPTIONAL
4112 60 : bool bOpt = false;
4113 60 : if( pMeth )
4114 : {
4115 60 : SbxInfo* pInfo = pMeth->GetInfo();
4116 60 : if ( pInfo )
4117 : {
4118 60 : const SbxParamInfo* pParam = pInfo->GetParam( i );
4119 60 : if( pParam && ( (pParam->nFlags & SBX_OPTIONAL) != SBX_NONE ) )
4120 : {
4121 : // Default value?
4122 60 : sal_uInt16 nDefaultId = (sal_uInt16)(pParam->nUserData & 0x0ffff);
4123 60 : if( nDefaultId > 0 )
4124 : {
4125 0 : OUString aDefaultStr = pImg->GetString( nDefaultId );
4126 0 : p = new SbxVariable();
4127 0 : p->PutString( aDefaultStr );
4128 0 : refParams->Put( p, i );
4129 : }
4130 60 : bOpt = true;
4131 : }
4132 : }
4133 : }
4134 60 : if( !bOpt )
4135 : {
4136 0 : Error( SbERR_NOT_OPTIONAL );
4137 : }
4138 : }
4139 5528 : else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t )
4140 : {
4141 12 : SbxVariable* q = new SbxVariable( t );
4142 12 : SaveRef( q );
4143 12 : *q = *p;
4144 12 : p = q;
4145 12 : if ( i )
4146 : {
4147 0 : refParams->Put( p, i );
4148 : }
4149 : }
4150 5588 : SetupArgs( p, nOp1 );
4151 5588 : PushVar( CheckArray( p ) );
4152 5588 : }
4153 :
4154 : // Case-Test (+True-Target+Test-Opcode)
4155 :
4156 1310 : void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4157 : {
4158 1310 : if( !refCaseStk || !refCaseStk->Count() )
4159 : {
4160 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
4161 : }
4162 : else
4163 : {
4164 1310 : SbxVariableRef xComp = PopVar();
4165 2620 : SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
4166 1310 : if( xCase->Compare( (SbxOperator) nOp2, *xComp ) )
4167 : {
4168 172 : StepJUMP( nOp1 );
4169 1310 : }
4170 : }
4171 1310 : }
4172 :
4173 : // call of a DLL-procedure (+StringID+type)
4174 : // the StringID's MSB shows that Argv is occupied
4175 :
4176 10 : void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4177 : {
4178 10 : OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4179 10 : SbxArray* pArgs = NULL;
4180 10 : if( nOp1 & 0x8000 )
4181 : {
4182 10 : pArgs = refArgv;
4183 : }
4184 10 : DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, false );
4185 10 : aLibName = "";
4186 10 : if( nOp1 & 0x8000 )
4187 : {
4188 10 : PopArgv();
4189 10 : }
4190 10 : }
4191 :
4192 : // call of a DLL-procedure after CDecl (+StringID+type)
4193 :
4194 0 : void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4195 : {
4196 0 : OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
4197 0 : SbxArray* pArgs = NULL;
4198 0 : if( nOp1 & 0x8000 )
4199 : {
4200 0 : pArgs = refArgv;
4201 : }
4202 0 : DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, true );
4203 0 : aLibName = "";
4204 0 : if( nOp1 & 0x8000 )
4205 : {
4206 0 : PopArgv();
4207 0 : }
4208 0 : }
4209 :
4210 :
4211 : // beginning of a statement (+Line+Col)
4212 :
4213 23610 : void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4214 : {
4215 : // If the Expr-Stack at the beginning of a statement constains a variable,
4216 : // some fool has called X as a function, although it's a variable!
4217 23610 : bool bFatalExpr = false;
4218 23610 : OUString sUnknownMethodName;
4219 23610 : if( nExprLvl > 1 )
4220 : {
4221 0 : bFatalExpr = true;
4222 : }
4223 23610 : else if( nExprLvl )
4224 : {
4225 2084 : SbxVariable* p = refExprStk->Get( 0 );
4226 4168 : if( p->GetRefCount() > 1 &&
4227 2084 : refLocals.Is() && refLocals->Find( p->GetName(), p->GetClass() ) )
4228 : {
4229 0 : sUnknownMethodName = p->GetName();
4230 0 : bFatalExpr = true;
4231 : }
4232 : }
4233 :
4234 23610 : ClearExprStack();
4235 :
4236 23610 : ClearRefs();
4237 :
4238 : // We have to cancel hard here because line and column
4239 : // would be wrong later otherwise!
4240 23610 : if( bFatalExpr)
4241 : {
4242 0 : StarBASIC::FatalError( SbERR_NO_METHOD, sUnknownMethodName );
4243 23610 : return;
4244 : }
4245 23610 : pStmnt = pCode - 9;
4246 23610 : sal_uInt16 nOld = nLine;
4247 23610 : nLine = static_cast<short>( nOp1 );
4248 :
4249 : // #29955 & 0xFF, to filter out for-loop-level
4250 23610 : nCol1 = static_cast<short>( nOp2 & 0xFF );
4251 :
4252 : // find the next STMNT-command to set the final column
4253 : // of this statement
4254 :
4255 23610 : nCol2 = 0xffff;
4256 : sal_uInt16 n1, n2;
4257 23610 : const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
4258 23610 : if( p )
4259 : {
4260 22344 : if( n1 == nOp1 )
4261 : {
4262 : // #29955 & 0xFF, to filter out for-loop-level
4263 316 : nCol2 = (n2 & 0xFF) - 1;
4264 : }
4265 : }
4266 :
4267 : // #29955 correct for-loop-level, #67452 NOT in the error-handler
4268 23610 : if( !bInError )
4269 : {
4270 : // (there's a difference here in case of a jump out of a loop)
4271 23518 : sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
4272 23518 : if( pGosubStk )
4273 : {
4274 0 : nExspectedForLevel = nExspectedForLevel + pGosubStk->nStartForLvl;
4275 : }
4276 :
4277 : // if the actual for-level is too small it'd jump out
4278 : // of a loop -> corrected
4279 47036 : while( nForLvl > nExspectedForLevel )
4280 : {
4281 0 : PopFor();
4282 : }
4283 : }
4284 :
4285 : // 16.10.96: #31460 new concept for StepInto/Over/Out
4286 : // see explanation at _ImplGetBreakCallLevel
4287 23610 : if( pInst->nCallLvl <= pInst->nBreakCallLvl )
4288 : {
4289 0 : StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
4290 0 : sal_uInt16 nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
4291 :
4292 0 : pInst->CalcBreakCallLevel( nNewFlags );
4293 : }
4294 :
4295 : // break points only at STMNT-commands in a new line!
4296 47220 : else if( ( nOp1 != nOld )
4297 23404 : && ( nFlags & SbDEBUG_BREAK )
4298 23610 : && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
4299 : {
4300 0 : StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
4301 0 : sal_uInt16 nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
4302 :
4303 0 : pInst->CalcBreakCallLevel( nNewFlags );
4304 23610 : }
4305 : }
4306 :
4307 : // (+SvStreamFlags+Flags)
4308 : // Stack: block length
4309 : // channel number
4310 : // file name
4311 :
4312 24 : void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4313 : {
4314 24 : SbxVariableRef pName = PopVar();
4315 48 : SbxVariableRef pChan = PopVar();
4316 48 : SbxVariableRef pLen = PopVar();
4317 24 : short nBlkLen = pLen->GetInteger();
4318 24 : short nChan = pChan->GetInteger();
4319 48 : OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
4320 : pIosys->Open( nChan, aName, static_cast<short>( nOp1 ),
4321 24 : static_cast<short>( nOp2 ), nBlkLen );
4322 48 : Error( pIosys->GetError() );
4323 24 : }
4324 :
4325 : // create object (+StringID+StringID)
4326 :
4327 36 : void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4328 : {
4329 36 : OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4330 36 : SbxObject *pObj = SbxBase::CreateObject( aClass );
4331 36 : if( !pObj )
4332 : {
4333 0 : Error( SbERR_INVALID_OBJECT );
4334 : }
4335 : else
4336 : {
4337 36 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4338 36 : pObj->SetName( aName );
4339 : // the object must be able to call the BASIC
4340 36 : pObj->SetParent( &rBasic );
4341 36 : SbxVariable* pNew = new SbxVariable;
4342 36 : pNew->PutObject( pObj );
4343 36 : PushVar( pNew );
4344 36 : }
4345 36 : }
4346 :
4347 12 : void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4348 : {
4349 12 : StepDCREATE_IMPL( nOp1, nOp2 );
4350 12 : }
4351 :
4352 0 : void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4353 : {
4354 0 : StepDCREATE_IMPL( nOp1, nOp2 );
4355 0 : }
4356 :
4357 :
4358 : // Helper function for StepDCREATE_IMPL / bRedimp = true
4359 0 : void implCopyDimArray_DCREATE( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
4360 : short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
4361 : {
4362 0 : sal_Int32& ri = pActualIndices[nActualDim];
4363 0 : for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
4364 : {
4365 0 : if( nActualDim < nMaxDimIndex )
4366 : {
4367 : implCopyDimArray_DCREATE( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
4368 0 : pActualIndices, pLowerBounds, pUpperBounds );
4369 : }
4370 : else
4371 : {
4372 0 : SbxVariable* pSource = pOldArray->Get32( pActualIndices );
4373 0 : pNewArray->Put32( pSource, pActualIndices );
4374 : }
4375 : }
4376 0 : }
4377 :
4378 : // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4379 12 : void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4380 : {
4381 12 : SbxVariableRef refVar = PopVar();
4382 :
4383 12 : DimImpl( refVar );
4384 :
4385 : // fill the array with instances of the requested class
4386 24 : SbxBaseRef xObj = (SbxBase*)refVar->GetObject();
4387 12 : if( !xObj )
4388 : {
4389 0 : StarBASIC::Error( SbERR_INVALID_OBJECT );
4390 12 : return;
4391 : }
4392 :
4393 12 : SbxDimArray* pArray = 0;
4394 12 : if( xObj->ISA(SbxDimArray) )
4395 : {
4396 12 : SbxBase* pObj = (SbxBase*)xObj;
4397 12 : pArray = static_cast<SbxDimArray*>(pObj);
4398 :
4399 12 : short nDims = pArray->GetDims();
4400 12 : sal_Int32 nTotalSize = 0;
4401 :
4402 : // must be a one-dimensional array
4403 : sal_Int32 nLower, nUpper, nSize;
4404 : sal_Int32 i;
4405 24 : for( i = 0 ; i < nDims ; i++ )
4406 : {
4407 12 : pArray->GetDim32( i+1, nLower, nUpper );
4408 12 : nSize = nUpper - nLower + 1;
4409 12 : if( i == 0 )
4410 : {
4411 12 : nTotalSize = nSize;
4412 : }
4413 : else
4414 : {
4415 0 : nTotalSize *= nSize;
4416 : }
4417 : }
4418 :
4419 : // create objects and insert them into the array
4420 12 : OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4421 16 : for( i = 0 ; i < nTotalSize ; i++ )
4422 : {
4423 4 : SbxObject *pClassObj = SbxBase::CreateObject( aClass );
4424 4 : if( !pClassObj )
4425 : {
4426 0 : Error( SbERR_INVALID_OBJECT );
4427 0 : break;
4428 : }
4429 : else
4430 : {
4431 4 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4432 4 : pClassObj->SetName( aName );
4433 : // the object must be able to call the basic
4434 4 : pClassObj->SetParent( &rBasic );
4435 4 : pArray->SbxArray::Put32( pClassObj, i );
4436 : }
4437 12 : }
4438 : }
4439 :
4440 12 : SbxDimArray* pOldArray = static_cast<SbxDimArray*>((SbxArray*)refRedimpArray);
4441 12 : if( pArray && pOldArray )
4442 : {
4443 0 : short nDimsNew = pArray->GetDims();
4444 0 : short nDimsOld = pOldArray->GetDims();
4445 0 : short nDims = nDimsNew;
4446 0 : bool bRangeError = false;
4447 :
4448 : // Store dims to use them for copying later
4449 0 : boost::scoped_array<sal_Int32> pLowerBounds(new sal_Int32[nDims]);
4450 0 : boost::scoped_array<sal_Int32> pUpperBounds(new sal_Int32[nDims]);
4451 0 : boost::scoped_array<sal_Int32> pActualIndices(new sal_Int32[nDims]);
4452 0 : if( nDimsOld != nDimsNew )
4453 : {
4454 0 : bRangeError = true;
4455 : }
4456 : else
4457 : {
4458 : // Compare bounds
4459 0 : for( short i = 1 ; i <= nDims ; i++ )
4460 : {
4461 : sal_Int32 lBoundNew, uBoundNew;
4462 : sal_Int32 lBoundOld, uBoundOld;
4463 0 : pArray->GetDim32( i, lBoundNew, uBoundNew );
4464 0 : pOldArray->GetDim32( i, lBoundOld, uBoundOld );
4465 :
4466 0 : lBoundNew = std::max( lBoundNew, lBoundOld );
4467 0 : uBoundNew = std::min( uBoundNew, uBoundOld );
4468 0 : short j = i - 1;
4469 0 : pActualIndices[j] = pLowerBounds[j] = lBoundNew;
4470 0 : pUpperBounds[j] = uBoundNew;
4471 : }
4472 : }
4473 :
4474 0 : if( bRangeError )
4475 : {
4476 0 : StarBASIC::Error( SbERR_OUT_OF_RANGE );
4477 : }
4478 : else
4479 : {
4480 : // Copy data from old array by going recursively through all dimensions
4481 : // (It would be faster to work on the flat internal data array of an
4482 : // SbyArray but this solution is clearer and easier)
4483 : implCopyDimArray_DCREATE( pArray, pOldArray, nDims - 1,
4484 0 : 0, pActualIndices.get(), pLowerBounds.get(), pUpperBounds.get() );
4485 : }
4486 0 : refRedimpArray = NULL;
4487 12 : }
4488 : }
4489 :
4490 270 : void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4491 : {
4492 270 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4493 540 : OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
4494 :
4495 270 : SbxObject* pCopyObj = createUserTypeImpl( aClass );
4496 270 : if( pCopyObj )
4497 : {
4498 2 : pCopyObj->SetName( aName );
4499 : }
4500 270 : SbxVariable* pNew = new SbxVariable;
4501 270 : pNew->PutObject( pCopyObj );
4502 270 : pNew->SetDeclareClassName( aClass );
4503 540 : PushVar( pNew );
4504 270 : }
4505 :
4506 2176 : void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
4507 : {
4508 2176 : bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
4509 2176 : if( bWithEvents )
4510 : {
4511 0 : pVar->SetFlag( SBX_WITH_EVENTS );
4512 : }
4513 2176 : bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
4514 2176 : if( bDimAsNew )
4515 : {
4516 2 : pVar->SetFlag( SBX_DIM_AS_NEW );
4517 : }
4518 2176 : bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
4519 2176 : if( bFixedString )
4520 : {
4521 0 : sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000
4522 0 : OUStringBuffer aBuf;
4523 0 : comphelper::string::padToLength(aBuf, nCount, 0);
4524 0 : pVar->PutString(aBuf.makeStringAndClear());
4525 : }
4526 :
4527 2176 : bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
4528 2176 : if( bVarToDim )
4529 : {
4530 60 : pVar->SetFlag( SBX_VAR_TO_DIM );
4531 : }
4532 2176 : }
4533 :
4534 : // establishing a local variable (+StringID+type)
4535 :
4536 1932 : void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4537 : {
4538 1932 : if( !refLocals.Is() )
4539 : {
4540 830 : refLocals = new SbxArray;
4541 : }
4542 1932 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4543 1932 : if( refLocals->Find( aName, SbxCLASS_DONTCARE ) == NULL )
4544 : {
4545 1916 : SbxDataType t = (SbxDataType)(nOp2 & 0xffff);
4546 1916 : SbxVariable* p = new SbxVariable( t );
4547 1916 : p->SetName( aName );
4548 1916 : implHandleSbxFlags( p, t, nOp2 );
4549 1916 : refLocals->Put( p, refLocals->Count() );
4550 1932 : }
4551 1932 : }
4552 :
4553 : // establishing a module-global variable (+StringID+type)
4554 :
4555 260 : void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
4556 : {
4557 260 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4558 260 : SbxDataType t = (SbxDataType)(SbxDataType)(nOp2 & 0xffff);;
4559 260 : bool bFlag = pMod->IsSet( SBX_NO_MODIFY );
4560 260 : pMod->SetFlag( SBX_NO_MODIFY );
4561 520 : SbxVariableRef p = pMod->Find( aName, SbxCLASS_PROPERTY );
4562 260 : if( p.Is() )
4563 : {
4564 0 : pMod->Remove (p);
4565 : }
4566 260 : SbProperty* pProp = pMod->GetProperty( aName, t );
4567 260 : if( !bUsedForClassModule )
4568 : {
4569 260 : pProp->SetFlag( SBX_PRIVATE );
4570 : }
4571 260 : if( !bFlag )
4572 : {
4573 260 : pMod->ResetFlag( SBX_NO_MODIFY );
4574 : }
4575 260 : if( pProp )
4576 : {
4577 260 : pProp->SetFlag( SBX_DONTSTORE );
4578 : // from 2.7.1996: HACK because of 'reference can't be saved'
4579 260 : pProp->SetFlag( SBX_NO_MODIFY);
4580 :
4581 260 : implHandleSbxFlags( pProp, t, nOp2 );
4582 260 : }
4583 260 : }
4584 :
4585 70 : void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4586 : {
4587 70 : StepPUBLIC_Impl( nOp1, nOp2, false );
4588 70 : }
4589 :
4590 190 : void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4591 : {
4592 : // Creates module variable that isn't reinitialised when
4593 : // between invocations ( for VBASupport & document basic only )
4594 190 : if( pMod->pImage->bFirstInit )
4595 : {
4596 190 : bool bUsedForClassModule = pImg->GetFlag( SBIMG_CLASSMODULE );
4597 190 : StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
4598 : }
4599 190 : }
4600 :
4601 : // establishing a global variable (+StringID+type)
4602 :
4603 272 : void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4604 : {
4605 272 : if( pImg->GetFlag( SBIMG_CLASSMODULE ) )
4606 : {
4607 0 : StepPUBLIC_Impl( nOp1, nOp2, true );
4608 : }
4609 272 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4610 272 : SbxDataType t = (SbxDataType)(nOp2 & 0xffff);
4611 :
4612 : // Store module scope variables at module scope
4613 : // in non vba mode these are stored at the library level :/
4614 : // not sure if this really should not be enabled for ALL basic
4615 272 : SbxObject* pStorage = &rBasic;
4616 272 : if ( SbiRuntime::isVBAEnabled() )
4617 : {
4618 44 : pStorage = pMod;
4619 44 : pMod->AddVarName( aName );
4620 : }
4621 :
4622 272 : bool bFlag = pStorage->IsSet( SBX_NO_MODIFY );
4623 272 : rBasic.SetFlag( SBX_NO_MODIFY );
4624 544 : SbxVariableRef p = pStorage->Find( aName, SbxCLASS_PROPERTY );
4625 272 : if( p.Is() )
4626 : {
4627 0 : pStorage->Remove (p);
4628 : }
4629 272 : p = pStorage->Make( aName, SbxCLASS_PROPERTY, t );
4630 272 : if( !bFlag )
4631 : {
4632 272 : pStorage->ResetFlag( SBX_NO_MODIFY );
4633 : }
4634 272 : if( p )
4635 : {
4636 272 : p->SetFlag( SBX_DONTSTORE );
4637 : // from 2.7.1996: HACK because of 'reference can't be saved'
4638 272 : p->SetFlag( SBX_NO_MODIFY);
4639 272 : }
4640 272 : }
4641 :
4642 :
4643 : // Creates global variable that isn't reinitialised when
4644 : // basic is restarted, P=PERSIST (+StringID+Typ)
4645 :
4646 272 : void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4647 : {
4648 272 : if( pMod->pImage->bFirstInit )
4649 : {
4650 272 : StepGLOBAL( nOp1, nOp2 );
4651 : }
4652 272 : }
4653 :
4654 :
4655 : // Searches for global variable, behavior depends on the fact
4656 : // if the variable is initialised for the first time
4657 :
4658 4 : void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4659 : {
4660 4 : if( pMod->pImage->bFirstInit )
4661 : {
4662 : // Behave like always during first init
4663 4 : StepFIND( nOp1, nOp2 );
4664 : }
4665 : else
4666 : {
4667 : // Return dummy variable
4668 0 : SbxDataType t = (SbxDataType) nOp2;
4669 0 : OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
4670 :
4671 0 : SbxVariable* pDummyVar = new SbxVariable( t );
4672 0 : pDummyVar->SetName( aName );
4673 0 : PushVar( pDummyVar );
4674 : }
4675 4 : }
4676 :
4677 :
4678 0 : SbxVariable* SbiRuntime::StepSTATIC_Impl( OUString& aName, SbxDataType& t )
4679 : {
4680 0 : SbxVariable* p = NULL;
4681 0 : if ( pMeth )
4682 : {
4683 0 : SbxArray* pStatics = pMeth->GetStatics();
4684 0 : if( pStatics && ( pStatics->Find( aName, SbxCLASS_DONTCARE ) == NULL ) )
4685 : {
4686 0 : p = new SbxVariable( t );
4687 0 : if( t != SbxVARIANT )
4688 : {
4689 0 : p->SetFlag( SBX_FIXED );
4690 : }
4691 0 : p->SetName( aName );
4692 0 : pStatics->Put( p, pStatics->Count() );
4693 : }
4694 : }
4695 0 : return p;
4696 : }
4697 : // establishing a static variable (+StringID+type)
4698 0 : void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
4699 : {
4700 0 : OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
4701 0 : SbxDataType t = (SbxDataType) nOp2;
4702 0 : StepSTATIC_Impl( aName, t );
4703 1203 : }
4704 :
4705 : /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
|
