'===========================================================================
' Subject: RAM IN QBASIC 3: XMS               Date: 01-16-97 (23:25)       
'  Author: Rick Elbers                        Code: QB, QBasic, PDS        
'  Origin: t030611@tip.nl                   Packet: MEMORY.ABC
'===========================================================================
'BASIC XMS FUNCTIONS   : WORKING BUT NOT DEMONSTRATED HERE.

DECLARE FUNCTION biosXMS.detect% () : DECLARE FUNCTION INT2STR$ (SWORD%)
DECLARE FUNCTION XMM.detect% () : DECLARE FUNCTION XMS.alloc$ (es%, bx%)
DECLARE FUNCTION xms.dealloc$ (es%, bx%) : DECLARE FUNCTION XMS.free$ (es%, bx%)
DECLARE FUNCTION XMS.lock$ (es%, bx%) : DECLARE FUNCTION XMS.move$ (es%, bx%)
DECLARE FUNCTION XMS.realloc$ (es%, bx%) : DECLARE FUNCTION XMS.unlock$ (es%, bx%)

'ADVANCED XMS FUNCTIONS :DEMONSTRATED

DECLARE SUB arraydemo (moveW%(), backW%(), getW%(), setW%())
DECLARE SUB graphicsdemo (copy%())
DECLARE SUB initXMS (nrKB%, moveW%(), backW%(), getW%(), setW%(), moveB%(), backB%(), copy%(), free%())
DECLARE SUB stringdemo (moveB%(), backB%())
CLS

'Initialize a 1 mB array  and storage arrays
'--------------------------------------------
DIM moveW%(34): DIM backW%(34): DIM getW%(38): DIM setW%(38): DIM free%(12)
DIM moveB%(39): DIM backB%(39): DIM copy%(55): freeseg% = VARSEG(free%(0))
initXMS 1024, moveW%(), backW%(), getW%(), setW%(), moveB%(), backB%(), copy%(), free%()

'--------------------------------------------
'This one uses integers for storage!
'--------------------------------------------

arraydemo moveW%(), backW%(), getW%(), setW%()
stringdemo moveB%(), backB%()
graphicsdemo copy%()
SCREEN 0: WIDTH 80, 25

PRINT "Is this stable you might ask ??? Press a key to see": SLEEP
'Oke, oke but is it stable ???? Let us do something rough ...
a$ = STRING$(10000, "k"): DIM c%(20000)
FOR i% = 0 TO 20000: c%(i%) = i%: NEXT

'And do it again sam....

stringdemo moveB%(), backB%()
arraydemo moveW%(), backW%(), getW%(), setW%()
graphicsdemo copy%()

'And set them free, set them free....
DEF SEG = freeseg%
CALL absolute(AX%, 0)
IF (AX% AND &HFF) <> 1 THEN PRINT "Error deallocating XMS" ELSE PRINT "and exiting XMS...." + SPACE$(20)
VIEW PRINT
END


SUB arraydemo (moveW%(), backW%(), getW%(), setW%())
CLS : COLOR 0, 7: PRINT "Move an array to XMS": COLOR 7, 0
'Demonstrating the integrated XMS arrayfunctions initialized in initXMS.....
'1)move array to XMS and get it back
'2)move 1MB array to XMS and get subarray back in BASIC
'3)get elements of 1MB XMS array
'4)set elements of 1MB XMS array

moveseg% = VARSEG(moveW%(0)): backseg% = VARSEG(backW%(0))
getseg% = VARSEG(getW%(0)): setseg% = VARSEG(setW%(0))

'Let us move the array to XMS
'-----------------------------
DEF SEG = moveseg%: codeoff% = 16
DIM src%(16383): FOR i% = 0 TO 16383: src%(i%) = i%: NEXT
nrbytes& = 32768: xmsoff& = 0
CALL absolute(nrbytes&, src%(), xmsoff&, codeoff%)
IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving array to XMS nr : "; HEX$((nrbytes& / &H100) AND &HFF) ELSE PRINT "Sucsesfully moved to XMS "
PRINT "Want the array back ? <key>": SLEEP

'Let us move the array back to BASIC
'------------------------------------
DEF SEG = backseg%: codeoff% = 16
FOR i% = 0 TO 16383: src%(i%) = 0: NEXT
nrbytes& = 32768: xmsoff& = 0

CALL absolute(nrbytes&, src%(), xmsoff&, codeoff%)
IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving array to BASIC nr : "; HEX$((nrbytes& / &H100) AND &HFF) ELSE PRINT "Sucsesfully moved array to BASIC "

COLOR 0, 7: PRINT "Let us control the array as given back": COLOR 7, 0: PRINT STRING$(80, "_")
VIEW PRINT 10 TO 15: FOR i% = 0 TO 16383: PRINT src%(i%); : NEXT
SLEEP: VIEW PRINT: CLS

'Let us do something called advantage of scale
'------------------------------------------------
DEF SEG = moveseg%: codeoff% = 16
COLOR 0, 7: PRINT "Let us move a 1mb array in parts to XMS": COLOR 7, 0
PRINT "Sucsesfully moved array :   to XMS":

FOR j% = 0 TO 31: '32*32 KB=1MB
  FOR i% = 0 TO 16383: src%(i%) = j%: NEXT
  nrbytes& = 32768: xmsoff& = 32768 * j%
  CALL absolute(nrbytes&, src%(), xmsoff&, codeoff%)
  IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving array"; j%; " to XMS nr : "; HEX$((nrbytes& / &H100) AND &HFF): EXIT FOR ELSE LOCATE 2, 25: PRINT j%
NEXT

PRINT "1 MB array initialized. Which part do you want back ?"
COLOR 0, 7: PRINT "Give a number 0..31 "; : COLOR 7, 0
nrbytes& = 32768: DEF SEG = &H40: POKE &H1C, PEEK(&H1A): DEF SEG = backseg%
INPUT a%: xmsoff& = 32768 * a%:
PRINT "Sucsesfully got array :     from XMS";
CALL absolute(nrbytes&, src%(), xmsoff&, codeoff%)
IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving array"; j%; " to BASIC nr : "; HEX$((nrbytes& / &H100) AND &HFF):  ELSE LOCATE 5, 25: PRINT a%
LOCATE 9, 1: PRINT STRING$(80, "_")
VIEW PRINT 10 TO 15: FOR i% = 0 TO 16383: PRINT src%(i%); : NEXT
VIEW PRINT: LOCATE 6, 1: PRINT "Press key for next demo": SLEEP: CLS

'Let us get and set some elements
'---------------------------------
CLS : DEF SEG = getseg%
COLOR 0, 7: PRINT "Let us get some elements ": COLOR 7, 0: VIEW PRINT 2 TO 24
FOR i% = 0 TO 31
  bas% = 0: elementnr& = 16383& * i%
  CALL absolute(bas%, elementnr&, codeoff%)
  PRINT "Elementnr:"; i% * 16383&; " value: "; bas%; "  Errors ? "; HEX$(elementnr& MOD &HFFFF0000)
NEXT                                                              ' ^this is slow.....
COLOR 0, 7:
PRINT "Press a key for demo of setting an element"; : COLOR 7, 0: SLEEP: CLS
'Set an element to -1 and control it too!
'-------------------------------------------
VIEW PRINT: COLOR 0, 7: PRINT "Let us set an element" + SPACE$(10)
COLOR 7, 0
DEF SEG = setseg%: bas% = -1: elementnr& = 450000
CALL absolute(bas%, elementnr&, codeoff%)
PRINT "Setting element "; : COLOR 0, 7: PRINT 450000; : COLOR 7, 0: PRINT " to "; :
COLOR 0, 7:  PRINT -1; : COLOR 7, 0: PRINT " errorcode: "; HEX$(elementnr& MOD &HFFFF&)
DEF SEG = getseg%: bas% = 0: elementnr& = 450000:
CALL absolute(bas%, elementnr&, codeoff%)
PRINT "Getting element "; : COLOR 0, 7: PRINT 450000; : COLOR 7, 0: PRINT " with errorcode ";
PRINT HEX$(elementnr& MOD &HFFFF&); " set to :"; : COLOR 0, 7: PRINT bas%
COLOR 7, 0: PRINT "Press a key for next": SLEEP

