'===========================================================================
' Subject: RAM IN QBASIC 2: LOWMEM            Date: 01-16-97 (23:25)       
'  Author: Rick Elbers                        Code: QB, QBasic, PDS        
'  Origin: t030611@tip.nl                   Packet: MEMORY.ABC
'===========================================================================
DECLARE FUNCTION USWORD% (SWORD&) : DECLARE FUNCTION getSWORD& (USWORD%)
DECLARE FUNCTION low.dealloc$ () : DECLARE FUNCTION low.alloc$ ()
DECLARE SUB demo2 () : DECLARE SUB demo3 () : DECLARE SUB demo4 () :
DECLARE FUNCTION low.getstring$ () : DECLARE FUNCTION low.movestring$ ()
DECLARE FUNCTION low.getsubarray$ () : DECLARE FUNCTION low.setelement$ ()
DECLARE FUNCTION low.getelement$ () : DECLARE FUNCTION COPYVID13$ ()
DECLARE FUNCTION low.movewords$ () : DECLARE SUB demo ()
DECLARE FUNCTION low.free$ () : DECLARE SUB demo1 (free%)


CLS
demo

'--------------------------------
'DOSMEMORY ACCESS ....AND......?
'--------------------------------
'Oke let us go for the real stuff now, oke.
'What you should in fact do is unlike the demos initialize the space you
'need and leave allocation/ deallocation until the end of the program
'SAY you need 100Kb ?

'Initialization
'---------------
moveW$ = low.movewords$: dealloc$ = low.dealloc$: alloc$ = low.alloc$:
stringseg% = VARSEG(alloc$): DEF SEG = stringseg%: offcode% = SADD(alloc$)
bx% = 100 * (1024& \ 16): CALL absolute(ax%, bx%, offcode%): DEF SEG
IF ax% = 0 THEN dosseg% = bx%: nrDOSbytes% = 100 * (1024& \ 16) ELSE END 'errorcondition
'So at this time we know we have 100KB access if dosseg%> 0

'----------------------------------------------------------------------------
'USEFUL 1: PROGRAMS WITH 20 FILES OPEN LIKE SOME ACCOUNTING PROGRAMS ?
'Lets just copy them on and offscreen( providing that 5000 bytes is enough)
'Instead of having open so many files or opening/closing them each time
'----------------------------------------------------------------------------
'--------------------------------------------------------------
'Print 20 screens for BASIC and let us save 10 screens to DOS.
'--------------------------------------------------------------
DEF SEG = &H40: help% = PEEK(&H10) AND &H30:
IF help% = &H30 THEN videobase% = &HB000 ELSE videobase% = &HB800
DEF SEG = stringseg%

FOR i% = 0 TO 9:
LOCATE 1, 1: PRINT STRING$(3999, CHR$(48 + i%))
codeoff% = SADD(moveW$): es% = dosseg%
CALL absolute(videobase%, 0, es%, USWORD%(4000& * i%), 4000, codeoff%)
NEXT: DEF SEG = &H40: POKE &H1C, PEEK(&H1A): DEF SEG = stringseg%
CLS : PRINT "Want some back ? Give a number that i will MOD 9 "; : INPUT ; i%
'----------------------------------------------
'Let us get one of them back
'----------------------------------------------
codeoff% = SADD(moveW$): es% = dosseg%: i% = i% MOD 9
CALL absolute(es%, USWORD%(4000& * i%), videobase%, 0, 4000, codeoff%)
VIEW PRINT 23 TO 25: CLS 2
PRINT "Impressive and fast ? Wait until you see what you can do with 7MB EMS/XMS !"
PRINT "press a key for next ": SLEEP
'---------------------------------------------------------------------------
'USEFUL 2: PROGRAMS THAT NEED 100 KB EXTRA DATASPACE ?
'---------------------------------------------------------------------------
'Demo 2,3,4 should have given you the taste...
'Further uses:
'Read really big files( bigger then 10 KB) into DOSMEM and copy parts of
'them to BASIC. Faster then reading bit/bit from the file. Even more fast is
'to read the file directly to the segment, but for that possibility you need
'some assembly routine to read a file.

'---------------------------------------------------------------------------
'USEFUL 3: PROGRAMS THAT WANT MORE PAGES IN GRAPHICS MODE
'---------------------------------------------------------------------------
VIEW PRINT: CLS : PRINT "Be sure that you are in PLAIN DOS before executing this one!"
PRINT "If you are , press a key": SLEEP
'Lets draw some stuff onscreen
SCREEN 13
FOR x% = 1 TO 99
   CIRCLE (159, 99), x%, x%
