QB/PDS/VBDOS INT Handlers

Area:    Quik_Bas
  Msg:    #287
 Date:    11-23-92 19:07 (Public) 
 From:    Steve Gartrell           
 To:      Robert Church            
 Subject: QB/PDS/VBDOS INT Handlers

'So Basic can't do interrupt handlers...The DemRegs variable
'passes back the status of the registers at the time of the
'interrupt.  Likewise, if you change a DemRegs.(anyreg)
'value inside the handler sub, that value will be placed
'in the respective register!!!  Dangerous toy, A?  The
'global variable Busy% is read inside the Absolute array
'ASM; if it's <> 0 then the routine chains directly (mostly)
'to the original vector.  Which you will want, if you are going
'to DEF SEG out of DGROUP, for instance!!!
'NOT FOR USE IN THE ENVIRONMENT!!  Compile it, and then
'let it run for 20 or 30 seconds, and you'll start seeing the
' registers passed back...
'
'This is _not_ a toy...If you are not sure what you are doing,
' try thinking about worst-case scenarios, and take proper
' preventative measures...Like, if you play with disk access
' interrupts, BACK UP!!

'Compiled and tested under QB45 and PDS...
DEFINT A-Z
'$INCLUDE: 'VBDOS.BI'   'QB.BI if using QB4.5, QBX.BI in PDS
DECLARE SUB Handler ()
'remark out the original DECLARE SUB Absolute declaration in your
' include file; it's modified here...
DECLARE SUB Absolute (RegsOff%, Busy%, OldSeg%, OldOff%,_
 StartPtr%, address AS INTEGER)
'bet ya can't guess what my middle initial is...
TYPE SKGregs
  ax AS INTEGER
  bx AS INTEGER
  cx AS INTEGER
  dx AS INTEGER
  si AS INTEGER
  di AS INTEGER
  es AS INTEGER
  ds AS INTEGER
  flags AS INTEGER
  bp AS INTEGER
END TYPE

CONST C$ = "Created 08/31/92 by Steve Gartrell."
'don't want this stuff moving around!!!  These
' MUST remain global!!!
'$STATIC
DIM SHARED AsmArray%(1 TO 88), DemRegs AS SKGregs
DIM SHARED OldOff%, OldSeg%, RetToAsm%, RegsOff%, SetUp%
DIM SHARED TicCnt%, Busy%
'$DYNAMIC
CLS
LOCATE 1, 70: PRINT LEFT$(TIME$, 8)

SetUp% = VARPTR(AsmArray%(47))
RetToAsm% = VARPTR(AsmArray%(29))
NewSeg% = VARSEG(AsmArray%(1))
NewOff% = VARPTR(AsmArray%(1))
RegsOff% = VARPTR(DemRegs)

DIM Regs AS RegTypeX

'DOS get interrupt vector using the clock 08h for
' demo purposes...Can use any other, too, but be
' aware that results can be extremely dependent
' upon what QB/PDS has done/is gonna do with the
' original vector!!!
Regs.ax = &H3508
CALL INTERRUPTX(&H21, Regs, Regs)
'save 08h original vector
OldSeg% = Regs.es
OldOff% = Regs.bx
'read all the sneaky little ASM opcodes in, which are primarily
' concerned with register saving, and navigating around the
' flow "limitations" imposed by QB/PDS...
RESTORE
FOR Word% = 1 TO 88
  READ DataStr$
  AsmArray(Word%) = VAL(DataStr$)
NEXT

'Call the sub that sets up necessary address calculations...

Handler   'OldSeg% & OldOff% are global, remember...

'Use DOS set interrupt call to change interrupt &H08 vector to
' the one returned for the AsmArray code that resides in DGROUP...
Regs.ax = &H2508
Regs.ds = NewSeg%
Regs.dx = NewOff%
CALL INTERRUPTX(&H21, Regs, Regs)

cnt& = 0
DO
  'gotta do something to show clock is interrupt driven
  ' Fix Busy% true, and the interrupt-driven time
  ' print can occur before this LOCATE and PRINT finish,
  ' with the number then showing up at coordinate 2,1!!
  cnt& = cnt& + 1
  Busy% = -1
  LOCATE 5, 35
  PRINT cnt&;
  Busy% = 0
  IF cnt& > 2000000 THEN cnt& = 1
LOOP UNTIL LEN(INKEY$)

'Return INT &H08 to it's original vector-THIS MUST ALWAYS
' BE DONE!!!
Regs.ax = &H2508
Regs.ds = OldSeg%
Regs.dx = OldOff%
CALL INTERRUPTX(&H21, Regs, Regs)