END SUB

FUNCTION biosXMS.detect%
'------------------------------------------------------
'THIS FUNCTION RETURNS XMS MEMORY BLOCKS OF 1KB
'FOR 286 AND 386 WITHOUT XMS MANAGER INSTALLED

'STACKPASSING :AX%

'IN:

'OUT          :AX%--NR OF 1 KB EXTENDED MEMBLOCKS

'ERRORRETURN  :AX%= 0 THEN FUNCTION NOT SUPPORTED OR XMS
'                     HANDLER INSTALLED
'-------------------------------------------------------
asm$ = asm$ + CHR$(&H55)                            'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'MOV BP,SP
asm$ = asm$ + CHR$(&H50)                            'PUSH AX

asm$ = asm$ + CHR$(&HB4) + CHR$(&H88)               'MOV AH,88
asm$ = asm$ + CHR$(&HCD) + CHR$(&H15)               'INT 15
asm$ = asm$ + CHR$(&H72) + CHR$(&H5)                'JC 5
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H58)                            'POP AX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)    'RETF 2
'________________________________________
codeoff% = SADD(asm$)
DEF SEG = VARSEG(asm$)
CALL absolute(AX%, codeoff%)
'________________________________________
DEF SEG
biosXMS.detect% = AX%
END FUNCTION

SUB documentation
'Oke this will be the documentation for the whole XMS source.

'1)ACKNOWLEDGEMENTS:
'-------------------
'First i have to mention a few sources i used.
'1 Ste source is the classical R. Duffy source. Also present in ABC packets
'  This source is nice, but it lacks a few features such as getting
'  elements of an array which have bigger offset then &hffff
'  Also his way of forcing even bytes is inferior.
'  The last comment is that he uses to much variables( seg and off passing),
'  and has its functions\subs not very well structured( to much of them).
'  But as i have been saying, it is the classic source and everyone who
'  wants to do anything in XMS and BASIC should start there.
'2 nd source is the XMS 3.0 specification of Microsoft. I am sure it is
'  still somewhere in the knowledge bases.
'3 ird source is XMEM10.zip in C++\asm from Alexander Russell. Useful and
'  you can get if from simtelnet.
'I wanna thank all the people who made that, and without I do not think
'this XMS functions for QBASIC would have been there..

'2)REQUIREMENTS
'----------------
'For XMS to use you need extended memory installed on your system, and also
'some extended memory manager like HIMEM. For this demo you need to have
'1 MB XMS free. You might run RAM in QBASIC 1 first to know if you got all
'this.

'3)PROGRAMMING KNOWLEDGE REQUIRED:
'----------------------------------
'Since this article is contributed to a sourcecode collection i think i have
'to include a few pointers to whats needed to understand this program.
'First of all you need to have finished at least MarkKim's tutorial. After
'that you should get acquinted with a few articles in the ABC asm directory.
'For this source you need at least an understanding of the article about
'passinfo and qbasicinside. You can run this program without it, but i
'very much doubt it if you will ever understand it....

'4)THIS XMS SOURCE:
'------------------
'This source is opening up the XMS road giving you access to a lot of space
'for strings, arrays, or graphics. I will try to give some outline of the
'possibilities but there are lots and lots of possibilities i do not even
'touch upon. After you worked your way through this program you should know
'more then enough to work with XMS, and thats all.

'As usual i made the choice to limit the functions and the variables to
'pass to the absolute minimum. The reason is that you can easily remember
'the variables and functions that way.

'The first set of functions/subs are just all the XMS functions for QBASIC.
'They are only there to make it possible to develop your own integrated
'XMS environment, by putting together and optimilization.

'It is possible to initialize all XMS functions you need at once and you
'should do that if you are concerned about foreground preservation and speed
'To give an example the initXMS and demoprograms are there.

'5)XMS PARAMETERS:
'-----------------
'The XMS move function is making use of a parameterblock that is set up like:
'--------------------------
' 0:.DW    ?                ( 32bit bytes to move)
' 4:.W     ?                ( source handle( 0 for lowmem))
' 6:.DW    offset:stringseg ( Offset:segment source or 32 bit offset for XMS)
' A:.W     handle$          ( destiny handle (0 for lowmem))
' C:.DW    32 bitoff        ( 32 bit offset destiny (XMS) or offset:segment for lowmem)
'----------------------

'The XMS handle should be checked. It could not be zero(0) since that is the
'HIMEM handler. A zero handler or another not existent one locks up the
'system thats why. Another thing that you can do to prevent this is to
'initialize you functions with the handle hardcoded...

'6)ARRAYS:[arraydemo documentation]
'-----------------------------------
'1)The strategy adopted here is that you initialize one big array in XMS
'  which totals ALL space you need( for as many array's you want)
'2)After that you put the array's at specific places into this XMS array
'  or putelements in it, or get elements of it or get/put subarray's
'3)This strategy seems to me superior to allocating everytime a new
'  xms handle for each array. Take only the hassle of controling time
'  and again the handles. This way you could do with one big intializing,
'  hard coding the handle, and the only thing you have to keep in mind
'  is the offset of the array in XMS.
'4)You should write new routines for every function you need. For instance
'  you could write a qsort routine for the whole arrea, which might be
'  very fast...To give some examples i wrote getelement,setelement
'  to get and set 1 element of an integerarray. When you have worked your
'  way through the demo's then you should be aware that getting and setting
'  of a subarrea can be done with the normal move2BAS and move2XMS functions
'5)In the get and setelement functions the adress of the variable is
'  equalled to stackadress( which is in the stringsegment!)

'7)STRINGS: [stringdemo]
'-----------------------------------------
'1)The stringsegment is static for QBASIC so this segment is hardcoded in the
'  string move functions.
'2)Since the XMS string move functions are known to copy words, the number of
'  bytes you specify should be even. The designed XMS functions are forcing
'  this even bytes upon you, so when you specify an odd number you will lose last byte!
'3)The stringadress is equalled to the adress at [bx+2] which equals SADD.

'8)PCOPY: [graphicsdemo]
'-------------------------
'1)The number of bytes to copy are STATIC to &h10000 so this is hardcoded in
'  the pagecopy function.


'9)LIMITATIONS:
'----------------
'1) You could have loaded everything in one array, and that way you lose
'   that awkward DEF SEG statements, and also you have to use only
'   one parameterblock then.
'2) Array's of other then stringelements require other XMS functions.

END SUB

SUB graphicsdemo (copy%())
'######
'#DEMO#
'######
'-----------------
'Initializations:
'-----------------
DEF SEG = VARSEG(copy%(0)): codeoff% = 16: CLS
'-------------------------------
'Let us draw something onscreen
'-------------------------------
SCREEN 13
FOR x% = 1 TO 100
CIRCLE (159, 99), x% OR 8, 2 + 3 * i%
NEXT x%:
SLEEP
'--------------------------------
'And let us copy that to page 1
'--------------------------------
frompage% = 0: topage% = 1: CALL absolute(frompage%, topage%, codeoff%): CLS
PRINT "To page 1 < more...>     ": SLEEP
'--------------------------
'And copying it to page 8
'--------------------------
frompage% = 1: topage% = 8: CALL absolute(frompage%, topage%, codeoff%):
LOCATE 1, 1: PRINT "To page 8 < more...>    ": SLEEP
'--------------------------------
'And getting it back from page 8
'--------------------------------
frompage% = 8: topage% = 0: CALL absolute(frompage%, topage%, codeoff%):
LOCATE 1, 1: PRINT "Back from 8          ":
SLEEP
END SUB

