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

2006-09-28 00:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/make_rpm.sh
    * check for rpmbuild also when BUGGY_RPM is set

  * harbour/make_tgz.sh
    * removed rebuild hbpptest with shared libraries

  * harbour/include/hbapicls.h
    + added definitions for hb_clsCreate(), hb_clsAdd(), hb_clsAssociate()

  * harbour/include/hbapierr.h
  * harbour/source/rtl/errorapi.c
    + added hb_errFuncName - pseudo function name which can be used as
      operation description in new error object. It should help to simplify
      some code and fix function names when RT error is generated from C
      function which can be executed from different .prg functions.

  * harbour/include/hbclass.ch
    + added some missing Classy(y) compatible object variable type
      descriptions: Int, Integer, Block

  * harbour/source/rdd/dbfcdx/dbfcdx1.c
    ! disabled early retrieving from the cache key position and key count

  * harbour/include/hbvm.h
  * harbour/source/vm/hvm.c
    + added: void hb_vmPushEvalSym( void ) for the code which do not
      want to access any [P]HB_SYMB structures
    * changed symbol name in hb_symEval from __EVAL to EVAL and modified
      hb_symEval registration method to not register hb_vmDoBlock as global
      function. Having PHB_DYNS address for "EVAL" in hb_symEval.pDynSym
      allows to eliminate some strcmp() when we are looking for EVAL public
      symbol.
    ! fixed symbol table updating in PCODE functions for future multi module
      .hrb files

  * harbour/source/vm/proc.c
    * use hb_symEval.pDynSym instead of strcmp()

  * harbour/source/vm/arrays.c
  * harbour/source/vm/debug.c
    * minor code cleanup

  * harbour/source/rtl/tclass.prg
  * harbour/source/vm/classes.c
    % separate message hash table from methods table - it will cause farther
      reduction of allocated memory - many thanks to all people who send
      me statistics about number of used classes and symbols from their code.
    % use hb_symEval.pDynSym
    + added support for object variable type scope checking like in Class(y).
    ! fixed typo in pushing object class variables by reference
    % s_pClasses is now indexed directly by class handle
    % some other optimiztions
    ! make hidden and non virtual invisible in child classes if it overloaded
      some other non hidden method. In such case the overloaded method is used
      and can be accessed.
    ! make friend functions real method class oriented not (super)object for
      hidden messages
This commit is contained in:
Przemyslaw Czerpak
2006-09-27 22:39:06 +00:00
parent 5ba81a153a
commit 9aaaadbc6f
15 changed files with 1246 additions and 701 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
harbour/ChangeLog
View File

@@ -8,6 +8,65 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* harbour/include/hbextern.ch
- removed __CLS_PARAM()
* harbour/include/hbclass.ch
* harbour/source/rtl/tclass.prg
* harbour/source/vm/classes.c
* replaced __CLS_PAR00() and __CLS_PARAM() functions by preprocessor
rules. These functions are not longer necessary though I left them
in classes.c for backward binary compatibility. Probably they will
be removed in the future.
! use function pointers (@<funcname>()) instead of function names
with REQUEST for super classes ID. It fixes using STATIC class
functions.
2006-09-28 00:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/make_rpm.sh
* check for rpmbuild also when BUGGY_RPM is set
* harbour/make_tgz.sh
* removed rebuild hbpptest with shared libraries
* harbour/include/hbapicls.h
+ added definitions for hb_clsCreate(), hb_clsAdd(), hb_clsAssociate()
* harbour/include/hbapierr.h
* harbour/source/rtl/errorapi.c
+ added hb_errFuncName - pseudo function name which can be used as
operation description in new error object. It should help to simplify
some code and fix function names when RT error is generated from C
function which can be executed from different .prg functions.
* harbour/include/hbclass.ch
+ added some missing Classy(y) compatible object variable type
descriptions: Int, Integer, Block
* harbour/source/rdd/dbfcdx/dbfcdx1.c
! disabled early retrieving from the cache key position and key count
* harbour/include/hbvm.h
* harbour/source/vm/hvm.c
+ added: void hb_vmPushEvalSym( void ) for the code which do not
want to access any [P]HB_SYMB structures
* changed symbol name in hb_symEval from __EVAL to EVAL and modified
hb_symEval registration method to not register hb_vmDoBlock as global
function. Having PHB_DYNS address for "EVAL" in hb_symEval.pDynSym
allows to eliminate some strcmp() when we are looking for EVAL public
symbol.
! fixed symbol table updating in PCODE functions for future multi module
.hrb files
* harbour/source/vm/proc.c
* use hb_symEval.pDynSym instead of strcmp()
* harbour/source/vm/arrays.c
* harbour/source/vm/debug.c
* minor code cleanup
* harbour/source/rtl/tclass.prg
* harbour/source/vm/classes.c
% separate message hash table from methods table - it will cause farther
reduction of allocated memory - many thanks to all people who send
me statistics about number of used classes and symbols from their code.

9
harbour/include/hbapicls.h
View File