LOCATE 24, 1

END 'This is the end, my FIDO friend, the end...

'88 WORDS, FIRST call at VARPTR(47), LAST call at VARPTR(29)
ReversedOpcodes:

DATA &H8B55,&H9CEC,&H061E,&H5657,&H5152,&H5053,&HD78C,&HDF8E
DATA &H90BB,&H8B90,&H2307,&H75C0,&H8E30,&H8BC7,&HFCF4,&H90BF
DATA &HB990,&H000A,&HA5F3,&HEF83,&H5714,&HEE83,&H5614,&HB8FB
DATA &H9090,&HB850,&H9090,&HCB50,&HC483,&H8C0E,&H8ED7,&H8EDF
DATA &H5FC7,&HFC5E,&H0AB9,&HF300,&H58A5,&H595B,&H5E5A,&H075F
DATA &H9D1F,&H2E5D,&H2EFF,&H0058,&H9090,&H9090,&H8B55,&H50EC
DATA &H5253,&H8B56,&H065E,&H1F8B,&HEB83,&H8B5C,&H0246,&H0305
DATA &H8900,&H3487,&H8B00,&H0446,&H8789,&H0030,&HF38B,&H5E8B
DATA &H8B08,&H8917,&H5894,&H8B00,&H0A5E,&H178B,&H9489,&H005A
DATA &H5E8B,&H890C,&H119C,&H8B00,&H0E5E,&H178B,&H9489,&H001F
DATA &HC68B,&H5805,&H8900,&H5644,&H5A5E,&H585B,&HCA5D,&H000A

REM $STATIC
STATIC SUB Handler ()

SHARED OldOff%, OldSeg%, RetToAsm%, RegsOff%, SetUp%
SHARED TicCnt%, Busy%, DemRegs AS SKGregs, NewOff%

'Make sure we're looking at DGROUP
DEF SEG

CALL Absolute(RegsOff%, Busy%, OldSeg%, OldOff%, SetUp%, SetUp%)
EXIT SUB

'This routine's LIFE DEPENDS UPON a certain amount of
' code bytes between the EXIT SUB and the next command
' (happens to be JGE [IF < THEN] here, but not critical).  IF
' YOU SPECIFY /D(ebug) when compiling, YOUR system will HANG!!
' ('Cuz the compiler will sneak some stuff in in between
'  the EXIT SUB and your first line of code!!!)  Also, ERROR
' handling (/E/X compile options) in QB is probably
' impossible, and should be approached with care in PDS (like,
' anything but LOCAL error handling is probably out of the
' question, and LOCAL in this sub is a no-no!!!)
' Put any code you want between the EXIT SUB and the
' DEF SEG...EXCEPT (at least) END or it's equivalents...
' You MUST return the clock to it's original vector before
' exiting to DOS, SHELLing, and so forth!!!

'update if 10 seconds have elapsed AND it's safe to do so!

IF TicCnt% < 10 THEN
  TicCnt% = TicCnt% + 1   'a little delay...
ELSE
  Busy% = -1
  LOCATE 1, 70
  PRINT LEFT$(TIME$, 8)  'update the time
  LOCATE 2, 1
  'print the register values at interrupt...
  ' Remember, if you change a register variable at
  ' this point, it _will_ change the register contents!!
  PRINT "AX = "; HEX$(DemRegs.ax); "h"; SPACE$(4)
  PRINT "BX = "; HEX$(DemRegs.bx); "h"; SPACE$(4)
  PRINT "CX = "; HEX$(DemRegs.cx); "h"; SPACE$(4)
  PRINT "DX = "; HEX$(DemRegs.dx); "h"; SPACE$(4)
  PRINT "SI = "; HEX$(DemRegs.si); "h"; SPACE$(4)
  PRINT "DI = "; HEX$(DemRegs.di); "h"; SPACE$(4)
  PRINT "ES = "; HEX$(DemRegs.es); "h"; SPACE$(4)
  PRINT "DS = "; HEX$(DemRegs.ds); "h"; SPACE$(4)
  PRINT "BP = "; HEX$(DemRegs.bp); "h"; SPACE$(4)
  PRINT "Flags = "; HEX$(DemRegs.flags); "h"; SPACE$(4)
  TicCnt% = 1
  Busy% = 0
END IF

DEF SEG
CALL Absolute(dummy%, dummy%, dummy%, dummy%, dummy%, RetToAsm%)

END 'I stuck this END in here just to show you that
   ' the instruction pointer will never get here...

END SUB


--- D'Bridge 1.30/071082
 * Origin: RadioLink! Columbus, OH (614)766-2162 HST/DS (1:226/140)