SUB initXMS (nrKB%, moveW%(), backW%(), getW%(), setW%(), moveB%(), backB%(), copy%(), free%())
'

'#################################################
'# THis function does al initializing for XMS    #
'#    use of array, string and graphics or       #
'#             quits early                       #
'#                                               #
'# Specifics: handles, stacksegment hardcoded!   #
'#                                               #
'#################################################

'1) XMM installed ?
'2) XMM entrie
'3) XMS allocate nrKBytes( NrKB%)
'4) XMS check returned handle%
'5) Initialize moveW( arrays to XMS)
'   Initialize backW( arrays to BASIC)
'   Initialize getW ( Integer element from XMS)
'   Initialize setW ( Integer element to XMS)
'   Initialize moveB( strings to XMS)
'   Initialize backB( strings to BASIC)
'   Initialize Pcopy( pages from/to/in XMS)
'   Initialize free ( deallocates XMS)

'----------------------
'1)DETECT XMM MANAGER
'---------------------
'------------------------------------------------------------
'THIS FUNCTION DETECTS IF XMS MEMORY MANAGER INSTALLED

'STACKPASSING :AX%

'IN:

'OUT          :AX% =  &H0080 XMM INSTALLED

'ERRORRETURN  :AX% <> &H0080 XMM NOT INSTALLED( QBASIC:AX%=0)
'------------------------------------------------------------
asm$ = asm$ + CHR$(&H55)                           'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP

asm$ = asm$ + CHR$(&HB8) + CHR$(&H0) + CHR$(&H43)  'MOV AX,4300
asm$ = asm$ + CHR$(&HCD) + CHR$(&H2F)              'INT 2F
asm$ = asm$ + CHR$(&H3C) + CHR$(&H80)              'CMP AL,80
asm$ = asm$ + CHR$(&H74) + CHR$(&H2)               'JZ 2
asm$ = asm$ + CHR$(&H31) + CHR$(&HC0)              'XOR AX,AX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX

asm$ = asm$ + CHR$(&H5D)                           'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)   'RETF 2
'________________________________________
DEF SEG = VARSEG(asm$): codeoff% = SADD(asm$)
CALL absolute(AX%, codeoff%)
'________________________________________
IF AX% = 0 THEN PRINT "No XMM manager detected,...exiting...": END

'-------------------
'2)GET DRIVERENTRIE
'-------------------
'--------------------------------------------------
'THIS FUNCTION DETECTS DRIVER ENTRIE,

'STACK PASSING : ES%,BX%

'IN            :

'OUT           : ES%= DRIVER ENTRIE SEGMENT
'                BX%= DRIVER ENTRIE OFFSET

'--------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                             'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)                'MOV BP,SP
asm$ = asm$ + CHR$(&H6)                              'PUSH ES

asm$ = asm$ + CHR$(&HB8) + CHR$(&H10) + CHR$(&H43)   'MOV AX,4310
asm$ = asm$ + CHR$(&HCD) + CHR$(&H2F)                'INT 2F GET DRIVER ENTRIE
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8)                'MOV AX,BX (NEED TO STORE BX)
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)    'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8C) + CHR$(&H7)                 'MOV [BX],ES SEG DRIVER
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)    'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                 'MOV [BX],AX OFF DRIVER

asm$ = asm$ + CHR$(&H7)                              'POP ES
asm$ = asm$ + CHR$(&H5D)                             'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)     'RETF 4
'________________________________________
codeoff% = SADD(asm$)
CALL absolute(es%, bx%, codeoff%)
'________________________________________
es$ = MKI$(es%): bx$ = MKI$(bx%)   'translate to strings

'-----------------------------------
'3)ALLOCATE XMS ENOUGH FOR nrKB%
'-----------------------------------
'---------------------------------------------------------
'THIS FUNCTION ALLOCATES XMS MEMORY (IF AVAILABLE)

'STACKPASSING :AX%,DX%
'IN:          :ES[BX] DRIVER ENTRIE
'              DX%    NUMBER OF KB BLOCKS REQUESTED

'OUT          :AX% =  0 FAIL , AX%=1 SUCSES
'              DX% =  HANDLE /ERROR
'---------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'mov bp,sp

asm$ = asm$ + CHR$(&HB4) + CHR$(&H9)                'MOV AH,9
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H17)               'MOV DX,[BX] 1 KB BLOCKS
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX
asm$ = asm$ + CHR$(&H75) + CHR$(&H2)                'JNZ 2
asm$ = asm$ + CHR$(&H89) + CHR$(&HDA)               'MOV DX,BX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H17)               'MOV [BX],DX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)    'RETF 4
'_____________________________________________________________________________
offcode% = SADD(asm$): AX% = 0:
dx% = 1 + nrKB%
CALL absolute(AX%, dx%, offcode%):
handle% = dx%: handle$ = MKI$(dx%)          'save handle as integer and string
'____________________________________________________________________________
IF AX% THEN
  PRINT "REQUESTED XMS BLOCKS TO HANDLE: "; HEX$(handle%)
ELSE
  PRINT "ERROR ALLOCATING XMS "; HEX$(dx% AND &HFF); "and exiting.....": END
END IF

'---------------
'4) CHECKHANDLE
'---------------
'----------------------------------------------------------------
'THIS FUNCTION RETURNS DX% AND &HFF=0 IF HANDLE IS NOT A VALID ONE

'STACKPASSING :DX%

'IN:          :ES[BX] DRIVER ENTRIE
'              DX     HANDLE

'OUT          :AX       =  1 sucses
'              else AH  = errorcode
'              QBASIC: DX% returns BL/AL
'----------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'MOV BP,SP

asm$ = asm$ + CHR$(&HB4) + CHR$(&HE)                'MOV AH,E
asm$ = asm$ + CHR$(&HBA) + handle$                  'MOV DX,handle$
asm$ = asm$ + CHR$(&H9) + CHR$(&HD2)                'OR DX,DX    0 is the HIMEM handler: locks sys for users
asm$ = asm$ + CHR$(&H75) + CHR$(&H4)                'JNZ handle oke
asm$ = asm$ + CHR$(&H31) + CHR$(&HC0)               'Set error and
asm$ = asm$ + CHR$(&HEB) + CHR$(&H7)                'JMP to end:Skip all
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)               'MOV AH,BL
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)    'RETF 2
'___________________________________________
codeoff% = SADD(asm$)
dx% = handle%: CALL absolute(dx%, codeoff%)
'___________________________________________
IF (dx% AND &HFF) = 0 THEN PRINT "Handle error nr "; (dx% / &H100) AND &HFF; " and exiting....": END

'--------------------------------------
'5)INITIATING MOVEW2XMS AND MOVEW2BAS
'as integers
'--------------------------------------
'###############################################
'#              # MOVE2XSM #                   #
'#              ############                   #
'# This function moves a BASIC array to XMS    #
'#              [integers!]                    #
'#                                             #
'###############################################
'INITILIZATION PARAMETERS
'--------------------------
' 0:.DW    ?        ( 32 bit nr bytes to move)
' 4:.W     0        ( source handle= 0 for lowmem))
' 6:.DW    off:segm ( Offset:segment src%())
' A:.W     handle%  ( destiny handle)
' C:.DW    ?        ( 32 bit XMSoffset)

