fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
0fef17cf67a9e3bb96a087babdaf3d7f2d66dd2f
harbour-core/harbour/source/compiler/hbpcode.c
Antonio Linares 5095f34175 HB_P_STATICNAME support.
2001-02-05 09:41:40 +00:00

2365 lines
97 KiB
C
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* Compiler PCode generation functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 2000 RonPinkas <Ron@Profit-Master.com>
* hb_compStrongType()
*
* See doc/license.txt for licensing terms.
*
*/
#include <assert.h>
#include "hbcomp.h"
static BYTE s_pcode_len[] = {
1, /* HB_P_AND, */
1, /* HB_P_ARRAYPUSH, */
1, /* HB_P_ARRAYPOP, */
3, /* HB_P_ARRAYDIM, */
3, /* HB_P_ARRAYGEN, */
1, /* HB_P_EQUAL, */
1, /* HB_P_ENDBLOCK, */
1, /* HB_P_ENDPROC, */
1, /* HB_P_EXACTLYEQUAL, */
1, /* HB_P_FALSE, */
1, /* HB_P_FORTEST, */
3, /* HB_P_FUNCTION, */
2, /* HB_P_FUNCTIONSHORT, */
3, /* HB_P_FRAME, */
1, /* HB_P_FUNCPTR, */
1, /* HB_P_GREATER, */
1, /* HB_P_GREATEREQUAL, */
1, /* HB_P_DEC, */
1, /* HB_P_DIVIDE, */
3, /* HB_P_DO, */
2, /* HB_P_DOSHORT, */
1, /* HB_P_DUPLICATE, */
1, /* HB_P_DUPLTWO, */
1, /* HB_P_INC, */
1, /* HB_P_INSTRING, */
2, /* HB_P_JUMPNEAR, */
3, /* HB_P_JUMP, */
4, /* HB_P_JUMPFAR, */
2, /* HB_P_JUMPFALSENEAR, */
3, /* HB_P_JUMPFALSE, */
4, /* HB_P_JUMPFALSEFAR, */
2, /* HB_P_JUMPTRUENEAR, */
3, /* HB_P_JUMPTRUE, */
4, /* HB_P_JUMPTRUEFAR, */
1, /* HB_P_LESSEQUAL, */
1, /* HB_P_LESS, */
3, /* HB_P_LINE, */
0, /* HB_P_LOCALNAME, */
1, /* HB_P_MACROPOP, */
1, /* HB_P_MACROPOPALIASED, */
1, /* HB_P_MACROPUSH, */
1, /* HB_P_MACROPUSHALIASED, */
1, /* HB_P_MACROSYMBOL, */
1, /* HB_P_MACROTEXT, */
3, /* HB_P_MESSAGE, */
1, /* HB_P_MINUS, */
1, /* HB_P_MODULUS, */
0, /* HB_P_MODULENAME, */
/* start: pcodes generated by macro compiler */
3, /* HB_P_MMESSAGE, */
3, /* HB_P_MPOPALIASEDFIELD, */
3, /* HB_P_MPOPALIASEDVAR, */
3, /* HB_P_MPOPFIELD, */
3, /* HB_P_MPOPMEMVAR, */
3, /* HB_P_MPUSHALIASEDFIELD, */
3, /* HB_P_MPUSHALIASEDVAR, */
0, /* HB_P_MPUSHBLOCK, */
3, /* HB_P_MPUSHFIELD, */
3, /* HB_P_MPUSHMEMVAR, */
3, /* HB_P_MPUSHMEMVARREF, */
3, /* HB_P_MPUSHSYM, */
3, /* HB_P_MPUSHVARIABLE, */
/* end: */
1, /* HB_P_MULT, */
1, /* HB_P_NEGATE, */
1, /* HB_P_NOOP, */
1, /* HB_P_NOT, */
1, /* HB_P_NOTEQUAL, */
1, /* HB_P_OR, */
4, /* HB_P_PARAMETER, */
1, /* HB_P_PLUS, */
1, /* HB_P_POP, */
1, /* HB_P_POPALIAS, */
3, /* HB_P_POPALIASEDFIELD, */
2, /* HB_P_POPALIASEDFIELDNEAR, */
3, /* HB_P_POPALIASEDVAR, */
3, /* HB_P_POPFIELD, */
3, /* HB_P_POPLOCAL, */
2, /* HB_P_POPLOCALNEAR, */
3, /* HB_P_POPMEMVAR, */
3, /* HB_P_POPSTATIC, */
3, /* HB_P_POPVARIABLE, */
1, /* HB_P_POWER, */
1, /* HB_P_PUSHALIAS, */
3, /* HB_P_PUSHALIASEDFIELD, */
2, /* HB_P_PUSHALIASEDFIELDNEAR, */
3, /* HB_P_PUSHALIASEDVAR, */
0, /* HB_P_PUSHBLOCK, */
0, /* HB_P_PUSHBLOCKSHORT, */
3, /* HB_P_PUSHFIELD, */
2, /* HB_P_PUSHBYTE, */
3, /* HB_P_PUSHINT, */
3, /* HB_P_PUSHLOCAL, */
2, /* HB_P_PUSHLOCALNEAR, */
3, /* HB_P_PUSHLOCALREF, */
1 + sizeof( long ), /* HB_P_PUSHLONG, */
3, /* HB_P_PUSHMEMVAR, */
3, /* HB_P_PUSHMEMVARREF, */
1, /* HB_P_PUSHNIL, */
1 + sizeof( double ) + sizeof( BYTE ) + sizeof( BYTE ), /* HB_P_PUSHDOUBLE, */
1, /* HB_P_PUSHSELF, */
3, /* HB_P_PUSHSTATIC, */
3, /* HB_P_PUSHSTATICREF, */
0, /* HB_P_PUSHSTR, */
0, /* HB_P_PUSHSTRSHORT, */
3, /* HB_P_PUSHSYM, */
2, /* HB_P_PUSHSYMNEAR, */
3, /* HB_P_PUSHVARIABLE, */
1, /* HB_P_RETVALUE, */
3, /* HB_P_SEND, */
2, /* HB_P_SENDSHORT, */
4, /* HB_P_SEQBEGIN, */
4, /* HB_P_SEQEND, */
1, /* HB_P_SEQRECOVER, */
3, /* HB_P_SFRAME, */
5, /* HB_P_STATICS, */
0, /* HB_P_STATICNAME, */
1, /* HB_P_SWAPALIAS, */
1, /* HB_P_TRUE, */
1, /* HB_P_ZERO, */
1 /* HB_P_ONE, */
};
static PVAR hb_compPrivateFind( char * szPrivateName )
{
PFUNCTION pFunc = hb_comp_functions.pLast;
PVAR pPrivate = NULL;
if( pFunc )
pPrivate = pFunc->pPrivates;
while ( pPrivate )
{
if( ! strcmp( pPrivate->szName, szPrivateName ) )
return pPrivate;
else
pPrivate = pPrivate->pNext;
}
return NULL;
}
void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * cargo )
{
ULONG ulPos = 0;
USHORT usSkip;
BYTE opcode;
HB_PCODE_FUNC_PTR pCall;
/* Make sure that table is correct */
assert( sizeof( s_pcode_len ) == HB_P_LAST_PCODE );
while( ulPos < pFunc->lPCodePos )
{
opcode = pFunc->pCode[ ulPos ];
if( opcode < HB_P_LAST_PCODE )
{
usSkip = s_pcode_len[ opcode ];
pCall = pFunctions[ opcode ];
if( pCall )
{
if( usSkip )
pCall( pFunc, ulPos, cargo );
else
usSkip = pCall( pFunc, ulPos, cargo );
}
ulPos += usSkip;
}
else
{
printf( "--- Invalid opcode %i in hb_compPCodeEval() ---\n", opcode );
++ulPos;
}
}
}
void hb_compStrongType( int iSize )
{
PFUNCTION pFunc = hb_comp_functions.pLast, pTmp;
PVAR pVar = NULL;
PCOMSYMBOL pSym = NULL;
PCOMDECLARED pDeclared;
ULONG ulPos = pFunc->lPCodePos - iSize;
SHORT wVar = 0;
BYTE szType1[64], szType2[64], cType, cSubType1 = 0, cSubType2 = 0;
BYTE bLast1, bLast2;
/* Make sure we have enough stack space. */
if( ! pFunc->pStack )
pFunc->pStack = ( BYTE * ) hb_xgrab( pFunc->iStackSize += 16 );
else if( pFunc->iStackSize - pFunc->iStackIndex < 4 )
pFunc->pStack = ( BYTE * ) hb_xrealloc( pFunc->pStack, pFunc->iStackSize += 16 );
/* TODO Split under conitions for the different matching possible iSize. */
/* TODO Subject to Operator Overloading! */
switch ( pFunc->pCode[ ulPos ] )
{
/*-----------------4/26/00 0:16AM-------------------
* Push values on stack.
* --------------------------------------------------*/
case HB_P_SWAPALIAS :
/* TODO check affect on stack. */
break;
case HB_P_RETVALUE :
if( pFunc->iStackIndex < 1 )
break;
pFunc->iStackIndex--;
pSym = hb_compSymbolFind( pFunc->szName, NULL );
if( pSym && pSym->szName )
{
char cType1, cType2;
pDeclared = hb_compDeclaredFind( pSym->szName );
if( pDeclared )
{
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pDeclared->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
/* Variant as SubType. */
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
else
cType1 = pFunc->pStack[ pFunc->iStackIndex ];
if( cSubType1 )
{
if( cSubType1 == 'S' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "AnyType.SubType[%s]", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cSubType1 == 's' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "AnyType.SubType[ARRAY OF %s]", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", cSubType1 );
}
else
{
if( cType1 == 'S' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "%s", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cType1 == 's' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "ARRAY OF %s", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cType1 == '-' )
strcpy( ( char * ) szType1, "NIL" );
else
sprintf( ( char * ) szType1, "%c", cType1 );
}
cType2 = pDeclared->cType;
if( cType2 == 'S' )
sprintf( ( char * ) szType2, "%s", pDeclared->pClass->szName );
else if( cType2 == 's' )
sprintf( ( char * ) szType2, "ARRAY OF %s", pDeclared->pClass->szName );
else if( cType2 == '-' )
sprintf( ( char * ) szType2, "NIL" );
else
sprintf( ( char * ) szType2, "%c", cType2 );
if( pDeclared->cType != ' ' && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_RETURN_SUSPECT, ( char * ) szType1, ( char * ) szType2 );
else if( pDeclared->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'O' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_RETURN_SUSPECT, ( char * ) szType1, ( char * ) szType2 );
else if( pDeclared->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 'o' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_RETURN_SUSPECT, ( char * ) szType1, ( char * ) szType2 );
else if( pDeclared->cType != ' ' && pDeclared->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_RETURN_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
break;
case HB_P_DO :
case HB_P_FUNCTION :
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
/* DON't put break; Has to fall through */
case HB_P_DOSHORT :
case HB_P_FUNCTIONSHORT :
if( wVar == 0 )
wVar = pFunc->pCode[ ulPos + 1 ];
if( pFunc->iStackIndex < ( wVar + 2 ) )
break;
if( pFunc->iStackFunctions > 0 && pFunc->pStackFunctions[ --pFunc->iStackFunctions ] )
{
int hb_comp_iParamCount, iParamCount, iOptionals = 0;
BYTE * hb_comp_cParamTypes;
hb_comp_cParamTypes = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->cParamTypes;
hb_comp_iParamCount = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->iParamCount;
iParamCount = hb_comp_iParamCount;
/* First, find how many optionals. */
while ( --iParamCount >= 0 )
{
if( hb_comp_cParamTypes[ iParamCount ] == ( ' ' + VT_OFFSET_OPTIONAL ) || hb_comp_cParamTypes[ iParamCount ] >= ( 'A' + VT_OFFSET_OPTIONAL ) )
iOptionals++;
else
break;
}
/*printf( "\nOptionals: %i\n", iOptionals );*/
//printf( "Exec Function: %s, wVar: %i Parameters: %i Optionals: %i\n", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName,wVar, hb_comp_iParamCount, iOptionals );
/* Now, check the types. */
if( wVar >= ( hb_comp_iParamCount - iOptionals ) && wVar <= hb_comp_iParamCount )
{
BYTE iParamBase = pFunc->iStackIndex - wVar, cFormalType;
int iOffset = wVar;
while ( --iOffset >= 0 )
{
cFormalType = hb_comp_cParamTypes[ iOffset ];
if( cFormalType == ( ' ' + VT_OFFSET_OPTIONAL ) || cFormalType >= ( 'A' + VT_OFFSET_OPTIONAL ) )
cFormalType -= VT_OFFSET_OPTIONAL;
if( cFormalType == ' ' + VT_OFFSET_BYREF )
cFormalType = '@';
if( cFormalType == ' ' )
; /* Declared is Variant, accept anything. */
else if( pFunc->pStack[ iParamBase + iOffset ] == '-' )
; /* Parameter is NIL, always accepted. */
else if( cFormalType == '@' && pFunc->pStack[ iParamBase + iOffset ] >= ( 'A' + VT_OFFSET_BYREF ) )
; /* Prameter is ANY REFERENCE, and Parameter is SOME REFERENCE. */
else if( cFormalType == 'S' && pFunc->pStack[ iParamBase + iOffset ] == 'S' && pFunc->iStackClasses )
{
PCOMCLASS hb_comp_pFormalClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ];
if( hb_comp_pFormalClass != hb_comp_pParamClass )
{
sprintf( ( char * ) szType1, "%i", iOffset + 1 );
sprintf( ( char * ) szType2, "%s", hb_comp_pFormalClass->szName );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
else if( cFormalType == 's' && pFunc->pStack[ iParamBase + iOffset ] == 's' && pFunc->iStackClasses )
{
PCOMCLASS hb_comp_pFormalClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ];
if( hb_comp_pFormalClass != hb_comp_pParamClass )
{
sprintf( ( char * ) szType1, "%i", iOffset + 1 );
sprintf( ( char * ) szType2, "ARRAY OF %s", hb_comp_pFormalClass->szName );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
else if( cFormalType != pFunc->pStack[ iParamBase + iOffset ] )
{
if( cFormalType == 'S' )
{
PCOMCLASS hb_comp_pParamClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
sprintf( ( char * ) szType2, "%s", hb_comp_pParamClass->szName );
}
else if( cFormalType == 's' )
{
PCOMCLASS hb_comp_pParamClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
sprintf( ( char * ) szType2, "ARRAY OF %s", hb_comp_pParamClass->szName );
}
else
{
if( cFormalType > ( 'A' + VT_OFFSET_BYREF ) )
sprintf( ( char * ) szType2, "@%c", cFormalType - VT_OFFSET_BYREF );
else if( toupper( pFunc->pStack[ iParamBase + iOffset ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses;
else
sprintf( ( char * ) szType2, "%c", cFormalType );
}
sprintf( ( char * ) szType1, "%i", iOffset + 1 );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
}
else
{
sprintf( ( char * ) szType1, "%i", wVar );
sprintf( ( char * ) szType2, "%i", hb_comp_iParamCount - iOptionals );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_COUNT, ( char * ) szType1, ( char * ) szType2 );
}
}
/* Removing all the parameters. Rteurn type already pushed just prior to parameters */
pFunc->iStackIndex -= wVar;
/* Removing the NIL */
pFunc->iStackIndex--;
if( pFunc->pCode[ ulPos ] == HB_P_DO || pFunc->pCode[ ulPos ] == HB_P_DOSHORT )
/* No return value. */
pFunc->iStackIndex--;
else
; /* Declared result already on stack. */
/*printf( "\nType of Function: \'%c\'\n", pFunc->pStack[ pFunc->iStackIndex - 1 ] );*/
break;
case HB_P_MESSAGE :
if( pFunc->iStackIndex < 1 )
break;
cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ];
if( cSubType1 >= ( 'A' + VT_OFFSET_VARIANT ) )
{
cSubType1 -= VT_OFFSET_VARIANT;
if( cSubType1 == 'S' )
sprintf( ( char * ) szType1, "AnyType.SubType[Object]" );
else if( cSubType1 == 's' )
sprintf( ( char * ) szType1, "AnyType.SubType[ARRAY OF Object]" );
else if( islower( cSubType1 ) )
sprintf( ( char * ) szType1, "AnyType.SubType[ARRAY OF %c]", cSubType1 );
else if( cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", cSubType1 );
}
else
sprintf( ( char * ) szType1, "%c", cSubType1 );
if( cSubType1 == 'O' )
;/* The Object is not declared. */
else if( cSubType1 == 'S' )
{
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 );
if( pSym && pSym->szName && pFunc->iStackClasses && pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
{
if( pFunc->iStackFunctions < 8 )
{
pFunc->pStackFunctions[ pFunc->iStackFunctions++ ] = hb_compMethodFind( pFunc->pStackClasses[ pFunc->iStackClasses - 1 ], pSym->szName );
/*printf( "\nMethod: %s of Class: %s Parameters: %i\n", pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName, pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ]->iParamCount );*/
if( pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ] == NULL )
{
if( pSym->szName[0] == '_' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, &( pSym->szName[1] ), pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName );
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName );
}
}
}
else /* The method is not declared. */
{
if( pFunc->iStackFunctions < 8 )
pFunc->pStackFunctions[ pFunc->iStackFunctions++ ] = NULL;
}
}
else if( cSubType1 == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "O", NULL );
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "O" );
/* Result will be pushed by HB_P_SEND*/
break;
/* Also handled by HB_P_MESSAGE. */
case HB_P_SEND :
wVar = * ( ( SHORT * ) &( pFunc->pCode )[ ulPos + 1 ] );
/* Fall Through - don't add break !!! */
case HB_P_SENDSHORT :
if( wVar == 0 )
wVar = ( SHORT ) pFunc->pCode[ ulPos + 1 ];
if( pFunc->iStackIndex < ( wVar + 1 ) )
break;
cType = pFunc->pStack[ pFunc->iStackIndex - ( wVar + 1 ) ];
if( cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType -= VT_OFFSET_VARIANT;
if( cType == 'S' && pFunc->iStackFunctions > 0 && pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ] )
{
int hb_comp_iParamCount, iParamCount, iOptionals = 0;
BYTE * hb_comp_cParamTypes;
hb_comp_cParamTypes = pFunc->pStackFunctions[ --pFunc->iStackFunctions ]->cParamTypes;
hb_comp_iParamCount = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->iParamCount;
iParamCount = hb_comp_iParamCount;
/*printf( "\nExec Method: %s of Class: %s Parameters: %i\n", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName, pFunc->pStackFunctions[ pFunc->iStackFunctions ]->iParamCount );*/
/* First, find how many optionals. */
while ( --iParamCount >= 0 )
{
if( hb_comp_cParamTypes[ iParamCount ] == ( ' ' + VT_OFFSET_OPTIONAL ) || hb_comp_cParamTypes[ iParamCount ] >= ( 'A' + VT_OFFSET_OPTIONAL ) )
iOptionals++;
else
break;
}
/*printf( "\nOptionals: %i\n", iOptionals );*/
/*printf( "Method: %s, wVar: %i Parameters: %i Optionals: %i\n", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, wVar, hb_comp_iParamCount, iOptionals );*/
/* Now, check the types. */
if( wVar >= ( hb_comp_iParamCount - iOptionals ) && wVar <= hb_comp_iParamCount )
{
BYTE iParamBase = pFunc->iStackIndex - wVar, cFormalType;
int iOffset = wVar;
while ( --iOffset >= 0 )
{
cFormalType = hb_comp_cParamTypes[ iOffset ];
/*printf( "\nFormal # %i Type: %c\n", iOffset, cFormalType );*/
if( cFormalType == ( ' ' + VT_OFFSET_OPTIONAL ) || cFormalType >= ( 'A' + VT_OFFSET_OPTIONAL ) )
cFormalType -= VT_OFFSET_OPTIONAL;
if( cFormalType == ' ' + VT_OFFSET_BYREF )
cFormalType = '@';
if( cFormalType == ' ' )
; /* Declared is Variant, accept anything. */
else if( pFunc->pStack[ iParamBase + iOffset ] == '-' )
; /* Parameter is NIL, always accepted. */
else if( cFormalType == '@' && pFunc->pStack[ iParamBase + iOffset ] >= ( 'A' + VT_OFFSET_BYREF ) )
; /* Prameter is ANY REFERENCE, and Parameter is SOME REFERENCE. */
else if( cFormalType == 'S' && pFunc->pStack[ iParamBase + iOffset ] == 'S' && pFunc->iStackClasses )
{
PCOMCLASS hb_comp_pFormalClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ];
if( hb_comp_pFormalClass != hb_comp_pParamClass )
{
sprintf( ( char * ) szType1, "%i", iOffset + 1 );
sprintf( ( char * ) szType2, "%s", hb_comp_pFormalClass->szName );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
else if( cFormalType == 's' && pFunc->pStack[ iParamBase + iOffset ] == 's' && pFunc->iStackClasses )
{
PCOMCLASS hb_comp_pFormalClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ];
if( hb_comp_pFormalClass != hb_comp_pParamClass )
{
sprintf( ( char * ) szType1, "%i", iOffset + 1 );
sprintf( ( char * ) szType2, "ARRAY OF %s", hb_comp_pFormalClass->szName );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
else if( cFormalType != pFunc->pStack[ iParamBase + iOffset ] )
{
if( cFormalType == 'S' )
{
PCOMCLASS hb_comp_pFormalClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
sprintf( ( char * ) szType2, "%s", hb_comp_pFormalClass->szName );
}
else if( cFormalType == 's' )
{
PCOMCLASS hb_comp_pFormalClass = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pParamClasses[ iOffset ];
sprintf( ( char * ) szType2, "ARRAY OF %s", hb_comp_pFormalClass->szName );
}
else
{
if( toupper( pFunc->pStack[ iParamBase + iOffset ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses ;
else if( cFormalType > ( 'A' + VT_OFFSET_BYREF ) )
sprintf( ( char * ) szType2, "@%c", cFormalType - VT_OFFSET_BYREF );
else
sprintf( ( char * ) szType2, "%c", cFormalType );
}
sprintf( ( char * ) szType1, "%i", iOffset + 1 );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 );
}
}
}
else
{
/*printf( "Method: %s, wVar: %i Parameters: %i Optionals: %i\n", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, wVar, hb_comp_iParamCount, iOptionals );*/
sprintf( ( char * ) szType1, "%i", wVar );
sprintf( ( char * ) szType2, "%i", hb_comp_iParamCount - iOptionals );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_COUNT, ( char * ) szType1, ( char * ) szType2 );
}
}
else if( pFunc->iStackFunctions )
{
--pFunc->iStackFunctions;
}
/* Removing all the parameters.*/
pFunc->iStackIndex -= wVar;
if( cType == 'S' && pFunc->pStackFunctions[ pFunc->iStackFunctions ] )
{
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->cType;
/*printf( "\nDeclared Method!!! Stack: %i Type: %c\n", pFunc->iStackIndex, pFunc->pStack[ pFunc->iStackIndex - 1 ] );*/
if( toupper( pFunc->pStack[ pFunc->iStackIndex - 1 ] ) == 'S' && pFunc->iStackClasses < 8 )
{
/*printf( "\nNested CLASS!!! Stack: %i Type: %c Class: %s\n", pFunc->iStackIndex, pFunc->pStack[ pFunc->iStackIndex - 1 ], pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pClass->szName );*/
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pClass;
}
}
else
{
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
}
break;
case HB_P_DEC :
case HB_P_INC :
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL" );
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'N' )
;
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "N", NULL );
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "N" );
break;
case HB_P_JUMPFALSENEAR :
case HB_P_JUMPFALSE :
case HB_P_JUMPFALSEFAR :
case HB_P_JUMPTRUENEAR :
case HB_P_JUMPTRUE :
case HB_P_JUMPTRUEFAR :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
strcpy( ( char * ) szType1, "NIL" );
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
if( pFunc->pStack[ pFunc->iStackIndex ] == 'L' )
;
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "L", NULL );
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "L" );
break;
case HB_P_INSTRING :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL");
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( cSubType2 && cSubType2 == '-' )
strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" );
else if( cSubType2 )
sprintf( ( char * ) szType2, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
strcpy( ( char * ) szType2, "NIL" );
else
sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
;
else if( pFunc->pStack[ pFunc->iStackIndex ] == 'C' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'C' )
{
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L';
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "C", NULL );
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] != 'C' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "C" );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "C", NULL );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
}
else if( pFunc->pStack[ pFunc->iStackIndex ] != 'C' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType2, "C" );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
break;
/* May be subject to Operator Overloading - don't restrict to Numeric! */
case HB_P_DIVIDE :
case HB_P_PLUS :
case HB_P_MINUS :
case HB_P_NEGATE :
case HB_P_MULT :
case HB_P_POWER :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
/*printf( "\nTop: %c Bottom: %c Typ-SubType: %c Bottom->SubType: %c\n", pFunc->pStack[ pFunc->iStackIndex], pFunc->pStack[ pFunc->iStackIndex - 1 ], pFunc->pStack[ pFunc->iStackIndex] - 100, pFunc->pStack[ pFunc->iStackIndex - 1 ] - 100 );*/
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL");
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( cSubType2 && cSubType2 == '-' )
strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" );
else if( cSubType2 )
sprintf( ( char * ) szType2, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
strcpy( ( char * ) szType2, "NIL" );
else
sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
/* Override the last item with the new result type which is already there */
;
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == 'N' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'N' )
{
/* Override the last item with the new result type wich is already there */
;
}
else if( ( pFunc->pCode[ ulPos ] == HB_P_PLUS || pFunc->pCode[ ulPos ] == HB_P_MINUS ) &&
pFunc->pStack[ pFunc->iStackIndex ] == pFunc->pStack[ pFunc->iStackIndex - 1 ] )
{
/* Override the last item with the new result type wich is already there */
;
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType2, NULL );
/* Override the last item with the new result type wich is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, NULL );
/* Override the last item with the new result type. */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, "NIL", NULL );
/* Override the last item with the new result type. */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, "NIL", NULL );
/* Override the last item with the new result type. */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERANDS_INCOMPATBLE, ( char * ) szType1, ( char * ) szType2 );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
break;
case HB_P_GREATER :
case HB_P_GREATEREQUAL :
case HB_P_LESSEQUAL :
case HB_P_LESS :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
sprintf( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL" );
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( cSubType2 && cSubType2 == '-' )
strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" );
else if( cSubType2 )
sprintf( ( char * ) szType2, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
strcpy( ( char * ) szType2, "NIL" );
else
sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
if( pFunc->pStack[ pFunc->iStackIndex ] == '-' || pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERANDS_INCOMPATBLE, ( char * ) szType1, ( char * ) szType2 );
/* Override the last item with the new result type wich is already there */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
/* Override the last item with the new result type which is already there */
;
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == pFunc->pStack[ pFunc->iStackIndex - 1 ] )
{
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L';
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, NULL );
/* Override the last item with the new result type wich is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType2, NULL );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERANDS_INCOMPATBLE, ( char * ) szType1, ( char * ) szType2 );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
break;
case HB_P_EQUAL :
case HB_P_EXACTLYEQUAL :
case HB_P_NOTEQUAL :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
sprintf( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL");
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( cSubType2 && cSubType2 == '-' )
strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" );
else if( cSubType2 )
sprintf( ( char * ) szType2, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
strcpy( ( char * ) szType2, "NIL" );
else
sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
if( pFunc->pStack[ pFunc->iStackIndex ] == '-' || pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
{
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L';
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
/* Override the last item with the new result type which is already there */
;
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == pFunc->pStack[ pFunc->iStackIndex - 1 ] )
{
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L';
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType2, NULL );
/* Override the last item with the new result type wich is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, NULL );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERANDS_INCOMPATBLE, ( char * ) szType1, ( char * ) szType2 );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
break;
case HB_P_NOT :
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL" );
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "L", NULL );
/* Override the last item with the new result type which is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] != 'L' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "L" );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
break;
case HB_P_AND :
case HB_P_OR :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pStack[ pFunc->iStackIndex - 1 ] >= 'A' + VT_OFFSET_VARIANT )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT );
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if( cSubType1 && cSubType1 == '-' )
sprintf( ( char * ) szType1, "AnyType.SubType[NIL]" );
else if( cSubType1 )
sprintf( ( char * ) szType1, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' )
strcpy( ( char * ) szType1, "NIL");
else
sprintf( ( char * ) szType1, "%c", pFunc->pStack[ pFunc->iStackIndex - 1 ] );
if( cSubType2 && cSubType2 == '-' )
strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" );
else if( cSubType2 )
sprintf( ( char * ) szType2, "AnyType.SubType[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
strcpy( ( char * ) szType2, "NIL" );
else
sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
if( ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' ) ||
( pFunc->pStack[ pFunc->iStackIndex ] == 'L' && pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'L' ) )
{
/* Override the last item with the new result type which is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "L", NULL );
/* Override the last item with the new result type which is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex - 1 ] != 'L' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "L" );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
else if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "L", NULL );
/* Override the last item with the new result type which is already there */
}
else if( pFunc->pStack[ pFunc->iStackIndex ] != 'L' )
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType2, "L" );
/* Override the last item with the new result type */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U';
}
break;
case HB_P_DUPLICATE :
if( pFunc->iStackIndex < 1 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
bLast1 = pFunc->pStack[ pFunc->iStackIndex - 1 ];
pFunc->pStack[ pFunc->iStackIndex++ ] = bLast1;
break;
case HB_P_DUPLTWO :
if( pFunc->iStackIndex < 2 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
bLast1 = pFunc->pStack[ pFunc->iStackIndex - 2 ];
bLast2 = pFunc->pStack[ pFunc->iStackIndex - 1 ];
pFunc->pStack[ pFunc->iStackIndex++ ] = bLast1;
pFunc->pStack[ pFunc->iStackIndex++ ] = bLast2;
break;
/* Explicit Types. */
/* Objects */
case HB_P_PUSHSELF :
pFunc->pStack[ pFunc->iStackIndex++ ] = 'O';
/* Todo find Self's Class. */
break;
/* Blcoks */
/* Nothing to do, handled by HB_P_ENDBLOCK.
case HB_P_PUSHBLOCK :
case HB_P_PUSHBLOCKSHORT :
*/
case HB_P_ENDBLOCK :
/* Override the last value of the block left on the stack. */
pFunc->pStack[ pFunc->iStackIndex ] = 'B';
break;
/* Undefined */
case HB_P_PUSHNIL :
pFunc->pStack[ pFunc->iStackIndex++ ] = '-';
break;
/* Logicals */
case HB_P_TRUE :
case HB_P_FALSE :
pFunc->pStack[ pFunc->iStackIndex++ ] = 'L';
break;
/* Numerics */
case HB_P_PUSHDOUBLE :
case HB_P_PUSHLONG :
case HB_P_PUSHINT :
case HB_P_PUSHBYTE :
case HB_P_ZERO :
case HB_P_ONE :
pFunc->pStack[ pFunc->iStackIndex++ ] = 'N';
break;
/* Charcters */
case HB_P_PUSHSTRSHORT :
case HB_P_PUSHSTR :
pFunc->pStack[ pFunc->iStackIndex++ ] = 'C';
break;
case HB_P_PUSHSYMNEAR :
case HB_P_PUSHSYM :
case HB_P_MPUSHSYM :
/* In Private or Public statement can't be a declared function */
if( ( hb_comp_iVarScope == VS_PRIVATE || hb_comp_iVarScope == VS_PUBLIC ) )
pFunc->pStack[ pFunc->iStackIndex++ ] = ' ';
else
{
if( pFunc->pCode[ ulPos ] == HB_P_PUSHSYMNEAR )
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] );
else
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 );
/*printf( "\nSymbol: %s\n", pSym->szName );*/
if( pSym && pSym->szName )
{
pDeclared = hb_compDeclaredFind( pSym->szName );
if( pDeclared )
{
pFunc->pStack[ pFunc->iStackIndex++ ] = pDeclared->cType;
if( toupper( pDeclared->cType ) == 'S' && pFunc->iStackClasses < 8 )
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pDeclared->pClass;
}
else
pFunc->pStack[ pFunc->iStackIndex++ ] = ' ';
/* Storing, will be checked by HB_P_FUNCTION, OK to store NULL */
/* TODO don't use hard coded size */
if( pFunc->iStackFunctions < 8 )
pFunc->pStackFunctions[ pFunc->iStackFunctions++ ] = pDeclared;
/* QUESTION: Add other "safe" functions, or remove adaptive type checking support for memvars? */
if( strcmp( pSym->szName, "QOUT" ) )
{
/*printf( "\nRestting privates affected by: %s\n", pSym->szName );*/
/* All Private Variants Subtype will be unknown after function call. */
pVar = pFunc->pMemvars;
while ( pVar )
{
if( pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
pVar->cType = ' ';
pVar = pVar->pNext;
}
}
}
else
{
/* Storing, will be checked by FUNCTION, OK to store NULL */
/* TODO don't use hard coded size */
if( pFunc->iStackFunctions < 8 )
pFunc->pStackFunctions[ pFunc->iStackFunctions++ ] = NULL;
}
}
break;
case HB_P_FUNCPTR :
/* Previous symbol pushed no longer used as function call. */
pFunc->pStackFunctions[ --pFunc->iStackFunctions ] = NULL;
pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'F';
break;
case HB_P_PUSHLOCALNEAR :
case HB_P_PUSHLOCALREF :
case HB_P_PUSHLOCAL :
if( pFunc->pCode[ ulPos ] == HB_P_PUSHLOCALNEAR )
wVar = ( SHORT ) pFunc->pCode[ ulPos + 1 ];
else
wVar = * ( ( SHORT * ) &( pFunc->pCode )[ ulPos + 1 ] );
/* we are accesing variables within a codeblock */
if( wVar < 0 )
{
/* Finding the Function owning the block. */
pTmp = pFunc->pOwner;
/* Might be a nested block. */
while ( pTmp->pOwner )
pTmp = pTmp->pOwner;
pVar = hb_compVariableFind( pTmp->pLocals, -wVar );
}
else
pVar = hb_compVariableFind( pFunc->pLocals, wVar );
if( pVar )
{
if( ! ( pVar->iUsed & VU_INITIALIZED ) )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL );
/* Mark as used */
pVar->iUsed |= VU_USED;
if( pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType = pVar->cType - VT_OFFSET_VARIANT;
else
cType = pVar->cType;
if( toupper( cType ) == 'S' && pFunc->iStackClasses < 8 )
{
/* Object of declared class */
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass;
}
if( pFunc->pCode[ ulPos ] == HB_P_PUSHLOCALREF )
pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType + VT_OFFSET_BYREF;
else
pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType;
}
else
if( pFunc->pCode[ ulPos ] == HB_P_PUSHLOCALREF )
pFunc->pStack[ pFunc->iStackIndex++ ] = '@';
else
pFunc->pStack[ pFunc->iStackIndex++ ] = ' ';
break;
case HB_P_PUSHSTATICREF :
case HB_P_PUSHSTATIC :
pTmp = hb_comp_functions.pFirst;
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
while( pTmp->pNext && pTmp->pNext->iStaticsBase < wVar )
pTmp = pTmp->pNext;
pVar = hb_compVariableFind( pTmp->pStatics, wVar - pTmp->iStaticsBase );
/* Will be pushed shortly. */
pFunc->iStackIndex++;
if( pVar )
{
/*printf( "\nStatic: %s Type: %c Function: %s Found in: %s\n", pVar->szName, pVar->cType, pFunc->szName, pTmp->szName );*/
/* Only if "private" static, since global static may be intialized elsewhere. */
/* May have been initialized in previous execution of the function.
if( pTmp == pFunc )
if( ! ( pVar->iUsed & VU_INITIALIZED ) )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL );
*/
/* Mark as used */
pVar->iUsed |= VU_USED;
if( pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType = pVar->cType - VT_OFFSET_VARIANT;
else
cType = pVar->cType;
if( toupper( cType ) == 'S' && pFunc->iStackClasses < 8 )
{
/* Object of declared class */
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass;
}
if( pFunc->pCode[ ulPos ] == HB_P_PUSHSTATICREF )
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType + VT_OFFSET_BYREF;
else
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType;
}
else
if( pFunc->pCode[ ulPos ] == HB_P_PUSHSTATICREF )
pFunc->pStack[ pFunc->iStackIndex - 1 ] = '@';
else
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
break;
case HB_P_PUSHVARIABLE :
/* Type can not be detrmined at compile time. */
pFunc->pStack[ pFunc->iStackIndex++ ] = ' ';
break;
case HB_P_PUSHALIASEDVAR :
/* TODO check what is aliased var. */
pFunc->pStack[ pFunc->iStackIndex++ ] = ' ';
break;
case HB_P_PUSHALIASEDFIELDNEAR :
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] );
/* Fall through - don't add break */
case HB_P_PUSHALIASEDFIELD :
case HB_P_PUSHFIELD :
if( ! pSym )
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 );
if( pSym && pSym->szName && pFunc->pFields )
{
wVar = hb_compVariableGetPos( pFunc->pFields, pSym->szName );
if( wVar )
pVar = hb_compVariableFind( pFunc->pFields, wVar );
}
/* Fall through - don't add break */
case HB_P_PUSHMEMVARREF :
case HB_P_PUSHMEMVAR :
if( ! pSym )
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 );
if( pSym )
{
if( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVAR && pSym->szName )
{
if( pFunc->pMemvars )
wVar = hb_compVariableGetPos( pFunc->pMemvars, pSym->szName );
if( wVar )
pVar = hb_compVariableFind( pFunc->pMemvars, wVar );
if( ! pVar )
pVar = hb_compPrivateFind( pSym->szName );
if( ( ! pVar ) && hb_comp_functions.pFirst->pMemvars )
{
wVar = hb_compVariableGetPos( hb_comp_functions.pFirst->pMemvars, pSym->szName );
if( wVar )
pVar = hb_compVariableFind( hb_comp_functions.pFirst->pMemvars, wVar );
}
}
if( pVar )
{
cType = pVar->cType;
/*printf( "\nPushed: %s Type: %c SubType: %c\n", pVar->szName, pVar->cType, pVar->cType - 100 );*/
if( ! ( pVar->iUsed & VU_INITIALIZED ) )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL );
if( cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType -= VT_OFFSET_VARIANT;
/* Mark as used */
pVar->iUsed |= VU_USED;
if( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVARREF )
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType + VT_OFFSET_BYREF;
else if( toupper( cType ) == 'S' && pFunc->iStackClasses < 8 )
{
/* Object of declared class */
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass;
pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType;
}
else
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType;
}
else
{
cType = pSym->cType;
/*printf( "\nPushed Symbol: %s Type: %c SubType: %c\n", pSym->szName, pSym->cType, pSym->cType - 100 );*/
if( cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType -= VT_OFFSET_VARIANT;
if( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVARREF )
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pSym->cType + VT_OFFSET_BYREF;
else if( toupper( cType ) == 'S' && pFunc->iStackClasses < 8 )
{
/* Object of declared class */
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pSym->pClass;
pFunc->pStack[ pFunc->iStackIndex++ ] = pSym->cType;
}
else
pFunc->pStack[ pFunc->iStackIndex - 1 ] = pSym->cType;
}
}
else
if( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVARREF )
pFunc->pStack[ pFunc->iStackIndex++ ] = '@';
else
pFunc->pStack[ pFunc->iStackIndex++ ] = ' ';
break;
/* Arrays. */
case HB_P_ARRAYDIM :
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
if( pFunc->iStackIndex < wVar )
/* TODO Error Message after finalizing all possible pcodes. */
break;
/* Removing the dimensions sizes. */
pFunc->iStackIndex -= wVar;
/* Push type array of NILs (empty array). */
pFunc->pStack[ pFunc->iStackIndex++ ] = '-' + 100;
/*printf( "\nPushed array at: %i\n", pFunc->iStackIndex - 1 );*/
break;
case HB_P_ARRAYGEN :
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
if( pFunc->iStackIndex == 0 )
{
pFunc->pStack[ pFunc->iStackIndex++ ] = 'A';
break;
}
if( pFunc->iStackIndex < wVar )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( wVar )
cType = pFunc->pStack[ pFunc->iStackIndex - 1 ];
else
cType = 'A';
while ( --wVar > 0 )
{
pFunc->iStackIndex--;
if( cType == ' ' || cType != pFunc->pStack[ pFunc->iStackIndex - 1 ] )
{
cType = 'A';
break;
}
}
/* Lower Case Indicates array of ...*/
if( cType != 'A' )
cType = tolower( cType );
pFunc->pStack[ pFunc->iStackIndex - 1 ] = cType;
break;
case HB_P_ARRAYPUSH :
/* Poping the Array Index. */
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
{
BYTE cVarType = pFunc->pStack[ pFunc->iStackIndex - 1 ];
/*printf( "\n Base Type: %c\n", cVarType );*/
if( cVarType >= ( 'A' + VT_OFFSET_VARIANT ) )
cVarType -= VT_OFFSET_VARIANT;
if( cVarType == ' ' )
{
/* Type unknown. */
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "A", NULL );
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
}
else if( cVarType == 'A' )
/* Variant Array Element - Type unknown. */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
else if( cVarType == 'a' )
/* Variant Array Element - Type unknown. */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
else if( islower( cVarType ) )
/* Now we have the declared array element on the stack.*/
pFunc->pStack[ pFunc->iStackIndex - 1 ] = toupper( cVarType );
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_ARRAY, NULL, NULL );
}
break;
case HB_P_ARRAYPOP :
/* Poping the Array Index. */
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 2 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
{
BYTE cVarType = pFunc->pStack[ pFunc->iStackIndex - 1 ], cElementType = pFunc->pStack[ pFunc->iStackIndex - 2 ];
if( cVarType >= ( 'A' + VT_OFFSET_VARIANT ) )
cVarType -= VT_OFFSET_VARIANT;
if( cElementType >= ( 'A' + VT_OFFSET_VARIANT ) )
cElementType -= VT_OFFSET_VARIANT;
if( cVarType == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "A", NULL );
else if( cVarType == 'A' )
/* Array of variant can hold any value. */
;
else if( cVarType == 'a' )
/* Array of variant can hold any value. */
;
else if( islower( cVarType ) && cElementType == ' ' )
{
/* Array Of explicit type. */
char szType[2];
sprintf( ( char * ) szType, "%c", toupper( cVarType ) );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
}
else if( islower( cVarType ) && toupper( cVarType ) != cElementType && cElementType != '-' )
{
/* Array Of explicit type. */
char szType[2];
sprintf( ( char * ) szType, "%c", toupper( cVarType ) );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
}
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_ARRAY, NULL, NULL );
}
/* Poping the Assigned Value. */
pFunc->iStackIndex--;
break;
/* Macros type unknown */
case HB_P_MPUSHALIASEDFIELD :
case HB_P_MPUSHALIASEDVAR :
case HB_P_MPUSHFIELD :
case HB_P_MPUSHMEMVAR :
case HB_P_MPUSHMEMVARREF :
case HB_P_MPUSHVARIABLE :
case HB_P_MACROPUSHALIASED :
case HB_P_MACROPUSH :
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
/* Replace the value of the macro expression with unknown result of expanded macro. */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
break;
case HB_P_MACROSYMBOL :
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
/* Replace Macro Variable Symbol Name type with unknown type of expanded macro Function Call */
pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' ';
break;
case HB_P_MACROTEXT :
/* Stack already has type C. */
/*pFunc->pStack[ pFunc->iStackIndex ] = 'C';*/
break;
/*-----------------4/26/00 0:15AM-------------------
* Begin POP Check and Remove from Stack.
* --------------------------------------------------*/
case HB_P_POP :
case HB_P_POPALIAS :
pFunc->iStackIndex--;
break;
case HB_P_POPVARIABLE :
/* Ambigious Variable, will be determined only in Run Time! */
pFunc->iStackIndex--;
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses;
break;
case HB_P_POPALIASEDVAR :
/* Ambigious Variable, will be determined only in Run Time! */
pFunc->iStackIndex--;
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses;
break;
case HB_P_POPALIASEDFIELDNEAR :
if( pFunc->pCode[ ulPos ] == HB_P_POPALIASEDFIELDNEAR )
{
wVar = ( SHORT ) pFunc->pCode[ ulPos + 1 ];
pSym = hb_compSymbolGetPos( wVar );
}
/* Fall through, don't put break!!!*/
case HB_P_POPALIASEDFIELD :
case HB_P_POPFIELD :
if( pFunc->pCode[ ulPos ] == HB_P_POPFIELD || pFunc->pCode[ ulPos ] == HB_P_POPALIASEDFIELD )
{
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
pSym = hb_compSymbolGetPos( wVar );
}
/*printf( "\nField: %s Pos: %i", pSym->szName, wVar );*/
/* For fall through as well */
if( pSym && pSym->szName && pFunc->pFields )
{
wVar = hb_compVariableGetPos( pFunc->pFields, pSym->szName );
if( wVar )
pVar = hb_compVariableFind( pFunc->pFields, wVar );
}
if( ( ( ! wVar ) || ( ! pVar ) ) && pSym && pSym->szName && hb_comp_functions.pFirst->pFields )
{
wVar = hb_compVariableGetPos( hb_comp_functions.pFirst->pFields, pSym->szName );
pVar = hb_compVariableFind( hb_comp_functions.pFirst->pFields, wVar );
}
/* Fall through, don't put break!!!*/
case HB_P_POPMEMVAR :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR )
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
if( ! pSym )
pSym = hb_compSymbolGetPos( wVar );
/*
if( pFunc->pMemvars )
printf( "\nSymbol: %s #%li Function: %s which HAS memvars\n", pSym->szName, wVar, pFunc->szName );
if( pFunc->pPrivates )
printf( "\nSymbol: %s #%li Function: %s which HAS privates\n", pSym->szName, wVar, pFunc->szName );
*/
if( pSym )
{
if( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR && pSym->szName )
{
if( pFunc->pMemvars )
wVar = hb_compVariableGetPos( pFunc->pMemvars, pSym->szName );
if( wVar )
pVar = hb_compVariableFind( pFunc->pMemvars, wVar );
if( ! pVar )
pVar = hb_compPrivateFind( pSym->szName );
if( ( ! pVar ) && hb_comp_functions.pFirst->pMemvars )
{
wVar = hb_compVariableGetPos( hb_comp_functions.pFirst->pMemvars, pSym->szName );
if( wVar )
pVar = hb_compVariableFind( hb_comp_functions.pFirst->pMemvars, wVar );
}
}
if( pVar )
{
pVar->iUsed |= VU_INITIALIZED;
/*printf( "\nSymbol: %s Variable: %s Type: %c #%i Function: %s\n", pSym->szName, pVar->szName, pVar->cType, wVar, pFunc->szName );*/
/* Allow any type into a Variant, and record the subtype */
if( pVar->cType == ' ' || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
{
if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
pVar->cType = ' ';
else if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pVar->cType = pFunc->pStack[ pFunc->iStackIndex ];
else
pVar->cType = pFunc->pStack[ pFunc->iStackIndex ] + VT_OFFSET_VARIANT;
/* Will need the Class Handle. */
cType = pVar->cType;
if( cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType -= VT_OFFSET_VARIANT;
if( toupper( cType ) == 'S' && pFunc->iStackClasses )
pVar->pClass = pFunc->pStackClasses[ pFunc->iStackClasses - 1 ];
else
pVar->pClass = NULL;
/*printf( "\nSymbol: %s Variable: %s Assigned Type: \'%c\' SubType: %c #%i Stack: %i\n", pSym->szName, pVar->szName, pVar->cType, pVar->cType - 100, wVar, pFunc->iStackIndex );*/
}
else
{
char szType[2];
if( pVar->cType == 'S' )
sprintf( ( char * ) szType, "%s", pVar->pClass->szName );
else if( pVar->cType == 's' )
sprintf( ( char * ) szType, "ARRAY OF %s", pVar->pClass->szName );
else if( islower( pVar->cType ) )
sprintf( ( char * ) szType, "ARRAY OF %c", toupper( pVar->cType ) );
else
sprintf( ( char * ) szType, "%c", pVar->cType );
/*printf( "Variable: %s Type: \'%c\' SubType: %c Comparing: %c Recorded: %s\n", pSym->szName, pVar->cType, pVar->cType - 100, pFunc->pStack[ pFunc->iStackIndex ], ( char * ) szType );*/
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pVar->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;
if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
; /* NIL allowed into all types */
else if( pVar->cType == 'a' && islower( pFunc->pStack[ pFunc->iStackIndex ] ) )
; /* Array Of ANYTYPE may accept any Array */
else if( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
else if( pVar->cType != ' ' && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'O' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 'o' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'S' )
{
if( pFunc->iStackClasses && pVar->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
else if( pVar->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 's' )
{
if( pFunc->iStackClasses && pVar->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
else if( isupper( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
}
else
{
/* Allow any type into a Variant, and record the subtype */
if( pSym->cType == ' ' || pSym->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
{
if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
pSym->cType = ' ';
else if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pSym->cType = pFunc->pStack[ pFunc->iStackIndex ];
else
pSym->cType = pFunc->pStack[ pFunc->iStackIndex ] + VT_OFFSET_VARIANT;
/* Will need the Class Handle. */
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
pSym->pClass = pFunc->pStackClasses[ pFunc->iStackClasses - 1 ];
}
else
{
char szType[2];
if( pSym->cType == 'S' )
sprintf( ( char * ) szType, "%s", pSym->pClass->szName );
else if( pSym->cType == 's' )
sprintf( ( char * ) szType, "ARRAY OF %s", pSym->pClass->szName );
else if( islower( pSym->cType ) )
sprintf( ( char * ) szType, "ARRAY OF %c", toupper( pSym->cType ) );
else
sprintf( ( char * ) szType, "%c", pSym->cType );
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;
if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
; /* NIL allowed into all types */
else if( pSym->cType == 'a' && islower( pFunc->pStack[ pFunc->iStackIndex ] ) )
; /* Array Of ANYTYPE may accept any Array */
else if( islower( pSym->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pSym->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pSym->cType ) && pSym->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
else if( pSym->cType != ' ' && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pSym->szName, ( char * ) szType );
else if( pSym->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'O' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pSym->szName, ( char * ) szType );
else if( pSym->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 'o' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, pSym->szName, ( char * ) szType );
else if( pSym->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'S' )
{
if( pFunc->iStackClasses && pSym->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pSym->szName, ( char * ) szType );
}
else if( pSym->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 's' )
{
if( pFunc->iStackClasses && pSym->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, pSym->szName, ( char * ) szType );
}
else if( isupper( pSym->cType ) && pSym->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pSym->szName, ( char * ) szType );
}
}
}
/* Resetting */
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses;
break;
case HB_P_POPLOCALNEAR :
case HB_P_POPLOCAL :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if( pFunc->pCode[ ulPos ] == HB_P_POPLOCAL )
wVar = * ( ( SHORT * ) &( pFunc->pCode )[ ulPos + 1 ] );
else
wVar = ( SHORT ) pFunc->pCode[ ulPos + 1 ];
/* we are accesing variables within a codeblock */
if( wVar < 0 )
{
/* Finding the Function owning the block. */
pTmp = pFunc->pOwner;
/* Might be a nested block. */
while ( pTmp->pOwner )
pTmp = pTmp->pOwner;
pVar = hb_compVariableFind( pTmp->pLocals, -wVar );
}
else
pVar = hb_compVariableFind( pFunc->pLocals, wVar );
if( pVar )
{
pVar->iUsed |= VU_INITIALIZED;
/* Allow any type into a Variant, and record the subtype */
if( pVar->cType == ' ' || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
{
if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
pVar->cType = ' ';
else if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pVar->cType = pFunc->pStack[ pFunc->iStackIndex ];
else
pVar->cType = pFunc->pStack[ pFunc->iStackIndex ] + VT_OFFSET_VARIANT;
cType = pVar->cType;
if( cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType -= VT_OFFSET_VARIANT;
if( toupper( cType ) == 'S' && pFunc->iStackClasses )
pVar->pClass = pFunc->pStackClasses[ pFunc->iStackClasses - 1 ];
else
pVar->pClass = NULL;
}
else
{
char szType[2];
if( pVar->cType == 'S' )
sprintf( ( char * ) szType, "%s", pVar->pClass->szName );
else if( pVar->cType == 's' )
sprintf( ( char * ) szType, "ARRAY OF %s", pVar->pClass->szName );
else if( islower( pVar->cType ) )
sprintf( ( char * ) szType, "ARRAY OF %c", toupper( pVar->cType ) );
else
sprintf( ( char * ) szType, "%c", pVar->cType );
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pVar->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;
if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
; /* NIL allowed into all types */
else if( pVar->cType == 'a' && islower( pFunc->pStack[ pFunc->iStackIndex ] ) )
; /* Array Of ANYTYPE may accept any Array */
else if( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
else if( pVar->cType != ' ' && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'O' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 'o' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'S' )
{
if( pFunc->iStackClasses && pVar->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
else if( pVar->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 's' )
{
if( pFunc->iStackClasses && pVar->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
else if( isupper( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
}
/* Resetting */
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses;
break;
case HB_P_POPSTATIC :
pFunc->iStackIndex--;
if( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
pTmp = hb_comp_functions.pFirst;
wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256;
while( pTmp->pNext && pTmp->pNext->iStaticsBase < wVar )
pTmp = pTmp->pNext;
pVar = hb_compVariableFind( pTmp->pStatics, wVar - pTmp->iStaticsBase );
if( pVar )
{
pVar->iUsed |= VU_INITIALIZED;
/* Allow any type into a Variant, and record the subtype */
if( pVar->cType == ' ' || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) )
{
if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
pVar->cType = ' ';
else if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pVar->cType = pFunc->pStack[ pFunc->iStackIndex ];
else
pVar->cType = pFunc->pStack[ pFunc->iStackIndex ] + VT_OFFSET_VARIANT;
cType = pVar->cType;
if( cType >= ( 'A' + VT_OFFSET_VARIANT ) )
cType -= VT_OFFSET_VARIANT;
if( toupper( cType ) == 'S' && pFunc->iStackClasses )
pVar->pClass = pFunc->pStackClasses[ pFunc->iStackClasses - 1 ];
else
pVar->pClass = NULL;
/*printf( "\nStack: %c Asc: %i, Var: %c Asc: %i\n", pFunc->pStack[ pFunc->iStackIndex ], pFunc->pStack[ pFunc->iStackIndex ], pVar->cType, pVar->cType );*/
}
else
{
char szType[2];
if( pVar->cType == 'S' )
sprintf( ( char * ) szType, "%s", pVar->pClass->szName );
else if( pVar->cType == 's' )
sprintf( ( char * ) szType, "ARRAY OF %s", pVar->pClass->szName );
else if( islower( pVar->cType ) )
sprintf( ( char * ) szType, "ARRAY OF %c", toupper( pVar->cType ) );
else
sprintf( ( char * ) szType, "%c", pVar->cType );
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pVar->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;
if( pFunc->pStack[ pFunc->iStackIndex ] == '-' )
; /* NIL allowed into all types */
else if( pVar->cType == 'a' && islower( pFunc->pStack[ pFunc->iStackIndex ] ) )
; /* Array Of ANYTYPE may accept any Array */
else if( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL );
else if( islower( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
else if( pVar->cType != ' ' && pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'O' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 'o' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if( pVar->cType == 'S' && pFunc->pStack[ pFunc->iStackIndex ] == 'S' )
{
if( pFunc->iStackClasses && pVar->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
else if( pVar->cType == 's' && pFunc->pStack[ pFunc->iStackIndex ] == 's' )
{
if( pFunc->iStackClasses && pVar->pClass == pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] )
; /* Same class */
else
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
else if( isupper( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, ( char * ) szType );
}
}
/* Resetting */
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
--pFunc->iStackClasses;
break;
/* Macros Undefined Types */
case HB_P_MPOPALIASEDFIELD :
case HB_P_MPOPALIASEDVAR :
case HB_P_MPOPFIELD :
case HB_P_MPOPMEMVAR :
case HB_P_MACROPOP :
case HB_P_MACROPOPALIASED :
pFunc->iStackIndex--;
break;
}
/* TODO Error or trace messages when completed. */
if( pFunc->iStackIndex < 0 )
pFunc->iStackIndex = 0;
}
void hb_compGenPCode1( BYTE byte )
{
PFUNCTION pFunc = hb_comp_functions.pLast; /* get the currently defined Clipper function */
if( ! pFunc->pCode ) /* has been created the memory block to hold the pcode ? */
{
pFunc->pCode = ( BYTE * ) hb_xgrab( HB_PCODE_CHUNK );
pFunc->lPCodeSize = HB_PCODE_CHUNK;
pFunc->lPCodePos = 0;
}
else if( ( pFunc->lPCodeSize - pFunc->lPCodePos ) < 1 )
pFunc->pCode = ( BYTE * ) hb_xrealloc( pFunc->pCode, pFunc->lPCodeSize += HB_PCODE_CHUNK );
pFunc->pCode[ pFunc->lPCodePos++ ] = byte;
if( hb_comp_iWarnings >= 3 )
hb_compStrongType( 1 );
}
void hb_compGenPCode2( BYTE byte1, BYTE byte2, BOOL bStackAffected )
{
PFUNCTION pFunc = hb_comp_functions.pLast; /* get the currently defined Clipper function */
if( ! pFunc->pCode ) /* has been created the memory block to hold the pcode ? */
{
pFunc->pCode = ( BYTE * ) hb_xgrab( HB_PCODE_CHUNK );
pFunc->lPCodeSize = HB_PCODE_CHUNK;
pFunc->lPCodePos = 0;
}
else if( ( pFunc->lPCodeSize - pFunc->lPCodePos ) < 2 )
pFunc->pCode = ( BYTE * ) hb_xrealloc( pFunc->pCode, pFunc->lPCodeSize += HB_PCODE_CHUNK );
pFunc->pCode[ pFunc->lPCodePos++ ] = byte1;
pFunc->pCode[ pFunc->lPCodePos++ ] = byte2;
if( hb_comp_iWarnings >= 3 && bStackAffected )
hb_compStrongType( 2 );
}
void hb_compGenPCode3( BYTE byte1, BYTE byte2, BYTE byte3, BOOL bStackAffected )
{
PFUNCTION pFunc = hb_comp_functions.pLast; /* get the currently defined Clipper function */
if( ! pFunc->pCode ) /* has been created the memory block to hold the pcode ? */
{
pFunc->pCode = ( BYTE * ) hb_xgrab( HB_PCODE_CHUNK );
pFunc->lPCodeSize = HB_PCODE_CHUNK;
pFunc->lPCodePos = 0;
}
else if( ( pFunc->lPCodeSize - pFunc->lPCodePos ) < 3 )
pFunc->pCode = ( BYTE * ) hb_xrealloc( pFunc->pCode, pFunc->lPCodeSize += HB_PCODE_CHUNK );
pFunc->pCode[ pFunc->lPCodePos++ ] = byte1;
pFunc->pCode[ pFunc->lPCodePos++ ] = byte2;
pFunc->pCode[ pFunc->lPCodePos++ ] = byte3;
if( hb_comp_iWarnings >= 3 && bStackAffected )
hb_compStrongType( 3 );
}
void hb_compGenPCode4( BYTE byte1, BYTE byte2, BYTE byte3, BYTE byte4, BOOL bStackAffected )
{
PFUNCTION pFunc = hb_comp_functions.pLast; /* get the currently defined Clipper function */
if( ! pFunc->pCode ) /* has been created the memory block to hold the pcode ? */
{
pFunc->pCode = ( BYTE * ) hb_xgrab( HB_PCODE_CHUNK );
pFunc->lPCodeSize = HB_PCODE_CHUNK;
pFunc->lPCodePos = 0;
}
else if( ( pFunc->lPCodeSize - pFunc->lPCodePos ) < 4 )
pFunc->pCode = ( BYTE * ) hb_xrealloc( pFunc->pCode, pFunc->lPCodeSize += HB_PCODE_CHUNK );
pFunc->pCode[ pFunc->lPCodePos++ ] = byte1;
pFunc->pCode[ pFunc->lPCodePos++ ] = byte2;
pFunc->pCode[ pFunc->lPCodePos++ ] = byte3;
pFunc->pCode[ pFunc->lPCodePos++ ] = byte4;
if( hb_comp_iWarnings >= 3 && bStackAffected )
hb_compStrongType( 4 );
}
void hb_compGenPCodeN( BYTE * pBuffer, ULONG ulSize, BOOL bStackAffected )
{
PFUNCTION pFunc = hb_comp_functions.pLast; /* get the currently defined Clipper function */
if( ! pFunc->pCode ) /* has been created the memory block to hold the pcode ? */
{
pFunc->lPCodeSize = ( ( ulSize / HB_PCODE_CHUNK ) + 1 ) * HB_PCODE_CHUNK;
pFunc->pCode = ( BYTE * ) hb_xgrab( pFunc->lPCodeSize );
pFunc->lPCodePos = 0;
}
else if( pFunc->lPCodePos + ulSize > pFunc->lPCodeSize )
{
/* not enough free space in pcode buffer - increase it */
pFunc->lPCodeSize += ( ( ( ulSize / HB_PCODE_CHUNK ) + 1 ) * HB_PCODE_CHUNK );
pFunc->pCode = ( BYTE * ) hb_xrealloc( pFunc->pCode, pFunc->lPCodeSize );
}
memcpy( pFunc->pCode + pFunc->lPCodePos, pBuffer, ulSize );
pFunc->lPCodePos += ulSize;
if( hb_comp_iWarnings >= 3 && bStackAffected )
hb_compStrongType( ulSize );
}
Reference in New Issue View Git Blame Copy Permalink