fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
eb2d8afdb44badedcd50a6bbfe224669cae6f634
harbour-core/harbour/source/compiler/hbpcode.c
Ron Pinkas eb2d8afdb4 20000522-06:15 GMT-8 Ron Pinkas <Ron@Profit-Master.com> 
* source/compiler/harbour.l
     + Added "as structure", "as stru", "as array of structure", "as array of stru"

   * source/compiler/hbpcode.c
     * Improved some logic in hb_StrongType()

   * source/vm/hvm.c
     ! Corrected startup symbol when having to use Main() as per Ryszard.

   * source/pp/pptable.c
     + Added the equivalent of:
        #COMMANDS STRUCTURE <StruName> <Var1> AS <Type1> [, <VarN> AS <TypeN> ] => ;
                  STATIC __<StruName> := {|| IF( __<StruName> == NIL, , ) , HB_Structure( <"StruName">, { <"Var1"> [, <"VarN">] } )} ;;
                  DECLARE <StruName> <Var1> AS <Type1> [ <VarN> AS <TypeN> ] ;;
                  #TRANSLATE AS NEW <ClassName> => AS CLASS <StruName> := ( Eval( __<StruName> ), HB_Structure( <StruName> ) )

	#TRANSLATE AS NEW <ClassName> => AS CLASS <ClassName> := <ClassName>():New()

   * source/rtl/tclass.prg
     + Added Function HB_Structure() ( Fully Declared! ) This function is used internally, but may be freely called from Clipper level.
       It Aceepts Parameter 1 Structure Name, and optional parameter 2, as array of structure variable names.
       If called with 2nd parameter, returns NIL (just creates the new Structure), if called with just parameter 1, it returns
       new instance of defined structure.

   + tests\teststru.prg
     + Added demo for new structure syntax
2000-05-22 13:53:14 +00:00

