Call Absolute (warning! hardcore inside!)

If you have questions about any aspect of QBasic programming, or would like to help fellow programmers solve their problems, check out this board!

Moderators: Pete, Mods

Post Reply
Yazar
Coder
Posts: 11
Joined: Sat May 24, 2008 10:51 pm

Call Absolute (warning! hardcore inside!)

Post by Yazar »

Hi, can we write/create the command 'Call Absolute' In asm ?
What is the Logic ? The bare hex codes are stored in some where and then, the CS:IP is pointed there with the 'call absolute' command ?

Call absolute [parameter list], [offset of hex code string]

Proc MyAbsolute
Put the Parameters Into Stack ?
jmp SEGMENT:OFFSET of The Code String ?
.End Proc

def seg = varseg(code$)
MyAbsolute (byval x%, byval y%, c%, sadd(code$))
def seg


1 - Save The CS:IP where we are coming from to the sp
2 - Put the variable list either byval or byref
3 - Jump to the new CS:IP as SEGMENT:OFFSET of code$

????????

I would love to write my own call absolute command in qb.
Thanks....
User avatar
Kiyotewolf
Veteran
Posts: 96
Joined: Tue Apr 01, 2008 11:38 pm

Been done before

Post by Kiyotewolf »

That has been coded already awhile ago. It was in an old old OLD Dos computer magazine. I fortunately went throught the trouble of writing it out by hand in a notebook in case my computer crashed. Which, it did.

The Interrupt code is from the magazine, most of the other Functions were in a QBasic book at the library, and the ANSI decoding code is from a Powerbasic source I got on a CD of Basic source code.




'Code ~~~~~~~~~~~~~
'ANSI Viewer/ ANSI Music Player

DEFINT A-Z

TYPE REGTYPE 'Machine language interface
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
DIM SHARED REGS AS REGTYPE

DECLARE SUB INTERRUPT (INTNUM%, REGS AS REGTYPE)

'Other SUBs and FUNCTIONs
DECLARE SUB Scroll ()
DECLARE FUNCTION EXIST% (FileSpec$)
DECLARE SUB BackIntens (Setting%)
DECLARE SUB ANSI (Ch0$)
DECLARE FUNCTION NextFile$ (FileSpec$)
DECLARE FUNCTION FirstFile$ (FileSpec$)
DECLARE SUB ScreenWrite (x%, y%, Char%, fore%, Back%)

REDIM SHARED INTRPT(1 TO 50) 'Machine language interface
DEF SEG = VARSEG(INTRPT(1))
ADDRESS = VARPTR(INTRPT(1))
FOR i = 0 TO 99
READ a
POKE ADDRESS + i, a
NEXT

SCREEN 2
SCREEN 0
COLOR 7, 0
KEY OFF
WIDTH 80 ',43
CLS

Flash = -1

BackIntens Flash 'Make sure colors flash

'FileSpec$ = "*.ans" 'Name of file or wildcard name of files.
'First$ = FirstFile$(FileSpec$)
'First$ = NextFile$(FileSpec$)
'First$ = FirstFile$(FileSpec$)
DO
SHELL "dir *.ans /w /p"
INPUT First$
'First$ = "mcdonald.ANSa"
IF First$ <> "" THEN
File$ = First$
DO
OPEN File$ FOR INPUT AS #1
DO
a$ = INPUT$(1, 1)
st$ = a$ '+ CHR$(13)
FOR disp0% = 1 TO LEN(st$)
Ch0$ = MID$(st$, disp0%, 1)
ANSI Ch0$
NEXT
LOOP UNTIL EOF(1)
CLOSE #1
Paws = -1
IF Paws THEN
WHILE INKEY$ = "": WEND
COLOR 7, 0
CLS
END IF
DisplayName = 0
IF DisplayName THEN
PRINT File$
WHILE INKEY$ = "": WEND
CLS
END IF
'File$ = NextFile$(FileSpec$)
File$ = ""
LOOP UNTIL File$ = ""
END IF

LOOP
'SYSTEM
END

MatchTest = 0
IF MatchTest THEN
DO
FileSpec$ = "*.ans"
'First$ = FirstFile$(FileSpec$)
IF First$ = "" THEN
EXIT DO
ELSE
PRINT First$
DO
'Next$ = NextFile$(FileSpec$)
IF Next$ = "" THEN
EXIT DO
ELSE
PRINT Next$
END IF
LOOP
EXIT DO
END IF
LOOP
END IF

