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

19990912-20:30 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-12 18:42:02 +00:00
parent 1caac178d1
commit 0efb6a77d4
7 changed files with 353 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
harbour/ChangeLog
View File

@@ -1,3 +1,24 @@
19990912-20:30 GMT+1 Victor Szel <info@szelvesz.hu>
+ __MVSAVE()/__MVRESTORE() .MEM file saving and restoring support added,
Clipper compatible, with extensions to __MVRESTORE() to only restore
varnames with a specified mask.
* source/rtl/itemapi.c
include/itemapi.h
+ hb_itemPutDL() added to set a date directly with a Julian date value.
* source/rtl/filesys.c
! hb_fsIsDrv() fixed bug when the original drive is not restored.
Thanks go to Jose Lalin for finding this.
* tests/working/statinit.prg
+ More meaningful messages are printed.
* source/rtl/extend.c
! hb_parcsiz() now only works for parameters passed by reference, just like
in CA-Cl*pper.
19990912-15:45 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*include/errorapi.h

1
harbour/include/itemapi.h
View File

@@ -74,6 +74,7 @@ extern PHB_ITEM hb_itemParam ( USHORT uiParam );
extern PHB_ITEM hb_itemPutC ( PHB_ITEM pItem, char * szText );
extern PHB_ITEM hb_itemPutCL ( PHB_ITEM pItem, char * szText, ULONG ulLen );
extern PHB_ITEM hb_itemPutDS ( PHB_ITEM pItem, char * szDate );
extern PHB_ITEM hb_itemPutDL ( PHB_ITEM pItem, long lJulian );
extern PHB_ITEM hb_itemPutL ( PHB_ITEM pItem, BOOL bValue );
extern PHB_ITEM hb_itemPutND ( PHB_ITEM pItem, double dNumber );
extern PHB_ITEM hb_itemPutNI ( PHB_ITEM pItem, int iNumber );

30
harbour/source/rtl/extend.c
View File

@@ -144,8 +144,9 @@ ULONG hb_parclen( int iParam, ... )
return 0;
}
/* Same as _parclen() but returns the length including the */
/* terminating zero byte */
/* NOTE: Similar to _parclen() but returns the length including the
terminating zero byte, and it only works for parameters passed by
reference. */
ULONG hb_parcsiz( int iParam, ... )
{
@@ -158,22 +159,27 @@ ULONG hb_parcsiz( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
/* NOTE: hb_parcsiz() will only work for strings passed by reference.
CA-Cl*pper works like this. */
if( IS_BYREF( pItem ) )
{
pItem = hb_itemUnRef( pItem );
if( IS_STRING( pItem ) )
return pItem->item.asString.length + 1;
if( IS_STRING( pItem ) )
return pItem->item.asString.length + 1;
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
va_end( va );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
va_end( va );
return hb_arrayGetCLen( pItem, ulArrayIndex ) + 1;
return hb_arrayGetCLen( pItem, ulArrayIndex ) + 1;
}
}
}

3
harbour/source/rtl/filesys.c
View File

@@ -883,10 +883,11 @@ USHORT hb_fsIsDrv( BYTE nDrive )
else
{
uiResult = 0;
_chdrive( uiSave );
s_uiErrorLast = FS_ERROR;
}
_chdrive( uiSave );
#else
uiResult = 0;

16
harbour/source/rtl/itemapi.c
View File

