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

2013-12-18 21:05 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* include/Makefile
  + include/hbzlib.h
  * include/hbzlib.ch
  * src/rtl/Makefile
  * src/rtl/hbzlib.c
    + added new C functions weakly bound with ZLIB library:
         HB_SIZE hb_zlibCompressBound( HB_SIZE nLen );
         HB_SIZE hb_zlibUncompressedSize( const char * pSrc, HB_SIZE nLen,
                                          int * piResult );
         int hb_zlibCompress( char * pDst, HB_SIZE * pnDst,
                              const char * pSrc, HB_SIZE nLen, int iLevel );
         int hb_zlibUncompress( char * pDst, HB_SIZE * pnDst,
                                const char * pSrc, HB_SIZE nLen );
      these functions can be used by any C code without forcing ZLIB liking.
      If user usese in his code HB_ZCOMPRESS() function or has
         REQUEST HB_ZCOMPRESS
      then above funcitons are automatically bound with linked ZLIB library.
      Otherwise they return 0 or HB_ZLIB_RES_UNSUPPORTED error.

  * src/rdd/dbf1.c
    * small code simplification
    ; added note about alternative numeric value rounding when
      pure binary integer fields (without decimal places) are
      assigned.

  * src/common/hbdate.c
    ! added missing header for WinCE builds

  * include/hbexpra.c
    * minor simplification

  * src/vm/macro.c
    + added new implementation for MemVarBlock() function. It's much faster
      and does not force dynamic symbol table scanning on each call

  * src/rtl/Makefile
  - src/rtl/memvarbl.prg
    - removed previous implementation of MemVarBlock()

  * src/rtl/tgetint.prg
    ! fixed __Get() and __GetA() to return NIL when cVarName parameter
      is not string (CA-Cl*pper compatible)
    ! fixed __GetA() to return NIL when given aIndex parameter or value
      returned by variable block is not array (CA-Cl*pper compatible)
    ! fixed __Get() and __GetA() to use FieldWBlock() instead of manually
      created macro block which didn't respect workarea
      (CA-Cl*pper compatible)
    ! fixed __GetA() to create SET/GET block instead of access block
      (CA-Cl*pper compatible)
    ! fixed  __Get() and __GetA() to not create simple SET/GET macro
      blocks but always force memvar usage (CA-Cl*pper compatible).
      Please remember that
         &( "DATA" )
      gives code which tries to access field then memvar but
         &( "DATA := .T." )
      gives code which always tries to assign memvar and does not even
      check if "DATA" field exists in current WA. It means that macro
      compiled code like:
         &( "{|_1| iif( _1 == NIL, DATA, DATA := _1 ) }" )
      should not be used because gives higher priority for fields in
      access operation and always assigns memvars, if necessary creating
      them.
    ! allow to dynamically create memvars for get objects in error handler
      (CA-Cl*pper compatible)
    % use much faster MemVarBlock() instead of manually created codeblock
      which activates dynamic symbol table scanning on each call
This commit is contained in:
Przemysław Czerpak
2013-12-18 21:05:06 +01:00
parent 5df97ba47a
commit 4ffd5bb726
11 changed files with 284 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
ChangeLog.txt
View File

