fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2006-07-18 21:26 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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
This commit is contained in:
Przemyslaw Czerpak
2006-07-18 19:28:34 +00:00
parent bd29875021
commit 65d8bc1265
5 changed files with 81 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
harbour/ChangeLog
View File

@@ -8,6 +8,23 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* 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

1
harbour/include/hbapi.h
View File

@@ -273,6 +273,7 @@ struct hb_struPointer
{
void * value;
BOOL collect;
BOOL single;
};
struct hb_struMemvar

61
harbour/source/rdd/workarea.c
View File

@@ -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 );

24
harbour/source/vm/hvm.c
View File

@@ -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 )

11
harbour/source/vm/itemapi.c
View File

@@ -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 );
}
}
}
}