basic/source/runtime/step1.cxx

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