ExistTest = 0
IF ExistTest THEN
'Testing of EXIST function:
File$ = "INTRPT1.BAS"
There = EXIST(File$)
PRINT "The file "; File$; " ";
IF There THEN
PRINT "does";
ELSE
PRINT "doesn't";
END IF
PRINT " exist."
END IF

BackIntensTest = 0
IF BackIntensTest THEN
Flash = -1
FOR x = 0 TO 15
FOR y = 0 TO 15
LOCATE y + 1, x * 2 + 1
COLOR x - 16 * Flash, y
PRINT CHR$(254);
COLOR x, y
PRINT CHR$(254);
NEXT
NEXT
DO
WHILE INKEY$ = "": WEND
BackIntens -1
WHILE INKEY$ = "": WEND
BackIntens 0
LOOP
END IF

saveVgaPalTest = 0
IF saveVgaPalTest THEN
SCREEN 13
SHELL "dragon2 > nul"

'FOR x = 0 TO 15
' FOR y = 0 TO 15
' LINE (x * 5, y * 5)-(x * 5 + 5, y * 5 + 5), x + &H10 * y, BF
' NEXT
'NEXT


WHILE INKEY$ = "": WEND

PALETTE 0, 15 * 256
PALETTE 255, 15

REDIM Plt(384) 'Code to save palette in array
Sg = VARSEG(Plt(0))
Of = VARPTR(Plt(0))
REGS.AX = &H1017
REGS.BX = 0
REGS.CX = 256
REGS.ES = Sg
REGS.DX = Of
CALL INTERRUPT(&H10, REGS)
DEF SEG = Sg
BSAVE "test.plt", Of, 768
DEF SEG

WHILE INKEY$ = "": WEND

REDIM Plt(384) 'Code to erase color palette
Sg = VARSEG(Plt(0))
Of = VARPTR(Plt(0))
REGS.AX = &H1012
REGS.BX = 0
REGS.CX = 256
REGS.ES = Sg
REGS.DX = Of
CALL INTERRUPT(&H10, REGS)

WHILE INKEY$ = "": WEND

LoadPlt = -1
IF LoadPlt THEN
REDIM Plt(384) 'Code to load palette in array
Sg = VARSEG(Plt(0))
Of = VARPTR(Plt(0))
DEF SEG = Sg
BLOAD "test.plt", Of
DEF SEG
REGS.AX = &H1012
REGS.BX = 0
REGS.CX = 256
REGS.ES = Sg
REGS.DX = Of
CALL INTERRUPT(&H10, REGS)
END IF

WHILE INKEY$ = "": WEND
STOP

END IF

'Machine code for interrupt calling routine:
DATA 85 : 'PUSH BP
DATA 139, 236 : 'MOV BP, SP
DATA 86 : 'PUSH SI
DATA 87 : 'PUSH DI
DATA 30 : 'PUSH DS
DATA 139, 118, 6 : 'MOV SI, WORD PTR [BP+6]
DATA 139, 4 : 'MOV AX, WORD PTR [SI]
DATA 139, 92, 2 : 'MOV BX, WORD PTR [SI+2]
DATA 139, 76, 4 : 'MOV CX, WORD PTR [SI+4]
DATA 139, 84, 6 : 'MOV DX, WORD PTR [SI+6]
DATA 139, 108, 8 : 'MOV BP, WORD PTR [SI+8]
DATA 139, 124, 12 : 'MOV DI, WORD PTR [SI+12]
DATA 142, 68, 18 : 'MOV ES, [SI+18]
DATA 255, 116, 10 : 'PUSH WORD PTR [SI+10]
DATA 131, 124, 18, 255 : 'CMP WORD PTR [SI+18],-1
DATA 117, 2 : 'JNZ LABEL1
DATA 30 : 'PUSH DS
DATA 7 : 'POP ES
: 'LABEL1:
DATA 131, 124, 16, 255 : 'CMP WORD PTR [SI+16],-1
DATA 116, 3 : 'JZ LABEL2
DATA 142, 92, 16 : 'MOV DS, [SI+16]
: 'LABEL2:
DATA 94 : 'POP SI
DATA 205, 33 : 'INT 33
DATA 85 : 'PUSH BP
DATA 139, 236 : 'MOV BP, SP
DATA 30 : 'PUSH DS
DATA 86 : 'PUSH SI
DATA 142, 94, 2 : 'MOV DS, [BP+2]
DATA 139, 118, 14 : 'MOV SI, WORD PTR [BP+14]
DATA 137, 4 : 'MOV WORD PTR [SI], AX
DATA 137, 92, 2 : 'MOV WORD PTR [SI+2], BX
DATA 137, 76, 4 : 'MOV WORD PTR [SI+4], CX
DATA 137, 84, 6 : 'MOV WORD PTR [SI+6], DX
DATA 143, 68, 10 : 'POP WORD PTR [SI+10]
DATA 143, 68, 16 : 'POP WORD PTR [SI+16]
DATA 143, 68, 8 : 'POP WORD PTR [SI+8]
DATA 137, 124, 12 : 'MOV WORD PTR [SI+12], DI
DATA 140, 68, 18 : 'MOV WORD PTR [SI+18], ES
DATA 156 : 'PUSHF
DATA 143, 68, 14 : 'POP WORD PTR [SI+14]
DATA 95 : 'POP DI
DATA 95 : 'POP DI
DATA 94 : 'POP SI
DATA 93 : 'POP BP
DATA 202, 2, 0 : 'RETF 2