'-----------------------------------------------------------
'STACKPASSING:  nrbytes&,src%(),xmsoff&
'---------------------------------------
'RETURN:
'-------
'xmsoffset& lowintlowbyte = 0 error
'           lowintlowbyte = 1 then sucses
'           lowinthighbyte = errorcode
'-------------------------------------------------------------------------------
'INITIATE the array for storage:
'INITIATE PARAMS: 16 bytes
moveW%(2) = 0
moveW%(5) = handle%
'---------------------------------------------------------------------------------
'POPA:                               5
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'LOADS ES[DI] WITH OFFSET PARAMS     5
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H31) + CHR$(&HFF)            'XOR di,di offset params=0
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'NRBYTES&                            7
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&HA) 'mov si,[bp+0A]
asm$ = asm$ + CHR$(&HA5)                          'movsw  nrbytes% lowW
asm$ = asm$ + CHR$(&HA5)                          'movsw  nrbytes% HighW
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di skip hardcoded handle
'Source offset:segment:                   7
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H8) 'mov si,[bp+08]
asm$ = asm$ + CHR$(&HA5)                          'movsw  XMSoffset% lowW
asm$ = asm$ + CHR$(&HA5)                          'movsw  XMSoffset% HighW
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di skip hardcoded handle
'Destiny XMSoffset:             5
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H6) 'mov si,[bp+06]
asm$ = asm$ + CHR$(&HA5)                          'movsw  offset array
asm$ = asm$ + CHR$(&HA5)                          'movsw  segment array
'Set up ds[si] to paramblock         4
asm$ = asm$ + CHR$(&HE)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it  15
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0a]'to las to handle
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint nrbytes&

asm$ = asm$ + CHR$(&H7)                           'pop Es   5
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'retf 6

'Poke asm$ into the array:
DEF SEG = VARSEG(moveW%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG

'###############################################
'#              # MOVE2BAS #                   #
'#              ############                   #
'# This function moves a XMS array to BASIC    #
'#              [integers!]                    #
'#                                             #
'###############################################
'Initialization paramblock
'--------------------------
' 0:.DW    ?        ( 32 bit nrbytes to move)
' 4:.W     handle%  ( XMS handle)
' 6:.DW    ?        ( 32bit offset XMS offset)
' A:.W     0        ( destiny handle= 0 for lowmem))
' C:.DW    off:segm ( offset:segment)

'STACKPASSING:  nrbytes&,dest%(),xmsoff&
'---------------------------------------
'RETURN:
'-------
'xmsoffset& lowintlowbyte = 0 error
'           lowintlowbyte = 1 then sucses
'           lowinthighbyte = errorcode
'-------------------------------------------------------------------------------
'INITIALIZE THE STORAGE ARRAY:
'INITIALIZE THE PARAMETERS:
backW%(2) = handle%
backW%(5) = 0
'---------------------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'Loads es[di] with offset params
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H31) + CHR$(&HFF)            'XOR di,di offset params=0
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'NRBYTES&
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&HA) 'mov si,[bp+0A]
asm$ = asm$ + CHR$(&HA5)                          'movsw  nrbytes% lowW
asm$ = asm$ + CHR$(&HA5)                          'movsw  nrbytes% HighW
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di skip hardcoded handle
'Source XMSoffset:
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H6) 'mov si,[bp+06]
asm$ = asm$ + CHR$(&HA5)                          'movsw  nrbytes% lowW
asm$ = asm$ + CHR$(&HA5)                          'movsw  nrbytes% HighW
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di skip hardcoded handle
'Destiny offset:segment:
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H8) 'mov si,[bp+08]
asm$ = asm$ + CHR$(&HA5)                          'movsw  offset array
asm$ = asm$ + CHR$(&HA5)                          'movsw  segment array
'Set up ds[si] to paramblock
asm$ = asm$ + CHR$(&HE)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0a]'to las to handle
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint nrbytes&

asm$ = asm$ + CHR$(&H7)                           'pop es
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'retf 6

'Poke asm$ into the array:
DEF SEG = VARSEG(backW%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG


'GETELEMENT
'-------------------------------------------------------
'This function gets an element of an XMSarray.

'STACKPASSING :BAS%, ELEMENTNR&

'IN           :BAS            = destiny
'              ELEMENTNR&     = elementnumber

'OUT          :

'-------------------------------------------------------
'Initialization paramblock
'--------------------------
' 0:.DW    2        (= bytes to move)
' 4:.W     handle%  ( XMS source handle)
' 6:.DW    32bit    ( 32bit XMSoffset)
' A:.W     0        ( destiny handle = 0 for lowmem))
' C:.DW    off:segm ( offset:segment)

'STACKPASSING:  BAS%(),elementnr&

'RETURN:
'-------

'xmsoffset& lowintlowbyte = 0 error
'           lowintlowbyte = 1 then sucses
'           lowinthighbyte = errorcode

'Special issues: bas% is directly loaded to the stack since SS points to stringseg
'-------------------------------------------------------------------------------
'INITIALIZE ARRAY FOR STORAGE
'INITIALIZE PARAMS:
help$ = "mmm": stackseg% = VARSEG(help$):   'need stacksegment
getW%(0) = 2: getW%(1) = 0
getW%(2) = handle%
getW%(7) = stackseg%
'---------------------------------------------------------------------------------
'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'Loads es[di] with offset params
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&HBF) + CHR$(&H6) + CHR$(0)   'MOV di,6 offset [XMS offset]
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'NRBYTES& =2
'Source XMSoffset: elementnr&*2
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)              'mov ax,[bx]  32B offset lowW
asm$ = asm$ + CHR$(&H8B) + CHR$(&H4F) + CHR$(&H2) 'mov cx,[bx+2]32B offset HighW
asm$ = asm$ + CHR$(&H31) + CHR$(&HBB)             'xor bx,bx   set to no carry
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE1)             'shl cx,1    high*2
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE0)             'shl ax,1    low*2
asm$ = asm$ + CHR$(&H11) + CHR$(&HC9)             'adc cx,cx   add 1 to high if CF set
asm$ = asm$ + CHR$(&HAB)                          'stosw   store lowW
asm$ = asm$ + CHR$(&H89) + CHR$(&HC8)             'ax ,cx
asm$ = asm$ + CHR$(&HAB)                          'stosw   store highW
'DESTINYHANDLE=0
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di skip hardcoded handle
'Destinyoffset: pointing to itself at stack!
asm$ = asm$ + CHR$(&H8B) + CHR$(&H46) + CHR$(&H8) 'mov ax,[bp+08] BASVAR
asm$ = asm$ + CHR$(&HAB)                          'stosw
'Set up ds[si] to paramblock
asm$ = asm$ + CHR$(&HE)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]'to las to handle
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint elementnr&
                                                                 'BAS is already
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)  'retf 4

