IMD 1.17: 14/03/2012 8:30:39 HPIB: B3466A DS 3.5"  €HPIB    p @PLLEL_ASMTéK “T%€ŠPLLELT____éKU“UD€T3IOLIBT____éKtŚ“WS€‹cMAKE_HPIBTéK“!€ˇDISCINTT__éK“Y@€ÁyDMA_DRVT__éKČ4“YV€3ÁGPIOT_____éKüˇ“7€ [G_DRVT____éKť7“T€6NH_DRVT____éKÔ8“€7YCOMASMT___éK ‹“H€ŠuDI_DRVT___éK—3“€2wHPIBT_____éKʤ“A€ŁůGPIODVRT__éKn6“Y€5,DRVASMT___éK¤ “€ ŮDISCHPIBT_éKŻG“(€FŠCOMDCLT___éKö “@€žREADMET___“ XV€}READMET___éK“ W€¸ ˙˙@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ MNAME PLLEL_ASM SRC MODULE PLLEL_ASM; SRC IMPORT IODECLARATIONS; SRC EXPORT SRC TYPE SRC TIMER_REC = RECORD SRC TIME : INTEGER; SRC FLAG : IO_WORD; SRC END; SRC SRC  PROCEDURE START_TIMER(VAR TIME : TIMER_REC); SRC FUNCTION TIME_EXPIRED(VAR TIME : TIMER_REC):BOOLEAN; SRC PROCEDURE ABORT_IO; SRC PROCEDURE STBSY; SRC PROCEDURE STCLR; SRC FUNCTION GETDMA:INTEGER; {returns dma channel (0,1) being used} SRC FUNCTION DROPDMA:INTEGER; {returns dma final count+1; 0, not -1, means normal completion} SRC SRC END; { PLLEL_ASM } DEF PLLEL_ASM_PLLEL_ASM DEF PLLEL_ASM_START_TIMER DEF PLLEL_ASM_TIME_EXPIRED DEF PLLEL_ASM_ABORT_IO DEF PLLEL_ASM_STBSY DEF PLLEL_ASM_STCLR DEF PLLEL_ASM_GETDMA DEF PLLEL_ASM_DROPDMA * include IOLIB:COMDCL include COMDCL ************************************************************************* * START_TIMER   timing setup * * ASSUMES: * - sp+4 points to location of a timer record * the TIME field is a delay in milliseconds * RETURNS: * - The TIME field contains a value to match against the timer * (no timer present then this field is a scaled count) ************************************************************************* REFA CHECK_TIMER in system POWERUP code LMODE CHECK_TIMER PLLEL_ASM_START_TIMER equ * movea.l 4(sp),a0 get addr of timer rec btst #timer_present,sysflag2 bne.s soft_start st 4(a0) set the first time flag jmp CHECK_TIMER soft_start equ * * scale the time out value for use as a counter move.l (a0),d0 lsl.l #4,d0 x 16 move.l d0,(a0)  move.l (sp)+,(sp) move the return address rts ************************************************************************* * FUNCTION TIME_EXPIRED(VAR TIME: INTEGER):BOOLEAN; * ASSUMES: * - sp+4 points to a timer record (set up by start_timer) ************************************************************************* PLLEL_ASM_TIME_EXPIRED EQU * clr.b 8(sp) clear the function value btst #timer_present,sysflag2 bne.s soft_check move.l 4(sp),-(sp) copy the timer rec address jsr CHECK_TIMER bpl.s timex1 timex0 move.b #1,8(sp) timex1 move.l (sp)+,(sp) move the return address rts soft_check equ * movea.l 4(sp),a0 subq.l #1,(a0) bpl timex1 bra timex0 ************************************************************************* * pascal wrapper routines for the iocomasm driver routines that have * assembly only interfaces. ************************************************************************* refa pllel_util refa abort_io refa stbsy  refa stclr refa itxfr refa getdma refa dma_stbsy refa dropdma lmode pllel_util lmode abort_io lmode stbsy lmode stclr lmode itxfr lmode getdma lmode dma_stbsy lmode dropdma gettmp equ * movea.l pllel_util-4(a5),a2 rts ************************************************************************* * PROCEDURE ABORT_IO ************************************************************************* PLLEL_ASM_ABORT_IO equ * bsr gettmp jsr abort_io rts ************************************************************************* * PROCEDURE STBSY ************************************************************************* PLLEL_ASM_STBSY equ * bsr gettmp jsr itxfr move.l d3,d0 jsr stbsy rts ************************************************************************* * PROCEDURE STCLR ************************************************************************* PLLEL_ASM_STCLR equ * bsr gettmp jsr stclr rts ************************************************************************* * FUNCTION GETDMA:INTEGER * o acquires DMA channel * o set up DMA address * o set up DMA count * o set up DMA arm word for priority and ARMS! * o returns the channel, either 0 or 1. ************************************************************************* PLLEL_ASM_GETDMA equ * bsr gettmp jsr itxfr move.l d3,d0 movea.l c_adr(a2),a1 jsr getdma addq.w #8,d2 ;dma priority move.w d2,(a4) ;arm DMA channel sub #$81,d3 moveq #0,d0 move.b d3,d0 move.l d0,4(sp) ;return channel # rts ************************************************************************* * PROCEDURE DROPDMA ************************************************************************* PLLEL_ASM_DROPDMA equ * bsr gettmp jsr DROPDMA move.l d4,4(sp) rts * * module initialization * PLLEL_ASM_PLLEL_ASM EQU * RTS end {system options} $modcal on$ $allow_packed on$ $partial_eval on$ {code generation options} $debug off$ $linenum 10000$ $iocheck off$ $ovflcheck off$ $range off$ $stackcheck off$ {listing options} $lines 57$ $pagewidth 130$ $tables off$ $copyright 'Hewlet t Packard Company, 1989'$ program pllel_start{{(input, output){for debug}; {local search{} $search { 'KERNEL.CODE', 'IOLIB.CODE', } 'PLLEL_ASM.CODE'$ {system search{{ $search 'IOLIB:KERNEL', 'IOLIB:IOLIB', 'IOLIB:PLLEL_ASM', 'IOLIB:COMASM'$ {} $page$ module pllel_util; {------------------------------------------------------------------------------} {------------------ parallel driver utilities ------------------} {------------------------------------------------------------------------------} { This module contains types, constants, procedures and functions necessary to perform low level I/O on the parallel hardware. These routines are intended to be invoked as necessary by routines in a higher level module which have need of this functionality. The ordering of the procedures and functions within this module imply a hierarchy. The first routines encountered are the lowest level routines. The following routines can make use of them. Generally, routines cannot invoke routines which are higher than them in the hierarchy. Higher level modules will generally invoke the routines that are highest in the hierarchy of this module. The highest level routines generally conduct a O/S described transfer, thus they make use of the current buffer pointer and other system variables. There are a set of pointers, refered to herein has my ptrs, which are  assumed to be valid by the majority of routines within this module. These pointers are made valid by calling set_my_ptrs. Thus, users of this module should call set_my_ptrs before calling any other routine within this module. These pointers uniquely define the hardware and user options required of the caller. A set of assembler routines found in PLLEL_ASM are invoked by this module. These routines form a high level interface to the PWS I/O common assembly routines (IOCOMASM). } import sysglobals, iodeclarations, iocomasm, asm, parallel_3, pllel_asm; export type ptr_misc_block = ^misc_block; misc_block = record peripheral_type: io_byte;  peripheral_reset: io_byte; options: driver_options_type; options_reset: driver_options_type; state: driver_state_type;  d_isr_ie: driver_int_state_type; d_int_e: boolean; u_isr_ie: user_isr_status_type; u_isr_status: user_isr_status_type; last_read_nack: boolean; time_rec: timer_rec; my_int_level: io_byte; end; type reg_type = (rw_whole, readbits, writebits); sysreg_type = packed record byte0: char; case reg_type of rw_whole: (bl: char); readbits: (cardid: char); writebits:(softreset: char); end; intdma_type = packed record byte2: char; case reg_type of  rw_whole: (bl: char); readbits:(int_e_set: boolean; int_r_set: boolean; int_lvl: 0..3;  iomod_set: boolean; io_set: boolean; dma_e1_set: boolean; dma_e0_set: boolean);   writebits:(int_e: boolean; pad: 0..7; iomod: boolean; io: boolean;  dma_e1: boolean; dma_e0: boolean); end; comm_per_type = packed record byte4: char;  case reg_type of rw_whole: (bl: char); readbits: (c_fifofull: boolean; c_fifoempty: boolean;  c_nstrobe_low:boolean; c_busy_high: boolean; c_nack_low: boolean; p_nerror_low: boolean;  p_select_high:boolean; p_perror_high:boolean); writebits:(do_not_write:char); end; phy_hostline_type = packed record byte6: char; case reg_type of rw_whole: (bl: char); readbits: (pad: 0..hex('1f'); ninit_low: boolean; nselectin_low:boolean; wr_nrd_high: boolean); writebits:(do_not_write:char); end; int_state_type = packed record byte8: char; case reg_type of rw_whole: (bl: char); readbits: (fifo_full: boolean;  fifo_empty: boolean; pad: boolean; busy_low: boolean; nack_low_trans:boolean;  nerror_trans: boolean; select_trans: boolean; pe_trans: boolean); {writebits are same as readbits}  end; fifo_type = packed record byte10: char; case reg_type of rw_whole: (bl: char); readbits: (fifoin: char); writebits:(fifoout: char); end; ptr_parallel_hw_type = ^parallel_hw_type; parallel_hw_type = packed record sysreg: sysreg_type; intdma: intdma_type; comm_per: comm_per_type; hostline: phy_hostline_type; int_state: int_state_type; fifo: fifo_type; end; type ptr_char_type = ^char; ptr_buf_info_type = ^buf_info_type; const delay_ms = 1; delay_second = 1000; USE_SMALL_FIFO = TRUE; USE_LARGE_FIFO = FALSE;  XMITTED_MASK = hex('60'); {for write_verify} LAST_BYTE_XMITTED = hex('40'); {for write_verify} var { Usage info for these pointers. The PLLEL_DRIVE module entry point routines should call set_my_ptrs prior to calling any routines within the PLLEL_UTILS module. The PLLEL_UTILS routines assume that these pointers are valid. NOTE: Assembly routines access my_tmp_ptr, so it CAN NOT be moved!!!!! } my_tmp_ptr:   pio_tmp_ptr; my_misc_ptr: ptr_misc_block; my_hw_ptr: ptr_parallel_hw_type; procedure delay(time:integer); procedure set_my_ptrs(tmp_ptr:pio_tmp_ptr); procedure dvr_error(io_error_code:integer); procedure set_int; procedure reset_peripheral; procedure peripheral_check; procedure set_peripheral_type; procedure set_wr_nrd_low; procedure set_bus_out; procedure set_bus_in(set_iomod:boolean); procedure fhs_out(buf:ptr_char_type; var count:integer); procedure fhs_in(buf:ptr_char_type; var count:integer; exit_on_nack:boolean); procedure do_fhs_tfr(ptr_buf:ptr_buf_info_type); function dma_available:boolean; function get_buf_ptr:ptr_buf_info_type; procedure dma_int_handler(temp:ANYPTR); procedure dma_start(bcb:ANYPTR); procedure ovl_int_out_start; procedure ovl_int_in_start; procedure do_ovl_int_fifo_empty; procedure do_ovl_int_fifo_full; implement {********************************************************* * procedure name: * delay(time:integer) * time is in units of milliseconds * * input dependencies: * none. * * functional description: * delay time. * * output environement: * the requested amount of time has passed. * *********************************************************} procedure delay(time:integer); var tr:timer_rec; begin tr.time := time; start_timer(tr); repeat until time_expired(tr); end; {********************************************************* * procedure name: * set_my_ptrs(tmp_ptr:pio_tmp_ptr); * tmp_ptr points to the i/o temp * block for this select code. * * input dependencies: * none. *  * functional description: * set up the parallel drivers global pointers. * affectionatly called my ptrs. * * output environement: * parallel driver pointers (my ptrs) are valid. * *********************************************************} procedure set_my_ptrs(tmp_ptr:pio_tmp_ptr); begin if tmp_ptr <> NIL then with tmp_ptr^ do begin if (card_addr = NIL) or (isc_table[my_isc].card_type <> pllel_card) then  io_escape(ioe_no_card, my_isc); my_tmp_ptr := tmp_ptr; my_misc_ptr := addr(drv_misc[1]); my_hw_ptr := card_addr; end else io_escape(ioe_no_card, 0); end; {********************************************************* * procedure name: * dvr_error(io_error_code:integer); * io_error_code is defined in IODECLARATIONS. * * input dependencies: * my ptrs are valid. *  driver is in an error state. * * functional description: * set driver state, turn off all interrupts, * terminate any existing transfers, and * execute a system escape. * * output environement: * *********************************************************} procedure dvr_error(io_error_code:integer); begin with my_misc_ptr^do begin if state.bl <> DISABLED_BY_USER then state.bl := INACTIVE_ERROR;  d_isr_ie.bl := 0; d_int_e := false; set_int; end; abort_io; io_escape(io_error_code, my_tmp_ptr^.my_isc); end; {********************************************************* * procedure name: * set_int; * * input dependencies: * my ptrs are valid. * desired driver and user interrupts have been * set up in the misc block. * if true interrupt is desired, this has also *   been so indicated. * * functional description: * reset all existing interrupt latches. * merge both the driver and user interrupt * requests into one, and store in h/w register. * if true interrupt is desired, enable interrupts. * * output environement: * hardware is set up for desired interrupts. * *********************************************************} procedure set_int; begin with my_hw_ptr^, my_misc_ptr^ do begin int_state.bl := #0; {reset latches} int_state.bl := chr(binior(d_isr_ie.bl, u_isr_ie.bl)); if u_isr_ie.bl <> 0 then intdma.int_e := true else  intdma.int_e := d_int_e; end; end; {********************************************************* * procedure name: * reset_peripheral; * * input dependencies: * my_ptrs are set up. * NOTE: it is not assumed that a peripheral is present, * nor is any attempt made to determine such. * * functional description: * set state to INACTIVE_ERROR and peripheral_type to * NOT_PRESENT. This will force the driver to exactly * determine peripheral_type and bus state on next * transfer request. * follow reset specifications: * set wr/nrd high. * float nStrobe and Data lines. * release Busy. * set nInit low - reset the peripheral. * wait for busy high or 25ms. * reset nInit line. * wait for busy low. * * output environement: * peripheral has been reset, and has correctly * responded. if user timing is in place and * peripheral does not respond to reset, then * escaped (dvr_error). * *********************************************************} procedure reset_peripheral; var use_timer:boolean; begin with my_hw_ptr^, my_misc_ptr^, my_tmp_ptr^ do begin if peripheral_type < USER_SPEC_NO_DEVICE then peripheral_type := NOT_PRESENT; if state.bl <> DISABLED_BY_USER then state.bl := INACTIVE_ERROR; { set host lines in prep for peripheral reset. } hostline.wr_nrd_high := true; intdma.iomod := true; intdma.io := false; hostline.nselectin_low := true; { reset peripheral, and wait for busy to go high. } hostline.ninit_low := true; delay(delay_ms); {wait for everything to settle} time_rec.time := 50*delay_ms; {spec says 25} start_timer(time_rec); repeat until comm_per.c_busy_high or time_expired(time_rec); hostline.ninit_low := false; { wait for busy to go low. } use_timer := timeout <> 0; if use_timer then begin time_rec.time := timeout; start_timer(time_rec); end;  repeat { if busy never goes low, then device is in a bad state. } if (use_timer) and (time_expired(time_rec)) then dvr_error(ioe_timeout); until not comm_per.c_busy_high; end; end; {********************************************************* * procedure name: * peripheral_check; * * input dependencies: * my_ptrs are valid. * device type may/may not be known. * * functional description: * check that the peripheral is not in an * error state by checking the select, nerror, * and perror lines. * if  driver has been told to ignore the perror * line, then do so. * * output environement: * device is present and ready to talk. * if device not present and user timing in place * and user timeout expired, then set peripheral_type * is set to NOT_PRESENT and escaped (dvr_error) * *********************************************************} procedure peripheral_check; var mask:integer; use_timer: boolean; begin with my_hw_ptr^, my_misc_ptr^ do begin if options.ignore_pe then mask := hex('6') {select, and nerror} else mask := hex('7'); {select, nerror, and perror}  if (binand(ord(comm_per.bl), mask) <> PLLEL_PERIPHERAL_ONLINE) then with my_tmp_ptr^ do begin use_timer := timeout <> 0; if use_timer then begin  time_rec.time := timeout; start_timer(time_rec); end; repeat until (binand(ord(comm_per.bl), mask) =  PLLEL_PERIPHERAL_ONLINE) or (use_timer and time_expired(time_rec)); if (use_timer) and (time_expired(time_rec)) then begin if peripheral_type < USER_SPEC_NO_DEVICE then begin if (peripheral_type <> HP_BIDIRECTIONAL) or (binand(ord(comm_per.bl), 7) <> 3) then  peripheral_type := NOT_PRESENT; end; dvr_error(ioe_timeout); end; end; end; end; {********************************************************* * procedure name: * set_peripheral_type; * * input dependencies: * my ptrs active. * peripheral_type is assumed to be NOT_PRESENT. * * do not call this routine if the peripheral * type is known - as for output only peripherals * this routine will take 2 seconds. * * do not call this routine if peripheral_type * is set by user (>= USER_SPEC_NO_DEVICE) as this * routine will override user specification. * * functional description: * check if peripheral is online. * if it is, then follow spec to determine if * peripheral is bidirectional or not: * reset peripheral * set Wr/nRd to read, but do not take * over busy line. * if device bidirectional, it will * give up Busy line, and since no one * owns it, it will float high. * since bus is no longer in a known state set current * state to INACTIVE_ERROR, which always forces * the driver to set bus state to desired state. * * output environement: * peripheral_type is set. * state.bl is INACTIVE_ERROR; * *********************************************************} procedure set_peripheral_type; var type_found:boolean; i:integer; begin  with my_hw_ptr^, my_misc_ptr^, my_tmp_ptr^ do begin type_found := false; i := ord(comm_per.bl); if binand(i, hex('1f')) = hex('13') then {device not physically there} begin  type_found := true; peripheral_type := NOT_PRESENT; end else begin { device is there, see if it is online.   } try peripheral_check; recover begin if escapecode = ioescapecode then begin { peripheral is in bad state, type has been set to NOT_PRESENT. }  type_found := true; end else escape(escapecode); end; end; {  now know that a device is there, what type? } if not type_found then begin if options.wr_nrd_low then peripheral_type := OUTPUT_ONLY  else begin { check for bidirectional device } reset_peripheral;  intdma.io := false; {output, give up busy line} hostline.wr_nrd_high := false; {tell device input} {spec max for peripheral to give up busy is 2 seconds}  time_rec.time := 2 * delay_second; start_timer(time_rec); repeat until (comm_per.c_busy_high) or time_expired(time_rec); if (comm_per.c_busy_high) then  peripheral_type := HP_BIDIRECTIONAL else peripheral_type := OUTPUT_ONLY; if peripheral_type = HP_BIDIRECTIONAL then  begin d_isr_ie.nack_low_trans := true; set_int; hostline.wr_nrd_high := true;  repeat until int_state.nack_low_trans; d_isr_ie.nack_low_trans := false; set_int; delay(delay_ms); {let everything settle}  end else hostline.wr_nrd_high := true; end; end; state.bl := INACTIVE_ERROR; end; end; {********************************************************* * procedure name: * set_wr_nrd_low; * * input dependencies: * my ptrs are valid. * user has set driver option to maintain * wr_nrd_low at all times. By definition, * this forces peripheral_type to OUTPUT_ONLY * or NOT_PRESENT. * * functional description: * reset Wr/nRd. If peripheral_type is set to * bidirectional device, set it to OUTPUT_ONLY. * * output environement: * Wr/nRd is low. peripheral_type is legal. * *********************************************************} procedure set_wr_nrd_low; begin with my_hw_ptr^, my_misc_ptr^ do begin hostline.wr_nrd_high := false; if peripheral_type in INPUT_SET then peripheral_type := OUTPUT_ONLY; end; end; {********************************************************* * procedure name: * set_bus_out; * * input dependencies: * my ptrs are active. peripheral_type may or * may not be known. * * functional description: * if peripheral type is not known, then determine *   its type. * if peripheral can talk output, then set bus to * output state and set state to INACTIVE_WRITE. * * output environement: * bus in output state, peripheral is in a known * state and driver state is INACTIVE_WRITE. * OR ELSE, driver error. * *********************************************************} procedure set_bus_out; begin with my_misc_ptr^ do begin if (peripheral_type = NOT_PRESENT) then set_peripheral_type; if (peripheral_type in OUTPUT_SET) then with my_hw_ptr^ do begin if not state.write then begin  d_isr_ie.nack_low_trans := false; set_int; intdma.iomod := (not options.use_nack); intdma.io := false; hostline.wr_nrd_high := (not options.wr_nrd_low); state.bl := INACTIVE_WRITE; end; end else if peripheral_type < USER_SPEC_NO_DEVICE then dvr_error(ioe_timeout) else dvr_error(ioe_misc); end; end; {********************************************************* * procedure name: * set_bus_in(set_iomod:boolean); * * input dependencies: *  my ptrs are active. peripheral_type may or * may not be known. if set_iomod is true, * caller wants small fifo, large fifo otherwise. * * functional description: * if peripheral type is not known, then determine * its type. * if peripheral can talk input, then wait for * fifo to emtpy out (from last write) and set bus to * output state and set state to INACTIVE_READ. * * output environement:  * bus in input state, peripheral is in a known * state and driver state is INACTIVE_READ. * OR ELSE, driver error. * *********************************************************} procedure set_bus_in(set_iomod:boolean); var use_timer:boolean; begin with my_misc_ptr^ do begin if (peripheral_type = NOT_PRESENT) then set_peripheral_type; if (peripheral_type in INPUT_SET) then  with my_hw_ptr^, my_tmp_ptr^ do begin if not state.read then begin { if h/w is in an output state:  wait for last byte transmited wait for not busy (thus nack on last byte is seen) } if (not intdma.io) then begin use_timer := timeout <> 0; if use_timer then begin time_rec.time := timeout;  start_timer(time_rec); end; repeat if (use_timer) and (time_expired(time_rec)) then  dvr_error(ioe_timeout); until (binand(ord(comm_per.bl),XMITTED_MASK) = LAST_BYTE_XMITTED); repeat  if (use_timer) and (time_expired(time_rec)) then dvr_error(ioe_timeout); until not comm_per.c_busy_high; end ; { used to always set iomod to 1, which forced FIFO to a size of 1. No longer true due to rewrite of fhs_in and dma_int_handler. } intdma.iomod := set_iomod; intdma.io := true; d_isr_ie.nack_low_trans := true; set_int; hostline.wr_nrd_high := false; state.bl := INACTIVE_READ; end; end else if peripheral_type < USER_SPEC_NO_DEVICE then  dvr_error(ioe_timeout) else dvr_error(ioe_misc); end; end; {********************************************************* * procedure name: * fhs_out(buf:ptr_char_type; var count:integer); * * input dependencies: * my ptrs are set up. * peripheral_type may or may not be known. * bus may or may not be in output phase. * peripheral may or may not be ready to talk. * * functional description: * make sure peripheral can talk output and set * bus to output phase. * programmatically transfer data to peripheral. * if driver option write_verify is on, then verify * data byte handshaked with peripheral. * * output environement: * peripheral_type is known and bus is in output state. * OR ELSE dvr_error. * *********************************************************} procedure fhs_out(buf:ptr_char_type; var count:integer); var use_timer:boolean; begin with my_hw_ptr^, my_misc_ptr^, my_tmp_ptr^ do begin { make sure device is not in an error state. make sure device can talk output, and set bus to output state. } peripheral_check; set_bus_out; state.bl := ACTIVE_WRITE; { set up some local variables to save a little bit of time. } use_timer := timeout <> 0; { do programmatic transfer. } while count > 0 do begin if (comm_per.c_fifofull) then begin { make sure peripheral hasn't seen an error. } peripheral_check;  { peripheral is o.k., wait for fifo to empty out. } if use_timer then begin  time_rec.time := timeout; start_timer(time_rec); end; repeat if (use_timer) and (time_expired(time_rec)) then dvr_error(ioe_timeout); until not comm_per.c_fifofull; end; fifo.fifoout := buf^; buf := addr(buf^, 1); count := count - 1; end; if options.write_verify then begin { wait for fifo empty and nStrobe not asserted.  } if use_timer then begin time_rec.time := timeout; start_timer(time_rec); end; repeat   if (use_timer) and (time_expired(time_rec)) then dvr_error(ioe_timeout); until (binand(ord(comm_per.bl), XMITTED_MASK) = LAST_BYTE_XMITTED); end  else { make sure device is still communicating. } peripheral_check; state.bl := INACTIVE_WRITE; end; end; {********************************************************* * procedure name: * wait_nack; * * input dependencies: * my ptrs are set up. * a nack transition interrupt has been enabled. * a inbound transfer has just occured, and * want to see if an nack will occur with this * byte. * * functional description: * wait for either something in FIFO (obviously * no nack on this byte) or an nack interrupt, or * an error. * * output environement: * if nack occured then last_read_nack (misc_ptr) * set to true. * *********************************************************} procedure wait_nack; var i:integer; begin with my_hw_ptr^ do begin if comm_per.c_fifoempty then begin repeat until (not comm_per.c_fifoempty) or (int_state.bl <> #0); if (int_state.nack_low_trans) then begin my_misc_ptr^.last_read_nack := true; set_int; {clear latches, reset interrupt} end; end; end; end; {********************************************************* * procedure name: * fhs_in(buf:ptr_char_type; var count:integer, * exit_on_nack:boolean); * * input dependencies: * my ptrs are set up. * peripheral_type may or may not be known. * bus may or may not be in input phase. * peripheral may or may not be ready to talk. * * functional description: * make sure peripheral can talk input and set *  bus to input phase. * programmatically transfer data from peripheral. * if exit_on_nack, then look for an nack occurence. * * output environement: * peripheral_type is known and bus is in input state. *  OR ELSE dvr_error. * *********************************************************} procedure fhs_in(buf:ptr_char_type; var count:integer; exit_on_nack:boolean); label 1; var use_timer:boolean; begin with my_hw_ptr^, my_misc_ptr^, my_tmp_ptr^ do begin { make sure device is not in an error state. make sure device can talk input, and set bus to input state. } peripheral_check;  set_bus_in(USE_LARGE_FIFO); state.bl := ACTIVE_READ; { set up some local variables to save a little bit of time. } use_timer := timeout <> 0; last_read_nack := false; { do programmatic transfer } while count > 0 do begin if (comm_per.c_fifoempty) then begin  peripheral_check; if use_timer then begin time_rec.time := timeout; start_timer(time_rec); end; repeat until (not comm_per.c_fifoempty) or (int_state.bl <> #0) or (use_timer  and time_expired(time_rec)); if comm_per.c_fifoempty then begin if (exit_on_nack) and (int_state.nack_low_trans) then  begin last_read_nack := true; goto 1; end else  dvr_error(ioe_timeout); end; end; buf^ := fifo.fifoin; buf := addr(buf^, 1); count := count - 1;  end; { if we are supposed to exit_on_nack, then there is a very good possibility that the nack will occur with the last byte read. Therefore, wait for one to possibly show up.  } if exit_on_nack then wait_nack; 1: state.bl := INACTIVE_READ; end; end; {********************************************************* * procedure name: *  do_fhs_tfr(ptr_buf:ptr_buf_info_type); * * input dependencies: * User has requested a programmatic transfer. * my ptrs are set up. * device may or may not be there (or ready). * device type may or may not even be known! * * functional description: * execute the desired transfer request. This * routine is responsible for updating the buffer * parameters (Standard I/O buffer). * If this is an output transfer, use fhs_out. * If this is an input trnasfer, use fhs_in. * * output environement: * If successful, transfer has completed as requested * and the buffer parameters have been updated. The * device type is known and the bus is in an output * state. * If not successful, then an escape has occured, bus * state is not known and the device type is not known. * *********************************************************} procedure do_fhs_tfr(ptr_buf:ptr_buf_info_type); var my_count: integer; lastchar: char; begin with ptr_buf^, my_misc_ptr^ do begin act_tfr := FHS_tfr;  my_count := term_count; if direction = FROM_MEMORY then begin fhs_out(buf_empty, term_count); buf_empty := addr(ptr_char_type(buf_empty)^, my_count - term_count);  end else {direction is TO_MEMORY} begin if term_char = -1 then {not a transfer_until} begin fhs_in(buf_fill, term_count, end_mode);  buf_fill := addr(ptr_char_type(buf_fill)^, my_count - term_count); end else {transfer_until} begin  repeat my_count := 1; fhs_in(buf_fill, my_count, end_mode); lastchar := ptr_char_type(buf_fill)^;  buf_fill := addr(ptr_char_type(buf_fill)^, 1); term_count := term_count - 1; until (term_count = 0) or (lastchar = chr(term_char)) or ((last_read_nack) and (end_mode)); end; end; {serial_FHS transfer has completed normally, clean up.} stclr; end; end; {**** ***************************************************** * procedure name: * FUNCTION dma_available:boolean; * * input dependencies: * none * * functional description: * determine if DMA hardware is available, if the * DMA driver is in memory, and if a DMA channel is * available for use (note that a DMA channel is not * acquired). * * output environement: * TRUE if dma h/w, s/w and channel is available, *  FALSE otherwise. * *********************************************************} function dma_available:boolean; begin dma_available := ( (dma_here) and ((dma_isc_0 = no_isc) or (dma_isc_1 = no_isc)) ); end; {********************************************************* * procedure name: * FUNCTION get_buf_ptr:ptr_buf_info_type * * input dependencies: * my ptrs are set up. * * functional description: * retrieve either the input or output buffer * pointer. Since only one can be active at a * time, only need to make one check. If niether * is active, then NIL will be returned. * * output environement: * returns either the current active buffer pointer * or NIL. * *********************************************************} function get_buf_ptr:ptr_buf_info_type; begin with my_tmp_ptr^ do  if in_bufptr <> NIL then get_buf_ptr := in_bufptr else get_buf_ptr := out_bufptr; end; {********************************************************* * procedure name: *  dma_int_handler(temp:ANYPTR) - temp is the * driver temp space. * * input dependencies: * received either a DMA complete interrupt or * an nack occured interrupt. * * functional description: *  turn off DMA, update buffer pointers with * transfer amount. Terminate transfer buffer, and * clean up hardware. * * output environement: * DMA and transfer hardware cleaned up and ready *  for next transfer. Transfer buffer updated and * terminated. * *********************************************************} procedure dma_int_handler(temp:ANYPTR); var ptr_buf:ptr_buf_info_type; diroutput:boolean; residual_count, amt_xfered:integer; begin set_my_ptrs(temp); with get_buf_ptr^, my_misc_ptr^, my_hw_ptr^ do begin intdma.dma_e0 := false; intdma.dma_e1 := false; residual_count := dropdma; amt_xfered := term_count - residual_count; if direction = FROM_MEMORY then begin buf_empty := addr(ptr_char_type(buf_empty)^, amt_xfered); {  wait for fifoempty } repeat until (comm_per.c_fifoempty) or (not comm_per.p_select_high); end else begin buf_fill := addr(ptr_char_type(buf_fill)^, amt_xfered); { if this is a transfer_end then wait for fifo not empty or an interrupt. } if end_mode then  wait_nack; end; term_count := residual_count; d_isr_ie.bl := 0; d_int_e := false; set_int; stclr; end; end; {********************************************************* * procedure name: * dma_start(bcb:ANYPTR) - bcb: Buffer Control block Pointer * * input dependencies: * my ptrs are set up. * User has made a valid request for ei ther an * inbound or outbound DMA transfer * bus state may or may not be known. * device type may or may not be known. * * functional description: * set up hardware and software for a DMA transfer * kick off the DMA transfer * * output environement: * If successful, then DMA transfer started, bus state * and device type known. * If not successful, then an escape has occured, bus *  state is not known and device type is not known. * *********************************************************} procedure dma_start(bcb:ANYPTR); var dma_channel:integer; loc_intdma:intdma_type; begin with my_misc_ptr^, ptr_buf_info_type(bcb)^, my_hw_ptr^ do begin { insure dma enable bits are off (a little bit of paranoia is good for the soul). } intdma.dma_e0 := false; intdma.dma_e1 := false; { make sure device can talk } peripheral_check; { set up the bus for the direction of the transfer, and set up request for driver interupts. } if direction = FROM_MEMORY then begin set_bus_out; state.bl := ACTIVE_WRITE; d_isr_ie.bl := hex('07');  end else begin set_bus_in(USE_LARGE_FIFO); state.bl := ACTIVE_READ; last_read_nack := false; if end_mode then  d_isr_ie.bl := hex('0f') else d_isr_ie.bl := hex('07'); end; if options.ignore_pe then d_isr_ie.pe_trans := false;  { get dma channel, set it up and arm it. } dma_channel := getdma; {this gets a dma channel, sets it up, and arms it} { haven't escaped yet so everthing is ready to communicate. turn on requested interrupts. Note that set_int should follow getdma. Don't want to escape with interrupts set! } d_int_e := true; set_int; { set up for DMA interrupt (based on channel received) and kick off the DMA transfer. h/w required fix. when doing inbound DMA, turn off i/o bit, then turn on I/O and DMA enable at the same time. for ease of implementation, use same algorithm for both inbound and outbound DMA. } loc_intdma.bl := intdma.bl; intdma.io := false; if dma_channel = 0 then begin dma_ch_0.real_proc := dma_int_handler; loc_intdma.dma_e0 := true; end else begin dma_ch_1.real_proc := dma_int_handler; loc_intdma.dma_e1 := true; end; intdma.bl := loc_intdma.bl; {this kicks off the DMA} end; end; {********************************************************* * procedure name: * ovl_int_out_start * * input dependencies: * my ptrs set up. * bus state may or may not be known, * device type may or may not be known. * * functional description: * start an ouput overlap interrupt transfer * sequence. * * output environement: * if successful, bus is in output state, * device type is known and overlap interrupt * transfer in output direction is star ted. * if not successful, this routine has escaped. * *********************************************************} procedure ovl_int_out_start; begin with my_misc_ptr^ do begin peripheral_check;  set_bus_out; state.bl := ACTIVE_WRITE; d_isr_ie.fifo_empty := true; d_int_e := true; set_int; end; end; {********************************************************* * procedure name: * ovl_int_in_start * * input dependencies: * my ptrs set up. * bus state may or may not be known, * device type may or may not be known. * * functional description: * start an input overlap interrupt transfer * sequence. * note a fifo of size 1 is used for this type * of transfer. This allows an interrupt * with each byte transfered. * * output environement: *  if successful, bus is in input state, * device type is known and overlap interrupt * transfer in input direction is started. * if not successful, this routine has escaped. * *********************************************************} procedure ovl_int_in_start; begin with my_misc_ptr^ do begin peripheral_check; state.bl := INACTIVE_ERROR; set_bus_in(USE_SMALL_FIFO); state.bl := ACTIVE_READ; d_isr_ie.fifo_full := true; d_int_e := true; set_int; end; end; {********************************************************* * procedure name: * do_ovl_int_fifo_empty * * input dependencies: * my ptrs set up * a fifo empty interrupt has occured * an output overlap interrupt transfer is * currently in progress. * * functional description: * update buffer pointers, get another byte into * fifo, and set up for another interrupt. * if transfer has completed, terminate buffer. * since can't escape from an interrupt, handle * all errors here - if error occurs, terminate * transfer. * * output environement: * either transfer is continuing or has terminated. * if transfer terminated, then h/w and s/w are cleaned * up. * *********************************************************} procedure do_ovl_int_fifo_empty; var my_count:integer; begin with get_buf_ptr^, my_misc_ptr^ do begin try my_count := 1; fhs_out(buf_empty, my_count); buf_empty := addr(ptr_char_type(buf_empty)^, 1); term_count := term_count - 1; if (term_count = 0) then {transfer completed} begin  stclr; d_isr_ie.fifo_empty := false; d_int_e := false; set_int; end else  begin d_isr_ie.fifo_empty := true; d_int_e := true; set_int; end; recover if (escapecode = ioescapecode) then begin stclr; d_isr_ie.fifo_empty := false; d_int_e := false; set_int; end; end; end; {********************************************************* * procedure name: * do_ovl_int_fifo_full * * input dependencies: * my ptrs set up * a fifo full interrupt has occured * an input overlap interrupt transfer is   * currently in progress. * * functional description: * update buffer pointers, get another byte from * fifo, and set up for another interrupt. * if transfer has completed, terminate buffer. *  since can't escape from an interrupt, handle * all errors here - if error occurs, terminate * transfer. * * output environement: * either transfer is continuing or has terminated. * if transfer terminated, then h/w and s/w are cleaned * up. * *********************************************************} procedure do_ovl_int_fifo_full; var my_count:integer; last_char:char; begin with get_buf_ptr^, my_misc_ptr^ do begin try peripheral_check; my_count := 1; fhs_in(buf_fill, my_count, end_mode); last_char := ptr_char_type(buf_fill)^;  buf_fill := addr(ptr_char_type(buf_fill)^, 1); term_count := term_count - 1; if (term_count = 0) or (end_mode and last_read_nack) or  ((term_char <> -1) and (last_char = chr(term_char))) then begin stclr; state.bl := INACTIVE_ERROR; d_isr_ie.fifo_full := false;  d_int_e := false; set_int; end else begin d_isr_ie.fifo_full := true;  d_int_e := true; set_int; end; recover if (escapecode = ioescapecode) then begin stclr; d_isr_ie.fifo_full := false; d_int_e := false; set_int; end; end; end; end {pllel_util}; $page$ module pllel_drive; {------------------------------------------------------------------------------} {------------------ parallel driver hook flow control ------------------} {------------------------------------------------------------------------------} { This module acts as a demuxer for the PWS I/O system. I/O system calls  enter into this module and are translatted into PARALLEL I/O requests. The later requests are invoked by calls to routines within the PLLEL_UTIL module. The functionality of each of the I/O requests are defined in either the  Procedure Library GENERAL I/O discussions, the Procedure Library PARALLEL Inteface discussions, or in the Systems Designers Guide. Unless necessary, the functionality is NOT repeated here in the guise of routine headers. } import sysglobals, asm, iodeclarations, iocomasm, parallel_3, pllel_util, pllel_asm; export procedure pinit_hook(temp:ANYPTR); procedure pisr_hook(temp:PISRIB); procedure prdb_hook(temp:ANYPTR; VAR x:CHAR); procedure pwtb_hook(temp:ANYPTR; x:CHAR); procedure prdw_hook(temp:ANYPTR; VAR x:io_word); procedure pwtw_hook(temp:ANYPTR; x:io_word); procedure prds_hook(temp:ANYPTR; reg:io_word; VAR x : io_word);  procedure pwtc_hook(temp:ANYPTR; reg:io_word; x : io_word ); procedure pend_hook(temp:ANYPTR; VAR b:boolean); procedure ptfr_hook(temp:ANYPTR; bcb:ANYPTR ); implement procedure pinit_hook(temp:ANYPTR); var  timevalue:integer; begin try {this routine should NEVER escape!} { this routine should also not go into a forever loop for whatever reason. save timeout value, and set timeout to 1ms.   } with pio_tmp_ptr(temp)^ do begin timevalue := timeout; timeout := 1; end; set_my_ptrs(temp); with my_hw_ptr^, my_tmp_ptr^, my_misc_ptr^ do begin { clear up any existing transfers } if state.active_xfer then abort_io;  { restore reset defaults } peripheral_type := peripheral_reset; if peripheral_type = USER_SPEC_NO_DEVICE then state.bl := DISABLED_BY_USER else state.bl := INACTIVE_ERROR; options.w := options_reset.w; if options.wr_nrd_low then set_wr_nrd_low; { reset h/w } intdma.int_e := false; hostline.bl := #0; {turn off all hostlines}  sysreg.softreset := #0; delay(delay_ms); if not options.wr_nrd_low then hostline.wr_nrd_high := true; d_int_e := false; intdma.io := false; {output forces chip to own data & nstrobe lines} d_isr_ie.w := 0; u_isr_ie.w := 0; set_int; hostline.nselectin_low := true;  { reset driver variables } u_isr_status.w := 0; last_read_nack := false; user_isr.dummy_pr := nil; user_isr.dummy_sl := nil; in_bufptr := nil; out_bufptr := nil; my_int_level := intdma.int_lvl + 3; end; recover ; { restore timeout value } try pio_tmp_ptr(temp)^.timeout := timevalue; recover ; end; procedure pisr_hook(temp:PISRIB); type pxlate_type = record case integer of  1:(pproc:parallel_user_isr_type); 2:(ioproc:io_proc); end; var save_ioe_result:integer; save_ioe_isc:integer; save_int_state:int_state_type; d_isr_ir:driver_int_state_type; ptr_buf:ptr_buf_info_type; p:pxlate_type; do_u_isr_ovl:boolean; procedure kill_act_tfr; begin with my_misc_ptr^ do begin d_isr_ie.bl := 0;  d_int_e := false; abort_io; end; end; begin do_u_isr_ovl := false; set_my_ptrs(anyptr(temp)); with my_tmp_ptr^, my_misc_ptr^, my_hw_ptr^ do begin {  save current h/w interrupts - support routines will reset the driver interrupt conditions and call set_int. set_int resets the h/w interrupt conditions, thus a copy is necessary }  save_int_state.bl := int_state.bl; {handle driver interrupts} d_isr_ir.bl := binand(d_isr_ie.bl, ord(save_int_state.bl)); if (d_isr_ir.bl <> 0) then begin {only supposed to be getting driver interrupts with active transfers} ptr_buf := get_buf_ptr; if (ptr_buf = nil) then begin {res et all driver interrupts - this should never happen} d_isr_ie.bl := 0; d_int_e := false; end else with ptr_buf^ do  begin { utility routines will set ioe_result and ioe_isc. Can't allow ioe_result and ioe_isc to be modified!  } save_ioe_result := ioe_result; save_ioe_isc := ioe_isc; if (act_tfr = DMA_tfr) then begin  if binand(ord(save_int_state.bl), hex('07')) <> 0 then begin {peripheral gone off line during dma transfer, wait for peripheral to respond} try peripheral_check; {if didn't escape, peripheral back online and DMA continuing} recover kill_act_tfr; end  else if save_int_state.nack_low_trans then begin last_read_nack := true; dma_int_handler(temp); end else kill_act_tfr; end else if (act_tfr = INTR_tfr) then begin do_u_isr_ovl := true; if save_int_state.fifo_full then do_ovl_int_fifo_full  else if save_int_state.fifo_empty then do_ovl_int_fifo_empty else begin  do_u_isr_ovl := false; kill_act_tfr; end; end else if (act_tfr = FHS_tfr) then  begin try {fake out the tfr hook} d_isr_ie.fifo_empty := false;  d_isr_ie.fifo_full := false; d_int_e := false; set_int; do_fhs_tfr(ptr_buf);  recover kill_act_tfr; end else kill_act_tfr; ioe_result := save_ioe_result; ioe_isc := save_ioe_isc; end; end; {handle user isr interrupts} u_isr_status.w := 0; u_isr_status.bl := binand(u_isr_ie.bl, ord(save_int_state.bl)); if (u_isr_ie.xfer_extend) and (do_u_isr_ovl) then u_isr_status.xfer_extend := true; if (u_isr_status.bl <> 0) then begin    {disable user interrupts on interrupting conditions only.} u_isr_ie.bl := u_isr_ie.bl - u_isr_status.bl; {call the user isr} p.ioproc := user_isr.real_proc;  call(p.pproc, my_isc); {clear user isr status} u_isr_status.w := 0; end; {reset up any interrupts} set_int; end; end; procedure prdb_hook(temp:ANYPTR; VAR x:CHAR); var count:integer; begin set_my_ptrs(temp); count := 1; fhs_in(addr(x), count, true); end; procedure pwtb_hook(temp:ANYPTR; x:CHAR); var count:integer; begin set_my_ptrs(temp); count := 1; fhs_out(addr(x), count); end; procedure prdw_hook(temp:ANYPTR; VAR x:io_word); var count:integer; begin set_my_ptrs(temp); count := 2; fhs_in(addr(x), count, true); end; procedure pwtw_hook(temp:ANYPTR; x:io_word); var count:integer; begin set_my_ptrs(temp); count := 2; fhs_out(addr(x), count); end; procedure prds_hook(temp:ANYPTR; reg:io_word; VAR x:io_word); var status:p3regs_type; begin set_my_ptrs(temp);  with my_hw_ptr^, my_tmp_ptr^, my_misc_ptr^ do begin status.w := 0; case reg of PLLEL_REG_CARD_ID: begin status.w := PARALLEL_CARDID; end; PLLEL_REG_INTDMA_STATUS: begin status.bl := ord(intdma.bl); status.intdma_status.pad := 0; end; PLLEL_REG_PERIPHERAL_STATUS: begin status.bl := ord(comm_per.bl);  status.peripheral_status.pad := 0; end; PLLEL_REG_COMM_STATUS: begin status.bl := binlsr(ord(comm_per.bl),3);  status.comm_status.pad := 0; end; PLLEL_REG_HOST_LINE_CONTROL: begin status.bl := ord(hostline.bl); status.host_line.pad := 0; end; PLLEL_REG_IO_CONTROL: begin status.bl := binlsr(ord(intdma.bl),2); status.io_control.pad := 0; end; PLLEL_REG_FIFO: begin status.bl := ord(fifo.fifoin); end; PLLEL_REG_PERIPHERAL_TYPE: begin if peripheral_type = NOT_PRESENT then  try set_peripheral_type; recover if escapecode <> ioescapecode then  escape(escapecode); status.bl := peripheral_type; end; PLLEL_REG_TYPE_RESET: begin  status.bl := peripheral_reset; end; PLLEL_REG_INTERRUPT_STATE: begin status.bl := d_isr_ie.bl;    end; PLLEL_REG_DRIVER_OPTIONS: begin status.bl := options.bl; end; PLLEL_REG_OPTIONS_RESET:  begin status.bl := options_reset.bl; end; PLLEL_REG_DRIVER_STATE: begin  status.driver_state := state; end; PLLEL_REG_HOOK_STATUS: begin if (user_isr.dummy_pr = NIL) then  status.bl := USER_ISR_HOOK_INACTIVE else status.bl := USER_ISR_HOOK_ACTIVE; end; PLLEL_REG_USER_ISR_ENABLE: begin status.user_isr_status := u_isr_ie; end; PLLEL_REG_USER_ISR_STATUS: begin status.user_isr_status := u_isr_status; end; OTHERWISE dvr_error(ioe_rds_wtc); end; x := status.w; end; end; procedure pwtc_hook(temp:ANYPTR; reg:io_word; x:io_word ); var control:p3regs_type; peripheral_online:boolean; timevalue:integer; begin set_my_ptrs(temp); with my_hw_ptr^, my_tmp_ptr^, my_misc_ptr^ do begin control.w := x; case reg of PLLEL_REG_RESET: begin pinit_hook(temp); end; PLLEL_REG_HOST_LINE_CONTROL: begin control.host_line.pad := 0; hostline.bl := chr(control.bl);  end; PLLEL_REG_IO_CONTROL: begin intdma.io := control.io_control.input_high; intdma.iomod := control.io_control.modify_io; {force driver to set up bus on next transfer} if not state.disabled then state.bl := INACTIVE_ERROR;  end; PLLEL_REG_FIFO: begin fifo.fifoout := chr(control.bl); end; PLLEL_REG_PERIPHERAL_TYPE, PLLEL_REG_TYPE_RESET: begin if control.bl in USER_SET then begin  if reg = PLLEL_REG_PERIPHERAL_TYPE then begin if (options.wr_nrd_low) and (control.bl in INPUT_SET) then dvr_error(ioe_rds_wtc); peripheral_type := control.bl; end  else peripheral_reset := control.bl; end else    dvr_error(ioe_rds_wtc); end; PLLEL_REG_PERIPHERAL_RESET: begin { do a quick test to see if the attached peripheral is online. Want to do a hard reset if the device is not online, the device type is specified by user, or the wr_nrd_low option is used. Otherwise, call set_peripheral_type which will do a reset and additionally determine the type of the attached device. This prevents a 'double reset'. } timevalue := timeout; timeout := 1; try peripheral_check; peripheral_online := true; timeout := timevalue; recover begin timeout := timevalue; if escapecode = ioescapecode then peripheral_online := false else escape(escapecode); end; if (not peripheral_online) or (peripheral_type in [USER_SPEC_NO_DEVICE, USER_SPEC_OUTPUT_ONLY,  USER_SPEC_HP_BIDIRECTIONAL]) or (options.wr_nrd_low) then reset_peripheral  else begin peripheral_type := NOT_PRESENT; set_peripheral_type; end;  end; PLLEL_REG_DRIVER_OPTIONS: begin control.bh := 0; control.driver_options.pad := 0;  if options.wr_nrd_low and not control.driver_options.wr_nrd_low then begin {wr_nrd_low is being turned off}  peripheral_type := NOT_PRESENT; end; options.w := control.w; if options.wr_nrd_low then  set_wr_nrd_low; { force bus to be set on next write this forces use_nack and other options in place.  } state.bl := INACTIVE_ERROR; end; PLLEL_REG_OPTIONS_RESET: begin control.bh := 0; control.driver_options.pad := 0; options_reset.w := control.w; end; PLLEL_REG_HOOK_CLEAR:    begin u_isr_ie.w := 0; u_isr_status.w := 0; user_isr.dummy_pr := NIL; user_isr.dummy_sl := NIL; set_int; end; PLLEL_REG_USER_ISR_ENABLE: begin if user_isr.dummy_pr = NIL then dvr_error(ioe_rds_wtc); u_isr_ie.bl := control.bl; set_int; end;  OTHERWISE dvr_error(ioe_rds_wtc); end; end; end; procedure pend_hook(temp:ANYPTR; VAR b:boolean); begin set_my_ptrs(temp); b := my_misc_ptr^.last_read_nack; end; procedure ptfr_hook(temp:ANYPTR; bcb:ANYPTR ); VAR tmp: integer; BEGIN set_my_ptrs(temp); with my_tmp_ptr^, ptr_buf_info_type(bcb)^, my_misc_ptr^ do begin {check for illegal full duplex transfer request}  if (direction = TO_MEMORY) and (out_bufptr <> NIL) then begin dvr_error(ioe_bad_tfr); end else if (direction = FROM_MEMORY) and (in_bufptr <> NIL) then begin  dvr_error(ioe_bad_tfr); end; {check for illegal word transfer request} if (b_w_mode = TRUE) then begin dvr_error(ioe_bad_tfr); end; {check for illegal transfer end request for outbound transfers} if (end_mode) and (direction = FROM_MEMORY) then begin dvr_error(ioe_bad_tfr); end; {check for illegal transfer request} if (usr_tfr in [dummy_tfr_1, dummy_tfr_2]) then begin dvr_error(ioe_bad_tfr); end; { adjust transfer request type of FASTEST }  if usr_tfr in [serial_FASTEST, overlap_FASTEST] then begin usr_tfr := pred(usr_tfr); {--> FHS} if (dma_available) then begin  usr_tfr := pred(usr_tfr); {--> DMA} end; end; { adjust transfer request type of OVERLAP } if usr_tfr = OVERLAP then begin if (dma_available) then usr_tfr := OVERLAP_DMA else usr_tfr := OVERLAP_INTR; end; {transfer accepted, mark buffer busy} stbsy;  {do the various transfers} if usr_tfr in [serial_DMA, overlap_DMA] then begin act_tfr := DMA_tfr; dma_start(bcb); if usr_tfr = serial_DMA then begin repeat until active_isc = no_isc; end; end else if usr_tfr = serial_FHS then begin do_fhs_tfr(bcb); end else if usr_tfr in [overlap_FHS, overlap_INTR] then begin if usr_tfr = overlap_FHS then act_tfr := FHS_tfr else  act_tfr := INTR_tfr; if direction = FROM_MEMORY then ovl_int_out_start else ovl_int_in_start; end    else dvr_error(ioe_bad_tfr); end; end; end {pllel_drive}; $page$ {------------------------------------------------------------------------------} {------------------ parallel driver main program. ------------------} {------------------------------------------------------------------------------} import sysglobals, isr, loader, asm, iodeclarations, general_0, parallel_3, pllel_drive, pllel_util; function pllel_init:boolean; type p_drv_type = ^drv_table_type; var card_found:boolean; io_isc:type_isc; io_lvl:io_byte; p_drivers:p_drv_type; p_hw:ptr_parallel_hw_type; p_misc:ptr_misc_block; i:integer; pch:ptr_char_type; begin  card_found := false; io_revid := io_revid + ' P3.2'; { set up the driver tables } newbytes(p_drivers, sizeof(drv_table_type)); p_drivers^ := dummy_drivers; with p_drivers^ do begin  iod_init := pinit_hook; iod_isr := pisr_hook; iod_rdb := prdb_hook; iod_wtb := pwtb_hook; iod_rdw := prdw_hook; iod_wtw := pwtw_hook; iod_rds  := prds_hook; iod_wtc := pwtc_hook; iod_end := pend_hook; iod_tfr := ptfr_hook; end; { look for parallel interfaces, and initialize. } for io_isc:=iominisc to iomaxisc do with isc_table[io_isc] do begin if (card_ptr <> nil) and (card_type = pllel_card) then begin card_found := true; p_hw := io_tmp_ptr^.card_addr; p_misc := addr(io_tmp_ptr^.drv_misc[1]); { set up O/S I/O hooks } io_drv_ptr := anyptr(p_drivers);  { set up ISR handler } io_lvl := p_hw^.intdma.int_lvl + 3; if io_tmp_ptr^.myisrib.intregaddr <> nil then {isr already exits}  begin { unlink existing isr hook. } isrunlink(io_lvl, addr(io_tmp_ptr^.myisrib)); end;  permisrlink( io_drv_ptr^.iod_isr, { isr handler } ADDR(p_hw^.intdma, 1), { card address } hex('c0'),  { intr. mask } hex('c0'), { intr. value } io_lvl, { level } ADDR(io_tmp_ptr^.myisrib)); { isrib info } { initialize driver variables. } pch := addr(p_misc^); for i := 1 to sizeof(misc_block) do  begin pch^ := #0; pch := addr(pch^,1); end; with p_misc^ do begin peripheral_type := NOT_PRESENT; peripheral_reset := NOT_PRESENT; options.w := 0; options_reset.w := 0; state.bl := INACTIVE_ERROR;  d_isr_ie.w := 0; d_int_e := false; u_isr_ie.w := 0; u_isr_status.w := 0; last_read_nack := false;    end; { initialize driver & h/w. } with io_tmp_ptr^ do try i := timeout;  timeout := 1; pinit_hook(io_tmp_ptr); timeout := i; recover begin timeout := i;  if escapecode <> ioescapecode then escape(escapecode); end; end; end; pllel_init := card_found; end; begin {program pllel_start}  if pllel_init then markuser; end.  (* (c) Copyright Hewlett-Packard Company, 1985. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) $MODCAL ON$ $PARTIAL_EVAL ON$ $STACKCHECK ON$ $RANGE OFF$ $DEBUG OFF$ $OVFLCHECK OFF$ $PAGE$ (************************************************************************) (*  *) (* RELEASED VERSION 3.1 *) (* *) (************************************************************************) (* *) (* *) (* IOLIB IOLIB *) (* *) (* *) (************************************************************************) (*  *) (* *) (* library - IOLIB *) (* name - IOLIB  *) (* module(s) - general_1 *) (* - hpib_1 *) (* - general_2 *) (*  - general_3 *) (* - general_4 *) (* - hpib_0 *) (* - hpib_2  *) (* - hpib_3 *) (* - serial_0 *) (* - serial_3 *) (*  *) (* author - Tim Mikkelsen *) (* phone - 303-226-3800 ext. 2910 *) (*  *) (* date - June 1 , 1981 *) (* update - June 4, 1984 *) (* release - Jul 12, 1985    *) (* *) (* source - IOLIB:IOLIB.TEXT *) (* object - IOLIB:IOLIB.CODE *) (*  *) (************************************************************************) $PAGE$ (************************************************************************) (*  *) (* *) (* This is the source code for an external procedures library *) (* to be used for general purpose interfacing on the HP 9826. *) (*  *) (* The library consists of 3 primary sets of modules - *) (* *) (* 1. KERNEL modules *) (* 2. driver modules *) (* 3. IOLIB modules *) (*  *) (* The KERNEL modules consist of the following modules - *) (* *) (* 1. iodeclarations ( contains static r/w space ) *) (* 2.  iocomasm *) (* 3. general_0 ( initialization & low level *) (* routines like ioread/iowrite) *) (* The KERNEL modules also have an executable program segement *) (* that gets executed at the time it is loaded. This program *) (* initializes the static read/write memory. This program also *) (* allocates the temporary storage for any card that exists - *) (* independent of whether there is or is not a driver for it. *) (* *) (* The driver modules consist of the actual assembly or PASCAL *) (* routines that deal with a specific interface card. There is *) (* also an executable program segment for each driver module. *) (* This program searches the select code table in the static r/w *) (* initialized by the KERNEL general_0 module for all select codes *) (* that have the right interface card ( HPIB drivers will search *) (* for the 98624 interface ). This program will then set up the *) (* driver tables to point to the correct drivers. *) (*  *) (* The rest of the IOLIB modules are high-level modules that are *) (* used by an end user in his/her application program. *) (*  *) (* The KERNEL and some set of driver modules will exist in the *) (* SYSTEM.INITLIB file as object code ( not EXPORT text ). The *) (* export text will reside on the SYSTEM.LIBRARY file. The rest *) (* of the library will reside on the SYSTEM.LIBRARY. *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (* *) (* BUG FIX HISTORY - after release  *) (* *) (* *) (* BUG # BY / ON LOCATION DESCRIPTION *) (* ----- ----------  - -------------- ---------------------- *) (* *) (* 1250 T Mikkelsen HPIB_3 request service allows *) (* 01/08/1982 request_service active ctl to request *) (* service. *) (* *) (* 1251 T Mikkelsen HPIB_2 local(7) with sc 7 as *) (*  01/08/1982 local sys ctl / not act ctl *) (* 01/26/1982 gives error. *) (* *) (* 1252 T Mikkelsen HPIB_2  remote(7) with sc 7 as *) (* 01/08/1982 remote act ctl / not sys ctl *) (* doesn't give error. *) (* *) (* 1258 T Mikkelsen HPIB_2 pass control sends the *) (* 01/08/1982 pass_control wrong sequence to pass *) (* control to itself. *) (*  *) (* 1269 T Mikkelsen SERIAL_3 bad check for a 98626 *) (* 01/08/1982 set_stop_bits card. *) (*  *) (* 1270 T Mikkelsen SERIAL_3 make procedures for *) (* 01/08/1982 set_baud_rate data comm consistent *) (* set_stop_bits for buffered control. *) (*  set_parity *) (* set_char_length *) (* *) (* 1281 T Mikkelsen GENERAL_3 Wrong message for error *) (* 01/08/1982 ioerror_message ioe_not_dvc. *) (* *) (* 0082 T Mikkelsen GENERAL_3 Addition of a link for *) (*  07/23/1982 ioerror_message the error messages. *) (* See also IODECLARATIONS.*) (* *) (* 0083 T Mikkelsen GENERAL_4 Addition of buffer_busy *) (* 07/23/1982 buffer_busy and isc_busy routines. *) (* isc_busy *) (*  *) (* 0355 T Mikkelsen SERIAL_3 Set parity of one and *) (* 08/20/1982 set_parity zero parity is backwards*) (* for the 98628 card. *) (*  *) (* 0359 T Mikkelsen SERIAL_3 Changes for addition *) (* 08/26/1982 set_parity of 98626 drivers. *) (* set_char_length  *) (* set_stop_bits *) (* *) (* 0364 T Mikkelsen GENERAL_3 Addition of SRM driver *) (*  08/23/1982 ioerror_message error codes. See also *) (* IODECLARATIONS. *) (* *) (* 557 T Mikkelsen GENERAL_3 Mistyped. ( typo ) *) (* 10/01/1982 set_parity *) (* *) (* jsjs T Mikkelsen HPIB_2 BUG FIX error in Local   *) (* 03/09/1983 local procedure for isc param *) (* and not sys controller. *) (* *) (* tttt J Schmidt  HPIB_1 Use timer on CPU board *) (* 08/03/1983 if available for timeout*) (* checking *) (*  *) (* J Schmidt serial modules add code for 98644 *) (* 5/15/84 *) (* 6/4/84 *) (*  *) (* D Willis PARALLEL_3 Added for centronics *) (* 12/89 support. *) (*  *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (* *) (* REFERENCES : *) (*  *) (* *) (* 1. 9826 I/O Designers Guide ( Loyd Nelson ) *) (*  *) (* 2. 68000 Manual ( Motorola ) *) (* *) (* 3. Pascal alpha site ERS ( Roger Ison ) *) (*  *) (* 4. Pascal I/O Library ERS ( Tim Mikkelsen ) *) (* *) (* 5. 9826 HPL EIO & IOD listings  ( Bob Hallissy ) *) (* *) (* 6. 9826 HPL Misc. I/O Doc. ( Bob Hallissy ) *) (* *) (* 7. 9826 card documentation ( Mfg. Specs. ) *) (* *) (* 8. Pascal I/O Library IRS ( Tim Mikkelsen ) *) (*  *) (* *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (* *) (* GENERAL GROUP *) (* *) (* *) (************************************************************************) MODULE general_1 ; { by Tim Mikkelsen date 07/15/81 update 11/20/81 purpose This module contains the LEVEL 1 GENERAL GROUP procedures. } {local search{{ $SEARCH 'KERNEL.CODE', 'COMASM'$ {system search{{ $SEARCH 'IOLIB:KERNEL.CODE', 'IOLIB:COMASM'$ {} IMPORT iodeclarations ; EXPORT PROCEDURE ioinitialize; PROCEDURE iouninitialize; PROCEDURE ioreset ( select_code : type_isc); PROCEDURE readchar (   select_code : type_isc ; VAR value : CHAR ); PROCEDURE writechar ( select_code : type_isc ; value : CHAR ); PROCEDURE readword ( select_code : type_isc ; VAR num : INTEGER); PROCEDURE writeword ( select_code : type_isc ; value : INTEGER); PROCEDURE set_timeout ( select_code : type_isc ; time : REAL ); IMPLEMENT IMPORT general_0;  PROCEDURE ioinitialize; BEGIN io_system_reset; END; { of ioinitialize } PROCEDURE iouninitialize; BEGIN io_system_reset; END; { of iouninitialize } PROCEDURE ioreset ( select_code : type_isc); BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_init, io_tmp_ptr); END; { of ioreset } PROCEDURE readchar ( select_code : type_isc ; VAR value : CHAR ); BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_rdb, io_tmp_ptr, value); END; { of readchar } PROCEDURE writechar ( select_code : type_isc ; value : CHAR ); BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_wtb, io_tmp_ptr, value); END; { of writechar } PROCEDURE readword ( select_code : type_isc ; VAR num : INTEGER); VAR my_num : io_word; BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_rdw,  io_tmp_ptr, my_num); num:=my_num; END; { of readword } PROCEDURE writeword ( select_code : type_isc ; value : INTEGER); VAR my_value : io_word; BEGIN my_value:=value; WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_wtw, io_tmp_ptr, my_value); END; { of writeword } PROCEDURE set_timeout ( select_code : type_isc ; time : REAL { in seconds } ); BEGIN IF time>8191 { 4 byte timeout - 1 byte left for shifts } THEN BEGIN { error } io_escape(ioe_bad_tmo,select_code); END; { of IF } IF (time>0) AND (time<0.001) THEN BEGIN { error } io_escape(ioe_bad_tmo,select_code); END; { of IF } WITH isc_table[select_code] DO BEGIN { the table entry used by drivers is in milliseconds } user_time:=ROUND(time*1000); IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout := user_time; END; { of WITH DO BEGIN } END; { of set_timeout } END; { of general_1 } $PAGE$ (************************************************************************) (* *) (*  *) (* HPIB GROUP LEVEL 1 *) (* *) (*  *) (************************************************************************) (* *) (* *) (* This level is included in the *) (* general group because HP-IB *) (* addressing is necessary for *) (* general puropose device speci-  *) (* fication. *) (* *) (************************************************************************) MODULE hpib_1 ; { by Tim Mikkelsen date 07/16/81 update 08/03/83 by J Schmidt purpose This module contains the LEVEL 1 HPIB GROUP procedures. } IMPORT iodeclarations ; EXPORT PROCED URE send_command( select_code : type_isc ; command : CHAR ); FUNCTION my_address ( select_code : type_isc) : type_hpib_addr ; FUNCTION active_controller ( select_code : type_isc) : BOOLEAN; FUNCTION system_controller ( select_code : type_isc) : BOOLEAN; FUNCTION addr_to_talk( device : type_device) : type_isc; FUNCTION addr_to_listen ( device : type_device) : type_isc; FUNCTION set_to_talk ( device : type_device) : type_isc; FUNCTION set_to_listen ( device  : type_device) : type_isc; FUNCTION end_set ( select_code : type_isc ) : BOOLEAN; IMPLEMENT IMPORT iocomasm , general_0 ; TYPE timeoutrec = record { tttt JS 8/3/83 } counter: integer; { tttt JS 8/3/83 } firsttime: boolean; { tttt JS 8/3/83 } end; { tttt JS 8/3/83 } FUNCTION timerexists: boolean; external; { tttt JS 8/3/83 } FUNCTION timed_out(var rec: timeoutrec): boolean; external; {tttt JS 8/3/83} PROCEDURE send_command( select_code : type_isc ; command : CHAR ); BEGIN WITH isc_table[select_code] DO CALL ( io_drv_ptr^.iod_send, io_tmp_ptr, command); END; { of send_command } FUNCTION my_address ( select_code : type_isc) : type_hpib_addr ; BEGIN IF isc_table[select_code].io_tmp_ptr <> NIL THEN BEGIN WITH isc_table[select_code].io_tmp_ptr^ DO IF addressed <> -1 THEN BEGIN my_address:=addressed; END ELSE BEGIN { error } io_escape(ioe_not_hpib,select_code); END; { of IF addressed } END ELSE BEGIN { error } io_escape(ioe_not_hpib,select_code); END; { of IF io_tmp_ptr } END; { of my_address } FUNCTION active_controller  ( select_code : type_isc) : BOOLEAN; BEGIN IF isc_table[select_code].card_type=hpib_card THEN BEGIN active_controller:=bit_set(iostatus(select_code,3),6); END ELSE BEGIN active_controller := TRUE; END; { of IF } END; { of active_controller } FUNCTION system_controller ( select_code : type_isc) : BOOLEAN; BEGIN IF isc_table[select_code].card_type=hpib_card THEN BEGIN system_controller:=bit_set(iostatus(select_code,3),7); END ELSE BEGIN system_controller := TRUE; END; { of IF } END; { of system_controller } FUNCTION end_set ( select_code : type_isc )  : BOOLEAN ; VAR mybool : BOOLEAN; BEGIN WITH isc_table[select_code] DO CALL ( io_drv_ptr^.iod_end, io_tmp_ptr, mybool); end_set := mybool; END; { of send_command } $PAGE$ FUNCTION addr_to_talk( device : type_device) : type_isc; VAR io_isc : type_isc; timer : INTEGER; hpibrec: timeoutrec; {tttt JS 8/3/83} BEGIN IF device>iomaxisc THEN BEGIN io_isc:=device DIV 100; WITH isc_table[io_isc] DO BEGIN IF io_tmp_ptr <> NIL THEN BEGIN { set up user timeout - in case system drivers changed it } io_tmp_ptr^.timeout:=user_time; IF io_tmp_ptr^.addressed <> -1 THEN BEGIN IF ( card_type <> hpib_card ) AND ( device MOD 100 > 31 ) THEN io_escape(ioe_misc,io_isc); send_command(io_isc,CHR(talk_constant+(dev ice MOD 100))); send_command(io_isc,'?'); send_command(io_isc,CHR(my_address(io_isc)+listen_constant)); END ELSE BEGIN { error } io_escape(ioe_not_hpib,io_isc); END; { of IF } END ELSE BEGIN END; { of IF } END; { of WITH DO BEGIN } END ELSE BEGIN io_isc:=device; WITH isc_table[io_isc] DO BEGIN { set up user timeout - in case system drivers changed it } IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time; IF card_type=hpib_card THEN BEGIN IF NOT active_controller(io_isc) THEN BEGIN  { if non controller wait until listener } IF user_time = 0 THEN BEGIN REPEAT { wait forever } UNTIL bit_set(iostatus(io_isc,6),10);  END ELSE BEGIN { wait for timeout value } IF timerexists THEN BEGIN {tttt JS 8/3/83} hpibrec.firsttime:=true; {tttt JS 8/3/83}  hpibrec.counter:=user_time; {tttt JS 8/3/83} REPEAT {tttt JS 8/3/83} UNTIL timed_out(hpibrec) OR {tttt JS 8/3/83} bit_set(iostatus(io_isc,6),10); {tttt JS 8/3/83} END {tttt JS 8/3/83} ELSE BEGIN {tttt JS 8/3/83} timer:=user_time*3;  REPEAT timer:=timer-1; UNTIL ( timer = 0 ) OR ( bit_set(iostatus(io_isc,6),10) ) ; END; {tttt JS 8/3/83} IF NOT bit_set(iostatus(io_isc,6),10) THEN io_escape(ioe_timeout,io_isc); END; { of IF user_time=0 } END; { of IF } END; { of IF card_type = hpib_card }  END; { of WITH DO BEGIN } END; { of IF } addr_to_talk:=io_isc; { return select code } END; { of addr_to_talk } $PAGE$ FUNCTION addr_to_listen ( device : type_device) : type_isc; VAR io_isc : type_isc; timer : INTEGER; hpibrec: timeoutrec; {tttt JS 8/3/83} BEGIN IF device>iomaxisc THEN BEGIN io_isc:=device DIV 100; WITH isc_table[io_isc] DO BEGIN  IF io_tmp_ptr <> NIL THEN BEGIN { set up user timeout - in case system drivers changed it } io_tmp_ptr^.timeout:=user_time; IF io_tmp_ptr^.addressed <> -1 THEN BEGIN  IF ( card_type <> hpib_card ) AND ( device MOD 100 > 31 ) THEN io_escape(ioe_misc,io_isc); send_command(io_isc,CHR(my_address(io_isc)+talk_constant)); send_command(io_isc,'?');  send_command(io_isc,CHR(listen_constant+(device MOD 100))); END ELSE BEGIN { error } io_escape(ioe_not_hpib,io_isc); END; { of IF } END  ELSE BEGIN END; { of IF } END; { of WITH DO BEGIN } END ELSE BEGIN io_isc:=device; WITH isc_table[io_isc] DO BEGIN { set up user timeout - in case system drivers changed it } IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time; IF card_type=hpib_card THEN BEGIN IF NOT active_controller(io_isc) THEN BEGIN { if non controller wait until talker }   IF user_time = 0 THEN BEGIN REPEAT { wait forever } UNTIL bit_set(iostatus(io_isc,6),9); END ELSE BEGIN  { wait for timeout value } IF timerexists THEN BEGIN {tttt JS 8/3/83} hpibrec.firsttime:=true; {tttt JS 8/3/83} hpibrec.counter:=user_time; {tttt JS 8/3/83} REPEAT {tttt JS 8/3/83} UNTIL timed_out(hpibrec) OR {tttt JS 8/3/83} bit_set(iostatus(io_isc,6), 9); {tttt JS 8/3/83}  END {tttt JS 8/3/83} ELSE BEGIN {tttt JS 8/3/83} timer:=user_time*3; REPEAT timer:=timer-1; UNTIL ( timer = 0 ) OR ( bit_set(iostatus(io_isc,6),9) ) ; END; {tttt JS 8/3/83} IF NOT bit_set(iostatus(io_isc,6),9)  THEN io_escape(ioe_timeout,io_isc); END; { of IF user_time=0 } END; { of IF } END; { of IF card_type = hpib_card } END; { of WITH DO BEGIN } END; { of IF } addr_to_listen:=io_isc; END; { of addr_to_listen } $PAGE$ { set to talk exists because of HPIB_2/HPIB_3 - those routines are intended to be the controller ( active ) and should not wait for the card to be addressed as talker. addr_to_talk is used by data transfer routines. set_to_talk is used by bus control routines. } FUNCTION set_to_talk ( device : type_device) : type_isc; VAR io_isc : type_isc; BEGIN IF device>iomaxisc THEN BEGIN io_isc:=addr_to_talk(device); END ELSE BEGIN io_isc:=device; WITH isc_table[io_isc] DO BEGIN { set up user timeout - in case system drivers changed it } IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time; IF card_type=hpib_card THEN BEGIN IF NOT active_controller(io_isc) THEN BEGIN io_escape(ioe_not_act,io_isc); END; { of IF }  END; { of IF card_type = hpib_card } END; { of WITH DO BEGIN } END; { of IF } set_to_talk:=io_isc; { return select code } END; { of set_to_talk } $PAGE$ { set to listen exists because of HPIB_2/HPIB_3 - those routines are intended to be the controller ( active ) and should not wait for the card to be addressed as listener. addr_to_listen is used by data transfer routines. set_to_listen is used by bus control routines. }  FUNCTION set_to_listen ( device : type_device) : type_isc; VAR io_isc : type_isc; timer : INTEGER; BEGIN IF device>iomaxisc THEN BEGIN io_isc:=addr_to_listen(device); END ELSE BEGIN io_isc:=device; WITH isc_table[io_isc] DO BEGIN { set up user timeout - in case system drivers changed it } IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time; IF card_type=hpib_card THEN BEGIN IF NOT active_controller(io_isc) THEN BEGIN io_escape(ioe_not_act,io_isc); END; { of IF } END; { of IF card_type = hpib_card } END; { of WITH DO BEGIN } END; { of IF } set_to_listen:=io_isc; END; { of set_to_listen } END; { of hpib_1 } $PAGE$ MODULE general_2 ; { by Tim Mikkelsen date 07/15/81 update 11/30/81 purpose This  module contains the LEVEL 2 GENERAL GROUP procedures. } IMPORT iodeclarations; EXPORT PROCEDURE readnumber ( device : type_device ; VAR num: REAL ) ; PROCEDURE writenumber( device : type_device ;  value : REAL ) ; PROCEDURE readstring ( device : type_device ; VAR str: STRING ) ; PROCEDURE readstring_until ( term : CHAR ; device : type_device ; VAR str: STRING ); PROCEDURE writestring( device : type_device ; str : io_STRING ) ; PROCEDURE readnumberln ( device : type_device ; VAR num: REAL ); PROCEDURE writenumberln ( device : type_device ; value : REAL ); PROCEDURE writestringln ( device : type_device ; str : io_STRING ); PROCEDURE readuntil ( term : CHAR ; device : type_device ); PROCEDURE skipfor ( count : INTEGER ; device : type_device ); IMPLEMENT IMPORT sysglobals, hpib_1 , general_1 ; PROCEDURE readnumber ( device : type_device ; VAR num: REAL ) ; VAR io_work_str : STRING[255]; i : INTEGER; p2 : INTEGER; io_isc : type_isc; numbuilt : BOOLEAN; FUNCTION numeric ( character : CHAR) : BOOLEAN; BEGIN CASE character OF '0'..'9', '+','-','.', 'E','e' : numeric:=TRUE OTHERWISE numeric:=FALSE END; { of CASE } END; { of numeric } BEGIN { use TRY RECOVER to build a number until I find one } io_isc:=addr_to_talk(device); numbuilt := FALSE; WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc] DO BEGIN REPEAT SETSTRLEN(io_work_str,255); i:=1; { skip over non-numeric characters } REPEAT CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]); WHILE io_work_str[i]=' ' DO CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]); UNTIL numeric(io_work_str[i]) ; { read in numeric characters } REPEAT i:=i+1; CALL ( iod_rdb , io_tmp_ptr , io_work_str[i] ); WHILE io_work_str[i]=' ' DO CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]); UNTIL ( (NOT ( numeric(io_work_str[i]))) OR ( ( i>=255) ) ); SETSTRLEN(io_work_str,i); io_work_char:=io_work_str[i]; TRY STRREAD(io_work_str,1,p2,num); numbuilt := TRUE; RECOVER BEGIN IF ( ESCAPECODE=-10 ) AND ( ( IORESULT = ORD(IBADFORMAT) ) OR ( IORESULT = ORD(ISTROVFL) ) ) THEN BEGIN { this is the strread errors - try again } END ELSE BEGIN { this means something else happened } ESCAPE(ESCAPECODE); END; { of IF my error } END; { of RECOVER } UNTIL numbuilt; END; { of WITH DO BEGIN } END; { of readnumber } PROCEDURE writenumber (device : type_device ; value : REAL ); VAR i : INTEGER; p2 : INTEGER; io_isc : type_isc; io_work_str : STRING[255]; BEGIN io_isc:=addr_to_listen(device); WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc] DO BEGIN STRWRITE(io_work_str,1,p2,value); FOR i:=1 TO p2-1 DO CALL ( iod_wtb , io_tmp_ptr , io_work_str[i]); END; { of WITH DO } END; { of writenumber } PROCEDURE readstring  ( device : type_device ; VAR str: STRING ) ; VAR i : INTEGER; io_isc : type_isc; BEGIN io_isc:=addr_to_talk(device); WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc ] DO BEGIN SETSTRLEN(str,STRMAX(str)); { so I can do assign to empty string } i:=0; REPEAT i:=i+1; CALL ( iod_rdb , io_tmp_ptr , str[i]); UNTIL ( (i>=STRMAX(str) ) OR ( str[i] = io_line_feed ) ); IF str[i]=io_line_feed THEN i:=i-1; IF i<>0 THEN IF str[i]=io_carriage_rtn THEN i:=i-1; SETSTRLEN(str,i); END; { of WITH DO BEGIN } END; { of readstring } PROCEDURE readstring_until  ( term : CHAR ; device : type_device ; VAR str: STRING ); VAR i : INTEGER; io_isc : type_isc; io_work_char: CHAR; BEGIN io_isc:=addr_to_talk(device); WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc] DO BEGIN SETSTRLEN(str,STRMAX(str)); i:=0; REPEAT i:=i+1; CALL ( iod_rdb , io_tmp_ptr , str[i]); UNTIL ( (i>=STRMAX(str) ) OR ( str[i]=term ) ); SETSTRLEN(str,i); END; { of WITH DO BEGIN } END; { of readstring_until } PROCEDURE writestring( device : type_device ; str : io_STRING ) ; VAR i : INTEGER; io_isc: type_isc; BEGIN io_isc:=addr_to_listen(device); WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc] DO BEGIN FOR i:=1 TO STRLEN(str) DO CALL ( iod_wtb , io_tmp_ptr , str[i]); END; { of WITH DO } END; { of writestring } PROCEDURE readnumberln ( device : type_device ; VAR num: REAL ); VAR io_isc : type_isc; BEGIN io_isc:=addr_to_talk(device); readnumber(io_isc,num); IF io_work_char <> io_line_feed THEN readuntil(io_line_feed,io_isc); END; { of readnumberln } PROCEDURE writenumberln ( device : type_device ; value : REAL ); VAR io_isc : type_isc; BEGIN io_isc:=addr_to_listen(device); writenumber(io_isc,value); writechar(io_isc,io_carriage_rtn); writechar(io_isc,io_line_feed); END; { of writenumberln } PROCEDURE writestringln ( device : type_device ; str : io_STRING ); VAR io_isc : type_isc; BEGIN io_isc:=addr_to_listen(device); writestring(io_isc,str); writechar(io_isc,io_carriage_rtn); writechar(io_isc,io_line_feed); END; { of writestringln } PROCEDURE readuntil ( term : CHAR ; device : type_device ); VAR io_work_char: CHAR; io_isc : type_isc; BEGIN io_isc:=addr_to_talk(device); WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc] DO BEGIN REPEAT CALL ( iod_rdb , io_tmp_ptr , io_work_char); UNTIL ( io_work_char=term ); END; { of WITH DO BEGIN } END; { of readuntil } PROCEDURE skipfor ( count : INTEGER ; device : type_device ); VAR i  : INTEGER; io_isc : type_isc; io_work_char: CHAR; BEGIN io_isc:=addr_to_talk(device); WITH isc_table[io_isc].io_drv_ptr^ , isc_table[io_isc] DO BEGIN FOR i:=1 TO count DO CALL ( iod_rdb , io_tmp_ptr , io_work_char); END; { of WITH DO BEGIN } END; { of skipfor } END; { of general_2 } $PAGE$ MODULE general_3 ; { by Tim Mikkelsen date 11/27/81 update 07/23/82 purpose This module contains the LEVEL 3 GENERAL GROUP procedures. } IMPORT iodeclarations ; EXPORT FUNCTION ioerror_message ( ioerror : INTEGER ) : io_STRING; IMPLEMENT FUNCTION ioerror_message ( ioerror : INTEGER ) : io_STRING; VAR my_msg : io_STRING; BEGIN my_msg:='zzzz' ; { 0082 TM 7/23/82 } IF ( ioerror <= ioe_misc ) AND ( ioerror >= ioe_no_error ) THEN BEGIN CASE ioerror OF ioe_no_error : my_msg := 'no err or '; ioe_no_card : my_msg := 'no card at select code'; ioe_not_hpib : my_msg := 'interface should be hpib'; ioe_not_act : my_msg := 'not active controller'; ioe_not_dvc : my_msg := 'should be device not sc'; { BUG 1281 TM 1/8/82 } ioe_no_space : my_msg := 'no space left in buffer'; ioe_no_data : my_msg := 'no data left in buffer'; ioe_bad_tfr : my_msg := 'improper transfer attempted'; ioe_isc_busy : my_msg := 'the select code is busy'; ioe_buf_busy : my_msg := 'the buffer is busy'; ioe_bad_cnt : my_msg := 'improper transfer count'; ioe_bad_tmo : my_msg := 'bad timeout value'; ioe_no_driver : my_msg := 'no driver for this card'; ioe_no_dma : my_msg := 'no dma'; ioe_no_word : my_msg := 'word operations not allowed'; ioe_not_talk : my_msg := 'not addressed as talker'; ioe_not_lstn  : my_msg := 'not addressed as listener'; ioe_timeout : my_msg := 'a timeout has occurred'; ioe_not_sctl : my_msg := 'not system controller'; ioe_rds_wtc : my_msg := 'bad status or control'; ioe_bad_sct : my_msg := 'bad set/clear/test operation'; ioe_crd_dwn : my_msg := 'interface card is dead'; ioe_eod_seen : my_msg := 'end/eod has occured'; ioe_misc : my_msg := 'miscellaneous - value of param error'; END; { of CASE } END; { of IF } IF ( ioerror >= ioe_dc_fail ) AND ( ioerror <= ioe_dc_rval ) THEN BEGIN CASE ioerror OF ioe_sr_toomany : my_msg := { 0364 TM 87/23/82 }  'too many chars w/o terminator'; { 0364 TM 87/23/82 } ioe_dc_fail : my_msg := 'dc interface failure'; ioe_dc_usart : my_msg := 'USART receive buffer overflow'; ioe_dc_ovfl : my_msg := 'receive buffer overflow'; ioe_dc_clk : my_msg := 'missing clock'; ioe_dc_cts : my_msg := 'CTS false too long'; ioe_dc_car : my_msg := 'lost carrier disconnect'; ioe_dc_act : my_msg := 'no activity disconnect'; ioe_dc_conn : my_msg := 'connection not established'; ioe_dc_conf : my_msg := 'bad data bits/parity combination'; ioe_dc_reg : my_msg := 'bad status /control register'; ioe_dc_rval :  my_msg := 'control value out of range'; END; { of CASE } END; { of IF } IF ioe_result = ioe_sr_fail { 0364 TM 8/23/82 } THEN my_msg := 'data link failure'; { 0364 TM 8/23/82 }  IF my_msg = 'zzzz' { we don't let sleeping msgs lie } { 0082 TM 7/23/82 } THEN CALL(io_error_link , ioerror , my_msg ); { 0082 TM 7/23/82 } ioerror_message := my_msg; END; { ioerror_message } END; { of general_3 } $PAGE$ MODULE general_4 ; { by Tim Mikkelsen date 07/17/81 update 07/23/82 purpose This module contains the LEVEL 4 GENERAL GROUP procedures. } IMPORT iodeclarations ; EXPORT PROCEDURE abort_transfer ( VAR b_info: buf_info_type ); FUNCTION transfer_setup ( device : type_device; t_tfr : user_tfr_type; t_dir : dir_of_tfr ;  VAR b_info: buf_info_type ; VAR t_cnt : INTEGER ) : type_isc ; PROCEDURE transfer ( device : type_device; t_tfr : user_tfr_type; t_dir  : dir_of_tfr ; VAR b_info: buf_info_type; x_count : INTEGER ) ; PROCEDURE transfer_word ( device : type_device; t_tfr : user_tfr_type;   t_dir : dir_of_tfr ; VAR b_info: buf_info_type; x_count : INTEGER ) ; PROCEDURE transfer_until ( term : CHAR ; device : type_device; t_tfr : user_tfr_type; t_dir : dir_of_tfr; VAR b_info: buf_info_type ) ; PROCEDURE transfer_end ( device : type_device;  t_tfr : user_tfr_type; t_dir : dir_of_tfr; VAR b_info: buf_info_type ) ; PROCEDURE iobuffer ( VAR b_info: buf_info_type ; t_count : INTEGER ); PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ; FUNCTION buffer_space(VAR b_info: buf_info_type) : INTEGER; FUNCTION buffer_data( VAR b_info: buf_info_type) : INTEGER; PROCEDURE readbuffer ( VAR b_info: buf_info_type; VAR value : CHAR); PROCEDURE writebuffer( VAR b_info: buf_info_type; value : CHAR); PROCEDURE readbuffer_string ( VAR b_info: buf_info_type; VAR str : STRING; str_count : INTEGER); PROCEDURE writebuffer_string ( VAR b_info: buf_info_type; str : io_STRING); FUNCTION buffer_busy( VAR b_info: buf_info_type )  { 0083 TM 7/23/82 } : BOOLEAN; { 0083 TM 7/23/82 } FUNCTION isc_busy ( isc : type_isc ) { 0083 TM 7/23/82 } : BOOLEAN;  { 0083 TM 7/23/82 } IMPLEMENT IMPORT hpib_1 ; PROCEDURE iobuffer ( VAR b_info: buf_info_type ; t_count : INTEGER ) ; PROCEDURE NEW $ALIAS 'ASM_NEWBYTES'$ (VAR p:ANYPTR;v:INTEGER);EXTERNAL; BEGIN WITH b_info DO BEGIN { what about IOBUFFER to a already existant buffer ? } { - the space will be thrown away. } NEW(buf_ptr,t_count); act_tfr := no_tfr; active_isc:= no_isc; buf_size := t_count; buf_empty := buf_ptr; buf_fill := buf_ptr; drv_tmp_ptr := NIL; eot_proc.dummy_sl := NIL; eot_proc.dummy_pr := NIL; eot_parm := NIL; {JPC 02/22/82} dma_priority  := FALSE ; END; { of WITH DO } END; { of iobuffer } FUNCTION buffer_data(VAR b_info : buf_info_type ) : INTEGER; BEGIN WITH b_info DO BEGIN buffer_data:=INTEGER(buf_fill)-INTEGER(buf_empty); END; { of WITH DO } END; { of buffer_data } PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ; BEGIN WITH b_info DO BEGIN IF active_isc = no_isc THEN BEGIN buf_fill:=buf_ptr; buf_empty:=buf_ptr; END  ELSE BEGIN { error } io_escape(ioe_buf_busy,no_isc); END; { of IF } END; { of WITH DO } END; { of buffer_reset } FUNCTION buffer_space(VAR b_info: buf_info_type) : INTEGER; BEGIN WITH b_info DO BEGIN IF ( buffer_data(b_info)=0 ) AND ( active_isc = no_isc ) THEN buffer_reset(b_info); buffer_space:=buf_size+INTEGER(buf_ptr)-INTEGER(buf_fill); END; { of WITH DO } END; { of buffer_space } PROCEDURE abort_transfer ( VAR b_info: buf_info_type ); BEGIN WITH b_info DO BEGIN IF active_isc <> no_isc THEN BEGIN WITH isc_table[active_isc] DO CALL ( io_drv_ptr^.iod_init , io_tmp_ptr ); END; { of IF } END; { of WITH b_info DO } END; { of abort_transfer } FUNCTION transfer_setup ( device : type_device; t_tfr : user_tfr_type; t _dir : dir_of_tfr ; VAR b_info: buf_info_type ; VAR t_cnt : INTEGER ) : type_isc ; VAR io_isc : type_isc; BEGIN IF device>iomaxisc THEN io_isc := device DIV 100  ELSE io_isc := device; IF isc_table[io_isc].io_tmp_ptr = NIL THEN io_escape(ioe_no_driver,io_isc); WITH b_info DO BEGIN { test for tfr count } IF t_cnt=0 THEN BEGIN { error } io_escape(ioe_bad_cnt,no_isc); END; { test for another tfr on this buffer } IF active_isc <> no_isc THEN BEGIN { error } io_escape(ioe_buf_busy,no_isc); END ELSE BEGIN IF buffer_data(b_info)=0 THEN buffer_reset(b_info); END; { of IF } { configure card based on direction and check for available space/data } IF t_dir= to_memory THEN BEGIN IF isc_table[io_isc].io_tmp_ptr^.in_bufptr <> NIL THEN BEGIN { error } io_escape(ioe_isc_busy,io_isc); END; { of IF } IF buffer_space(b_info) NIL THEN BEGIN  { error } io_escape(ioe_isc_busy,io_isc); END; { of IF } IF buffer_data(b_info) no_isc ) AND ( direction = from_memory )  THEN BEGIN { error } io_escape( no_isc , ioe_buf_busy ); END; { of IF } p:=ANYPTR(buf_empty); value:=p^; buf_empty:=ANYPTR(INTEGER(buf_empty)+1); END; { of WITH b_info DO }  END; { of IF } END; { of readbuffer } PROCEDURE writebuffer( VAR b_info: buf_info_type; value : CHAR); VAR p : ^CHAR; BEGIN IF buffer_space(b_info)<1 THEN BEGIN { error } io_escape(ioe_no_space,no_isc); END ELSE BEGIN WITH b_info DO BEGIN IF ( active_isc <> no_isc ) AND ( direction = to_memory ) THEN BEGIN { error } io_escape( no_isc , ioe_buf_busy ); END; { of IF } p:=buf_fill; p^:=value; buf_fill:=ANYPTR(INTEGER(buf_fill)+1); END; { of WITH b_info DO } END; { of IF } END; { of writebuffer } PROCEDURE readbuffer_string  ( VAR b_info: buf_info_type; VAR str : STRING; str_count : INTEGER); VAR i : INTEGER ; BEGIN IF STRMAX(str) < str_count THEN BEGIN { error - string too small } io_escape(ioe_misc,no_isc); END; SETSTRLEN(str,str_count); { so I can put chars into empty string } IF buffer_data(b_info) no_isc THEN buffer_busy := TRUE { 0083 TM 7/23/82 } ELSE buffer_busy := FALSE; { 0083 TM 7/23/82 } END; { of WITH DO BEGIN }  { 0083 TM 7/23/82 } END; { of buffer_busy } { 0083 TM 7/23/82 } FUNCTION isc_busy ( isc : type_isc ) { 0083 TM 7/23/82 } : BOOLEAN;  { 0083 TM 7/23/82 } BEGIN { 0083 TM 7/23/82 } WITH isc_table[isc].io_tmp_ptr^ DO BEGIN { 0083 TM 7/23/82 } IF ( in_bufptr <> NIL ) OR  { 0083 TM 7/23/82 } ( out_bufptr <> NIL ) THEN isc_busy := TRUE { 0083 TM 7/23/82 } ELSE isc_busy := FALSE; { 0083 TM 7/23/82 } END; { of WITH DO BEGIN }  { 0083 TM 7/23/82 } END; { of isc_busy } { 0083 TM 7/23/82 } END; { of general_4 } $PAGE$ (************************************************************************) (*  *) (* *) (* HPIB GROUP *) (*  *) (* *) (************************************************************************) MODULE hpib_0 ; { by Tim Mikkelsen date 07/17/81 update 09/17/81 purpose This module contains the LEVEL 0 HPIB GROUP procedures. } IMPORT iodeclarations ; EXPORT PROCEDURE set_hpib ( select_code : type_isc ; line : type_hpib_line); PROCEDURE clear_hpib ( select_code : type_isc ; line : type_hpib_line); FUNCTION hpib_line ( select_code : type_isc ; line : type_hpib_line) : BOOLEAN; IMPLEMENT PROCEDURE set_hpib ( select_code : type_isc ; line : type_hpib_line); BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_set, io_tmp_ptr, ORD(line)); END; PROCEDURE clear_hpib ( select_code : type_isc ; line : type_hpib_line); BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_clr, io_tmp_ptr, ORD(line)); END; FUNCTION hpib_line ( select_code : type_isc ; line : type_hpib_line) : BOOLEAN; VAR my_boolean : BOOLEAN; BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_test, io_tmp_ptr, ORD(line), my_boolean); hpib_line:=my_boolean; END; END; { of hpib_0 } $PAGE$ MODULE hpib_2 ; { by Tim Mikkelsen date 07/17/81 update 03/09/83 purpose This module contains the LEVEL 2 HPIB GROUP procedures. } IMPORT iodeclarations ; EXPORT PROCEDURE abort_hpib ( select_code : type_isc); PROCEDURE clear ( device : type_device); PROCEDURE listen ( select_code : type_isc ; address  : type_hpib_addr ); PROCEDURE local ( device : type_device); PROCEDURE local_lockout ( select_code : type_isc); PROCEDURE pass_control ( device : type_device); PROCEDURE ppoll_configure  ( device : type_device; mask : INTEGER ); PROCEDURE ppoll_unconfigure ( device : type_device); PROCEDURE remote ( device : type_device); PROCEDURE secondary  ( select_code : type_isc ; address : type_hpib_addr ); PROCEDURE talk ( select_code : type_isc ; address : type_hpib_addr ); PROCEDURE trigger ( device : type_device); PROCEDURE unlisten( select_code : type_isc ); PROCEDURE untalk ( select_code : type_isc ); IMPLEMENT IMPORT hpib_0 , hpib_1 ; PROCEDURE abort_hpib ( select_code : type_isc); BEGIN { what about active tfrs ? } IF system_controller(select_code) THEN BEGIN set_hpib(select_code,ifc_line); set_hpib(select_code,ren_line); clear_hpib(select_code,ifc_line); clear_hpib(select_code,atn_line); { all done by ifc } END  ELSE BEGIN IF active_controller(select_code) THEN BEGIN send_command(select_code, CHR(talk_constant+my_address(select_code))); send_command(select_code,'?'); clear_hpib(select_code,atn_line);  END ELSE BEGIN { do nothing } END; { of IF } END; { of IF } END; { of abort_hpib } PROCEDURE clear ( device : type_device); VAR io_isc : type_isc; BEGIN io_isc:=set_to_listen(device); IF device>iomaxisc THEN BEGIN send_command(io_isc,sdc_message); END ELSE BEGIN send_command(io_isc,dcl_message); END; { of IF } END; { of clear } PROCEDURE listen ( select_code : type_isc ; address : type_hpib_addr ); BEGIN send_command(select_code,CHR(listen_constant+address)); END; { of listen } PROCEDURE local ( device : type_device); VAR io_isc : type_isc; BEGIN IF device>iomaxisc THEN BEGIN io_isc:=set_to_listen(device); { BUG 1251 TM 1/8/82 } send_command(io_isc,gtl_message); END ELSE BEGIN io_isc := device; { BUG 1251 TM 1/8/82 } IF system_controller(io_isc) { BUG jsjs TM 3/9/83 } THEN BEGIN { system controller - drop REN } { BUG jsjs TM 3/9/83 } clear_hpib(io_isc,ren_line); IF active_controller(io_isc) { BUG 1251 TM 1/26/82 } THEN clear_hpib(io_isc,atn_line); { BUG 1251 TM 1/26/82 } END { BUG jsjs TM 3/9/83 } ELSE BEGIN { BUG jsjs TM 3/9/83 }  { not system controller - send GTL } { BUG jsjs TM 3/9/83 } send_command(io_isc,gtl_message); { BUG jsjs TM 3/9/83 } END; { of IF } { BUG jsjs TM 3/9/83 } END; { of IF } END; { of local } PROCEDURE local_lockout ( select_code : type_isc); BEGIN send_command(select_code,llo_message); END; { of local_lockout } PROCEDURE pass_control ( device : type_device);  VAR io_isc : type_isc; BEGIN IF device>iomaxisc { BUG 1258 TM 1/8/82 } THEN BEGIN { BUG 1258 TM 1/8/82 } io_isc := device DIV 100; { BUG 1258 TM 1/8/82 } send_command(io_isc,unl_message); { BUG 1258 TM 1/8/82 } send_command(io_isc, { BUG 1258 TM 1/8/82 } chr((device MOD 100)+talk_constant)); { BUG 1258 TM 1/8/8 2 } END { BUG 1258 TM 1/8/82 } ELSE BEGIN { BUG 1258 TM 1/8/82 } io_isc := set_to_talk(device); { BUG 1258 TM 1/8/82 } END; { of IF device } { BUG 1258 TM 1/8/82 } send_command(io_isc,tct_message); END; PROCEDURE ppoll_configure ( device : type_device; mask : INTEGER ); VAR io_isc  : type_isc; BEGIN io_isc:=set_to_listen(device); IF io_isc=device THEN BEGIN { error } io_escape(ioe_not_dvc,io_isc); END ELSE BEGIN send_command(io_isc,ppc_message); send_command(io_isc,CHR(ord(ppe_message)+(mask MOD 16))); END; { of IF } END; { of ppoll_configure } PROCEDURE ppoll_unconfigure ( device : type_device); VAR io_isc : type_isc; BEGIN io_isc:=set_to_listen(device); IF device>iomaxisc THEN BEGIN send_command(io_isc,ppc_message); send_command(io_isc,ppd_message); END ELSE BEGIN send_command(io_isc,ppu_message); END; { of IF } END; { of ppoll_unconfigure } PROCEDURE remote ( device : type_device); VAR io_isc : type_isc; BEGIN IF device>iomaxisc THEN BEGIN io_isc:=device DIV 100; IF NOT system_controller(io_isc) { BUG 1252 TM 1/8/82 } THEN io_escape(ioe_not_sctl,io_isc); { BUG 1252 TM 1/8/82 } set_hpib(io_isc,ren_line); io_isc:=set_to_listen(device); END ELSE BEGIN io_isc := device; { BUG 1252 TM 1/8/82 } IF NOT system_controller(io_isc) { BUG 1252 TM 1/8/82 } THEN io_escape(ioe_not_sctl,io_isc); { BUG 1252 TM 1/8/82 } set_hpib(io_isc,ren_line); END; { of IF } END; { of remote } PROCEDURE secondary ( select_code : type_isc ; address : type_hpib_addr ); BEGIN send_command(select_code,CHR(address+96)); END; { of secondary } PROCEDURE talk ( select_code : type_isc ; address : type_hpib_addr ); BEGIN send_command(select_code,CHR(address+talk_constant)); END; { of talk } PROCEDURE trigger ( device : type_device); BEGIN send_command(set_to_listen(device),get_message); END; { of trigger } PROCEDURE unlisten( select_code : type_isc ); BEGIN send_command(select_code,unl_message); END; { of unlisten } PROCEDURE untalk ( select_code : type_isc ); BEGIN send_command(select_code,unt_message); END; { of untalk } END; { of hpib_2 } $PAGE$ MODULE hpib_3 ;  { by Tim Mikkelsen date 07/17/81 update 01/08/82 purpose This module contains the LEVEL 3 HPIB GROUP procedures. } IMPORT iodeclarations ; EXPORT FUNCTION requested  ( select_code : type_isc ) : BOOLEAN ; FUNCTION ppoll ( select_code : type_isc ) : INTEGER ; FUNCTION spoll ( device : type_device) : INTEGER ; PROCEDURE request_service ( select_code : type_isc ; response : INTEGER ); FUNCTION listener( select_code : type_isc ) : BOOLEAN; FUNCTION talker ( select_code : type_isc ) : BOOLEAN ; FUNCTION remoted ( select_code : type_isc ) : BOOLEAN ; FUNCTION locked_out ( select_code : type_isc ) : BOOLEAN ; IMPLEMENT IMPORT iocomasm , general_0 , general_1 , hpib_0 , hpib_1 ; FUNCTION requested ( select_code : type_isc ) : BOOLEAN ; BEGIN IF active_controller(select_code) THEN BEGIN requested:=hpib_line(select_code,srq _line); END ELSE BEGIN { error - not active controller when look at srq } io_escape(ioe_not_act,select_code); END; { of IF } END; { of requested } FUNCTION ppoll ( select_code : type_isc ) : INTEGER ; VAR my_byte : CHAR; BEGIN WITH isc_table[select_code] DO CALL(io_drv_ptr^.iod_ppoll, io_tmp_ptr, my_byte); ppoll:=ORD(my_byte); END; { of ppoll } FUNCTION spoll ( device : type_device)  : INTEGER ; VAR io_isc : type_isc; io_work_char: CHAR; BEGIN io_isc:=set_to_talk(device); send_command(io_isc,spe_message); readchar(io_isc,io_work_char); send_command(io_isc,spd_message); send_command(io_isc,unt_message); spoll:=ord(io_work_char); END; { of spoll } PROCEDURE request_service ( select_code : type_isc ; response : INTEGER ); BEGIN IF isc_table[select_code].card_type=hpib_card  THEN BEGIN IF NOT active_controller(select_code) { BUG 1250 TM 1/8/82 } THEN iocontrol(select_code,1,response) { BUG 1250 TM 1/8/82 } ELSE io_escape(ioe_misc,select_code); { BUG 1250 TM 1/8/82 }  END ELSE BEGIN { error } io_escape(ioe_not_hpib,select_code); END; { of IF } END; { of request_service } FUNCTION listener( select_code : type_isc ) : BOOLEAN; BEGIN listener:=bit_set(iostatus(select_code,6),10); END; { of listener } FUNCTION talker ( select_code : type_isc ) : BOOLEAN ; BEGIN talker:=bit_set(iostatus(select_code,6),9); END; { of talker } FUNCTION remoted ( select_code : type_isc ) : BOOLEAN ; BEGIN remoted:=bit_set(iostatus(select_code,6),15); END; { of remoted } FUNCTION locked_out ( select_code : type_isc ) : BOOLEAN ; BEGIN locked_out:=bit_set(iostatus(select_code,6),14); END; END; { of hpib_3 } $PAGE$ (************************************************************************) (* *) (*  *) (* SERIAL GROUP *) (* *) (* *) (************************************************************************) (* *) (* *) (* The 98626 code in the serial_0 and serial_3 modules has NOT *) (* been tested and is included in the hopes that it is correct *) (* and that someone will do the 98626 card drivers sometime. *) (*  *) (* There is a good chance that the 98626 will require a re- *) (* release of the IOLIB:IOLIB file ( serial modules only ). *) (* *) (************************************************************************) MODULE serial_0 ; { by Tim Mikkelsen date 07/22/81 update 11/06/81 purpose This module contains the LEVEL 0 SERIAL GROUP procedures. } IMPORT iodeclarations ; EXPORT PROCEDURE set_serial ( select_code : type_isc ; line : type_serial_line); PROCEDURE clear_serial( select_code : type_isc ; line  : type_serial_line); FUNCTION serial_line ( select_code : type_isc ; line : type_serial_line) : BOOLEAN; IMPLEMENT IMPORT iocomasm , general_0 ; PROCEDURE set_serial ( sel ect_code : type_isc ; line : type_serial_line); VAR mybit : INTEGER; dummy : INTEGER; BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);  IF (isc_table[select_code].card_id = hp98628_async) THEN BEGIN CASE line OF rts_line: mybit := 1; dtr_line: mybit := 2; drs_line: mybit := 4; OTHERWISE io_escape(ioe_bad_sct,select_code); END; { of CASE line } dummy := iostatus(select_code,8); dummy := binior(dummy,mybit); iocontrol(select_code,8+256,dummy); END ELSE BEGIN IF (card_id = hp98626) OR (card_id = hp98644) THEN BEGIN CASE line OF rts_line: mybit := 2; dtr_line: mybit := 1; drs_line: mybit := 8; OTHERWISE io_escape(ioe_bad_sct,select_code);  END; { of CASE line } dummy := iostatus(select_code,5); dummy := binior(dummy,mybit); iocontrol(select_code,5,dummy); END ELSE BEGIN CALL ( io_drv_ptr^.iod_set ,  io_tmp_ptr , ORD(line) ); END; { of IF } END; { of IF } END; { of WITH isc_table BEGIN } END; { of set_serial } PROCEDURE clear_serial( select_code : type_isc ; line : type_serial_line); VAR mybit : INTEGER; dummy : INTEGER; BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code); IF isc_table[select_code].card_id = hp98628_async THEN BEGIN CASE line OF rts_line: mybit := 1; dtr_line: mybit := 2; drs_line: mybit := 4; OTHERWISE io_escape(ioe_bad_sct,select_code); END; { of CASE line }  dummy := iostatus(select_code,8); dummy := binand(dummy,bincmp(mybit)); iocontrol(select_code,8+256,dummy); END ELSE BEGIN IF (card_id = hp98626) or (card_id = hp98644) THEN BEGIN  CASE line OF rts_line: mybit := 2; dtr_line: mybit := 1; drs_line: mybit := 8; OTHERWISE io_escape(ioe_bad_sct,select_code); END; { of CASE line } dummy := iostatus(select_code,5); dummy := binand(dummy,bincmp(mybit)); iocontrol(select_code,5,dummy); END ELSE BEGIN CALL ( io_drv_ptr^.iod_clr , io_tmp_ptr ,  ORD(line) ); END; { of IF } END; { of IF } END; { of WITH isc_table BEGIN } END; { of clear_serial } FUNCTION serial_line ( select_code : type_isc ; line : type_serial_line ) : BOOLEAN ; VAR mybit : INTEGER; dummy : INTEGER; reg : INTEGER; mybool : BOOLEAN; BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code); IF isc_table[select_code].card_id = hp98628_async THEN BEGIN CASE line OF rts_line: BEGIN reg := 8; mybit := 0; END; dtr_line: BEGIN reg := 8; mybit := 1; END; drs_line: BEGIN reg := 8; mybit := 2; END;  dsr_line: BEGIN reg := 7; mybit := 0; END; dcd_line: BEGIN reg := 7; mybit := 1;   END; cts_line: BEGIN reg := 7; mybit := 2; END; ri_line: BEGIN reg := 7; mybit := 3;  END; OTHERWISE io_escape(ioe_bad_sct,select_code); END; { of CASE line } dummy := iostatus(select_code,reg); mybool:= bit_set(dummy,mybit); END ELSE BEGIN IF (card_id = hp98626) or (card_id = hp98644) THEN BEGIN CASE line OF rts_line: BEGIN reg := 5; mybit := 1; END;  dtr_line: BEGIN reg := 5; mybit := 0; END; drs_line: BEGIN reg := 5; mybit := 3; END; dsr_line: BEGIN reg := 11; mybit := 5; END; dcd_line: BEGIN reg := 11; mybit := 7; END; cts_line: BEGIN reg := 11; mybit := 4; END; ri_line: BEGIN reg := 11; mybit := 6; END; OTHERWISE io_escape(ioe_bad_sct,select_code); END; { of CASE line } dummy := iostatus(select_code,reg); mybool:= bit_set(dummy,mybit); END ELSE BEGIN CALL ( io_drv_ptr^.iod_test , io_tmp_ptr , ORD(line) , mybool );  END; { of IF } END; { of IF } END; { of WITH isc_table BEGIN } serial_line := mybool; END; { of serial_line } END; { of serial_0 } $PAGE$ MODULE serial_3 ; { by Tim Mikkelsen date 07/22/81 update 10/01/82 purpose This module contains the LEVEL 3 SERIAL GROUP procedures. } IMPORT iodeclarations ; EXPORT PROCEDURE set_baud_rate ( select_code : type_isc ; rate : REAL ); PROCEDURE set_stop_bits ( select_code : type_isc ; num_bits : REAL ); PROCEDURE set_char_length ( select_code : type_isc ; num_char_bit: INTEGER ); PROCEDURE set_parity ( select_code : type_isc ; parity_mode : type_parity); PROCEDURE send_break ( select_code : type_isc ); PROCEDURE abort_serial ( select_code : type_isc ); IMPLEMENT IMPORT iocomasm , general_0 ; PROCEDURE set_baud_rate ( select_code : type_isc ; rate : REAL ); VAR dummy : INTEGER; FUNCTION calc_rate ( r : REAL ) : INTEGER; VAR myrate : INTEGER; BEGIN myrate := 0; IF r=50 THEN myrate := 1; IF r=75 THEN myrate := 2; IF r=110 THEN myrate := 3; IF r=134.5 THEN myrate := 4; IF r=150 THEN myrate := 5; IF r=200 THEN myrate := 6; IF r=300 THEN myrate := 7; IF r=600 THEN myrate := 8; IF r=1200 THEN myrate := 9; IF r=1800 THEN myrate :=10; IF r=2400 THEN myrate :=11; IF r=3600 THEN myrate :=12; IF r=4800 THEN myrate :=13; IF r=9600 THEN myrate :=14; IF r=19200 THEN myrate :=15; calc_rate := myrate; END; { of calc_rate } BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);  IF isc_table[select_code].card_id = hp98628_async THEN BEGIN dummy:=calc_rate(rate); IF dummy = 0 THEN io_escape(ioe_misc,select_code); iocontrol(select_code,20,dummy); { BUG 1270 TM 1/8/82 } iocontrol(select_code,21,dummy); { BUG 1270 TM 1/8/82 } END ELSE BEGIN IF (isc_table[select_code].card_id = hp98626) OR (isc_table[select_code].card_id = hp98644) THEN BEGIN dummy:=ROUND(rate); IF dummy = 0 THEN io_escape(ioe_misc,select_code); iocontrol(select_code,3,dummy); { what about 134.5 ? } END ELSE BEGIN io_escape(ioe_misc,select_code);  END; { of IF 98626 } END; { of IF 98628_async } END; { of WITH isc_table BEGIN } END; { of set_baud_rate } PROCEDURE set_stop_bits ( select_code : type_isc ; num_bits : REAL ); VAR myval : INTEGER; dummy : INTEGER; BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_misc,select_code); IF isc_table[select_code].card_id = hp98628_async THEN BEGIN  IF num_bits = 1 THEN BEGIN myval := 0; END ELSE BEGIN IF num_bits = 1.5 THEN BEGIN myval := 1; END ELSE BEGIN  IF num_bits = 2 THEN BEGIN myval :=2 END ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF 2 } END; { of IF 1.5 } END; { of IF 1 } iocontrol(select_code,35,myval); { BUG 1270 TM 1/8/82 } END ELSE BEGIN IF (isc_table[select_code].card_id = hp98626) { BUG 1269 TM 1/8/82 } OR (isc_table[select_code].card_id = hp98644) THEN BEGIN IF num_bits = 1 THEN BEGIN myval:=0; END ELSE BEGIN IF num_bits = 1.5 THEN BEGIN IF binand(iostatus(select_code,4),3)<>0 THEN io_escape(ioe_misc,select_code); myval:=1; END ELSE BEGIN IF num_bits = 2 THEN BEGIN myval:=1; END ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF 2 } END; { of IF 1.5 } END; { of IF 1 } dummy:=iostatus(select_code,4); dummy:=binand(dummy,251)+myval*4; { 0359 TM 8/26/82 } iocontrol(select_code,4,dummy); END  ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF 98626 } END; { of IF 98628_async } END; { of WITH isc_table BEGIN } END; { set_stop_bits } PROCEDURE set_char_length ( select_code : type_isc ; num_char_bit: INTEGER ); VAR myval : INTEGER; dummy : INTEGER; BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_misc,select_code); CASE num_char_bit OF 5: myval := 0; 6: myval := 1; 7: myval := 2; 8: myval := 3; OTHERWISE io_escape(ioe_misc,select_code); END; { of CASE } IF isc_table[select_code].card_id = hp98628_async  THEN BEGIN iocontrol(select_code,34,myval); END ELSE BEGIN IF(isc_table[select_code].card_id = hp98626) or (isc_table[select_code].card_id = hp98644) THEN BEGIN dummy:=iostatus( select_code,4); dummy:=binand(dummy,252)+myval; { 0359 TM 8/23/82 } iocontrol(select_code,4,dummy); { 557 TM 10/1/82 } END ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF 98626 } END; { of IF 98628_asnync } END; { of WITH isc_table BEGIN } END; { set_char_length } PROCEDURE set_parity ( select_code : type_isc ; parity_mode : type_parity); VAR myval : INTEGER; dummy : INTEGER; BEGIN WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_misc,select_code); IF isc_table[select_code].card_id = hp98628_async THEN BEGIN CASE parity_mode OF no_parity: myval := 0; odd_parity: myval := 1; even_parity: myval := 2; zero_parity: myval := 3; { 0355 TM 8/20/82 } one_parity: myval := 4; { 0355 TM 8/20/82 } OTHERWISE io_escape(ioe_misc,select_code); END; { of CASE } iocontrol(select_code,36,myval); END ELSE BEGIN IF (isc_table[select_code].card_id = hp98626) or (isc_table[select_code].card_id = hp98644) THEN BEGIN CASE parity_mode OF no_parity: myval := 0; odd_parity: myval := 1; even_parity: myval := 3; one_parity: myval := 5; zero_parity: myval := 7; OTHERWISE io_escape(ioe_misc,select_code); END; { of CASE } dummy:=iostatus(select_code,4); dummy:=binand(dummy,199)+myval*8; { 0359 TM 8/23/82 } iocontrol(select_code,4,dummy); END ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF 98626 } END; { of IF 98628_asnync } END; { of WITH isc_table BEGIN } END; { set_parity } PROCEDURE send_break ( select_code : type_isc ); BEGIN { what about active tfrs } WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_misc,select_code); IF isc_table[select_code].card_id = hp98628_async THEN BEGIN iocontrol(select_code,6,1); END ELSE BEGIN IF (card_id = hp98626) or (card_id = hp98644)  THEN BEGIN iocontrol(select_code,1,1); END ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF } END; { of IF } END; { of WITH isc_table BEGIN } END; { of send_break } PROCEDURE abort_serial ( select_code : type_isc ); BEGIN { what about active tfrs } WITH isc_table[select_code] DO BEGIN IF card_type <> serial_card THEN io_escape(ioe_misc,select_code); IF isc_table[select_code].card_id = hp98628_async THEN BEGIN iocontrol(select_code,256+125,1); { BUG xxxx TM 1/26/82 } END ELSE BEGIN IF (card_id = hp98626) or (card_id = hp98644) { BUG FIX 6/4/84 }  THEN BEGIN iocontrol(select_code,0,1); END ELSE BEGIN io_escape(ioe_misc,select_code); END; { of IF } END; { of IF } END; { of WITH isc_table BEGIN } END; { of abort_serial } END; { of serial_3 } $PAGE$ (************************************************************************) (* *) (*  *) (* PARALLEL GROUP *) (* *) (* *) (******************** ****************************************************) module parallel_3; import iodeclarations; export { IOCONTROL and IOSTATUS register definitions. } {-----------------------------------------------------------------} { level 0 registers. Registers 0 - 9 are system defined registers. } {-----------------------------------------------------------------} const PLLEL_REG_CARD_ID = 0; PLLEL_REG_RESET = 0; PLLEL_REG_INTDMA_STATUS = 1; const { for use with PLLEL_REG_CARD_ID } PARALLEL_CARDID = 6; type { for use with: PLLEL_REG_INTDMA_STATUS } intdma_status_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte; bl: io_byte); 2:(b: io_byte; {upper byte unused} ie: boolean;  ir: boolean; intlvl: 0..3; pad: 0..3; de1: boolean; de0: boolean); end; {-----------------------------------------------------------------} { level 10 registers. Register 10 - 19 are for hardware status and control. } {-----------------------------------------------------------------} const PLLEL_REG_PERIPHERAL_STATUS = 10; PLLEL_REG_COMM_STATUS = 11; PLLEL_REG_HOST_LINE_CONTROL = 12; PLLEL_REG_IO_CONTROL = 13; PLLEL_REG_FIFO = 14; type { for use with: PLLEL_REG_PERIPHERAL_STATUS } peripheral_status_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte; bl: io_byte);  2:(b: io_byte; {upper byte unused} pad: 0..hex('1F'); nerror_low: boolean; select_high: boolean; perror_high: boolean); end; const PLLEL_PERIPHERAL_ONLINE = HEX('02'); type { for use with: PLLEL_REG_COMM_STATUS } comm_status_type = packed record case integer of 0:(w:  io_word); 1:(bh: io_byte; bl: io_byte); 2:(b: io_byte; {upper byte unused} pad: 0..7; fifofull: boolean; fifoempty: boolean; nstrobe_low: boolean; {true = asserted low} busy_high: boolean; nack_low: boolean); end; type { for use with: PLLEL_REG_HOST_LINE_CONTROL } host_line_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte;  bl: io_byte); 2:(b: io_byte; {upper byte unused} pad: 0..hex('1F'); ninit_low: boolean; nselectin_low:boolean;  wr_nrd_high: boolean); end; type { for use with: PLLEL_REG_IO_CONTROL } io_control_type = packed record case integer of 0:(w: io_word);  1:(bh: io_byte; bl: io_byte); 2:(b: io_byte; {upper byte unused} pad: 0..hex('3F'); modify_io: boolean;  input_high: boolean); end; {-----------------------------------------------------------------} { level 20 registers. Register 20 - 29 are for driver status and control. } {-----------------------------------------------------------------} const PLLEL_REG_PERIPHERAL_TYPE = 20; PLLEL_REG_TYPE_RESET = 21; PLLEL_REG_PERIPHERAL_RESET = 22; PLLEL_REG_INTERRUPT_STATE = 23; PLLEL_REG_DRIVER_OPTIONS = 24; PLLEL_REG_OPTIONS_RESET = 25; PLLEL_REG_DRIVER_STATE = 26; const { for use with: PLLEL_REG_PERIPHERAL_TYPE PLLEL_REG_TYPE_RESET } NOT_PRESENT = 0; OUTPUT_ONLY = 1; HP_BIDIRECTIONAL = 2; USER_SPEC_NO_DEVICE = 10; USER_SPEC_OUTPUT_ONLY = 11; USER_SPEC_HP_BIDIRECTIONAL = 12; OUTPUT_SET = [OUTPUT_ONLY, HP_BIDIRECTIONAL, USER_SPEC_OUTPUT_ONLY, USER_SPEC_HP_BIDIRECTIONAL]; INPUT_SET = [HP_BIDIRECTIONAL,  USER_SPEC_HP_BIDIRECTIONAL]; USER_SET = [NOT_PRESENT, USER_SPEC_NO_DEVICE, USER_SPEC_OUTPUT_ONLY, USER_SPEC_HP_BIDIRECTIONAL]; type { for use with PLLEL_REG_INTERRUPT_STATE } driver_int_state_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte; bl: io_byte); 2:(b: io_byte; {upper byte unused} fifo_full: boolean; fifo_empty: boolean; pad:  boolean; busy_low: boolean; nack_low_trans:boolean; nerror_trans:boolean; select_trans:boolean; pe_trans: boolean); end; type { for use with: PLLEL_REG_DRIVER_OPTIONS PLLEL_REG_OPTIONS_RESET } driver_options_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte; bl: io_byte); 2:(b: io_byte; {upper byte unused} pad: 0..hex('f'); ignore_pe: boolean; write_verify:boolean; wr_nrd_low: boolean; use_nack: boolean); end; type { for use with PLLEL_REG_DRIVER_STATE } driver_state_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte; bl: io_byte); 2:(b: io_byte; {upper byte unused} disabled: boolean; error: boolean; write: boolean; read: boolean; pad: 0..7; active_xfer: boolean); end; const DISABLED_BY_USER = hex('80'); INACTIVE_ERROR = hex('40'); INACTIVE_WRITE = hex('20'); ACTIVE_WRITE = hex('21'); INACTIVE_READ = hex('10'); ACTIVE_READ = hex('11'); {-----------------------------------------------------------------} { level 30 registers. Registers 30 - 39 are for User IS R status and control } {-----------------------------------------------------------------} const PLLEL_REG_HOOK_STATUS = 30; PLLEL_REG_HOOK_CLEAR = 30; PLLEL_REG_USER_ISR_ENABLE = 31; PLLEL_REG_USER_ISR_STATUS = 32; const { for use with PLLEL_REG_HOOK_STATUS } USER_ISR_HOOK_INACTIVE = 0; USER_ISR_HOOK_ACTIVE = 1; type { for use with: PLLEL_REG_USER_ISR_ENABLE PLLEL_REG_USER_ISR_STATUS } user_isr_status_type = packed record case integer of 0:(w: io_word); 1:(bh: io_byte; bl: io_byte);  2:(b: io_byte; {upper byte unused} fifo_full: boolean; fifo_empty: boolean; xfer_extend: boolean; busy_low: boolean;  nack_low_trans:boolean; nerror_trans:boolean; select_trans:boolean; pe_trans: boolean); end; {-----------------------------------------------------------------} { All together now. } {-----------------------------------------------------------------} type p3regs_type = packed record case integer of 1:(w: io_word);  2:(bh: io_byte; bl: io_byte); 3:(intdma_status: intdma_status_type); 4:(peripheral_status: peripheral_status_type); 5:(comm_status:  comm_status_type); 6:(host_line: host_line_type); 7:(io_control: io_control_type); 8:(driver_int_state: driver_int_state_type); 9:(driver_options: driver_options_type); 10:(driver_state: driver_state_type); 11:(user_isr_status: user_isr_status_type); end; {-----------------------------------------------------------------} { HP Parallel interface support routines. } {-----------------------------------------------------------------} type PARALLEL_USER_ISR_TYPE = PROCEDURE(SC:TYPE_ISC); PROCEDURE SET_USER_ISR(SC:TYPE_ISC; P:PARALLEL_USER_ISR_TYPE); PROCEDURE CLEAR_USER_ISR(SC:TYPE_ISC); FUNCTION NACK_SET(SC:TYPE_ISC):BOOLEAN; implement procedure sc_check(sc:type_isc); begin with isc_table[sc] do if (card_ptr = NIL) or (card_type <> pllel_card) then io_escape(ioe_no_card, sc); end; procedure set_user_isr(sc:type_isc; p:parallel_user_isr_type); type pxlate_type = record case integer of 1:(pproc:parallel_user_isr_type); 2:(ioproc:io_proc); end; var pxlate:pxlate_type; begin sc_check(sc); pxlate.pproc := p; with isc_table[sc] do begin io_tmp_ptr^.user_isr.real_proc := pxlate.ioproc; call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_USER_ISR_ENABLE, 0); end; end; procedure clear_user_isr(sc:type_isc); begin sc_check(sc); with isc_table[sc] do begin call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_HOOK_CLEAR, 0); end; end; function nack_set(sc:type_isc):boolean; var b:boolean; begin sc_check(sc); b := false; with isc_table[sc] do  call(io_drv_ptr^.iod_end, io_tmp_ptr, b); nack_set := b; end; end. {of PARALLEL_3}  *********************************************************************** * STREAM FILE TO MAKE VARIOUS INTERFACE DRIVERS *********************** *********************************************************************** cH_DRV n cDI_DRV n cDMA_DRV n cG_DRV n aHPIB n aDISCINT n aGPIO n cIOLIB n aPLLEL_ASM n cPLLEL n aGPIODVR n aDRVASM n cDISCHPIB n ********************************************************************* * NOW LINKEM TO PRODUCE THE ACTUAL MODULES ************************** ********************************************************************* loDISCHPIB. lnDISCHPIB x Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iDISCHPIB aiDRVASM alkq loHPIB. lnHPIB dx Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iH_DRV aiHPIB alkq loDMA. lnDMA dx Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iDMA_DRV alkq lh1 oDISC_INTF. lnDISC_INTF dx Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iDI_DRV aiDISCINT alkq lh1 oGPIO. lnGPIO dx Copyright Hewlett-Packard Co.,1982,1991 All rights reserved iG_DRV aiGPIO alkq lh1 oPARALLEL. lnPARALLEL dx Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iPLLEL aiPLLEL_ASM aiIOLIB mPARALLEL_3 tlkq *********************************************************************** * DONE BUILDING AND LINKING VARIOUS INITLIB MODULES ******************* ***********************************************************************  ttl iolib extdi - 98625 disc interface drivers page ******************************************************************************** * * copyright (c) 1985 by HEWLETT-PACKARD COMPANY * ******************************************************************************** * * * iolib extdi * * ******************************************************************************** * * * * library - iolib * author - Joe Cowan * phone - 303-226-3800 ext. 2404 * * purpose - this set of assembly language code is intended to be used as * a PASCAL module for i/o drivers for use by the external i/o * procedures library. * * date - 05/03/82 * update - 08/10/83 BY J Schmidt *  release - 7/12/85 * * * source - IOLIB:DISCINT.TEXT * object - IOLIB:DISCINT.CODE * * ******************************************************************************** * * * released * version 3.1 * * ******************************************************************************** page **************************************************************************** * * *  * * bug fix history - after release * * * *  * * bug # by / on loc description * * ----- ----------- -------------- ---------------------- * * tttt J Schmidt di_wfc Changes to use timer * *  8/10/83 di_IFC on UMM boards if avail. * * input_tfr_term * * * * dew1 D Willis di_p_poll new 375 machines have * * 12/89 decreased access time to * * medussa chip, causing * * parallel poll to fail. * * added additional reads * * to medussa. * * * *   * **************************************************************************** page ******************************************************************************** * * * the following lines are used to tell the linker/loader what this module * looks like in PASCAL terms. * * note that it is possible to create assembly modules that are functions. * these routines are called through an indirect pointer using the call * facility which does not permit functions. * * this module is called 'extdi' ( upper or lower case - doesn't matter ) * independent of the file name ( by use of the mname pseudo-op ). * * all the externally used procedures are called 'extdi_@@@@@@@@' in * this module. if you are using assembly to access them use the * 'extdi_@@@@@@@' name. if you are using PASCAL use the '@@@@@@@' * name. * ******************************************************************************** mname extdi src module extdi; src import iodeclarations; src export src procedure edi_init ( temp : anyptr ); src procedure edi_isr ( temp : anyptr ); src procedure edi_rdb ( temp : anyptr ; var x : char); src procedure edi_wtb ( temp : anyptr ; val : char); src procedure edi_rdw ( temp : anyptr ; var x : io_word); src procedure edi_wtw ( temp : anyptr ; val : io_word); src procedure edi_rds ( temp : anyptr ; reg : io_word; src var x : io_word); src procedure edi_wtc ( temp : anyptr ; reg : io_word; src val : io_word ); src procedure edi_tfr ( temp : anyptr ; bcb : anyptr ); src procedure edi_send ( temp : anyptr ; val : char ); src procedure edi_end ( temp : anyptr ; var x : boolean ); src procedure edi_ppoll ( temp : anyptr ; var x : char ); src procedure edi_clr ( temp : anyptr ; line : io_bit ); src procedure edi_set ( temp : anyptr ; line : io_bit ); src procedure edi_test ( temp : anyptr ; line : io_bit ; src var x : boolean ); src src end; { of extdi } page ******************************************************************************** * * symbols for export as procedure names * ******************************************************************************** def  extdi_extdi def extdi_edi_init def extdi_edi_isr def extdi_edi_rdb def extdi_edi_wtb def extdi_edi_rdw def extdi_edi_wtw def extdi_edi_rds def extdi_edi_wtc def extdi_edi_tfr def extdi_edi_send def extdi_edi_ppoll def extdi_edi_set def extdi_edi_clr def extdi_edi_test def extdi_edi_end ******************************************************************************** * * symbols for import - common assembly language routines * * the routines are in the module common_assembly and powerup * ******************************************************************************** refa dropdma give up DMA resource refa getdma actually get DMA refa testdma check to see if DMA is available refa logint branch to user isr refa logeot branch to user eot refa stbsy set buffer busy refa stclr set buffer not busy refa DMA_stbsy set buffer DMA busy refa itxfr is there a tfr active ? refa abort_io kill any tfr active refa wait_tfr timed wait for tfr active refa check_tfr timed wait for tfr - direction refa check_timer use for timeouts with hw timer tttt jws refa delay_timer use for all delays tttt jws lmode dropdma,getdma,testdma,logint,logeot,stbsy lmode stclr,DMA_stbsy,itxfr,abort_io,wait_tfr,check_tfr lmode check_timer,delay_ timer tttt jws ttl iolib extdi - common equates and definitions page include COMDCL ttl iolib extdi - disc interface card temp definitions page * * disc interface card temp definitions * ABI equ avail_off+0 PHI/ABI flag EOI_in equ avail_off+1 EOI flag for previous byte in EOI_out equ avail_off+2 EOI flag for next byte out flags equ avail_off+5 driver flags and status byte 0 mask: *  bit 0: pass control flag * bit 1: not used * bit 2: error indicator * bit 3: IFC indicator *  bit 4: dcl indicator * bit 5: get indicator * bit 6: current rsv status bit. * bit 7: if set, 9914 is in holdoff mode, therefore * issue release hold off before reading, and * use take control sync to set ATN. ppollmsk equ avail_off+6 value to put in di_ppoll when ist = 1 *  equ avail_off+7 value to put in di_ppoll when ist = 0 DMA_count equ avail_off+8 remaining DMA count DMA_arm_addr equ avail_off+12 arm address of the assigned DMA channel DMA_arm_word equ avail_off+16  arm word of the assigned DMA channel ttl iolib extdi - PASCAL entry points page ******************************************************************************** * * PASCAL driver entry points for disc interface cards * ******************************************************************************** * * module initialization * extdi_extdi rts do nothing * * driver initialization * extdi_edi_init movea.l (sp)+,a0 get return address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_init * * interrupt service routine * extdi_edi_isr movea.l (sp)+,a0 get return address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_isr * * read a byte * extdi_edi_rdb movea.l (sp)+,a0 get return address movea.l (sp)+,a3 get var address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack  bsr di_rdb call read byte move.b d0,(a3) save character rts * * write a byte * extdi_edi_wtb movea.l (sp)+,a0 get return address move.b (sp)+,d0 get value movea.l (sp)+,a2  get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_wtb call write byte page * * read a word * extdi_edi_rdw movea.l (sp)+,a0 get return address movea.l (sp)+,a3 get var address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack  bsr di_rdb read first byte move.b d0,(a3)+ save first byte bsr di_rdb read second byte move.b d0,(a3) save second byte rts * * write a word * extdi_edi_wtw movea.l (sp)+,a0 get return address move (sp)+,d0 get word value movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack  move.b d0,d5 save second byte lsr #8,d0 bsr di_wtb write the byte move.b d5,d0 get the second byte bra di_wtb write the byte * * read status * extdi_edi_rds movea.l (sp)+,a0 get return address movea.l (sp)+,a3 get var address move (sp)+,d1 get register number movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address  pea (a0) push return address back on stack bsr di_rds read status move d0,(a3) save status info rts * * write control * extdi_edi_wtc movea.l (sp)+,a0 get return address move (sp)+,d0 get value move (sp)+,d1 get register number movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_wtc write control page * * transfer * extdi_edi_tfr movea.l (sp)+,a0 get return address movea.l (sp)+,a3 get buffer control block address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_tfr transfer * * send an 'ATN' true command * extdi_edi_send movea.l (sp)+,a0  get return address move.b (sp)+,d0 get value movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_r6out  send command byte * * perform a parallel poll * extdi_edi_ppoll movea.l (sp)+,a0 get return address movea.l (sp)+,a3 get var address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1  get card address pea (a0) push return address back on stack bsr di_p_poll do a parallel poll move.b d0,(a3) save value rts * * set an hpib line * extdi_edi_set movea.l (sp)+,a0  get return address move (sp)+,d1 get line movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bra di_set call set line * * clear an hpib line * extdi_edi_clr movea.l (sp)+,a0 get return address move (sp)+,d1 get line movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1  get card address pea (a0) push return address back on stack bra di_clr clear the line page * * test an hpib line * extdi_edi_test movea.l (sp)+,a0 get return address movea.l (sp)+,a3  get var address move (sp)+,d1 get line movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack bsr di_test read status move.b d0,(a3) save character rts * * test for EOI/end condition * extdi_edi_end movea.l (sp)+,a0 get return address movea.l (sp)+,a3 get var address movea.l (sp)+,a2 get temp address movea.l c_adr(a2),a1 get card address pea (a0) push return address back on stack move.b EOI_in(a2),d0 get eor flag byte lsr.b #7,d0 PASCAL needs it [0..1] move.b d0,(a3) save condition rts ttl iolib extdi - disc interface card declarations page ******************************************************************************** * * disc interface card address equates ( offs ets from a1 ) * ******************************************************************************** cardid equ $01 read card identification cardreset equ $01 write card software reset cardstatus equ $03 read  card status cardcontrol equ $03 write card control cardlatch equ $07 read/write latch for testing card buffers intreg equ $11 read/write PHI/ABI interrupt register intmask equ $13 read/write PHI/ABI interrupt mask fifo equ $15 read/write PHI/ABI inbound/outbound fifo status equ $17 read/write PHI/ABI status register control equ $19 read/write PHI/ABI control register address equ $1B read/write PHI/ABI hp-ib address register ppolmask equ $1D read/write PHI/ABI parallel poll mask register ppolsense equ $1F read/write PHI/ABI parallel poll sense register ******************************************************************************** * * hp-ib command equates * ******************************************************************************** gtl equ 1 go to local sdc equ 4 selective device clear ppc equ 5 ppoll configure get equ 8 group execute trigger tct equ 9 take control llo equ 17 local lockout dcl equ 20 device clear ppu equ 21 ppoll unconfigure spe equ 24 spoll enable spd equ 25 spoll disable unl equ 63 unlisten unt equ 95  untalk ppe equ 96 ppoll enable ppd equ 112 ppoll disable ttl iolib extdi - disc interface drivers page ******************************************************************************** * *  di_init * * initialize a disc interface card * ******************************************************************************** di_init moveq #30,d0 my address if active controller bsr.s di_init_s start software reset bne di_IFC if system controller, branch rts ******************************************************************************** * * di_int_s * * subroutine used for both initialization and wtc: * ******************************************************************************** * * software reset the card * di_init_s moveq #$80,d1 prepare to... move.b d1,cardreset(a1) software reset the card (PHI/ABI pon) move.b d1,control(a1) set 8-bit mode move.b d1,control(a1) once more, to guarantee high-order bit values move d0,ma_w(a2) save my address add.b d1,d0 set the "online" bit move.b d1,status(a1) prepare to enable CRC if ABI move.b d0,address(a1) bring PHI/ABI online with specified address tst.b address(a1) is this an ABI? btst #7,status(a1) a writeable CRC bit will tell sne ABI(a2) remember it * * set up the interrupt register & driver temps * jsr abort_io cleanup any attached buffer sf EOI_in(a2) clear the EOI in flag sf EOI_out(a2) clear the EOI out flag lea status(a1),a0 point to the status register move.b #$80,(a0) set high-order bits move.b #$00,intmask(a1) initial interrupt mask ???????????????? move.b #$80,cardcontrol(a1) enable card interrupts btst #3,(a0)  is this THE system controller? rts (leave cc for caller) page ******************************************************************************** * * di_rdb * * read a byte of data from hp-ib * * ex it: d0.l = byte read * ******************************************************************************** di_rdb lea status(a1),a0 point to the status register btst #1,(a0) make sure addressed to listen beq.s  di_lsterr else give error btst #4,(a0) active controller? beq.s di_rdb1 branch if not move.b #$80,(a0) inhibit LF detection move.b #1,fifo(a1) enable a 1 byte counted transfer di_rdb1 bsr.s di_wait_fb now wait for fifo byte moveq #0,d0 clear upper part of d0 move.b fifo(a1),d0 and put data in lower byte btst #6,status(a1) tagged with EOI? sne  EOI_in(a2) remember it rts done! ******************************************************************************** * * di_wtb * * write a byte of data to hp-ib * * entry: d0.b = byte to write * * hpl routine * ******************************************************************************** di_wtb btst #2,status(a1) make sure addressed to talk beq.s di_tlkerr else error bsr.s di_wait_fi wait for fifo idle move.b EOI_out(a2),d2 EOI out flag lsl.b #7,d2 prepare to... move.b d2,status(a1) set the high-order bits move.b d0,fifo(a1) move the data out sf EOI_out(a2) clear the EOI out flag rts done! ttl iolib extdi - error escapes page ******************************************************************************** * * error escapes * ******************************************************************************** di_scbsy moveq #sc_busy,d0 buffer is busy bra.s esc_err di_sc_err moveq #bad_sct,d0 bad set/clear/test bra.s esc_err di_notactl moveq #no_actl,d0 not active controller bra.s esc_err di_notsctl moveq #no_sctl,d0 not system controller bra.s esc_err hterr_b moveq #tfr_err,d0 bad transfer specification bra.s esc_err hterr_d moveq #no_DMA,d0 DMA not installed bra.s esc_err di_noword moveq #no_word,d0 word transfers not allowed bra.s esc_err di_lsterr moveq #not_lstn,d0 not addressed as listener bra.s esc_err di_tlkerr moveq #not_talk,d0 not addressed as talker bra.s esc_err di_tmo moveq #tmo_err,d0 timeout * bra.s esc_err esc_err move.l d0,ioe_rslt(a5) save error in io space move.b io_sc(a2),d0 \ get sc for error move.l d0,ioe_sc(a5) / move #ioe_error,esc_code(a5) save system esc code trap #10 escape page ******************************************************************************** * * wait for fifo idle or fifo byte routines * ******************************************************************************** di_wait_fi moveq #1,d1 fifo idle is bit 1 bra.s di_wfc di_wait_fb moveq #2,d1  fifo byte is bit 2 * * generalized wait for condition routine * di_wfc clr.b cardcontrol(a1) disable card interrupts bset d1,intmask(a1) unmask the appropriate interrupt bit lea intreg(a1),a0  point to the interrupt register * * quick low-overhead loop * move.l #254,d2 quick loop counter * * Count changed from 127 to 254 tttt jws 8/10/83 * di_wfc_quick btst d1,(a0) condition met? bne.s di_wfc_done branch if so dbra d2,di_wfc_quick loop until quick count expires * * timed wait loop * move.l timeout(a2),d2 current timeout beq.s di_wfc_infinite branch if infinite timeout btst #time r_present,sysflag2 check if timer tttt jws beq.s di_wfc_timer br if got it tttt jws mulu #491,d2 loop iterations per millisecond di_wfc_timed btst d1,(a0) condition met? bne.s di_wfc_done branch if so subq.l #1,d2 decrement the loop counter bhi di_wfc_timed loop until count expired bclr d1,intmask(a1) re-mask the appropriate interrupt bit move.b #$80,cardcontrol(a1)  re-enable card interrupts bra di_tmo escape with timeout error * * infinite wait loop * di_wfc_infinite btst d1,(a0) condition met? beq di_wfc_infinite loop until so * * wait for condition done * di_wfc_done bclr d1,intmask(a1) re-mask the appropriate interrupt bit move.b #$80,cardcontrol(a1) re-enable card interrupts rts done! * * Wait using the timer tttt jws * di_wfc_timer move.b #1,-(sp) setup timer record tttt jws 8/10/83 move.l d2,-(sp) tttt jws 8/10/83 di_wfc_tloop btst d1,(a0) check condition tttt jws 8/10/83 bne.s di_wfc_texit if true, exit tttt jws 8/10/83 pea (sp) else call timer tttt jws 8/10/83 jsr check_timer check routine tttt jws 8/10/83 bpl di_wfc_tloop ok -- loop tttt jws 8/10/83 addq #6,sp timeout, clean stk tttt jws 5/2/84 moveq #10,d2 try again with a tttt jws 5/2/84 bra di_wfc_timed short count tttt jws 5/2/84 di_wfc_texit addq #6,sp cleanup stack tttt jws 8/10/83 bra di_wfc_done  and continue tttt jws 8/10/83 page ******************************************************************************** * * di_rds * * read status * * PASCAL routine * ******************************************************************************** di_rds cmp #8,d1 register within range? bhi.s rds_err branch if not add d1,d1 two bytes per table entry move rds_table(d1),d1 load routine offset  jmp rds_table(d1) jump to the appropriate routine * * rds jump table * rds_table dc rds_0-rds_table status 0 dc rds_1-rds_table status 1 dc rds_2-rds_table status 2 dc rds_3-rds_table status 3 dc rds_4-rds_table status 4 dc rds_5-rds_table status 5 dc rds_6-rds_table status 6 dc rds_7-rds_table status 7 dc rds_8-rds_table status 8 rds_1 equ * rds_2 equ * rds_4 equ * rds_5 equ * rds_7 equ * rds_8 equ * rds_err moveq #bad_rds,d0 bad read status bra esc_err page * * status 0 - card ID * rds_0 moveq #8,d0  Simon's ID rts * * status 3 - controller status & address * rds_3 moveq #0,d0 ZZZZZZZZ ZZZZZZZZ move.b status(a1),d0 ZZZZZZZZ 76543210 rol.b #4,d0 ZZZZZZZZ 32107654 lsl #1,d0 ZZZZZZZ3 2107654Z lsl.b #6,d0 ZZZZZZZ3 4ZZZZZZZ lsr #1,d0 ZZZZZZZZ 34ZZZZZZ add.b ma(a2),d0 ZZZZZZZZ 34ZAAAAA rts * * status 6 - interface status * rds_6  bsr rds_3 ZZZZZZZZ ZZZZZZZZ ZZZZZZZZ LLLLLLLL ror.l #8,d0 LLLLLLLL ZZZZZZZZ ZZZZZZZZ ZZZZZZZZ move.b status(a1),d0 LLLLLLLL ZZZZZZZZ ZZZZZZZZ 76543210 rol #1,d0 LLLLLLLL ZZZZZZZZ ZZZZZZZ7 6543210Z ror.l #1,d0 ZLLLLLLL LZZZZZZZ ZZZZZZZZ 76543210 ror.b #2,d0 ZLLLLLLL LZZZZZZZ ZZZZZZZZ 10765432 ror.l #1,d0 2ZLLLLLL LLZZZZZZ ZZZZZZZZ Z1076543 rol.b #2,d0 2ZLLLLLL LLZZZZZZ ZZZZZZZZ 076543Z1 ror.l #1,d0   12ZLLLLL LLLZZZZZ ZZZZZZZZ Z076543Z rol #4,d0 12ZLLLLL LLLZZZZZ ZZZZZ076 543ZZZZZ ror.l #4,d0 ZZZZ12ZL LLLLLLLZ ZZZZZZZZ Z076543Z ror.b #3,d0 ZZZZ12ZL LLLLLLLZ ZZZZZZZZ 43ZZ0765 ror.l #1,d0 5ZZZZ12Z LLLLLLLL ZZZZZZZZ Z43ZZ076 swap d0 ZZZZZZZZ Z43ZZ076 5ZZZZ12Z LLLLLLLL rts whew!!! page ******************************************************************************** * * di_wtc * * write control * * entry: d0.w = parameter * ******************************************************************************** di_wtc cmpi #1,d1 register within range? bhi.s rds_err branch if not add d1,d1 two bytes per table entry jmp hwtctbl(d1) jump to the appropriate routine hwtctbl bra.s di_wtc_rst control 0 - do a reset bra.s di_rqs control 1 - set SRQ response * bra.s di_wtc_ppc control 2 - ppoll configure * bra.s di_wtc_sma control 3 - set my addr * bra.s rds_err control 4 - not used * bra.s rds_err  control 5 - enable interrupts * * software reset * di_wtc_rst move.b ma(a2),d0 else use previous address hpl_wtc1 move.b status(a1),-(sp) save controller active state. bsr di_init_s do software reset btst #4,(sp)+ were we active controller? beq.s hpl_wtc2 if not, skip nop ??????????????????????????????????????????????? hpl_wtc2 rts else done * * request service * di_rqs bclr #6,flags(a2) assume rsv = 0 in this new byte move.b d0,d1 if rsv bit in the new byte is indeed bclr #6,d1 zero, then just output the new byte. beq.s di_rqs2 *  move.b d1,di_spoll(a1) else first write the byte with rsv bset #6,flags(a2) clear. remember that rsv is set. di_rqs2 move.b d0,(a1) << NIL THEN ISRUNLINK(3, { interrupt level } ADDR(dma_isrib0)); { ptr to the isrib } IF dma_isrib1.INTREGADDR <> NIL THEN ISRUNLINK(3, { interrupt level } ADDR(dma_isrib1)); { ptr to the isrib } { if the card exists then link in an ISR for it } IF dma_here THEN WITH isc_table[3] DO BEGIN { dma if installed is always int. level 3 } PERMISRLINK(dma_isr_0, { channel 0 isr } ANYPTR(INTEGER(card_ptr)+7), { channel 0 addr } 2,  { int reg mask } 2, { int reg value } 3, { int level } ADDR(dma_isrib0)); { isrib 0 info } PERMISRLINK(dma_isr_1, { channel 1 isr } ANYPTR(INTEGER(card_ptr)+15), { channel 1 addr } 2, { int reg mask } 2, { int reg value }  3, { int level } ADDR(dma_isrib1)); { isrib 1 info } END; { of IF } END; { of io_init_dma } END; { of MODULE init_dma } $PAGE$ IMPORT init_dma , LOADER ;  { 367 TM 9/22/82 } BEGIN io_init_dma; MARKUSER; { 367 TM 9/22/82 } END. { of dma_initialize }  TTL IOLIB EXTG - GPIO DRIVERS PAGE ******************************************************************************** * * COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY * ******************************************************************************** * * * IOLIB EXTG * * ******************************************************************************** * * * * Library - IOLIB * Author - Tim Mikkelsen * Phone - 303-226-3800 ext. 2910 * * Purpose - This set of assembly language code is intended to be used as * a PASCAL module for I/O drivers for use by the external I/O * procedures library. * * Much of this code was taken from Andy Goris' HPL GPIO * drivers. * * Date - 09/20/81 * Update - 04/26/84 BY J Schmidt * Release - 07/12/85 * * * Source - IOLIB:GPIO.TEXT * Object - IOLIB:GPIO.CODE * * ********************************************************************************   * * * RELEASED * VERSION 3.1 * * ******************************************************************************** PAGE **************************************************************************** *  * * * * BUG FIX HISTORY - after release 1.0 * *  * * * * BUG # BY / ON LOC DESCRIPTION * * ----- ----------- -------------- ---------------------- * *  * * SPR836 T Mikkelsen G_SET_PCT a IOCONTROL(x,1,1); does * * 08/09/1982 not set the PCTL line, it * *  resets the interface. * * * * 475 T Mikkelsen all over Change BSRs into JSRs to * * 09/17/1982 allow re-placement of the * * modules. Also in HPIB and * * Data comm modules. * * * * 507 T Mikkelsen G_TFI Did not do a trigger to the * * 09/17/1982 gpio card before a FHS tfr. * * * * 508 T Mikkelsen G_WTC Typographical error in * * 09/17/1982 write control to CTL0/1. * * * * xxx T Mikkelsen G_TFR Transfer should wait for * * 10/06/1982 card to be ready ( ala the * * HPL system ). * * * * yyy J Schmidt G_INIT Changes for timing on * * 8/1/83 G_WAIT 680xx UMM CPU boards * * 5/2/84 G_STSCHK * *  * * 69 J Schmidt G_WTC Missing inst. in set CTL0/1 * * (3.0 QA) 4/26/84 * *  * * SPR12724 J Schmidt G_TFR Clear upper byte on byte * * 5/3/84 transfers * **************************************************************************** PAGE ******************************************************************************** * * * The following lines are used to tell the LINKER/LOADER what this module * looks like in PASCAL terms. * * Note that it is possible to create assembly modules that are functions. * These routines are called through an indirect pointer using the CALL * facility which does NOT permit functions. * * This module is called 'EXTG' ( upper or lower case - doesn't matter ) * independent of the file name ( by use of the MNAME pseudo-op ). * * All the externally used procedures are called 'EXTG_@@@@@@@@' in * this module. If you are using assembly to access them use the * 'EXTG_@@@@@@@' name. If you are using Pascal use the '@@@@@@@' * name. * ******************************************************************************** MNAME EXTG SRC MODULE EXTG; SRC IMPORT iodeclarations; SRC EXPORT SRC PROCEDURE eg_init ( temp : ANYPTR ); SRC PROCEDURE eg_is  r ( temp : ANYPTR ); SRC PROCEDURE eg_rdb ( temp : ANYPTR ; VAR x : CHAR); SRC PROCEDURE eg_wtb ( temp : ANYPTR ; val : CHAR); SRC PROCEDURE eg_rdw ( temp : ANYPTR ; VAR x : io_word); SRC PROCEDURE eg_wtw ( temp : ANYPTR ; val : io_word); SRC PROCEDURE eg_rds ( temp : ANYPTR ; reg : io_word; SRC VAR x : io_word); SRC PROCEDURE eg_wtc ( temp : ANYPTR ; reg : io_word; SRC  val : io_word ); SRC PROCEDURE eg_tfr ( temp : ANYPTR ; bcb : ANYPTR ); SRC PROCEDURE eg_clr ( temp : ANYPTR ; line : io_bit ); SRC PROCEDURE eg_set ( temp : ANYPTR ; line : io_bit ); SRC PROCEDURE eg_test ( temp : ANYPTR ; line : io_bit ; SRC VAR x : BOOLEAN ); SRC END; { of EXTG } PAGE ******************************************************************************** * * SYMBOLS FOR EXPORT AS PROCEDURE NAMES * ******************************************************************************** DEF EXTG_EXTG SPC 1 DEF EXTG_EG_INIT DEF EXTG_EG_ISR,EXTG_EG_TDMA DEF EXTG_EG_RDB,EXTG_EG_WTB DEF EXTG_EG_RDW,EXTG_EG_WTW DEF EXTG_EG_RDS,EXTG_EG_WTC DEF EXTG_EG_TFR SPC 1 DEF EXTG_EG_SET,EXTG_EG_CLR,EXTG_EG_TEST SPC 1 ******************************************************************************** * * SYMBOLS FOR IMPORT * ******************************************************************************** REFA STBSY REFA STCLR REFA ITXFR REFA ABORT_IO REFA LOGINT REFA GETDMA REFA DROPDMA REFA TESTDMA REFA DMA_STBSY REFA WAIT_TFR REFA CHECK_TFR REFA CHECK_TIMER yyyy JS 8/ 1/83 REFA DELAY_TIMER yyyy JS 8/ 1/83 * * change references to allow long jumps when the I/O 475 TM 9/17/82 * modules get moved around 475 TM 9/17/82 LMODE STBSY  475 TM 9/17/82 LMODE STCLR 475 TM 9/17/82 LMODE ITXFR 475 TM 9/17/82 LMODE ABORT_IO 475 TM 9/17/82 LMODE LOGINT 475 TM 9/17/82 LMODE GETDMA 475 TM 9/17/82 LMODE DROPDMA 475 TM 9/17/82 LMODE TESTDMA  475 TM 9/17/82 LMODE DMA_STBSY 475 TM 9/17/82 LMODE WAIT_TFR 475 TM 9/17/82 LMODE CHECK_TFR 475 TM 9/17/82 LMODE CHECK_TIMER yyyy JS 8/ 1/83 LMODE DELAY_TIMER yyyy JS 8/ 1/83 TTL IOLIB EXTG - COMMON DECLARATIONS AND EQUATES PAGE INCLUDE COMDCL TTL IOLIB EXTG - PASCAL ENTRY POINTS ******************************************************************************** * * PASCAL DRIVER ENTRY POINTS FOR GPIO CARDS * ******************************************************************************** SPC 1 * * MODULE initialization * EXTG_EXTG EQU * RTS * * Driver initialization * EXTG_EG_INIT EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_INIT * * Interrupt service routine * EXTG_EG_ISR EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_ISR * * HPIB DMA transfer termination routine * EXTG_EG_TDMA EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA !  (A0) push return address back on stack BRA G_DMATERM * * Read a byte * EXTG_EG_RDB EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BSR G_RDB call read byte ( or word ) MOVE.B D0,(A3) save character RTS * * Write a byte * EXTG_EG_WTB EQU * MOVEA.L (SP)+,A0 get return address MOVE.B (SP)+,D0 get value ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_WTB call write byte ( or word ) * * Read a word * EXTG_EG_RDW EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BSR G_RDB call read byte ( or word ) MOVE.W D0,(A3) save word RTS * * Write a word * EXTG_EG_WTW EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D0 get word value MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_WTB write the byte ( or word ) * * Read status * EXTG_EG_RDS EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVE.W (SP)+,D1 get register number MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA  (A0) push return address back on stack BSR G_RDS get status MOVE.W D0,(A3) save status info RTS * * Write control * EXTG_EG_WTC EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D0  get value MOVE.W (SP)+,D1 get register number MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_WTC write control * * Transfer * EXTG_EG_TFR EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get buffer control block address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_TFR transfer * * Set an GPIO line * EXTG_EG_SET EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D1 get line ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_SET call set line * * Clear an GPIO line * EXTG_EG_CLR EQU * MOVEA.L (SP)+,A0 get return address  MOVE.W (SP)+,D1 get line ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA G_CLR clear the line * * Test an GPIO line * EXTG_EG_TEST EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVE.W (SP)+,D1 get line ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BSR G_TEST read status MOVE.B D0,(A3) save character RTS TTL IOLIB EXTG - GPIO DRIVERS PAGE ****************************************** * * GPIO INITIALIZATION * ****************************************** G_INIT EQU * G_RESET JSR ABORT_IO 475 TM 9/17/82 MOVE.W #-1,MA_W(A2) the card is not addressable - so my addr =-1 MOV! E.B D0,1(A1) Reset the GPIO card MOVE.L #40,-(SP) Wait AT LEAST 15 microseconds JSR DELAY_TIMER USE DELAY ROUTINE 40 uS yyyy JS 8/1/83 MOVE.B #3,2(A1) RTS SPC 6 ****************************************** * * IOFS * ****************************************** G_IOFS MOVEQ #0,D0 BTST #3,7(A1) PSTS -> D0<0> BEQ.S G_IOFS1 MOVEQ #1,D0 G_IOFS1 BTST #0,(A1) PFLG -> D0<1> BEQ.S G_IOFS2 ADDQ #2,D0 G_IOFS2 RTS PAGE ****************************************** * * wtb * ****************************************** G_WTB BSR.S G_STSCHK Check for PSTS BSR.S G_WAIT Wait for FLG MOVE.W D0,4(A1) Write the word MOVE.B D0,(A1) wti 7,0 trigger output RTS SPC  3 ****************************************** * * rdb * ****************************************** G_RDB BSR.S G_STSCHK Check for PSTS BSR.S G_WAIT MOVE.W 4(A1),D0 Set I/O line for input MOVE.B D0,(A1) wti 7,0 trigger input BSR.S G_WAIT Wait for data to come in MOVE.W 4(A1),D0 RTS SPC 6 G_STSCHK BTST #3,7(A1) CHECK FOR PSTS OK yyyy JS 8/1/83 BNE.S G_STSRTS IF OK THEN RETURN yyyy JS 8/1/83 BTST #TIMER_PRESENT,SYSFLAG2 TIMER EXISTS? yyyy JS 8/1/83 BEQ.S G_STS0B YES, USE IT yyyy JS 8/1/83 MOVE D0,-(SP) SAVE D0 yyyy JS 8/1/83 MOVE #22000,D0 SETUP 100MS LOOP yyyy JS 8/1/83 G_STS0 BTST #3,7(A1) Is PSTS O.K. ? BEQ.S G_STS1 No: Give him 100 ms MOVE (SP)+,D0 Yes: Restore D0 G_STSRTS RTS G_STS1 DBRA D0,G_STS0 Decrement loop counter BRA CRD_DOWN If counter expires, card is down G_STS0B MOVE.B #1,-(SP) SETUP TIMER RECORD yyyy JS 8/1/83 MOVE.L #100,-(SP) LOOP FOR 100 MS yyyy JS 8/1/83 G_STS0C BTST #3,7(A1) PSTS SET ? yyyy JS 8/1/83 BNE.S G_STS1B YES, RETURN yyyy JS 8/1/83 PEA (SP) CHECK TIMER yyyy JS 8/1/83 JSR CHECK_TIMER SEE IF 100MS GONE yyyy JS 8/1/83 BPL G_STS0C NO, CHECK PSTS yyyy JS 8/1/83 BTST #3,7(A1) LAST CHANCE TEST yyyy JS 5/2/84 BEQ CRD_DOWN IF NOT PSTS, ERROR yyyy JS 5/2/84 G_STS1B ADDQ #6,SP STRIP TIMER REC yyyy JS 8/1/83 RTS AND RETURN yyyy JS 8/1/83 PAGE ****************************************** * * GPIO WAIT ROUTINE * ****************************************** G_WAIT BTST #0,(A1) IF CARD_READY THEN RETURN BNE.S G_WRTS MOVE.L TIMEOUT(A2),D1 D1 = (TIMEOUT) BEQ.S G_WAIT4 BTST #TIMER_PRESENT,SYSFLAG2 GOT A TIMER? yyyy JS 8/1/83 BEQ.S G_WAIT2B YES, SO USE IT yyyy JS 8/1/83 G_WAIT2 EQU * * tm MULU #182,D1 CONVERT D1 TO MILLISECONDS MOVE.L D1,D5 \ LSL.L #7,D1 \ * 196 IS CLOSE TO * 182 LSL.L #6,D5 / ADD.L D5,D1 / G_WAIT3 BTST #0,(A1) WHILE D1 MILLISECONDS HAS NOT EXPIRED DO BNE.S G_WRTS IF CARD_READY THEN RETURN SUBQ.L #1,D1 BGT.S G_WAIT3 G_WAITER MOVEQ #TMO_ERR,D0 GENERATE ESCAPE BRA.S ESC_ERR SPC 4 G_WAIT4 BTST #0,(A1) IF CARD_READY THEN RETURN BEQ.S G_WAIT4 G_WRTS RTS G_WAIT2B MOVE.B #1,-(SP) SETUP TIMER RECORD yyyy JS 8/1/83 MOVE.L D1,-(SP) D1 HAS MS TO WAIT yyyy JS 8/1/83 G_WAIT3B MOVE.L #364,D1 INNER LOOP TO GET 1 MS AT yyyy JS 8/1/83 G_WAIT4B BTST #0,(A1) 16 MHZ -- CHECK FOR READY yyyy JS 8/1/83 BNE.S G_WAIT5B READY -- EXIT THE LOOP yyyy JS 8/1/83 SUBQ.L #1,D1 ELSE LOOP FOR 1-2 MS HERE yyyy JS 8/1/83 BGT G_WAIT4B yyyy JS 8/1/83 PEA (SP) AFTER INNER LOOP CHECK TIMER yyyy JS 8/1/83 JSR CHECK_TIMER yyyy JS 8/1/83 BPL G_WAIT3B BRANCH IF NO TIMEOUT yyyy JS 8/1/83 BTST #0,(A1) TIMEOUT -- LAST CHANCE yyyy JS 5/2/84 BEQ G_WAITER "  REAL TIMEOUT IF NOT READY yyyy JS 5/2/84 G_WAIT5B ADDQ #6,SP CLEAN UP STACK yyyy JS 8/1/83 RTS DONE yyyy JS 8/1/83 TTL IOLIB EXTG - ERROR ESCAPES PAGE ******************************************************************************** * * Error escapes * ******************************************************************************** G_SCBSY MOVEQ #SC_BUSY,D0 sc is busy BRA.S ESC_ERR CRD_DOWN MOVEQ #CRD_DWN,D0 CARD IS DOWN BRA.S ESC_ERR G_SC_ERR MOVEQ #BAD_SCT,D0 bad set/clear/test BRA.S ESC_ERR GTERR_B MOVEQ #TFR_ERR,D0 bad transfer specification BRA.S ESC_ERR GTERR_D MOVEQ #NO_DMA,D0 DMA not installed * BRA.S ESC_ERR SPC 4 ESC_ERR EXT.L D0 assume errors<128 MOVE.L D0,IOE_RSLT(A5) save ioe_result MOVE.B IO_SC(A2),D0 MOVE.L D0,IOE_SC(A5) save io s.c. MOVE.W #IOE_ERROR,ESC_CODE(A5) TRAP #10 escape TTL IOLIB EXTG - GPIO DRIVERS PAGE ******************************************** * * LINE DEFINITIONS * * bit 0 STI0 * 1 STI1 * 2 EIR *  3 PSTS * 4 CTL0 * 5 CTL1 * 6 READY * 7 PCTL * ******************************************** SPC 3 ******************************************** * * SET LINE * ******************************************** G_SET AND.B #7,D1 MASK TO RIGHT SIZE CMP.B #5,D1 \ HANDLE SET PCTL BEQ.S GSET_1 / CMP.B #6,D1 \ CAN ONLY SET BLT.S G_SC_ERR / CTL0/1 SUB.B #5,D1 GET INTO 1/2 FORM OR.B D1,7(A1) SET CTL0 or 1 OR.B D1,EIRB_OFF(A2) SAVE IN EIRB RTS GSET_1 MOVE.B D1,0(A1) SET PCTL RTS SPC 3 ******************************************** * * CLEAR LINE * ******************************************** G_CLR AND.B #7,D1 MASK TO RIGHT SIZE CMP.B #6,D1 \ CAN ONLY CLEAR BLT.S G_SC_ERR / CTL0/1 MOVE.B EIRB_OFF(A2),D0 GET OLD CTL0/1 SUB.B #6,D1 GET INTO 0/1 FORM BCLR D1,D0 CLEAR COPY MOVE.B D0,EIRB_OFF(A2) SAVE IN EIRB MOVE.B D0,7(A1) WRITE TO CARD RTS SPC 3 ******************************************** * * TEST LINE * ******************************************** G_TEST CLR.W D0  set FALSE indication AND.B #7,D1 mask to the right size CMP.B #7,D1 \ CHECK FOR PCTL BEQ G_SC_ERR / AND GIVE ERROR CMP.B #3,D1 BGT.S GTST2 GTST1 BTST D1,7(A1) TEST ST0/1,EIR,or psts GTST_CHK BEQ.S GTST_RTS if clear then RTS GTST_SET MOVEQ #1,D0 else return true indication GTST_RTS RTS SPC 2 GTST2 SUB.B #4,D1 CMP.B #1,D1 BGT.S GTST4 GTST3 BTST D1,EIRB_OFF(A2) TEST CTL0/1 BRA.S GTST_CHK GO TO COMMON CHECK CODE SPC 2 GTST4 BTST #0,0(A1) CHECK READY LINE BRA.S GTST_CHK PAGE ******************************************************************************** * * G_RDS * * READ STATUS * * PASCAL ROUTINE * ******************************************************************************** G_ROUTINE EQU 2 G_TEMP EQU 1 G_CRDREG EQU 0 * * G_RDS LEA G_RDSTBL,A0 get pointer to lookup table ADD.W D1,D1 multiply the rds register by 2 CMP.B #G_RT_SIZ,D1 \ check for out of bounds BGE.S RDS_ERR / MOVE.W 0(A0,D1),D0 get the table entry BMI.S RDS_ERR if the entry is 0 then error CMP.B #G_TEMP,D0 * tm  BEQ.S GR_TEMP BLT.S GR_CARD LSR #8,D0 get the routine offset BEQ.S G_RDS_DI - status rtn 3 - data in SUBQ #1,D0 BEQ.S G_RDS_RDY - status 4 - ready SUBQ #1,D0 BEQ.S G_RDS_PST "  - status 5 - peripheral status * BRA.S RDS_ERR there are no more status 'routines' SPC 2 RDS_ERR MOVEQ #BAD_RDS,D0 bad read status BRA ESC_ERR SPC 2 * * retrieve temps as words * * tm GR_TEMP LSR #8,D0 get temp offset * tm MOVE.W 0(A2,D0),D0 get the value * tm RTS SPC 3 * * retrieve card registers as bytes * GR_CARD LSR #8,D0 get the card offset GR_CARD1 MOVE.B 0(A1,D0),D0 get the value GREGEXIT ANDI.W #$00FF,D0 mask off garbage RTS SPC 3 * * data in * G_RDS_DI MOVE.W 4(A1),D0 get data lines RTS SPC 3 G_RDS_RDY MOVE.B 0(A1),D0  get ready line ANDI.B #$01,D0 mask to 1 bit BRA GREGEXIT and get out SPC 3 G_RDS_PST MOVE.B 7(A1),D0 get status ANDI.B #$0F,D0 mask to 4 bits BRA GREGEXIT  and get out SPC 4 G_RDSTBL EQU * DC.B 1,G_CRDREG status 0 - card reg 0 - card id DC.B 3,G_CRDREG status 1 - card reg 3 - intr/dma status DC.B 9,G_ROUTINE status 2 - not implemented DC.B  0,G_ROUTINE status 3 - data in DC.B 1,G_ROUTINE status 4 - ready line DC.B 2,G_ROUTINE status 5 - peripheral status G_RT_END EQU * G_RT_SIZ EQU G_RT_END-G_RDSTBL size of table PAGE ******************************************************************************** * * G_WTC * * WRITE CONTROL * * ENTRY: D0.W = PARAMETER * ******************************************************************************** G_WTC CMP.W #6,D1  \ BGE.S RDS_ERR / check wtc limits EXT.L D1 ADD.L D1,D1 JMP GWTCTBL(D1) SPC 2 GWTCTBL BRA.S G_WTC_RST CONTROL 0 - DO A RESET BRA.S G_SET_PCT CONTROL 1 - set pctl BRA.S  G_SET_CTL CONTROL 2 : set control lines BRA.S G_DATA_O CONTROL 3 - write data out BRA.S RDS_ERR CONTROL 4 : not used BRA.S G_EIR CONTROL 5 : enable intrpts SPC 3 G_WTC_RST BRA  G_INIT reset card SPC 2 G_SET_PCT MOVE.B D0,0(A1) set pctl line SPR836 TM 8/9/82 RTS SPC 2 G_SET_CTL MOVE.B D0,7(A1) set ctl 0 and 1 AND.B #3,D0 \ save CTL0/1  508 TM 9/17/82 ANDI.B #$FC,EIRB_OFF(A2) CLEAR CTL0/1 #69 (3.0) JWS 4/26/84 OR.B D0,EIRB_OFF(A2) / in EIR byte 508 TM 9/17/82 RTS G_DATA_O MOVE.W D0,4(A1) write 16 bit data RTS PAGE ************************************************* * * EIR * ************************************************* G_EIR MOVE.B D0,EIRB_OFF(A2) JSR ITXFR 475 TM 9/17/82 BNE.S G_RTS if tfr then don't G_WTI5 MOVE.B D0,7(A1) Update CTL1:CTL0 BTST #5,D0 Check RESET bit BNE G_RESET TST.B D0 BGE.S G_RTS1 MOVE.B #$80,3(A1) G_RTS RTS G_RTS1 MOVE.B #0,3(A1) RTS TTL IOLIB EXTG - TRANSFER PAGE ************************************************* * * GPIO tfr * ************************************************* G_TFR JSR CHECK_TFR wait for tfr to finish 475 TM 9/17/82 BSR G_WAIT Wait for FLG xxx TM 10/6/82 MOVE.W #0,4(A1) CLEAR DATA REG SPR12724 JS 5/3/84 TST.B TEND_OFF(A3) \ end NOT ALLOWED BNE GTERR_B / MOVE.L TCNT_OFF(A3),D0 GET COUNT CLR.W D1 \ MOVE.B TUSR_OFF(A3),D1 \ COMPUTE OFFSET INTO JUMP TABLE ADD.W D1,D1 \ JSR TESTDMA / BASED ON TFR 475 TM 9/17/82 BEQ.S G_NODMA / TYPE AND DMA PRESENCE ADDI.W #20,D1 #  / G_NODMA LEA G_TBL,A0 \ ADDA.W 0(A0,D1),A0 INDEXED JUMP THRU TABLE JMP (A0) / * * TRANSFER JUMP TABLE * * -------------------- DMA is not installed or available G_TBL DC.W GTERR_B-G_TBL serial interrupt DC.W GTERR_D-G_TBL serial dma DC.W G_T_FHS-G_TBL serial fhs DC.W G_T_FHS-G_TBL serial fastest DC.W GTERR_B-G_TBL serial overlap * -------------------- DC.W G_T_INT-G_TBL overlap interrupt DC.W GTERR_D-G_TBL overlap dma DC.W G_T_BST-G_TBL overlap fhs DC.W G_T_BST-G_TBL overlap fastest DC.W G_T_INT-G_TBL overlap overlap * -------------------- DMA is installed DC.W GTERR_B-G_TBL serial interrupt DC.W G_T_DMA-G_TBL serial dma DC.W G_T_FHS-G_TBL serial fhs DC.W G_T_DMA-G_TBL serial fastest DC.W GTERR_B-G_TBL serial overlap * -------------------- DC.W G_T_INT-G_TBL overlap interrupt DC.W G_T_DMA-G_TBL overlap dma DC.W G_T_BST-G_TBL overlap fhs DC.W G_T_DMA-G_TBL overlap fastest DC.W G_T_DMA-G_TBL overlap overlap PAGE * * Transfer DMA * G_T_DMA CMP.L #1,D0 \ USE INTR IF COUNT=1 ON DMA BEQ G_T_INT / MOVE.B #TT_DMA,TACT_OFF(A3) set tfr type to DMA TST.B TDIR_OFF(A3) \ test for transfer direction BGT.S G_TOD / * * Transfer Input Dma: * G_TID EQU * SUBQ.L #1,D0 0 - Set up DMA for Input JSR GETDMA Tfr N-1 bytes via DMA 475 TM 9/17/82 BTST #3,3(A1) Is BURST bit set on GPIO card ? BEQ.S  G_DMA1 No ORI.W #8,D2 Yes: Set BURST bit in DMA arm byte G_DMA1 MOVE D2,(A4) Arm DMA BSR GD_STBSY Set buffer busy (Card is still not triggered) TST 4(A1) rdi 4 MOVE.B D0,(A1) wti 7,0 (trigger card) MOVE.B #1,2(A1) RDYEN = 0 (so transfers won't interrupt) TST.B T_BW_OFF(A3) Byte (0) or Word (1) transfers ? BEQ.S G_DMA3 ADD #4,D3 G_DMA3 MOVE.B D3,3(A1) Tell the GPIO what channel he's got and * watch the shit hit the fan BRA.S G_DMA_W DONE * * Transfer Output Dma: * G_TOD EQU * G_DMAOUT JSR GETDMA  Get a DMA channel 475 TM 9/17/82 BTST #3,3(A1) Is Burst mode enabled (1) BEQ.S G_DMA4 ORI.W #8,D2 Yes: Set the Burst bit in DMA arm byte G_DMA4 MOVE D2,(A4) Arm the DMA channel  BSR GD_STBSY Set the buffer busy MOVE.B #1,2(A1) Disable the transfer interrupt mechanism TST.B T_BW_OFF(A3) Byte (1) or Word (0) transfers ? BEQ.S G_DMA6 Byte: Don't set the WORD bit on GPIO card ORI.W #4,D3 WORD: Set the WORD bit G_DMA6 MOVE.B D3,3(A1) Tell the GPIO what channel he's got, etc. * * G_DMA_W IF SERIAL THEN WAIT FOR COMPLETION * G_DMA_W MOVE.B TUSR_OFF(A3),D4 \ CMP.B #5,D4 IS THE TRANSFER OVERLAP ? BGE.S G_DMA_W2 / G_DMA_W1 CMPI.B #255,T_SC_OFF(A3) IF NOT THEN WAIT TILL DONE BNE.S G_DMA_W1 G_DMA_W2 RTS SPC 5 GD_STBSY LEA EXTG_EG_TDMA,A4  \ save g_dmaterm routine JSR DMA_STBSY / in dma temps 475 TM 9/17/82 RTS 475 TM 9/17/82 PAGE * * Transfer INTERRUPT * G_T_INT MOVE.B #TT_INT,TACT_OFF(A3)  set tfr type to INTERRUPT BRA.S G_T_BIC go to common code SPC 3 * * Transfer BURST ( intr on 1st byte FHS on rest ) * G_T_BST MOVE.B #TT_BURST,TACT_OFF(A3) set tfr type to BURST * BRA.S G_T_BIC g# o to common code SPC 3 * * common interrupt and burst code * G_T_BIC JSR STBSY SET BUFFER BUSY, ETC TST.B TDIR_OFF(A3) \ test for transfer direction BGT.S G_TOI / * * Transfer Input Interrupt or Transfer Input Burst * G_TII EQU * G_INT_I TST 4(A1) Dummy read to set I/O line to I MOVE.B D0,(A1) wti 7,0 (trigger input) * * Transfer Output Interrupt or Transfer Output Burst * G_TOI EQU * G_INT_O MOVE.B #3,2(A1) Allow I/O to cause an interrupt MOVE.B EIRB_OFF(A2),D0 GET CTL0/1 ORI.B #$80,D0 BSR G_WTI5 Enable interrupts BRA G_DMA_W and wait if necessary PAGE * * Transfer FHS * G_T_FHS MOVE.B #TT_FHS,TACT_OFF(A3) set tfr type to FHS JSR STBSY set buffer busy 475 TM 9/17/82 JSR ITXFR get all pointers 475 TM 9/17/82 TST.B TDIR_OFF(A3) \ test for transfer direction BGT.S G_TFO / * * Transfer FHS in * G_TFI TST 4(A1) to set I/O line to I 507 TM 9/17/82 MOVE.B D0,(A1) trigger input 507 TM 9/17/82 MOVEQ #0,D0 clear upper part of data in MOVEA.L TFIL_OFF(A3),A0 GET FILL POINTER TST.B T_BW_OFF(A3) GET B/W INDICATIONS BNE.S G_TFIW G_TFIB BSR G_WAIT G_TFIB1 MOVE.B 5(A1),D0 D0.L = Byte received MOVE.B D0,(A0)+ SUBQ.L #1,D3 Decrement transfer counter BLE.S GTFI_TRM If buffer full; exit fast handshake CMP.W D0,D2 If input character matches end character BEQ.S GTFI_TRM then we're done MOVE.B D0,(A1) wti 7,0 (Trigger next input) G_TFIB2 BTST #0,(A1) PFLG = 1 ? BNE G_TFIB1 Yes: Get next byte BRA G_TFIB2 No: Keep checking  SPC 3 G_TFIW BSR G_WAIT G_TFIW1 MOVE 4(A1),(A0)+ Copy word from GPIO to buffer SUBQ.L #1,D3 Decrement transfer counter BLE.S GTFI_TRM If D3 = 0 we're done MOVE.B D0,(A1) wti 7,0 (Trigger next input) G_TFIW2 BTST #0,(A1) PFLG = 1 BNE G_TFIW1 BRA G_TFIW2 No: Keep checking SPC 3 * * FHS TRANSFER TERMINATION * GTFI_TRM MOVE.L D3,TCNT_OFF(A3) D3 has bytes not finished MOVE.L A0,TFIL_OFF(A3) update fill pointer GTFO_TRM JSR STCLR MARK BUFFER FINISHED 475 TM 9/17/82 RTS SPC 3 * * Transfer FHS out * G_TFO MOVEA.L TEMP_OFF(A3),A0 GET EMPTY POINTER TST.B T_BW_OFF(A3) GET B/W INDICATIONS BNE.S G_TFOW G_TFOB BSR G_WAIT Wait for card ready G_TFOB1 MOVE.B (A0)+,5(A1) Copy byte from buffer to GPIO MOVE.B D0,(A1) wti 7,0 (Trigger next output) SUBQ.L #1,D3 Decrement transfer count BLE.S G_TFO3 If D3 = 0 then we're done G_TFOB2 BTST #0,(A1) PFLG = 1 ? BNE G_TFOB1 Yes: Get next byte BRA G_TFOB2 No: Keep checking SPC 3 G_TFOW BSR G_WAIT wait for card ready G_TFOW1 MOVE.W (A0)+,4(A1) Copy word from buffer to GPIO MOVE.B D0,(A1) wti 7,0 (Trigger next output) SUBQ.L #1,D3 Decrement transfer count BLE.S G_TFO3 IF D3 = 0 then we're done G_TFOW2 BTST #0,(A1) PFLG = 1 ? BNE G_TFOW1 Yes: Get next byte BRA G_TFOW2 No: Keep checking SPC 3 G_TFO3 MOVE.L A0,TEMP_OFF(A3) SAVE EMPTY PTR CLR.L TCNT_OFF(A3) CLEAR COUNT BRA.S GTFO_TRM SPC 4 PAGE **************************************************** * * UNDMA * * Release the DMA channel associated with the GPIO * card when the tra$ nsfer is done. * **************************************************** G_DMATERM EQU * G_UNDMA ORI #$2700,SR Disable all other interrupts JSR DROPDMA Release the DMA channel 475 TM 9/17/82 JSR ITXFR  See if buf was active 475 TM 9/17/82 BEQ.S G_UNDEND No: this should never happen TST.B TDIR_OFF(A3) Was it an Input (0) or Output (1) ? BEQ.S UNINPUT UNOUTPUT MOVE.B EIRB_OFF(A2),D0 AND #$F,D0 BSR  G_WTI5 MOVE.W #$300,2(A1) Restore REDYN and EIREN TST.B T_BW_OFF(A3) Was it a Byte (1) or Word (0) tfr ? BEQ.S UNOUT2 ADD.L D3,D3 Word: Double the count UNOUT2 ADD.L D3,TEMP_OFF(A3) UPDATE EMPTY POINTER CLR.L TCNT_OFF(A3) CLEAR COUNT JSR STCLR Unbusy the buffer 475 TM 9/17/82 RTS SPC 4 UNINPUT MOVE.L TCNT_OFF(A3),D0 D0 = Transfer count * tm MOVE.L D4,TCNT_OFF(A3) SET COUNT TO REMAINING BYTES SUB.L D4,D0 GET ACTUAL BYTES TFR'D TST.B T_BW_OFF(A3) Was it a Byte (1) or Word (0) tfr ? BEQ.S UNIN2 ADD.L D0,D0 Word: Double the count UNIN2 ADD.L D0,TFIL_OFF(A3)  UPDATE FILL POINTER MOVE.L #1,TCNT_OFF(A3) Last byte is received via interrupt MOVE.W #$380,2(A1) Allow it to cause an interrupt MOVE.B #TT_INT,TACT_OFF(A3) change tfr type G_UNDEND RTS TTL IOLIB EXTG - INTERRUPT SERVICE ROUTINE PAGE ******************************************************* * * GPIO INTERRUPT SERVICE ROUTINE * ******************************************************* G_ISR EQU * G_ISR1 JSR ITXFR Transfer in progress? 475 TM 9/17/82 BNE.S G_ATFR G_ISR2 MOVE.B EIRB_OFF(A2),D0 NO TFR IN PROGRESS AND #$F,D0 BSR G_WTI5 JSR LOGINT log the interrupt 475 TM 9/17/82 GISR_END RTS SPC 4 G_ATFR MOVE.B 3(A1),D0 Put DMA channel for GPIO in D0 AND #3,D0 BNE.S G_TABORT If DMA in progress: Abort & update pointers CMP.B #TT_FHS,D1 \ If FHS then exit BEQ.S G_TABORT / G_ATFR1 SUB.B #1,D1 \ IF INTR THEN D1=0 LSL.B #2,D1 / BURST THEN D1=8 TST.B T_BW_OFF(A3) \ IF WORD THEN ADD 4 BEQ.S GTST_DIR / ADD.B #4,D1 GTST_DIR TST.B TDIR_OFF(A3) \ IF OUTPUT THEN ADD 16 BEQ.S G_ATFR2  / ADD.B #$10,D1 EXT.W D1 EXT.L D1 G_ATFR2 JMP G_TTBL(D1) computed goto SPC 4 G_TTBL BRA G_TIIB INTR IN BYTE BRA G_TIIW INTR IN WORD BRA G_TIFB  BRST IN BYTE BRA G_TIFW BRST IN WORD BRA G_TOIB INTR OUT BYTE BRA G_TOIW INTR OUT WORD BRA G_TOFB BRST OUT BYTE BRA G_TOFW BRST OUT WORD SPC  4 G_TABORT JSR DROPDMA Release DMA channel 475 TM 9/17/82 BRA G_TDIN PAGE ********************************************** * * OUTPUT TRANSFERS * ********************************************** G_TOFB ORI #$2700,SR Disable interrupts G_TOFB1 MOVE.B (A0)+,5(A1) Copy byte from buffer to GPIO SUBQ.L #1,D3 Decrement transfer count BLE.S G_TDOUT If D3 = 0 then we're done MOVE.B D0,(A1) wti 7,0 (Trigger next output) G_TOFB2 BTST #0,(A1) PFLG = 1 ? BNE G_TOFB1 Yes: Get next byte BRA G_TOFB2 No: Keep checking SPC 4 G_TOFW ORI #$2700,SR Disable interrupts G_TOFW1 MOVE.W (A0)+,4(A1) Copy word from buffer to GPIO SUBQ.L #1,D3 Decrement transfer count BLE.S G_TDOUT IF D3 = 0 then we're done MOVE.B D0,(A1) wti 7,0 (Trigger next output) G_TOFW2 $ BTST #0,(A1) PFLG = 1 ? BNE G_TOFW1 Yes: Get next byte BRA G_TOFW2 No: Keep checking SPC 4 G_TOIB MOVE.B (A0)+,5(A1) Copy a byte from buffer to GPIO BRA.S G_ENDOUT G_TOIW  MOVE.W (A0)+,4(A1) Copy a word from buffer to GPIO G_ENDOUT MOVE.L A0,TEMP_OFF(A3) Save A0 for use on next output byte/word SUBQ.L #1,D3 MOVE.L D3,TCNT_OFF(A3) Decrement transfer out counter BLE.S G_TDOUT  If zero, go thru Transfer Done Out MOVE.B D0,(A1) wti 7,0 (Trigger byte out) RTS End of ISR SPC 4 G_TDOUT MOVE.L A0,TEMP_OFF(A3) save empty ptr CLR.L TCNT_OFF(A3) clear tfr count MOVE.B #0,3(A1) Stop card from interrupting MOVE.B EIRB_OFF(A2),7(A1) Put EIR byte in CTL1/CTL0 MOVE.B D0,(A1) wti 7,0 (Trigger last output) JSR STCLR Unbusy buffer 475 TM 9/17/82 RTS PAGE ********************************************** * * INPUT TRANSFERS * ********************************************** G_TIFB ORI #$2700,SR MOVEQ #0,D0 G_TIFB1 MOVE.B 5(A1),D0 D0.L = Byte received MOVE.B D0,(A0)+ SUBQ.L #1,D3 Decrement transfer counter BLE.S G_TDIN If buffer full; exit fast handshake CMP.W D0,D2 If input character matches end character BEQ.S G_TDIN then we're done MOVE.B D0,(A1) wti 7,0 (Trigger next input) G_TIFB2 BTST #0,(A1) PFLG = 1 ? BNE G_TIFB1 Yes: Get next byte BRA G_TIFB2 No: Keep checking SPC 4 G_TIFW ORI #$2700,SR Disable interrupts G_TIFW1 MOVE 4(A1),(A0)+ Copy word from GPIO to buffer SUBQ.L #1,D3 Decrement transfer counter BLE.S G_TDIN If D3 = 0 we're done MOVE.B D0,(A1) wti 7,0 (Trigger next input) G_TIFW2 BTST #0,(A1) PFLG = 1 BNE G_TIFW1 BRA G_TIFW2 No: Keep checking SPC 4 G_TIIB MOVEQ #0,D0 MOVE.B 5(A1),D0 D0.L = Byte received MOVE.B D0,(A0)+  Store byte in input buffer CMP.W D0,D2 Compare termination byte with input byte BNE.S G_ENDIN No match: Everybody get out of here ! SUBQ.L #1,D3 Decrement byte counter MOVE.L D3,TCNT_OFF(A3) BRA.S G_TDIN SPC 4 G_TIIW MOVE 4(A1),(A0)+ Copy word from GPIO to buffer G_ENDIN MOVE.L A0,TFIL_OFF(A3) Save buffer pointer SUBQ.L #1,D3 MOVE.L D3,TCNT_OFF(A3) BLE.S G_TDIN MOVE.B D0,(A1)  wti 7,0 RTS SPC 4 G_TDIN MOVE.L A0,TFIL_OFF(A3) save fill ptr MOVE.L D3,TCNT_OFF(A3) save remaining count MOVE.B #0,3(A1) Stop card from interrupting MOVE.B EIRB_OFF(A2),7(A1) Put EIR byte in CTL1/CTL0  JSR STCLR Unbusy buffer 475 TM 9/17/82 RTS PAGE END  (* (c) Copyright Hewlett-Packard Company, 1985. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) { $SEARCH 'IOLIB:KERNEL.CODE'$ } $MODCAL ON$ $PARTIAL_EVAL ON$ $STACKCHECK ON$ $RANGE OFF$ $DEBUG OFF$ $OVFLCHECK OFF$ $PAGE$ (*******************************************************% *****************) (* *) (* RELEASED VERSION 3.1 *) (* *) (************************************************************************) (* *) (* *) (* IOLIB GPIO_DRIVERS  *) (* *) (* *) (************************************************************************) (* *) (* *) (* library - IOLIB *) (* name - GPIO_DRIVERS *) (* module(s) - init_gpio *) (* - extg *) (*  *) (* author - Tim Mikkelsen *) (* phone - 303-226-3800 ext. 2910 *) (* *) (* date  - June 1 , 1981 *) (* update - Aug 1 , 1983 *) (* release - Jul 12 , 1985 *) (*  *) (* source - IOLIB:G_DRV.TEXT *) (* object - IOLIB:G_DRV.CODE *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (*  *) (* BUG FIX HISTORY - after release 1.0 *) (* *) (*  *) (* BUG # BY / ON LOC DESCRIPTION *) (* ----- ----------- -------------- ---------------------- *) (* *) (* 367  T Mikkelsen gpio_initialize Allow eXecute of driver *) (* 09/22/82 and have it install *) (* itself in the system. *) (*  *) (************************************************************************) $PAGE$ (************************************************************************) (*  *) (* *) (* This is the source code for an external procedures library *) (* to be used for general purpose interfacing on the HP 9826. *) (*  *) (* The library consists of 3 primary sets of modules - *) (* *) (* 1. KERNEL modules  *) (* 2. driver modules *) (* 3. IOLIB modules *) (* *) (* The K% ERNEL modules consist of the following modules - *) (* *) (* 1. iodeclarations ( contains static r/w space ) *) (* 2. iocomasm  *) (* 3. general_0 ( initialization & low level *) (* routines like ioread/iowrite) *) (* The KERNEL modules also have an executable program segement *) (* that gets executed at the time it is loaded. This program *) (* initializes the static read/write memory. This program also *) (* allocates the temporary storage for any card that exists - *) (* independent of whether there is or is not a driver for it. *) (* *) (* The driver modules consist of the actual assembly or PASCAL *) (* routines that deal with a specific interface card. There is *) (* also an executable program segment for each driver module. *) (* This program searches the select code table in the static r/w *) (* initialized by the KERNEL general_0 module for all select codes *) (* that have the right interface card ( HPIB drivers will search *) (* for the 98624 interface ). This program will then set up the *) (* driver tables to point to the correct drivers. *) (*  *) (* The rest of the IOLIB modules are high-level modules that are *) (* used by an end user in his/her application program. *) (* *) (*  The KERNEL and some set of driver modules will exist in the *) (* SYSTEM.INITLIB file as object code ( not EXPORT text ). The *) (* export text will reside on the SYSTEM.LIBRARY file. The rest *) (* of the library will reside on the SYSTEM.LIBRARY. *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (* *) (* REFERENCES : *) (*  *) (* *) (* 1. 9826 I/O Designers Guide ( Loyd Nelson ) *) (*  *) (* 2. 68000 Manual ( Motorola ) *) (* *) (* 3. Pascal alpha site ERS ( Roger Ison ) *) (*  *) (* 4. Pascal I/O Library ERS ( Tim Mikkelsen ) *) (* *) (* 5. 9826 HPL EIO & IOD listings ( Bob Hallissy ) *) (* *) (* 6. 9826 HPL Misc. I/O Doc. ( Bob Hallissy ) *) (*  *) (* 7. 9826 card documentation ( Mfg. Specs. ) *) (* *) (* 8. Pascal I/O Library IRS ( Tim Mikkelsen ) *) (*  *) (* *) (************************************************************************) $PAGE$ PROGRAM gpio_initialize ( INPUT , OUTPUT ); $& PAGE$ (************************************************************************) (* *) (* *) (* GPIO DRIVERS  *) (* *) (* *) (************************************************************************) EXTERNAL MODULE extg; { by Tim Mikkelsen date 08/25/81 update 10/13/81 purpose This module is a declaration of the importation text for the external drivers. note The assembly language code that is imported needs to be called 'extg'. The routines need to be called 'extg_@@@@@@' - eg_init referenced below would be extg_eg_init. 'eg' refers to GPIO.  } IMPORT sysglobals , iodeclarations ; EXPORT PROCEDURE eg_init ( temp : ANYPTR ); PROCEDURE eg_isr ( temp : PISRIB ); PROCEDURE eg_rdb ( temp : ANYPTR ; VAR x : CHAR); PROCEDURE eg_wtb ( temp : ANYPTR ; val : CHAR); PROCEDURE eg_rdw ( temp : ANYPTR ; VAR x : io_word); PROCEDURE eg_wtw ( temp : ANYPTR ; val : io_word); PROCEDURE eg_rds ( temp : ANYPTR ; reg : io_word; VAR x : io_word); PROCEDURE eg_wtc ( temp : ANYPTR ; reg : io_word; val : io_word ); PROCEDURE eg_tfr ( temp : ANYPTR ; bcb : ANYPTR ); PROCEDURE eg_clr ( temp : ANYPTR ; line : io_bit ); PROCEDURE eg_set ( temp : ANYPTR ; line : io_bit ); PROCEDURE eg_test ( temp : ANYPTR ; line : io_bit ; VAR x : BOOLEAN ); END; { of extg } $PAGE$ MODULE init_gpio; { by Tim Mikkelsen date 08/25/81 update 10/04/82  8/01/83 change rev number purpose This module initializes the gpio drivers. } IMPORT iodeclarations ; EXPORT VAR gpio_drivers : drv_table_type; PROCEDURE io_init_gpio; IMPLEMENT IMPORT sysglobals , isr , general_0 , extg ; PROCEDURE io_init_gpio; VAR io_isc : type_isc; dummy : INTEGER; io_lvl : io_byte; BEGIN io_revid := io_revid + ' G3.2'; { GPIO revision added 2/5/82 TM } { set up the driver tables } WITH gpio_drivers DO BEGIN gpio_drivers := dummy_drivers ; iod_init := eg_init; iod_isr := eg_isr; iod_rdb := eg_rdb; iod_wtb := eg_wtb; iod_rdw := eg_rdw; iod_wtw := eg_wtw; iod_rds := eg_rds; iod_wtc := eg_wtc; iod_tfr := eg_tfr; iod_set := eg_set; iod_clr := eg_clr; iod_test := eg_test; END; { of WITH } { set up drivers for the interfaces } FOR io_isc:=iominisc TO iomaxisc DO WITH isc_table[io_isc] DO BEGIN IF card_id = hp98622 THEN BEGIN io_drv_ptr:=ADDR(gpio_drivers); WITH io_drv_ptr^, io_tmp_ptr^ DO BEGIN { if the card exists then link in an ISR for it } { ??? - what happens if an ISR fires during init } io_lvl:=((ioread_byte(io_isc,3) DIV 16) MOD 4)+3; IF myisrib.INTREGADDR <> NIL THEN BEGIN { if isr exists then unlink it } ISRUNLINK(io_lvl, { interrupt level } addr(myisrib)); { ptr to the isrib } END; { of IF } PERMISRLINK(iod_isr,  { isr } ANYPTR(INTEGER(card_ptr)+3), { int reg addr } 192, { int reg mask } 192, { int reg value } &  io_lvl, { int level } ADDR(myisrib)); { isrib info } END; { of WITH BEGIN } END; { of IF card_type = gpio_card } END; { of FOR io_isc WITH isc_table[io_isc] BEGIN } { call the actual driver initialization } FOR io_isc:=iominisc TO iomaxisc DO WITH isc_table[io_isc] DO IF card_id = hp98622 THEN BEGIN CALL(io_drv_ptr^.iod_init , io_tmp_ptr);  END; { of WITH IF } END; { of io_init_gpio } END; { of MODULE init_gpio } $PAGE$ IMPORT init_gpio , LOADER ; { 367 TM 9/22/82 } BEGIN io_init_gpio; MARKUSER;  { 367 TM 9/22/82 } END. { of gpio_initialize }  (* (c) Copyright Hewlett-Packard Company, 1985. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) $MODCAL ON$ $PARTIAL_EVAL ON$ $STACKCHECK ON$ $RANGE OFF$ $DEBUG OFF$ $OVFLCHECK OFF$ $PAGE$ (************************************************************************) (*  *) (* RELEASED VERSION 3.1 *) (* *) (************************************************************************) (* *) (* *) (* IOLIB HPIB_DRIVERS *) (* *) (* *) (************************************************************************) (*  *) (* *) (* library - IOLIB *) (* name - HPIB_DRIVERS  *) (* module(s) - h_drv *) (* - hpib *) (* *) (* author  - Tim Mikkelsen *) (* phone - 303-226-3800 ext. 2910 *) (* *) (* date - June 1 , 1981  *) (* update - Aug 1 , 1983 *) (* release - Jul 12, 1985 *) (* *) (*  source - IOLIB:H_DRV.TEXT *) (* object - IOLIB:H_DRV.CODE *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (* '  *) (* BUG FIX HISTORY - after release *) (* *) (* *) (* BUG # BY / ON LOC DESCRIPTION *) (* ----- ----------- -------------- ---------------------- *) (* *) (* 367 T Mikkelsen hpib_initialize Allow eXecute of driver *) (* 09/22/82 and have it install *) (* itself in the system. *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (*  *) (* This is the source code for an external procedures library *) (* to be used for general purpose interfacing on the HP 9826. *) (*  *) (* The library consists of 3 primary sets of modules - *) (* *) (* 1. KERNEL modules *) (*  2. driver modules *) (* 3. IOLIB modules *) (* *) (* The KERNEL modules consist of the following modules - *) (* *) (* 1. iodeclarations ( contains static r/w space ) *) (* 2. iocomasm *) (* 3. general_0 ( initialization & low level *) (* routines like ioread/iowrite) *) (* The KERNEL modules also have an executable program segement *) (* that gets executed at the time it is loaded. This program *) (* initializes the static read/write memory. This program also *) (* allocates the temporary storage for any card that exists - *) (* independent of whether there is or is not a driver for it. *) (* *) (* The driver modules consist of the actual assembly or PASCAL *) (* routines that deal with a specific interface card. There is *) (* also an executable program segment for each driver module. *) (* This program searches the select code table in the static r/w *) (* initialized by the KERNEL general_0 module for all select codes *) (* that have the right interface card ( HPIB drivers will search *) (* for the 98624 interface ). This program will then set up the *) (* driver tables to point to the correct drivers. *) (* *) (*  The rest of the IOLIB modules are high-level modules that are *) (* used by an end user in his/her application program. *) (* *) (* The KERNEL and some set of driver modules will exist in the *) (* SYSTEM.INITLIB file as object code ( not EXPORT text ). The *) (* export text will reside on the SYSTEM.LIBRARY file. The rest *) (* of the library will reside on the SYSTEM.LIBRARY.  *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* '  *) (* *) (* REFERENCES : *) (*  *) (* *) (* 1. 9826 I/O Designers Guide ( Loyd Nelson ) *) (* *) (*  2. 68000 Manual ( Motorola ) *) (* *) (* 3. Pascal alpha site ERS ( Roger Ison ) *) (*  *) (* 4. Pascal I/O Library ERS ( Tim Mikkelsen ) *) (* *) (* 5. 9826 HPL EIO & IOD listings ( Bob Hallissy )  *) (* *) (* 6. 9826 HPL Misc. I/O Doc. ( Bob Hallissy ) *) (* *) (* 7. 9826 card documentation ( Mfg. Specs. ) *) (* *) (* 8. Pascal I/O Library IRS ( Tim Mikkelsen ) *) (*  *) (* *) (************************************************************************) $PAGE$ PROGRAM hpib_initialize ( INPUT , OUTPUT ); { This module has a program segment so that there is an executable entry point into the module. At INITLIB time this program is executed. } $PAGE$ EXTERNAL MODULE exth; { by Tim Mikkelsen date 08/25/81 update 10/02/81  purpose This module is a declaration of the importation text for the external drivers. note The assembly language code that is imported needs to be called 'exth'. The routines need to be called  'exth_@@@@@@' - eh_init referenced below would be exth_eh_init. 'eh' refers to external HP-IB. } IMPORT { $SEARCH 'IOLIB:KERNEL.CODE'$ } sysglobals , iodeclarations ; EXPORT PROCEDURE eh_init ( temp : ANYPTR ); PROCEDURE eh_isr ( temp : PISRIB ); PROCEDURE eh_rdb ( temp : ANYPTR ; VAR x : CHAR); PROCEDURE eh_wtb ( temp : ANYPTR ; val : CHAR); PROCEDURE eh_rdw ( temp : ANYPTR ; VAR x : io_word); PROCEDURE eh_wtw ( temp : ANYPTR ; val : io_word); PROCEDURE eh_rds ( temp : ANYPTR ; reg : io_word; VAR x : io_word); PROCEDURE eh_wtc ( temp : ANYPTR ; reg : io_word; val : io_word ); PROCEDURE eh_tfr ( temp : ANYPTR ; bcb : ANYPTR ); PROCEDURE eh_send ( temp : ANYPTR ; val : CHAR ); PROCEDURE eh_ppoll ( temp : ANYPTR ; VAR x : CHAR ); PROCEDURE eh_clr ( temp : ANYPTR ; line : io_bit ); PROCEDURE eh_set ( temp : ANYPTR ; line : io_bit ); PROCEDURE eh_test ( temp : ANYPTR ; line : io_bit ; VAR x : BOOLEAN ); PROCEDURE eh_end ( temp : ANYPTR ; VAR x : BOOLEAN ); END; { of exth } $PAGE$ MODULE init_hpib; { by Tim Mikkelsen date 08/25/81 update 12/16/82 8/01/83 JS change rev number purpose This module initializes the HPIB drivers. } IMPORT iodeclarations ; EXPORT VAR hpib_drivers : drv_table_type; PROCEDURE io_init_hpib; IMPLEMENT IMPORT sysglobals , isr , general_0 , exth ; PROCEDURE io_init_hpib; VAR io_isc : type_isc; dummy : INTEGER; io_lvl : io( _byte; BEGIN io_revid := io_revid + ' H3.2'; { HPIB revision added 2/5/82 TM } { set up the driver tables } WITH hpib_drivers DO BEGIN hpib_drivers := dummy_drivers; iod_init := eh_init; iod_isr := eh_isr; iod_rdb := eh_rdb; iod_wtb := eh_wtb; iod_rdw := eh_rdw; iod_wtw := eh_wtw; iod_rds := eh_rds; iod_wtc := eh_wtc; iod_end := eh_end; iod_tfr := eh_tfr; iod_send := eh_send; iod_ppoll := eh_ppoll; iod_set := eh_set; iod_clr := eh_clr; iod_test := eh_test; END; { of WITH } { set up drivers for the interfaces } FOR io_isc:=iominisc TO iomaxisc DO WITH isc_table[io_isc] DO BEGIN IF ( card_id = hp98624 ) OR ( card_id = internal_hpib) THEN BEGIN io_drv_ptr:=ADDR(hpib_drivers); WITH io_drv_ptr^, io_tmp_ptr^ DO BEGIN IF io_isc=7 THEN BEGIN io_lvl := 3;  END ELSE BEGIN io_lvl:=((ioread_byte(io_isc,3) DIV 16) MOD 4)+3; END; { of IF } { if the card exists then link in an ISR for it } { ??? - what happens if an ISR fires during init } IF myisrib.INTREGADDR <> NIL THEN BEGIN { remove any existant isr } ISRUNLINK(io_lvl, { interrupt level } addr(myisrib)); { ptr to the isrib } END; { of IF } PERMISRLINK(iod_isr, { isr } ANYPTR(INTEGER(card_ptr)+3), { int reg addr } 192,  { int reg mask } 192, { int reg value } io_lvl, { int level } ADDR(myisrib)); { isrib info } END; { of WITH // DO BEGIN } END; { of IF card_id } END; { of FOR io_isc WITH isc_table[io_isc] BEGIN } { call the actual driver initialization } { this is seperate from the set up stuff in case there are 2 or more cards connected - and generate an isr } FOR io_isc:=iominisc TO iomaxisc DO WITH isc_table[io_isc] DO IF ( card_id = hp98624 ) OR ( card_id = internal_hpib ) THEN BEGIN CALL(io_drv_ptr^.iod_init , io_tmp_ptr); END; { of WITH IF } END; { of io_init_hpib } END; { of MODULE init_hpib } $PAGE$ IMPORT init_hpib , LOADER ; { 367 TM 9/22/82 } BEGIN io_init_hpib; MARKUSER;  { 367 TM 9/22/82 } END. { of hpib_initialize }  TTL IOLIB IOCOMASM - common assembly routines PAGE ******************************************************************************** * * COPYRIGHT (C) 1985, 1985 BY HEWLETT-PACKARD COMPANY * ******************************************************************************** * * * IOLIB IOCOMASM * * ******************************************************************************** * * * * Library - IOLIB * Module - IOCOMASM * Author - Tim Mikkelsen * Phone - 303-226-3800 ext. 2910 * * Purpose - This set of assembly language * code is intended to be used as * a support module for I/O drivers * * Date - 08/18/81 * Update - 03/25/85 * Release - 7/12/85 * * *  Source - IOLIB:COMASM.TEXT * Object - IOLIB:COMASM.CODE * * ******************************************************************************** * * * RELEASED * VERSION 3.1 * * **************************************************( ****************************** PAGE ******************************************************************************** * * PASCAL DEFINITION OF MODULE * ******************************************************************************** MNAME IOCOMASM SRC MODULE IOCOMASM; SRC IMPORT iodeclarations; SRC EXPORT SRC FUNCTION dma_request ( temp : ANYPTR ) : INTEGER; SRC PROCEDURE dma_release ( temp : ANYPTR ); SRC FUNCTION bit_set ( v : INTEGER ; SRC  b : INTEGER ) : BOOLEAN ; SRC FUNCTION binand ( x : INTEGER ; SRC y : INTEGER ) : INTEGER ; SRC FUNCTION binior ( x : INTEGER ; SRC y : INTEGER ) : INTEGER ; SRC FUNCTION bineor ( x : INTEGER ; SRC y : INTEGER ) : INTEGER ; SRC FUNCTION bincmp ( x : INTEGER ) : INTEGER ; SRC FUNCTION binasr ( Object : INTEGER ; SRC Amount_of_shift : INTEGER ) : INTEGER ; SRC FUNCTION binasl ( Object : INTEGER ; SRC Amount_of_shift : INTEGER ) : INTEGER ; SRC FUNCTION binlsr ( Object : INTEGER ; SRC Amount_of_shift : INTEGER ) : INTEGER ; SRC FUNCTION binlsl ( Object : INTEGER ; SRC Amount_of_shift : INTEGER ) : INTEGER ; SRC END; { IOCOMASM } SPC 5 DEF IOCOMASM_iocomasm DEF IOCOMASM_dma_request DEF IOCOMASM_dma_release DEF IOCOMASM_bit_set DEF IOCOMASM_binand DEF IOCOMASM_binior DEF IOCOMASM_bineor DEF IOCOMASM_bincmp DEF IOCOMASM_binasr DEF IOCOMASM_binasl DEF IOCOMASM_binlsr DEF IOCOMASM_binlsl PAGE ******************************************************************************** * * SYMBOLS FOR EXPORT - COMMON ASSEMBLY LANGUAGE ROUTINES * * THE SYMBOLS DO NOT HAVE PASCAL ENTRY * POINTS SINCE THEY ARE ONLY USED BY * ASSEMBLY LANGUAGE MODULES OR WITH EXTERNAL DECLARATIONS * ******************************************************************************** DEF DROPDMA DEF GETDMA DEF TESTDMA DEF LOGINT DEF LOGEOT DEF STBSY DEF STCLR DEF DMA_STBSY DEF ITXFR DEF ABORT_IO DEF WAIT_TFR  DEF CHECK_TFR DEF TIMEREXISTS USED AS PASCAL EXTERNAL PROC DEF TIMED_OUT USED AS PASCAL EXTERNAL PROC SPC 3 * ***************************************************************************** * * IMPORTED SYMBOLS * ***************************************************************************** * REFA CHECK_TIMER USED TO GET AT TIMER ROUTINE IN POWERUP REFA ASM_FLUSH_ICACHE USED TO FLUSH 68020 AFTER DMA XFR * JWH 9/24/90 : LMODE CHECK_TIMER LMODE ASM_FLUSH_ICACHE LMODE save_dtt1 jwh 9/24/90 TTL IOLIB IOCOMASM - pascal binary functions PAGE * * module initialization * IOCOMASM_IOCOMASM EQU * RTS * * bit test * IOCOMASM_BIT_SET EQU * MOVEA.L (SP)+,A0 save return address MOVE.L (SP)+,D0 get bit # MOVE.L (SP)+,D1 get numeric value CLR.B D2 clear indicator BTST D0,D1 test bit in value BEQ.S BITT_EXIT MOVEQ #1,D2  if bit set set indicator BITT_EXIT MOVE.B D2,(SP) push result JMP (A0) return * * binary and * IOCOMASM_BINAND EQU * MOVEA.L (SP)+,A0 save return address MOVE.L (SP)+,D0 get last param MOVE.L (SP)+,D1 get first param AND.L D0,D1 perform AND MOVE.L D1,(SP) push result JMP (A0) return * * binary inclusive or * IOCOMASM_BINIOR EQU * MOVEA.L (SP)+,A0 save return address MOVE.L (SP)+,D0 get last param MOVE.L (SP)+,D1 get first param OR.L D0,D1 perform OR MOVE.L D1,(SP) push result JMP (A0) )  return * * binary exclusive or * IOCOMASM_BINEOR EQU * MOVEA.L (SP)+,A0 save return address MOVE.L (SP)+,D0 get last param MOVE.L (SP)+,D1 get first param EOR.L D0,D1 perform XOR MOVE.L D1,(SP) push result JMP (A0) return * * binary complement * IOCOMASM_BINCMP EQU * MOVEA.L (SP)+,A0 save return address MOVE.L (SP)+,D0 get param NOT.L D0 perform complement MOVE.L D0,(SP) push result JMP (A0) return SPC 5 TTL IOLIB IOCOMASM - common equates and definitions PAGE INCLUDE IOLIB:COMDCL TTL IOLIB IOCOMASM - error escape PAGE ******************************************************************************** * * Error escapes * ******************************************************************************** CTMO_ERR MOVEQ #TMO_ERR,D0 timeout BRA.S ESC_ERR TERR_C MOVEQ #TCNTERR,D0 bad transfer specification BRA.S ESC_ERR TERR_B MOVEQ #TFR_ERR,D0 bad transfer specification BRA.S ESC_ERR TERR_D MOVEQ #NO_DMA,D0 DMA not installed * BRA.S ESC_ERR SPC 4 ESC_ERR EXT.L D0 MOVE.L D0,IOE_RSLT(A5) save io error MOVE.B IO_SC(A2),D0 \ get sc for error MOVE.L D0,IOE_SC(A5) / MOVE.W #IOE_ERROR,ESC_CODE(A5) give i/o error TRAP #10  escape TTL IOLIB IOCOMASM - transfer support PAGE ******************************************************************************** * * ABORT_IO * * USED DURING INITIALIZATION/RESET TO MAKE SURE THERE * IS NO ACTIVE BUFFER LEFT AROUND. * * ENTRY: A2.L = TEMP POINTER * * USES: D1,D2,D3 AND ROUTINE DROPDMA (WHICH USES A0) * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** ABORT_IO TRAP  #11 GET INTO SUPERVISOR MODE, SAVE SR scs * scs MOVE SR,-(SP) \ PREVENT INTERRUPTS FOR A MOMENT. ORI #$2700,SR / ABORT_IO3 BSR ITXFR IS THERE A TRANSFER IN PROGRESS? BEQ.S  ABORT_IO2 IF NOT, DO NOTHING CMP.B #TT_DMA,D1 ELSE IS IT A DMA? BEQ.S ABORT_IO1 IF NOT, SKIP BSR DROPDMA ELSE FREE UP THE DMA CH, GET COUNT MOVE.L D4,TCNT_OFF(A3) fix up count  SUB.L D4,D3 fix up actual count TST.B TDIR_OFF(A3) BNE.S AB_OUT ADD.L D3,TFIL_OFF(A3) if input then update fill BRA.S ABORT_IO1 AB_OUT ADD.L D3,TEMP_OFF(A3) if output then update empty ABORT_IO1 MOVE.B #255,T_SC_OFF(A3) UNBUSY THE BUFFER CLR.B TACT_OFF(A3) SET TRANSFER TYPE TO NONE CLR.L (A4) clear buffer ptr BRA ABORT_IO3 see if there is another ABORT_IO2 MOVE (SP)+,SR RESTORE USER MODE scs RTS scs * scs RTE RESTORE INTERRUPT LEVEL & RETURN PAGE ******************************************************************************** * * CHECK_TFR * * ROUTINE TO CHECK FOR ACTIVE TRANSFER IN THE OPPOSITE DIRECTION. * ( this is called by a tfr routine on cards * that can't do bi-directional tfrs ) * ( gpio and hpib modules use this routine ) * ( with a timeout wait ) * * ENTRY: A2.L = TEMP POINTER * A3.L = BUF CTL BLK POINTER * * EXIT : IF NOT TRANSFER, RETURN * IF TRANSFER, THEN wait until finished *  or until timeout ( if any ) * ******************************************************************************** CHECK_TFR TST.B TDIR_OFF(A3) base test on direction BNE.S CHKT_IN ( if this is in , ) check out ) CHKT_OUT LEA BUFO_OFF(A2),A4 IS THERE AN output BUFFER ACTIVE? MOVE.L (A4),D1 BRA.S CHKWAIT IF SO , THEN WAIT SPC 2 CHKT_IN LEA BUFI_OFF(A2),A4 is there an input tfr MOVE.L (A4),D1 *  BRA.S CHKWAIT SPC 3 CHKWAIT BEQ.S CHKEXIT exit if no tfr MOVE.L TIMEOUT(A2),D2 get timeout value BEQ.S CHECK_TFR if timeout = 0 then try forever BTST #TIMER_PRESENT,SYSFLAG2 CHECK IF TIMER PRESENT JS 8/3/83 BEQ.S CHKT_TIM IF SO THEN USE IT JS 8/3/83 LSL.L #8,D2 CHKLOOP MOVE.L (A4),D1 check the buffer again BEQ.S CHKEXIT if finished in time then return SUBQ.L #1,D2 decrement BNE.S CHKLOOP BRA CTMO_ERR CHKEXIT RTS SPC 3 CHKT_TIM MOVE.B #1,-(SP) SET UP TIMER RECORD JS 8/3/83 MOVE.L D2,-(SP) JS 8/3/83 CHKT_TIM1 MOVE.L (A4),D1 TRANSFER ACTIVE ? JS 8/3/83 BEQ.S CHKT_TIM2 NO -- EXIT JS 8/3/83 PEA (SP) ELSE CHECK TIMER JS 8/3/83 JSR CHECK_TIMER  JS 8/3/83 BPL CHKT_TIM1 BRANCH IF NOT TIMED OUT JS 8/3/83 BRA CTMO_ERR ELSE DO TIMEOUT ESCAPE JS 8/3/83 CHKT_TIM2 ADDQ.L #6,SP CLEAN TIMER RECORD FROM STACK JS 8/3/83 RTS AND RETURN JS 8/3/83 PAGE ******************************************************************************** * * WAIT_TFR * * ROUTINE TO CHECK FOR ACTIVE TRANSFER. * ( with a timeout wait ) * * ENTRY: A2.L = TEMP POINTER * * EXIT : IF NOT TRANSFER, RETURN * IF TRANSFER, THEN wait until finished * or until timeout ( if any ) * * USES: NO REGS OTHER THAN RETURN VALUES. * * ******************************************************************************** WAIT_TFR BSR ITXFR quick check for tfr BEQ.S WT_DONE and exit MOVE.L TIMEOUT(A2),D6 get timeout value BEQ.S WAIT_TFR if timeout = 0 then try forever BTST #TIMER_PRESENT,SYSFLAG2 IF TIMER PRESENT USE IT JS 8/3/83 BEQ.S WT_TIM BRANCH IF WE HAVE IT JS 8/3/83 LSL.L #5,D6 WT_LOOP BSR.S ITXFR  try BEQ.S WT_DONE if finished in time then return SUBQ.L #1,D6 decrement BNE.S WT_LOOP BRA CTMO_ERR WT_DONE RTS SPC 3 WT_TIM MOVE.B #1,-(SP) SET UP TIMER RECORD JS 8/3/83 MOVE.L D6,-(SP) JS 8/3/83 WT_TIM1 BSR.S ITXFR CHECK FOR ACTIVE TRANSFER JS 8/3/83 BEQ.S WT_TIM2 NONE -- EXIT JS 8/3/83 PEA (SP)  CHECK TIMER JS 8/3/83 JSR CHECK_TIMER JS 8/3/83 BPL WT_TIM1 LOOK AGAIN IF NOT TIMED OUT JS 8/3/83 BRA CTMO_ERR ELSE DO TIMEOUT ESCAPE JS 8/3/83 WT_TIM2 ADDQ.L #6,SP CLEAN UP TIMER RECORD JS 8/3/83 RTS AND RETURN JS 8/3/83 PAGE ******************************************************************************** * * ITXFR * *  ROUTINE TO CHECK FOR ACTIVE TRANSFER. * * ENTRY: A2.L = TEMP POINTER * * EXIT : IF NOT TRANSFER, RET with zero flag set * IF TRANSFER, RET with not zero * D1.W = ACTUAL TFR TYPE *  D2.W = TERMINATING CHAR FROM TEMPS * D3.L = TRANSFER COUNT FROM TEMPS * A0.L = DATA POINTER FROM TEMPS ( either emtpy or fill ) * A3.L = BUF CTL BLK POINTER FROM TEMPS * * HPL ROUTINE*  ( MODIFIED ) * ******************************************************************************** ITXFR LEA BUFI_OFF(A2),A4 IS THERE AN input BUFFER ACTIVE? MOVE.L (A4),D1 BNE.S ITXFR3 IF NOT, SKIP LEA BUFO_OFF(A2),A4 is there an output tfr MOVE.L (A4),D1 BEQ.S ITXFR1 -no ITXFR3 MOVEA.L D1,A3 \ CLR.L D1 ELSE GET BUFFER TYPE WORD MOVE.B TACT_OFF(A3),D1 / CLR.L D2 MOVE.W TCHR_OFF(A3),D2 GET TERMINATING CHAR MOVE.L TCNT_OFF(A3),D3 GET COUNT MOVEA.L TEMP_OFF(A3),A0 GET EMPTY POINTER TST.B TDIR_OFF(A3) check direction BNE.S ITXFR2 \ IF INPUT MOVEA.L TFIL_OFF(A3),A0 / THEN GET FILL POINTER ITXFR2 MOVEQ #1,D5 set not zero STCLR1 EQU * ITXFR1 RTS PAGE ******************************************************************************** * * STCLR * * ROUTINE TO SET A BUFFER & SELECT CODE NOT BUSY * * ENTRY: gets buf ptr from ITXFR routine * * assumes only one tfr per select code * * USES: A3,D0 * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** STCLR BSR ITXFR GET BUFFER POINTER FROM TEMPS BEQ.S STCLR1 IF ALREADY CLEAR, SKIP MOVE.B #255,T_SC_OFF(A3) CLEAR S.C. INDICATOR IN THE BUF CTL BLK CLR.B TACT_OFF(A3)  clear tfr type CLR.L (A4) CLEAR BUF POINTER IN SC TEMPS *RTS SPC 5 ******************************************************************************** * * LOGEOT * * CALL THE USER PROC AT END OF TRANSFER * * PASCAL ROUTINE * * modified to pass a user parameter: JPC 02/22/82 * ******************************************************************************** LOGEOT LEA T_PR_OFF(A3),A0 point to procedure/static link/parameter H_EOT1 MOVE.L (A0),D0 is there a proc? BEQ.S H_EOT3 skip if not MOVEM.L A1-A4,-(SP) save dedicated regs (8/10/82 JPC) MOVE.L 8(A0),-(SP) push the parameter MOVE.L 4(A0),D1 is there a static link? BEQ.S H_EOT2 Roger Ison says it is okay to try MOVE.L D1,-(SP) and call proc with static link H_EOT2 MOVEA.L D0,A0 procedure address JSR (A0) call it MOVEM.L (SP)+,A1-A4 restore dedicated regs (8/10/82 JPC) H_EOT3 RTS PAGE ******************************************************************************** * * LOGINT * * THIS ROUTINE WAS CALLED H_LOG * * CALL THE USER PROC WHEN AN ISR SAYS TO * * PASCAL ROUTINE * * modified to pass a user parameter: JPC 02/22/82 * ******************************************************************************** LOGINT LEA H_ISR_PR(A2),A0 point to procedure/static link/parameter BRA H_EOT1 call it (if it exists) PAGE ******************************************************************************** * * DMA_STBSY * * ROUTINE TO SET A BUFFER BUSY * * ENTRY: * D0.W = TRANSFER COUNT TO BE PUT IN TCNT_OFF(A2) * AND TO BE ADDED TO E/F COUNT. * A0.L = pointer to DMA temps * A2.L = POINTER TO DRIVER TEMPS * A3.L = POINTER TO BUFFER CTL BLOCK * A4.L = POINTER TO TERMINATION ROUTINE * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** DMA_STBSY MOVE.L A4,DMAISR(A0) SAVE THE TERMINATION ROUTINE CLR.L DMASL(A0) CLEAR THE STATIC LINK * BRA.S STBSY SET THE BUFFER BUSY SPC 5 ******************************************************************************** * * STBSY * * ROUTINE TO SET A * BUFFER BUSY * * ENTRY: * D0.W = TRANSFER COUNT TO BE PUT IN TCNT_OFF(A2) * AND TO BE ADDED TO E/F COUNT. * A2.L = POINTER TO DRIVER TEMPS * A3.L = POINTER TO BUFFER CTL BLOCK * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** STBSY MOVE.L D0,TCNT_OFF(A3) COPY TFR COUNT INTO TEMPS. TST.B TDIR_OFF(A3) \ BNE.S STBSY1 \  MOVE.L A3,BUFI_OFF(A2) MAKE SELECT CODE BUSY BRA.S STBSY2 / STBSY1 MOVE.L A3,BUFO_OFF(A2) / STBSY2 MOVE.B IO_SC(A2),T_SC_OFF(A3) SET UP BUFFER ACTIVE SELECT CODE RTS DONE! TTL IOLIB IOCOMASM - dma support PAGE ******************************************************************************** * * DMA RESOURCE MANAGEMENT ROUTINES * * ******************************************************************************** SPC 3 ******************************************************************************** * * DMA RESOURCE temporaries * * These resource temporaries need to be aligned with the offsets * generated by the main Pascal library. This is not an automatic * operation - it must be done by hand if ANY new declarations are * added in the iodeclarations in front of the dma resource temps. * ******************************************************************************** DMAFLAG EQU iodeclarations-61 boolean indicating presence of dma hardware SPC 2 DMA0 EQU iodeclarations-8 DMAISR_0 EQU iodeclarations-8 \ DMASL_0 EQU iodeclarations-4 channel 0 temps DMA_SC_0 EQU iodeclarations-9 /  SPC 2 DMA1 EQU iodeclarations-18 DMAISR_1 EQU iodeclarations-18 \ DMASL_1 EQU iodeclarations-14 channel 1 temps DMA_SC_1 EQU iodeclarations-19 / SPC 2 DMAISR EQU 0 isr pointer DMASL EQU 4 static link DMA_SC EQU -1 allocated s.c. SPC 2 DMACH0 EQU $500000 address of dma channel 0 DMACH1 EQU $500008 address of dma channel 1 ******************************************************************************** * * ADDRESS CONSTANTS * ******************************************************************************** H_INT_CA EQU $478000 ADDRESS OF INTERNAL HPIB INTERFACE  TTL IOLIB IOCOMASM - pascal dma procedures PAGE * * request a dma channel * IOCOMASM_DMA_REQUEST EQU * MOVEA.L (SP)+,A4 save return address MOVEA.L (SP)+,A2 get sc temp MOVEA.L C_ADR(A2),A1 get card ptr TRAP #11 GET INTO SUPERVISOR MODE scs * scs MOVE SR,-(SP) JUST IN CASE CALLER DIDN'T DISABLE ORI #$2700,SR INTERRUPTS, I WILL. BSR TESTDMA SEE IF DMA IS INSTALLED  BEQ.S DR_FAIL IF NOT, return -1 SUBQ.W #1,D3 turn $82/$81 to $81/$80 ANDI.W #1,D3 determine channel EXT.L D3 MOVE.B IO_SC(A2),DMA_SC(A0) ELSE CLAIM THIS CHANNEL FOR CALLER * following 3 lines for 68040 support JWH 2/15/91 btst #3,SYSFLAG2 bne no_40 jsr WRITE_68040 jsr ASM_FLUSH_ICACHE no_40 BRA.S DR_GOOD DR_FAIL MOVE.L #-1,D3 return -1 DR_GOOD MOVE (SP)+,SR restore int. state MOVE.L D3,(SP) assign return value - channel ( or -1 ) JMP (A4) return addr SPC 4 * * release a dma channel * IOCOMASM_DMA_RELEASE EQU * MOVEA.L (SP)+,A0 save return address MOVEA.L (SP)+,A2 get sc temp MOVEA.L C_ADR(A2),A1 get card ptr PEA (A0) push return address BRA DROPDMA release it SPC 4 TTL IOLIB IOCOMASM - assembly dma procedures PAGE ********+ ************************************************************************ * * GETDMA * * ROUTINE TO OBTAIN CONTROL OF A DMA CHANNEL * GET EITHER DMA CHANNEL, TRYING FOR CH 1 FIRST. * * ENTR: CONDITIONS ARE THE SAME AS FOR THE tfr DRIVER ENTRY POINT. * * EXIT: IF DMA IS NOT INSTALLED, 'no dma' escape is generated. * IF DMA IS INSTALLED, THE ALGORITHM WAITS FOR A CHANNEL TO * BECOME AVAILABLE AND THEN: * LOGS USE OF DMA CHANNEL * SETS UP ADDRESS AND COUNT REGISTERS. * CONSTRUCTS CARD ARM AND DMA ARM MASKS AS FOLLOWS: * D2.W = DMA ARM BYTE WITH BITS 1, 2 DEFINED BY * CONTENTS OF D1 AND BIT 0 = 1. * D3.B = CARD ENABLE BYTE WITH BITS 0, 1 DEFINED BY * WHICH DMA CHANNEL WAS GRANTED AND BIT 7=1. * A4.L = ADDRESS OF DMA CHANNEL ARM WORD. * * NOTE: IF THE REQUEST IS FOR INTERNAL HP-IB AS INDICATED BY A1, * ONLY CHANNEL 0 WILL BE GRANTED. * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** GETDMA TRAP #11  GET INTO SUPERVISOR MODE scs * scs MOVE SR,-(SP) JUST IN CASE CALLER DIDN'T DISABLE ORI #$2700,SR INTERRUPTS, I WILL. CMPI.L #$010001,D0 \ make sure count <=65536 BPL TERR_C  / BSR.S TESTDMA SEE IF DMA IS INSTALLED BEQ TERR_D IF NOT, GIVE ERROR MOVE.B IO_SC(A2),DMA_SC(A0) ELSE CLAIM THIS CHANNEL FOR CALLER * added for 68040 support JWH 2/15/91 btst #3,SYSFLAG2  bne not_40 jsr WRITE_68040 jsr ASM_FLUSH_ICACHE not_40 MOVEA.L D2,A4 A4 = ADDRESS OF DMA CHANNEL HARDWARE. SPC 1 MOVE.L TEMP_OFF(A3),D2 \ TST.B TDIR_OFF(A3) \ BNE.S GETDMA1  SET UP ADDRESS MOVE.L TFIL_OFF(A3),D2 / GETDMA1 MOVE.L D2,(A4)+ / SPC 1 SUBQ.L #1,D0 COUNT REGISTERS (COUNT REG MOVE.W D0,(A4)+ MUST BE COUNT-1) ADDQ.L #1,D0 SPC 2 CLR.W D2 MOVE.B TDIR_OFF(A3),D2 MOVE DIRECTION BIT INTO B2 OF D2 LSL #2,D2 IN ORDER TO CONSTRUCT DMA ARM SPC 2 TST.B T_BW_OFF(A3) IF BYTE TRANSFER BEQ.S GETDMA2 THEN SKIP ADDQ.W #2,D2 ELSE SET BIT 1 OF DMA ARM. GETDMA2 TST.B T_DMAPRI(A3) check for dma priority requested BEQ.S GETDMA3 ADDQ.W #8,D2 if set then set pri bit GETDMA3 ADDQ.W #1,D2 SET BIT0 OF DMA ARM MOVE (SP)+,SR scs RTS scs * scs RTE SPC 6 ******************************************************************************** * *  TESTDMA * * THIS ROUTINE TESTS FOR PRESENCE OF DMA HARDWARE AND WAITS FOR * A CHANNEL TO BECOME AVAILABLE. * * ENTRY: A1 = CARD ADDRESS * * EXIT: IF NO DMA IS INSTALLED, RET with zero flag set * IF DMA IS INSTALLED, RET with not zero set * A0.L = ADDRESS OF DMA FLAG FOR AVAILABLE CHANNEL * D2.L = ADDRESS OF AVAILABLE DMA CHANNEL * D3.B = CARD ENABLE BYTE FOR AVAILABLE CHANNEL * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** TESTDMA LEA DMAFLAG(A5),A0 \ TST.B (A0) DO RET 1 IF NO DMA BEQ.S TESTDMA_C / CMPA.L #H_INT_CA,A1 IF THIS IS A REQUEST FOR THE INTERNAL BEQ.S TESTDMA_A HP-IB, THEN CAN'T TRY FOR CH 1 SO SKIP. LEA DMA1(A5),A0 ELSE ASSUME WE CAN GET CH 1 MOVE.L #DMACH1,D2 * tm MOVEQ #$82,D3 MOVE.B #$82,D3 CMPI.+ B #255,DMA_SC(A0) CAN WE? BEQ.S TESTDMA_B IF SO, THEN RET 3 TESTDMA_A LEA DMA0(A5),A0 ELSE ASSUME WE CAN GET CH 0 MOVE.L #DMACH0,D2 * tm MOVEQ #$81,D3 MOVE.B #$81,D3 CMPI.B #255,DMA_SC(A0) CAN WE? BEQ.S TESTDMA_B IF HARDWARE PRESENT BUT BUSY,same as not there CLR D5 RTS TESTDMA_B MOVEQ #1,D5 ELSE WE GOT A CH TESTDMA_C RTS SPC 6 ******************************************************************************** * * DROPDMA * * ROUTINE TO FREE UP A DMA CHANNEL * * ENTRY: A2.L = POINTER TO DRIVER TEMPS * * EXIT: D4.W = FINAL DMA CHANNEL COUNT * CHANNEL IS DISARMED. * * USES: A0 * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** DROPDMA EQU * TRAP #11 scs * scs MOVE SR,-(SP) JUST IN CASE CALLER DIDN'T DISABLE ORI #$2700,SR INTERRUPTS, I WILL. BTST #GOT_68020,SYSFLAG2 CHECK IF WE HAVE 68020 BEQ.S DODROP IF NOT THEN SKIP JSR ASM_FLUSH_ICACHE FLUSH ICACHE ON 68020 MOVE CACHE_CTL,D4 GET EXT. CACHE CONTROL WORD ANDI #$63,D4 SET DISABLE MOVE D4,CACHE_CTL TURN CACHE OFF BSET #2,D4 SET ENABLE BIT MOVE D4,CACHE_CTL TURN CACHE BACK ON DODROP MOVEQ #0,D4 ASSUME DMA CHA ALREADY DROPPED... MOVE.B DMA_SC_0(A5),D0 \ CMP.B IO_SC(A2),D0 / IS IT CH 0? BNE.S DROPDMA0 IF NOT, SKIP LEA DMA0(A5),A4 GET A POINTER TO THE CHANNEL R/W LEA DMACH0,A0 POINT A0 TO CH 0 BRA.S DROPDMA1 GO DO IT SPC 2 DROPDMA0 MOVE.B DMA_SC_1(A5),D0 \ CMP.B IO_SC(A2),D0 / IS IT CH 1? BNE.S DROPDMA2 IF NOT, DO NOTHING LEA DMA1(A5),A4 GET A POINTER TO THE CHANNEL R/W LEA DMACH1,A0 POINT A0 TO CH 1 DROPDMA1 equ * * next 3 lines for 68040 support JWH 2/15/91 btst #3,SYSFLAG2 bne same_old jsr copy_68040 same_old MOVE.B #255,DMA_SC(A4) clear s.c. CLR.L DMASL(A4) clear static link CLR.L DMAISR(A4) clear isr pointer MOVE.L (A0)+,D4 DISARM CH BY READING ADDRESS CLR.L D4 MOVE.W (A0),D4 GET FINAL COUNT INTO D0 ADD.W #1,D4 FIX UP COUNT TO INDICATE LEFT OVER TFR'S DROPDMA2 MOVE (SP)+,SR scs RTS scs * scs RTE PAGE * ******************************************************************************* * WRITE_68040 JEFF HENDERSHOT 2/15/91. * * THIS ROUTINE IS CALLED IN CASE WE HAVE A 68040 AND WE HAVE ACTUALLY * CLAIMED A DMA CHANNEL. BASICALLY, ONCE A DMA CHANNEL HAS ACTUALLY * BEEN ASSIGNED, WE HAVE TO FORCE WRITETHROUGH CACHING MODE AND * FLUSH CACHES. WHEN ALL DMA CHANNELS ARE RELEASED WE CAN RESTORE * COPYBACK MODE IF THAT WAS THE MODE WE ENCOUNTERED HERE. * * CALLED BY : DMA_REQUEST and GETDMA, right after a DMA channel has * actually been claimed. Note - we do not call this from * TESTDMA because TESTDMA does not assign channels * * ALGORITHM: ASSUMES 68040 (PUT TEST BEFORE CALLING) * * IF DTT1 CONTAINS SOMETHING NON-ZERO * SAVE CONTENTS OF DTT1 (IN SAVE_DTT1) * PUT 0 (WRITETHROUGH MODE) IN DTT1 * EXIT ******************************************************************************** SAVE_DTT1 DC.L $00000000 save place for DTT1 * WRITE_68040 trap #11 supervisor mode move.l d0,-(sp) save d0 movec DTT1,d0 grab DTT1 cmpi.l #$, 00000000,d0 if 0 don't ... beq bag_it bother, already in writethrough move.l d0,SAVE_DTT1 else saveit move.l #0,d0 and force ... movec d0,DTT1 writethrough mode bag_it move.l (sp)+,d0 restore d0 move (sp)+,SR and SR also RTS ********************************************************************************* * COPY_68040 JEFF HENDERSHOT 2/15/91. * * THIS ROUTINE IS CALLED IN CASE WE HAVE A 68040 AND WE ARE * DROPPING A DMA CHANNEL. BASICALLY, ONCE A DMA CHANNEL HAS ACTUALLY * BEEN ASSIGNED, WE HAVE TO FORCE WRITETHROUGH CACHING MODE AND * FLUSH CACHES. WHEN ALL DMA CHANNELS ARE RELEASED WE CAN RESTORE * COPYBACK MODE (IF THAT MODE WAS SAVED EARLIER) * * CALLED BY : DROPDMA, right after the channel is released * * ENTRY: A0 contains DMACH0 or DMACH1 * * ALGORITHM: ASSUMES 68040 (PUT TEST BEFORE CALLING) * * IF SAVE_DTT1 HAS A NON-ZERO VALUE (COPYBACK MODE) * IF CHANNEL 0 RELEASED * IF CHANNEL 1 NOT IN USE * RESTORE DTT1 *  ZERO OUT SAVE_DTT1 * EXIT * IF CHANNEL 1 RELEASED * IF CHANNEL 0 NOT IN USE * RESTORE DTT1 * ZERO OUT SAVE_DTT1 * EXIT ******************************************************************************** COPY_68040 equ * move.l d0,-(sp) save d0 move.l SAVE_DTT1,d0 cmpi.l #0,d0 anything there ?  beq OUTTA_HERE bail out if not move.l a1,-(sp) a1 needed in either case cmpa.l #DMACH0,a0 was it channel 0 released ? bne hadta_be_one if not then one lea DMA1(A5),a1 see if .. CMPI.B #$FF,DMA_SC(a1) channel 1 busy BNE DONT if so don't restore DTT1 BRA PUT_IT otherwise do restore it hadta_be_one equ * no other choice lea DMA0(A5),a1 CMPI.B #$FF,DMA_SC(a1) channel 0 busy ? BNE DONT if so don't restore DTT1 PUT_IT trap #11 otherwise do save it movec d0,DTT1 d0 has SAVE_DTT1 move.l #0,SAVE_DTT1 clear save spot move (sp)+,SR restore SR also DONT movea.l (sp)+,a1 restore a1 OUTTA_HERE move.l (sp)+,d0 restore d0 RTS ****************************************************************************** * * TIMEREXISTS: PASCAL FUNCTION TO SEE IF TIMER EXISTS * * FUNCTION TIMEREXISTS: BOOLEAN; EXTERNAL; * * RETURNS TRUE IF TIMER PRESENT, ELSE FALSE * * J SCHMIDT 8/2/83 * ***************************************************************************** * TIMEREXISTS EQU * BTST #TIMER_PRESENT,SYSFLAG2 CHECK BIT FOR TIMER PRESENT SEQ 4(SP) SET FUNCTION RESULT 0=>TRUE RTS AND RETURN * *************************************************************************** * * TIMED_OUT: PASCAL FUNCTION TO SEE IF TIMEOUT HAS OCCURRED * * FUNCTION TIMED_OUT(VAR REC: TIMEOUTREC): BOOLEAN; EXTERNAL; * * TIMEOUTREC= PACKED RECORD * COUNT: INTEGER { SET TO TIMEOUT IN MS } * FIRSTTIME: BOOLEAN; {SET THIS TO TRUE FOR FIRST * CALL } * END; * * RETURNS: TRUE IF TIMEOUT PERIOD EXPIRED, ELSE FALSE * * CAUTION: WILL SMASH BOTH PARTS OF TIMEOUTREC PARAMETER * * J SCHMIDT 8/2/83 * * REMOVED ADDQ.L #4,SP AFTER SMI JWS 5/3/84 ***************************************************************************** * TI, MED_OUT MOVEA.L (SP)+,A0 SAVE RETURN ADDRESS JSR CHECK_TIMER CALL CHECK_TIMER USING PARAMETER ON STK SMI (SP) SET RESULT OF FUNCTION JMP (A0) AND RETURN WITH SP POINTING TO RESULT * ***************************************************************************** * * Bit shifting routines * ***************************************************************************** * IOCOMASM_binasr equ * movea.l (sp)+,a0 Save return address move.l (sp)+,d0 Pop # of bits to shift move.l (sp)+,d1 Pop the value to shift asr.l d0,d1 Shift the value move.l d1,(sp) Push the resulting return value jmp (a0) Return IOCOMASM_binlsr equ  * movea.l (sp)+,a0 Save return address move.l (sp)+,d0 Pop # of bits to shift move.l (sp)+,d1 Pop the value to shift lsr.l d0,d1 Shift the value move.l d1,(sp) Push the resulting return value jmp (a0) Return IOCOMASM_binasl equ * movea.l (sp)+,a0 Save return address move.l (sp)+,d0 Pop # of bits to shift move.l (sp)+,d1 Pop the value to shift asl.l d0,d1 Shift the value move.l d1,(sp)  Push the resulting return value jmp (a0) Return IOCOMASM_binlsl equ * movea.l (sp)+,a0 Save return address move.l (sp)+,d0 Pop # of bits to shift move.l (sp)+,d1 Pop the value to shift lsl.l d0,d1  Shift the value move.l d1,(sp) Push the resulting return value jmp (a0) Return end  (* (c) Copyright Hewlett-Packard Company, 1985. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) $MODCAL ON$ $PARTIAL_EVAL ON$ $STACKCHECK ON$ $RANGE OFF$ $DEBUG OFF$ $OVFLCHECK OFF$ $PAGE$ (************************************************************************) (*  *) (* RELEASED VERSION FOR 3.1 *) (* *) (************************************************************************) (* *) (* *) (* IOLIB DISCINT_DRIVERS (98625 Disc Interface) *) (* *) (* *) (************************************************************************) (*  *) (* *) (* library - IOLIB *) (* name - DISCINT_DRIVERS  *) (* module(s) - di_drv *) (* - discint *) (* *) (* author  - Joe Cowan *) (* phone - 303-226-3800 ext. 2404 *) (* *) (* date - May 5 , 1982 -  *) (* update - Aug 10 , 1983 ( J Schmidt ) *) (* release - Jul 12 , 1985 *) (* *) (*  source - IOLIB:DI_DRV.TEXT *) (* object - IOLIB:DI_DRV.CODE *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* *) (*  *) (* This is the source code for an external procedures library *) (* to be used for general purpose interfacing on the HP 9826. *) (* *) (* The library consists of 3 primary sets of modules - *) (* *) (* 1. KERNEL modules *) (* 2. driver modules  *) (* 3. IOLIB modules *) (* *) (* The KERNEL modules consist of the following modules - *) (*  *) (* 1. iodeclarations ( contains static r/w space ) *) (* 2. iocomasm *) (* 3. general_0  ( initialization & low level *) (* routines like ioread/iowrite) *) (* The KERNEL modules also have an executable program segement *) (* that gets executed at the time it is loaded. This program *) (* initializes the static read/write memory. This program also *) (* allocates the temporary storage for any card that exists - *) (* independent of whether there is or is not a driver for it. *) (*  *) (* The driver modules consist of the actual assembly or PASCAL *) (* routines that deal with a specific interface card. There is *) (* also an executable program segment for each driver module. *) (* This program searches the select code table in the static r/w *) (* initialized by the KERNEL general_0 module for all select codes *) (* that have the right interface card ( HPIB drivers will search *) (* for the 98624 interface ). This program will then set up the *) (* driver tables to point to the correct drivers. *) (* *) (* The rest of the IOLIB modules are high-level modules that are *) (* used by an end user in his/her application program. *) (* *) (* The KERNEL and some set of driver modules will exist in the  *) (* SYSTEM.INITLIB file as object code ( not EXPORT text ). The *) (* export text will reside on the SYSTEM.LIBRARY file. The rest *) (* of the library will reside on the SYSTEM.LIBRARY. *) (*  *) (************************************************************************) $PAGE$ (************************************************************************) (*  *) (* *) (* REFERENCES : *) (* *) (* -  *) (* 1. 9826 I/O Designers Guide ( Loyd Nelson ) *) (* *) (* 2. 68000 Manual  ( Motorola ) *) (* *) (* 3. Pascal alpha site ERS ( Roger Ison ) *) (*  *) (* 4. Pascal I/O Library ERS ( Tim Mikkelsen ) *) (* *) (* 5. 9826 HPL EIO & IOD listings ( Bob Hallissy ) *) (*  *) (* 6. 9826 HPL Misc. I/O Doc. ( Bob Hallissy ) *) (* *) (* 7. 9826 card documentation ( Mfg. Specs. ) *) (* *) (* 8. Pascal I/O Library IRS ( Tim Mikkelsen ) *) (* *) (*  *) (************************************************************************) $PAGE$ PROGRAM discint_initialize ( INPUT , OUTPUT ); { This module has a program segment so that there is  an executable entry point into the module. At INITLIB time this program is executed. } $PAGE$ EXTERNAL MODULE extdi; { by Joe Cowan date 05/03/82 update 08/10/83 by J Schmidt purpose This module is a declaration of the importation text for the external drivers. note The assembly language code that is imported needs to be called 'extdi'. The routines need to be called 'extdi_@@@@@@' - edi_init referenced below would be extdi_edi_init. 'edi' refers to external disc interface. } IMPORT { $SEARCH 'IOLIB:KERNEL.CODE'$ } sysglobals , iodeclarations ; EXPORT PROCEDURE edi_init ( temp : ANYPTR ); PROCEDURE edi_isr ( temp : PISRIB ); PROCEDURE edi_rdb ( temp : ANYPTR ; VAR x : CHAR); PROCEDURE edi_wtb ( temp : ANYPTR ; val : CHAR); PROCEDURE edi_rdw ( temp : ANYPTR ; VAR x : io_word); PROCEDURE edi_wtw ( temp : ANYPTR ; val : io_word); PROCEDURE edi_rds ( temp : ANYPTR ; reg : io_word; VAR x : io_word); PROCEDURE edi_wtc ( temp : ANYPTR ; reg : io_word; val : io_word ); PROCEDURE edi_tfr ( temp : ANYPTR ; bcb : ANYPTR ); PROCEDURE edi_send ( temp : ANYPTR ; val : CHAR ); PROCEDURE edi_ppoll ( temp : ANYPTR ; VAR x : CHAR ); PROCEDURE edi_clr ( temp : ANYPTR ; line : io_bit ); PROCEDURE edi_set ( temp : ANYPTR ; line : io_bit ); PROCEDURE edi_test ( temp : ANYPTR ; line : io_bit ; VAR x : BOOLEAN ); PROCEDURE edi_end ( temp : ANYPTR ; VAR x : BOOLEAN ); END; { of extdi } $PAGE$ MODULE init_discint; { by Joe Cowan date 05/03/82 update 08/10/83 by J Schmidt -- vers. number purpose This module initializes the DISCINT drivers. } IMPORT iodeclarations ; EXPORT VAR discint_drivers : drv_table_type; PROCEDURE io_init_discint; IMPLEMENT IMPORT sysglobals , isr , general_0 , extdi ; PROCEDURE io_init_discint; VAR io_isc : type_isc; dummy : INTEGER; io_lvl : io_byte; BEGIN io_revid := io_revid + ' DI3.2'; { set up the driver tables } WITH discint_drivers DO BEGIN discint_drivers := dummy_drivers; iod_init := edi_init; iod_isr := edi_isr; iod_rdb := ed. i_rdb; iod_wtb := edi_wtb; iod_rdw := edi_rdw; iod_wtw := edi_wtw; iod_rds := edi_rds; iod_wtc := edi_wtc; iod_end := edi_end; iod_tfr := edi_tfr; iod_send := edi_send; iod_ppoll := edi_ppoll; iod_set := edi_set; iod_clr := edi_clr; iod_test := edi_test; END; { of WITH } { set up drivers for the interfaces } FOR io_isc:=iominisc TO iomaxisc DO WITH isc_table[io_isc] DO BEGIN IF card_id = hp98625 THEN BEGIN io_drv_ptr:=ADDR(discint_drivers); WITH io_drv_ptr^, io_tmp_ptr^ DO BEGIN io_lvl:=((ioread_byte(io_isc,3) DIV 16) MOD 4)+3; { if the card exists then link in an ISR for it } { ??? - what happens if an ISR fires during init } IF myisrib.INTREGADDR <> NIL THEN BEGIN { remove any existant isr } ISRUNLINK(io_lvl, { interrupt level  } addr(myisrib)); { ptr to the isrib } END; { of IF } PERMISRLINK(iod_isr, { isr } ANYPTR(INTEGER(card_ptr)+3), { int reg addr } 192, { int reg mask } 192, { int reg value } io_lvl, { int level }  ADDR(myisrib)); { isrib info } END; { of WITH // DO BEGIN } END; { of IF card_id } END; { of FOR io_isc WITH isc_table[io_isc] BEGIN } { call the actual driver initialization } { this is seperate from the set up stuff in case there are 2 or more cards connected - and generate an isr } FOR io_isc:=iominisc TO iomaxisc DO WITH isc_table[io_isc] DO IF card_id = hp98625 THEN BEGIN CALL(io_drv_ptr^.iod_init , io_tmp_ptr); END; { of WITH IF } END; { of io_init_discint } END; { of MODULE init_discint } $PAGE$ IMPORT init_discint , LOADER ; { 367 TM 9/22/82 } BEGIN io_init_discint; MARKUSER; { 367 TM 9/22/82 } END. { of discint_initialize }  TTL IOLIB EXTH - HPIB DRIVERS PAGE ******************************************************************************** * * COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY * ******************************************************************************** * * * IOLIB EXTH * * ******************************************************************************** * * * * Library - IOLIB * Author - Tim Mikkelsen * Phone - 303-226-3800 ext. 2910 * * Purpose - This set of assembly language code is intended to be used as * a PASCAL module for I/O drivers for use by the external I/O * procedures library. * * Most of this code is taken from Bob Hallissy's HPL code. * *  Date - 08/18/81 * Update - 08/01/83 * Release - 7/12/85 * * * Source - IOLIB:HPIB.TEXT * Object - IOLIB:HPIB.CODE * * ******************************************************************************** * * * RELEASED *  VERSION 3.1 * * ******************************************************************************** PAGE **************************************************************************** *  * * * * BUG FIX HISTORY - after release 1.0 * * * * .  * * BUG # BY / ON LOC DESCRIPTION * * ----- ----------- -------------- ---------------------- * *  * * SPR695 T Mikkelsen HPL_WTC the HPIB cards will not * * 04/21/1982 respond properly to a PPC/ * * PPE setup of ppoll info * * * * SPR740 T Mikkelsen H_TID DMA input transfers will * * 05/28/1982 not terminate properly if * * there is an EOI termination * * and EOI is true on the * * first byte and the byte * *  comes in immediately. This * * is a big problem for disk * * transfers. * *  * * SPRxxx T Mikkelsen H_BYTTST DMA input transfers will * * 06/14/1982 not terminate properly if * * 07/21/1982 the device is very fast and * * EOI is true on the last * * byte. Due to DMA on lvl 3 * * and an external HPIB card * *  on lvl 4,5, or 6. * * * * 475 T Mikkelsen all over Change BSRs into JSRs to * * 09/17/1982 allow re-placement of the * * modules. Also in GPIO and * * Data Comm. * *  * * 564 T Mikkelsen H_WTC_PPC IOCONTROL(sc,2,x) does not * * 10/22/1982 work - set up PPOLL byte. * * Always responds with a * *  PPOLL response of 4. * * * **************************************************************************** *  * * * * * * BUG FIX HISTORY - after release 2.0  * * * * * * BUG # BY / ON LOC DESCRIPTION * * ----- ----------- -------------- ---------------------- * * * * qqqq T Mikkelsen H_TID Non active controller DMA * * 12/16/1982  transfers do not work. * * They mess up the count. * * * * rrrr T Mikkelsen H_EIR Re-enabling interrupts when * * 12/17/1982 srq is already asserted do * * not work. * * * * wuwu T / Mikkelsen H_DMATERM Re-enabling interrupts when * * 01/19/1983 ON EOT routine is called * * due to flukey term emulator * *  problem. * * * * hphp T Mikkelsen H_INIT_S Allowing DMA non-ctlr tfrs * * 01/28/1983 H_EIR to be started from inside * * H_DMATERM user ISR. * * H_ISR * * H_TFR * *  H_ENABLE H_DISABLE * * * * ???? J Cowan H_T_FHS Even though FHS with the * * 02/02/1983  internal HPIB to Coyote * * makes the interleave, FHS * * with the external HPIB to * * Coyote does not!!! * * * * tttt J Schmidt H_WAIT_BO Timing changes for 680xx * * 08/01/1983 H_WAIT_BI processors on UMM CPU boards* *  05/02/1984 H_P_POLL * * H_IFC * * H_ISR0 * *  * **************************************************************************** PAGE ******************************************************************************** * * * The following lines are used to tell the LINKER/LOADER what this module * looks like in PASCAL terms. * * Note that it is possible to create assembly modules that are functions. * These routines are called through an indirect pointer using the CALL * facility which does NOT permit functions. * * This module is called 'EXTH' ( upper or lower case - doesn't matter ) * independent of the file name ( by use of the MNAME pseudo-op ). * * All the externally used procedures are called 'EXTH_@@@@@@@@' in *  this module. If you are using assembly to access them use the * 'EXTH_@@@@@@@' name. If you are using Pascal use the '@@@@@@@' * name. * ******************************************************************************** MNAME EXTH  SRC MODULE EXTH; SRC IMPORT iodeclarations; SRC EXPORT SRC PROCEDURE eh_init ( temp : ANYPTR ); SRC PROCEDURE eh_isr ( temp : ANYPTR ); SRC PROCEDURE eh_rdb ( temp : ANYPTR ; VAR x : CHAR); SRC PROCEDURE eh_wtb ( temp : ANYPTR ; val : CHAR); SRC PROCEDURE eh_rdw ( temp : ANYPTR ; VAR x : io_word); SRC PROCEDURE eh_wtw ( temp : ANYPTR ; val : io_word); SRC PROCEDURE eh_rds ( temp : ANYPTR ; reg : io_word; SRC VAR x : io_word); SRC PROCEDURE eh_wtc ( temp : ANYPTR ; reg : io_word; SRC val : io_word ); SRC PROCEDURE eh_tfr ( temp : ANYPTR ; bcb : ANYPTR ); SRC PROCEDURE eh_send ( temp : ANYPTR ; val : CHAR ); SRC PROCEDURE eh_end ( temp : ANYPTR ; VAR x : BOOLEAN ); SRC  PROCEDURE eh_ppoll ( temp : ANYPTR ; VAR x : CHAR ); SRC PROCEDURE eh_clr ( temp : ANYPTR ; line : io_bit ); SRC PROCEDURE eh_set ( temp : ANYPTR ; line : io_bit ); SRC PROCEDURE eh_test ( temp : / ANYPTR ; line : io_bit ; SRC VAR x : BOOLEAN ); SRC END; { of EXTH } PAGE ******************************************************************************** * * SYMBOLS FOR EXPORT AS PROCEDURE NAMES * ******************************************************************************** DEF EXTH_EXTH SPC 1 DEF EXTH_EH_INIT DEF EXTH_EH_ISR,EXTH_EH_TDMA DEF EXTH_EH_RDB,EXTH_EH_WTB DEF EXTH_EH_RDW,EXTH_EH_WTW DEF EXTH_EH_RDS,EXTH_EH_WTC DEF EXTH_EH_TFR SPC 1 DEF EXTH_EH_SEND,EXTH_EH_PPOLL,EXTH_EH_SET DEF EXTH_EH_CLR,EXTH_EH_TEST,EXTH_EH_END SPC 5 ******************************************************************************** * * SYMBOLS FOR IMPORT - COMMON ASSEMBLY LANGUAGE ROUTINES * * THE ROUTINES ARE IN THE MODULE COMMON_ASSEMBLY * THE TIMER ROUTINES ARE IN THE FILE "POWERUP" * ******************************************************************************** REFA DROPDMA give up dma resource REFA GETDMA actually get dma REFA TESTDMA check to see if dma is available REFA LOGINT branch to user isr REFA LOGEOT branch to user eot REFA STBSY set buffer busy REFA STCLR set buffer not busy REFA DMA_STBSY set buffer dma busy REFA ITXFR is there a tfr active ?  REFA ABORT_IO kill any tfr active REFA WAIT_TFR timed wait for tfr active REFA CHECK_TFR timed wait for tfr - direction REFA DELAY_TIMER timed delay REFA CHECK_TIMER timed wait for timeout checking * change references to allow long jumps when the I/O 475 JPC 9/17/82 * modules get moved around 475 JPC 9/17/82 LMODE DROPDMA,GETDMA,TESTDMA,LOGINT,LOGEOT,STBSY LMODE STCLR,DMA_STBSY,ITXFR,ABORT_IO,WAIT_TFR,CHECK_TFR LMODE DELAY_TIMER,CHECK_TIMER TTL IOLIB EXTH - COMMON EQUATES AND DEFINITIONS PAGE INCLUDE COMDCL TTL IOLIB EXTH - HPIB DRIVER EQUATES PAGE * H_INT0COPY EQU AVAIL_OFF+0 COPY OF INT0STAT REGISTER H_INT1COPY EQU AVAIL_OFF+1 COPY OF INT1STAT REGISTER H_INTMSKSAV EQU AVAIL_OFF+2 COPY OF INT0MASK & INT1MASK H_STAT3 EQU AVAIL_OFF+4 STATUS BYTE 3 MASK: * BIT 0: EOR LATCH * BITS 1-7: 0 H_FLAGS EQU AVAIL_OFF+5 DRIVER FLAGS AND STATUS BYTE 0 MASK: * BIT 0: PASS CONTROL FLAG * BIT 1: USER ISR TO BE CALLED ( IN ISR ) * BIT 2: ERROR INDICATOR * BIT 3: IFC INDICATOR * BIT 4: DCL INDICATOR * BIT 5: GET INDICATOR *  BIT 6: CURRENT rsv STATUS BIT. * BIT 7: IF SET, 9914 IS IN HOLDOFF MODE, THEREFORE * ISSUE RELEASE HOLD OFF BEFORE READING, AND *  USE TAKE CONTROL SYNC TO SET ATN. H_PPOLLMSK EQU AVAIL_OFF+6 VALUE TO PUT IN H_PPOLL WHEN ist = 1 * EQU AVAIL_OFF+7 VALUE TO PUT IN H_PPOLL WHEN ist = 0 SPC 4 TTL IOLIB EXTH - PASCAL ENTRY POINTS PAGE ******************************************************************************** * * PASCAL DRIVER ENTRY POINTS FOR HP-IB CARDS * ******************************************************************************** SPC 1 * * Module initialization * EXTH_EXTH EQU * RTS Do nothing * * Driver initialization * EXTH_EH_INIT EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A2 get temp address 0  MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_INIT * * Interrupt service routine * EXTH_EH_ISR EQU * MOVEA.L (SP)+,A0 get return address  MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_ISR * * HPIB DMA transfer termination routine * EXTH_EH_TDMA EQU *  MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_DMATERM * * Read a byte * EXTH_EH_RDB EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0)  push return address back on stack BSR H_RDB call read byte MOVE.B D0,(A3) save character RTS * * Write a byte * EXTH_EH_WTB EQU * MOVEA.L (SP)+,A0 get return address  MOVE.B (SP)+,D0 get value ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA  H_WTB call write byte * * Read a word * EXTH_EH_RDW EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BSR H_RDB call read byte MOVE.B D0,D5 save byte BSR H_RDB read second byte LSL.W #8,D5  shift first by MOVE.B D0,D5 bring in low bits MOVE.W D5,(A3) save word RTS * * Write a word * EXTH_EH_WTW EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D0 get word value MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack MOVE.B D0,D5 save second byte LSR #8,D0  BSR H_WTB write the byte MOVE.B D5,D0 get the second byte BRA H_WTB write the byte * * Read status * EXTH_EH_RDS EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVE.W (SP)+,D1 get register number MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack  BSR H_RDS read status MOVE.W D0,(A3) save status info RTS * * Write control * EXTH_EH_WTC EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D0 get value MOVE.W (SP)+,D1 get register number MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_WTC write control * *  Transfer * EXTH_EH_TFR EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get buffer control block address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address  PEA (A0) push return address back on stack BRA H_TFR transfer * * Send an 'ATN' true command * EXTH_EH_SEND EQU * MOVEA.L (SP)+,A0 get return address MOVE.B (SP)+,D0 get val0 ue ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_R6OUT send command byte * * Perform a Parallel Poll * EXTH_EH_PPOLL EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BSR H_P_POLL do a parallel poll MOVE.B D0,(A3) save value RTS * * Set an HPIB line * EXTH_EH_SET EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D1 get line ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_SET call set line * * Clear an HPIB line * EXTH_EH_CLR EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D1 get line ( this actually bumps SP by 2 )  MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BRA H_CLR clear the line * * Test an HPIB line * EXTH_EH_TEST EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVE.W (SP)+,D1 get line ( this actually bumps SP by 2 ) MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack BSR H_TEST read status MOVE.B D0,(A3) save character RTS * * Test for EOI/END condition * EXTH_EH_END EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) push return address back on stack MOVE.B H_STAT3(A2),D0 get EOR bit ANDI.B #1,D0 mask it off MOVE.B D0,(A3) save condition RTS TTL IOLIB EXTH - HPIB CARD DECLARATIONS PAGE ******************************************************************************** * * ADDRESS CONSTANTS * ******************************************************************************** H_INT_CA EQU $478000 address of internal HP-IB card SPC 4 ******************************************************************************** * * HP-IB CARD ADDRESS EQUATES ( OFFSETS FROM A1 ) * * for the TI 9914 * * HPL DECLARATIONS * ******************************************************************************** H_EXTSTAT EQU $05 READ EXTERNAL STATUS REGISTER H_INT0STAT EQU $11 READ INTERRUPT STATUS REGISTER 0 H_INT0MASK EQU $11 WRITE INTERRUPT MASK REGISTER 0 H_INT1STAT EQU $13 READ INTERRUPT STATUS REGISTER 1 H_INT1MASK EQU $13 WRITE INTERRUPT MASK REGISTER 1 H_ADRSSTAT EQU $15 READ ADDRESS STATUS REGISTER H_BUSSTAT EQU $17 READ BUS STATUS REGISTER H_AUXCMD EQU $17 WRITE AUXILLARY COMMAND REGISTER H_ADDRESS EQU $19 WRITE ADDRESS REGISTER H_SPOLL EQU $1B WRITE SERIAL POLL RESPONSE REGISTER H_CMDPASS EQU $1D READ COMMAND PASS THROUGH REGISTER H_PPOLL EQU $1D WRITE PARALLEL RESPONSE REGISTER H_DATAIN EQU $1F READ DATA IN REGISTER H_DATAOUT  EQU $1F WRITE DATA OUT REGISTER PAGE ******************************************************************************** * * HP-IB AUXILLARY COMMAND EQUATES * * for the TI 9914 * * HPL DECLARATIONS * **************1 ****************************************************************** H_SWRST0 EQU $00 FALSE SOFTWARE RESET H_SWRST1 EQU $80 TRUE " " H_DACR0 EQU $01 FALSE RELEASE DAC HOLDOFF H_DACR1 EQU $81 TRUE " "  " H_RHDF EQU $02 PULSE RELEASE RFD HOLDOFF H_HDFA0 EQU $03 FALSE HOLDOFF ON ALL DATA H_HDFA1 EQU $83 TRUE " " " " H_HDFE0 EQU $04 FALSE HOLDOFF ON END H_HDFE1 EQU $84 TRUE " " " H_NBAF EQU $05 PULSE SET NEW BYTE AVAILABLE H_FGET0 EQU $06 FALSE FORCE GROUP EXECUTE TRIGGER H_FGET1 EQU $86 TRUE " " " " H_RTL0 EQU $07 FALSE RETURN TO LOCAL H_RTL1 EQU $87 TRUE " " " H_FEOI EQU $08 PULSE FORCE EOI H_LON0 EQU $09 FALSE LISTEN ONLY H_LON1 EQU $89 TRUE " " H_TON0 EQU $0A FALSE TALK ONLY H_TON1 EQU $8A TRUE " " H_GTS EQU $0B PULSE GO TO STANBY H_TCA EQU $0C PULSE TAKE CONTROL ASYNCHRONOUSLY H_TCS EQU $0D PULSE TAKE CONTROL SYNCHRONOUSLY H_RPP0 EQU $0E FALSE REQUEST PARALLEL POLL H_RPP1 EQU $8E TRUE " " " H_SIC0 EQU $0F FALSE SEND IFC H_SIC1 EQU $8F TRUE " " H_SRE0 EQU $10 FALSE SEND REN H_SRE1 EQU $90 TRUE " " H_RQC EQU $11 PULSE REQUEST CONTROL H_RLC EQU $12 PULSE RELEASE CONTROL H_DAI0 EQU $13 FALSE DISABLE ALL INTERRUPTS H_DAI1 EQU $93 TRUE " " " H_PTS EQU $14 PULSE PASS THROUGH NEXT SECONDARY H_STDL0 EQU $15 FALSE SET T1 DELAY (1200ns) H_STDL1 EQU $95 TRUE " " " H_SHDW0 EQU $16 FALSE SHADOW HANDSHAKE H_SHDW1 EQU $96 TRUE " " H_VSTDL0 EQU $17 FALSE SPECIAL SET T1 DELAY FOR 9914A (600ns) H_VSTDL1 EQU $97 TRUE " " " PAGE ******************************************************************************** * * HP-IB command equates * * PASCAL DECLARATIONS * ******************************************************************************** GTL EQU 1 go to local SDC EQU 4  selective device clear PPC EQU 5 ppoll configure GET EQU 8 group execute trigger TCT EQU 9 take control LLO EQU 17 local lockout DCL EQU 20 device clear PPU EQU 21 ppoll unconfigure SPE EQU 24 spoll enable SPD EQU 25 spoll disable UNL EQU 63 unlisten UNT EQU 95 untalk PPE EQU 96  ppoll enable PPD EQU 112 ppoll disable TTL IOLIB EXTH - HPIB DRIVERS PAGE * wuwu TM 1/19/83 * SET THE PROCESSOR INTERRUPT LEVEL TO THE INTERFACE  wuwu TM 1/19/83 * CARD'S INTERRUPT LEVEL wuwu TM 1/19/83 * wuwu TM 1/19/83 * A1 MUST HAVE THE CARD ADDRESS wuwu TM 1/19/83 * wuwu TM 1/19/83 SET_INT_LEVEL MOVEQ #0,D0 wuwu TM 1/19/83 CMPA.L #$478000,A1 THIS THE INTERNAL HPIB? BEQ.S  INTLEV_1 BRANCH IF SO MOVEQ #$30,D0 CARD'S INTERRUPT LEVEL MASK AND.B 3(A1),D0 INTERRUPT LEVEL IN UPPER NIBBLE LSR #4,D0 SHIFT TO LOWER NIBBLE INTLEV_1 ADDQ  #3,D0 CONVERT TO PROCESSOR'S INTERRUPT LEVEL LSL #8,D0 SHIFT TO UPPER BYTE MOVE D0,-(SP) SAVE FOR A MOMENT MOVE SR,D0 CURRENT STATUS REGISTER AN1 DI #$F8FF,D0 STRIP CURRENT INT LEVEL BITS OR (SP)+,D0 SUBSTITUTE NEW INT LEVEL BITS MOVE D0,SR SET NEW INTERRUPT LEVEL RTS wuwu TM 1/19/83 PAGE ******************************************************************************** * * H_INIT * * INITIALIZE AN HP-IB CARD * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** H_INIT EQU * * tm MOVE.B MA(A2),D0 ASSUME THIS IS NOT POWER UP AND MOVE.W #21,D0 ASSUME THIS IS THE INTERNAL CARD BTST #7,H_EXTSTAT(A1) SO CHOOSE ADDRESS 21 IF THIS BNE.S H_INIT_C IS SYSTEM CONTROLLER ELSE MOVE.W #20,D0 CHOOSE ADDRESS 20. H_INIT_C CMPA.L #H_INT_CA,A1 IS THIS THE INTERNAL CARD? BEQ.S H_INIT0 IF SO, SKIP  MOVE.B H_EXTSTAT(A1),D0 ELSE GET ADDRESS FROM CARD AND #$1F,D0 CMP #31,D0 IF CARD SAYS IT IS AT ADDRESS BNE.S H_INIT0 31, THEN USE ZERO INSTEAD! MOVEQ #0,D0 H_INIT0 MOVE.B #H_SRE0,H_AUXCMD(A1) set REN false BSR.S H_INIT_S START SOFTWARE RESET BNE H_IFC IF SYSTEM CONTROLLER, BRANCH RTS ******************************************************************************** * * H_INT_S * * SUBROUTINE USED FOR BOTH INITIALIZATION AND wtc: * * HPL ROUTINE * ******************************************************************************** H_INIT_S MOVE.B #H_SWRST1,H_AUXCMD(A1) START SOFTWARE RESET MOVE.W D0,MA_W(A2) SAVE MY ADDRESS MOVE.B D0,H_ADDRESS(A1) AND TELL CARD MY ADDRESS JSR ABORT_IO CLEANUP ANY ATTACHED BUFFER LEA H_AUXCMD(A1),A0 MAKE A0 POINT TO AUX CMD REG MOVEQ #0,D0 AND PRELOAD D0 WITH A ZERO MOVE.B #H_STDL1,(A0) SET T1 DELAY (1200NS) MOVE.B #H_VSTDL1,(A0) SET T1 DELAY FOR 9914A (600NS) MOVEP D0,H_INT0MASK(A1) FOR NOW, CLEAR BOTH INT MASKS MOVE.W D0,H_INT0COPY(A2) CLEAR COPYS OF INT STAT REGS MOVE.W D0,H_STAT3(A2) INIT. DRIVER FLAGS MOVE.B #H_HDFA1,(A0) SET HOLD OFF ON ALL DATA MOVE.B #H_HDFE0,(A0) CLEAR HOLD OFF ON END MOVE.B #H_RPP0,(A0) CLEAR PAR. POLL IF ACTIVE. MOVE.B D0,H_SPOLL(A1) CLEAR SERIAL POLL RESPONSE MOVE.B D0,H_PPOLL(A1) UNCONFIGURE PARALLEL POLL MOVE.W D0,H_PPOLLMSK(A2)  CLEAR PPOLL MASK MOVE.B #H_SWRST0,(A0) CLEAR SOFTWARE RESET * tm MOVEQ #0,D0 SET UP INT MASKS BSR H_EIR MOVE.B #$80,3(A1) ENABLE THE CARD ( hphp TM 1/19/83 ) BTST #7,H_EXTSTAT(A1) IS THIS A SYSTEM CONTROLLER? RTS (LEAVE CC FOR CALLER) PAGE ******************************************************************************** * * H_RDB * * READ A BYTE OF DATA FROM HP-IB * * EXIT: D0.B = BYTE READ * * HPL ROUTINE * ******************************************************************************** H_RDB MOVE.B #H_GTS,H_AUXCMD(A1) CLEAR ATN BTST #2,H_ADRSSTAT(A1) MAKE SURE ADDRESSED TO LISTEN BEQ.S H_LSTERR ELSE GIVE ERROR H_RDB0 BCLR #7,H_FLAGS(A2) TEST (AND CLEAR) HOLDOFF FLAG BEQ.S H_RDB1 IF IT WAS CLEAR, SKIP BCLR #0,H_STAT3(A2) CLEAR EOR ( EOI ) FLAG IN TEMPS MOVE.B #H_RHDF,H_AUXCMD(A1) RELEASE RFD HOLDOFF TO START HS H_RDB1 BSR H_WAIT_BI NOW WAIT FOR BYTE IN MOVEQ #0,D0 ELSE CLEAR UPPER PART OF D0 MOVE.B H_DATAOU2 T(A1),D0 AND PUT DATA IN LOWER BYTE RTS DONE! SPC 6 ******************************************************************************** * * H_WTB * * WRITE A BYTE OF DATA TO HP-IB * *  ENTRY: D0.B = BYTE TO WRITE * * HPL ROUTINE * ******************************************************************************** H_WTB BTST #1,H_ADRSSTAT(A1) MAKE SURE ADDRESSED TO TALK BEQ.S H_TLKERR ELSE ERROR H_WTB0 MOVE.B #H_GTS,H_AUXCMD(A1) CLEAR ATN H_WTB1 BSR H_WAIT_BO WAIT FOR BYTE OUT MOVE.B D0,H_DATAOUT(A1) MOVE THE DATA OUT RTS DONE! SPC 4 TTL IOLIB EXTH - ERROR ESCAPES PAGE ******************************************************************************** * * Error escapes * ******************************************************************************** H_SCBSY MOVEQ #SC_BUSY,D0  buffer is busy BRA.S ESC_ERR H_SC_ERR MOVEQ #BAD_SCT,D0 bad set/clear/test BRA.S ESC_ERR H_NOTACTL MOVEQ #NO_ACTL,D0 not active controller BRA.S ESC_ERR H_NOTSCTL MOVEQ #NO_SCTL,D0 not system controller BRA.S ESC_ERR HTERR_B MOVEQ #TFR_ERR,D0 bad transfer specification BRA.S ESC_ERR HTERR_D MOVEQ #NO_DMA,D0 DMA not installed BRA.S ESC_ERR H_NOWORD MOVEQ #NO_WORD,D0  WORD transfers not allowed BRA.S ESC_ERR H_LSTERR MOVEQ #NOT_LSTN,D0 not addressed as listener BRA.S ESC_ERR H_TLKERR MOVEQ #NOT_TALK,D0 not addressed as talker BRA.S ESC_ERR H_TMO MOVEQ #TMO_ERR,D0 timeout * BRA.S ESC_ERR SPC 4 ESC_ERR EXT.L D0 MOVE.L D0,IOE_RSLT(A5) save error in io space MOVE.B IO_SC(A2),D0 \ get sc for error MOVE.L D0,IOE_SC(A5)  / MOVE.W #IOE_ERROR,ESC_CODE(A5) save system esc code TRAP #10 escape PAGE ******************************************************************************** * * HP-IB WAIT ROUTINES * * * ENTRY: H_WAIT_BO WAIT FOR BO STATUS TO BE TRUE * H_WAIT_BI WAIT FOR BI STATUS TO BE TRUE * * EXIT: IF CONDITION IS OR COMES TRUE, RTS. * THE ERROR ESCAPE IS GENERATED * IF TIMEOUT > 0 AND MS HAS EXPIRED, OR * * NOTE: DURING THE FIRST 1-2 MS OF THE WAIT, A QUICK CHECK ALGORITHM IS * USED WHICH DOES NOT CHECK THE TIMEOUT - THUS IF * THE DATA RATE IS > 1 KB, NO TIMEOUT DETECTION OVERHEAD OCCURS. * * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** H_WAIT_BO MOVE.L #254,D2 D2 = QUICK CHECK LOOP COUNTER * * Quick check counter was 127, changed to 254 tttt  JS 8/1/83 * ALSO CHANGED MOVEQ TO MOVE.L * H_WBO_1 MOVE.B H_INT0STAT(A1),D1 GET THE INTERRUPT STATUS CMP #$3F,D1 IF IN READING THE STATUS WE MISSED AN BLS.S H_WBO_2 AN INTERRUPT, THEN WE HAVE TO BSR H_FAKEISR FAKE AISR CALL...DUMB HARDWARE! MOVEQ #0,D1 H_WBO_2 OR.B H_INT0COPY(A2),D1 THIS IS IN CASE ISR LEFT STUFF HERE BTST #4,D1 BYTE OUT? BNE.S H_W_DONE  IF SO, GET OUT! DBRA D2,H_WBO_1 ELSE LOOP BACK SPC 1 MOVE.L TIMEOUT(A2),D2 OK, SET UP TO WATCH FOR TIMEOUT,ETC BEQ.S H_WBO_5 if =0 goto inf loop BTST #TIMER_PRESENT,SYSFLAG2 CHECK IF TIMER THERE tttt JS 8/1/83 BEQ.S H_WBOT YES, USE IT tttt JS 8/1/83 * tm MULU #60,D2 60 TIMES THROUGH LOOP = 1 MS LSL.L #6,D2 ( * 64 IS 2 CLOSE ENOUGH ) H_WBO_3 BSR H_GETSTAT GO GET STATUS BTST #4,D1 BYTE OUT? BNE.S H_WAIT_D1 YES, GET OUT OF HERE! SUBQ.L #1,D2 LOOP UNTIL GRACE PERIOD DONE  BNE H_WBO_3 BRA.S H_TMO_ERR GIVE ERROR SPC 1 H_WBO_5 BSR H_GETSTAT ELSE TRY AGAIN FOR STATUS BTST #4,D1 BEQ H_WBO_5 IF NOT SET, KEEP WAITING SPC 1 H_W_DONE OR.B D1,H_INT0COPY(A2) SAVE ANY STATUS BITS WE DIDN'T USE H_WAIT_D1 ANDI.B #$CF,H_INT0COPY(A2) CLEAR BO/BI BITS BTST #5,D1 DID WE GET A BYTE IN? BEQ.S H_WAIT_D2 IF NOT, SKIP  BSET #7,H_FLAGS(A2) ELSE SET HOLDOFF FLAG H_WAIT_D2 RTS DONE! SPC 4 H_TMO_ERR OR.B D1,H_INT0COPY(A2) SAVE ANY STATUS BITS NOT USED. BRA H_TMO H_WBOT MOVE.B #1,-(SP) SETUP TIMER RECORD tttt JS 8/1/83 MOVE.L D2,-(SP) tttt JS 8/1/83 H_WBOT1 BSR H_GETSTAT CHECK FOR BYTE OUT tttt JS 8/1/83 BTST #4,D1 BO SET? tttt JS 8/1/83 BNE.S H_WBOT2 YES, GET OUT OF HERE tttt JS 8/1/83 PEA (SP) ELSE CHECK TIMER tttt JS 8/1/83 JSR CHECK_TIMER tttt JS 8/1/83 BPL H_WBOT1  BR IF NOT TIMED OUT tttt JS 8/1/83 ADDQ #6,SP TIMEOUT, GIVE ONE tttt JS 5/2/84 MOVEQ #60,D2 MORE CHANCE WITH tttt JS 5/2/84 BRA H_WBO_3 SHORT TIMEOUT  tttt JS 5/2/84 H_WBOT2 ADDQ #6,SP CLEAN UP STACK tttt JS 8/1/83 BRA H_WAIT_D1 AND RETURN tttt JS 8/1/83 SPC 4 H_WAIT_BI MOVE.L #254,D2 D2 = QUICK CHECK LOOP COUNTER * * Quick timeout count was 127, changed to get 1 MS on 16 MHz processor * tttt JS 8/1/83 ALSO CHANGED MOVEQ TO MOVE.L * H_WBI_1 MOVE.B H_INT0STAT(A1),D1 GET THE INTERRUPT STATUS CMP #$3F,D1 IF IN READING THE STATUS WE MISSED AN BLS.S H_WBI_2 AN INTERRUPT, THEN WE HAVE TO BSR H_FAKEISR FAKE AISR CALL...DUMB HARDWARE! MOVEQ #0,D1 H_WBI_2 OR.B H_INT0COPY(A2),D1 THIS IS IN CASE ISR LEFT STUFF HERE BTST #5,D1 BYTE IN? BNE.S H_W_DONE IF SO, GET OUT! DBRA D2,H_WBI_1 ELSE LOOP BACK SPC 1 MOVE.L TIMEOUT(A2),D2 OK, SET UP TO WATCH FOR TIMEOUT,ETC  BEQ.S H_WBI_5 if =0 goto inf loop BTST #TIMER_PRESENT,SYSFLAG2 CHECK FOR TIMER tttt JS 8/1/83 BEQ.S H_WBIT IF THERE USE IT tttt JS 8/1/83 * tm MULU #60,D2 60 TIMES THROUGH LOOP = 1 MS LSL.L #6,D2 ( * 64 IS CLOSE ENOUGH ) H_WBI_3 BSR H_GETSTAT GO GET STATUS BTST #5,D1 BYTE IN? BNE.S H_WAIT_D1 YES, GET OUT OF HERE! SUBQ.L #1,D2 LOOP UNTIL GRACE PERIOD DONE BNE H_WBI_3 BRA.S H_TMO_ERR IF SO, GIVE ERROR SPC 1 H_WBI_5 BSR H_GETSTAT ELSE TRY AGAIN FOR STATUS BTST #5,D1 BNE H_WAIT_D1 IF SET, GET OUT! BRA H_WBI_5 H_WBIT MOVE.B #1,-(SP) SET UP TIMER RECORD tttt JS 8/1/83 MOVE.L D2,-(SP) tttt JS 8/1/83 H_WBIT1 BSR H_GETSTAT GET STATUS tttt JS 8/1/83 BTST #5,D1 CHECK FOR BI SET tttt JS 8/1/83 BNE.S H_WBIT2 IF GOTIT THEN EXIT tttt JS 8/1/83 PEA (SP) 3  ELSE CHECK TIMER tttt JS 8/1/83 JSR CHECK_TIMER tttt JS 8/1/83 BPL H_WBIT1 BR IF NOT TIMED OUT tttt JS 8/1/83 ADDQ #6,SP TIMEOUT, GIVE ONE MORE tttt JS 5/2/84 MOVEQ #60,D2 CHANCE WITH SHORT tttt JS 5/2/84 BRA H_WBI_3 TIMEOUT COUNT tttt JS 5/2/84 H_WBIT2 ADDQ #6,SP CLEAN UP TIMER RECORD tttt JS 8/1/83 BRA H_WAIT_D1 AND GET OUT tttt JS 8/1/83 PAGE ******************************************************************************** * * H_GETSTAT * * SUBROUTINE TO GET INT0STAT AND INSURE WE DON'T MISS AN * INTERRUPT * * HPL ROUTINE * ******************************************************************************** H_GETSTAT MOVE.B H_INT0STAT(A1),D1 GET CURRENT INTERRUPT STATUS CMP.B #$3F,D1  DID WE MISS AN INTERRUPT? BLS.S H_G_STAT1 IF NOT, THEN DONE BSR.S H_FAKEISR ELSE FAKE AN ISR CALL MOVEQ #0,D1 AND JUST USE THE COPY H_G_STAT1 OR.B H_INT0COPY(A2),D1 INCLUDE ANY SAVED BITS OR.B D1,H_INT0COPY(A2) RTS SPC 3 ******************************************************************************** * * H_FAKEISR * * SUBROUTINE TO FAKE AN ISR IN CASE AN INPUT FROM INT0STAT * CAUSED HARDWARE TO MISS AN INTERRUPT. * * ENTRY: D1.B = INT0STAT(A1) WHICH CAUSED INTERRUPT * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** H_FAKEISR TRAP #11  GET INTO SUPERVISOR MODE scs * scs MOVE SR,-(SP) PUT SR ON STACK FOR ISR'S RTE MOVEM.L D0-D7/A0-A6,-(SP) SAVE REGISTERS OR.B D1,H_INT0COPY(A2) PUT BYTE WHERE ISR WILL SEE IT  BSR SET_INT_LEVEL DISABLE CARD INTRS wuwu TM 1/19/83 JSR H_ISR CALL ISR MOVEM.L (SP)+,D0-D7/A0-A6 RESTORE REGISTERS MOVE (SP)+,SR RESTORE USER MODE scs RTS scs * scs RTE Re-enable interrupts and get SR off stack PAGE ******************************************************************************** * * H_RDS * * READ STATUS * * PASCAL ROUTINE * ******************************************************************************** H_ROUTINE EQU 2 H_TEMP EQU 1 H_CRDREG EQU 0 * * H_RDS LEA H_RDSTBL,A0 get pointer to lookup table ADD.W D1,D1 multiply the rds register by 2 CMP.B #H_RT_SIZ,D1 \ check for out of bounds BGE.S RDS_ERR / MOVE.W 0(A0,D1),D0 get the table entry BMI.S RDS_ERR if the entry is 0 then error CMP.B #H_TEMP,D0 BEQ.S HR_TEMP BLT.S HR_CARD LSR #8,D0 get the routine offset BEQ.S H_RDS_ID - status rtn 0 - card id SUBQ #1,D0 BEQ.S H_RDS_CS - status 3 - ctrl status + address SUBQ #1,D0 BEQ.S H_RDS_ST - status 6 - chip state SUBQ #1,D0 BEQ.S H_RDS_LI - status 7 - bus lines * BRA.S RDS_ERR there are no more status 'routines' SPC 2 RDS_ERR MOVEQ #BAD_RDS,D0 bad read status BRA ESC_ERR SPC 2 * * retrieve temps as words * HR_TEMP LSR #8,D0 get temp offset MOVE.W 0(A2,D0),D0 get the value RTS SPC 3 * * retrieve card registers as bytes * HR_CARD LSR #8,D0 get the 3 card offset HR_CARD1 MOVE.B 0(A1,D0),D0 get the value ANDI.W #$00FF,D0 mask off garbage RTS SPC 3 * * card id * H_RDS_ID MOVE.W #1,D0 * tm CMPA.L #H_INT_CA,A1 is this the internal card ? * tm BNE.S HR_CARD1 RTS SPC 2 H_RDS_CS MOVE.B H_EXTSTAT(A1),D0 get sys ctl and active ctl BCHG #6,D0 complement NOT actv ctl ANDI.W #$C0,D0 mask bits  ADD.B MA(A2),D0 get my address RTS SPC 2 H_RDS_ST BSR H_RDS_CS get sys/act ctl and address info MOVE.B H_ADRSSTAT(A1),D1 get chip state LSL #8,D1 ADD.W D1,D0  put together in D0 RTS SPC 2 H_RDS_LI MOVE.B H_BUSSTAT(A1),D0 get bus lines LSL #8,D0 MOVE.B H_DATAIN(A1),D0 get data lines RTS SPC 4 H_RDSTBL EQU *  DC.B 0,H_ROUTINE status 0 - routine 0 - card id DC.B 3,H_CRDREG status 1 - card reg 3 - intr/dma status DC.B 99,H_ROUTINE status 2 - not implemented DC.B 1,H_ROUTINE  status 3 - status&addr - sys & act ctl my addr DC.B H_INT0COPY,H_TEMP status 4 - temps DC.B H_INTMSKSAV,H_TEMP status 5 - temps DC.B 2,H_ROUTINE status 6 - card reg 21+ - state DC.B 3,H_ROUTINE status 7 - card reg 23 - bus state DC.B H_CMDPASS,H_CRDREG status 8 - card reg - command H_RT_END EQU * H_RT_SIZ EQU H_RT_END-H_RDSTBL size of table PAGE ******************************************************************************** * * H_WTC * * WRITE CONTROL * * ENTRY: D0.W = PARAMETER * ******************************************************************************** H_WTC CMPI.W #6,D1 \ check for ctl limits BGE.S RDS_ERR / EXT.L D1 ADD.L D1,D1 JMP HWTCTBL(D1) SPC 3 HWTCTBL BRA.S H_WTC_RST CONTROL 0 - DO A RESET BRA.S H_RQS CONTROL 1 - set SRQ response BRA.S H_WTC_PPC CONTROL 2 : ppoll configure BRA.S H_WTC_SMA CONTROL 3 - set my addr BRA.S RDS_ERR CONTROL 4 : not used BRA.S H_EIR CONTROL 5 : enable intrpts SPC 5 ******************************************************************************** * * HPL_WTC * * WRITE CONTROL TO HP-IB ( alter my addr or set ppoll conf. ) * * ENTRY: D0.W = PARAMETER * * NOTE: This command was illegal on a 9825. On WILDFIRE, it is used * to alter the HP-IB address of a given card and/or reset the * card without generating IFC or locally configure the * parallel poll response: * * wtc 7,20 will change address to 20 and reset card * wtc 7,31 will reset the card without changing addr * wtc 7, will do PP configure. * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** HPL_WTC CMP #31,D0 MAKE SURE PARM IS 0..31 BHI.S HPL_WTC3 IF NOT, GO TO PPOLL CONFIGURE HPL_WTC0 BNE.S HPL_WTC1  IF PARM <31, THEN SKIP SPC 2 H_WTC_RST EQU * MOVE.B MA(A2),D0 ELSE USE PREVIOUS ADDRESS SPC 2 H_WTC_SMA EQU * HPL_WTC1 MOVE.B H_EXTSTAT(A1),-(SP) SAVE CONTROLLER ACTIVE STATE. BSR  H_INIT_S DO SOFTWARE RESET BTST #6,(SP)+ WERE WE CONTROLLER? BNE.S HPL_WTC2 IF NOT, SKIP MOVE.B #H_RQC,(A0) ELSE REGAIN CONTROL MOVE.B #H_GTS,(A0) A4 ND RE-DROP ATN HPL_WTC2 RTS ELSE DONE SPC 3 HPL_WTC3 MOVEQ #0,D1 COMPUTE THE TWO BYTE PPOLLMSK BSET D0,D1 BASED ON CONFIGURATION IN D0. MOVE.W D1,H_PPOLLMSK(A2) SAVE THE MASK BSR HPL_WTC4 set response in 9914 ( SPR695 TM 4/21/82 ) RTS ( SPR695 TM 4/21/82 ) SPC 3 H_WTC_PPC EQU * MOVE.B D0,D1  copy so HPL_WTC4 works( 564 TM 10/6/82 ) LSL.W #8,D1 \ duplicate in left ( 564 TM 10/6/82 ) OR.B D0,D1 / byte for rsv stuff ( 564 TM 10/6/82 ) CLR.W H_PPOLLMSK(A2)  clear the mask ( SPR695 TM 4/21/82 ) MOVE.W D1,H_PPOLLMSK(A2) move new mask in temps( SPR695 TM 4/21/82 ) BSR HPL_WTC4 set response in 9914 ( SPR695 TM 4/21/82 ) RTS SPC 3 ******************************************************************************** * * H_RQS * * request service - set spoll response ( & SRQ ) * * NOTE : rsv is the Request SerVice bit. * On the 9825 this is tied to the *  ist state ( individual status ). * In the IEEE 488 standard the rsv state is * the SRQ response and ist is the PPOLL * response. The standard does not * specify any relation between the * two. * * PASCAL ROUTINE ( taken from HPL R7OUT ) * ******************************************************************************** H_RQS BCLR #6,H_FLAGS(A2) ASSUME rsv = 0 IN THIS NEW BYTE MOVE.B D0,D1 IF rsv BIT IN THE NEW BYTE IS INDEED BCLR #6,D1 ZERO, THEN JUST OUTPUT THE NEW BYTE. BEQ.S H_RQS2 MOVE.B D1,H_SPOLL(A1) ELSE FIRST WRITE THE BYTE WITH rsv BSET #6,H_FLAGS(A2) CLEAR. REMEMBER THAT rsv IS SET. H_RQS2 MOVE.B D0,H_SPOLL(A1) WRITE THE BYTE WITH rsv CORRECT. MOVE.W H_PPOLLMSK(A2),D1 GO UPDATE THE PARALLEL POLL RESPONSE HPL_WTC4 TRAP #11  scs * scs MOVE SR,-(SP) DISABLE ISR'S WHILE WE FIGURE ORI #$2700,SR OUT WHICH MASK TO SET BASED ON BTST #6,H_FLAGS(A2) CURRENT rsv BIT. BEQ.S HPL_WTC5  IF rsv = 0, USE RIGHT BYTE ROR #8,D1 ELSE USE LEFT BYTE HPL_WTC5 MOVE.B D1,H_PPOLL(A1) MOVE (SP)+,SR scs RTS  scs * scs RTE RE-ENABLE ISR'S AND RETURN PAGE ******************************************************************************** * * H_EIR * * ENABLE THE HP-IB BASED ON 98034 ENABLE BYTE * *  ENTRY: D0.B = EIR BYTE A LA 98034 CARD * * EXIT: EIR BYTE SAVED IN DRIVER TEMPS. * EIR ACCOMPLISHED. ANY CONDITIONS ALREADY TRUE GENERATE LOGIN. * * USES: D0, D1, D2 * * HPL ROUTINE * ******************************************************************************** H_EIR MOVE.B D0,EIRB_OFF(A2) SAVE EIR BYTE MOVE.B #H_DAI1,H_AUXCMD(A1) DISABLE ALL INTS FOR A SEC * tm MOVE.B #$80,3(A1) ENABLE THE CARD ( hphp TM 1/19/83 ) MOVE.W #$CEAB,D1 D1 = INITIAL VALUE OF INTMSK MOVE.W D0,D2 EXTRACT IRF & ORE BITS FROM BYTE AND #$C,D2 LSL #8,D2 MOVE THESE BITS TO BI/BO POSITION  LSL #2,D2 OR D2,D1 AND INCLUDE IN THE ENABLE MASK MOVE.W D0,D2 SAVE EIR BYTE IN D2 WHILE LOOKING FOR AND #$30,D0 EITHER TLK OR LST BITS ON? BEQ.S H_EIR2 4  IF NOT, SKIP ADD #4,D1 ELSE ENABLE MA TO INTERRUPT H_EIR2 MOVE.W D1,H_INTMSKSAV(A2) SAVE THIS MASK VALUE MOVEP D1,H_INT0MASK(A1) GIVE MASK TO 9914 MOVE.B H_FLAGS(A2),D0 GENERATE IMMEDIATE INTERRUPT IF ANY AND #$3C,D0 OF THE 'OTHER' CONDITIONS ARE TRUE BEQ.S H_EIR3 JSR LOGINT H_EIR3 BSR H_CHKADDR GENERATE ANY ADDRESS INTERRUPTS. BSR H_CHKSRQ  GENERATE SRQ INTERRUPT IF NECESSARY MOVE.B H_INT0COPY(A2),D1 IF BI/BO IS ENABLED AND THE AND.B H_INTMSKSAV(A2),D1 BO/BI STATUS IS ALREADY TRUE, AND.B #$30,D1 THEN WE HAVE TO FAKE AN  BEQ.S H_EIR4 INTERRUPT. BSR H_FAKEISR H_EIR4 MOVE.B #H_DAI0,H_AUXCMD(A1) RENABLE ALL INTS FOR CARD BCLR #1,H_FLAGS(A2) if isr pend then do it ( rrrr TM 12/17/82 ) BEQ.S H_EIR5  else just exit ( rrrr TM 12/17/82 ) JSR LOGINT ( rrrr TM 12/17/82 ) H_EIR5 RTS ( rrrr TM 12/17/82 ) PAGE ******************************************************************************** * * H_ENABLE * * ENABLE THE HP-IB FOR TRANSFER USES * * ENTRY: D0.W = 9914 ENABLE MASK ( TO BE INCLUSIVE OR'ED ) * ( D0 = #$2000 FOR BYTE IN ( BI ) *  ( D0 = #$1000 FOR BYTE OUT ( BO ) * * USES: D0, D1 * * PASCAL ROUTINE 1/19/83 * ******************************************************************************** H_ENABLE EQU * MOVE.B #H_DAI1,H_AUXCMD(A1) DISABLE THE CARD ( hphp TM 1/19/83 ) OR.W H_INTMSKSAV(A2),D0 OR NEW BITS IN ( hphp TM 1/19/83 ) H_ED_COM MOVE.W D0,H_INTMSKSAV(A2) AND RE-SAVE ( hphp TM 1/19/83 ) MOVEP D0,H_INT0MASK(A1) AND GIVE TO CARD ( hphp TM 1/19/83 ) MOVE.B H_INT0COPY(A2),D1 IF BI/BO ENABLED & ( hphp TM 1/19/83 ) AND.B H_INTMSKSAV(A2),D1 IS ALREADY TRUE, ( hphp TM 1/19/83 ) AND.B #$30,D1 THEN FAKE AN ( hphp TM 1/19/83 ) BEQ.S H_ED_EXIT INTERRUPT. ( hphp TM 1/19/83 ) BSR H_FAKEISR ( hphp TM 1/19/83 ) H_ED_EXIT MOVE.B #H_DAI0,H_AUXCMD(A1) RENABLE CARD ( hphp TM 1/19/83 )  RTS ( hphp TM 1/19/83 ) ******************************************************************************** * * H_DISABLE * * DISABLES BO AND BI ON THE HP-IB FOR TRANSFER USES * * USES: D0, D1 * * PASCAL ROUTINE 1/19/83 * ******************************************************************************** H_DISABLE EQU * MOVE.B #H_DAI1,H_AUXCMD(A1) DISABLE THE CARD ( hphp TM 1/19/83 ) MOVE.W H_INTMSKSAV(A2),D0 GET OLD MASK ( hphp TM 1/19/83 ) ANDI.W #$CFFF,D0 MASK OUT BO/BI ( hphp TM 1/25/83 ) BRA.S H_ED_COM JUMP TO COMMON CODE ( hphp TM 1/19/83 ) PAGE ******************************************************************************** * * H_P_POLL * * CONDUCT PARALLEL POLL * * IF NOT ACTIVE CONTROLLER GIVE ERROR * ELSE VALUE RETURNED IN D0.B * * HPL ROUTINE * ******************************************************************************** H_P_POLL BSR H_SET_ATN SET ATN LINE BSR H_WAIT_BO WAIT FOR 'READY' ORI.B #16,H_INT0COPY(A2) (SAVE BO STATUS FOR LATER) MOVE.B #H_RPP1,H_AUXCMD(A1) REQUEST THE PARALLEL POLL * JS MOVEQ #20,D0 DELAY 40 US FOR LINES TO SETTLE * JS DBRA D0,* MOVE.L #40,-(SP) USE TIMER FOR DELAY tttt JS 8/1/83 JSR DELAY_TIMER 5  tttt JS 8/1/83 MOVEQ #0,D0 MOVE.B H_CMDPASS(A1),D0 GET THE RESPONSE MOVE.B #H_RPP0,H_AUXCMD(A1) CLEAR PARALLEL POLL MOVE.B #H_GTS,H_AUXCMD(A1) CLEAR ATN RTS PAGE ******************************************************************************** * * H_SET * * Set an HPIB line true * * PASCAL ROUTINE * ******************************************************************************** H_SET CMP #7,D1  \ BHI H_SC_ERR / make sure bit # is <=7 ADD D1,D1 LEA H_S_TBL,A0 \ ADDA.W 0(A0,D1),A0 INDEXED JUMP THRU TABLE JMP (A0) / *  move h_s_tbl(d1),d1 * jmp h_s_tbl(d1) SPC 3 H_S_TBL EQU * DC.W H_REN-H_S_TBL REN - set REN DC.W H_IFC-H_S_TBL IFC - pulse IFC ( set REN/clr ATN ) DC.W H_SC_ERR-H_S_TBL SRQ - error DC.W H_EOI-H_S_TBL EOI - pulse EOI on next byte out DC.W H_SC_ERR-H_S_TBL NRFD - error DC.W H_SC_ERR-H_S_TBL NDAC - error DC.W H_SC_ERR-H_S_TBL DAV - error DC.W H_SET_ATN-H_S_TBL ATN - set ATN true SPC 3 ******************************************************************************** * * H_REN * * SET REN ON HP-IB * * EXIT : IF NOT SYSTEM CONTROLLER THEN GIVE ERROR * * HPL ROUTINE * ******************************************************************************** H_REN BTST #7,H_EXTSTAT(A1) BEQ H_NOTSCTL BRA.S H_IFC2 SPC 3 ******************************************************************************** * * H_IFC * * DRIVE IFC TRUE FOR 100 MICROSECONDS * * ENTRY : IF NOT SYSTEM CONTROLLER, CLEAR STS AND SET ERR * * EXIT : ATN CLEARED *  REN SET * * NOTE : IF THE 9914 IS NOT IN SOFTWARE RESET, THIS ROUTINE WILL * DRIVE THE ATN LINE TRUE DURING THE IFC. * * HPL ROUTINE * * ******************************************************************************** H_IFC BTST #7,H_EXTSTAT(A1) MUST BE SYSTEM CONTROLLER BEQ H_NOTSCTL MOVE.B #H_SIC1,H_AUXCMD(A1) SET IFC * JS MOVEQ #70,D0 SET DELAY COUNT * JS DBRA D0,* MOVE.L #100,-(SP) USE TIMER FOR DELAY tttt JS 8/1/83 JSR DELAY_TIMER tttt JS 8/1/83 MOVE.B #H_SIC0,H_AUXCMD(A1) CLEAR IFC MOVE.B #H_GTS,H_AUXCMD(A1) CLEAR ATN H_IFC2 MOVE.B #H_SRE1,H_AUXCMD(A1) SET REN RTS SPC 3 ******************************************************************************** * * H_SET_ATN * * ROUTINE TO SET ATN. * * EXIT: IF NOT CONTROLLER THEN GIVE ERROR *  ELSE IF ADDRESSED TO LISTEN AND HOLDOFF FLAG IS SET * THEN DO TCS * ELSE IF ADDRESSED TO TALK, * THEN WAIT FOR BO STATUS AND DO TCA * ELSE DO TCA * * USES: H_WAIT ROUTINE * * HPL ROUTINE ( H_SET_ATN used to be H_ATN1 ) * ( H_SET_ATN was identical to H_ATN1 * except for error exits ) * ******************************************************************************** H_SET_ATN BTST #6,H_EXTSTAT(A1) BETTER BE CONTROLLER BNE H_NOTACTL ELSE ERROR H_ATN1A MOVE.B H_ADRSSTAT(A1),D1 GET ADDRESSED STATUS MOVEQ #H_TCS,D2 ASSUME WE CAN DO TCS BTST #2,D1  ARE WE A LISTENER? BEQ.S H_ATN1_0 IF NOT, SKIP BTST #7,H_FLAGS(A2) TEST HOLDOFF FLAG BNE.S H_ATN1_3 IF IT WAS SET, USE THE TCS BRA.S H_ATN1_2 ELSE DO TCA H5 _ATN1_0 BTST #1,D1 ARE WE A TALKER? BEQ.S H_ATN1_2 IF NOT, TAKE CONTROL ASYNC H_ATN1_1 BSR H_WAIT_BO ELSE WAIT FOR BYTE OUT ORI.B #16,H_INT0COPY(A2) (SAVE BO STATUS FOR LATER!) H_ATN1_2 MOVEQ #H_TCA,D2 DO TAKE CONTROL ASYNC H_ATN1_3 MOVE.B D2,H_AUXCMD(A1) TAKE CONTROL! RTS SPC 3 ******************************************************************************** * * H_EOI * * ROUTINE TO SET EOI ON THE NEXT BYTE OUT * * test to see if 9914 waits - * if so - ok * if not- do wait ( HW... ) * ******************************************************************************** H_EOI MOVE.B #H_FEOI,H_AUXCMD(A1) SET EIO WITH NEXT BYTE H_DMYRTS RTS PAGE ******************************************************************************** * * H_CLR * * Set an HPIB line false * * PASCAL ROUTINE * ******************************************************************************** H_CLR CMP #7,D1 \ BHI H_SC_ERR / make sure bit # is <=7 ADD.W D1,D1 LEA H_C_TBL,A0 \ ADDA.W 0(A0,D1),A0 INDEXED JUMP THRU TABLE JMP (A0) / SPC 3 H_C_TBL EQU * DC.W H_LOCAL-H_C_TBL REN - clear REN DC.W H_DMYRTS-H_C_TBL IFC - nothing DC.W H_SC_ERR-H_C_TBL SRQ - error DC.W H_DMYRTS-H_C_TBL EOI - nothing DC.W H_SC_ERR-H_C_TBL NRFD - error DC.W H_SC_ERR-H_C_TBL NDAC - error DC.W H_SC_ERR-H_C_TBL DAV - error DC.W  H_CLR_ATN-H_C_TBL ATN - clear ATN SPC 3 ******************************************************************************** * * H_LOCAL * * CLEAR REN ON HP-IB * * EXIT : IF NOT SYSTEM CONTROLLER THEN GIVE ERROR * *  PASCAL ROUTINE * ******************************************************************************** H_LOCAL BTST #7,H_EXTSTAT(A1) BEQ H_NOTSCTL MOVE.B #H_SRE0,H_AUXCMD(A1) CLEAR REN RTS SPC 3 ******************************************************************************** * * H_CLR_ATN * * CLEAR ATN ON HP-IB * * EXIT : IF NOT ACTIVE CONTROLLER THEN GIVE ERROR * * PASCAL ROUTINE * ******************************************************************************** H_CLR_ATN BTST #6,H_EXTSTAT(A1) BNE H_NOTACTL MOVE.B #H_GTS,H_AUXCMD(A1) CLEAR ATN RTS SPC 3 PAGE ******************************************************************************** * * H_TEST * * Get an HPIB line's state * * ENTRY : D1 = line parameter * 0 = REN * 1 = IFC * 2 = SRQ *  3 = EOI * 4 = NRFD * 5 = NDAC * 6 = DAV * 7 = ATN * * PASCAL ROUTINE * ******************************************************************************** H_TEST MOVEQ #1,D0 assume line is true BTST D1,H_BUSSTAT(A1) test bus lines from 9914 BNE.S H_TEST_EX if line is set then return CLR.W D0 else set false return H_TEST_EX RTS PAGE ******************************************************************************** * * H_R6OUT * * EMULATION OF R6 OUT FOR HP-IB * * ENTRY: D0 = BYTE TO OUTPUT * * EXIT: IF NOT ACTIVE CONTROLLER, STS CLEARED AND ERROR BIT SET * ELSE OPERATION IS DONE AND ANY ADDRESSING DECODED. * * HPL ROUTINE ( MODIFIED ) * * ******************************************************************************** H_R6OUT JSR WAIT_T6 FR IF A TFR IS ACTIVE WAIT TILL IT ISN'T BSR H_SET_ATN GO SET ATN OR GIVE STS ERROR BSET #0,H_FLAGS(A2) SET PASS CONTROL FLAG BSR H_WTB1 GO OUTPUT THE BYTE AND #$7F,D0 CLEAR MSB FOR COMPARISON MOVE.B MA(A2),D2 GET MY ADDRESS OR #$20,D2 MAKE A LISTEN ADDRESS * tm MOVEQ #H_LON1,D1 ASSUME LON COMMAND... MOVE.B #H_LON1,D1 CMP.B D2,D0 MLA? BEQ.S H_R6OUT3 IF SO GO DO LON EORI #$60,D2 MAKE A TALK ADDRESS * tm MOVEQ #H_TON1,D1 ASSUME TON COMMAND... MOVE.B #H_TON1,D1  CMP.B D2,D0 MTA? BEQ.S H_R6OUT3 IF SO, GO DO TON MOVEQ #H_LON0,D1 ASSUME LON0 COMMAND CMP.B #UNL,D0 UNLISTEN? BEQ.S H_R6OUT3 IF SO, GO DO LON0 CMP.B #TCT,D0 TAKE CONTROL? BEQ.S H_R6TCT IF SO , SKIP to tct code H_R6OUT2 AND #$60,D0 OTHER TALK ADDRESS? CMP.B #$40,D0 BNE.S H_R6OUT4  IF NOT, SKIP MOVEQ #H_TON0,D1 IF SO, SET UP FOR TON0 H_R6OUT3 MOVE.B D1,H_AUXCMD(A1) IF SO, DO IT H_R6OUT4 BCLR #0,H_FLAGS(A2) CLEAR PASS CONTROL FLAG * * Added for 68040 timing problem - delay just a little bit * This timing value taken from another usage in this file * Our test suite passes with a value of 5. I tried to get * a spec value but I couldn't find one. This delay value * may have to be increased in the future ... JWH 2/28/91 * BTST #3,SYSFLAG2 68040 only BNE just_leave else same as before MOVE.L #40,-(SP) this time delay JSR DELAY_TIMER worked with our test suite just_leave RTS JWH 2/28/91 SPC 3 H_R6TCT BTST #1,H_ADRSSTAT(A1) ARE WE TALKER? BNE.S H_R6OUT4 IF SO, IGNORE TCT BSR H_WAIT_BO IF NOT, THEN WAIT FOR BYTE OUT MOVE.B #H_GTS,H_AUXCMD(A1) AND drop atn MOVE.B #H_RLC,H_AUXCMD(A1) AND RELEASE CONTROL HTCTLOOP BTST #6,H_EXTSTAT(A1) (tm) \ BEQ HTCTLOOP (tm) / wait for non active ctl RTS (tm) exit PAGE ******************************************************************************** * * H_DMATERM * * TERMINATION OF DMA TRANSFER * * CALLED FROM DMA INTERRUPT SERVICE ROUTINE * * DMA RESOURCE HAS ALREADY BEEN RELEASED * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** H_DMATERM BSR SET_INT_LEVEL DISABLE CARD INTRS wuwu TM 1/19/83 * this is okay - only called in ISR JSR DROPDMA RELINQUISH DMA RESOURCE MOVE.B #$80,3(A1) TURN OFF DMA ENABLE BITS( hphp TM 1/27/83 ) * in the card. ( hphp TM 1/27/83 ) JSR ITXFR MAKE SURE THERE IS A TRANSFER ACTIVE BEQ.S HDMA_END IF NOT, FORGET THE INTERRUPT * at this point * D4 has remaining count * D3 has intended  MOVE.L D4,TCNT_OFF(A3) update count SUB.L D4,D3 put # bytes tfr'd into D3 TST.B TDIR_OFF(A3) WHAT DIRECTION OF TRANSFER? BNE.S H_DMATO IF OUTPUT, SKIP ADD.L  D3,TFIL_OFF(A3) update fill pointer MOVE.B #H_HDFE0,H_AUXCMD(A1) ELSE CLEAR HOLD OFF ON END MODE MOVE.B #H_HDFA1,H_AUXCMD(A1) SET HOLD OFF ON ALL MODE MOVE.W #$2000,D0 PRESET ENABLE FOR BI ( hphp TM 1/6 19/83 ) H_DMATI_1 MOVE.L #1,TCNT_OFF(A3) TRANSFER LAST BYTE UNDER INTERRUPT BSR H_ENABLE ( hphp TM 1/19/83 ) BRA.S HDMA_END SPC 2 H_DMATO ADD.L D3,TEMP_OFF(A3) update empty pointer TST.B TEND_OFF(A3) IS EOI TAG SET? BEQ.S H_DMATO_1 IF NOT, TRANSFER IS DONE! MOVE.W #$1000,D0 SEND LAST BYTE BY INTR ( hphp TM 1/19/83 ) BRA.S H_DMATI_1 H_DMATO_1 JSR STCLR CLEAR BUFFER BUSY BITS & LOG BRANCH HDMA_END RTS END OF SERVICE TTL IOLIB EXTH - HPIB INTERRUPT SERVICE ROUTINE PAGE ******************************************************************************** * * H_ISR * * INTERRUPT SERVICE ROUTINE FOR HP-IB CARDS * * ENTRY : A1,A2 are set up * * The ISR will track down the buffer control block * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** H_ISR EQU * BCLR #1,H_FLAGS(A2) clear user isr pending flag MOVEP H_INT0STAT(A1),D0 GET BOTH STATUS BYTES FROM 9914 BSR H_ISR1  PROCESS THE INTERRUPTING CONDITION(S) JSR ITXFR GO SEE IF TRANSFER IS ACTIVE BEQ.S HISR_END IF NOT, THEN WE ARE DONE. CMP.B #TT_BURST,D1 IF FRW IS ACTIVE, GO PROCESS IT  BEQ H_FRW CMP.B #TT_INT,D1 IF INT THEN GO PROCESS IT BEQ.S H_BUF CMP.B #TT_DMA,D1 IF DMA BEQ.S H_ISRDMA HISR_END BCLR #1,H_FLAGS(A2) if isr pending then do it BEQ.S H_ISR_EX JSR LOGINT H_ISR_EX RTS otherwise return ( used for FAKEISR ) SPC 2 * * DMA TRANSFER CLEANUP: * H_ISRDMA CMPI.L #1,D3 IF COUNT IS = one , THIS IS BEQ.S H_BUF THE EXTRA TFR BY INTERRUPT, SO SKIP TST.B TDIR_OFF(A3) \ BNE.S HISR_END / IF OUTPUT, CAN'T BE EARLY TERM TST.B TEND_OFF(A3) \ BEQ.S HISR_END / IF NO EOI TAG, CAN'T BE EARLY TERM BTST #11,D0 \ BEQ HISR_END / IF EOI NOT SET, CAN'T BE EARLY TERM MOVE.B #$80,3(A1) ELSE IT IS EARLY DMA TERMINATION MOVE.B #H_HDFA1,H_AUXCMD(A1) SO DISABLE DMA, SET HOLD OFF ON MOVE.B #H_HDFE0,H_AUXCMD(A1) ALL, CLEAR HOLD OFF ON END. BSET #7,H_FLAGS(A2) SET HOLDOFF INDICATOR H_BYTTST EQU * ( SPRxxx TM 6/14/82 ) BTST #13-8,H_INT0COPY(A2) test for byte in ( SPRxxx TM 7/21/82 ) BEQ.S H_NOBYTE if no byte - norm. ( SPRxxx TM 6/14/82 ) JSR DROPDMA free the dma channel ( SPRxxx TM 6/14/82 ) * D4 has remaining = 0 ( SPRxxx TM 6/14/82 ) * D3 has intended ( SPRxxx TM 6/14/82 ) MOVE.W #$2000,D0 set bit #13 - byte in ADD.L  D3,TFIL_OFF(A3) update fill pointer ( SPRxxx TM 6/14/82 ) MOVEA.L TFIL_OFF(A3),A0 get pointer to next ( SPRxxx TM 6/14/82 ) * byte in the buffer ( SPRxxx TM 6/14/82 ) MOVEQ #1,D3 set count = 1 ( SPRxxx TM 6/14/82 ) BRA.S H_BUFI let intr tfr finish ( SPRxxx TM 6/14/82 ) * H_NOBYTE JSR DROPDMA FREE THE DMA CHANNEL *  D4 has remaining * D3 has intended MOVE.L D4,TCNT_OFF(A3) put remaining into TCNT SUB.L D4,D3 put # bytes tfr'd into D3 ADD.L D3,TFIL_OFF(A3) update th7 e fill pointer based on actual * bytes tfr'd JSR STCLR MARK THE TFR DONE AND LOG BRANCH BRA HISR_END DONE! SPC 2 * * INTERRUPT TRANSFER PROCESSING: * H_BUF TST.B TDIR_OFF(A3) WHICH DIRECTION TRANSFER? BNE.S H_BUFO SKIP IF OUTPUT SPC 2 * * BUFFERED INPUT: * H_BUFI BTST #13,D0 IS BYTE IN SET? BEQ HISR_END  IF NOT, DO NOTHING MOVEQ #0,D4 ELSE GET THE BYTE MOVE.B H_DATAIN(A1),D4 BTST #11,D0 IS EOI SET WITH THIS BYTE? BNE.S H_BUFI_0 BTST #0,H_STAT3(A2)  is eor set BEQ.S H_BUFI_1 IF NOT SKIP H_BUFI_0 TST.B TEND_OFF(A3) SHOULD WE IGNORE EOI? BEQ.S H_BUFI_1 IF SO, SKIP MOVE.W D4,D2 ELSE USE TRICK TO MAKE TFR QUIT. * - set term char to current char H_BUFI_1 MOVE.B D4,(A0)+ SAVE CHARACTER IN BUFFER MOVE.L A0,TFIL_OFF(A3) AND SAVE NEW FILL PTR SUBQ.L #1,D3 HAVE WE TRANSFERED ALL CHARS? MOVE.L D3,TCNT_OFF(A3) SAVE TRANSFER COUNT... BLE.S H_TI_TERM IF SO, SKIP CMP.W D4,D2 ELSE TERMINATE ON CHARACTER? BEQ.S H_TI_TERM IF SO, SKIP MOVE.B #H_RHDF,H_AUXCMD(A1) RELEASE HOLDOFF FOR NEXT BYTE BCLR #0,H_STAT3(A2) clear eor flag H_BUF_NT BRA HISR_END AND RETURN SPC 2 * * BUFFERED OUTPUT: * H_BUFO BTST #12,D0  IS BYTE OUT SET ? BEQ HISR_END IF NOT, DO NOTHING. SUBQ.L #1,D3 IS THIS THE LAST CHARACTER? BNE.S H_BUFO_1 IF NOT, SKIP TST.B TEND_OFF(A3) SHOULD WE SET EOI? BEQ.S H_BUFO_1 IF NOT, SKIP MOVE.B #H_FEOI,H_AUXCMD(A1) ELSE SET EOI WITH THE LAST BYTE H_BUFO_1 MOVE.B (A0)+,H_DATAOUT(A1) SEND THE BYTE MOVE.L A0,TEMP_OFF(A3) AND SAVE NEW EMPTY PTR  MOVE.L D3,TCNT_OFF(A3) SAVE TRANSFER COUNT... BGT.S H_BUF_NT NO...DON'T TERMINATE BRA.S H_TO_TERM YES...TERMINATE THE TFR SPC 2 * * INT AND FRW TRANSFER TERMINATION * H_TI_TERM BSET #7,H_FLAGS(A2) SET HOLDOFF INDICATOR H_TO_TERM EQU * * tm MOVE.B #0,D0 DISABLE OTHER INTERRUPTS * tm BSR H_EIR BSR H_DISABLE DISABLE BO/BI INTRPTS ( hphp TM 1/19/83 ) JSR STCLR MARK THE BUFFER FINISHED BRA HISR_END END OF ISR PAGE * * FAST R/W TRANSFER PROCESSING: * H_FRW ORI #$2700,SR DISABLE ALL OTHER INTS * the pascal system will re-enable&RTE TST.B TDIR_OFF(A3) WHICH DIRECTION TRANSFER? BNE.S H_FRWO SKIP IF OUTPUT SPC 4 * * FAST R/W INPUT: * H_FRI MOVEQ #0,D4 PRESET UPPER BYTE TO 0  LSR #8,D0 REPOSITION REMAINING INT STAT BITS BTST #5,D0 DO WE ALREADY HAVE BYTE IN? BNE.S H_FRWI_2A IF SO, SKIP H_FRWI_1 MOVE.B H_INT0STAT(A1),D0 GET INTERRUPT STATUS  BEQ H_FRWI_1 IF NOTHING, KEEP WAITING BTST #3,D0 IS EOI SET? BNE.S H_FRWI_2 IF SO, GO PROCESS BI AND END BTST #5,D0 IS BYTE IN SET? BNE.S H_FRWI_2A IF SO, GO PROCESS IT BSR.S H_FRW_OTHER ELSE PROCESS OTHER INTERRUPTS BRA H_FRWI_1 AND KEEP WAITING H_FRWI_2 OR.B H_INT0STAT(A1),D0 MAKE SURE WE GET THE BI BIT! H_FRWI_2A MOVE.B H7 _DATAIN(A1),D4 GET THE DATA BYTE MOVE.B D4,(A0)+ SAVE IT IN THE BUFFER AND #$5F,D0 CLEAR BI STAT AND CHECK FOR OTHERS BEQ.S H_FRWI_3 IF NO OTHER BITS SET, SKIP BSR.S H_FRW_OTHER ELSE PROCESS THE OTHERS BTST #3+8,D0 WAS EOI SET? BEQ.S H_FRWI_3 IF NOT, SKIP TST.B TEND_OFF(A3) SHOULD WE IGNORE EOI? BEQ.S H_FRWI_3  IF SO, SKIP MOVE.W D4,D2 ELSE USE TRICK TO MAKE TFR TERMINATE BSET #0,H_STAT3(A2) SET EOR INDICATOR H_FRWI_3 SUBQ.L #1,D3 DONE? BLE H_TBI_TRM IF SO, GO QUIT  CMP.W D4,D2 DOES CHAR MATCH TERMINATION CHAR? BEQ H_TBI_TRM IF SO, GO QUIT MOVE.B #H_RHDF,H_AUXCMD(A1) ELSE ASK FOR ANOTHER BYTE BRA H_FRWI_1 AND GO WAIT FOR IT  SPC 2 H_FRW_OTHER MOVEM.L D1-D3,-(SP) SAVE REGS FOR LATER TAS D0 SET BIT 8 TO FORCE LOOK AT INT0STAT BSR.S H_ISR0 PROCESS OTHER INTERRUPTS MOVEM.L (SP)+,D1-D3 RESTORE REGS FOR ANOTHER PASS RTS SPC 2 H_TBI_TRM MOVE.L TCNT_OFF(A3),D4 get intended count MOVE.L D3,TCNT_OFF(A3) D3 has bytes not finished SUB.L D3,D4 D4 has bytes transfered ADD.L D4,TFIL_OFF(A3) update fill pointer BRA H_TI_TERM and finish SPC 3 * * FAST R/W OUTPUT: * H_FRWO BTST #12,D0 DO WE ALREADY HAVE BYTE OUT? BNE.S H_FRWO_2 IF SO, GET STARTED H_FRWO_1 MOVE.B H_INT0STAT(A1),D0 ELSE GET THE INTERRUPT STATUS BEQ H_FRWO_1 IF NOTHING, KEEP WATCHING CMP.B #$90,D0 IS IT BO? BEQ.S H_FRWO_2 IF SO, LETS GO!  BSR H_FRW_OTHER ELSE GO PROCESS OTHER INTERRUPTS BTST #12,D0 IS BO LEFT? BEQ H_FRWO_1 IF NOT, KEEP WATCHING H_FRWO_2 CMP.L #1,D3 IS THIS THE LAST BYTE?  BNE.S H_FRWO_3 IF NOT, SKIP TST.B TEND_OFF(A3) SHOULD WE TAG WITH EOI? BEQ.S H_FRWO_3 IF NOT, SKIP MOVE.B #H_FEOI,H_AUXCMD(A1) ELSE TAG IT! H_FRWO_3 MOVE.B (A0)+,H_DATAOUT(A1) OUTPUT A BYTE FROM THE BUFFER SUBQ.L #1,D3 DONE? BGT H_FRWO_1 IF NOT, WATCH FOR BO AGAIN MOVE.L TCNT_OFF(A3),D3 \ ADD.L D3,TEMP_OFF(A3) / update empty pointer  CLR.L TCNT_OFF(A3) clear the count BRA H_TO_TERM ELSE WE ARE DONE! PAGE ******************************************************************************** * * ISR0 * ISR1 * * THE FOLLOWING ROUTINE DOES ALL THE GRUNT WORK FOR THE ISR. IT IS * SEPARATED OUT SO IT CAN BE CALLED FROM BACKGROUND. * * ENTRY: D0 CONTAINS BOTH 9914 STATUS BYTES. * * THE FOLLOWING CONDITIONS, IF THEY ARE THE CAUSE OF THE INTERRUPT, WILL *  BE PROCESSED: * * END: SET EOR LATCH. * SPAS: CLEAR rsv INDICATOR, CHANGE PPOLL RESPONSE. * RLC: IF ENABLED, LOG BRANCH. (ENHANCEMENT) * GET: SET LATCH. IF ENABLED, LOG EOL BRANCH. (ENHANCEMENT) * UCG: IF TCT, THEN REQUEST 9914 BECOME CONTROLLER. * IF ENABLED, LOG EOL BRANCH. * IF PPC, THEN TELL 9914 TO PASS THROUGH NEXT SECONDARY. * IF PPD OR SECONDARY, DO PP CONFIGURING. * DCAS: SET DCAS LATCH. * ELSE IF ENABLED, LOG EOL BRANCH. * MA: IF T/L IS ENABLED AND TADS/LADS IS TRUE, LOG EOL BRANCH. * SRQ: LOG EOL BRANCH, DISABL8 E SRQ INTERRUPT. * IFC: SET IFC LATCH. IF ENABLED, LOG EOL BRANCH. (ENHANCEMENT) * NOTE: BO AND BI ARE NOT PROCESSED! * * EXIT: D0 HAS LEFT OVER BITS OF INTERRUPT STATUS. THE 'END' BIT * WILL BE PROCESSED BY THIS ROUTINE BUT NOT CLEARED. ALL OTHER * BITS PROCESSED WILL BE CLEARED. * * USES: D0-D3 * * HPL ROUTINE * ******************************************************************************** H_ISR0 LSL #8,D0 ALTERNATE ENTRY TO BUILD FULL STAT OR.B H_INT1STAT(A1),D0 WORD IF ONLY BYTE 0 WAS READ. H_ISR1 OR H_INT0COPY(A2),D0 INCLUDE ANY SAVED BITS MOVE.W D0,D3 SAVE COPY OF INT STATUS  AND H_INTMSKSAV(A2),D3 KEEP ONLY THE ENABLED BITS IN D3 MOVE.W H_INTMSKSAV(A2),D1 TURN OFF THE ENABLED BITS IN D0 NOT D1 AND D1,D0 MOVE.W D0,H_INT0COPY(A2) SEND THESE BACK TO BACKGROUND  MOVE.B EIRB_OFF(A2),D2 GET CURRENT EIR BYTE * * PROCESS INTERRUPT CAUSES FROM INT1STAT: * BCLR #6+8,D3 ARE THERE ANY INT1 CAUSES? BEQ H_NO_INT1 IF NOT, SKIP SPC 1 BCLR  #0,D3 IFC INTERRUPT? BEQ.S H_NO_IFC IF NOT, SKIP BSET #3,H_FLAGS(A2) ELSE SET IFC LATCH BSR H_LOG GO LOG INTERRUPT IF ENABLED SPC 1 H_NO_IFC BCLR #1,D3 SRQ INTERRUPT? BEQ.S H_NO_SRQ IF NOT, SKIP BSR H_CHKSRQ ELSE GO PROCESS SRQ INTERRUPT SPC 1 H_NO_SRQ BCLR #2,D3 MA INTERRUPT? BEQ.S H_NO_MA  MOVE.B #H_DACR0,H_AUXCMD(A1) RELEASE DAC HOLDOFF BSR H_CHKADDR GO SEE IF WE SHOULD INTERRUPT SPC 1 H_NO_MA BCLR #3,D3 DCL/SDC INTERRUPT? BEQ.S H_NO_DCL MOVE.B #H_DACR0,H_AUXCMD(A1) RELEASE DAC HOLDOFF BSET #4,H_FLAGS(A2) SET DCL LATCH BTST #1,D2 OTHER INTERRUPTS ENABLED? BEQ.S H_NO_DCL IF NOT, SKIP BSR H_LOG ELSE JUST LOG EOL BRANCH SPC 1 H_NO_DCL BCLR #5,D3 UNIDENTIFIED COMMAND INTERRUPT? BEQ.S H_NO_UCG MOVE.B H_CMDPASS(A1),D0 GET THE COMMAND MOVE.B #H_DACR0,H_AUXCMD(A1) RELEASE DAC HOLDOFF  AND #$7F,D0 IGNORE PARITY ON COMMANDS CMP.B #TCT,D0 IS THIS TAKE CONTROL? BNE.S H_NO_TCT IF NOT, SKIP * * waiting in ISR * * trial for tct fix 11/29/81 4:47 PM * * tm  BTST #0,H_FLAGS(A2) IF THE 68000 IS TRYING TO PCT FROM * tm BNE.S H_TCTW1 ANOTHER SELECTCODE, THEN SKIP H_TCTW MOVE.W #8191,D5 tttt JS 8/1/83 * * Count changed from 4095 to 8191 to allow for 16 MHz processors * This is really much more than enough since card only can respond * at 8 MHz rate. tttt JS 8/1/83 * H_TCTWL BTST #5,H_ADRSSTAT(A1) ELSE WAIT FOR ATN TO DROP DBEQ D5,H_TCTWL H_TCTW1 MOVE.B #H_RQC,H_AUXCMD(A1) REQUEST CONTROL FROM 9914 MOVE.B #H_GTS,H_AUXCMD(A1) AND DROP ATN BTST #6,D2 ENABLED TO INTERRUPT? BEQ.S H_NO_TCT IF NOT, SKIP BSR H_LOG ELSE LOG THE BRANCH H_NO_TCT CMP.B #PPC,D0 PARALLEL POLL CONFIGURE? BNE.S H_NO_PPC IF NOT, SKIP MOVE.B #H_PTS,H_AUXCMD(A1) ELSE PASS THRU NEXT SECONDARY H_NO_PPC CMP.B #PPU,D0 PARALLEL POLL UNCONFIGURE?  BEQ.S H_PPE IF SO, TREAT SAME AS PPE CMP.B #$60,D0 GENERAL SECONDARY? BLT.S H_NO_PPE IF NOT, THEN NOT PPE/PPD H_PPE BSR HPL_WTC3 ELSE GO SET PPOLL CONFIGURATIO8 N H_NO_PPE EQU * PROCESS OTHER UCG VALUES HERE SPC 1 H_NO_UCG BCLR #7,D3 GET INTERRUPT? BEQ.S H_NO_GET IF NOT, SKIP MOVE.B #H_DACR0,H_AUXCMD(A1) ELSE RELEASE DAC HOLDOFF BSET #5,H_FLAGS(A2) AND SET GET LATCH BSR H_LOG GO LOG INTERRUPT IF ENABLED H_NO_GET EQU * PROCESS OTHER INT1 CAUSES HERE * * PROCESS INTERRUPT CAUSES FROM INT0STAT: * H_NO_INT1 BCLR #7+8,D3 ARE THERE ANY INT0 CAUSES? BEQ.S H_NO_INT0 IF NOT, SKIP SPC 1 BCLR #1+8,D3 RLC INTERRUPT? BEQ.S H_NO_RLC IF NOT SKIP BSR H_LOG GO LOG INTERRUPT IF ENABLED SPC 1 H_NO_RLC BCLR #2+8,D3 SPAS INTERRUPT? BEQ.S H_NO_SPAS IF NOT, SKIP BCLR #6,H_FLAGS(A2) ELSE INDICATE rsv IS NOW 0 MOVE.B H_PPOLLMSK+1(A2),H_PPOLL(A1) AND UPDATE PPOLL SPC 1 H_NO_SPAS BTST #3+8,D3 END INTERRUPT? BEQ.S H_NO_END IF NOT, SKIP BSET #0,H_STAT3(A2) ELSE SET EOR LATCH SPC 1 H_NO_END EQU * PROCESS OTHER INT0 CAUSES HERE H_NO_INT0 MOVE.W D3,D0 PUT REMAINING INT BITS BACK INTO D0 RTS FOR CALLER. TTL IOLIB EXTH - HPIB ISR SUPPORT ROUTINES PAGE ******************************************************************************** * * H_CHKADDR * * SUBROUTINE TO CHECK FOR ADDRESS INTERRUPT * * ENTRY: D2.B = EIR BYTE * * IF THE TLK (LST) BIT OF THE EIR BYTE IS TRUE AND THE 9914 * IS ADDRESSED AS TALKER (LISTENER), THEN LOG AN EOL BRANCH. * * HPL ROUTINE * ******************************************************************************** H_CHKADDR BTST #5,D2 INTERRUPT ON TALKER ENABLED (TLK)? BEQ.S H_CHKA1 IF NOT, SKIP BTST #1,H_ADRSSTAT(A1) ARE WE TALKER? BNE H_LOG IF SO, GO LOG INTERRUPT H_CHKA1 BTST #4,D2 INTERRUPT ON LISTEN ENABLED (LST)?  BEQ.S H_CHKA2 IF NOT, SKIP BTST #2,H_ADRSSTAT(A1) ARE WE LISTENER? BNE H_LOG IF SO, GO LOG INTERRUPT H_CHKA2 RTS ELSE RETURN ******************************************************************************** * * H_CHKSRQ * * SUBROUTINE TO CHECK FOR SRQ INTERRUPT * * ENTRY: EIRB_OFF(A2) HAS ENABLE MASK * * IF WE ARE CONTROLLER AND SRQ IS SET AND BIT 7 OF ENABLE BYTE * IS SET THEN LOG EITHER A NORMAL SRQ INTERRUPT. * * HPL ROUTINE * ******************************************************************************** H_CHKSRQ BTST #6,H_EXTSTAT(A1) ARE WE CONTROLLER? BNE.S H_CHKS2 IF NOT, DO NOTHING BTST #2,H_BUSSTAT(A1) IS SRQ SET? BEQ.S H_CHKS2 IF NOT, DO NOTHING BCLR #7,EIRB_OFF(A2) ARE WE ENABLED FOR SRQ? BEQ.S H_CHKS2 IF NOT, DO NOTHING H_CHKS1 BSR  H_LOG ELSE DO NORMAL LOGING H_CHKS2 RTS DONE CHECKING FOR SRQ SPC 4 * * H_LOG mark that an isr condition is * pending * H_LOG BSET #1,H_FLAGS(A2) set condition RTS TTL IOLIB EXTH - HPIB TRANSFER PAGE ******************************************************************************** * * H_TFR * * DRIVER CALL FOR EXECUTION OF tfr STATEMENT * * ENTRY: CONDITIONS OTHER THAN NORMAL A1,A2 ARE: * A3.L = POINTER TO TRANSFER INFORMATION * * HPL ROUTINE ( MODIFIED BEYOND ALL RECOGNITION ) * ******************************************************************************** H_TFR JSR CHECK_TFR 9  wait for tfr to finish ( timed ) MOVE.B #H_GTS,H_AUXCMD(A1) MAKE SURE ATN IS FALSE TST.B T_BW_OFF(A3) DON'T ALLOW WORD TRANSFERS BNE H_NOWORD MOVE.L TCNT_OFF(A3),D0 GET COUNT  CLR.W D1 \ MOVE.B TUSR_OFF(A3),D1 \ COMPUTE OFFSET INTO JUMP TABLE ADD.W D1,D1 \ JSR TESTDMA / BASED ON TFR TYPE AND DMA PRESENCE BEQ.S H_NODMA / ADDI.W #20,D1 / H_NODMA LEA H_TBL,A0 \ ADDA.W 0(A0,D1),A0 INDEXED JUMP THRU TABLE JMP (A0) / * * TRANSFER JUMP TABLE * *  -------------------- DMA is not installed or available H_TBL DC.W HTERR_B-H_TBL serial interrupt DC.W HTERR_D-H_TBL serial dma DC.W H_T_FHS-H_TBL serial fhs DC.W H_T_FHS-H_TBL serial fastest DC.W HTERR_B-H_TBL serial overlap * -------------------- DC.W H_T_INT-H_TBL overlap interrupt DC.W HTERR_D-H_TBL overlap dma DC.W H_T_BST-H_TBL overlap fhs  DC.W H_T_BST-H_TBL overlap fastest DC.W H_T_INT-H_TBL overlap overlap * -------------------- DMA is installed DC.W HTERR_B-H_TBL serial interrupt DC.W H_T_DMA-H_TBL serial dma  DC.W H_T_FHS-H_TBL serial fhs DC.W H_T_DMA-H_TBL serial fastest DC.W HTERR_B-H_TBL serial overlap * -------------------- DC.W H_T_INT-H_TBL overlap interrupt DC.W H_T_DMA-H_TBL overlap dma DC.W H_T_BST-H_TBL overlap fhs DC.W H_T_DMA-H_TBL overlap fastest DC.W H_T_DMA-H_TBL overlap overlap PAGE * * Transfer DMA * H_T_DMA CMP.L #1,D0 \ USE INTR IF COUNT=1 ON DMA BEQ H_T_INT / MOVE.B #TT_DMA,TACT_OFF(A3) set tfr type to DMA TST.B TDIR_OFF(A3) \ test for transfer direction BNE H_TOD / * * Transfer Input Dma: * H_TID EQU * * tm MOVEQ #0,D0 DISABLE CARD INTRPTS hphp TM 1/25/83 * tm BSR H_EIR hphp TM 1/25/83 MOVE.B #H_DAI1,H_AUXCMD(A1) disable hpib card ( SPR740 TM 5/24/82 ) BTST #6,H_EXTSTAT(A1) ARE WE ACTIVE CONTROLLER? BEQ.S H_TID_0 IF SO, SKIP * * non controller path * MOVE.B #TT_INT,TACT_OFF(A3) fake tfr type as intr ( SPR740 TM 5/24/82 ) MOVE.L TCNT_OFF(A3),D0 copy count so this works( qqqq TM 12/16/82 ) JSR STBSY set buf busy ( intr ) ( SPR740 TM 5/24/82 ) BSR H_RHDF_S OTHERWISE RELEASE HOLD OFF AND WAIT BSR H_WAIT_BI AROUND FOR THE FIRST BYTE TO APPEAR. BCLR #7,H_FLAGS(A2) INSURE WON'T RE RELEASE HOLDOFF * * at this point BYTE IN is true. IF EOI and EOI term hphp TM 1/26/83 * are true then the tfr should be faked out as finished. hphp TM 1/26/83 * BTST #0,H_STAT3(A2) \ is EOI set hphp TM 1/26/83 BEQ.S H_TID_0 / hphp TM 1/26/83 TST.B TEND_OFF(A3) \ is EOI term. enabled hphp TM 1/26/83 BEQ.S H_TID_0 / hphp TM 1/26/83 * * at this point - fake that the tfr is finished hphp TM 1/26/83 * H_TID_F JSR  ITXFR get appropriate ptrs. hphp TM 1/26/83 MOVE.B H_DATAIN(A1),D4 get data byte hphp TM 1/26/83 MOVE.B D4,(A0)+ SAVE CHARACTER IN BUFFER hphp TM 1/26/83 MOVE.L A0,9 TFIL_OFF(A3) AND SAVE NEW FILL PTR hphp TM 1/26/83 SUBQ.L #1,D3 we have TFR'D ALL CHARS hphp TM 1/26/83 MOVE.L D3,TCNT_OFF(A3) SAVE TRANSFER COUNT... hphp TM 1/26/83 BSET #7,H_FLAGS(A2) SET HOLDOFF INDICATOR hphp TM 1/26/83 JSR STCLR MARK THE BUFFER FINISHED hphp TM 1/26/83 BRA.S H_TID_E if done then finished hphp TM 1/26/83 * * common controller/non-controller path * H_TID_0 EQU * ( SPR740 TM 5/28/82 ) MOVE.B #TT_DMA,TACT_OFF(A3) restore type as DMA ( SPR740 TM 5/24/82 ) MOVE.L TCNT_OFF(A3),D0 RESTORE D0 SUBQ.L #1,D0 DMA CH SHOULD ONLY DO N-1 BYTES. JSR GETDMA TRY FOR DMA CHANNEL MOVE.W D2,(A4) ARM THE CHANNEL BSR HD_STBSY SET BUFFER BUSY, ETC ( SPR740 TM 5/24/82 ) TST.B TEND_OFF(A3) IF EOI TAG, THEN TELL ( SPR740 TM 5/28/82 ) BEQ.S H_TID_1 9914 TO HOLD OFF ON END ( SPR740 TM 5/28/82 ) MOVE.B #H_HDFE1,H_AUXCMD(A1) ( SPR740 TM 5/28/82 ) H_TID_1 MOVE.B #H_HDFA0,H_AUXCMD(A1) TURN OFF HOLD OFF ON ALL BSR.S H_RHDF_S DO RHDF IF NECESSARY MOVE.B D3,3(A1) ENABLE CARD FOR DMA * * common exit for input DMA tfr * H_TID_E EQU  * ( SPR740 TM 5/28/82) MOVE.B #H_DAI0,H_AUXCMD(A1) enable hpib card ( SPR740 TM 5/24/82 ) BRA.S H_DMA_W DONE * * Transfer Output Dma: * H_TOD TST.B TEND_OFF(A3) IF EOI TAG IS SET, THEN LET DMA BEQ.S H_TOD_1 DO ONLY N-1 BYTES AND DO THE LAST SUBQ.L #1,D0 UNDER INTERRUPT H_TOD_1 JSR GETDMA GET A DMA CHANNEL MOVE.W D2,(A4) ARM THE CHANNEL BSR HD_STBSY SET BUFFER BUSY, ETC * tm MOVEQ #0,D0 DISABLE USER INTERRUPTS hphp TM 1/25/83 * tm BSR H_EIR hphp TM 1/25/83 MOVE.B D3,3(A1) ENABLE CARD FOR DMA * * H_DMA_W IF SERIAL THEN WAIT FOR COMPLETION * H_DMA_W MOVE.B TUSR_OFF(A3),D4 \ CMP.B #5,D4 IS THE TRANSFER OVERLAP ? BGE.S H_DMA_W2 / H_DMA_W1 CMPI.B #255,T_SC_OFF(A3) IF NOT THEN WAIT TILL DONE BNE.S H_DMA_W1 H_DMA_W2 RTS PAGE * * Transfer INTERRUPT * H_T_INT MOVE.B #TT_INT,TACT_OFF(A3) set tfr type to INTERRUPT BRA.S H_T_BIC go to common code SPC 3 * * Transfer BURST ( intr on 1st byte FHS on rest ) * H_T_BST MOVE.B #TT_BURST,TACT_OFF(A3) set tfr type to BURST * BRA.S H_T_BIC go to common code SPC 3 * * common interrupt and burst code * H_T_BIC JSR STBSY SET BUFFER BUSY, ETC TST.B TDIR_OFF(A3) \ test for transfer direction BNE.S H_TOI / * * Transfer Input Interrupt or Transfer Input Burst * H_TII EQU * * tm MOVEQ #9,D0 ENABLE CARD FOR BYTE IN * tm BSR H_EIR MOVE.W #$2000,D0 ENABLE CARD FOR BI ( hphp TM 1/19/83 )  BSR H_ENABLE ( hphp TM 1/19/83 ) BSR.S H_RHDF_S should we release holdoff BRA H_DMA_W see if tfr was serial - and wait * if it was * * * H_RHDF_S BCLR #7,H_FLAGS(A2) SHOULD WE RELEASE HOLDOFF? BEQ.S H_RHDF_S1 IF NOT, SKIP BCLR #0,H_STAT3(A2) clear eor flag MOVE.B #H_RHDF,H_AUXCMD(A1) ELSE DO IT H_RHDF_S1 RTS * * :  Transfer Output Interrupt or Transfer Output Burst * H_TOI EQU * * tm MOVEQ #4,D0 ENABLE FOR BYTE OUT * tm BSR H_EIR MOVE.W #$1000,D0 ENABLE CARD FOR BO ( hphp TM 1/19/83 ) BSR H_ENABLE ( hphp TM 1/19/83 ) BRA H_DMA_W wait if serial PAGE ****************************************************************************** * Transfer FHS * ****************************************************************************** * * WARNING: these FHS routines have been carefully optimized towards... * 1. a close FHS coupling with Coyote (Greeley's new 913X Disc Controller) * 2. efficient Series 200 to Series 200 transfers * 3. efficient high-speed disc transfers * While the inner loops can be tuned for higher-speed transfers with * selected other devices, doing so will almost certainly compromise the * above optimizations! If you decide to optomize further, keep in mind * that: 1) the internal and external HPIB's behave differently with the * same FHS loop!!!, and 2) the 9914 & 9914A are programmed for different * T1 delays!!! Good Luck! *  J Cowan * * special register assignments for the fast handshake transfer routines: * fhs_eoi_bit equ d5 always set to 0 for the eoi bit test fhs_BI_stat equ d6 set to $20 for input (int0stat w/ BI only) fhs_BO_stat equ d6 set to $10 for output (int0stat w/ BO only) fhs_BI_bit equ d7 set to 5 for input (the BI bit number) fhs_BO_bit equ d7 set to 4 for output (the BO bit number) fhs_int0stat equ a4  permanent pointer to the int0stat register fhs_auxcmd equ a5 permanent pointer to the auxcmd register fhs_datain equ a6 permanent pointer to the datain register fhs_dataout equ fhs_datain permanent pointer to the dataout register H_T_FHS MOVE.B #TT_FHS,TACT_OFF(A3) set tfr type to FAST HANDSHAKE JSR STBSY make buffer busy JSR ITXFR set up pointers and registers movem.l fhs_int0stat-fhs_datain,-(sp) moveq #0,fhs_eoi_bit lea h_int0stat(a1),fhs_int0stat lea h_auxcmd(a1),fhs_auxcmd lea h_datain(a1),fhs_datain move.b #h_dai1,(fhs_auxcmd) disable all card interrupts! TST.B TDIR_OFF(A3) which transfer direction? BNE fto branch if output BSR H_RHDF_S input; release holdoff if necessary  moveq #$20,fhs_BI_stat int0stat with BI only moveq #5,fhs_BI_bit the BI bit number TST D2 termination character specified? BPL fti  branch if so page * * Transfer FHS in; NO termination character * move.b #h_hdfa0,(fhs_auxcmd) release holdoff on all subq.l #2,d3 count-2! bge.s fti_nt_i1  initial BI test (n-1 bytes loop) bra.s fti_nt_i2 initial BI test (last byte loop) * * high-speed loop for n-1 bytes * fti_nt_w1 move.b (fhs_int0stat),d1 get card status beq fti_nt_w1  loop until we get something cmp.b d1,fhs_BI_stat BI status only? bne.s fti_nt_s1 if not, process other conditions fti_nt_t1 move.b (fhs_datain),(a0)+ transfer this data byte and request the next dbra d3,fti_nt_w1 loop until lower count exhausted clr d3 clear lower count word only subq.l #1,d3 decrement the entire long c: ount bpl fti_nt_w1 loop until entire long count exhausted * * last byte handling * fti_nt_w2 move.b (fhs_int0stat),d1 get card status beq fti_nt_w2 loop until we get something cmp.b d1,fhs_BI_stat BI status only? beq.s fti_nt_t2 if so, transfer the byte bsr.s j_fakeisr otherwise, process the other conditions fti_nt_i2 bclr fhs_BI_bit,h_int0copy(a2) see if BI was logged beq fti_nt_w2 if not, keep waiting fti_nt_t2 move.b #h_hdfa1,(fhs_auxcmd) set holdoff on all again move.b (fhs_datain),(a0)+ transfer the last data byte addq.l #1,d3 correct remaining count bra h_tfi_trm go terminate * * special status handling: n-1 bytes loop * fti_nt_s1 bsr.s j_fakeisr process the other conditions fti_nt_i1 bclr fhs_BI_bit,h_int0copy(a2) BI logged? beq fti_nt_w1 if not, keep testing status btst fhs_eoi_bit,h_stat3(a2) BI logged; was EOI set? beq.s fti_nt_t1  if not, go transfer the byte tst.b tend_off(a3) BI w/ EOI; should we terminate? bne.s fti_nt_t2 if so, transfer the last byte bclr fhs_eoi_bit,h_stat3(a2) otherwise, clear the eoi flag bra fti_nt_t1 and continue transferring bytes page * * restoration of A5/6 required because fakeisr * can call a PASCAL user procedure * j_fakeisr movem.l (sp)+,fhs_int0stat-fhs_datain restore the dedicated registers bsr h_fakeisr movem.l fhs_int0stat-fhs_datain,-(sp) lea h_int0stat(a1),fhs_int0stat lea h_auxcmd(a1),fhs_auxcmd lea h_datain(a1),fhs_datain rts * * Transfer FHS in; looking for a termination character * fti moveq #0,d4 clear upper byte to enable word comparison bra.s fti_it make the initial BI test fti_fi bsr j_fakeisr process the other conditions fti_it bclr fhs_BI_bit,h_int0copy(a2) see if BI was logged bne.s fti_BI branch if so fti_wl move.b (fhs_int0stat),d1 get card status  beq fti_wl keep trying until we get something cmp.b d1,fhs_BI_stat BI status only? bne.s fti_fi if not, process other conditions fti_BI move.b (fhs_datain),d4  get the data byte move.b d4,(a0)+ save it in the buffer btst fhs_eoi_bit,h_stat3(a2) was EOI set? beq.s fti_tc branch if not tst.b tend_off(a3)  EOI was set; do we terminate? beq.s fti_ceoi branch if not move.w d4,d2 else use trick to make tfr terminate bra.s fti_tc fti_ceoi bclr fhs_eoi_bit,h_stat3(a2) clear the eoi flag fti_tc subq.l #1,d3 termination count expired? ble.s h_tfi_trm branch if so cmp.w d4,d2 termination character match? beq.s h_tfi_trm branch if so move.b #h_rhdf,(fhs_auxcmd) else ask for another byte bra fti_wl and go wait for it page * * Transfer FHS out * fto moveq #$10,fhs_BO_stat int0stat with BO only moveq #4,fhs_BO_bit the BO bit number subq.l #2,d3 count-2! bge.s fto_i1 initial BO test (n-1 bytes loop) ;  bra.s fto_i2 initial BO test (last byte loop) * * high-speed loop for n-1 bytes * fto_w1 move.b (fhs_int0stat),d1 get card status beq fto_w1 loop until we get something cmp.b d1,fhs_BO_stat BO status only? bne.s fto_s1 if not, process other conditions fto_t1 move.b (a0)+,(fhs_dataout) transfer a byte dbra d3,fto_w1  loop until lower count exhausted clr d3 clear lower count word only subq.l #1,d3 decrement the entire long count bpl fto_w1 loop until entire long count exhausted * * last byte handling * fto_w2 move.b (fhs_int0stat),d1 get card status beq fto_w2 loop until we get something cmp.b d1,fhs_BO_stat BO status only?  beq.s fto_t2 if so, transfer the byte bsr j_fakeisr otherwise, process the other conditions fto_i2 bclr fhs_BO_bit,h_int0copy(a2) see if BO was logged beq fto_w2  if not, keep waiting fto_t2 tst.b tend_off(a3) should we tag it with an EOI? beq.s fto_ob branch if not move.b #h_feoi,(fhs_auxcmd) else tag it! fto_ob move.b (a0)+,(fhs_dataout) output the last byte MOVE.L TCNT_OFF(A3),D3 \ ADD.L D3,TEMP_OFF(A3) / update empty pointer CLR.L TCNT_OFF(A3) clear count BRA.S H_TFO_TRM ELSE WE ARE DONE! * * special status handling: n-1 bytes loop * fto_s1 bsr j_fakeisr process the other conditions fto_i1 bclr fhs_BO_bit,h_int0copy(a2) see if BO was logged bne  fto_t1 if so, go transfer the byte bra fto_w1 otherwise, keep waiting PAGE * * FHS TRANSFER TERMINATION * H_TFI_TRM MOVE.L TCNT_OFF(A3),D4 get intended count MOVE.L D3,TCNT_OFF(A3) D3 has bytes not finished SUB.L D3,D4 D4 has bytes transfered ADD.L D4,TFIL_OFF(A3) update fill pointer BSET #7,H_FLAGS(A2) SET HOLDOFF INDICATOR H_TFO_TRM andi.b #$cf,h_int0copy(a2) move.b #h_dai0,(fhs_auxcmd) re-enable card interrupts! movem.l (sp)+,fhs_int0stat-fhs_datain restore the dedicated registers JMP STCLR  MARK BUFFER FINISHED & RETURN ******************************************************************************** * * HD_STBSY * * ROUTINE TO SET A DMA TFR BUFFER BUSY * * ENTRY: * D0.L = TRANSFER COUNT TO BE PUT IN TCNT_OFF(A2) * AND TO BE ADDED TO E/F COUNT. * A0.L = POINTER TO DMA TEMPS ( DMA1 OR DMA0 ) * A2.L = POINTER TO DRIVER TEMPS * A3.L = POINTER TO BUFFER CTL BLOCK * * HPL ROUTINE ( MODIFIED ) * ******************************************************************************** HD_STBSY LEA EXTH_EH_TDMA,A4 \ JMP DMA_STBSY / SAVE H_DMATERM ROUTINE IN DMA TEMPS PAGE END  nosyms mname gp src module gp; src src import src sysglobals, mini; src src export src type src gpiotype = { gpio interface card definition } src packed record case integer of src  0: {direct byte access} src ( r0,r1,r2,r3,r4,r5,r6,r7: byte ); src 1: {read access} src ( {r0} R0pad:0..127; ready:boolean; src {r1} R1pad:0..7; cardid:0..31; src {r2} ; R2pad: byte; src {r3} Renab,req:boolean; intlevel:0..3; burst,Rword,Rdmac1,Rdmac0: boolean; src {r4} Rdata: src {r5} shortint; src {r6} R6pad:byte; src {r7} R7pad:0..15; psts,eir,sti1,sti0:boolean ); src 2: {write access} src ( {r0} setpctl:byte; src {r1} reset:byte; src {r2} W2pad:0..63; rdyen,eiren:boolean; src {r3} Wenab:boolean; W3pad:0..15; Wword,Wdmac1,Wdmac0: boolean; src {r4} Wdata: src {r5} shortint; src {r6} W6pad:byte; src {r7} W7pad:0..63; ctl1,ctl0:boolean ) src end; { gpio interface card definition } src src gpio_r3_type = {separate declaration for use with structured constants} src packed record src {r3} Wenab:boolean; W3pad:0..15; Wword,Wdmac1,Wdmac0: boolean; src end; src  src dmachanneltype = packed array[0..7] of byte; src src var src dma_port[5242880]: array[0..1] of dmachanneltype; src src procedure gpioclear (var gpio: gpiotype); src procedure gpiowordout (var gpio: gpiotype; datum: shortint); src function gpiowordin (var gpio: gpiotype): shortint; src procedure gpiodmaout (var gpio: gpiotype; src command: shortint; src enable_byte: gpio_r3_type; src var dma_channel: dmachanneltype; src buffer: charptr; length: integer); src procedure gpiodmain (var gpio: gpiotype; src command: shortint; src enable_byte: gpio_r3_type; src var dma_channel: dmachanneltype; src buffer: charptr; length: integer); src end; {gpio} page * * dmaout/dmain stack frame definitions * olda6 equ +0 (long) old stack frame pointer radd equ +4 (long) return address len equ +8 (long) length of transfer in words buf equ +12 (long) address of buffer chan equ +16 (long) dma channel base address enab equ +20 (byte) gpio dma enable byte stackpad equ +21 (byte) unused - caused by pushing byte on stack cmnd equ +22 (word) disc command (read/write/verify) gpio equ +24 (long) gpio card base address * * Def's & Ref's * def gp_gp def gp_gpioclear def gp_gpiowordout def gp_gpiowordin def gp_gpiodmaout def  gp_gpiodmain refa sysglobals refa mini_ioresc refa check_timer jws 8/10/83 lmode mini_ioresc lmode check_timer jws 8/10/83 timer_present equ 1 jws 8/10/83 sysflag2  equ $fffffeda jws 8/10/83 * * module initialization routine * gp_gp rts * * ioresult assignments * ztimeout equ 4 zcatchall equ 21 * * error exits * ioresc_catchall moveq #zcatchall,d0  zcatchall ioresult ioresc move d0,-(sp) push the ioresult jsr mini_ioresc set ioresult then escape(-10) bus_error move #-12,sysglobals-2(a5) set the escapecode trap #10  escape page * * gpiowaitready with 2 second timeout * waitready move.l #206,d0 timeout counter * * Counter changed to be about 1 ms at 16 MHz -- was 206185 * by jws 8/10/83 * waitready_loop btst #3,7(a1) peripheral status? bne ioresc_catchall ioresc(zcatchall) if so btst #0,(a1) ready? bne.s waitready_rts branch if so subq.l #1,d0 decrement the timeout counter bgt waitready_loop < loop until timeout count expired * * Low data rate if we get here, so use timer if have it jws 8/10/83 * 8 MHz loop code is duplicated from above jws 8/10/83 * jws 8/10/83 btst #timer_present,sysflag2 jws 8/10/83 beq.s waitready_timer use timer jws 8/10/83 move.l #206185,d0 else set 2 sec loop jws 8/10/83 waitready_loop2 btst #3,7(a1) peripheral status? bne ioresc_catchall ioresc(zcatchall) if so btst #0,(a1) ready? bne.s waitready_rts branch if so subq.l #1,d0 decrement the timeout counter bgt waitready_loop2 loop until timeout count expired bra.s wait_timeout timeout on 2sec loop jws * waitready_timer equ * jws 8/10/83 move.b #1,-(sp) setup timer record jws 8/10/83 move.l #2000,-(sp) time to wait jws 8/10/83 waitready_tloop btst #3,7(a1) check psts jws 8/10/83 bne ioresc_catchall if not there,escape jws 8/10/83 btst #0,(a1) check card ready jws 8/10/83 bne.s waitready_texit if so then done jws 8/10/83  pea (sp) point to timer rec jws 8/10/83 jsr check_timer timed out? jws 8/10/83 bpl waitready_tloop no--try again jws 8/10/83 addq #6,sp yes, clean stack jws 5/2/84 moveq #10,d0  give one more try jws 5/2/84 bra waitready_loop2 with a short count jws 5/2/84 waitready_texit addq #6,sp cleanup stack jws 8/10/83 waitready_rts rts and continue jws 8/10/83 wait_timeout  moveq #ztimeout,d0 ztimeout ioresult bra ioresc escape ****************************************************************************** * gpioclear * ****************************************************************************** gp_gpioclear movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the gpio card base address move.b d0,1(a1) reset the card move.l #200,d0 prepare to... * * Count changed from 100 to 200 for 16 MHz processors jws 8/10/83 * dbra d0,* wait a while... clr.b 7(a1) clear ctl1 & clt0 bsr waitready  before testing psts & ready jmp (a0) return ******************************************************************************* * gpiowordout * ******************************************************************************* gp_gpiowordout movea.l (sp)+,a0 pop the return address movea.l 2(sp),a1 gpio card base address bsr waitready wait until ready move (sp),4(a1) output the datum move.b d0,(a1) set pctl addq.l #6,sp pop off the parameters jmp (a0) return ******************************************************************************* * gpiowordin * ******************************************************************************* gp_gpiowordin movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1  gpio card base address bsr waitready wait until ready move 4(a1),(sp) input the datum move.b d0,(a1) set pctl (same manner as 98032 autohandshake) jmp (a0) return page ******************************************************************************* * gpiodmaout * ******************************************************************************* gp_gpio< dmaout link a6,#0 create our own stack frame movea.l gpio(a6),a1 gpio card base address bsr waitready wait for previous handshake to complete trap #11 move into supervisor mode (scs) * scs move sr,-(sp) prepare to disable interrupts ori #$2700,sr disable interrupts ******************* move cmnd(a6),4(a1) disc command move.b d0,(a1) set pctl move.b enab(a6),3(a1) enable the gpio card for dma movea.l chan(a6),a2 dma channel base address move.l buf(a6),(a2) set the dma address move.l len(a6),d0 transfer length subq.l #1,d0  length-1 move d0,4(a2) set the dma count move #$0006,6(a2) arm the dma channel move (sp)+,sr re-enable interrupts ****************** lea 7(a1),a3 gpio register 7 address moveq #3,d0 psts bit (gpio register 7) lea 7(a2),a4 dma status lower byte address moveq #0,d1 armed bit (dma status register) do_loop btst d0,(a3) psts? bne  ioresc_catchall ioresc(zcatchall) if so btst d1,(a4) dma channel still armed? bne do_loop keep looping if so cmpi #-1,4(a2) dma transfer complete normally? bne bus_error  branch if not (bus error) bsr waitready wait for the final handshake to complete unlk a6 remove our stack frame movea.l (sp)+,a0 pop the return address adda #20,sp  pop off the parameters jmp (a0) return page ******************************************************************************* * gpiodmain * ******************************************************************************* gp_gpiodmain link a6,#0 create our own stack frame movea.l gpio(a6),a1 gpio card base address bsr waitready wait for previous handshake to complete trap #11 move into supervisor mode (scs) * scs move sr,-(sp) prepare to disable interrupts ori #$2700,sr disable interrupts ******************* move cmnd(a6),4(a1) disc command move.b d0,(a1) set pctl moveq #0,d0 ready bit (register 0) lea 7(a1),a2 register 7 address moveq #3,d1 psts bit (register 7) d_loop btst d1,(a2) peripheral status? bne.s d_enab fall out of the critical section if so btst d0,(a1) ready? beq d_loop branch if not clr 4(a1) clear the output buffer move.b d0,(a1) set pctl, requesting the first word in d_enab move.b enab(a6),3(a1) enable the gpio card for dma movea.l chan(a6),a2 dma channel base address move.l buf(a6),(a2)  set the dma address move #-1,4(a2) set count to -1 for the case of one transfer move.l len(a6),d0 transfer length subq.l #2,d0 length-2 blt.s di_reni branch if one transfer only  move d0,4(a2) set the dma count move #$0002,6(a2) arm the dma channel di_reni move (sp)+,sr re-enable interrupts ****************** lea 7(a1),a3 gpio register 7 address moveq #3,d0 psts bit (gpio register 7) lea 7(a2),a4 dma status lower byte address moveq #0,d1 armed bit (dma status register) di_loop btst d0,(a3) psts? bne ior= esc_catchall ioresc(zcatchall) if so btst d1,(a4) dma channel still armed? bne di_loop keep looping if so page cmpi #-1,4(a2) dma transfer complete normally? bne bus_error  branch if not (bus error) bsr waitready wait for last handshake to complete movea.l buf(a6),a0 buffer address move.l len(a6),d0 transfer length in words add.l d0,d0 transfer length in bytes move 4(a1),-2(a0,d0.l) transfer last word unlk a6 remove our stack frame movea.l (sp)+,a0 pop the return address adda #20,sp pop off the parameters jmp (a0) return end  nosyms ****************************************************************************** * driver assembly routines * ****************************************************************************** * * PASCAL interface text * mname drvasm src module drvasm; src src import src sysglobals; src src export src function test_and_toggle(var semaphore: boolean): boolean; src procedure eor(correction_byte: char; bufptr: charptr); src function shifted_left(value: integer; n: shortint): integer; src function shifted_right(value: integer; n: shortint): integer; src function mod_power_of_2(value: integer; n: shortint): integer; src src end; {drvasm} * * def's * def drvasm_drvasm def drvasm_test_and_toggle def drvasm_eor def drvasm_shifted_left def drvasm_shifted_right def drvasm_mod_power_of_2 * * module intialization routine * drvasm_drvasm rts * * test and toggle - semaphore manipulation function * drvasm_test_and_toggle equ * movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the var parameter address bchg #0,(a1) test and toggle the semaphore sne d0  remember the previous state neg.b d0 form a legal PASCAL boolean move.b d0,(sp) set the return variable jmp (a0) return page * * exclusive or - error correction procedure * drvasm_eor movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the bufptr move.b (sp)+,d0 pop the correction character eor.b d0,(a1) do it to it jmp (a0) return * * shift left n places * drvasm_shifted_left equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop the shift count move.l (sp)+,d0 pop the operand asl.l d1,d0 do it to it move.l d0,(sp) set the return value jmp (a0) return * * shift right n places * drvasm_shifted_right equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop the shift count move.l (sp)+,d0 pop the operand asr.l d1,d0 do it to it move.l d0,(sp)  set the return value jmp (a0) return * * take a mod power of 2 * drvasm_mod_power_of_2 equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop n moveq #-1,d0 start with all ones asl.l  d1,d0 shift in n zeros not.l d0 invert the sense and.l (sp)+,d0 pop and mask the operand move.l d0,(sp) set the return value jmp (a0) return end  (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-= Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal, debug off, range off, ovflcheck off, stackcheck off, iocheck off$ $search 'DRVASM' { , 'IOLIB:KERNEL' } $ program init_bkgnd; module bkgnd; import sysglobals, misc, iodeclarations; export type uep_type = {unit entry pointer} ^unitentry; bi_type = {background info} record iores : iorsltwd; {ioresult } set_in_use : boolean; {allocation flag } async : boolean; {overlapped transfer flag } feot : eotproc; {end of transfer procedure } fibptr : fibp; {file information block ptr } read_operation : boolean; {transfer direction flag } buffered_transfer : boolean; {amigo driver flag } xfr_chain_semaphore : boolean; {driver semaphore } bx_tries : shortint; {number of previous tries } bx_strt_rcrd : integer; {record address } bx_bufptr : charptr; {R/W address pointer } bx_length : integer; {total transfer byte count } bx_tfr_length : integer; {intermediate tfr byte count } bdx_chain_semaphore : boolean; {data transfer semaphore } bdx_pre_eoi : boolean; {premature eoi flag } bdx_nb : integer; {data transfer byte count } bdx_proc : io_proc; {data transfer completion proc } buf_info : buf_info_type; {as defined by the iolibrary } end; bip_type = ^bi_type; $page$ procedure initialize_bkgnd; procedure allocate_bkgnd_info (uep: uep_type); procedure deallocate_bkgnd_info(uep: uep_type); procedure abort_bkgnd_process (uep: uep_type); procedure ioresc_bkgnd (uep: uep_type; ior: iorsltwd); function unit_busy (uep: uep_type): boolean; procedure unit_wait (uep: uep_type); implement {bkgnd} const n = 3; {number of bkgnd info sets} type bia_type = array[0..n-1] of bi_type; var bia_ptr: ^bia_type; index: shortint; procedure initialize_bkgnd; var local_index: shortint; begin {initialize_bkgnd} if bia_ptr=nil then new(bia_ptr); for local_index := 0 to n-1 do bia_ptr^[local_index].set_in_use := false; index := 0; end; {initialize_bkgnd} function bip_valid(bip: bip_type): boolean; var local_index: shortint; begin {bip_valid} bip_valid := false; for local_index := 0 to n-1 do if bip=addr(bia_ptr^[local_index]) then bip_valid := true; end; {bip_valid} $page$ procedure allocate_bkgnd_info(uep: uep_type); var bip: bip_type; begin {allocate_bkgnd_info} lockup; repeat bip := addr(bia_ptr^[index]); index := index+1; if index>=n then index := 0; until not bip^.set_in_use; uep^.dvrtemp := integer(bip); with bip^ do begin iores := inoerror; set_in_use := true; async := false; end; {with} end; {allocate_bkgnd_info} procedure deallocate_bkgnd_info(uep: uep_type); var saved_ioresult: integer; begin {deallocate_bkgnd_info} if bip_valid(bip_type(uep^.dvrtemp)) then with bip_type(uep^.dvrtemp)^ do begin set_in_use := false; uep^.dvrtemp := ord(iores); lockdown; if async then {call the eot procedure} begin saved_ioresult := ioresult; ioresult := uep^.dvrtemp; call(feot, fibptr); ioresult := sa> ved_ioresult; end; {if} end; {with} end; {deallocate_bkgnd_info} procedure abort_bkgnd_process(uep: uep_type); begin {abort_bkgnd_process} if escapecode<>-10 then {prevent any eot procedure call while deallocating} bip_type(uep^.dvrtemp)^.async := false; deallocate_bkgnd_info(uep); if escapecode<>-10 then escape(escapecode); end; {abort_bkgnd_process} procedure ioresc_bkgnd(uep: uep_type; ior: iorsltwd); begin {ioresc_bkgnd} if bip_valid(bip_type(uep^.dvrtemp)) then bip_type(uep^.dvrtemp)^.iores := ior; escape(-10); end; {ioresc_bkgnd} $page$ function unit_busy(uep: uep_type): boolean; begin {unit_busy} if bip_valid(bip_type(uep^.dvrtemp)) then unit_busy := true else begin unit_busy := false; ioresult := uep^.dvrtemp; end; {else} end; {unit_busy} procedure unit_wait(uep: uep_type); begin {unit_wait} while unit_busy(uep) do {nothing}; end; {unit_wait} end; {bkgnd} $page$ $copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$ module discHPIB; import sysglobals, iodeclarations, drvasm, bkgnd; export function Simon_no_DMA (uep: uep_type): boolean; function Simon_DMA (uep: uep_type): boolean; procedure HPIBcheck_sc (uep: uep_type); procedure HPIBwait_for_ppol (uep: uep_type); procedure HPIBshort_msge_out (uep: uep_type; sec: byte; bp: charptr; nb: shortint); procedure HPIBamigo_clear (uep: uep_type); procedure HPIBshort_msge_in (uep: uep_type; sec: byte; bp: charptr; nb: shortint); function HPIBamigo_identify (uep: uep_type): shortint; procedure HPIBget_amigo_ident(uep: uep_type; var ident: shortint); procedure HPIBupon_ppol_resp (uep: uep_type; proc: io_proc); procedure HPIBupon_dxfr_comp (uep: uep_type; sec: byte; bp: charptr; nb: integer; proc: io_proc); implement {discHPIB} const standard_tc = 5000; {standard byte timeout value milliseconds} short_tc = 25; {short byte timeout value milliseconds} SDC = 4;  {selective device clear} LAG_base = 32; {listen address group base} TAG_base = 64; {talk address group base} SCG_base = 96; {secondary command group base} procedure delay_timer(microsec_value: integer); external; procedure confirm_timeout_and_reset_card(uep: uep_type); begin {confirm_timeout_and_reset_card} if (escapecode<>ioescapecode) or (ioe_isc<>uep^.sc) then escape(escapecode); if ioe_result<>ioe_timeout then ioresc_bkgnd(uep, znodevice); with isc_table[uep^.sc] do call(io_drv_ptr^.iod_init, io_tmp_ptr); ioresc_bkgnd(uep, ztimeout); end; {confirm_timeout_and_reset_card} $page$ function Simon_no_DMA(uep: uep_type): boolean; begin {Simon_no_DMA} with isc_table[uep^.sc] do Simon_no_DMA := (card_id=hp98625) and not dma_here; end; {Simon_no_DMA} function Simon_DMA(uep: uep_type): boolean; begin {Simon_DMA} with isc_table[uep^.sc] do Simon_DMA := (card_id=hp98625) and dma_here; end; {Simon_DMA} procedure HPIBcheck_sc(uep: uep_type); begin {HPIBcheck_sc} with isc_table[uep^.sc] do begin if card_type<>hpib_card then ioresc_bkgnd(uep, znodevice); with io_tmp_ptr^ do while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing}; end; {with} end; {HPIBcheck_sc} procedure HPIBwait_for_ppol(uep: uep_type); var pprb: packed array[0..7] of boolean; {parallel poll response byte} begin {HPIBwait_for_ppol} try with isc_table[uep^.sc], io_drv_ptr^ do  repeat call(iod_ppoll, io_tmp_ptr, charptr(addr(pprb))^); until pprb[uep^.ba]; recover confirm_timeout_and_reset_card(uep); end; {HPIBwait_for_ppol} $page$ procedure address_for_msge_out(var isc_te: isc_table_type; ba, sec: byte; tc: integer); var dummy_char: char; begin {address_for_msge_out} with isc_te, io_drv_ptr^ do begin call(iod_send, io_tmp_ptr, '?'); io_tmp_ptr^.timeout := tc; call(iod_send, io_tmp_ptr, chr(TAG_base+io_t> mp_ptr^.addressed)); call(iod_send, io_tmp_ptr, chr(LAG_base+ba)); if card_id<>hp98625 then {delay to avoid Chinook bug} delay_timer(85 {microseconds}); call(iod_send, io_tmp_ptr, chr(SCG_base+sec)); call(iod_ppoll, io_tmp_ptr, dummy_char); {enforce timeout} end; {with} end; {address_for_msge_out} procedure HPIBshort_msge_out(uep: uep_type; sec: byte; bp: charptr; nb: shortint); var isc_te_ptr: ^isc_table_type; begin {HPIBshort_msge_out} try  isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_out(isc_te_ptr^, uep^.ba, sec, standard_tc); with isc_te_ptr^, io_drv_ptr^ do begin while nb>1 do begin call(iod_wtb, io_tmp_ptr, bp^);  bp := addr(bp^, 1); nb := nb-1; end; {while} call(iod_set, io_tmp_ptr, ord(eoi_line)); call(iod_wtb, io_tmp_ptr, bp^); call(iod_send, io_tmp_ptr, '?'); end; {with} recover  confirm_timeout_and_reset_card(uep); end; {HPIBshort_msge_out} procedure HPIBamigo_clear(uep: uep_type); var isc_te_ptr: ^isc_table_type; begin {HPIBamigo_clear} try isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_out(isc_te_ptr^, uep^.ba, 16, standard_tc); with isc_te_ptr^, io_drv_ptr^ do begin call(iod_set, io_tmp_ptr, ord(eoi_line)); call(iod_wtb, io_tmp_ptr, chr(0)); {disable parity check} call(iod_send, io_tmp_ptr, chr(SDC)); call(iod_send, io_tmp_ptr, '?'); end; {with} recover confirm_timeout_and_reset_card(uep); end; {HPIBamigo_clear} $page$ procedure address_for_msge_in(var isc_te: isc_table_type; ba, sec: byte; tc: integer); var  dummy_char: char; begin {address_for_msge_in} with isc_te, io_drv_ptr^ do begin call(iod_send, io_tmp_ptr, '?'); io_tmp_ptr^.timeout := tc; call(iod_send, io_tmp_ptr, chr(LAG_base+io_tmp_ptr^.addressed)); call(iod_send, io_tmp_ptr, chr(TAG_base+ba)); if card_id<>hp98625 then {delay to avoid Chinook bug} delay_timer(85 {microseconds}); call(iod_send, io_tmp_ptr, chr(SCG_base+sec)); call(iod_ppoll, io_tmp_ptr, dummy_char); {enforce timeout} if card_id<>hp98625 then {delay to avoid Chinook bug} delay_timer(85 {microseconds}); end; {with} end; {address_for_msge_in} procedure premature_eoi(uep: uep_type); begin {premature_eoi} with isc_table[uep^.sc] do call(io_drv_ptr^.iod_send, io_tmp_ptr, '_'); ioresc_bkgnd(uep, zbadhardware); {all "expected" premature eoi's have to be trapped} end; {premature_eoi} procedure HPIBshort_msge_in(uep: uep_type; sec: byte; bp: charptr; nb: shortint);  var isc_te_ptr: ^isc_table_type; eoi_set: boolean; begin {HPIBshort_msge_in} try isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_in(isc_te_ptr^, uep^.ba, sec, standard_tc); with isc_te_ptr^, io_drv_ptr^ do begin while nb>1 do begin call(iod_rdb, io_tmp_ptr, bp^); call(iod_end, io_tmp_ptr, eoi_set); if eoi_set then premature_eoi(uep); bp := addr(bp^, 1); nb := nb-1;  end; {while} call(iod_rdb, io_tmp_ptr, bp^); call(iod_send, io_tmp_ptr, '_'); end; {with} recover confirm_timeout_and_reset_card(uep); end; {HPIBshort_msge_in} $page$ function HPIBamigo_identify(uep: uep_type): shortint; var isc_te_ptr: ^isc_table_type; ident: {the two identify bytes} record case integer of 0: (word: shortint); 1: (upper_char, lower_char: char); end; eoi_set: boolean; begin {HPIBamigo_identify} try isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_in(isc_te_ptr^, {"ba"} 31, {"sec"} uep^.ba, short_tc); with isc_te_ptr^, io_drv_ptr^ do begin call(iod_rdb, io_tmp_ptr, ident.upper_char); call? (iod_end, io_tmp_ptr, eoi_set); if eoi_set then premature_eoi(uep); call(iod_rdb, io_tmp_ptr, ident.lower_char); call(iod_send, io_tmp_ptr, chr(TAG_base+io_tmp_ptr^.addressed)); end; {with} recover confirm_timeout_and_reset_card(uep); HPIBamigo_identify := ident.word; end; {HPIBamigo_identify} procedure HPIBget_amigo_ident(uep: uep_type; var ident: shortint); begin {HPIBget_amigo_ident} ident := HPIBamigo_identify(uep); end; {HPIBget_amigo_ident} procedure HPIBupon_ppol_resp(uep: uep_type; proc: io_proc); { NOTE: when SIMON drivers become available, this routine needs to be modified to utilize the "interrupt on parallel poll response" capability of SIMON. However, until then, this will have to do. } var pprb: packed array[0..7] of boolean; {parallel poll response byte} begin {HPIBupon_ppol_resp} try with isc_table[uep^.sc], io_drv_ptr^ do repeat call(iod_ppoll, io_tmp_ptr, charptr(addr(pprb))^); until pprb[uep^.ba]; recover confirm_timeout_and_reset_card(uep); call(proc, uep); end; {HPIBupon_ppol_resp} $page$ procedure enter_bdx_chain(uep: uep_type); forward; procedure initiate_transfer(uep: uep_type); forward; procedure upon_transfer_complete(uep: anyptr); forward; procedure HPIBupon_dxfr_comp(uep: uep_type; sec: byte; bp: charptr; nb: integer; proc: io_proc); var isc_te_ptr: ^isc_table_type; t_dir: dir_of_tfr; begin {HPIBupon_dxfr_comp} try isc_te_ptr := addr(isc_table[uep^.sc]); with bip_type(uep^.dvrtemp)^ do begin if read_operation then begin address_for_msge_in (isc_te_ptr^, uep^.ba, sec, standard_tc); t_dir := to_memory; end {then} else begin address_for_msge_out(isc_te_ptr^, uep^.ba, sec, standard_tc); t_dir := from_memory; end; {else} bdx_nb := nb; bdx_proc := proc;  with isc_te_ptr^, buf_info do begin drv_tmp_ptr := io_tmp_ptr; active_isc := no_isc; { act_tfr is set by the driver } if dma_here then usr_tfr  := overlap_FASTEST {DMA, or BURST FHS if both channels are busy} else usr_tfr := serial_FHS; {unlike BURST FHS, won't lock out interrupts} b_w_mode := false; { end_mode is setup in initiate_transfer } direction := t_dir; term_char := -1; { term_count is setup in initiate_transfer } buf_ptr := anyptr(bp); buf_size := nb; buf_empty := anyptr(bp); buf_fill := anyptr(bp); eot_proc.real_proc := upon_transfer_complete; eot_parm := uep; dma_priority := card_id=hp98625; end; {with} bdx_chain_semaphore := false; enter_bdx_chain(uep); end; {with} recover confirm_timeout_and_reset_card(uep); end; {HPIBupon_dxfr_comp} $page$ procedure enter_bdx_chain(uep: uep_type); begin {enter_bdx_chain} with bip_type(uep^.dvrtemp)^ do if not test_and_toggle(bdx_chain_semaphore) then repeat initiate_transfer(uep); until test_and_toggle(bdx_chain_semaphore); end; {enter_bdx_chain} procedure initiate_transfer(uep: uep_type); var maximum_term_count: integer; begin {initiate_transfer} with bip_type(uep^.dvrtemp)^, isc_table[uep^.sc], buf_info do begin if (usr_tfr=serial_FHS) or (card_id=hp98625) then maximum_term_count := maxint {"no" limitation} else maximum_term_count := 65536; {DMA hardware/9914 driver limitation} if bdx_nb<=maximum_term_count then term_count := bdx_nb else term_count := maximum_term_count; bdx_? nb := bdx_nb-term_count; end_mode := (direction=to_memory) or (bdx_nb=0); call(io_drv_ptr^.iod_tfr, io_tmp_ptr, addr(buf_info)); end; {with} end; {initiate_transfer} procedure upon_transfer_complete(uep: anyptr); var unaddressing_char: char; begin {upon_transfer_complete} with bip_type(uep_type(uep)^.dvrtemp)^, isc_table[uep_type(uep)^.sc], io_drv_ptr^, buf_info do try if direction=to_memory then {check for premature transfer termination} if bdx_nb=0 then bdx_pre_eoi := term_count<>0 else call(iod_end, io_tmp_ptr, bdx_pre_eoi) else bdx_pre_eoi := false; if (bdx_nb>0) and not bdx_pre_eoi then {re-initiate the transfer} enter_bdx_chain(uep) else {unaddress the bus and call the specified end-of-transfer procedure} begin if direction=to_memory then unaddressing_char := '_' {untalk} else unaddressing_char := '?'; {unlisten}  call(iod_send, io_tmp_ptr, unaddressing_char); call(bdx_proc, uep); end; {else} recover confirm_timeout_and_reset_card(uep); end; {upon_transfer_complete} end; {discHPIB} $page$ import loader, bkgnd; begin {init_bkgnd} initialize_bkgnd; {allocate temp space} markuser; {make temp space and modules permanent} end. {init_bkgnd}  TTL IOLIB COMDCL - common equates and definitions PAGE ******************************************************************************** * * modified: 02/22/82 JPC added parm to user EOT & ISR proc's * 08/01/83 JS added timer_present and sysflag2 equ's * 03/25/85 JS added got_68020, cache_ctl equ's * * ******************************************************************************** * * HPL CONVENTIONS * * * Much of this code is taken intact from the 9826 HPL * language system EIO ROM ( extended I/O ROM ). * This was written by Bob Hallissy ( originally John Nairn ). * The Pascal that will be calling this code uses * the stack for parameter passage. The HPL code * uses the Ax and Dx registers for all parameters. * The Pascal driver entry points on the previous pages * take care of getting the parameters into the correct * registers. * * * GENERAL HPL ENTRY/EXIT CONDITIONS: * * A1.L = CARD ADDRESS * A2.L = DRIVER TEMP ADDRESS * UNLESS OTHERWISE INDICATED, THESE REGISTERS ARE UNALTERED. * * * NEW ENTRY/EXIT CONDITIONS FOR PASCAL USE : * * A3.L = BUFFER CONTROL BLOCK ADDRESS *  In addition to the A1/A2 convention, Pascal will use * A3 for a pointer to the buffer control block. * The HPL system kept much of the transfer * information in the s.c. temps. * * TIMEOUT(A2) = contains timeout information * Timeout was a global temp in HPL and a timeout * generated an error. * In PASCAL each card has a timeout value stored in * its temporary area. A timeout error *  generates an ESCAPE ( which can be trapped ). * * ******************************************************************************** PAGE ******************************************************************************** * * * DRIVER TEMPS TEMPLATE * * OFFSET FROM A2 * * HPL DECLARATIONS ( MODIFIED ) * * ******************************************************************************** ISR_ENTRY EQU 0 ..19 PASCAL ISR LINK & UNLINK area USER_ISR EQU 20  user ISR: do NOT change the proc/stat link/parm ordering!!! H_ISR_PR EQU 20 ..23 procedure ptr H_ISR_SL EQU 24 ..27 static link H_ISR_PM EQU 28 ..31 parameter C_ADR EQU 32 ..35 card addre@ ss BUFI_OFF EQU 36 ..39 buffer pointer offset BUFO_OFF EQU 40 ..43 buffer pointer offset EIRB_OFF EQU 44 eir byte IO_SC EQU 45 select code ( i.e. 7, 22, etc. ) TIMEOUT EQU 46 ..49 timeout value * =0 : no timeout * #0 : value of timeout MA_W EQU 50 ..51 word access to my address MA EQU 51 byte access to my address AVAIL_OFF EQU 52 ..?? standard space taken from temps * 52 ..83 normal cards ( 32 bytes ) * 52 ..179 98628 card ( 128 bytes ) PAGE ******************************************************************************** * *  TRANSFER OFFSETS IN BUFFER CONTROL BLOCK * * OFFSET FROM A3 * * PASCAL DECLARATION * ******************************************************************************** TTMP_OFF EQU 0 ..3 pointer to driver temp offset T_SC_OFF EQU 5 transfer select code TACT_OFF EQU 7 actual transfer mode TUSR_OFF EQU 9 transfer mode * 00 - not used * 01 serial DMA * 02 serial FHS * 03 serial FASTEST ( DMA or FHS ) * 04 - not used * ---------------- *  05 overlp INTR * 06 overlp DMA * 07 overlp FHS ( BURST ) * 08 overlp FASTEST ( DMA or BURST ) *  09 overlp OVERLAP ( DMA or INTR ) T_BW_OFF EQU 10 transfer byte/word indicator * 0 = byte / 1 = word TEND_OFF EQU 11 transfer EOI/END indicator *  0 = no eoi / 1 = eoi sent or searched for TDIR_OFF EQU 13 transfer direction * 0 = input / 1 = output TCHR_OFF EQU 14 ..15 transfer terminate character *  -1 = no termination character TCNT_OFF EQU 16 ..19 transfer count TBUF_OFF EQU 20 ..23 transfer buffer pointer TBSZ_OFF EQU 24 ..27 transfer buffer maximum size TEMP_OFF EQU 28 ..31 transfer empty pointer pointer TFIL_OFF EQU 32 ..35 transfer fill pointer T_PR_OFF EQU 36 ..39 transfer pointer to eot procedure * NIL no procedure T_SL_OFF EQU 40 ..43 transfer eot proc static link T_PM_OFF EQU 44 ..47 transfer eot proc parameter T_DMAPRI EQU 48 dma priority request * * TRANSFER EQUATES * TT_INT EQU 1 interrupt TT_DMA EQU 2 DMA TT_BURST EQU 3 burst TT_FHS  EQU 4 fast handshake TTL IOLIB IOCOMASM - escape support PAGE ******************************************************************************** * * EXTERNAL REFERANCES for escape * ******************************************************************************** REFA iodeclarations reference the io lib var. area REFA sysglobals SPC 2 ******************************************************************************** * * Escape code values * ******************************************************************************** NO_CARD EQU 1 no interface NOT_HPIB EQU 2 not an hpib interface NO_ACTL EQU 3 no active controller NO_DVC EQU 4 sc ( not device ) specified NO_SPACE EQU 5 not enough space in the buffer NO_DATA EQU 6 not enough data left in the buffer TFR_ERR EQU 7 tfr error SC_BU@ SY EQU 8 sc is currently busy BUF_BUSY EQU 9 the buffer is busy TCNTERR EQU 10 bad count BADTMO EQU 11 bad timeout value NO_DRV EQU 12  no driver NO_DMA EQU 13 no dma installed NO_WORD EQU 14 no word transfers allowed NOT_TALK EQU 15 not addressed as talker NOT_LSTN EQU 16 not addressed as listener TMO_ERR EQU 17 timeout NO_SCTL EQU 18 not system controller BAD_RDS EQU 19 bad read status / write control BAD_SCT EQU 20 bad set/clear/test CRD_DWN EQU 21 interface is dead EOD_SEEN EQU 22 end of data has happened IO_MISC EQU 23 misc. error SPC 3 IOE_ERROR EQU -26 io sub system error escape code SPC 3 IOE_RSLT EQU IODECLARATIONS-66 IOE_SC EQU IODECLARATIONS-70 SPC 3 ESC_CODE EQU SYSGLOBALS-2 RCVR_BLK EQU SYSGLOBALS-10 TIMER_PRESENT EQU 1 JS 8/1/83 SYSFLAG2 BIT -- 0=>TIMER PRESENT GOT_68020 EQU 4  JS 3/25/85 SYSFLAG2 BIT -- 1=>68020 PRESENT SYSFLAG2 EQU $FFFFFEDA JS 8/1/83 CACHE_CTL EQU $5F400E JS 3/25/85  This floppy contains the source for various Pascal Workstation drivers (DISCHPIB, HPIB, DMA, DISC_INTF, GPIO, PARALLEL). The modcal version of the PaWS Pascal compiler is required to build the various drivers. A copy of this compiler can be found on the SCSI: source floppy disk. A stream file (MAKE_ALL.TEXT) which shows how to build and link the drivers is also included.  This floppy contains the source for various Pascal Workstation drivers (DISCHPIB, HPIB, DMA, DISC_INTF, GPIO, PARALLEL). The modcal version of the PaWS Pascal compiler is required to build the various drivers. A copy of this compiler can be found on the SCSI: source floppy disk. A stream file (MAKE_HPIB.TEXT) which shows how to build and link the drivers is also included. **************************************************************** Copyright Hewlett-Packard Company, 1994. All rights are reserved.  Copying or other reproduction of this product except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado  } if use_timer then begin time_rec.time := timeout; start_timer(time_rec); end; repeat  if (use_timer) and (time_expired(time_rec)) then dvr_error(ioe_timeout); until (binand(ord(comm_per.bl), XMITTED_MASK) = LAST_BYTE_XMITTED); end  else { make sure device is still communicating. } peripheral_check; state.bl := INACTIVE_WRITE; end; end; {********************************************************* * procedure name: * wait_nack; * * input dependencies: * my ptrs are set up. * a nack transition interrupt has been enabled. * a inbound transfer has A just occured, and * want to see if an nack will occur with this * byte. * * functional description: * wait for either something in FIFO (obviously * no nack on this byte) or an nack interrupt, or * an error. * * output environement: * if nack occured then last_read_nack (misc_ptr) * set to true. * *********************************************************} procedure wait_nack; var i:integer; begin with my_hw_ptr^ do begin if comm_per.c_fifoempty then begin repeat until (not comm_per.c_fifoempty) or (int_state.bl <> #0); if (int_state.nack_low_trans) then begin my_misc_ptr^.last_read_nack := true; set_int; {clear latches, reset interrupt} end; end; end; end; {********************************************************* * procedure name: * fhs_in(buf:ptr_char_type; var count:integer, * exit_on_nack:boolean); * * input dependencies: * my ptrs are set up. * peripheral_type may or may not be known. * bus may or may not be in input phase. * peripheral may or may not be ready to talk. * * functional description: * make sure peripheral can talk input and set *  bus to input phase. * programmatically transfer data from peripheral. * if exit_on_nack, then look for an nack occurence. * * output environement: * peripheral_type is known and bus is in input state. *  OR ELSE dvr_error. * *********************************************************} procedure fhs_in(buf:ptr_char_type; var count:integer; exit_on_nack:boolean); label 1; var use_timer:boolean; begin with my_hw_ptr^, my_misc_ptr^, my_tmp_ptr^ do begin { make sure device is not in an error state. make sure device can talk input, and set bus to input state. } peripheral_check;  set_bus_in(USE_LARGE_FIFO); state.bl := ACTIVE_READ; { set up some local variables to save a little bit of time. } use_timer := timeout <> 0; last_read_nack := false; { do programmatic transfer } while count > 0 do begin if (comm_per.c_fifoempty) then begin  peripheral_check; if use_timer then begin time_rec.time := timeout; start_timer(time_rec); end; repeat until (not comm_per.c_fifoempty) or (int_state.bl <> #0) or (use_timer and time_expired(time_rec)); if comm_per.c_fifoempty then begin if (exit_on_nack) and (int_state.nack_low_trans) then  begin last_read_nack := true; goto 1; end else  dvr_error(ioe_timeout); end; end; buf^ := fifo.fifoin; buf := addr(buf^, 1); count := count - 1; A  end; { if we are supposed to exit_on_nack, then there is a very good possibility that the nack will occur with the last byte read. Therefore, wait for one to possibly show up.  } if exit_on_nack then wait_nack; 1: state.bl := INACTIVE_READ; end; end; {********************************************************* * procedure name: *  do_fhs_tfr(ptr_buf:ptr_buf_info_type); * * input dependencies: * User has requested a programmatic transfer. * my ptrs are set up. * device may or may not be there (or ready). * device type may or may not even be known! * * functional description: * execute the desired transfer request. This * routine is responsible for updating the buffer * parameters (Standard I/O buffer). * If this is an output transfer, use fhs_out. * If this is an input trnasfer, use fhs_in. * * output environement: * If successful, transfer has completed as requested * and the buffer parameters have been updated. The * device type is known and the bus is in an output * state. * If not successful, then an escape has occured, bus * state is not known and the device type is not known. * *********************************************************} procedure do_fhs_tfr(ptr_buf:ptr_buf_info_type); var my_count: integer; lastchar: char; begin with ptr_buf^, my_misc_ptr^ do begin act_tfr := FHS_tfr;  my_count := term_count; if direction = FROM_MEMORY then begin fhs_out(buf_empty, term_count); buf_empty := addr(ptr_char_type(buf_empty)^, my_count - term_count);  end else {direction is TO_MEMORY} begin if term_char = -1 then {not a transfer_until} begin fhs_in(buf_fill, term_count, end_mode);  buf_fill := addr(ptr_char_type(buf_fill)^, my_count - term_count); end else {transfer_until} begin  repeat my_count := 1; fhs_in(buf_fill, my_count, end_mode); lastchar := ptr_char_type(buf_fill)^;  buf_fill := addr(ptr_char_type(buf_fill)^, 1); term_count := term_count - 1; until (term_count = 0) or (lastchar = chr(term_char)) or ((last_read_nack) and (end_mode)); end; end; {serial_FHS transfer has completed normally, clean up.} stclr; end; end; {********************************************************* * procedure name: * FUNCTION dma_available:boolean; * * input dependencies: * none * * functional description: * determine if DMA hardware is available, if the * DMA driver is in memory, and if a DMA channel is * available for use (note that a DMA channel is not * acquired). * * output environement: * TRUE if dma h/w, s/w and channel is available, *  FALSE otherwise. * *********************************************************} function dma_available:boolean; begin dma_available := ( (dma_here) and ((dma_isc_0 = no_isc) or (dmaB _isc_1 = no_isc)) ); end; {********************************************************* * procedure name: * FUNCTION get_buf_ptr:ptr_buf_info_type * * input dependencies: * my ptrs are set up. * * functional description: * retrieve either the input or output buffer * pointer. Since only one can be active at a * time, only need to make one check. If niether * is active, then NIL will be returned. * * output environement: * returns either the current active buffer pointer * or NIL. * *********************************************************} function get_buf_ptr:ptr_buf_info_type; begin with my_tmp_ptr^ do  if in_bufptr <> NIL then get_buf_ptr := in_bufptr else get_buf_ptr := out_bufptr; end; {********************************************************* * procedure name: *  dma_int_handler(temp:ANYPTR) - temp is the * driver temp space. * * input dependencies: * received either a DMA complete interrupt or * an nack occured interrupt. * * functional description: *  turn off DMA, update buffer pointers with * transfer amount. Terminate transfer buffer, and * clean up hardware. * * output environement: * DMA and transfer hardware cleaned up and ready *  for next transfer. Transfer buffer updated and * terminated. * *********************************************************} procedure dma_int_handler(temp:ANYPTR); var ptr_buf:ptr_buf_info_type; diroutput:boolean; residual_count, amt_xfered:integer; begin set_my_ptrs(temp); with get_buf_ptr^, my_misc_ptr^, my_hw_ptr^ do begin intdma.dma_e0 := false; intdma.dma_e1 := false; residual_count := dropdma; amt_xfered := term_count - residual_count; if direction = FROM_MEMORY then begin buf_empty := addr(ptr_char_type(buf_empty)^, amt_xfered); {  wait for fifoempty } repeat until (comm_per.c_fifoempty) or (not comm_per.p_select_high); end else begin buf_fill := addr(ptr_char_type(buf_fill)^, amt_xfered); { if this is a transfer_end then wait for fifo not empty or an interrupt. } if end_mode then  wait_nack; end; term_count := residual_count; d_isr_ie.bl := 0; d_int_e := false; set_int; stclr; end; end; {********************************************************* * procedure name: * dma_start(bcb:ANYPTR) - bcb: Buffer Control block Pointer * * input dependencies: * my ptrs are set up. * User has made a valid request for either an * inbound or outbound DMA transfer * bus state may or may not be known. * device type may or may not be known. * * functional description: * set up hardware and software for a DMA transfer * kick off the DMA transfer * * output environement: * If successful, then DMA transfer started, bus state * and device type known. * If not successful, then an escape has occured, bus *  state is not known and device type is not known. * *********************************************************} procedure dma_start(bcb:ANYPTR); var dma_channel:integer; loc_intdma:intdma_type; begin with my_misc_ptr^, ptr_buf_infB o_type(bcb)^, my_hw_ptr^ do begin { insure dma enable bits are off (a little bit of paranoia is good for the soul). } intdma.dma_e0 := false; intdma.dma_e1 := false; { make sure device can talk } peripheral_check; { set up the bus for the direction of the transfer, and set up request for driver interupts. } if direction = FROM_MEMORY then begin set_bus_out; state.bl := ACTIVE_WRITE; d_isr_ie.bl := hex('07');  end else begin set_bus_in(USE_LARGE_FIFO); state.bl := ACTIVE_READ; last_read_nack := false; if end_mode then  d_isr_ie.bl := hex('0f') else d_isr_ie.bl := hex('07'); end; if options.ignore_pe then d_isr_ie.pe_trans := false;  { get dma channel, set it up and arm it. } dma_channel := getdma; {this gets a dma channel, sets it up, and arms it} { haven't escaped yet so everthing is ready to communicate. turn on requested interrupts. Note that set_int should follow getdma. Don't want to escape with interrupts set! } d_int_e := true; set_int; { set up for DMA interrupt (based on channel received) and kick off the DMA transfer. h/w required fix. when doing inbound DMA, turn off i/o bit, then turn on I/O and DMA enable at the same time. for ease of implementation, use same algorithm for both inbound and outbound DMA. } loc_intdma.bl := intdma.bl; intdma.io := false; if dma_channel = 0 then begin dma_ch_0.real_proc := dma_int_handler; loc_intdma.dma_e0 := true; end else begin dma_ch_1.real_proc := dma_int_handler; loc_intdma.dma_e1 := true; end; intdma.bl := loc_intdma.bl; {this kicks off the DMA} end; end; {********************************************************* * procedure name: * ovl_int_out_start * * input dependencies: * my ptrs set up. * bus state may or may not be known, * device type may or may not be known. * * functional description: * start an ouput overlap interrupt transfer * sequence. * * output environement: * if successful, bus is in output state, * device type is known and overlap interrupt * transfer in output direction is started. * if not successful, this routine has escaped. * *********************************************************} procedure ovl_int_out_start; begin with my_misc_ptr^ do begin peripheral_check;  set_bus_out; state.bl := ACTIVE_WRITE; d_isr_ie.fifo_empty := true; d_int_e := true; set_int; end; end; {********************************************************* * procedure name: * ovl_int_in_start * * input dependencies: * my ptrs set up. * bus state may or may not be known, * device type may or may not be known. * * functional description: * start an inputC  overlap interrupt transfer * sequence. * note a fifo of size 1 is used for this type * of transfer. This allows an interrupt * with each byte transfered. * * output environement: *  if successful, bus is in input state, * device type is known and overlap interrupt * transfer in input direction is started. * if not successful, this routine has escaped. * *********************************************************} procedure ovl_int_in_start; begin with my_misc_ptr^ do begin peripheral_check; state.bl := INACTIVE_ERROR; set_bus_in(USE_SMALL_FIFO); state.bl := ACTIVE_READ; d_isr_ie.fifo_full := true; d_int_e := true; set_int; end; end; {********************************************************* * procedure name: * do_ovl_int_fifo_empty * * input dependencies: * my ptrs set up * a fifo empty interrupt has occured * an output overlap interrupt transfer is * currently in progress. * * functional description: * update buffer pointers, get another byte into * fifo, and set up for another interrupt. * if transfer has completed, terminate buffer. * since can't escape from an interrupt, handle * all errors here - if error occurs, terminate * transfer. * * output environement: * either transfer is continuing or has terminated. * if transfer terminated, then h/w and s/w are cleaned * up. * *********************************************************} procedure do_ovl_int_fifo_empty; var my_count:integer; begin with get_buf_ptr^, my_misc_ptr^ do begin try my_count := 1; fhs_out(buf_empty, my_count); buf_empty := addr(ptr_char_type(buf_empty)^, 1); term_count := term_count - 1; if (term_count = 0) then {transfer completed} begin  stclr; d_isr_ie.fifo_empty := false; d_int_e := false; set_int; end else  begin d_isr_ie.fifo_empty := true; d_int_e := true; set_int; end; recover if (escapecode = ioescapecode) then begin stclr; d_isr_ie.fifo_empty := false; d_int_e := false; set_int; end; end; end; {********************************************************* * procedure name: * do_ovl_int_fifo_full * * input dependencies: * my ptrs set up * a fifo full interrupt has occured * an input overlap interrupt transfer is  * currently in progress. * * functional description: * update buffer pointers, get another byte from * fifo, and set up for another interrupt. * if transfer has completed, terminate buffer. *  since can't escape from an interrupt, handle * all errors here - if error occurs, terminate * transfer. * * output environement: * either transfer is continuing or has terminated. * if transfer terminated, then h/w and s/w are cleaned * up. * *********************************************************} procedure do_ovl_int_fifo_full; var my_count:integer; last_char:char; begin with get_buf_ptr^, myC _misc_ptr^ do begin try peripheral_check; my_count := 1; fhs_in(buf_fill, my_count, end_mode); last_char := ptr_char_type(buf_fill)^;  buf_fill := addr(ptr_char_type(buf_fill)^, 1); term_count := term_count - 1; if (term_count = 0) or (end_mode and last_read_nack) or  ((term_char <> -1) and (last_char = chr(term_char))) then begin stclr; state.bl := INACTIVE_ERROR; d_isr_ie.fifo_full := false;  d_int_e := false; set_int; end else begin d_isr_ie.fifo_full := true;  d_int_e := true; set_int; end; recover if (escapecode = ioescapecode) then begin stclr; d_isr_ie.fifo_full := false; d_int_e := false; set_int; end; end; end; end {pllel_util}; $page$ module pllel_drive; {------------------------------------------------------------------------------} {------------------ parallel driver hook flow control ------------------} {------------------------------------------------------------------------------} { This module acts as a demuxer for the PWS I/O system. I/O system calls  enter into this module and are translatted into PARALLEL I/O requests. The later requests are invoked by calls to routines within the PLLEL_UTIL module. The functionality of each of the I/O requests are defined in either the  Procedure Library GENERAL I/O discussions, the Procedure Library PARALLEL Inteface discussions, or in the Systems Designers Guide. Unless necessary, the functionality is NOT repeated here in the guise of routine headers. } import sysglobals, asm, iodeclarations, iocomasm, parallel_3, pllel_util, pllel_asm; export procedure pinit_hook(temp:ANYPTR); procedure pisr_hook(temp:PISRIB); procedure prdb_hook(temp:ANYPTR; VAR x:CHAR); procedure pwtb_hook(temp:ANYPTR; x:CHAR); procedure prdw_hook(temp:ANYPTR; VAR x:io_word); procedure pwtw_hook(temp:ANYPTR; x:io_word); procedure prds_hook(temp:ANYPTR; reg:io_word; VAR x : io_word);  procedure pwtc_hook(temp:ANYPTR; reg:io_word; x : io_word ); procedure pend_hook(temp:ANYPTR; VAR b:boolean); procedure ptfr_hook(temp:ANYPTR; bcb:ANYPTR ); implement procedure pinit_hook(temp:ANYPTR); var  timevalue:integer; begin try {this routine should NEVER escape!} { this routine should also not go into a forever loop for whatever reason. save timeout value, and set timeout to 1ms.  } with pio_tmp_ptr(temp)^ do begin timevalue := timeout; timeout := 1; end; set_my_ptrs(temp); with my_hw_ptr^, my_tmp_ptr^, my_misc_ptr^ do begin { clear up any existing transfers } if state.active_xfer then abort_io;  { restore reset defaults } peripheral_type := peripheral_reset; if peripheral_type = USER_SPEC_NO_DEVICE then D state.bl := DISABLED_BY_USER else state.bl := INACTIVE_ERROR; options.w := options_reset.w; if options.wr_nrd_low then set_wr_nrd_low; { reset h/w } intdma.int_e := false; hostline.bl := #0; {turn off all hostlines}  sysreg.softreset := #0; delay(delay_ms); if not options.wr_nrd_low then hostline.wr_nrd_high := true; d_int_e := false; intdma.io := false; {output forces chip to own data & nstrobe lines} d_isr_ie.w := 0; u_isr_ie.w := 0; set_int; hostline.nselectin_low := true;  { reset driver variables } u_isr_status.w := 0; last_read_nack := false; user_isr.dummy_pr := nil; user_isr.dummy_sl := nil; in_bufptr := nil; out_bufptr := nil; my_int_level := intdma.int_lvl + 3; end; recover ; { restore timeout value } try pio_tmp_ptr(temp)^.timeout := timevalue; recover ; end; procedure pisr_hook(temp:PISRIB); type pxlate_type = record case integer of  1:(pproc:parallel_user_isr_type); 2:(ioproc:io_proc); end; var save_ioe_result:integer; save_ioe_isc:integer; save_int_state:int_state_type; d_isr_ir:driver_int_state_type; ptr_buf:ptr_buf_info_type; p:pxlate_type; do_u_isr_ovl:boolean; procedure kill_act_tfr; begin with my_misc_ptr^ do begin d_isr_ie.bl := 0;  d_int_e := false; abort_io; end; end; begin do_u_isr_ovl := false; set_my_ptrs(anyptr(temp)); with my_tmp_ptr^, my_misc_ptr^, my_hw_ptr^ do begin {  save current h/w interrupts - support routines will reset the driver interrupt conditions and call set_int. set_int resets the h/w interrupt conditions, thus a copy is necessary }  save_int_state.bl := int_state.bl; {handle driver interrupts} d_isr_ir.bl := binand(d_isr_ie.bl, ord(save_int_state.bl)); if (d_isr_ir.bl <> 0) then begin {only supposed to be getting driver interrupts with active transfers} ptr_buf := get_buf_ptr; if (ptr_buf = nil) then begin {reset all driver interrupts - this should never happen} d_isr_ie.bl := 0; d_int_e := false; end else with ptr_buf^ do  begin { utility routines will set ioe_result and ioe_isc. Can't allow ioe_result and ioe_isc to be modified!  } save_ioe_result := ioe_result; save_ioe_isc := ioe_isc; if (act_tfr = DMA_tfr) then begin D  if binand(ord(save_int_state.bl), hex('07')) <> 0 then begin {peripheral gone off line during dma transfer, wait for peripheral to respond} try peripheral_check; {if didn't escape, peripheral back online and DMA continuing} recover kill_act_tfr; end  else if save_int_state.nack_low_trans then begin last_read_nack := true; dma_int_handler(temp); end else kill_act_tfr; end else if (act_tfr = INTR_tfr) then begin do_u_isr_ovl := true; if save_int_state.fifo_full then do_ovl_int_fifo_full  else if save_int_state.fifo_empty then do_ovl_int_fifo_empty else begin  do_u_isr_ovl := false; kill_act_tfr; end; end else if (act_tfr = FHS_tfr) then  begin try {fake out the tfr hook} d_isr_ie.fifo_empty := false;  d_isr_ie.fifo_full := false; d_int_e := false; set_int; do_fhs_tfr(ptr_buf);  recover kill_act_tfr; end else kill_act_tfr; ioe_result := save_ioe_result; ioe_isc := save_ioe_isc; end; end; {handle user isr interrupts} u_isr_status.w := 0; u_isr_status.bl := binand(u_isr_ie.bl, ord(save_int_state.bl)); if (u_isr_ie.xfer_extend) and (do_u_isr_ovl) then u_isr_status.xfer_extend := true; if (u_isr_status.bl <> 0) then begin  {disable user interrupts on interrupting conditions only.} u_isr_ie.bl := u_isr_ie.bl - u_isr_status.bl; {call the user isr} p.ioproc := user_isr.real_proc;  call(p.pproc, my_isc); {clear user isr status} u_isr_status.w := 0; end; {reset up any interrupts} set_int; end; end; procedure prdb_hook(temp:ANYPTR; VAR x:CHAR); var count:integer; begin set_my_ptrs(temp); count := 1; fhs_in(addr(x), count, true); end; procedure pwtb_hook(temp:ANYPTR; x:CHAR); var count:integer; begin set_my_ptrs(temp); count E := 1; fhs_out(addr(x), count); end; procedure prdw_hook(temp:ANYPTR; VAR x:io_word); var count:integer; begin set_my_ptrs(temp); count := 2; fhs_in(addr(x), count, true); end; procedure pwtw_hook(temp:ANYPTR; x:io_word); var count:integer; begin set_my_ptrs(temp); count := 2; fhs_out(addr(x), count); end; procedure prds_hook(temp:ANYPTR; reg:io_word; VAR x:io_word); var status:p3regs_type; begin set_my_ptrs(temp);  with my_hw_ptr^, my_tmp_ptr^, my_misc_ptr^ do begin status.w := 0; case reg of PLLEL_REG_CARD_ID: begin status.w := PARALLEL_CARDID; end; PLLEL_REG_INTDMA_STATUS: begin status.bl := ord(intdma.bl); status.intdma_status.pad := 0; end; PLLEL_REG_PERIPHERAL_STATUS: begin status.bl := ord(comm_per.bl);  status.peripheral_status.pad := 0; end; PLLEL_REG_COMM_STATUS: begin status.bl := binlsr(ord(comm_per.bl),3);  status.comm_status.pad := 0; end; PLLEL_REG_HOST_LINE_CONTROL: begin status.bl := ord(hostline.bl); status.host_line.pad := 0; end; PLLEL_REG_IO_CONTROL: begin status.bl := binlsr(ord(intdma.bl),2); status.io_control.pad := 0; end; PLLEL_REG_FIFO: begin status.bl := ord(fifo.fifoin); end; PLLEL_REG_PERIPHERAL_TYPE: begin if peripheral_type = NOT_PRESENT then  try set_peripheral_type; recover if escapecode <> ioescapecode then  escape(escapecode); status.bl := peripheral_type; end; PLLEL_REG_TYPE_RESET: begin  status.bl := peripheral_reset; end; PLLEL_REG_INTERRUPT_STATE: begin status.bl := d_isr_ie.bl;  end; PLLEL_REG_DRIVER_OPTIONS: begin status.bl := options.bl; end; PLLEL_REG_OPTIONS_RESET:  begin status.bl := options_reset.bl; end; PLLEL_REG_DRIVER_STATE: begin  status.driver_state := state; end; PLLEL_REG_HOOK_STATUS: begin if (user_isr.dummy_pr = NIL) then E  status.bl := USER_ISR_HOOK_INACTIVE else status.bl := USER_ISR_HOOK_ACTIVE; end; PLLEL_REG_USER_ISR_ENABLE: begin status.user_isr_status := u_isr_ie; end; PLLEL_REG_USER_ISR_STATUS: begin status.user_isr_status := u_isr_status; end; OTHERWISE dvr_error(ioe_rds_wtc); end; x := status.w; end; end; procedure pwtc_hook(temp:ANYPTR; reg:io_word; x:io_word ); var control:p3regs_type; peripheral_online:boolean; timevalue:integer; begin set_my_ptrs(temp); with my_hw_ptr^, my_tmp_ptr^, my_misc_ptr^ do begin control.w := x; case reg of PLLEL_REG_RESET: begin pinit_hook(temp); end; PLLEL_REG_HOST_LINE_CONTROL: begin control.host_line.pad := 0; hostline.bl := chr(control.bl);  end; PLLEL_REG_IO_CONTROL: begin intdma.io := control.io_control.input_high; intdma.iomod := control.io_control.modify_io; {force driver to set up bus on next transfer} if not state.disabled then state.bl := INACTIVE_ERROR;  end; PLLEL_REG_FIFO: begin fifo.fifoout := chr(control.bl); end; PLLEL_REG_PERIPHERAL_TYPE, PLLEL_REG_TYPE_RESET: begin if control.bl in USER_SET then begin  if reg = PLLEL_REG_PERIPHERAL_TYPE then begin if (options.wr_nrd_low) and (control.bl in INPUT_SET) then dvr_error(ioe_rds_wtc); peripheral_type := control.bl; end  else peripheral_reset := control.bl; end else  dvr_error(ioe_rds_wtc); end; PLLEL_REG_PERIPHERAL_RESET: begin { do a quick test to see if the attached peripheral is online. Want to do a hard reset if the device is not online, the device type is specified by user, or the wr_nrd_low option is used. Otherwise, call set_peripheral_type which will do a reset and additionally deterF mine the type of the attached device. This prevents a 'double reset'. } timevalue := timeout; timeout := 1; try peripheral_check; peripheral_online := true; timeout := timevalue; recover begin timeout := timevalue; if escapecode = ioescapecode then peripheral_online := false else escape(escapecode); end; if (not peripheral_online) or (peripheral_type in [USER_SPEC_NO_DEVICE, USER_SPEC_OUTPUT_ONLY,  USER_SPEC_HP_BIDIRECTIONAL]) or (options.wr_nrd_low) then reset_peripheral  else begin peripheral_type := NOT_PRESENT; set_peripheral_type; end;  end; PLLEL_REG_DRIVER_OPTIONS: begin control.bh := 0; control.driver_options.pad := 0;  if options.wr_nrd_low and not control.driver_options.wr_nrd_low then begin {wr_nrd_low is being turned off}  peripheral_type := NOT_PRESENT; end; options.w := control.w; if options.wr_nrd_low then  set_wr_nrd_low; { force bus to be set on next write this forces use_nack and other options in place.  } state.bl := INACTIVE_ERROR; end; PLLEL_REG_OPTIONS_RESET: begin control.bh := 0; control.driver_options.pad := 0; options_reset.w := control.w; end; PLLEL_REG_HOOK_CLEAR:  begin u_isr_ie.w := 0; u_isr_status.w := 0; user_isr.dummy_pr := NIL; user_isr.dummy_sl := NIL; set_int; end; PLLEL_REG_USER_ISR_ENABLE: begin if user_isr.dummy_pr = NIL then dvr_error(ioe_rds_wtc); u_isr_ie.bl := control.bl; set_int; end; F  OTHERWISE dvr_error(ioe_rds_wtc); end; end; end; procedure pend_hook(temp:ANYPTR; VAR b:boolean); begin set_my_ptrs(temp); b := my_misc_ptr^.last_read_nack; end; procedure ptfr_hook(temp:ANYPTR; bcb:ANYPTR ); VAR tmp: integer; BEGIN set_my_ptrs(temp); with my_tmp_ptr^, ptr_buf_info_type(bcb)^, my_misc_ptr^ do begin {check for illegal full duplex transfer request}  if (direction = TO_MEMORY) and (out_bufptr <> NIL) then begin dvr_error(ioe_bad_tfr); end else if (direction = FROM_MEMORY) and (in_bufptr <> NIL) then begin  dvr_error(ioe_bad_tfr); end; {check for illegal word transfer request} if (b_w_mode = TRUE) then begin dvr_error(ioe_bad_tfr); end; {check for illegal transfer end request for outbound transfers} if (end_mode) and (direction = FROM_MEMORY) then begin dvr_error(ioe_bad_tfr); end; {check for illegal transfer request} if (usr_tfr in [dummy_tfr_1, dummy_tfr_2]) then begin dvr_error(ioe_bad_tfr); end; { adjust transfer request type of FASTEST }  if usr_tfr in [serial_FASTEST, overlap_FASTEST] then begin usr_tfr := pred(usr_tfr); {--> FHS} if (dma_available) then begin  usr_tfr := pred(usr_tfr); {--> DMA} end; end; { adjust transfer request type of OVERLAP } if usr_tfr = OVERLAP then begin if (dma_available) then usr_tfr := OVERLAP_DMA else usr_tfr := OVERLAP_INTR; end; {transfer accepted, mark buffer busy} stbsy;  {do the various transfers} if usr_tfr in [serial_DMA, overlap_DMA] then begin act_tfr := DMA_tfr; dma_start(bcb); if usr_tfr = serial_DMA then begin repeat until active_isc = no_isc; end; end else if usr_tfr = serial_FHS then begin do_fhs_tfr(bcb); end else if usr_tfr in [overlap_FHS, overlap_INTR] then begin if usr_tfr = overlap_FHS then act_tfr := FHS_tfr else  act_tfr := INTR_tfr; if direction = FROM_MEMORY then ovl_int_out_start else ovl_int_in_start; end  else dvr_error(ioe_bad_tfr); end; end; end {pllel_drive}; $page$ {------------------------------------------------------------------------------} {------------------ parallel driver main program. ------------------} {------------------------------------------------------------------------------} import sysglobals, isr, loader, asm, iodeclarations, general_0, parallel_3, pllel_drive, pllel_util; function pllel_init:boolean; type p_drv_type = ^drv_table_type; var card_found:boolean; io_isc:type_isc; io_lvl:io_byte; p_drivers:p_drv_type; p_hw:ptr_parallel_hw_type; p_misc:ptr_misc_block; i:integer; pch:ptr_char_type; begin G  card_found := false; io_revid := io_revid + ' P3.2'; { set up the driver tables } newbytes(p_drivers, sizeof(drv_table_type)); p_drivers^ := dummy_drivers; with p_drivers^ do begin  iod_init := pinit_hook; iod_isr := pisr_hook; iod_rdb := prdb_hook; iod_wtb := pwtb_hook; iod_rdw := prdw_hook; iod_wtw := pwtw_hook; iod_rds  := prds_hook; iod_wtc := pwtc_hook; iod_end := pend_hook; iod_tfr := ptfr_hook; end; { look for parallel interfaces, and initialize. } for io_isc:=iominisc to iomaxisc do with isc_table[io_isc] do begin if (card_ptr <> nil) and (card_type = pllel_card) then begin card_found := true; p_hw := io_tmp_ptr^.card_addr; p_misc := addr(io_tmp_ptr^.drv_misc[1]); { set up O/S I/O hooks } io_drv_ptr := anyptr(p_drivers);  { set up ISR handler } io_lvl := p_hw^.intdma.int_lvl + 3; if io_tmp_ptr^.myisrib.intregaddr <> nil then {isr already exits}  begin { unlink existing isr hook. } isrunlink(io_lvl, addr(io_tmp_ptr^.myisrib)); end;  permisrlink( io_drv_ptr^.iod_isr, { isr handler } ADDR(p_hw^.intdma, 1), { card address } hex('c0'),  { intr. mask } hex('c0'), { intr. value } io_lvl, { level } ADDR(io_tmp_ptr^.myisrib)); { isrib info } { initialize driver variables. } pch := addr(p_misc^); for i := 1 to sizeof(misc_block) do  begin pch^ := #0; pch := addr(pch^,1); end; with p_misc^ do begin peripheral_type := NOT_PRESENT; peripheral_reset := NOT_PRESENT; options.w := 0; options_reset.w := 0; state.bl := INACTIVE_ERROR;  d_isr_ie.w := 0; d_int_e := false; u_isr_ie.w := 0; u_isr_status.w := 0; last_read_nack := false;  end; { initialize driver & h/w. } with io_tmp_ptr^ do try i := timeout;  timeout := 1; pinit_hook(io_tmp_ptr); timeout := i; recover begin timeout := i;  if escapecode <> ioescapecode then escape(escapecode); end; end; end; pllel_init := card_found; end; begin {program pllel_start} G  if pllel_init then markuser; end.  nosyms mname gp src module gp; src src import src sysglobals, mini; src src export src type src gpiotype = { gpio interface card definition } src packed record case integer of src  0: {direct byte access} src ( r0,r1,r2,r3,r4,r5,r6,r7: byte ); src 1: {read access} src ( {r0} R0pad:0..127; ready:boolean; src {r1} R1pad:0..7; cardid:0..31; src {r2} R2pad: byte; src {r3} Renab,req:boolean; intlevel:0..3; burst,Rword,Rdmac1,Rdmac0: boolean; src {r4} Rdata: src {r5} shortint; src {r6} R6pad:byte; src {r7} R7pad:0..15; psts,eir,sti1,sti0:boolean ); src 2: {write access} src ( {r0} setpctl:byte; src {r1} reset:byte; src {r2} W2pad:0..63; rdyen,eiren:boolean; src {r3} Wenab:boolean; W3pad:0..15; Wword,Wdmac1,Wdmac0: boolean; src {r4} Wdata: src {r5} shortint; src {r6} W6pad:byte; src {r7} W7pad:0..63; ctl1,ctl0:boolean ) src end; { gpio interface card definition } src src gpio_r3_type = {separate declaration for use with structured constants} src packed record src {r3} Wenab:boolean; W3pad:0..15; Wword,Wdmac1,Wdmac0: boolean; src end; src  src dmachanneltype = packed array[0..7] of byte; src src var src dma_port[5242880]: array[0..1] of dmachanneltype; src src procedure gpioclear (var gpio: gpiotype); src procedure gpiowordout (var gpio: gpiotype; datum: shortint); src function gpiowordin (var gpio: gpiotype): shortint; src procedure gpiodmaout (var gpio: gpiotype; src command: shortint; src enable_byte: gpio_r3_type; src var dma_channel: dmachanneltype; src buffer: charptr; length: integer); src procedure gpiodmain (var gpio: gpiotype; src command: shortint; src enable_byte: gpio_r3_type; src var dma_channel: dmachanneltype; src buffer: charptr; length: integer); src end; {gpio} page * * dmaout/dmain stack frame definitions * olda6 equ +0 (long) old stack frame pointer radd equ +4 (long) return address len equ +8 (long) length of transfer in words buf equ +12 (long) address of buffer chan equ +16 (long) dma channel base address enab equ +20 (byte) gpio dma enable byte stackpad equ +21 (byte) unused - caused by pushing byte on stack cmnd equ +22 (word) disc command (read/write/verify) gpio equ +24 (long) gpio card base address * * Def's & Ref's * def gp_gp def gp_gpioclear def gp_gpiowordout def gp_gpiowordin def gp_gpiodmaout def  gp_gpiodmain refa sysglobals refa mini_ioresc refa check_timer jws 8/10/83 lmode mini_ioresc lmode check_timer jws 8/10/83 timer_present equ 1 jws 8/10/83 sysflag2  equ $fffffeda jws 8/10/83 * * module initialization routine * gp_gp rts * * ioresult assignments * ztimeout equ 4 zcatchall equ 21 * * error exits * ioresc_catchall moveq #zcatchall,d0 H  zcatchall ioresult ioresc move d0,-(sp) push the ioresult jsr mini_ioresc set ioresult then escape(-10) bus_error move #-12,sysglobals-2(a5) set the escapecode trap #10  escape page * * gpiowaitready with 2 second timeout * waitready move.l #206,d0 timeout counter * * Counter changed to be about 1 ms at 16 MHz -- was 206185 * by jws 8/10/83 * waitready_loop btst #3,7(a1) peripheral status? bne ioresc_catchall ioresc(zcatchall) if so btst #0,(a1) ready? bne.s waitready_rts branch if so subq.l #1,d0 decrement the timeout counter bgt waitready_loop loop until timeout count expired * * Low data rate if we get here, so use timer if have it jws 8/10/83 * 8 MHz loop code is duplicated from above jws 8/10/83 * jws 8/10/83 btst #timer_present,sysflag2 jws 8/10/83 beq.s waitready_timer use timer jws 8/10/83 move.l #206185,d0 else set 2 sec loop jws 8/10/83 waitready_loop2 btst #3,7(a1) peripheral status? bne ioresc_catchall ioresc(zcatchall) if so btst #0,(a1) ready? bne.s waitready_rts branch if so subq.l #1,d0 decrement the timeout counter bgt waitready_loop2 loop until timeout count expired bra.s wait_timeout timeout on 2sec loop jws * waitready_timer equ * jws 8/10/83 move.b #1,-(sp) setup timer record jws 8/10/83 move.l #2000,-(sp) time to wait jws 8/10/83 waitready_tloop btst #3,7(a1) check psts jws 8/10/83 bne ioresc_catchall if not there,escape jws 8/10/83 btst #0,(a1) check card ready jws 8/10/83 bne.s waitready_texit if so then done jws 8/10/83  pea (sp) point to timer rec jws 8/10/83 jsr check_timer timed out? jws 8/10/83 bpl waitready_tloop no--try again jws 8/10/83 addq #6,sp yes, clean stack jws 5/2/84 moveq #10,d0  give one more try jws 5/2/84 bra waitready_loop2 with a short count jws 5/2/84 waitready_texit addq #6,sp cleanup stack jws 8/10/83 waitready_rts rts and continue jws 8/10/83 wait_timeout  moveq #ztimeout,d0 ztimeout ioresult bra ioresc escape ****************************************************************************** * gpioclear * ****************************************************************************** gp_gpioclear movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the gpio card base address move.b d0,1(a1) reset the card move.l #200,d0 prepare to... * * Count changed from 100 to 200 for 16 MHz processors jws 8/10/83 * dbra d0,* wait a while... clr.b 7(a1) clear ctl1 & clt0 bsr waitready  before testing psts & ready jmp (a0) return ******************************************************************************* * gpiowordout * ******************************************************************************* gp_gpiowordout movea.l (sp)+,a0 pop the return address movea.l 2(sp),a1 gpio card base address bsr waitready wait until ready move (sp),4(a1) output the datum move.b d0,(a1) set pctl addq.l #6,sp pop off the parameters jmp (a0) return ******************************************************************************H * * gpiowordin * ******************************************************************************* gp_gpiowordin movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1  gpio card base address bsr waitready wait until ready move 4(a1),(sp) input the datum move.b d0,(a1) set pctl (same manner as 98032 autohandshake) jmp (a0) return page ******************************************************************************* * gpiodmaout * ******************************************************************************* gp_gpiodmaout link a6,#0 create our own stack frame movea.l gpio(a6),a1 gpio card base address bsr waitready wait for previous handshake to complete trap #11 move into supervisor mode (scs) * scs move sr,-(sp) prepare to disable interrupts ori #$2700,sr disable interrupts ******************* move cmnd(a6),4(a1) disc command move.b d0,(a1) set pctl move.b enab(a6),3(a1) enable the gpio card for dma movea.l chan(a6),a2 dma channel base address move.l buf(a6),(a2) set the dma address move.l len(a6),d0 transfer length subq.l #1,d0  length-1 move d0,4(a2) set the dma count move #$0006,6(a2) arm the dma channel move (sp)+,sr re-enable interrupts ****************** lea 7(a1),a3 gpio register 7 address moveq #3,d0 psts bit (gpio register 7) lea 7(a2),a4 dma status lower byte address moveq #0,d1 armed bit (dma status register) do_loop btst d0,(a3) psts? bne  ioresc_catchall ioresc(zcatchall) if so btst d1,(a4) dma channel still armed? bne do_loop keep looping if so cmpi #-1,4(a2) dma transfer complete normally? bne bus_error  branch if not (bus error) bsr waitready wait for the final handshake to complete unlk a6 remove our stack frame movea.l (sp)+,a0 pop the return address adda #20,sp  pop off the parameters jmp (a0) return page ******************************************************************************* * gpiodmain * ******************************************************************************* gp_gpiodmain link a6,#0 create our own stack frame movea.l gpio(a6),a1 gpio card base address bsr waitready wait for previous handshake to complete trap #11 move into supervisor mode (scs) * scs move sr,-(sp) prepare to disable interrupts ori #$2700,sr disable interrupts ******************* move cmnd(a6),4(a1) disc command move.b d0,(a1) set pctl moveq #0,d0 ready bit (register 0) lea 7(a1),a2 register 7 address moveq #3,d1 psts bit (register 7) d_loop btst d1,(a2) peripheral status? bne.s d_enab fall out of the critical section if so btst d0,(a1) ready? beq d_loop branch if not clr 4(a1) clear the output buffer move.b d0,(a1) set pctl, requesting the first word in d_enab move.b enab(a6),3(a1) enable the gpio card for dma movea.l chan(a6),a2 dma channel base address move.l buf(a6),(a2) I  set the dma address move #-1,4(a2) set count to -1 for the case of one transfer move.l len(a6),d0 transfer length subq.l #2,d0 length-2 blt.s di_reni branch if one transfer only  move d0,4(a2) set the dma count move #$0002,6(a2) arm the dma channel di_reni move (sp)+,sr re-enable interrupts ****************** lea 7(a1),a3 gpio register 7 address moveq #3,d0 psts bit (gpio register 7) lea 7(a2),a4 dma status lower byte address moveq #0,d1 armed bit (dma status register) di_loop btst d0,(a3) psts? bne ioresc_catchall ioresc(zcatchall) if so btst d1,(a4) dma channel still armed? bne di_loop keep looping if so page cmpi #-1,4(a2) dma transfer complete normally? bne bus_error  branch if not (bus error) bsr waitready wait for last handshake to complete movea.l buf(a6),a0 buffer address move.l len(a6),d0 transfer length in words add.l d0,d0 transfer length in bytes move 4(a1),-2(a0,d0.l) transfer last word unlk a6 remove our stack frame movea.l (sp)+,a0 pop the return address adda #20,sp pop off the parameters jmp (a0) return end  nosyms ****************************************************************************** * driver assembly routines * ****************************************************************************** * * PASCAL interface text * mname drvasm src module drvasm; src src import src sysglobals; src src export src function test_and_toggle(var semaphore: boolean): boolean; src procedure eor(correction_byte: char; bufptr: charptr); src function shifted_left(value: integer; n: shortint): integer; src function shifted_right(value: integer; n: shortint): integer; src function mod_power_of_2(value: integer; n: shortint): integer; src src end; {drvasm} * * def's * def drvasm_drvasm def drvasm_test_and_toggle def drvasm_eor def drvasm_shifted_left def drvasm_shifted_right def drvasm_mod_power_of_2 * * module intialization routine * drvasm_drvasm rts * * test and toggle - semaphore manipulation function * drvasm_test_and_toggle equ * movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the var parameter address bchg #0,(a1) test and toggle the semaphore sne d0  remember the previous state neg.b d0 form a legal PASCAL boolean move.b d0,(sp) set the return variable jmp (a0) return page * * exclusive or - error correction procedure * drvasm_eor movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the bufptr move.b (sp)+,d0 pop the correction character eor.b d0,(a1) do it to it jmp (a0) return * * shift left n places * drvasm_shifted_left equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop the shift count move.l (sp)+,d0 pop the operand asl.l d1,d0 do it to it move.l d0,(sp) set the return value jmp (a0) return * * shift right n places * drvasm_shifted_right equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop the shift count move.l (sp)+,d0 pop the operand asr.l d1,d0 do it to it move.l d0,(sp) I  set the return value jmp (a0) return * * take a mod power of 2 * drvasm_mod_power_of_2 equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop n moveq #-1,d0 start with all ones asl.l  d1,d0 shift in n zeros not.l d0 invert the sense and.l (sp)+,d0 pop and mask the operand move.l d0,(sp) set the return value jmp (a0) return end  (* (c) Copyright Hewlett-Packard Company, 1984. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal$ $debug off, range off, ovflcheck off$ $stackcheck off, iocheck off$ {{ $search 'KERNEL'$ {{ $search 'IOLIB:KERNEL','OSFS:SYSDEVS'$ {} $page$ $copyright 'COPYRIGHT (C) 1984 BY HEWLETT-PACKARD COMPANY'$ module prtdvr; import sysglobals, iodeclarations, asm, sysdevs, mini, misc, fs; export procedure prtio (fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer); implement {prtdvr} procedure bep; begin write(bellchar); end; procedure prtio(fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer); const uclr_timeout_const = 25; {HPIB commands during unitclear} repeating_timeout = 333; {timeout constant after initial timeout} timeouts_per_beep = 40; {beep period in repeating timeout units} SDC = 4; {selective device clear} LAGbase = 32; {listen address group base} TAGbase = 64; {talk address group base} linefeed = chr(10); {ASCII linefeed} formfeed = chr(12); {ASCII formfeed} return = chr(13); {ASCII carriage return} var select_code: type_isc; sc_table_entry_ptr: ^isc_table_type; previous_char_ptr: charptr; bus_address: byte; channel_is_setup: boolean; writing_previous_char: boolean; previously_timed_out: boolean; timeout_blanked: boolean; user_spec_timeout: integer; current_timeout: integer; timeout_counter: shortint; saved_line : string[42]; { 3.0 bug fix -- 4/12/84 } line_needs_restoring : boolean; { 4/12/84 } buf: charptr; saved_echo: boolean; { 5/9/84 } $page$ procedure reset_card_and_confirm_timeout; var saved_escapecode: shortint; saved_ioe_sc: integer; saved_ioe_result: integer; begin {reset_card_and_confirm_timeout} saved_escapecode := escapecode; saved_ioe_sc := ioe_isc; saved_ioe_result := ioe_result; try with sc_table_entry_ptr^ do call(io_drv_ptr^.iod_init, io_tmp_ptr); recover if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(escapecode); ioe_isc := saved_ioe_sc; ioe_result := saved_ioe_result; if (saved_escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(saved_escapecode); if ioe_result<>ioe_timeout then ioresc(znodevice); end; {reset_card_and_confirm_timeout} procedure clear_unit; var w:io_word; procedure HPIBsdc; begin {HPIBsdc} with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do begin call(iod_send, io_tmp_ptr, '?'); timeout := uclr_timeout_const; call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address)); call(iod_send, io_tmp_ptr, chr(SDC)); end; {with} end; {HPIBsdc} begin {clear_unit} with sc_table_entry_ptr^ do if card_type=hpib_card then try HPIBsdc; {first attempt} reJ cover begin reset_card_and_confirm_timeout; try HPIBsdc; {second attempt} recover begin reset_card_and_confirm_timeout; ioresc(ztimeout);  end; {recover} end {recover} else if card_type = serial_card then {12/89 dew - added pllel} try call(io_drv_ptr^.iod_init, io_tmp_ptr); recover if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(escapecode) else ioresc(znodevice) else {parallel_card} {12/89 dew - added pllel} try io_tmp_ptr^.timeout := current_timeout; call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 0); {set the reset type to not present} call(io_drv_ptr^.iod_init, io_tmp_ptr); {reset driver} call(io_drv_ptr^.iod_rds, io_tmp_ptr, 20, w); {get peripheral type} if w = 1 then {OUTPUT_ONLY} begin call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 20, 11); {set current type to user_spec_output_only} call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 11); {set the reset type to same} end else {not a printer there} ioresc(znodevice); recover begin reset_card_and_confirm_timeout; ioresc(ztimeout); end; {recover} end; {clear_unit} $page$ procedure wrtchar(character: char; last_char: boolean); var hs_successfully_initiated: boolean; previous_hs_completed : boolean; procedure restore_line; var dummyc:char; begin if line_needs_restoring then { 4/12/84 } begin keybuffer^.echo:=saved_echo; keybufops(kdisplay,dummyc); line_needs_restoring:=false; end; end; $page$ procedure inform_operator; var lmstr : string[42]; { 3.0 bug fix -- 4/12/84 } begin {inform_operator} if not previously_timed_out then  begin timeout_blanked := true; timeout_counter := 0; end; if not line_needs_restoring then begin saved_line := '* Printer timeout: fix or '; if intlevel=0 then saved_line:=saved_line+' aborts *'  else saved_line:=saved_line+'wait auto-abort*' ; { 3.0 bug fix -- 4/12/84 } line_needs_restoring := true; if menustate=m_none then saved_echo:=keybuffer^.echo  else saved_echo:=true; menustate := m_none; { 4/12/84 } keybuffer^.echo :=false; end; if timeout_blanked then lmstr:= saved_line else lmstr:= ' '; CALL(CRTLLHOOK,CLLDISPLAY,LMSTR,' ');  timeout_blanked:= (timeout_counter mod 4)<>0; if timeout_counter<=1 then bep; timeout_counter := timeout_counter+1; if timeout_counter>=timeouts_per_beep then if intlevel=0 then timeout_counter := 0 else begin bep; restore_line; ioresc(ztimeout); end; {else} end; {inform_operator} $page$ begin {wrtchar} try with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do repeat try  previous_hs_completed := false; if not channel_is_setup then begin case card_type of hpib_card: begin call(iod_send, io_tmp_ptr, '?');  previous_hs_completed := true; timeout := current_timeout; call(iod_send, io_tmp_ptr, chr(TAGbase+addressed)); call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address));  end; {hpib_card} serial_card: if card_id=hp98626 then {always set full duplex modem HS} call(iod_wtc, io_tmp_ptr, 13, 1); pllel_card: {J 12/89 dew - added pllel} begin timeout := current_timeout; call(iod_wtc, io_tmp_ptr, 24, 4); {write verify} end; otherwise {do nothing}; end; {case} channel_is_setup := true; end; {if} call(iod_wtb, io_tmp_ptr, character); previous_char_ptr^ := character; timeout := current_timeout; if last_char then if card_type=hpib_card then call(iod_send, io_tmp_ptr, '?'); if previously_timed_out then if not writing_previous_char then begin restore_line;  current_timeout := user_spec_timeout; previously_timed_out := false; end; {if} hs_successfully_initiated := true; recover begin reset_card_and_confirm_timeout;  channel_is_setup := false; inform_operator; previously_timed_out := true; current_timeout := repeating_timeout; if not (writing_previous_char or previous_hs_completed) then begin  writing_previous_char := true; wrtchar(previous_char_ptr^, false); writing_previous_char := false; end; {if} hs_successfully_initiated := false; end; {recover}  until hs_successfully_initiated; recover begin restore_line; { 4/12/84 } escape(escapecode); end; {recover} end; {wrtchar} $page$ begin {prtio} ioresult := ord(inoerror); { scs 1/17/83 } with unitable^[fp^.funit] do begin select_code := sc; sc_table_entry_ptr := addr(isc_table[select_code]); bus_address := ba; previous_char_ptr := addr(dvrtemp); user_spec_timeout := devid; {user-specified in CTABLE} end; {with} buf := addr(buffer); channel_is_setup := false; current_timeout := user_spec_timeout; previously_timed_out := false; writing_previous_char := false; line_needs_restoring := false; { 4/12/84 } try with sc_table_entry_ptr^, io_tmp_ptr^ do begin if card_type=no_card then ioresc(znodevice); while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing}; end; {with} case request of flush:  {do nothing}; clearunit: clear_unit; writeeol: begin wrtchar(return, false); wrtchar(linefeed, true) end; writebytes: while length>0 do begin  wrtchar(buf^, length=1); buf := addr(buf^, 1); length := length-1; end; otherwise ioresc(zbadmode); end; {case} recover if (escapecode=-20) and previously_timed_out then  ioresult := ord(ztimeout) else if escapecode<>-10 then escape(escapecode); end; {prtio} end. {prtdvr}  (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal$ $debug off, range off, ovflcheck off$ $stackcheck off, iocheck off$ $search 'GPIODVR' { , 'IOLIB:COMASM', 'IOLIB:KERNEL'} $ $page$ $copyright 'COPYRIGHT (C) 1983 BY HEWLETK T-PACKARD COMPANY'$ program F9885init; module F9885dvr; import sysglobals, mini, gp, iodeclarations, iocomasm, misc; export procedure F9885io (fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer); implement procedure F9885io; type errors = (noerror, nopower, dooropen, nodisc, badcommand, norecord, notrack, badcheckword, dataoverrun, badverify); primarycommands = (readblock, verifyblock, writeblock, settracksector);  fd = {floppy disc command & status structure} packed record case integer of -1: (w: shortint); 0: (case primary: primarycommands of readblock, verifyblock, writeblock: (drv: 0..3; nrecords: 0..4095);  settracksector: (driv: 0..3; track: 0..127; sector: 0..31)); 1: (pad: 0..15; errcode: errors; p2, transfercomplete, seekcomplete, notready, writeprotected, dooropened: boolean; drve: 0..3);  end; gpio_enable_type = packed array[0..1] of gpio_r3_type; const maxtries = 10; password = -20857; gpio_enable = {gpio enable bytes for the 2 DMA channels} gpio_enable_type [ gpio_r3_type [ Wenab: false, W3pad:0, Wword:true, Wdmac1:false, Wdmac0:true ], gpio_r3_type [ Wenab: false, W3pad:0, Wword:true, Wdmac1:true, Wdmac0:false ] ]; var uep: ^unitentry; gptr: ^gpiotype; tptr: pio_tmp_ptr; bufptr: charptr; $page$ procedure clear_unit; begin with gptr^ do if sti1 or sti0 then ioresc(znodevice); gpioclear(gptr^); {also tests psts while waiting for ready} end; procedure clear_and_escape(escape_value: shortint; iores_value: integer); begin {clear_and_escape} try gpioclear(gptr^); recover {do nothing}; ioresult := iores_value; escape(escape_value); end; {clear_and_escape} procedure transfer(record_addr, total_words: integer); var gpiodma_proc: procedure(var gpio: gpiotype; command: shortint; enable_byte: gpio_r3_type; var dma_channel: dmachanneltype; buffer: charptr; length: integer); status, opcode: fd; chan, tries, sectors: shortint; words: integer; const request_status = fd [ primary: settracksector, driv: 0, track: 127, sector: 31 ]; begin {transfer} if not dma_here then ioresc(zbaddma); gptr^.r3 := 0; {setup gpio card} gptr^.r7 := 0; gpiowordout(gptr^, password); {issue password} opcode := request_status; opcode.driv := uep^.du; gpiowordout(gptr^, opcode.w); {issue request status command} gpiowordout(gptr^, 0); {clear output regs & request data word} status.w := gpiowordin(gptr^); {input status word} if (status.drve<>uep^.du) or (status.pad<>0) then clear_and_escape(-10, ord(zcatchall)); if status.dooropened then begin uep^.umediavalid := false; if uep^.ureportchange then ioresc(zmediumchanged); end; {if} $page$ tries := 0; while total_words>0 do begin try gpiowordout(gptr^, password); opcode.primary := settracksector; opcode.driv := uep^.du; opcode.track := record_addr div 30; opcode.sector := record_addr mod 30;  gpiowordout(gptr^, opcode.w); repeat chan := dma_request(tptr); until chan>=0; if (chan<>0) and (chan<>1) then ioresc(zcatchall); if total_words<=65536 then words := total_words else words := 65536; sectors := (words+127) div 128; gpiowordout(gptr^, password); opcode.drv := uep^.du; opcode.nrecords:= sectors; case request of readbytes, startrK ead: begin opcode.primary := readblock; gpiodma_proc := gpiodmain; end; writebytes, startwrite: begin opcode.primary := writeblock;  gpiodma_proc := gpiodmaout; end; end; {case} call(gpiodma_proc, gptr^, opcode.w, gpio_enable[chan], dma_port[chan], bufptr, words); ioresc(inoerror); {invoke proper cleanup} recover  begin gptr^.r3 := 0; {disable the gpio card} dma_release(tptr); {release the dma resource} if (escapecode=-10) and ( (ioresult=ord(inoerror)) or (ioresult= ord(zcatchall)) )  then ioresult := ord(inoerror) else clear_and_escape(escapecode, ioresult); end; {recover} with gptr^ do begin r7 := 1; {set the end of transfer bit}  Wdata := 0; {clear bidirectional buffer for reading status} setpctl := 0; {request the status word} status.w := gpiowordin(gptr^); {save the status word} r7 := 0; {clear the end of transfer bit} end; {with} $page$ if (status.drve<>uep^.du) or (status.pad<>0) then clear_and_escape(-10, ord(zcatchall)); with status do case errcode of noerror: begin if notready or (not seekcomplete) or (not transfercomplete) then clear_and_escape(-10, ord(zcatchall)); tries := 0; record_addr := record_addr+sectors; total_words := total_words-words; bufptr := addr(bufptr^,words*2) end; nopower: ioresc(znodevice); dooropen, nodisc:  ioresc(znomedium); badcommand: if writeprotected and ( (request=writebytes) or (request=startwrite) ) then ioresc(zprotected) else clear_and_escape(-10, ord(zcatchall));  notrack: ioresc(znoblock); norecord, badcheckword: begin tries := tries+1; if tries>=maxtries then begin if errcode=norecord then ioresc(znoblock); if errcode=badcheckword then ioresc(zbadblock); ioresc(zcatchall); end; {if} end; dataoverrun: ioresc(zbadhardware);  otherwise clear_and_escape(-10, ord(zcatchall)); end; {case} end; {while} end; {transfer} $page$ begin {F9885io} uep := addr(unitable^[fp^.funit]); if uep^.offline then ioresult := ord(znodevice)  else begin lockup; try with isc_table[uep^.sc] do begin if card_id<>hp98622 then ioresc(znodevice); gptr := card_ptr; tptr := io_tmp_ptr; end; {with}  case request of clearunit: clear_unit; unitstatus: fp^.fbusy := false; flush: {do nothing}; readbytes, writebytes, startread, startwrite: begin if uep^.ureportchange and not uep^.umediavalid then ioresc(zmediumchanged); bufptr := addr(buffer); if (position mod 256<>0) or odd(integer(bufptr)) then ioresc(zbadmode); if (position<0) or (length<0) or (position+length>fp^.fpeof) then ioresc(ieof); transfer((position+fp^.fileid+uep^.byteoffset) div 256, (length+1) div 2); end; otherwise L  ioresc(ibadrequest); end; {cases} ioresc(inoerror); {set ioresult & perform lockdown} recover begin lockdown; if escapecode<>-10 then escape(escapecode); if (request=startread) or (request=startwrite) then call(fp^.feot, fp); end; {recover} end; {else} end; {f9885io} end; {f9885dvr} { program F9885init } import loader; begin {F9885init} markuser; end. {F9885init} @@@@@@@@@@@@@@L @@@@@@@@@@@@@@@@