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