'Poke it into the array:
DEF SEG = VARSEG(getW%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG

'SETELEMENT
'-------------------------------------------------------
'This function sets an element of an XMSarray.

'STACKPASSING :BAS%, ELEMENTNR&

'IN           :BAS            = source
'              ELEMENTNR&     = elementnumber

'OUT          :

'-------------------------------------------------------
'Initialization paramblock
'--------------------------
' Paramblock setup in stringsegment( DS defaults to that)
' 0:.DW    2        (= bytes to move)
' 4:.W     0        ( source handle= 0 for lowmem))
' 6:.DW    off:seg  ( offset:segment)
' A:.W     handle$  ( XMS destiny handle)
' C:.DW    ?        ( 32 bit offset(XMS))

'STACKPASSING:  BAS%(),elementnr%

'RETURN:
'-------

'xmsoffset& lowintlowbyte = 0 error
'           lowintlowbyte = 1 then sucses
'           lowinthighbyte = errorcode
'Special issues: bas% adress is stackadress! SS points to stringseg by default
'-------------------------------------------------------------------------------
'INITIATING STORAGEARRAY:
'INITIATING PARAMETERS
setW%(0) = 2: setW%(1) = 0
setW%(4) = stackseg%
setW%(5) = handle%
'---------------------------------------------------------------------------------
'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'Loads es[di] with offset params
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&HBF) + CHR$(&H6) + CHR$(0)   'MOV di,6 offset [BAS offset]
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'NRBYTES& =2 :Sourcehandle=0
'Sourceoffset: pointing to itself at stack!
asm$ = asm$ + CHR$(&H8B) + CHR$(&H46) + CHR$(&H8) 'mov ax,[bp+08] BASVAR
asm$ = asm$ + CHR$(&HAB)                          'stosw
'Source segment + destinyhandle handle hardcoded
asm$ = asm$ + CHR$(&H83) + CHR$(&HC7) + CHR$(4)   'add di,4 di skip hardcoded segment+handle
'Destiny XMSoffset: elementnr&*2
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)              'mov ax,[bx]  32B offset lowW
asm$ = asm$ + CHR$(&H8B) + CHR$(&H4F) + CHR$(&H2) 'mov cx,[bx+2]32B offset HighW
asm$ = asm$ + CHR$(&H31) + CHR$(&HBB)             'xor bx,bx   set to no carry
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE1)             'shl cx,1    high*2
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE0)             'shl ax,1    low*2
asm$ = asm$ + CHR$(&H11) + CHR$(&HC9)             'adc cx,cx   add 1 to high if CF set
asm$ = asm$ + CHR$(&HAB)                          'stosw   store lowW
asm$ = asm$ + CHR$(&H89) + CHR$(&HC8)             'ax ,cx
asm$ = asm$ + CHR$(&HAB)                          'stosw   store highW

'Set up ds[si] to paramblock
asm$ = asm$ + CHR$(&HE)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint elementnr&

asm$ = asm$ + CHR$(&H7)                           'pop es
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)  'retf 4

'Poke it into the array:
DEF SEG = VARSEG(setW%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG

'-------------------------------
')INITIALIZING STRINGFUNCTIONS
'-------------------------------

'###############################################
'#              # MOVE2XMS #                   #
'#              ############                   #
'# This function moves a BASIC string to XMS   #
'#  [even number of bytes required!]           #
'#                                             #
'###############################################
'INITIALIZATION PARAMBLOCK
'--------------------------
' Paramblock setup in stringsegment( DS defaults to that)
' 0:.DW    ?           ( 32bit bytes to move)
' 4:.W     0           ( source handle= 0 for lowmem)
' 6:.DW    ?:stringseg ( Offset:BASIC stringsegment)
' A:.W     handle$     ( destiny XMShandle)
' C:.DW    ?           ( 32 bit XMSoffset)

'STACKPASSING:  nrbytes&,src$,xmsoff&
'-------------

'RETURN:
'-------
'xmsoffset& lowintlowbyte = 0 error
'           lowintlowbyte = 1 then sucses
'           lowinthighbyte = errorcode

'----------------------------------------------------------------------------
'SETUP PARAMS:
moveB%(2) = 0
moveB%(4) = stackseg%
moveB%(5) = handle%
'----------------------------------------------------------------------------
'POPA:                               5
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'LOADS ES[DI] WITH OFFSET PARAMS     5
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H31) + CHR$(&HFF)            'XOR di,di offset params=0
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'NRBYTES&                            7
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&HA) 'mov si,[bp+0A]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H4)              'mov ax,[si]  nrbytes% lowW
asm$ = asm$ + CHR$(&H25) + CHR$(&HFE) + CHR$(&HFF)'and ax,fffe force even!                                                                force even!
asm$ = asm$ + CHR$(&HAB)                          'stosw
asm$ = asm$ + CHR$(&H8B) + CHR$(&H44) + CHR$(2)   'mov ax,[si+2]
asm$ = asm$ + CHR$(&HAB)                          'stosw
'Skip hardcoded sourcehandle:
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di skip handle(hardcoded)
'Source offset:segment:                   7
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H8) 'mov si,[bp+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H44) + CHR$(2)   'mov ax,[si+2]  offset src$
asm$ = asm$ + CHR$(&HAB)                          'stosw
'Skip hardcoded Sourcesegment and XMShandle
asm$ = asm$ + CHR$(&H83) + CHR$(&HC7) + CHR$(4)   'add di,4
'Destiny XMSoffset:             5
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H6) 'mov si,[bp+06]
asm$ = asm$ + CHR$(&HA5)                          'movsw  LowW  XMSstring
asm$ = asm$ + CHR$(&HA5)                          'movsw  HighW XMSstring
'Set up ds[si] to paramblock         4
asm$ = asm$ + CHR$(&H6)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it  15
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint nrbytes&

asm$ = asm$ + CHR$(&H7)                           'pop Es   5
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'retf 6

'Poke it into the storagearray:
DEF SEG = VARSEG(moveB%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT


'###############################################
'#                # MOVE2BAS #                 #
'#                ############                 #
'#   This function moves a XMSstring to BASIC  #
'#     [even number of bytes required!]        #
'#                                             #
'###############################################
'INITIALIZATION PARAMBLOCK
'--------------------------
' 0:.DW    ?            ( 32 bit bytes to move)        NRBYTES&
' 4:.W     handle$      ( XMS handle)
' 6:.DW    ?            ( 32bit XMSoffset)             XMSOFF&
' A:.W     0            ( 0 handle for lowmem)
' C:.DW    ?:stringseg% ( offset:BASIC stringsegment ) DEST$

'STACKPASSING:  nrbytes&,dest$,xmsoff&
'---------------------------------------

'RETURN:
'-------
'xmsoffset& lowintlowbyte = 0 error
'           lowintlowbyte = 1 then sucses
'           lowinthighbyte = errorcode
'-------------------------------------------------------------------------
'SETUP PARAMETERS:
backB%(2) = handle%
backB%(5) = 0
backB%(7) = stackseg%
'--------------------------------------------------------------------------
'POPA:                               5
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'LOADS ES[DI] WITH OFFSET PARAMS     5
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H31) + CHR$(&HFF)            'XOR di,di offset params=0
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'NRBYTES&                            7
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&HA) 'mov si,[bp+0A]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H4)              'mov ax,[si]  nrbytes% lowW
asm$ = asm$ + CHR$(&H25) + CHR$(&HFE) + CHR$(&HFF)'and ax,fffe force even!                                                                force even!
asm$ = asm$ + CHR$(&HAB)                          'stosw
asm$ = asm$ + CHR$(&H8B) + CHR$(&H44) + CHR$(2)   'mov ax,[si+2]
asm$ = asm$ + CHR$(&HAB)                          'stosw
'Skip Sourcehandle( hardcoded):
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di:inc di
'Source XMSoffset                   7
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H6) 'mov si,[bp+06]
asm$ = asm$ + CHR$(&HA5)                          'movsw  XMSoffset lowW
asm$ = asm$ + CHR$(&HA5)                          'movsw  XMSoffset HighW
'Skip Destinyhandle( hardcoded):
asm$ = asm$ + CHR$(&H47) + CHR$(&H47)             'inc di,inc di
'Destiny offset:             5
asm$ = asm$ + CHR$(&H8B) + CHR$(&H76) + CHR$(&H8) 'mov si,[bp+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H44) + CHR$(2)   'mov ax,[si+2]  offset dest$
asm$ = asm$ + CHR$(&HAB)                          'stosw
'Set up ds[si] to paramblock         4
asm$ = asm$ + CHR$(&HE)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it  15
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint nrbytes&

asm$ = asm$ + CHR$(&H7)                           'pop Es   5
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'retf 6

