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

19990824-18:05 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-08-24 16:27:57 +00:00
parent 01e6c62c7d
commit b958703cd9
17 changed files with 2007 additions and 1821 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
harbour/ChangeLog
View File

@@ -1,3 +1,82 @@
19990824-18:05 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/extend.c
include/extend.h
% Variable declarations moved to inner blocks.
! Parameter number zero is considered a bad case, instead of undefined.
% Optimalization and cleanup. Returns from inner blocks optimed out.
% Array index parameter is only evaluated when actual parameter is an
array, so that it should be faster now.
% The type checkings reordered, so that the first is the most probable one.
Array type is checked last, since this is the most rarely occuring case.
This will speed up things a bit.
! Casting to (long) fixed in hb_parni() when return an array element.
! Variable parameters are treated consistently as longs, we are not
Clipper compatible here, but in Harbour an array index can be ULONG, just
as like the string lengths were already ULONGs instead of ints.
! WORD wArrayIndex changed to ULONG ulArrayIndex.
! hb_storclen() WORD parameter changed to ULONG.
+ Some casts added to hb_parni(), hb_parnd()
! hb_parl() is returning valid values for INTEGER, LONG and DOUBLE type of
parameters. (Clipper does the same except for DOUBLE)
! hb_parnl() is returning the date value as a long is the paramater is DATE
type. (just like in Clipper).
; Reformatted to Harbour standard.
* source/arrays.c
! hb_arrayGetDouble() is now returning a value even for the DATE type,
to be consistent with hb_parn*();
! hb_arrayGetBool() is now returning a value even for INTEGER, LONG and
DOUBLE types, to be consistent with hb_parl().
* Reindented using Harbour standard.
% Removed hb_ret() calls, they are not needed, since the default return
value is always NIL.
! AEVAL() GPF fixed when the second parameter was not a codeblock.
- Removed (unsigned) casts from hb_arrayLen().
; Reformatted to Harbour standard.
* source/rdd/dbcmd.c
! HB_DBSKIP() it will work even when a DOUBLE type of numeric was passed,
(like Clipper). The low level HB_ITEM access changes to use the
extend API.
* makefile.b32
! Fixes by Luiz Rafael Culik <Culik@sl.conex.net> implemented.
* source/rtl/strings.c
+ Added a new runtime error for ALLTRIM(), this error has been
introduced in Clipper 5.3.
(Put between HB_COMPATIBILITY_CLIPPER_53 guard)
% Some PHB_ITEM accesses changed to type checking macros, only where
the PHB_ITEM was only used to check the type.
* Some reformatting (putting spaces between ()[] chars)
; Reformatted to Harbour standard.
* source/rtl/math.c
% PHB_ITEM access changed to Extend API calls and/or type checking macros.
* source/rtl/console.c
% PHB_ITEM access changed to Extend API calls and/or type checking macros.
! SETPRC() was checking the first parameter type two times, but not at all
the second.
* source/rtl/descend.c
! One (double) cast moved to the right place.
* source/rtl/classes.c
% One hb_ret() removed.
* Some reformatting.
* tests/working/rtl_test.prg
+ CA-Clipper bugs documented somewhat better.
* source/rtl/dates.c
source/rtl/dir.c
source/rtl/inkey.c
source/vm/hvm.c
* Some minor formatting change: defined( x ) -> defined(x).
+ Two (double) casts added to hb_vmPopDouble()
19990824-17:57 GMT+1 Antonio Linares <alinares@fivetech.com>
* source/debug/debugger.prg
+ Added support for Next Window (K_TAB) and Prev Window (K_SH_TAB)

2
harbour/include/extend.h
View File

@@ -230,7 +230,7 @@ extern void hb_retnd( double dNumber ); /* returns a double */
extern void hb_reta( ULONG ulLen ); /* returns an array with a specific length */
extern void hb_storc( char * szText, int iParam, ... ); /* stores a szString on a variable by reference */
extern void hb_storclen( char * fixText, WORD wLength, int iParam, ... ); /* stores a fixed length string on a variable by reference */
extern void hb_storclen( char * fixText, ULONG ulLength, int iParam, ... ); /* stores a fixed length string on a variable by reference */
extern void hb_stords( char * szDate, int iParam, ... ); /* szDate must have yyyymmdd format */
extern void hb_storl( int iLogical, int iParam, ... ); /* stores a logical integer on a variable by reference */
extern void hb_storni( int iValue, int iParam, ... ); /* stores an integer on a variable by reference */

7
harbour/makefile.b32
View File

