' InterruptX
' Interrupt procedure for QBASIC
' (c) 1992 Hans Lunsing
' ----------------------------------------------------------------------
DEFINT A-Z

' Register type for use with InterruptX

TYPE RegTypeX
  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

CONST FALSE = 0, TRUE = NOT FALSE

DECLARE SUB InterruptX (IntNo%, Inreg AS RegTypeX, OutReg AS RegTypeX)

'-----------------------------------------------------------------------
' The machine code of the interrupt procedure for InterruptX
'-----------------------------------------------------------------------
InterruptXASM:
' Number of bytes
DATA  190
' Hexadecimal representation of machine code
DATA 55,8B,EC,8B,5E,0C,8B,17,0A,F6
DATA 74,07,C7,07,FF,FF,E9,A7,00,8B
DATA 5E,06,8B,1F,2E,88,97,77,00,32
DATA C0,80,FA,25,74,05,80,FA,26,75
DATA 02,0C,02,50,1E,06,56,57,9C,8B
DATA 76,0A,80,FA,20,7C,05,80,FA,30
DATA 7C,0A,81,7C,08,FF,FF,74,03,8B
DATA 6C,08,8B,44,0E,25,D5,0F,50,8B
DATA 04,8B,5C,02,8B,4C,04,8B,54,06
DATA 8B,7C,0C,FF,74,0A,81,7C,12,FF
DATA FF,74,03,8E,44,12,81,7C,10,FF
DATA FF,74,03,8E,5C,10,5E,9D,CD,00
DATA 55,8B,EC,9C,83,C5,0E,F6,46,FE
DATA 02,74,02,45,45,1E,56,8E,5E,FC
DATA 8B,76,08,89,04,89,5C,02,89,4C
DATA 04,89,54,06,8F,44,0A,89,7C,0C
DATA 8F,44,10,8C,44,12,8F,44,0E,8F
DATA 44,08,F6,46,FE,02,74,02,44,44
DATA 9D,5F,5E,07,1F,58,5D,CA,08,00

'-----------------------------------------------------------------------
' Example: get current video mode
'-----------------------------------------------------------------------
DIM r AS RegTypeX
r.ax = &HF00
InterruptX &H10, r, r
VideoMode = (r.ax AND &HFF)
PRINT "Video mode is "; VideoMode
END

'Hans Lunsing,           Fido     : 2:281/607.214, 2:282/610.12
'                        Internet : jlunsing@doge.nl

SUB InterruptX (IntNo AS INTEGER, Inreg AS RegTypeX, OutReg AS RegTypeX) STATIC
'-----------------------------------------------------------------------
' Interrupt procedure. Works in the same way as its QB 4.5 counterpart.
'-----------------------------------------------------------------------

IF NOT MachineCode% THEN
  ' First time dimension string array to hold machine code
  RESTORE InterruptXASM
  READ nASMBYTES%
  REDIM ASMBuffer(0 TO nASMBYTES% - 1) AS STRING * 1
END IF

' Get address of machine code
DEF SEG = VARSEG(ASMBuffer(0))
Offset% = VARPTR(ASMBuffer(0))

IF NOT MachineCode% THEN
  ' First time load string array with machine code
  FOR i% = 0 TO nASMBYTES% - 1
    READ Code$
    POKE Offset% + i%, VAL("&H" + Code$)
  NEXT i%
  ' Indicate availability of machine code
  MachineCode% = TRUE
END IF

' Call interrupt.
' The first Offset% parameter is used by the machine code modifying it self,
' so don't leave it out.
CALL ABSOLUTE(IntNo%, Inreg, OutReg, Offset%, Offset%)

DEF SEG
END SUB