From 65d8bc126569ae2207ad3c5d052e0ca4e19241d3 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Tue, 18 Jul 2006 19:28:34 +0000 Subject: [PATCH] 2006-07-18 21:26 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/vm/hvm.c ! fixed executing EXIT procedures after external to BEGIN SEQUENCE / END BREAK - now by default we are taking the same action as after QUIT what seems to be intention of Clipper authors. When HVM is compiled with HB_C52_STRICT macro then we will try to emulate real Clipper behavior. * harbour/include/hbapi.h * harbour/source/vm/itemapi.c + added single member to hb_struPointer structure for internal HVM use. The reference counter for GC collectible HB_IT_POINTER items which have 'single' member set to TRUE is not updated in hb_itemCopy(). * harbour/source/rdd/workarea.c * code cleanup --- harbour/ChangeLog | 17 ++++++++++ harbour/include/hbapi.h | 1 + harbour/source/rdd/workarea.c | 61 +++++++++++++++++++---------------- harbour/source/vm/hvm.c | 24 ++++++++++++-- harbour/source/vm/itemapi.c | 11 +++++-- 5 files changed, 81 insertions(+), 33 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b0285cfe48..92715970c4 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,23 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + * new file to test preprocessor Preprocess both with Clipper + and harbour and next use diff utility to compare outputs - + ignore the number of white spaces (use diff -w -u ...) + + +2006-07-18 21:26 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/vm/hvm.c + + BREAK - now by default we are taking the same action as after QUIT + what seems to be intention of Clipper authors. When HVM is compiled + with HB_C52_STRICT macro then we will try to emulate real Clipper + behavior. + + * harbour/include/hbapi.h + * harbour/source/vm/itemapi.c + + added single member to hb_struPointer structure for internal HVM use. + The reference counter for GC collectible HB_IT_POINTER items which have 'single' member set to TRUE is not updated in hb_itemCopy(). * harbour/source/rdd/workarea.c diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index e84c4cd798..8a04b8181d 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -273,6 +273,7 @@ struct hb_struPointer { void * value; BOOL collect; + BOOL single; }; struct hb_struMemvar diff --git a/harbour/source/rdd/workarea.c b/harbour/source/rdd/workarea.c index 49b8a1eca6..51b03484ad 100644 --- a/harbour/source/rdd/workarea.c +++ b/harbour/source/rdd/workarea.c @@ -127,8 +127,10 @@ ERRCODE hb_waSkip( AREAP pArea, LONG lToSkip ) } while( lToSkip-- > 0 ) { - SELF_SKIPRAW( pArea, lSkip ); - SELF_SKIPFILTER( pArea, lSkip ); + if( SELF_SKIPRAW( pArea, lSkip ) != SUCCESS ) + return FAILURE; + if( SELF_SKIPFILTER( pArea, lSkip ) != SUCCESS ) + return FAILURE; if( pArea->fBof || pArea->fEof ) break; } @@ -166,15 +168,16 @@ ERRCODE hb_waSkipFilter( AREAP pArea, LONG lUpDown ) /* remember if we are here after SLEF_GOTOP() */ fBottom = pArea->fBottom; - while ( !pArea->fBof && !pArea->fEof ) + while( !pArea->fBof && !pArea->fEof ) { /* SET DELETED */ if( hb_set.HB_SET_DELETED ) { - SELF_DELETED( pArea, &fDeleted ); + if( SELF_DELETED( pArea, &fDeleted ) != SUCCESS ) + return FAILURE; if( fDeleted ) { - if ( SELF_SKIPRAW( pArea, lUpDown ) != SUCCESS ) + if( SELF_SKIPRAW( pArea, lUpDown ) != SUCCESS ) return FAILURE; continue; } @@ -186,7 +189,7 @@ ERRCODE hb_waSkipFilter( AREAP pArea, LONG lUpDown ) pResult = hb_vmEvalBlock( pArea->dbfi.itmCobExpr ); if( HB_IS_LOGICAL( pResult ) && !hb_itemGetL( pResult ) ) { - if ( SELF_SKIPRAW( pArea, lUpDown ) != SUCCESS ) + if( SELF_SKIPRAW( pArea, lUpDown ) != SUCCESS ) return FAILURE; continue; } @@ -275,7 +278,8 @@ ERRCODE hb_waCreateFields( AREAP pArea, PHB_ITEM pStruct ) HB_TRACE(HB_TR_DEBUG, ("hb_waCreateFields(%p, %p)", pArea, pStruct)); uiItems = ( USHORT ) hb_arrayLen( pStruct ); - SELF_SETFIELDEXTENT( pArea, uiItems ); + if( SELF_SETFIELDEXTENT( pArea, uiItems ) != SUCCESS ) + return FAILURE; for( uiCount = 0; uiCount < uiItems; uiCount++ ) { @@ -365,7 +369,7 @@ ERRCODE hb_waCreateFields( AREAP pArea, PHB_ITEM pStruct ) return FAILURE; } /* Add field */ - if( SELF_ADDFIELD( pArea, &pFieldInfo ) == FAILURE ) + if( SELF_ADDFIELD( pArea, &pFieldInfo ) != SUCCESS ) return FAILURE; } return SUCCESS; @@ -849,7 +853,7 @@ ERRCODE hb_waEval( AREAP pArea, LPDBEVALINFO pEvalInfo ) if( pEvalInfo->dbsci.itmRecID ) { - if( SELF_GOTOID( pArea, pEvalInfo->dbsci.itmRecID ) == FAILURE ) + if( SELF_GOTOID( pArea, pEvalInfo->dbsci.itmRecID ) != SUCCESS ) return FAILURE; } else if( pEvalInfo->dbsci.lNext ) @@ -859,7 +863,7 @@ ERRCODE hb_waEval( AREAP pArea, LPDBEVALINFO pEvalInfo ) else if( !pEvalInfo->dbsci.itmCobWhile && !hb_itemGetL( pEvalInfo->dbsci.fRest ) ) { - if( SELF_GOTOP( pArea ) == FAILURE ) + if( SELF_GOTOP( pArea ) != SUCCESS ) return FAILURE; } @@ -869,7 +873,7 @@ ERRCODE hb_waEval( AREAP pArea, LPDBEVALINFO pEvalInfo ) { while( TRUE ) { - if( SELF_EOF( pArea, &fEof ) == FAILURE ) + if( SELF_EOF( pArea, &fEof ) != SUCCESS ) return FAILURE; if( fEof ) @@ -886,7 +890,7 @@ ERRCODE hb_waEval( AREAP pArea, LPDBEVALINFO pEvalInfo ) if( pEvalInfo->dbsci.itmRecID || ( pEvalInfo->dbsci.lNext && --lNext < 1 ) ) break; - if( SELF_SKIP( pArea, 1 ) == FAILURE ) + if( SELF_SKIP( pArea, 1 ) != SUCCESS ) return FAILURE; } } @@ -909,12 +913,12 @@ ERRCODE hb_waLocate( AREAP pArea, BOOL fContinue ) if( ! pArea->dbsi.itmCobFor ) return SUCCESS; - if ( SELF_SKIP( pArea, 1 ) == FAILURE ) + if( SELF_SKIP( pArea, 1 ) != SUCCESS ) return FAILURE; } else if( pArea->dbsi.itmRecID ) { - if( SELF_GOTOID( pArea, pArea->dbsi.itmRecID ) == FAILURE ) + if( SELF_GOTOID( pArea, pArea->dbsi.itmRecID ) != SUCCESS ) return FAILURE; } else if( pArea->dbsi.lNext ) @@ -924,7 +928,7 @@ ERRCODE hb_waLocate( AREAP pArea, BOOL fContinue ) else if( !pArea->dbsi.itmCobWhile && !hb_itemGetL( pArea->dbsi.fRest ) ) { - if( SELF_GOTOP( pArea ) == FAILURE ) + if( SELF_GOTOP( pArea ) != SUCCESS ) return FAILURE; } @@ -936,7 +940,7 @@ ERRCODE hb_waLocate( AREAP pArea, BOOL fContinue ) { while( TRUE ) { - if( SELF_EOF( pArea, &fEof ) == FAILURE ) + if( SELF_EOF( pArea, &fEof ) != SUCCESS ) return FAILURE; if( fEof ) @@ -957,7 +961,7 @@ ERRCODE hb_waLocate( AREAP pArea, BOOL fContinue ) ( pArea->dbsi.itmRecID || ( pArea->dbsi.lNext && --lNext < 1 ) ) ) break; - if( SELF_SKIP( pArea, 1 ) == FAILURE ) + if( SELF_SKIP( pArea, 1 ) != SUCCESS ) return FAILURE; } } @@ -977,7 +981,7 @@ ERRCODE hb_waTrans( AREAP pArea, LPDBTRANSINFO pTransInfo ) if( pTransInfo->dbsci.itmRecID ) { - if( SELF_GOTOID( pArea, pTransInfo->dbsci.itmRecID ) == FAILURE ) + if( SELF_GOTOID( pArea, pTransInfo->dbsci.itmRecID ) != SUCCESS ) return FAILURE; } else if( pTransInfo->dbsci.lNext ) @@ -987,7 +991,7 @@ ERRCODE hb_waTrans( AREAP pArea, LPDBTRANSINFO pTransInfo ) else if( !pTransInfo->dbsci.itmCobWhile && !hb_itemGetL( pTransInfo->dbsci.fRest ) ) { - if( SELF_GOTOP( pArea ) == FAILURE ) + if( SELF_GOTOP( pArea ) != SUCCESS ) return FAILURE; } @@ -997,7 +1001,7 @@ ERRCODE hb_waTrans( AREAP pArea, LPDBTRANSINFO pTransInfo ) { while( TRUE ) { - if( SELF_EOF( pArea, &fEof ) == FAILURE ) + if( SELF_EOF( pArea, &fEof ) != SUCCESS ) return FAILURE; if( fEof ) @@ -1010,14 +1014,14 @@ ERRCODE hb_waTrans( AREAP pArea, LPDBTRANSINFO pTransInfo ) if( ! pTransInfo->dbsci.itmCobFor || hb_itemGetL( hb_vmEvalBlock( pTransInfo->dbsci.itmCobFor ) ) ) { - if( SELF_TRANSREC( pArea, pTransInfo ) == FAILURE ) + if( SELF_TRANSREC( pArea, pTransInfo ) != SUCCESS ) return FAILURE; } if( pTransInfo->dbsci.itmRecID || ( pTransInfo->dbsci.lNext && --lNext < 1 ) ) break; - if( SELF_SKIP( pArea, 1 ) == FAILURE ) + if( SELF_SKIP( pArea, 1 ) != SUCCESS ) return FAILURE; } } @@ -1144,7 +1148,8 @@ ERRCODE hb_waSyncChildren( AREAP pArea ) lpdbRelation = pArea->lpdbRelations; while( lpdbRelation ) { - SELF_CHILDSYNC( lpdbRelation->lpaChild, lpdbRelation ); + if( SELF_CHILDSYNC( lpdbRelation->lpaChild, lpdbRelation ) != SUCCESS ) + return FAILURE; lpdbRelation = lpdbRelation->lpdbriNext; } @@ -1334,9 +1339,7 @@ ERRCODE hb_waSetRel( AREAP pArea, LPDBRELINFO lpdbRelInf ) lpdbRelations->abKey = lpdbRelInf->abKey; lpdbRelations->lpdbriNext = lpdbRelInf->lpdbriNext; - SELF_CHILDSTART( ( AREAP ) lpdbRelInf->lpaChild, lpdbRelations ); - - return SUCCESS; + return SELF_CHILDSTART( ( AREAP ) lpdbRelInf->lpaChild, lpdbRelations ); } /* @@ -1430,7 +1433,8 @@ ERRCODE hb_waSetFilter( AREAP pArea, LPDBFILTERINFO pFilterInfo ) HB_TRACE(HB_TR_DEBUG, ("hb_waSetFilter(%p, %p)", pArea, pFilterInfo)); /* Clear the active filter expression */ - SELF_CLEARFILTER( pArea ); + if( SELF_CLEARFILTER( pArea ) != SUCCESS ) + return FAILURE; if( pFilterInfo->itmCobExpr ) { @@ -1454,7 +1458,8 @@ ERRCODE hb_waSetLocate( AREAP pArea, LPDBSCOPEINFO pScopeInfo ) HB_TRACE(HB_TR_DEBUG, ("hb_waSetLocate(%p, %p)", pArea, pScopeInfo)); /* Clear the active locate expression */ - SELF_CLEARLOCATE( pArea ); + if( SELF_CLEARLOCATE( pArea ) != SUCCESS ) + return FAILURE; if( pScopeInfo->itmCobFor ) pArea->dbsi.itmCobFor = hb_itemNew( pScopeInfo->itmCobFor ); diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 93a320662e..bd26466a44 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -5953,12 +5953,30 @@ void hb_vmRequestBreak( PHB_ITEM pItem ) s_uiActionRequest = HB_BREAK_REQUESTED; } else + { +#ifdef HB_C52_STRICT /* - * do not call hb_vmRequestQuit() - * Clipper does not execute EXIT procedures now but after leaving all - * functions + * do not execute EXIT procedures to be as close as possible + * buggy Clipper behavior. [druzus] */ + s_fDoExitProc = FALSE; s_uiActionRequest = HB_QUIT_REQUESTED; +#else + /* + * Clipper has a bug here. Tests shows that it set exception flag + * and then tries to execute EXIT procedures so the first one is + * immediately interrupted. Because Clipper does not check the + * exception flag often enough then it's possible to execute one + * function from first EXIT PROC. Using small trick with + * QOUT( TYPE( cPrivateVar ) ) in the EXIT procedure (TYPE() is + * not normal function) we can also check that it tries to execute + * EXIT procedures exactly here before leave current function. + * So to be as close as possible the Clipper intentional behavior + * we execute hb_vmRequestQuit() here. [druzus] + */ + hb_vmRequestQuit(); +#endif + } } USHORT hb_vmRequestQuery( void ) diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index aabc7b3474..30ed42d627 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -1096,7 +1096,8 @@ HB_EXPORT PHB_ITEM hb_itemPutPtr( PHB_ITEM pItem, void * pValue ) pItem->type = HB_IT_POINTER; pItem->item.asPointer.value = pValue; - pItem->item.asPointer.collect = FALSE; + pItem->item.asPointer.collect = + pItem->item.asPointer.single = FALSE; return pItem; } @@ -1116,6 +1117,7 @@ HB_EXPORT PHB_ITEM hb_itemPutPtrGC( PHB_ITEM pItem, void * pValue ) pItem->type = HB_IT_POINTER; pItem->item.asPointer.value = pValue; pItem->item.asPointer.collect = TRUE; + pItem->item.asPointer.single = FALSE; return pItem; } @@ -1328,7 +1330,12 @@ HB_EXPORT void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) else if( HB_IS_POINTER( pSource ) ) { if( pSource->item.asPointer.collect ) - hb_gcRefInc( pSource->item.asPointer.value ); + { + if( pSource->item.asPointer.single ) + pDest->item.asPointer.collect = FALSE; + else + hb_gcRefInc( pSource->item.asPointer.value ); + } } } }