@@ -20,7 +20,7 @@ harbour.lib : achoice.obj adir.obj alert.obj arrays.obj asort.obj \
errorapi.obj errorsys.obj extend.obj fileread.obj filesys.obj fm.obj \
hardcr.obj hb_f.obj hvm.obj initsymb.obj inkey.obj itemapi.obj \
langapi.obj math.obj mathx.obj memvars.obj menuto.obj mtran.obj msges.obj \
objfunc.obj \
objfunc.obj readvar.obj xsavescr.obj\
set.obj setcolor.obj setkey.obj strings.obj symbols.obj stringp.obj \
stringsx.obj tbcolumn.obj tbrowse.obj tbrwtext.obj tclass.obj tget.obj tgetlist.obj tone.obj transfrm.obj
@@ -82,6 +82,8 @@ tget.obj : tget.c extend.h hbdefs.h
tgetlist.obj : tgetlist.c extend.h hbdefs.h
tone.obj : tone.c extend.h init.h inkey.h
transfrm.obj : transfrm.c extend.h hbdefs.h
readvar.obj : readvar.c extend.h hbdefs.h
xsavescr.obj : xsavescr.c extend.h hbdefs.h
achoice.c : achoice.prg harbour.exe
adir.c : adir.prg harbour.exe
@@ -102,7 +104,8 @@ tbrowse.c : tbrowse.prg harbour.exe
tclass.c : tclass.prg harbour.exe
tget.c : tget.prg harbour.exe
tgetlist.c : tgetlist.prg harbour.exe
readvar.c : readvar.prg harbour.exe
xsavescr.c : xsavescr.prg harbour.exe
.asm.obj:
tasm32 $<, $@
tlib .\libs\b32\harbour.lib -+$@,,

12
harbour/source/rdd/dbcmd.c
View File

