xref: /aoo42x/main/basic/source/runtime/runtime.cxx (revision 07a3d7f1)
1 /**************************************************************
2  *
3  * Licensed to the Apache Software Foundation (ASF) under one
4  * or more contributor license agreements.  See the NOTICE file
5  * distributed with this work for additional information
6  * regarding copyright ownership.  The ASF licenses this file
7  * to you under the Apache License, Version 2.0 (the
8  * "License"); you may not use this file except in compliance
9  * with the License.  You may obtain a copy of the License at
10  *
11  *   http://www.apache.org/licenses/LICENSE-2.0
12  *
13  * Unless required by applicable law or agreed to in writing,
14  * software distributed under the License is distributed on an
15  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16  * KIND, either express or implied.  See the License for the
17  * specific language governing permissions and limitations
18  * under the License.
19  *
20  *************************************************************/
21 
22 
23 
24 // MARKER(update_precomp.py): autogen include statement, do not remove
25 #include "precompiled_basic.hxx"
26 #include <tools/fsys.hxx>
27 #include <vcl/svapp.hxx>
28 #include <tools/wldcrd.hxx>
29 #include <svl/zforlist.hxx>
30 #include <unotools/syslocale.hxx>
31 #include "runtime.hxx"
32 #include "sbintern.hxx"
33 #include "opcodes.hxx"
34 #include "codegen.hxx"
35 #include "iosys.hxx"
36 #include "image.hxx"
37 #include "ddectrl.hxx"
38 #include "dllmgr.hxx"
39 #include <comphelper/processfactory.hxx>
40 #include <com/sun/star/container/XEnumerationAccess.hpp>
41 #include "sbunoobj.hxx"
42 #include "errobject.hxx"
43 #include "sbtrace.hxx"
44 #include "comenumwrapper.hxx"
45 
46 using namespace ::com::sun::star;
47 
isVBAEnabled()48 bool SbiRuntime::isVBAEnabled()
49 {
50 	bool result = false;
51 	SbiInstance* pInst = pINST;
52 	if ( pInst && pINST->pRun )
53 		result = pInst->pRun->bVBAEnabled;
54 	return result;
55 }
56 
57 // #91147 Global reschedule flag
58 static sal_Bool bStaticGlobalEnableReschedule = sal_True;
59 
StaticEnableReschedule(sal_Bool bReschedule)60 void StarBASIC::StaticEnableReschedule( sal_Bool bReschedule )
61 {
62     bStaticGlobalEnableReschedule = bReschedule;
63 }
SetVBAEnabled(sal_Bool bEnabled)64 void StarBASIC::SetVBAEnabled( sal_Bool bEnabled )
65 {
66     if ( bDocBasic )
67     {
68         bVBAEnabled = bEnabled;
69     }
70 }
71 
isVBAEnabled()72 sal_Bool StarBASIC::isVBAEnabled()
73 {
74     if ( bDocBasic )
75     {
76         if( SbiRuntime::isVBAEnabled() )
77             return sal_True;
78         return bVBAEnabled;
79     }
80     return sal_False;
81 }
82 
83 
84 struct SbiArgvStack {					// Argv stack:
85 	SbiArgvStack*  pNext;	   			// Stack Chain
86 	SbxArrayRef    refArgv;	 			// Argv
87 	short nArgc;						// Argc
88 };
89 
90 SbiRuntime::pStep0 SbiRuntime::aStep0[] = {	// Alle Opcodes ohne Operanden
91 	&SbiRuntime::StepNOP,
92 	&SbiRuntime::StepEXP,
93 	&SbiRuntime::StepMUL,
94 	&SbiRuntime::StepDIV,
95 	&SbiRuntime::StepMOD,
96 	&SbiRuntime::StepPLUS,
97 	&SbiRuntime::StepMINUS,
98 	&SbiRuntime::StepNEG,
99 	&SbiRuntime::StepEQ,
100 	&SbiRuntime::StepNE,
101 	&SbiRuntime::StepLT,
102 	&SbiRuntime::StepGT,
103 	&SbiRuntime::StepLE,
104 	&SbiRuntime::StepGE,
105 	&SbiRuntime::StepIDIV,
106 	&SbiRuntime::StepAND,
107 	&SbiRuntime::StepOR,
108 	&SbiRuntime::StepXOR,
109 	&SbiRuntime::StepEQV,
110 	&SbiRuntime::StepIMP,
111 	&SbiRuntime::StepNOT,
112 	&SbiRuntime::StepCAT,
113 
114 	&SbiRuntime::StepLIKE,
115 	&SbiRuntime::StepIS,
116 	// Laden/speichern
117 	&SbiRuntime::StepARGC,		// neuen Argv einrichten
118 	&SbiRuntime::StepARGV,		// TOS ==> aktueller Argv
119 	&SbiRuntime::StepINPUT,	 	// Input ==> TOS
120 	&SbiRuntime::StepLINPUT,	 	// Line Input ==> TOS
121 	&SbiRuntime::StepGET,        // TOS anfassen
122 	&SbiRuntime::StepSET,        // Speichern Objekt TOS ==> TOS-1
123 	&SbiRuntime::StepPUT,		// TOS ==> TOS-1
124 	&SbiRuntime::StepPUTC,		// TOS ==> TOS-1, dann ReadOnly
125 	&SbiRuntime::StepDIM,		// DIM
126 	&SbiRuntime::StepREDIM, 		// REDIM
127 	&SbiRuntime::StepREDIMP,		// REDIM PRESERVE
128 	&SbiRuntime::StepERASE, 		// TOS loeschen
129 	// Verzweigen
130 	&SbiRuntime::StepSTOP,  	  	// Programmende
131 	&SbiRuntime::StepINITFOR,  	// FOR-Variable initialisieren
132 	&SbiRuntime::StepNEXT,	  	// FOR-Variable inkrementieren
133 	&SbiRuntime::StepCASE,	  	// Anfang CASE
134 	&SbiRuntime::StepENDCASE,  	// Ende CASE
135 	&SbiRuntime::StepSTDERROR,  	// Standard-Fehlerbehandlung
136 	&SbiRuntime::StepNOERROR,  	// keine Fehlerbehandlung
137 	&SbiRuntime::StepLEAVE,		// UP verlassen
138 	// E/A
139 	&SbiRuntime::StepCHANNEL,  	// TOS = Kanalnummer
140 	&SbiRuntime::StepPRINT,	  	// print TOS
141 	&SbiRuntime::StepPRINTF,	  	// print TOS in field
142 	&SbiRuntime::StepWRITE,	  	// write TOS
143 	&SbiRuntime::StepRENAME,	  	// Rename Tos+1 to Tos
144 	&SbiRuntime::StepPROMPT,	  	// Input Prompt aus TOS definieren
145 	&SbiRuntime::StepRESTART,  	// Set restart point
146 	&SbiRuntime::StepCHANNEL0,	// E/A-Kanal 0 einstellen
147 	&SbiRuntime::StepEMPTY,		// Leeren Ausdruck auf Stack
148 	&SbiRuntime::StepERROR,	  	// TOS = Fehlercode
149 	&SbiRuntime::StepLSET,		// Speichern Objekt TOS ==> TOS-1
150 	&SbiRuntime::StepRSET,		// Speichern Objekt TOS ==> TOS-1
151 	&SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
152 	&SbiRuntime::StepINITFOREACH,// Init for each loop
153 	&SbiRuntime::StepVBASET,// vba-like set statement
154 	&SbiRuntime::StepERASE_CLEAR,// vba-like set statement
155 	&SbiRuntime::StepARRAYACCESS,// access TOS as array
156 	&SbiRuntime::StepBYVAL,     // access TOS as array
157 };
158 
159 SbiRuntime::pStep1 SbiRuntime::aStep1[] = {	// Alle Opcodes mit einem Operanden
160 	&SbiRuntime::StepLOADNC,	  	// Laden einer numerischen Konstanten (+ID)
161 	&SbiRuntime::StepLOADSC,	  	// Laden einer Stringkonstanten (+ID)
162 	&SbiRuntime::StepLOADI,	  	// Immediate Load (+Wert)
163 	&SbiRuntime::StepARGN,		// Speichern eines named Args in Argv (+StringID)
164 	&SbiRuntime::StepPAD,	  	// String auf feste Laenge bringen (+Laenge)
165 	// Verzweigungen
166 	&SbiRuntime::StepJUMP,	  	// Sprung (+Target)
167 	&SbiRuntime::StepJUMPT,	  	// TOS auswerten), bedingter Sprung (+Target)
168 	&SbiRuntime::StepJUMPF,	  	// TOS auswerten), bedingter Sprung (+Target)
169 	&SbiRuntime::StepONJUMP,	  	// TOS auswerten), Sprung in JUMP-Tabelle (+MaxVal)
170 	&SbiRuntime::StepGOSUB,		// UP-Aufruf (+Target)
171 	&SbiRuntime::StepRETURN,		// UP-Return (+0 oder Target)
172 	&SbiRuntime::StepTESTFOR,	// FOR-Variable testen), inkrementieren (+Endlabel)
173 	&SbiRuntime::StepCASETO,		// Tos+1 <= Case <= Tos), 2xremove (+Target)
174 	&SbiRuntime::StepERRHDL,		// Fehler-Handler (+Offset)
175 	&SbiRuntime::StepRESUME,		// Resume nach Fehlern (+0 or 1 or Label)
176 	// E/A
177 	&SbiRuntime::StepCLOSE,		// (+Kanal/0)
178 	&SbiRuntime::StepPRCHAR,		// (+char)
179 	// Verwaltung
180 	&SbiRuntime::StepSETCLASS,	// Set + Klassennamen testen (+StringId)
181 	&SbiRuntime::StepTESTCLASS,	// Check TOS class (+StringId)
182 	&SbiRuntime::StepLIB,  		// Lib fuer Declare-Call (+StringId)
183 	&SbiRuntime::StepBASED,	  	// TOS wird um BASE erhoeht, BASE davor gepusht
184 	&SbiRuntime::StepARGTYP,	  	// Letzten Parameter in Argv konvertieren (+Typ)
185 	&SbiRuntime::StepVBASETCLASS,// vba-like set statement
186 };
187 
188 SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// Alle Opcodes mit zwei Operanden
189 	&SbiRuntime::StepRTL,  	    // Laden aus RTL (+StringID+Typ)
190 	&SbiRuntime::StepFIND,	    // Laden (+StringID+Typ)
191 	&SbiRuntime::StepELEM,  		// Laden Element (+StringID+Typ)
192 	&SbiRuntime::StepPARAM,		// Parameter (+Offset+Typ)
193 	// Verzweigen
194 	&SbiRuntime::StepCALL,	  	// Declare-Call (+StringID+Typ)
195 	&SbiRuntime::StepCALLC,	  	// CDecl-Declare-Call (+StringID+Typ)
196 	&SbiRuntime::StepCASEIS,		// Case-Test (+Test-Opcode+False-Target)
197 	// Verwaltung
198 	&SbiRuntime::StepSTMNT, 		// Beginn eines Statements (+Line+Col)
199 	// E/A
200 	&SbiRuntime::StepOPEN,  		// (+SvStreamFlags+Flags)
201 	// Objekte
202 	&SbiRuntime::StepLOCAL,		// Lokale Variable definieren (+StringId+Typ)
203 	&SbiRuntime::StepPUBLIC,		// Modulglobale Variable (+StringID+Typ)
204 	&SbiRuntime::StepGLOBAL,	  	// Globale Variable definieren (+StringID+Typ)
205 	&SbiRuntime::StepCREATE,		// Objekt kreieren (+StringId+StringId)
206 	&SbiRuntime::StepSTATIC,     // Statische Variable (+StringId+StringId)
207 	&SbiRuntime::StepTCREATE,    // User Defined Objekte (+StringId+StringId)
208 	&SbiRuntime::StepDCREATE,    // Objekt-Array kreieren (+StringID+StringID)
209 	&SbiRuntime::StepGLOBAL_P,   // Globale Variable definieren, die beim Neustart
210                                         // von Basic nicht ueberschrieben wird (+StringID+Typ)
211 	&SbiRuntime::StepFIND_G,    	// Sucht globale Variable mit Spezialbehandlung wegen _GLOBAL_P
212 	&SbiRuntime::StepDCREATE_REDIMP, // Objekt-Array redimensionieren (+StringID+StringID)
213 	&SbiRuntime::StepFIND_CM,    // Search inside a class module (CM) to enable global search in time
214 	&SbiRuntime::StepPUBLIC_P,    // Search inside a class module (CM) to enable global search in time
215 	&SbiRuntime::StepFIND_STATIC,    // Search inside a class module (CM) to enable global search in time
216 };
217 
218 
219 //////////////////////////////////////////////////////////////////////////
220 //								SbiRTLData								//
221 //////////////////////////////////////////////////////////////////////////
222 
SbiRTLData()223 SbiRTLData::SbiRTLData()
224 {
225 	pDir		= 0;
226 	nDirFlags	= 0;
227 	nCurDirPos	= 0;
228 	pWildCard	= NULL;
229 }
230 
~SbiRTLData()231 SbiRTLData::~SbiRTLData()
232 {
233 	delete pDir;
234 	pDir = 0;
235 	delete pWildCard;
236 }
237 
238 //////////////////////////////////////////////////////////////////////////
239 //								SbiInstance								//
240 //////////////////////////////////////////////////////////////////////////
241 
242 // 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out
243 // Die Entscheidung, ob StepPoint aufgerufen werden soll, wird anhand des
244 // CallLevels getroffen. Angehalten wird, wenn der aktuelle CallLevel <=
245 // nBreakCallLvl ist. Der aktuelle CallLevel kann niemals kleiner als 1
246 // sein, da er beim Aufruf einer Methode (auch main) inkrementiert wird.
247 // Daher bedeutet ein BreakCallLvl von 0, dass das Programm gar nicht
248 // angehalten wird.
249 // (siehe auch step2.cxx, SbiRuntime::StepSTMNT() )
250 
251 // Hilfsfunktion, um den BreakCallLevel gemaess der der Debug-Flags zu ermitteln
CalcBreakCallLevel(sal_uInt16 nFlags)252 void SbiInstance::CalcBreakCallLevel( sal_uInt16 nFlags )
253 {
254 	// Break-Flag wegfiltern
255 	nFlags &= ~((sal_uInt16)SbDEBUG_BREAK);
256 
257 	sal_uInt16 nRet;
258 	switch( nFlags )
259 	{
260 		case SbDEBUG_STEPINTO:
261 			nRet = nCallLvl + 1;	// CallLevel+1 wird auch angehalten
262 			break;
263 		case SbDEBUG_STEPOVER | SbDEBUG_STEPINTO:
264 			nRet = nCallLvl;		// Aktueller CallLevel wird angehalten
265 			break;
266 		case SbDEBUG_STEPOUT:
267 			nRet = nCallLvl - 1;	// Kleinerer CallLevel wird angehalten
268 			break;
269 		case SbDEBUG_CONTINUE:
270 		// Basic-IDE liefert 0 statt SbDEBUG_CONTINUE, also auch default=continue
271 		default:
272 			nRet = 0;				// CallLevel ist immer >0 -> kein StepPoint
273 	}
274 	nBreakCallLvl = nRet;			// Ergebnis uebernehmen
275 }
276 
SbiInstance(StarBASIC * p)277 SbiInstance::SbiInstance( StarBASIC* p )
278 {
279 	pBasic   = p;
280 	pNext    = NULL;
281 	pRun     = NULL;
282 	pIosys   = new SbiIoSystem;
283 	pDdeCtrl = new SbiDdeControl;
284 	pDllMgr	 = 0; // on demand
285 	pNumberFormatter = 0; // on demand
286 	nCallLvl = 0;
287 	nBreakCallLvl = 0;
288 	nErr	 =
289 	nErl	 = 0;
290 	bReschedule = sal_True;
291 	bCompatibility = sal_False;
292 }
293 
~SbiInstance()294 SbiInstance::~SbiInstance()
295 {
296 	while( pRun )
297 	{
298 		SbiRuntime* p = pRun->pNext;
299 		delete pRun;
300 		pRun = p;
301 	}
302 	delete pIosys;
303 	delete pDdeCtrl;
304 	delete pDllMgr;
305 	delete pNumberFormatter;
306 
307 	try
308 	{
309 		int nSize = ComponentVector.size();
310 		if( nSize )
311 		{
312 			for( int i = nSize - 1 ; i >= 0 ; --i )
313 			{
314 				Reference< XComponent > xDlgComponent = ComponentVector[i];
315 				if( xDlgComponent.is() )
316 					xDlgComponent->dispose();
317 			}
318 		}
319 	}
320 	catch( const Exception& )
321 	{
322 		DBG_ERROR( "SbiInstance::~SbiInstance: caught an exception while disposing the components!" );
323 	}
324 
325     ComponentVector.clear();
326 }
327 
GetDllMgr()328 SbiDllMgr* SbiInstance::GetDllMgr()
329 {
330 	if( !pDllMgr )
331 		pDllMgr = new SbiDllMgr;
332 	return pDllMgr;
333 }
334 
335 // #39629 NumberFormatter jetzt ueber statische Methode anlegen
GetNumberFormatter()336 SvNumberFormatter* SbiInstance::GetNumberFormatter()
337 {
338     LanguageType eLangType = GetpApp()->GetSettings().GetLanguage();
339     SvtSysLocale aSysLocale;
340     DateFormat eDate = aSysLocale.GetLocaleData().getDateFormat();
341 	if( pNumberFormatter )
342     {
343         if( eLangType != meFormatterLangType ||
344             eDate != meFormatterDateFormat )
345         {
346             delete pNumberFormatter;
347             pNumberFormatter = NULL;
348         }
349     }
350     meFormatterLangType = eLangType;
351     meFormatterDateFormat = eDate;
352 	if( !pNumberFormatter )
353 		PrepareNumberFormatter( pNumberFormatter, nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx,
354         &meFormatterLangType, &meFormatterDateFormat );
355 	return pNumberFormatter;
356 }
357 
358 // #39629 NumberFormatter auch statisch anbieten
PrepareNumberFormatter(SvNumberFormatter * & rpNumberFormatter,sal_uInt32 & rnStdDateIdx,sal_uInt32 & rnStdTimeIdx,sal_uInt32 & rnStdDateTimeIdx,LanguageType * peFormatterLangType,DateFormat * peFormatterDateFormat)359 void SbiInstance::PrepareNumberFormatter( SvNumberFormatter*& rpNumberFormatter,
360 	sal_uInt32 &rnStdDateIdx, sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
361     LanguageType* peFormatterLangType, DateFormat* peFormatterDateFormat )
362 {
363 	com::sun::star::uno::Reference< com::sun::star::lang::XMultiServiceFactory >
364 		xFactory = comphelper::getProcessServiceFactory();
365 
366     LanguageType eLangType;
367     if( peFormatterLangType )
368         eLangType = *peFormatterLangType;
369     else
370         eLangType = GetpApp()->GetSettings().GetLanguage();
371 
372     DateFormat eDate;
373     if( peFormatterDateFormat )
374         eDate = *peFormatterDateFormat;
375     else
376     {
377         SvtSysLocale aSysLocale;
378         eDate = aSysLocale.GetLocaleData().getDateFormat();
379     }
380 
381     rpNumberFormatter = new SvNumberFormatter( xFactory, eLangType );
382 
383 	xub_StrLen nCheckPos = 0; short nType;
384 	rnStdTimeIdx = rpNumberFormatter->GetStandardFormat( NUMBERFORMAT_TIME, eLangType );
385 
386 	// Standard-Vorlagen des Formatters haben nur zweistellige
387 	// Jahreszahl. Deshalb eigenes Format registrieren
388 
389 	// HACK, da der Numberformatter in PutandConvertEntry die Platzhalter
390 	// fuer Monat, Tag, Jahr nicht entsprechend der Systemeinstellung
391 	// austauscht. Problem: Print Year(Date) unter engl. BS
392 	// siehe auch svtools\source\sbx\sbxdate.cxx
393 
394 	String aDateStr;
395 	switch( eDate )
396 	{
397 		case MDY: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") ); break;
398 		case DMY: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("TT.MM.JJJJ") ); break;
399 		case YMD: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("JJJJ.MM.TT") ); break;
400 		default:  aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") );
401 	}
402 	String aStr( aDateStr );
403 	rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
404 		rnStdDateIdx, LANGUAGE_GERMAN, eLangType );
405 	nCheckPos = 0;
406 	String aStrHHMMSS( RTL_CONSTASCII_USTRINGPARAM(" HH:MM:SS") );
407 	aStr = aDateStr;
408 	aStr += aStrHHMMSS;
409 	rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
410 		rnStdDateTimeIdx, LANGUAGE_GERMAN, eLangType );
411 }
412 
413 
414 
415 // Engine laufenlassen. Falls Flags == SbDEBUG_CONTINUE, Flags uebernehmen
416 
Stop()417 void SbiInstance::Stop()
418 {
419 	for( SbiRuntime* p = pRun; p; p = p->pNext )
420 		p->Stop();
421 }
422 
423 // Allows Basic IDE to set watch mode to suppress errors
424 static bool bWatchMode = false;
425 
setBasicWatchMode(bool bOn)426 void setBasicWatchMode( bool bOn )
427 {
428 	bWatchMode = bOn;
429 }
430 
Error(SbError n)431 void SbiInstance::Error( SbError n )
432 {
433 	Error( n, String() );
434 }
435 
Error(SbError n,const String & rMsg)436 void SbiInstance::Error( SbError n, const String& rMsg )
437 {
438 	if( !bWatchMode )
439 	{
440 		aErrorMsg = rMsg;
441 		pRun->Error( n );
442 	}
443 }
444 
ErrorVB(sal_Int32 nVBNumber,const String & rMsg)445 void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const String& rMsg )
446 {
447 	if( !bWatchMode )
448 	{
449 		SbError n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
450 		if ( !n )
451 			n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
452 
453 		aErrorMsg = rMsg;
454 		SbiRuntime::translateErrorToVba( n, aErrorMsg );
455 
456 		bool bVBATranslationAlreadyDone = true;
457 		pRun->Error( SbERR_BASIC_COMPAT, bVBATranslationAlreadyDone );
458 	}
459 }
460 
setErrorVB(sal_Int32 nVBNumber,const String & rMsg)461 void SbiInstance::setErrorVB( sal_Int32 nVBNumber, const String& rMsg )
462 {
463 	SbError n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
464 	if( !n )
465 		n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
466 
467 	aErrorMsg = rMsg;
468 	SbiRuntime::translateErrorToVba( n, aErrorMsg );
469 
470 	nErr = n;
471 }
472 
473 
FatalError(SbError n)474 void SbiInstance::FatalError( SbError n )
475 {
476 	pRun->FatalError( n );
477 }
478 
FatalError(SbError _errCode,const String & _details)479 void SbiInstance::FatalError( SbError _errCode, const String& _details )
480 {
481 	pRun->FatalError( _errCode, _details );
482 }
483 
Abort()484 void SbiInstance::Abort()
485 {
486 	// Basic suchen, in dem der Fehler auftrat
487 	StarBASIC* pErrBasic = GetCurrentBasic( pBasic );
488 	pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 );
489 	pBasic->Stop();
490 }
491 
492 // Hilfsfunktion, um aktives Basic zu finden, kann ungleich pRTBasic sein
GetCurrentBasic(StarBASIC * pRTBasic)493 StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic )
494 {
495 	StarBASIC* pCurBasic = pRTBasic;
496 	SbModule* pActiveModule = pRTBasic->GetActiveModule();
497 	if( pActiveModule )
498 	{
499 		SbxObject* pParent = pActiveModule->GetParent();
500 		if( pParent && pParent->ISA(StarBASIC) )
501 			pCurBasic = (StarBASIC*)pParent;
502 	}
503 	return pCurBasic;
504 }
505 
GetActiveModule()506 SbModule* SbiInstance::GetActiveModule()
507 {
508 	if( pRun )
509 		return pRun->GetModule();
510 	else
511 		return NULL;
512 }
513 
GetCaller(sal_uInt16 nLevel)514 SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel )
515 {
516 	SbiRuntime* p = pRun;
517 	while( nLevel-- && p )
518 		p = p->pNext;
519 	if( p )
520 		return p->GetCaller();
521 	else
522 		return NULL;
523 }
524 
GetLocals(SbMethod * pMeth)525 SbxArray* SbiInstance::GetLocals( SbMethod* pMeth )
526 {
527 	SbiRuntime* p = pRun;
528 	while( p && p->GetMethod() != pMeth )
529 		p = p->pNext;
530 	if( p )
531 		return p->GetLocals();
532 	else
533 		return NULL;
534 }
535 
536 //////////////////////////////////////////////////////////////////////////
537 //								SbiInstance								//
538 //////////////////////////////////////////////////////////////////////////
539 
540 // Achtung: pMeth kann auch NULL sein (beim Aufruf des Init-Codes)
541 
SbiRuntime(SbModule * pm,SbMethod * pe,sal_uInt32 nStart)542 SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart )
543 		 : rBasic( *(StarBASIC*)pm->pParent ), pInst( pINST ),
544 		   pMod( pm ), pMeth( pe ), pImg( pMod->pImage ), m_nLastTime(0)
545 {
546 	nFlags	  = pe ? pe->GetDebugFlags() : 0;
547 	pIosys	  = pInst->pIosys;
548 	pArgvStk  = NULL;
549 	pGosubStk = NULL;
550 	pForStk   = NULL;
551 	pError    = NULL;
552 	pErrCode  =
553 	pErrStmnt =
554 	pRestart  = NULL;
555 	pNext     = NULL;
556 	pCode     =
557 	pStmnt    = (const sal_uInt8* ) pImg->GetCode() + nStart;
558 	bRun      =
559 	bError    = sal_True;
560 	bInError  = sal_False;
561 	bBlocked  = sal_False;
562 	nLine	  = 0;
563 	nCol1	  = 0;
564 	nCol2	  = 0;
565 	nExprLvl  = 0;
566 	nArgc     = 0;
567 	nError	  = 0;
568 	nGosubLvl = 0;
569 	nForLvl   = 0;
570 	nOps	  = 0;
571 	refExprStk = new SbxArray;
572 	SetVBAEnabled( pMod->IsVBACompat() );
573 #if defined GCC
574 	SetParameters( pe ? pe->GetParameters() : (class SbxArray *)NULL );
575 #else
576 	SetParameters( pe ? pe->GetParameters() : NULL );
577 #endif
578 	pRefSaveList = NULL;
579 	pItemStoreList = NULL;
580 }
581 
~SbiRuntime()582 SbiRuntime::~SbiRuntime()
583 {
584 	ClearGosubStack();
585 	ClearArgvStack();
586 	ClearForStack();
587 
588 	// #74254 Items zum Sichern temporaere Referenzen freigeben
589 	ClearRefs();
590 	while( pItemStoreList )
591 	{
592 		RefSaveItem* pToDeleteItem = pItemStoreList;
593 		pItemStoreList = pToDeleteItem->pNext;
594 		delete pToDeleteItem;
595 	}
596 }
597 
SetVBAEnabled(bool bEnabled)598 void SbiRuntime::SetVBAEnabled(bool bEnabled )
599 {
600 	bVBAEnabled = bEnabled;
601 }
602 
603 // Aufbau der Parameterliste. Alle ByRef-Parameter werden direkt
604 // uebernommen; von ByVal-Parametern werden Kopien angelegt. Falls
605 // ein bestimmter Datentyp verlangt wird, wird konvertiert.
606 
SetParameters(SbxArray * pParams)607 void SbiRuntime::SetParameters( SbxArray* pParams )
608 {
609 	refParams = new SbxArray;
610 	// fuer den Returnwert
611 	refParams->Put( pMeth, 0 );
612 
613 	SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : NULL;
614 	sal_uInt16 nParamCount = pParams ? pParams->Count() : 1;
615 	if( nParamCount > 1 )
616 	{
617 		for( sal_uInt16 i = 1 ; i < nParamCount ; i++ )
618 		{
619 			const SbxParamInfo* p = pInfo ? pInfo->GetParam( i ) : NULL;
620 
621 			// #111897 ParamArray
622 			if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
623 			{
624 				SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
625 				sal_uInt16 nParamArrayParamCount = nParamCount - i;
626 				pArray->unoAddDim( 0, nParamArrayParamCount - 1 );
627 				for( sal_uInt16 j = i ; j < nParamCount ; j++ )
628 				{
629 					SbxVariable* v = pParams->Get( j );
630 					short nDimIndex = j - i;
631 					pArray->Put( v, &nDimIndex );
632 				}
633 				SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
634 				pArrayVar->SetFlag( SBX_READWRITE );
635 				pArrayVar->PutObject( pArray );
636 				refParams->Put( pArrayVar, i );
637 
638 				// Block ParamArray for missing parameter
639 				pInfo = NULL;
640 				break;
641 			}
642 
643 			SbxVariable* v = pParams->Get( i );
644 			// Methoden sind immer byval!
645 			sal_Bool bByVal = v->IsA( TYPE(SbxMethod) );
646 			SbxDataType t = v->GetType();
647 			bool bTargetTypeIsArray = false;
648 			if( p )
649 			{
650 				bByVal |= sal_Bool( ( p->eType & SbxBYREF ) == 0 );
651 				t = (SbxDataType) ( p->eType & 0x0FFF );
652 
653 				if( !bByVal && t != SbxVARIANT &&
654 					(!v->IsFixed() || (SbxDataType)(v->GetType() & 0x0FFF ) != t) )
655 						bByVal = sal_True;
656 
657 				bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0;
658 			}
659 			if( bByVal )
660 			{
661 				if( bTargetTypeIsArray )
662 					t = SbxOBJECT;
663 				SbxVariable* v2 = new SbxVariable( t );
664 				v2->SetFlag( SBX_READWRITE );
665 				*v2 = *v;
666 				refParams->Put( v2, i );
667 			}
668 			else
669 			{
670 				if( t != SbxVARIANT && t != ( v->GetType() & 0x0FFF ) )
671 				{
672 					// Array konvertieren??
673 					if( p && (p->eType & SbxARRAY) )
674 						Error( SbERR_CONVERSION );
675 					else
676 						v->Convert( t );
677 				}
678 				refParams->Put( v, i );
679 			}
680 			if( p )
681 				refParams->PutAlias( p->aName, i );
682 		}
683 	}
684 
685 	// ParamArray for missing parameter
686 	if( pInfo )
687 	{
688 		// #111897 Check first missing parameter for ParamArray
689 		const SbxParamInfo* p = pInfo->GetParam( nParamCount );
690 		if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
691 		{
692 			SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
693 			pArray->unoAddDim( 0, -1 );
694 			SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
695 			pArrayVar->SetFlag( SBX_READWRITE );
696 			pArrayVar->PutObject( pArray );
697 			refParams->Put( pArrayVar, nParamCount );
698 		}
699 	}
700 }
701 
702 
703 // Einen P-Code ausfuehren
704 
Step()705 sal_Bool SbiRuntime::Step()
706 {
707 	if( bRun )
708 	{
709 		// Unbedingt gelegentlich die Kontrolle abgeben!
710 		if( !( ++nOps & 0xF ) && pInst->IsReschedule() && bStaticGlobalEnableReschedule )
711 		{
712 			sal_uInt32 nTime = osl_getGlobalTimer();
713 			if (nTime - m_nLastTime > 5 ) // 20 ms
714 			{
715 				Application::Reschedule();
716 				m_nLastTime = nTime;
717 			}
718 		}
719 
720 		// #i48868 blocked by next call level?
721 		while( bBlocked )
722 		{
723 			if( pInst->IsReschedule() && bStaticGlobalEnableReschedule )
724 				Application::Reschedule();
725 		}
726 
727 #ifdef DBG_TRACE_BASIC
728 		sal_uInt32 nPC = ( pCode - (const sal_uInt8* )pImg->GetCode() );
729 		dbg_traceStep( pMod, nPC, pINST->nCallLvl );
730 #endif
731 
732 		SbiOpcode eOp = (SbiOpcode ) ( *pCode++ );
733 		sal_uInt32 nOp1, nOp2;
734         if (eOp < SbOP0_END)
735 		{
736 			(this->*( aStep0[ eOp ] ) )();
737 		}
738         else if (eOp >= SbOP1_START && eOp < SbOP1_END)
739 		{
740 			nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
741 
742 			(this->*( aStep1[ eOp - SbOP1_START ] ) )( nOp1 );
743 		}
744         else if (eOp >= SbOP2_START && eOp < SbOP2_END)
745 		{
746 			nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
747 			nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24;
748 			(this->*( aStep2[ eOp - SbOP2_START ] ) )( nOp1, nOp2 );
749 		}
750 		else
751 			StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
752 
753 		// SBX-Fehler aufgetreten?
754 		SbError nSbError = SbxBase::GetError();
755 		Error( ERRCODE_TOERROR(nSbError) );			// Warnings rausfiltern
756 
757 		// AB 13.2.1997, neues Error-Handling:
758 		// ACHTUNG: Hier kann nError auch dann gesetzt sein, wenn !nSbError,
759 		// da nError jetzt auch von anderen RT-Instanzen gesetzt werden kann
760 
761 		if( nError )
762 			SbxBase::ResetError();
763 
764 		// AB,15.3.96: Fehler nur anzeigen, wenn BASIC noch aktiv
765 		// (insbesondere nicht nach Compiler-Fehlern zur Laufzeit)
766 		if( nError && bRun )
767 		{
768 #ifdef DBG_TRACE_BASIC
769 			SbError nTraceErr = nError;
770 			String aTraceErrMsg = GetSbData()->aErrMsg;
771 			bool bTraceErrHandled = true;
772 #endif
773 			SbError err = nError;
774 			ClearExprStack();
775 			nError = 0;
776 			pInst->nErr = err;
777 			pInst->nErl = nLine;
778 			pErrCode    = pCode;
779 			pErrStmnt   = pStmnt;
780 			// An error occurred in an error handler
781 			// force parent handler ( if there is one )
782 			// to handle the error
783 			bool bLetParentHandleThis = false;
784 
785 			// Im Error Handler? Dann Std-Error
786 			if ( !bInError )
787 			{
788 				bInError = sal_True;
789 
790 				if( !bError )			// On Error Resume Next
791 					StepRESUME( 1 );
792 				else if( pError )		// On Error Goto ...
793 					pCode = pError;
794 				else
795 					bLetParentHandleThis = true;
796             }
797 			else
798 			{
799 				bLetParentHandleThis = true;
800 				pError = NULL; //terminate the handler
801 			}
802 			if ( bLetParentHandleThis )
803 			{
804 				// AB 13.2.1997, neues Error-Handling:
805 				// Uebergeordnete Error-Handler beruecksichtigen
806 
807 				// Wir haben keinen Error-Handler -> weiter oben suchen
808 				SbiRuntime* pRtErrHdl = NULL;
809 				SbiRuntime* pRt = this;
810 				while( NULL != (pRt = pRt->pNext) )
811 				{
812 					// Gibt es einen Error-Handler?
813 					if( pRt->bError == sal_False || pRt->pError != NULL )
814 					{
815 						pRtErrHdl = pRt;
816 						break;
817 					}
818 				}
819 
820 				// Error-Hdl gefunden?
821 				if( pRtErrHdl )
822 				{
823 					// (Neuen) Error-Stack anlegen
824 					SbErrorStack*& rErrStack = GetSbData()->pErrStack;
825 					if( rErrStack )
826 						delete rErrStack;
827 					rErrStack = new SbErrorStack();
828 
829 					// Alle im Call-Stack darunter stehenden RTs manipulieren
830 					pRt = this;
831 					do
832 					{
833 						// Fehler setzen
834 						pRt->nError = err;
835 						if( pRt != pRtErrHdl )
836 							pRt->bRun = sal_False;
837 
838 						// In Error-Stack eintragen
839 						SbErrorStackEntry *pEntry = new SbErrorStackEntry
840 							( pRt->pMeth, pRt->nLine, pRt->nCol1, pRt->nCol2 );
841 						rErrStack->C40_INSERT(SbErrorStackEntry, pEntry, rErrStack->Count() );
842 
843 						// Nach RT mit Error-Handler aufhoeren
844 						if( pRt == pRtErrHdl )
845 							break;
846                            pRt = pRt->pNext;
847 					}
848 					while( pRt );
849 				}
850 				// Kein Error-Hdl gefunden -> altes Vorgehen
851 				else
852 				{
853 #ifdef DBG_TRACE_BASIC
854 					bTraceErrHandled = false;
855 #endif
856 					pInst->Abort();
857 				}
858 
859 				// ALT: Nur
860 				// pInst->Abort();
861 			}
862 
863 #ifdef DBG_TRACE_BASIC
864 			dbg_traceNotifyError( nTraceErr, aTraceErrMsg, bTraceErrHandled, pINST->nCallLvl );
865 #endif
866 		}
867 	}
868 	return bRun;
869 }
870 
Error(SbError n,bool bVBATranslationAlreadyDone)871 void SbiRuntime::Error( SbError n, bool bVBATranslationAlreadyDone )
872 {
873 	if( n )
874 	{
875 		nError = n;
876 		if( isVBAEnabled() && !bVBATranslationAlreadyDone )
877 		{
878 			String aMsg = pInst->GetErrorMsg();
879 			sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
880 			SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject();
881 			SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
882 			if( pGlobErr != NULL )
883 				pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
884 
885 			pInst->aErrorMsg = aMsg;
886 			nError = SbERR_BASIC_COMPAT;
887 		}
888 	}
889 }
890 
Error(SbError _errCode,const String & _details)891 void SbiRuntime::Error( SbError _errCode, const String& _details )
892 {
893     if ( _errCode )
894     {
895 		// Not correct for class module usage, remove for now
896         //OSL_ENSURE( pInst->pRun == this, "SbiRuntime::Error: can't propagate the error message details!" );
897         if ( pInst->pRun == this )
898         {
899             pInst->Error( _errCode, _details );
900             //OSL_POSTCOND( nError == _errCode, "SbiRuntime::Error: the instance is expecte to propagate the error code back to me!" );
901         }
902         else
903         {
904             nError = _errCode;
905         }
906     }
907 }
908 
FatalError(SbError n)909 void SbiRuntime::FatalError( SbError n )
910 {
911 	StepSTDERROR();
912 	Error( n );
913 }
914 
FatalError(SbError _errCode,const String & _details)915 void SbiRuntime::FatalError( SbError _errCode, const String& _details )
916 {
917 	StepSTDERROR();
918 	Error( _errCode, _details );
919 }
920 
translateErrorToVba(SbError nError,String & rMsg)921 sal_Int32 SbiRuntime::translateErrorToVba( SbError nError, String& rMsg )
922 {
923 	// If a message is defined use that ( in preference to
924 	// the defined one for the error ) NB #TODO
925 	// if there is an error defined it more than likely
926 	// is not the one you want ( some are the same though )
927 	// we really need a new vba compatible error list
928 	if ( !rMsg.Len() )
929 	{
930 		// TEST, has to be vb here always
931 #ifdef DBG_UTIL
932 		SbError nTmp = StarBASIC::GetSfxFromVBError( (sal_uInt16)nError );
933 		DBG_ASSERT( nTmp, "No VB error!" );
934 #endif
935 
936 		StarBASIC::MakeErrorText( nError, rMsg );
937 		rMsg = StarBASIC::GetErrorText();
938 		if ( !rMsg.Len() ) // no message for err no, need localized resource here
939 			rMsg = String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") );
940 	}
941 	// no num? most likely then it *is* really a vba err
942 	sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
943 	sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? nError : nVBErrorCode;
944 	return nVBAErrorNumber;
945 }
946 
947 //////////////////////////////////////////////////////////////////////////
948 //
949 //	Parameter, Locals, Caller
950 //
951 //////////////////////////////////////////////////////////////////////////
952 
GetCaller()953 SbMethod* SbiRuntime::GetCaller()
954 {
955 	return pMeth;
956 }
957 
GetLocals()958 SbxArray* SbiRuntime::GetLocals()
959 {
960 	return refLocals;
961 }
962 
GetParams()963 SbxArray* SbiRuntime::GetParams()
964 {
965 	return refParams;
966 }
967 
968 //////////////////////////////////////////////////////////////////////////
969 //
970 //	Stacks
971 //
972 //////////////////////////////////////////////////////////////////////////
973 
974 // Der Expression-Stack steht fuer die laufende Auswertung von Expressions
975 // zur Verfuegung.
976 
PushVar(SbxVariable * pVar)977 void SbiRuntime::PushVar( SbxVariable* pVar )
978 {
979 	if( pVar )
980 		refExprStk->Put( pVar, nExprLvl++ );
981 }
982 
PopVar()983 SbxVariableRef SbiRuntime::PopVar()
984 {
985 #ifdef DBG_UTIL
986 	if( !nExprLvl )
987 	{
988 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
989 		return new SbxVariable;
990 	}
991 #endif
992 	SbxVariableRef xVar = refExprStk->Get( --nExprLvl );
993 #ifdef DBG_UTIL
994 	if ( xVar->GetName().EqualsAscii( "Cells" ) )
995 		DBG_TRACE( "" );
996 #endif
997 	// Methods halten im 0.Parameter sich selbst, also weghauen
998 	if( xVar->IsA( TYPE(SbxMethod) ) )
999 		xVar->SetParameters(0);
1000 	return xVar;
1001 }
1002 
ClearExprStack()1003 sal_Bool SbiRuntime::ClearExprStack()
1004 {
1005 	// Achtung: Clear() reicht nicht, da Methods geloescht werden muessen
1006 	while ( nExprLvl )
1007 	{
1008 		PopVar();
1009 	}
1010 	refExprStk->Clear();
1011 	return sal_False;
1012 }
1013 
1014 // Variable auf dem Expression-Stack holen, ohne sie zu entfernen
1015 // n zaehlt ab 0.
1016 
GetTOS(short n)1017 SbxVariable* SbiRuntime::GetTOS( short n )
1018 {
1019 	n = nExprLvl - n - 1;
1020 #ifdef DBG_UTIL
1021 	if( n < 0 )
1022 	{
1023 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1024 		return new SbxVariable;
1025 	}
1026 #endif
1027 	return refExprStk->Get( (sal_uInt16) n );
1028 }
1029 
1030 // Sicherstellen, dass TOS eine temporaere Variable ist
1031 
TOSMakeTemp()1032 void SbiRuntime::TOSMakeTemp()
1033 {
1034 	SbxVariable* p = refExprStk->Get( nExprLvl - 1 );
1035 	if( p->GetRefCount() != 1 )
1036 	{
1037 		SbxVariable* pNew = new SbxVariable( *p );
1038 		pNew->SetFlag( SBX_READWRITE );
1039 		refExprStk->Put( pNew, nExprLvl - 1 );
1040 	}
1041 }
1042 
1043 // Der GOSUB-Stack nimmt Returnadressen fuer GOSUBs auf
1044 
PushGosub(const sal_uInt8 * pc)1045 void SbiRuntime::PushGosub( const sal_uInt8* pc )
1046 {
1047 	if( ++nGosubLvl > MAXRECURSION )
1048 		StarBASIC::FatalError( SbERR_STACK_OVERFLOW );
1049 	SbiGosubStack* p = new SbiGosubStack;
1050 	p->pCode  = pc;
1051 	p->pNext  = pGosubStk;
1052 	p->nStartForLvl = nForLvl;
1053 	pGosubStk = p;
1054 }
1055 
PopGosub()1056 void SbiRuntime::PopGosub()
1057 {
1058 	if( !pGosubStk )
1059 		Error( SbERR_NO_GOSUB );
1060 	else
1061 	{
1062 		SbiGosubStack* p = pGosubStk;
1063 		pCode = p->pCode;
1064 		pGosubStk = p->pNext;
1065 		delete p;
1066 		nGosubLvl--;
1067 	}
1068 }
1069 
1070 // Entleeren des GOSUB-Stacks
1071 
ClearGosubStack()1072 void SbiRuntime::ClearGosubStack()
1073 {
1074 	SbiGosubStack* p;
1075 	while(( p = pGosubStk ) != NULL )
1076 		pGosubStk = p->pNext, delete p;
1077 	nGosubLvl = 0;
1078 }
1079 
1080 // Der Argv-Stack nimmt aktuelle Argument-Vektoren auf
1081 
PushArgv()1082 void SbiRuntime::PushArgv()
1083 {
1084 	SbiArgvStack* p = new SbiArgvStack;
1085 	p->refArgv = refArgv;
1086 	p->nArgc = nArgc;
1087 	nArgc = 1;
1088 	refArgv.Clear();
1089 	p->pNext = pArgvStk;
1090 	pArgvStk = p;
1091 }
1092 
PopArgv()1093 void SbiRuntime::PopArgv()
1094 {
1095 	if( pArgvStk )
1096 	{
1097 		SbiArgvStack* p = pArgvStk;
1098 		pArgvStk = p->pNext;
1099 		refArgv = p->refArgv;
1100 		nArgc = p->nArgc;
1101 		delete p;
1102 	}
1103 }
1104 
1105 // Entleeren des Argv-Stacks
1106 
ClearArgvStack()1107 void SbiRuntime::ClearArgvStack()
1108 {
1109 	while( pArgvStk )
1110 		PopArgv();
1111 }
1112 
1113 // Push des For-Stacks. Der Stack hat Inkrement, Ende, Beginn und Variable.
1114 // Nach Aufbau des Stack-Elements ist der Stack leer.
1115 
PushFor()1116 void SbiRuntime::PushFor()
1117 {
1118 	SbiForStack* p = new SbiForStack;
1119 	p->eForType = FOR_TO;
1120 	p->pNext = pForStk;
1121 	pForStk = p;
1122 	// Der Stack ist wie folgt aufgebaut:
1123 	p->refInc = PopVar();
1124 	p->refEnd = PopVar();
1125 	SbxVariableRef xBgn = PopVar();
1126 	p->refVar = PopVar();
1127 	*(p->refVar) = *xBgn;
1128 	nForLvl++;
1129 }
1130 
PushForEach()1131 void SbiRuntime::PushForEach()
1132 {
1133 	SbiForStack* p = new SbiForStack;
1134 	p->pNext = pForStk;
1135 	pForStk = p;
1136 
1137 	SbxVariableRef xObjVar = PopVar();
1138 	SbxBase* pObj = xObjVar.Is() ? xObjVar->GetObject() : NULL;
1139 	if( pObj == NULL )
1140 	{
1141 		Error( SbERR_NO_OBJECT );
1142 		return;
1143 	}
1144 
1145 	bool bError_ = false;
1146 	BasicCollection* pCollection;
1147 	SbxDimArray* pArray;
1148 	SbUnoObject* pUnoObj;
1149 	if( (pArray = PTR_CAST(SbxDimArray,pObj)) != NULL )
1150 	{
1151 		p->eForType = FOR_EACH_ARRAY;
1152 		p->refEnd = (SbxVariable*)pArray;
1153 
1154 		short nDims = pArray->GetDims();
1155 		p->pArrayLowerBounds = new sal_Int32[nDims];
1156 		p->pArrayUpperBounds = new sal_Int32[nDims];
1157 		p->pArrayCurIndices  = new sal_Int32[nDims];
1158 		sal_Int32 lBound, uBound;
1159 		for( short i = 0 ; i < nDims ; i++ )
1160 		{
1161 			pArray->GetDim32( i+1, lBound, uBound );
1162 			p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
1163 			p->pArrayUpperBounds[i] = uBound;
1164 		}
1165 	}
1166 	else if( (pCollection = PTR_CAST(BasicCollection,pObj)) != NULL )
1167 	{
1168 		p->eForType = FOR_EACH_COLLECTION;
1169 		p->refEnd = pCollection;
1170 		p->nCurCollectionIndex = 0;
1171 	}
1172 	else if( (pUnoObj = PTR_CAST(SbUnoObject,pObj)) != NULL )
1173 	{
1174 		// XEnumerationAccess?
1175 		Any aAny = pUnoObj->getUnoAny();
1176 		Reference< XEnumerationAccess > xEnumerationAccess;
1177 		if( (aAny >>= xEnumerationAccess) )
1178 		{
1179 			p->xEnumeration = xEnumerationAccess->createEnumeration();
1180 			p->eForType = FOR_EACH_XENUMERATION;
1181 		}
1182 		else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
1183         {
1184             uno::Reference< script::XInvocation > xInvocation;
1185             if ( ( aAny >>= xInvocation ) && xInvocation.is() )
1186             {
1187                 try
1188                 {
1189                     p->xEnumeration = new ComEnumerationWrapper( xInvocation );
1190                     p->eForType = FOR_EACH_XENUMERATION;
1191                 }
1192                 catch( uno::Exception& )
1193                 {}
1194             }
1195 
1196             if ( !p->xEnumeration.is() )
1197                 bError_ = true;
1198         }
1199         else
1200 		{
1201 			bError_ = true;
1202 		}
1203 	}
1204 	else
1205 	{
1206 		bError_ = true;
1207 	}
1208 
1209 	if( bError_ )
1210 	{
1211 		Error( SbERR_CONVERSION );
1212 		return;
1213 	}
1214 
1215 	// Container variable
1216 	p->refVar = PopVar();
1217 	nForLvl++;
1218 }
1219 
1220 // Poppen des FOR-Stacks
1221 
PopFor()1222 void SbiRuntime::PopFor()
1223 {
1224 	if( pForStk )
1225 	{
1226 		SbiForStack* p = pForStk;
1227 		pForStk = p->pNext;
1228 		delete p;
1229 		nForLvl--;
1230 	}
1231 }
1232 
1233 // Entleeren des FOR-Stacks
1234 
ClearForStack()1235 void SbiRuntime::ClearForStack()
1236 {
1237 	while( pForStk )
1238 		PopFor();
1239 }
1240 
FindForStackItemForCollection(class BasicCollection * pCollection)1241 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection* pCollection )
1242 {
1243 	SbiForStack* pRet = NULL;
1244 
1245 	SbiForStack* p = pForStk;
1246 	while( p )
1247 	{
1248 		SbxVariable* pVar = p->refEnd.Is() ? (SbxVariable*)p->refEnd : NULL;
1249 		if( p->eForType == FOR_EACH_COLLECTION && pVar != NULL &&
1250 			(pCollection = PTR_CAST(BasicCollection,pVar)) == pCollection )
1251 		{
1252 			pRet = p;
1253 			break;
1254 		}
1255 	}
1256 
1257 	return pRet;
1258 }
1259 
1260 
1261 //////////////////////////////////////////////////////////////////////////
1262 //
1263 //	DLL-Aufrufe
1264 //
1265 //////////////////////////////////////////////////////////////////////////
1266 
DllCall(const String & aFuncName,const String & aDLLName,SbxArray * pArgs,SbxDataType eResType,sal_Bool bCDecl)1267 void SbiRuntime::DllCall
1268 	( const String& aFuncName,	// Funktionsname
1269 	  const String& aDLLName,	// Name der DLL
1270 	  SbxArray* pArgs,			// Parameter (ab Index 1, kann NULL sein)
1271 	  SbxDataType eResType,		// Returnwert
1272 	  sal_Bool bCDecl )				// sal_True: nach C-Konventionen
1273 {
1274 	// No DllCall for "virtual" portal users
1275 	if( needSecurityRestrictions() )
1276 	{
1277 		StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
1278 		return;
1279 	}
1280 
1281 	// MUSS NOCH IMPLEMENTIERT WERDEN
1282 	/*
1283 	String aMsg;
1284 	aMsg = "FUNC=";
1285 	aMsg += pFunc;
1286 	aMsg += " DLL=";
1287 	aMsg += pDLL;
1288 	MessBox( NULL, WB_OK, String( "DLL-CALL" ), aMsg ).Execute();
1289 	Error( SbERR_NOT_IMPLEMENTED );
1290 	*/
1291 
1292 	SbxVariable* pRes = new SbxVariable( eResType );
1293 	SbiDllMgr* pDllMgr = pInst->GetDllMgr();
1294 	SbError nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
1295 	if( nErr )
1296 		Error( nErr );
1297 	PushVar( pRes );
1298 }
1299 
GetImageFlag(sal_uInt16 n) const1300 sal_uInt16 SbiRuntime::GetImageFlag( sal_uInt16 n ) const
1301 {
1302 	return pImg->GetFlag( n );
1303 }
1304 
GetBase()1305 sal_uInt16 SbiRuntime::GetBase()
1306 {
1307 	return pImg->GetBase();
1308 }
1309