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
27 #include <stdlib.h>
28 #include <rtl/math.hxx>
29 #include <basic/sbuno.hxx>
30 #include "runtime.hxx"
31 #include "sbintern.hxx"
32 #include "iosys.hxx"
33 #include "image.hxx"
34 #include "sbunoobj.hxx"
35 #include "errobject.hxx"
36
37 bool checkUnoObjectType( SbUnoObject* refVal, const ::rtl::OUString& aClass );
38
39 // Laden einer numerischen Konstanten (+ID)
40
StepLOADNC(sal_uInt32 nOp1)41 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
42 {
43 SbxVariable* p = new SbxVariable( SbxDOUBLE );
44
45 // #57844 Lokalisierte Funktion benutzen
46 String aStr = pImg->GetString( static_cast<short>( nOp1 ) );
47 // Auch , zulassen !!!
48 sal_uInt16 iComma = aStr.Search( ',' );
49 if( iComma != STRING_NOTFOUND )
50 {
51 String aStr1 = aStr.Copy( 0, iComma );
52 String aStr2 = aStr.Copy( iComma + 1 );
53 aStr = aStr1;
54 aStr += '.';
55 aStr += aStr2;
56 }
57 double n = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
58
59 p->PutDouble( n );
60 PushVar( p );
61 }
62
63 // Laden einer Stringkonstanten (+ID)
64
StepLOADSC(sal_uInt32 nOp1)65 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
66 {
67 SbxVariable* p = new SbxVariable;
68 p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
69 PushVar( p );
70 }
71
72 // Immediate Load (+Wert)
73
StepLOADI(sal_uInt32 nOp1)74 void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
75 {
76 SbxVariable* p = new SbxVariable;
77 p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
78 PushVar( p );
79 }
80
81 // Speichern eines named Arguments in Argv (+Arg-Nr ab 1!)
82
StepARGN(sal_uInt32 nOp1)83 void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
84 {
85 if( !refArgv )
86 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
87 else
88 {
89 String aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
90 SbxVariableRef pVal = PopVar();
91 refArgv->Put( pVal, nArgc );
92 refArgv->PutAlias( aAlias, nArgc++ );
93 }
94 }
95
96 // Konvertierung des Typs eines Arguments in Argv fuer DECLARE-Fkt. (+Typ)
97
StepARGTYP(sal_uInt32 nOp1)98 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
99 {
100 if( !refArgv )
101 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
102 else
103 {
104 sal_Bool bByVal = (nOp1 & 0x8000) != 0; // Ist BYVAL verlangt?
105 SbxDataType t = (SbxDataType) (nOp1 & 0x7FFF);
106 SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // letztes Arg
107
108 // BYVAL pr�fen
109 if( pVar->GetRefCount() > 2 ) // 2 ist normal f�r BYVAL
110 {
111 // Parameter ist eine Referenz
112 if( bByVal )
113 {
114 // Call by Value ist verlangt -> Kopie anlegen
115 pVar = new SbxVariable( *pVar );
116 pVar->SetFlag( SBX_READWRITE );
117 refExprStk->Put( pVar, refArgv->Count() - 1 );
118 }
119 else
120 pVar->SetFlag( SBX_REFERENCE ); // Ref-Flag f�r DllMgr
121 }
122 else
123 {
124 // Parameter ist KEINE Referenz
125 if( bByVal )
126 pVar->ResetFlag( SBX_REFERENCE ); // Keine Referenz -> OK
127 else
128 Error( SbERR_BAD_PARAMETERS ); // Referenz verlangt
129 }
130
131 if( pVar->GetType() != t )
132 {
133 // Variant, damit richtige Konvertierung
134 // Ausserdem Fehler, wenn SbxBYREF
135 pVar->Convert( SbxVARIANT );
136 pVar->Convert( t );
137 }
138 }
139 }
140
141 // String auf feste Laenge bringen (+Laenge)
142
StepPAD(sal_uInt32 nOp1)143 void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
144 {
145 SbxVariable* p = GetTOS();
146 String& s = (String&)(const String&) *p;
147 if( s.Len() > nOp1 )
148 s.Erase( static_cast<xub_StrLen>( nOp1 ) );
149 else
150 s.Expand( static_cast<xub_StrLen>( nOp1 ), ' ' );
151 }
152
153 // Sprung (+Target)
154
StepJUMP(sal_uInt32 nOp1)155 void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
156 {
157 #ifdef DBG_UTIL
158 // #QUESTION shouln't this be
159 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
160 if( nOp1 >= pImg->GetCodeSize() )
161 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
162 #endif
163 pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
164 }
165
166 // TOS auswerten, bedingter Sprung (+Target)
167
StepJUMPT(sal_uInt32 nOp1)168 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
169 {
170 SbxVariableRef p = PopVar();
171 if( p->GetBool() )
172 StepJUMP( nOp1 );
173 }
174
175 // TOS auswerten, bedingter Sprung (+Target)
176
StepJUMPF(sal_uInt32 nOp1)177 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
178 {
179 SbxVariableRef p = PopVar();
180 if( !p->GetBool() )
181 StepJUMP( nOp1 );
182 }
183
184 // TOS auswerten, Sprung in JUMP-Tabelle (+MaxVal)
185 // Sieht so aus:
186 // ONJUMP 2
187 // JUMP target1
188 // JUMP target2
189 // ...
190 //Falls im Operanden 0x8000 gesetzt ist, Returnadresse pushen (ON..GOSUB)
191
StepONJUMP(sal_uInt32 nOp1)192 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
193 {
194 SbxVariableRef p = PopVar();
195 sal_Int16 n = p->GetInteger();
196 if( nOp1 & 0x8000 )
197 {
198 nOp1 &= 0x7FFF;
199 //PushGosub( pCode + 3 * nOp1 );
200 PushGosub( pCode + 5 * nOp1 );
201 }
202 if( n < 1 || static_cast<sal_uInt32>(n) > nOp1 )
203 n = static_cast<sal_Int16>( nOp1 + 1 );
204 //nOp1 = (sal_uInt32) ( (const char*) pCode - pImg->GetCode() ) + 3 * --n;
205 nOp1 = (sal_uInt32) ( (const char*) pCode - pImg->GetCode() ) + 5 * --n;
206 StepJUMP( nOp1 );
207 }
208
209 // UP-Aufruf (+Target)
210
StepGOSUB(sal_uInt32 nOp1)211 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
212 {
213 PushGosub( pCode );
214 if( nOp1 >= pImg->GetCodeSize() )
215 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
216 pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
217 }
218
219 // UP-Return (+0 oder Target)
220
StepRETURN(sal_uInt32 nOp1)221 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
222 {
223 PopGosub();
224 if( nOp1 )
225 StepJUMP( nOp1 );
226 }
227
228 // FOR-Variable testen (+Endlabel)
229
StepTESTFOR(sal_uInt32 nOp1)230 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
231 {
232 if( !pForStk )
233 {
234 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
235 return;
236 }
237
238 bool bEndLoop = false;
239 switch( pForStk->eForType )
240 {
241 case FOR_TO:
242 {
243 SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
244 if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
245 bEndLoop = true;
246 break;
247 }
248 case FOR_EACH_ARRAY:
249 {
250 SbiForStack* p = pForStk;
251 if( p->pArrayCurIndices == NULL )
252 {
253 bEndLoop = true;
254 }
255 else
256 {
257 SbxDimArray* pArray = (SbxDimArray*)(SbxVariable*)p->refEnd;
258 short nDims = pArray->GetDims();
259
260 // Empty array?
261 if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
262 {
263 bEndLoop = true;
264 break;
265 }
266 SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices );
267 *(p->refVar) = *pVal;
268
269 bool bFoundNext = false;
270 for( short i = 0 ; i < nDims ; i++ )
271 {
272 if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
273 {
274 bFoundNext = true;
275 p->pArrayCurIndices[i]++;
276 for( short j = i - 1 ; j >= 0 ; j-- )
277 p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
278 break;
279 }
280 }
281 if( !bFoundNext )
282 {
283 delete[] p->pArrayCurIndices;
284 p->pArrayCurIndices = NULL;
285 }
286 }
287 break;
288 }
289 case FOR_EACH_COLLECTION:
290 {
291 BasicCollection* pCollection = (BasicCollection*)(SbxVariable*)pForStk->refEnd;
292 SbxArrayRef xItemArray = pCollection->xItemArray;
293 sal_Int32 nCount = xItemArray->Count32();
294 if( pForStk->nCurCollectionIndex < nCount )
295 {
296 SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
297 pForStk->nCurCollectionIndex++;
298 (*pForStk->refVar) = *pRes;
299 }
300 else
301 {
302 bEndLoop = true;
303 }
304 break;
305 }
306 case FOR_EACH_XENUMERATION:
307 {
308 SbiForStack* p = pForStk;
309 if( p->xEnumeration->hasMoreElements() )
310 {
311 Any aElem = p->xEnumeration->nextElement();
312 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
313 unoToSbxValue( (SbxVariable*)xVar, aElem );
314 (*pForStk->refVar) = *xVar;
315 }
316 else
317 {
318 bEndLoop = true;
319 }
320 break;
321 }
322 }
323 if( bEndLoop )
324 {
325 PopFor();
326 StepJUMP( nOp1 );
327 }
328 }
329
330 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
331
StepCASETO(sal_uInt32 nOp1)332 void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
333 {
334 if( !refCaseStk || !refCaseStk->Count() )
335 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
336 else
337 {
338 SbxVariableRef xTo = PopVar();
339 SbxVariableRef xFrom = PopVar();
340 SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
341 if( *xCase >= *xFrom && *xCase <= *xTo )
342 StepJUMP( nOp1 );
343 }
344 }
345
346 // Fehler-Handler
347
StepERRHDL(sal_uInt32 nOp1)348 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
349 {
350 const sal_uInt8* p = pCode;
351 StepJUMP( nOp1 );
352 pError = pCode;
353 pCode = p;
354 pInst->aErrorMsg = String();
355 pInst->nErr = 0;
356 pInst->nErl = 0;
357 nError = 0;
358 SbxErrObject::getUnoErrObject()->Clear();
359 }
360
361 // Resume nach Fehlern (+0=statement, 1=next or Label)
362
StepRESUME(sal_uInt32 nOp1)363 void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
364 {
365 // AB #32714 Resume ohne Error? -> Fehler
366 if( !bInError )
367 {
368 Error( SbERR_BAD_RESUME );
369 return;
370 }
371 if( nOp1 )
372 {
373 // Code-Zeiger auf naechstes Statement setzen
374 sal_uInt16 n1, n2;
375 pCode = pMod->FindNextStmnt( pErrCode, n1, n2, sal_True, pImg );
376 }
377 else
378 pCode = pErrStmnt;
379 if ( pError ) // current in error handler ( and got a Resume Next statment )
380 SbxErrObject::getUnoErrObject()->Clear();
381
382 if( nOp1 > 1 )
383 StepJUMP( nOp1 );
384 pInst->aErrorMsg = String();
385 pInst->nErr = 0;
386 pInst->nErl = 0;
387 nError = 0;
388 bInError = sal_False;
389
390 // Error-Stack loeschen
391 SbErrorStack*& rErrStack = GetSbData()->pErrStack;
392 delete rErrStack;
393 rErrStack = NULL;
394 }
395
396 // Kanal schliessen (+Kanal, 0=Alle)
StepCLOSE(sal_uInt32 nOp1)397 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
398 {
399 SbError err;
400 if( !nOp1 )
401 pIosys->Shutdown();
402 else
403 {
404 err = pIosys->GetError();
405 if( !err )
406 {
407 pIosys->Close();
408 }
409 }
410 err = pIosys->GetError();
411 Error( err );
412 }
413
414 // Zeichen ausgeben (+char)
415
StepPRCHAR(sal_uInt32 nOp1)416 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
417 {
418 ByteString s( (char) nOp1 );
419 pIosys->Write( s );
420 Error( pIosys->GetError() );
421 }
422
423 // Check, ob TOS eine bestimmte Objektklasse ist (+StringID)
424
implIsClass(SbxObject * pObj,const String & aClass)425 bool SbiRuntime::implIsClass( SbxObject* pObj, const String& aClass )
426 {
427 bool bRet = true;
428
429 if( aClass.Len() != 0 )
430 {
431 bRet = pObj->IsClass( aClass );
432 if( !bRet )
433 bRet = aClass.EqualsIgnoreCaseAscii( String( RTL_CONSTASCII_USTRINGPARAM("object") ) );
434 if( !bRet )
435 {
436 String aObjClass = pObj->GetClassName();
437 SbModule* pClassMod = pCLASSFAC->FindClass( aObjClass );
438 SbClassData* pClassData;
439 if( pClassMod && (pClassData=pClassMod->pClassData) != NULL )
440 {
441 SbxVariable* pClassVar =
442 pClassData->mxIfaces->Find( aClass, SbxCLASS_DONTCARE );
443 bRet = (pClassVar != NULL);
444 }
445 }
446 }
447 return bRet;
448 }
449
checkClass_Impl(const SbxVariableRef & refVal,const String & aClass,bool bRaiseErrors,bool bDefault)450 bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
451 const String& aClass, bool bRaiseErrors, bool bDefault )
452 {
453 bool bOk = bDefault;
454
455 SbxDataType t = refVal->GetType();
456 if( t == SbxOBJECT )
457 {
458 SbxObject* pObj;
459 SbxVariable* pVal = (SbxVariable*)refVal;
460 if( pVal->IsA( TYPE(SbxObject) ) )
461 pObj = (SbxObject*) pVal;
462 else
463 {
464 pObj = (SbxObject*) refVal->GetObject();
465 if( pObj && !pObj->IsA( TYPE(SbxObject) ) )
466 pObj = NULL;
467 }
468 if( pObj )
469 {
470 if( !implIsClass( pObj, aClass ) )
471 {
472 if ( bVBAEnabled && pObj->IsA( TYPE(SbUnoObject) ) )
473 {
474 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
475 bOk = checkUnoObjectType( pUnoObj, aClass );
476 }
477 else
478 bOk = false;
479 if ( !bOk )
480 {
481 if( bRaiseErrors )
482 Error( SbERR_INVALID_USAGE_OBJECT );
483 }
484 }
485 else
486 {
487 bOk = true;
488
489 SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pObj);
490 if( pClassModuleObject != NULL )
491 pClassModuleObject->triggerInitializeEvent();
492 }
493 }
494 }
495 else
496 {
497 if ( !bVBAEnabled )
498 {
499 if( bRaiseErrors )
500 Error( SbERR_NEEDS_OBJECT );
501 bOk = false;
502 }
503 }
504 return bOk;
505 }
506
StepSETCLASS_impl(sal_uInt32 nOp1,bool bHandleDflt)507 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
508 {
509 SbxVariableRef refVal = PopVar();
510 SbxVariableRef refVar = PopVar();
511 String aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
512
513 bool bOk = checkClass_Impl( refVal, aClass, true );
514 if( bOk )
515 StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle dflt prop for a "proper" set
516 }
517
StepVBASETCLASS(sal_uInt32 nOp1)518 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
519 {
520 StepSETCLASS_impl( nOp1, false );
521 }
522
StepSETCLASS(sal_uInt32 nOp1)523 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
524 {
525 StepSETCLASS_impl( nOp1, true );
526 }
527
StepTESTCLASS(sal_uInt32 nOp1)528 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
529 {
530 SbxVariableRef xObjVal = PopVar();
531 String aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
532 bool bDefault = !bVBAEnabled;
533 bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
534
535 SbxVariable* pRet = new SbxVariable;
536 pRet->PutBool( bOk );
537 PushVar( pRet );
538 }
539
540 // Library fuer anschliessenden Declare-Call definieren
541
StepLIB(sal_uInt32 nOp1)542 void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
543 {
544 aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
545 }
546
547 // TOS wird um BASE erhoeht, BASE davor gepusht (+BASE)
548 // Dieser Opcode wird vor DIM/REDIM-Anweisungen gepusht,
549 // wenn nur ein Index angegeben wurde.
550
StepBASED(sal_uInt32 nOp1)551 void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
552 {
553 SbxVariable* p1 = new SbxVariable;
554 SbxVariableRef x2 = PopVar();
555
556 // #109275 Check compatiblity mode
557 bool bCompatible = ((nOp1 & 0x8000) != 0);
558 sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
559 p1->PutInteger( uBase );
560 if( !bCompatible )
561 x2->Compute( SbxPLUS, *p1 );
562 PushVar( x2 ); // erst die Expr
563 PushVar( p1 ); // dann die Base
564 }
565
566
567
568
569
570