'===========================================================================
' Subject: FUN WITH ARRAY DESCRIPTORS        Date: 12-25-97 (13:39)       
' Author:  Matt Bross                        Code: QB, QBasic, PDS        
' Origin:  ebross@mixcom.com               Packet: MEMORY.ABC
'===========================================================================
'FUN WITH ARRAY DESCRIPTORS (REQUIRES 386+)
'MATT BROSS, DEC '97
'HOMEPAGE - HTTP://WWW.GEOCITIES.COM/SOHO/7067/
'EMAIL - OH-BOTHER@GEOCITIES.COM

DEFINT A-Z
DECLARE SUB CHG.SEG (ARR%(), RSEG%, ROFF%)
DECLARE SUB P.REDIM (ARR%(), LB%, UB%)

'What's an array descriptor?  It's basically all the internal information
'QBASIC needs to access the parts of an array it describes.

'This is all that's in an array descriptor.
'(Table taken from "BASIC TECHNIQUES AND UTILITIES"
'COPYRIGHT (C) 1994 ETHAN WINER)
'(I don't view this as a violation of the copyright, 'cause it's for
'non-profit educational purposes, in which the author was credited.)

'Offset Size          Description
'ŽŽŽŽŽŽ ŽŽŽŽ ŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽ
'00     02   Address where array data begins
'00     02   Segment where that address resides
'04     02   Far heap descriptor, pointer
'06     02   Far heap descriptor, block size
'08     01   Number of dimensions in the array
'09     01   Array type and storage method:
'              Bit 0 set = far array
'              Bit 1 set = huge (/ah) array
'              Bit 6 set = static array
'              Bit 7 set = string array
'0A     02   Adjusted Offset
'0C     02   Length in bytes of each element
'0E     02   Number of elements in the last
'              dimension (UBOUND - LBOUND + 1)
'10     02   First element number in that dimension (LBOUND)
'12     02   Number of elements in the second from last dimension
'14     02   First element number in that dimension
'..     02   Repeat number of elements and first element number as necessary,
'..     02   through the first dimension

SCREEN 13

PRINT "DEMO 1:"
PRINT "========"
PRINT
PRINT "ARRAY IS DIMENSIONED (159, 199)"

DIM ARR1(159, 199) 'Create an array descriptor and allocate memory

PRINT
PRINT "ARRAY IS CHANGED"

CHG.SEG ARR1(), &HA000, 0 'Make the array access Screen 13
                        
                         'Note: this is wasteful because the
                         'memory allocated for the original array
                         'cannot be accessed.  That can be fixed but
                         'I didn't fix it because this program is
                         'only for display purposes.


PRINT
PRINT "ARRAY ACCESS WRITES TO SCREEN"
PRINT
PRINT "PRESS A KEY"

SLEEP

FOR J = 0 TO 199
  FOR I = 0 TO 159
    ARR1(I, J) = I * J 'write to the screen
  NEXT I
NEXT J

SLEEP

CLS

PRINT "DEMO 2:"
PRINT "======="
PRINT
PRINT "ARRAY IS DIMENSIONED (10) AS INTEGER"

DIM ARR2(10)

PRINT
PRINT "1ST ELEMENT IS SET TO 10 (ARR(1) = 10)"

ARR2(1) = 10

PRINT
PRINT "ARRAY IS REDIMENSIONED (11) BUT ALL"
PRINT "CURRENT ELEMENTS ARE PRESERVED"

P.REDIM ARR2(), 0, 11

PRINT
PRINT "11TH ELEMENT IS SET TO 5 (ARR(11) = 5)"

ARR2(11) = 5

PRINT
PRINT "1ST ELEMENT IS STILL 10"
PRINT
PRINT "ARR(1) ="; ARR2(1), "ARR(11) ="; ARR2(11)

END

SUB CHG.SEG (ARR(), RSEG, ROFF)

ASM$ = CHR$(&H55)                                'push bp
ASM$ = ASM$ + CHR$(&H89) + CHR$(&HE5)            'mov bp, sp
ASM$ = ASM$ + CHR$(&H8B) + CHR$(&H76) + CHR$(10) 'mov si, [bp+10]
ASM$ = ASM$ + CHR$(&H66) + CHR$(&H8B) + CHR$(&H46) + CHR$(6)' mov eax, [bp+06]
ASM$ = ASM$ + CHR$(&H66) + CHR$(&H89) + CHR$(&H4)'mov [si], eax
ASM$ = ASM$ + CHR$(&H5D)                         'pop bp
ASM$ = ASM$ + CHR$(&HCA) + MKI$(6)               'retf

DEF SEG = VARSEG(ASM$)
  CALL ABSOLUTE(ARR(), BYVAL RSEG, BYVAL ROFF, SADD(ASM$))

END SUB

SUB P.REDIM (ARR(), LB, UB)

ASM$ = CHR$(&H55)                                 'push bp
ASM$ = ASM$ + CHR$(&H89) + CHR$(&HE5)             'mov bp, sp
ASM$ = ASM$ + CHR$(&H8B) + CHR$(&H76) + CHR$(10)  'mov si, [bp+10]
ASM$ = ASM$ + CHR$(&H8B) + CHR$(&H46) + CHR$(8)   'mov ax, [bp+08]
ASM$ = ASM$ + CHR$(&H89) + CHR$(&H44) + CHR$(&H10)'mov [si+10h], ax
ASM$ = ASM$ + CHR$(&H8B) + CHR$(&H46) + CHR$(6)   'mov ax, [bp+06]
ASM$ = ASM$ + CHR$(&H89) + CHR$(&H44) + CHR$(&HE) 'mov [si+0Eh], ax
ASM$ = ASM$ + CHR$(&H8B) + CHR$(&H5C) + CHR$(&HC) 'mov bx, [si+0Ch]
ASM$ = ASM$ + CHR$(&HF7) + CHR$(&HEB)             'imul bx
ASM$ = ASM$ + CHR$(&HC1) + CHR$(&HE8) + CHR$(4)   'shr ax, 4
ASM$ = ASM$ + CHR$(&H40)                          'inc ax
ASM$ = ASM$ + CHR$(&H89) + CHR$(&H44) + CHR$(6)   'mov [si+06], ax
ASM$ = ASM$ + CHR$(&H5D)                          'pop bp
ASM$ = ASM$ + CHR$(&HCA) + MKI$(6)                'retf 06

DEF SEG = VARSEG(ASM$)
  CALL ABSOLUTE(ARR(), BYVAL LB, BYVAL (UB - LB + 1), SADD(ASM$))

END SUB