'Poke it into the storagearray:
DEF SEG = VARSEG(backB%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG

'---------------------------------
'INITIATING PCOPY$
'---------------------------------
'SUPERCOPY
'#######################################################
'# This function makes it possible to copy to,from     #
'#   and inside XMS multiple screen 13 pages           #
'#                                                     #
'# Page 0 is BASIC page 13 and Pages > 1 are XMS pages #
'#######################################################
'Initialization paramblock
'--------------------------
' 0:.DW    &h10000  ( =64 KB bytes to move)
' 4:.W     ?        ( source handle( 0 for lowmem))
' 6:.DW    ?        ( Offset:segment or 32 bit offset(XMS))
' A:.W     ?        ( destiny handle (0 for lowmem))
' C:.DW    ?        ( Offset:segment or 32 bit offset(XMS))

'STACKPASSING:  page1nr%, page2nr%
'---------------------------------

'RETURN:
'-------
'page2nr%   lowbyte = 0 error
'           lowbyte = 1 then sucses
'           highbyte = errorcode

'-------------------------------------------------------------------------------
'PARAMETERS
copy%(0) = 0: copy%(1) = 1
'---------------------------------------------------------------------------------
'PUSHA                                      5
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'mov bp,sp
asm$ = asm$ + CHR$(&H6)                          'push es
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds

'Loads es[di] with offset params            6
asm$ = asm$ + CHR$(&HE)                          'push cs
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&HBF) + CHR$(&H4) + CHR$(0)   'mov di,4 offset [sourceparams]
asm$ = asm$ + CHR$(&HFC)                         'cld
'----------------------------------------------------------
'Source:                                  11:   9
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx,[bp+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)              'mov ax,[bx]  sourcepagenr%
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)              'OR AX,AX  page 0 = low ?
asm$ = asm$ + CHR$(&H75) + CHR$(&H8)              'JNZ +8  XMS source
'LOW source:                              20:   8
asm$ = asm$ + CHR$(&HAB)                          'stosw   handle=0
asm$ = asm$ + CHR$(&HAB)                          'stosw   offset=0
asm$ = asm$ + CHR$(&HB8) + CHR$(&H0) + CHR$(&HA0) 'mov ax,a000
asm$ = asm$ + CHR$(&HAB)                          'stosw  videobasesegment
asm$ = asm$ + CHR$(&HEB) + CHR$(&HD)              'JMP +13 over XMS source
'XMS source:                              28:   13
asm$ = asm$ + CHR$(&H89) + CHR$(&HC3)             'mov bx,ax  store ax
asm$ = asm$ + CHR$(&HB8) + handle$                'mov ax,handle
asm$ = asm$ + CHR$(&HAB)                          'stosw   XMShandle
asm$ = asm$ + CHR$(&H31) + CHR$(&HC0)             'xor ax,ax
asm$ = asm$ + CHR$(&HAB)                          'stosw   lowbyte xmsoffset
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8)             'mov ax,bx  retrieve page1nr
asm$ = asm$ + CHR$(&H48)                          'dec ax  zero based!
asm$ = asm$ + CHR$(&HAB)                          'stosw   highbyte xmsoffset
'destiny:                                 41:   9
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)              'mov ax,[bx]  destinypagenr%
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)              'OR AX,AX  page 0 = low ?
asm$ = asm$ + CHR$(&H75) + CHR$(&H8)              'JNZ +8  XMS destiny
'LOW destiny:                             50:   8
asm$ = asm$ + CHR$(&HAB)                          'stosw   handle=0
asm$ = asm$ + CHR$(&HAB)                          'stosw   offset=0
asm$ = asm$ + CHR$(&HB8) + CHR$(&H0) + CHR$(&HA0) 'mov ax,a000
asm$ = asm$ + CHR$(&HAB)                          'stosw  videobasesegment
asm$ = asm$ + CHR$(&HEB) + CHR$(&HD)              'JMP +13 over XMS source
'XMS destiny:                             58:   13
asm$ = asm$ + CHR$(&H89) + CHR$(&HC1)             'mov cx,ax  store ax
asm$ = asm$ + CHR$(&HB8) + handle$                'mov ax,handle
asm$ = asm$ + CHR$(&HAB)                          'stosw XMShandle
asm$ = asm$ + CHR$(&H31) + CHR$(&HC0)             'xor ax,ax
asm$ = asm$ + CHR$(&HAB)                          'stosw lowbyte xmsoffset
asm$ = asm$ + CHR$(&H89) + CHR$(&HC8)             'mov ax,cx  retrieve page1nr
asm$ = asm$ + CHR$(&H48)                          'dec ax  zero based!
asm$ = asm$ + CHR$(&HAB)                          'stosw highbyte xmsoffset
'Set up ds[si] to paramblock         4
asm$ = asm$ + CHR$(&HE)                           'push cs
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H31) + CHR$(&HF6)             'XOR si,si
'----------------------------------------------------------------
'Believe it or not can go XMS: DS points already to stringsegment!
'DS[SI] points to parameterblock. Let HIMEM move it move it   75:   20
'----------------------------------------------------------------
asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)              'MOV AH,B     'function move
asm$ = asm$ + CHR$(&H9A) + bx$ + es$              'CALL DRIVER  'initialized
asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)             'mov ah,bl     'errorcode to BL
asm$ = asm$ + CHR$(&H1F)                          'pop ds
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]'to topage%
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)              'MOV [BX],AX   'Lowint nrbytes&

asm$ = asm$ + CHR$(&H7)                           'pop Es
asm$ = asm$ + CHR$(&H5D)                          'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)  'retf 4

'Poke it into the array:
DEF SEG = VARSEG(copy%(0)): offset% = 16
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG


'DEALLOC
'----------------------------------------------------------------
'THIS FUNCTION FREES ALLOCATED XMS MEMORY BLOCKS

'STACKPASSING :DX%

'IN:          :ES[BX] DRIVER ENTRIE
'              DX%    HANDLE OF XMS BLOCK ALLOCATED

'OUT          :AX% =  0 FAIL , AX%=1 SUCSES
'              BL% =  ERROR
'              QBASIC : RETURNS DX% lowbyte =1 SUCSES ELSE ERRORCODE
'                               DX% highbyte= errorcode
'------------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'MOV BP,SP

asm$ = asm$ + CHR$(&HB4) + CHR$(&HA)                'MOV AH,A
asm$ = asm$ + CHR$(&HBA) + handle$                  'MOV DX,handle$
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER

asm$ = asm$ + CHR$(&H88) + CHR$(&HDC)               'MOV AH,BL
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)    'RETF 2

'Poke it into the array:
DEF SEG = VARSEG(free%(0)): offset% = VARPTR(free%(0))
FOR i% = 1 TO LEN(asm$): POKE offset% + i% - 1, ASC(MID$(asm$, i%, 1)): NEXT
DEF SEG

END SUB

SUB stringdemo (moveB%(), backB%())
CLS

'Demonstrating the integrated XMS stringfunctions initialized in initXMS

'1)Move string to XMS and get it back
'2)Move 1MB file to XMS and get substring back in BASIC

'Initialize a BASIC string and the XMS functions
'-------------------------------------------------
moveseg% = VARSEG(moveB%(0)): backseg% = VARSEG(backB%(0))
codeoff% = 16               'after the paramblock

'1)Let us move the string to XMS
'--------------------------------
COLOR 0, 7: PRINT "Let us move a string to XMS": COLOR 7, 0
DEF SEG = moveseg%: swap$ = "": swap$ = STRING$(16383, "r")
nrbytes& = 16383: xmsoff& = 0:
CALL absolute(nrbytes&, swap$, xmsoff&, codeoff%)
IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving string to XMS nr : "; HEX$((nrbytes& / &H100) AND &HFF) ELSE PRINT "Sucsesfully moved string to XMS "
PRINT "Want the string back ? <key>": SLEEP

