Line data Source code
1 : /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 : /*
3 : * This file is part of the LibreOffice project.
4 : *
5 : * This Source Code Form is subject to the terms of the Mozilla Public
6 : * License, v. 2.0. If a copy of the MPL was not distributed with this
7 : * file, You can obtain one at http://mozilla.org/MPL/2.0/.
8 : *
9 : * This file incorporates work covered by the following license notice:
10 : *
11 : * Licensed to the Apache Software Foundation (ASF) under one or more
12 : * contributor license agreements. See the NOTICE file distributed
13 : * with this work for additional information regarding copyright
14 : * ownership. The ASF licenses this file to you under the Apache
15 : * License, Version 2.0 (the "License"); you may not use this file
16 : * except in compliance with the License. You may obtain a copy of
17 : * the License at http://www.apache.org/licenses/LICENSE-2.0 .
18 : */
19 :
20 :
21 : #include <stdlib.h>
22 : #include <comphelper/string.hxx>
23 : #include <rtl/math.hxx>
24 : #include <rtl/ustrbuf.hxx>
25 : #include <basic/sbuno.hxx>
26 : #include "runtime.hxx"
27 : #include "sbintern.hxx"
28 : #include "iosys.hxx"
29 : #include "image.hxx"
30 : #include "sbunoobj.hxx"
31 : #include "errobject.hxx"
32 :
33 : bool checkUnoObjectType( SbUnoObject* refVal, const OUString& aClass );
34 :
35 : // loading a numeric constant (+ID)
36 :
37 0 : void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
38 : {
39 0 : SbxVariable* p = new SbxVariable( SbxDOUBLE );
40 :
41 : // #57844 use localized function
42 0 : OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
43 : // also allow , !!!
44 0 : sal_Int32 iComma = aStr.indexOf((sal_Unicode)',');
45 0 : if( iComma >= 0 )
46 : {
47 0 : aStr = aStr.replaceAt(iComma, 1, OUString("."));
48 : }
49 0 : double n = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
50 :
51 0 : p->PutDouble( n );
52 0 : PushVar( p );
53 0 : }
54 :
55 : // loading a string constant (+ID)
56 :
57 4 : void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
58 : {
59 4 : SbxVariable* p = new SbxVariable;
60 4 : p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
61 4 : PushVar( p );
62 4 : }
63 :
64 : // Immediate Load (+Wert)
65 :
66 12 : void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
67 : {
68 12 : SbxVariable* p = new SbxVariable;
69 12 : p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
70 12 : PushVar( p );
71 12 : }
72 :
73 : // stora a named argument in Argv (+Arg-no. from 1!)
74 :
75 0 : void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
76 : {
77 0 : if( !refArgv )
78 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
79 : else
80 : {
81 0 : OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
82 0 : SbxVariableRef pVal = PopVar();
83 0 : if( bVBAEnabled && ( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) ) )
84 : {
85 : // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
86 0 : if ( pVal->GetType() == SbxEMPTY )
87 0 : pVal->Broadcast( SBX_HINT_DATAWANTED );
88 : // evaluate methods and properties!
89 0 : SbxVariable* pRes = new SbxVariable( *pVal );
90 0 : pVal = pRes;
91 : }
92 0 : refArgv->Put( pVal, nArgc );
93 0 : refArgv->PutAlias( aAlias, nArgc++ );
94 : }
95 0 : }
96 :
97 : // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
98 :
99 0 : void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
100 : {
101 0 : if( !refArgv )
102 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
103 : else
104 : {
105 0 : bool bByVal = (nOp1 & 0x8000) != 0; // Ist BYVAL requested?
106 0 : SbxDataType t = (SbxDataType) (nOp1 & 0x7FFF);
107 0 : SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // last Arg
108 :
109 : // check BYVAL
110 0 : if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
111 : {
112 : // parameter is a reference
113 0 : if( bByVal )
114 : {
115 : // Call by Value is requested -> create a copy
116 0 : pVar = new SbxVariable( *pVar );
117 0 : pVar->SetFlag( SBX_READWRITE );
118 0 : refExprStk->Put( pVar, refArgv->Count() - 1 );
119 : }
120 : else
121 0 : pVar->SetFlag( SBX_REFERENCE ); // Ref-Flag for DllMgr
122 : }
123 : else
124 : {
125 : // parameter is NO reference
126 0 : if( bByVal )
127 0 : pVar->ResetFlag( SBX_REFERENCE ); // no reference -> OK
128 : else
129 0 : Error( SbERR_BAD_PARAMETERS ); // reference needed
130 : }
131 :
132 0 : if( pVar->GetType() != t )
133 : {
134 : // variant for correct conversion
135 : // besides error, if SbxBYREF
136 0 : pVar->Convert( SbxVARIANT );
137 0 : pVar->Convert( t );
138 : }
139 : }
140 0 : }
141 :
142 : // bring string to a definite length (+length)
143 :
144 0 : void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
145 : {
146 0 : SbxVariable* p = GetTOS();
147 0 : OUString s = p->GetOUString();
148 0 : sal_Int32 nLen(nOp1);
149 0 : if( s.getLength() != nLen )
150 : {
151 0 : rtl::OUStringBuffer aBuf(s);
152 0 : if (aBuf.getLength() > nLen)
153 : {
154 0 : comphelper::string::truncateToLength(aBuf, nLen);
155 : }
156 : else
157 : {
158 0 : comphelper::string::padToLength(aBuf, nLen, ' ');
159 : }
160 0 : s = aBuf.makeStringAndClear();
161 0 : }
162 0 : }
163 :
164 : // jump (+target)
165 :
166 2 : void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
167 : {
168 : #ifdef DBG_UTIL
169 : // #QUESTION shouln't this be
170 : // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
171 : if( nOp1 >= pImg->GetCodeSize() )
172 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
173 : #endif
174 2 : pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
175 2 : }
176 :
177 : // evaluate TOS, conditional jump (+target)
178 :
179 0 : void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
180 : {
181 0 : SbxVariableRef p = PopVar();
182 0 : if( p->GetBool() )
183 0 : StepJUMP( nOp1 );
184 0 : }
185 :
186 : // evaluate TOS, conditional jump (+target)
187 :
188 2 : void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
189 : {
190 2 : SbxVariableRef p = PopVar();
191 : // In a test e.g. If Null then
192 : // will evaluate Null will act as if False
193 2 : if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
194 0 : StepJUMP( nOp1 );
195 2 : }
196 :
197 : // evaluate TOS, jump into JUMP-table (+MaxVal)
198 : // looks like this:
199 : // ONJUMP 2
200 : // JUMP target1
201 : // JUMP target2
202 : // ...
203 : // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
204 :
205 0 : void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
206 : {
207 0 : SbxVariableRef p = PopVar();
208 0 : sal_Int16 n = p->GetInteger();
209 0 : if( nOp1 & 0x8000 )
210 : {
211 0 : nOp1 &= 0x7FFF;
212 0 : PushGosub( pCode + 5 * nOp1 );
213 : }
214 0 : if( n < 1 || static_cast<sal_uInt32>(n) > nOp1 )
215 0 : n = static_cast<sal_Int16>( nOp1 + 1 );
216 0 : nOp1 = (sal_uInt32) ( (const char*) pCode - pImg->GetCode() ) + 5 * --n;
217 0 : StepJUMP( nOp1 );
218 0 : }
219 :
220 : // UP-call (+target)
221 :
222 0 : void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
223 : {
224 0 : PushGosub( pCode );
225 0 : if( nOp1 >= pImg->GetCodeSize() )
226 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
227 0 : pCode = (const sal_uInt8*) pImg->GetCode() + nOp1;
228 0 : }
229 :
230 : // UP-return (+0 or target)
231 :
232 0 : void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
233 : {
234 0 : PopGosub();
235 0 : if( nOp1 )
236 0 : StepJUMP( nOp1 );
237 0 : }
238 :
239 : // check FOR-variable (+Endlabel)
240 :
241 0 : void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
242 : {
243 0 : if( !pForStk )
244 : {
245 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
246 0 : return;
247 : }
248 :
249 0 : bool bEndLoop = false;
250 0 : switch( pForStk->eForType )
251 : {
252 : case FOR_TO:
253 : {
254 0 : SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
255 0 : if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
256 0 : bEndLoop = true;
257 0 : break;
258 : }
259 : case FOR_EACH_ARRAY:
260 : {
261 0 : SbiForStack* p = pForStk;
262 0 : if( p->pArrayCurIndices == NULL )
263 : {
264 0 : bEndLoop = true;
265 : }
266 : else
267 : {
268 0 : SbxDimArray* pArray = (SbxDimArray*)(SbxVariable*)p->refEnd;
269 0 : short nDims = pArray->GetDims();
270 :
271 : // Empty array?
272 0 : if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
273 : {
274 0 : bEndLoop = true;
275 0 : break;
276 : }
277 0 : SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices );
278 0 : *(p->refVar) = *pVal;
279 :
280 0 : bool bFoundNext = false;
281 0 : for( short i = 0 ; i < nDims ; i++ )
282 : {
283 0 : if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
284 : {
285 0 : bFoundNext = true;
286 0 : p->pArrayCurIndices[i]++;
287 0 : for( short j = i - 1 ; j >= 0 ; j-- )
288 0 : p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
289 0 : break;
290 : }
291 : }
292 0 : if( !bFoundNext )
293 : {
294 0 : delete[] p->pArrayCurIndices;
295 0 : p->pArrayCurIndices = NULL;
296 : }
297 : }
298 0 : break;
299 : }
300 : case FOR_EACH_COLLECTION:
301 : {
302 0 : BasicCollection* pCollection = (BasicCollection*)(SbxVariable*)pForStk->refEnd;
303 0 : SbxArrayRef xItemArray = pCollection->xItemArray;
304 0 : sal_Int32 nCount = xItemArray->Count32();
305 0 : if( pForStk->nCurCollectionIndex < nCount )
306 : {
307 0 : SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
308 0 : pForStk->nCurCollectionIndex++;
309 0 : (*pForStk->refVar) = *pRes;
310 : }
311 : else
312 : {
313 0 : bEndLoop = true;
314 : }
315 0 : break;
316 : }
317 : case FOR_EACH_XENUMERATION:
318 : {
319 0 : SbiForStack* p = pForStk;
320 0 : if( p->xEnumeration->hasMoreElements() )
321 : {
322 0 : Any aElem = p->xEnumeration->nextElement();
323 0 : SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
324 0 : unoToSbxValue( (SbxVariable*)xVar, aElem );
325 0 : (*pForStk->refVar) = *xVar;
326 : }
327 : else
328 : {
329 0 : bEndLoop = true;
330 : }
331 0 : break;
332 : }
333 : }
334 0 : if( bEndLoop )
335 : {
336 0 : PopFor();
337 0 : StepJUMP( nOp1 );
338 : }
339 : }
340 :
341 : // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
342 :
343 0 : void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
344 : {
345 0 : if( !refCaseStk || !refCaseStk->Count() )
346 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
347 : else
348 : {
349 0 : SbxVariableRef xTo = PopVar();
350 0 : SbxVariableRef xFrom = PopVar();
351 0 : SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
352 0 : if( *xCase >= *xFrom && *xCase <= *xTo )
353 0 : StepJUMP( nOp1 );
354 : }
355 0 : }
356 :
357 :
358 0 : void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
359 : {
360 0 : const sal_uInt8* p = pCode;
361 0 : StepJUMP( nOp1 );
362 0 : pError = pCode;
363 0 : pCode = p;
364 0 : pInst->aErrorMsg = OUString();
365 0 : pInst->nErr = 0;
366 0 : pInst->nErl = 0;
367 0 : nError = 0;
368 0 : SbxErrObject::getUnoErrObject()->Clear();
369 0 : }
370 :
371 : // Resume after errors (+0=statement, 1=next or Label)
372 :
373 0 : void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
374 : {
375 : // #32714 Resume without error? -> error
376 0 : if( !bInError )
377 : {
378 0 : Error( SbERR_BAD_RESUME );
379 0 : return;
380 : }
381 0 : if( nOp1 )
382 : {
383 : // set Code-pointer to the next statement
384 : sal_uInt16 n1, n2;
385 0 : pCode = pMod->FindNextStmnt( pErrCode, n1, n2, sal_True, pImg );
386 : }
387 : else
388 0 : pCode = pErrStmnt;
389 0 : if ( pError ) // current in error handler ( and got a Resume Next statment )
390 0 : SbxErrObject::getUnoErrObject()->Clear();
391 :
392 0 : if( nOp1 > 1 )
393 0 : StepJUMP( nOp1 );
394 0 : pInst->aErrorMsg = OUString();
395 0 : pInst->nErr = 0;
396 0 : pInst->nErl = 0;
397 0 : nError = 0;
398 0 : bInError = false;
399 : }
400 :
401 : // close channel (+channel, 0=all)
402 0 : void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
403 : {
404 : SbError err;
405 0 : if( !nOp1 )
406 0 : pIosys->Shutdown();
407 : else
408 : {
409 0 : err = pIosys->GetError();
410 0 : if( !err )
411 : {
412 0 : pIosys->Close();
413 : }
414 : }
415 0 : err = pIosys->GetError();
416 0 : Error( err );
417 0 : }
418 :
419 : // output character (+char)
420 :
421 0 : void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
422 : {
423 0 : OString s(static_cast<sal_Char>(nOp1));
424 0 : pIosys->Write( s );
425 0 : Error( pIosys->GetError() );
426 0 : }
427 :
428 : // check whether TOS is a certain object class (+StringID)
429 :
430 2 : bool SbiRuntime::implIsClass( SbxObject* pObj, const OUString& aClass )
431 : {
432 2 : bool bRet = true;
433 :
434 2 : if( !aClass.isEmpty() )
435 : {
436 2 : bRet = pObj->IsClass( aClass );
437 2 : if( !bRet )
438 0 : bRet = aClass.equalsIgnoreAsciiCaseAsciiL( RTL_CONSTASCII_STRINGPARAM("object") );
439 2 : if( !bRet )
440 : {
441 0 : OUString aObjClass = pObj->GetClassName();
442 0 : SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
443 : SbClassData* pClassData;
444 0 : if( pClassMod && (pClassData=pClassMod->pClassData) != NULL )
445 : {
446 0 : SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxCLASS_DONTCARE );
447 0 : bRet = (pClassVar != NULL);
448 0 : }
449 : }
450 : }
451 2 : return bRet;
452 : }
453 :
454 2 : bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
455 : const OUString& aClass, bool bRaiseErrors, bool bDefault )
456 : {
457 2 : bool bOk = bDefault;
458 :
459 2 : SbxDataType t = refVal->GetType();
460 2 : SbxVariable* pVal = (SbxVariable*)refVal;
461 : // we don't know the type of uno properties that are (maybevoid)
462 2 : if ( t == SbxEMPTY && refVal->ISA(SbUnoProperty) )
463 : {
464 0 : SbUnoProperty* pProp = (SbUnoProperty*)pVal;
465 0 : t = pProp->getRealType();
466 : }
467 2 : if( t == SbxOBJECT )
468 : {
469 : SbxObject* pObj;
470 2 : if( pVal->IsA( TYPE(SbxObject) ) )
471 0 : pObj = (SbxObject*) pVal;
472 : else
473 : {
474 2 : pObj = (SbxObject*) refVal->GetObject();
475 2 : if( pObj && !pObj->IsA( TYPE(SbxObject) ) )
476 0 : pObj = NULL;
477 : }
478 2 : if( pObj )
479 : {
480 2 : if( !implIsClass( pObj, aClass ) )
481 : {
482 0 : if ( bVBAEnabled && pObj->IsA( TYPE(SbUnoObject) ) )
483 : {
484 0 : SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
485 0 : bOk = checkUnoObjectType( pUnoObj, aClass );
486 : }
487 : else
488 0 : bOk = false;
489 0 : if ( !bOk )
490 : {
491 0 : if( bRaiseErrors )
492 0 : Error( SbERR_INVALID_USAGE_OBJECT );
493 : }
494 : }
495 : else
496 : {
497 2 : bOk = true;
498 :
499 2 : SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pObj);
500 2 : if( pClassModuleObject != NULL )
501 0 : pClassModuleObject->triggerInitializeEvent();
502 : }
503 : }
504 : }
505 : else
506 : {
507 0 : if ( !bVBAEnabled )
508 : {
509 0 : if( bRaiseErrors )
510 0 : Error( SbERR_NEEDS_OBJECT );
511 0 : bOk = false;
512 : }
513 : }
514 2 : return bOk;
515 : }
516 :
517 2 : void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
518 : {
519 2 : SbxVariableRef refVal = PopVar();
520 2 : SbxVariableRef refVar = PopVar();
521 2 : OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
522 :
523 2 : bool bOk = checkClass_Impl( refVal, aClass, true );
524 2 : if( bOk )
525 : {
526 2 : StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle dflt prop for a "proper" set
527 2 : }
528 2 : }
529 :
530 0 : void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
531 : {
532 0 : StepSETCLASS_impl( nOp1, false );
533 0 : }
534 :
535 2 : void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
536 : {
537 2 : StepSETCLASS_impl( nOp1, true );
538 2 : }
539 :
540 0 : void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
541 : {
542 0 : SbxVariableRef xObjVal = PopVar();
543 0 : OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
544 0 : bool bDefault = !bVBAEnabled;
545 0 : bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
546 :
547 0 : SbxVariable* pRet = new SbxVariable;
548 0 : pRet->PutBool( bOk );
549 0 : PushVar( pRet );
550 0 : }
551 :
552 : // define library for following declare-call
553 :
554 0 : void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
555 : {
556 0 : aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
557 0 : }
558 :
559 : // TOS is incremented by BASE, BASE is pushed before (+BASE)
560 : // This opcode is pushed before DIM/REDIM-commands,
561 : // if there's been only one index named.
562 :
563 0 : void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
564 : {
565 0 : SbxVariable* p1 = new SbxVariable;
566 0 : SbxVariableRef x2 = PopVar();
567 :
568 : // #109275 Check compatiblity mode
569 0 : bool bCompatible = ((nOp1 & 0x8000) != 0);
570 0 : sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
571 0 : p1->PutInteger( uBase );
572 0 : if( !bCompatible )
573 0 : x2->Compute( SbxPLUS, *p1 );
574 0 : PushVar( x2 ); // first the Expr
575 0 : PushVar( p1 ); // then the Base
576 0 : }
577 :
578 :
579 :
580 :
581 :
582 : /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
|
