'===========================================================================
' Subject: SWAP ARRAY DEMO                   Date: 10-17-95 (00:00)       
' Author:  Jamshid Khoshrangi                Code: PB                     
' Origin:  FidoNet POWER_BAS Echo          Packet: PB.ABC
'===========================================================================
$IF 0

    SWAPARR.BAS                                         SWAPARR.BAS


                            SwapArray Demo

                     Written by Jamshid Khoshrangi

    PURPOSE:

        Have you ever wanted to just do this with arrays:

            SWAP ArrayOne(), ArrayTwo()

        rather than this:

            FOR i = 1 TO UBOUND(ArrayOne)
                SWAP ArrayOne(i), ArrayTwo(i)
            NEXT i

        Well, this file demonstrates how to do it by swapping
        array descriptors.  That's right -- just swap the descriptors
        in memory, and, well, the rest takes care of itself.  From
        that point on, your arrays are swapped.

        I used my REDIM.PRESERVE code to demonstrate the speed gains
        that can be had by swapping just the descriptors, rather than
        every single data item.

        This code uses my ARRAYDESC32() function and Ethan Winer's
        SWAPMEM.ASM (turned in line).

    WARNINGS:

        Although the code checks the data types of the arrays, if you
        attempt to swap to user defined TYPEs arrays of different TYPEs
        but with the same overall length ... it chokes.

        In other words, the safeties I've added would generate run-time
        ERROR 10 (Duplicate definition) if you were to do this:

            SwapArray ArrayOne$(), ArrayTwo%(), 64

        Or this:

            TYPE UserType1
                A AS INTEGER
            END TYPE

            TYPE UserType2
                A AS LONG
            END TYPE

            DIM ArrayOne() AS UserType1
            DIM ArrayTwo() AS UserType2

            SwapArray ArrayOne(), ArrayTwo(), 64

        But NOT this:

            TYPE UserType1
                A AS INTEGER  ' these add up to
                B AS INTEGER  ' an overall total of 4 bytes
            END TYPE

            TYPE UserType2
                A AS LONG     ' and this is four bytes
            END TYPE

            DIM ArrayOne() AS UserType1
            DIM ArrayTwo() AS UserType2

            SwapArray ArrayOne(), ArrayTwo(), 64

        So look out when you swap arrays of user defined TYPEs.

        Also note that these routines use pedal-to-the-metal tricks
        to do what they do, so I cannot guarantee that they will run
        under anything other than what I tested them under: PB 3.2.
        If the array descriptor size ever changes, for instance, you
        must change the constant %ARRAY.DESC.SIZE to whatever it
        should be....  All else will crash.  <grin>

        Explore and have fun with this....

        Jamshid

$ENDIF

DECLARE FUNCTION ArrayInfo(BYVAL Code AS INTEGER, _
    ArrayDescriptor AS ANY) AS LONG

DEFINT A-Z

%ARRAY.DESC.SIZE = 64

$IF 1

    DIM DYNAMIC Test(1:10) AS STRING

    Test(10) = "Wow!"

    CLS

    MTIMER
        REDIM.PRESERVE Test(), 32000
    PRINT "Using SwapArray: ", MTIMER

    '   Crunch it back down for the next test...
    REDIM.PRESERVE Test(), 10

    MTIMER
        REDIM.PRESERVE.OLD Test(), 32000
    PRINT "The old style: ", MTIMER

    END
$ENDIF


SUB SwapArray (_
    BYVAL Var1 AS DWord,_
    BYVAL Var2 AS DWord,_
    BYVAL NumBytes AS Word)

    '   SWAPMEM.ASM was originally written by Ethan Winer and included
    '   with his great book on QuickBASIC....

    '   First, we check that we are dealing with identical data types!

    IF ArrayInfo(4, BYVAL Var1) <> ArrayInfo(4, BYVAL Var2) THEN
        ERROR 10    ' This is the same error PB generates when you
                    ' try to REDIM an array into a different data
                    ' type than its original DIM

    ELSE
        '   If the arrays are of a user defined TYPE, we check to
        '   make sure that the elements are of the same length.  This
        '   will catch most goof ups, but if type different types with
        '   identical overall lengths are swapped, this check fails to
        '   catch the error....
        IF ArrayInfo(4, BYVAL Var1) = 12 THEN   ' user defined TYPE
            IF ArrayInfo(2, BYVAL Var1) <> ArrayInfo(2, BYVAL Var2) THEN
                ERROR 10
            END IF
        END IF

    END IF

!    Lds  SI,Var1        ;get the segmented address of the first variable
!    Les  DI,Var2        ;and for the second variable too
!    Mov  CX,NumBytes    ;get the number of bytes to exchange
!    Jcxz ExitLabel      ;we can't swap zero bytes!
!    Cld                 ;ensure Lodsb works forward

DoSwap:
!    Mov  AL,ES:[DI]     ;get a byte from the second variable
!    Xchg AL,[SI]        ;swap it with the first variable
!    Stosb               ;complete the swap and also increment DI
!    Inc  SI             ;point to the next byte in the first variable
!    Loop DoSwap         ;continue until done

ExitLabel:

END SUB

FUNCTION ARRAYDESC32 (ANY) AS DWORD

    DIM Desc AS DWORD

    ! mov ax, [bp+6]
    ! mov bx, [bp+8]
    ! mov Desc[0], ax
    ! mov Desc[2], bx

    FUNCTION = Desc

END FUNCTION


DEFINT A-Z

%TRUE   =   -1
%FALSE  =   NOT %TRUE

SUB REDIM.PRESERVE (InArray() AS STRING, NewMax AS INTEGER)

ArrayStart  = LBOUND (InArray)
ArrayEnd    = UBOUND(InArray)

'   We'd better make it HUGE, just in case the original array was
'   huge....
DIM HUGE OutArray(ArrayStart:NewMax) AS STRING

SELECT CASE NewMax > ArrayEnd
  CASE %TRUE
        FOR i = ArrayStart TO ArrayEnd
            OutArray(i) = InArray(i)
        NEXT i

    CASE %FALSE
        FOR i = ArrayStart TO NewMax
            OutArray(i) = InArray(i)
        NEXT i

END SELECT

SwapArray ARRAYDESC32(InArray()),_
          ARRAYDESC32(OutArray()),_
          %ARRAY.DESC.SIZE

END SUB

SUB REDIM.PRESERVE.OLD (InArray() AS STRING, NewMax AS INTEGER)

ArrayStart  = LBOUND (InArray)
ArrayEnd    = UBOUND(InArray)

'   We'd better make it HUGE, just in case the original array was
'   huge....
DIM HUGE OutArray(ArrayStart:NewMax) AS STRING

SELECT CASE NewMax > ArrayEnd
  CASE %TRUE
        FOR i = ArrayStart TO ArrayEnd
          OutArray(i) = InArray(i)
        NEXT i
        REDIM InArray(ArrayStart:NewMax) AS STRING
        FOR i = ArrayStart TO ArrayEnd
            InArray(i) = OutArray(i)
        NEXT i

    CASE FALSE
        FOR i = ArrayStart TO NewMax
            OutArray(i) = InArray(i)
        NEXT i
        REDIM InArray(ArrayStart:NewMax) AS STRING
        FOR i = ArrayStart TO NewMax
            InArray(i) = OutArray(i)
        NEXT i

END SELECT

END SUB