'=========================================================================== ' Subject: ASSEMBLY IN QBASIC 5: PROCS Date: 02-07-97 (22:15) ' Author: Rick Elbers Code: QB, QBasic, PDS ' Origin: rick@tip.nl Packet: ASMCODE.ABC '=========================================================================== 'ASSEMBLY IN QBASIC PART 5: USING A PROCEDURE SEGMENT '------------------------------------------------------- 'Rick Elbers november 1996, modificated februari 1997[] DEFSTR A DEFINT B-Z DECLARE FUNCTION asmcaller () DECLARE SUB biosvideo (vidbase, prnstr, main) DECLARE SUB neardemo () DECLARE SUB fardemo () '------------ 'INTRODUCTION '------------ 'Procedures. When you have taken a short look at assembly programs then you 'know that asm is generally flooded with it. That is why we need a way to 'handle procedures inside our asm functions if we want to do anything even 'remotely advanced. 'The first distinction to keep in mind when speeking about procedures is the 'destinction between FAR and NEAR procedures. Near procedures are procs that 'are procedures in the same SEGMENT and can be CALLED with a NEAR CALL like: 'NEAR CALLS examples clocks FAR CALLS examples clocks 'CALL relat CALL 100 3(!) CALL 1234:FFFF 3 'CALL reg CALL BX 5 ES:CALL [BX] 2+10 'CALL [reg] CALL [BX] 10+(5 for 32 bits) CALL FAR [BX] 18 'return with: 'RET RET 5(!) RETF 13 'From the above you should have noticed that based/indexed 16 bit calling 'is much less cheap then relative calling. However the base/indexed calling 'is much more flexible of course since you do not need to hardcode or 'calculate the relative/ absolute adress. Next thing you could have noticed 'is that relative adressing is cheaper then absolute adressing. The meaning 'of that is that when you have hardcoded procedures then you should use 'relative adressing. A last thing you could learn from the above is that 'NEAR CALLING/RETURNING is very much favored over FAR CALLING/ RETURNING. 'You only have to compare the RETF(13) with RET(5) to see what I mean. The 'situation for FAR CALLS is much alike of course since there is additional 'pushing/ popping of the segment needed as well as a far jump. 'For QBASIC when you use stringstorage ALL procedures are near procedures 'by default. When you use integerstorage ONLY the procedures in the same 'array are near procedures and the others are far. It should be very clear 'by now that you should avoid using FAR procedures. But that is not always 'possible. The two reasons to use FAR procedures are: '1) You have to CALL some FAR driver/TSR/INTERRUPT routine etc.. '2) You are to lazy to put all your procs into one asm%() << not supported. 'NEAR PROCEDURES '**************** 'Now that we made clear that basically we need a way to handle NEAR 'PROCEDURES, the next important point is the FLEXIBLILITY that you need. 'Basically there exist the following ways to handle near procedures: '1)DGROUP APPROACH: Fast, easy to calculate entries. ' Don't need fixed assembly storage ' However, not flexible: needs hardcoded CALLS. '2)STACK APPROACH : Slower, have to know entrie of procs ' Need fixed assembly storage ' However, is more flexible: needs no hardcoded CALLS ' Needs a assembly caller procedure with FAR return. 'The first approach is closely related to the DATA DGROUP approach, and is 'favored when you either run through a FIXED pattern of procs or you have 'decisions as to which proc to use in your asm code. 'The second approach is favored when you want to handle CONCURRENT procs. 'Say that you want to print a string OR replace a part of a string AND 'then print that part depending on some QBASIC code. In that case you 'should use the second approach. 'Since we know we can fixate a string in memory it is not necessary any 'different if you use integerstorage or stringstorage of youre assembly 'procedures. I will only elaborate on one of them. CALL neardemo '*************** 'FAR PROCEDURES '*************** 'As have been said before the only reason why you should FAR calls instead 'of near calls is when that type of calling is forced upon you by for 'instance a dos extender, a TSR, some driver like HIMEM, EMM386 etc.. CALL fardemo END DEFSNG B-Z FUNCTION asmcaller '-------------------------------------- 'This function constitutes a minimal 'structure for calling asm procs.. '------------------------------------- asm = "" asm = asm + CHR$(&H55) 'push bp asm = asm + CHR$(&H89) + CHR$(&HE5) 'mov bp,sp asm = asm + CHR$(&HBE) + MKI$(&HA) 'mov si,a asm = asm + CHR$(&H8B) + CHR$(&H1A) 'mov bx,[bp+si] asm = asm + CHR$(&HFF) + CHR$(&H17) 'call [bx] vidbase asm = asm + CHR$(&HBE) + MKI$(8) 'mov si,8 asm = asm + CHR$(&H8B) + CHR$(&H1A) 'mov bx,[bp+si] asm = asm + CHR$(&HBE) + MKI$(6) 'mov si,6 point to string asm = asm + CHR$(&HFF) + CHR$(&H17) 'call [bx] print direct asm = asm + CHR$(&H89) + CHR$(&HEC) 'mov sp,bp asm = asm + CHR$(&H5D) 'pop bp asm = asm + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'retf 6 asmcaller = asm END FUNCTION DEFINT B-Z SUB biosvideo (vidbase, prnstr, main) 'This procedure is the start of a BIOS print dispatcher. 'It needs a little bit elaboration to make it really useful 'an sich, but it gives you the idea what sort of programs 'you can get with structured programming in asm.... 'STACKPASSING STRING1,STRING2 'This is a very fast printstring procedure, since the 'cursor is only updated at the end of all printing jobs 'and since even the page offset is only updated on request... 'Initializing: DIM asmstore AS STRING * 1000: datas = VARPTR(asmstore) asm = "" 'DATA: asm = asm + MKI$(0) '0:OFFSET PAGE asm = asm + MKI$(0) '2:VIDEOSEGMENT asm = asm + MKI$(0) '4:CURRENT CURSORPOS row:col asm = asm + MKI$(0) '6:UPDATED PAGEOFFSET asm = asm + MKI$(0) '8:OFFSET IN VIDEOPAGE asm = asm + CHR$(0) 'a:PAGENR '--------------------*****************------------------ ' *GETVIDBASE PROC* ' ***************** 'SUBROUTINE : GET THE VIDEOBASE 'IN : DI points to DATA 'USES : AX,ES 'WRITES : VIDEOSEG,VIDEOOFF 'OUT : BH POINTS TO PAGENR. vidbase = LEN(asm) '------------------------------------------------------- 'CODE asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H6) 'PUSH ES asm = asm + CHR$(&HBF) + MKI$(datas) 'MOV DI,OFFSET(DATA) asm = asm + CHR$(&HB8) + CHR$(&H40) + CHR$(&H0) 'MOV AX,40 asm = asm + CHR$(&H8E) + CHR$(&HC0) 'MOV ES,AX asm = asm + CHR$(&H26) 'ES: asm = asm + CHR$(&HA1) + MKI$(&H4E) 'MOV AX,[4E] asm = asm + CHR$(&H89) + CHR$(&H5) 'MOV [DI],AX pageoffset asm = asm + CHR$(&H26) 'ES: asm = asm + CHR$(&H8A) + CHR$(&H26) + MKI$(&H62) 'MOV AH,[62] asm = asm + CHR$(&H88) + CHR$(&H65) + CHR$(&HA) 'MOV [DI+A],AH pagenr asm = asm + CHR$(&H26) 'ES: asm = asm + CHR$(&HA0) + CHR$(&H10) + CHR$(&H0) 'MOV AL,[10] asm = asm + CHR$(&H24) + CHR$(&H30) 'AND AL,30 asm = asm + CHR$(&H3C) + CHR$(&H30) 'CMP AL,30 asm = asm + CHR$(&H74) + CHR$(&H9) 'JZ MONOchr$OME asm = asm + CHR$(&HB8) + CHR$(&H0) + CHR$(&HB8) 'MOV AX,B800 asm = asm + CHR$(&H89) + CHR$(&H45) + CHR$(&H2) 'MOV [DI+2],AX vidseg asm = asm + CHR$(&H7) 'POP ES asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&HC3) 'RET asm = asm + CHR$(&HB8) + CHR$(&H0) + CHR$(&HB0) 'MOV AX,B000 asm = asm + CHR$(&HEB) + CHR$(&HF5) 'JMP -11 'GETVIDBASE ENDP: '-----------------****************---------------------- ' *GETCURSOR PROC* ' **************** 'SUBROUTINE : GET THE CURSOR POSITION 'IN : DI points to DATA 'USES : AX,BX 'WRITES : CURSORPOSITION DATA 'OUT : getcurs = LEN(asm) '------------------------------------------------------- asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H53) 'PUSH BX asm = asm + CHR$(&H52) 'PUSH DX asm = asm + CHR$(&H8A) + CHR$(&H7D) + CHR$(&HA) 'MOV BH,[DI+A] pagenr asm = asm + CHR$(&HB4) + CHR$(&H3) 'MOV AH,03 asm = asm + CHR$(&HCD) + CHR$(&H10) 'INT 10 asm = asm + CHR$(&H89) + CHR$(&H55) + CHR$(&H4) 'MOV [DI+4],DX cursorpos asm = asm + CHR$(&H5A) 'POP DX asm = asm + CHR$(&H5B) 'POP BX asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&HC3) 'RET 'GETCURSOR ENDP: '-----------------********************---------------------- ' *OFFSET2CURSOR PROC* ' ******************** 'SUBROUTINE : UPDATES THE CURSOR POSITION FROM THE PAGE OFFSET 'IN : DI points to DATA 'USES : AX,CX 'READS : OFFSET IN VIDEOPAGE 'WRITES : CURSORPOSITION 'OUT : updcurs = LEN(asm) '----------------------------------------------------------- asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H51) 'PUSH CX asm = asm + CHR$(&H8B) + CHR$(&H45) + CHR$(8) 'MOV AX,[DI+08]pageoffset asm = asm + CHR$(&HD1) + CHR$(&HE8) 'SHR AX,1 offset/2=chars asm = asm + CHR$(&HB1) + CHR$(&H50) 'MOV CL,50 for div asm = asm + CHR$(&HF6) + CHR$(&HF1) 'DIV CL col to AH row to AL! asm = asm + CHR$(&H88) + CHR$(&HC5) 'MOV CH,AL row to DH asm = asm + CHR$(&H88) + CHR$(&HE1) 'MOV CL,AH column to DL asm = asm + CHR$(&H89) + CHR$(&H4D) + CHR$(&H4) 'MOV [DI+4],CX cursorpos asm = asm + CHR$(&H59) 'POP CX asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&HC3) 'RET 'OFFSET2CURSOR ENDP: '-----------------********************---------------------- ' *CURSOR2OFFSET PROC* ' ******************** 'SUBROUTINE : UPDATES THE PAGE OFFSET FROM THE CURSOR POSITION 'IN : DI points to DATA 'USES : AX,CX 'READS : OFFSET IN VIDEOPAGE 'WRITES : CURSORPOSITION 'OUT : crs2off = LEN(asm) '----------------------------------------------------------- asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H51) 'PUSH CX asm = asm + CHR$(&H8B) + CHR$(&H4D) + CHR$(4) 'MOV CX,[DI+04]cursorpos asm = asm + CHR$(&HB8) + MKI$(&H50) 'MOV AX,50 for mul asm = asm + CHR$(&HF6) + CHR$(&HE5) 'MUL CH (row *&h50 asm = asm + CHR$(&H81) + CHR$(&HE1) + MKI$(&HFF) 'AND CX,&HFF + asm = asm + CHR$(&H1) + CHR$(&HC8) 'ADD AX,CX column) asm = asm + CHR$(&HD1) + CHR$(&HE0) 'SHL AX,1 *2 asm = asm + CHR$(&H89) + CHR$(&H45) + CHR$(&H8) 'MOV [DI+8],AX pageoffset asm = asm + CHR$(&H59) 'POP CX asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&HC3) 'RET 'CURSOR2OFFSET ENDPROC: '-----------------****************-------------------------- ' *SETCURSOR PROC* ' **************** 'SUBROUTINE : SETS THE CURSOR POSITION 'IN : DI points to DATA 'USES : AX,BX 'WRITES : CURSORPOSITION DATA 'OUT : setcurs = LEN(asm) '------------------------------------------------------------ asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H53) 'PUSH BX asm = asm + CHR$(&H52) 'PUSH DX asm = asm + CHR$(&H8B) + CHR$(&H55) + CHR$(4) 'MOV DX,[DI+4]cursorpos asm = asm + CHR$(&H8A) + CHR$(&H7D) + CHR$(&HA) 'MOV BH,[DI+A]pagenr asm = asm + CHR$(&HB4) + CHR$(&H2) 'MOV AH,02 asm = asm + CHR$(&HCD) + CHR$(&H10) 'INT 10 asm = asm + CHR$(&H5A) 'POP DX asm = asm + CHR$(&H5B) 'POP BX asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&HC3) 'RET 'SETCURSOR ENDP: '-----------------**************-------------------------- ' *PRINT STRING* ' ************** 'SUBROUTINE : PRINTS A STRING USING THE BIOS FUNCTION 'IN : DI points to DATA,BP+SI to string 'USES : AX,BX,CX,DX,ES,BP 'WRITES : STRING 'OUT : prnstr = LEN(asm) '------------------------------------------------------------ 'Get string length set DS[si] to adress: asm = asm + CHR$(&H6) 'PUSH ES asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H53) 'PUSH BX asm = asm + CHR$(&H51) 'PUSH CX asm = asm + CHR$(&H52) 'PUSH DX asm = asm + CHR$(&H55) 'PUSH BP asm = asm + CHR$(&H8B) + CHR$(&H1A) 'MOV BX,[BP+SI] asm = asm + CHR$(&H8B) + CHR$(&H6F) + CHR$(&H2)'MOV BP,[BX+2] sadd asm = asm + CHR$(&HE) + CHR$(&H7) 'PUSH CS:POP ES ES[BP]string asm = asm + CHR$(&H8B) + CHR$(&HF) 'MOV CX,[BX] length asm = asm + CHR$(&HB3) + CHR$(&H70) 'MOV BL,70 attribute asm = asm + CHR$(&H8A) + CHR$(&H7D) + CHR$(&HA)'MOV BH,[DI+A]pagenr asm = asm + CHR$(&H8B) + CHR$(&H55) + CHR$(4) 'MOV DX,[DI+4]cursorpos asm = asm + CHR$(&HB8) + CHR$(&H0) + CHR$(&H13)'MOV AX,1300 asm = asm + CHR$(&HCD) + CHR$(&H10) 'INT 10 asm = asm + CHR$(&H5D) 'POP BP asm = asm + CHR$(&H5A) 'POP DX asm = asm + CHR$(&H59) 'POP CX asm = asm + CHR$(&H5B) 'POP BX asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&H7) 'POP ES asm = asm + CHR$(&HC3) 'RET 'PRINTSTRING ENDP: '-----------------*******************---------------------- ' *PRINT DIRECT PROC* ' ******************* 'SUBROUTINE : PRINTS DIRECTLY TO THE SCREENSEGMENT 'IN : DI points to DATA,BP+SI TO STRING 'USES : AX,BX,CX,SI,DI,ES 'READS : LENGTH OF STRING, OFFSET IN VIDEOBUFFER:PAGE 'WRITES : STRING, CURSORPOSITION DATA ,VIDEOSEGMENT:OFFSET DATA 'OUT : prndir = LEN(asm) '----------------------------------------------------------- asm = asm + CHR$(&H6) 'PUSH ES asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H53) 'PUSH BX asm = asm + CHR$(&H51) 'PUSH CX asm = asm + CHR$(&H56) 'PUSH SI asm = asm + CHR$(&H57) 'PUSH DI 'Get string length set DS[si] to adress: asm = asm + CHR$(&H8B) + CHR$(&H1A) 'MOV BX,[BP+SI] asm = asm + CHR$(&H8B) + CHR$(&H77) + CHR$(&H2)'MOV SI,[BX+2] DS[SI]string asm = asm + CHR$(&H8B) + CHR$(&HF) 'MOV CX,[BX] CX length asm = asm + CHR$(&H8B) + CHR$(&H45) + CHR$(8) 'MOV AX,[DI+08]pageoffset 'adjust string to 'onscreen' length.. asm = asm + CHR$(&HBB) + MKI$(&H1000) 'MOV BX,&H1000 end page asm = asm + CHR$(&H29) + CHR$(&HC3) 'SUB BX,AX space on page asm = asm + CHR$(&HD1) + CHR$(&HEB) 'SHR BX,1 char space on p asm = asm + CHR$(&H39) + CHR$(&HD9) 'CMP CX,BX string fits ? asm = asm + CHR$(&H72) + CHR$(&H2) 'JB OKE +2 yes:oke asm = asm + CHR$(&H89) + CHR$(&HD9) 'MOV CX,BX no: adjust length 'Set ES[DI] to current videooffset asm = asm + CHR$(&HC4) + CHR$(&H3D) 'LES DI,[DI] start off page asm = asm + CHR$(&H1) + CHR$(&HC7) 'ADD DI,AX add the pageoffset 'Copy the string to the screen: asm = asm + CHR$(&HFC) 'CLD asm = asm + CHR$(&HA4) 'MOVSB asm = asm + CHR$(&H47) 'INC DI skipp attribute asm = asm + CHR$(&H49) 'DEC CX asm = asm + CHR$(&H75) + CHR$(&HFB) 'JNZ -5 'And store new page offset asm = asm + CHR$(&H89) + CHR$(&HFB) 'MOV BX,DI current offset asm = asm + CHR$(&H5F) 'POP DI asm = asm + CHR$(&H2B) + CHR$(&H5) 'SUB BX,[DI] in page asm = asm + CHR$(&H89) + CHR$(&H5D) + CHR$(&H6)'MOV [DI+6],BX asm = asm + CHR$(&H5E) 'POP SI asm = asm + CHR$(&H59) 'POP CX asm = asm + CHR$(&H5B) 'POP BX asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&H7) 'POP ES asm = asm + CHR$(&HC3) 'ret 'PRINTdirect ENDP: '-----------------********************-------------------------- ' *UPDATEOFFSET PROC* ' ******************** 'SUBROUTINE : UPDATES THE VIDEOPAGEOFFSET 'IN : DI points to DATA 'USES : AX 'READS : NEW PAGEOFFSET 'WRITES : PAGEOFFSET 'OUT : updoffs = LEN(asm) '------------------------------------------------------------ asm = asm + CHR$(&H50) 'PUSH AX asm = asm + CHR$(&H8B) + CHR$(&H45) + CHR$(6) 'MOV AX,[DI+6]updated asm = asm + CHR$(&H89) + CHR$(&H45) + CHR$(8) '[DI+8],AX pageoffset asm = asm + CHR$(&H58) 'POP AX asm = asm + CHR$(&HC3) 'RET 'UPDATEOFFSET ENDP: 'MAIN: '-----------------****************------------------------------------------ ' *MAIN PROCEDURE* ' **************** 'MAIN ROUTINE : PRINTS DIRECTLY TO THE SCREENSEGMENT AND UPDATES CURSOR 'IN : A STRING IS PUSHED ONTO THE STACK 'USES : BP,DX, GETVIDEOBASE,SETCURSOR,PRINTDIRECT,GETCURSOR main = LEN(asm) '------------------------------------------------------------------------- asm = asm + CHR$(&H55) 'PUSH BP asm = asm + CHR$(&H89) + CHR$(&HE5) 'MOV BP,SP asm = asm + CHR$(&HBF) + MKI$(datas) 'MOV DI,OFFSET(DATA) asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + vidbase) 'CALL GETVIDEOBASE asm = asm + CHR$(&HBA) + MKI$(&H0) 'MOV DX,CURSORPOS asm = asm + CHR$(&H89) + CHR$(&H55) + CHR$(4) 'MOV [DI+4],DX asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + setcurs) 'CALL SETCURSOR asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + crs2off) 'CALL CURSOR2OFFSET asm = asm + CHR$(&HB9) + MKI$(250) 'MOV CX,250 'LOOPING.... asm = asm + CHR$(&HBE) + MKI$(6) 'MOV SI,6 asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + prndir) 'CALL PRINTDIRECT asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + updoffs) 'CALL UPDATEOFFSET asm = asm + CHR$(&HBE) + MKI$(8) 'MOV SI,8 asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + prndir) 'CALL PRINTDIRECT asm = asm + CHR$(&HE2) + CHR$(&HEF) 'LOOP -20 'ENDING... asm = asm + CHR$(&HBE) + MKI$(6) 'MOV SI,6 asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + prndir) 'CALL PRINTDIRECT 'asm = asm + chr$(&HE8) + mki$(-3 - LEN(asm) + updcurs)'CALL UPDATECURSOR asm = asm + CHR$(&HE8) + MKI$(-3 - LEN(asm) + setcurs) 'CALL SETCURSOR asm = asm + CHR$(&H89) + CHR$(&HEC) 'MOV SP,BP asm = asm + CHR$(&H5D) 'POP BP asm = asm + CHR$(&HCA) + MKI$(4) 'RETF 2 asmstore = asm: datas = VARPTR(asmstore) main = datas + main: vidbase = datas + vidbase prnstr = datas + prnstr END SUB SUB fardemo 'Since procedures which can be hardcoded do not need any FAR calls, 'as we have seen, the only approach of procedures we will look into in 'this section will be the STACKAPPROACH.. 'Like with the other STACKAPPROACHES we have to distinguish the CALLED 'PROCEDURE{the "would be driver") and the CALLER( our program specific 'assembly code). 'For the sake of demonstration we will have to assume some code loaded 'into memory. For an elaborated example you should look into the RAM in 'QBASIC series, but at this moment we will simulate some driver with the 'following code: '------------------------------------ 'CALLED PROCEDURE: simulated driver '------------------------------------ DIM newint(4): segm = VARSEG(newint(0)): offs = 0 newint(0) = &H41B2 'MOV DL,41 newint(1) = &H2B4 'MOV AH,02 newint(2) = &H21CD 'INT 21 newint(3) = &HCB 'RETF (returns to the caller) '---------------------------------- 'CALLING APPROACH : CALL FAR [BX] '---------------------------------- 'We will just call the far pointer of the driver. A far pointer means 'that the double word is popped of the stack and after that the jump 'is executed. When you load the double word pointer with segment:offset 'then the execution of the far call will jump to the driver. Notice that 'contrary to the stackapproach with NEAR procedures we are doing in fact 'TWO far calls, the first one from QBASIC and the second one from our 'assembly CALLER routine to the driver. Stupid, but unavoidable.. '---------------- 'CALLER PROCEDURE '----------------- 'So let us do the far call code with stackpassing here. asm = "" asm = asm + CHR$(&H55) 'push bp 4 asm = asm + CHR$(&H89) + CHR$(&HE5) 'mov bp,sp 1 asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx,[bp+06] 1 asm = asm + CHR$(&HFF) + CHR$(&H1F) 'call far [bx] 17 asm = asm + CHR$(&H5D) 'pop bp 1 asm = asm + CHR$(&HCA) + MKI$(&H2) 'retf 2 14 'This program does nothing but CALLING THE FAR PROCEDURE("would be driver") 'and returning to QBASIC. Let us controle it: CLS : dwordptr& = segm * &H10000 OR offs DEF SEG = VARSEG(asm): CALL ABSOLUTE(dwordptr&, SADD(asm$)): DEF SEG LOCATE 10, 1: PRINT "This was our driver called from QBASIC..": SLEEP: CLS : LOCATE 10, 1: PRINT "Good bye" PRINT : PRINT "Rickn" END SUB SUB neardemo 'Initiating: CALL biosvideo(vidbase, prnstr, main): stringseg = VARSEG(asm): CLS '*************** 'DGROUP calling: '*************** 'Have you ever heard of subliminal perception ? I can tell you that for 'commercials on TV it is forbidden..Subliminal perception takes place when 'the folluw up of images is to fast for your eyes. Although you do not 'consciously recognize the image, there is still a part of your brain that 'will notice the image...Well in this demonstration the printing/fading is 'just tooo fast..so you will have a look at a very small part of what is 'actually printed...The string will be moved 10000 times from screenposition '0 to position 250*8=the end of the screen. So far about this little 'bios dispatcher...When you need really fast prints you could built 'a real nice routine out of this dispatcher, I guess..[of course I 'included bugs...;)]. The topic however was procedures. You should 'notice that all procedures are NEAR!! and HARDCODED. And that is the 'same as saying that there is a FIXED PATTERN of CALLS...which is 'displayed in the procedure I called MAIN. a = SPACE$(10000): DEF SEG = stringseg: away = SPACE$(8) FOR i = 0 TO 10000 CALL ABSOLUTE("Gonewind", away, main): NEXT FOR i = 7 TO 0 STEP -1 SCREEN 0, i, i: PRINT "Screenpage "; i; " ": SLEEP NEXT PRINT : PRINT "Press a key for next demonstration ..": SLEEP: CLS '************** 'STACKPASSING: '************** 'This time we are going to use the same near procedures from another 'procedure. That is the way to stay flexible. You can call every procedure 'inside your NEAR LIBRARY [I think calling biosvideo a library is best here]. 'So ,you do not need the fixed pattern of calls inside the mainprocedure 'after all!. The only thing you have to do, is to set up a CALLING PROCEDURE 'which will be your INTERFACE between QBASIC and BIOSVIDEO. 'Initiating: there must be a far caller.... asm = asmcaller: DEF SEG = VARSEG(asm) CALL ABSOLUTE(vidbase, prnstr, "nada", SADD(asm)) DEF SEG : LOCATE 10, 1: PRINT "This was the demonstration of NEAR PROCEDURES..": PRINT : PRINT "Press a key for FAR PROCEDURES": SLEEP 'Although I will not very much go into it I think I should point 'out to you all the possibilities of this type of FLEXIBLE NEAR CALLING 'This type of calling makes it possible that you do: '1)Store your assembly procedures as NEAR procedures in a string. '2)Store the string in a librarie file, without header pointing to the ' offsets of the different procedures.. '3)Everytime you need a procedure out of your library you just load ' the file into a string again, and you refer to the ' string offset+procedure offset inside your CALLING FUNCTION.... 'Easy enough...You even could automate the CALLING FUNCTION any further... 'Well, I think I just have to wait for someone to do it, I guess END SUB