diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 25dbe794e4..8d84a06709 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,49 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ * source/pp/ppcore.c + + * harbour/makefile.bc + * fixed calculation of length of stringify expressions + + +2006-03-28 13:46 UTC+0200 Jacek Kubica (kubica/at/wssk.wroc.pl) + * harbour/makefile.bc + * harbour/makefile.nt + * harbour/makefile.vc + * harbour/makefile64.nt + + added references for harbour/source/compiler/hbstrong.c + +2006-03-28 13:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbcomp.h + + added hb_compPCodeSize() and hb_compStrongType() declarations + + * harbour/include/hbpp.h + * formatting + + * harbour/source/compiler/Makefile + + harbour/source/compiler/hbstrong.c + * harbour/source/compiler/hbpcode.c + * moved strong typing code to separate file + + * harbour/source/compiler/hbpcode.c + + added hb_compPCodeSize() function + + added support for automatic size checking of variable size PCODEs + in hb_compPCodeEval() + + * harbour/source/compiler/gencc.c + * added escaping of '?' character in generated strings to + avoid possible conflicts with trigraph sequences which + are part of ANSI C standard + * force .0 at the end of double numbers to avoid possible range + conflicts in generated .c files + * removed unnecessary HB_SYMBOL_UNUSED() + + * harbour/source/compiler/harbour.l + * harbour/source/compiler/harbour.y + * harbour/source/macro/macro.l + * harbour/source/macro/macro.y + * added #define realloc hb_xrealloc + * harbour/source/compiler/hbdead.c * harbour/source/compiler/hbfix.c * harbour/source/compiler/hblbl.c diff --git a/harbour/include/hbcomp.h b/harbour/include/hbcomp.h index 619d1077bc..77275a29b6 100644 --- a/harbour/include/hbcomp.h +++ b/harbour/include/hbcomp.h @@ -271,6 +271,7 @@ typedef void * HB_VOID_PTR; typedef HB_PCODE_FUNC( HB_PCODE_FUNC_, HB_VOID_PTR ); typedef HB_PCODE_FUNC_ * HB_PCODE_FUNC_PTR; +extern LONG hb_compPCodeSize( PFUNCTION, ULONG ); extern void hb_compPCodeEval( PFUNCTION, HB_PCODE_FUNC_PTR *, void * ); extern void hb_compPCodeTrace( PFUNCTION, HB_PCODE_FUNC_PTR *, void * ); @@ -419,6 +420,11 @@ extern void hb_compGenPCode3( BYTE, BYTE, BYTE, BOOL ); /* generates 3 bytes of extern void hb_compGenPCode4( BYTE, BYTE, BYTE, BYTE, BOOL ); /* generates 4 bytes of pcode + flag for optional StrongType() */ extern void hb_compGenPCodeN( BYTE * pBuffer, ULONG ulSize, BOOL ); /* copy bytes to a pcode buffer + flag for optional StrongType() */ +#if defined(HB_COMP_STRONG_TYPES) +extern void hb_compStrongType( int iSize ); +#endif + + extern ULONG hb_compSequenceBegin( void ); extern ULONG hb_compSequenceEnd( void ); extern void hb_compSequenceFinish( ULONG, int ); @@ -553,9 +559,6 @@ extern PHB_FNAME hb_comp_pPpoPath; extern BOOL hb_comp_bCredits; extern BOOL hb_comp_bBuildInfo; -/* Andi Jahja */ -extern BOOL hb_comp_bFileVersionInfo; - extern BOOL hb_comp_bLogo; extern BOOL hb_comp_bSyntaxCheckOnly; extern int hb_comp_iLanguage; diff --git a/harbour/include/hbpp.h b/harbour/include/hbpp.h index 75d71bfa65..1f4a5133ec 100644 --- a/harbour/include/hbpp.h +++ b/harbour/include/hbpp.h @@ -85,7 +85,7 @@ typedef struct _COMMANDS #define HB_PP_STR_SIZE 12288 #define HB_PP_BUFF_SIZE 4096 -#define HB_SKIPTABSPACES( sptr ) while( *sptr == ' ' || *sptr == '\t' ) ( sptr )++ +#define HB_SKIPTABSPACES( sptr ) while( *( sptr ) == ' ' || *( sptr ) == '\t' ) ( sptr )++ /* PPCORE.C exported functions and variables */ diff --git a/harbour/source/compiler/Makefile b/harbour/source/compiler/Makefile index 420d8483c4..456cce1df5 100644 --- a/harbour/source/compiler/Makefile +++ b/harbour/source/compiler/Makefile @@ -52,6 +52,7 @@ C_SOURCES=\ hbdead.c \ hblbl.c \ hbstripl.c \ + hbstrong.c \ hbusage.c \ hbident.c \ expropta.c \ diff --git a/harbour/source/compiler/gencc.c b/harbour/source/compiler/gencc.c index 52b61314f6..b443b252ae 100644 --- a/harbour/source/compiler/gencc.c +++ b/harbour/source/compiler/gencc.c @@ -62,8 +62,11 @@ static void hb_gencc_string_put( FILE * yyc, BYTE * pText, USHORT usLen ) * into a string containing nonprintable characters. * * TODO: add switch to use hexadecimal format "%#04x" + * + * ? is escaped to avoid conflicts with trigraph sequences which + * are part of ANSI C standard */ - if( uchr == '"' || uchr == '\\' ) + if( uchr == '"' || uchr == '\\' || uchr == '?' ) fprintf( yyc, "\\%c", uchr ); else if( uchr < ( BYTE ) ' ' || uchr >= 127 ) fprintf( yyc, "\\%03o", uchr ); @@ -96,8 +99,6 @@ static int hb_gencc_checkNumAhead( LONG lValue, PFUNCTION pFunc, ULONG lPCodePos static HB_GENC_FUNC( hb_p_and ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmAnd() ) break;\n" ); @@ -106,8 +107,6 @@ static HB_GENC_FUNC( hb_p_and ) static HB_GENC_FUNC( hb_p_arraypush ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmArrayPush() ) break;\n" ); @@ -116,8 +115,6 @@ static HB_GENC_FUNC( hb_p_arraypush ) static HB_GENC_FUNC( hb_p_arraypop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmArrayPop() ) break;\n" ); @@ -126,8 +123,6 @@ static HB_GENC_FUNC( hb_p_arraypop ) static HB_GENC_FUNC( hb_p_dec ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmDec() ) break;\n" ); @@ -145,8 +140,6 @@ static HB_GENC_FUNC( hb_p_arraydim ) static HB_GENC_FUNC( hb_p_divide ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmDivide() ) break;\n" ); @@ -155,8 +148,6 @@ static HB_GENC_FUNC( hb_p_divide ) static HB_GENC_FUNC( hb_p_do ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmDo( %hu ) ) break;\n", @@ -175,8 +166,6 @@ static HB_GENC_FUNC( hb_p_doshort ) static HB_GENC_FUNC( hb_p_duplicate ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmDuplicate();\n" ); @@ -185,8 +174,6 @@ static HB_GENC_FUNC( hb_p_duplicate ) static HB_GENC_FUNC( hb_p_dupltwo ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmDuplTwo();\n" ); @@ -195,8 +182,6 @@ static HB_GENC_FUNC( hb_p_dupltwo ) static HB_GENC_FUNC( hb_p_equal ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmEqual( FALSE ) ) break;\n" ); @@ -205,8 +190,6 @@ static HB_GENC_FUNC( hb_p_equal ) static HB_GENC_FUNC( hb_p_exactlyequal ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmEqual( TRUE ) ) break;\n" ); @@ -215,8 +198,6 @@ static HB_GENC_FUNC( hb_p_exactlyequal ) static HB_GENC_FUNC( hb_p_endblock ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); HB_GENC_ERROR( "HB_P_ENDBLOCK" ); @@ -240,8 +221,6 @@ static HB_GENC_FUNC( hb_p_endproc ) static HB_GENC_FUNC( hb_p_false ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmPushLogical( FALSE );\n" ); @@ -250,8 +229,6 @@ static HB_GENC_FUNC( hb_p_false ) static HB_GENC_FUNC( hb_p_fortest ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmForTest() ) break;\n" ); @@ -269,8 +246,6 @@ static HB_GENC_FUNC( hb_p_frame ) static HB_GENC_FUNC( hb_p_funcptr ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmFuncPtr();\n" ); @@ -306,8 +281,6 @@ static HB_GENC_FUNC( hb_p_arraygen ) static HB_GENC_FUNC( hb_p_greater ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmGreater() ) break;\n" ); @@ -316,8 +289,6 @@ static HB_GENC_FUNC( hb_p_greater ) static HB_GENC_FUNC( hb_p_greaterequal ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmGreaterEqual() ) break;\n" ); @@ -326,8 +297,6 @@ static HB_GENC_FUNC( hb_p_greaterequal ) static HB_GENC_FUNC( hb_p_inc ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmInc() ) break;\n" ); @@ -336,8 +305,6 @@ static HB_GENC_FUNC( hb_p_inc ) static HB_GENC_FUNC( hb_p_instring ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmInstring() ) break;\n" ); @@ -445,8 +412,6 @@ static HB_GENC_FUNC( hb_p_jumptruefar ) static HB_GENC_FUNC( hb_p_less ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmLess() ) break;\n" ); @@ -455,8 +420,6 @@ static HB_GENC_FUNC( hb_p_less ) static HB_GENC_FUNC( hb_p_lessequal ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmLessEqual() ) break;\n" ); @@ -514,8 +477,6 @@ static HB_GENC_FUNC( hb_p_macropush ) static HB_GENC_FUNC( hb_p_macropushref ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMacroPushRef() ) break;\n" ); @@ -555,8 +516,6 @@ static HB_GENC_FUNC( hb_p_macropushlist ) static HB_GENC_FUNC( hb_p_macropushindex ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMacroPushIndex( %d ) ) break;\n", @@ -566,8 +525,6 @@ static HB_GENC_FUNC( hb_p_macropushindex ) static HB_GENC_FUNC( hb_p_macropushpare ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMacroPushPare( %d ) ) break;\n", @@ -577,8 +534,6 @@ static HB_GENC_FUNC( hb_p_macropushpare ) static HB_GENC_FUNC( hb_p_macropushaliased ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMacroPushAliased( %d ) ) break;\n", @@ -588,8 +543,6 @@ static HB_GENC_FUNC( hb_p_macropushaliased ) static HB_GENC_FUNC( hb_p_macrosymbol ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMacroSymbol() ) break;\n" ); @@ -598,8 +551,6 @@ static HB_GENC_FUNC( hb_p_macrosymbol ) static HB_GENC_FUNC( hb_p_macrotext ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMacroText() ) break;\n" ); @@ -617,8 +568,6 @@ static HB_GENC_FUNC( hb_p_message ) static HB_GENC_FUNC( hb_p_minus ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMinus() ) break;\n" ); @@ -640,8 +589,6 @@ static HB_GENC_FUNC( hb_p_modulename ) static HB_GENC_FUNC( hb_p_modulus ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmModulus() ) break;\n" ); @@ -650,8 +597,6 @@ static HB_GENC_FUNC( hb_p_modulus ) static HB_GENC_FUNC( hb_p_mult ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMult() ) break;\n" ); @@ -660,8 +605,6 @@ static HB_GENC_FUNC( hb_p_mult ) static HB_GENC_FUNC( hb_p_negate ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmNegate() ) break;\n" ); @@ -670,8 +613,6 @@ static HB_GENC_FUNC( hb_p_negate ) static HB_GENC_FUNC( hb_p_not ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmNot() ) break;\n" ); @@ -680,8 +621,6 @@ static HB_GENC_FUNC( hb_p_not ) static HB_GENC_FUNC( hb_p_notequal ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmNotEqual() ) break;\n" ); @@ -690,8 +629,6 @@ static HB_GENC_FUNC( hb_p_notequal ) static HB_GENC_FUNC( hb_p_or ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmOr() ) break;\n" ); @@ -710,8 +647,6 @@ static HB_GENC_FUNC( hb_p_parameter ) static HB_GENC_FUNC( hb_p_plus ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmPlus() ) break;\n" ); @@ -720,8 +655,6 @@ static HB_GENC_FUNC( hb_p_plus ) static HB_GENC_FUNC( hb_p_pop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_stackPop();\n" ); @@ -730,8 +663,6 @@ static HB_GENC_FUNC( hb_p_pop ) static HB_GENC_FUNC( hb_p_popalias ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmPopAlias() ) break;\n" ); @@ -821,8 +752,6 @@ static HB_GENC_FUNC( hb_p_popvariable ) static HB_GENC_FUNC( hb_p_power ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmPower() ) break;\n" ); @@ -831,8 +760,6 @@ static HB_GENC_FUNC( hb_p_power ) static HB_GENC_FUNC( hb_p_pushalias ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmPushAlias() ) break;\n" ); @@ -919,7 +846,7 @@ static HB_GENC_FUNC( hb_p_pushdouble ) HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmPushDouble( %.*f, %d, %d );\n", - pFunc->pCode[ lPCodePos + 1 + sizeof( double ) + sizeof( BYTE ) ], + pFunc->pCode[ lPCodePos + 1 + sizeof( double ) + sizeof( BYTE ) ] + 1, HB_PCODE_MKDOUBLE( &pFunc->pCode[ lPCodePos + 1 ] ), pFunc->pCode[ lPCodePos + 1 + sizeof( double ) ], pFunc->pCode[ lPCodePos + 1 + sizeof( double ) + sizeof( BYTE ) ] ); @@ -1035,8 +962,6 @@ static HB_GENC_FUNC( hb_p_pushmemvarref ) static HB_GENC_FUNC( hb_p_pushnil ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmPushNil();\n" ); @@ -1045,8 +970,6 @@ static HB_GENC_FUNC( hb_p_pushnil ) static HB_GENC_FUNC( hb_p_pushself ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmPushSelf();\n" ); @@ -1126,8 +1049,6 @@ static HB_GENC_FUNC( hb_p_pushvariable ) static HB_GENC_FUNC( hb_p_retvalue ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmRetValue();\n" ); @@ -1154,8 +1075,6 @@ static HB_GENC_FUNC( hb_p_sendshort ) static HB_GENC_FUNC( hb_p_seqbegin ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmSeqBegin();\n\tdo {\n" ); @@ -1180,8 +1099,6 @@ static HB_GENC_FUNC( hb_p_seqend ) static HB_GENC_FUNC( hb_p_seqrecover ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmSeqRecover( %s );\n", @@ -1225,8 +1142,6 @@ static HB_GENC_FUNC( hb_p_staticname ) static HB_GENC_FUNC( hb_p_swapalias ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmSwapAlias() ) break;\n" ); @@ -1235,8 +1150,6 @@ static HB_GENC_FUNC( hb_p_swapalias ) static HB_GENC_FUNC( hb_p_true ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmPushLogical( TRUE );\n" ); @@ -1257,18 +1170,18 @@ static HB_GENC_FUNC( hb_p_one ) static HB_GENC_FUNC( hb_p_zero ) { - HB_SYMBOL_UNUSED( pFunc ); + int iSkip; HB_GENC_LABEL(); - fprintf( cargo->yyc, "\thb_xvmPushInteger( 0 );\n" ); - return 1; + iSkip = hb_gencc_checkNumAhead( 0, pFunc, lPCodePos + 1, cargo ); + if( iSkip == 0 ) + fprintf( cargo->yyc, "\thb_xvmPushInteger( 0 );\n" ); + return 1 + iSkip; } static HB_GENC_FUNC( hb_p_noop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); return 1; @@ -1284,8 +1197,6 @@ static HB_GENC_FUNC( hb_p_dummy ) static HB_GENC_FUNC( hb_p_macrolist ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmMacroList();\n" ); @@ -1294,8 +1205,6 @@ static HB_GENC_FUNC( hb_p_macrolist ) static HB_GENC_FUNC( hb_p_macrolistend ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmMacroListEnd();\n" ); @@ -1313,8 +1222,6 @@ static HB_GENC_FUNC( hb_p_enumstart ) static HB_GENC_FUNC( hb_p_enumnext ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmEnumNext() ) break;\n" ); @@ -1323,8 +1230,6 @@ static HB_GENC_FUNC( hb_p_enumnext ) static HB_GENC_FUNC( hb_p_enumprev ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmEnumPrev() ) break;\n" ); @@ -1333,8 +1238,6 @@ static HB_GENC_FUNC( hb_p_enumprev ) static HB_GENC_FUNC( hb_p_enumend ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmEnumEnd( &lForEachBase );\n" ); @@ -1422,8 +1325,6 @@ static HB_GENC_FUNC( hb_p_localnearaddint ) static HB_GENC_FUNC( hb_p_pluseqpop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmPlusEqPop() ) break;\n" ); @@ -1432,8 +1333,6 @@ static HB_GENC_FUNC( hb_p_pluseqpop ) static HB_GENC_FUNC( hb_p_minuseqpop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMinusEqPop() ) break;\n" ); @@ -1442,8 +1341,6 @@ static HB_GENC_FUNC( hb_p_minuseqpop ) static HB_GENC_FUNC( hb_p_multeqpop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMultEqPop() ) break;\n" ); @@ -1452,8 +1349,6 @@ static HB_GENC_FUNC( hb_p_multeqpop ) static HB_GENC_FUNC( hb_p_diveqpop ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmDivEqPop() ) break;\n" ); @@ -1462,8 +1357,6 @@ static HB_GENC_FUNC( hb_p_diveqpop ) static HB_GENC_FUNC( hb_p_pluseq ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmPlusEq() ) break;\n" ); @@ -1472,8 +1365,6 @@ static HB_GENC_FUNC( hb_p_pluseq ) static HB_GENC_FUNC( hb_p_minuseq ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMinusEq() ) break;\n" ); @@ -1482,8 +1373,6 @@ static HB_GENC_FUNC( hb_p_minuseq ) static HB_GENC_FUNC( hb_p_multeq ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmMultEq() ) break;\n" ); @@ -1492,8 +1381,6 @@ static HB_GENC_FUNC( hb_p_multeq ) static HB_GENC_FUNC( hb_p_diveq ) { - HB_SYMBOL_UNUSED( pFunc ); - HB_GENC_LABEL(); fprintf( cargo->yyc, "\tif( hb_xvmDivEq() ) break;\n" ); diff --git a/harbour/source/compiler/harbour.l b/harbour/source/compiler/harbour.l index df7dab1a5b..f529b612ff 100644 --- a/harbour/source/compiler/harbour.l +++ b/harbour/source/compiler/harbour.l @@ -47,8 +47,10 @@ #define alloca hb_xgrab #undef malloc #define malloc hb_xgrab +#undef realloc +#define realloc hb_xrealloc #undef free -#define free hb_xfree +#define free hb_xfree /* helper functions */ static int yy_ConvertNumber( char * szBuffer ); diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index 6d9339edd2..ca9b6d43d3 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -38,8 +38,10 @@ #define alloca hb_xgrab #undef malloc #define malloc hb_xgrab +#undef realloc +#define realloc hb_xrealloc #undef free -#define free hb_xfree +#define free hb_xfree /* Compile using: bison -d -v harbour.y */ diff --git a/harbour/source/compiler/hbdead.c b/harbour/source/compiler/hbdead.c index 778986bb13..6176bacde5 100644 --- a/harbour/source/compiler/hbdead.c +++ b/harbour/source/compiler/hbdead.c @@ -122,78 +122,12 @@ static void hb_compCodeTraceMark( PHB_CODETRACE_INFO pInfo, ULONG ulPCodePos, UL static HB_CODETRACE_FUNC( hb_p_default ) { - ULONG ulSize = hb_comp_pcode_len[ pFunc->pCode[ lPCodePos ] ]; + ULONG ulSize = hb_compPCodeSize( pFunc, lPCodePos ); hb_compCodeTraceMark( cargo, lPCodePos, ulSize ); return hb_compCodeTraceNextPos( cargo, lPCodePos + ulSize ); } -static HB_CODETRACE_FUNC( hb_p_pushstr ) -{ - BYTE * pAddr = &pFunc->pCode[ lPCodePos + 1 ]; - ULONG ulSize = 3 + HB_PCODE_MKUSHORT( pAddr ); - - hb_compCodeTraceMark( cargo, lPCodePos, ulSize ); - return hb_compCodeTraceNextPos( cargo, lPCodePos + ulSize ); -} - -static HB_CODETRACE_FUNC( hb_p_pushstrshort ) -{ - ULONG ulSize = 2 + pFunc->pCode[ lPCodePos + 1 ]; - - hb_compCodeTraceMark( cargo, lPCodePos, ulSize ); - return hb_compCodeTraceNextPos( cargo, lPCodePos + ulSize ); -} - -static HB_CODETRACE_FUNC( hb_p_pushblock ) -{ - BYTE * pAddr = &pFunc->pCode[ lPCodePos + 1 ]; - ULONG ulSize = HB_PCODE_MKUSHORT( pAddr ); - - hb_compCodeTraceMark( cargo, lPCodePos, ulSize ); - return hb_compCodeTraceNextPos( cargo, lPCodePos + ulSize ); -} - -static HB_CODETRACE_FUNC( hb_p_pushblockshort ) -{ - ULONG ulSize = pFunc->pCode[ lPCodePos + 1 ]; - - hb_compCodeTraceMark( cargo, lPCodePos, ulSize ); - return hb_compCodeTraceNextPos( cargo, lPCodePos + ulSize ); -} - -static HB_CODETRACE_FUNC( hb_p_localname ) -{ - ULONG ulStart = lPCodePos; - - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos++ ] ); - - hb_compCodeTraceMark( cargo, ulStart, lPCodePos - ulStart ); - return hb_compCodeTraceNextPos( cargo, lPCodePos ); -} - -static HB_CODETRACE_FUNC( hb_p_modulename ) -{ - ULONG ulStart = lPCodePos; - - while( pFunc->pCode[ lPCodePos++ ] ); - - hb_compCodeTraceMark( cargo, ulStart, lPCodePos - ulStart ); - return hb_compCodeTraceNextPos( cargo, lPCodePos ); -} - -static HB_CODETRACE_FUNC( hb_p_staticname ) -{ - ULONG ulStart = lPCodePos; - - lPCodePos += 4; - while( pFunc->pCode[ lPCodePos++ ] ); - - hb_compCodeTraceMark( cargo, ulStart, lPCodePos - ulStart ); - return hb_compCodeTraceNextPos( cargo, lPCodePos ); -} - static HB_CODETRACE_FUNC( hb_p_jumpnear ) { ULONG ulNewPos = lPCodePos + ( signed char ) pFunc->pCode[ lPCodePos + 1 ]; @@ -410,7 +344,7 @@ static PHB_CODETRACE_FUNC s_codeTraceFuncTable[ HB_P_LAST_PCODE ] = hb_p_default, /* HB_P_LESSEQUAL, */ hb_p_default, /* HB_P_LESS, */ hb_p_default, /* HB_P_LINE, */ - hb_p_localname, /* HB_P_LOCALNAME, */ + hb_p_default, /* HB_P_LOCALNAME, */ hb_p_default, /* HB_P_MACROPOP, */ hb_p_default, /* HB_P_MACROPOPALIASED, */ hb_p_default, /* HB_P_MACROPUSH, */ @@ -424,7 +358,7 @@ static PHB_CODETRACE_FUNC s_codeTraceFuncTable[ HB_P_LAST_PCODE ] = hb_p_default, /* HB_P_MESSAGE, */ hb_p_default, /* HB_P_MINUS, */ hb_p_default, /* HB_P_MODULUS, */ - hb_p_modulename, /* HB_P_MODULENAME, */ + hb_p_default, /* HB_P_MODULENAME, */ /* start: pcodes generated by macro compiler */ hb_p_default, /* HB_P_MMESSAGE, */ hb_p_default, /* HB_P_MPOPALIASEDFIELD, */ @@ -464,8 +398,8 @@ static PHB_CODETRACE_FUNC s_codeTraceFuncTable[ HB_P_LAST_PCODE ] = hb_p_default, /* HB_P_PUSHALIASEDFIELD, */ hb_p_default, /* HB_P_PUSHALIASEDFIELDNEAR, */ hb_p_default, /* HB_P_PUSHALIASEDVAR, */ - hb_p_pushblock, /* HB_P_PUSHBLOCK, */ - hb_p_pushblockshort, /* HB_P_PUSHBLOCKSHORT, */ + hb_p_default, /* HB_P_PUSHBLOCK, */ + hb_p_default, /* HB_P_PUSHBLOCKSHORT, */ hb_p_default, /* HB_P_PUSHFIELD, */ hb_p_default, /* HB_P_PUSHBYTE, */ hb_p_default, /* HB_P_PUSHINT, */ @@ -480,8 +414,8 @@ static PHB_CODETRACE_FUNC s_codeTraceFuncTable[ HB_P_LAST_PCODE ] = hb_p_default, /* HB_P_PUSHSELF, */ hb_p_default, /* HB_P_PUSHSTATIC, */ hb_p_default, /* HB_P_PUSHSTATICREF, */ - hb_p_pushstr, /* HB_P_PUSHSTR, */ - hb_p_pushstrshort, /* HB_P_PUSHSTRSHORT, */ + hb_p_default, /* HB_P_PUSHSTR, */ + hb_p_default, /* HB_P_PUSHSTRSHORT, */ hb_p_default, /* HB_P_PUSHSYM, */ hb_p_default, /* HB_P_PUSHSYMNEAR, */ hb_p_default, /* HB_P_PUSHVARIABLE, */ @@ -493,7 +427,7 @@ static PHB_CODETRACE_FUNC s_codeTraceFuncTable[ HB_P_LAST_PCODE ] = hb_p_default, /* HB_P_SEQRECOVER, */ hb_p_default, /* HB_P_SFRAME, */ hb_p_default, /* HB_P_STATICS, */ - hb_p_staticname, /* HB_P_STATICNAME, */ + hb_p_default, /* HB_P_STATICNAME, */ hb_p_default, /* HB_P_SWAPALIAS, */ hb_p_default, /* HB_P_TRUE, */ hb_p_default, /* HB_P_ZERO, */ diff --git a/harbour/source/compiler/hbfix.c b/harbour/source/compiler/hbfix.c index 1a197f8e55..d9aad1eb9b 100644 --- a/harbour/source/compiler/hbfix.c +++ b/harbour/source/compiler/hbfix.c @@ -65,18 +65,6 @@ typedef HB_FIX_FUNC( HB_FIX_FUNC_ ); typedef HB_FIX_FUNC_ * HB_FIX_FUNC_PTR; -static HB_FIX_FUNC( hb_p_pushstr ) -{ - HB_SYMBOL_UNUSED( cargo ); - return 3 + HB_PCODE_MKUSHORT( &( pFunc->pCode[ lPCodePos + 1 ] ) ); -} - -static HB_FIX_FUNC( hb_p_pushstrshort ) -{ - HB_SYMBOL_UNUSED( cargo ); - return 2 + pFunc->pCode[ lPCodePos + 1 ]; -} - static HB_FIX_FUNC( hb_p_endblock ) { HB_SYMBOL_UNUSED( pFunc ); @@ -128,30 +116,6 @@ static HB_FIX_FUNC( hb_p_pushblockshort ) return 2; } -static HB_FIX_FUNC( hb_p_localname ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos ] ) - ++lPCodePos; - - return (lPCodePos - ulStart + 1); -} - -static HB_FIX_FUNC( hb_p_modulename ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos ] ) - ++lPCodePos; - - return (lPCodePos - ulStart + 1); -} - static HB_FIX_FUNC( hb_p_poplocal ) { /* only local variables used outside of a codeblock need fixing @@ -271,18 +235,6 @@ static HB_FIX_FUNC( hb_p_pushlocalnear ) return 2; } -static HB_FIX_FUNC( hb_p_staticname ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 4; - while( pFunc->pCode[ lPCodePos ] ) - ++lPCodePos; - - return (lPCodePos - ulStart + 1) ; -} - static HB_FIX_FUNC( hb_p_localnearaddint ) { /* only local variables used outside of a codeblock need fixing @@ -509,7 +461,7 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] = NULL, /* HB_P_LESSEQUAL, */ NULL, /* HB_P_LESS, */ NULL, /* HB_P_LINE, */ - hb_p_localname, /* HB_P_LOCALNAME, */ + NULL, /* HB_P_LOCALNAME, */ NULL, /* HB_P_MACROPOP, */ NULL, /* HB_P_MACROPOPALIASED, */ NULL, /* HB_P_MACROPUSH, */ @@ -523,7 +475,7 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] = NULL, /* HB_P_MESSAGE, */ NULL, /* HB_P_MINUS, */ NULL, /* HB_P_MODULUS, */ - hb_p_modulename, /* HB_P_MODULENAME, */ + NULL, /* HB_P_MODULENAME, */ /* start: pcodes generated by macro compiler */ NULL, /* HB_P_MMESSAGE, */ NULL, /* HB_P_MPOPALIASEDFIELD, */ @@ -579,8 +531,8 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] = NULL, /* HB_P_PUSHSELF, */ NULL, /* HB_P_PUSHSTATIC, */ NULL, /* HB_P_PUSHSTATICREF, */ - hb_p_pushstr, /* HB_P_PUSHSTR, */ - hb_p_pushstrshort, /* HB_P_PUSHSTRSHORT, */ + NULL, /* HB_P_PUSHSTR, */ + NULL, /* HB_P_PUSHSTRSHORT, */ NULL, /* HB_P_PUSHSYM, */ NULL, /* HB_P_PUSHSYMNEAR, */ NULL, /* HB_P_PUSHVARIABLE, */ @@ -592,7 +544,7 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] = NULL, /* HB_P_SEQRECOVER, */ NULL, /* HB_P_SFRAME, */ NULL, /* HB_P_STATICS, */ - hb_p_staticname, /* HB_P_STATICNAME, */ + NULL, /* HB_P_STATICNAME, */ NULL, /* HB_P_SWAPALIAS, */ hb_p_true, /* HB_P_TRUE, */ NULL, /* HB_P_ZERO, */ diff --git a/harbour/source/compiler/hblbl.c b/harbour/source/compiler/hblbl.c index d2fc6d4e6a..4206ee6d4f 100644 --- a/harbour/source/compiler/hblbl.c +++ b/harbour/source/compiler/hblbl.c @@ -58,66 +58,6 @@ typedef HB_LABEL_FUNC( HB_LABEL_FUNC_ ); typedef HB_LABEL_FUNC_ * PHB_LABEL_FUNC; -/* - * function for variable size PCODE tracing - */ -static HB_LABEL_FUNC( hb_p_pushstr ) -{ - HB_SYMBOL_UNUSED( cargo ); - return 3 + HB_PCODE_MKUSHORT( &( pFunc->pCode[ lPCodePos + 1 ] ) ); -} - -static HB_LABEL_FUNC( hb_p_pushstrshort ) -{ - HB_SYMBOL_UNUSED( cargo ); - return 2 + pFunc->pCode[ lPCodePos + 1 ]; -} - -static HB_LABEL_FUNC( hb_p_pushblock ) -{ - HB_SYMBOL_UNUSED( cargo ); - return HB_PCODE_MKUSHORT( &pFunc->pCode[ lPCodePos + 1 ] ); -} - -static HB_LABEL_FUNC( hb_p_pushblockshort ) -{ - HB_SYMBOL_UNUSED( cargo ); - return pFunc->pCode[ lPCodePos + 1 ]; -} - -static HB_LABEL_FUNC( hb_p_localname ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos++ ] ); - - return ( lPCodePos - ulStart ); -} - -static HB_LABEL_FUNC( hb_p_modulename ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos++ ]); - - return ( lPCodePos - ulStart ); -} - -static HB_LABEL_FUNC( hb_p_staticname ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 4; - while( pFunc->pCode[ lPCodePos++ ] ); - - return ( lPCodePos - ulStart ); -} - /* * jump functions */ @@ -285,7 +225,7 @@ static PHB_LABEL_FUNC s_GenLabelFuncTable[ HB_P_LAST_PCODE ] = NULL, /* HB_P_LESSEQUAL, */ NULL, /* HB_P_LESS, */ NULL, /* HB_P_LINE, */ - hb_p_localname, /* HB_P_LOCALNAME, */ + NULL, /* HB_P_LOCALNAME, */ NULL, /* HB_P_MACROPOP, */ NULL, /* HB_P_MACROPOPALIASED, */ NULL, /* HB_P_MACROPUSH, */ @@ -299,7 +239,7 @@ static PHB_LABEL_FUNC s_GenLabelFuncTable[ HB_P_LAST_PCODE ] = NULL, /* HB_P_MESSAGE, */ NULL, /* HB_P_MINUS, */ NULL, /* HB_P_MODULUS, */ - hb_p_modulename, /* HB_P_MODULENAME, */ + NULL, /* HB_P_MODULENAME, */ /* start: pcodes generated by macro compiler */ NULL, /* HB_P_MMESSAGE, */ NULL, /* HB_P_MPOPALIASEDFIELD, */ @@ -339,8 +279,8 @@ static PHB_LABEL_FUNC s_GenLabelFuncTable[ HB_P_LAST_PCODE ] = NULL, /* HB_P_PUSHALIASEDFIELD, */ NULL, /* HB_P_PUSHALIASEDFIELDNEAR, */ NULL, /* HB_P_PUSHALIASEDVAR, */ - hb_p_pushblock, /* HB_P_PUSHBLOCK, */ - hb_p_pushblockshort, /* HB_P_PUSHBLOCKSHORT, */ + NULL, /* HB_P_PUSHBLOCK, */ + NULL, /* HB_P_PUSHBLOCKSHORT, */ NULL, /* HB_P_PUSHFIELD, */ NULL, /* HB_P_PUSHBYTE, */ NULL, /* HB_P_PUSHINT, */ @@ -355,8 +295,8 @@ static PHB_LABEL_FUNC s_GenLabelFuncTable[ HB_P_LAST_PCODE ] = NULL, /* HB_P_PUSHSELF, */ NULL, /* HB_P_PUSHSTATIC, */ NULL, /* HB_P_PUSHSTATICREF, */ - hb_p_pushstr, /* HB_P_PUSHSTR, */ - hb_p_pushstrshort, /* HB_P_PUSHSTRSHORT, */ + NULL, /* HB_P_PUSHSTR, */ + NULL, /* HB_P_PUSHSTRSHORT, */ NULL, /* HB_P_PUSHSYM, */ NULL, /* HB_P_PUSHSYMNEAR, */ NULL, /* HB_P_PUSHVARIABLE, */ @@ -368,7 +308,7 @@ static PHB_LABEL_FUNC s_GenLabelFuncTable[ HB_P_LAST_PCODE ] = NULL, /* HB_P_SEQRECOVER, */ NULL, /* HB_P_SFRAME, */ NULL, /* HB_P_STATICS, */ - hb_p_staticname, /* HB_P_STATICNAME, */ + NULL, /* HB_P_STATICNAME, */ NULL, /* HB_P_SWAPALIAS, */ NULL, /* HB_P_TRUE, */ NULL, /* HB_P_ZERO, */ diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index baedc8e30b..6d9c32def5 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -41,6 +41,68 @@ #include "hbcomp.h" +#define HB_PSIZE_FUNC( func ) HB_PCODE_FUNC( func, HB_VOID_PTR ) + +/* + * functions for variable size PCODE tracing + */ +static HB_PSIZE_FUNC( hb_p_pushstr ) +{ + HB_SYMBOL_UNUSED( cargo ); + return 3 + HB_PCODE_MKUSHORT( &pFunc->pCode[ lPCodePos + 1 ] ); +} + +static HB_PSIZE_FUNC( hb_p_pushstrshort ) +{ + HB_SYMBOL_UNUSED( cargo ); + return 2 + pFunc->pCode[ lPCodePos + 1 ]; +} + +static HB_PSIZE_FUNC( hb_p_pushblock ) +{ + HB_SYMBOL_UNUSED( cargo ); + return HB_PCODE_MKUSHORT( &pFunc->pCode[ lPCodePos + 1 ] ); +} + +static HB_PSIZE_FUNC( hb_p_pushblockshort ) +{ + HB_SYMBOL_UNUSED( cargo ); + return pFunc->pCode[ lPCodePos + 1 ]; +} + +static HB_PSIZE_FUNC( hb_p_localname ) +{ + ULONG ulStart = lPCodePos; + + HB_SYMBOL_UNUSED( cargo ); + lPCodePos += 3; + while( pFunc->pCode[ lPCodePos++ ] ); + + return ( lPCodePos - ulStart ); +} + +static HB_PSIZE_FUNC( hb_p_modulename ) +{ + ULONG ulStart = lPCodePos; + + HB_SYMBOL_UNUSED( cargo ); + lPCodePos += 3; + while( pFunc->pCode[ lPCodePos++ ]); + + return ( lPCodePos - ulStart ); +} + +static HB_PSIZE_FUNC( hb_p_staticname ) +{ + ULONG ulStart = lPCodePos; + + HB_SYMBOL_UNUSED( cargo ); + lPCodePos += 4; + while( pFunc->pCode[ lPCodePos++ ] ); + + return ( lPCodePos - ulStart ); +} + const BYTE hb_comp_pcode_len[] = { 1, /* HB_P_AND, */ 1, /* HB_P_ARRAYPUSH, */ @@ -190,6 +252,180 @@ const BYTE hb_comp_pcode_len[] = { 1 /* HB_P_DIVEQ, */ }; +/* + * this table has pointers to functions which count + * real size of variable size PCODEs + */ +static HB_PCODE_FUNC_PTR s_psize_table[] = +{ + NULL, /* HB_P_AND, */ + NULL, /* HB_P_ARRAYPUSH, */ + NULL, /* HB_P_ARRAYPOP, */ + NULL, /* HB_P_ARRAYDIM, */ + NULL, /* HB_P_ARRAYGEN, */ + NULL, /* HB_P_EQUAL, */ + NULL, /* HB_P_ENDBLOCK, */ + NULL, /* HB_P_ENDPROC, */ + NULL, /* HB_P_EXACTLYEQUAL, */ + NULL, /* HB_P_FALSE, */ + NULL, /* HB_P_FORTEST, */ + NULL, /* HB_P_FUNCTION, */ + NULL, /* HB_P_FUNCTIONSHORT, */ + NULL, /* HB_P_FRAME, */ + NULL, /* HB_P_FUNCPTR, */ + NULL, /* HB_P_GREATER, */ + NULL, /* HB_P_GREATEREQUAL, */ + NULL, /* HB_P_DEC, */ + NULL, /* HB_P_DIVIDE, */ + NULL, /* HB_P_DO, */ + NULL, /* HB_P_DOSHORT, */ + NULL, /* HB_P_DUPLICATE, */ + NULL, /* HB_P_DUPLTWO, */ + NULL, /* HB_P_INC, */ + NULL, /* HB_P_INSTRING, */ + NULL, /* HB_P_JUMPNEAR, */ + NULL, /* HB_P_JUMP, */ + NULL, /* HB_P_JUMPFAR, */ + NULL, /* HB_P_JUMPFALSENEAR, */ + NULL, /* HB_P_JUMPFALSE, */ + NULL, /* HB_P_JUMPFALSEFAR, */ + NULL, /* HB_P_JUMPTRUENEAR, */ + NULL, /* HB_P_JUMPTRUE, */ + NULL, /* HB_P_JUMPTRUEFAR, */ + NULL, /* HB_P_LESSEQUAL, */ + NULL, /* HB_P_LESS, */ + NULL, /* HB_P_LINE, */ + hb_p_localname, /* HB_P_LOCALNAME, */ + NULL, /* HB_P_MACROPOP, */ + NULL, /* HB_P_MACROPOPALIASED, */ + NULL, /* HB_P_MACROPUSH, */ + NULL, /* HB_P_MACROPUSHARG, */ + NULL, /* HB_P_MACROPUSHLIST, */ + NULL, /* HB_P_MACROPUSHINDEX, */ + NULL, /* HB_P_MACROPUSHPARE, */ + NULL, /* HB_P_MACROPUSHALIASED, */ + NULL, /* HB_P_MACROSYMBOL, */ + NULL, /* HB_P_MACROTEXT, */ + NULL, /* HB_P_MESSAGE, */ + NULL, /* HB_P_MINUS, */ + NULL, /* HB_P_MODULUS, */ + hb_p_modulename, /* HB_P_MODULENAME, */ + /* start: pcodes generated by macro compiler */ + NULL, /* HB_P_MMESSAGE, */ + NULL, /* HB_P_MPOPALIASEDFIELD, */ + NULL, /* HB_P_MPOPALIASEDVAR, */ + NULL, /* HB_P_MPOPFIELD, */ + NULL, /* HB_P_MPOPMEMVAR, */ + NULL, /* HB_P_MPUSHALIASEDFIELD, */ + NULL, /* HB_P_MPUSHALIASEDVAR, */ + NULL, /* HB_P_MPUSHBLOCK, */ + NULL, /* HB_P_MPUSHFIELD, */ + NULL, /* HB_P_MPUSHMEMVAR, */ + NULL, /* HB_P_MPUSHMEMVARREF, */ + NULL, /* HB_P_MPUSHSYM, */ + NULL, /* HB_P_MPUSHVARIABLE, */ + /* end: */ + NULL, /* HB_P_MULT, */ + NULL, /* HB_P_NEGATE, */ + NULL, /* HB_P_NOOP, */ + NULL, /* HB_P_NOT, */ + NULL, /* HB_P_NOTEQUAL, */ + NULL, /* HB_P_OR, */ + NULL, /* HB_P_PARAMETER, */ + NULL, /* HB_P_PLUS, */ + NULL, /* HB_P_POP, */ + NULL, /* HB_P_POPALIAS, */ + NULL, /* HB_P_POPALIASEDFIELD, */ + NULL, /* HB_P_POPALIASEDFIELDNEAR, */ + NULL, /* HB_P_POPALIASEDVAR, */ + NULL, /* HB_P_POPFIELD, */ + NULL, /* HB_P_POPLOCAL, */ + NULL, /* HB_P_POPLOCALNEAR, */ + NULL, /* HB_P_POPMEMVAR, */ + NULL, /* HB_P_POPSTATIC, */ + NULL, /* HB_P_POPVARIABLE, */ + NULL, /* HB_P_POWER, */ + NULL, /* HB_P_PUSHALIAS, */ + NULL, /* HB_P_PUSHALIASEDFIELD, */ + NULL, /* HB_P_PUSHALIASEDFIELDNEAR, */ + NULL, /* HB_P_PUSHALIASEDVAR, */ + hb_p_pushblock, /* HB_P_PUSHBLOCK, */ + hb_p_pushblockshort, /* HB_P_PUSHBLOCKSHORT, */ + NULL, /* HB_P_PUSHFIELD, */ + NULL, /* HB_P_PUSHBYTE, */ + NULL, /* HB_P_PUSHINT, */ + NULL, /* HB_P_PUSHLOCAL, */ + NULL, /* HB_P_PUSHLOCALNEAR, */ + NULL, /* HB_P_PUSHLOCALREF, */ + NULL, /* HB_P_PUSHLONG, */ + NULL, /* HB_P_PUSHMEMVAR, */ + NULL, /* HB_P_PUSHMEMVARREF, */ + NULL, /* HB_P_PUSHNIL, */ + NULL, /* HB_P_PUSHDOUBLE, */ + NULL, /* HB_P_PUSHSELF, */ + NULL, /* HB_P_PUSHSTATIC, */ + NULL, /* HB_P_PUSHSTATICREF, */ + hb_p_pushstr, /* HB_P_PUSHSTR, */ + hb_p_pushstrshort, /* HB_P_PUSHSTRSHORT, */ + NULL, /* HB_P_PUSHSYM, */ + NULL, /* HB_P_PUSHSYMNEAR, */ + NULL, /* HB_P_PUSHVARIABLE, */ + NULL, /* HB_P_RETVALUE, */ + NULL, /* HB_P_SEND, */ + NULL, /* HB_P_SENDSHORT, */ + NULL, /* HB_P_SEQBEGIN, */ + NULL, /* HB_P_SEQEND, */ + NULL, /* HB_P_SEQRECOVER, */ + NULL, /* HB_P_SFRAME, */ + NULL, /* HB_P_STATICS, */ + hb_p_staticname, /* HB_P_STATICNAME, */ + NULL, /* HB_P_SWAPALIAS, */ + NULL, /* HB_P_TRUE, */ + NULL, /* HB_P_ZERO, */ + NULL, /* HB_P_ONE, */ + NULL, /* HB_P_MACROLIST, */ + NULL, /* HB_P_MACROLISTEND, */ + NULL, /* HB_P_MPUSHSTR, */ + NULL, /* HB_P_LOCALNEARADDINT, */ + NULL, /* HB_P_MACROPUSHREF */ + NULL, /* HB_P_PUSHLONGLONG */ + NULL, /* HB_P_ENUMSTART */ + NULL, /* HB_P_ENUMNEXT */ + NULL, /* HB_P_ENUMPREV */ + NULL, /* HB_P_ENUMEND */ + NULL, /* HB_P_SWITCH */ + NULL, /* HB_P_PUSHDATE */ + /* optimalization of inlined math operations */ + NULL, /* HB_P_PLUSEQPOP */ + NULL, /* HB_P_MINUSEQPOP */ + NULL, /* HB_P_MULTEQPOP */ + NULL, /* HB_P_DIVEQPOP */ + NULL, /* HB_P_PLUSEQ */ + NULL, /* HB_P_MINUSEQ */ + NULL, /* HB_P_MULTEQ */ + NULL /* HB_P_DIVEQ */ +}; + +LONG hb_compPCodeSize( PFUNCTION pFunc, ULONG ulOffset ) +{ + LONG lSize = 0; + BYTE opcode = pFunc->pCode[ ulOffset ]; + + if( opcode < HB_P_LAST_PCODE ) + { + lSize = hb_comp_pcode_len[ opcode ]; + + if( lSize == 0 ) + { + HB_PCODE_FUNC_PTR pCall = s_psize_table[ opcode ]; + + if( pCall != NULL ) + lSize = pCall( pFunc, ulOffset, NULL ); + } + } + return lSize; +} + void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * cargo ) { ULONG ulPos = 0; @@ -199,6 +435,7 @@ void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * c /* Make sure that table is correct */ assert( sizeof( hb_comp_pcode_len ) == HB_P_LAST_PCODE ); + assert( sizeof( s_psize_table ) / sizeof( HB_PCODE_FUNC_PTR ) == HB_P_LAST_PCODE ); while( ulPos < pFunc->lPCodePos ) { @@ -206,14 +443,18 @@ void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * c if( opcode < HB_P_LAST_PCODE ) { pCall = pFunctions[ opcode ]; - if( pCall ) + ulSkip = pCall ? pCall( pFunc, ulPos, cargo ) : 0; + if( ulSkip == 0 ) { - ulSkip = pCall( pFunc, ulPos, cargo ); - if( ulSkip == 0 ) - ulSkip = hb_comp_pcode_len[ opcode ]; - } - else ulSkip = hb_comp_pcode_len[ opcode ]; + if( ulSkip == 0 ) + { + HB_PCODE_FUNC_PTR pCall = s_psize_table[ opcode ]; + + if( pCall != NULL ) + ulSkip = pCall( pFunc, ulPos, NULL ); + } + } if( ulSkip == 0 ) { @@ -270,2861 +511,6 @@ void hb_compPCodeTrace( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * } } -#if defined(HB_COMP_STRONG_TYPES) - -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_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 szType0[64], szType1[64], szType2[64], cType, cSubType0 = 0, cSubType1 = 0, cSubType2 = 0; - BYTE bLast1, bLast2; - static int s_aiPreCondStack[ 16 ], s_iCondIndex = 0; - - /* - printf( "\nProcessing: %i Stack: %i\n", pFunc->pCode[ ulPos ], pFunc->iStackSize ); - */ - - /* 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, HB_SYM_FUNCNAME ); - - 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 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT ); - cType1 = 'X'; - } - 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - /* 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 ) ) - { - /* - printf( "\nNeeded %i values, found %i!\n", wVar + 1, pFunc->iStackIndex - 1 ); - */ - pFunc->iStackIndex = 1; - pFunc->pStack[ 0 ] = ' '; - 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( "\nExec 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, cParamType; - int iOffset = wVar; - - while ( --iOffset >= 0 ) - { - BOOL bByRef = FALSE; - - cParamType = pFunc->pStack[ iParamBase + iOffset ]; - if( ( cParamType == '-' + VT_OFFSET_VARIANT ) || cParamType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cParamType -= VT_OFFSET_VARIANT; - } - - 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 >= ( 'A' + VT_OFFSET_BYREF ) ) - { - bByRef = TRUE; - cFormalType -= VT_OFFSET_BYREF; - } - - /* --- */ - - if( cFormalType == ' ' && ! bByRef ) - { - /* Declared is Variant, accept anything. */ - } - else if( cFormalType == 'S' && cParamType == '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, "%s %i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, 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' && cParamType == '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, "%s %i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, 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 != cParamType ) - { - 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 - { - /* Cleanup. */ - if( toupper( cParamType ) == 'S' && pFunc->iStackClasses ) - { - --pFunc->iStackClasses; - } - - if( bByRef ) - { - sprintf( ( char * ) szType2, "@%c", cFormalType ); - } - else if( islower( cFormalType ) ) - { - sprintf( ( char * ) szType2, "ARRAY OF %c", toupper( cFormalType ) ); - } - else - { - sprintf( ( char * ) szType2, "%c", cFormalType ); - } - } - - sprintf( ( char * ) szType1, "%s #%i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, iOffset + 1 ); - - if( cParamType == ' ' || cParamType == '-' || cParamType == 'U' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_SUSPECT, ( char * ) szType1, ( char * ) szType2 ); - } - else if( bByRef && ( cParamType == ( ' ' + VT_OFFSET_BYREF ) || cParamType >= ( 'A' + VT_OFFSET_BYREF ) ) ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_SUSPECT, ( char * ) szType1, ( char * ) szType2 ); - } - else - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 ); - } - } - } - } - else - { - sprintf( ( char * ) szType1, "%s got %i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, wVar ); - - if( iOptionals ) - { - sprintf( ( char * ) szType2, "%i-%i", hb_comp_iParamCount - iOptionals, hb_comp_iParamCount ); - } - else - { - sprintf( ( char * ) szType2, "%i", hb_comp_iParamCount - iOptionals ); - } - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_COUNT, ( char * ) szType1, ( char * ) szType2 ); - } - } - else - { - /* - printf( "\nExec Non Declared Function - Stack: %i Functions: %i\n", pFunc->iStackIndex, pFunc->iStackFunctions ); - */ - } - - #if 0 - { - int i; - for ( i = 0; i < pFunc->iStackIndex; i++ ) - { - printf( "\nStack: %i Type: %c", i, pFunc->pStack[ i ] ); - } - } - printf( "\Removing %i parameters\n", wVar ); - - #endif - - /* Removing all the parameters. Return 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--; - /* - printf( "\nNo Type for Procedure. - Stack: %i\n", pFunc->iStackIndex ); - */ - } - else - { - #if 0 - /* Declared result already on stack. */ - cType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - if( ( cType == '-' + VT_OFFSET_VARIANT ) || cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cType -= VT_OFFSET_VARIANT; - } - printf( "\nType of Function \'%c\' - Stack: %i\n", cType, pFunc->iStackIndex ); - #endif - } - break; - - case HB_P_MESSAGE : - if( pFunc->iStackIndex < 1 ) - break; - - cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - - if( ( cSubType1 == '-' + VT_OFFSET_VARIANT ) || 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); - - 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 = HB_PCODE_MKSHORT( &( 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 == '-' + VT_OFFSET_VARIANT ) || 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 == ' ' ) - ; /* Formal 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 ) ) - ; /* Formal is ANY REFERENCE, and Parameter is SOME REFERENCE. */ - else if( cFormalType == pFunc->pStack[ iParamBase + iOffset ] - VT_OFFSET_VARIANT ) - ; /* Prameter is VARIANT.SubType of same as Formal. */ - 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( islower( cFormalType ) && pFunc->pStack[ iParamBase + iOffset ] == 'A' ) - { - 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( cFormalType == ( '-' + VT_OFFSET_BYREF ) || cFormalType >= ( 'A' + VT_OFFSET_BYREF ) ) - sprintf( ( char * ) szType2, "@%c", cFormalType - VT_OFFSET_BYREF ); - else if( islower( cFormalType ) ) - sprintf( ( char * ) szType2, "ARRAY OF %c", toupper( cFormalType ) ); - else - sprintf( ( char * ) szType2, "%c", cFormalType ); - } - - if( pFunc->pStack[ iParamBase + iOffset ] == 'S' ) - { - PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; - sprintf( ( char * ) szType1, "(%i) %s", iOffset + 1, hb_comp_pParamClass->szName ); - } - else if( pFunc->pStack[ iParamBase + iOffset ] == 's' ) - { - PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; - sprintf( ( char * ) szType1, "(%i) ARRAY OF %s", iOffset + 1, hb_comp_pParamClass->szName ); - } - else - { - if( pFunc->pStack[ iParamBase + iOffset ] == ( '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ iParamBase + iOffset ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - sprintf( ( char * ) szType1, "(%i) AnyType.SubType[%c]", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] - VT_OFFSET_VARIANT ); - else if( islower( pFunc->pStack[ iParamBase + iOffset ] ) ) - sprintf( ( char * ) szType1, "(%i) ARRAY OF %c", iOffset + 1, toupper( pFunc->pStack[ iParamBase + iOffset ] ) ); - else - sprintf( ( char * ) szType1, "(%i) %c", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] ); - } - - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_SUSPECT, ( 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( cFormalType == ( '-' + VT_OFFSET_BYREF ) || cFormalType >= ( 'A' + VT_OFFSET_BYREF ) ) - sprintf( ( char * ) szType2, "@%c", cFormalType - VT_OFFSET_BYREF ); - else if( islower( cFormalType ) ) - sprintf( ( char * ) szType2, "ARRAY OF %c", toupper( cFormalType ) ); - else - sprintf( ( char * ) szType2, "%c", cFormalType ); - } - - if( pFunc->pStack[ iParamBase + iOffset ] == 'S' ) - { - PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; - sprintf( ( char * ) szType1, "(%i) %s", iOffset + 1, hb_comp_pParamClass->szName ); - } - else if( pFunc->pStack[ iParamBase + iOffset ] == 's' ) - { - PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; - sprintf( ( char * ) szType1, "(%i) ARRAY OF %s", iOffset + 1, hb_comp_pParamClass->szName ); - } - else - { - if( pFunc->pStack[ iParamBase + iOffset ] == ( '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ iParamBase + iOffset ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - sprintf( ( char * ) szType1, "(%i) AnyType.SubType[%c]", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] - VT_OFFSET_VARIANT ); - else if( islower( pFunc->pStack[ iParamBase + iOffset ] ) ) - sprintf( ( char * ) szType1, "(%i) ARRAY OF %c", iOffset + 1, toupper( pFunc->pStack[ iParamBase + iOffset ] ) ); - else - sprintf( ( char * ) szType1, "(%i) %c", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] ); - } - - 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 ] == '-' + VT_OFFSET_VARIANT ) || 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' ) - { - /* Ok. */ - } - 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_JUMPNEAR : - case HB_P_JUMP : - case HB_P_JUMPFAR : - /* Restoring Stack depth. */ - if( s_iCondIndex ) - { - pFunc->iStackIndex = s_aiPreCondStack[ --s_iCondIndex ]; - } - /* - printf( "\nAfter Cond: %i\n", pFunc->iStackIndex ); - */ - 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 : - if( pFunc->iStackIndex < 1 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - /* - printf( "\nBefore Cond: %i\n", pFunc->iStackIndex ); - */ - - /* Saving Stack depth befor Jump. */ - /* TODO: Remove Hard coded limitation. */ - if( s_iCondIndex < 16 ) - { - s_aiPreCondStack[ s_iCondIndex++ ] = pFunc->iStackIndex; - } - - if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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' ) - { - /* Ok. */ - } - 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 : - if( pFunc->iStackIndex < 2 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); - } - - if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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 ] == ' ' ) - { - /* Ok. */ - } - 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 : - if( pFunc->iStackIndex < 2 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - /*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 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ] - VT_OFFSET_VARIANT; - } - - if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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]", cSubType1 ); - } - 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]", cSubType2 ); - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) - { - strcpy( ( char * ) szType2, "NIL" ); - } - else - { - sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] ); - } - - if( ! cSubType1 ) - { - cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - } - - if( ! cSubType2 ) - { - cSubType2 = pFunc->pStack[ pFunc->iStackIndex ]; - } - - if( cSubType1 == ' ' && cSubType2 == ' ' ) - { - /* Override the last item with the new result type which is already there */ - } - else if( cSubType1 == 'N' && cSubType2 == '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 ) && - cSubType1 == cSubType2 ) - { - /* Override the last item with the new result type wich is already there */ - } - else if( cSubType1 == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, ( char * ) szType2 ); - - /* Override the last item with the new result type. */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = cSubType2; - } - else if( cSubType2 == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType2, ( char * ) szType1 ); - - /* Override the last item with the new result type. */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = cSubType1; - } - else if( cSubType1 == '-' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, (char *) szType1, ( char * ) szType2 ); - - /* Override the last item with the new result type. */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U'; - } - else if( cSubType2 == '-' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, (char *) szType2, ( char * ) szType1 ); - - /* 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_INCOMPATIBLE, ( char * ) szType1, ( char * ) szType2 ); - - /* Override the last item with the new result type */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U'; - } - break; - - case HB_P_FORTEST : - - if( pFunc->iStackIndex < 3 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - /* --- */ - - if( ( pFunc->pStack[ pFunc->iStackIndex - 2 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 2 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType0 = pFunc->pStack[ pFunc->iStackIndex - 2 ] - VT_OFFSET_VARIANT; - } - - if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ] - VT_OFFSET_VARIANT; - } - - if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType2 = pFunc->pStack[ pFunc->iStackIndex ] - VT_OFFSET_VARIANT; - } - - /* --- */ - - if( cSubType0 && cSubType0 == '-' ) - { - strcpy( ( char * ) szType0, "AnyType.SubType[NIL]" ); - } - else if( cSubType0 ) - { - sprintf( ( char * ) szType0, "AnyType.SubType[%c]", cSubType0 ); - } - else if( pFunc->pStack[ pFunc->iStackIndex - 2 ] == '-' ) - { - strcpy( ( char * ) szType0, "NIL"); - } - else - { - sprintf( ( char * ) szType0, "%c", pFunc->pStack[ pFunc->iStackIndex - 2 ] ); - } - - /* --- */ - - if( cSubType1 && cSubType1 == '-' ) - { - strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" ); - } - else if( cSubType1 ) - { - sprintf( ( char * ) szType1, "AnyType.SubType[%c]", cSubType1 ); - } - 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]", cSubType2 ); - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) - { - strcpy( ( char * ) szType2, "NIL" ); - } - else - { - sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] ); - } - - /* --- */ - - if( ! cSubType0 ) - { - cSubType0 = pFunc->pStack[ pFunc->iStackIndex - 2 ]; - } - - if( ! cSubType1 ) - { - cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - } - - if( ! cSubType2 ) - { - cSubType2 = pFunc->pStack[ pFunc->iStackIndex ]; - } - - /* --- */ - - if( cSubType0 == 'N' ) - { - /* Ok. */ - } - else if ( cSubType0 == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "UnKnown", "N" ); - } - else - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType0, "N" ); - } - - /* --- */ - - if( cSubType1 == 'N' ) - { - /* Ok. */ - } - else if ( cSubType1 == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "UnKnown", "N" ); - } - else - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "N" ); - } - - /* --- */ - - if( cSubType2 == 'N' ) - { - /* Ok. */ - } - else if ( cSubType2 == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "UnKnown", "N" ); - } - else - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType2, "N" ); - } - - /* Remove Step. */ - pFunc->iStackIndex--; - - /* Override the last item with Logical */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L'; - - break; - - case HB_P_GREATER : - case HB_P_GREATEREQUAL : - case HB_P_LESSEQUAL : - case HB_P_LESS : - if( pFunc->iStackIndex < 2 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); - } - - if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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_INCOMPATIBLE, ( 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_INCOMPATIBLE, ( 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 : - if( pFunc->iStackIndex < 2 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); - } - if( cSubType1 && cSubType1 == '-' ) - { - sprintf( ( char * ) szType1, "AnyType.SubType[NIL]" ); - } - else if( cSubType1 ) - { - sprintf( ( char * ) szType1, "AnyType.SubType[%c]", cSubType1 ); - } - 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 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT ); - } - if( cSubType2 && cSubType2 == '-' ) - { - strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" ); - } - else if( cSubType2 ) - { - sprintf( ( char * ) szType2, "AnyType.SubType[%c]", cSubType2 ); - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) - { - strcpy( ( char * ) szType2, "NIL" ); - } - else - { - sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] ); - } - - /*---*/ - - if( ! cSubType1 ) - { - cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - } - - if( ! cSubType2 ) - { - cSubType2 = pFunc->pStack[ pFunc->iStackIndex ]; - } - - if( cSubType1 == '-' || cSubType2 == '-' ) - { - /* Override the last item with the new result type */ - } - else if( cSubType1 == cSubType2 ) - { - /* Override the last item with the new result type */ - } - else if( cSubType1 == ' ' ) - { - 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( cSubType2 == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, NULL ); - /* Override the last item with the new result type */ - } - else - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERANDS_INCOMPATIBLE, ( char * ) szType1, ( char * ) szType2 ); - /* Override the last item with the new result type */ - } - - /* Override the last item with the new result type */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L'; - - break; - - case HB_P_NOT : - if( pFunc->iStackIndex < 1 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || 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 : - if( pFunc->iStackIndex < 2 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= 'A' + VT_OFFSET_VARIANT ) - { - cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); - } - - if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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; - - #if 0 - /* Blcoks */ - case HB_P_PUSHBLOCKSHORT : - case HB_P_PUSHBLOCK : - break; - #endif - - case HB_P_ENDBLOCK : - /* Override the last value of the block left on the stack. */ - /* The last value was actualy generated on the pBlock stack, not in parrent. */ - 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_PUSHLONGLONG : - 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); - } - - /*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" ) == 1 ) - { - /*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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - pVar->cType = ' '; - } - - pVar = pVar->pNext; - } - } - - /* - printf( "\nPushed: %s() Type: %c Stack: %i\n", pSym->szName, pFunc->pStack[ pFunc->iStackIndex - 1], pFunc->iStackIndex - 1 ); - */ - } - 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; - } - - pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; - } - } - 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 = ( signed char ) pFunc->pCode[ ulPos + 1 ]; - } - else - { - wVar = HB_PCODE_MKSHORT( &( 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 = pFunc->pStatics; - while( ++wVar < 0 && pVar ) - { - pVar = pVar->pNext; - } - - if ( pVar ) - { - wVar = hb_compVariableGetPos( pTmp->pLocals, pVar->szName ); - pVar = hb_compVariableFind( pTmp->pLocals, wVar ); - } - } - else - { - pVar = hb_compVariableFind( pFunc->pLocals, wVar ); - } - - if( pVar ) - { - if( pFunc->pCode[ ulPos ] == HB_P_PUSHLOCALREF ) - { - pVar->iUsed |= VU_INITIALIZED; - } - else if( ! ( pVar->iUsed & VU_INITIALIZED ) ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL ); - } - - /* - printf( "\nUsed: %s\n", pVar->szName ); - */ - - /* Mark as used */ - pVar->iUsed |= VU_USED; - - if( pVar->cType == ( '-' + VT_OFFSET_VARIANT ) || 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 - { - /* - printf( "\nCould not find Local %i in: $s\n", wVar, pFunc->szName ); - */ - - 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - - 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 == ( '-' + VT_OFFSET_VARIANT ) || 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); - - 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); - - 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 ); - /* May have been initialized in any other function - can't check. */ - pVar->iUsed |= VU_INITIALIZED; - } - } - } - - if( pVar ) - { - cType = pVar->cType; - - /*printf( "\nPushed: %s Type: %c SubType: %c\n", pVar->szName, pVar->cType, pVar->cType - 100 );*/ - - if( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVARREF ) - { - pVar->iUsed |= VU_INITIALIZED; - } - else if( ! ( pVar->iUsed & VU_INITIALIZED ) ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL ); - } - - if( cType == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - - 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - - /* TODO Error Message after finalizing all possible pcodes. */ - if( pFunc->iStackIndex < wVar ) - { - pFunc->iStackIndex = 1; - pFunc->pStack[ 0 ] = 'A'; - break; - } - - /* Pop the Elements. */ - pFunc->iStackIndex -= wVar; - - /* Push the array. */ - pFunc->pStack[ pFunc->iStackIndex++ ] = 'A'; - break; - - case HB_P_ARRAYPUSH : - if( pFunc->iStackIndex < 1 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - /* Poping the Array Index. */ - pFunc->iStackIndex--; - - cType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - - /*printf( "\n Base Type: %c\n", cType );*/ - - if( cType == ( '-' + VT_OFFSET_VARIANT ) || cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cType -= VT_OFFSET_VARIANT; - } - - if( cType == ' ' ) - { - /* Type unknown. */ - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "A", NULL ); - pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; - } - else if( cType == 'A' ) - { - /* Variant Array Element - Type unknown. */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; - } - else if( cType == 'a' ) - { - /* Variant Array Element - Type unknown. */ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; - } - else if( islower( cType ) ) - { - /* Now we have the declared array element on the stack.*/ - pFunc->pStack[ pFunc->iStackIndex - 1 ] = toupper( cType ); - } - else - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_ARRAY, NULL, NULL ); - } - break; - - case HB_P_ARRAYPOP : - if( pFunc->iStackIndex < 3 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - /* Poping the Array Index. */ - pFunc->iStackIndex--; - - { - BYTE cElementType = pFunc->pStack[ pFunc->iStackIndex - 2 ]; - - cType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; - - if( cType == ( '-' + VT_OFFSET_VARIANT ) || cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cType -= VT_OFFSET_VARIANT; - } - - if( cElementType == ( '-' + VT_OFFSET_VARIANT ) || cElementType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - cElementType -= VT_OFFSET_VARIANT; - } - - if( cType == ' ' ) - { - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "A", NULL ); - } - else if( cType == 'A' ) - { - /* Array of variant can hold any value. */ - } - else if( cType == 'a' ) - { - /* Array of variant can hold any value. */ - } - else if( islower( cType ) && cElementType == ' ' ) - { - /* Array Of explicit type. */ - char szType[2]; - - sprintf( ( char * ) szType, "%c", toupper( cType ) ); - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL ); - } - else if( islower( cType ) && toupper( cType ) != cElementType && cElementType != '-' ) - { - /* Array Of explicit type. */ - char szType[2]; - - sprintf( ( char * ) szType, "%c", toupper( cType ) ); - 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 < 1 ) - /* 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 < 1 ) - /* 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - 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 : - if( pFunc->iStackIndex < 1 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - if( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR ) - wVar = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - - 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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - { - pVar->cType = ' '; - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || pSym->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - { - pSym->cType = ' '; - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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 : - /* TODO Error Message after finalizing all possible pcodes. */ - if( pFunc->iStackIndex < 1 ) - { - fprintf( hb_comp_errFile, "Oops - Stack: %i\n", pFunc->iStackIndex ); - break; - } - - pFunc->iStackIndex--; - - if( pFunc->pCode[ ulPos ] == HB_P_POPLOCAL ) - { - wVar = HB_PCODE_MKSHORT( &( 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 = pFunc->pStatics; - while( ++wVar < 0 && pVar ) - { - pVar = pVar->pNext; - } - - if ( pVar ) - { - wVar = hb_compVariableGetPos( pTmp->pLocals, pVar->szName ); - 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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - { - pVar->cType = ' '; - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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 : - if( pFunc->iStackIndex < 1 ) - /* TODO Error Message after finalizing all possible pcodes. */ - break; - - pFunc->iStackIndex--; - - pTmp = hb_comp_functions.pFirst; - wVar = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); - - 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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) - { - if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - { - pVar->cType = ' '; - } - else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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; - - case HB_P_SEQRECOVER : - /* TODO: find type of BREAK() */ - pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; - break; - } - - /* TODO Error or trace messages when completed. */ - if( pFunc->iStackIndex < 0 ) - { - fprintf( hb_comp_errFile, "\nStrongType Stack underflow!\n" ); - pFunc->iStackIndex = 0; - } -} -#endif /* ifdefined(HB_COMP_STRONG_TYPES) */ - void hb_compGenPCode1( BYTE byte ) { PFUNCTION pFunc = hb_comp_functions.pLast; /* get the currently defined Clipper function */ diff --git a/harbour/source/compiler/hbstripl.c b/harbour/source/compiler/hbstripl.c index 95c94da6b6..59c72ed9d6 100644 --- a/harbour/source/compiler/hbstripl.c +++ b/harbour/source/compiler/hbstripl.c @@ -60,63 +60,6 @@ typedef void HB_STRIP_INFO, * PHB_STRIP_INFO; typedef HB_STRIP_FUNC( HB_STRIP_FUNC_ ); typedef HB_STRIP_FUNC_ * PHB_STRIP_FUNC; -static HB_STRIP_FUNC( hb_p_pushstr ) -{ - HB_SYMBOL_UNUSED( cargo ); - return 3 + HB_PCODE_MKUSHORT( &( pFunc->pCode[ lPCodePos + 1 ] ) ); -} - -static HB_STRIP_FUNC( hb_p_pushstrshort ) -{ - HB_SYMBOL_UNUSED( cargo ); - return 2 + pFunc->pCode[ lPCodePos + 1 ]; -} - -static HB_STRIP_FUNC( hb_p_pushblock ) -{ - HB_SYMBOL_UNUSED( cargo ); - return HB_PCODE_MKUSHORT( &pFunc->pCode[ lPCodePos + 1 ] ); -} - -static HB_STRIP_FUNC( hb_p_pushblockshort ) -{ - HB_SYMBOL_UNUSED( cargo ); - return pFunc->pCode[ lPCodePos + 1 ]; -} - -static HB_STRIP_FUNC( hb_p_localname ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos++ ] ); - - return ( lPCodePos - ulStart ); -} - -static HB_STRIP_FUNC( hb_p_modulename ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 3; - while( pFunc->pCode[ lPCodePos++ ]); - - return ( lPCodePos - ulStart ); -} - -static HB_STRIP_FUNC( hb_p_staticname ) -{ - ULONG ulStart = lPCodePos; - - HB_SYMBOL_UNUSED( cargo ); - lPCodePos += 4; - while( pFunc->pCode[ lPCodePos++ ] ); - - return ( lPCodePos - ulStart ); -} - static HB_STRIP_FUNC( hb_p_line ) { HB_SYMBOL_UNUSED( cargo ); @@ -170,7 +113,7 @@ static PHB_STRIP_FUNC s_stripLines_table[] = NULL, /* HB_P_LESSEQUAL, */ NULL, /* HB_P_LESS, */ hb_p_line, /* HB_P_LINE, */ - hb_p_localname, /* HB_P_LOCALNAME, */ + NULL, /* HB_P_LOCALNAME, */ NULL, /* HB_P_MACROPOP, */ NULL, /* HB_P_MACROPOPALIASED, */ NULL, /* HB_P_MACROPUSH, */ @@ -184,7 +127,7 @@ static PHB_STRIP_FUNC s_stripLines_table[] = NULL, /* HB_P_MESSAGE, */ NULL, /* HB_P_MINUS, */ NULL, /* HB_P_MODULUS, */ - hb_p_modulename, /* HB_P_MODULENAME, */ + NULL, /* HB_P_MODULENAME, */ /* start: pcodes generated by macro compiler */ NULL, /* HB_P_MMESSAGE, */ NULL, /* HB_P_MPOPALIASEDFIELD, */ @@ -224,8 +167,8 @@ static PHB_STRIP_FUNC s_stripLines_table[] = NULL, /* HB_P_PUSHALIASEDFIELD, */ NULL, /* HB_P_PUSHALIASEDFIELDNEAR, */ NULL, /* HB_P_PUSHALIASEDVAR, */ - hb_p_pushblock, /* HB_P_PUSHBLOCK, */ - hb_p_pushblockshort, /* HB_P_PUSHBLOCKSHORT, */ + NULL, /* HB_P_PUSHBLOCK, */ + NULL, /* HB_P_PUSHBLOCKSHORT, */ NULL, /* HB_P_PUSHFIELD, */ NULL, /* HB_P_PUSHBYTE, */ NULL, /* HB_P_PUSHINT, */ @@ -240,8 +183,8 @@ static PHB_STRIP_FUNC s_stripLines_table[] = NULL, /* HB_P_PUSHSELF, */ NULL, /* HB_P_PUSHSTATIC, */ NULL, /* HB_P_PUSHSTATICREF, */ - hb_p_pushstr, /* HB_P_PUSHSTR, */ - hb_p_pushstrshort, /* HB_P_PUSHSTRSHORT, */ + NULL, /* HB_P_PUSHSTR, */ + NULL, /* HB_P_PUSHSTRSHORT, */ NULL, /* HB_P_PUSHSYM, */ NULL, /* HB_P_PUSHSYMNEAR, */ NULL, /* HB_P_PUSHVARIABLE, */ @@ -253,7 +196,7 @@ static PHB_STRIP_FUNC s_stripLines_table[] = NULL, /* HB_P_SEQRECOVER, */ NULL, /* HB_P_SFRAME, */ NULL, /* HB_P_STATICS, */ - hb_p_staticname, /* HB_P_STATICNAME, */ + NULL, /* HB_P_STATICNAME, */ NULL, /* HB_P_SWAPALIAS, */ NULL, /* HB_P_TRUE, */ NULL, /* HB_P_ZERO, */ diff --git a/harbour/source/compiler/hbstrong.c b/harbour/source/compiler/hbstrong.c new file mode 100644 index 0000000000..bfe3a5d84a --- /dev/null +++ b/harbour/source/compiler/hbstrong.c @@ -0,0 +1,2896 @@ +/* + * $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: + * + * 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 + * hb_compStrongType() + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbcomp.h" + +#if defined(HB_COMP_STRONG_TYPES) + +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_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 szType0[64], szType1[64], szType2[64], cType, cSubType0 = 0, cSubType1 = 0, cSubType2 = 0; + BYTE bLast1, bLast2; + static int s_aiPreCondStack[ 16 ], s_iCondIndex = 0; + + /* + printf( "\nProcessing: %i Stack: %i\n", pFunc->pCode[ ulPos ], pFunc->iStackSize ); + */ + + /* 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, HB_SYM_FUNCNAME ); + + 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 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT ); + cType1 = 'X'; + } + 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + /* 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 ) ) + { + /* + printf( "\nNeeded %i values, found %i!\n", wVar + 1, pFunc->iStackIndex - 1 ); + */ + pFunc->iStackIndex = 1; + pFunc->pStack[ 0 ] = ' '; + 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( "\nExec 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, cParamType; + int iOffset = wVar; + + while ( --iOffset >= 0 ) + { + BOOL bByRef = FALSE; + + cParamType = pFunc->pStack[ iParamBase + iOffset ]; + if( ( cParamType == '-' + VT_OFFSET_VARIANT ) || cParamType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cParamType -= VT_OFFSET_VARIANT; + } + + 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 >= ( 'A' + VT_OFFSET_BYREF ) ) + { + bByRef = TRUE; + cFormalType -= VT_OFFSET_BYREF; + } + + /* --- */ + + if( cFormalType == ' ' && ! bByRef ) + { + /* Declared is Variant, accept anything. */ + } + else if( cFormalType == 'S' && cParamType == '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, "%s %i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, 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' && cParamType == '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, "%s %i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, 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 != cParamType ) + { + 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 + { + /* Cleanup. */ + if( toupper( cParamType ) == 'S' && pFunc->iStackClasses ) + { + --pFunc->iStackClasses; + } + + if( bByRef ) + { + sprintf( ( char * ) szType2, "@%c", cFormalType ); + } + else if( islower( cFormalType ) ) + { + sprintf( ( char * ) szType2, "ARRAY OF %c", toupper( cFormalType ) ); + } + else + { + sprintf( ( char * ) szType2, "%c", cFormalType ); + } + } + + sprintf( ( char * ) szType1, "%s #%i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, iOffset + 1 ); + + if( cParamType == ' ' || cParamType == '-' || cParamType == 'U' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_SUSPECT, ( char * ) szType1, ( char * ) szType2 ); + } + else if( bByRef && ( cParamType == ( ' ' + VT_OFFSET_BYREF ) || cParamType >= ( 'A' + VT_OFFSET_BYREF ) ) ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_SUSPECT, ( char * ) szType1, ( char * ) szType2 ); + } + else + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_TYPE, ( char * ) szType1, ( char * ) szType2 ); + } + } + } + } + else + { + sprintf( ( char * ) szType1, "%s got %i", pFunc->pStackFunctions[ pFunc->iStackFunctions ]->szName, wVar ); + + if( iOptionals ) + { + sprintf( ( char * ) szType2, "%i-%i", hb_comp_iParamCount - iOptionals, hb_comp_iParamCount ); + } + else + { + sprintf( ( char * ) szType2, "%i", hb_comp_iParamCount - iOptionals ); + } + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_COUNT, ( char * ) szType1, ( char * ) szType2 ); + } + } + else + { + /* + printf( "\nExec Non Declared Function - Stack: %i Functions: %i\n", pFunc->iStackIndex, pFunc->iStackFunctions ); + */ + } + + #if 0 + { + int i; + for ( i = 0; i < pFunc->iStackIndex; i++ ) + { + printf( "\nStack: %i Type: %c", i, pFunc->pStack[ i ] ); + } + } + printf( "\Removing %i parameters\n", wVar ); + + #endif + + /* Removing all the parameters. Return 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--; + /* + printf( "\nNo Type for Procedure. - Stack: %i\n", pFunc->iStackIndex ); + */ + } + else + { + #if 0 + /* Declared result already on stack. */ + cType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + if( ( cType == '-' + VT_OFFSET_VARIANT ) || cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cType -= VT_OFFSET_VARIANT; + } + printf( "\nType of Function \'%c\' - Stack: %i\n", cType, pFunc->iStackIndex ); + #endif + } + break; + + case HB_P_MESSAGE : + if( pFunc->iStackIndex < 1 ) + break; + + cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + + if( ( cSubType1 == '-' + VT_OFFSET_VARIANT ) || 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); + + 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 = HB_PCODE_MKSHORT( &( 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 == '-' + VT_OFFSET_VARIANT ) || 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 == ' ' ) + ; /* Formal 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 ) ) + ; /* Formal is ANY REFERENCE, and Parameter is SOME REFERENCE. */ + else if( cFormalType == pFunc->pStack[ iParamBase + iOffset ] - VT_OFFSET_VARIANT ) + ; /* Prameter is VARIANT.SubType of same as Formal. */ + 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( islower( cFormalType ) && pFunc->pStack[ iParamBase + iOffset ] == 'A' ) + { + 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( cFormalType == ( '-' + VT_OFFSET_BYREF ) || cFormalType >= ( 'A' + VT_OFFSET_BYREF ) ) + sprintf( ( char * ) szType2, "@%c", cFormalType - VT_OFFSET_BYREF ); + else if( islower( cFormalType ) ) + sprintf( ( char * ) szType2, "ARRAY OF %c", toupper( cFormalType ) ); + else + sprintf( ( char * ) szType2, "%c", cFormalType ); + } + + if( pFunc->pStack[ iParamBase + iOffset ] == 'S' ) + { + PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; + sprintf( ( char * ) szType1, "(%i) %s", iOffset + 1, hb_comp_pParamClass->szName ); + } + else if( pFunc->pStack[ iParamBase + iOffset ] == 's' ) + { + PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; + sprintf( ( char * ) szType1, "(%i) ARRAY OF %s", iOffset + 1, hb_comp_pParamClass->szName ); + } + else + { + if( pFunc->pStack[ iParamBase + iOffset ] == ( '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ iParamBase + iOffset ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + sprintf( ( char * ) szType1, "(%i) AnyType.SubType[%c]", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] - VT_OFFSET_VARIANT ); + else if( islower( pFunc->pStack[ iParamBase + iOffset ] ) ) + sprintf( ( char * ) szType1, "(%i) ARRAY OF %c", iOffset + 1, toupper( pFunc->pStack[ iParamBase + iOffset ] ) ); + else + sprintf( ( char * ) szType1, "(%i) %c", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] ); + } + + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_PARAM_SUSPECT, ( 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( cFormalType == ( '-' + VT_OFFSET_BYREF ) || cFormalType >= ( 'A' + VT_OFFSET_BYREF ) ) + sprintf( ( char * ) szType2, "@%c", cFormalType - VT_OFFSET_BYREF ); + else if( islower( cFormalType ) ) + sprintf( ( char * ) szType2, "ARRAY OF %c", toupper( cFormalType ) ); + else + sprintf( ( char * ) szType2, "%c", cFormalType ); + } + + if( pFunc->pStack[ iParamBase + iOffset ] == 'S' ) + { + PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; + sprintf( ( char * ) szType1, "(%i) %s", iOffset + 1, hb_comp_pParamClass->szName ); + } + else if( pFunc->pStack[ iParamBase + iOffset ] == 's' ) + { + PCOMCLASS hb_comp_pParamClass = pFunc->pStackClasses[ --pFunc->iStackClasses ]; + sprintf( ( char * ) szType1, "(%i) ARRAY OF %s", iOffset + 1, hb_comp_pParamClass->szName ); + } + else + { + if( pFunc->pStack[ iParamBase + iOffset ] == ( '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ iParamBase + iOffset ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + sprintf( ( char * ) szType1, "(%i) AnyType.SubType[%c]", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] - VT_OFFSET_VARIANT ); + else if( islower( pFunc->pStack[ iParamBase + iOffset ] ) ) + sprintf( ( char * ) szType1, "(%i) ARRAY OF %c", iOffset + 1, toupper( pFunc->pStack[ iParamBase + iOffset ] ) ); + else + sprintf( ( char * ) szType1, "(%i) %c", iOffset + 1, pFunc->pStack[ iParamBase + iOffset ] ); + } + + 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 ] == '-' + VT_OFFSET_VARIANT ) || 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' ) + { + /* Ok. */ + } + 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_JUMPNEAR : + case HB_P_JUMP : + case HB_P_JUMPFAR : + /* Restoring Stack depth. */ + if( s_iCondIndex ) + { + pFunc->iStackIndex = s_aiPreCondStack[ --s_iCondIndex ]; + } + /* + printf( "\nAfter Cond: %i\n", pFunc->iStackIndex ); + */ + 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 : + if( pFunc->iStackIndex < 1 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + /* + printf( "\nBefore Cond: %i\n", pFunc->iStackIndex ); + */ + + /* Saving Stack depth befor Jump. */ + /* TODO: Remove Hard coded limitation. */ + if( s_iCondIndex < 16 ) + { + s_aiPreCondStack[ s_iCondIndex++ ] = pFunc->iStackIndex; + } + + if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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' ) + { + /* Ok. */ + } + 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 : + if( pFunc->iStackIndex < 2 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); + } + + if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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 ] == ' ' ) + { + /* Ok. */ + } + 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 : + if( pFunc->iStackIndex < 2 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + /*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 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ] - VT_OFFSET_VARIANT; + } + + if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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]", cSubType1 ); + } + 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]", cSubType2 ); + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) + { + strcpy( ( char * ) szType2, "NIL" ); + } + else + { + sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] ); + } + + if( ! cSubType1 ) + { + cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + } + + if( ! cSubType2 ) + { + cSubType2 = pFunc->pStack[ pFunc->iStackIndex ]; + } + + if( cSubType1 == ' ' && cSubType2 == ' ' ) + { + /* Override the last item with the new result type which is already there */ + } + else if( cSubType1 == 'N' && cSubType2 == '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 ) && + cSubType1 == cSubType2 ) + { + /* Override the last item with the new result type wich is already there */ + } + else if( cSubType1 == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, ( char * ) szType2 ); + + /* Override the last item with the new result type. */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = cSubType2; + } + else if( cSubType2 == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType2, ( char * ) szType1 ); + + /* Override the last item with the new result type. */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = cSubType1; + } + else if( cSubType1 == '-' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, (char *) szType1, ( char * ) szType2 ); + + /* Override the last item with the new result type. */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U'; + } + else if( cSubType2 == '-' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, (char *) szType2, ( char * ) szType1 ); + + /* 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_INCOMPATIBLE, ( char * ) szType1, ( char * ) szType2 ); + + /* Override the last item with the new result type */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'U'; + } + break; + + case HB_P_FORTEST : + + if( pFunc->iStackIndex < 3 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + /* --- */ + + if( ( pFunc->pStack[ pFunc->iStackIndex - 2 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 2 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType0 = pFunc->pStack[ pFunc->iStackIndex - 2 ] - VT_OFFSET_VARIANT; + } + + if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ] - VT_OFFSET_VARIANT; + } + + if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType2 = pFunc->pStack[ pFunc->iStackIndex ] - VT_OFFSET_VARIANT; + } + + /* --- */ + + if( cSubType0 && cSubType0 == '-' ) + { + strcpy( ( char * ) szType0, "AnyType.SubType[NIL]" ); + } + else if( cSubType0 ) + { + sprintf( ( char * ) szType0, "AnyType.SubType[%c]", cSubType0 ); + } + else if( pFunc->pStack[ pFunc->iStackIndex - 2 ] == '-' ) + { + strcpy( ( char * ) szType0, "NIL"); + } + else + { + sprintf( ( char * ) szType0, "%c", pFunc->pStack[ pFunc->iStackIndex - 2 ] ); + } + + /* --- */ + + if( cSubType1 && cSubType1 == '-' ) + { + strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" ); + } + else if( cSubType1 ) + { + sprintf( ( char * ) szType1, "AnyType.SubType[%c]", cSubType1 ); + } + 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]", cSubType2 ); + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) + { + strcpy( ( char * ) szType2, "NIL" ); + } + else + { + sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] ); + } + + /* --- */ + + if( ! cSubType0 ) + { + cSubType0 = pFunc->pStack[ pFunc->iStackIndex - 2 ]; + } + + if( ! cSubType1 ) + { + cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + } + + if( ! cSubType2 ) + { + cSubType2 = pFunc->pStack[ pFunc->iStackIndex ]; + } + + /* --- */ + + if( cSubType0 == 'N' ) + { + /* Ok. */ + } + else if ( cSubType0 == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "UnKnown", "N" ); + } + else + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType0, "N" ); + } + + /* --- */ + + if( cSubType1 == 'N' ) + { + /* Ok. */ + } + else if ( cSubType1 == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "UnKnown", "N" ); + } + else + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType1, "N" ); + } + + /* --- */ + + if( cSubType2 == 'N' ) + { + /* Ok. */ + } + else if ( cSubType2 == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "UnKnown", "N" ); + } + else + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_TYPE, ( char * ) szType2, "N" ); + } + + /* Remove Step. */ + pFunc->iStackIndex--; + + /* Override the last item with Logical */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L'; + + break; + + case HB_P_GREATER : + case HB_P_GREATEREQUAL : + case HB_P_LESSEQUAL : + case HB_P_LESS : + if( pFunc->iStackIndex < 2 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); + } + + if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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_INCOMPATIBLE, ( 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_INCOMPATIBLE, ( 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 : + if( pFunc->iStackIndex < 2 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); + } + if( cSubType1 && cSubType1 == '-' ) + { + sprintf( ( char * ) szType1, "AnyType.SubType[NIL]" ); + } + else if( cSubType1 ) + { + sprintf( ( char * ) szType1, "AnyType.SubType[%c]", cSubType1 ); + } + 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 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cSubType2 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT ); + } + if( cSubType2 && cSubType2 == '-' ) + { + strcpy( ( char * ) szType2, "AnyType.SubType[NIL]" ); + } + else if( cSubType2 ) + { + sprintf( ( char * ) szType2, "AnyType.SubType[%c]", cSubType2 ); + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) + { + strcpy( ( char * ) szType2, "NIL" ); + } + else + { + sprintf( ( char * ) szType2, "%c", pFunc->pStack[ pFunc->iStackIndex ] ); + } + + /*---*/ + + if( ! cSubType1 ) + { + cSubType1 = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + } + + if( ! cSubType2 ) + { + cSubType2 = pFunc->pStack[ pFunc->iStackIndex ]; + } + + if( cSubType1 == '-' || cSubType2 == '-' ) + { + /* Override the last item with the new result type */ + } + else if( cSubType1 == cSubType2 ) + { + /* Override the last item with the new result type */ + } + else if( cSubType1 == ' ' ) + { + 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( cSubType2 == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, ( char * ) szType1, NULL ); + /* Override the last item with the new result type */ + } + else + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERANDS_INCOMPATIBLE, ( char * ) szType1, ( char * ) szType2 ); + /* Override the last item with the new result type */ + } + + /* Override the last item with the new result type */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = 'L'; + + break; + + case HB_P_NOT : + if( pFunc->iStackIndex < 1 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || 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 : + if( pFunc->iStackIndex < 2 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + if( ( pFunc->pStack[ pFunc->iStackIndex - 1 ] == '-' + VT_OFFSET_VARIANT ) || pFunc->pStack[ pFunc->iStackIndex - 1 ] >= 'A' + VT_OFFSET_VARIANT ) + { + cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex - 1 ] -= VT_OFFSET_VARIANT ); + } + + if( ( pFunc->pStack[ pFunc->iStackIndex ] == '-' + VT_OFFSET_VARIANT ) || 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; + + #if 0 + /* Blcoks */ + case HB_P_PUSHBLOCKSHORT : + case HB_P_PUSHBLOCK : + break; + #endif + + case HB_P_ENDBLOCK : + /* Override the last value of the block left on the stack. */ + /* The last value was actualy generated on the pBlock stack, not in parrent. */ + 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_PUSHLONGLONG : + 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); + } + + /*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" ) == 1 ) + { + /*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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + pVar->cType = ' '; + } + + pVar = pVar->pNext; + } + } + + /* + printf( "\nPushed: %s() Type: %c Stack: %i\n", pSym->szName, pFunc->pStack[ pFunc->iStackIndex - 1], pFunc->iStackIndex - 1 ); + */ + } + 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; + } + + pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; + } + } + 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 = ( signed char ) pFunc->pCode[ ulPos + 1 ]; + } + else + { + wVar = HB_PCODE_MKSHORT( &( 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 = pFunc->pStatics; + while( ++wVar < 0 && pVar ) + { + pVar = pVar->pNext; + } + + if ( pVar ) + { + wVar = hb_compVariableGetPos( pTmp->pLocals, pVar->szName ); + pVar = hb_compVariableFind( pTmp->pLocals, wVar ); + } + } + else + { + pVar = hb_compVariableFind( pFunc->pLocals, wVar ); + } + + if( pVar ) + { + if( pFunc->pCode[ ulPos ] == HB_P_PUSHLOCALREF ) + { + pVar->iUsed |= VU_INITIALIZED; + } + else if( ! ( pVar->iUsed & VU_INITIALIZED ) ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL ); + } + + /* + printf( "\nUsed: %s\n", pVar->szName ); + */ + + /* Mark as used */ + pVar->iUsed |= VU_USED; + + if( pVar->cType == ( '-' + VT_OFFSET_VARIANT ) || 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 + { + /* + printf( "\nCould not find Local %i in: $s\n", wVar, pFunc->szName ); + */ + + 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + + 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 == ( '-' + VT_OFFSET_VARIANT ) || 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); + + 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( HB_PCODE_MKUSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ) ); + + 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 ); + /* May have been initialized in any other function - can't check. */ + pVar->iUsed |= VU_INITIALIZED; + } + } + } + + if( pVar ) + { + cType = pVar->cType; + + /*printf( "\nPushed: %s Type: %c SubType: %c\n", pVar->szName, pVar->cType, pVar->cType - 100 );*/ + + if( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVARREF ) + { + pVar->iUsed |= VU_INITIALIZED; + } + else if( ! ( pVar->iUsed & VU_INITIALIZED ) ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL ); + } + + if( cType == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + + 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + + /* TODO Error Message after finalizing all possible pcodes. */ + if( pFunc->iStackIndex < wVar ) + { + pFunc->iStackIndex = 1; + pFunc->pStack[ 0 ] = 'A'; + break; + } + + /* Pop the Elements. */ + pFunc->iStackIndex -= wVar; + + /* Push the array. */ + pFunc->pStack[ pFunc->iStackIndex++ ] = 'A'; + break; + + case HB_P_ARRAYPUSH : + if( pFunc->iStackIndex < 1 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + /* Poping the Array Index. */ + pFunc->iStackIndex--; + + cType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + + /*printf( "\n Base Type: %c\n", cType );*/ + + if( cType == ( '-' + VT_OFFSET_VARIANT ) || cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cType -= VT_OFFSET_VARIANT; + } + + if( cType == ' ' ) + { + /* Type unknown. */ + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "A", NULL ); + pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; + } + else if( cType == 'A' ) + { + /* Variant Array Element - Type unknown. */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; + } + else if( cType == 'a' ) + { + /* Variant Array Element - Type unknown. */ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; + } + else if( islower( cType ) ) + { + /* Now we have the declared array element on the stack.*/ + pFunc->pStack[ pFunc->iStackIndex - 1 ] = toupper( cType ); + } + else + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_ARRAY, NULL, NULL ); + } + break; + + case HB_P_ARRAYPOP : + if( pFunc->iStackIndex < 3 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + /* Poping the Array Index. */ + pFunc->iStackIndex--; + + { + BYTE cElementType = pFunc->pStack[ pFunc->iStackIndex - 2 ]; + + cType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + + if( cType == ( '-' + VT_OFFSET_VARIANT ) || cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cType -= VT_OFFSET_VARIANT; + } + + if( cElementType == ( '-' + VT_OFFSET_VARIANT ) || cElementType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + cElementType -= VT_OFFSET_VARIANT; + } + + if( cType == ' ' ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_OPERAND_SUSPECT, "A", NULL ); + } + else if( cType == 'A' ) + { + /* Array of variant can hold any value. */ + } + else if( cType == 'a' ) + { + /* Array of variant can hold any value. */ + } + else if( islower( cType ) && cElementType == ' ' ) + { + /* Array Of explicit type. */ + char szType[2]; + + sprintf( ( char * ) szType, "%c", toupper( cType ) ); + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, ( char * ) szType, NULL ); + } + else if( islower( cType ) && toupper( cType ) != cElementType && cElementType != '-' ) + { + /* Array Of explicit type. */ + char szType[2]; + + sprintf( ( char * ) szType, "%c", toupper( cType ) ); + 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 < 1 ) + /* 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 < 1 ) + /* 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 = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + 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 : + if( pFunc->iStackIndex < 1 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + if( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR ) + wVar = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + + 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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + { + pVar->cType = ' '; + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || pSym->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + { + pSym->cType = ' '; + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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 : + /* TODO Error Message after finalizing all possible pcodes. */ + if( pFunc->iStackIndex < 1 ) + { + fprintf( hb_comp_errFile, "Oops - Stack: %i\n", pFunc->iStackIndex ); + break; + } + + pFunc->iStackIndex--; + + if( pFunc->pCode[ ulPos ] == HB_P_POPLOCAL ) + { + wVar = HB_PCODE_MKSHORT( &( 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 = pFunc->pStatics; + while( ++wVar < 0 && pVar ) + { + pVar = pVar->pNext; + } + + if ( pVar ) + { + wVar = hb_compVariableGetPos( pTmp->pLocals, pVar->szName ); + 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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + { + pVar->cType = ' '; + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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 : + if( pFunc->iStackIndex < 1 ) + /* TODO Error Message after finalizing all possible pcodes. */ + break; + + pFunc->iStackIndex--; + + pTmp = hb_comp_functions.pFirst; + wVar = HB_PCODE_MKSHORT( &( pFunc->pCode[ ulPos + 1 ] ) ); + + 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 == ( '-' + VT_OFFSET_VARIANT ) || pVar->cType >= ( 'A' + VT_OFFSET_VARIANT ) ) + { + if( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + { + pVar->cType = ' '; + } + else if( pFunc->pStack[ pFunc->iStackIndex ] == ( '-' + VT_OFFSET_VARIANT ) || 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 == ( '-' + VT_OFFSET_VARIANT ) || 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 ] == ( '-' + VT_OFFSET_VARIANT ) || 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; + + case HB_P_SEQRECOVER : + /* TODO: find type of BREAK() */ + pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; + break; + } + + /* TODO Error or trace messages when completed. */ + if( pFunc->iStackIndex < 0 ) + { + fprintf( hb_comp_errFile, "\nStrongType Stack underflow!\n" ); + pFunc->iStackIndex = 0; + } +} +#endif /* ifdefined(HB_COMP_STRONG_TYPES) */ + diff --git a/harbour/source/macro/macro.l b/harbour/source/macro/macro.l index 323dc96a0d..00e23f2197 100644 --- a/harbour/source/macro/macro.l +++ b/harbour/source/macro/macro.l @@ -86,8 +86,10 @@ NOTE: -C controls the speed/size ratio of generated scanner #define alloca hb_xgrab #undef malloc #define malloc hb_xgrab +#undef realloc +#define realloc hb_xrealloc #undef free -#define free hb_xfree +#define free hb_xfree /* declaration of yylex function diff --git a/harbour/source/macro/macro.y b/harbour/source/macro/macro.y index 2871b123c0..2a9b1b60ad 100644 --- a/harbour/source/macro/macro.y +++ b/harbour/source/macro/macro.y @@ -74,8 +74,16 @@ #define alloca hb_xgrab #undef malloc #define malloc hb_xgrab +#undef realloc +#define realloc hb_xrealloc #undef free -#define free hb_xfree +#define free hb_xfree + +#undef YYFREE +#define YYFREE hb_xfree +#undef YYMALLOC +#define YYMALLOC hb_xgrab + /* This is workaround of yyparse() declaration bug in bison.simple */ diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 203717ea40..f83db0174f 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -2015,8 +2015,16 @@ static void hb_vmAddInt( HB_ITEM_PTR pResult, int iAdd ) { PHB_ITEM pSubst, pAdd = hb_stackTopItem(); - hb_vmPushInteger( iAdd ); - pSubst = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+", 2, pResult, pAdd ); + if( iAdd > 0 ) + { + hb_vmPushInteger( iAdd ); + pSubst = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+", 2, pResult, pAdd ); + } + else + { + hb_vmPushInteger( -iAdd ); + pSubst = hb_errRT_BASE_Subst( EG_ARG, 1082, NULL, "-", 2, pResult, pAdd ); + } if( pSubst ) { @@ -6938,7 +6946,7 @@ HB_EXPORT BOOL hb_xvmArrayPush( void ) HB_EXPORT BOOL hb_xvmArrayItemPush( ULONG ulIndex ) { - HB_TRACE(HB_TR_DEBUG, ("hb_xvmArrayPush(%lu)", ulIndex)); + HB_TRACE(HB_TR_DEBUG, ("hb_xvmArrayItemPush(%lu)", ulIndex)); hb_vmArrayItemPush( ulIndex ); @@ -6956,7 +6964,7 @@ HB_EXPORT BOOL hb_xvmArrayPop( void ) HB_EXPORT BOOL hb_xvmArrayItemPop( ULONG ulIndex ) { - HB_TRACE(HB_TR_DEBUG, ("hb_xvmArrayPop(%lu)", ulIndex)); + HB_TRACE(HB_TR_DEBUG, ("hb_xvmArrayItemPop(%lu)", ulIndex)); hb_vmArrayItemPop( ulIndex );