xref: /trunk/main/basic/source/comp/dim.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 #include <basic/sbx.hxx>
27 #include "sbcomp.hxx"
28 
29 SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj );
30 
31 // Deklaration einer Variablen
32 // Bei Fehlern wird bis zum Komma oder Newline geparst.
33 // Returnwert: eine neue Instanz, die eingefuegt und dann geloescht wird.
34 // Array-Indexe werden als SbiDimList zurueckgegeben
35 
36 SbiSymDef* SbiParser::VarDecl( SbiDimList** ppDim, sal_Bool bStatic, sal_Bool bConst )
37 {
38 	bool bWithEvents = false;
39 	if( Peek() == WITHEVENTS )
40 	{
41 		Next();
42 		bWithEvents = true;
43 	}
44 	if( !TestSymbol() ) return NULL;
45 	SbxDataType t = eScanType;
46 	SbiSymDef* pDef = bConst ? new SbiConstDef( aSym ) : new SbiSymDef( aSym );
47 	SbiDimList* pDim = NULL;
48 	// Klammern?
49 	if( Peek() == LPAREN )
50 	{
51 		pDim = new SbiDimList( this );
52 		if( !pDim->GetDims() )
53 			pDef->SetWithBrackets();
54 	}
55 	pDef->SetType( t );
56 	if( bStatic )
57 		pDef->SetStatic();
58 	if( bWithEvents )
59 		pDef->SetWithEvents();
60 	TypeDecl( *pDef );
61 	if( !ppDim && pDim )
62 	{
63 		if(pDim->GetDims() )
64 			Error( SbERR_EXPECTED, "()" );
65 		delete pDim;
66 	}
67 	else if( ppDim )
68 		*ppDim = pDim;
69 	return pDef;
70 }
71 
72 // Aufloesen einer AS-Typdeklaration
73 // Der Datentyp wird in die uebergebene Variable eingetragen
74 
75 void SbiParser::TypeDecl( SbiSymDef& rDef, sal_Bool bAsNewAlreadyParsed )
76 {
77 	SbxDataType eType = rDef.GetType();
78 	short nSize = 0;
79 	if( bAsNewAlreadyParsed || Peek() == AS )
80 	{
81 		if( !bAsNewAlreadyParsed )
82 			Next();
83 		rDef.SetDefinedAs();
84 		String aType;
85 		SbiToken eTok = Next();
86 		if( !bAsNewAlreadyParsed && eTok == NEW )
87 		{
88 			rDef.SetNew();
89 			eTok = Next();
90 		}
91 		switch( eTok )
92 		{
93 			case ANY:
94 				if( rDef.IsNew() )
95 					Error( SbERR_SYNTAX );
96 				eType = SbxVARIANT; break;
97 			case TINTEGER:
98 			case TLONG:
99 			case TSINGLE:
100 			case TDOUBLE:
101 			case TCURRENCY:
102 			case TDATE:
103 			case TSTRING:
104 			case TOBJECT:
105 			case _ERROR_:
106 			case TBOOLEAN:
107 			case TVARIANT:
108 			case TBYTE:
109 				if( rDef.IsNew() )
110 					Error( SbERR_SYNTAX );
111 				eType = (eTok==TBYTE) ? SbxBYTE : SbxDataType( eTok - TINTEGER + SbxINTEGER );
112 				if( eType == SbxSTRING )
113 				{
114 					// STRING*n ?
115 					if( Peek() == MUL )
116 					{		// fixed size!
117 						Next();
118 						SbiConstExpression aSize( this );
119 						nSize = aSize.GetShortValue();
120 						if( nSize < 0 || (bVBASupportOn && nSize <= 0) )
121 							Error( SbERR_OUT_OF_RANGE );
122 						else
123 							rDef.SetFixedStringLength( nSize );
124 					}
125 				}
126 				break;
127 			case SYMBOL: // kann nur ein TYPE oder eine Objektklasse sein!
128 				if( eScanType != SbxVARIANT )
129 					Error( SbERR_SYNTAX );
130 				else
131 				{
132 					String aCompleteName = aSym;
133 
134 					// #52709 DIM AS NEW fuer Uno mit voll-qualifizierten Namen
135 					if( Peek() == DOT )
136 					{
137 						String aDotStr( '.' );
138 						while( Peek() == DOT )
139 						{
140 							aCompleteName += aDotStr;
141 							Next();
142                             SbiToken ePeekTok = Peek();
143 							if( ePeekTok == SYMBOL || IsKwd( ePeekTok ) )
144 							{
145 								Next();
146 								aCompleteName += aSym;
147 							}
148 							else
149 							{
150 								Next();
151 								Error( SbERR_UNEXPECTED, SYMBOL );
152 								break;
153 							}
154 						}
155 					}
156 					else if( rEnumArray->Find( aCompleteName, SbxCLASS_OBJECT ) )
157 					{
158 						eType = SbxLONG;
159 						break;
160 					}
161 
162 					// In den String-Pool uebernehmen
163 					rDef.SetTypeId( aGblStrings.Add( aCompleteName ) );
164 
165 					if( rDef.IsNew() && pProc == NULL )
166 						aRequiredTypes.push_back( aCompleteName );
167 				}
168 				eType = SbxOBJECT;
169 				break;
170 			case FIXSTRING: // new syntax for complex UNO types
171 				rDef.SetTypeId( aGblStrings.Add( aSym ) );
172 				eType = SbxOBJECT;
173 				break;
174 			default:
175 				Error( SbERR_UNEXPECTED, eTok );
176 				Next();
177 		}
178 		// Die Variable koennte mit Suffix deklariert sein
179 		if( rDef.GetType() != SbxVARIANT )
180 		{
181 			if( rDef.GetType() != eType )
182 				Error( SbERR_VAR_DEFINED, rDef.GetName() );
183 			else if( eType == SbxSTRING && rDef.GetLen() != nSize )
184 				Error( SbERR_VAR_DEFINED, rDef.GetName() );
185 		}
186 		rDef.SetType( eType );
187 		rDef.SetLen( nSize );
188 	}
189 }
190 
191 // Hier werden Variable, Arrays und Strukturen definiert.
192 // DIM/PRIVATE/PUBLIC/GLOBAL
193 
194 void SbiParser::Dim()
195 {
196 	DefVar( _DIM, ( pProc && bVBASupportOn ) ? pProc->IsStatic() : sal_False );
197 }
198 
199 void SbiParser::DefVar( SbiOpcode eOp, sal_Bool bStatic )
200 {
201 	SbiSymPool* pOldPool = pPool;
202 	sal_Bool bSwitchPool = sal_False;
203 	sal_Bool bPersistantGlobal = sal_False;
204 	SbiToken eFirstTok = eCurTok;
205 	if( pProc && ( eCurTok == GLOBAL || eCurTok == PUBLIC || eCurTok == PRIVATE ) )
206 		Error( SbERR_NOT_IN_SUBR, eCurTok );
207 	if( eCurTok == PUBLIC || eCurTok == GLOBAL )
208     {
209 		bSwitchPool = sal_True;		// im richtigen Moment auf globalen Pool schalten
210     	if( eCurTok == GLOBAL )
211             bPersistantGlobal = sal_True;
212     }
213 	// behavior in VBA is that a module scope variable's lifetime is
214 	// tied to the document. e.g. a module scope variable is global
215    	if(  GetBasic()->IsDocBasic() && bVBASupportOn && !pProc )
216 		bPersistantGlobal = sal_True;
217 	// PRIVATE ist Synonym fuer DIM
218 	// _CONST_?
219 	sal_Bool bConst = sal_False;
220 	if( eCurTok == _CONST_ )
221 		bConst = sal_True;
222 	else if( Peek() == _CONST_ )
223 		Next(), bConst = sal_True;
224 
225 	// #110004 It can also be a sub/function
226 	if( !bConst && (eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY ||
227 					eCurTok == STATIC || eCurTok == ENUM || eCurTok == DECLARE || eCurTok == TYPE) )
228 	{
229 		// Next token is read here, because !bConst
230 		bool bPrivate = ( eFirstTok == PRIVATE );
231 
232 		if( eCurTok == STATIC )
233 		{
234 			Next();
235 			DefStatic( bPrivate );
236 		}
237 		else if( eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY )
238 		{
239 			// End global chain if necessary (not done in
240 			// SbiParser::Parse() under these conditions
241 			if( bNewGblDefs && nGblChain == 0 )
242 			{
243 				nGblChain = aGen.Gen( _JUMP, 0 );
244 				bNewGblDefs = sal_False;
245 			}
246 			Next();
247 			DefProc( sal_False, bPrivate );
248 			return;
249 		}
250 		else if( eCurTok == ENUM )
251 		{
252 			Next();
253 			DefEnum( bPrivate );
254 			return;
255 		}
256 		else if( eCurTok == DECLARE )
257 		{
258 			Next();
259 			DefDeclare( bPrivate );
260 			return;
261 		}
262 		// #i109049
263 		else if( eCurTok == TYPE )
264 		{
265 			Next();
266 			DefType( bPrivate );
267 			return;
268 		}
269 	}
270 
271 #ifdef SHARED
272 #define tmpSHARED
273 #undef SHARED
274 #endif
275 	// SHARED wird ignoriert
276 	if( Peek() == SHARED ) Next();
277 #ifdef tmpSHARED
278 #define SHARED
279 #undef tmpSHARED
280 #endif
281 	// PRESERVE nur bei REDIM
282 	if( Peek() == PRESERVE )
283 	{
284 		Next();
285 		if( eOp == _REDIM )
286 			eOp = _REDIMP;
287 		else
288 			Error( SbERR_UNEXPECTED, eCurTok );
289 	}
290 	SbiSymDef* pDef;
291 	SbiDimList* pDim;
292 
293 	// AB 9.7.97, #40689, Statics -> Modul-Initialisierung, in Sub ueberspringen
294 	sal_uInt32 nEndOfStaticLbl = 0;
295 	if( !bVBASupportOn && bStatic )
296 	{
297 		nEndOfStaticLbl = aGen.Gen( _JUMP, 0 );
298 		aGen.Statement();	// bei static hier nachholen
299 	}
300 
301 	sal_Bool bDefined = sal_False;
302 	while( ( pDef = VarDecl( &pDim, bStatic, bConst ) ) != NULL )
303 	{
304 		EnableErrors();
305 		// Variable suchen:
306 		if( bSwitchPool )
307 			pPool = &aGlobals;
308 		SbiSymDef* pOld = pPool->Find( pDef->GetName() );
309 		// AB 31.3.1996, #25651#, auch in Runtime-Library suchen
310 		sal_Bool bRtlSym = sal_False;
311 		if( !pOld )
312 		{
313 			pOld = CheckRTLForSym( pDef->GetName(), SbxVARIANT );
314 			if( pOld )
315 				bRtlSym = sal_True;
316 		}
317 		if( pOld && !(eOp == _REDIM || eOp == _REDIMP) )
318 		{
319 			if( pDef->GetScope() == SbLOCAL && pOld->GetScope() != SbLOCAL )
320 				pOld = NULL;
321 		}
322 		if( pOld )
323 		{
324 			bDefined = sal_True;
325 			// Bei RTL-Symbol immer Fehler
326 			if( !bRtlSym && (eOp == _REDIM || eOp == _REDIMP) )
327 			{
328 				// Bei REDIM die Attribute vergleichen
329 				SbxDataType eDefType;
330 				bool bError_ = false;
331 				if( pOld->IsStatic() )
332 				{
333 					bError_ = true;
334 				}
335 				else if( pOld->GetType() != ( eDefType = pDef->GetType() ) )
336 				{
337 					if( !( eDefType == SbxVARIANT && !pDef->IsDefinedAs() ) )
338 						bError_ = true;
339 				}
340 				if( bError_ )
341 					Error( SbERR_VAR_DEFINED, pDef->GetName() );
342 			}
343 			else
344 				Error( SbERR_VAR_DEFINED, pDef->GetName() );
345 			delete pDef; pDef = pOld;
346 		}
347 		else
348 			pPool->Add( pDef );
349 
350 		// #36374: Variable vor Unterscheidung IsNew() anlegen
351 		// Sonst Error bei Dim Identifier As New Type und option explicit
352 		if( !bDefined && !(eOp == _REDIM || eOp == _REDIMP)
353                       && ( !bConst || pDef->GetScope() == SbGLOBAL ) )
354 		{
355 			// Variable oder globale Konstante deklarieren
356 			SbiOpcode eOp2;
357 			switch ( pDef->GetScope() )
358 			{
359 				case SbGLOBAL:	eOp2 = bPersistantGlobal ? _GLOBAL_P : _GLOBAL;
360                                 goto global;
361 				case SbPUBLIC:	eOp2 = bPersistantGlobal ? _PUBLIC_P : _PUBLIC;
362 								// AB 9.7.97, #40689, kein eigener Opcode mehr
363 								if( bVBASupportOn && bStatic )
364 								{
365 									eOp2 = _STATIC;
366 									break;
367 								}
368 				global:			aGen.BackChain( nGblChain );
369 								nGblChain = 0;
370 								bGblDefs = bNewGblDefs = sal_True;
371 								break;
372 				default:		eOp2 = _LOCAL;
373 			}
374 			sal_uInt32 nOpnd2 = sal::static_int_cast< sal_uInt16 >( pDef->GetType() );
375 			if( pDef->IsWithEvents() )
376 				nOpnd2 |= SBX_TYPE_WITH_EVENTS_FLAG;
377 
378 			if( bCompatible && pDef->IsNew() )
379 				nOpnd2 |= SBX_TYPE_DIM_AS_NEW_FLAG;
380 
381 			short nFixedStringLength = pDef->GetFixedStringLength();
382 			if( nFixedStringLength >= 0 )
383 				nOpnd2 |= (SBX_FIXED_LEN_STRING_FLAG + (sal_uInt32(nFixedStringLength) << 17));		// len = all bits above 0x10000
384 
385 			if( pDim != NULL && pDim->GetDims() > 0 )
386 				nOpnd2 |= SBX_TYPE_VAR_TO_DIM_FLAG;
387 
388 			aGen.Gen( eOp2, pDef->GetId(), nOpnd2 );
389 		}
390 
391 		// Initialisierung fuer selbstdefinierte Datentypen
392 		// und per NEW angelegte Variable
393 		if( pDef->GetType() == SbxOBJECT
394 		 && pDef->GetTypeId() )
395 		{
396 			if( !bCompatible && !pDef->IsNew() )
397 			{
398 				String aTypeName( aGblStrings.Find( pDef->GetTypeId() ) );
399 				if( rTypeArray->Find( aTypeName, SbxCLASS_OBJECT ) == NULL )
400 					Error( SbERR_UNDEF_TYPE, aTypeName );
401 			}
402 
403 			if( bConst )
404 			{
405 				Error( SbERR_SYNTAX );
406 			}
407 
408 			if( pDim )
409 			{
410                 if( eOp == _REDIMP )
411                 {
412 					SbiExpression aExpr( this, *pDef, NULL );
413 					aExpr.Gen();
414 					aGen.Gen( _REDIMP_ERASE );
415 
416 				    pDef->SetDims( pDim->GetDims() );
417 				    SbiExpression aExpr2( this, *pDef, pDim );
418 				    aExpr2.Gen();
419     				aGen.Gen( _DCREATE_REDIMP, pDef->GetId(), pDef->GetTypeId() );
420                 }
421                 else
422                 {
423 				    pDef->SetDims( pDim->GetDims() );
424 				    SbiExpression aExpr( this, *pDef, pDim );
425 				    aExpr.Gen();
426 	    			aGen.Gen( _DCREATE, pDef->GetId(), pDef->GetTypeId() );
427                 }
428 			}
429 			else
430 			{
431 				SbiExpression aExpr( this, *pDef );
432 				aExpr.Gen();
433 				SbiOpcode eOp_ = pDef->IsNew() ? _CREATE : _TCREATE;
434 				aGen.Gen( eOp_, pDef->GetId(), pDef->GetTypeId() );
435 				aGen.Gen( _SET );
436 			}
437 		}
438 		else
439 		{
440 			if( bConst )
441 			{
442 				// Konstanten-Definition
443 				if( pDim )
444 				{
445 					Error( SbERR_SYNTAX );
446 					delete pDim;
447 				}
448 				SbiExpression aVar( this, *pDef );
449 				if( !TestToken( EQ ) )
450 					goto MyBreak;	// AB 24.6.1996 (s.u.)
451 				SbiConstExpression aExpr( this );
452 				if( !bDefined && aExpr.IsValid() )
453 				{
454 					if( pDef->GetScope() == SbGLOBAL )
455 					{
456 						// Nur Code fuer globale Konstante erzeugen!
457 						aVar.Gen();
458 						aExpr.Gen();
459 						aGen.Gen( _PUTC );
460 					}
461 					SbiConstDef* pConst = pDef->GetConstDef();
462 					if( aExpr.GetType() == SbxSTRING )
463 						pConst->Set( aExpr.GetString() );
464 					else
465 						pConst->Set( aExpr.GetValue(), aExpr.GetType() );
466 				}
467 			}
468 			else if( pDim )
469 			{
470 				// Die Variable dimensionieren
471 				// Bei REDIM die Var vorher loeschen
472 				if( eOp == _REDIM )
473 				{
474 					SbiExpression aExpr( this, *pDef, NULL );
475 					aExpr.Gen();
476 					if ( bVBASupportOn )
477 						// delete the array but
478 						// clear the variable ( this
479 						// allows the processing of
480 						// the param to happen as normal without errors ( ordinary ERASE just clears the array )
481 						aGen.Gen( _ERASE_CLEAR );
482 					else
483 						aGen.Gen( _ERASE );
484 				}
485 				else if( eOp == _REDIMP )
486 				{
487 					SbiExpression aExpr( this, *pDef, NULL );
488 					aExpr.Gen();
489 					aGen.Gen( _REDIMP_ERASE );
490 				}
491 				pDef->SetDims( pDim->GetDims() );
492                 if( bPersistantGlobal )
493                     pDef->SetGlobal( sal_True );
494 				SbiExpression aExpr( this, *pDef, pDim );
495 				aExpr.Gen();
496                 pDef->SetGlobal( sal_False );
497 				aGen.Gen( (eOp == _STATIC) ? _DIM : eOp );
498 			}
499 		}
500 		if( !TestComma() )
501 			goto MyBreak;	// AB 24.6.1996 (s.u.)
502 
503 		// #27963# AB, 24.6.1996
504 		// Einfuehrung bSwitchPool (s.o.): pPool darf beim VarDecl-Aufruf
505 		// noch nicht auf &aGlobals gesetzt sein.
506 		// Ansonsten soll das Verhalten aber absolut identisch bleiben,
507 		// d.h. pPool muss immer am Schleifen-Ende zurueckgesetzt werden.
508 		// auch bei break
509 		pPool = pOldPool;
510 		continue;		// MyBreak �berspingen
511 	MyBreak:
512 		pPool = pOldPool;
513 		break;
514 	}
515 
516 	// AB 9.7.97, #40689, Sprung ueber Statics-Deklaration abschliessen
517 	if( !bVBASupportOn && bStatic )
518 	{
519 		// globalen Chain pflegen
520 		nGblChain = aGen.Gen( _JUMP, 0 );
521 		bGblDefs = bNewGblDefs = sal_True;
522 
523 		// fuer Sub Sprung auf Ende der statics eintragen
524 		aGen.BackChain( nEndOfStaticLbl );
525 	}
526 
527 	//pPool = pOldPool;
528 }
529 
530 // Hier werden Arrays redimensioniert.
531 
532 void SbiParser::ReDim()
533 {
534 	DefVar( _REDIM, (  pProc && bVBASupportOn ) ? pProc->IsStatic() : sal_False );
535 }
536 
537 // ERASE array, ...
538 
539 void SbiParser::Erase()
540 {
541 	while( !bAbort )
542 	{
543 		SbiExpression aExpr( this, SbLVALUE );
544 		aExpr.Gen();
545 		aGen.Gen( _ERASE );
546 		if( !TestComma() ) break;
547 	}
548 }
549 
550 // Deklaration eines Datentyps
551 
552 void SbiParser::Type()
553 {
554 	DefType( sal_False );
555 }
556 
557 void SbiParser::DefType( sal_Bool bPrivate )
558 {
559 	// TODO: Use bPrivate
560     (void)bPrivate;
561 
562 	// Neues Token lesen, es muss ein Symbol sein
563 	if (!TestSymbol())
564 		return;
565 
566 	if (rTypeArray->Find(aSym,SbxCLASS_OBJECT))
567 	{
568 		Error( SbERR_VAR_DEFINED, aSym );
569 		return;
570 	}
571 
572 	SbxObject *pType = new SbxObject(aSym);
573 
574 	SbiSymDef* pElem;
575 	SbiDimList* pDim = NULL;
576 	sal_Bool bDone = sal_False;
577 
578 	while( !bDone && !IsEof() )
579 	{
580 		switch( Peek() )
581 		{
582 			case ENDTYPE :
583 				pElem = NULL;
584 				bDone = sal_True;
585 				Next();
586 			break;
587 
588 			case EOLN :
589 			case REM :
590 				pElem = NULL;
591 				Next();
592 			break;
593 
594 			default:
595 				pDim = NULL;
596 				pElem = VarDecl(&pDim,sal_False,sal_False);
597 				if( !pElem )
598 					bDone = sal_True;	// Error occured
599 		}
600 		if( pElem )
601 		{
602 			SbxArray *pTypeMembers = pType->GetProperties();
603 			String aElemName = pElem->GetName();
604 			if( pTypeMembers->Find( aElemName, SbxCLASS_DONTCARE) )
605 				Error (SbERR_VAR_DEFINED);
606 			else
607 			{
608 				SbxDataType eElemType = pElem->GetType();
609 				SbxProperty *pTypeElem = new SbxProperty( aElemName, eElemType );
610 				if( pDim )
611 				{
612 					SbxDimArray* pArray = new SbxDimArray( pElem->GetType() );
613 					if ( pDim->GetSize() )
614 					{
615 						// Dimension the target array
616 
617 						for ( short i=0; i<pDim->GetSize();++i )
618 						{
619 							sal_Int32 ub = -1;
620 							sal_Int32 lb = nBase;
621 							SbiExprNode* pNode =  pDim->Get(i)->GetExprNode();
622 							ub = pNode->GetNumber();
623 							if ( !pDim->Get( i )->IsBased() ) // each dim is low/up
624 							{
625 								if (  ++i >= pDim->GetSize() ) // trouble
626 									StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
627 								pNode =  pDim->Get(i)->GetExprNode();
628 								lb = ub;
629 								ub = pNode->GetNumber();
630 							}
631 							else if ( !bCompatible )
632 								ub += nBase;
633 							pArray->AddDim32( lb, ub );
634 						}
635 						pArray->setHasFixedSize( true );
636 					}
637 					else
638 						pArray->unoAddDim( 0, -1 ); // variant array
639 					sal_uInt16 nSavFlags = pTypeElem->GetFlags();
640 					// need to reset the FIXED flag
641 					// when calling PutObject ( because the type will not match Object )
642 					pTypeElem->ResetFlag( SBX_FIXED );
643 					pTypeElem->PutObject( pArray );
644 					pTypeElem->SetFlags( nSavFlags );
645 				}
646 				// Nested user type?
647 				if( eElemType == SbxOBJECT )
648 				{
649 					sal_uInt16 nElemTypeId = pElem->GetTypeId();
650 					if( nElemTypeId != 0 )
651 					{
652 						String aTypeName( aGblStrings.Find( nElemTypeId ) );
653 						SbxObject* pTypeObj = static_cast< SbxObject* >( rTypeArray->Find( aTypeName, SbxCLASS_OBJECT ) );
654 						if( pTypeObj != NULL )
655 						{
656 							SbxObject* pCloneObj = cloneTypeObjectImpl( *pTypeObj );
657 							pTypeElem->PutObject( pCloneObj );
658 						}
659 					}
660 				}
661 				delete pDim;
662 				pTypeMembers->Insert( pTypeElem, pTypeMembers->Count() );
663 			}
664 			delete pElem;
665 		}
666 	}
667 
668 	pType->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_DONTCARE );
669 	pType->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Parent") ), SbxCLASS_DONTCARE );
670 
671 	rTypeArray->Insert (pType,rTypeArray->Count());
672 }
673 
674 
675 // Declaration of Enum type
676 
677 void SbiParser::Enum()
678 {
679 	DefEnum( sal_False );
680 }
681 
682 void SbiParser::DefEnum( sal_Bool bPrivate )
683 {
684 	// Neues Token lesen, es muss ein Symbol sein
685 	if (!TestSymbol())
686 		return;
687 
688 	String aEnumName = aSym;
689 	if( rEnumArray->Find(aEnumName,SbxCLASS_OBJECT) )
690 	{
691 		Error( SbERR_VAR_DEFINED, aSym );
692 		return;
693 	}
694 
695 	SbxObject *pEnum = new SbxObject( aEnumName );
696 	if( bPrivate )
697 		pEnum->SetFlag( SBX_PRIVATE );
698 
699 	SbiSymDef* pElem;
700 	SbiDimList* pDim;
701 	sal_Bool bDone = sal_False;
702 
703 	// Starting with -1 to make first default value 0 after ++
704 	sal_Int32 nCurrentEnumValue = -1;
705 	while( !bDone && !IsEof() )
706 	{
707 		switch( Peek() )
708 		{
709 			case ENDENUM :
710 				pElem = NULL;
711 				bDone = sal_True;
712 				Next();
713 			break;
714 
715 			case EOLN :
716 			case REM :
717 				pElem = NULL;
718 				Next();
719 			break;
720 
721 			default:
722 			{
723 				// TODO: Check existing!
724 				sal_Bool bDefined = sal_False;
725 
726 				pDim = NULL;
727 				pElem = VarDecl( &pDim, sal_False, sal_True );
728 				if( !pElem )
729 				{
730 					bDone = sal_True;	// Error occured
731 					break;
732 				}
733 				else if( pDim )
734 				{
735 					delete pDim;
736 					Error( SbERR_SYNTAX );
737 					bDone = sal_True;	// Error occured
738 					break;
739 				}
740 
741 				SbiExpression aVar( this, *pElem );
742 				if( Peek() == EQ )
743 				{
744 					Next();
745 
746 					SbiConstExpression aExpr( this );
747 					if( !bDefined && aExpr.IsValid() )
748 					{
749 						SbxVariableRef xConvertVar = new SbxVariable();
750 						if( aExpr.GetType() == SbxSTRING )
751 							xConvertVar->PutString( aExpr.GetString() );
752 						else
753 							xConvertVar->PutDouble( aExpr.GetValue() );
754 
755 						nCurrentEnumValue = xConvertVar->GetLong();
756 					}
757 				}
758 				else
759 					nCurrentEnumValue++;
760 
761 				SbiSymPool* pPoolToUse = bPrivate ? pPool : &aGlobals;
762 
763 				SbiSymDef* pOld = pPoolToUse->Find( pElem->GetName() );
764 				if( pOld )
765 				{
766 					Error( SbERR_VAR_DEFINED, pElem->GetName() );
767 					bDone = sal_True;	// Error occured
768 					break;
769 				}
770 
771 				pPool->Add( pElem );
772 
773 				if( !bPrivate )
774 				{
775 					SbiOpcode eOp = _GLOBAL;
776 					aGen.BackChain( nGblChain );
777 					nGblChain = 0;
778 					bGblDefs = bNewGblDefs = sal_True;
779 					aGen.Gen(
780                         eOp, pElem->GetId(),
781                         sal::static_int_cast< sal_uInt16 >( pElem->GetType() ) );
782 
783 					aVar.Gen();
784 					sal_uInt16 nStringId = aGen.GetParser()->aGblStrings.Add( nCurrentEnumValue, SbxLONG );
785 					aGen.Gen( _NUMBER, nStringId );
786 					aGen.Gen( _PUTC );
787 				}
788 
789 				SbiConstDef* pConst = pElem->GetConstDef();
790 				pConst->Set( nCurrentEnumValue, SbxLONG );
791 			}
792 		}
793 		if( pElem )
794 		{
795 			SbxArray *pEnumMembers = pEnum->GetProperties();
796 			SbxProperty *pEnumElem = new SbxProperty( pElem->GetName(), SbxLONG );
797 			pEnumElem->PutLong( nCurrentEnumValue );
798 			pEnumElem->ResetFlag( SBX_WRITE );
799 			pEnumElem->SetFlag( SBX_CONST );
800 			pEnumMembers->Insert( pEnumElem, pEnumMembers->Count() );
801 		}
802 	}
803 
804 	pEnum->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_DONTCARE );
805 	pEnum->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Parent") ), SbxCLASS_DONTCARE );
806 
807 	rEnumArray->Insert( pEnum, rEnumArray->Count() );
808 }
809 
810 
811 // Prozedur-Deklaration
812 // das erste Token ist bereits eingelesen (SUB/FUNCTION)
813 // xxx Name [LIB "name"[ALIAS "name"]][(Parameter)][AS TYPE]
814 
815 SbiProcDef* SbiParser::ProcDecl( sal_Bool bDecl )
816 {
817 	sal_Bool bFunc = sal_Bool( eCurTok == FUNCTION );
818 	sal_Bool bProp = sal_Bool( eCurTok == GET || eCurTok == SET || eCurTok == LET );
819 	if( !TestSymbol() ) return NULL;
820 	String aName( aSym );
821 	SbxDataType eType = eScanType;
822 	SbiProcDef* pDef = new SbiProcDef( this, aName, true );
823 	pDef->SetType( eType );
824 	if( Peek() == _CDECL_ )
825 	{
826 		Next(); pDef->SetCdecl();
827 	}
828 	if( Peek() == LIB )
829 	{
830 		Next();
831 		if( Next() == FIXSTRING )
832 			pDef->GetLib() = aSym;
833 		else
834 			Error( SbERR_SYNTAX );
835 	}
836 	if( Peek() == ALIAS )
837 	{
838 		Next();
839 		if( Next() == FIXSTRING )
840 			pDef->GetAlias() = aSym;
841 		else
842 			Error( SbERR_SYNTAX );
843 	}
844 	if( !bDecl )
845 	{
846 		// CDECL, LIB und ALIAS sind unzulaessig
847 		if( pDef->GetLib().Len() )
848 			Error( SbERR_UNEXPECTED, LIB );
849 		if( pDef->GetAlias().Len() )
850 			Error( SbERR_UNEXPECTED, ALIAS );
851 		if( pDef->IsCdecl() )
852 			Error( SbERR_UNEXPECTED, _CDECL_ );
853 		pDef->SetCdecl( sal_False );
854 		pDef->GetLib().Erase();
855 		pDef->GetAlias().Erase();
856 	}
857 	else if( !pDef->GetLib().Len() )
858 	{
859 		// ALIAS und CDECL nur zusammen mit LIB
860 		if( pDef->GetAlias().Len() )
861 			Error( SbERR_UNEXPECTED, ALIAS );
862 		if( pDef->IsCdecl() )
863 			Error( SbERR_UNEXPECTED, _CDECL_ );
864 		pDef->SetCdecl( sal_False );
865 		pDef->GetAlias().Erase();
866 	}
867 	// Klammern?
868 	if( Peek() == LPAREN )
869 	{
870 		Next();
871 		if( Peek() == RPAREN )
872 			Next();
873 		else
874 		  for(;;) {
875 			sal_Bool bByVal = sal_False;
876 			sal_Bool bOptional = sal_False;
877 			sal_Bool bParamArray = sal_False;
878 			while( Peek() == BYVAL || Peek() == BYREF || Peek() == _OPTIONAL_ )
879 			{
880 				if		( Peek() == BYVAL )		Next(), bByVal = sal_True;
881 				else if	( Peek() == BYREF )		Next(), bByVal = sal_False;
882 				else if	( Peek() == _OPTIONAL_ )	Next(), bOptional = sal_True;
883 			}
884 			if( bCompatible && Peek() == PARAMARRAY )
885 			{
886 				if( bByVal || bOptional )
887 					Error( SbERR_UNEXPECTED, PARAMARRAY );
888 				Next();
889 				bParamArray = sal_True;
890 			}
891 			SbiSymDef* pPar = VarDecl( NULL, sal_False, sal_False );
892 			if( !pPar )
893 				break;
894 			if( bByVal )
895 				pPar->SetByVal();
896 			if( bOptional )
897 				pPar->SetOptional();
898 			if( bParamArray )
899 				pPar->SetParamArray();
900 			pDef->GetParams().Add( pPar );
901 			SbiToken eTok = Next();
902 			if( eTok != COMMA && eTok != RPAREN )
903 			{
904 				sal_Bool bError2 = sal_True;
905 				if( bOptional && bCompatible && eTok == EQ )
906 				{
907 					SbiConstExpression* pDefaultExpr = new SbiConstExpression( this );
908 					SbxDataType eType2 = pDefaultExpr->GetType();
909 
910 					sal_uInt16 nStringId;
911 					if( eType2 == SbxSTRING )
912 						nStringId = aGblStrings.Add( pDefaultExpr->GetString() );
913 					else
914 						nStringId = aGblStrings.Add( pDefaultExpr->GetValue(), eType2 );
915 
916 					pPar->SetDefaultId( nStringId );
917 					delete pDefaultExpr;
918 
919 					eTok = Next();
920 					if( eTok == COMMA || eTok == RPAREN )
921 						bError2 = sal_False;
922 				}
923 				if( bError2 )
924 				{
925 					Error( SbERR_EXPECTED, RPAREN );
926 					break;
927 				}
928 			}
929 			if( eTok == RPAREN )
930 				break;
931 		}
932 	}
933 	TypeDecl( *pDef );
934 	if( eType != SbxVARIANT && pDef->GetType() != eType )
935 		Error( SbERR_BAD_DECLARATION, aName );
936 //	if( pDef->GetType() == SbxOBJECT )
937 //		pDef->SetType( SbxVARIANT ),
938 //		Error( SbERR_SYNTAX );
939 	if( pDef->GetType() == SbxVARIANT && !( bFunc || bProp ) )
940 		pDef->SetType( SbxEMPTY );
941 	return pDef;
942 }
943 
944 // DECLARE
945 
946 void SbiParser::Declare()
947 {
948 	DefDeclare( sal_False );
949 }
950 
951 void SbiParser::DefDeclare( sal_Bool bPrivate )
952 {
953 	Next();
954 	if( eCurTok != SUB && eCurTok != FUNCTION )
955 	  Error( SbERR_UNEXPECTED, eCurTok );
956 	else
957 	{
958 		bool bFunction = (eCurTok == FUNCTION);
959 
960 		SbiProcDef* pDef = ProcDecl( sal_True );
961 		if( pDef )
962 		{
963 			if( !pDef->GetLib().Len() )
964 				Error( SbERR_EXPECTED, LIB );
965 			// gibts den schon?
966 			SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
967 			if( pOld )
968 			{
969 				SbiProcDef* p = pOld->GetProcDef();
970 				if( !p )
971 				{
972 					// Als Variable deklariert
973 					Error( SbERR_BAD_DECLARATION, pDef->GetName() );
974 					delete pDef;
975 					pDef = NULL;
976 				}
977 				else
978 					pDef->Match( p );
979 			}
980 			else
981 				aPublics.Add( pDef );
982 
983 			if ( pDef )
984 			{
985 				pDef->SetPublic( !bPrivate );
986 
987 				// New declare handling
988 				if( pDef->GetLib().Len() > 0 )
989 				{
990 					if( bNewGblDefs && nGblChain == 0 )
991 					{
992 						nGblChain = aGen.Gen( _JUMP, 0 );
993 						bNewGblDefs = sal_False;
994 					}
995 
996 					sal_uInt16 nSavLine = nLine;
997 					aGen.Statement();
998 					pDef->Define();
999 					pDef->SetLine1( nSavLine );
1000 					pDef->SetLine2( nSavLine );
1001 
1002 					SbiSymPool& rPool = pDef->GetParams();
1003 					sal_uInt16 nParCount = rPool.GetSize();
1004 
1005 					SbxDataType eType = pDef->GetType();
1006 					if( bFunction )
1007 						aGen.Gen( _PARAM, 0, sal::static_int_cast< sal_uInt16 >( eType ) );
1008 
1009 					if( nParCount > 1 )
1010 					{
1011 						aGen.Gen( _ARGC );
1012 
1013 						for( sal_uInt16 i = 1 ; i < nParCount ; ++i )
1014 						{
1015 							SbiSymDef* pParDef = rPool.Get( i );
1016 							SbxDataType eParType = pParDef->GetType();
1017 
1018 							aGen.Gen( _PARAM, i, sal::static_int_cast< sal_uInt16 >( eParType ) );
1019 							aGen.Gen( _ARGV );
1020 
1021 							sal_uInt16 nTyp = sal::static_int_cast< sal_uInt16 >( pParDef->GetType() );
1022 							if( pParDef->IsByVal() )
1023 							{
1024 								// Reset to avoid additional byval in call to wrapper function
1025 								pParDef->SetByVal( sal_False );
1026 								nTyp |= 0x8000;
1027 							}
1028 							aGen.Gen( _ARGTYP, nTyp );
1029 						}
1030 					}
1031 
1032 					aGen.Gen( _LIB, aGblStrings.Add( pDef->GetLib() ) );
1033 
1034 					SbiOpcode eOp = pDef->IsCdecl() ? _CALLC : _CALL;
1035 					sal_uInt16 nId = pDef->GetId();
1036 					if( pDef->GetAlias().Len() )
1037 						nId = ( nId & 0x8000 ) | aGblStrings.Add( pDef->GetAlias() );
1038 					if( nParCount > 1 )
1039 						nId |= 0x8000;
1040 					aGen.Gen( eOp, nId, sal::static_int_cast< sal_uInt16 >( eType ) );
1041 
1042 					if( bFunction )
1043 						aGen.Gen( _PUT );
1044 
1045 					aGen.Gen( _LEAVE );
1046 				}
1047 			}
1048 		}
1049 	}
1050 }
1051 
1052 // Aufruf einer SUB oder FUNCTION
1053 
1054 void SbiParser::Call()
1055 {
1056 	String aName( aSym );
1057 	SbiExpression aVar( this, SbSYMBOL );
1058 	aVar.Gen( FORCE_CALL );
1059 	aGen.Gen( _GET );
1060 }
1061 
1062 // SUB/FUNCTION
1063 
1064 void SbiParser::SubFunc()
1065 {
1066 	DefProc( sal_False, sal_False );
1067 }
1068 
1069 // Einlesen einer Prozedur
1070 
1071 sal_Bool runsInSetup( void );
1072 
1073 void SbiParser::DefProc( sal_Bool bStatic, sal_Bool bPrivate )
1074 {
1075 	sal_uInt16 l1 = nLine, l2 = nLine;
1076 	sal_Bool bSub = sal_Bool( eCurTok == SUB );
1077 	sal_Bool bProperty = sal_Bool( eCurTok == PROPERTY );
1078 	PropertyMode ePropertyMode = PROPERTY_MODE_NONE;
1079 	if( bProperty )
1080 	{
1081 		Next();
1082 		if( eCurTok == GET )
1083 			ePropertyMode = PROPERTY_MODE_GET;
1084 		else if( eCurTok == LET )
1085 			ePropertyMode = PROPERTY_MODE_LET;
1086 		else if( eCurTok == SET )
1087 			ePropertyMode = PROPERTY_MODE_SET;
1088 		else
1089 			Error( SbERR_EXPECTED, "Get or Let or Set" );
1090 	}
1091 
1092 	SbiToken eExit = eCurTok;
1093 	SbiProcDef* pDef = ProcDecl( sal_False );
1094 	if( !pDef )
1095 		return;
1096 	pDef->setPropertyMode( ePropertyMode );
1097 
1098 	// Ist die Proc bereits deklariert?
1099 	SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
1100 	if( pOld )
1101 	{
1102 		bool bError_ = false;
1103 
1104 		pProc = pOld->GetProcDef();
1105 		if( !pProc )
1106 		{
1107 			// Als Variable deklariert
1108 			Error( SbERR_BAD_DECLARATION, pDef->GetName() );
1109 			delete pDef;
1110 			pProc = NULL;
1111 			bError_ = true;
1112 		}
1113 		// #100027: Multiple declaration -> Error
1114 		// #112787: Not for setup, REMOVE for 8
1115 		else if( !runsInSetup() && pProc->IsUsedForProcDecl() )
1116 		{
1117 			PropertyMode ePropMode = pDef->getPropertyMode();
1118 			if( ePropMode == PROPERTY_MODE_NONE || ePropMode == pProc->getPropertyMode() )
1119 			{
1120 				Error( SbERR_PROC_DEFINED, pDef->GetName() );
1121 				delete pDef;
1122 				pProc = NULL;
1123 				bError_ = true;
1124 			}
1125 		}
1126 
1127 		if( !bError_ )
1128 		{
1129 			pDef->Match( pProc );
1130 			pProc = pDef;
1131 		}
1132 	}
1133 	else
1134 		aPublics.Add( pDef ), pProc = pDef;
1135 
1136 	if( !pProc )
1137 		return;
1138 	pProc->SetPublic( !bPrivate );
1139 
1140 	// Nun setzen wir die Suchhierarchie fuer Symbole sowie die aktuelle
1141 	// Prozedur.
1142 	aPublics.SetProcId( pProc->GetId() );
1143 	pProc->GetParams().SetParent( &aPublics );
1144 	if( bStatic )
1145         {
1146 		if ( bVBASupportOn )
1147 			pProc->SetStatic( sal_True );
1148 		else
1149 			Error( SbERR_NOT_IMPLEMENTED ); // STATIC SUB ...
1150         }
1151  	else
1152 	{
1153 		pProc->SetStatic( sal_False );
1154         }
1155 	// Normalfall: Lokale Variable->Parameter->Globale Variable
1156 	pProc->GetLocals().SetParent( &pProc->GetParams() );
1157 	pPool = &pProc->GetLocals();
1158 
1159 	pProc->Define();
1160 	OpenBlock( eExit );
1161 	StmntBlock( bSub ? ENDSUB : (bProperty ? ENDPROPERTY : ENDFUNC) );
1162 	l2 = nLine;
1163 	pProc->SetLine1( l1 );
1164 	pProc->SetLine2( l2 );
1165 	pPool = &aPublics;
1166 	aPublics.SetProcId( 0 );
1167 	// Offene Labels?
1168 	pProc->GetLabels().CheckRefs();
1169 	CloseBlock();
1170 	aGen.Gen( _LEAVE );
1171 	pProc = NULL;
1172 }
1173 
1174 // STATIC variable|procedure
1175 
1176 void SbiParser::Static()
1177 {
1178 	DefStatic( sal_False );
1179 }
1180 
1181 void SbiParser::DefStatic( sal_Bool bPrivate )
1182 {
1183 	switch( Peek() )
1184 	{
1185 		case SUB:
1186 		case FUNCTION:
1187 		case PROPERTY:
1188 			// End global chain if necessary (not done in
1189 			// SbiParser::Parse() under these conditions
1190 			if( bNewGblDefs && nGblChain == 0 )
1191 			{
1192 				nGblChain = aGen.Gen( _JUMP, 0 );
1193 				bNewGblDefs = sal_False;
1194 			}
1195 			Next();
1196 			DefProc( sal_True, bPrivate );
1197 			break;
1198 		default: {
1199 			if( !pProc )
1200 				Error( SbERR_NOT_IN_SUBR );
1201 			// Pool umsetzen, damit STATIC-Deklarationen im globalen
1202 			// Pool landen
1203 			SbiSymPool* p = pPool; pPool = &aPublics;
1204 			DefVar( _STATIC, sal_True );
1205 			pPool = p;
1206 			} break;
1207 	}
1208 }
1209 
1210