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

19991113-13:49 GMT+1 Victor Szel <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
1999-11-13 13:04:11 +00:00
parent 42fb8fbd7d
commit 3c69fc1ea1
12 changed files with 1247 additions and 1491 deletions
Download Patch File Download Diff File Expand all files Collapse all files

282
harbour/ChangeLog
View File

@@ -1,3 +1,17 @@
19991113-13:49 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/arrays.c
source/rtl/console.c
source/rtl/dates.c
source/rtl/do.c
source/rtl/filesys.c
source/rtl/inkey.c
source/rtl/math.c
source/rtl/strings.c
source/rtl/transfrm.c
source/vm/hvm.c
doc/subcodes.txt
% Removed the runtime argument count checks.
19991113-13:25 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/extend.c
include/extend.h
@@ -24,7 +38,7 @@
19991113-03:23 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/itemapi.c
% hb_evalNew(), hb_evalPutParam(), hb_evalRelease(), hb_itemRelease(),
hb_itemFreeC() - Variables and double initializations elimiated, faster,
hb_itemFreeC() - Variables and double initializations elimiated, faster,
simpler.
* source/rtl/dates.c
- DTOS() optimalization removed, it's now always 100% Clipper compatible,
@@ -52,13 +66,13 @@
19991112-01:35 GMT+1 Victor Szel <info@szelvesz.hu>
* config/w32/mingw32.cf
- "-g" switch removed, so now no debug info will be included by default.
This makes the generated binaries to be much smaller, and the make
process mych faster.
WARNING! If you need the debug functionality please use the C_USR=-g
This makes the generated binaries to be much smaller, and the make
process mych faster.
WARNING! If you need the debug functionality please use the C_USR=-g
envvar.
! Fixed comment explaining why the USER32 lib is needed.
+ source/rtl/natmsg/msgzhbig.c
+ source/rtl/natmsg/msgzhgb.c
+ source/rtl/natmsg/msgzhbig.c
+ source/rtl/natmsg/msgzhgb.c
* source/rtl/msgxxx.c
+ Chinese-GB and Chinese-BIG5 Language Modules added
Thanks to Dongming Wang <dongming@km169.net>
@@ -203,25 +217,25 @@
Tue Nov 09 11:56:05 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* include/hbsetup.h:
* source/rtl/gt/gtsln.c:
* source/rtl/gtxxx.c:
* source/rtl/mousexxx.c:
Added an initial implementation of GT over S-lang.
* include/hbsetup.h:
* source/rtl/gt/gtsln.c:
* source/rtl/gtxxx.c:
* source/rtl/mousexxx.c:
Added an initial implementation of GT over S-lang.
* source/rtl/inkey.c:
Changed the order in which the #ifdef/#endif checks are done, to
make sure the curses and S-lang implementations are picked up
correctly.
* source/rtl/inkey.c:
Changed the order in which the #ifdef/#endif checks are done, to
make sure the curses and S-lang implementations are picked up
correctly.
* config/linux/gcc.cf:
* config/w32/gcc.cf:
* config/w32/mingw32.cf:
Added initial support for easily switching between curses and
slang. This could be vastly improved.
* config/linux/gcc.cf:
* config/w32/gcc.cf:
* config/w32/mingw32.cf:
Added initial support for easily switching between curses and
slang. This could be vastly improved.
* tests/testbrw.prg:
Added a piece of code bound to K_TAB, just for the fun of it...
* tests/testbrw.prg:
Added a piece of code bound to K_TAB, just for the fun of it...
19991109-01:58 GMT+1 Victor Szel <info@szelvesz.hu>
* samples/Makefile
@@ -307,7 +321,7 @@ Tue Nov 09 11:56:05 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
19991105-14:07 GMT+1 Ryszard Glab <rglab@imid.med.pl>
*source/rtl/codebloc.prg
* memory occupied by detached local variables is properly released now
* memory occupied by detached local variables is properly released now
19991104-23:45 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/filesys.c
@@ -329,78 +343,78 @@ Tue Nov 09 11:56:05 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
Thu Nov 04 14:32:06 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/common/hbtrace.c:
* doc/tracing.txt:
Added the possibility to direct tracing output to a file by
specifying its name in the HB_TR_OUTPUT environment variable. The
default is stderr.
* source/common/hbtrace.c:
* doc/tracing.txt:
Added the possibility to direct tracing output to a file by
specifying its name in the HB_TR_OUTPUT environment variable. The
default is stderr.
Thu Nov 04 13:49:23 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* include/hbtrace.h:
* source/common/hbtrace.c:
* doc/tracing.txt:
Implemented a better way of tracing with support for several
levels (ALWAYS, FATAL, ERROR, WARNING, INFO and DEBUG), efficient
compile-out of unwanted levels and level control using an
environment variable at run-time. See doc/tracing.txt for detailed
information.
* include/hbtrace.h:
* source/common/hbtrace.c:
* doc/tracing.txt:
Implemented a better way of tracing with support for several
levels (ALWAYS, FATAL, ERROR, WARNING, INFO and DEBUG), efficient
compile-out of unwanted levels and level control using an
environment variable at run-time. See doc/tracing.txt for detailed
information.
* source/pp/hbpp.c:
* source/pp/hbppint.c:
* source/pp/hbpplib.c:
* source/pp/stdalone/hbpp.c:
* source/rdd/dbcmd.c:
* source/rdd/dbf1.c:
* source/rdd/dbfcdx/dbfcdx1.c:
* source/rtl/arrays.c:
* source/rtl/classes.c:
* source/rtl/codebloc.c:
* source/rtl/console.c:
* source/rtl/copyfile.c:
* source/rtl/dates.c:
* source/rtl/descend.c:
* source/rtl/dir.c:
* source/rtl/environ.c:
* source/rtl/errorapi.c:
* source/rtl/extend.c:
* source/rtl/filesys.c:
* source/rtl/fm.c:
* source/rtl/gtapi.c:
* source/rtl/hardcr.c:
* source/rtl/inkey.c:
* source/rtl/itemapi.c:
* source/rtl/langapi.c:
* source/rtl/math.c:
* source/rtl/memvars.c:
* source/rtl/mouseapi.c:
* source/rtl/mtran.c:
* source/rtl/natmsg.c:
* source/rtl/samples.c:
* source/rtl/set.c:
* source/rtl/setcolor.c:
* source/rtl/strings.c:
* source/rtl/tone.c:
* source/rtl/transfrm.c:
* source/rtl/gt/gt_tpl.c:
* source/rtl/gt/gtcrs.c:
* source/rtl/gt/gtdos.c:
* source/rtl/gt/gtos2.c:
* source/rtl/gt/gtstd.c:
* source/rtl/gt/gtwin.c:
* source/runner/runlib.c:
* source/tools/dates2.c:
* source/tools/hb_f.c:
* source/tools/strasint.c:
* source/tools/stringsx.c:
* source/vm/cmdarg.c:
* source/vm/debug.c:
* source/vm/dynsym.c:
* source/vm/hvm.c:
* source/vm/initsymb.c:
* source/vm/mainstd.c:
* source/vm/mainwin.c:
Changed calls to HB_TRACE to incorporate the new level parameter.
* source/pp/hbpp.c:
* source/pp/hbppint.c:
* source/pp/hbpplib.c:
* source/pp/stdalone/hbpp.c:
* source/rdd/dbcmd.c:
* source/rdd/dbf1.c:
* source/rdd/dbfcdx/dbfcdx1.c:
* source/rtl/arrays.c:
* source/rtl/classes.c:
* source/rtl/codebloc.c:
* source/rtl/console.c:
* source/rtl/copyfile.c:
* source/rtl/dates.c:
* source/rtl/descend.c:
* source/rtl/dir.c:
* source/rtl/environ.c:
* source/rtl/errorapi.c:
* source/rtl/extend.c:
* source/rtl/filesys.c:
* source/rtl/fm.c:
* source/rtl/gtapi.c:
* source/rtl/hardcr.c:
* source/rtl/inkey.c:
* source/rtl/itemapi.c:
* source/rtl/langapi.c:
* source/rtl/math.c:
* source/rtl/memvars.c:
* source/rtl/mouseapi.c:
* source/rtl/mtran.c:
* source/rtl/natmsg.c:
* source/rtl/samples.c:
* source/rtl/set.c:
* source/rtl/setcolor.c:
* source/rtl/strings.c:
* source/rtl/tone.c:
* source/rtl/transfrm.c:
* source/rtl/gt/gt_tpl.c:
* source/rtl/gt/gtcrs.c:
* source/rtl/gt/gtdos.c:
* source/rtl/gt/gtos2.c:
* source/rtl/gt/gtstd.c:
* source/rtl/gt/gtwin.c:
* source/runner/runlib.c:
* source/tools/dates2.c:
* source/tools/hb_f.c:
* source/tools/strasint.c:
* source/tools/stringsx.c:
* source/vm/cmdarg.c:
* source/vm/debug.c:
* source/vm/dynsym.c:
* source/vm/hvm.c:
* source/vm/initsymb.c:
* source/vm/mainstd.c:
* source/vm/mainwin.c:
Changed calls to HB_TRACE to incorporate the new level parameter.
19991103-22:38 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/filesys.c
@@ -416,13 +430,13 @@ Thu Nov 04 13:49:23 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
Wed Nov 03 18:38:03 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* tests/testbrdb.prg:
The test now restores the color setting and does a CLS before
exiting.
* tests/testbrdb.prg:
The test now restores the color setting and does a CLS before
exiting.
* tests/testbrw.prg:
The test now remembers its device position, cursor setting and
color and restores everything before exiting.
* tests/testbrw.prg:
The test now remembers its device position, cursor setting and
color and restores everything before exiting.
19991103-07:28 GMT+1 Antonio Linares
* source/rtl/classes.c
@@ -545,31 +559,31 @@ Wed Nov 03 18:38:03 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
Tue Oct 26 17:16:43 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/common/hbtrace.c:
Now it is REALLY efficient; no copying, nothing.
* source/common/hbtrace.c:
Now it is REALLY efficient; no copying, nothing.
* source/rtl/codebloc.c:
* source/rtl/dir.c:
* source/rtl/filesys.c:
* source/rtl/inkey.c:
* source/rtl/memvars.c:
* source/rtl/set.c:
* source/vm/hvm.c:
Got rid of other ways of tracing. Hopefully now HB_TRACE() is the
only, standard way used in Harbour.
* source/rtl/codebloc.c:
* source/rtl/dir.c:
* source/rtl/filesys.c:
* source/rtl/inkey.c:
* source/rtl/memvars.c:
* source/rtl/set.c:
* source/vm/hvm.c:
Got rid of other ways of tracing. Hopefully now HB_TRACE() is the
only, standard way used in Harbour.
* source/rtl/gt/gt_tpl.c:
* source/rtl/gt/gtdos.c:
* source/rtl/gt/gtos2.c:
* source/rtl/gt/gtstd.c:
* source/rtl/gt/gtwin.c:
Made sure all the GT implementations (including the template) have
proper HB_TRACE() calls.
* source/rtl/gt/gt_tpl.c:
* source/rtl/gt/gtdos.c:
* source/rtl/gt/gtos2.c:
* source/rtl/gt/gtstd.c:
* source/rtl/gt/gtwin.c:
Made sure all the GT implementations (including the template) have
proper HB_TRACE() calls.
Tue Oct 26 13:20:46 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/runner/runlib.c:
Added HB_TRACE() calls to the RUNNER library.
* source/runner/runlib.c:
Added HB_TRACE() calls to the RUNNER library.
19991026-18:10 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/gt/gtwin.c
@@ -587,29 +601,29 @@ Tue Oct 26 13:20:46 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
Tue Oct 26 13:11:19 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/tools/dates2.c:
* source/tools/hb_f.c:
* source/tools/strasint.c:
* source/tools/stringsx.c:
Added HB_TRACE() calls to the TOOLS library.
* source/tools/dates2.c:
* source/tools/hb_f.c:
* source/tools/strasint.c:
* source/tools/stringsx.c:
Added HB_TRACE() calls to the TOOLS library.
Tue Oct 26 12:55:49 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/rdd/dbcmd.c:
* source/rdd/dbf1.c:
* source/rdd/dbfcdx/dbfcdx1.c:
Added HB_TRACE() calls to the RDD library.
* source/rdd/dbcmd.c:
* source/rdd/dbf1.c:
* source/rdd/dbfcdx/dbfcdx1.c:
Added HB_TRACE() calls to the RDD library.
Tue Oct 26 12:15:01 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/vm/cmdarg.c:
* source/vm/debug.c:
* source/vm/dynsym.c:
* source/vm/hvm.c:
* source/vm/initsymb.c:
* source/vm/mainstd.c:
* source/vm/mainwin.c:
Added HB_TRACE() calls to the VM.
* source/vm/cmdarg.c:
* source/vm/debug.c:
* source/vm/dynsym.c:
* source/vm/hvm.c:
* source/vm/initsymb.c:
* source/vm/mainstd.c:
* source/vm/mainwin.c:
Added HB_TRACE() calls to the VM.
19991026-14:07 GMT+1 Victor Szel <info@szelvesz.hu>
* include/itemapi.h