'Let us move the string back to BASIC
'------------------------------------
nrbytes& = 16383: swap$ = "": swap$ = SPACE$(16383): xmsoff& = 0:
DEF SEG = backseg%: CALL absolute(nrbytes&, swap$, xmsoff&, codeoff%)
IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving string to BASIC nr : "; HEX$((nrbytes& / &H100) AND &HFF) ELSE PRINT "Sucsesfully moved string to BASIC "

COLOR 0, 7: PRINT "Let us control the string as given back": COLOR 7, 0
PRINT STRING$(80, "_"): VIEW PRINT 10 TO 15: PRINT swap$: SLEEP:
VIEW PRINT: CLS

'2)Let us move a really big string to XMS: how about a file ?
'--------------------------------------------------------------
COLOR 0, 7: PRINT "Moving a file to XMS": COLOR 7, 0
PRINT "Give me please a big file < 1 MB  ";
DEF SEG = &H40: POKE &H1C, PEEK(&H1A): DEF SEG = moveseg%
COLOR 0, 7: LINE INPUT "? "; a$
OPEN a$ FOR BINARY AS #1
  a% = LOF(1) \ 16383&                     'Let do it in piece's of 16 KB
  nrbytes& = 16383
  PRINT "Sucsesfully moved part :    to XMS"; : COLOR 7, 0: PRINT SPACE$(20): COLOR 0, 7
  FOR j% = 0 TO a%:  ' in pieces of 32 KB( max 32 *)"
    GET #1, , swap$: xmsoff& = j% * 16383&:
    nrbytes& = 16383: CALL absolute(nrbytes&, swap$, xmsoff&, codeoff%)
    IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving string"; j%; " to XMS nr : "; HEX$((nrbytes& / &H100) AND &HFF): EXIT FOR ELSE LOCATE 3, 25: PRINT j%
  NEXT
CLOSE :
COLOR 7, 0: PRINT "File moved to XMS. Want a part back ?":
DEF SEG = &H40: POKE &H1C, PEEK(&H1A): DEF SEG = backseg%
PRINT "Give a number 0.."; a%; "   "; : COLOR 0, 7: INPUT a%
xmsoff& = 16383& * a%: nrbytes& = 16383
CALL absolute(nrbytes&, swap$, xmsoff&, codeoff%)
IF (nrbytes& AND &HFF) <> 1 THEN PRINT "Error moving string to BASIC nr : "; HEX$((nrbytes& / &H100) AND &HFF) ELSE PRINT "Sucsesfully moved string to BASIC "

COLOR 7, 0: PRINT "Let us control the string as given back": PRINT STRING$(80, "_")
VIEW PRINT 10 TO 15: PRINT swap$
SLEEP: VIEW PRINT: CLS

'3)Lets try something again: 10 files < 100 KB.

CLS : PRINT "Ever seen some accounting program with 10 files or more opened ?"
PRINT "Here is the way to do that faster and better: XMS"
SLEEP
COLOR 0, 7: PRINT " I am sory you have to do this yourself. This file is to big already"
COLOR 7, 0: PRINT "<key>": SLEEP:

'And set them free, set them free....
swap$ = ""



END SUB

FUNCTION XMM.detect%
'------------------------------------------------------------
'THIS FUNCTION RETURNS IF XMS MEMORY MANAGER INSTALLED

'STACKPASSING :AX%

'IN:

'OUT          :AX% =  &H0080 XMM INSTALLED

'ERRORRETURN  :AX% <> &H0080 XMM NOT INSTALLED( QBASIC:AX%=0)
'------------------------------------------------------------
asm$ = asm$ + CHR$(&H55)                           'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
asm$ = asm$ + CHR$(&H50)                           'PUSH AX
asm$ = asm$ + CHR$(&HB8) + CHR$(&H0) + CHR$(&H43)  'MOV AX,4300
asm$ = asm$ + CHR$(&HCD) + CHR$(&H2F)              'INT 2F
asm$ = asm$ + CHR$(&H3C) + CHR$(&H80)              'CMP AL,80
asm$ = asm$ + CHR$(&H74) + CHR$(&H2)               'JZ 2
asm$ = asm$ + CHR$(&H31) + CHR$(&HC0)              'XOR AX,AX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX

asm$ = asm$ + CHR$(&H58)                           'POP AX
asm$ = asm$ + CHR$(&H5D)                           'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)   'RETF 2
'________________________________________
codeoff% = SADD(asm$)
DEF SEG = VARSEG(asm$)
CALL absolute(AX%, codeoff%)
'________________________________________
DEF SEG
XMM.detect% = AX%
END FUNCTION

FUNCTION XMS.alloc$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION RETURNS IF FREE AND TOTAL XMS MEMORY

'STACKPASSING :AX%,DX%
'IN:          :ES[BX] DRIVER ENTRIE
'              DX%    NUMBER OF KB BLOCKS REQUESTED

'OUT          :AX% =  0 FAIL , AX%=1 SUCSES
'              DX% =  HANDLE /ERROR
'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%)
'------------------------------------------------------------------------
asm$ = asm$ + CHR$(&H55)
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)
asm$ = asm$ + CHR$(&H50)
asm$ = asm$ + CHR$(&H52)

asm$ = asm$ + CHR$(&HB4) + CHR$(&H9)                'MOV AH,9
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H17)               'MOV DX,[BX] 1 KB BLOCKS
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX
asm$ = asm$ + CHR$(&H75) + CHR$(&H2)                'JNZ 2
asm$ = asm$ + CHR$(&H89) + CHR$(&HDA)               'MOV DX,BX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H17)               'MOV [BX],DX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5A)                            'POP AX
asm$ = asm$ + CHR$(&H58)                            'POP DX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)    'RETF 4

XMS.alloc$ = asm$

END FUNCTION

FUNCTION xms.dealloc$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION FREES ALLOCATED XMS MEMORY BLOCKS

'STACKPASSING :DX%

'IN:          :ES[BX] DRIVER ENTRIE
'              DX%    HANDLE OF XMS BLOCK ALLOCATED

'OUT          :AX% =  0 FAIL , AX%=1 SUCSES
'              BL% =  ERROR
'              QBASIC : RETURNS DX%=1 SUCSES ELSE ERRORCODE
'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%):
'------------------------------------------------------------------------
asm$ = asm$ + CHR$(&H55)                            'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'MOV BP,SP
asm$ = asm$ + CHR$(&H50)                            'PUSH AX
asm$ = asm$ + CHR$(&H52)                            'PUSH DX

asm$ = asm$ + CHR$(&HB4) + CHR$(&HA)                'MOV AH,A
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H17)               'MOV DX,[BX] HANDLE
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX
asm$ = asm$ + CHR$(&H75) + CHR$(&H2)                'JNZ 2
asm$ = asm$ + CHR$(&H89) + CHR$(&HD9)               'MOV AX,BX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5A)                            'POP dX
asm$ = asm$ + CHR$(&H58)                            'POP aX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)    'RETF 2

xms.dealloc$ = asm$
END FUNCTION

SUB XMS.entrie (es%, bx%)
'--------------------------------------------------
'THIS FUNCTION DETECTS DRIVER ENTRIE,
'THE FREE XMS SIZE AND TOTAL XMS SIZE

'STACK PASSING : ES%,BX%

'IN            :

'OUT           : ES%= DRIVER ENTRIE SEGMENT
'                BX%= DRIVER ENTRIE OFFSET

'--------------------------------------------------
asm$ = asm$ + CHR$(&H55)                             'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)                'MOV BP,SP
asm$ = asm$ + CHR$(&H50)                             'PUSH AX
asm$ = asm$ + CHR$(&H53)                             'PUSH BX
asm$ = asm$ + CHR$(&H6)                              'PUSH ES

