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

2011-07-15 21:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/hbct/ct.h
  * harbour/contrib/hbct/bitnum.c
    * declared
         HB_BOOL ct_numParam( int iParam, HB_MAXINT * plNum )
      as public function so it can be used by different number and bit
      manipulation CT3 functions

  * harbour/contrib/hbct/hbct.hbp
  + harbour/contrib/hbct/numbase.c
    ! added new CTON() and NTOC() implementation.
      This version is written in C and fixes many different problems
      which existed in the previous one.
      Both functions can work with 64bit integers.
      Passing 3-rd logical parameter to CTON() forces 32-bit mode
      for binary compatibility with CT3.

  * harbour/contrib/hbct/hbct.hbp
  + harbour/contrib/hbct/bitstr.c
    ! added new CTOBIT() and BITTOC() implementation.
      This version is written in C and fixes many different problems
      which existed in the previous one.

  * harbour/contrib/hbct/hbct.hbp
  * harbour/contrib/hbct/numconv.prg
    - removed old CTON(), NTOC(), CTOBIT() and BITTOC() implementation.
This commit is contained in:
Przemyslaw Czerpak
2011-07-15 19:57:20 +00:00
parent 7e7c0f2a61
commit 2a92b6c569
7 changed files with 355 additions and 190 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
harbour/ChangeLog
View File

@@ -16,6 +16,33 @@
The license applies to all entries newer than 2009-04-28.
*/
2011-07-15 21:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/hbct/ct.h
* harbour/contrib/hbct/bitnum.c
* declared
HB_BOOL ct_numParam( int iParam, HB_MAXINT * plNum )
as public function so it can be used by different number and bit
manipulation CT3 functions
* harbour/contrib/hbct/hbct.hbp
+ harbour/contrib/hbct/numbase.c
! added new CTON() and NTOC() implementation.
This version is written in C and fixes many different problems
which existed in the previous one.
Both functions can work with 64bit integers.
Passing 3-rd logical parameter to CTON() forces 32-bit mode
for binary compatibility with CT3.
* harbour/contrib/hbct/hbct.hbp
+ harbour/contrib/hbct/bitstr.c
! added new CTOBIT() and BITTOC() implementation.
This version is written in C and fixes many different problems
which existed in the previous one.
* harbour/contrib/hbct/hbct.hbp
* harbour/contrib/hbct/numconv.prg
- removed old CTON(), NTOC(), CTOBIT() and BITTOC() implementation.
2011-07-15 18:24 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* src/rtl/hbini.prg
! fixed HB_INIREAD() unable to read values containing '=' sign

35
harbour/contrib/hbct/bitnum.c
View File