6
harbour/doc/subcodes.txt
View File

@@ -1055,17 +1055,11 @@ start from 3000
* $SUBCODE$
* BASE/3000
* $CATEGORY$
* arguments
* $ONELINER$
* Incorrect number of arguments
* $DESCRIPTION$
* The number of arguments passed to a function is incorrect
* $FUNCTION$
* DTOS
* $STATUS$
* Harbour specific
* $SEEALSO$
*
* $END$
*/

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

@@ -805,32 +805,27 @@ HARBOUR HB_ARRAY( void )
HARBOUR HB_AADD( void )
{
if( hb_pcount() == 2 )
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pArray )
{
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pValue && hb_arrayAdd( pArray, pValue ) )
hb_itemReturn( pValue );
else
hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" );
}
if( pValue && hb_arrayAdd( pArray, pValue ) )
hb_itemReturn( pValue );
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "AADD" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_ASIZE( void )

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

@@ -601,47 +601,26 @@ HARBOUR HB_QOUT( void )
HARBOUR HB_SETPOS( void ) /* Sets the screen position */
{
if( hb_pcount() == 2 )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
/* Set the new screen position */
hb_setpos( hb_parni( 1 ), hb_parni( 2 ) );
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SETPOS" ); /* NOTE: Clipper catches this at compile time! */
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_setpos( hb_parni( 1 ), hb_parni( 2 ) );
}
/* Move the screen position to the right by one column */
HARBOUR HB_SETPOSBS( void )
{
if( hb_pcount() == 0 )
{
#ifdef HARBOUR_USE_GTAPI
SHORT iRow, iCol;
SHORT iRow, iCol;
/* NOTE: Clipper does no checks about reaching the border or anything */
hb_gtGetPos( &iRow, &iCol );
hb_gtSetPos( iRow, iCol + 1 );
/* NOTE: Clipper does no checks about reaching the border or anything */
hb_gtGetPos( &iRow, &iCol );
hb_gtSetPos( iRow, iCol + 1 );
#endif
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SETPOSBS" ); /* NOTE: Clipper catches this at compile time! */
}
HARBOUR HB_DEVPOS( void ) /* Sets the screen and/or printer position */
{
if( hb_pcount() == 2 )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
/* Set the new screen position */
hb_devpos( hb_parni( 1 ), hb_parni( 2 ) );
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DEVPOS" ); /* NOTE: Clipper catches this at compile time! */
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_devpos( hb_parni( 1 ), hb_parni( 2 ) );
}
HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen or printer), but is not affected by SET ALTERNATE */
@@ -734,18 +713,12 @@ HARBOUR HB___EJECT( void ) /* Ejects the current page from the printer */
HARBOUR HB_PROW( void ) /* Returns the current printer row position */
{
if( hb_pcount() == 0 )
hb_retni( s_uiPRow );
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "PROW" ); /* NOTE: Clipper catches this at compile time! */
hb_retni( s_uiPRow );
}
HARBOUR HB_PCOL( void ) /* Returns the current printer row position */
{
if( hb_pcount() == 0 )
hb_retni( s_uiPCol );
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "PCOL" ); /* NOTE: Clipper catches this at compile time! */
hb_retni( s_uiPCol );
}
HARBOUR HB_SETPRC( void ) /* Sets the current printer row and column positions */
@@ -814,28 +787,18 @@ HARBOUR HB_MAXCOL( void ) /* Return the maximum screen column number (zero origi
HARBOUR HB_ROW( void ) /* Return the current screen row position (zero origin) */
{
if( hb_pcount() == 0 )
{
#ifdef HARBOUR_USE_GTAPI
hb_gtGetPos( &s_iDevRow, &s_iDevCol );
hb_gtGetPos( &s_iDevRow, &s_iDevCol );
#endif
hb_retni( s_iDevRow );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ROW" ); /* NOTE: Clipper catches this at compile time! */
hb_retni( s_iDevRow );
}
HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin) */
{
if( hb_pcount() == 0 )
{
#ifdef HARBOUR_USE_GTAPI
hb_gtGetPos( &s_iDevRow, &s_iDevCol );
hb_gtGetPos( &s_iDevRow, &s_iDevCol );
#endif
hb_retni( s_iDevCol );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "COL" ); /* NOTE: Clipper catches this at compile time! */
hb_retni( s_iDevCol );
}
HARBOUR HB_DISPBOX( void )

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

