From 3c69fc1ea15584a23ac5a4465b65c6fad5666db2 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sat, 13 Nov 1999 13:04:11 +0000 Subject: [PATCH] 19991113-13:49 GMT+1 Victor Szel --- harbour/ChangeLog | 282 ++++++++------- harbour/doc/subcodes.txt | 6 - harbour/source/rtl/arrays.c | 37 +- harbour/source/rtl/console.c | 65 +--- harbour/source/rtl/dates.c | 520 ++++++++++++--------------- harbour/source/rtl/do.c | 114 +++--- harbour/source/rtl/filesys.c | 5 +- harbour/source/rtl/inkey.c | 3 - harbour/source/rtl/math.c | 438 +++++++++++------------ harbour/source/rtl/strings.c | 645 +++++++++++++++------------------- harbour/source/rtl/transfrm.c | 409 +++++++++++---------- harbour/source/vm/hvm.c | 214 +++++------ 12 files changed, 1247 insertions(+), 1491 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index bfa845d428..b8a14685b8 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +19991113-13:49 GMT+1 Victor Szel + * 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 * source/rtl/extend.c include/extend.h @@ -24,7 +38,7 @@ 19991113-03:23 GMT+1 Victor Szel * 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 * 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 @@ -203,25 +217,25 @@ Tue Nov 09 11:56:05 1999 Gonzalo A. Diethelm - * 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 * samples/Makefile @@ -307,7 +321,7 @@ Tue Nov 09 11:56:05 1999 Gonzalo A. Diethelm 19991105-14:07 GMT+1 Ryszard Glab *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 * source/rtl/filesys.c @@ -329,78 +343,78 @@ Tue Nov 09 11:56:05 1999 Gonzalo A. Diethelm Thu Nov 04 14:32:06 1999 Gonzalo A. Diethelm - * 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 - * 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 * source/rtl/filesys.c @@ -416,13 +430,13 @@ Thu Nov 04 13:49:23 1999 Gonzalo A. Diethelm Wed Nov 03 18:38:03 1999 Gonzalo A. Diethelm - * 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 Tue Oct 26 17:16:43 1999 Gonzalo A. Diethelm - * 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 - * 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 * source/rtl/gt/gtwin.c @@ -587,29 +601,29 @@ Tue Oct 26 13:20:46 1999 Gonzalo A. Diethelm Tue Oct 26 13:11:19 1999 Gonzalo A. Diethelm - * 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 - * 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 - * 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 * include/itemapi.h diff --git a/harbour/doc/subcodes.txt b/harbour/doc/subcodes.txt index afd62187d1..38a5dbc2ca 100644 --- a/harbour/doc/subcodes.txt +++ b/harbour/doc/subcodes.txt @@ -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$ */ diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index 31171f4f79..a2ddda09da 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -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 ) diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index a80cdce4d7..4f04f38b99 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -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 ) diff --git a/harbour/source/rtl/dates.c b/harbour/source/rtl/dates.c index a765444b6d..5c72c535bd 100644 --- a/harbour/source/rtl/dates.c +++ b/harbour/source/rtl/dates.c @@ -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() ); } diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index f096d0f80f..80f16c3ae3 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -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 ); + } + } } diff --git a/harbour/source/rtl/filesys.c b/harbour/source/rtl/filesys.c index cc4601b727..4ab3612127 100644 --- a/harbour/source/rtl/filesys.c +++ b/harbour/source/rtl/filesys.c @@ -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 ) diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c index 309eb96ee4..8dd9dbc3fa 100644 --- a/harbour/source/rtl/inkey.c +++ b/harbour/source/rtl/inkey.c @@ -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 diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 622929c6d1..cb813af733 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -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 ); + } + } } diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index 052d693d0f..5a05f97262 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -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 ); } + diff --git a/harbour/source/rtl/transfrm.c b/harbour/source/rtl/transfrm.c index c893bc8d81..541167447a 100644 --- a/harbour/source/rtl/transfrm.c +++ b/harbour/source/rtl/transfrm.c @@ -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"); } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 3f455086d4..dced086346 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -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( ) */ @@ -3717,3 +3692,4 @@ HARBOUR HB___VMVARSGET( void ) hb_itemReturn( s_aStatics.item.asArray.value->pItems + hb_stack.iStatics + hb_parni( 1 ) - 1 ); } +