' QBASIC to CEC IEEE-488 interface code
' (QBASIC is a subset of Microsoft QuickBASIC, which does not support
'  linking external procedures)
'
' To use these subroutines, merge them into your program.
' 
' Before running QBASIC, load the BASIC488.EXE program into memory,
' just as you would for interpreted BASICA or GWBASIC.
'

FUNCTION IEEEINIT% STATIC
   SHARED IEEESEG AS INTEGER
   DEF SEG=0
   IEEESEG=PEEK(&H182)+256*PEEK(&H183)
   DEF SEG=IEEESEG
   IEEEINIT=IEEESEG
END FUNCTION

SUB INITIALIZE ( Addr AS INTEGER,  Level AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IEEESEG=IEEEINIT%
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Addr,Level,0%)
END SUB

SUB SEND ( Addr AS INTEGER, S AS STRING, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Addr,S,Status,36%)
END SUB

SUB ENTER ( R AS STRING, L AS INTEGER, Addr AS INTEGER, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (R,L,Addr,Status,39%) 
END SUB

SUB TRANSMIT ( Cmd AS STRING, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Cmd,Status,30%)
END SUB

SUB RECEIVE ( R AS STRING, L AS INTEGER, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (R,L,Status,33%)
END SUB

SUB SPOLL ( Addr AS INTEGER, Poll AS INTEGER, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Addr,Poll,Status,12%)
END SUB

SUB PPOLL (Poll AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Poll,15%)
END SUB

SUB TARRAY ( D AS INTEGER, Count AS INTEGER, EOI AS INTEGER, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   S%=0:O%=0
   S%=VARSEG(D) : O%=VARPTR(D)
   CALL ABSOLUTE (S,O,Count,EOI,Status,200%)
END SUB

SUB RARRAY ( D AS INTEGER, Count AS INTEGER, L AS INTEGER, Status AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   S%=0:O%=0
   S%=VARSEG(D) : O%=VARPTR(D)
   CALL ABSOLUTE (S,O,Count,L,Status,203%)
END SUB

FUNCTION SRQ% STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (S%,63%)
   SRQ%=S%
END FUNCTION

SUB SETPORT (Bd AS INTEGER, Port AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IEEESEG=IEEEINIT%
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Bd,Port,57%)
END SUB

SUB BOARDSELECT (Bd AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Bd,60%) 
END SUB

SUB DMACHANNEL (C AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (C,45%)
END SUB

SUB SETTIMEOUT (T AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (T,48%)
END SUB

SUB SETOUTPUTEOS (E1 AS INTEGER, E2 AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (E1,E2,54%)
END SUB

SUB SETINPUTEOS (E AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (E,51%)
END SUB

FUNCTION LISTENER.PRESENT% (Addr AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (Addr,Present%,84%)
   LISTENER.PRESENT%=Present%
END FUNCTION

FUNCTION BOARD.PRESENT% STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (BP%,87%)
   BOARD.PRESENT%=BP%
END FUNCTION  

SUB ENABLE.488EX (E AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (E,90%)
END SUB

SUB ENABLE.488SD (E AS INTEGER, T AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (E,T,93%)
END SUB

FUNCTION GPIBFEATURE% (F AS INTEGER) STATIC
   SHARED IEEESEG AS INTEGER
   IF IEEESEG=0 THEN EXIT SUB
   DEF SEG=IEEESEG
   CALL ABSOLUTE (F,R%,96%)
   GPIBFEATURE% = R%
END SUB

const   IEEEListener = 0,   IEEE488SD = 1,   IEEEDMA = 2,   IEEEIOBASE = 100,   IEEETIMEOUT = 200,   IEEEINPUTEOS = 201,   IEEEOUTPUTEOS1 = 202,   IEEEOUTPUTEOS2 = 203,   IEEEBOARDSELECT = 204,   IEEEDMACHANNEL = 205