@@ -251,103 +251,98 @@ long hb_dateEncStr( char * szDate )
HARBOUR HB_CTOD( void )
{
if( hb_pcount() == 1 )
if( ISCHAR( 1 ) )
{
if( ISCHAR( 1 ) )
char * szDate = hb_parc( 1 );
int d_value = 0, m_value = 0, y_value = 0;
char szDateFormat[ 9 ];
if( szDate )
{
char * szDate = hb_parc( 1 );
int d_value = 0, m_value = 0, y_value = 0;
char szDateFormat[ 9 ];
int d_pos = 0, m_pos = 0, y_pos = 0;
int count, digit, size = strlen( hb_set.HB_SET_DATEFORMAT );
if( szDate )
for( count = 0; count < size; count++ )
{
int d_pos = 0, m_pos = 0, y_pos = 0;
int count, digit, size = strlen( hb_set.HB_SET_DATEFORMAT );
for( count = 0; count < size; count++ )
switch( hb_set.HB_SET_DATEFORMAT[ count ] )
{
switch( hb_set.HB_SET_DATEFORMAT[ count ] )
{
case 'D':
case 'd':
if( d_pos == 0 )
{
if( m_pos == 0 && y_pos == 0 ) d_pos = 1;
else if( m_pos == 0 || y_pos == 0 ) d_pos = 2;
else d_pos = 3;
}
break;
case 'M':
case 'm':
if( m_pos == 0 )
{
if( d_pos == 0 && y_pos == 0 ) m_pos = 1;
else if( d_pos == 0 || y_pos == 0 ) m_pos = 2;
else m_pos = 3;
}
break;
case 'Y':
case 'y':
if( y_pos == 0 )
{
if( m_pos == 0 && d_pos == 0 ) y_pos = 1;
else if( m_pos == 0 || d_pos == 0 ) y_pos = 2;
else y_pos = 3;
}
}
}
size = strlen( szDate );
for( count = 0; count < size; count++ )
{
digit = szDate[ count ];
if( isdigit( digit ) )
{
if( d_pos == 1 )
d_value = ( d_value * 10 ) + digit - '0';
else if( m_pos == 1 )
m_value = ( m_value * 10 ) + digit - '0';
else if( y_pos == 1 )
y_value = ( y_value * 10 ) + digit - '0';
}
else if( digit != ' ' )
{
d_pos--;
m_pos--;
y_pos--;
}
}
if( y_value > 0 && y_value < 100 )
{
count = hb_set.HB_SET_EPOCH % 100;
digit = hb_set.HB_SET_EPOCH / 100;
if( y_value >= count )
y_value += ( digit * 100 );
else
y_value += ( ( digit * 100 ) + 100 );
case 'D':
case 'd':
if( d_pos == 0 )
{
if( m_pos == 0 && y_pos == 0 ) d_pos = 1;
else if( m_pos == 0 || y_pos == 0 ) d_pos = 2;
else d_pos = 3;
}
break;
case 'M':
case 'm':
if( m_pos == 0 )
{
if( d_pos == 0 && y_pos == 0 ) m_pos = 1;
else if( d_pos == 0 || y_pos == 0 ) m_pos = 2;
else m_pos = 3;
}
break;
case 'Y':
case 'y':
if( y_pos == 0 )
{
if( m_pos == 0 && d_pos == 0 ) y_pos = 1;
else if( m_pos == 0 || d_pos == 0 ) y_pos = 2;
else y_pos = 3;
}
}
}
sprintf( szDateFormat, "%04i%02i%02i", y_value, m_value, d_value );
size = strlen( szDate );
hb_retds( szDateFormat );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1119, NULL, "CTOD" );
if( pResult )
for( count = 0; count < size; count++ )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
digit = szDate[ count ];
if( isdigit( digit ) )
{
if( d_pos == 1 )
d_value = ( d_value * 10 ) + digit - '0';
else if( m_pos == 1 )
m_value = ( m_value * 10 ) + digit - '0';
else if( y_pos == 1 )
y_value = ( y_value * 10 ) + digit - '0';
}
else if( digit != ' ' )
{
d_pos--;
m_pos--;
y_pos--;
}
}
if( y_value > 0 && y_value < 100 )
{
count = hb_set.HB_SET_EPOCH % 100;
digit = hb_set.HB_SET_EPOCH / 100;
if( y_value >= count )
y_value += ( digit * 100 );
else
y_value += ( ( digit * 100 ) + 100 );
}
}
sprintf( szDateFormat, "%04i%02i%02i", y_value, m_value, d_value );
hb_retds( szDateFormat );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "CTOD" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1119, NULL, "CTOD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: szFormattedDate must be an at least 11 chars wide buffer */
@@ -522,28 +517,23 @@ char * hb_dtoc( const char * szDate, char * szFormattedDate, const char * szDate
HARBOUR HB_DTOC( void )
{
if( hb_pcount() == 1 )
if( ISDATE( 1 ) )
{
if( ISDATE( 1 ) )
{
char szDate[ 9 ];
char szFormatted[ 11 ];
char szDate[ 9 ];
char szFormatted[ 11 ];
hb_retc( hb_dtoc( hb_pardsbuff( szDate, 1 ), szFormatted, hb_set.HB_SET_DATEFORMAT ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1118, NULL, "DTOC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retc( hb_dtoc( hb_pardsbuff( szDate, 1 ), szFormatted, hb_set.HB_SET_DATEFORMAT ) );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DTOC" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1118, NULL, "DTOC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* QUESTION: Should we drop error checkings to make it faster ? */
@@ -552,27 +542,22 @@ HARBOUR HB_DTOC( void )
/* Clipper does these checks, anyway. */
HARBOUR HB_DTOS( void )
{
if( hb_pcount() == 1 )
if( ISDATE( 1 ) )
{
if( ISDATE( 1 ) )
{
char szDate[ 9 ];
char szDate[ 9 ];
hb_retc( hb_pardsbuff( szDate, 1 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1120, NULL, "DTOS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retc( hb_pardsbuff( szDate, 1 ) );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DTOS" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1120, NULL, "DTOS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
#ifdef HB_COMPAT_XPP
@@ -596,139 +581,114 @@ HARBOUR HB_HB_STOD( void )
HARBOUR HB_YEAR( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
long lDay, lMonth, lYear;
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retnllen( lYear, 5 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1112, NULL, "YEAR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retnllen( lYear, 5 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "YEAR" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1112, NULL, "YEAR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_MONTH( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
long lDay, lMonth, lYear;
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retnllen( lMonth, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1113, NULL, "MONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retnllen( lMonth, 3 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MONTH" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1113, NULL, "MONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_DAY( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
long lDay, lMonth, lYear;
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retnllen( lDay, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1114, NULL, "DAY" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retnllen( lDay, 3 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DAY" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1114, NULL, "DAY" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_TIME( void )
{
if( hb_pcount() == 0 )
{
char szResult[ 9 ];
char szResult[ 9 ];
#if defined(_Windows) || defined(WINNT)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond );
#else
time_t t;
struct tm * oTime;
#if defined(_Windows) || defined(WINNT)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond );
#else
time_t t;
struct tm * oTime;
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%02d:%02d:%02d", oTime->tm_hour, oTime->tm_min, oTime->tm_sec );
#endif
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%02d:%02d:%02d", oTime->tm_hour, oTime->tm_min, oTime->tm_sec );
#endif
hb_retclen( szResult, 8 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "TIME" );
hb_retclen( szResult, 8 );
}
HARBOUR HB_DATE( void )
{
if( hb_pcount() == 0 )
{
char szResult[ 9 ];
char szResult[ 9 ];
#if defined(_Windows) || defined(WINNT)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%04d%02d%02d", st.wYear, st.wMonth, st.wDay );
#else
time_t t;
struct tm * oTime;
#if defined(_Windows) || defined(WINNT)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%04d%02d%02d", st.wYear, st.wMonth, st.wDay );
#else
time_t t;
struct tm * oTime;
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%04d%02d%02d", oTime->tm_year + 1900, oTime->tm_mon + 1, oTime->tm_mday );
#endif
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%04d%02d%02d", oTime->tm_year + 1900, oTime->tm_mon + 1, oTime->tm_mday );
#endif
hb_retds( szResult );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DATE" ); /* NOTE: Clipper catches this at compile time! */
hb_retds( szResult );
}
long hb_dow( long d, long m, long y )
@@ -748,104 +708,86 @@ long hb_dow( long d, long m, long y )
HARBOUR HB_DOW( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
if( pDate->item.asDate.value )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 );
}
else
hb_retnllen( 0, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1115, NULL, "DOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DOW" ); /* NOTE: Clipper catches this at compile time! */
}
HARBOUR HB_CMONTH( void )
{
if( hb_pcount() == 1 )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
if( pDate->item.asDate.value )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retc( hb_cmonth( lMonth ) );
hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1116, NULL, "CMONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retnllen( 0, 3 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "CMONTH" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1115, NULL, "DOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_CMONTH( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retc( hb_cmonth( lMonth ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1116, NULL, "CMONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_CDOW( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
if( pDate->item.asDate.value )
{
if( pDate->item.asDate.value )
{
long lDay, lMonth, lYear;
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) );
}
else
hb_retc( "" );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1117, NULL, "CDOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retc( "" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "CDOW" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1117, NULL, "CDOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_SECONDS( void )
{
if( hb_pcount() == 0 )
hb_retnd( hb_secondsToday() );
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SECONDS" ); /* NOTE: Clipper catches this at compile time! */
hb_retnd( hb_secondsToday() );
}

114
harbour/source/rtl/do.c
View File

@@ -86,93 +86,81 @@
HARBOUR HB_DO( void )
{
USHORT uiPCount = hb_pcount();
PHB_ITEM pItem = hb_param( 1, IT_ANY );
if( uiPCount >= 1 )
if( IS_STRING( pItem ) )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
PHB_DYNS pDynSym = hb_dynsymFindName( hb_itemGetCPtr( pItem ) );
if( IS_STRING( pItem ) )
{
PHB_DYNS pDynSym = hb_dynsymFindName( hb_itemGetCPtr( pItem ) );
if( pDynSym )
{
USHORT uiParam;
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pItem->item.asString.value );
}
else if( IS_BLOCK( pItem ) )
if( pDynSym )
{
USHORT uiParam;
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else if( IS_SYMBOL( pItem ) )
{
USHORT uiParam;
hb_vmPushSymbol( pItem->item.asSymbol.value );
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 3012, NULL, "DO" );
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pItem->item.asString.value );
}
else if( IS_BLOCK( pItem ) )
{
USHORT uiParam;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else if( IS_SYMBOL( pItem ) )
{
USHORT uiParam;
hb_vmPushSymbol( pItem->item.asSymbol.value );
hb_vmPushNil();
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DO" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 3012, NULL, "DO" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_EVAL( void )
{
USHORT uiPCount = hb_pcount();
PHB_ITEM pItem = hb_param( 1, IT_BLOCK );
if( uiPCount >= 1 )
if( pItem )
{
PHB_ITEM pItem = hb_param( 1, IT_BLOCK );
USHORT uiParam;
if( pItem )
{
USHORT uiParam;
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EVAL" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

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

@@ -1447,10 +1447,7 @@ BOOL hb_fsFile( BYTE * pFilename )
HARBOUR HB_FILE( void )
{
if( hb_pcount() == 1 )
hb_retl( ISCHAR( 1 ) ? hb_fsFile( ( BYTE * ) hb_parc( 1 ) ) : FALSE );
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "FILE" ); /* NOTE: Clipper catches this at compile time! */
hb_retl( ISCHAR( 1 ) ? hb_fsFile( ( BYTE * ) hb_parc( 1 ) ) : FALSE );
}
HARBOUR HB_FREADSTR( void )

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

@@ -946,9 +946,6 @@ HARBOUR HB_INKEY( void )
double seconds = 0.0;
HB_inkey_enum event_mask = hb_set.HB_SET_EVENTMASK; /* Default to the SET input event mask */
if( args > 2 )
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "INKEY" ); /* NOTE: Clipper catches this at compile time! */
if( args == 1 || ( args > 1 && hb_param( 1, IT_NUMERIC ) ) )
{
/* If only one parameter or if 1st parameter is numeric, then use it

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

@@ -95,291 +95,261 @@ int matherr( struct exception *err )
HARBOUR HB_ABS( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
int iWidth;
int iDec;
if( pNumber )
hb_itemGetNLen( pNumber, &iWidth, &iDec );
if( IS_INTEGER( pNumber ) )
{
int iWidth;
int iDec;
int iNumber = hb_itemGetNI( pNumber );
hb_itemGetNLen( pNumber, &iWidth, &iDec );
if( IS_INTEGER( pNumber ) )
{
int iNumber = hb_itemGetNI( pNumber );
if( iNumber >= 0 )
hb_retnilen( iNumber, iWidth );
else
hb_retni( -iNumber );
}
else if( IS_LONG( pNumber ) )
{
long lNumber = hb_itemGetNL( pNumber );
if( lNumber >= 0 )
hb_retnllen( lNumber, iWidth );
else
hb_retnl( -lNumber );
}
else if( IS_DOUBLE( pNumber ) )
{
double dNumber = hb_itemGetND( pNumber );
hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, iDec );
}
if( iNumber >= 0 )
hb_retnilen( iNumber, iWidth );
else
hb_retni( -iNumber );
}
else
else if( IS_LONG( pNumber ) )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" );
long lNumber = hb_itemGetNL( pNumber );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
if( lNumber >= 0 )
hb_retnllen( lNumber, iWidth );
else
hb_retnl( -lNumber );
}
else if( IS_DOUBLE( pNumber ) )
{
double dNumber = hb_itemGetND( pNumber );
hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, iDec );
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ABS" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_EXP( void )
{
if( hb_pcount() == 1 )
if( ISNUM( 1 ) )
{
if( ISNUM( 1 ) )
double dResult = exp( hb_parnd( 1 ) );
if( internal_math_error )
{
double dResult = exp( hb_parnd( 1 ) );
if( internal_math_error )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1096, NULL, "EXP" );
internal_math_error = 0;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
else
hb_retnd( dResult );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1096, NULL, "EXP" );
PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1096, NULL, "EXP" );
internal_math_error = 0;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
else
hb_retnd( dResult );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EXP" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1096, NULL, "EXP" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_INT( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
double dNumber = hb_itemGetND( pNumber );
int iWidth;
if( pNumber )
{
double dNumber = hb_itemGetND( pNumber );
int iWidth;
hb_itemGetNLen( pNumber, &iWidth, NULL );
hb_itemGetNLen( pNumber, &iWidth, NULL );
hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), iWidth, 0 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), iWidth, 0 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "INT" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_LOG( void )
{
if( hb_pcount() == 1 )
if( ISNUM( 1 ) )
{
if( ISNUM( 1 ) )
{
#if defined( __WATCOMC__ )
double dResult = log( hb_parnd( 1 ) );
if( internal_math_error )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1095, NULL, "LOG" );
internal_math_error = 0;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
else
hb_retnd( dResult );
#else
double dNumber = hb_parnd( 1 );
if( dNumber <= 0.0 )
/* Indicate overflow if called with an invalid argument */
hb_retndlen( log( dNumber ), 99, -1 );
else
hb_retnd( log( dNumber ) );
#endif
}
else
double dResult = log( hb_parnd( 1 ) );
if( internal_math_error )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1095, NULL, "LOG" );
PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1095, NULL, "LOG" );
internal_math_error = 0;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
else
hb_retnd( dResult );
#else
double dNumber = hb_parnd( 1 );
if( dNumber <= 0.0 )
/* Indicate overflow if called with an invalid argument */
hb_retndlen( log( dNumber ), 99, -1 );
else
hb_retnd( log( dNumber ) );
#endif
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LOG" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1095, NULL, "LOG" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the maximum of two date or numerics */
HARBOUR HB_MAX( void )
{
if( hb_pcount() == 2 )
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
/* NOTE: The order of these if() branches is significant, */
/* Please, don't change it. */
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
/* NOTE: The order of these if() branches is significant, */
/* Please, don't change it. */
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
int iDec1;
int iDec2;
int iDec1;
int iDec2;
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
hb_retndlen( d1 >= d2 ? d1 : d2, 0, ( d1 >= d2 ? iDec1 : iDec2 ) );
}
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 >= l2 ? l1 : l2 );
}
else
{
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 >= i2 ? i1 : i2 );
}
hb_retndlen( d1 >= d2 ? d1 : d2, 0, ( d1 >= d2 ? iDec1 : iDec2 ) );
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
char szDate[ 9 ];
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retds( hb_itemGetNL( p1 ) >= hb_itemGetNL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
hb_retnl( l1 >= l2 ? l1 : l2 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" );
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
hb_retni( i1 >= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
char szDate[ 9 ];
hb_retds( hb_itemGetNL( p1 ) >= hb_itemGetNL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MAX" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the minimum of two date or numerics */
HARBOUR HB_MIN( void )
{
if( hb_pcount() == 2 )
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
/* NOTE: The order of these if() branches is significant, */
/* Please, don't change it. */
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
/* NOTE: The order of these if() branches is significant, */
/* Please, don't change it. */
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
int iDec1;
int iDec2;
int iDec1;
int iDec2;
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
hb_retndlen( d1 <= d2 ? d1 : d2, 0, ( d1 <= d2 ? iDec1 : iDec2 ) );
}
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 <= l2 ? l1 : l2 );
}
else
{
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 <= i2 ? i1 : i2 );
}
hb_retndlen( d1 <= d2 ? d1 : d2, 0, ( d1 <= d2 ? iDec1 : iDec2 ) );
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
char szDate[ 9 ];
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retds( hb_itemGetNL( p1 ) <= hb_itemGetNL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
hb_retnl( l1 <= l2 ? l1 : l2 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" );
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
hb_retni( i1 <= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
char szDate[ 9 ];
hb_retds( hb_itemGetNL( p1 ) <= hb_itemGetNL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MIN" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* TOFIX: In Clipper this is written in Clipper, see the source below, */
@@ -467,71 +437,61 @@ double hb_numRound( double dResult, int iDec )
HARBOUR HB_ROUND( void )
{
if( hb_pcount() == 2 )
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
int iDec = hb_parni( 2 );
int iDec = hb_parni( 2 );
hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, HB_MAX_( iDec, 0 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, HB_MAX_( iDec, 0 ) );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ROUND" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_SQRT( void )
{
if( hb_pcount() == 1 )
if( ISNUM( 1 ) )
{
if( ISNUM( 1 ) )
{
#if defined( __WATCOMC__ )
double dResult = sqrt( hb_parnd( 1 ) );
if( internal_math_error )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1097, NULL, "SQRT" );
internal_math_error = 0;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
else
hb_retnd( dResult );
#else
double dNumber = hb_parnd( 1 );
if( dNumber > 0 )
hb_retnd( sqrt( dNumber ) );
else
hb_retnd( 0 ); /* Clipper doesn't error! */
#endif
}
else
double dResult = sqrt( hb_parnd( 1 ) );
if( internal_math_error )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1097, NULL, "SQRT" );
PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1097, NULL, "SQRT" );
internal_math_error = 0;
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
else
hb_retnd( dResult );
#else
double dNumber = hb_parnd( 1 );
if( dNumber > 0 )
hb_retnd( sqrt( dNumber ) );
else
hb_retnd( 0 ); /* Clipper doesn't error! */
#endif
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SQRT" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1097, NULL, "SQRT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

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

@@ -246,30 +246,25 @@ char * hb_strLTrim( const char * szText, ULONG * ulLen )
/* TEST: QOUT( "ltrim( ' hello world ' ) = '" + ltrim( ' hello world ' ) + "'" ) */
HARBOUR HB_LTRIM( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
ULONG ulLen = pText->item.asString.length;
char * szText = hb_strLTrim( pText->item.asString.value, &ulLen );
if( pText )
{
ULONG ulLen = pText->item.asString.length;
char * szText = hb_strLTrim( pText->item.asString.value, &ulLen );
hb_retclen( szText, ulLen );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1101, NULL, "LTRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retclen( szText, ulLen );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LTRIM" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1101, NULL, "LTRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns szText and the new length in lLen */
@@ -297,30 +292,24 @@ ULONG hb_strRTrimLen( const char * szText, ULONG ulLen, BOOL bAnySpace )
/* TEST: QOUT( "rtrim( ' hello world ' ) = '" + rtrim( ' hello world ' ) + "'" ) */
HARBOUR HB_RTRIM( void )
{
if( hb_pcount() >= 1 && hb_pcount() <= 2 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE );
hb_retclen( pText->item.asString.value, hb_strRTrimLen( pText->item.asString.value, pText->item.asString.length, bAnySpace ) );
}
else
{
/* NOTE: "TRIM" is right here */
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1100, NULL, "TRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE );
hb_retclen( pText->item.asString.value, hb_strRTrimLen( pText->item.asString.value, pText->item.asString.length, bAnySpace ) );
}
else
{
/* NOTE: "TRIM" is right here */
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "TRIM" ); /* NOTE: Clipper catches this at compile time! */
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1100, NULL, "TRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: The second parameter is a Harbour extension */
@@ -576,29 +565,24 @@ ULONG hb_strAt( const char * szSub, ULONG ulSubLen, const char * szText, ULONG u
/* TEST: QOUT( "at( 'cde', 'abcdefgfedcba' ) = '" + at( 'cde', 'abcsefgfedcba' ) + "'" ) */
HARBOUR HB_AT( void )
{
if( hb_pcount() == 2 )
PHB_ITEM pSub = hb_param( 1, IT_STRING );
PHB_ITEM pText = hb_param( 2, IT_STRING );
if( pText && pSub )
{
PHB_ITEM pSub = hb_param( 1, IT_STRING );
PHB_ITEM pText = hb_param( 2, IT_STRING );
if( pText && pSub )
{
hb_retnl( hb_strAt( pSub->item.asString.value, pSub->item.asString.length,
pText->item.asString.value, pText->item.asString.length ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1108, NULL, "AT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retnl( hb_strAt( pSub->item.asString.value, pSub->item.asString.length,
pText->item.asString.value, pText->item.asString.length ) );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "AT" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1108, NULL, "AT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* locates a substring in a string starting at the end */
@@ -638,99 +622,84 @@ HARBOUR HB_RAT( void )
/* converts an ASCII code to a character value */
HARBOUR HB_CHR( void )
{
if( hb_pcount() == 1 )
if( ISNUM( 1 ) )
{
if( ISNUM( 1 ) )
{
char szChar[ 2 ];
char szChar[ 2 ];
/* NOTE: CA-Cl*pper's compiler optimizer will be wrong for those
CHR() cases where the passed parameter is a constant which
can be divided by 256 but it's not zero, in this case it
will return an empty string instead of a Chr(0). [vszel] */
/* NOTE: CA-Cl*pper's compiler optimizer will be wrong for those
CHR() cases where the passed parameter is a constant which
can be divided by 256 but it's not zero, in this case it
will return an empty string instead of a Chr(0). [vszel] */
/* Believe it or not, clipper does this! */
szChar[ 0 ] = hb_parnl( 1 ) % 256;
szChar[ 1 ] = '\0';
/* Believe it or not, clipper does this! */
szChar[ 0 ] = hb_parnl( 1 ) % 256;
szChar[ 1 ] = '\0';
hb_retclen( szChar, 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1104, NULL, "CHR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retclen( szChar, 1 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "CHR" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1104, NULL, "CHR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* converts a character value to an ASCII code */
HARBOUR HB_ASC( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
if( pText->item.asString.length > 0 )
hb_retni( ( BYTE ) * ( pText->item.asString.value ) );
else
hb_retni( 0 );
}
if( pText->item.asString.length > 0 )
hb_retni( ( BYTE ) * ( pText->item.asString.value ) );
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1107, NULL, "ASC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retni( 0 );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ASC" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1107, NULL, "ASC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the left-most n characters in string */
HARBOUR HB_LEFT( void )
{
if( hb_pcount() == 2 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText && ISNUM( 2 ) )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
LONG lLen = hb_parnl( 2 );
if( pText && ISNUM( 2 ) )
{
LONG lLen = hb_parnl( 2 );
if( lLen > ( LONG ) pText->item.asString.length )
lLen = ( LONG ) pText->item.asString.length;
if( lLen > ( LONG ) pText->item.asString.length )
lLen = ( LONG ) pText->item.asString.length;
else if( lLen < 0 )
lLen = 0;
else if( lLen < 0 )
lLen = 0;
hb_retclen( pText->item.asString.value, lLen );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1124, NULL, "LEFT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retclen( pText->item.asString.value, lLen );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LEFT" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1124, NULL, "LEFT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the right-most n characters in string */
@@ -760,76 +729,71 @@ HARBOUR HB_RIGHT( void )
/* returns l characters from n characters into string */
HARBOUR HB_SUBSTR( void )
{
if( hb_pcount() >= 2 && hb_pcount() <= 3 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText && ISNUM( 2 ) )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
LONG lPos = hb_parnl( 2 );
if( pText && ISNUM( 2 ) )
if( lPos < 0 )
{
LONG lPos = hb_parnl( 2 );
lPos += ( LONG ) pText->item.asString.length;
if( lPos < 0 )
{
lPos += ( LONG ) pText->item.asString.length;
if( lPos < 0 )
lPos = 0;
}
else if( lPos )
{
lPos--;
}
lPos = 0;
}
else if( lPos )
{
lPos--;
}
if( lPos < ( LONG ) pText->item.asString.length )
{
LONG lLen;
if( lPos < ( LONG ) pText->item.asString.length )
{
LONG lLen;
if( hb_pcount() >= 3 )
if( hb_pcount() >= 3 )
{
if( ISNUM( 3 ) )
{
if( ISNUM( 3 ) )
{
lLen = hb_parnl( 3 );
lLen = hb_parnl( 3 );
if( lLen > ( LONG ) pText->item.asString.length - lPos )
lLen = ( LONG ) pText->item.asString.length - lPos;
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
/* NOTE: Exit from inside */
return;
}
if( lLen > ( LONG ) pText->item.asString.length - lPos )
lLen = ( LONG ) pText->item.asString.length - lPos;
}
else
lLen = ( LONG ) pText->item.asString.length - lPos;
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( lLen > 0 )
hb_retclen( pText->item.asString.value + lPos, lLen );
else
hb_retc( "" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
/* NOTE: Exit from inside */
return;
}
}
else
lLen = ( LONG ) pText->item.asString.length - lPos;
if( lLen > 0 )
hb_retclen( pText->item.asString.value + lPos, lLen );
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retc( "" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SUBSTR" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* converts szText to lower case. Does not create a new string! */
@@ -848,32 +812,27 @@ char * hb_strLower( char * szText, ULONG ulLen )
/* converts string to lower case */
HARBOUR HB_LOWER( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
if( pText )
{
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
hb_retclen( hb_strLower( pszBuffer, ulLen ), ulLen );
hb_retclen( hb_strLower( pszBuffer, ulLen ), ulLen );
hb_itemFreeC( pszBuffer );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1103, NULL, "LOWER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_itemFreeC( pszBuffer );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LOWER" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1103, NULL, "LOWER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
void hb_strupr( char * szText )
@@ -918,132 +877,117 @@ char * hb_strncpyUpper( char * pDest, const char * pSource, ULONG ulLen )
/* converts string to upper case */
HARBOUR HB_UPPER( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
if( pText )
{
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
hb_retclen( hb_strUpper( pszBuffer, ulLen ), ulLen );
hb_retclen( hb_strUpper( pszBuffer, ulLen ), ulLen );
hb_itemFreeC( pszBuffer );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1102, NULL, "UPPER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_itemFreeC( pszBuffer );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "UPPER" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1102, NULL, "UPPER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns n copies of given string */
/* TEST: QOUT( "replicate( 'abc', 5 ) = " + replicate( 'abc', 5 ) ) */
HARBOUR HB_REPLICATE( void )
{
if( hb_pcount() == 2 )
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) )
LONG lTimes = hb_parnl( 2 );
if( lTimes > 0 )
{
LONG lTimes = hb_parnl( 2 );
ULONG ulLen = hb_parclen( 1 );
if( lTimes > 0 )
if( ( double ) ( ( double ) ulLen * ( double ) lTimes ) < ( double ) ULONG_MAX )
{
ULONG ulLen = hb_parclen( 1 );
char * szText = hb_parc( 1 );
char * szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 );
char * szPtr = szResult;
LONG i;
if( ( double ) ( ( double ) ulLen * ( double ) lTimes ) < ( double ) ULONG_MAX )
for( i = 0; i < lTimes; i++ )
{
char * szText = hb_parc( 1 );
char * szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 );
char * szPtr = szResult;
LONG i;
for( i = 0; i < lTimes; i++ )
{
hb_xmemcpy( szPtr, szText, ulLen );
szPtr += ulLen;
}
hb_retclen( szResult, ulLen * lTimes );
hb_xfree( szResult );
hb_xmemcpy( szPtr, szText, ulLen );
szPtr += ulLen;
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retclen( szResult, ulLen * lTimes );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1106, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_retc( "" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "REPLICATE" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1106, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns n copies of a single space */
/* TEST: QOUT( "space( 5 ) = '" + space( 5 ) + "'" ) */
HARBOUR HB_SPACE( void )
{
if( hb_pcount() == 1 )
if( ISNUM( 1 ) )
{
if( ISNUM( 1 ) )
LONG lLen = hb_parnl( 1 );
if( lLen > 0 )
{
LONG lLen = hb_parnl( 1 );
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
if( lLen > 0 )
{
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
/* NOTE: String overflow could never occure since a string can */
/* be as large as ULONG_MAX, and the maximum length that */
/* can be specified is LONG_MAX here. */
/* hb_errRT_BASE( EG_STROVERFLOW, 1233, NULL, "SPACE" ); */
/* NOTE: String overflow could never occure since a string can */
/* be as large as ULONG_MAX, and the maximum length that */
/* can be specified is LONG_MAX here. */
/* hb_errRT_BASE( EG_STROVERFLOW, 1233, NULL, "SPACE" ); */
hb_xmemset( szResult, ' ', lLen );
hb_retclen( szResult, lLen );
hb_xfree( szResult );
}
else
hb_retc( "" );
hb_xmemset( szResult, ' ', lLen );
hb_retclen( szResult, lLen );
hb_xfree( szResult );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1105, NULL, "SPACE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
hb_retc( "" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SPACE" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1105, NULL, "SPACE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* replaces characters in a string */
@@ -1254,42 +1198,37 @@ double hb_strVal( const char * szText )
/* returns the numeric value of a character string representation of a number */
HARBOUR HB_VAL( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
int iWidth;
int iDec;
char * ptr = strchr( pText->item.asString.value, '.' );
if( pText )
if( ptr )
{
int iWidth;
int iDec;
char * ptr = strchr( pText->item.asString.value, '.' );
if( ptr )
{
iWidth = ptr - pText->item.asString.value;
iDec = strlen( ptr + 1 );
}
else
{
iWidth = strlen( pText->item.asString.value );
iDec = 0;
}
hb_retnlen( hb_strVal( pText->item.asString.value ), iWidth, iDec );
iWidth = ptr - pText->item.asString.value;
iDec = strlen( ptr + 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1098, NULL, "VAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
iWidth = strlen( pText->item.asString.value );
iDec = 0;
}
hb_retnlen( hb_strVal( pText->item.asString.value ), iWidth, iDec );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "VAL" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1098, NULL, "VAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* $DOC$
@@ -1362,55 +1301,50 @@ HARBOUR HB_VAL( void )
HARBOUR HB_STR( void )
{
if( hb_pcount() >= 1 && hb_pcount() <= 3 )
BOOL bValid = TRUE;
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
PHB_ITEM pWidth = NULL;
PHB_ITEM pDec = NULL;
if( !pNumber )
bValid = FALSE;
else
{
BOOL bValid = TRUE;
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
PHB_ITEM pWidth = NULL;
PHB_ITEM pDec = NULL;
if( !pNumber )
bValid = FALSE;
else
if( hb_pcount() >= 2 )
{
if( hb_pcount() >= 2 )
{
pWidth = hb_param( 2, IT_NUMERIC );
if( !pWidth )
bValid = FALSE;
}
if( hb_pcount() >= 3 )
{
pDec = hb_param( 3, IT_NUMERIC );
if( !pDec )
bValid = FALSE;
}
pWidth = hb_param( 2, IT_NUMERIC );
if( !pWidth )
bValid = FALSE;
}
if( bValid )
if( hb_pcount() >= 3 )
{
char * szResult = hb_itemStr( pNumber, pWidth, pDec );
if( szResult )
{
hb_retc( szResult );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
pDec = hb_param( 3, IT_NUMERIC );
if( !pDec )
bValid = FALSE;
}
}
if( bValid )
{
char * szResult = hb_itemStr( pNumber, pWidth, pDec );
if( szResult )
{
hb_retc( szResult );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "STR" ); /* NOTE: Clipper catches this at compile time! */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* ------------------------------------------------- */
@@ -1616,3 +1550,4 @@ HARBOUR HB_HB_VALTOSTR( void )
if( bFreeReq )
hb_xfree( buffer );
}

409
harbour/source/rtl/transfrm.c
View File

@@ -387,249 +387,244 @@ static char * DatePicture( char * szDate, USHORT uiPicFlags, char * szResult )
HARBOUR HB_TRANSFORM( void )
{
if( hb_pcount() == 2 )
PHB_ITEM pExp = hb_param( 1, IT_ANY ); /* Input parameter */
if( ISCHAR( 2 ) && hb_parclen( 2 ) > 0 )
{
PHB_ITEM pExp = hb_param( 1, IT_ANY ); /* Input parameter */
PHB_ITEM pPic = hb_param( 2, IT_STRING ); /* Picture string */
if( ISCHAR( 2 ) && hb_parclen( 2 ) > 0 )
char *szPic = pPic->item.asString.value;
char *szTemp;
char *szResult;
char *szExp;
ULONG ulPic = pPic->item.asString.length;
ULONG ulPicStart = 0; /* Start of template */
ULONG ulExpPos = 0;
ULONG ulResultPos = 0;
ULONG n;
USHORT uiPicFlags = 0; /* Function flags */
if( *szPic == '@' ) /* Function marker found */
{
PHB_ITEM pPic = hb_param( 2, IT_STRING ); /* Picture string */
uiPicFlags = PictFunc( &szPic, &ulPic ); /* Get length of function */
ulPicStart = pPic->item.asString.length - ulPic;
/* Get start of template */
}
char *szPic = pPic->item.asString.value;
char *szTemp;
char *szResult;
char *szExp;
ULONG ulPic = pPic->item.asString.length;
ULONG ulPicStart = 0; /* Start of template */
ULONG ulExpPos = 0;
ULONG ulResultPos = 0;
ULONG n;
USHORT uiPicFlags = 0; /* Function flags */
if( *szPic == '@' ) /* Function marker found */
switch( pExp->type & ~IT_BYREF )
{
case IT_STRING:
{
uiPicFlags = PictFunc( &szPic, &ulPic ); /* Get length of function */
ulPicStart = pPic->item.asString.length - ulPic;
/* Get start of template */
}
szExp = pExp->item.asString.value;
szResult = ( char * ) hb_xgrab( ( ( ulPic-ulPicStart ) >
pExp->item.asString.length ) ?
( ulPic - ulPicStart ) + 64 : pExp->item.asString.length + 64 );
/* Grab enough */
szPic += ulPicStart; /* Skip functions */
switch( pExp->type & ~IT_BYREF )
{
case IT_STRING:
if( uiPicFlags & PF_UPPER ) /* Function : @! */
{
szExp = pExp->item.asString.value;
szResult = ( char * ) hb_xgrab( ( ( ulPic-ulPicStart ) >
pExp->item.asString.length ) ?
( ulPic - ulPicStart ) + 64 : pExp->item.asString.length + 64 );
/* Grab enough */
szPic += ulPicStart; /* Skip functions */
if( uiPicFlags & PF_UPPER ) /* Function : @! */
szTemp = szExp; /* Convert to upper */
for( n = pExp->item.asString.length; n != 0; n-- )
{
szTemp = szExp; /* Convert to upper */
for( n = pExp->item.asString.length; n != 0; n-- )
{
*szTemp = toupper( *szTemp );
szTemp++;
}
*szTemp = toupper( *szTemp );
szTemp++;
}
if( ulPic ) /* Template string */
{
while( ulPic && ulExpPos < pExp->item.asString.length )
{ /* Analyze picture mask */
switch( *szPic )
{
case '!': /* Upper */
{
szResult[ ulResultPos++ ] = toupper( szExp[ ulExpPos++ ] );
break;
}
case 'L': /* Ignored */
case 'Y':
case '*':
case '$':
case '.':
case ',':
break;
case '#': /* Out the character */
case '9':
case 'A':
case 'N':
case 'X':
case ' ':
{
szResult[ ulResultPos++ ] = szExp[ ulExpPos++ ];
break;
}
default: /* Other choices */
{
szResult[ ulResultPos++ ] = *szPic;
ulExpPos++;
}
}
szPic++;
ulPic--;
}
}
else if( uiPicFlags & ( PF_UPPER + PF_REMAIN ) )
{ /* Without template */
for( n = pExp->item.asString.length; n != 0; n-- )
szResult[ ulResultPos++ ] = *szExp++;
}
if( ( uiPicFlags & PF_REMAIN ) && ulPic )
{ /* Any chars left */
for( n = ulPic; n != 0; n-- )
szResult[ ulResultPos++ ] = *szPic;
/* Export remainder */
}
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_LOGICAL:
if( ulPic ) /* Template string */
{
BOOL bDone = FALSE;
szResult = ( char * ) hb_xgrab( ulPic + 1 );
/* That's all folks */
szPic += ulPicStart; /* Skip functions */
ulResultPos = 1;
if( ulPic ) /* Template string */
{
while( ulPic && ulExpPos < pExp->item.asString.length )
{ /* Analyze picture mask */
switch( *szPic )
{
case 'Y': /* Yes/No */
case '!': /* Upper */
{
*szResult = pExp->item.asLogical.value ? 'Y' : 'N';
szPic++;
ulPic--;
bDone = TRUE; /* Logical written */
szResult[ ulResultPos++ ] = toupper( szExp[ ulExpPos++ ] );
break;
}
case 'L': /* Ignored */
case 'Y':
case '*':
case '$':
case '.':
case ',':
break;
case '#': /* Out the character */
case '9':
case 'A':
case 'N':
case 'X':
case ' ':
{
szResult[ ulResultPos++ ] = szExp[ ulExpPos++ ];
break;
}
case '#':
case 'L': /* True/False */
default: /* Other choices */
{
*szResult = pExp->item.asLogical.value ? 'T' : 'F';
szPic++;
ulPic--;
bDone = TRUE;
break;
}
default:
{
*szResult = *szPic++;
ulPic--;
szResult[ ulResultPos++ ] = *szPic;
ulExpPos++;
}
}
szPic++;
ulPic--;
}
if( ( uiPicFlags & PF_REMAIN ) && ulPic )
{ /* Any chars left */
for( n = ulPic; n; n--) /* Copy remainder */
szResult[ ulResultPos++ ] = *szPic++;
if( !bDone ) /* Logical written ? */
szResult[ ulResultPos++ ] = pExp->item.asLogical.value ? 'T' : 'F';
}
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_INTEGER:
{
szResult = NumPicture( szPic + ulPicStart, ulPic, uiPicFlags,
( double ) pExp->item.asInteger.value, &ulResultPos,
pExp->item.asInteger.length, 0 );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
else if( uiPicFlags & ( PF_UPPER + PF_REMAIN ) )
{ /* Without template */
for( n = pExp->item.asString.length; n != 0; n-- )
szResult[ ulResultPos++ ] = *szExp++;
}
case IT_LONG:
{
szResult = NumPicture( szPic + ulPicStart, ulPic, uiPicFlags,
( double ) pExp->item.asLong.value, &ulResultPos,
pExp->item.asLong.length, 0 );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_DOUBLE:
{
szResult = NumPicture( szPic + ulPicStart, ulPic, uiPicFlags,
( double ) pExp->item.asDouble.value, &ulResultPos,
pExp->item.asDouble.length, pExp->item.asDouble.decimal );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_DATE:
{
char szDate[ 9 ];
char szResult[ 11 ];
DatePicture( hb_pardsbuff( szDate, 1 ), uiPicFlags, szResult );
hb_retc( szResult );
break;
if( ( uiPicFlags & PF_REMAIN ) && ulPic )
{ /* Any chars left */
for( n = ulPic; n != 0; n-- )
szResult[ ulResultPos++ ] = *szPic;
/* Export remainder */
}
default:
hb_errRT_BASE( EG_ARG, 1122, NULL, "TRANSFORM" );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
}
else if( ISCHAR( 2 ) || ISNIL( 2 ) ) /* No picture supplied */
{
switch( pExp->type & ~IT_BYREF ) /* Default behaviour */
case IT_LOGICAL:
{
case IT_STRING:
{
hb_retclen( pExp->item.asString.value, pExp->item.asString.length );
break;
}
case IT_LOGICAL:
{
hb_retc( pExp->item.asLogical.value ? "T" : "F" );
break;
}
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
{
char * szStr = hb_itemStr( pExp, NULL, NULL );
BOOL bDone = FALSE;
if( szStr )
szResult = ( char * ) hb_xgrab( ulPic + 1 );
/* That's all folks */
szPic += ulPicStart; /* Skip functions */
ulResultPos = 1;
if( ulPic ) /* Template string */
{
switch( *szPic )
{
hb_retc( szStr );
hb_xfree( szStr );
case 'Y': /* Yes/No */
{
*szResult = pExp->item.asLogical.value ? 'Y' : 'N';
szPic++;
ulPic--;
bDone = TRUE; /* Logical written */
break;
}
case '#':
case 'L': /* True/False */
{
*szResult = pExp->item.asLogical.value ? 'T' : 'F';
szPic++;
ulPic--;
bDone = TRUE;
break;
}
default:
{
*szResult = *szPic++;
ulPic--;
}
}
else
hb_retc( "" );
break;
}
case IT_DATE:
{
char szDate[ 9 ];
char szResult[ 11 ];
DatePicture( hb_pardsbuff( szDate, 1 ), 0, szResult );
hb_retc( szResult );
break;
if( ( uiPicFlags & PF_REMAIN ) && ulPic )
{ /* Any chars left */
for( n = ulPic; n; n--) /* Copy remainder */
szResult[ ulResultPos++ ] = *szPic++;
if( !bDone ) /* Logical written ? */
szResult[ ulResultPos++ ] = pExp->item.asLogical.value ? 'T' : 'F';
}
default:
hb_errRT_BASE( EG_ARG, 1122, NULL, "TRANSFORM" );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_INTEGER:
{
szResult = NumPicture( szPic + ulPicStart, ulPic, uiPicFlags,
( double ) pExp->item.asInteger.value, &ulResultPos,
pExp->item.asInteger.length, 0 );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_LONG:
{
szResult = NumPicture( szPic + ulPicStart, ulPic, uiPicFlags,
( double ) pExp->item.asLong.value, &ulResultPos,
pExp->item.asLong.length, 0 );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_DOUBLE:
{
szResult = NumPicture( szPic + ulPicStart, ulPic, uiPicFlags,
( double ) pExp->item.asDouble.value, &ulResultPos,
pExp->item.asDouble.length, pExp->item.asDouble.decimal );
hb_retclen( szResult, ulResultPos );
hb_xfree( szResult );
break;
}
case IT_DATE:
{
char szDate[ 9 ];
char szResult[ 11 ];
DatePicture( hb_pardsbuff( szDate, 1 ), uiPicFlags, szResult );
hb_retc( szResult );
break;
}
default:
hb_errRT_BASE( EG_ARG, 1122, NULL, "TRANSFORM" );
}
}
else if( ISCHAR( 2 ) || ISNIL( 2 ) ) /* No picture supplied */
{
switch( pExp->type & ~IT_BYREF ) /* Default behaviour */
{
case IT_STRING:
{
hb_retclen( pExp->item.asString.value, pExp->item.asString.length );
break;
}
case IT_LOGICAL:
{
hb_retc( pExp->item.asLogical.value ? "T" : "F" );
break;
}
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
{
char * szStr = hb_itemStr( pExp, NULL, NULL );
if( szStr )
{
hb_retc( szStr );
hb_xfree( szStr );
}
else
hb_retc( "" );
break;
}
case IT_DATE:
{
char szDate[ 9 ];
char szResult[ 11 ];
DatePicture( hb_pardsbuff( szDate, 1 ), 0, szResult );
hb_retc( szResult );
break;
}
default:
hb_errRT_BASE( EG_ARG, 1122, NULL, "TRANSFORM" );
}
else
hb_errRT_BASE( EG_ARG, 1122, NULL, "TRANSFORM");
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "TRANSFORM" ); /* NOTE: Clipper catches this at compile time! */
hb_errRT_BASE( EG_ARG, 1122, NULL, "TRANSFORM");
}

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

@@ -540,7 +540,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
case HB_P_PARAMETER:
uiParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
hb_memvarNewParameter( pSymbols + uiParams, hb_stack.pBase + 1 + pCode[ w + 3 ] );
HB_TRACE(HB_TR_INFO, ("(hb_vmPopParameter)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPopParameter)"));
w += 4;
break;
@@ -580,7 +580,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
case HB_P_ENDBLOCK:
hb_vmEndBlock();
HB_TRACE(HB_TR_INFO, ("(EndBlock)"));
HB_TRACE(HB_TR_INFO, ("(EndBlock)"));
return; /* end of a codeblock - stop evaluation */
/* BEGIN SEQUENCE/RECOVER/END SEQUENCE */
@@ -734,7 +734,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
case HB_P_PUSHNIL:
hb_stack.pPos->type = IT_NIL;
hb_stackPush();
HB_TRACE(HB_TR_INFO, ("(hb_vmPushNil)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPushNil)"));
w++;
break;
@@ -800,7 +800,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
uiParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
hb_rddGetFieldValue( hb_stack.pPos, pSymbols + uiParams );
hb_stackPush();
HB_TRACE(HB_TR_INFO, ("(hb_vmPushField)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPushField)"));
w += 3;
break;
@@ -828,7 +828,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
uiParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
hb_memvarGetValue( hb_stack.pPos, pSymbols + uiParams );
hb_stackPush();
HB_TRACE(HB_TR_INFO, ("(hb_vmPushMemvar)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPushMemvar)"));
w += 3;
break;
@@ -836,7 +836,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
uiParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
hb_memvarGetRefer( hb_stack.pPos, pSymbols + uiParams );
hb_stackPush();
HB_TRACE(HB_TR_INFO, ("(hb_vmPushMemvarRef)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPushMemvarRef)"));
w += 3;
break;
@@ -873,7 +873,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
}
}
while( uiAction == E_RETRY );
HB_TRACE(HB_TR_INFO, ("(hb_vmPushVariable)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPushVariable)"));
w += 3;
}
break;
@@ -914,7 +914,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
hb_stackDec();
hb_rddPutFieldValue( hb_stack.pPos, pSymbols + uiParams );
hb_itemClear( hb_stack.pPos );
HB_TRACE(HB_TR_INFO, ("(hb_vmPopField)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPopField)"));
w += 3;
break;
@@ -933,7 +933,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
hb_stackDec();
hb_memvarSetValue( pSymbols + uiParams, hb_stack.pPos );
hb_itemClear( hb_stack.pPos );
HB_TRACE(HB_TR_INFO, ("(hb_vmPopMemvar)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPopMemvar)"));
w += 3;
break;
@@ -951,7 +951,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
if( hb_rddFieldPut( hb_stack.pPos, pSymbols + uiParams ) == FAILURE )
hb_memvarSetValue( pSymbols + uiParams, hb_stack.pPos );
hb_itemClear( hb_stack.pPos );
HB_TRACE(HB_TR_INFO, ("(hb_vmPopVariable)"));
HB_TRACE(HB_TR_INFO, ("(hb_vmPopVariable)"));
w += 3;
break;
@@ -3377,134 +3377,119 @@ void hb_vmForceLink( void )
HARBOUR HB_LEN( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
case IT_ARRAY:
hb_retnl( hb_arrayLen( pItem ) );
break;
/* NOTE: pItem cannot be NULL here */
case IT_STRING:
hb_retnl( hb_itemGetCLen( pItem ) );
break;
switch( pItem->type )
default:
{
case IT_ARRAY:
hb_retnl( hb_arrayLen( pItem ) );
break;
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1111, NULL, "LEN" );
case IT_STRING:
hb_retnl( hb_itemGetCLen( pItem ) );
break;
default:
if( pResult )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1111, NULL, "LEN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LEN" ); /* NOTE: Clipper catches this at compile time! */
}
HARBOUR HB_EMPTY( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type & ~IT_BYREF )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
case IT_ARRAY:
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
/* NOTE: pItem cannot be NULL here */
case IT_STRING:
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
case IT_INTEGER:
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
case IT_STRING:
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
case IT_LONG:
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_INTEGER:
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
case IT_DOUBLE:
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
case IT_LONG:
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_DATE:
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_DOUBLE:
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
case IT_LOGICAL:
hb_retl( ! hb_itemGetL( pItem ) );
break;
case IT_DATE:
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_BLOCK:
hb_retl( FALSE );
break;
case IT_LOGICAL:
hb_retl( ! hb_itemGetL( pItem ) );
break;
case IT_BLOCK:
hb_retl( FALSE );
break;
default:
hb_retl( TRUE );
break;
}
default:
hb_retl( TRUE );
break;
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EMPTY" ); /* NOTE: Clipper catches this at compile time! */
}
HARBOUR HB_VALTYPE( void )
{
if( hb_pcount() == 1 )
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type & ~IT_BYREF )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
case IT_ARRAY:
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
/* NOTE: pItem cannot be NULL here */
case IT_BLOCK:
hb_retc( "B" );
break;
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
case IT_DATE:
hb_retc( "D" );
break;
case IT_BLOCK:
hb_retc( "B" );
break;
case IT_LOGICAL:
hb_retc( "L" );
break;
case IT_DATE:
hb_retc( "D" );
break;
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
hb_retc( "N" );
break;
case IT_LOGICAL:
hb_retc( "L" );
break;
case IT_STRING:
hb_retc( "C" );
break;
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
hb_retc( "N" );
break;
case IT_STRING:
hb_retc( "C" );
break;
case IT_NIL:
default:
hb_retc( "U" );
break;
}
case IT_NIL:
default:
hb_retc( "U" );
break;
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "VALTYPE" ); /* NOTE: Clipper catches this at compile time! */
}
HARBOUR HB_TYPE( void )
@@ -3518,15 +3503,10 @@ HARBOUR HB_TYPE( void )
HARBOUR HB_WORD( void )
{
if( hb_pcount() == 1 )
{
if( ISNUM( 1 ) )
hb_retni( hb_parni( 1 ) );
else
hb_errRT_BASE( EG_ARG, 1091, NULL, "WORD" );
}
if( ISNUM( 1 ) )
hb_retni( hb_parni( 1 ) );
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "WORD" );
hb_errRT_BASE( EG_ARG, 1091, NULL, "WORD" );
}
HARBOUR HB_PROCNAME( void )
@@ -3594,15 +3574,10 @@ HARBOUR HB_ERRORLEVEL( void )
HARBOUR HB_PCOUNT( void )
{
if( hb_pcount() == 0 )
{
/* Skip current function */
PHB_ITEM pBase = hb_stack.pItems + hb_stack.pBase->item.asSymbol.stackbase;
/* Skip current function */
PHB_ITEM pBase = hb_stack.pItems + hb_stack.pBase->item.asSymbol.stackbase;
hb_retni( pBase->item.asSymbol.paramcnt );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "PCOUNT" ); /* NOTE: Clipper catches this at compile time! */
hb_retni( pBase->item.asSymbol.paramcnt );
}
HARBOUR HB_PVALUE( void ) /* PValue( <nArg> ) */
@@ -3717,3 +3692,4 @@ HARBOUR HB___VMVARSGET( void )
hb_itemReturn( s_aStatics.item.asArray.value->pItems +
hb_stack.iStatics + hb_parni( 1 ) - 1 );
}