NEXT x%
'---------------------------------------
'And now let us save the screen to DOS.
'---------------------------------------
codeoff% = SADD(moveW$): es% = dosseg%
CALL absolute(&HA000, 0, es%, 0, 32000, codeoff%)
CLS : PRINT "Want that nice picture back ?": PRINT "press a key"
SLEEP
'--------------------------------------
'And getting the screen back
'--------------------------------------
codeoff% = SADD(moveW$): es% = dosseg%
CALL absolute(es%, 0, &HA000, 0, 32000, codeoff%)

'Deallocating
'-------------
offcode% = SADD(dealloc$): es% = dosseg%: segm% = es%:
codeoff% = SADD(dealloc$): CALL absolute(es%, codeoff%)
IF es% THEN PRINT "Error deallocating memory "; es%
DEF SEG
'----------------------------------------------------------------------------
'NOTES:
'-------
'1)There is not a function modify memalloc available here, since i did not
'  thought that would have been very useful. It can easily be developed from
'  the function low.alloc( only change is: mov ah,4a and that is that)
'2)You can only move blocks up to 128 KB around with movewords since i
'  did not accounted for bigger moves. When you are going to move blocks
'  bigger then 32 KB be sure that you translate to UNSIGNED INTEGERS!
'  The reason that i did not accounted for bigger moves is that both the
'  EMS and XMS move functions are perfectly suited for bigger moves already
'3)For stringmovement the limit is 64 KB. Same reasons
'4)I did not have timed any of these functions
LOCATE 24, 1: PRINT "Press  a key ..sleep.....": SLEEP
SCREEN 0: WIDTH 80
LOCATE 19, 1
PRINT "This is the end of the DOS memory demo: if you want to move bigger "
PRINT "strings or array's at once you have to use the EMS or XMS move"
PRINT "functions in some later article i will adress those functions. "
PRINT
PRINT "Good bye"
PRINT "Rick"

END

SUB demo
CLS
demo1 free%

IF free% > 64000 \ 16 THEN demo2: demo3
IF free% > 10000 \ 16 THEN demo4
CLS



END SUB

SUB demo1 (free%)
'------------
'initiating:
'------------
dosfree$ = low.free$: alloc$ = low.alloc$: dealloc$ = low.dealloc$

'Lets first get the free dosmemory after BASIC is done
'------------------------------------------------------
DEF SEG = VARSEG(dosfree$): codeoff% = SADD(dosfree$)
CALL absolute(bx%, codeoff%)
PRINT "DEMO 1 DOS FREE MEMORY AND ALLOCATING DEALLOCATING DOS MEM"
PRINT STRING$(80, "_")
IF bx% THEN PRINT "Low memory free in para's( bytes)       :"; bx%; "("; 16& * bx%; ")" ELSE PRINT "No free DOS memory to demonstrate ..exiting..": END
free% = bx%

'Second lets allocate 3 times
'-----------------------------------------
DIM dealloc%(3)                     'save the segments in this array
bx% = &HFFF: nralloc$ = HEX$(bx%): codeoff% = SADD(alloc$):
CALL absolute(ax%, bx%, codeoff%): dealloc%(0) = bx%
IF ax% THEN
PRINT "Error allocating memory "; bx%; " Available memory (para's) "; HEX$(ax%)
'deallocate and quit
ELSE
PRINT "Allocated "; STRING$(4 - LEN(nralloc$), "0") + nralloc$; " para's at segment(hex)   : "; HEX$(bx%)
END IF

bx% = 2: nralloc$ = HEX$(bx%): codeoff% = SADD(alloc$):
CALL absolute(ax%, bx%, codeoff%): dealloc%(1) = bx%
IF ax% THEN
PRINT "Error allocating memory "; bx%; " Available memory (para's) "; HEX$(ax%)
ELSE
PRINT "Allocated "; STRING$(4 - LEN(nralloc$), "0") + nralloc$; " para's at segment(hex)   : "; HEX$(bx%)
END IF

