1 /*************************************************************************
3 * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
5 * Copyright 2008 by Sun Microsystems, Inc.
7 * OpenOffice.org - a multi-platform office productivity suite
9 * $RCSfile: runtime.cxx,v $
12 * This file is part of OpenOffice.org.
14 * OpenOffice.org is free software: you can redistribute it and/or modify
15 * it under the terms of the GNU Lesser General Public License version 3
16 * only, as published by the Free Software Foundation.
18 * OpenOffice.org is distributed in the hope that it will be useful,
19 * but WITHOUT ANY WARRANTY; without even the implied warranty of
20 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 * GNU Lesser General Public License version 3 for more details
22 * (a copy is included in the LICENSE file that accompanied this code).
24 * You should have received a copy of the GNU Lesser General Public License
25 * version 3 along with OpenOffice.org. If not, see
26 * <http://www.openoffice.org/license.html>
27 * for a copy of the LGPLv3 License.
29 ************************************************************************/
31 // MARKER(update_precomp.py): autogen include statement, do not remove
32 #include "precompiled_basic.hxx"
33 #include <tools/fsys.hxx>
34 #include <vcl/svapp.hxx>
35 #include <tools/wldcrd.hxx>
36 #include <svtools/zforlist.hxx>
37 #include <svtools/syslocale.hxx>
38 #include "runtime.hxx"
39 #include "sbintern.hxx"
40 #include "opcodes.hxx"
41 #include "codegen.hxx"
44 #include "ddectrl.hxx"
46 #include <comphelper/processfactory.hxx>
47 #include <com/sun/star/container/XEnumerationAccess.hpp>
48 #include "sbunoobj.hxx"
49 #include "errobject.hxx"
51 SbxVariable
* getDefaultProp( SbxVariable
* pRef
);
53 bool SbiRuntime::isVBAEnabled()
56 SbiInstance
* pInst
= pINST
;
57 if ( pInst
&& pINST
->pRun
)
58 //result = pInst->pRun->GetImageFlag( SBIMG_VBASUPPORT );
59 result
= pInst
->pRun
->bVBAEnabled
;
63 // #91147 Global reschedule flag
64 static BOOL bStaticGlobalEnableReschedule
= TRUE
;
66 void StarBASIC::StaticEnableReschedule( BOOL bReschedule
)
68 bStaticGlobalEnableReschedule
= bReschedule
;
70 void StarBASIC::SetVBAEnabled( BOOL bEnabled
)
74 bVBAEnabled
= bEnabled
;
78 BOOL
StarBASIC::isVBAEnabled()
82 if( SbiRuntime::isVBAEnabled() )
90 struct SbiArgvStack
{ // Argv stack:
91 SbiArgvStack
* pNext
; // Stack Chain
92 SbxArrayRef refArgv
; // Argv
96 SbiRuntime::pStep0
SbiRuntime::aStep0
[] = { // Alle Opcodes ohne Operanden
100 &SbiRuntime::StepDIV
,
101 &SbiRuntime::StepMOD
,
102 &SbiRuntime::StepPLUS
,
103 &SbiRuntime::StepMINUS
,
104 &SbiRuntime::StepNEG
,
111 &SbiRuntime::StepIDIV
,
112 &SbiRuntime::StepAND
,
114 &SbiRuntime::StepXOR
,
115 &SbiRuntime::StepEQV
,
116 &SbiRuntime::StepIMP
,
117 &SbiRuntime::StepNOT
,
118 &SbiRuntime::StepCAT
,
120 &SbiRuntime::StepLIKE
,
123 &SbiRuntime::StepARGC
, // neuen Argv einrichten
124 &SbiRuntime::StepARGV
, // TOS ==> aktueller Argv
125 &SbiRuntime::StepINPUT
, // Input ==> TOS
126 &SbiRuntime::StepLINPUT
, // Line Input ==> TOS
127 &SbiRuntime::StepGET
, // TOS anfassen
128 &SbiRuntime::StepSET
, // Speichern Objekt TOS ==> TOS-1
129 &SbiRuntime::StepPUT
, // TOS ==> TOS-1
130 &SbiRuntime::StepPUTC
, // TOS ==> TOS-1, dann ReadOnly
131 &SbiRuntime::StepDIM
, // DIM
132 &SbiRuntime::StepREDIM
, // REDIM
133 &SbiRuntime::StepREDIMP
, // REDIM PRESERVE
134 &SbiRuntime::StepERASE
, // TOS loeschen
136 &SbiRuntime::StepSTOP
, // Programmende
137 &SbiRuntime::StepINITFOR
, // FOR-Variable initialisieren
138 &SbiRuntime::StepNEXT
, // FOR-Variable inkrementieren
139 &SbiRuntime::StepCASE
, // Anfang CASE
140 &SbiRuntime::StepENDCASE
, // Ende CASE
141 &SbiRuntime::StepSTDERROR
, // Standard-Fehlerbehandlung
142 &SbiRuntime::StepNOERROR
, // keine Fehlerbehandlung
143 &SbiRuntime::StepLEAVE
, // UP verlassen
145 &SbiRuntime::StepCHANNEL
, // TOS = Kanalnummer
146 &SbiRuntime::StepPRINT
, // print TOS
147 &SbiRuntime::StepPRINTF
, // print TOS in field
148 &SbiRuntime::StepWRITE
, // write TOS
149 &SbiRuntime::StepRENAME
, // Rename Tos+1 to Tos
150 &SbiRuntime::StepPROMPT
, // Input Prompt aus TOS definieren
151 &SbiRuntime::StepRESTART
, // Set restart point
152 &SbiRuntime::StepCHANNEL0
, // E/A-Kanal 0 einstellen
153 &SbiRuntime::StepEMPTY
, // Leeren Ausdruck auf Stack
154 &SbiRuntime::StepERROR
, // TOS = Fehlercode
155 &SbiRuntime::StepLSET
, // Speichern Objekt TOS ==> TOS-1
156 &SbiRuntime::StepRSET
, // Speichern Objekt TOS ==> TOS-1
157 &SbiRuntime::StepREDIMP_ERASE
,// Copy array object for REDIMP
158 &SbiRuntime::StepINITFOREACH
,// Init for each loop
159 &SbiRuntime::StepVBASET
,// vba-like set statement
160 &SbiRuntime::StepERASE_CLEAR
,// vba-like set statement
161 &SbiRuntime::StepARRAYACCESS
,// access TOS as array
164 SbiRuntime::pStep1
SbiRuntime::aStep1
[] = { // Alle Opcodes mit einem Operanden
165 &SbiRuntime::StepLOADNC
, // Laden einer numerischen Konstanten (+ID)
166 &SbiRuntime::StepLOADSC
, // Laden einer Stringkonstanten (+ID)
167 &SbiRuntime::StepLOADI
, // Immediate Load (+Wert)
168 &SbiRuntime::StepARGN
, // Speichern eines named Args in Argv (+StringID)
169 &SbiRuntime::StepPAD
, // String auf feste Laenge bringen (+Laenge)
171 &SbiRuntime::StepJUMP
, // Sprung (+Target)
172 &SbiRuntime::StepJUMPT
, // TOS auswerten), bedingter Sprung (+Target)
173 &SbiRuntime::StepJUMPF
, // TOS auswerten), bedingter Sprung (+Target)
174 &SbiRuntime::StepONJUMP
, // TOS auswerten), Sprung in JUMP-Tabelle (+MaxVal)
175 &SbiRuntime::StepGOSUB
, // UP-Aufruf (+Target)
176 &SbiRuntime::StepRETURN
, // UP-Return (+0 oder Target)
177 &SbiRuntime::StepTESTFOR
, // FOR-Variable testen), inkrementieren (+Endlabel)
178 &SbiRuntime::StepCASETO
, // Tos+1 <= Case <= Tos), 2xremove (+Target)
179 &SbiRuntime::StepERRHDL
, // Fehler-Handler (+Offset)
180 &SbiRuntime::StepRESUME
, // Resume nach Fehlern (+0 or 1 or Label)
182 &SbiRuntime::StepCLOSE
, // (+Kanal/0)
183 &SbiRuntime::StepPRCHAR
, // (+char)
185 &SbiRuntime::StepSETCLASS
, // Set + Klassennamen testen (+StringId)
186 &SbiRuntime::StepTESTCLASS
, // Check TOS class (+StringId)
187 &SbiRuntime::StepLIB
, // Lib fuer Declare-Call (+StringId)
188 &SbiRuntime::StepBASED
, // TOS wird um BASE erhoeht, BASE davor gepusht
189 &SbiRuntime::StepARGTYP
, // Letzten Parameter in Argv konvertieren (+Typ)
190 &SbiRuntime::StepVBASETCLASS
,// vba-like set statement
193 SbiRuntime::pStep2
SbiRuntime::aStep2
[] = {// Alle Opcodes mit zwei Operanden
194 &SbiRuntime::StepRTL
, // Laden aus RTL (+StringID+Typ)
195 &SbiRuntime::StepFIND
, // Laden (+StringID+Typ)
196 &SbiRuntime::StepELEM
, // Laden Element (+StringID+Typ)
197 &SbiRuntime::StepPARAM
, // Parameter (+Offset+Typ)
199 &SbiRuntime::StepCALL
, // Declare-Call (+StringID+Typ)
200 &SbiRuntime::StepCALLC
, // CDecl-Declare-Call (+StringID+Typ)
201 &SbiRuntime::StepCASEIS
, // Case-Test (+Test-Opcode+False-Target)
203 &SbiRuntime::StepSTMNT
, // Beginn eines Statements (+Line+Col)
205 &SbiRuntime::StepOPEN
, // (+SvStreamFlags+Flags)
207 &SbiRuntime::StepLOCAL
, // Lokale Variable definieren (+StringId+Typ)
208 &SbiRuntime::StepPUBLIC
, // Modulglobale Variable (+StringID+Typ)
209 &SbiRuntime::StepGLOBAL
, // Globale Variable definieren (+StringID+Typ)
210 &SbiRuntime::StepCREATE
, // Objekt kreieren (+StringId+StringId)
211 &SbiRuntime::StepSTATIC
, // Statische Variable (+StringId+StringId)
212 &SbiRuntime::StepTCREATE
, // User Defined Objekte (+StringId+StringId)
213 &SbiRuntime::StepDCREATE
, // Objekt-Array kreieren (+StringID+StringID)
214 &SbiRuntime::StepGLOBAL_P
, // Globale Variable definieren, die beim Neustart
215 // von Basic nicht ueberschrieben wird (+StringID+Typ)
216 &SbiRuntime::StepFIND_G
, // Sucht globale Variable mit Spezialbehandlung wegen _GLOBAL_P
217 &SbiRuntime::StepDCREATE_REDIMP
, // Objekt-Array redimensionieren (+StringID+StringID)
218 &SbiRuntime::StepFIND_CM
, // Search inside a class module (CM) to enable global search in time
219 &SbiRuntime::StepPUBLIC_P
, // Search inside a class module (CM) to enable global search in time
220 &SbiRuntime::StepFIND_STATIC
, // Search inside a class module (CM) to enable global search in time
224 //////////////////////////////////////////////////////////////////////////
226 //////////////////////////////////////////////////////////////////////////
228 SbiRTLData::SbiRTLData()
236 SbiRTLData::~SbiRTLData()
243 //////////////////////////////////////////////////////////////////////////
245 //////////////////////////////////////////////////////////////////////////
247 // 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out
248 // Die Entscheidung, ob StepPoint aufgerufen werden soll, wird anhand des
249 // CallLevels getroffen. Angehalten wird, wenn der aktuelle CallLevel <=
250 // nBreakCallLvl ist. Der aktuelle CallLevel kann niemals kleiner als 1
251 // sein, da er beim Aufruf einer Methode (auch main) inkrementiert wird.
252 // Daher bedeutet ein BreakCallLvl von 0, dass das Programm gar nicht
254 // (siehe auch step2.cxx, SbiRuntime::StepSTMNT() )
256 // Hilfsfunktion, um den BreakCallLevel gemaess der der Debug-Flags zu ermitteln
257 void SbiInstance::CalcBreakCallLevel( USHORT nFlags
)
259 // Break-Flag wegfiltern
260 nFlags
&= ~((USHORT
)SbDEBUG_BREAK
);
265 case SbDEBUG_STEPINTO
:
266 nRet
= nCallLvl
+ 1; // CallLevel+1 wird auch angehalten
268 case SbDEBUG_STEPOVER
| SbDEBUG_STEPINTO
:
269 nRet
= nCallLvl
; // Aktueller CallLevel wird angehalten
271 case SbDEBUG_STEPOUT
:
272 nRet
= nCallLvl
- 1; // Kleinerer CallLevel wird angehalten
274 case SbDEBUG_CONTINUE
:
275 // Basic-IDE liefert 0 statt SbDEBUG_CONTINUE, also auch default=continue
277 nRet
= 0; // CallLevel ist immer >0 -> kein StepPoint
279 nBreakCallLvl
= nRet
; // Ergebnis uebernehmen
282 SbiInstance::SbiInstance( StarBASIC
* p
)
287 pIosys
= new SbiIoSystem
;
288 pDdeCtrl
= new SbiDdeControl
;
289 pDllMgr
= 0; // on demand
290 pNumberFormatter
= 0; // on demand
296 bCompatibility
= FALSE
;
299 SbiInstance::~SbiInstance()
303 SbiRuntime
* p
= pRun
->pNext
;
310 delete pNumberFormatter
;
314 int nSize
= ComponentVector
.size();
317 for( int i
= nSize
- 1 ; i
>= 0 ; --i
)
319 Reference
< XComponent
> xDlgComponent
= ComponentVector
[i
];
320 if( xDlgComponent
.is() )
321 xDlgComponent
->dispose();
325 catch( const Exception
& )
327 DBG_ERROR( "SbiInstance::~SbiInstance: caught an exception while disposing the components!" );
330 ComponentVector
.clear();
333 SbiDllMgr
* SbiInstance::GetDllMgr()
336 pDllMgr
= new SbiDllMgr
;
340 // #39629 NumberFormatter jetzt ueber statische Methode anlegen
341 SvNumberFormatter
* SbiInstance::GetNumberFormatter()
343 LanguageType eLangType
= GetpApp()->GetSettings().GetLanguage();
344 SvtSysLocale aSysLocale
;
345 DateFormat eDate
= aSysLocale
.GetLocaleData().getDateFormat();
346 if( pNumberFormatter
)
348 if( eLangType
!= meFormatterLangType
||
349 eDate
!= meFormatterDateFormat
)
351 delete pNumberFormatter
;
352 pNumberFormatter
= NULL
;
355 meFormatterLangType
= eLangType
;
356 meFormatterDateFormat
= eDate
;
357 if( !pNumberFormatter
)
358 PrepareNumberFormatter( pNumberFormatter
, nStdDateIdx
, nStdTimeIdx
, nStdDateTimeIdx
,
359 &meFormatterLangType
, &meFormatterDateFormat
);
360 return pNumberFormatter
;
363 // #39629 NumberFormatter auch statisch anbieten
364 void SbiInstance::PrepareNumberFormatter( SvNumberFormatter
*& rpNumberFormatter
,
365 sal_uInt32
&rnStdDateIdx
, sal_uInt32
&rnStdTimeIdx
, sal_uInt32
&rnStdDateTimeIdx
,
366 LanguageType
* peFormatterLangType
, DateFormat
* peFormatterDateFormat
)
368 com::sun::star::uno::Reference
< com::sun::star::lang::XMultiServiceFactory
>
369 xFactory
= comphelper::getProcessServiceFactory();
371 LanguageType eLangType
;
372 if( peFormatterLangType
)
373 eLangType
= *peFormatterLangType
;
375 eLangType
= GetpApp()->GetSettings().GetLanguage();
378 if( peFormatterDateFormat
)
379 eDate
= *peFormatterDateFormat
;
382 SvtSysLocale aSysLocale
;
383 eDate
= aSysLocale
.GetLocaleData().getDateFormat();
386 rpNumberFormatter
= new SvNumberFormatter( xFactory
, eLangType
);
388 xub_StrLen nCheckPos
= 0; short nType
;
389 rnStdTimeIdx
= rpNumberFormatter
->GetStandardFormat( NUMBERFORMAT_TIME
, eLangType
);
391 // Standard-Vorlagen des Formatters haben nur zweistellige
392 // Jahreszahl. Deshalb eigenes Format registrieren
394 // HACK, da der Numberformatter in PutandConvertEntry die Platzhalter
395 // fuer Monat, Tag, Jahr nicht entsprechend der Systemeinstellung
396 // austauscht. Problem: Print Year(Date) unter engl. BS
397 // siehe auch svtools\source\sbx\sbxdate.cxx
402 case MDY
: aDateStr
= String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") ); break;
403 case DMY
: aDateStr
= String( RTL_CONSTASCII_USTRINGPARAM("TT.MM.JJJJ") ); break;
404 case YMD
: aDateStr
= String( RTL_CONSTASCII_USTRINGPARAM("JJJJ.MM.TT") ); break;
405 default: aDateStr
= String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") );
407 String
aStr( aDateStr
);
408 rpNumberFormatter
->PutandConvertEntry( aStr
, nCheckPos
, nType
,
409 rnStdDateIdx
, LANGUAGE_GERMAN
, eLangType
);
411 String
aStrHHMMSS( RTL_CONSTASCII_USTRINGPARAM(" HH:MM:SS") );
414 rpNumberFormatter
->PutandConvertEntry( aStr
, nCheckPos
, nType
,
415 rnStdDateTimeIdx
, LANGUAGE_GERMAN
, eLangType
);
420 // Engine laufenlassen. Falls Flags == SbDEBUG_CONTINUE, Flags uebernehmen
422 void SbiInstance::Stop()
424 for( SbiRuntime
* p
= pRun
; p
; p
= p
->pNext
)
428 // Allows Basic IDE to set watch mode to suppress errors
429 static bool bWatchMode
= false;
431 void setBasicWatchMode( bool bOn
)
436 void SbiInstance::Error( SbError n
)
438 Error( n
, String() );
441 void SbiInstance::Error( SbError n
, const String
& rMsg
)
450 void SbiInstance::FatalError( SbError n
)
452 pRun
->FatalError( n
);
455 void SbiInstance::FatalError( SbError _errCode
, const String
& _details
)
457 pRun
->FatalError( _errCode
, _details
);
460 void SbiInstance::Abort()
462 // Basic suchen, in dem der Fehler auftrat
463 StarBASIC
* pErrBasic
= GetCurrentBasic( pBasic
);
464 pErrBasic
->RTError( nErr
, aErrorMsg
, pRun
->nLine
, pRun
->nCol1
, pRun
->nCol2
);
468 // Hilfsfunktion, um aktives Basic zu finden, kann ungleich pRTBasic sein
469 StarBASIC
* GetCurrentBasic( StarBASIC
* pRTBasic
)
471 StarBASIC
* pCurBasic
= pRTBasic
;
472 SbModule
* pActiveModule
= pRTBasic
->GetActiveModule();
475 SbxObject
* pParent
= pActiveModule
->GetParent();
476 if( pParent
&& pParent
->ISA(StarBASIC
) )
477 pCurBasic
= (StarBASIC
*)pParent
;
482 SbModule
* SbiInstance::GetActiveModule()
485 return pRun
->GetModule();
490 SbMethod
* SbiInstance::GetCaller( USHORT nLevel
)
492 SbiRuntime
* p
= pRun
;
493 while( nLevel
-- && p
)
496 return p
->GetCaller();
501 SbxArray
* SbiInstance::GetLocals( SbMethod
* pMeth
)
503 SbiRuntime
* p
= pRun
;
504 while( p
&& p
->GetMethod() != pMeth
)
507 return p
->GetLocals();
512 //////////////////////////////////////////////////////////////////////////
514 //////////////////////////////////////////////////////////////////////////
516 // Achtung: pMeth kann auch NULL sein (beim Aufruf des Init-Codes)
518 SbiRuntime::SbiRuntime( SbModule
* pm
, SbMethod
* pe
, UINT32 nStart
)
519 : rBasic( *(StarBASIC
*)pm
->pParent
), pInst( pINST
),
520 pMod( pm
), pMeth( pe
), pImg( pMod
->pImage
), mpExtCaller(0), m_nLastTime(0)
522 nFlags
= pe
? pe
->GetDebugFlags() : 0;
523 pIosys
= pInst
->pIosys
;
533 pStmnt
= (const BYTE
* ) pImg
->GetCode() + nStart
;
547 refExprStk
= new SbxArray
;
548 SetVBAEnabled( pMod
->IsVBACompat() );
550 SetParameters( pe
? pe
->GetParameters() : (class SbxArray
*)NULL
);
552 SetParameters( pe
? pe
->GetParameters() : NULL
);
555 pItemStoreList
= NULL
;
558 SbiRuntime::~SbiRuntime()
564 // #74254 Items zum Sichern temporaere Referenzen freigeben
566 while( pItemStoreList
)
568 RefSaveItem
* pToDeleteItem
= pItemStoreList
;
569 pItemStoreList
= pToDeleteItem
->pNext
;
570 delete pToDeleteItem
;
574 void SbiRuntime::SetVBAEnabled(bool bEnabled
)
576 bVBAEnabled
= bEnabled
;
580 mpExtCaller
= pMeth
->mCaller
;
586 // Aufbau der Parameterliste. Alle ByRef-Parameter werden direkt
587 // uebernommen; von ByVal-Parametern werden Kopien angelegt. Falls
588 // ein bestimmter Datentyp verlangt wird, wird konvertiert.
590 void SbiRuntime::SetParameters( SbxArray
* pParams
)
592 refParams
= new SbxArray
;
593 // fuer den Returnwert
594 refParams
->Put( pMeth
, 0 );
596 SbxInfo
* pInfo
= pMeth
? pMeth
->GetInfo() : NULL
;
597 USHORT nParamCount
= pParams
? pParams
->Count() : 1;
598 if( nParamCount
> 1 )
600 for( USHORT i
= 1 ; i
< nParamCount
; i
++ )
602 const SbxParamInfo
* p
= pInfo
? pInfo
->GetParam( i
) : NULL
;
604 // #111897 ParamArray
605 if( p
&& (p
->nUserData
& PARAM_INFO_PARAMARRAY
) != 0 )
607 SbxDimArray
* pArray
= new SbxDimArray( SbxVARIANT
);
608 USHORT nParamArrayParamCount
= nParamCount
- i
;
609 pArray
->unoAddDim( 0, nParamArrayParamCount
- 1 );
610 for( USHORT j
= i
; j
< nParamCount
; j
++ )
612 SbxVariable
* v
= pParams
->Get( j
);
613 short nDimIndex
= j
- i
;
614 pArray
->Put( v
, &nDimIndex
);
616 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
617 pArrayVar
->SetFlag( SBX_READWRITE
);
618 pArrayVar
->PutObject( pArray
);
619 refParams
->Put( pArrayVar
, i
);
621 // Block ParamArray for missing parameter
626 SbxVariable
* v
= pParams
->Get( i
);
627 // Methoden sind immer byval!
628 BOOL bByVal
= v
->IsA( TYPE(SbxMethod
) );
629 SbxDataType t
= v
->GetType();
632 bByVal
|= BOOL( ( p
->eType
& SbxBYREF
) == 0 );
633 t
= (SbxDataType
) ( p
->eType
& 0x0FFF );
635 if( !bByVal
&& t
!= SbxVARIANT
&&
636 (!v
->IsFixed() || (SbxDataType
)(v
->GetType() & 0x0FFF ) != t
) )
641 SbxVariable
* v2
= new SbxVariable( t
);
642 v2
->SetFlag( SBX_READWRITE
);
644 refParams
->Put( v2
, i
);
648 if( t
!= SbxVARIANT
&& t
!= ( v
->GetType() & 0x0FFF ) )
650 // Array konvertieren??
651 if( p
&& (p
->eType
& SbxARRAY
) )
652 Error( SbERR_CONVERSION
);
656 refParams
->Put( v
, i
);
659 refParams
->PutAlias( p
->aName
, i
);
663 // ParamArray for missing parameter
666 // #111897 Check first missing parameter for ParamArray
667 const SbxParamInfo
* p
= pInfo
->GetParam( nParamCount
);
668 if( p
&& (p
->nUserData
& PARAM_INFO_PARAMARRAY
) != 0 )
670 SbxDimArray
* pArray
= new SbxDimArray( SbxVARIANT
);
671 pArray
->unoAddDim( 0, -1 );
672 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
673 pArrayVar
->SetFlag( SBX_READWRITE
);
674 pArrayVar
->PutObject( pArray
);
675 refParams
->Put( pArrayVar
, nParamCount
);
681 // Einen P-Code ausfuehren
683 BOOL
SbiRuntime::Step()
687 // Unbedingt gelegentlich die Kontrolle abgeben!
688 if( !( ++nOps
& 0xF ) && pInst
->IsReschedule() && bStaticGlobalEnableReschedule
)
690 sal_uInt32 nTime
= osl_getGlobalTimer();
691 if (nTime
- m_nLastTime
> 5 ) // 20 ms
693 Application::Reschedule();
698 // #i48868 blocked by next call level?
701 if( pInst
->IsReschedule() && bStaticGlobalEnableReschedule
)
702 Application::Reschedule();
704 SbiOpcode eOp
= (SbiOpcode
) ( *pCode
++ );
706 if( eOp
<= SbOP0_END
)
708 (this->*( aStep0
[ eOp
] ) )();
710 else if( eOp
>= SbOP1_START
&& eOp
<= SbOP1_END
)
712 nOp1
= *pCode
++; nOp1
|= *pCode
++ << 8; nOp1
|= *pCode
++ << 16; nOp1
|= *pCode
++ << 24;
714 (this->*( aStep1
[ eOp
- SbOP1_START
] ) )( nOp1
);
716 else if( eOp
>= SbOP2_START
&& eOp
<= SbOP2_END
)
718 nOp1
= *pCode
++; nOp1
|= *pCode
++ << 8; nOp1
|= *pCode
++ << 16; nOp1
|= *pCode
++ << 24;
719 nOp2
= *pCode
++; nOp2
|= *pCode
++ << 8; nOp2
|= *pCode
++ << 16; nOp2
|= *pCode
++ << 24;
720 (this->*( aStep2
[ eOp
- SbOP2_START
] ) )( nOp1
, nOp2
);
723 StarBASIC::FatalError( SbERR_INTERNAL_ERROR
);
725 // SBX-Fehler aufgetreten?
726 SbError nSbError
= SbxBase::GetError();
727 Error( ERRCODE_TOERROR(nSbError
) ); // Warnings rausfiltern
729 // AB 13.2.1997, neues Error-Handling:
730 // ACHTUNG: Hier kann nError auch dann gesetzt sein, wenn !nSbError,
731 // da nError jetzt auch von anderen RT-Instanzen gesetzt werden kann
734 SbxBase::ResetError();
736 // AB,15.3.96: Fehler nur anzeigen, wenn BASIC noch aktiv
737 // (insbesondere nicht nach Compiler-Fehlern zur Laufzeit)
740 SbError err
= nError
;
747 // An error occured in an error handler
748 // force parent handler ( if there is one )
749 // to handle the error
750 bool bLetParentHandleThis
= false;
752 // Im Error Handler? Dann Std-Error
757 if( !bError
) // On Error Resume Next
759 else if( pError
) // On Error Goto ...
762 bLetParentHandleThis
= true;
766 bLetParentHandleThis
= true;
767 pError
= NULL
; //terminate the handler
769 if ( bLetParentHandleThis
)
771 // AB 13.2.1997, neues Error-Handling:
772 // Uebergeordnete Error-Handler beruecksichtigen
774 // Wir haben keinen Error-Handler -> weiter oben suchen
775 SbiRuntime
* pRtErrHdl
= NULL
;
776 SbiRuntime
* pRt
= this;
777 while( NULL
!= (pRt
= pRt
->pNext
) )
779 // Gibt es einen Error-Handler?
780 if( pRt
->bError
== FALSE
|| pRt
->pError
!= NULL
)
787 // Error-Hdl gefunden?
790 // (Neuen) Error-Stack anlegen
791 SbErrorStack
*& rErrStack
= GetSbData()->pErrStack
;
794 rErrStack
= new SbErrorStack();
796 // Alle im Call-Stack darunter stehenden RTs manipulieren
802 if( pRt
!= pRtErrHdl
)
805 // In Error-Stack eintragen
806 SbErrorStackEntry
*pEntry
= new SbErrorStackEntry
807 ( pRt
->pMeth
, pRt
->nLine
, pRt
->nCol1
, pRt
->nCol2
);
808 rErrStack
->C40_INSERT(SbErrorStackEntry
, pEntry
, rErrStack
->Count() );
810 // Nach RT mit Error-Handler aufhoeren
811 if( pRt
== pRtErrHdl
)
817 // Kein Error-Hdl gefunden -> altes Vorgehen
831 void SbiRuntime::Error( SbError n
)
836 if ( isVBAEnabled() )
838 String aMsg
= pInst
->GetErrorMsg();
839 // If a message is defined use that ( in preference to
840 // the defined one for the error ) NB #TODO
841 // if there is an error defined it more than likely
842 // is not the one you want ( some are the same though )
843 // we really need a new vba compatible error list
846 StarBASIC::MakeErrorText( n
, aMsg
);
847 aMsg
= StarBASIC::GetErrorText();
848 if ( !aMsg
.Len() ) // no message for err no.
849 // need localized resource here
850 aMsg
= String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") );
852 // no num? most likely then it *is* really a vba err
853 SbxErrObject::getUnoErrObject()->setNumber( ( StarBASIC::GetVBErrorCode( n
) == 0 ) ? n
: StarBASIC::GetVBErrorCode( n
) );
854 SbxErrObject::getUnoErrObject()->setDescription( aMsg
);
856 // prepend an error number to the message.
858 aTmp
+= String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() );
859 aTmp
+= String( RTL_CONSTASCII_USTRINGPARAM("\'\n") );
862 pInst
->aErrorMsg
= aTmp
;
863 nError
= SbERR_BASIC_COMPAT
;
868 void SbiRuntime::Error( SbError _errCode
, const String
& _details
)
872 OSL_ENSURE( pInst
->pRun
== this, "SbiRuntime::Error: can't propagate the error message details!" );
873 if ( pInst
->pRun
== this )
875 pInst
->Error( _errCode
, _details
);
876 OSL_POSTCOND( nError
== _errCode
, "SbiRuntime::Error: the instance is expecte to propagate the error code back to me!" );
885 void SbiRuntime::FatalError( SbError n
)
891 void SbiRuntime::FatalError( SbError _errCode
, const String
& _details
)
894 Error( _errCode
, _details
);
897 //////////////////////////////////////////////////////////////////////////
899 // Parameter, Locals, Caller
901 //////////////////////////////////////////////////////////////////////////
903 SbMethod
* SbiRuntime::GetCaller()
908 SbxArray
* SbiRuntime::GetLocals()
913 SbxArray
* SbiRuntime::GetParams()
918 //////////////////////////////////////////////////////////////////////////
922 //////////////////////////////////////////////////////////////////////////
924 // Der Expression-Stack steht fuer die laufende Auswertung von Expressions
927 void SbiRuntime::PushVar( SbxVariable
* pVar
)
930 refExprStk
->Put( pVar
, nExprLvl
++ );
933 SbxVariableRef
SbiRuntime::PopVar()
938 StarBASIC::FatalError( SbERR_INTERNAL_ERROR
);
939 return new SbxVariable
;
942 SbxVariableRef xVar
= refExprStk
->Get( --nExprLvl
);
944 if ( xVar
->GetName().EqualsAscii( "Cells" ) )
947 // Methods halten im 0.Parameter sich selbst, also weghauen
948 if( xVar
->IsA( TYPE(SbxMethod
) ) )
949 xVar
->SetParameters(0);
953 BOOL
SbiRuntime::ClearExprStack()
955 // Achtung: Clear() reicht nicht, da Methods geloescht werden muessen
964 // Variable auf dem Expression-Stack holen, ohne sie zu entfernen
967 SbxVariable
* SbiRuntime::GetTOS( short n
)
969 n
= nExprLvl
- n
- 1;
973 StarBASIC::FatalError( SbERR_INTERNAL_ERROR
);
974 return new SbxVariable
;
977 return refExprStk
->Get( (USHORT
) n
);
980 // Sicherstellen, dass TOS eine temporaere Variable ist
982 void SbiRuntime::TOSMakeTemp()
984 SbxVariable
* p
= refExprStk
->Get( nExprLvl
- 1 );
985 if ( p
->GetType() == SbxEMPTY
)
986 p
->Broadcast( SBX_HINT_DATAWANTED
);
988 SbxVariable
* pDflt
= NULL
;
989 if ( bVBAEnabled
&& ( p
->GetType() == SbxOBJECT
|| p
->GetType() == SbxVARIANT
) && ( pDflt
= getDefaultProp( p
) ) )
991 pDflt
->Broadcast( SBX_HINT_DATAWANTED
);
992 // replacing new p on stack causes object pointed by
993 // pDft->pParent to be deleted, when p2->Compute() is
994 // called below pParent is accessed ( but its deleted )
995 // so set it to NULL now
996 pDflt
->SetParent( NULL
);
997 p
= new SbxVariable( *pDflt
);
998 p
->SetFlag( SBX_READWRITE
);
999 refExprStk
->Put( p
, nExprLvl
- 1 );
1003 else if( p
->GetRefCount() != 1 )
1005 SbxVariable
* pNew
= new SbxVariable( *p
);
1006 pNew
->SetFlag( SBX_READWRITE
);
1007 refExprStk
->Put( pNew
, nExprLvl
- 1 );
1011 // Der GOSUB-Stack nimmt Returnadressen fuer GOSUBs auf
1012 void SbiRuntime::PushGosub( const BYTE
* pc
)
1014 if( ++nGosubLvl
> MAXRECURSION
)
1015 StarBASIC::FatalError( SbERR_STACK_OVERFLOW
);
1016 SbiGosubStack
* p
= new SbiGosubStack
;
1018 p
->pNext
= pGosubStk
;
1019 p
->nStartForLvl
= nForLvl
;
1023 void SbiRuntime::PopGosub()
1026 Error( SbERR_NO_GOSUB
);
1029 SbiGosubStack
* p
= pGosubStk
;
1031 pGosubStk
= p
->pNext
;
1037 // Entleeren des GOSUB-Stacks
1039 void SbiRuntime::ClearGosubStack()
1042 while(( p
= pGosubStk
) != NULL
)
1043 pGosubStk
= p
->pNext
, delete p
;
1047 // Der Argv-Stack nimmt aktuelle Argument-Vektoren auf
1049 void SbiRuntime::PushArgv()
1051 SbiArgvStack
* p
= new SbiArgvStack
;
1052 p
->refArgv
= refArgv
;
1056 p
->pNext
= pArgvStk
;
1060 void SbiRuntime::PopArgv()
1064 SbiArgvStack
* p
= pArgvStk
;
1065 pArgvStk
= p
->pNext
;
1066 refArgv
= p
->refArgv
;
1072 // Entleeren des Argv-Stacks
1074 void SbiRuntime::ClearArgvStack()
1080 // Push des For-Stacks. Der Stack hat Inkrement, Ende, Beginn und Variable.
1081 // Nach Aufbau des Stack-Elements ist der Stack leer.
1083 void SbiRuntime::PushFor()
1085 SbiForStack
* p
= new SbiForStack
;
1086 p
->eForType
= FOR_TO
;
1089 // Der Stack ist wie folgt aufgebaut:
1090 p
->refInc
= PopVar();
1091 p
->refEnd
= PopVar();
1092 SbxVariableRef xBgn
= PopVar();
1093 p
->refVar
= PopVar();
1094 *(p
->refVar
) = *xBgn
;
1098 void SbiRuntime::PushForEach()
1100 SbiForStack
* p
= new SbiForStack
;
1104 SbxVariableRef xObjVar
= PopVar();
1105 SbxBase
* pObj
= xObjVar
.Is() ? xObjVar
->GetObject() : NULL
;
1108 Error( SbERR_NO_OBJECT
);
1112 bool bError_
= false;
1113 BasicCollection
* pCollection
;
1114 SbxDimArray
* pArray
;
1115 SbUnoObject
* pUnoObj
;
1116 if( (pArray
= PTR_CAST(SbxDimArray
,pObj
)) != NULL
)
1118 p
->eForType
= FOR_EACH_ARRAY
;
1119 p
->refEnd
= (SbxVariable
*)pArray
;
1121 short nDims
= pArray
->GetDims();
1122 p
->pArrayLowerBounds
= new sal_Int32
[nDims
];
1123 p
->pArrayUpperBounds
= new sal_Int32
[nDims
];
1124 p
->pArrayCurIndices
= new sal_Int32
[nDims
];
1125 sal_Int32 lBound
, uBound
;
1126 for( short i
= 0 ; i
< nDims
; i
++ )
1128 pArray
->GetDim32( i
+1, lBound
, uBound
);
1129 p
->pArrayCurIndices
[i
] = p
->pArrayLowerBounds
[i
] = lBound
;
1130 p
->pArrayUpperBounds
[i
] = uBound
;
1133 else if( (pCollection
= PTR_CAST(BasicCollection
,pObj
)) != NULL
)
1135 p
->eForType
= FOR_EACH_COLLECTION
;
1136 p
->refEnd
= pCollection
;
1137 p
->nCurCollectionIndex
= 0;
1139 else if( (pUnoObj
= PTR_CAST(SbUnoObject
,pObj
)) != NULL
)
1141 // XEnumerationAccess?
1142 Any aAny
= pUnoObj
->getUnoAny();
1143 Reference
< XEnumerationAccess
> xEnumerationAccess
;
1144 if( (aAny
>>= xEnumerationAccess
) )
1146 p
->xEnumeration
= xEnumerationAccess
->createEnumeration();
1147 p
->eForType
= FOR_EACH_XENUMERATION
;
1161 Error( SbERR_CONVERSION
);
1165 // Container variable
1166 p
->refVar
= PopVar();
1170 // Poppen des FOR-Stacks
1172 void SbiRuntime::PopFor()
1176 SbiForStack
* p
= pForStk
;
1183 // Entleeren des FOR-Stacks
1185 void SbiRuntime::ClearForStack()
1191 //////////////////////////////////////////////////////////////////////////
1195 //////////////////////////////////////////////////////////////////////////
1197 void SbiRuntime::DllCall
1198 ( const String
& aFuncName
, // Funktionsname
1199 const String
& aDLLName
, // Name der DLL
1200 SbxArray
* pArgs
, // Parameter (ab Index 1, kann NULL sein)
1201 SbxDataType eResType
, // Returnwert
1202 BOOL bCDecl
) // TRUE: nach C-Konventionen
1204 // No DllCall for "virtual" portal users
1205 if( needSecurityRestrictions() )
1207 StarBASIC::Error(SbERR_NOT_IMPLEMENTED
);
1211 // MUSS NOCH IMPLEMENTIERT WERDEN
1218 MessBox( NULL, WB_OK, String( "DLL-CALL" ), aMsg ).Execute();
1219 Error( SbERR_NOT_IMPLEMENTED );
1222 SbxVariable
* pRes
= new SbxVariable( eResType
);
1223 SbiDllMgr
* pDllMgr
= pInst
->GetDllMgr();
1224 ByteString
aByteFuncName( aFuncName
, gsl_getSystemTextEncoding() );
1225 ByteString
aByteDLLName( aDLLName
, gsl_getSystemTextEncoding() );
1226 SbError nErr
= pDllMgr
->Call( aByteFuncName
.GetBuffer(), aByteDLLName
.GetBuffer(), pArgs
, *pRes
, bCDecl
);
1232 SbiRuntime::GetImageFlag( USHORT n
) const
1234 return pImg
->GetFlag( n
);
1237 SbiRuntime::GetBase()
1239 return pImg
->GetBase();