QB64.org Forum
Active Forums => QB64 Discussion => Topic started by: NOVARSEG on October 26, 2020, 12:46:14 am
-
I got lots of experience with Quick Basic 4.5 and A86 assembler
I can do things you guys never heard of (maybe)
The stack is most often used in Quick Basic to pass data to assembler code but
there is a much better way to do it and that is by using
common memory. It's a bit of an undocumented hack that is made
possible by using A86 assembler.
Wanna hear how to do it?
Hint : The DIM statement is ALL you need (trust me on that)
-
Sure. Share away. I'm always wanting to learn new things. ;)
-
Peter Norton wrote an entire book on this, which I use to squish spiders.
-
Ya i got one of his books. Maybe he did touch on it.
Uh did he in fact explain how to use common memory in Quick Basic?
Ok I will start by saying that the DIM statement stores data in a
memory segment named BC_DATA. One of the tricks (hacks) is to create a dummy segment
of zero length just before BC_DATA. That has to be done in assembler.
I call this dummy segment BC_DAT
You then make memory references to BC_DAT which has the same DS value that BC_DATA has because BC_DAT has zero length.
There are other bits and pieces that I will show in some code examples
The advantage here is that you don't need to make calls to subroutines in the usual way. Calls are made directly to assembler code which can access the same named variables that Quick Basic can access.
-
Feel free to correct me as it has been a while but as far as I remember, QBasic 1.1 and QB4.5 store all variables (integers, doubles, etc) on a single 64kb segment and all strings on another. If you ever use them up you either get an 'out of string space' or 'out of memory' error. So all your assembly routine needs to know is the address of that segment which you can get with VARSEG(num%) of any variable or VARSEG(str$). Then you simply can simply pass VARPTR(num2%) or SADD(str2$) and these are called short pointers, since, of course, it would be infeasible to always pass BYVAL. With QB7.1 and VB for DOS, you can actually use the entire 1 MB memory for your variables requiring the use of long pointers.
Here are some fun excerpts of mine of mixing assembly and QB with an actual assembler and LINK.EXE (http://matejhorvat.si/en/software/nasmqb.htm (http://matejhorvat.si/en/software/nasmqb.htm)), you can see the use of VARPTR, VARSEG, SEG, SADD, BYVAL, etc.
fget and fput are a specialized variant of GET and PUT requiring access to both vga memory and QB program memory where the images are stored, printf (print font) is similar
asm:
global mouse
global printf
global fget
global fput
global setdta
global ffile
group dgroup
section code
mouse:
push bp
mov bp,sp
mov ax,[bp+12]
int 33h
mov si,[bp+10]
mov [si],bx
mov si,[bp+8]
mov [si],cx
mov si,[bp+6]
mov [si],dx
pop bp
retf 8
printf:
push bp
mov bp,sp
push es
mov ax,0a000h
mov fs,ax
les di,[bp+6]
mov dx,[bp+12] ;y
mov ax,80
mul dx
mov si,[bp+14] ;x
shr si,3
add si,ax
mov bx,[bp+10]
mov cx,[bx]
mov bx,[bx+2]
label:
push di
mov ax,[bx]
sub ax,32
mov dl,11
mul dl
add di,ax
push cx
push si
mov cx,11
label1:
mov al,[es:di]
mov [fs:si],al
add si,80
inc di
loop label1
pop si
pop cx
pop di
inc bx
inc si
loop label
pop es
pop bp
retf 10
fget:
push bp
mov bp,sp
push ds
push es
mov dx,80
mov ax,[bp+14] ;y
mov cx,[bp+10] ;y1
sub cx,ax
mul dx
mov si,[bp+16] ;x
mov dx,[bp+12] ;x1
sub dx,si
shr dx,3
shr si,3
add si,ax
inc dx
inc cx
les di,[bp+6]
mov [es:di],dx
mov [es:di+2],cx
add di,4
mov ax,0a000h
mov ds,ax
label3:
push cx
push si
mov cx,dx
rep movsb
;shr cx,1
;rep movsw
;adc cx,cx
;rep movsb
pop si
pop cx
add si,80
loop label3
pop es
pop ds
pop bp
retf 12
fput:
push bp
mov bp,sp
push ds
push es
mov dx,80
mov ax,[bp+10] ;y
mul dx
mov di,[bp+12] ;x
shr di,3
add di,ax
lds si,[bp+6]
mov dx,[si]
mov cx,[si+2]
add si,4
mov ax,0a000h
mov es,ax
label4:
push cx
push di
mov cx,dx
rep movsb
;shr cx,1
;rep movsw
;adc cx,cx
;rep movsb
pop di
pop cx
add di,80
loop label4
pop es
pop ds
pop bp
retf 8
setdta:
push bp
mov bp,sp
push ds
lds dx,[bp+6]
mov ax,01a00h
int 21h
pop ds
pop bp
retf 4
ffile:
push bp
mov bp,sp
mov dx,[bp+6]
mov cx,[bp+8]
mov si,[bp+10]
mov ax,[si]
int 21h
mov [si],ax
pop bp
retf 6
qb:
DEFINT A-Z
DECLARE SUB mouse (BYVAL ax, mb, mx, my)
DECLARE SUB printf (BYVAL x, BYVAL y, s$, SEG addr AS ANY)
DECLARE SUB fget (BYVAL x, BYVAL y, BYVAL x1, BYVAL y1, SEG addr AS ANY)
DECLARE SUB fput (BYVAL x, BYVAL y, SEG addr AS ANY)
DECLARE SUB setdta (SEG dta AS ANY)
DECLARE SUB ffile (ax, BYVAL cx, BYVAL dx)
DECLARE FUNCTION getfiles (q$, arr() AS STRING)
DIM SHARED font(520)
DEF SEG = VARSEG(font(0))
BLOAD "font.dat", VARPTR(font(5)) + 1
DEF SEG
DIM SHARED fol(1190)
DIM SHARED exe(1190)
DIM SHARED fil(1190)
DEF SEG = VARSEG(fol(0))
BLOAD "fol.bsv", VARPTR(fol(0))
DEF SEG = VARSEG(exe(0))
BLOAD "exe.bsv", VARPTR(exe(0))
DEF SEG = VARSEG(fil(0))
BLOAD "fil.bsv", VARPTR(fil(0))
DEF SEG = 0
TYPE dtatype
reserved AS STRING * 21
a AS STRING * 1
time AS INTEGER
date AS STRING * 2
size AS LONG
n AS STRING * 13
END TYPE
DIM SHARED dta AS dtatype
setdta dta
DIM SHARED mb, mx, my
DIM SHARED fs(500) AS STRING 'files
DIM SHARED sf(30, 1) AS STRING 'selected files, active select
DIM SHARED sfn(1) 'number of selected files (active select)
DIM SHARED sff 'selected file flag (1=cut/move, 2=copy)
DIM SHARED sft 'selected file tab
DIM SHARED sab 'active file selection array
'...
FUNCTION getfiles (q$, arr() AS STRING)
p$ = q$ + "*.*" + CHR$(0)
ax = &H4E00
ffile ax, 16, SADD(p$)
FOR i = 0 TO UBOUND(arr) - 1
ax = &H4F00
ffile ax, 0, 0
IF ax AND &HF <> 0 THEN EXIT FOR
arr(i) = LEFT$(dta.n, INSTR(dta.n, CHR$(0)) - 1) + CHR$(32 + (dta.a = CHR$(16)) * -60)
NEXT
getfiles = i
END FUNCTION
and of course, all can be done with CALL ABSOLUTE on QB 1.1. Here is a simple mouse routine:
push bp
mov bp,sp
mov si,[bp+12]
mov ax,[si]
int 33h
mov si,[bp+10]
mov [si],bx
mov si,[bp+8]
mov [si],cx
mov si,[bp+6]
mov [si],dx
pop bp
retf 8
DEFINT A-Z
DECLARE SUB mouse (ax, mb, mx, my)
DIM SHARED m(7) AS LONG
m(0) = &H8BE58955
m(1) = &H48B0C76
m(2) = &H768B33CD
m(3) = &H8B1C890A
m(4) = &HC890876
m(5) = &H8906768B
m(6) = &H8CA5D14
SCREEN 12
mouse 0, mb, mx, my 'reset mouse driver
mouse 1, mb, mx, my 'show mouse cursor
DO
'get mouse state
mouse 3, mb, mx, my
'print mouse coordinates
LOCATE 1, 1: PRINT mb, mx, my
LOOP UNTIL INP(&H60) = 1
SYSTEM
SUB mouse (ax, mb, mx, my)
DEF SEG = VARSEG(m(0))
CALL absolute(ax, mb, mx, my, VARPTR(m(0)))
END SUB
It's fun to revisit old school QB, I think it has really hardened a generation of programmers for the better. Now you'd probably be insane to hand code x86 assembly
-
Just don't plan on using ASM in QB64.
-
Passing string data to assembler can be done like this
from
http://matejhorvat.si/en/software/nasmqb.htm
****
push bp
mov bp, sp
push si ; SI has to be preserved
mov si, [bp+6] ; Get pointer to string descriptor (4 bytes)
mov cx, [si] ; Get string length
mov bx, [si+2] ; Get pointer to string contents
****
Unnecessarily complicated!!
I used to do it that way for years until I discovered how to pass data thru common memory.
In other words STOP USING THE STACK to pass data!!!!
****
Hi Vince
**** you say
QB4.5 store all variables (integers, doubles, etc) on a single 64kb segment and all strings on another.
****
I have found that if string data and numeric data are DIMed then Quick Basic 4.5 puts the data in a segment named BC_DATA every time.
For strings it has to be like:
DIM some string AS STRING * some length
no telling where QB puts the string without that length parameter.
-
Hi NO VAR SEG
:-)
interesting technical thread.
I want to be clearer about this aspect of the thread (use an ASM trick to access/pass data more than 64kb)
cause as QB64 is translated into C++/C and compiled to EXE by GCC
Does QB64 emulate BC_DATA with its limit of 64k or not because that is compiled is
a C++/C code?
Thanks to read
-
Unnecessarily complicated!!
I used to do it that way for years until I discovered how to pass data thru common memory.
In other words STOP USING THE STACK to pass data!!!!
Every SUB and FUNCTION in all languages (and also some OS API) passes parameters through the stack. People that like to abuse recursion learn that with the 'out of stack space' error. It is convenient because it allows you to naturally keep track of variable scope and allows you to free memory space by removing it from the stack. It also allows for dynamic memory allocation where your variables might change location during runtime. Using assembler labels like BC_DATA is the equivalent of having every variable global. From what I gather, BC_DATA is just a label that gets assembled into an immediate value.
On ARM and MIPS architectures (unlike x86) the convention is to pass variables with registers. So r1 is the first parameter, r2 second and so on. This also means that these registers are treated as temporary variables.
-
Hi Vince
you say
****
From what I gather, BC_DATA is just a label that gets assembled into an immediate value.
****
BC_DATA is the name of a data segment where Quick Basic 4.5 puts DIMed data (strings and numeric stuff)
In assembler, you can't access BC_DATA directly because I do believe that segment "BC_DATA" was made private - not public. If you want to access BC_DATA in assembler, you need to refer to a dummy segment just below BC_DATA in memory, of zero length. That way when you refer to the dummy segment you are in fact referring to BC_DATA - neat trick!!
With a few more more assembler tricks (EQU), you can now refer to the same variable by name, both in the Quick Basic code and in the assembler code.
In that way you DO NOT NEED the stack to pass data to assembler code.
You no longer have to remember the parameter order of where data is on the stack, or the messy BASIC string descriptor or what the x in RETF x should be.
So basically data is passed in common memory which is more of a hack.
Assembler is not done that much anymore although it shows what can be done.
****_vince says
Every SUB and FUNCTION in all languages (and also some OS API) passes parameters through the stack. People that like to abuse recursion learn that with the 'out of stack space' error.
****
True. some of my QB programs used the SUBs alot which used the stack. I got coding some real large projects and found that SUBs were pretty but they also hid what the code did. Also the endless declare statements added clutter. Most of the time I get more enjoyment from a well placed GOSUB than a SUB.
So I resorted to using common memory and of course stopped writing subs and instead did CALLs to assembler. That made QB much more useful. Basically it was the discovery of assembler and the DOS interrupts that changed the way I program .
XP is the OS that can emulate the x86 fully in virtual mode
16 bit code with DOS interrupts will run on any computer that can run XP. Which proves that the DOS interrupts still work.
You can access the windows file system with DOS interrupts!!. (open file, read file, write file, move file pointer) on any computer.
-
TempodiBasic
says
****
Does QB64 emulate BC_DATA with its limit of 64k or not because that is compiled is
a C++/C code?
****
Good question.
not sure
-
we'll wait the answer from how have the knowledge...
-
QB64 handles memory in various ways. Most variables and such are in an emulated 64k cmem block (conventional memory), which most strings go into dynamic memory. Our cmem is basically so that VARPTR and such will work for older programs.
-
In that way you DO NOT NEED the stack to pass data to assembler code.
You no longer have to remember the parameter order of where data is on the stack, or the messy BASIC string descriptor or what the x in RETF x should be.
So basically data is passed in common memory which is more of a hack.
Assembler is not done that much anymore although it shows what can be done.
****_vince says
Every SUB and FUNCTION in all languages (and also some OS API) passes parameters through the stack. People that like to abuse recursion learn that with the 'out of stack space' error.
****
True. some of my QB programs used the SUBs alot which used the stack. I got coding some real large projects and found that SUBs were pretty but they also hid what the code did. Also the endless declare statements added clutter. Most of the time I get more enjoyment from a well placed GOSUB than a SUB.
For the sake of discussion, here is an example on why you would prefer to pass data through the stack. Instead of thinking of it as an imposing constraint think of it as a handy clipboard for storing information that is temporary in nature.
Say you have some complicated math function on variables a, b, c, d, e, f that you opted to optimize with an assembly routine
defint a-z
SUB fun(y, BYVAL a, BYVAL b, BYVAL c, BYVAL d, BYVAL e, BYVAL f)
y = a*b*c + d*e*f
end sub
Would you rather have those variables in a permanent location in BC_DATA consuming 14 bytes of data or would they be better suited for the stack where they can be released or use on other temporary variables? You may be likely already using the stack for when you run out of registers in this complicated routine.
-
Hi Vince
Ok Im not totally against SUBS or FUNCTIONS which are like magic black boxes -you put data in and get data out. Nothing wrong with that, The thing is - when you start programming in COMMON memory the SUBS and FUNCTIONS suddenly become redundant.
Would you rather have those variables in a permanent location in BC_DATA consuming 14 bytes of data or would they be better suited for the stack where they can be released or use on other temporary variables? You may be likely already using the stack for when you run out of registers in this complicated routine.
Well BC_DATA is 64k bytes and you can store a lot of variables there. 14 bytes of data is not going to cause any problems. Assembler code can access the same variable by name say: (Using Quick Basic 4.5)
****
QB code
DIM APPLE AS INTEGER
APPLE = 27
****
ASM code
add w[apple],1 (that is A86 assembler.)
****
QB code
PRINT APPLE
28
****
This is how assembler interprets the word "apple"
****
ASM code
apple EQU 6
****
Where "apple" is the first variable that was DIMed
EQU means equate
In this case, the word "apple" literally means 6
so
add w[apple],1
is the same as
add w[6],1
Why the 6??
Data starts at offset 6 into BC_DATA
You can't write to the first 6 bytes as this is reserved for QB, don't know what for.
****