bx% = 1: nralloc$ = HEX$(bx%): codeoff% = SADD(alloc$):
CALL absolute(ax%, bx%, codeoff%): dealloc%(2) = bx%
IF ax% THEN
PRINT "Error allocating memory "; bx%; " Available memory (para's) "; HEX$(ax%)
ELSE
PRINT "Allocated "; STRING$(4 - LEN(nralloc$), "0") + nralloc$; " para's at segment(hex)   : "; HEX$(bx%)
END IF

FOR i% = 0 TO 2:
es% = dealloc%(i%): segm% = es%: codeoff% = SADD(dealloc$)
CALL absolute(es%, codeoff%)
IF es% THEN PRINT "Error deallocating memory "; es% ELSE PRINT "Sucses deallocating memory from segment : "; HEX$(segm%)
NEXT

PRINT
PRINT "Press a key for next demo": SLEEP: CLS





END SUB

SUB demo2
'Initiating:
'-----------
moveW$ = low.movewords$: alloc$ = low.alloc$: dealloc$ = low.dealloc$

'DEMO 2 let us move an array
'---------------------------
LOCATE 10, 1: PRINT STRING$(80, "_")
LOCATE 11, 1: PRINT "DEMO 2: MOVING A 64 KB ARRAY TO DOS AND BACK AGAIN"
COLOR 0, 7: LOCATE 12, 1: PRINT "Initializing array in BASIC"
COLOR 7, 0: VIEW PRINT 15 TO 22
DIM datas%(32000): FOR i% = 0 TO 32000 - 1: datas%(i%) = i%: PRINT datas%(i%); : NEXT

basseg% = VARSEG(datas%(0)): basoff% = VARPTR(datas%(0))
bx% = 64000 \ 16: nralloc$ = HEX$(bx%): codeoff% = SADD(alloc$):
CALL absolute(ax%, bx%, codeoff%): dosseg% = bx%
VIEW PRINT: LOCATE 1, 1
IF ax% THEN
PRINT "Error allocating memory "; bx%; " Available memory (para's) "; HEX$(ax%)
'deallocate and quit
ELSE
PRINT "Allocated "; STRING$(4 - LEN(nralloc$), "0") + nralloc$; " para's at segment(hex)   : "; HEX$(bx%)
END IF



LOCATE 12, 1: COLOR 0, 7: PRINT "Moved 64 KB array to DOS:  BASIC array is free!"
codeoff% = SADD(moveW$): es% = dosseg%
CALL absolute(basseg%, basoff%, es%, 0, 32000, codeoff%)

LOCATE 13, 1: PRINT "64 KB Array given other values in BASIC: "
COLOR 7, 0: VIEW PRINT 15 TO 22
FOR i% = 0 TO 32000 - 1: datas%(i%) = -1: PRINT datas%(i%); : NEXT
VIEW PRINT

COLOR 0, 7: LOCATE 12, 1: PRINT "64 KB Array back from DOS with old values     ": COLOR 7, 0
PRINT SPACE$(45)
codeoff% = SADD(moveW$)
CALL absolute(dosseg%, 0, basseg%, basoff%, 32000, codeoff%)
DEF SEG

COLOR 7, 0: VIEW PRINT 15 TO 22
FOR i% = 0 TO 32000 - 1: PRINT datas%(i%); : NEXT
VIEW PRINT: LOCATE 2, 1

es% = dosseg%: segm% = es%: codeoff% = SADD(dealloc$)
CALL absolute(es%, codeoff%)
IF es% THEN PRINT "Error deallocating memory "; es% ELSE PRINT "Sucses deallocating memory from segment : "; HEX$(segm%)

PRINT : PRINT "Press a key for next demo": SLEEP: CLS


END SUB

SUB demo3

'Initializing:
'---------------
alloc$ = low.alloc$: dealloc$ = low.dealloc$
moveW$ = low.movewords$: setelement$ = low.setelement$:
getelement$ = low.getelement$: subarray$ = low.getsubarray$:


