From e31bdceeb4b66d6335e5d9e9b0281ada84bb1bd2 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sun, 30 Jan 2005 21:11:50 +0000 Subject: [PATCH] 2005-01-30 22:10 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * xharbour/contrib/rdd_ads/ace.h * small modification for OpenWatcom on Linux * xharbour/source/rdd/dbfntx/dbfntx1.c * minor fix: use *_GOTO( pArea, 0 ) instead of *_GOTO( pArea, pArea->ulRecCount+1000 ) + use hb_fsSeekLarge() - for DBFs longer then 2GB * xharbour/include/hbrddcdx.h * xharbour/source/rdd/dbfcdx/dbfcdx1.c + use hb_fsSeekLarge() - for DBFs longer then 2GB * my last xHarbour modifications: improved indexing speed of DBFs with very big number of records. In small DBFs less then 100'000 records the new algorithm can even decrease the speed by ~0.5% due to static costs but in bigger it becomes faster. For 1'000'000 records DBFs is about 20% faster, for 10'000'000 records about twice faster. With bigger DBFs more. Please test it. If you will have any troubles (I hope not) then please comment out in dbfcdx.c: #define HB_CDX_NEW_SORT I should done it before when I was rewriting the indexing but sorry I was too lazy. Now I've found a while. Current cost of key comparisons is always n*log2(n) and cannot be more improved. Some small optimizations still can be done but the static cost for small database will be bigger then ~0.5% as in this case so I do not plan to do it in the nearest future. * harbour/include/dbinfo.ch * harbour/source/rdd/dbf1.c + use hb_fsSeekLarge() - for DBFs longer then 2GB * synched with xHarbour (added DBRI_RAW*) * do not call GOCOLD() inside CHILDSYNC() but do it in FORCEREL() the modification based on CL5.3 NG. Below is a note I lef in dbf1.c: /* * !!! The side effect of calling GOCOLD() inside CHILDSYNC() is * evaluation of index expressions (index KEY and FOR condition) * when the pArea is not the current one - it means that the * used RDD has to set proper work area before eval, DBFCDX does * but DBFNTX not yet - it should be changed. * IMHO GOCOLD() could be safely removed from this place but I'm not * sure it's Clipper compatible - I will have to check it, Druzus. */ /* * I've checked in CL5.3 Technical Reference Guide that only * FORCEREL() should ensure that the work area buffer is not hot * and then call RELEVAL() - I hope it describes the CL5.3 DBF* RDDs * behavior so I replicate it - the GOCOLD() is moved from CHILDSYNC() * to FORCEREL(), Druzus. */ * harbour/source/rdd/dbf0.prg * harbour/source/rdd/delim0.prg * harbour/source/rdd/rddsys.prg * harbour/source/rdd/sdf0.prg * harbour/source/rdd/dbfntx/dbfntx0.prg * formatting (adding EOL at EOF) * harbour/include/hbapifs.h * harbour/source/rtl/filesys.c * added hb_fsLockLarge() and hb_fsSeekLarge() which uses 64bit ofsets * harbour/source/rdd/workarea.c * set current work area to the used one in EVALBLOCK RDD method before code block evaluation * harbour/source/vm/harbinit.prg * harbour/source/vm/hvm.c + added hb_vmDoInitClip() which calls CLIPINIT function to initialize ErrorBlock() and __SetHelpK() Because on some platform the execution order of init functions is out of Harbour control then CLIPINIT has to be called explicitly in VM initialization process before hb_vmDoInitFunctions() and do not depends on INIT clause. * small modification in VM loop which gives noticeable speed-up --- harbour/ChangeLog | 84 +++++++++++- harbour/contrib/rdd_ads/ace.h | 2 +- harbour/include/dbinfo.ch | 3 + harbour/include/hbapifs.h | 3 + harbour/include/hbrddcdx.h | 12 +- harbour/source/rdd/dbf0.prg | 2 +- harbour/source/rdd/dbf1.c | 128 ++++++++++++++--- harbour/source/rdd/dbfcdx/dbfcdx1.c | 190 ++++++++++++++++++++------ harbour/source/rdd/dbfntx/dbfntx0.prg | 2 +- harbour/source/rdd/dbfntx/dbfntx1.c | 8 +- harbour/source/rdd/delim0.prg | 2 +- harbour/source/rdd/rddsys.prg | 1 - harbour/source/rdd/sdf0.prg | 2 +- harbour/source/rdd/workarea.c | 18 ++- harbour/source/rtl/filesys.c | 20 ++- harbour/source/vm/harbinit.prg | 8 +- harbour/source/vm/hvm.c | 34 ++++- 17 files changed, 426 insertions(+), 93 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 841d0c5f44..f51b56c15c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,84 @@ 2002-12-01 23:12 UTC+0100 Foo Bar */ +2005-01-30 22:10 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * xharbour/contrib/rdd_ads/ace.h + * small modification for OpenWatcom on Linux + + * xharbour/source/rdd/dbfntx/dbfntx1.c + * minor fix: use *_GOTO( pArea, 0 ) instead + of *_GOTO( pArea, pArea->ulRecCount+1000 ) + + use hb_fsSeekLarge() - for DBFs longer then 2GB + + * xharbour/include/hbrddcdx.h + * xharbour/source/rdd/dbfcdx/dbfcdx1.c + + use hb_fsSeekLarge() - for DBFs longer then 2GB + * my last xHarbour modifications: + improved indexing speed of DBFs with very big number of + records. In small DBFs less then 100'000 records the new + algorithm can even decrease the speed by ~0.5% due to static + costs but in bigger it becomes faster. For 1'000'000 records + DBFs is about 20% faster, for 10'000'000 records about twice + faster. With bigger DBFs more. Please test it. If you will + have any troubles (I hope not) then please comment out in + dbfcdx.c: + #define HB_CDX_NEW_SORT + I should done it before when I was rewriting the indexing but + sorry I was too lazy. Now I've found a while. Current cost of + key comparisons is always n*log2(n) and cannot be more improved. + Some small optimizations still can be done but the static cost + for small database will be bigger then ~0.5% as in this case + so I do not plan to do it in the nearest future. + + * harbour/include/dbinfo.ch + * harbour/source/rdd/dbf1.c + + use hb_fsSeekLarge() - for DBFs longer then 2GB + * synched with xHarbour (added DBRI_RAW*) + * do not call GOCOLD() inside CHILDSYNC() but do it in FORCEREL() + the modification based on CL5.3 NG. + Below is a note I lef in dbf1.c: + /* + * !!! The side effect of calling GOCOLD() inside CHILDSYNC() is + * evaluation of index expressions (index KEY and FOR condition) + * when the pArea is not the current one - it means that the + * used RDD has to set proper work area before eval, DBFCDX does + * but DBFNTX not yet - it should be changed. + * IMHO GOCOLD() could be safely removed from this place but I'm not + * sure it's Clipper compatible - I will have to check it, Druzus. + */ + /* + * I've checked in CL5.3 Technical Reference Guide that only + * FORCEREL() should ensure that the work area buffer is not hot + * and then call RELEVAL() - I hope it describes the CL5.3 DBF* RDDs + * behavior so I replicate it - the GOCOLD() is moved from CHILDSYNC() + * to FORCEREL(), Druzus. + */ + + * harbour/source/rdd/dbf0.prg + * harbour/source/rdd/delim0.prg + * harbour/source/rdd/rddsys.prg + * harbour/source/rdd/sdf0.prg + * harbour/source/rdd/dbfntx/dbfntx0.prg + * formatting (adding EOL at EOF) + + * harbour/include/hbapifs.h + * harbour/source/rtl/filesys.c + * added hb_fsLockLarge() and hb_fsSeekLarge() which uses 64bit ofsets + + * harbour/source/rdd/workarea.c + * set current work area to the used one in EVALBLOCK RDD method + before code block evaluation + + * harbour/source/vm/harbinit.prg + * harbour/source/vm/hvm.c + + added hb_vmDoInitClip() which calls CLIPINIT function to initialize + ErrorBlock() and __SetHelpK() + Because on some platform the execution order of init functions + is out of Harbour control then CLIPINIT has to be called explicitly + in VM initialization process before hb_vmDoInitFunctions() and do not + depends on INIT clause. + * small modification in VM loop which gives noticeable speed-up + 2005-01-23 09:05 UTC+0100 Antonio Linares * makefile.nt + hbverdsp.obj module added to makefile.nt @@ -20,14 +98,14 @@ * source/rdd/dbfntx/dbfntx1.c ! Bug fixed, which oocured in some rare situations while record updating. -2004-01-13 09:35 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) +2005-01-13 09:35 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * xharbour/source/rtl/mod.c ! fixed mod() function to be Clipper/DBASE III compatible (not the % operator) for combination of psitive and negative numbers -2004-01-13 08:15 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) +2005-01-13 08:15 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + harbour/include/hbfixdj.h + I missed to add this file in my last commit - it's borrowed from xHarbour. @@ -35,7 +113,7 @@ ! fixed DJGPP compilation I broke -2004-01-12 18:25 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) +2005-01-12 18:25 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/hbgtmk.sh * harbour/make_rpm.sh * harbour/harbour.spec diff --git a/harbour/contrib/rdd_ads/ace.h b/harbour/contrib/rdd_ads/ace.h index 193411befa..60580b320d 100644 --- a/harbour/contrib/rdd_ads/ace.h +++ b/harbour/contrib/rdd_ads/ace.h @@ -10,7 +10,7 @@ #define __ACE_INCLUDED__ -#if defined( unix ) +#if defined( unix ) || defined(__LINUX__) #ifndef ADS_LINUX #define ADS_LINUX #endif diff --git a/harbour/include/dbinfo.ch b/harbour/include/dbinfo.ch index 91ecad18d0..9e2df31297 100644 --- a/harbour/include/dbinfo.ch +++ b/harbour/include/dbinfo.ch @@ -130,6 +130,9 @@ #define DBRI_RECSIZE 3 #define DBRI_RECNO 4 #define DBRI_UPDATED 5 +#define DBRI_RAWRECORD 6 +#define DBRI_RAWMEMOS 7 +#define DBRI_RAWDATA 8 /* constants for some SCOPED DBOI_* parameter */ #define DBRMI_FUNCTION 1 diff --git a/harbour/include/hbapifs.h b/harbour/include/hbapifs.h index 5db4bb4ad7..3a0a395ff4 100644 --- a/harbour/include/hbapifs.h +++ b/harbour/include/hbapifs.h @@ -125,6 +125,8 @@ extern USHORT hb_fsIsDrv ( BYTE nDrive ); /* determine if a drive number extern BOOL hb_fsIsDevice ( FHANDLE hFileHandle ); /* determine if a file is attached to a device (console?) */ extern BOOL hb_fsLock ( FHANDLE hFileHandle, ULONG ulStart, ULONG ulLength, USHORT uiMode ); /* request a lock on a portion of a file */ +extern BOOL hb_fsLockLarge ( FHANDLE hFileHandle, HB_FOFFSET ulStart, + HB_FOFFSET ulLength, USHORT uiMode ); /* request a lock on a portion of a file using 64bit API */ extern BOOL hb_fsMkDir ( BYTE * pszDirName ); /* create a directory */ extern FHANDLE hb_fsOpen ( BYTE * pszFileName, USHORT uiFlags ); /* open a file */ extern USHORT hb_fsRead ( FHANDLE hFileHandle, BYTE * pBuff, USHORT ulCount ); /* read contents of a file into a buffer (<=64K) */ @@ -132,6 +134,7 @@ extern ULONG hb_fsReadLarge ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCou extern BOOL hb_fsRmDir ( BYTE * pszDirName ); /* remove a directory */ extern BOOL hb_fsRename ( BYTE * pszOldName, BYTE * pszNewName ); /* rename a file */ extern ULONG hb_fsSeek ( FHANDLE hFileHandle, LONG lOffset, USHORT uiMode ); /* reposition an open file */ +extern HB_FOFFSET hb_fsSeekLarge( FHANDLE hFileHandle, HB_FOFFSET llOffset, USHORT uiFlags ); /* reposition an open file using 64bit API */ extern ULONG hb_fsTell ( FHANDLE hFileHandle ); /* retrieve the current position of a file */ extern BOOL hb_fsSetDevMode ( FHANDLE hFileHandle, USHORT uiDevMode ); /* change the device mode of a file (text/binary) */ extern void hb_fsSetError ( USHORT uiError ); /* set the file system error number */ diff --git a/harbour/include/hbrddcdx.h b/harbour/include/hbrddcdx.h index 5276976452..4bb0e930e9 100644 --- a/harbour/include/hbrddcdx.h +++ b/harbour/include/hbrddcdx.h @@ -360,11 +360,11 @@ typedef CDXINDEX * LPCDXINDEX; /* for index creation */ typedef struct { - ULONG nOffset; /* offset in temporary file */ - ULONG ulKeys; /* number of keys in page */ - ULONG ulKeyBuf; /* number of keys in memory buffer */ - ULONG ulCurKey; /* current key in memory buffer */ - BYTE * pKeyPool; /* memory buffer */ + HB_FOFFSET nOffset; /* offset in temporary file */ + ULONG ulKeys; /* number of keys in page */ + ULONG ulKeyBuf; /* number of keys in memory buffer */ + ULONG ulCurKey; /* current key in memory buffer */ + BYTE * pKeyPool; /* memory buffer */ } CDXSWAPPAGE; typedef CDXSWAPPAGE * LPCDXSWAPPAGE; @@ -386,6 +386,8 @@ typedef struct BYTE * pKeyPool; /* memory buffer for current page then for pages */ LPCDXSWAPPAGE pSwapPage; /* list of pages */ LPCDXPAGE NodeList[ CDX_STACKSIZE ]; /* Stack of pages */ + ULONG ulFirst; + ULONG * pSortedPages; BYTE pLastKey[ CDX_MAXKEY ]; /* last key val */ ULONG ulLastRec; BYTE * pRecBuff; diff --git a/harbour/source/rdd/dbf0.prg b/harbour/source/rdd/dbf0.prg index ac64197867..981ba89077 100644 --- a/harbour/source/rdd/dbf0.prg +++ b/harbour/source/rdd/dbf0.prg @@ -60,4 +60,4 @@ init procedure DBFInit rddRegister( "DBF", RDT_FULL ) -return \ No newline at end of file +return diff --git a/harbour/source/rdd/dbf1.c b/harbour/source/rdd/dbf1.c index ab21fcb209..be0a921867 100644 --- a/harbour/source/rdd/dbf1.c +++ b/harbour/source/rdd/dbf1.c @@ -250,7 +250,7 @@ static ULONG hb_dbfCalcRecCount( DBFAREAP pArea ) { HB_TRACE(HB_TR_DEBUG, ("hb_dbfCalcRecCount(%p)", pArea)); - return ( hb_fsSeek( pArea->hDataFile, 0, FS_END ) - pArea->uiHeaderLen ) / + return ( hb_fsSeekLarge( pArea->hDataFile, 0, FS_END ) - pArea->uiHeaderLen ) / pArea->uiRecordLen; } @@ -715,7 +715,7 @@ BOOL HB_EXPORT hb_dbfLockIdxFile( FHANDLE hFile, BYTE bScheme, USHORT usMode, UL } fRet = hb_fsLock( hFile, ulPos + *pPoolPos, ulSize, usMode ); fWait = ( !fRet && ( usMode & FLX_WAIT ) != 0 && ( usMode & FL_MASK ) == FL_LOCK ); - /* TODO: call special error handler (LOCKHANDLER) hiere if fWait */ + /* TODO: call special error handler (LOCKHANDLER) here if fWait */ } while ( fWait ); @@ -799,10 +799,13 @@ static ERRCODE hb_dbfGoTo( DBFAREAP pArea, ULONG ulRecNo ) if( SELF_GOCOLD( ( AREAP ) pArea ) == FAILURE ) return FAILURE; - if( pArea->lpdbPendingRel && pArea->lpdbPendingRel->isScoped ) - SELF_FORCEREL( ( AREAP ) pArea ); - /* Reset parent rel struct */ - pArea->lpdbPendingRel = NULL; + if( pArea->lpdbPendingRel ) + { + if ( pArea->lpdbPendingRel->isScoped ) + SELF_FORCEREL( ( AREAP ) pArea ); + else /* Reset parent rel struct */ + pArea->lpdbPendingRel = NULL; + } /* Update record count */ if( ulRecNo > pArea->ulRecCount && pArea->fShared ) @@ -973,8 +976,13 @@ static ERRCODE hb_dbfAppend( DBFAREAP pArea, BOOL bUnLockAll ) if( SELF_GOCOLD( ( AREAP ) pArea ) == FAILURE ) return FAILURE; - /* Reset parent rel struct */ - pArea->lpdbPendingRel = NULL; + if( pArea->lpdbPendingRel ) + { + if ( pArea->lpdbPendingRel->isScoped ) + SELF_FORCEREL( ( AREAP ) pArea ); + else /* Reset parent rel struct */ + pArea->lpdbPendingRel = NULL; + } if( pArea->fShared ) { @@ -1111,8 +1119,9 @@ static ERRCODE hb_dbfGetRec( DBFAREAP pArea, BYTE ** pBuffer ) else { /* Read data from file */ - hb_fsSeek( pArea->hDataFile, pArea->uiHeaderLen + ( pArea->ulRecNo - 1 ) * - pArea->uiRecordLen, FS_SET ); + hb_fsSeekLarge( pArea->hDataFile, ( HB_FOFFSET ) pArea->uiHeaderLen + + ( HB_FOFFSET ) ( pArea->ulRecNo - 1 ) * + ( HB_FOFFSET ) pArea->uiRecordLen, FS_SET ); if( hb_fsRead( pArea->hDataFile, pArea->pRecord, pArea->uiRecordLen ) != pArea->uiRecordLen ) { @@ -1369,8 +1378,9 @@ static ERRCODE hb_dbfPutRec( DBFAREAP pArea, BYTE * pBuffer ) else /* if( pArea->fRecordChanged ) */ { /* Write data to file */ - hb_fsSeek( pArea->hDataFile, pArea->uiHeaderLen + ( pArea->ulRecNo - 1 ) * - pArea->uiRecordLen, FS_SET ); + hb_fsSeekLarge( pArea->hDataFile, ( HB_FOFFSET ) pArea->uiHeaderLen + + ( HB_FOFFSET ) ( pArea->ulRecNo - 1 ) * + ( HB_FOFFSET ) pArea->uiRecordLen, FS_SET ); if( hb_fsWrite( pArea->hDataFile, pArea->pRecord, pArea->uiRecordLen ) != pArea->uiRecordLen ) { @@ -2090,6 +2100,70 @@ static ERRCODE hb_dbfRecInfo( DBFAREAP pArea, PHB_ITEM pRecID, USHORT uiInfoType hb_itemPutL( pInfo, ulRecNo == pArea->ulRecNo && pArea->fRecordChanged ); break; + case DBRI_RAWRECORD: + case DBRI_RAWMEMOS: + case DBRI_RAWDATA: + { + USHORT uiFields; + BYTE *pResult ; + HB_ITEM itItem = HB_ITEM_NIL ; + ULONG ulLength; + ULONG ulPrevRec = 0; + BOOL bDeleted; + if( pArea->ulRecNo != ulRecNo ) + { + ulPrevRec = pArea->ulRecNo; + SELF_GOTO( ( AREAP ) pArea, ulRecNo ); + } + SELF_DELETED( ( AREAP ) pArea, &bDeleted ); /* No need to allow for == FAILURE here */ + + if ( uiInfoType == DBRI_RAWRECORD || uiInfoType == DBRI_RAWDATA ) + { + ulLength = pArea->uiRecordLen; + pResult = (BYTE *) hb_xgrab( ulLength + 1 ) ; /* Allow final '\0' placed by hb_itemPutCPtr */ + /* Assume xgrab ok - no memory checking */ + memcpy( pResult, pArea->pRecord, ulLength ) ; + } + else + { + pResult = NULL; + ulLength = 0; + } + + if ( uiInfoType == DBRI_RAWMEMOS || uiInfoType == DBRI_RAWDATA ) + { + for ( uiFields = 0; uiFields < pArea->uiFieldCount ; uiFields++ ) + { + if ( pArea->lpFields[ uiFields ].uiType == HB_IT_MEMO ) + { + /* uiFields in SELF_GETVALUE() 1 based */ + if ( SELF_GETVALUE( ( AREAP ) pArea, uiFields + 1, &itItem ) == SUCCESS && + HB_IS_STRING( &itItem ) && itItem.item.asString.length > 0 ) + { + if ( pResult ) + { + pResult = (BYTE *) hb_xrealloc( pResult, ulLength + 1 + itItem.item.asString.length ); /* Assume xgrab ok - no memory checking */ + } + else + { + pResult = (BYTE *) hb_xgrab( itItem.item.asString.length + 1 ); /* Assume xgrab ok - no memory checking */ + } + memcpy( pResult + ulLength, itItem.item.asString.value, itItem.item.asString.length ); + ulLength += itItem.item.asString.length; + } + } + } + } + hb_itemClear( &itItem ); + hb_itemPutCPtr( pInfo, (char *) pResult, ulLength ); + + if( ulPrevRec != 0 ) + { + SELF_GOTO( ( AREAP ) pArea, ulPrevRec ); + } + break; + } + default: return SUPER_RECINFO( ( AREAP ) pArea, pRecID, uiInfoType, pInfo ); } @@ -2821,9 +2895,27 @@ static ERRCODE hb_dbfChildSync( DBFAREAP pArea, LPDBRELINFO pRelInfo ) { HB_TRACE(HB_TR_DEBUG, ("hb_dbfChildSync(%p, %p)", pArea, pRelInfo)); - SELF_GOCOLD( ( AREAP ) pArea ); + /* + * !!! The side effect of calling GOCOLD() inside CHILDSYNC() is + * evaluation of index expressions (index KEY and FOR condition) + * when the pArea is not the current one - it means that the + * used RDD has to set proper work area before eval, DBFCDX does + * but DBFNTX not yet - it should be changed. + * IMHO GOCOLD() could be safely removed from this place but I'm not + * sure it's Clipper compatible - I will have to check it, Druzus. + */ + /* + * I've checked in CL5.3 Technical Reference Guide that only + * FORCEREL() should ensure that the work area buffer is not hot + * and then call RELEVAL() - I hope it describes the CL5.3 DBF* RDDs + * behavior so I replicate it - the GOCOLD() is moved from CHILDSYNC() + * to FORCEREL(), Druzus. + */ + /* SELF_GOCOLD( ( AREAP ) pArea ); */ + pArea->lpdbPendingRel = pRelInfo; - SELF_SYNCCHILDREN( ( AREAP ) pArea ); + if( pArea->lpdbRelations ) + SELF_SYNCCHILDREN( ( AREAP ) pArea ); return SUCCESS; } @@ -2842,6 +2934,9 @@ static ERRCODE hb_dbfForceRel( DBFAREAP pArea ) if( pArea->lpdbPendingRel ) { + /* update buffers */ + SELF_GOCOLD( ( AREAP ) pArea ); + lpdbPendingRel = pArea->lpdbPendingRel; pArea->lpdbPendingRel = NULL; uiError = SELF_RELEVAL( ( AREAP ) pArea, lpdbPendingRel ); @@ -3215,8 +3310,9 @@ static ERRCODE hb_dbfWriteDBHeader( DBFAREAP pArea ) { /* Exclusive mode */ /* Seek to logical eof and write eof mark */ - hb_fsSeek( pArea->hDataFile, pArea->uiHeaderLen + - pArea->uiRecordLen * pArea->ulRecCount, FS_SET ); + hb_fsSeekLarge( pArea->hDataFile, ( HB_FOFFSET ) pArea->uiHeaderLen + + ( HB_FOFFSET ) pArea->uiRecordLen * + ( HB_FOFFSET ) pArea->ulRecCount, FS_SET ); hb_fsWrite( pArea->hDataFile, ( BYTE * ) "\032", 1 ); hb_fsWrite( pArea->hDataFile, NULL, 0 ); } diff --git a/harbour/source/rdd/dbfcdx/dbfcdx1.c b/harbour/source/rdd/dbfcdx/dbfcdx1.c index 53c5bc1e04..9544fbb766 100644 --- a/harbour/source/rdd/dbfcdx/dbfcdx1.c +++ b/harbour/source/rdd/dbfcdx/dbfcdx1.c @@ -56,6 +56,8 @@ #define HB_CDX_CLIP_AUTOPEN #define HB_CDX_PACKTRAIL +#define HB_CDX_NEW_SORT + #define HB_CDX_DBGCODE /* @@ -734,12 +736,9 @@ static LPCDXKEY hb_cdxKeyEval( LPCDXKEY pKey, LPCDXTAG pTag, BOOL fSetWA ) pKey = hb_cdxKeyPutItem( pKey, pItem, pArea->ulRecNo, pTag, FALSE, TRUE ); hb_itemRelease( pItem ); } - else if ( hb_itemType( pTag->pKeyItem ) == HB_IT_BLOCK ) + else if ( HB_IS_BLOCK( pTag->pKeyItem ) ) { - hb_vmPushSymbol( &hb_symEval ); - hb_vmPush( pTag->pKeyItem ); - hb_vmSend( 0 ); - pKey = hb_cdxKeyPutItem( pKey, hb_stackReturnItem(), pArea->ulRecNo, pTag, FALSE, TRUE ); + pKey = hb_cdxKeyPutItem( pKey, hb_vmEvalBlock( pTag->pKeyItem ), pArea->ulRecNo, pTag, FALSE, TRUE ); } else { @@ -798,12 +797,9 @@ static BOOL hb_cdxEvalCond( CDXAREAP pArea, PHB_ITEM pCondItem, BOOL fSetWA ) iCurrArea = 0; } - if ( hb_itemType( pCondItem ) == HB_IT_BLOCK ) + if ( HB_IS_BLOCK( pCondItem ) ) { - hb_vmPushSymbol( &hb_symEval ); - hb_vmPush( pCondItem ); - hb_vmSend( 0 ); - fRet = hb_itemGetL( hb_stackReturnItem() ); + fRet = hb_itemGetL( hb_vmEvalBlock( pCondItem ) ); } else { @@ -827,7 +823,7 @@ static BOOL hb_cdxEvalSeekCond( LPCDXTAG pTag, PHB_ITEM pCondItem ) BOOL fRet; HB_ITEM ItemKey; - if ( hb_itemType( pCondItem ) != HB_IT_BLOCK ) + if ( ! HB_IS_BLOCK( pCondItem ) ) return TRUE; ItemKey.type = HB_IT_NIL; @@ -4245,7 +4241,6 @@ static BOOL hb_cdxTagKeyDel( LPCDXTAG pTag, LPCDXKEY pKey ) if ( hb_cdxTagKeyFind( pTag, pKey ) != 0 ) { hb_cdxPageKeyRemove( pTag->RootPage ); - //pTag->rawKeyCount--; pTag->curKeyState &= ~( CDX_CURKEY_RAWPOS | CDX_CURKEY_LOGPOS | CDX_CURKEY_RAWCNT | CDX_CURKEY_LOGCNT ); pTag->CurKey->rec = 0; @@ -5291,7 +5286,7 @@ static BOOL hb_cdxDBOISkipRegEx( CDXAREAP pArea, LPCDXTAG pTag, BOOL fForward, return fForward ? pArea->fPositioned : !pArea->fBof; } - if ( hb_isregexstring( pRegExItm ) ) // ( pRegExItm->item.asString.length > 3 && memcmp( szMask, "***", 3 ) == 0 ) + if ( hb_isregexstring( pRegExItm ) ) { pReg = (regex_t *) ( szMask + 3 ); } @@ -7890,7 +7885,7 @@ static void hb_cdxSortWritePage( LPCDXSORTINFO pSort ) pSort->szTempFileName = hb_strdup( ( char * ) szName ); } pSort->pSwapPage[ pSort->ulCurPage ].ulKeys = pSort->ulKeys; - pSort->pSwapPage[ pSort->ulCurPage ].nOffset = hb_fsSeek( pSort->hTempFile, 0, SEEK_END ); + pSort->pSwapPage[ pSort->ulCurPage ].nOffset = hb_fsSeekLarge( pSort->hTempFile, 0, SEEK_END ); if ( hb_fsWriteLarge( pSort->hTempFile, pSort->pKeyPool, ulSize ) != ulSize ) { hb_errInternal( 9999, "hb_cdxSortWritePage: Write error in temporary file.", "", "" ); @@ -7899,31 +7894,137 @@ static void hb_cdxSortWritePage( LPCDXSORTINFO pSort ) pSort->ulCurPage++; } +static void hb_cdxSortGetPageKey( LPCDXSORTINFO pSort, ULONG ulPage, + BYTE ** pKeyVal, ULONG *pulRec ) +{ + int iLen = pSort->keyLen; + + if ( pSort->pSwapPage[ ulPage ].ulKeyBuf == 0 ) + { + ULONG ulKeys = HB_MIN( pSort->ulPgKeys, pSort->pSwapPage[ ulPage ].ulKeys ); + ULONG ulSize = ulKeys * ( iLen + 4 ); + + if ( hb_fsSeekLarge( pSort->hTempFile, pSort->pSwapPage[ ulPage ].nOffset, SEEK_SET ) != pSort->pSwapPage[ ulPage ].nOffset || + hb_fsReadLarge( pSort->hTempFile, pSort->pSwapPage[ ulPage ].pKeyPool, ulSize ) != ulSize ) + { + hb_errInternal( 9999, "hb_cdxSortGetPageKey: Read error from temporary file.", "", "" ); + } + pSort->pSwapPage[ ulPage ].nOffset += ulSize; + pSort->pSwapPage[ ulPage ].ulKeyBuf = ulKeys; + pSort->pSwapPage[ ulPage ].ulCurKey = 0; + } + *pKeyVal = &pSort->pSwapPage[ ulPage ].pKeyPool[ pSort->pSwapPage[ ulPage ].ulCurKey * ( iLen + 4 ) ]; + *pulRec = HB_GET_LE_UINT32( *pKeyVal + iLen ); +} + +#ifdef HB_CDX_NEW_SORT +static void hb_cdxSortOrderPages( LPCDXSORTINFO pSort ) +{ + int iLen = pSort->keyLen, i; + LONG l, r, m; + ULONG n, ulPage, ulRec; + BYTE *pKey = NULL, *pTmp; + + pSort->ulFirst = 0; + pSort->pSortedPages = ( ULONG * ) hb_xgrab( pSort->ulPages * sizeof( ULONG ) ); + pSort->pSortedPages[ 0 ] = 0; + + if ( pSort->ulTotKeys > 0 ) + { + for ( n = 0; n < pSort->ulPages; n++ ) + { + hb_cdxSortGetPageKey( pSort, n, &pKey, &ulRec ); + l = 0; + r = n - 1; + while ( l <= r ) + { + m = ( l + r ) >> 1; + ulPage = pSort->pSortedPages[ m ]; + pTmp = &pSort->pSwapPage[ ulPage ].pKeyPool[ pSort->pSwapPage[ ulPage ].ulCurKey * ( iLen + 4 ) ]; + i = hb_cdxValCompare( pSort->pTag, pKey, iLen, pTmp, iLen, TRUE ); + if ( i == 0 ) + i = ( ulRec < HB_GET_LE_UINT32( &pTmp[ iLen ] ) ) ? -1 : 1; + if ( i > 0 ) + l = m + 1; + else + r = m - 1; + } + for ( r = n; r > l; r-- ) + pSort->pSortedPages[ r ] = pSort->pSortedPages[ r - 1 ]; + pSort->pSortedPages[ l ] = n; + } + } +} + +static BOOL hb_cdxSortKeyGet( LPCDXSORTINFO pSort, BYTE ** pKeyVal, ULONG *pulRec ) +{ + int iLen = pSort->keyLen, i; + LONG l, r, m; + ULONG ulPage; + + ulPage = pSort->pSortedPages[ pSort->ulFirst ]; + + /* check if first page has some keys yet */ + if ( pSort->pSwapPage[ ulPage ].ulKeys > 0 ) + { + BYTE *pKey, *pTmp; + ULONG ulRec; + + hb_cdxSortGetPageKey( pSort, ulPage, &pKey, &ulRec ); + + l = pSort->ulFirst + 1; + r = pSort->ulPages - 1; + while ( l <= r ) + { + m = ( l + r ) >> 1; + ulPage = pSort->pSortedPages[ m ]; + pTmp = &pSort->pSwapPage[ ulPage ].pKeyPool[ pSort->pSwapPage[ ulPage ].ulCurKey * ( iLen + 4 ) ]; + i = hb_cdxValCompare( pSort->pTag, pKey, iLen, pTmp, iLen, TRUE ); + if ( i == 0 ) + i = ( ulRec < HB_GET_LE_UINT32( &pTmp[ iLen ] ) ) ? -1 : 1; + + if ( i > 0 ) + l = m + 1; + else + r = m - 1; + } + if ( l > ( LONG ) pSort->ulFirst + 1 ) + { + ulPage = pSort->pSortedPages[ pSort->ulFirst ]; + for ( r = pSort->ulFirst + 1; r < l; r++ ) + pSort->pSortedPages[ r - 1 ] = pSort->pSortedPages[ r ]; + pSort->pSortedPages[ l - 1 ] = ulPage; + } + } + else + { + pSort->ulFirst++; + } + if ( pSort->ulFirst < pSort->ulPages ) + { + ulPage = pSort->pSortedPages[ pSort->ulFirst ]; + hb_cdxSortGetPageKey( pSort, ulPage, pKeyVal, pulRec ); + pSort->pSwapPage[ ulPage ].ulCurKey++; + pSort->pSwapPage[ ulPage ].ulKeys--; + pSort->pSwapPage[ ulPage ].ulKeyBuf--; + return TRUE; + } + return FALSE; +} + +#else + static BOOL hb_cdxSortKeyGet( LPCDXSORTINFO pSort, BYTE ** pKeyVal, ULONG *pulRec ) { int i, iLen = pSort->keyLen; - ULONG ulPage, ulKeyPage = 0, ulRec = 0; + ULONG ulPage, ulKeyPage = 0, ulRec = 0, ulRecTmp; BYTE *pKey = NULL, *pTmp; for ( ulPage = 0; ulPage < pSort->ulPages; ulPage++ ) { if ( pSort->pSwapPage[ ulPage ].ulKeys > 0 ) { - if ( pSort->pSwapPage[ ulPage ].ulKeyBuf == 0 ) - { - ULONG ulKeys = HB_MIN( pSort->ulPgKeys, pSort->pSwapPage[ ulPage ].ulKeys ); - ULONG ulSize = ulKeys * ( pSort->keyLen + 4 ); - - if ( hb_fsSeek( pSort->hTempFile, pSort->pSwapPage[ ulPage ].nOffset, SEEK_SET ) != pSort->pSwapPage[ ulPage ].nOffset || - hb_fsReadLarge( pSort->hTempFile, pSort->pSwapPage[ ulPage ].pKeyPool, ulSize ) != ulSize ) - { - hb_errInternal( 9999, "hb_cdxSortKeyGet: Read error from temporary file.", "", "" ); - } - pSort->pSwapPage[ ulPage ].nOffset += ulSize; - pSort->pSwapPage[ ulPage ].ulKeyBuf = ulKeys; - pSort->pSwapPage[ ulPage ].ulCurKey = 0; - } - pTmp = &pSort->pSwapPage[ ulPage ].pKeyPool[ pSort->pSwapPage[ ulPage ].ulCurKey * ( iLen + 4 ) ]; + hb_cdxSortGetPageKey( pSort, ulPage, &pTmp, &ulRecTmp ); if ( ! pKey ) { i = 1; @@ -7933,13 +8034,13 @@ static BOOL hb_cdxSortKeyGet( LPCDXSORTINFO pSort, BYTE ** pKeyVal, ULONG *pulRe i = hb_cdxValCompare( pSort->pTag, pKey, iLen, pTmp, iLen, TRUE ); if ( i == 0 ) { - i = ( ulRec < HB_GET_LE_UINT32( &pTmp[ iLen ] ) ) ? -1 : 1; + i = ( ulRec < ulRecTmp ) ? -1 : 1; } } if ( i > 0 ) { pKey = pTmp; - ulRec = HB_GET_LE_UINT32( &pKey[ iLen ] ); + ulRec = ulRecTmp; ulKeyPage = ulPage; } } @@ -7956,6 +8057,8 @@ static BOOL hb_cdxSortKeyGet( LPCDXSORTINFO pSort, BYTE ** pKeyVal, ULONG *pulRe return FALSE; } +#endif + static void hb_cdxSortKeyAdd( LPCDXSORTINFO pSort, ULONG ulRec, BYTE * pKeyVal, int iKeyLen ) { int iLen = pSort->keyLen; @@ -8053,6 +8156,10 @@ static void hb_cdxSortFree( LPCDXSORTINFO pSort ) { hb_xfree( pSort->pRecBuff ); } + if ( pSort->pSortedPages ) + { + hb_xfree( pSort->pSortedPages ); + } hb_xfree( pSort ); } @@ -8086,6 +8193,11 @@ static void hb_cdxSortOut( LPCDXSORTINFO pSort ) pSort->pSwapPage[ 0 ].ulCurKey = 0; pSort->pSwapPage[ 0 ].pKeyPool = pSort->pKeyPool; } + +#ifdef HB_CDX_NEW_SORT + hb_cdxSortOrderPages( pSort ); +#endif + for ( ulKey = 0; ulKey < pSort->ulTotKeys; ulKey++ ) { if ( ! hb_cdxSortKeyGet( pSort, &pKeyVal, &ulRec ) ) @@ -8273,9 +8385,10 @@ static void hb_cdxTagDoIndex( LPCDXTAG pTag ) else iRec = ulRecCount - ulRecNo + 1; - hb_fsSeek( pArea->hDataFile, - pArea->uiHeaderLen + ( ulRecNo - 1 ) * pArea->uiRecordLen, - FS_SET ); + hb_fsSeekLarge( pArea->hDataFile, + ( HB_FOFFSET ) pArea->uiHeaderLen + + ( HB_FOFFSET ) ( ulRecNo - 1 ) * + ( HB_FOFFSET ) pArea->uiRecordLen, FS_SET ); hb_fsReadLarge( pArea->hDataFile, pSort->pRecBuff, pArea->uiRecordLen * iRec ); iRecBuff = 0; } @@ -8300,12 +8413,9 @@ static void hb_cdxTagDoIndex( LPCDXTAG pTag ) { SELF_GETVALUE( ( AREAP ) pArea, pTag->nField, pItem ); } - else if ( hb_itemType( pTag->pKeyItem ) == HB_IT_BLOCK ) + else if ( HB_IS_BLOCK( pTag->pKeyItem ) ) { - hb_vmPushSymbol( &hb_symEval ); - hb_vmPush( pTag->pKeyItem ); - hb_vmSend( 0 ); - hb_itemCopy( pItem, hb_stackReturnItem() ); + hb_itemCopy( pItem, hb_vmEvalBlock( pTag->pKeyItem ) ); } else { diff --git a/harbour/source/rdd/dbfntx/dbfntx0.prg b/harbour/source/rdd/dbfntx/dbfntx0.prg index 60e549a515..d251392ad3 100644 --- a/harbour/source/rdd/dbfntx/dbfntx0.prg +++ b/harbour/source/rdd/dbfntx/dbfntx0.prg @@ -55,7 +55,7 @@ ANNOUNCE DBFNTX -init procedure DBFNTXInit +procedure DBFNTXInit REQUEST _DBFNTX diff --git a/harbour/source/rdd/dbfntx/dbfntx1.c b/harbour/source/rdd/dbfntx/dbfntx1.c index 16f2160c0f..8134e77043 100644 --- a/harbour/source/rdd/dbfntx/dbfntx1.c +++ b/harbour/source/rdd/dbfntx/dbfntx1.c @@ -619,7 +619,7 @@ static ERRCODE hb_ntxGoEof( NTXAREAP pArea ) LPTAGINFO lpCurTag = pArea->lpCurTag; pArea->lpCurTag = NULL; - retvalue = SUPER_GOTO( ( AREAP ) pArea, pArea->ulRecCount+1000 ); + retvalue = SUPER_GOTO( ( AREAP ) pArea, 0 ); if( pArea->ulRecCount ) pArea->fBof = lpCurTag->TagBOF = FALSE; pArea->fEof = lpCurTag->TagEOF = TRUE; @@ -2465,8 +2465,10 @@ static BOOL hb_ntxReadBuf( NTXAREAP pArea, BYTE* readBuffer, SHORT* numRecinBuf, if( *numRecinBuf == 0 ) { ULONG ulBufLen = pArea->uiRecordLen * 10; - hb_fsSeek( pArea->hDataFile, - pArea->uiHeaderLen + pArea->uiRecordLen * ( ulRecNo - 1 ), FS_SET ); + hb_fsSeekLarge( pArea->hDataFile, + ( HB_FOFFSET ) pArea->uiHeaderLen + + ( HB_FOFFSET ) pArea->uiRecordLen * + ( HB_FOFFSET ) ( ulRecNo - 1 ), FS_SET ); hb_fsReadLarge( pArea->hDataFile, readBuffer, ulBufLen ); } pArea->pRecord = readBuffer + (*numRecinBuf) * pArea->uiRecordLen; diff --git a/harbour/source/rdd/delim0.prg b/harbour/source/rdd/delim0.prg index 7de8a9b923..bca59ce8a6 100644 --- a/harbour/source/rdd/delim0.prg +++ b/harbour/source/rdd/delim0.prg @@ -60,4 +60,4 @@ init procedure DELIMInit rddRegister( "DELIM", RDT_TRANSFER ) -return \ No newline at end of file +return diff --git a/harbour/source/rdd/rddsys.prg b/harbour/source/rdd/rddsys.prg index a25441d834..f10247f542 100644 --- a/harbour/source/rdd/rddsys.prg +++ b/harbour/source/rdd/rddsys.prg @@ -66,4 +66,3 @@ PROCEDURE RddInit __rddSetDefault( "DBFNTX" ) return - diff --git a/harbour/source/rdd/sdf0.prg b/harbour/source/rdd/sdf0.prg index 98fb03cfba..8ae5a3ad75 100644 --- a/harbour/source/rdd/sdf0.prg +++ b/harbour/source/rdd/sdf0.prg @@ -60,4 +60,4 @@ init procedure SDFInit rddRegister( "SDF", RDT_TRANSFER ) -return \ No newline at end of file +return diff --git a/harbour/source/rdd/workarea.c b/harbour/source/rdd/workarea.c index f0f20dcaf4..b03be5ea7a 100644 --- a/harbour/source/rdd/workarea.c +++ b/harbour/source/rdd/workarea.c @@ -956,9 +956,11 @@ ERRCODE hb_waRelEval( AREAP pArea, LPDBRELINFO pRelInfo ) sInfo.scopeValue = pResult; sInfo.nScope = 0; - SELF_SETSCOPE( pArea, (LPDBORDSCOPEINFO) &sInfo ); + if ( SELF_SETSCOPE( pArea, (LPDBORDSCOPEINFO) &sInfo ) == FAILURE ) + return FAILURE; sInfo.nScope = 1; - SELF_SETSCOPE( pArea, (LPDBORDSCOPEINFO) &sInfo ); + if ( SELF_SETSCOPE( pArea, (LPDBORDSCOPEINFO) &sInfo ) == FAILURE ) + return FAILURE; } if( SELF_SEEK( pArea, 0, pResult, 0 ) == SUCCESS ) return SUCCESS; @@ -1230,11 +1232,23 @@ ERRCODE hb_waError( AREAP pArea, PHB_ITEM pError ) */ ERRCODE hb_waEvalBlock( AREAP pArea, PHB_ITEM pBlock ) { + int iCurrArea; + HB_TRACE(HB_TR_DEBUG, ("hb_waEvalBlock(%p, %p)", pArea, pBlock)); if( ! pArea->valResult ) pArea->valResult = hb_itemNew( NULL ); + iCurrArea = hb_rddGetCurrentWorkAreaNumber(); + if ( iCurrArea != pArea->uiArea ) + hb_rddSelectWorkAreaNumber( pArea->uiArea ); + else + iCurrArea = 0; + hb_itemCopy( pArea->valResult, hb_vmEvalBlock( pBlock ) ); + + if ( iCurrArea ) + hb_rddSelectWorkAreaNumber( iCurrArea ); + return SUCCESS; } diff --git a/harbour/source/rtl/filesys.c b/harbour/source/rtl/filesys.c index 35e92c9b05..99cf62fffc 100644 --- a/harbour/source/rtl/filesys.c +++ b/harbour/source/rtl/filesys.c @@ -195,6 +195,10 @@ #define O_BINARY 0 /* O_BINARY not defined on Linux */ #endif +#ifndef O_LARGEFILE + #define O_LARGEFILE 0 /* O_LARGEFILE is used for LFS in 32-bit Linux */ +#endif + #ifndef S_IEXEC #define S_IEXEC 0x0040 /* owner may execute */ #endif @@ -309,8 +313,8 @@ static int convert_open_flags( USHORT uiFlags ) HB_TRACE(HB_TR_DEBUG, ("convert_open_flags(%hu)", uiFlags)); - result_flags |= O_BINARY; - HB_TRACE(HB_TR_INFO, ("convert_open_flags: added O_BINARY\n")); + result_flags |= O_BINARY | O_LARGEFILE; + HB_TRACE(HB_TR_INFO, ("convert_open_flags: added O_BINARY | O_LARGEFILE\n")); #if defined(HB_FS_SOPEN) if( ( uiFlags & ( FO_WRITE | FO_READWRITE ) ) == FO_READ ) @@ -434,7 +438,7 @@ static void convert_create_flags( USHORT uiFlags, int * result_flags, unsigned * HB_TRACE(HB_TR_DEBUG, ("convert_create_flags(%hu, %p, %p)", uiFlags, result_flags, result_pmode)); /* by default FC_NORMAL is set */ - *result_flags = O_BINARY | O_CREAT | O_TRUNC | O_RDWR; + *result_flags = O_BINARY | O_CREAT | O_TRUNC | O_RDWR | O_LARGEFILE; *result_pmode = convert_pmode_flags( uiFlags ); HB_TRACE(HB_TR_INFO, ("convert_create_flags: 0x%04x, 0x%04x\n", *result_flags, *result_pmode)); @@ -444,14 +448,8 @@ static void convert_create_flags_ex( USHORT uiAttr, USHORT uiFlags, int * result { HB_TRACE(HB_TR_DEBUG, ("convert_create_flags_ex(%hu, %hu, %p, %p)", uiAttr, uiFlags, result_flags, result_pmode)); - /* by default FC_NORMAL is set */ - - /* *result_flags = O_BINARY | O_CREAT | O_TRUNC | O_RDWR; */ - *result_flags = convert_open_flags( uiFlags ) | O_BINARY | O_CREAT | O_TRUNC | O_RDWR; - if ( uiFlags & FO_EXCL ) - *result_flags |= O_EXCL; - - *result_pmode = convert_pmode_flags( uiAttr ); + convert_create_flags( uiAttr, result_flags, result_pmode ); + *result_flags |= convert_open_flags( uiFlags ); HB_TRACE(HB_TR_INFO, ("convert_create_flags: 0x%04x, 0x%04x\n", *result_flags, *result_pmode)); } diff --git a/harbour/source/vm/harbinit.prg b/harbour/source/vm/harbinit.prg index e3ce8cb1cd..079cc0d1fb 100644 --- a/harbour/source/vm/harbinit.prg +++ b/harbour/source/vm/harbinit.prg @@ -67,7 +67,13 @@ PROCEDURE CLIPPER530() #endif -INIT PROCEDURE ClipInit +/* + * because on some platform the execution order of init functions + * is out of Harbour control then this function has to be called + * explicitly in VM initialization process before hb_vmDoInitFunctions() + * and not depends on INIT clause. + */ +PROCEDURE ClipInit MEMVAR GetList diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 257af0fc36..db97846554 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -298,7 +298,21 @@ ULONG _System OS2TermHandler(PEXCEPTIONREPORTRECORD p1, PVOID pv); #endif -void hb_vmDoInitRdd( void ) +/* call CLIPINIT function to initialize ErrorBlock() and __SetHelpK() */ +static void hb_vmDoInitClip( void ) +{ + PHB_DYNS pDynSym = hb_dynsymFind( "CLIPINIT" ); + + if( pDynSym && pDynSym->pSymbol->value.pFunPtr ) + { + hb_vmPushSymbol( pDynSym->pSymbol ); + hb_vmPushNil(); + hb_vmDo(0); + } +} + +/* Initialize linked RDDs */ +static void hb_vmDoInitRdd( void ) { PHB_DYNS pDynSym; int i; @@ -363,7 +377,7 @@ void HB_EXPORT hb_vmInit( BOOL bStartMainProc ) /* Check for some internal switches */ s_VMFlags = hb_cmdargProcessVM( &s_VMCancelKey, &s_VMCancelKeyEx ); - hb_inkeySetCancelKeys( s_VMCancelKey, s_VMCancelKeyEx ); + hb_inkeySetCancelKeys( s_VMCancelKey, s_VMCancelKeyEx ); /* Initialize opcodes profiler support arrays */ { @@ -381,7 +395,14 @@ void HB_EXPORT hb_vmInit( BOOL bStartMainProc ) * because INIT function can use static variables */ hb_vmDoInitStatics(); - hb_vmDoInitRdd(); + /* call CLIPINIT function to initialize ErrorBlock() and __SetHelpK() + * Because on some platform the execution order of init functions + * is out of Harbour control then this function has to be called + * explicitly in VM initialization process before hb_vmDoInitFunctions() + * and not depends on INIT clause. + */ + hb_vmDoInitClip(); + hb_vmDoInitRdd(); /* initialize the Harbour's RDDs */ hb_vmDoInitFunctions(); /* process defined INIT functions */ /* This is undocumented CA-Clipper, if there's a function called _APPMAIN @@ -510,11 +531,12 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) { LONG w = 0; BOOL bCanRecover = FALSE; + BYTE curPCode; ULONG ulPrivateBase; ULONG ulLastOpcode = 0; /* opcodes profiler support */ ULONG ulPastClock = 0; /* opcodes profiler support */ #ifndef HB_GUI - static unsigned int uiPolls = 1; + static unsigned short uiPolls = 1; #endif HB_TRACE(HB_TR_DEBUG, ("hb_vmExecute(%p, %p)", pCode, pSymbols)); @@ -530,7 +552,7 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) if( hb_bProfiler ) ulPastClock = ( ULONG ) clock(); - while( pCode[ w ] != HB_P_ENDPROC ) + while( ( curPCode = pCode[ w ] ) != HB_P_ENDPROC ) { if( hb_bProfiler ) { @@ -567,7 +589,7 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) } #endif - switch( pCode[ w ] ) + switch( curPCode ) { /* Operators ( mathematical / character / misc ) */