@@ -122,6 +122,15 @@ HB_EXPORT extern BOOL hb_objHasMessage( PHB_ITEM pObject, PHB_DYNS pMessag
HB_EXPORT extern void hb_objSendMsg( PHB_ITEM pObj, char *sMsg, ULONG ulArg, ... );
HB_EXPORT extern void hb_objSendMessage( PHB_ITEM pObj, PHB_DYNS pMessage, ULONG ulArg, ... );
/* Harbour equivalent for Clipper internal __mdCreate() */
USHORT hb_clsCreate( USHORT usSize, char * szClassName );
/* Harbour equivalent for Clipper internal __mdAdd() */
void hb_clsAdd( USHORT usClassH, char * szMethodName, PHB_FUNC pFuncPtr );
/* Harbour equivalent for Clipper internal __mdAssociate() */
void hb_clsAssociate( USHORT usClassH );
HB_EXTERN_END
#endif /* HB_APICLS_H_ */

3
harbour/include/hbapierr.h
View File

@@ -96,6 +96,9 @@ HB_EXTERN_BEGIN
#define HB_ERR_ARGS_BASEPARAMS 0xFFFFFFFF
#define HB_ERR_ARGS_SELFPARAMS 0xFFFFFFFE
/* pseudo function name in operation description */
extern char hb_errFuncName;
/* Standard API */
extern char * hb_errGetDescription ( PHB_ITEM pError );

7
harbour/include/hbclass.ch
View File

@@ -148,8 +148,11 @@ DECLARE HBClass ;
/* CLASSY SYNTAX */
#IFDEF HB_CLS_CSY
#xtranslate CREATE CLASS => CLASS
#xtranslate _HB_MEMBER {AS Num => _HB_MEMBER {AS Numeric
#xtranslate _HB_MEMBER {AS Char => _HB_MEMBER {AS Character
#xtranslate _HB_MEMBER {AS Int => _HB_MEMBER {AS Numeric
#xtranslate _HB_MEMBER {AS Integer => _HB_MEMBER {AS Numeric
#xtranslate _HB_MEMBER {AS Num => _HB_MEMBER {AS Numeric
#xtranslate _HB_MEMBER {AS Char => _HB_MEMBER {AS Character
#xtranslate _HB_MEMBER {AS Block => _HB_MEMBER {AS CodeBlock
#translate @:<MessageName>([<MsgParams,...>]) => ;
::realclass:<MessageName>([<MsgParams>])

1
harbour/include/hbvm.h
View File

@@ -141,6 +141,7 @@ extern HB_EXPORT void hb_vmPushStringPcode( char * szText, ULONG length );
extern HB_EXPORT void hb_vmPushDate( long lDate ); /* pushes a long date onto the stack */
extern HB_EXPORT void hb_vmPushSymbol( PHB_SYMB pSym ); /* pushes a function pointer onto the stack */
extern HB_EXPORT void hb_vmPushDynSym( PHB_DYNS pDynSym ); /* pushes a function/method pointer onto the stack */
extern HB_EXPORT void hb_vmPushEvalSym( void ); /* pushes a codeblock eval symbol onto the stack */
extern HB_EXPORT void hb_vmPushPointer( void * ); /* push an item of HB_IT_POINTER type */
extern HB_EXPORT void hb_vmPushState( void ); /* push current VM state on stack */
extern HB_EXPORT void hb_vmPopState( void ); /* pop current VM state from stack */

14
harbour/make_rpm.sh
View File

@@ -149,14 +149,18 @@ then
cp ${hb_filename} ${RPMDIR}/SOURCES
cp harbour.spec ${RPMDIR}/SPECS
fi
if which rpmbuild &>/dev/null
then
RPMBLD="rpmbuild"
else
RPMBLD="rpm"
fi
if [ "${BUGGY_RPM}" = "yes" ]
then
rpm -ba harbour.spec ${INST_PARAM}
elif which rpmbuild &>/dev/null
then
rpmbuild -ta ${hb_filename} --rmsource ${INST_PARAM}
${RPMBLD} -ba harbour.spec ${INST_PARAM}
else
rpm -ta ${hb_filename} --rmsource ${INST_PARAM}
${RPMBLD} -ta ${hb_filename} --rmsource ${INST_PARAM}
fi
else
echo "Cannot find archive file: ${hb_filename}"

2
harbour/make_tgz.sh
View File

@@ -245,7 +245,7 @@ then
export L_USR="-L${HB_LIB_INSTALL} -l${name} ${ADD_LIBS}"
export PRG_USR="\"-D_DEFAULT_INC_DIR='${_DEFAULT_INC_DIR}'\" ${PRG_USR}"
for utl in hbmake hbrun hbpp hbdoc hbtest hbpptest
for utl in hbmake hbrun hbpp hbdoc hbtest
do
(cd "utils/${utl}"
rm -fR "./${HB_ARCHITECTURE}"

354
harbour/source/rdd/dbfcdx/dbfcdx1.c
View File

@@ -5655,11 +5655,7 @@ static LONG hb_cdxDBOIKeyCount( CDXAREAP pArea, LPCDXTAG pTag, BOOL fFilters )
ULONG ulKeyCount = 0;
BOOL fLogOpt = pArea->dbfi.itmCobExpr || !pArea->dbfi.fFilter;
if ( pTag && ( fFilters ? fLogOpt && CURKEY_LOGCNT( pTag ) : CURKEY_RAWCNT( pTag ) ) )
{
ulKeyCount = fFilters ? pTag->logKeyCount : pTag->rawKeyCount;
}
else if ( pTag )
if ( pTag )
{
BOOL fCheckFilter = ( fLogOpt && fFilters && pArea->dbfi.itmCobExpr );
ULONG ulRecNo = pArea->ulRecNo;
@@ -5667,62 +5663,69 @@ static LONG hb_cdxDBOIKeyCount( CDXAREAP pArea, LPCDXTAG pTag, BOOL fFilters )
hb_cdxIndexLockRead( pTag->pIndex );
hb_cdxTagRefreshScope( pTag );
if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter )
if ( pTag && ( fFilters ? fLogOpt && CURKEY_LOGCNT( pTag ) : CURKEY_RAWCNT( pTag ) ) )
{
pCurKey = hb_cdxKeyCopy( NULL, pTag->CurKey );
hb_cdxTagGoTop( pTag );
while ( !pTag->TagEOF )
{
if ( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, pTag->CurKey->rec ) )
ulKeyCount++;
hb_cdxTagSkipNext( pTag );
}
pTag->fRePos = TRUE;
hb_cdxKeyCopy( pTag->CurKey, pCurKey );
hb_cdxKeyFree( pCurKey );
if ( fCheckFilter )
SELF_GOTO( ( AREAP ) pArea, ulRecNo );
ulKeyCount = fFilters ? pTag->logKeyCount : pTag->rawKeyCount;
}
else
{
LPCDXPAGE pPage;
pCurKey = hb_cdxKeyCopy( NULL, pTag->CurKey );
if ( pTag->UsrAscend )
hb_cdxTagGoTop( pTag );
else
hb_cdxTagGoBottom( pTag );
pPage = pTag->RootPage;
while ( pPage->Child )
pPage = pPage->Child;
ulKeyCount = pPage->iKeys;
if ( pPage->Right != CDX_DUMMYNODE )
if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter )
{
ULONG ulPage = pPage->Right;
pPage = hb_cdxPageNew( pTag, NULL, CDX_DUMMYNODE );
pPage->Page = ulPage;
while ( pPage->Page != CDX_DUMMYNODE )
pCurKey = hb_cdxKeyCopy( NULL, pTag->CurKey );
hb_cdxTagGoTop( pTag );
while ( !pTag->TagEOF )
{
hb_cdxPageLoad( pPage );
ulKeyCount += pPage->iKeys;
pPage->Page = pPage->Right;
if ( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, pTag->CurKey->rec ) )
ulKeyCount++;
hb_cdxTagSkipNext( pTag );
}
hb_cdxPageFree( pPage, TRUE );
pTag->fRePos = TRUE;
hb_cdxKeyCopy( pTag->CurKey, pCurKey );
hb_cdxKeyFree( pCurKey );
if ( fCheckFilter )
SELF_GOTO( ( AREAP ) pArea, ulRecNo );
}
else
{
LPCDXPAGE pPage;
pCurKey = hb_cdxKeyCopy( NULL, pTag->CurKey );
if ( pTag->UsrAscend )
hb_cdxTagGoTop( pTag );
else
hb_cdxTagGoBottom( pTag );
pPage = pTag->RootPage;
while ( pPage->Child )
pPage = pPage->Child;
ulKeyCount = pPage->iKeys;
if ( pPage->Right != CDX_DUMMYNODE )
{
ULONG ulPage = pPage->Right;
pPage = hb_cdxPageNew( pTag, NULL, CDX_DUMMYNODE );
pPage->Page = ulPage;
while ( pPage->Page != CDX_DUMMYNODE )
{
hb_cdxPageLoad( pPage );
ulKeyCount += pPage->iKeys;
pPage->Page = pPage->Right;
}
hb_cdxPageFree( pPage, TRUE );
}
pTag->fRePos = TRUE;
hb_cdxKeyCopy( pTag->CurKey, pCurKey );
hb_cdxKeyFree( pCurKey );
}
if ( !fFilters )
{
pTag->rawKeyCount = ulKeyCount;
pTag->curKeyState |= CDX_CURKEY_RAWCNT;
}
else if ( fLogOpt )
{
pTag->logKeyCount = ulKeyCount;
pTag->curKeyState |= CDX_CURKEY_LOGCNT;
}
pTag->fRePos = TRUE;
hb_cdxKeyCopy( pTag->CurKey, pCurKey );
hb_cdxKeyFree( pCurKey );
}
hb_cdxIndexUnLockRead( pTag->pIndex );
if ( !fFilters )
{
pTag->rawKeyCount = ulKeyCount;
pTag->curKeyState |= CDX_CURKEY_RAWCNT;
}
else if ( fLogOpt )
{
pTag->logKeyCount = ulKeyCount;
pTag->curKeyState |= CDX_CURKEY_LOGCNT;
}
}
else /* no filter, no order */
{
@@ -5762,12 +5765,6 @@ static LONG hb_cdxDBOIKeyNo( CDXAREAP pArea, LPCDXTAG pTag, BOOL fFilters )
if ( !pArea->fPositioned )
ulKeyNo = 0;
else if ( pTag && ( fFilters ? ( fLogOpt && CURKEY_LOGPOS( pTag ) ) :
( CURKEY_RAWPOS( pTag ) &&
pTag->rawKeyRec == pArea->ulRecNo ) ) )
{
ulKeyNo = fFilters ? pTag->logKeyPos : pTag->rawKeyPos;
}
else if ( pTag )
{
BOOL fCheckFilter = ( fLogOpt && fFilters && pArea->dbfi.itmCobExpr );
@@ -5775,80 +5772,90 @@ static LONG hb_cdxDBOIKeyNo( CDXAREAP pArea, LPCDXTAG pTag, BOOL fFilters )
hb_cdxIndexLockRead( pTag->pIndex );
hb_cdxTagRefreshScope( pTag );
hb_cdxTagOpen( pTag );
if ( hb_cdxCurKeyRefresh( pArea, pTag ) )
if ( fFilters ? ( fLogOpt && CURKEY_LOGPOS( pTag ) ) :
( CURKEY_RAWPOS( pTag ) &&
pTag->rawKeyRec == pArea->ulRecNo ) )
{
if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter )
ulKeyNo = fFilters ? pTag->logKeyPos : pTag->rawKeyPos;
}
else
{
hb_cdxTagOpen( pTag );
if ( hb_cdxCurKeyRefresh( pArea, pTag ) )
{
if ( hb_cdxBottomScope( pTag ) && hb_cdxTopScope( pTag ) &&
( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, ulRecNo ) ) )
if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter )
{
if ( hb_cdxBottomScope( pTag ) && hb_cdxTopScope( pTag ) &&
( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, ulRecNo ) ) )
{
LPCDXKEY pCurKey = hb_cdxKeyCopy( NULL, pTag->CurKey );
while ( !pTag->TagBOF )
{
if ( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, pTag->CurKey->rec ) )
ulKeyNo++;
hb_cdxTagSkipPrev( pTag );
}
pTag->fRePos = TRUE;
hb_cdxKeyCopy( pTag->CurKey, pCurKey );
hb_cdxKeyFree( pCurKey );
if ( fCheckFilter )
SELF_GOTO( ( AREAP ) pArea, ulRecNo );
}
}
else
{
LPCDXPAGE pPage = pTag->RootPage;
while ( pPage->Child )
pPage = pPage->Child;
if ( pTag->UsrAscend )
{
ulKeyNo = pPage->iCurKey + 1;
if ( pPage->Left != CDX_DUMMYNODE )
{
ULONG ulPage = pPage->Left;
pPage = hb_cdxPageNew( pTag, NULL, CDX_DUMMYNODE );
pPage->Page = ulPage;
while ( pPage->Page != CDX_DUMMYNODE )
LPCDXKEY pCurKey = hb_cdxKeyCopy( NULL, pTag->CurKey );
while ( !pTag->TagBOF )
{
hb_cdxPageLoad( pPage );
ulKeyNo += pPage->iKeys;
pPage->Page = pPage->Left;
if ( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, pTag->CurKey->rec ) )
ulKeyNo++;
hb_cdxTagSkipPrev( pTag );
}
hb_cdxPageFree( pPage, TRUE );
pTag->fRePos = TRUE;
hb_cdxKeyCopy( pTag->CurKey, pCurKey );
hb_cdxKeyFree( pCurKey );
if ( fCheckFilter )
SELF_GOTO( ( AREAP ) pArea, ulRecNo );
}
}
else
{
ulKeyNo = pPage->iKeys - pPage->iCurKey;
if ( pPage->Right != CDX_DUMMYNODE )
LPCDXPAGE pPage = pTag->RootPage;
while ( pPage->Child )
pPage = pPage->Child;
if ( pTag->UsrAscend )
{
ULONG ulPage = pPage->Right;
pPage = hb_cdxPageNew( pTag, NULL, CDX_DUMMYNODE );
pPage->Page = ulPage;
while ( pPage->Page != CDX_DUMMYNODE )
ulKeyNo = pPage->iCurKey + 1;
if ( pPage->Left != CDX_DUMMYNODE )
{
hb_cdxPageLoad( pPage );
ulKeyNo += pPage->iKeys;
pPage->Page = pPage->Right;
ULONG ulPage = pPage->Left;
pPage = hb_cdxPageNew( pTag, NULL, CDX_DUMMYNODE );
pPage->Page = ulPage;
while ( pPage->Page != CDX_DUMMYNODE )
{
hb_cdxPageLoad( pPage );
ulKeyNo += pPage->iKeys;
pPage->Page = pPage->Left;
}
hb_cdxPageFree( pPage, TRUE );
}
}
else
{
ulKeyNo = pPage->iKeys - pPage->iCurKey;
if ( pPage->Right != CDX_DUMMYNODE )
{
ULONG ulPage = pPage->Right;
pPage = hb_cdxPageNew( pTag, NULL, CDX_DUMMYNODE );
pPage->Page = ulPage;
while ( pPage->Page != CDX_DUMMYNODE )
{
hb_cdxPageLoad( pPage );
ulKeyNo += pPage->iKeys;
pPage->Page = pPage->Right;
}
hb_cdxPageFree( pPage, TRUE );
}
hb_cdxPageFree( pPage, TRUE );
}
}
}
if ( ulKeyNo != 0 )
{
if ( !fFilters )
if ( ulKeyNo != 0 )
{
pTag->rawKeyPos = ulKeyNo;
CURKEY_SETRAWPOS( pTag );
}
else if ( fLogOpt )
{
pTag->logKeyPos = ulKeyNo;
CURKEY_SETLOGPOS( pTag );
if ( !fFilters )
{
pTag->rawKeyPos = ulKeyNo;
CURKEY_SETRAWPOS( pTag );
}
else if ( fLogOpt )
{
pTag->logKeyPos = ulKeyNo;
CURKEY_SETLOGPOS( pTag );
}
}
}
}
@@ -5890,79 +5897,82 @@ static ERRCODE hb_cdxDBOIKeyGoto( CDXAREAP pArea, LPCDXTAG pTag, ULONG ulKeyNo,
if ( ulKeyNo == 0 )
retval = SELF_GOTO( ( AREAP ) pArea, 0 );
else if ( pTag && ! pArea->lpdbPendingRel && ( fFilters ?
fLogOpt && CURKEY_LOGPOS( pTag ) && pTag->logKeyPos == ulKeyNo :
( CURKEY_RAWPOS( pTag ) && pTag->rawKeyPos == ulKeyNo ) ) )
{
retval = SELF_GOTO( ( AREAP ) pArea, fFilters ? pTag->logKeyRec : pTag->rawKeyRec );
}
else if ( pTag )
{
BOOL fCheckFilter = ( fLogOpt && fFilters && pArea->dbfi.itmCobExpr );
hb_cdxIndexLockRead( pTag->pIndex );
hb_cdxTagRefreshScope( pTag );
if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter )
if ( ! pArea->lpdbPendingRel && ( fFilters ?
fLogOpt && CURKEY_LOGPOS( pTag ) && pTag->logKeyPos == ulKeyNo :
( CURKEY_RAWPOS( pTag ) && pTag->rawKeyPos == ulKeyNo ) ) )
{
hb_cdxTagGoTop( pTag );
if ( fCheckFilter )
while ( !pTag->TagEOF )
{
if ( hb_cdxCheckRecordFilter( pArea, pTag->CurKey->rec ) )
{
if ( ! --ulKeyCnt )
break;
}
hb_cdxTagSkipNext( pTag );
}
else
while( !pTag->TagEOF && --ulKeyCnt )
hb_cdxTagSkipNext( pTag );
retval = SELF_GOTO( ( AREAP ) pArea, fFilters ? pTag->logKeyRec : pTag->rawKeyRec );
}
else
{
LPCDXPAGE pPage, pOwnerPage = NULL;
ULONG ulNextPg;
hb_cdxTagGoTop( pTag );
pPage = pTag->RootPage;
while ( pPage->Child )
if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter )
{
pOwnerPage = pPage;
pPage = pPage->Child;
}
while ( (ULONG) pPage->iKeys < ulKeyCnt && pOwnerPage &&
( ulNextPg = pTag->UsrAscend ?
pPage->Right : pPage->Left ) != CDX_DUMMYNODE )
{
ulKeyCnt -= pPage->iKeys;
pOwnerPage->Child = hb_cdxPageNew( pPage->TagParent, pPage->Owner, ulNextPg );
hb_cdxPageFree( pPage, FALSE );
pPage = pOwnerPage->Child;
}
if ( (ULONG) pPage->iKeys >= ulKeyCnt )
{
pPage->iCurKey = pTag->UsrAscend ? ( SHORT ) ulKeyCnt - 1 : pPage->iKeys - ( SHORT ) ulKeyCnt;
hb_cdxSetCurKey( pPage );
hb_cdxTagGoTop( pTag );
if ( fCheckFilter )
while ( !pTag->TagEOF )
{
if ( hb_cdxCheckRecordFilter( pArea, pTag->CurKey->rec ) )
{
if ( ! --ulKeyCnt )
break;
}
hb_cdxTagSkipNext( pTag );
}
else
while( !pTag->TagEOF && --ulKeyCnt )
hb_cdxTagSkipNext( pTag );
}
else
{
pTag->CurKey->rec = 0;
LPCDXPAGE pPage, pOwnerPage = NULL;
ULONG ulNextPg;
hb_cdxTagGoTop( pTag );
pPage = pTag->RootPage;
while ( pPage->Child )
{
pOwnerPage = pPage;
pPage = pPage->Child;
}
while ( (ULONG) pPage->iKeys < ulKeyCnt && pOwnerPage &&
( ulNextPg = pTag->UsrAscend ?
pPage->Right : pPage->Left ) != CDX_DUMMYNODE )
{
ulKeyCnt -= pPage->iKeys;
pOwnerPage->Child = hb_cdxPageNew( pPage->TagParent, pPage->Owner, ulNextPg );
hb_cdxPageFree( pPage, FALSE );
pPage = pOwnerPage->Child;
}
if ( (ULONG) pPage->iKeys >= ulKeyCnt )
{
pPage->iCurKey = pTag->UsrAscend ? ( SHORT ) ulKeyCnt - 1 : pPage->iKeys - ( SHORT ) ulKeyCnt;
hb_cdxSetCurKey( pPage );
}
else
{
pTag->CurKey->rec = 0;
}
}
retval = SELF_GOTO( ( AREAP ) pArea, pTag->CurKey->rec );
if ( pArea->fPositioned )
{
if ( !fFilters )
{
pTag->rawKeyPos = ulKeyNo;
CURKEY_SETRAWPOS( pTag );
}
else if ( fLogOpt )
{
pTag->logKeyPos = ulKeyNo;
CURKEY_SETLOGPOS( pTag );
}
}
}
hb_cdxIndexUnLockRead( pTag->pIndex );
retval = SELF_GOTO( ( AREAP ) pArea, pTag->CurKey->rec );
if ( pArea->fPositioned )
{
if ( !fFilters )
{
pTag->rawKeyPos = ulKeyNo;
CURKEY_SETRAWPOS( pTag );
}
else if ( fLogOpt )
{
pTag->logKeyPos = ulKeyNo;
CURKEY_SETLOGPOS( pTag );
}
}
}
else
{

8
harbour/source/rtl/errorapi.c
View File

@@ -86,6 +86,8 @@
better shows what is really the problem. [vszakats] */
#define HB_ERROR_LAUNCH_MAX 8
char hb_errFuncName = 0;
static HB_ERROR_INFO_PTR s_errorHandler = NULL;
static HB_ITEM_PTR s_errorBlock;
static int s_iLaunchCount = 0;
@@ -439,6 +441,12 @@ PHB_ITEM hb_errPutOperation( PHB_ITEM pError, const char * szOperation )
{
HB_TRACE(HB_TR_DEBUG, ("hb_errPutOperation(%p, %s)", pError, szOperation));
if( szOperation == &hb_errFuncName )
{
PHB_SYMB pSym = hb_itemGetSymbol( hb_stackBaseItem() );
if( pSym )
szOperation = pSym->szName;
}
hb_vmPushSymbol( hb_dynsymGetSymbol( "_OPERATION" ) );
hb_vmPush( pError );
hb_vmPushString( ( char * ) szOperation, strlen( szOperation ) );

49
harbour/source/rtl/tclass.prg
View File

@@ -202,6 +202,7 @@ STATIC PROCEDURE Create()
LOCAL Self := QSelf()
LOCAL n
LOCAL nLen
LOCAL nScope
LOCAL nLenDatas := Len( ::aDatas ) //Datas local to the class !!
LOCAL nClassBegin
LOCAL hClass
@@ -239,17 +240,21 @@ STATIC PROCEDURE Create()
//Local message...
FOR n := 1 TO nLenDatas
nScope := ::aDatas[ n ][ HB_OO_DATA_SCOPE ]
IF ::aDatas[ n ][ HB_OO_DATA_PERSISTENT ]
nScope := _SetBit( nScope, HB_OO_CLSTP_PERSIST )
ENDIF
__clsAddMsg( hClass, ::aDatas[ n ][ HB_OO_DATA_SYMBOL ] , n, ;
HB_OO_MSG_ACCESS, ::aDatas[ n ][ HB_OO_DATA_VALUE ], ::aDatas[ n ][ HB_OO_DATA_SCOPE ],;
::aDatas[ n ][ HB_OO_DATA_PERSISTENT ] )
HB_OO_MSG_ACCESS, ::aDatas[ n ][ HB_OO_DATA_VALUE ], nScope )
__clsAddMsg( hClass, "_" + ::aDatas[ n ][ HB_OO_DATA_SYMBOL ] , n, ;
HB_OO_MSG_ASSIGN, , ::aDatas[ n ][ HB_OO_DATA_SCOPE ] )
HB_OO_MSG_ASSIGN, , ::aDatas[ n ][ HB_OO_DATA_SCOPE ],;
::aDatas[ n ][ HB_OO_DATA_TYPE ] )
NEXT
nLen := Len( ::aMethods )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aMethods[ n ][ HB_OO_MTHD_SYMBOL ], ::aMethods[ n ][ HB_OO_MTHD_PFUNCTION ], HB_OO_MSG_METHOD, NIL, ::aMethods[ n ][ HB_OO_MTHD_SCOPE ],;
::aMethods[ n ][ HB_OO_MTHD_PERSISTENT ] )
__clsAddMsg( hClass, ::aMethods[ n ][ HB_OO_MTHD_SYMBOL ], ::aMethods[ n ][ HB_OO_MTHD_PFUNCTION ],;
HB_OO_MSG_METHOD, NIL, ::aMethods[ n ][ HB_OO_MTHD_SCOPE ] )
NEXT
nLen := Len( ::aClsDatas )
@@ -264,8 +269,7 @@ STATIC PROCEDURE Create()
nLen := Len( ::aInlines )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aInlines[ n ][ HB_OO_MTHD_SYMBOL ], ::aInlines[ n ][ HB_OO_MTHD_PFUNCTION ],;
HB_OO_MSG_INLINE, NIL, ::aInlines[ n ][ HB_OO_MTHD_SCOPE ],;
::aInlines[ n ][ HB_OO_MTHD_PERSISTENT ] )
HB_OO_MSG_INLINE, NIL, ::aInlines[ n ][ HB_OO_MTHD_SCOPE ] )
NEXT
nLen := Len( ::aVirtuals )
@@ -309,8 +313,9 @@ STATIC PROCEDURE AddData( cData, xInit, cType, nScope, lNoinit, lPersistent )
LOCAL Self := QSelf()
if lNoInit==NIL;lNoInit:=.F.;endif
if lPersistent == nil; lpersistent := .f.; endif
DEFAULT lNoInit TO .F.
DEFAULT lPersistent TO .F.
DEFAULT nScope TO HB_OO_CLSTP_EXPORTED
// Default Init for Logical and numeric
IF ! lNoInit .AND. cType != NIL .AND. xInit == NIL
@@ -355,7 +360,7 @@ STATIC PROCEDURE AddClassData( cData, xInit, cType, nScope, lNoInit )
LOCAL Self := QSelf()
if lNoInit==NIL;lNoInit:=.F.;endif
DEFAULT lNoInit TO .F.
// Default Init for Logical and numeric
IF ! lNoInit .AND. cType != NIL .AND. xInit == NIL
@@ -400,6 +405,13 @@ STATIC PROCEDURE AddInline( cMethod, bCode, nScope, lPersistent )
LOCAL Self := QSelf(), nAt
DEFAULT lPersistent TO .F.
DEFAULT nScope TO HB_OO_CLSTP_EXPORTED
IF lPersistent
nScope := _SetBit( nScope, HB_OO_CLSTP_PERSIST )
ENDIF
/* Remove possible ( <x,...> )*/
IF ( nAt := At( "(", cMethod ) ) > 0
cMethod := RTrim( Left( cMethod, nAt - 1 ) )
@@ -415,6 +427,13 @@ STATIC PROCEDURE AddMethod( cMethod, nFuncPtr, nScope, lPersistent )
LOCAL Self := QSelf(), nAt
DEFAULT lPersistent TO .F.
DEFAULT nScope TO HB_OO_CLSTP_EXPORTED
IF lPersistent
nScope := _SetBit( nScope, HB_OO_CLSTP_PERSIST )
ENDIF
/* Remove possible ( <x,...> )*/
IF ( nAt := At( "(", cMethod ) ) > 0
cMethod := RTrim( Left( cMethod, nAt - 1 ) )
@@ -500,4 +519,12 @@ STATIC FUNCTION InitClass()
RETURN Self
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
STATIC FUNCTION _SetBit( nValue1, nValue2 )
IF nValue1 % ( nValue2 + nValue2 ) < nValue2
nValue1 += nValue2
ENDIF
RETURN nValue1
//----------------------------------------------------------------------------//