'DEMO 3 Let us access array elements in DOS
'------------------------------------------
LOCATE 10, 1: PRINT STRING$(80, "_")
LOCATE 11, 1: PRINT "DEMO 3: MOVING A 64 KB ARRAY TO DOS AND GETTING ELEMENTS\ SETTING ELEMENTS"
COLOR 0, 7: LOCATE 12, 1: PRINT "Initializing array in BASIC"
COLOR 7, 0: VIEW PRINT 15 TO 22
DIM datas%(32000): FOR i% = 0 TO 32000 - 1: datas%(i%) = i%: PRINT datas%(i%); : NEXT
'-----------
'allocating
'-----------
basseg% = VARSEG(datas%(0)): basoff% = VARPTR(datas%(0))
bx% = 64000 \ 16: VIEW PRINT: nralloc$ = HEX$(bx%): codeoff% = SADD(alloc$):
CALL absolute(ax%, bx%, codeoff%): dosseg% = bx%
VIEW PRINT: LOCATE 1, 1
IF ax% THEN
PRINT "Error allocating memory "; bx%; " Available memory (para's) "; HEX$(ax%): EXIT SUB
ELSE
PRINT "Allocated "; STRING$(4 - LEN(nralloc$), "0") + nralloc$; " para's at segment(hex)   : "; HEX$(bx%)
END IF

'moving the array to DOS
'-------------------------
LOCATE 12, 1: COLOR 0, 7: PRINT "Moved 64 KB array to DOS:  BASIC array is free!"
COLOR 7, 0
DEF SEG = VARSEG(moveW$): codeoff% = SADD(moveW$): es% = dosseg%
CALL absolute(basseg%, basoff%, es%, 0, 32000, codeoff%)

'Get an element:
'--------------
offcode% = SADD(getelement$): es% = dosseg%: nr% = 456'lets get this number
CALL absolute(es%, 0, bas%, nr%, offcode%)
VIEW PRINT: LOCATE 2, 1: PRINT "The element "; : COLOR 0, 7: PRINT nr%; :
COLOR 7, 0: PRINT " has the value of      : "; : COLOR 0, 7: PRINT bas%
COLOR 7, 0

'Let us change this element oke ?
'--------------------------------
offcode% = SADD(setelement$): chgbas% = -1: bas% = chgbas%'let us give it -1
es% = dosseg%: CALL absolute(es%, 0, bas%, nr%, offcode%)
PRINT "The element "; : COLOR 0, 7: PRINT nr%; :
COLOR 7, 0: PRINT " changing to value     : "; : COLOR 0, 7: PRINT chgbas%
COLOR 7, 0

'And get it again from DOS
'--------------------------
offcode% = SADD(getelement$): es% = dosseg%: nr% = 456'lets get this number
CALL absolute(dosseg%, 0, bas%, nr%, offcode%)
PRINT "The element "; : COLOR 0, 7: PRINT nr%; :
COLOR 7, 0: PRINT " has now the value of  : "; : COLOR 0, 7: PRINT bas%
COLOR 7, 0

'Is looking good so far, not ?
'---------------------------------------------------------------------
'Let us move on with defining a subarray in BASIC with values from DOS
'---------------------------------------------------------------------
PRINT "Getting BASIC subarray "; : COLOR 0, 7: PRINT "[0..9]"; :
COLOR 7, 0: PRINT " from DOSarray "; : COLOR 0, 7: PRINT "[455.. 464]"
codeoff% = SADD(subarray$): dosoff% = (456 * 2) - 2  'let us get 10 elements offset 456
es% = dosseg%
CALL absolute(es%, dosoff%, basseg%, basoff%, 10, codeoff%)
COLOR 7, 0: PRINT "The subarray "; : COLOR 0, 7: PRINT "0.. 10"; :
COLOR 7, 0: PRINT " has now the values :":
COLOR 0, 7: FOR i% = 0 TO 10: PRINT datas%(i%); : NEXT
COLOR 7, 0: PRINT :


es% = dosseg%: segm% = es%: codeoff% = SADD(dealloc$)
CALL absolute(es%, codeoff%)
IF es% THEN PRINT "Error deallocating memory "; es% ELSE PRINT "Sucses deallocating memory from segment : "; HEX$(segm%)


LOCATE 24, 1: PRINT "Press a key for next demo": SLEEP: CLS

END SUB

SUB demo4

'Initializing:
'--------------
alloc$ = low.alloc$: dealloc$ = low.dealloc$
movestring$ = low.movestring$: getstring$ = low.getstring$:
'--------------------------------------------
'DEMO 4 Let us access string elements in DOS
'--------------------------------------------
LOCATE 10, 1: PRINT STRING$(80, "_")
LOCATE 11, 1: PRINT "DEMO 4: MOVING AN 10 KB STRING TO DOS AND GETTING\ SETTING PARTS OF IT"
COLOR 0, 7: LOCATE 12, 1: PRINT "Initializing string in BASIC"
COLOR 7, 0: VIEW PRINT 15 TO 22