@@ -10,6 +10,74 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2013-12-18 21:05 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* include/Makefile
+ include/hbzlib.h
* include/hbzlib.ch
* src/rtl/Makefile
* src/rtl/hbzlib.c
+ added new C functions weakly bound with ZLIB library:
HB_SIZE hb_zlibCompressBound( HB_SIZE nLen );
HB_SIZE hb_zlibUncompressedSize( const char * pSrc, HB_SIZE nLen,
int * piResult );
int hb_zlibCompress( char * pDst, HB_SIZE * pnDst,
const char * pSrc, HB_SIZE nLen, int iLevel );
int hb_zlibUncompress( char * pDst, HB_SIZE * pnDst,
const char * pSrc, HB_SIZE nLen );
these functions can be used by any C code without forcing ZLIB liking.
If user usese in his code HB_ZCOMPRESS() function or has
REQUEST HB_ZCOMPRESS
then above funcitons are automatically bound with linked ZLIB library.
Otherwise they return 0 or HB_ZLIB_RES_UNSUPPORTED error.
* src/rdd/dbf1.c
* small code simplification
; added note about alternative numeric value rounding when
pure binary integer fields (without decimal places) are
assigned.
* src/common/hbdate.c
! added missing header for WinCE builds
* include/hbexpra.c
* minor simplification
* src/vm/macro.c
+ added new implementation for MemVarBlock() function. It's much faster
and does not force dynamic symbol table scanning on each call
* src/rtl/Makefile
- src/rtl/memvarbl.prg
- removed previous implementation of MemVarBlock()
* src/rtl/tgetint.prg
! fixed __Get() and __GetA() to return NIL when cVarName parameter
is not string (CA-Cl*pper compatible)
! fixed __GetA() to return NIL when given aIndex parameter or value
returned by variable block is not array (CA-Cl*pper compatible)
! fixed __Get() and __GetA() to use FieldWBlock() instead of manually
created macro block which didn't respect workarea
(CA-Cl*pper compatible)
! fixed __GetA() to create SET/GET block instead of access block
(CA-Cl*pper compatible)
! fixed __Get() and __GetA() to not create simple SET/GET macro
blocks but always force memvar usage (CA-Cl*pper compatible).
Please remember that
&( "DATA" )
gives code which tries to access field then memvar but
&( "DATA := .T." )
gives code which always tries to assign memvar and does not even
check if "DATA" field exists in current WA. It means that macro
compiled code like:
&( "{|_1| iif( _1 == NIL, DATA, DATA := _1 ) }" )
should not be used because gives higher priority for fields in
access operation and always assigns memvars, if necessary creating
them.
! allow to dynamically create memvars for get objects in error handler
(CA-Cl*pper compatible)
% use much faster MemVarBlock() instead of manually created codeblock
which activates dynamic symbol table scanning on each call
2013-12-10 06:04 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* ChangeLog.txt
* removed trailing spaces

1
include/Makefile
View File

@@ -78,6 +78,7 @@ C_HEADERS := \
hbxvm.h \
hbwince.h \
hbwinuni.h \
hbzlib.h \
hbznet.h \
hb_io.h \

5
include/hbexpra.c
View File

@@ -407,7 +407,6 @@ PHB_EXPR hb_compExprNewFunCall( PHB_EXPR pName, PHB_EXPR pParms, HB_COMP_DECL )
HB_COMP_EXPR_FREE( pFirst->pNext ); /* delete a second argument */
pArg->pNext = hb_compExprNewVar( szName, HB_COMP_PARAM );
pArg->pNext->pNext = pNext; /* restore third argument */
HB_COMP_EXPR_FREE( pFirst );
}
else
{
@@ -421,8 +420,8 @@ PHB_EXPR hb_compExprNewFunCall( PHB_EXPR pName, PHB_EXPR pParms, HB_COMP_DECL )
pArg->pNext = hb_compExprNewString( szText, strlen( szText ), HB_FALSE, HB_COMP_PARAM );
pArg->pNext->pNext = pNext;
}
HB_COMP_EXPR_FREE( pFirst ); /* delete first argument */
}
HB_COMP_EXPR_FREE( pFirst ); /* delete first argument */
}
else
{
@@ -455,6 +454,8 @@ PHB_EXPR hb_compExprNewFunCall( PHB_EXPR pName, PHB_EXPR pParms, HB_COMP_DECL )
*/
HB_COMP_EXPR_FREE( pArg );
pArg = hb_compExprNewNil( HB_COMP_PARAM );
if( HB_COMP_PARAM->iWarnings >= 2 )
hb_compGenWarning( HB_COMP_PARAM, hb_comp_szWarnings, 'W', HB_COMP_WARN_AMBIGUOUS_VAR, szVarName, NULL );
}
}
else

