From 196044b21f35f5bd27ad5be23cd271d8ef1ae1af Mon Sep 17 00:00:00 2001 From: Ron Pinkas Date: Mon, 7 May 2001 18:45:55 +0000 Subject: [PATCH] 2001-05-07 11:40 UTC-0800 Ron Pinkas * include/hbclass.ch ! Added missing parameter to declaration of AddMultiData() * source/compiler/harbour.c ! Corrected broken Linked-List links in hb_compDeclaredInit() * source/compiler/hbpcode.c * Minor correction declared parameters checking. * source/vm/hvm.c + Added complete call stack display to hb_vmRequestCancel() /* Cancelling will now show the complete call stack, rather than the not very helpful just current procedure. */ --- harbour/ChangeLog | 18 +++++++- harbour/include/hbclass.ch | 2 +- harbour/source/compiler/harbour.c | 6 +-- harbour/source/compiler/hbpcode.c | 76 ++++++++++++++++++++++++++++--- harbour/source/vm/arrays.c | 2 + harbour/source/vm/hvm.c | 31 ++++++++++++- 6 files changed, 121 insertions(+), 14 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 7faca80ca5..07df40d4d4 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,11 +1,25 @@ +2001-05-07 11:40 UTC-0800 Ron Pinkas + * include/hbclass.ch + ! Added missing parameter to declaration of AddMultiData() + + * source/compiler/harbour.c + ! Corrected broken Linked-List links in hb_compDeclaredInit() + + * source/compiler/hbpcode.c + * Minor correction declared parameters checking. + + * source/vm/hvm.c + + Added complete call stack display to hb_vmRequestCancel() + /* Cancelling will now show the complete call stack, rather than the not very helpful just current procedure. */ + 2001-05-06 20:30 CET Martin Vogel + contrib/libct/token1.c ! ATTOKEN() function ! New 4th parameter ! - ! TOKEN() function + ! TOKEN() function ! New 5th and 6th parameter and ! - ! NUMTOKEN() function + ! NUMTOKEN() function ! TOKENLOWER() function ! TOKENUPPER() function ! TOKENSEP() function diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index 25768a2ec8..062f54d764 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -103,7 +103,7 @@ DECLARE TClass ; Instance() AS Object ; AddClsMthds( cName AS String, @MethodName(), nScope AS Numeric, n2 AS Numeric, n3 AS Numeric ); AddMultiClsData( cType AS String, uVal, nScope AS Numeric, aDatas AS Array OF String ); - AddMultiData( cType AS String, uVal, nScope AS Numeric, aDatas AS Array OF String ); + AddMultiData( cType AS String, uVal, nScope AS Numeric, aDatas AS Array OF String, x AS LOGICAL ); AddMethod( cName AS String, @MethodName(), nScope AS Numeric ); AddInLine( cName AS String, bBlock AS CodeBlock, nScope AS Numeric ); AddVirtual( cName AS String ) diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index 0e913d5f31..9f66f379d9 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -933,9 +933,9 @@ void hb_compDeclaredInit( void ) /* -------------------------------------------------- Standard Classes --------------------------------------------------- */ static COMCLASS s_ERROR = { "ERROR" , NULL, NULL, NULL }; - static COMCLASS s_GET = { "GET" , NULL, NULL, NULL }; - static COMCLASS s_TBCOLUMN = { "TBCOLUMN", NULL, NULL, NULL }; - static COMCLASS s_TBROWSE = { "TBROWSE" , NULL, NULL, NULL }; + static COMCLASS s_GET = { "GET" , NULL, NULL, &s_ERROR }; + static COMCLASS s_TBCOLUMN = { "TBCOLUMN", NULL, NULL, &s_GET }; + static COMCLASS s_TBROWSE = { "TBROWSE" , NULL, NULL, &s_TBCOLUMN }; /* Name Ret # of Prams Param Types Ret Class Param Classes Next --------------- --- ---------- -------------------- --------- ------------- --------------- */ diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index a76a53fbd6..6162df7306 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -726,11 +726,13 @@ void hb_compStrongType( int iSize ) cFormalType = '@'; if( cFormalType == ' ' ) - ; /* Declared is Variant, accept anything. */ + ; /* 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 ) ) - ; /* Prameter is ANY REFERENCE, and Parameter is SOME REFERENCE. */ + ; /* 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 ]; @@ -755,6 +757,50 @@ void hb_compStrongType( int iSize ) 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' ) @@ -769,15 +815,33 @@ void hb_compStrongType( int iSize ) } else { - if( toupper( pFunc->pStack[ iParamBase + iOffset ] ) == 'S' && pFunc->iStackClasses ) - --pFunc->iStackClasses ; - else if( cFormalType > ( 'A' + VT_OFFSET_BYREF ) ) + 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 ); } - sprintf( ( char * ) szType1, "%i", iOffset + 1 ); + 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 ); } diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 39801b7ead..e2f27fae77 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -61,6 +61,8 @@ * * Copyright 2001 Ron Pinkas * hb_arrayClone() + * hb_arrayFromStack() + * hb_arrayfromParams() * * See doc/license.txt for licensing terms. * diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 5211fc61f1..a549128633 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -2880,7 +2880,7 @@ void hb_vmDo( USHORT uiParams ) * - generate unrecoverable runtime error */ PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pSym->szName, 1, pArgsArray ); + hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, 1, pArgsArray ); hb_itemRelease( pArgsArray ); } } @@ -4283,13 +4283,40 @@ void hb_vmRequestCancel( void ) if( hb_set.HB_SET_CANCEL ) { - char buffer[ HB_SYMBOL_NAME_LEN + 32 ]; + char buffer[ HB_SYMBOL_NAME_LEN + HB_SYMBOL_NAME_LEN + 2 ]; + int i = 1, i2; + unsigned long ulLine; + PHB_ITEM * pBase; hb_conOutErr( hb_conNewLine(), 0 ); sprintf( buffer, "Cancelled at: %s (%i)", ( hb_stackBaseItem() )->item.asSymbol.value->szName, ( hb_stackBaseItem() )->item.asSymbol.lineno ); hb_conOutErr( buffer, 0 ); hb_conOutErr( hb_conNewLine(), 0 ); + while ( buffer[0] ) + { + i2 = i; + hb_procname( i++, buffer ); + + if( buffer[0] == 0 ) + break; + + pBase = hb_stack.pBase; + while( ( i2-- > 0 ) && pBase != hb_stack.pItems ) + pBase = hb_stack.pItems + ( *pBase )->item.asSymbol.stackbase; + + if( i2 == -1 ) + ulLine = ( *pBase )->item.asSymbol.lineno; + else + ulLine = 0; + + i2 = strlen( (char *) buffer ); + sprintf( buffer + i2, " (%i)", ulLine ); + + hb_conOutErr( buffer, 0 ); + hb_conOutErr( hb_conNewLine(), 0 ); + } + s_uiActionRequest = HB_QUIT_REQUESTED; } }