'Let us initialize the string
STATIC a$: FOR i% = 0 TO 10: a$ = a$ + STRING$(1000, CHR$(65 + i%)): NEXT
basseg% = VARSEG(a$): basoff% = SADD(a$)
VIEW PRINT 15 TO 22: PRINT a$:
'-----------
'allocating
'-----------
bx% = 10000 / 16: VIEW PRINT:
VIEW PRINT: nralloc$ = HEX$(bx%): codeoff% = SADD(alloc$):
CALL absolute(ax%, bx%, codeoff%): dosseg% = bx%
VIEW PRINT: LOCATE 1, 1
IF ax% THEN
PRINT "Error allocating memory "; bx%; " Available memory (para's) "; HEX$(ax%): EXIT SUB
ELSE
PRINT "Allocated "; STRING$(4 - LEN(nralloc$), "0") + nralloc$; " para's at segment(hex)   : "; HEX$(bx%)
END IF


LOCATE 12, 1: COLOR 0, 7: PRINT "Moved 10 KB string to DOS:  BASIC string is free!"
COLOR 7, 0

'Let us move the string to DOS
'-----------------------------
DEF SEG = VARSEG(movestring$): codeoff% = SADD(movestring$): es% = dosseg%
CALL absolute(basseg%, basoff%, es%, 0, 10000, codeoff%)

'Let us move a part back to BASIC
LOCATE 12, 1: COLOR 0, 7:
PRINT "Get the part of the string from 1995 to 2005:"; : COLOR 7, 0: PRINT SPACE$(10)
b$ = SPACE$(10): codeoff% = SADD(getstring$)    'get chars 1995 to 2005
VIEW PRINT 15 TO 22: es% = dosseg%
CALL absolute(es%, 1995, VARSEG(b$), SADD(b$), 10, codeoff%)
CLS 2: LOCATE 15, 1: PRINT b$


VIEW PRINT: LOCATE 23, 1: PRINT "Press a key to change the last ten bytes of the DOSstring to ";
COLOR 0, 7: PRINT b$: COLOR 7, 0
PRINT "and get the whole string back in BASIC": SLEEP
'Let us set some stringbytes
codeoff% = SADD(movestring$): es% = dosseg%
CALL absolute(VARSEG(b$), SADD(b$), es%, 9990, 10, codeoff%)

VIEW PRINT: COLOR 0, 7: LOCATE 12, 1: PRINT "Get the whole string back to BASIC";
COLOR 7, 0: PRINT SPACE$(11): es% = dosseg%
a$ = SPACE$(10000): codeoff% = SADD(getstring$)
CALL absolute(es%, 0, VARSEG(a$), SADD(a$), 10000, codeoff%)
VIEW PRINT 15 TO 22: CLS 2: LOCATE 15, 1: PRINT a$
PRINT "Last character at byte "; LEN(a$); " is a character : "; RIGHT$(a$, 1)
DEF SEG
'Is looking good so far, not ?
VIEW PRINT: LOCATE 2, 1

es% = dosseg%: segm% = es%: codeoff% = SADD(dealloc$)
CALL absolute(es%, codeoff%)
IF es% THEN PRINT "Error deallocating memory "; es% ELSE PRINT "Sucses deallocating memory from segment : "; HEX$(segm%)

VIEW PRINT 23 TO 24: CLS 2
LOCATE 24, 1: PRINT "Press a key" + SPACE$(50): VIEW PRINT: SLEEP: CLS

END SUB

FUNCTION getSWORD& (USWORD%)
'---------------------------------------------
'This routine is translating an unsigned word in
'integer form to an signed integer in long format
'This might be useful when you have to read out
'some registers with unsigned words.
'IN:  USWORD%     (vb. &hEA60)
'OUT: SWORD&      (vb. 60000 )
'---------------------------------------------
getSWORD& = USWORD% AND &HFFFF&

END FUNCTION

FUNCTION low.alloc$
'-------------------------------------------------------------------
'This function allocates lower memory

'STACK PASSING :AX%,BX%
'
'IN            :BX%= number of para's to allocate
'
'OUT           :AX%= startsegment or error
'              :BX%= if error=8 then available memory
'              :QBASIC: AX%=0 then success, else  errorcode
'                       BX%=startsegment or number of segments available
'---------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                                    'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)                       'mov bp,sp

asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)           'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H1F)                       'mov bx,[bx]
asm$ = asm$ + CHR$(&HB4) + CHR$(&H48)                       'mov ah,48
asm$ = asm$ + CHR$(&HCD) + CHR$(&H21)                       'int 21

asm$ = asm$ + CHR$(&H72) + CHR$(&H2)                        'jc +2
asm$ = asm$ + CHR$(&H31) + CHR$(&HDB)                       'XOR bX,bX if no error
asm$ = asm$ + CHR$(&H89) + CHR$(&HD9)                       'mov cx,bx need bx
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)           'mov bx,[bp+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&HF)                        'mov [bx],cx 0=no error
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)           'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                        'mov [bx],ax seg or error

asm$ = asm$ + CHR$(&H5D)                                    'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)            'retf 4
low.alloc$ = asm$


END FUNCTION

FUNCTION low.dealloc$
'-------------------------------------------------------------------
'This function de allocates lower memory
'STACK PASSING :ES%
'
'IN            :ES%= segment of block to de_allocate
'
'OUT           :AX%= errorcode
'              :QBASIC: ES%=0 or errorcode
'---------------------------------------------------------------------
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$(&H8B) + CHR$(&H5E) + CHR$(&H6)           'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H7)                        'mov es,[bx]
asm$ = asm$ + CHR$(&HB4) + CHR$(&H49)                       'mov ah,49
asm$ = asm$ + CHR$(&HCD) + CHR$(&H21)                       'int 21

asm$ = asm$ + CHR$(&H72) + CHR$(&H2)                        'jc +2
asm$ = asm$ + CHR$(&H31) + CHR$(&HC0)                       'XOR aX,aX if no error
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)           'mov bx,[bp+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                        'mov [bx],ax 0=no error

asm$ = asm$ + CHR$(&H7)                                     'pop es
asm$ = asm$ + CHR$(&H5D)                                    'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)            'retf 2
low.dealloc$ = asm$

END FUNCTION

FUNCTION low.free$
'-------------------------------------------------------------------
'This function allocates lower memory
'STACK PASSING :BX%
'
'IN            :BX%= FFFF whole MB requested<g>
'
'OUT           :BX%= 0 or available memory

'---------------------------------------------------------------------
asm$ = ""
asm$ = asm$ + CHR$(&H55)                                    'push bp
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)                       'mov bp,sp

asm$ = asm$ + CHR$(&HBB) + CHR$(&HFF) + CHR$(&HFF)          'mov bx,ffff the whole MB
asm$ = asm$ + CHR$(&HB4) + CHR$(&H48)                       'mov ah,48
asm$ = asm$ + CHR$(&HCD) + CHR$(&H21)                       'int 21

asm$ = asm$ + CHR$(&H72) + CHR$(&H2)                        'jc +2
asm$ = asm$ + CHR$(&H31) + CHR$(&HDB)                       'XOR bX,bX if no error
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8)                       'mov ax,bx
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)           'mov bx,[bp+06]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)                        'mov [bx],ax 0=no error

asm$ = asm$ + CHR$(&H5D)                                    'pop bp
asm$ = asm$ + CHR$(&HCA) + CHR$(&H2) + CHR$(&H0)            'retf 2
low.free$ = asm$

END FUNCTION

FUNCTION low.getelement$
'-------------------------------------------------------
'This function gets an element of an DOSarray.

'STACKPASSING :DS%,SI%,BAS%,AX%

'IN           :DS[SI] = source    DOSarray
'              BAS    = destiny   BASvar
'              AX     = elementnumber

'OUT          :

'-------------------------------------------------------
'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'MOV BP,SP
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds
'number of bytes
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)             'MOV ax,[BX]
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE0)            'SHL AX,1 element relative adress
'source  :DOS memory
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H37)            'MOV si,[BX]
asm$ = asm$ + CHR$(&H1) + CHR$(&HC6)             'ADD si,ax si=offset+nradress
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)'MOV BX,[BP+0c]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H1F)            'MOV dS,[BX]
'alons y
asm$ = asm$ + CHR$(&HFC)                         'CLD
asm$ = asm$ + CHR$(&HAD)                         'LODSW
asm$ = asm$ + CHR$(&H1F)                         'pop ds
'destiny :BASIC variable
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H89) + CHR$(&H7)             'MOV [BX],ax

'POPA
asm$ = asm$ + CHR$(&H5D)                         'pop bp
'RETF
asm$ = asm$ + CHR$(&HCA) + CHR$(&H8) + CHR$(&H0) 'retf 8