SUB ANSI (Ch0$) STATIC

Music% = -1 'Use this until global support

'AP0:
IF ANSIcode0% THEN
IF INSTR(LEFT$(ANSIst0$, 2), "M") THEN
'PRINT "Music found!"
IF ASC(Ch0$) = 14 THEN
IF Music% THEN PLAY "MF" + MID$(ANSIst0$, 3)
ANSIst0$ = ""
ANSIcode0% = 0
ELSE
ANSIst0$ = ANSIst0$ + Ch0$
END IF
ELSEIF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(Ch0$)) THEN
SELECT CASE Ch0$
CASE "A": GOSUB CursorUp0
CASE "B": GOSUB CursorDown0
CASE "C": GOSUB CursorRight0
CASE "D": GOSUB CursorLeft0
CASE "H", "f": GOSUB CursorLocate0
CASE "s": GOSUB SaveCursorPosn0
CASE "u": GOSUB RestCursorPosn0
CASE "J": GOSUB BigErase0
CASE "K": GOSUB SmallErase0
CASE "h", "l": REM set display mode... ignored
CASE "m": GOSUB SetColors0
CASE "M"
'IF LEN(ANSIst0$) = 1 THEN
ANSIst0$ = ANSIst0$ + "M"
'END IF
CASE ELSE
'WWrite Win%, ANSIst0$
PRINT ANSIst0$;
ANSIcode0% = 0
ANSIst0$ = ""
END SELECT
IF Ch0$ <> "M" THEN
ANSIst0$ = ""
ANSIcode0% = 0
END IF
ELSEIF ASC(Ch0$) <= 32 OR LEN(ANSIst0$) > 60 THEN
'WWrite Win%, ANSIst0$
PRINT ANSIst0$;
ANSIcode0% = 0
ANSIst0$ = ""
ELSE
ANSIst0$ = ANSIst0$ + Ch0$
END IF
ELSEIF ASC(Ch0$) = 27 THEN
ANSIcode0% = -1
ANSIst0$ = ""
ELSE
'WWrite Win%, ch0$
x = POS(0)
y = CSRLIN
SELECT CASE ASC(Ch0$)
CASE 8
PRINT CHR$(29);
CASE 0, 7, 9 TO 12, 14 TO 29
'SELECT CASE ASC(Ch0$)
' CASE 13
' IF CSRLIN < 24 THEN
' PRINT Ch0$;
' END IF
' CASE ELSE
PRINT Ch0$;
'END SELECT
CASE 1 TO 6, 13, 30 TO 255
x = POS(0)
y = CSRLIN
IF x < 1 THEN x = 1
IF y < 1 THEN y = 1
IF y < 25 THEN
COLOR Fore0%, Back0%
IF Ch0$ = CHR$(13) THEN
x2 = 1
y2 = y + 1
IF y2 = 25 THEN PRINT CHR$(13);
ELSE
IF ASC(Ch0$) >= 32 THEN
PRINT Ch0$;
ELSE
PRINT " ";
END IF
ScreenWrite x, y, ASC(Ch0$), Fore0%, Back0%
'PRINT Ch0$;
x2 = POS(0)
y2 = CSRLIN
IF y2 = 25 THEN PRINT CHR$(13);
END IF
ELSE
IF Ch0$ = CHR$(13) THEN
Scroll
x2 = 1
y2 = 25
ELSE
IF ASC(Ch0$) >= 32 THEN
PRINT Ch0$;
ELSE
PRINT " ";
END IF
ScreenWrite x, y, ASC(Ch0$), Fore0%, Back0%
x2 = POS(0)
y2 = CSRLIN
END IF
END IF
LOCATE y2, x2
END SELECT
END IF
' RETURN
EXIT SUB
'************************************************************
REM * SINGLE VALUE EXTRACTION
'Tmp0% = VAL(MID$(ANSIst0$, 2))
REM * DOUBLE VALUE EXTRACTION
' Row0% = VAL(MID$(ANSIst0$, 2))
' Tmp0% = INSTR(ANSIst0$, ";")
' IF Tmp0% THEN
' Col0% = VAL(MID$(ANSIst0$, Tmp0% + 1))
' ELSE
' Col0% = 1
' END IF