2044 lines
81 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, */
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[32], szType2[32], 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 :
pFunc->iStackIndex--;
pSym = hb_compSymbolFind( pFunc->szName, NULL );
if ( pSym && pSym->szName )
{
pDeclared = hb_compDeclaredFind( pSym->szName );
/* The function was declared, but return value doesn't match the declaration */
if ( pDeclared && pDeclared->cType != ' ' && pDeclared->cType != pFunc->pStack[ pFunc->iStackIndex ] )
{
sprintf( ( char * ) szType1, "%c", pDeclared->cType );
/* Variant as SubType. */
if ( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
if ( cSubType1 == 'S' )
sprintf( ( char * ) szType2, "%s", pDeclared->pClass->szName );
else if ( cSubType1 == 's' )
sprintf( ( char * ) szType2, "ARRAY OF %s", pDeclared->pClass->szName );
else if ( cSubType1 && cSubType1 == '-' )
strcpy( ( char * ) szType2, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType2, "Variant.SubType\[%c]", pFunc->pStack[ pFunc->iStackIndex ] );
else
sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] );
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_RETURN_TYPE, ( char * ) szType2, ( char * ) szType1 );
}
}
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 );*/
/* 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 ( toupper( pFunc->pStack[ iParamBase + iOffset ] ) == 'S' )
pFunc->pStackClasses[ --pFunc->iStackClasses ] = NULL;
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
{
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;
sprintf( ( char * ) szType1, "%c", cSubType1 );
if ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'O' )
{
/* The Object is not declared. */
}
else if ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'S' )
{
pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 );
if ( pSym && pSym->szName && pFunc->iStackClasses > 0 && 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. */
pFunc->pStackFunctions[ pFunc->iStackFunctions++ ] = NULL;
}
}
else if ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == ' ' )
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;
/* Handles 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 ];
/*printf( "\nParams: %i Stack: %i\n", wVar, pFunc->iStackIndex );*/
if ( pFunc->iStackIndex < ( wVar + 1 ) )
break;
if ( pFunc->pStack[ pFunc->iStackIndex - ( wVar + 1 ) ] == 'S' )
{
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;
/*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 );*/
/* 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->pStackClasses[ --pFunc->iStackClasses ] = NULL;
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
{
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.*/
pFunc->iStackIndex -= wVar;
if ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '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 ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == 'S' && pFunc->iStackClasses < 8 )
{
/*printf( "\nNested CLASS!!! Stack: %i Type: %c Class Pointer: %i\n", pFunc->iStackIndex, pFunc->pStack[ pFunc->iStackIndex - 1 ], pFunc->pStackFunctions[ pFunc->iStackFunctions ]->pClass );*/
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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType2 )
sprintf( ( char * ) szType2, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType2 )
sprintf( ( char * ) szType2, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType2 )
sprintf( ( char * ) szType2, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType2 )
sprintf( ( char * ) szType2, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType1 )
sprintf( ( char * ) szType1, "Variant.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, "Variant.SubType\[NIL]" );
else if ( cSubType2 )
sprintf( ( char * ) szType2, "Variant.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;
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_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 == 'S' && pFunc->iStackClasses < 8 )
{
/* Object of declared class */
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass;
pFunc->pStack[ pFunc->iStackIndex++ ] = 'S';
}
else 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 ( toupper( pVar->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->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_PUSHMEMVARREF )
pFunc->pStack[ pFunc->iStackIndex++ ] = pSym->cType + VT_OFFSET_BYREF;
else
pFunc->pStack[ pFunc->iStackIndex++ ] = pSym->cType;
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 )
{
/*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 );
/* Mark as used */
pVar->iUsed |= VU_USED;
if ( pVar->cType == 'S' && pFunc->iStackClasses < 8 )
{
/* Object of declared class */
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass;
pFunc->pStack[ pFunc->iStackIndex++ ] = 'S';
}
else if ( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVARREF )
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_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 :
pFunc->iStackIndex--;
if ( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses > 0 )
{
/* Object of declared class */
pFunc->pStackClasses[ --pFunc->iStackClasses ] = NULL;
}
break;
case HB_P_POPALIASEDVAR :
/* TODO: check what is aliasedvar? */
pFunc->iStackIndex--;
if ( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses > 0 )
{
/* Object of declared class */
pFunc->pStackClasses[ --pFunc->iStackClasses ] = NULL;
}
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 ( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses > 0 )
{
/* Object of declared class */
pFunc->pStackClasses[ --pFunc->iStackClasses ] = NULL;
pFunc->pStack[ pFunc->iStackIndex ] = 'O';
}
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;
/*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 ( 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 ( islower( pFunc->pStack[ pFunc->iStackIndex ] ) && pVar->cType == 'a' )
; /* Array Of may accept any Array */
else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, 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 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 ( toupper( pVar->cType ) != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
}
}
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;
}
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 ( islower( pFunc->pStack[ pFunc->iStackIndex ] ) && pSym->cType == 'a' )
; /* Array Of may accept any Array */
else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, 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 );
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 ( toupper( pSym->cType ) != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
}
}
}
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;
}
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 ( 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 ( islower( pFunc->pStack[ pFunc->iStackIndex ] ) && pVar->cType == 'a' )
; /* Array Of may accept any Array */
else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, ( char * ) szType );
else if ( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ --pFunc->iStackClasses ] = NULL;
/* TODO **** */
}
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 if ( toupper( pVar->cType ) != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
}
}
break;
case HB_P_POPSTATIC :
pFunc->iStackIndex--;
if ( pFunc->iStackIndex < 0 )
/* TODO Error Message after finalizing all possible pcodes. */
break;
if ( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses > 0 )
{
/* Object of declared class */
pFunc->pStackClasses[ --pFunc->iStackClasses ] = NULL;
pFunc->pStack[ pFunc->iStackIndex ] = 'O';
}
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;
/*
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 ( 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 ( islower( pFunc->pStack[ pFunc->iStackIndex ] ) && pVar->cType == 'a' )
; /* Array Of may accept any Array */
else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, 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 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 ( toupper( pVar->cType ) != pFunc->pStack[ pFunc->iStackIndex ] )
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, ( char * ) szType, NULL );
}
}
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