low.getelement$ = asm$



END FUNCTION

FUNCTION low.getstring$
'-------------------------------------------------------
'This function returns a substring from DOS to BASIC.

'STACKPASSING :DS%,SI%,ES%,DI%,CX%

'IN           :DS[SI] = source SI points to first byte to get( 0 based)
'              ES[DI] = destiny BASIC
'              CX     = number of bytes to get (1 based)

'OUT          :

'-------------------------------------------------------

'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'MOV BP,SP
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds
asm$ = asm$ + CHR$(&H6)                          'PUSH es
'number of bytes
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&HF)             'MOV cx,[BX]
asm$ = asm$ + CHR$(&H89) + CHR$(&HCA)            'MOV dx,cx 'need a copy of cx
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE9)            'SHR cx,1 'divide by 2
'destiny: BASstring
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H3F)            'MOV di,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H7)             'MOV ES,[BX]
'source : DOS memory
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)'MOV BX,[BP+0c]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H37)            'MOV si,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)'MOV BX,[BP+0e]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H1F)            'MOV dS,[BX]
'alons y
asm$ = asm$ + CHR$(&HFC)                         'CLD
asm$ = asm$ + CHR$(&HF2) + CHR$(&HA5)            'REPNZ MOVSW 'moves cx words from DS[SI] to ES[DI]
asm$ = asm$ + CHR$(&HF6) + CHR$(&HC2) + CHR$(&H1)'TEST DL,1 is there a last byte ?
asm$ = asm$ + CHR$(&H74) + CHR$(&H1)             'No ? Jmp over JZ 1
asm$ = asm$ + CHR$(&HA4)                         'MOVSB 'last byte

'POPA
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H1F)                         'pop ds
asm$ = asm$ + CHR$(&H5D)                         'pop bp
'RETF
asm$ = asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0) 'retf a

low.getstring$ = asm$

END FUNCTION

FUNCTION low.getsubarray$
'-------------------------------------------------------
'This function moves a subarray from DOS to BASIC.
'It will move an even number of bytes around.

'STACKPASSING :DS%,SI%,ES%,DI%,CX%

'IN           :DS[SI] = source SI points to first element to get
'              ES[DI] = destiny BASIC
'              CX     = number of elements to get

'OUT          :

'-------------------------------------------------------

'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'MOV BP,SP
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds
asm$ = asm$ + CHR$(&H6)                          'PUSH es
'number of bytes
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&HF)             'MOV cx,[BX]
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE1)            'SHL CX,1 element relative adress
'destiny: BASIC array
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H3F)            'MOV di,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H7)             'MOV ES,[BX]
'source : DOS memory
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)'MOV BX,[BP+0c]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H37)            'MOV si,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)'MOV BX,[BP+0e]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H1F)            'MOV dS,[BX]
'alons y
asm$ = asm$ + CHR$(&HFC)                         'CLD
asm$ = asm$ + CHR$(&HF2) + CHR$(&HA5)            'REPNZ MOVSW 'moves cx words from DS[SI] to ES[DI]

'POPA
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H1F)                         'pop ds
asm$ = asm$ + CHR$(&H5D)                         'pop bp
'RETF
asm$ = asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0) 'retf a

low.getsubarray$ = asm$

END FUNCTION

FUNCTION low.movestring$
'-------------------------------------------------------
'This function moves stringblocks around in lowmemory.
'It can be used to move a block from BASIC to DOS and
'back. It moves bytes (for strings, string and byte types)

'STACKPASSING :DS%,SI%,ES%,DI%,CX%

'IN           :DS[SI] = source
'              ES[DI] = destiny
'              CX     = number of bytes to move

'OUT          :
'-------------------------------------------------------
'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'MOV BP,SP
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds
asm$ = asm$ + CHR$(&H6)                          'PUSH es
'number of words
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&HF)             'MOV cx,[BX]
asm$ = asm$ + CHR$(&H89) + CHR$(&HCA)            'MOV dx,cx 'need a copy of cx
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE9)            'SHR cx,1 'divide by 2
'destiny  DOS memory
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H3F)            'MOV di,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H7)             'MOV ES,[BX]
'source   BASIC string
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)'MOV BX,[BP+0c]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H37)            'MOV si,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)'MOV BX,[BP+0e]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H1F)            'MOV dS,[BX]
'alons y
asm$ = asm$ + CHR$(&HFC)                         'CLD
asm$ = asm$ + CHR$(&HF2) + CHR$(&HA5)            'REPNZ MOVSW
asm$ = asm$ + CHR$(&HF6) + CHR$(&HC2) + CHR$(&H1)'TEST DL,1 is there a last byte ?
asm$ = asm$ + CHR$(&H74) + CHR$(&H1)             'No ? Jmp over JZ 1
asm$ = asm$ + CHR$(&HA4)                         'MOVSB 'last byte