2
include/hbzlib.ch
View File

@@ -76,4 +76,6 @@
#define HB_ZLIB_RES_BUF_ERROR ( -5 )
#define HB_ZLIB_RES_VERSION_ERROR ( -6 )
#define HB_ZLIB_RES_UNSUPPORTED ( -10 )
#endif /* HB_ZLIB_CH_ */

34
src/rtl/memvarbl.prg → include/hbzlib.h
View File

@@ -1,8 +1,8 @@
/*
* Harbour Project source code:
* MemVarBlock() function
* dynamic reference to ZLIB functions
*
* Copyright 1999 Ryszard Glab <rglab@imid.med.pl>
* Copyright 2013 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -46,12 +46,30 @@
*
*/
#include "hbmemvar.ch"
#ifndef HB_ZLIB_H_
#define HB_ZLIB_H_
FUNCTION MemVarBlock( cMemvar )
#include "hbapi.h"
#include "hbzlib.ch"
IF HB_ISSTRING( cMemvar ) .AND. __mvExist( cMemvar )
RETURN {| x | iif( x == NIL, __mvGet( cMemvar ), __mvPut( cMemvar, x ) ) }
ENDIF
#if defined( _HB_ZLIB_INTERNAL_ )
RETURN NIL
typedef HB_SIZE ( * HB_ZLIB_CBOUND )( HB_SIZE );
typedef HB_SIZE ( * HB_ZLIB_UNSIZE )( const char *, HB_SIZE, int * );
typedef int ( * HB_ZLIB_COMPRS )( char *, HB_SIZE *, const char *, HB_SIZE, int );
typedef int ( * HB_ZLIB_UNCMPS )( char *, HB_SIZE *, const char *, HB_SIZE );
extern void hb_zlibInit( HB_ZLIB_CBOUND, HB_ZLIB_UNSIZE, HB_ZLIB_COMPRS, HB_ZLIB_UNCMPS );
#endif /* _HB_ZLIB_INTERNAL_ */
HB_EXTERN_BEGIN
extern HB_EXPORT HB_SIZE hb_zlibCompressBound( HB_SIZE nLen );
extern HB_EXPORT HB_SIZE hb_zlibUncompressedSize( const char * pSrc, HB_SIZE nLen, int * piResult );
extern HB_EXPORT int hb_zlibCompress( char * pDst, HB_SIZE * pnDst, const char * pSrc, HB_SIZE nLen, int iLevel );
extern HB_EXPORT int hb_zlibUncompress( char * pDst, HB_SIZE * pnDst, const char * pSrc, HB_SIZE nLen );
HB_EXTERN_END
#endif /* HB_ZLIB_H_ */

3
src/common/hbdate.c
View File

@@ -77,6 +77,9 @@
# include <sys/time.h>
#elif defined( HB_OS_WIN )
# include <windows.h>
# if defined( HB_OS_WIN_CE )
# include "hbwince.h"
# endif
#else
# include <sys/timeb.h>
# if defined( _MSC_VER )

27
src/rdd/dbf1.c
View File

