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