CursorUp0:
Tmp0% = VAL(MID$(ANSIst0$, 2))
IF Tmp0% < 1 THEN Tmp0% = 1
'WGetLocate Win%, Row0%, Col0%
Col0% = POS(0)
Row0% = CSRLIN
Row0% = Row0% - Tmp0%
IF Row0% < 1 THEN Row0% = 1
'WLocate Win%, Row0%, Col0%
LOCATE Row0%, Col0%
'LOCATE Row0%, 1
RETURN

CursorDown0:
Tmp0% = VAL(MID$(ANSIst0$, 2))
IF Tmp0% < 1 THEN Tmp0% = 1
'WGetLocate Win%, Row0%, Col0%
Col0% = POS(0)
Row0% = CSRLIN
Row0% = Row0% + Tmp0%
IF Row0% > 25 THEN Row0% = 25
'WLocate Win%, Row0%, Col0%
LOCATE Row0%, Col0%
'LOCATE Row0%, 1
RETURN

CursorLeft0:
Tmp0% = VAL(MID$(ANSIst0$, 2))
IF Tmp0% < 1 THEN Tmp0% = 1
'WGetLocate Win%, Row0%, Col0%
Col0% = POS(0)
Row0% = CSRLIN
Col0% = Col0% - Tmp0%
IF Col0% < 1 THEN Col0% = 1
'WLocate Win%, Row0%, Col0%
LOCATE Row0%, Col0%
RETURN

CursorRight0:
Tmp0% = VAL(MID$(ANSIst0$, 2))
IF Tmp0% < 1 THEN Tmp0% = 1
'WGetLocate Win%, Row0%, Col0%
Col0% = POS(0)
Row0% = CSRLIN
Col0% = Col0% + Tmp0%
IF Col0% > 80 THEN Col0% = 80
'WLocate Win%, Row0%, Col0%
LOCATE Row0%, Col0%
RETURN

CursorLocate0:
Row0% = VAL(MID$(ANSIst0$, 2))
Tmp0% = INSTR(ANSIst0$, ";")
IF Tmp0% THEN
Col0% = VAL(MID$(ANSIst0$, Tmp0% + 1))
ELSE
Col0% = 1
END IF
IF Row0% < 1 THEN
Row0% = 1
ELSEIF Row0% > 25 THEN
Row0% = 25
END IF
IF Col0% < 1 THEN
Col0% = 1
ELSEIF Col0% > 80 THEN
Col0% = 80
END IF
'WLocate Win%, Row0%, Col0%
LOCATE Row0%, Col0%
RETURN

SaveCursorPosn0:
'WGetLocate Win%, SaveRow0%, SaveCol0%
SaveCol0% = POS(0)
SaveRow0% = CSRLIN

RETURN

RestCursorPosn0:
IF SaveRow0% > 0 THEN
'WLocate Win%, SaveRow0%, SaveCol0%
LOCATE SaveRow0%, SaveCol0%
END IF
RETURN

BigErase0:
'WClear Win%
CLS
'WLocate Win%, 1, 1
LOCATE 1, 1
RETURN

SmallErase0:
'WGetLocate Win%, Row0%, Col0%
Col0% = POS(0)
Row0% = CSRLIN
'WWrite Win%, SPACE$(80 - Col0%)
PRINT SPACE$(80 - Col0%);
'WLocate Win%, Row0%, Col0%
LOCATE Row0%, Col0%
RETURN