@@ -1078,19 +1078,13 @@ HARBOUR HB_DBSETDRIVER( void )
HARBOUR HB_DBSKIP( void )
{
PHB_ITEM pItem;
LONG lToSkip = 1;
if( pCurrArea )
{
pItem = hb_param( 1, IT_NUMERIC );
if( pItem )
{
if( pItem->type == IT_INTEGER )
lToSkip = pItem->item.asInteger.value;
else if( pItem->type == IT_LONG )
lToSkip = pItem->item.asLong.value;
}
if( ISNUM( 1 ) )
lToSkip = hb_parnl( 1 );
SELF_SKIP( ( AREAP ) pCurrArea->pArea, lToSkip );
}
else

871
harbour/source/rtl/arrays.c
View File

File diff suppressed because it is too large Load Diff

62
harbour/source/rtl/classes.c
View File

@@ -70,7 +70,7 @@ typedef struct
#define BASE_METHODS 200
#define BUCKET 4
#define HASH_KEY (BASE_METHODS / BUCKET)
#define HASH_KEY ( BASE_METHODS / BUCKET )
static PCLASS pClasses = 0;
static WORD wClasses = 0;
@@ -133,7 +133,7 @@ extern HARBOUR HB___OBJMODMETHOD( void );
* <nType> see MET_*
* <xInit> Optional initializer for DATA
*/
HARBOUR HB___CLSADDMSG(void)
HARBOUR HB___CLSADDMSG( void )
{
WORD wClass = hb_parnl( 1 );
@@ -148,7 +148,7 @@ HARBOUR HB___CLSADDMSG(void)
if ( wType == MET_INLINE && hb_param( 3, IT_BLOCK ) == NULL )
{
hb_errRT_BASE(EG_ARG, 3000, NULL, "__CLSADDMSG");
hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSADDMSG" );
}
if( pClass->wMethods > ( pClass->wHashKey * BUCKET * 2/3 ) )
@@ -237,7 +237,7 @@ HARBOUR HB___CLSADDMSG(void)
* <nDatas> Number of DATAs in the class
* <hSuper> Optional handle of superclass
*/
HARBOUR HB___CLSNEW(void)
HARBOUR HB___CLSNEW( void )
{
WORD wSuper = hb_parni( 3 ); /* Super class present */
PCLASS pNewCls;
@@ -258,7 +258,7 @@ HARBOUR HB___CLSNEW(void)
WORD wSize;
pNewCls->wDataFirst = pSprCls->wDatas;
pNewCls->wDatas = pSprCls->wDatas + hb_parni(2);
pNewCls->wDatas = pSprCls->wDatas + hb_parni( 2 );
pNewCls->wMethods = pSprCls->wMethods;
pNewCls->pClassDatas = hb_arrayClone( pSprCls->pClassDatas );
@@ -295,7 +295,7 @@ HARBOUR HB___CLSNEW(void)
* <oObj> Object
* <cMessage> Message
*/
HARBOUR HB___CLSDELMSG(void)
HARBOUR HB___CLSDELMSG( void )
{
WORD wClass = hb_parni( 1 );
PHB_ITEM pString = hb_param( 2, IT_STRING );
@@ -314,7 +314,7 @@ HARBOUR HB___CLSDELMSG(void)
( pClass->pMethods[ wAt ].pMessage != pMsg ) ) )
{
wAt++;
if( wAt == wMask)
if( wAt == wMask )
wAt = 0;
}
@@ -334,7 +334,7 @@ HARBOUR HB___CLSDELMSG(void)
pClass->pMethods + ( ( wAt == wMask ) ? 0 : wAt + 1 ),
sizeof( METHOD ) );
wAt++;
if( wAt == wMask)
if( wAt == wMask )
wAt = 0;
}
@@ -362,7 +362,7 @@ static HARBOUR hb___msgClsH( void )
*
* Create a new object from class definition <hClass>
*/
HARBOUR HB___CLSINST(void)
HARBOUR HB___CLSINST( void )
{
WORD wClass = hb_parni( 1 );
@@ -380,8 +380,6 @@ HARBOUR HB___CLSINST(void)
if( pMeth->pInitValue )
hb_itemArrayPut( &stack.Return, pMeth->wData, pMeth->pInitValue );
}
else
hb_ret();
}
/*
@@ -389,7 +387,7 @@ HARBOUR HB___CLSINST(void)
*
* Modify message (only for INLINE and METHOD)
*/
HARBOUR HB___CLSMODMSG(void)
HARBOUR HB___CLSMODMSG( void )
{
WORD wClass = hb_parni( 1 );
PHB_ITEM pString = hb_param( 2, IT_STRING );
@@ -408,7 +406,7 @@ HARBOUR HB___CLSMODMSG(void)
( pClass->pMethods[ wAt ].pMessage != pMsg ) ) )
{
wAt++;
if( wAt == wMask)
if( wAt == wMask )
wAt = 0;
}
@@ -421,13 +419,13 @@ HARBOUR HB___CLSMODMSG(void)
PHB_ITEM pBlock = hb_param( 3, IT_BLOCK );
if ( pBlock == NULL )
hb_errRT_BASE(EG_ARG, 3000, NULL, "__CLSMODMSG");
hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSMODMSG" );
else
hb_arraySet( pClass->pInlines, pClass->pMethods[ wAt ].wData, pBlock );
}
else if( ( pFunc == hb___msgSetData ) || ( pFunc == hb___msgGetData ) )
{ /* Not allowed for DATA */
hb_errRT_BASE(EG_ARG, 3004, "Cannot modify a DATA item", "__CLSMODMSG");
hb_errRT_BASE( EG_ARG, 3004, "Cannot modify a DATA item", "__CLSMODMSG" );
}
else /* Modify METHOD */
pClass->pMethods[ wAt ].pFunction = ( PHB_FUNC ) hb_parnl( 3 );
@@ -459,7 +457,7 @@ static HARBOUR hb___msgClsName( void )
*
* Returns class name of <hClass>
*/
HARBOUR HB___OBJGETCLSNAME(void)
HARBOUR HB___OBJGETCLSNAME( void )
{
PHB_ITEM pObject = hb_param( 0, IT_OBJECT );
@@ -484,7 +482,7 @@ HARBOUR HB___OBJGETCLSNAME(void)
*
* Returns all the messages in <obj>
*/
static HARBOUR hb___msgClsSel(void)
static HARBOUR hb___msgClsSel( void )
{
WORD wClass = IS_ARRAY( stack.pBase + 1 ) ?
( stack.pBase + 1 )->item.asArray.value->wClass : 0;
@@ -697,7 +695,7 @@ PHB_FUNC hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage )
return pMethod->pFunction;
}
wAt++;
if( wAt == wMask)
if( wAt == wMask )
wAt = 0;
}
}
@@ -728,7 +726,7 @@ PHB_FUNC hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage )
ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString )
{
PHB_SYMB pMessage = hb_dynsymGet( szString )->pSymbol;
return( (ULONG) hb_objGetMethod( pObject, pMessage ) );
return( ( ULONG ) hb_objGetMethod( pObject, pMessage ) );
} /* Get funcptr of message */
@@ -737,7 +735,7 @@ ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString )
*
* Is <cSymbol> a valid message for the <oObj>
*/
HARBOUR HB___OBJHASMSG(void)
HARBOUR HB___OBJHASMSG( void )
{
PHB_ITEM pObject = hb_param( 1, IT_OBJECT );
PHB_ITEM pString = hb_param( 2, IT_STRING );
@@ -746,7 +744,7 @@ HARBOUR HB___OBJHASMSG(void)
hb_retl( hb_objHasMsg( pObject, pString->item.asString.value ) != 0 );
else
{
hb_errRT_BASE(EG_ARG, 3000, NULL, "__OBJHASMSG");
hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJHASMSG" );
}
}
@@ -769,7 +767,7 @@ HARBOUR HB___OBJCLONE( void )
}
else
{
hb_errRT_BASE(EG_ARG, 3001, NULL, "__OBJCLONE");
hb_errRT_BASE( EG_ARG, 3001, NULL, "__OBJCLONE" );
}
}
@@ -779,7 +777,7 @@ HARBOUR HB___OBJCLONE( void )
*
* Send a message to an object
*/
HARBOUR HB___OBJSENDMSG(void)
HARBOUR HB___OBJSENDMSG( void )
{
PHB_ITEM pObject = hb_param( 1, IT_OBJECT );
PHB_ITEM pMessage = hb_param( 2, IT_STRING );
@@ -797,7 +795,7 @@ HARBOUR HB___OBJSENDMSG(void)
}
else
{
hb_errRT_BASE(EG_ARG, 3000, NULL, "__OBJSENDMSG");
hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJSENDMSG" );
}
}
@@ -850,8 +848,8 @@ void hb_clsReleaseAll( void )
static HARBOUR hb___msgSuper( void )
{
PHB_ITEM pObject = stack.pBase + 1;
PHB_ITEM pSuper = (PHB_ITEM) hb_xgrab( sizeof( HB_ITEM ) );
PBASEARRAY pNewBase = (PBASEARRAY) hb_xgrab( sizeof( BASEARRAY ) );
PHB_ITEM pSuper = ( PHB_ITEM ) hb_xgrab( sizeof( HB_ITEM ) );
PBASEARRAY pNewBase = ( PBASEARRAY ) hb_xgrab( sizeof( BASEARRAY ) );
WORD wSuperCls = pMethod->wData; /* Get handle of superclass */
memcpy( pSuper, pObject, sizeof( HB_ITEM ) );
@@ -938,7 +936,7 @@ HARBOUR HB___CLSINSTSUPER( void )
if( !IS_OBJECT( &stack.Return ) )
{
hb_errRT_BASE(EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER");
hb_errRT_BASE( EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER" );
}
for( w = 0; !bFound && w < wClasses; w++ )
@@ -952,7 +950,7 @@ HARBOUR HB___CLSINSTSUPER( void )
}
else
{
hb_errRT_BASE(EG_ARG, 3003, "Cannot find super class", "__CLSINSTSUPER");
hb_errRT_BASE( EG_ARG, 3003, "Cannot find super class", "__CLSINSTSUPER" );
}
}
if( !bFound )
@@ -965,7 +963,7 @@ HARBOUR HB___CLSINSTSUPER( void )
*
* Return number of class datas
*/
HARBOUR HB___CLS_CNTCLSDATA(void)
HARBOUR HB___CLS_CNTCLSDATA( void )
{
WORD wClass = hb_parnl( 1 );
@@ -981,7 +979,7 @@ HARBOUR HB___CLS_CNTCLSDATA(void)
*
* Return number of datas
*/
HARBOUR HB___CLS_CNTDATA(void)
HARBOUR HB___CLS_CNTDATA( void )
{
WORD wClass = hb_parnl( 1 );
@@ -996,7 +994,7 @@ HARBOUR HB___CLS_CNTDATA(void)
*
* Return number of datas and decrease
*/
HARBOUR HB___CLS_DECDATA(void)
HARBOUR HB___CLS_DECDATA( void )
{
WORD wClass = hb_parnl( 1 );
@@ -1012,7 +1010,7 @@ HARBOUR HB___CLS_DECDATA(void)
*
* Return number of datas and decrease
*/
HARBOUR HB___CLS_INCDATA(void)
HARBOUR HB___CLS_INCDATA( void )
{
WORD wClass = hb_parnl( 1 );

74
harbour/source/rtl/console.c
View File

@@ -176,7 +176,7 @@ static void hb_out( WORD wParam, hb_out_func_typedef * hb_out_func )
{
char * szText;
PHB_ITEM pItem = hb_param( wParam, IT_ANY );
char szBuffer [11];
char szBuffer [ 11 ];
switch( hb_parinfo( wParam ) )
{
@@ -524,12 +524,9 @@ HARBOUR HB_QOUT( void )
HARBOUR HB_SETPOS( void ) /* Sets the screen position */
{
PHB_ITEM pRow, pCol;
if( hb_pcount() > 1 )
{
pRow = hb_param( 1, IT_NUMERIC );
pCol = hb_param( 2, IT_NUMERIC );
if( pRow && pCol )
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
int i_row = hb_parni( 1 );
int i_col = hb_parni( 2 );
@@ -551,12 +548,9 @@ HARBOUR HB_SETPOS( void ) /* Sets the screen position */
HARBOUR HB_DEVPOS( void ) /* Sets the screen and/or printer position */
{
PHB_ITEM pRow, pCol;
if( hb_pcount() > 1 )
{
pRow = hb_param( 1, IT_NUMERIC );
pCol = hb_param( 2, IT_NUMERIC );
if( pRow && pCol )
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
long l_row = hb_parnl( 1 );
long l_col = hb_parnl( 2 );
@@ -582,7 +576,7 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen
{
#ifdef HARBOUR_USE_GTAPI
char fpOldColor[ CLR_STRLEN ];
if( ISCHAR(2) )
if( ISCHAR( 2 ) )
{
hb_gtGetColorStr( fpOldColor );
hb_gtSetColorStr( hb_parc(2) );
@@ -592,7 +586,7 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen
hb_out( 1, hb_devout );
#ifdef HARBOUR_USE_GTAPI
if( ISCHAR(2) )
if( ISCHAR( 2 ) )
{
hb_gtSetColorStr( fpOldColor );
}
@@ -607,7 +601,7 @@ HARBOUR HB_DISPOUT( void ) /* writes a single value to the current device (scree
#ifdef HARBOUR_USE_GTAPI
char fpOldColor[ CLR_STRLEN ];
if( ISCHAR(2) )
if( ISCHAR( 2 ) )
{
hb_gtGetColorStr( fpOldColor );
hb_gtSetColorStr( hb_parc(2) );
@@ -617,7 +611,7 @@ HARBOUR HB_DISPOUT( void ) /* writes a single value to the current device (scree
hb_out( 1, hb_dispout );
#ifdef HARBOUR_USE_GTAPI
if( ISCHAR(2) )
if( ISCHAR( 2 ) )
{
hb_gtSetColorStr( fpOldColor );
}
@@ -648,9 +642,7 @@ HARBOUR HB_SETPRC( void ) /* Sets the current printer row and column positions *
{
if( hb_pcount() > 1 )
{
PHB_ITEM pRow = hb_param( 1, IT_NUMERIC );
PHB_ITEM pCol = hb_param( 1, IT_NUMERIC );
if( pRow && pCol )
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
long l_row = hb_parnl( 1 );
long l_col = hb_parnl( 2 );
@@ -672,17 +664,17 @@ HARBOUR HB_SCROLL( void ) /* Scrolls a screen region (requires the GT API) */
v_scroll = 0, h_scroll = 0;
WORD top, left, bottom, right;
if( hb_pcount() > 0 && hb_param( 1, IT_NUMERIC ) )
if( hb_pcount() > 0 && ISNUM( 1 ) )
i_top = hb_parni( 1 );
if( hb_pcount() > 1 && hb_param( 2, IT_NUMERIC ) )
if( hb_pcount() > 1 && ISNUM( 2 ) )
i_left = hb_parni( 2 );
if( hb_pcount() > 2 && hb_param( 3, IT_NUMERIC ) )
if( hb_pcount() > 2 && ISNUM( 3 ) )
i_bottom = hb_parni( 3 );
if( hb_pcount() > 3 && hb_param( 4, IT_NUMERIC ) )
if( hb_pcount() > 3 && ISNUM( 4 ) )
i_right = hb_parni( 4 );
if( hb_pcount() > 4 && hb_param( 5, IT_NUMERIC ) )
if( hb_pcount() > 4 && ISNUM( 5 ) )
v_scroll = hb_parni( 5 );
if( hb_pcount() > 5 && hb_param( 6, IT_NUMERIC ) )
if( hb_pcount() > 5 && ISNUM( 6 ) )
h_scroll = hb_parni( 6 );
/* Enforce limits of (0,0) to (MAXROW(),MAXCOL()) */
@@ -743,21 +735,21 @@ HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin
HARBOUR HB_DISPBOX (void)
{
#ifdef HARBOUR_USE_GTAPI
if (ISNUM(1) && ISNUM(2) && ISNUM(3) && ISNUM(4))
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) )
{
char szOldColor [CLR_STRLEN];
if (ISCHAR(6))
if( ISCHAR( 6 ) )
{
hb_gtGetColorStr(szOldColor);
hb_gtSetColorStr(hb_parc(6));
}
if (ISCHAR(5))
if( ISCHAR( 5 ) )
{
hb_gtBox(hb_parni(1), hb_parni(2), hb_parni(3), hb_parni(4), hb_parc(5));
}
else if (ISNUM(5) && hb_parni(5) == 2)
else if( ISNUM( 5 ) && hb_parni( 5 ) == 2 )
{
hb_gtBoxD(hb_parni(1), hb_parni(2), hb_parni(3), hb_parni(4));
}
@@ -766,13 +758,13 @@ HARBOUR HB_DISPBOX (void)
hb_gtBoxS(hb_parni(1), hb_parni(2), hb_parni(3), hb_parni(4));
}
if (ISCHAR(6))
if( ISCHAR( 6 ) )
{
hb_gtSetColorStr(szOldColor);
}
}
#else
if (ISNUM(1) && ISNUM(2) && ISNUM(3) && ISNUM(4))
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) )
{
char * szBorderStyle = B_SINGLE;
int i_top = hb_parni( 1 ), i_left = hb_parni( 2 );
@@ -920,7 +912,7 @@ HARBOUR HB_ISCOLOR (void)
HARBOUR HB_NOSNOW (void)
{
#ifdef HARBOUR_USE_GTAPI
if ( ISLOG( 1 ) )
if( ISLOG( 1 ) )
{
hb_gtSetSnowFlag(hb_parl(1));
}
@@ -1013,7 +1005,7 @@ HARBOUR HB_SETBLINK( void )
BOOL bPreviousBlink;
hb_gtGetBlink( &bPreviousBlink );
if ( ISLOG( 1 ) )
if( ISLOG( 1 ) )
hb_gtSetBlink( hb_parl( 1 ) );
hb_retl( bPreviousBlink );
@@ -1040,7 +1032,7 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command
/* Read the data using fgets(), because hb_inkeyPoll() doesn't support
Unix compatible operating systems yet. */
szResult[0] = '\x0'; /* start with something defined */
if (fgets( szResult, ACCEPT_BUFFER_LEN, stdin ))
if( fgets( szResult, ACCEPT_BUFFER_LEN, stdin ) )
{
strtok(szResult, "\n"); /* strip off the trailing newline
if it exists */
@@ -1123,40 +1115,40 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command
HARBOUR HB___COLORINDEX( void )
{
if ( ISCHAR( 1 ) && ISNUM( 2 ) )
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{
char * szColor = hb_parc( 1 );
ULONG ulColorPos;
ULONG ulColorLen;
USHORT uiColorIndex = (USHORT) hb_parni( 2 );
USHORT uiColorIndex = ( USHORT ) hb_parni( 2 );
/* Skip the given number of commas */
for ( ulColorPos = 0 ; szColor[ ulColorPos ] != '\0' && uiColorIndex > 0 ; ulColorPos++ )
for( ulColorPos = 0 ; szColor[ ulColorPos ] != '\0' && uiColorIndex > 0 ; ulColorPos++ )
{
if ( szColor[ ulColorPos ] == ',' )
if( szColor[ ulColorPos ] == ',' )
uiColorIndex--;
}
/* if found, continue */
if ( uiColorIndex == 0 )
if( uiColorIndex == 0 )
{
/* Skip the spaces after the comma */
while ( szColor[ ulColorPos ] == ' ' ) ulColorPos++;
while( szColor[ ulColorPos ] == ' ' ) ulColorPos++;
/* Search for next comma or end of string */
ulColorLen = 0;
while ( szColor[ ulColorPos + ulColorLen ] != '\0' &&
szColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++;
while( szColor[ ulColorPos + ulColorLen ] != '\0' &&
szColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++;
/* Skip the trailing spaces */
while ( ulColorLen > 0 &&
szColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--;
while( ulColorLen > 0 &&
szColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--;
/* Return the string */

2
harbour/source/rtl/dates.c
View File

@@ -46,7 +46,7 @@
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__)
#include <dos.h>
#endif
#if defined( _MSC_VER )
#if defined(_MSC_VER)
#include <sys\timeb.h>
#endif
#ifndef HARBOUR_STRICT_CLIPPER_COMPATIBILITY

14
harbour/source/rtl/descend.c
View File

@@ -67,7 +67,7 @@
char * hb_strDescend( char * szText, ULONG ulLen )
{
if (!(ulLen == 1 && szText[0] == '\0'))
if( ! ( ulLen == 1 && szText[ 0 ] == '\0' ) )
{
char *s;
@@ -82,7 +82,7 @@ HARBOUR HB_DESCEND( void )
{
if( hb_pcount() == 1 )
{
PHB_ITEM pItem = hb_param(1, IT_ANY );
PHB_ITEM pItem = hb_param( 1, IT_ANY );
if( pItem )
{
@@ -95,12 +95,12 @@ HARBOUR HB_DESCEND( void )
PHB_ITEM pReturn;
double dValue;
if ( IS_DOUBLE( pItem ) )
dValue = (double)pItem->item.asDouble.value;
if( IS_DOUBLE( pItem ) )
dValue = pItem->item.asDouble.value;
else if( IS_INTEGER( pItem ) )
dValue = (double)pItem->item.asInteger.value;
dValue = ( double ) pItem->item.asInteger.value;
else if( IS_LONG( pItem ) )
dValue = pItem->item.asLong.value;
dValue = ( double ) pItem->item.asLong.value;
pReturn = hb_itemPutND( NULL, -1 * dValue );
hb_itemReturn( pReturn );
@@ -111,7 +111,7 @@ HARBOUR HB_DESCEND( void )
*/
}
else if( IS_LOGICAL( pItem ) )
hb_retl( !pItem->item.asLogical.value );
hb_retl( ! pItem->item.asLogical.value );
}
}
}

6
harbour/source/rtl/dir.c
View File

@@ -47,7 +47,7 @@
#include <time.h>
#endif
#if defined(__WATCOMC__) || defined( _MSC_VER )
#if defined(__WATCOMC__) || defined(_MSC_VER)
#include <sys/stat.h>
#include <share.h>
#include <fcntl.h>
@@ -262,13 +262,13 @@ HARBOUR HB_DIRECTORY( void )
{
strcpy(string,entry.achName);
#else
#if defined( __WATCOMC__ )
#if defined(__WATCOMC__)
/* opendir in Watcom doesn't like the path delimiter at the end of a string */
dirname[ iDirnameLen ] ='.';
dirname[ iDirnameLen+1 ] ='\x0';
#endif
dir = opendir( dirname );
#if defined( __WATCOMC__ )
#if defined(__WATCOMC__)
dirname[ iDirnameLen ] ='\x0';
#endif
if (NULL == dir)

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

2
harbour/source/rtl/inkey.c
View File

@@ -79,7 +79,7 @@
#include "inkey.h"
#include "init.h"
#if defined( OS_UNIX_COMPATIBLE )
#if defined(OS_UNIX_COMPATIBLE)
#include <unistd.h>
#include <termios.h>

19
harbour/source/rtl/math.c
View File

@@ -60,9 +60,7 @@ HARBOUR HB_EXP( void )
{
if( hb_pcount() == 1 )
{
PHB_ITEM pNumber = hb_param(1, IT_NUMERIC);
if( pNumber )
if( ISNUM( 1 ) )
{
hb_retnd( exp( hb_parnd( 1 ) ) );
/* Always set default number of decimals after EXP() */
@@ -102,9 +100,7 @@ HARBOUR HB_LOG( void )
{
if( hb_pcount() == 1 )
{
PHB_ITEM pNumber = hb_param(1, IT_NUMERIC);
if( pNumber )
if( ISNUM( 1 ) )
{
double dNumber = hb_parnd( 1 );
hb_retnd( log( dNumber ) );
@@ -209,9 +205,8 @@ FUNCTION MOD(cl_num, cl_base)
IF(cl_result * cl_base < 0, cl_result + cl_base, cl_result) )
*/
PHB_ITEM pNumber = hb_param(1, IT_NUMERIC);
PHB_ITEM pBase = hb_param(2, IT_NUMERIC);
if( pNumber && pBase )
if( pNumber && ISNUM( 2 ) )
{
double dNumber = hb_parnd(1);
double dBase = hb_parnd(2); /* dBase! Cool! */
@@ -232,12 +227,12 @@ FUNCTION MOD(cl_num, cl_base)
{
hb_retnd(dNumber);
/* Set the correct number of decimals */
stack.Return.item.asDouble.decimal = (pNumber->item.asDouble.decimal);
stack.Return.item.asDouble.decimal = pNumber->item.asDouble.decimal;
}
}
else
{
hb_errRT_BASE(EG_ARG, 1085, NULL, "%");
hb_errRT_BASE( EG_ARG, 1085, NULL, "%" );
}
}
@@ -306,9 +301,7 @@ HARBOUR HB_SQRT( void )
{
if( hb_pcount() == 1 )
{
PHB_ITEM pNumber = hb_param(1, IT_NUMERIC);
if( pNumber )
if( ISNUM( 1 ) )
{
double dNumber = hb_parnd(1);

542
harbour/source/rtl/strings.c
View File

File diff suppressed because it is too large Load Diff

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

@@ -101,7 +101,7 @@ static PHB_SYMB pSymStart; /* start symbol of the application. MAIN() is
static PSYMBOLS pSymbols = 0; /* to hold a linked list of all different modules symbol tables */
static BYTE byErrorLevel = 0; /* application exit errorlevel */
/* Stores the position on the stack of current SEQUENCE envelope or 0 if no
/* Stores the position on the stack of current SEQUENCE envelope or 0 if no
* SEQUENCE is active
*/
static LONG RecoverBase = 0;
@@ -119,7 +119,7 @@ static WORD wActionRequest = 0;
/* uncomment it to trace the virtual machine activity */
/* #define bHB_DEBUG */
#if defined( bHB_DEBUG )
#if defined(bHB_DEBUG)
#define HB_DEBUG( x ) printf( x )
#define HB_DEBUG2( x, y ) printf( x, y )
#else
@@ -1734,23 +1734,24 @@ static void hb_vmPopAliasedField( PHB_SYMB pSym )
double hb_vmPopDouble( WORD *pwDec )
{
double d;
double dNumber;
hb_stackDec();
switch( stack.pPos->type & ~IT_BYREF )
{
case IT_INTEGER:
d = stack.pPos->item.asInteger.value;
dNumber = ( double ) stack.pPos->item.asInteger.value;
*pwDec =0;
break;
case IT_LONG:
d = stack.pPos->item.asLong.value;
dNumber = ( double ) stack.pPos->item.asLong.value;
*pwDec =0;
break;
case IT_DOUBLE:
d = stack.pPos->item.asDouble.value;
dNumber = stack.pPos->item.asDouble.value;
*pwDec =stack.pPos->item.asDouble.decimal;
break;
@@ -1758,9 +1759,12 @@ double hb_vmPopDouble( WORD *pwDec )
hb_errInternal( 9999, "Incorrect item type trying to Pop a double", NULL, NULL );
break;
}
stack.pPos->type = IT_NIL;
HB_DEBUG( "hb_vmPopDouble\n" );
return d;
return dNumber;
}
static void hb_vmPopField( PHB_SYMB pSym )
@@ -1842,11 +1846,14 @@ double hb_vmPopNumber( void )
break;
default:
hb_stackShow();
hb_errInternal( 9999, "Incorrect item on the stack trying to pop a number", NULL, NULL );
break;
}
stack.pPos->type = IT_NIL;
HB_DEBUG( "hb_vmPopNumber\n" );
return dNumber;
}

10
harbour/tests/working/rtl_test.prg
View File

@@ -443,7 +443,7 @@ FUNCTION Main( cPar1 )
TEST_LINE( Transform( SToD("19101112") , "9#-9#/##" ) , "1910.11.12" )
TEST_LINE( Transform( SToD("19920101") , "" ) , "1992.01.01" )
TEST_LINE( Transform( SToD("19920101") , "DO THIS " ) , "1992.01.01" )
TEST_LINE( Transform( SToD("19920102") , "@E" ) , "02/01/1992" ) /* BUG in Clipper */
TEST_LINE( Transform( SToD("19920102") , "@E" ) , "02/01/1992" ) /* Bug in CA-Cl*pper, it returns: "2.91901.02" */
TEST_LINE( Transform( 1234 , "@D 9999" ) , "1234.00.0 " )
TEST_LINE( Transform( 1234 , "@BD 9999" ) , "1234.00.0 " )
@@ -461,7 +461,7 @@ FUNCTION Main( cPar1 )
TEST_LINE( Transform( SToD("19101112") , "9#-9#/##" ) , "10.11.12" )
TEST_LINE( Transform( SToD("19920101") , "" ) , "92.01.01" )
TEST_LINE( Transform( SToD("19920101") , "DO THIS " ) , "92.01.01" )
TEST_LINE( Transform( SToD("19920102") , "@E" ) , "02/01/92" ) /* BUG in Clipper */
TEST_LINE( Transform( SToD("19920102") , "@E" ) , "02/01/92" ) /* Bug in CA-Cl*pper, it returns: "01.92.02" */
TEST_LINE( Transform( 1234 , "@D 9999" ) , "**.**.* " )
TEST_LINE( Transform( 1234 , "@BD 9999" ) , "**.**.* " )
@@ -502,7 +502,7 @@ FUNCTION Main( cPar1 )
TEST_LINE( Transform( -7 , "9X9^" ) , "-X7^" )
TEST_LINE( Transform( 1 , "@R 9HI!" ) , "1HI!" )
TEST_LINE( Transform( 1 , "9HI!" ) , "1HI!" )
TEST_LINE( Transform( -12 , "@( 99" ) , "(*)" ) /* BUG Fix */
TEST_LINE( Transform( -12 , "@( 99" ) , "(*)" ) /* Bug in CA-Cl*pper, it returns: "(2)" */
TEST_LINE( Transform( 12 , "@( 99" ) , "12" )
TEST_LINE( Transform( 1 , "" ) , " 1" )
TEST_LINE( Transform( 32768 , "" ) , " 32768" )
@@ -510,9 +510,9 @@ FUNCTION Main( cPar1 )
TEST_LINE( Transform( 1048576 , "" ) , " 1048576" )
TEST_LINE( Transform( 21.65 , "" ) , " 21.65" )
TEST_LINE( Transform( -3.33 , "" ) , " -3.33" )
TEST_LINE( Transform( -1234 , "@( 9999" ) , "(***)" ) /* BUG Fix */
TEST_LINE( Transform( -1234 , "@( 9999" ) , "(***)" ) /* Bug in CA-Cl*pper, it returns: "(234)" */
TEST_LINE( Transform( -1234 , "@B 9999" ) , "****" )
TEST_LINE( Transform( -1234 , "@B( 9999" ) , "(***)" ) /* BUG Fix */
TEST_LINE( Transform( -1234 , "@B( 9999" ) , "(***)" ) /* Bug in CA-Cl*pper, it returns: "(234)" */
TEST_LINE( Transform( 1234 , "@E 9,999.99" ) , "1.234,00" )
TEST_LINE( Transform( 12.2 , "@E 9,999.99" ) , " 12,20" )
TEST_LINE( Transform( -1234 , "@X 9999" ) , "1234 DB" )