@@ -4,7 +4,7 @@
/*
Harbour Project source code
The Item API
Copyright 1999 Antonio Linares <alinares@fivetech.com>
@@ -42,6 +42,7 @@
hb_itemReturnPtr()
hb_itemDo() ( based on HB_DO() by Ryszard Glab )
hb_itemDoC() ( based on HB_DO() by Ryszard Glab )
hb_itemPutDL()
hb_itemPutNI()
hb_itemGetNI()
hb_itemGetCPtr()
@@ -563,6 +564,19 @@ PHB_ITEM hb_itemPutDS( PHB_ITEM pItem, char * szDate )
return pItem;
}
PHB_ITEM hb_itemPutDL( PHB_ITEM pItem, long lJulian )
{
if( pItem )
hb_itemClear( pItem );
else
pItem = hb_itemNew( NULL );
pItem->type = IT_DATE;
pItem->item.asDate.value = lJulian;
return pItem;
}
PHB_ITEM hb_itemPutL( PHB_ITEM pItem, BOOL bValue )
{
if( pItem )

297
harbour/source/rtl/memvars.c
View File

@@ -34,11 +34,28 @@
their web site at http://www.gnu.org/).
*/
#include <ctype.h> /* for toupper() function */
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
HB___MVSAVE()
HB___MVRESTORE() (Thanks to Dave Pearson and Jo French for the original
Clipper function (FReadMen()) to read .MEM files)
HB___MSAVE()
HB___MRESTORE()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#include <limits.h> /* for __MVSAVE()/__MVRESTORE() */
#include <ctype.h> /* for toupper() function */
#include "extend.h"
#include "itemapi.h"
#include "errorapi.h"
#include "dates.h" /* for __MVSAVE()/__MVRESTORE() */
#include "filesys.h" /* for __MVSAVE()/__MVRESTORE() */
#include "error.ch"
#include "memvars.ch"
@@ -59,7 +76,8 @@ static HB_VALUE_PTR s_globalTable = NULL;
#define TABLE_INITHB_VALUE 100
#define TABLE_EXPANDHB_VALUE 50
struct mv_PUBLIC_var_info {
struct mv_PUBLIC_var_info
{
int iPos;
BOOL bFound;
HB_DYNS_PTR pDynSym;
@@ -606,7 +624,7 @@ static int hb_memvarScope( char * szVarName, ULONG ulLength )
memcpy( szName, szVarName, ulLength );
pDynVar = hb_dynsymFind( hb_strUpper( szName, ulLength - 1 ) );
if( pDynVar )
iMemvar =hb_memvarScopeGet( pDynVar );
iMemvar = hb_memvarScopeGet( pDynVar );
else
iMemvar = MV_NOT_FOUND;
hb_xfree( szName );
@@ -714,7 +732,7 @@ static HB_ITEM_PTR hb_memvarDebugVariable( int iScope, int iPos, char * *pszName
HB_DYNS_PTR pDynSym = s_privateStack[ iPos ];
pValue =&s_globalTable[ pDynSym->hMemvar ].item;
*pszName =pDynSym->pSymbol->szName;
*pszName = pDynSym->pSymbol->szName;
}
}
}
@@ -1043,7 +1061,7 @@ HARBOUR HB___MVRELEASE( void )
bIncludeVar = TRUE;
if( pMask->item.asString.value[ 0 ] == '*' )
bIncludeVar =TRUE; /* delete all memvar variables */
bIncludeVar = TRUE; /* delete all memvar variables */
hb_memvarReleaseWithMask( pMask->item.asString.value, bIncludeVar );
}
}
@@ -1310,7 +1328,7 @@ HARBOUR HB___MVDBGINFO( void )
}
else
{
pValue =hb_itemNew( NULL );
pValue = hb_itemNew( NULL );
hb_itemReturn( pValue ); /* return NIL value */
hb_itemRelease( pValue );
@@ -1481,14 +1499,277 @@ HARBOUR HB___MVPUT( void )
}
}
#define HB_MEM_REC_LEN 32
#define HB_MEM_NUM_LEN 8
HARBOUR HB___MVSAVE( void )
{
/* TODO: */
if( ISCHAR( 1 ) && ISCHAR( 2 ) && ISLOG( 3 ) )
{
PHB_FNAME pFileName;
char szFileName[ _POSIX_PATH_MAX + 1 ];
FHANDLE fhnd;
/* Generate filename */
pFileName = hb_fsFNameSplit( hb_parc( 1 ) );
if( pFileName->szExtension == NULL )
pFileName->szExtension = ".mem";
hb_fsFNameMerge( szFileName, pFileName );
hb_xfree( pFileName );
/* Create .MEM file */
while( ( fhnd = hb_fsCreate( ( BYTE * ) szFileName, FC_NORMAL ) ) == FS_ERROR )
{
WORD wResult = hb_errRT_BASE_Ext1( EG_CREATE, 2006, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY );
if( wResult == E_DEFAULT || wResult == E_BREAK )
break;
}
if( fhnd != FS_ERROR )
{
char * pszMask = hb_parc( 2 );
BOOL bIncludeMask = hb_parl( 3 );
BYTE buffer[ HB_MEM_REC_LEN ];
/* Walk through all visible memory variables */
ULONG ulBase = s_privateStackCnt;
PHB_DYNS pDynVar;
while( ulBase > s_privateStackBase )
{
--ulBase;
pDynVar = s_privateStack[ ulBase ];
if( pDynVar->hMemvar )
{
BOOL bMatch = ( pszMask[ 0 ] == '*' || hb_strMatchRegExp( pDynVar->pSymbol->szName, pszMask ) );
/* Process it if it matches the passed mask */
if( bIncludeMask ? bMatch : ! bMatch )
{
PHB_ITEM pItem = &s_globalTable[ pDynVar->hMemvar ].item;
memset( buffer, 0, HB_MEM_REC_LEN );
strcpy( buffer, pDynVar->pSymbol->szName );
if( IS_STRING( pItem ) && ( hb_itemGetCLen( pItem ) + 1 ) <= SHRT_MAX )
{
/* Store the closing zero byte, too */
USHORT uiLength = hb_itemGetCLen( pItem ) + 1;
buffer[ 11 ] = 'C' + 128;
buffer[ 16 ] = LOBYTE( uiLength );
buffer[ 17 ] = HIBYTE( uiLength );
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
hb_fsWrite( fhnd, hb_itemGetCPtr( pItem ), uiLength );
}
else if( IS_NUMERIC( pItem ) )
{
double dNumber = hb_itemGetND( pItem );
int iWidth;
int iDec;
hb_itemGetNLen( pItem, &iWidth, &iDec );
buffer[ 11 ] = 'N' + 128;
buffer[ 16 ] = ( BYTE ) iWidth + ( iDec ? iDec + 1 : 0 );
buffer[ 17 ] = ( BYTE ) iDec;
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
hb_fsWrite( fhnd, ( BYTE * ) &dNumber, sizeof( dNumber ) );
}
else if( IS_DATE( pItem ) )
{
double dNumber = ( double ) hb_itemGetNL( pItem );
buffer[ 11 ] = 'D' + 128;
buffer[ 16 ] = sizeof( dNumber );
buffer[ 17 ] = 0;
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
hb_fsWrite( fhnd, ( BYTE * ) &dNumber, sizeof( dNumber ) );
}
else if( IS_LOGICAL( pItem ) )
{
BYTE byLogical[ 1 ];
buffer[ 11 ] = 'L' + 128;
buffer[ 16 ] = sizeof( BYTE );
buffer[ 17 ] = 0;
byLogical[ 0 ] = hb_itemGetL( pItem ) ? 1 : 0;
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
hb_fsWrite( fhnd, byLogical, sizeof( BYTE ) );
}
}
}
}
buffer[ 0 ] = '\x1A';
hb_fsWrite( fhnd, buffer, 1 );
hb_fsClose( fhnd );
}
}
else
hb_errRT_BASE( EG_ARG, 2008, NULL, "__MSAVE" );
}
/* NOTE: There's an extension in Harbour, which makes it possible to only
load (or not load) variables names with a specific name mask. */
HARBOUR HB___MVRESTORE( void )
{
/* TODO: */
if( ISCHAR( 1 ) && ISLOG( 2 ) )
{
PHB_FNAME pFileName;
char szFileName[ _POSIX_PATH_MAX + 1 ];
FHANDLE fhnd;
BOOL bAdditive = hb_parl( 2 );
/* Clear all memory variables if not ADDITIVE */
if( ! bAdditive )
hb_dynsymEval( hb_memvarClear, NULL );
/* Generate filename */
pFileName = hb_fsFNameSplit( hb_parc( 1 ) );
if( pFileName->szExtension == NULL )
pFileName->szExtension = ".mem";
hb_fsFNameMerge( szFileName, pFileName );
hb_xfree( pFileName );
/* Open .MEM file */
while( ( fhnd = hb_fsOpen( ( BYTE * ) szFileName, FO_READ /* | FO_SHARED */ ) ) == FS_ERROR )
{
WORD wResult = hb_errRT_BASE_Ext1( EG_OPEN, 2005, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY );
if( wResult == E_DEFAULT || wResult == E_BREAK )
break;
}
if( fhnd != FS_ERROR )
{
char * pszMask = ISCHAR( 3 ) ? hb_parc( 3 ) : "*";
BOOL bIncludeMask = ISCHAR( 4 ) ? hb_parl( 4 ) : TRUE;
BYTE buffer[ HB_MEM_REC_LEN ];
while( hb_fsRead( fhnd, buffer, HB_MEM_REC_LEN ) == HB_MEM_REC_LEN )
{
PHB_ITEM pName = hb_itemPutC( NULL, ( char * ) buffer );
USHORT uiType = ( USHORT ) ( buffer[ 11 ] - 128 );
USHORT uiWidth = ( USHORT ) buffer[ 16 ];
USHORT uiDec = ( USHORT ) buffer[ 17 ];
PHB_ITEM pItem = NULL;
switch( uiType )
{
case 'C':
{
BYTE * pbyString;
uiWidth += uiDec * 256;
pbyString = ( BYTE * ) hb_xgrab( uiWidth );
if( hb_fsRead( fhnd, pbyString, uiWidth ) == uiWidth )
pItem = hb_itemPutCL( NULL, pbyString, uiWidth - 1 );
hb_xfree( pbyString );
break;
}
case 'N':
{
BYTE pbyNumber[ HB_MEM_NUM_LEN ];
if( hb_fsRead( fhnd, pbyNumber, HB_MEM_NUM_LEN ) == HB_MEM_NUM_LEN )
{
double dNumber = * ( double * ) &pbyNumber;
if( uiWidth >= 1 && uiDec )
pItem = hb_itemPutNDLen( NULL, dNumber, uiWidth - ( uiDec + 1 ), uiDec );
else if( SHRT_MIN <= dNumber && dNumber <= SHRT_MAX )
pItem = hb_itemPutNILen( NULL, ( int ) dNumber, uiWidth );
else if( LONG_MIN <= dNumber && dNumber <= LONG_MAX )
pItem = hb_itemPutNLLen( NULL, ( long ) dNumber, uiWidth );
else
pItem = hb_itemPutNDLen( NULL, dNumber, uiWidth, 0 );
}
break;
}
case 'D':
{
BYTE pbyNumber[ HB_MEM_NUM_LEN ];
if( hb_fsRead( fhnd, pbyNumber, HB_MEM_NUM_LEN ) == HB_MEM_NUM_LEN )
pItem = hb_itemPutDL( NULL, ( long ) ( * ( double * ) &pbyNumber ) );
break;
}
case 'L':
{
BYTE pbyLogical[ 1 ];
if( hb_fsRead( fhnd, pbyLogical, 1 ) == 1 )
pItem = hb_itemPutL( NULL, pbyLogical[ 0 ] != 0 );
break;
}
}
if( pItem )
{
BOOL bMatch = ( pszMask[ 0 ] == '*' || hb_strMatchRegExp( hb_itemGetCPtr( pName ), pszMask ) );
/* Process it if it matches the passed mask */
if( bIncludeMask ? bMatch : ! bMatch )
{
/* the first parameter is a string with not empty variable name */
HB_DYNS_PTR pDynVar = hb_memvarFindSymbol( pName );
if( pDynVar )
/* variable was declared somwhere - assign a new value */
hb_memvarSetValue( pDynVar->pSymbol, pItem );
else
/* attempt to assign a value to undeclared variable create the PRIVATE one */
hb_memvarCreateFromDynSymbol( hb_dynsymGet( pName->item.asString.value ), VS_PRIVATE, pItem );
hb_itemReturn( pItem );
}
hb_itemRelease( pItem );
}
hb_itemRelease( pName );
}
hb_fsClose( fhnd );
}
else
hb_retl( FALSE );
}
else
hb_errRT_BASE( EG_ARG, 2007, NULL, "__MRESTORE" );
}
/* CA-Clipper 5.2e compatibility functions. */

8
harbour/tests/working/statinit.prg
View File

@@ -9,9 +9,15 @@ STATIC bBlock2 := {|| cMyPubVar }
FUNCTION Main()
? "This is a compiler test, so if you see this, the test was successful."
PUBLIC cMyPubVar := "Printed from a PUBLIC var from a codeblock assigned to a static variable."
Eval( bBlock1 )
? Eval( bBlock2 )
RETURN NIL
FUNCTION Hello()
? "Printed from a codeblock assigned to a static variable."
RETURN NIL