xref: /trunk/main/basic/source/runtime/step1.cxx (revision cdf0e10c) 
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