asm$ = asm$ + CHR$(&HB8) + CHR$(&H10) + CHR$(&H43)   'MOV AX,4310
asm$ = asm$ + CHR$(&HCD) + CHR$(&H2F)                'INT 2F GET DRIVER ENTRIE
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8)                'MOV AX,BX (NEED TO STORE BX)
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)    'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8C) + CHR$(&H7)                 'MOV [BX],ES SEG DRIVER
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)    'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                 'MOV [BX],AX OFF DRIVER

asm$ = asm$ + CHR$(&H7)                              'POP ES
asm$ = asm$ + CHR$(&H5B)                             'POP BX
asm$ = asm$ + CHR$(&H58)                             'POP AX
asm$ = asm$ + CHR$(&H5D)                             'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)     'RETF 4
'________________________________________
codeoff% = SADD(asm$)
DEF SEG = VARSEG(asm$)
CALL absolute(es%, bx%, codeoff%)

'________________________________________
DEF SEG

END SUB

FUNCTION XMS.free$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION RETURNS IF FREE AND TOTAL XMS MEMORY

'STACKPASSING :AX%,DX%

'IN:          :ES[BX] DRIVER ENTRIE

'OUT          :AX% =  FREE XMS
'              DX% =  TOTAL XMS

'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%)
'----------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'MOV BP,SP
asm$ = asm$ + CHR$(&H50)                            'PUSH AX
asm$ = asm$ + CHR$(&H53)                            'PUSH BX
asm$ = asm$ + CHR$(&H52)                            'PUSH DX

asm$ = asm$ + CHR$(&HB4) + CHR$(&H8)                'MOV AH,0800 QUERY FREE XMS
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H17)               'MOV [BX],DX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5A)                            'POP DX
asm$ = asm$ + CHR$(&H5B)                            'POP BX
asm$ = asm$ + CHR$(&H58)                            'POP AX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)    'RETF 4



XMS.free$ = asm$
END FUNCTION

FUNCTION XMS.lock$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION LOCKS XMS and return fysical adress

'STACKPASSING :BX%,DX%
'IN:          :ES[BX] DRIVER ENTRIE
'              DX%    NUMBER OF KB BLOCKS REQUESTED

'OUT          :AX%     =  0 FAIL , AX%=1 SUCSES
'              DX%:BX% =  LINEAR ADRESS/ERROR(in BL)
'QBASIC return 0 in DX% on error
'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%)
'------------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'mov bp,sp
asm$ = asm$ + CHR$(&H50)                            'push ax
asm$ = asm$ + CHR$(&H52)                            'push dx

asm$ = asm$ + CHR$(&HB4) + CHR$(&HC)                'MOV AH,C
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H17)               'MOV DX,[BX] handle
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX
asm$ = asm$ + CHR$(&H75) + CHR$(&H4)                'JNZ 4
asm$ = asm$ + CHR$(&H30) + CHR$(&HFF)               'XOR BH,BH  'to zero on error
asm$ = asm$ + CHR$(&H89) + CHR$(&HDA)               'MOV DX,BX  'and put in DX
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8)               'mov ax,bx  'need bx
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H17)               'MOV [BX],DX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5A)                            'POP AX
asm$ = asm$ + CHR$(&H58)                            'POP DX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)    'RETF 4

XMS.lock$ = asm$

END FUNCTION

FUNCTION XMS.move$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION MOVES MEMORY BLOCKS TO XMS

'STACKPASSING :DS%,SI%

'IN:          :DS[SI] PTR TO MOVESTRUCTURE
'
                 'DW  : NR OF BYTES TO MOVE
                 'W   : HANDLE SOURCE: 0000 FOR LOW MEM
                 'DW  : OFFSET:SEGMENT OF SOURCE
                 'W   : HANDLE DESTINY: XMS HANDLE
                 'DW  : OFFSET:SEGMENT OF DESTINY 0000 FOR XMS

'              ES[BX] DRIVER ENTRIE

'OUT          :AX =  0 FAIL , AX%=1 SUCSES
'              BL =  ERROR
'QBASIC:       DS%=  0 SUCSES
'                    ELSE ERRORCODE

'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%)
'------------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'Push AX
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'MOV BP,SP
asm$ = asm$ + CHR$(&H56)                            'Push SI
asm$ = asm$ + CHR$(&H1E)                            'Push DS


asm$ = asm$ + CHR$(&HB4) + CHR$(&HB)                'MOV AH,B
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H37)               'MOV SI,[BX] OFFSET
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H1F)               'MOV DS,[BX] SEGMENT
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX 'SUCSES ?
asm$ = asm$ + CHR$(&H74) + CHR$(&H2)                'JZ 2    'NO ? JUMP
asm$ = asm$ + CHR$(&H31) + CHR$(&HDB)               'XOR BX,BX
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8)               'MOV AX,BX
asm$ = asm$ + CHR$(&H1F)                            'POP DS  'have to restore before [bx] is adressed
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5E)                            'POP SI
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)    'RETF 4

XMS.move$ = asm$

END FUNCTION

FUNCTION XMS.realloc$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION REALLOCATES AN ALREADY ALLOCATED XMS_HANDLE

'STACKPASSING :BX%,DX%
'IN:          :BX%    New request( KB)
'              DX%    XMS Handle

'OUT          :AX% =  0 FAIL , AX%=1 SUCSES
'              BL% =  ERROR

'QBSASIC      :DX% returns errorcode or 1
'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%)
'------------------------------------------------------------------------
asm$ = asm$ + CHR$(&H55)                            'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'mov bp,sp
asm$ = asm$ + CHR$(&H50)                            'push ax
asm$ = asm$ + CHR$(&H52)                            'push dx

asm$ = asm$ + CHR$(&HB4) + CHR$(&HF)                'MOV AH,F
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H17)               'MOV DX,[BX] XMS handle
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5F) + CHR$(&H8)   'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H1F)               'MOV BX,[BX]
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX
asm$ = asm$ + CHR$(&H75) + CHR$(&H2)                'JNZ 2
asm$ = asm$ + CHR$(&H89) + CHR$(&HD9)               'MOV AX,BX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX


asm$ = asm$ + CHR$(&H5A)                            'POP dX
asm$ = asm$ + CHR$(&H58)                            'POP aX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)    'RETF 4


XMS.realloc$ = asm$

END FUNCTION

FUNCTION XMS.unlock$ (es%, bx%)
'----------------------------------------------------------------
'THIS FUNCTION UNLOCKS XMS HANDLE

'STACKPASSING :DX%
'IN:          :ES[BX] DRIVER ENTRIE
'              DX%    HANDLE

'OUT          :AX     =  0 FAIL , AX%=1 SUCSES
'              BL     =  ERROR(in BL)
'QBASIC returns BX%=0 or error
'----------------------------------------------------------------
'INIT
'-----
es$ = MKI$(es%): bx$ = MKI$(bx%)
'------------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                            'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)               'mov bp,sp
asm$ = asm$ + CHR$(&H50)                            'push ax
asm$ = asm$ + CHR$(&H52)                            'push dx

asm$ = asm$ + CHR$(&HB4) + CHR$(&HD)                'MOV AH,D
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H17)               'MOV DX,[BX] handle
asm$ = asm$ + CHR$(&H9A) + bx$ + es$                'CALL DRIVER
asm$ = asm$ + CHR$(&H9) + CHR$(&HC0)                'OR AX,AX
asm$ = asm$ + CHR$(&H75) + CHR$(&H2)                'JNZ 2
asm$ = asm$ + CHR$(&H89) + CHR$(&HD9)               'MOV AX,BX
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                'MOV [BX],AX

asm$ = asm$ + CHR$(&H5A)                            'POP AX
asm$ = asm$ + CHR$(&H58)                            'POP DX
asm$ = asm$ + CHR$(&H5D)                            'POP BP
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)    'RETF 2

XMS.unlock$ = asm$

END FUNCTION