@@ -2630,31 +2630,18 @@ static HB_ERRCODE hb_dbfPutValue( DBFAREAP pArea, HB_USHORT uiIndex, PHB_ITEM pI
double dVal;
int iSize;
if( pField->uiDec )
if( pField->uiDec || HB_IS_DOUBLE( pItem ) )
{
#if 0 /* this version rounds double values to nearest integer */
dVal = hb_numDecConv( hb_itemGetND( pItem ), -( int ) pField->uiDec );
lVal = ( HB_MAXINT ) dVal;
if( ! HB_DBL_LIM_INT64( dVal ) )
iSize = 99;
else
#ifndef HB_LONG_LONG_OFF
iSize = HB_LIM_INT8( lVal ) ? 1 :
( HB_LIM_INT16( lVal ) ? 2 :
( HB_LIM_INT24( lVal ) ? 3 :
( HB_LIM_INT32( lVal ) ? 4 : 8 ) ) );
#else
iSize = HB_DBL_LIM_INT8( dVal ) ? 1 :
( HB_DBL_LIM_INT16( dVal ) ? 2 :
( HB_DBL_LIM_INT24( dVal ) ? 3 :
( HB_DBL_LIM_INT32( dVal ) ? 4 : 8 ) ) );
#endif
}
else if( HB_IS_DOUBLE( pItem ) )
{
#else /* this one truncates double value to integer dropping fractional part */
dVal = hb_itemGetND( pItem );
if( pField->uiDec )
dVal = hb_numDecConv( dVal, -( int ) pField->uiDec );
#endif
lVal = ( HB_MAXINT ) dVal;
if( ! HB_DBL_LIM_INT64( dVal ) )
iSize = 99;
iSize = pField->uiLen + 1;
else
#ifndef HB_LONG_LONG_OFF
iSize = HB_LIM_INT8( lVal ) ? 1 :

2
src/rtl/Makefile
View File

@@ -114,6 +114,7 @@ C_SOURCES := \
hbstrsh.c \
hbtoken.c \
hbzlib.c \
hbzlibc.c \
hbzlibgz.c \
hbznet.c \
idle.c \
@@ -243,7 +244,6 @@ PRG_SOURCES := \
libname.prg \
listbox.prg \
memoedit.prg \
memvarbl.prg \
memvarhb.prg \
menuto.prg \
menusys.prg \

86
src/rtl/hbzlib.c
View File

@@ -46,9 +46,13 @@
*
*/
#define _HB_ZLIB_INTERNAL_
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbinit.h"
#include "hbzlib.h"
#include <zlib.h>
@@ -62,17 +66,21 @@
#endif
#if ! defined( _HB_Z_COMPRESSBOUND )
static uLong hb_zlibCompressBound( uLong ulLen )
{
return ulLen + ( ulLen >> 12 ) + ( ulLen >> 14 ) + ( ulLen >> 25 ) + 13;
}
#define compressBound( n ) hb_zlibCompressBound( n )
/* additional 12 bytes is for GZIP compression which uses bigger header */
#define deflateBound( s, n ) ( hb_zlibCompressBound( n ) + 12 )
#endif
static HB_SIZE hb_zlibUncompressedSize( const char * szSrc, HB_SIZE nLen,
int * piResult )
static HB_SIZE s_zlibCompressBound( HB_SIZE nLen )
{
#if ! defined( _HB_Z_COMPRESSBOUND )
return nLen + ( nLen >> 12 ) + ( nLen >> 14 ) + ( nLen >> 25 ) + 13;
#else
return compressBound( ( uLong ) nLen );
#endif
}
static HB_SIZE s_zlibUncompressedSize( const char * szSrc, HB_SIZE nLen,
int * piResult )
{
Byte buffer[ 1024 ];
z_stream stream;
@@ -110,8 +118,8 @@ static HB_SIZE hb_zlibUncompressedSize( const char * szSrc, HB_SIZE nLen,
return nDest;
}
static int hb_zlibUncompress( char * pDst, HB_SIZE * pnDst,
const char * pSrc, HB_SIZE nSrc )
static int s_zlibUncompress( char * pDst, HB_SIZE * pnDst,
const char * pSrc, HB_SIZE nSrc )
{
z_stream stream;
int iResult;
@@ -143,6 +151,19 @@ static int hb_zlibUncompress( char * pDst, HB_SIZE * pnDst,
return iResult;
}
static int s_zlibCompress( char * pDst, HB_SIZE * pnDst,
const char * pSrc, HB_SIZE nSrc, int level )
{
uLong ulDst = ( uLong ) *pnDst;
int iResult;
iResult = compress2( ( Bytef * ) pDst, &ulDst,
( Bytef * ) pSrc, ( uLong ) nSrc, level );
*pnDst = ulDst;
return iResult;
}
static int hb_gz_compress( char ** pDstPtr, HB_SIZE * pnDst,
const char * pSrc, HB_SIZE nSrc, int level )
{
@@ -210,9 +231,9 @@ HB_FUNC( HB_ZLIBVERSION )
HB_FUNC( HB_ZCOMPRESSBOUND )
{
if( HB_ISCHAR( 1 ) )
hb_retnint( compressBound( ( uLong ) hb_parclen( 1 ) ) );
hb_retnint( s_zlibCompressBound( hb_parclen( 1 ) ) );
else if( HB_ISNUM( 1 ) )
hb_retnint( compressBound( ( uLong ) hb_parns( 1 ) ) );
hb_retnint( s_zlibCompressBound( hb_parns( 1 ) ) );
else
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
@@ -231,7 +252,7 @@ HB_FUNC( HB_ZUNCOMPRESSLEN )
int iResult = Z_OK;
if( nLen )
nLen = hb_zlibUncompressedSize( szData, nLen, &iResult );
nLen = s_zlibUncompressedSize( szData, nLen, &iResult );
if( iResult == Z_OK )
hb_retnint( nLen );
@@ -259,40 +280,35 @@ HB_FUNC( HB_ZCOMPRESS )
if( nLen )
{
PHB_ITEM pBuffer = HB_ISBYREF( 2 ) ? hb_param( 2, HB_IT_STRING ) : NULL;
uLong ulDstLen;
HB_SIZE nDstLen;
char * pDest;
int iResult;
if( pBuffer )
{
HB_SIZE nDstLen;
if( ! hb_itemGetWriteCL( pBuffer, &pDest, &nDstLen ) )
pDest = NULL;
ulDstLen = ( uLong ) nDstLen;
}
else
{
ulDstLen = HB_ISNUM( 2 ) ? ( uLong ) hb_parns( 2 ) :
compressBound( ( uLong ) nLen );
pDest = ( char * ) hb_xalloc( ulDstLen + 1 );
nDstLen = HB_ISNUM( 2 ) ? ( HB_SIZE ) hb_parns( 2 ) :
s_zlibCompressBound( nLen );
pDest = ( char * ) hb_xalloc( nDstLen + 1 );
}
if( pDest )
{
if( HB_ISNUM( 4 ) )
iResult = compress2( ( Bytef * ) pDest, &ulDstLen, ( Bytef * ) szData, ( uLong ) nLen, hb_parni( 4 ) );
else
iResult = compress( ( Bytef * ) pDest, &ulDstLen, ( Bytef * ) szData, ( uLong ) nLen );
iResult = s_zlibCompress( pDest, &nDstLen, szData, nLen,
hb_parnidef( 4, Z_DEFAULT_COMPRESSION ) );
if( ! pBuffer )
{
if( iResult == Z_OK )
hb_retclen_buffer( pDest, ulDstLen );
hb_retclen_buffer( pDest, nDstLen );
else
hb_xfree( pDest );
}
else if( iResult == Z_OK )
hb_retclen( pDest, ulDstLen );
hb_retclen( pDest, nDstLen );
}
else
iResult = Z_MEM_ERROR;
@@ -336,7 +352,7 @@ HB_FUNC( HB_ZUNCOMPRESS )
else
{
nDstLen = HB_ISNUM( 2 ) ? ( HB_SIZE ) hb_parns( 2 ) :
hb_zlibUncompressedSize( szData, nLen, &iResult );
s_zlibUncompressedSize( szData, nLen, &iResult );
if( iResult == Z_OK )
{
pDest = ( char * ) hb_xalloc( nDstLen + 1 );
@@ -347,7 +363,7 @@ HB_FUNC( HB_ZUNCOMPRESS )
if( iResult == Z_OK )
{
iResult = hb_zlibUncompress( pDest, &nDstLen, szData, nLen );
iResult = s_zlibUncompress( pDest, &nDstLen, szData, nLen );
if( ! pBuffer )
{
@@ -377,9 +393,9 @@ HB_FUNC( HB_ZUNCOMPRESS )
HB_FUNC( HB_GZCOMPRESSBOUND )
{
if( HB_ISCHAR( 1 ) )
hb_retnint( compressBound( ( uLong ) hb_parclen( 1 ) ) + 12 );
hb_retnint( s_zlibCompressBound( ( uLong ) hb_parclen( 1 ) ) + 12 );
else if( HB_ISNUM( 1 ) )
hb_retnint( compressBound( ( uLong ) hb_parns( 1 ) ) + 12 );
hb_retnint( s_zlibCompressBound( ( uLong ) hb_parns( 1 ) ) + 12 );
else
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
@@ -468,3 +484,15 @@ HB_FUNC( HB_ZERROR )
hb_retc( zError( hb_parni( 1 ) ) );
#endif
}
HB_CALL_ON_STARTUP_BEGIN( _hb_zlib_init_ )
hb_zlibInit( s_zlibCompressBound, s_zlibUncompressedSize,
s_zlibCompress, s_zlibUncompress );
HB_CALL_ON_STARTUP_END( _hb_zlib_init_ )
#if defined( HB_PRAGMA_STARTUP )
#pragma startup _hb_zlib_init_
#elif defined( HB_DATASEG_STARTUP )
#define HB_DATASEG_BODY HB_DATASEG_FUNC( _hb_zlib_init_ )
#include "hbiniseg.h"
#endif

42
src/rtl/tgetint.prg
View File

@@ -46,20 +46,27 @@
*
*/
REQUEST hb_PValue
REQUEST PCount
FUNCTION __Get( bSetGet, cVarName, cPicture, bValid, bWhen )
LOCAL oGet
IF bSetGet == NIL
IF ! HB_ISSTRING( cVarName )
RETURN NIL
ENDIF
IF ! HB_ISBLOCK( bSetGet )
IF FieldPos( cVarName ) > 0
bSetGet := hb_macroBlock( "iif(PCount()==0,FIELD->" + cVarName + ",FIELD->" + cVarName + ":=hb_PValue(1))" )
ELSEIF __mvExist( cVarName )
bSetGet := {| _1 | iif( _1 == NIL, __mvGet( cVarName ), __mvPut( cVarName, _1 ) ) }
bSetGet := FieldWBlock( cVarName, Select() )
ELSE
bSetGet := hb_macroBlock( "iif(PCount()==0," + cVarName + "," + cVarName + ":=hb_PValue(1))" )
/* If cVarName is not a field name in current workarea then
* CA-Cl*pper always tries to create SET/GET block for memvar.
* Simple loop below with __mvGet() inside is small trick to
* force the same RTE as in CA-Cl*pper so user can create
* memvar dynamically in his custom error handler. [druzus]
*/
DO WHILE ( bSetGet := MemVarBlock( cVarName ) ) == NIL
__mvGet( cVarName )
ENDDO
ENDIF
ENDIF
@@ -74,16 +81,25 @@ FUNCTION __GetA( bGetArray, cVarName, cPicture, bValid, bWhen, aIndex )
LOCAL oGet
IF bGetArray == NIL
IF ! HB_ISSTRING( cVarName ) .OR. ! HB_ISARRAY( aIndex )
RETURN NIL
ENDIF
IF ! HB_ISBLOCK( bGetArray )
/* CA-Cl*pper creates standard SET/GET block here */
IF FieldPos( cVarName ) > 0
bGetArray := hb_macroBlock( "FIELD->" + cVarName )
ELSEIF __mvExist( cVarName )
bGetArray := {|| __mvGet( cVarName ) }
bGetArray := FieldWBlock( cVarName, Select() )
ELSE
bGetArray := hb_macroBlock( cVarName )
DO WHILE ( bGetArray := MemVarBlock( cVarName ) ) == NIL
__mvGet( cVarName )
ENDDO
ENDIF
ENDIF
IF ! HB_ISARRAY( Eval( bGetArray ) )
RETURN NIL
ENDIF
oGet := GetNew(,, bGetArray, cVarName, cPicture )
oGet:SubScript := aIndex

150
src/vm/macro.c
View File

@@ -849,6 +849,91 @@ HB_FUNC( HB_MACROBLOCK )
}
}
static void hb_macroSetGetBlock( PHB_DYNS pVarSym, PHB_ITEM pItem,
int iWorkArea, HB_BOOL fMemVar )
{
HB_BYTE byBuf[ 23 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ];
HB_BYTE bPushPcode, bPopPcode;
int i = 0, n;
if( iWorkArea != 0 )
{
bPushPcode = HB_P_MPUSHALIASEDFIELD;
bPopPcode = HB_P_MPOPALIASEDFIELD;
}
else if( !fMemVar )
{
bPushPcode = HB_P_MPUSHFIELD;
bPopPcode = HB_P_MPOPFIELD;
}
else
{
bPushPcode = HB_P_MPUSHMEMVAR;
bPopPcode = HB_P_MPOPMEMVAR;
}
byBuf[ i++ ] = HB_P_PUSHLOCALNEAR;
byBuf[ i++ ] = 1;
byBuf[ i++ ] = HB_P_PUSHNIL;
byBuf[ i++ ] = HB_P_EXACTLYEQUAL;
byBuf[ i++ ] = HB_P_JUMPFALSENEAR;
n = i++;
if( iWorkArea != 0 )
{
byBuf[ i++ ] = HB_P_PUSHLONG;
HB_PUT_LE_UINT32( &byBuf[ i ], iWorkArea );
i += 4;
}
byBuf[ i++ ] = bPushPcode;
HB_PUT_PTR( &byBuf[ i ], pVarSym );
i += sizeof( PHB_DYNS );
byBuf[ i++ ] = HB_P_ENDBLOCK;
byBuf[ n ] = ( HB_BYTE ) ( i - n + 1 );
byBuf[ i++ ] = HB_P_PUSHLOCALNEAR;
byBuf[ i++ ] = 1;
byBuf[ i++ ] = HB_P_DUPLICATE;
if( iWorkArea != 0 )
{
byBuf[ i++ ] = HB_P_PUSHLONG;
HB_PUT_LE_UINT32( &byBuf[ i ], iWorkArea );
i += 4;
}
byBuf[ i++ ] = bPopPcode;
HB_PUT_PTR( &byBuf[ i ], pVarSym );
i += sizeof( PHB_DYNS );
byBuf[ i++ ] = HB_P_ENDBLOCK;
if( HB_IS_COMPLEX( pItem ) )
hb_itemClear( pItem );
pItem->item.asBlock.value = hb_codeblockMacroNew( byBuf, i );
pItem->type = HB_IT_BLOCK;
pItem->item.asBlock.paramcnt = 1;
pItem->item.asBlock.lineno = 0;
pItem->item.asBlock.hclass = 0;
pItem->item.asBlock.method = 0;
}
HB_FUNC( MEMVARBLOCK )
{
const char * szVarName = hb_parc( 1 );
if( szVarName )
{
PHB_DYNS pVarSym = hb_dynsymFindName( szVarName );
if( pVarSym && hb_dynsymIsMemvar( pVarSym ) )
{
HB_STACK_TLS_PRELOAD
hb_macroSetGetBlock( pVarSym, hb_stackReturnItem(), 0, HB_TRUE );
}
}
}
HB_FUNC( FIELDBLOCK )
{
const char * szName = hb_parc( 1 );
@@ -884,35 +969,7 @@ HB_FUNC( FIELDBLOCK )
if( pFieldSym )
{
HB_STACK_TLS_PRELOAD
HB_BYTE byBuf[ 13 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ];
PHB_ITEM pItem = hb_stackReturnItem();
byBuf[ 0 ] = HB_P_PUSHLOCALNEAR;
byBuf[ 1 ] = 1;
byBuf[ 2 ] = HB_P_PUSHNIL;
byBuf[ 3 ] = HB_P_EXACTLYEQUAL;
byBuf[ 4 ] = HB_P_JUMPFALSENEAR;
byBuf[ 5 ] = ( HB_BYTE ) ( sizeof( PHB_DYNS ) + 4 );
byBuf[ 6 ] = HB_P_MPUSHFIELD;
HB_PUT_PTR( &byBuf[ 7 ], pFieldSym );
byBuf[ 7 + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
byBuf[ 8 + sizeof( PHB_DYNS ) ] = HB_P_PUSHLOCALNEAR;
byBuf[ 9 + sizeof( PHB_DYNS ) ] = 1;
byBuf[ 10 + sizeof( PHB_DYNS ) ] = HB_P_DUPLICATE;
byBuf[ 11 + sizeof( PHB_DYNS ) ] = HB_P_MPOPFIELD;
HB_PUT_PTR( &byBuf[ 12 + sizeof( PHB_DYNS ) ], pFieldSym );
byBuf[ 12 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
if( HB_IS_COMPLEX( pItem ) )
hb_itemClear( pItem );
pItem->item.asBlock.value = hb_codeblockMacroNew( byBuf, sizeof( byBuf ) );
pItem->type = HB_IT_BLOCK;
pItem->item.asBlock.paramcnt = 1;
pItem->item.asBlock.lineno = 0;
pItem->item.asBlock.hclass = 0;
pItem->item.asBlock.method = 0;
hb_macroSetGetBlock( pFieldSym, hb_stackReturnItem(), 0, HB_FALSE );
}
}
}
@@ -937,40 +994,7 @@ HB_FUNC( FIELDWBLOCK )
if( pFieldSym )
{
HB_STACK_TLS_PRELOAD
HB_BYTE byBuf[ 23 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ];
PHB_ITEM pItem = hb_stackReturnItem();
byBuf[ 0 ] = HB_P_PUSHLOCALNEAR;
byBuf[ 1 ] = 1;
byBuf[ 2 ] = HB_P_PUSHNIL;
byBuf[ 3 ] = HB_P_EXACTLYEQUAL;
byBuf[ 4 ] = HB_P_JUMPFALSENEAR;
byBuf[ 5 ] = ( HB_BYTE ) ( sizeof( PHB_DYNS ) + 9 );
byBuf[ 6 ] = HB_P_PUSHLONG;
HB_PUT_LE_UINT32( &byBuf[ 7 ], iWorkArea );
byBuf[ 11 ] = HB_P_MPUSHALIASEDFIELD;
HB_PUT_PTR( &byBuf[ 12 ], pFieldSym );
byBuf[ 12 + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
byBuf[ 13 + sizeof( PHB_DYNS ) ] = HB_P_PUSHLOCALNEAR;
byBuf[ 14 + sizeof( PHB_DYNS ) ] = 1;
byBuf[ 15 + sizeof( PHB_DYNS ) ] = HB_P_DUPLICATE;
byBuf[ 16 + sizeof( PHB_DYNS ) ] = HB_P_PUSHLONG;
HB_PUT_LE_UINT32( &byBuf[ 17 + sizeof( PHB_DYNS ) ], iWorkArea );
byBuf[ 21 + sizeof( PHB_DYNS ) ] = HB_P_MPOPALIASEDFIELD;
HB_PUT_PTR( &byBuf[ 22 + sizeof( PHB_DYNS ) ], pFieldSym );
byBuf[ 22 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
if( HB_IS_COMPLEX( pItem ) )
hb_itemClear( pItem );
pItem->item.asBlock.value = hb_codeblockMacroNew( byBuf, sizeof( byBuf ) );
pItem->type = HB_IT_BLOCK;
pItem->item.asBlock.paramcnt = 1;
pItem->item.asBlock.lineno = 0;
pItem->item.asBlock.hclass = 0;
pItem->item.asBlock.method = 0;
hb_macroSetGetBlock( pFieldSym, hb_stackReturnItem(), iWorkArea, HB_FALSE );
}
}
}