xref: /aoo42x/main/basic/source/runtime/step1.cxx (revision e1f63238) 
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 
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 
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 
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 
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 
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 
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 
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 
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 
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 
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 
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 
221 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
222 {
223 	PopGosub();
224 	if( nOp1 )
225 		StepJUMP( nOp1 );
226 }
227 
228 // FOR-Variable testen (+Endlabel)
229 
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 
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 
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 
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)
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 
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 
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 
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 
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 
518 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
519 {
520 	StepSETCLASS_impl( nOp1, false );
521 }
522 
523 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
524 {
525 	StepSETCLASS_impl( nOp1, true );
526 }
527 
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 
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 
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