4
harbour/source/vm/arrays.c
View File

@@ -301,7 +301,7 @@ HB_EXPORT BOOL hb_arrayAddForward( PHB_ITEM pArray, PHB_ITEM pValue )
{
HB_TRACE(HB_TR_DEBUG, ("hb_arrayAddForward(%p, %p)", pArray, pValue));
if( pArray->type == HB_IT_ARRAY )
if( HB_IS_ARRAY( pArray ) )
{
PHB_BASEARRAY pBaseArray = ( PHB_BASEARRAY ) pArray->item.asArray.value;
@@ -892,7 +892,7 @@ static void hb_arrayCloneBody( PHB_BASEARRAY pSrcBaseArray, PHB_BASEARRAY pDstBa
for( ulLen = pSrcBaseArray->ulLen; ulLen; --ulLen, ++pSrcItem, ++pDstItem )
{
/* Clipper clones nested array ONLY if NOT an Object!!! */
if( pSrcItem->type == HB_IT_ARRAY && pSrcItem->item.asArray.value->uiClass == 0 )
if( HB_IS_ARRAY( pSrcItem ) && pSrcItem->item.asArray.value->uiClass == 0 )
{
PHB_NESTED_CLONED pCloned = pClonedList;
PHB_BASEARRAY pBaseArray = pSrcItem->item.asArray.value;

1390
harbour/source/vm/classes.c
View File

File diff suppressed because it is too large Load Diff

2
harbour/source/vm/debug.c
View File

@@ -63,7 +63,7 @@ static void AddToArray( PHB_ITEM pItem, PHB_ITEM pReturn, ULONG ulPos )
{
HB_TRACE(HB_TR_DEBUG, ("AddToArray(%p, %p, %lu)", pItem, pReturn, ulPos));
if( pItem->type == HB_IT_SYMBOL )
if( HB_IS_SYMBOL( pItem ) )
{ /* Symbol is pushed as text */
PHB_ITEM pArrayItem = hb_arrayGetItemPtr( pReturn, ulPos );

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

@@ -228,7 +228,7 @@ BOOL hb_bTracePrgCalls = FALSE; /* prg tracing is off */
/* virtual machine state */
HB_SYMB hb_symEval = { "__EVAL", {HB_FS_PUBLIC}, {hb_vmDoBlock}, NULL }; /* symbol to evaluate codeblocks */
HB_SYMB hb_symEval = { "EVAL", {HB_FS_PUBLIC}, {hb_vmDoBlock}, NULL }; /* symbol to evaluate codeblocks */
static HB_ITEM s_aStatics; /* Harbour array to hold all application statics variables */
@@ -398,18 +398,20 @@ HB_EXPORT void hb_vmInit( BOOL bStartMainProc )
s_lRecoverBase = 0;
s_uiActionRequest = 0;
hb_vmSymbolInit_RT(); /* initialize symbol table with runtime support functions */
s_pDynsDbgEntry = hb_dynsymFind( "__DBGENTRY" );
hb_xinit();
hb_stackInit();
hb_errInit();
hb_dynsymNew( &hb_symEval ); /* initialize dynamic symbol for evaluating codeblocks */
/* initialize dynamic symbol for evaluating codeblocks */
hb_symEval.pDynSym = hb_dynsymGetCase( hb_symEval.szName );
hb_setInitialize(); /* initialize Sets */
hb_conInit(); /* initialize Console */
hb_memvarsInit();
hb_vmSymbolInit_RT(); /* initialize symbol table with runtime support functions */
hb_clsInit(); /* initialize Classy/OO system */
/* Set the language to the default */
@@ -4326,7 +4328,7 @@ HB_EXPORT PHB_ITEM hb_vmEvalBlockOrMacro( PHB_ITEM pItem )
{
HB_TRACE(HB_TR_DEBUG, ("hb_vmEvalBlockOrMacro(%p)", pItem));
if( pItem->type == HB_IT_BLOCK )
if( HB_IS_BLOCK( pItem ) )
{
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
@@ -4353,7 +4355,7 @@ HB_EXPORT PHB_ITEM hb_vmEvalBlockOrMacro( PHB_ITEM pItem )
*/
HB_EXPORT void hb_vmDestroyBlockOrMacro( PHB_ITEM pItem )
{
if( pItem->type == HB_IT_POINTER )
if( HB_IS_POINTER( pItem ) )
{
HB_MACRO_PTR pMacro = ( HB_MACRO_PTR ) hb_itemGetPtr( pItem );
if( pMacro )
@@ -4820,6 +4822,17 @@ HB_EXPORT void hb_vmPushDynSym( PHB_DYNS pDynSym )
pItem->item.asSymbol.stackstate = NULL;
}
HB_EXPORT void hb_vmPushEvalSym( void )
{
PHB_ITEM pItem = hb_stackAllocItem();
HB_TRACE(HB_TR_DEBUG, ("hb_vmPushEvalSym()"));
pItem->type = HB_IT_SYMBOL;
pItem->item.asSymbol.value = &hb_symEval;
pItem->item.asSymbol.stackstate = NULL;
}
/* -3 -> HB_P_PUSHBLOCK
* -2 -1 -> size of codeblock
* 0 +1 -> number of expected parameters
@@ -5715,8 +5728,9 @@ void hb_vmExitSymbolGroup( void * hDynLib )
}
}
PHB_SYMBOLS
hb_vmRegisterSymbols( PHB_SYMB pModuleSymbols, USHORT uiSymbols, char * szModuleName, ULONG ulID, BOOL fDynLib, BOOL fClone )
PHB_SYMBOLS hb_vmRegisterSymbols( PHB_SYMB pModuleSymbols, USHORT uiSymbols,
char * szModuleName, ULONG ulID,
BOOL fDynLib, BOOL fClone )
{
PHB_SYMBOLS pNewSymbols;
BOOL fRecycled, fInitStatics = FALSE;
@@ -5800,7 +5814,8 @@ hb_vmRegisterSymbols( PHB_SYMB pModuleSymbols, USHORT uiSymbols, char * szModule
fInitStatics = TRUE;
}
if( ( hSymScope & HB_FS_PCODEFUNC ) != 0 && ( fRecycled || fClone ) )
if( ( hSymScope & HB_FS_PCODEFUNC ) && ( hSymScope & HB_FS_LOCAL ) &&
( fRecycled || fClone ) )
{
pSymbol->value.pCodeFunc->pSymbols = pNewSymbols->pModuleSymbols;
}

14
harbour/source/vm/proc.c
View File

@@ -59,7 +59,7 @@
*
* Copyright 2001 JFL (Mafact) <jfl@mafact.com>
* Adding the MethodName() just calling Procname()
* Special treatment in case of Object and __Eval (only for methodname)
* Special treatment in case of Object and Eval (only for methodname)
* skipping block and adding (b) before the method name
*
* See doc/license.txt for licensing terms.
@@ -122,7 +122,7 @@ HB_FUNC( PROCFILE )
{
pSym = hb_stackItem( lOffset )->item.asSymbol.value;
if( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 )
if( pSym == &hb_symEval || pSym->pDynSym == hb_symEval.pDynSym )
{
PHB_ITEM pSelf = hb_stackItem( lOffset + 1 );
@@ -144,6 +144,7 @@ char * hb_procname( int iLevel, char * szName, BOOL fMethodName )
{
long lOffset = hb_stackBaseProcOffset( iLevel );
szName[ 0 ] = '\0';
if( lOffset >= 0 )
{
PHB_ITEM pBase, pSelf;
@@ -167,9 +168,8 @@ char * hb_procname( int iLevel, char * szName, BOOL fMethodName )
}
}
szName[ 0 ] = '\0';
if( pBase->item.asSymbol.value == &hb_symEval ||
strcmp( pBase->item.asSymbol.value->szName, "EVAL" ) == 0 )
pBase->item.asSymbol.value->pDynSym == hb_symEval.pDynSym )
{
strcat( szName, "(b)" );
@@ -189,8 +189,6 @@ char * hb_procname( int iLevel, char * szName, BOOL fMethodName )
strcat( szName, pBase->item.asSymbol.value->szName );
}
}
else
strcpy( szName, "" );
return szName;
}
@@ -217,7 +215,7 @@ BOOL hb_procinfo( int iLevel, char * szName, USHORT * puiLine, char * szFile )
if( szName )
{
szName[ 0 ] = '\0';
if( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 )
if( pSym == &hb_symEval || pSym->pDynSym == hb_symEval.pDynSym )
{
strcat( szName, "(b)" );
@@ -245,7 +243,7 @@ BOOL hb_procinfo( int iLevel, char * szName, USHORT * puiLine, char * szFile )
char * szModule;
if( HB_IS_BLOCK( pSelf ) &&
( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 ) )
( pSym == &hb_symEval || pSym->pDynSym == hb_symEval.pDynSym ) )
pSym = pSelf->item.asBlock.value->pDefSymb;
szModule = hb_vmFindModuleSymbolName( hb_vmGetRealFuncSym( pSym ) );