@@ -54,8 +54,9 @@
*/
#include "hbapi.h"
#include "ct.h"
static HB_BOOL __numParam( int iParam, HB_MAXINT * plNum )
HB_BOOL ct_numParam( int iParam, HB_MAXINT * plNum )
{
const char *szHex = hb_parc( iParam );
@@ -97,9 +98,9 @@ HB_FUNC( NUMAND )
int iPCount = hb_pcount(), i = 1;
HB_MAXINT lValue = -1, lNext = 0;
if( iPCount && __numParam( 1, &lValue ) )
if( iPCount && ct_numParam( 1, &lValue ) )
{
while( --iPCount && __numParam( ++i, &lNext ) )
while( --iPCount && ct_numParam( ++i, &lNext ) )
lValue &= lNext;
if( iPCount )
@@ -113,9 +114,9 @@ HB_FUNC( NUMOR )
int iPCount = hb_pcount(), i = 1;
HB_MAXINT lValue = -1, lNext = 0;
if( iPCount && __numParam( 1, &lValue ) )
if( iPCount && ct_numParam( 1, &lValue ) )
{
while( --iPCount && __numParam( ++i, &lNext ) )
while( --iPCount && ct_numParam( ++i, &lNext ) )
lValue |= lNext;
if( iPCount )
@@ -129,9 +130,9 @@ HB_FUNC( NUMXOR )
int iPCount = hb_pcount(), i = 1;
HB_MAXINT lValue = -1, lNext = 0;
if( iPCount && __numParam( 1, &lValue ) )
if( iPCount && ct_numParam( 1, &lValue ) )
{
while( --iPCount && __numParam( ++i, &lNext ) )
while( --iPCount && ct_numParam( ++i, &lNext ) )
lValue ^= lNext;
if( iPCount )
@@ -144,7 +145,7 @@ HB_FUNC( NUMNOT )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
lValue = ( ~lValue ) & 0xffff;
hb_retnint( lValue );
@@ -154,7 +155,7 @@ HB_FUNC( NUMLOW )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
lValue &= 0xff;
hb_retnint( lValue );
@@ -164,7 +165,7 @@ HB_FUNC( NUMHIGH )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) /* && lValue == lValue & 0xffff */ )
if( ct_numParam( 1, &lValue ) /* && lValue == lValue & 0xffff */ )
lValue = ( lValue >> 8 ) & 0xff;
hb_retnint( lValue );
@@ -174,7 +175,7 @@ HB_FUNC( NUMROL )
{
HB_MAXINT lValue, lShift;
if( __numParam( 1, &lValue ) && lValue == ( lValue & 0xffff ) && __numParam( 2, &lShift )
if( ct_numParam( 1, &lValue ) && lValue == ( lValue & 0xffff ) && ct_numParam( 2, &lShift )
&& lShift == ( lShift & 0xffff ) )
{
if( hb_parl( 3 ) )
@@ -199,7 +200,7 @@ HB_FUNC( NUMMIRR )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) && lValue == ( lValue & 0xffff ) )
if( ct_numParam( 1, &lValue ) && lValue == ( lValue & 0xffff ) )
{
HB_USHORT usBits = hb_parl( 2 ) ? 8 : 16;
HB_USHORT usResult = ( HB_USHORT ) ( lValue >> usBits );
@@ -226,7 +227,7 @@ HB_FUNC( CLEARBIT )
int iPCount = hb_pcount(), iBit, i = 1;
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
{
while( --iPCount )
{
@@ -248,7 +249,7 @@ HB_FUNC( SETBIT )
int iPCount = hb_pcount(), iBit, i = 1;
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
{
while( --iPCount )
{
@@ -269,7 +270,7 @@ HB_FUNC( ISBIT )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
{
int iBit = hb_parni( 2 );
@@ -287,7 +288,7 @@ HB_FUNC( INTNEG )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
{
HB_BOOL f32Bit = hb_parl( 2 );
@@ -304,7 +305,7 @@ HB_FUNC( INTPOS )
{
HB_MAXINT lValue;
if( __numParam( 1, &lValue ) )
if( ct_numParam( 1, &lValue ) )
{
HB_BOOL f32Bit = hb_parl( 2 );

131
harbour/contrib/hbct/bitstr.c Normal file
View File

@@ -0,0 +1,131 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Number and bit manipulation functions:
* CTOBIT(), BITTOC()
*
* Copyright 2011 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
HB_FUNC( CTOBIT )
{
HB_SIZE nString = hb_parclen( 1 ), nPattern, n;
int iResult = 0;
if( nString > 0 )
{
nPattern = hb_parclen( 2 );
if( nPattern >= 1 && nPattern <= 16 )
{
const char * pszString = hb_parc( 1 ),
* pszPattern = hb_parc( 2 );
for( n = 0; n < nString; ++n )
{
char c = pszString[ n ];
int i = 0;
do
{
if( pszPattern[ i ] == c )
{
iResult |= 1 << ( ( int ) nPattern - i - 1 );
break;
}
}
while( ++i < ( int ) nPattern );
}
}
else
iResult = -1;
}
hb_retni( iResult );
}
HB_FUNC( BITTOC )
{
HB_SIZE nPattern = hb_parclen( 2 );
if( nPattern >= 1 && nPattern <= 16 )
{
const char * pszPattern = hb_parc( 2 );
char szBuffer[ 16 ];
char * pszResult = &szBuffer[ sizeof( szBuffer ) ];
int iValue, iLen = 0;
iValue = hb_parnidef( 1, -1 );
if( iValue > 0xFFFF || iValue < 0 )
iValue = 0;
if( hb_parl( 3 ) )
{
while( nPattern-- > 0 )
{
*--pszResult = iValue & 1 ? pszPattern[ nPattern ] : ' ';
++iLen;
iValue >>= 1;
}
}
else
{
while( iValue != 0 && nPattern-- > 0 )
{
if( iValue & 1 )
{
*--pszResult = pszPattern[ nPattern ];
++iLen;
}
iValue >>= 1;
}
}
hb_retclen( pszResult, iLen );
}
else
hb_retc_null();
}

2
harbour/contrib/hbct/ct.h
View File

@@ -99,6 +99,8 @@ extern void ct_charlist( int iMode );
extern void ct_charop( int iMode );
extern HB_BOOL ct_numParam( int iParam, HB_MAXINT * plNum );
/* CT subsystem error throwing functions */
extern HB_USHORT ct_error( HB_USHORT uiSeverity, HB_ERRCODE ulGenCode, HB_ERRCODE ulSubCode,
const char *szDescription, const char *szOperation, HB_ERRCODE uiOsCode, HB_USHORT uiFlags, HB_ULONG uiArgCount, ... );

3
harbour/contrib/hbct/hbct.hbp
View File

@@ -35,6 +35,7 @@ atadjust.c
atnum.c
atrepl.c
bitnum.c
bitstr.c
blank.c
charevod.c
charlihb.c
@@ -87,6 +88,7 @@ misc3.c
misc4.c
num1.c
numat.c
numbase.c
numcount.c
numline.c
pack.c
@@ -124,7 +126,6 @@ getsecrt.prg
keysave.prg
keysec.prg
keytime.prg
numconv.prg
screen3.prg
scrmark.prg
showtime.prg

175
harbour/contrib/hbct/numbase.c Normal file
View File

@@ -0,0 +1,175 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Number and bit manipulation functions:
* CTON(), NTOC()
*
* Copyright 2011 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "ct.h"
#if HB_VMLONG_MAX == INT32_MAX
# define HB_CT3_STRICT32
#endif
HB_FUNC( CTON )
{
const char * szNumber = hb_parc( 1 );
int iBase = hb_parnidef( 2, 10 );
if( szNumber && iBase >= 2 && iBase <= 36 )
{
HB_MAXUINT nValue = 0, nMax;
#ifdef HB_CT3_STRICT32
nMax = UINT32_MAX;
#else
HB_BOOL fStrict = HB_ISLOG( 3 );
if( fStrict )
nMax = UINT32_MAX;
else
nMax = UINT64_MAX;
#endif
for( ;; )
{
int iDigit = ( HB_UCHAR ) *szNumber++;
if( iDigit >= '0' && iDigit <= '9' )
iDigit -= '0';
else if( iDigit >= 'A' && iDigit <= 'Z' )
iDigit -= 'A' - 10;
else if( iDigit >= 'a' && iDigit <= 'z' )
iDigit -= 'a' - 10;
else
break;
if( iDigit >= iBase )
break;
if( nValue > ( nMax - iDigit ) / iBase )
{
nValue = 0;
break;
}
nValue = nValue * iBase + iDigit;
}
#ifdef HB_CT3_STRICT32
/* test shows that this is exact CT3 behavior */
if( ( HB_I32 ) nValue >= 0 || hb_parl( 3 ) )
hb_retnl( ( HB_I32 ) nValue );
else
hb_retnd( ( HB_U32 ) nValue );
#else
if( fStrict )
{
if( hb_parl( 3 ) )
hb_retnint( ( HB_I32 ) nValue );
else
hb_retnint( ( HB_U32 ) nValue );
}
else if( ( HB_MAXINT ) nValue < 0 )
hb_retnd( nValue );
else
hb_retnint( nValue );
#endif
}
else
hb_retni( 0 );
}
HB_FUNC( NTOC )
{
char szBuffer[ 256 ], * pszResult = NULL;
HB_MAXINT nValue = 0;
int iBase = hb_parnidef( 2, 10 ), iLen = hb_parni( 3 ), i;
if( iLen < 0 || iLen > ( int ) sizeof( szBuffer ) )
iLen = sizeof( szBuffer );
if( iBase >= 2 && iBase <= 36 && ct_numParam( 1, &nValue ) )
{
HB_MAXUINT uValue = ( HB_MAXUINT ) nValue;
i = iLen == 0 ? ( int ) sizeof( szBuffer ) : iLen;
do
{
if( --i < 0 )
break;
else
{
int iDigit = uValue % iBase;
uValue /= iBase;
iDigit += iDigit < 10 ? '0' : ( 'A' - 10 );
szBuffer[ i ] = ( char ) iDigit;
}
}
while( uValue != 0 );
if( i >= 0 )
{
if( iLen == 0 )
iLen = sizeof( szBuffer ) - i;
else
{
const char * szPad = hb_parc( 4 );
char cPad = szPad ? szPad[ 0 ] : ( char ) hb_parnidef( 4, ' ' );
while( i > 0 )
szBuffer[ --i ] = cPad;
}
pszResult = &szBuffer[ i ];
}
}
if( pszResult == NULL )
{
if( iLen == 0 )
iLen = 1;
memset( szBuffer, '*', iLen );
pszResult = szBuffer;
}
hb_retclen( pszResult, iLen );
}

172
harbour/contrib/hbct/numconv.prg
View File

@@ -1,172 +0,0 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Number and bit manipulation functions: - NTOC()
* - CTON()
* - BITTOC()
* - CTOBIT()
*
* Copyright 2001 Walter Negro - FOEESITRA" <waltern@foeesitra.org.ar>
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#define WORLD "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
FUNCTION NTOC( xNum, nBase, nLenght, cPad )
LOCAL cNum
IF ! ISCHARACTER( cPad )
cPad := " "
ENDIF
IF ! ISNUMBER( nBase )
nBase := 10
ENDIF
IF ISCHARACTER( xNum )
xNum := Upper( AllTrim( xNum ) )
xNum := CTON( xNum, 16 )
ENDIF
IF nBase > 36 .OR. nBase < 2
RETURN ""
ENDIF
IF xNum < 0
xNum += 4294967296
ENDIF
cNum := B10TOBN( xNum, @nBase )
IF ISNUMBER( nLenght )
IF Len( cNum ) > nLenght
cNum := Replicate( "*", nLenght )
ELSEIF ISCHARACTER( cPad ) .AND. Len( cNum ) < nLenght
cNum := Replicate( cPad, nLenght - Len( cNum ) ) + cNum
ENDIF
ENDIF
RETURN cNum
FUNCTION CTON( xNum, nBase, lMode )
LOCAL i
LOCAL nNum := 0
LOCAL nPos
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
IF ! ISNUMBER( nBase )
nBase := 10
ENDIF
IF ISCHARACTER( xNum ) .AND. nBase >= 2 .AND. nBase <= 36
xNum := Upper( AllTrim( xNum) )
FOR i := 1 TO Len( xNum )
nPos := At( SubStr( xNum, i, 1 ), WORLD )
IF nPos == 0 .OR. nPos > nBase
EXIT
ELSE
nNum := nNum * nBase + ( nPos - 1 )
ENDIF
NEXT
IF lMode .AND. nNum > 32767
nNum := nNum - 65536
ENDIF
ENDIF
RETURN nNum
STATIC FUNCTION B10TOBN( nNum, nBase )
LOCAL nInt
IF nNum > 0
nInt := Int( nNum / nBase)
RETURN iif( nInt == 0, "", B10TOBN( nInt, @nBase ) ) +;
SubStr( WORLD, ( nNum % nBase ) + 1, 1 )
ELSEIF nNum == 0
RETURN "0"
ENDIF
RETURN ""
FUNCTION BITTOC( nInteger, cBitPattern, lMode )
LOCAL cBinary
LOCAL nI
LOCAL cString := ""
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
cBitPattern := Right( cBitPattern, 16 )
cBinary := NTOC( nInteger, 2, 16 )
FOR nI := 1 TO 16
IF SubStr( cBinary, -nI, 1 ) == "1"
cString := SubStr( cBitPattern, -nI, 1 ) + cString
ELSEIF lMode
cString := " " + cString
ENDIF
NEXT
RETURN Right( cString, Len( cBitPattern ) )
FUNCTION CTOBIT( cCharString, cBitPattern )
LOCAL nI, cString := ""
cCharString := Right( cCharString, 16 )
cBitPattern := Right( cBitPattern, 16 )
FOR nI := 1 TO Len( cBitPattern )
cString := iif( At( SubStr( cBitPattern, -nI, 1 ), cCharString ) > 0, "1", "0" ) + cString
NEXT
RETURN CTON( cString, 2 )