'POPA
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H1F)                         'pop ds
asm$ = asm$ + CHR$(&H5D)                         'pop bp
'RETF
asm$ = asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0) 'retf a

low.movestring$ = asm$

END FUNCTION

FUNCTION low.movewords$
'-------------------------------------------------------
'This function moves memoryblocks around in lowmemory.
'It can be used to move a block from BASIC to DOS and
'back. It moves words( for integers and arrays,integer types)

'STACKPASSING :DS%,SI%,ES%,DI%,CX%

'IN           :DS[SI] = source
'              ES[DI] = destiny
'              CX     = number of words to move

'OUT          :

'-------------------------------------------------------
'PUSHA
asm$ = ""
asm$ = asm$ + CHR$(&H55)                         'PUSH BP
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5)            'MOV BP,SP
asm$ = asm$ + CHR$(&H1E)                         'PUSH ds
asm$ = asm$ + CHR$(&H6)                          'PUSH es
'number of words
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&HF)              'MOV cx,[BX]
'destiny DOS memory     
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H3F)            'MOV di,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H7)             'MOV ES,[BX]
'source  BASIC array
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)'MOV BX,[BP+0c]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H37)            'MOV si,[BX]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)'MOV BX,[BP+0e]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H1F)            'MOV dS,[BX]
'alons y
asm$ = asm$ + CHR$(&HFC)                         'CLD
asm$ = asm$ + CHR$(&HF2) + CHR$(&HA5)            'REPNZ MOVSW

'POPA
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H1F)                         'pop ds
asm$ = asm$ + CHR$(&H5D)                         'pop bp
'RETF
asm$ = asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0) 'retf a

low.movewords$ = asm$


END FUNCTION

FUNCTION low.setelement$
'-------------------------------------------------------
'This function sets an element of a DOSarray.

'STACKPASSING :ES%,DI%,BAS%,AX%

'IN           :ES[DI] = destiny   DOSarray
'              BAS    = source    BASvar
'              AX     = elementnumber

'OUT          :

'-------------------------------------------------------

'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$(&H57)                         'PUSH di
'Relative offset in array
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)             'MOV ax,[BX]
asm$ = asm$ + CHR$(&HD1) + CHR$(&HE0)            'SHL AX,1 element relative adress
'Destiny DOS memory
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)'MOV BX,[BP+0a]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H3F)            'MOV di,[BX]
asm$ = asm$ + CHR$(&H1) + CHR$(&HC7)             'ADD di,ax si=offset+nradress
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)'MOV BX,[BP+0c]
asm$ = asm$ + CHR$(&H8E) + CHR$(&H7)             'MOV eS,[BX]
'Source  BASIC variable
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm$ = asm$ + CHR$(&H8B) + CHR$(&H7)             'MOV ax,[bx]
'Alons y
asm$ = asm$ + CHR$(&HFC)                         'CLD
asm$ = asm$ + CHR$(&HAB)                         'STOSW

'POPA
asm$ = asm$ + CHR$(&H5F)                         'POP di
asm$ = asm$ + CHR$(&H7)                          'pop es
asm$ = asm$ + CHR$(&H5D)                         'pop bp
'RETF
asm$ = asm$ + CHR$(&HCA) + CHR$(&H8) + CHR$(&H0) 'retf 8

low.setelement$ = asm$


END FUNCTION

FUNCTION USWORD% (SWORD&)
'---------------------------------------------
'This routine is translating a signed word in
'long form to an unsigned integer. This might
'be useful when you have to fill some registers
'with unsigned words.
'IN : SWORD&        (vb. 60000 )
'OUT: USWORD%       (vb. &HEA60)
'---------------------------------------------
helplowbyte& = SWORD& AND &HFFFF&
word% = helplowbyte& AND &H7FFF
USWORD% = word% OR -(helplowbyte& AND &H8000):
END FUNCTION