From d83652a4a03338b9a5bd64ec23dc0cb15a15f2d7 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 17 Apr 2000 03:54:17 +0000 Subject: [PATCH] 20000417-05:49 GMT+1 Victor Szakats --- harbour/ChangeLog | 24 +++ harbour/include/hbapi.h | 1 + harbour/include/hbapiitm.h | 1 + harbour/makefile.bc | 13 +- harbour/makefile.vc | 2 +- harbour/source/lang/msges.c | 74 ++++----- harbour/source/rtl/Makefile | 1 - harbour/source/rtl/asort.prg | 129 ---------------- harbour/source/vm/Makefile | 1 + harbour/source/vm/asort.c | 281 +++++++++++++++++++++++++++++++++++ harbour/source/vm/itemapi.c | 18 +++ 11 files changed, 369 insertions(+), 176 deletions(-) delete mode 100644 harbour/source/rtl/asort.prg create mode 100644 harbour/source/vm/asort.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 80cd75e4a5..49220694f3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,27 @@ +20000417-05:49 GMT+1 Victor Szakats + + * include/hbapi.h + - source/rtl/asort.prg + * source/rtl/Makefile + + source/vm/asort.c + * source/vm/Makefile + * makefile.bc + * makefile.vc + + ASORT() rewritten using optimized C code, and using an optimized + quicksort algorithm, the number of compares is even less than before. + * ASORT() is now CA-Cl*pper compatible in handling the case when no + codeblock is supplied, or the codeblock returns non logical value. + ; Note that the function is new, so please test it as thoroughly as + possible. + ; Also thanks go to Jose Lalin. + + * include/hbapiitm.h + * source/vm/itemapi.c + + hb_itemSwap() function added. + + * source/lang/msges.c + * Spanish language module updated. + 20000416-15:23 GMT+2 Maurilio Longo * config/os2/gcc.cf diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index c4be44ed9c..3d7c9370ee 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -368,6 +368,7 @@ extern ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart extern BOOL hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG * pulStart, ULONG * pulCount ); extern BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG * pulStart, ULONG * pulCount, ULONG * pulTarget ); extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray ); +extern BOOL hb_arraySort( PHB_ITEM pArray, ULONG * pulStart, ULONG * pulCount, PHB_ITEM pBlock ); /* string management */ diff --git a/harbour/include/hbapiitm.h b/harbour/include/hbapiitm.h index bd0656299e..b903b1251f 100644 --- a/harbour/include/hbapiitm.h +++ b/harbour/include/hbapiitm.h @@ -111,6 +111,7 @@ extern char * hb_itemStr ( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pD extern char * hb_itemString ( PHB_ITEM pItem, ULONG * ulLen, BOOL * bFreeReq ); /* Convert any scalar to a string */ extern PHB_ITEM hb_itemValToStr ( PHB_ITEM pItem ); /* Convert any scalar to a string */ extern char * hb_itemPadConv ( PHB_ITEM pItem, char * buffer, ULONG * pulSize ); +extern void hb_itemSwap ( PHB_ITEM pItem1, PHB_ITEM pItem2 ); #if defined(HB_EXTERN_C) } diff --git a/harbour/makefile.bc b/harbour/makefile.bc index f76c789ffd..1bc6da9fd8 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -258,7 +258,6 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\achoice.obj \ $(OBJ_DIR)\adir.obj \ $(OBJ_DIR)\alert.obj \ - $(OBJ_DIR)\asort.obj \ $(OBJ_DIR)\browdb.obj \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ @@ -434,6 +433,7 @@ COMMON_LIB_OBJS = \ VM_LIB_OBJS = \ $(OBJ_DIR)\arrays.obj \ $(OBJ_DIR)\arrayshb.obj \ + $(OBJ_DIR)\asort.obj \ $(OBJ_DIR)\break.obj \ $(OBJ_DIR)\classes.obj \ $(OBJ_DIR)\cmdarg.obj \ @@ -826,6 +826,10 @@ $(OBJ_DIR)\arrayshb.obj : $(VM_DIR)\arrayshb.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(VM_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\asort.obj : $(VM_DIR)\asort.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(VM_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\break.obj : $(VM_DIR)\break.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(VM_LIB) $(ARFLAGS) -+$@,, @@ -962,13 +966,6 @@ $(OBJ_DIR)\ampm.obj : $(RTL_DIR)\ampm.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, -$(OBJ_DIR)\asort.c : $(RTL_DIR)\asort.prg - $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ - -$(OBJ_DIR)\asort.obj : $(OBJ_DIR)\asort.c - $(CC) $(CLIBFLAGS) -o$@ $** - tlib $(RTL_LIB) $(ARFLAGS) -+$@,, - $(OBJ_DIR)\at.obj : $(RTL_DIR)\at.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/makefile.vc b/harbour/makefile.vc index 769006b940..eb0b9fa127 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -294,7 +294,6 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\achoice.obj \ $(OBJ_DIR)\adir.obj \ $(OBJ_DIR)\alert.obj \ - $(OBJ_DIR)\asort.obj \ $(OBJ_DIR)\browdb.obj \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ @@ -548,6 +547,7 @@ COMMON_LIB_OBJS = \ VM_LIB_OBJS = \ $(OBJ_DIR)\arrays.obj \ $(OBJ_DIR)\arrayshb.obj \ + $(OBJ_DIR)\asort.obj \ $(OBJ_DIR)\break.obj \ $(OBJ_DIR)\classes.obj \ $(OBJ_DIR)\cmdarg.obj \ diff --git a/harbour/source/lang/msges.c b/harbour/source/lang/msges.c index 0a24b2821d..8a25ae280e 100644 --- a/harbour/source/lang/msges.c +++ b/harbour/source/lang/msges.c @@ -35,7 +35,7 @@ /* Language name: Spanish */ /* ISO language code (2 chars): ES */ -/* Codepage: ???? */ +/* Codepage: 850 */ #include "hbapilng.h" @@ -78,19 +78,19 @@ static HB_LANG s_lang = /* CA-Cl*pper compatible natmsg items */ - "Database Files # Records Last Update Size", - "Do you want more samples?", - "Page No.", + "Bases de Datos # Records Last Update Size", + "Desea Ud. m s ejemplos?", + "P gina N§.", "** Subtotal **", "* Subsubtotal *", "*** Total ***", "Ins", " ", - "Invalid date", - "Range: ", + "Fecha no v lida", + "Rango: ", " - ", - "Y/N", - "INVALID EXPRESSION", + "S/N", + "EXPRESION NO VALIDA", /* Error description names */ @@ -140,40 +140,40 @@ static HB_LANG s_lang = "", "", "", - "array access", - "array assign", - "array dimension", - "not an array", + "acceso al array", + "asignaci¢n del array", + "dimensi¢n del array", + "no es un array", "conditional", /* Internal error names */ - "Unrecoverable error %lu: ", - "Error recovery failure", - "No ERRORBLOCK() for error", - "Too many recursive error handler calls", - "RDD invalid or failed to load", - "Invalid method type from %s", - "hb_xgrab can't allocate memory", - "hb_xrealloc called with a NULL pointer", - "hb_xrealloc called with an invalid pointer", - "hb_xrealloc can't reallocate memory", - "hb_xfree called with an invalid pointer", - "hb_xfree called with a NULL pointer", - "Can\'t locate the starting procedure: \'%s\'", - "No starting procedure", - "Unsupported VM opcode", - "Symbol item expected from %s", - "Invalid symbol type for self from %s", - "Codeblock expected from %s", - "Incorrect item type on the stack trying to pop from %s", - "Stack underflow", - "An item was going to be copied to itself from %s", - "Invalid symbol item passed as memvar %s", - + "Error irrecuperable %lu: ", + "Falla en recuperaci¢n de error", + "No hay ERRORBLOCK() por error", + "Demasiadas llamadas recursivas al controlador de errores", + "RDD no v lido ¢ falla al cargar", + "Tipo de m‚todo no v lido desde %s", + "hb_xgrab no puede asignar memoria", + "hb_xrealloc llamado con un puntero NULL", + "hb_xrealloc llamado con un puntero no v lido", + "hb_xrealloc no puede reubicar la memoria", + "hb_xfree llamado con un puntero no v lido", + "hb_xfree llamado con un puntero NULL", + "No se puede localizar el procedimiento de inicio: \'%s\'", + "No hay procedimiento de inicio", + "Opcode de memoria virtual (VM) no soportado", + "S¡mbolo item esperado desde %s", + "Tipo de s¡mbolo para self no v lido desde %s", + "Bloque de c¢digo esperado desde %s", + "Tipo item incorrecto en la Pila al tratar de sacarlo desde %s", + "Falla de Pila por defecto", + "Un item estaba siendo copiado sobre s¡ mismo desde %s", + "S¡mbolo item no v lido pasado como memvar %s", + /* Texts */ - - "DD/MM/YYYY", + + "YYYY/MM/DD", "S", "N" } diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 497270b2be..7ef9f7ecd3 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -110,7 +110,6 @@ PRG_SOURCES=\ achoice.prg \ adir.prg \ alert.prg \ - asort.prg \ browdb.prg \ browdbx.prg \ browse.prg \ diff --git a/harbour/source/rtl/asort.prg b/harbour/source/rtl/asort.prg deleted file mode 100644 index 8a8ef589b5..0000000000 --- a/harbour/source/rtl/asort.prg +++ /dev/null @@ -1,129 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * ASORT() function - * - * Copyright 1999 Eddie Runia - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version, with one exception: - * - * The exception is that if you link the Harbour Runtime Library (HRL) - * and/or the Harbour Virtual Machine (HVM) with other files to produce - * an executable, this does not by itself cause the resulting executable - * to be covered by the GNU General Public License. Your use of that - * executable is in no way restricted on account of linking the HRL - * and/or HVM code into it. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit - * their web site at http://www.gnu.org/). - * - */ - -#include "common.ch" - -FUNCTION ASort( aArray, nStart, nCount, bBlock ) - - IF !ISARRAY( aArray ) - RETURN NIL - ENDIF - - IF Len( aArray ) >= 1 - - IF !ISNUMBER( nStart ) .OR. nStart == 0 - nStart := 1 - ENDIF - - IF nStart >= 1 - - IF nStart > Len( aArray ) - nStart := Len( aArray ) - ENDIF - - IF !ISNUMBER( nCount ) .OR. nCount < 1 .OR. nCount > ( Len( aArray ) - nStart + 1 ) - nCount := Len( aArray ) - nStart + 1 - ENDIF - - /* NOTE: For speed we are checking the return type of the passed - codeblock here. This will result in a small incompatibility - since the codeblock will be called one more time for the - first logical element than in Clipper. But block calling - frequency and order differs from CA-Clipper anyway, since - they use different sorting algorhythms. [vszakats] */ - - IF !ISBLOCK( bBlock ) .OR. !( ISLOGICAL( Eval( bBlock, aArray[ nStart ], aArray[ nStart ] ) ) ) - bBlock := {| x, y | x < y } - ENDIF - - QuickSort( aArray, nStart, nStart + nCount - 1, bBlock ) - - ENDIF - - ENDIF - - RETURN aArray - -/* - * QuickSort( , , , ) - * - * Perform a QuickSort of . - * - * For instructions : - * http://monty.cnri.reston.va.us/grail/demo/quicksort/quicksort.htm - */ -STATIC PROCEDURE QuickSort( aArray, nLeft, nRight, bBlock ) - - LOCAL nUp := nLeft - LOCAL nDown := nRight - LOCAL xMiddle := aArray[ Int( ( nLeft + nRight ) / 2 ) ] - LOCAL xTemp - - DO WHILE .T. - - DO WHILE Eval( bBlock, aArray[ nUp ], xMiddle ) - nUp++ - ENDDO - - DO WHILE Eval( bBlock, xMiddle, aArray[ nDown ] ) - nDown-- - ENDDO - - IF nUp <= nDown - IF nUp != nDown - xTemp := aArray[ nUp ] - aArray[ nUp ] := aArray[ nDown ] - aArray[ nDown ] := xTemp - ENDIF - nUp++ - nDown-- - ENDIF - - IF nUp > nDown - EXIT - ENDIF - - ENDDO - - IF nLeft < nDown - QuickSort( aArray, nLeft, nDown , bBlock ) - ENDIF - - IF nUp < nRight - QuickSort( aArray, nUp , nRight, bBlock ) - ENDIF - - RETURN - diff --git a/harbour/source/vm/Makefile b/harbour/source/vm/Makefile index ab4c5e4677..1bf092836e 100644 --- a/harbour/source/vm/Makefile +++ b/harbour/source/vm/Makefile @@ -7,6 +7,7 @@ ROOT = ../../ C_SOURCES=\ arrays.c \ arrayshb.c \ + asort.c \ break.c \ classes.c \ cmdarg.c \ diff --git a/harbour/source/vm/asort.c b/harbour/source/vm/asort.c new file mode 100644 index 0000000000..33e2cf2a1c --- /dev/null +++ b/harbour/source/vm/asort.c @@ -0,0 +1,281 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * ASORT() function + * + * Copyright 2000 Victor Szakats + * Jose Lalin + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* TOFIX: The sorting engine requires signed indexes to work, this means + that arrays larger than 2^31 elements cannot be sorted. [vszakats] */ + +/* NOTE: Based on PD code found in + SORTING AND SEARCHING ALGORITHMS: A COOKBOOK, BY THOMAS NIEMANN + http://members.xoom.com/_XMCM/thomasn/s_man.htm */ + +#include "hbapiitm.h" +#include "hbvm.h" + +/* NOTE: If this is defined the item copying is optimized, in a way that + instead of calling the official hb_itemCopy(), the item structures + will be directly copied with memcpy(), this means that the related + data areas (string space for example) will never be moved. This can be + safely done here, because it's guaranteed by the nature of sorting + that the set of items doesn't change (there're no deleted or new + items, just swapping) in this functions. + Using this option makes sorting *much* faster, but if you have a + problem, or the low level stuff changes, turn it off. [vszakats] */ +#define HB_ASORT_OPT_ITEMCOPY + +static BOOL hb_itemIsLess( PHB_ITEM pItem1, PHB_ITEM pItem2 ) +{ + if( HB_IS_STRING( pItem1 ) && HB_IS_STRING( pItem2 ) ) + return hb_itemStrCmp( pItem1, pItem2, FALSE ) < 0; + else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) + return hb_itemGetND( pItem1 ) < hb_itemGetND( pItem2 ); + else if( HB_IS_DATE( pItem1 ) && HB_IS_DATE( pItem2 ) ) + return hb_itemGetDL( pItem1 ) < hb_itemGetDL( pItem2 ); + else if( HB_IS_LOGICAL( pItem1 ) && HB_IS_LOGICAL( pItem2 ) ) + return hb_itemGetL( pItem1 ) < hb_itemGetL( pItem2 ); + else + { + /* NOTE: For non-matching types CA-Cl*pper sorts always like this: + Array/Object Block String Date Numeric NIL [jlalin] */ + + int iWeight1; + int iWeight2; + + if( HB_IS_ARRAY( pItem1 ) ) iWeight1 = 1; + else if( HB_IS_BLOCK( pItem1 ) ) iWeight1 = 2; + else if( HB_IS_STRING( pItem1 ) ) iWeight1 = 3; + else if( HB_IS_DATE( pItem1 ) ) iWeight1 = 4; + else if( HB_IS_NUMERIC( pItem1 ) ) iWeight1 = 5; + else iWeight1 = 6; + + if( HB_IS_ARRAY( pItem2 ) ) iWeight2 = 1; + else if( HB_IS_BLOCK( pItem2 ) ) iWeight2 = 2; + else if( HB_IS_STRING( pItem2 ) ) iWeight2 = 3; + else if( HB_IS_DATE( pItem2 ) ) iWeight2 = 4; + else if( HB_IS_NUMERIC( pItem2 ) ) iWeight2 = 5; + else iWeight2 = 6; + + return iWeight1 < iWeight2; + } +} + +/* partition array pItems[lb..ub] */ + +static LONG hb_arraySortQuickPartition( PHB_ITEM pItems, LONG lb, LONG ub, PHB_ITEM pBlock ) +{ + LONG i; + LONG j; + LONG p; + + HB_ITEM pivot; + + /* select pivot and exchange with 1st element */ + p = lb + ( ( ub - lb ) / 2 ); + +#ifdef HB_ASORT_OPT_ITEMCOPY + memcpy( &pivot, pItems + p, sizeof( HB_ITEM ) ); + if( p != lb ) + memcpy( pItems + p, pItems + lb, sizeof( HB_ITEM ) ); +#else + hb_itemCopy( &pivot, pItems + p ); + if( p != lb ) + hb_itemCopy( pItems + p, pItems + lb ); +#endif + + /* sort lb+1..ub based on pivot */ + i = lb + 1; + j = ub; + + while( TRUE ) + { + if( pBlock ) + { + /* Call the codeblock to compare the items */ + while( i < j ) + { + hb_vmPushSymbol( &hb_symEval ); + hb_vmPush( pBlock ); + hb_vmPush( pItems + i ); + hb_vmPush( &pivot ); + hb_vmDo( 2 ); + + if( HB_IS_LOGICAL( &hb_stack.Return ) && hb_stack.Return.item.asLogical.value ) + i++; + else + break; + } + + while( j >= i ) + { + hb_vmPushSymbol( &hb_symEval ); + hb_vmPush( pBlock ); + hb_vmPush( &pivot ); + hb_vmPush( pItems + j ); + hb_vmDo( 2 ); + + if( HB_IS_LOGICAL( &hb_stack.Return ) && hb_stack.Return.item.asLogical.value ) + j--; + else + break; + } + } + else + { + /* Do native compare when no codeblock is supplied */ + while( i < j && hb_itemIsLess( pItems + i, &pivot ) ) + i++; + + while( j >= i && hb_itemIsLess( &pivot, pItems + j ) ) + j--; + } + + if( i >= j ) + break; + + /* Swap the items */ + { + HB_ITEM temp; + +#ifdef HB_ASORT_OPT_ITEMCOPY + memcpy( &temp, pItems + j, sizeof( HB_ITEM ) ); + memcpy( pItems + j, pItems + i, sizeof( HB_ITEM ) ); + memcpy( pItems + i, &temp, sizeof( HB_ITEM ) ); +#else + hb_itemCopy( &temp, pItems + j ); + hb_itemCopy( pItems + j, pItems + i ); + hb_itemCopy( pItems + i, &temp ); + hb_itemClear( &temp ); +#endif + } + + j--; + i++; + } + + /* pivot belongs in pItems[j] */ +#ifdef HB_ASORT_OPT_ITEMCOPY + if( lb != j ) + memcpy( pItems + lb, pItems + j, sizeof( HB_ITEM ) ); + memcpy( pItems + j, &pivot, sizeof( HB_ITEM ) ); +#else + if( lb != j ) + hb_itemCopy( pItems + lb, pItems + j ); + hb_itemCopy( pItems + j, &pivot ); + hb_itemClear( &pivot ); +#endif + + return j; +} + +/* sort array pItems[lb..ub] */ + +static void hb_arraySortQuick( PHB_ITEM pItems, LONG lb, LONG ub, PHB_ITEM pBlock ) +{ + while( lb < ub ) + { + /* partition into two segments */ + LONG m = hb_arraySortQuickPartition( pItems, lb, ub, pBlock ); + + /* sort the smallest partition to minimize stack requirements */ + if( m - lb <= ub - m ) + { + hb_arraySortQuick( pItems, lb, m - 1, pBlock ); + lb = m + 1; + } + else + { + hb_arraySortQuick( pItems, m + 1, ub, pBlock ); + ub = m - 1; + } + } +} + +BOOL hb_arraySort( PHB_ITEM pArray, ULONG * pulStart, ULONG * pulCount, PHB_ITEM pBlock ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_arraySort(%p, %p, %p, %p)", pArray, pulStart, pulCount, pBlock)); + + if( HB_IS_ARRAY( pArray ) ) + { + PHB_BASEARRAY pBaseArray = pArray->item.asArray.value; + ULONG ulLen = pBaseArray->ulLen; + ULONG ulStart; + ULONG ulCount; + + if( pulStart && ( *pulStart >= 1 ) ) + ulStart = *pulStart; + else + ulStart = 1; + + if( ulStart <= ulLen ) + { + if( pulCount && ( *pulCount <= ulLen - ulStart ) ) + ulCount = *pulCount; + else + ulCount = ulLen - ulStart + 1; + + if( ulStart + ulCount > ulLen ) /* check range */ + ulCount = ulLen - ulStart + 1; + + ulCount += ulStart - 2; + + /* Optimize when only one or no element is to be sorted */ + if( ulCount > 1 ) + hb_arraySortQuick( pBaseArray->pItems, ulStart - 1, ulCount, pBlock ); + } + + return TRUE; + } + else + return FALSE; +} + +HB_FUNC( HB_ASORT ) +{ + PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); + + if( pArray ) + { + ULONG ulStart = hb_parnl( 2 ); + ULONG ulCount = hb_parnl( 3 ); + + hb_arraySort( pArray, + ISNUM( 2 ) ? &ulStart : NULL, + ISNUM( 3 ) ? &ulCount : NULL, + hb_param( 4, HB_IT_BLOCK ) ); + + hb_itemReturn( pArray ); /* ASort() returns the array itself */ + } +} + diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index c163712bd6..256618125b 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -1058,6 +1058,24 @@ void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) hb_memvarValueIncRef( pSource->item.asMemvar.value ); } +void hb_itemSwap( PHB_ITEM pItem1, PHB_ITEM pItem2 ) +{ + HB_ITEM temp; + + HB_TRACE(HB_TR_DEBUG, ("hb_itemSwap(%p, %p)", pItem1, pItem2)); + + hb_itemCopy( &temp, pItem2 ); + hb_itemCopy( pItem2, pItem1 ); + hb_itemCopy( pItem1, &temp ); + hb_itemClear( &temp ); + +/* Faster less safe way */ + memcpy( &temp, pItem2, sizeof( HB_ITEM ) ); + memcpy( pItem2, pItem1, sizeof( HB_ITEM ) ); + memcpy( pItem1, &temp, sizeof( HB_ITEM ) ); +*/ +} + /* Internal API, not standard Clipper */ /* De-references item passed by the reference */