with UATL_DATA_TYPES; use UATL_DATA_TYPES; with INTERFACE_DATA_TYPES_488; use INTERFACE_DATA_TYPES_488; with SYSTEM; use SYSTEM; package PC_HW_488 is -- GPIB Commands UNL : constant DATA_BYTE := 16#3f# ;-- GPIB unlisten command UNT : constant DATA_BYTE := 16#5f# ;-- GPIB untalk command GTL : constant DATA_BYTE := 16#01# ;-- GPIB go to local SDC : constant DATA_BYTE := 16#04# ;-- GPIB selected device clear PPC : constant DATA_BYTE := 16#05# ;-- GPIB parallel poll configure GET : constant DATA_BYTE := 16#08# ;-- GPIB group execute trigger TCT : constant DATA_BYTE := 16#09# ;-- GPIB take control LLO : constant DATA_BYTE := 16#11# ;-- GPIB local lock out DCL : constant DATA_BYTE := 16#14# ;-- GPIB device clear PPU : constant DATA_BYTE := 16#15# ;-- GPIB parallel poll unconfigure SPE : constant DATA_BYTE := 16#18# ;-- GPIB serial poll enable SPD : constant DATA_BYTE := 16#19# ;-- GPIB serial poll disable PPE : constant DATA_BYTE := 16#60# ;-- GPIB parallel poll enable PPD : constant DATA_BYTE := 16#70# ;-- GPIB parallel poll disable -- Error messages returned in global variable IBERR (STATUS.ERROR) EDVR : constant INTEGER_16 := 0 ;-- DOS error ECIC : constant INTEGER_16 := 1 ;-- Function requires GPIB board -- to be CIC ENOL : constant INTEGER_16 := 2 ;-- Write function detected no Listeners EADR : constant INTEGER_16 := 3 ;-- Interface board not -- addressed correctly EARG : constant INTEGER_16 := 4 ;-- Invalid argument to function call ESAC : constant INTEGER_16 := 5 ;-- Function requires GPIB board to -- be SAC EABO : constant INTEGER_16 := 6 ;-- I/O operation was aborted ENEB : constant INTEGER_16 := 7 ;-- Non-existent interface board EOIP : constant INTEGER_16 := 10 ;-- I/O operation started before -- previous operation completed ECAP : constant INTEGER_16 := 11 ;-- No capability for intended -- operation EFSO : constant INTEGER_16 := 12 ;-- File system operation error EBUS : constant INTEGER_16 := 14 ;-- Command error during device call ESTB : constant INTEGER_16 := 15 ;-- Serial poll status byte lost ESRQ : constant INTEGER_16 := 16 ;-- SRQ remains asserted LF_TERM : constant INTEGER_16 := 16#040A#; EOI_TERM : constant INTEGER_16 := 16#040A#; subtype ERROR_MESSAGE_TYPE is string(1..57); type ERROR_MESSAGE_ARRAY is array(INTEGER_16 range 0..16) of ERROR_MESSAGE_TYPE; ERROR_MESSAGE : constant ERROR_MESSAGE_ARRAY := ("DOS error ", -- 0 "Function requires GPIB board to be CIC ", -- 1 "Write function detected no Listeners ", -- 2 "Interface board not addressed correctly ", -- 3 "Invalid argument to function call ", -- 4 "Function requires GPIB board to be SAC ", -- 5 "I/O operation was aborted ", -- 6 "Non-existent interface board ", -- 7 " ", -- 8 " ", -- 9 "I/O operation started before previous operation completed", -- 10 "No capability for intended operation ", -- 11 "File system operation error ", -- 12 " ", -- 13 "Command error during device call ", -- 14 "Serial poll status byte lost ", -- 15 "SRQ remains asserted ");-- 16 -- ; Timeout values and meanings type TIMEOUT_TYPE is (TNONE, -- equ 0 ; Infinite timeout (disabled) T10us, -- equ 1 ; Timeout of 10 us (ideal) T30us, -- equ 2 ; Timeout of 30 us (ideal) T100us, -- equ 3 ; Timeout of 100 us (ideal) T300us, -- equ 4 ; Timeout of 300 us (ideal) T1ms, -- equ 5 ; Timeout of 1 ms (ideal) T3ms, -- equ 6 ; Timeout of 3 ms (ideal) T10ms, -- equ 7 ; Timeout of 10 ms (ideal) T30ms, -- equ 8 ; Timeout of 30 ms (ideal) T100ms, -- equ 9 ; Timeout of 100 ms (ideal) T300ms, -- equ 10 ; Timeout of 300 ms (ideal) T1s, -- equ 11 ; Timeout of 1 s (ideal) T3s, -- equ 12 ; Timeout of 3 s (ideal) T10s, -- equ 13 ; Timeout of 10 s (ideal) T30s, -- equ 14 ; Timeout of 30 s (ideal) T100s, -- equ 15 ; Timeout of 100 s (ideal) T300s, -- equ 16 ; Timeout of 300 s (ideal) T1000s); -- equ 17 ; Timeout of 1000 s (maximum) -- Miscellaneous S : constant DATA_BYTE := 16#8# ;-- Parallel poll sense bit LNFD : constant DATA_BYTE := 16#0A# ;-- ASCII linefeed character --- type STATUS_BIT IS (DCAS, DTAS, LACS, TACS, -- ATN, CIC, REMOTE, LOK, -- CMPL, FILL1, FILL2, RQS, -- SRQI, THEEND, TIMO, ERR); DCAS : constant := 2**0; LACS : constant := 2**2; TACS : constant := 2**3; ATN : constant := 2**4; SRQI : constant := 2**13; subtype STATUS_REGISTER_TYPE is INTEGER_16; type PC_STATUS_TYPE is record HW_STATUS : STATUS_REGISTER_TYPE; ERROR : INTEGER_16; COUNT : INTEGER_16; end record; --for PC_STATUS_TYPE use -- record -- HW_STATUS at word*0 range 00..15; -- ERROR at word*1 range 00..15; -- COUNT at word*2 range 00..15; -- end record; -- pragma PACK(PC_STATUS_TYPE); function STATUS_BIT_SET ( STATUS : in PC_STATUS_TYPE; BIT : in INTEGER) return BOOLEAN; -- type STATUS_REGISTER_TYPE is array(STATUS_BIT) of boolean; -- pragma PACK(STATUS_REGISTER_TYPE); PC_RETURN_STATUS : PC_STATUS_TYPE; -- SERVICE_MASK : STATUS_REGISTER_TYPE := (others => false); OLD_SRQI : BOOLEAN := FALSE; -- OLD_DCAS : BOOLEAN := FALSE; OLD_TACS : BOOLEAN := FALSE; OLD_LACS : BOOLEAN := FALSE; procedure INIT_IT(STATUS : in SYSTEM.ADDRESS; BOARD : in INTEGER_16; DEVICE_ID : in ID_TYPE); pragma INTERFACE(assembler, INIT_IT); pragma INTERFACE_NAME(INIT_IT, "BINIT"); procedure SEND_INTERFACE_CLEAR(STATUS : in SYSTEM.ADDRESS); pragma INTERFACE(assembler, SEND_INTERFACE_CLEAR); pragma INTERFACE_NAME(SEND_INTERFACE_CLEAR,"CLRDV"); procedure SEND_IT(STATUS : in SYSTEM.ADDRESS; MESSAGE : in SYSTEM.ADDRESS; LENGTH : in DATA_BYTE_COUNT_TYPE); pragma INTERFACE(assembler, SEND_IT); pragma INTERFACE_NAME(SEND_IT, "SEND"); procedure COMMAND(STATUS : in SYSTEM.ADDRESS; MESSAGE : in SYSTEM.ADDRESS; LENGTH : in DATA_BYTE_COUNT_TYPE); pragma INTERFACE(assembler, COMMAND); pragma INTERFACE_NAME(COMMAND, "CMMD"); procedure CONDUCT_PARALLEL_POLL(STATUS : in SYSTEM.ADDRESS; RESULTS : out DATA_BYTE); pragma INTERFACE(assembler, CONDUCT_PARALLEL_POLL); pragma INTERFACE_NAME(CONDUCT_PARALLEL_POLL, "PPOLL"); procedure LOAD_PP_REGISTER(STATUS : in SYSTEM.ADDRESS; RESPONSE : in BOOLEAN); pragma INTERFACE(assembler, LOAD_PP_REGISTER); pragma INTERFACE_NAME(LOAD_PP_REGISTER, "LPOLL"); procedure RECEIVE_FROM_BUS(STATUS : in SYSTEM.ADDRESS; RECEIVE_BUFFER : in SYSTEM.ADDRESS; COUNT : in DATA_BYTE_COUNT_TYPE; TERMINATION : in INTEGER_16); pragma INTERFACE(assembler, RECEIVE_FROM_BUS); pragma INTERFACE_NAME(RECEIVE_FROM_BUS, "RECV"); procedure SET_TIMEOUT(STATUS : in SYSTEM.ADDRESS; TIME : in TIMEOUT_TYPE); pragma INTERFACE(assembler, SET_TIMEOUT); pragma INTERFACE_NAME(SET_TIMEOUT, "TIMOUT"); procedure CONDUCT_SERIAL_POLL(STATUS : in SYSTEM.ADDRESS; RESULTS : out DATA_BYTE; DEVICE_ID : in DATA_BYTE); pragma INTERFACE(assembler, CONDUCT_SERIAL_POLL); pragma INTERFACE_NAME(CONDUCT_SERIAL_POLL, "SPOLL"); procedure WAIT_FOR_EVENT(STATUS : in SYSTEM.ADDRESS; EVENT : in INTEGER_16); pragma INTERFACE(assembler, WAIT_FOR_EVENT); pragma INTERFACE_NAME(WAIT_FOR_EVENT, "WEVENT"); procedure SET_REMOTE_LINE(STATUS : in SYSTEM.ADDRESS; SETTING : in INTEGER_16); pragma INTERFACE(assembler, SET_REMOTE_LINE); pragma INTERFACE_NAME(SET_REMOTE_LINE, "REMO"); procedure SERVICE_REQUEST(STATUS : in SYSTEM.ADDRESS; THE_REQUEST : in INTEGER_16); pragma INTERFACE(assembler, SERVICE_REQUEST); pragma INTERFACE_NAME(SERVICE_REQUEST, "SERVIS"); procedure GO_TO_STANDBY(STATUS : in SYSTEM.ADDRESS; DO_SHADOW_HANDSHAKE : in INTEGER_16); pragma INTERFACE(assembler, GO_TO_STANDBY); pragma INTERFACE_NAME(GO_TO_STANDBY, "STANDB"); end PC_HW_488; PACKAGE BODY PC_HW_488 IS function STATUS_BIT_SET (STATUS : in PC_STATUS_TYPE; BIT : in INTEGER) return BOOLEAN is begin if (STATUS.HW_STATUS / BIT) rem 2 = 1 then return TRUE; else return FALSE; end if; end STATUS_BIT_SET; end PC_HW_488;