SetColors0:
ANSIst0$ = MID$(ANSIst0$, 2)
'WGetColor Win%, Fore0%, Back0%
Attr = SCREEN(1, 1, 1)
fore = Attr MOD 16
Back = ((Attr - (Attr MOD 16)) / 16) MOD 128
fore = fore OR ((Attr AND (2 ^ 7)) \ (2 ^ 7) * 16)
DO WHILE LEN(ANSIst0$)
Tmp0% = VAL(ANSIst0$)
SELECT CASE Tmp0%
CASE 0: Fore0% = 7: Back0% = 0 ' reset colors
CASE 1: Fore0% = (Fore0% OR 8) ' high intensity
CASE 2: Fore0% = (Fore0% AND &H17) ' normal intensity
CASE 5: Fore0% = (Fore0% OR 16) ' blink
CASE 7: Fore0% = 0: Back0% = 7 ' reverse video
CASE 8: Fore0% = 0: Back0% = 0 ' invisible
CASE 30: Fore0% = (Fore0% AND &H18) ' black foreground
CASE 31: Fore0% = (Fore0% AND &H18) OR 4 ' red foreground
CASE 32: Fore0% = (Fore0% AND &H18) OR 2 ' green foreground
CASE 33: Fore0% = (Fore0% AND &H18) OR 6 ' yellow foreground
CASE 34: Fore0% = (Fore0% AND &H18) OR 1 ' blue foreground
CASE 35: Fore0% = (Fore0% AND &H18) OR 5 ' magenta foreground
CASE 36: Fore0% = (Fore0% AND &H18) OR 3 ' cyan foreground
CASE 37: Fore0% = (Fore0% OR 7) ' white foreground
CASE 40: Back0% = 0 ' black background
CASE 41: Back0% = 4 ' red background
CASE 42: Back0% = 2 ' green background
CASE 43: Back0% = 6 ' yellow background
CASE 44: Back0% = 1 ' blue background
CASE 45: Back0% = 5 ' magenta background
CASE 46: Back0% = 3 ' cyan background
CASE 47: Back0% = 7 ' white background
CASE ELSE ' ignore anything weird
END SELECT
Tmp0% = INSTR(ANSIst0$, ";")
IF Tmp0% THEN
ANSIst0$ = MID$(ANSIst0$, Tmp0% + 1)
ELSE
ANSIst0$ = ""
END IF
LOOP
'WColor Win%, Fore0%, Back0%
COLOR Fore0%, Back0%
RETURN


END SUB

SUB BackIntens (Setting)
REGS.AX = &H1003
IF Setting THEN
REGS.BX = 0 'High intensity background
ELSE
REGS.BX = 1 'Flashing foreground
END IF
CALL INTERRUPT(&H10, REGS)
END SUB

FUNCTION EXIST (FileSpec$)

TEMP$ = FileSpec$ + CHR$(0) 'Add a zero byte for DOS.
REGS.AX = &H4E00 'Find first matching file.
REGS.CX = 0 'Directory attribute byte.
REGS.DS = VARSEG(TEMP$) 'Put TEMP$'s segmeDEFINT A-Z

END FUNCTION

SUB INTERRUPT (INTNUM, REGS AS REGTYPE)

DEF SEG = VARSEG(INTRPT(1))'Point to buffer segment
ADDRESS = VARPTR(INTRPT(1)) ' and offset
POKE ADDRESS + 51, INTNUM 'Replace INT number in code
CALL ABSOLUTE(REGS, ADDRESS) 'Call assembler routine.

END SUB

'Subroutine to place a character a certain location of certain colors.
'Written by Paul Holmlund 04/09/95
SUB ScreenWrite (x, y, Char, Colr, Back)
COLOR Colr, Back
LOCATE y, x
PRINT CHR$(Char);
END SUB

SUB Scroll
REGS.AX = &H1
CALL INTERRUPT(&H10, REGS)
END SUB

'End of Code~~~~~~~~~



If you try to use this code in QB4.5, it will argue with you because it already has "" Interrupt listed as a command. Simply rename the Sub to be something spelled slightly different,.. like Intrpt,.. just so that QB4.5 will not be upset.

Besides not being able to compile, this bit of code virtually gives you almost everything you gain once you go into QB4.5, except in QB1.1.

I use this Interrupt routine alot.

Kiyote!
Banana phone! We need more lemon pledge. * exploding fist of iced tea! * I see your psycho cat and counter with a duck that has a broken leg, in a cast.
Post Reply