head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.26.17;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.04.51;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.46.25;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.23.37;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.26.59;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.28.05;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.12.03;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.11.48;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.26.29;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.10.44;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.16.53;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.59.42;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.46.53;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.54.41;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.11.51;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.03.49;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.48.35;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.30.37;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.52.38;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.36.47;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.28.57;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.41.20;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.19.39;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.34.40;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.09.43;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.41.41;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.50.22;  author bayes;  state Exp;
branches ;
next     31.4;

31.4
date     88.12.19.09.37.13;  author bayes;  state Exp;
branches ;
next     31.3;

31.3
date     88.12.16.12.48.34;  author quist;  state Exp;
branches ;
next     31.2;

31.2
date     88.12.16.12.45.23;  author quist;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.11.31;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.48.22;  author dew;  state Exp;
branches ;
next     29.4;

29.4
date     88.12.09.10.12.39;  author dew;  state Exp;
branches ;
next     29.3;

29.3
date     88.12.09.10.11.29;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.12.09.10.10.27;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.33.22;  author bayes;  state Exp;
branches ;
next     28.3;

28.3
date     88.10.31.10.56.37;  author bayes;  state Exp;
branches ;
next     28.2;

28.2
date     88.10.27.10.12.53;  author quist;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.00.05;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.35.35;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.15.02;  author bayes;  state Exp;
branches ;
next     25.2;

25.2
date     88.03.15.15.13.24;  author quist;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.31.33;  author bayes;  state Exp;
branches ;
next     24.2;

24.2
date     88.03.01.09.44.35;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     88.02.04.11.04.52;  author quist;  state Exp;
branches ;
next     1.1;

1.1
date     88.02.04.10.40.43;  author larry;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$MODCAL$
PROGRAM LAN(INPUT,OUTPUT);
$DEBUG OFF$ $RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
{ bug fix/changes  history
  disallowed dummy_tfr_1 and dummy_tfr_2 transfer requests.
  3.22A
  fixed MOVE_DATA_TO to also discard input if in_bufptr=nil.
  added code in LAN_INIT to fix the heap pointer.
  added code in LAN_TFR to call OPS_PROCS for TO_MEMORY
    transfers.  Gives an OPS_PROC a chance to supply data
    immediately.
  3.22C
  in LAN_TFR defined dummy_tfr_1 and dummy_tfr_2 to mean than
  the buffer involved must be registered.
  for these 'must be registered' type transfers,
    for from_memory transfers, OUT_BUFPTR is still used/required
    for to_memory transfers, IN_BUFPTR is ignored.
}

MODULE LANDVR;
$SEARCH 'LANDECS','LANASM','IOLIB:KERNEL.CODE'$
IMPORT  SYSGLOBALS, IODECLARATIONS, GENERAL_0,
	ASM, LANDECS, LANASM, ISR;

EXPORT
  function laninit(var ehp:anyptr):boolean;

IMPLEMENT
  $INCLUDE 'IOMPXDECS.TEXT'$
  $LINENUM 2000$
  CONST
    ack_timeout_count = 1000;     { just a count }
    init_timeout      = 30;       { milli secs }

    init_ladrf    = ladrf_type[int1 : 0,int2 : 0];
    rmd1_0_init   = HEX('80'); { sets OWN, clears others }
    clear_mcnt    = 0;
    tmd1_0_init   = 0; { clears OWN & all others }
    tmd1_0_return = HEX('83'); { sets OWN, STP & ENP }
    tmd3_return   = 0; { clears all bits }
    csr0_init     = csr0_type[ ERR :false, BABL:TRUE , CERR:TRUE , MISS:TRUE,
			       MERR:TRUE , RINT:TRUE , TINT:TRUE , IDON:TRUE,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:TRUE , INIT:TRUE ];

    csr0_init_ack = csr0_type[ ERR :false, BABL:TRUE , CERR:TRUE , MISS:TRUE ,
			       MERR:TRUE , RINT:TRUE , TINT:TRUE , IDON:TRUE ,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:false, INIT:false];

    csr0_start    = csr0_type[ ERR :false, BABL:TRUE , CERR:TRUE , MISS:TRUE,
			       MERR:TRUE , RINT:TRUE , TINT:TRUE , IDON:TRUE,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:TRUE , INIT:false];

    csr0_intr_ack = csr0_type[ ERR :false, BABL:false, CERR:false, MISS:false,
			       MERR:false, RINT:false, TINT:false, IDON:TRUE,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:false, INIT:false];

    tdmd_inea     = csr0_type[ ERR :false, BABL:false, CERR:false, MISS:false,
			       MERR:false, RINT:false, TINT:false, IDON:false,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:TRUE , STOP:false, STRT:false, INIT:false];
  type
    scan_result_type = (scan_ok, scan_done, scan_error, scan_nop);
    isr_tx_status_type = (isr_tx_done,isr_tx_none,isr_tx_retry);
    io_wp = ^io_word;
    bp = ^buf_info_type;
    cp = ^char;
    fp = ^frame_type;
    frame_type = packed array[1..lan_max_frame_len] of char;
    term_char_type = -1..255;
    ioclass = (lan_input,lan_output,lan_all_io);
  var
    lmpx_info : iompx_info_ptr;

  function read_csr0(var info : lan_info_rec;
			 card : card_base_ptr):csr0_type;
    var
      tcount  : integer;
    begin { Read the RDP register on the LANCE }
      tcount := ack_timeout_count;
      with info, card^ do
      begin
	repeat
	  READ_CSR0 := rdp.csr0;
	  tcount := tcount - 1;
	until sc_reg.ack or (tcount<=0) ;
	if not sc_reg.ack then
	begin
	  card_state   := cs_ack_error;
	  id_reg.reset := 1; { reset the card }
	  READ_CSR0.UW := 0; { no status info }
	end;
      end; { with }
    end; { read_csr0 }

  procedure write_rdp(var info : lan_info_rec;
			  card : card_base_ptr;
			  data : unsword);
    var
      tcount : integer;
    begin { Write the RDP register on the LANCE }
      tcount := ack_timeout_count;
      with info, card^ do
      begin
	repeat
	  rdp.uw := data;
	  tcount := tcount - 1;
	until sc_reg.ack or (tcount<=0);
	if not sc_reg.ack then
	begin
	  card_state := cs_ack_error;
	  id_reg.reset := 1;  { reset the card }
	end;
      end; { with }
    end; { write_rdp }

  procedure clean_up(io_info : pio_tmp_ptr;
			info : lan_info_ptr;
			  tc : term_char_type;
		       class : ioclass);
  { called only when tc = lb_abort, lb_reset or lb_hw_failed }
    var
      i : integer;
      can_continue : boolean;
      tempbp: ^buf_info_type;
      next1,
      next2 : iompx_rec_ptr;
      ans   : iompx_ans_rec;

    begin { clean_up }
      { check for IOMPX availability }
      if lmpx_info=nil then
      begin
	call(io_error_link,iompx_request,ans.s);
	if ans.s=iompx_answer then
	begin
	  lmpx_info := ans.ptr;
	  lmpx_info^.isc_iompx_table[io_info^.my_isc].capable := true ;
	end;
      end;
      with io_info^ do
      begin
	{ clean up input side }
	{ can continue from aborts and resets }
	if class<>lan_output then
	begin
	  if in_bufptr<>nil then
	  with bp(in_bufptr)^ do
	  begin
	    term_char := tc;
	    TRY
	      if eot_proc.dummy_pr<>nil then
		call(eot_proc.real_proc,in_bufptr);
	    RECOVER
	      term_char := lb_abort; { cancel the transfer }

	    can_continue := (tc=lb_abort) or (tc=lb_reset);
	    if not (can_continue and
	      ((term_char=lb_pending) or (term_char=lb_reset))) then
	    begin in_bufptr := nil;
		  active_isc:=no_isc;
	    end;
	  end;
	  { now check for registered buffers }
	  if lmpx_info<>nil then
	  begin
	    next1 := lmpx_info^.isc_iompx_table[my_isc].checkers;
	    while next1<>nil do
	    with next1^, user_buffer^ do
	    begin
	      next2 := next; { eot proc may decide to un-register }
	      if active_isc<>no_isc then
	      begin
		term_char := tc;
		TRY
		  if eot_proc.dummy_pr<>nil then
		    call(eot_proc.real_proc,user_buffer);
		RECOVER
		  begin end;
	      end;
	      next1 := next2;
	    end; { while .. with next1 }
	  end;
	end;

	{ clean up output side }
	{ can continue from aborts but not resets }
	{ allow re transmit on reset }
	if class<>lan_input then
	if out_bufptr<>nil then
	begin
	  tempbp := out_bufptr;
	  with tempbp^ do
	  begin
	    term_char  := tc;
	    out_bufptr := nil;    { dis-connect & de-activate }
	    active_isc := no_isc;
	    TRY
	      if eot_proc.dummy_pr<>nil then
		 call(eot_proc.real_proc,tempbp);
	    RECOVER
	      term_char := lb_abort;  { cancel the transfer }

	    if (tc=lb_abort) and (term_char=lb_pending) then
	    begin out_bufptr := tempbp; { re-connect and re-activate }
		  active_isc := my_isc;
	    end;
	  end;
	end;

      { notify all user buffers on the card of the request }
      { can continue from aborts but not resets or failures}
	if class=lan_all_io then
	for i := 0 to max_ring_elts-1 do
	begin
	  tempbp := info^.tx_user_buffs^[i]; { take a copy  }
	  info^.tx_user_buffs^[i] := nil;    { zap original }

	  if tempbp<>nil then
	  with tempbp^ do
	  begin
	    term_char := tc;
	    active_isc:= no_isc; { de-activate the buffer }
	    TRY
	      if eot_proc.dummy_pr<>nil then
		call(eot_proc.real_proc,tempbp);
	    RECOVER
	      term_char := lb_abort; { cancel the transfer }

	    if (term_char<>lb_pending) or (tc<>lb_abort)
	      then tempbp:=nil; { disconnect it }

	    { fix if call is abort }
	    if tc=lb_abort then info^.tx_user_buffs^[i]:=tempbp;
	  end;
	end;
      end;
      { try to call outbuf_proc }
      if tc<>lb_hw_failed then
      with info^, io_info^ do
      begin
	TRY
	  if out_bufptr=nil then
	    if outbuf_proc.dummy_pr<>nil then
	      call(outbuf_proc.real_proc,my_isc);
	RECOVER begin end;
      end;
    end; { clean_up }

  procedure card_start(io_info : pio_tmp_ptr);
    const
      p2 = #1#2#4#8#16#32#64#128;
    var
      card      : card_base_ptr;
      temp_addr : gpaddr;
      i,nb      : integer;
      info      : lan_info_ptr;
      rx_temp   : ^rx_buffers;
      tx_temp   : ^tx_buffers;
      done      : boolean;
      timeout   : timer_rec;
      csr0      : csr0_type;
      tc        : term_char_type;

    begin { card_start }
      info := ADDR(io_info^.drv_misc);
      card := io_info^.card_addr;
      with card^, info^ do
      if card_state<>cs_hw_failed then
      begin
      { ========== load the init block ========== }
       { reset the card so that handshake operations are not needed }
	id_reg.reset := 1;
	card_state := cs_card_reset;
	alloc_ok   := false; { set notice that output buffers
			       must be re-allocated }
      { set up LANCE registers 1, 2 and 3 }
	temp_addr.ptr := ADDR(ram_area.init_block);
	rap := 1;  { register 1 }
	rdp.uw := temp_addr.L16;
	rap := 2;  { register 2 }
	rdp.uw := temp_addr.H8;
	rap := 3;  { register 3 }
	rdp.uw := 4;  { bwsp=1, acon=0, bcon=0 }
	{ fill in the init_block pieces }
	TRY
	  with init_block do { temp init block }
	  begin
	    { note byte swapping }
	    padr[1]:=local_link_address[2];
	    padr[2]:=local_link_address[1];
	    padr[3]:=local_link_address[4];
	    padr[4]:=local_link_address[3];
	    padr[5]:=local_link_address[6];
	    padr[6]:=local_link_address[5];
	    i := num_rx_buffers*rx_buffer_size;
	    tx_buffer_size := memory_size
			     -init_size
			     -num_rx_buffers*sizeof(rx_ring_elt_type)
			     -num_tx_buffers*sizeof(tx_ring_elt_type)
			     -num_rx_buffers*rx_buffer_size;
	    if (tx_buffer_size < lan_max_frame_len ) or (i<lan_max_frame_len)
	      then escape(0); { buffer specs are messed up }

	    { point to the recive ring }
	      { fixup num_rx_buffers }
	    nb := 0;
	    for i := 1 to 8 do if num_rx_buffers>=ORD(p2[i]) then nb:=i-1;
	    num_rx_buffers := ORD(p2[nb+1]);
	    { recieve ring is the first part of buffers }
	    temp_addr.ptr := ADDR(ram_area.buffers);
	    rxr_1 := temp_addr.ptr;       {address of first rcv ring elt}
	    rx_temp := temp_addr.ptr;
	    rdraL := temp_addr.L16;
	    rdraH := temp_addr.H8;
	    rlen  := nb;
	    zip0  := 0;

	    { point to transmit ring }
	      { fixup num_tx_buffers }
	    nb := 0;
	    for i := 1 to 8 do if num_tx_buffers>=ORD(p2[i]) then nb:=i-1;
	    num_tx_buffers := ORD(p2[nb+1]);
	    { transmit ring is the second part of buffers }
	    temp_addr.int := temp_addr.int +
			     (num_rx_buffers*sizeof(rx_ring_elt_type));
	    rxr_n := temp_addr.ptr; { last + 1 rcv ring elt }
	    txr_1 := temp_addr.ptr; { first tx ring elt }
	    tx_ring_f := txr_1;
	    tx_ring_l := txr_1;
	    tx_temp := temp_addr.ptr;
	    tdraL := temp_addr.L16;
	    tdraH := temp_addr.H8;
	    tlen  := nb;
	    zip1  := 0;

	    { initialize the recieve ring }
	      { recieve buffers is the third part of buffers }
	    temp_addr.int := temp_addr.int +
			     (num_tx_buffers*sizeof(tx_ring_elt_type));
	    txr_n := temp_addr.ptr; {last + 1 tx ring elt}
	    for i := 1 to num_rx_buffers do
	      with rx_temp^[i] do
	      begin
		ladr  :=temp_addr.L16;
		hadr  :=temp_addr.H8;
		rmd1_0:=rmd1_0_init; { set own , clear all others }
		bcnt  :=-rx_buffer_size;
		mcnt  :=clear_mcnt;
		temp_addr.int := temp_addr.int+rx_buffer_size;
	      end; { for .. with }
	    rx_ring := rxr_1; { where to start looking for inbound messages }

	    { initialize the transmit ring }
	      { the trasmit buffer space is the fourth part of buffers }
	    for i := 1 to num_tx_buffers do
	      tx_temp^[i].tmd1_0 := tmd1_0_init;

	    { initialize the remaining pointers etc. }
	    txd_1.ptr := temp_addr.ptr; { first of tx buffer space }
	    temp_addr.int := temp_addr.int+tx_buffer_size;
	    txd_n.ptr := temp_addr.ptr; {last + 1 of tx buffer space}
	    tx_count := 0; { no outstanding tx requests }
	    tx_next.ptr := txd_1.ptr; { first usable space }
	    tx_used.ptr := nil;   { no used space }
	  end; { with init_block }

	RECOVER
	  card_state := cs_init_failed;

	if card_state=cs_card_reset then
	begin
	  {move the init_block from driver info to card ram_area }
	  ram_area.init_block:=init_block;
	  { start up the card }
	  rap := 0;
	  rdp.csr0 := csr0_init;
	  timeout.time := init_timeout; start_timer(timeout);
	  done := FALSE;
	  repeat
	    if sc_reg.ir then
	    begin
	      csr0 := read_csr0(info^,card);
	      if csr0.idon then
	      with csr0 do
	      begin
		if not (init and strt and txon and inea) then
		begin
		  id_reg.reset := 1;
		  io_escape(ioe_crd_dwn,io_info^.my_isc);
		end;
		{ acknowledge the init done }
		write_rdp(info^,card,csr0_init_ack.uw);
		done := TRUE;
		if card_state=cs_card_reset then card_state := cs_lance_ready;
	      end;
	    end;
	  until time_expired(timeout) or done;
	  if not done then
	  begin
	    id_reg.reset := 1;
	    card_state := cs_hw_failed;
	  end;
	  do_card_start := FALSE; { operation complete }
	  lan_stats^[lhw_restarts] := lan_stats^[lhw_restarts]+1;
	end; { if card_state .. }
	tx_ub_in := 0; tx_ub_out := 0; { reset tx user buffer control }
	last_rx_size := 0;      { no input frames available yet }
      end; { with card, info^ }
      { enable card interupts }
      if info^.card_state = cs_lance_ready then
      begin
	tc := lb_reset;
	card^.sc_reg.ie := TRUE;
      end
      else  tc := lb_hw_failed;

      { notify all user buffers of card reset/hw_failure }
      clean_up(io_info,info,tc,lan_all_io);
    end; { card_start }

  procedure card_reset(info : lan_info_ptr;
		       card : card_base_ptr);
    begin
      with card^ do
      begin
	id_reg.reset := 1;    { reset the card }
	sc_reg.control := 0;  { disable interupts }
      end;
      info^.card_state := cs_card_reset;
    end; { card_reset }

  procedure lan_init(temp : ANYPTR);
    { stop key/cleario/abort transfer }
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      old_level: integer;
    begin { lan_init }
      io_info := temp;
      with io_info^ do
      begin
	info := ADDR(drv_misc);
	old_level := intlevel;
	if old_level<info^.card_intlevel then
	begin { only do this if intlevel lower than card intlevel }
	  setintlevel(info^.card_intlevel);
	  clean_up(io_info,info,lb_abort,lan_all_io);
	  setintlevel(old_level);
	end;
      end;
    end; { lan_init }

  procedure skip_bad_frame(info : lan_info_ptr);
    { throws away the frame pointed to by rx_ring }
    { assumes that host owns at least the first element }
    begin
      with info^ do
      begin
	last_rx_size := 0;
	repeat
	  with rx_ring^ do
	  begin
	    mcnt   := clear_mcnt;
	    rmd1_0 := rmd1_0_init; { set own clear others }
	    { setup for next ring element }
	    rx_ring := ADDR(rx_ring^,sizeof(rx_ring_elt_type));
	    if rx_ring = rxr_n then rx_ring := rxr_1;
	  end;
	  { check this next ring element }
	until rx_ring^.stp or rx_ring^.own;
      end;
    end; { skip_bad_frame }

  procedure skip_frame(info : lan_info_ptr);
    { throws away the frame pointed to by rx_ring }
    { assumes that host owns at least the first element }
    var
      done : boolean;
    begin
      with info^ do
      begin
	last_rx_size := 0;
	repeat
	  with rx_ring^ do
	  begin
	    done   := enp or err; { is this the last one in the frame? }
	    mcnt   := clear_mcnt;
	    rmd1_0 := rmd1_0_init; { set own clear others }
	    { setup for next ring element }
	    rx_ring := ADDR(rx_ring^,sizeof(rx_ring_elt_type));
	    if rx_ring = rxr_n then rx_ring := rxr_1;
	  end;
	until done;
      end;
    end; { skip_frame }

  function scan_inbound(info   : lan_info_ptr;
			var size   : shortint): scan_result_type;
    var
      done  : scan_result_type;
      ring  : rx_ring_elt_ptr;

    begin
      with info^, rx_ring^ do
      begin { check for first of a series }
	if own then SCAN_INBOUND := scan_done
	else
	{ first buffer must have the start bit set }
	if not stp then
	begin SCAN_INBOUND := scan_error;
	      lan_stats^[lrx_other_err]:=lan_stats^[lrx_other_err]+1;
	end
	else
	begin
	  ring := rx_ring;
	  done := scan_nop;
	  repeat
	    with ring^ do { needed because ring could change }
	    begin
	      if own then done := scan_done
	      else
	      begin
		if err then
		begin done := scan_error;
		  if FRAM then
		     lan_stats^[lrx_frame_err] := lan_stats^[lrx_frame_err]+1;
		  if CRC then
		     lan_stats^[lrx_crc_err] := lan_stats^[lrx_crc_err]+1;
		  if OFLO then
		     lan_stats^[lrx_oflo_err] := lan_stats^[lrx_oflo_err]+1;
		  if BUFF then
		     lan_stats^[lrx_buff_err] := lan_stats^[lrx_buff_err]+1;
		end
		else
		if enp then
		begin
		  size := mcnt-crc_size; { exclude crc from buffer size }
		  done := scan_ok;
		end
		else
		begin { point to next ring element }
		  ring := ADDR(ring^,sizeof(rx_ring_elt_type));
		  if ring=rxr_n then ring := rxr_1;
		end;
	      end;
	    end; {with}
	  until done<>scan_nop;
	  SCAN_INBOUND := done;
	end;
      end; { with }
    end; { scan_inbound }

  procedure next_baddr(info : lan_info_ptr;
		       var ring : rx_ring_elt_ptr;
		       var bufptr : gpaddr);
    begin
      ring := ADDR(ring^,sizeof(rx_ring_elt_type));
      with info^ do
	if ring = rxr_n then ring := rxr_1;
	with ring^ do
	begin
	  bufptr.int := 0;
	  bufptr.L16 := ladr;
	  bufptr.H8  := hadr;
	end;
    end; { next_baddr }

  function inbound_ready(info : lan_info_ptr;
			 var bufptr : gpaddr;
			 var size   : shortint):boolean;
    var
      done    : boolean;
      result  : scan_result_type;

    begin
      done := FALSE;
      INBOUND_READY := FALSE;
      with info^ do
      repeat
	result := scan_inbound(info,size);
	case result of
	  scan_error :
	    skip_bad_frame(info);
	  scan_ok    :
	    begin
	      if (size > lan_max_frame_len) or
		 (size < lan_min_frame_len) then
	      begin skip_bad_frame(info);
		    lan_stats^[lrx_other_err]:=lan_stats^[lrx_other_err]+1;
	      end
	      else
	      with rx_ring^ do
	      begin
		bufptr.int := 0;
		bufptr.L16 := ladr;
		bufptr.H8  := hadr;

		if last_rx_size=0 then
		with io_temps^ do
		begin  { user validation checks }
		  last_rx_size := size;
		  skip_bytes := 0;      { set defaults }
		  copy_bytes := size;
		  lan_stats^[lrx_no_errors]:=lan_stats^[lrx_no_errors]+1;
		  if perm_isr.dummy_pr<>nil then
		  begin
		    call(perm_isr.real_proc,bufptr.enh);{ give first rx buffer seg.}
		  end
		  else
		  if user_isr.dummy_pr<>nil then
		  begin
		    call(user_isr.real_proc,bufptr.enh);{ give first rx buffer seg.}
		  end;
		end; { with io_temps }

		if copy_bytes=0 then skip_frame(info)
		else
		begin INBOUND_READY := TRUE;
		      done := TRUE;
		end;
	      end; { with rx_ring }
	    end; {scan_ok}
	  scan_done :
	    done := TRUE; { no frames ready }
	end; { case }
      until done;
    end; {inbound_ready}

  procedure lan_read_buffer(info : lan_info_ptr);
    var
      size,bsize  : shortint;
      baddr   : gpaddr;
      ring    : rx_ring_elt_ptr;
      working,
      target  : BUFxINFOxPTR;
      io_info : pio_tmp_ptr;
      ibp     : bp;

    function move_data_to: BUFxINFOxPTR;
      var demux : boolean;
      begin
	move_data_to := nil;
	if inbound_ready(info,baddr,size) then
	begin
	  demux := false;
	  if lmpx_info<>nil then
	    if lmpx_info^.
	       isc_iompx_table[io_info^.my_isc].checkers<>nil then
	    begin
	      move_data_to := info^.driver_buffer;
	      demux := true;
	    end;
	  if not demux then
	  begin
	    with io_info^ do
	    begin
	      if (in_bufptr<>nil) then
	      begin
		if (bp(in_bufptr)^.active_isc<>no_isc)
		then
		  move_data_to := in_bufptr
		else
		  while inbound_ready(info,baddr,size) do
			skip_frame(info);
	      end
	      else
		while inbound_ready(info,baddr,size) do
		      skip_frame(info);
	    end;
	  end;
	end;
      end; { move_data_to }

    begin { lan_read_buffer }
      io_info := info^.io_temps;
      working := move_data_to;
      while working<>nil do
      begin
	with info^, working^ do
	begin
	  { move data from card buffer(s) to user buffer }
	  { adjust term_count (available buffer capacity)
	       and size       (bytes to move from card) }
	  term_char := lb_eot; { assume normal completion }
	  if term_count>=size then term_count := size
			      else begin size := term_count;
					 term_char := lb_short;
				   end; {data was lost}
	  ring := rx_ring;
	  { assumed that skip_bytes is <= size }
	  { this is enforced by L_SKIP_BYTES and inbound_ready }
	  while skip_bytes>0 do
	  begin
	    if size > rx_buffer_size then bsize := rx_buffer_size
				     else bsize := size;
	    if skip_bytes<bsize then
	    begin
	      ibp := baddr.ptr;
	      ibp := ADDR(ibp^,skip_bytes);
	      moveleft(ibp^,cp(buf_fill)^,bsize-skip_bytes);
	      buf_fill := ADDR(cp(buf_fill)^,bsize-skip_bytes);
	    end;
	    size := size - bsize;
	    skip_bytes := skip_bytes - bsize;
	    if size>0 then next_baddr(info,ring,baddr);
	  end;

	  while size>0 do
	  begin
	    if size > rx_buffer_size then bsize := rx_buffer_size
				     else bsize := size;
	    moveleft(cp(baddr.ptr)^,cp(buf_fill)^,bsize);
	    buf_fill := ADDR(cp(buf_fill)^,bsize);
	    size := size - bsize;
	    if size>0 then next_baddr(info,ring,baddr);
	  end;
	  skip_frame(info);         { let the card have its buffer(s) back }

	  with io_info^ do
	  if working=in_bufptr then
	  begin
	    in_bufptr := nil;                  { disconnect the users buffer }
	    active_isc := no_isc;              { un_busy the buffer }
	    TRY
	      if eot_proc.dummy_pr<>nil then   { call the buffers eot proc }
	       call (eot_proc.real_proc,working);
	    RECOVER begin end;
	  end
	  else
	  begin
	    { call scanner giving the working buffer pointer
	      and a var target buffer pointer.
	      The scanner is to return target as nil (unable to find a buffer)
	      or pointing to a buffer which has the data already copied to it.
	      The target buffer could be in_bufptr. }
	    call(lmpx_info^.iompx_scanner,working,target);
	    if target<>nil then
	    with target^ do
	    begin
	      if working^.term_count=0 then term_char := lb_eot
				       else term_char := lb_short;
	      if target=in_bufptr then in_bufptr:=nil;
	      active_isc := no_isc;
	      TRY
		if eot_proc.dummy_pr<>nil then   { call the buffers eot proc }
		 call (eot_proc.real_proc,target);
	      RECOVER begin end;
	    end;
	    with BUFxINFOxPTR(driver_buffer)^ do
	    begin {reset & re-activate the driver buffer}
	      buf_fill := buf_ptr; buf_empty := buf_ptr;
	      term_count := lan_max_frame_len;
	      active_isc := my_isc;
	    end;
	  end; { with io_info^ ... }
	end; { with info^, working etc.. }
	working := move_data_to;
      end; { while working<>nil }
    end; { lan_read_buffer }

  function check_out(io_info : pio_tmp_ptr):boolean;
    var
      info : lan_info_ptr;
      card : card_base_ptr;
      ubuf : bp;
    begin { check_out }
      CHECK_OUT := FALSE;
      info := ADDR(io_info^.drv_misc);
      card := io_info^.card_addr;
      with info^, tx_ring_l^ do
      if not own then { if LANCE does not own it then continue }
      begin
	ubuf := tx_user_buffs^[tx_ub_out];
	CHECK_OUT := TRUE;
	if ERR then
	begin
	  { tranmission failed }
	  if ubuf<>nil then ubuf^.term_char := lb_tx_error;
	  if LCOL then lan_stats^[ltx_lcol_err] := lan_stats^[ltx_lcol_err]+1;
	  if LCAR then lan_stats^[ltx_lcar_err] := lan_stats^[ltx_lcar_err]+1;
	  if RTRY then lan_stats^[ltx_retry_err] := lan_stats^[ltx_retry_err]+1;
	  if UFLO then
	  begin { semi nasty failure }
	    lan_stats^[ltx_uflo_err] := lan_stats^[ltx_uflo_err]+1;
	    card_reset(info,card);
	    card_start(io_info);
	    CHECK_OUT := FALSE;
	    ubuf := nil;
	  end;
	end
	else
	begin { packet was sent }
	  if ubuf<>nil then ubuf^.term_char := lb_eot; { packet was sent }
	  if ONE then lan_stats^[ltx_one] := lan_stats^[ltx_one]+1
	  else
	  if MORE then lan_stats^[ltx_more] := lan_stats^[ltx_more]+1
	  else
	  if NOT DEF then
	     lan_stats^[ltx_no_errors] := lan_stats^[ltx_no_errors]+1;
	  if DEF then lan_stats^[ltx_def] := lan_stats^[ltx_def]+1;
	end;
	if ubuf<>nil then
	with ubuf^ do
	begin
	  tx_user_buffs^[tx_ub_out]:=nil;
	  active_isc := no_isc;  { no longer busy }
	  TRY
	    if eot_proc.dummy_pr<>nil then call(eot_proc.real_proc,ubuf);
	  RECOVER begin end;
	end;
	tx_ub_out := (tx_ub_out+1) mod max_ring_elts;
      end; { with ... }
    end; { check_out }

  procedure de_allocate(info:lan_info_ptr);
    begin
      with info^ do
      begin
	with tx_ring_l^ do
	begin
	  tx_count := tx_count - 1;
	  if tx_count=0 then
	  begin
	    tx_next := txd_1; { reset to start of tx_buffer space }
	    tx_used := tx_next;
	  end
	  else
	  begin
	    tx_used.int := 0;
	    tx_used.L16 := ladr;
	    tx_used.H8 := hadr;
	    tx_used.int := tx_used.int - bcnt; { bcnt is always negative }
	  end;
	end;
	tx_ring_l := ADDR(tx_ring_l^,sizeof(tx_ring_elt_type));
	if tx_ring_l=txr_n then tx_ring_l:=txr_1;
      end;
    end; {de_allocate}

  procedure lan_isr(isribptr: pisrib);
    var
      io_info : pio_tmp_ptr;
      info    : lan_info_ptr;
      card    : card_base_ptr;
      stat    : csr0_type;
      status  : rx_status_type;
      done    : boolean;

    begin { lan_isr }
      io_info := ADDR(isribptr^);
      info := ADDR(io_info^.drv_misc);
      card := io_info^.card_addr;
      with card^ do
      begin
	if sc_reg.jab then
	begin { nasty failure }
	  card_reset(info,card);
	  card_start(io_info);
	end;
	stat := read_csr0(info^,card);
	write_rdp(info^,card,w_or(stat.uw,CSR0_INTR_ACK.uw));
	with stat do
	if ERR then
	with info^ do
	begin
	  if MERR then lan_stats^[lhw_merr] := lan_stats^[lhw_merr]+1;
	  if BABL then lan_stats^[lhw_babl] := lan_stats^[lhw_babl]+1;
	  if CERR then lan_stats^[ltx_no_heart] := lan_stats^[ltx_no_heart]+1;
	  if MISS then lan_stats^[lrx_miss_err] := lan_stats^[lrx_miss_err]+1;
	  if (MERR or BABL) then
	  begin { fatal failure }
	    card_reset(info,card);
	    card_state := cs_hw_failed;
	    clean_up(io_info,info,lb_hw_failed,lan_all_io);
	    escape(0); { get out now }
	  end;
	end;
	with info^ do
	begin
	 { check for out going data }
	  done := tx_count=0;
	  while not done do
	  begin
	    if check_out(io_info) then
	    begin
	      de_allocate(info); {return space to pool}
	      done := tx_count=0;
	    end
	    else done := TRUE;
	  end;
	 { try to read any input }
	  lan_read_buffer(info);
	 { check to see if the card should be re-started/re-configured }
	  if do_card_start then card_start(io_info);
	end; { with info }
      end; { with card }
    end; { lan_isr }

  procedure lan_rds(temp : ANYPTR; reg : io_word; var v: io_word);
  { READ CARD REGISTERS }
    type
      cp       = ^char;
      int_wrd  = record
		   case boolean of
		   TRUE :(i:integer);
		   FALSE:(w1:io_word; w2:io_word);
		 end;
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      card     : card_base_ptr;
      lreg     : int_wrd;
      i        : integer;

      function get_hl(anyvar val:int_wrd; high:boolean):io_word;
	begin
	  if high then get_hl := val.w1
		  else get_hl := val.w2;
	end;
    begin
      io_info := temp;
      with io_info^ do
      begin
	info := ADDR(drv_misc);
	card := card_addr;
	lreg.w1 := 0;
	lreg.w2 := reg;
	with info^ do
	case lreg.i of
	L_GET_INTLEVEL: v := card_intlevel;
	L_CARD_STATE  : v := ord(card_state);
	L_RECONFIG    : v := ord(do_card_start);
	L_MODE        : v := init_block.mode.all;
	L_NUM_RX_BUFS : v := num_rx_buffers;
	L_RX_BUF_SIZE : v := rx_buffer_size;
	L_NUM_TX_BUFS : v := num_tx_buffers;
	L_GET_TX_BUF_SIZE: v := tx_buffer_size;
	L_GET_STATS_LSW: v := get_hl(lan_stats,false);
	L_GET_STATS_MSW: v := get_hl(lan_stats,true);
	L_GET_FRAME_SIZE: v := last_rx_size;
	L_LINK_ADDR1..L_LINK_ADDR1+5:
			v := ord(local_link_address[reg-20]);
	L_INPUT_BUSY  : v := ord(in_bufptr<>nil);
	L_OUTPUT_BUSY : v := ord(out_bufptr<>nil);

	otherwise
	  if (reg>=L_MMASK0) and
	     (reg<=L_MMASK0+63) then
	    begin
	      reg := reg-L_MMASK0;
	      if (reg mod 16) > 7 then reg := reg-8
				  else reg := reg+8;
	      v := ord(init_block.ladrf.bits[reg]);
	    end
	  else io_escape(ioe_rds_wtc,io_info^.my_isc);
	end; { case }
      end;
    end; { lan_rds }

  procedure init_lan_stats(var stats:lan_stats_data);
    var i : lan_stats_type;
    begin
      for i := lhw_merr to ltx_retry_err do stats[i]:=0;
    end;

  procedure lan_wtc(temp : ANYPTR; reg : io_word; v: io_word);
  { WRITE TO CARD REGISTERS }
    type
      cp       = ^char;
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      card     : card_base_ptr;
      lreg     : record
		   case boolean of
		   TRUE :(i:integer);
		   FALSE:(w1:io_word; w2:io_word);
		 end;
      i        : integer;

    procedure fake_interrupt;
      var
	old_level : integer;
      begin
	old_level := intlevel;
	if old_level<info^.card_intlevel then
	begin
	   setintlevel(info^.card_intlevel);
	   TRY
	     lan_isr(pisrib(io_info)); { call the isr procedure }
	   RECOVER begin end;
	   setintlevel(old_level);
	end;
      end; { fake interrupt }

    begin
      io_info := temp;
      with io_info^ do
      begin
	info := ADDR(drv_misc);
	card := card_addr;
	lreg.w1 := 0; { do unsigned extension }
	lreg.w2 := reg;
	with info^ do
	case lreg.i of
	L_CARD_STATE:
	  begin
	    if v=ord(cs_card_reset) then card_reset(info,card)
	    else
	    if v=ord(cs_lance_ready) then
	    begin do_card_start := true;
		  fake_interrupt;
	    end;
	    { ignore anything else }
	  end;
	L_FORCE_INTERRUPT: fake_interrupt;
	L_RECONFIG      : do_card_start := v<>0;
	L_MODE          : init_block.mode.all := v;
	L_NUM_RX_BUFS   : num_rx_buffers := v;
	L_RX_BUF_SIZE   : rx_buffer_size := v;
	L_NUM_TX_BUFS   : num_tx_buffers := v;
	L_SET_MULTICAST_ALL:begin {set/clear all multicast mask bits}
			      if v<>0 then v := -1; { all ones }
			      init_block.ladrf.int1 := v;
			      init_block.ladrf.int2 := v;
			    end;
	L_INIT_STATS    : init_lan_stats(lan_stats^);
	L_REJECT_FRAME  : copy_bytes := 0;   { used to signal packet reject }
	L_LINK_ADDR1..L_LINK_ADDR1+5:
			  local_link_address[reg-20] := chr(v);
	L_SET_UISR      : perm_isr := io_info^.user_isr;
	L_CLEAR_UISR    : perm_isr.dummy_pr := nil;
	L_ABORT         : begin{ L_INPUT, L_OUTPUT, L_ALL_IO }
			    case v of
			      L_INPUT : clean_up(io_info,info,lb_abort,lan_input);
			      L_OUTPUT: clean_up(io_info,info,lb_abort,lan_output);
			      L_ALL_IO: clean_up(io_info,info,lb_abort,lan_all_io);
			      otherwise
				io_escape(ioe_misc,io_info^.my_isc);
			    end;
			  end;
	L_SET_MMASK,
	L_CLR_MMASK     : begin
			    if (V<0) or (V>63) then io_escape(ioe_misc,io_info^.my_isc);
			    if (V mod 16) > 7 then V := V-8
					      else V := V+8;
			    init_block.ladrf.bits[V]:=(lreg.i=L_SET_MMASK);
			  end;
	L_SET_DEFAULT_CONFIG :
	   begin
	     if hw_read_local_address(card^,local_link_address) then
	     begin
	       init_block.mode.ALL := default_mode;      { prom. etc. all false }
	       init_block.ladrf    := init_ladrf; { initialize the filter to all zeroes }
	       {set rcv variables}
	       rx_buffer_size := default_rx_buffer_size;
	       num_rx_buffers := default_num_rx_buffers;
	       {set tx variables}
	       num_tx_buffers := default_num_tx_buffers;
	       init_lan_stats(lan_stats^);
	     end
	     else
	     begin
	       card_reset(info,card);
	       card_state := cs_hw_failed;
	       clean_up(io_info,info,lb_hw_failed,lan_all_io);
	       io_escape(ioe_crd_dwn,io_info^.my_isc);
	     end;
	   end;
	L_SKIP_BYTES    : begin { called from user_isr or perm_isr }
			    if v<0 then io_escape(ioe_misc,io_info^.my_isc);
			    if v>=copy_bytes then copy_bytes := 0
					     else begin skip_bytes := v;
							copy_bytes := copy_bytes-v;
						  end;
			  end;
	otherwise
	  io_escape(ioe_rds_wtc,io_info^.my_isc);
	end; { case }
      end;
    end; { lan_wtc }

  procedure lan_write_buffer(info : lan_info_ptr);
    type
      cp = ^char;
    var
      ubufptr   : bp;
      required  : integer;
      avail1,avail2 : integer;
      old_level,hi_level : integer;
      card      : card_base_ptr;

    begin { lan_write_buffer }
      old_level := intlevel;
      TRY
	with info^, io_temps^ do
	begin
	  lan_stats^[ltx_requests]:=lan_stats^[ltx_requests]+1;
	  if old_level>card_intlevel then hi_level := old_level
				     else hi_level := card_intlevel;
	  ubufptr := out_bufptr; { snapshot out_bufptr }
	  if ubufptr=nil then escape(0); { request aborted }

	  card := card_addr;
	  if ubufptr^.term_count<lan_min_frame_len
	     then required := lan_min_frame_len
	     else required := ubufptr^.term_count;
	  repeat { until allocation is ok }
	    if required>tx_buffer_size then
	       io_escape(ioe_no_space,io_temps^.my_isc); { will never ever fit }
	    repeat { wait for a ring element and enough space to free up }
	      setintlevel(hi_level); { block ISR during space check }
	      if out_bufptr=nil then escape(0); { request aborted }
	      alloc_ok := false;
	      if tx_count=0 then
	      begin
		avail1 := tx_buffer_size;
		avail2 := 0;
	      end
	      else
	      if tx_next.int>tx_used.int then
	      begin
		avail1 := txd_n.int-tx_next.int;
		avail2 := tx_used.int-txd_1.int;
	      end
	      else
	      begin
		avail1 := tx_used.int-tx_next.int;
		avail2 := 0;
	      end;
	      alloc_ok := (tx_count<num_tx_buffers) and
			  ((avail1>=required) or (avail2>=required));
	      setintlevel(old_level); { let ISR run again }
	      if not alloc_ok then
	      with card^ do
	      begin
		if old_level>=card_intlevel then
		begin
		  repeat until sc_reg.ir;    { wait for interrupt request }
		  TRY
		    lan_isr(pisrib(io_temps)); { call the ISR procedure }
		  RECOVER begin end;
		end;
	      end;
	    until alloc_ok;
	    setintlevel(hi_level);      { block ISR until pointers are set }
	    if out_bufptr=nil then escape(0);            { request aborted }
	    if not alloc_ok then setintlevel(old_level); { let ISR run }
	  until alloc_ok;

	  { move from ram to the allocated space on the card }
	  with bp(out_bufptr)^ do
	  begin
	    if avail1<required then tx_next := txd_1;
	    moveleft(cp(buf_empty)^,cp(tx_next.ptr)^,term_count);
	  end;

	  with tx_ring_f^ do
	  begin
	    bcnt := - required;
	    tmd3 := TMD3_RETURN;
	    ladr := tx_next.L16;
	    hadr := tx_next.H8;
	    tmd1_0 := tmd1_0_return; { set own stp enp to let card have it }
	  end;

	  TX_COUNT := TX_COUNT + 1;

	  tx_next.int := tx_next.int + required;
	  if tx_next.int>=txd_n.int then tx_next := txd_1;

	  tx_ring_f := ADDR(tx_ring_f^,sizeof(tx_ring_elt_type));
	  if tx_ring_f = txr_n then tx_ring_f := txr_1;

	  with bp(out_bufptr)^ do
	  if eot_proc.dummy_pr=nil then
	  begin { cleanup & disconnect now if no eot_proc }
	    term_char  := lb_eot;
	    active_isc := no_isc;
	    out_bufptr := nil;
	  end;

	  tx_user_buffs^[tx_ub_in] := out_bufptr;
	  tx_ub_in := (tx_ub_in+1) mod max_ring_elts;
	  out_bufptr := nil;      { disconnect user buffer }
	  setintlevel(old_level); { clean up intlevel }
	end; { with info^ ... }
      RECOVER
	begin
	  setintlevel(old_level);
	  if escapecode<>0 then escape(escapecode);
	end;
      { call outbuf_proc if out_bufptr is nil }
      with info^, io_temps^ do
      begin
	if out_bufptr=nil then
	  if outbuf_proc.dummy_pr<>nil then
	    call(outbuf_proc.real_proc,my_isc);
      end;
    end; { lan_write_buffer }

  procedure lan_tfr(temp : ANYPTR; v : ANYPTR);
    label 1;
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      buffer   : BUFxINFOxPTR;
      utimer   : timer_rec;
      u_reg_rec: iompx_rec_ptr;
      continue : boolean;
      need_reg : boolean; { buffer must be registered }
    begin
      io_info := temp;
      info    := ADDR(io_info^.drv_misc);
      buffer  := v;
      with io_info^, buffer^ do
      begin
	need_reg := (usr_tfr=dummy_tfr_1) or (usr_tfr=dummy_tfr_2);
	if need_reg then
	begin
	  if (lmpx_info=nil) then io_escape(ioe_no_driver,my_isc)
	  else
	  if act_tfr<>no_tfr then io_escape(ioe_bad_tfr,my_isc);
	end;

	term_char := lb_pending;  { set for eot proc use }
	if info^.card_state<>cs_lance_ready then
	begin
	  if direction = to_memory then in_bufptr := nil
				   else out_bufptr:= nil;
	  term_char := lb_hw_failed;
	  io_escape(ioe_crd_dwn,my_isc);
	end;

	if (direction=from_memory) and (lmpx_info<>nil) then
	begin
	  if (act_tfr=no_tfr) or need_reg then
	  begin
	    call(lmpx_info^.find_iompx_buf,
		 my_isc,direction,buffer^,u_reg_rec);
	    if u_reg_rec<>nil then
	      with u_reg_rec^ do
	      begin
		if not need_reg then out_bufptr := nil;
		call(ops_proc,u_reg_rec,continue);
		if continue then out_bufptr := v
			    else goto 1; { all done }
	      end
	    else { buffer not registered }
	    if need_reg then io_escape(ioe_bad_tfr,my_isc);
	  end;
	end;

	if direction=to_memory then
	begin { read }
	  { is this a registered buffer ? }
	  if lmpx_info<>nil then
	    call(lmpx_info^.find_iompx_buf,
		 my_isc,direction,buffer^,u_reg_rec)
	  else u_reg_rec := nil;

	  { for optional registered buffers, free in_bufptr now
	    for required reqisteded buffers, ignore in_bufptr
	    then give the ops_proc (checker) a chance to
	    supply the data.
	  }
	  if u_reg_rec<>nil then
	  begin
	    with u_reg_rec^ do
	    begin
	      if not need_reg then in_bufptr := nil;
	      in_buffer := nil; { signal, call comming from iod_tfr }
	      call(ops_proc,u_reg_rec,continue);
	    end
	  end
	  else
	  if need_reg then io_escape(ioe_bad_tfr,my_isc)
		      else continue := true;

	  if continue then
	  begin { data to come from ISR }
	    active_isc := my_isc; { let ISR use the buffer }
	    { If the read has not been satisfied
	      and there is data in card buffer(s)
	      then force an interrupt to get data moveing. }
	    if (in_bufptr<>nil) then
	      if iostatus(my_isc,L_GET_FRAME_SIZE)<>0 then
		  iocontrol(my_isc,L_FORCE_INTERRUPT,0);
	  end
	  else
	  begin { ops_proc supplied the data }
	    if term_count=0 then term_char := lb_eot
			    else term_char := lb_short;
	    TRY
	      if eot_proc.dummy_pr<>nil then   { call the buffers eot proc }
	       call (eot_proc.real_proc,buffer);
	    RECOVER begin end;
	    goto 1;  { all done }
	  end;
	end { read }
	else
	begin { write }
	  active_isc := my_isc; { show transfer in progress }
	  lan_write_buffer(info);
	end; { write }

	{ check requested tfr mode and either wait or continue }
	if (usr_tfr<=serial_fastest) then
	begin { serial transfer }
	  if timeout=0 then repeat until active_isc=no_isc
	  else
	  begin
	    utimer.time := timeout;
	    start_timer(utimer);
	    repeat until (active_isc=no_isc) or time_expired(utimer);
	    if active_isc<>no_isc then io_escape(ioe_timeout,my_isc);
	  end;
	end;
	{ else overlapped transfer }
      end; { with io_info^, buffer^ }
    1:
    end; { lan_tfr }

  function lan_setup(sc : integer):boolean;
  { this procedure is used only during powerup }
    var
      info : lan_info_ptr;
      card : card_base_ptr;
      i,nb : integer;
      d_buf: BUFxINFOxPTR;
    begin
      info := ADDR(isc_table[sc].io_tmp_ptr^.drv_misc);
      card := isc_table[sc].io_tmp_ptr^.card_addr;
      with info^, init_block do { init_block here is in temp area }
      begin
	if hw_read_local_address(card^,local_link_address) then
	begin
	  card_state := cs_pre_init;
	  mode.ALL := default_mode;             { prom etc all false }
	  { copy link address to the init block }
	  { NOTE byte swapping }
	  padr[1]:=local_link_address[2];
	  padr[2]:=local_link_address[1];
	  padr[3]:=local_link_address[4];
	  padr[4]:=local_link_address[3];
	  padr[5]:=local_link_address[6];
	  padr[6]:=local_link_address[5];
	  ladrf:= init_ladrf; { initialize the filter to all zeroes }
	  {set rcv variables}
	  rx_buffer_size := default_rx_buffer_size;
	  num_rx_buffers := default_num_rx_buffers;
	  {set tx variables}
	  num_tx_buffers := default_num_tx_buffers;
	  {set default interface hooks}
	  io_temps := isc_table[sc].io_tmp_ptr;
	  card_intlevel := card^.sc_reg.intlevel+3;
	  do_card_start := FALSE; { card init block etc & copy are same }
	  new(lan_stats);
	  init_lan_stats(lan_stats^);
	  new(tx_user_buffs);
	  for i := 0 to max_ring_elts-1 do tx_user_buffs^[i]:=nil;
	  tx_ub_in := 0; tx_ub_out := 0;
	  perm_isr.dummy_pr := nil;
	  outbuf_proc.dummy_pr := nil;
	  new(d_buf);
	  newbytes(d_buf^.buf_ptr,lan_max_frame_len);
	  with d_buf^ do
	  begin {init. the driver buffer}
	    buf_fill := buf_ptr; buf_empty := buf_ptr;
	    term_count := lan_max_frame_len;
	    active_isc := sc;
	  end;
	  driver_buffer := d_buf;
	end
	else card_state := cs_hw_failed;
      end; {with}
      with isc_table[sc] do
      begin { hook up the drivers }
	new(io_drv_ptr);
	io_drv_ptr^ := dummy_drivers;
	with io_drv_ptr^ do
	begin
	  iod_init := lan_init;
	  iod_isr  := lan_isr;
	  iod_rds  := lan_rds;
	  iod_wtc  := lan_wtc;
	  iod_tfr  := lan_tfr;
	end;
      end;
      lan_setup := info^.card_state=cs_pre_init;
    end; {lan_setup}

  function laninit(var ehp:anyptr):boolean;
    var
      sc, i    : integer;
      lan_card : card_base_ptr;
      ok       : boolean;
      cp       : ^char;

    begin { laninit }
      { scan selectcode table for LAN cards }
      ok := false;
      for sc := iominisc to iomaxisc do
      with isc_table[sc] do
      begin
	if (card_type=other_card) and
	   ((card_id=0) or (card_id=hp98643)) then
	begin
	  lan_card := card_ptr;
	  if (lan_card^.id_reg.idb mod 128) = hp98643 then
	  begin
	    card_id := hp98643; { fix it }
	    TRY { has this card been setup already ? }
	      i := iostatus(sc,l_reconfig);
	      { if the above call worked then driver is already setup }
	    RECOVER
	    { check escape code etc.}
	    if (escapecode=ioescapecode) and
	       (ioe_result=ioe_no_driver) then
	    begin
	      { fixup the heap as required }
	      mark(cp);
	      if ord(cp)<ord(ehp) then release(ehp);
	      { init the dvr_temp area }
	      if lan_setup(sc) then
	      begin
		{ hook in the isr }
		permisrlink(io_drv_ptr^.iod_isr,        { isr }
			    ADDR(lan_card^.sc_reg,1),   { interrupt reg }
			    hex('C0'),hex('C0'),        { mask and value }
			    lan_card^.sc_reg.intlevel+3,{ interrupt priority }
			    ADDR(io_tmp_ptr^.myisrib)); { isr info pointer }
		{ start the card }
		card_start(io_tmp_ptr);
		ok := true;
	      end;
	    end;
	  end;
	end;
      end;
      laninit := ok;
      if ok then io_revid := io_revid + ' L3.22';
    end; { laninit }

  END; { LANDVR }
  { program LANIO }
  IMPORT
    loader, landvr;
  BEGIN
    if laninit(eheap) then markuser;
  END.
@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 1455
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1455
$MODCAL$
PROGRAM LAN(INPUT,OUTPUT);
$DEBUG OFF$ $RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
{ bug fix/changes  history
  disallowed dummy_tfr_1 and dummy_tfr_2 transfer requests.
  3.22A
  fixed MOVE_DATA_TO to also discard input if in_bufptr=nil.
  added code in LAN_INIT to fix the heap pointer.
  added code in LAN_TFR to call OPS_PROCS for TO_MEMORY
    transfers.  Gives an OPS_PROC a chance to supply data
    immediately.
  3.22C
  in LAN_TFR defined dummy_tfr_1 and dummy_tfr_2 to mean than
  the buffer involved must be registered.
  for these 'must be registered' type transfers,
    for from_memory transfers, OUT_BUFPTR is still used/required
    for to_memory transfers, IN_BUFPTR is ignored.
}

MODULE LANDVR;
$SEARCH 'LANDECS','LANASM','IOLIB:KERNEL.CODE'$
IMPORT  SYSGLOBALS, IODECLARATIONS, GENERAL_0,
	ASM, LANDECS, LANASM, ISR;

EXPORT
  function laninit(var ehp:anyptr):boolean;

IMPLEMENT
  $INCLUDE 'IOMPXDECS.TEXT'$
  $LINENUM 2000$
  CONST
    ack_timeout_count = 1000;     { just a count }
    init_timeout      = 30;       { milli secs }

    init_ladrf    = ladrf_type[int1 : 0,int2 : 0];
    rmd1_0_init   = HEX('80'); { sets OWN, clears others }
    clear_mcnt    = 0;
    tmd1_0_init   = 0; { clears OWN & all others }
    tmd1_0_return = HEX('83'); { sets OWN, STP & ENP }
    tmd3_return   = 0; { clears all bits }
    csr0_init     = csr0_type[ ERR :false, BABL:TRUE , CERR:TRUE , MISS:TRUE,
			       MERR:TRUE , RINT:TRUE , TINT:TRUE , IDON:TRUE,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:TRUE , INIT:TRUE ];

    csr0_init_ack = csr0_type[ ERR :false, BABL:TRUE , CERR:TRUE , MISS:TRUE ,
			       MERR:TRUE , RINT:TRUE , TINT:TRUE , IDON:TRUE ,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:false, INIT:false];

    csr0_start    = csr0_type[ ERR :false, BABL:TRUE , CERR:TRUE , MISS:TRUE,
			       MERR:TRUE , RINT:TRUE , TINT:TRUE , IDON:TRUE,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:TRUE , INIT:false];

    csr0_intr_ack = csr0_type[ ERR :false, BABL:false, CERR:false, MISS:false,
			       MERR:false, RINT:false, TINT:false, IDON:TRUE,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:false, STOP:false, STRT:false, INIT:false];

    tdmd_inea     = csr0_type[ ERR :false, BABL:false, CERR:false, MISS:false,
			       MERR:false, RINT:false, TINT:false, IDON:false,
			       INTR:false, INEA:TRUE , RXON:false, TXON:false,
			       TDMD:TRUE , STOP:false, STRT:false, INIT:false];
  type
    scan_result_type = (scan_ok, scan_done, scan_error, scan_nop);
    isr_tx_status_type = (isr_tx_done,isr_tx_none,isr_tx_retry);
    io_wp = ^io_word;
    bp = ^buf_info_type;
    cp = ^char;
    fp = ^frame_type;
    frame_type = packed array[1..lan_max_frame_len] of char;
    term_char_type = -1..255;
    ioclass = (lan_input,lan_output,lan_all_io);
  var
    lmpx_info : iompx_info_ptr;

  function read_csr0(var info : lan_info_rec;
			 card : card_base_ptr):csr0_type;
    var
      tcount  : integer;
    begin { Read the RDP register on the LANCE }
      tcount := ack_timeout_count;
      with info, card^ do
      begin
	repeat
	  READ_CSR0 := rdp.csr0;
	  tcount := tcount - 1;
	until sc_reg.ack or (tcount<=0) ;
	if not sc_reg.ack then
	begin
	  card_state   := cs_ack_error;
	  id_reg.reset := 1; { reset the card }
	  READ_CSR0.UW := 0; { no status info }
	end;
      end; { with }
    end; { read_csr0 }

  procedure write_rdp(var info : lan_info_rec;
			  card : card_base_ptr;
			  data : unsword);
    var
      tcount : integer;
    begin { Write the RDP register on the LANCE }
      tcount := ack_timeout_count;
      with info, card^ do
      begin
	repeat
	  rdp.uw := data;
	  tcount := tcount - 1;
	until sc_reg.ack or (tcount<=0);
	if not sc_reg.ack then
	begin
	  card_state := cs_ack_error;
	  id_reg.reset := 1;  { reset the card }
	end;
      end; { with }
    end; { write_rdp }

  procedure clean_up(io_info : pio_tmp_ptr;
			info : lan_info_ptr;
			  tc : term_char_type;
		       class : ioclass);
  { called only when tc = lb_abort, lb_reset or lb_hw_failed }
    var
      i : integer;
      can_continue : boolean;
      tempbp: ^buf_info_type;
      next1,
      next2 : iompx_rec_ptr;
      ans   : iompx_ans_rec;

    begin { clean_up }
      { check for IOMPX availability }
      if lmpx_info=nil then
      begin
	call(io_error_link,iompx_request,ans.s);
	if ans.s=iompx_answer then
	begin
	  lmpx_info := ans.ptr;
	  lmpx_info^.isc_iompx_table[io_info^.my_isc].capable := true ;
	end;
      end;
      with io_info^ do
      begin
	{ clean up input side }
	{ can continue from aborts and resets }
	if class<>lan_output then
	begin
	  if in_bufptr<>nil then
	  with bp(in_bufptr)^ do
	  begin
	    term_char := tc;
	    TRY
	      if eot_proc.dummy_pr<>nil then
		call(eot_proc.real_proc,in_bufptr);
	    RECOVER
	      term_char := lb_abort; { cancel the transfer }

	    can_continue := (tc=lb_abort) or (tc=lb_reset);
	    if not (can_continue and
	      ((term_char=lb_pending) or (term_char=lb_reset))) then
	    begin in_bufptr := nil;
		  active_isc:=no_isc;
	    end;
	  end;
	  { now check for registered buffers }
	  if lmpx_info<>nil then
	  begin
	    next1 := lmpx_info^.isc_iompx_table[my_isc].checkers;
	    while next1<>nil do
	    with next1^, user_buffer^ do
	    begin
	      next2 := next; { eot proc may decide to un-register }
	      if active_isc<>no_isc then
	      begin
		term_char := tc;
		TRY
		  if eot_proc.dummy_pr<>nil then
		    call(eot_proc.real_proc,user_buffer);
		RECOVER
		  begin end;
	      end;
	      next1 := next2;
	    end; { while .. with next1 }
	  end;
	end;

	{ clean up output side }
	{ can continue from aborts but not resets }
	{ allow re transmit on reset }
	if class<>lan_input then
	if out_bufptr<>nil then
	begin
	  tempbp := out_bufptr;
	  with tempbp^ do
	  begin
	    term_char  := tc;
	    out_bufptr := nil;    { dis-connect & de-activate }
	    active_isc := no_isc;
	    TRY
	      if eot_proc.dummy_pr<>nil then
		 call(eot_proc.real_proc,tempbp);
	    RECOVER
	      term_char := lb_abort;  { cancel the transfer }

	    if (tc=lb_abort) and (term_char=lb_pending) then
	    begin out_bufptr := tempbp; { re-connect and re-activate }
		  active_isc := my_isc;
	    end;
	  end;
	end;

      { notify all user buffers on the card of the request }
      { can continue from aborts but not resets or failures}
	if class=lan_all_io then
	for i := 0 to max_ring_elts-1 do
	begin
	  tempbp := info^.tx_user_buffs^[i]; { take a copy  }
	  info^.tx_user_buffs^[i] := nil;    { zap original }

	  if tempbp<>nil then
	  with tempbp^ do
	  begin
	    term_char := tc;
	    active_isc:= no_isc; { de-activate the buffer }
	    TRY
	      if eot_proc.dummy_pr<>nil then
		call(eot_proc.real_proc,tempbp);
	    RECOVER
	      term_char := lb_abort; { cancel the transfer }

	    if (term_char<>lb_pending) or (tc<>lb_abort)
	      then tempbp:=nil; { disconnect it }

	    { fix if call is abort }
	    if tc=lb_abort then info^.tx_user_buffs^[i]:=tempbp;
	  end;
	end;
      end;
      { try to call outbuf_proc }
      if tc<>lb_hw_failed then
      with info^, io_info^ do
      begin
	TRY
	  if out_bufptr=nil then
	    if outbuf_proc.dummy_pr<>nil then
	      call(outbuf_proc.real_proc,my_isc);
	RECOVER begin end;
      end;
    end; { clean_up }

  procedure card_start(io_info : pio_tmp_ptr);
    const
      p2 = #1#2#4#8#16#32#64#128;
    var
      card      : card_base_ptr;
      temp_addr : gpaddr;
      i,nb      : integer;
      info      : lan_info_ptr;
      rx_temp   : ^rx_buffers;
      tx_temp   : ^tx_buffers;
      done      : boolean;
      timeout   : timer_rec;
      csr0      : csr0_type;
      tc        : term_char_type;

    begin { card_start }
      info := ADDR(io_info^.drv_misc);
      card := io_info^.card_addr;
      with card^, info^ do
      if card_state<>cs_hw_failed then
      begin
      { ========== load the init block ========== }
       { reset the card so that handshake operations are not needed }
	id_reg.reset := 1;
	card_state := cs_card_reset;
	alloc_ok   := false; { set notice that output buffers
			       must be re-allocated }
      { set up LANCE registers 1, 2 and 3 }
	temp_addr.ptr := ADDR(ram_area.init_block);
	rap := 1;  { register 1 }
	rdp.uw := temp_addr.L16;
	rap := 2;  { register 2 }
	rdp.uw := temp_addr.H8;
	rap := 3;  { register 3 }
	rdp.uw := 4;  { bwsp=1, acon=0, bcon=0 }
	{ fill in the init_block pieces }
	TRY
	  with init_block do { temp init block }
	  begin
	    { note byte swapping }
	    padr[1]:=local_link_address[2];
	    padr[2]:=local_link_address[1];
	    padr[3]:=local_link_address[4];
	    padr[4]:=local_link_address[3];
	    padr[5]:=local_link_address[6];
	    padr[6]:=local_link_address[5];
	    i := num_rx_buffers*rx_buffer_size;
	    tx_buffer_size := memory_size
			     -init_size
			     -num_rx_buffers*sizeof(rx_ring_elt_type)
			     -num_tx_buffers*sizeof(tx_ring_elt_type)
			     -num_rx_buffers*rx_buffer_size;
	    if (tx_buffer_size < lan_max_frame_len ) or (i<lan_max_frame_len)
	      then escape(0); { buffer specs are messed up }

	    { point to the recive ring }
	      { fixup num_rx_buffers }
	    nb := 0;
	    for i := 1 to 8 do if num_rx_buffers>=ORD(p2[i]) then nb:=i-1;
	    num_rx_buffers := ORD(p2[nb+1]);
	    { recieve ring is the first part of buffers }
	    temp_addr.ptr := ADDR(ram_area.buffers);
	    rxr_1 := temp_addr.ptr;       {address of first rcv ring elt}
	    rx_temp := temp_addr.ptr;
	    rdraL := temp_addr.L16;
	    rdraH := temp_addr.H8;
	    rlen  := nb;
	    zip0  := 0;

	    { point to transmit ring }
	      { fixup num_tx_buffers }
	    nb := 0;
	    for i := 1 to 8 do if num_tx_buffers>=ORD(p2[i]) then nb:=i-1;
	    num_tx_buffers := ORD(p2[nb+1]);
	    { transmit ring is the second part of buffers }
	    temp_addr.int := temp_addr.int +
			     (num_rx_buffers*sizeof(rx_ring_elt_type));
	    rxr_n := temp_addr.ptr; { last + 1 rcv ring elt }
	    txr_1 := temp_addr.ptr; { first tx ring elt }
	    tx_ring_f := txr_1;
	    tx_ring_l := txr_1;
	    tx_temp := temp_addr.ptr;
	    tdraL := temp_addr.L16;
	    tdraH := temp_addr.H8;
	    tlen  := nb;
	    zip1  := 0;

	    { initialize the recieve ring }
	      { recieve buffers is the third part of buffers }
	    temp_addr.int := temp_addr.int +
			     (num_tx_buffers*sizeof(tx_ring_elt_type));
	    txr_n := temp_addr.ptr; {last + 1 tx ring elt}
	    for i := 1 to num_rx_buffers do
	      with rx_temp^[i] do
	      begin
		ladr  :=temp_addr.L16;
		hadr  :=temp_addr.H8;
		rmd1_0:=rmd1_0_init; { set own , clear all others }
		bcnt  :=-rx_buffer_size;
		mcnt  :=clear_mcnt;
		temp_addr.int := temp_addr.int+rx_buffer_size;
	      end; { for .. with }
	    rx_ring := rxr_1; { where to start looking for inbound messages }

	    { initialize the transmit ring }
	      { the trasmit buffer space is the fourth part of buffers }
	    for i := 1 to num_tx_buffers do
	      tx_temp^[i].tmd1_0 := tmd1_0_init;

	    { initialize the remaining pointers etc. }
	    txd_1.ptr := temp_addr.ptr; { first of tx buffer space }
	    temp_addr.int := temp_addr.int+tx_buffer_size;
	    txd_n.ptr := temp_addr.ptr; {last + 1 of tx buffer space}
	    tx_count := 0; { no outstanding tx requests }
	    tx_next.ptr := txd_1.ptr; { first usable space }
	    tx_used.ptr := nil;   { no used space }
	  end; { with init_block }

	RECOVER
	  card_state := cs_init_failed;

	if card_state=cs_card_reset then
	begin
	  {move the init_block from driver info to card ram_area }
	  ram_area.init_block:=init_block;
	  { start up the card }
	  rap := 0;
	  rdp.csr0 := csr0_init;
	  timeout.time := init_timeout; start_timer(timeout);
	  done := FALSE;
	  repeat
	    if sc_reg.ir then
	    begin
	      csr0 := read_csr0(info^,card);
	      if csr0.idon then
	      with csr0 do
	      begin
		if not (init and strt and txon and inea) then
		begin
		  id_reg.reset := 1;
		  io_escape(ioe_crd_dwn,io_info^.my_isc);
		end;
		{ acknowledge the init done }
		write_rdp(info^,card,csr0_init_ack.uw);
		done := TRUE;
		if card_state=cs_card_reset then card_state := cs_lance_ready;
	      end;
	    end;
	  until time_expired(timeout) or done;
	  if not done then
	  begin
	    id_reg.reset := 1;
	    card_state := cs_hw_failed;
	  end;
	  do_card_start := FALSE; { operation complete }
	  lan_stats^[lhw_restarts] := lan_stats^[lhw_restarts]+1;
	end; { if card_state .. }
	tx_ub_in := 0; tx_ub_out := 0; { reset tx user buffer control }
	last_rx_size := 0;      { no input frames available yet }
      end; { with card, info^ }
      { enable card interupts }
      if info^.card_state = cs_lance_ready then
      begin
	tc := lb_reset;
	card^.sc_reg.ie := TRUE;
      end
      else  tc := lb_hw_failed;

      { notify all user buffers of card reset/hw_failure }
      clean_up(io_info,info,tc,lan_all_io);
    end; { card_start }

  procedure card_reset(info : lan_info_ptr;
		       card : card_base_ptr);
    begin
      with card^ do
      begin
	id_reg.reset := 1;    { reset the card }
	sc_reg.control := 0;  { disable interupts }
      end;
      info^.card_state := cs_card_reset;
    end; { card_reset }

  procedure lan_init(temp : ANYPTR);
    { stop key/cleario/abort transfer }
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      old_level: integer;
    begin { lan_init }
      io_info := temp;
      with io_info^ do
      begin
	info := ADDR(drv_misc);
	old_level := intlevel;
	if old_level<info^.card_intlevel then
	begin { only do this if intlevel lower than card intlevel }
	  setintlevel(info^.card_intlevel);
	  clean_up(io_info,info,lb_abort,lan_all_io);
	  setintlevel(old_level);
	end;
      end;
    end; { lan_init }

  procedure skip_bad_frame(info : lan_info_ptr);
    { throws away the frame pointed to by rx_ring }
    { assumes that host owns at least the first element }
    begin
      with info^ do
      begin
	last_rx_size := 0;
	repeat
	  with rx_ring^ do
	  begin
	    mcnt   := clear_mcnt;
	    rmd1_0 := rmd1_0_init; { set own clear others }
	    { setup for next ring element }
	    rx_ring := ADDR(rx_ring^,sizeof(rx_ring_elt_type));
	    if rx_ring = rxr_n then rx_ring := rxr_1;
	  end;
	  { check this next ring element }
	until rx_ring^.stp or rx_ring^.own;
      end;
    end; { skip_bad_frame }

  procedure skip_frame(info : lan_info_ptr);
    { throws away the frame pointed to by rx_ring }
    { assumes that host owns at least the first element }
    var
      done : boolean;
    begin
      with info^ do
      begin
	last_rx_size := 0;
	repeat
	  with rx_ring^ do
	  begin
	    done   := enp or err; { is this the last one in the frame? }
	    mcnt   := clear_mcnt;
	    rmd1_0 := rmd1_0_init; { set own clear others }
	    { setup for next ring element }
	    rx_ring := ADDR(rx_ring^,sizeof(rx_ring_elt_type));
	    if rx_ring = rxr_n then rx_ring := rxr_1;
	  end;
	until done;
      end;
    end; { skip_frame }

  function scan_inbound(info   : lan_info_ptr;
			var size   : shortint): scan_result_type;
    var
      done  : scan_result_type;
      ring  : rx_ring_elt_ptr;

    begin
      with info^, rx_ring^ do
      begin { check for first of a series }
	if own then SCAN_INBOUND := scan_done
	else
	{ first buffer must have the start bit set }
	if not stp then
	begin SCAN_INBOUND := scan_error;
	      lan_stats^[lrx_other_err]:=lan_stats^[lrx_other_err]+1;
	end
	else
	begin
	  ring := rx_ring;
	  done := scan_nop;
	  repeat
	    with ring^ do { needed because ring could change }
	    begin
	      if own then done := scan_done
	      else
	      begin
		if err then
		begin done := scan_error;
		  if FRAM then
		     lan_stats^[lrx_frame_err] := lan_stats^[lrx_frame_err]+1;
		  if CRC then
		     lan_stats^[lrx_crc_err] := lan_stats^[lrx_crc_err]+1;
		  if OFLO then
		     lan_stats^[lrx_oflo_err] := lan_stats^[lrx_oflo_err]+1;
		  if BUFF then
		     lan_stats^[lrx_buff_err] := lan_stats^[lrx_buff_err]+1;
		end
		else
		if enp then
		begin
		  size := mcnt-crc_size; { exclude crc from buffer size }
		  done := scan_ok;
		end
		else
		begin { point to next ring element }
		  ring := ADDR(ring^,sizeof(rx_ring_elt_type));
		  if ring=rxr_n then ring := rxr_1;
		end;
	      end;
	    end; {with}
	  until done<>scan_nop;
	  SCAN_INBOUND := done;
	end;
      end; { with }
    end; { scan_inbound }

  procedure next_baddr(info : lan_info_ptr;
		       var ring : rx_ring_elt_ptr;
		       var bufptr : gpaddr);
    begin
      ring := ADDR(ring^,sizeof(rx_ring_elt_type));
      with info^ do
	if ring = rxr_n then ring := rxr_1;
	with ring^ do
	begin
	  bufptr.int := 0;
	  bufptr.L16 := ladr;
	  bufptr.H8  := hadr;
	end;
    end; { next_baddr }

  function inbound_ready(info : lan_info_ptr;
			 var bufptr : gpaddr;
			 var size   : shortint):boolean;
    var
      done    : boolean;
      result  : scan_result_type;

    begin
      done := FALSE;
      INBOUND_READY := FALSE;
      with info^ do
      repeat
	result := scan_inbound(info,size);
	case result of
	  scan_error :
	    skip_bad_frame(info);
	  scan_ok    :
	    begin
	      if (size > lan_max_frame_len) or
		 (size < lan_min_frame_len) then
	      begin skip_bad_frame(info);
		    lan_stats^[lrx_other_err]:=lan_stats^[lrx_other_err]+1;
	      end
	      else
	      with rx_ring^ do
	      begin
		bufptr.int := 0;
		bufptr.L16 := ladr;
		bufptr.H8  := hadr;

		if last_rx_size=0 then
		with io_temps^ do
		begin  { user validation checks }
		  last_rx_size := size;
		  skip_bytes := 0;      { set defaults }
		  copy_bytes := size;
		  lan_stats^[lrx_no_errors]:=lan_stats^[lrx_no_errors]+1;
		  if perm_isr.dummy_pr<>nil then
		  begin
		    call(perm_isr.real_proc,bufptr.enh);{ give first rx buffer seg.}
		  end
		  else
		  if user_isr.dummy_pr<>nil then
		  begin
		    call(user_isr.real_proc,bufptr.enh);{ give first rx buffer seg.}
		  end;
		end; { with io_temps }

		if copy_bytes=0 then skip_frame(info)
		else
		begin INBOUND_READY := TRUE;
		      done := TRUE;
		end;
	      end; { with rx_ring }
	    end; {scan_ok}
	  scan_done :
	    done := TRUE; { no frames ready }
	end; { case }
      until done;
    end; {inbound_ready}

  procedure lan_read_buffer(info : lan_info_ptr);
    var
      size,bsize  : shortint;
      baddr   : gpaddr;
      ring    : rx_ring_elt_ptr;
      working,
      target  : BUFxINFOxPTR;
      io_info : pio_tmp_ptr;
      ibp     : bp;

    function move_data_to: BUFxINFOxPTR;
      var demux : boolean;
      begin
	move_data_to := nil;
	if inbound_ready(info,baddr,size) then
	begin
	  demux := false;
	  if lmpx_info<>nil then
	    if lmpx_info^.
	       isc_iompx_table[io_info^.my_isc].checkers<>nil then
	    begin
	      move_data_to := info^.driver_buffer;
	      demux := true;
	    end;
	  if not demux then
	  begin
	    with io_info^ do
	    begin
	      if (in_bufptr<>nil) then
	      begin
		if (bp(in_bufptr)^.active_isc<>no_isc)
		then
		  move_data_to := in_bufptr
		else
		  while inbound_ready(info,baddr,size) do
			skip_frame(info);
	      end
	      else
		while inbound_ready(info,baddr,size) do
		      skip_frame(info);
	    end;
	  end;
	end;
      end; { move_data_to }

    begin { lan_read_buffer }
      io_info := info^.io_temps;
      working := move_data_to;
      while working<>nil do
      begin
	with info^, working^ do
	begin
	  { move data from card buffer(s) to user buffer }
	  { adjust term_count (available buffer capacity)
	       and size       (bytes to move from card) }
	  term_char := lb_eot; { assume normal completion }
	  if term_count>=size then term_count := size
			      else begin size := term_count;
					 term_char := lb_short;
				   end; {data was lost}
	  ring := rx_ring;
	  { assumed that skip_bytes is <= size }
	  { this is enforced by L_SKIP_BYTES and inbound_ready }
	  while skip_bytes>0 do
	  begin
	    if size > rx_buffer_size then bsize := rx_buffer_size
				     else bsize := size;
	    if skip_bytes<bsize then
	    begin
	      ibp := baddr.ptr;
	      ibp := ADDR(ibp^,skip_bytes);
	      moveleft(ibp^,cp(buf_fill)^,bsize-skip_bytes);
	      buf_fill := ADDR(cp(buf_fill)^,bsize-skip_bytes);
	    end;
	    size := size - bsize;
	    skip_bytes := skip_bytes - bsize;
	    if size>0 then next_baddr(info,ring,baddr);
	  end;

	  while size>0 do
	  begin
	    if size > rx_buffer_size then bsize := rx_buffer_size
				     else bsize := size;
	    moveleft(cp(baddr.ptr)^,cp(buf_fill)^,bsize);
	    buf_fill := ADDR(cp(buf_fill)^,bsize);
	    size := size - bsize;
	    if size>0 then next_baddr(info,ring,baddr);
	  end;
	  skip_frame(info);         { let the card have its buffer(s) back }

	  with io_info^ do
	  if working=in_bufptr then
	  begin
	    in_bufptr := nil;                  { disconnect the users buffer }
	    active_isc := no_isc;              { un_busy the buffer }
	    TRY
	      if eot_proc.dummy_pr<>nil then   { call the buffers eot proc }
	       call (eot_proc.real_proc,working);
	    RECOVER begin end;
	  end
	  else
	  begin
	    { call scanner giving the working buffer pointer
	      and a var target buffer pointer.
	      The scanner is to return target as nil (unable to find a buffer)
	      or pointing to a buffer which has the data already copied to it.
	      The target buffer could be in_bufptr. }
	    call(lmpx_info^.iompx_scanner,working,target);
	    if target<>nil then
	    with target^ do
	    begin
	      if working^.term_count=0 then term_char := lb_eot
				       else term_char := lb_short;
	      if target=in_bufptr then in_bufptr:=nil;
	      active_isc := no_isc;
	      TRY
		if eot_proc.dummy_pr<>nil then   { call the buffers eot proc }
		 call (eot_proc.real_proc,target);
	      RECOVER begin end;
	    end;
	    with BUFxINFOxPTR(driver_buffer)^ do
	    begin {reset & re-activate the driver buffer}
	      buf_fill := buf_ptr; buf_empty := buf_ptr;
	      term_count := lan_max_frame_len;
	      active_isc := my_isc;
	    end;
	  end; { with io_info^ ... }
	end; { with info^, working etc.. }
	working := move_data_to;
      end; { while working<>nil }
    end; { lan_read_buffer }

  function check_out(io_info : pio_tmp_ptr):boolean;
    var
      info : lan_info_ptr;
      card : card_base_ptr;
      ubuf : bp;
    begin { check_out }
      CHECK_OUT := FALSE;
      info := ADDR(io_info^.drv_misc);
      card := io_info^.card_addr;
      with info^, tx_ring_l^ do
      if not own then { if LANCE does not own it then continue }
      begin
	ubuf := tx_user_buffs^[tx_ub_out];
	CHECK_OUT := TRUE;
	if ERR then
	begin
	  { tranmission failed }
	  if ubuf<>nil then ubuf^.term_char := lb_tx_error;
	  if LCOL then lan_stats^[ltx_lcol_err] := lan_stats^[ltx_lcol_err]+1;
	  if LCAR then lan_stats^[ltx_lcar_err] := lan_stats^[ltx_lcar_err]+1;
	  if RTRY then lan_stats^[ltx_retry_err] := lan_stats^[ltx_retry_err]+1;
	  if UFLO then
	  begin { semi nasty failure }
	    lan_stats^[ltx_uflo_err] := lan_stats^[ltx_uflo_err]+1;
	    card_reset(info,card);
	    card_start(io_info);
	    CHECK_OUT := FALSE;
	    ubuf := nil;
	  end;
	end
	else
	begin { packet was sent }
	  if ubuf<>nil then ubuf^.term_char := lb_eot; { packet was sent }
	  if ONE then lan_stats^[ltx_one] := lan_stats^[ltx_one]+1
	  else
	  if MORE then lan_stats^[ltx_more] := lan_stats^[ltx_more]+1
	  else
	  if NOT DEF then
	     lan_stats^[ltx_no_errors] := lan_stats^[ltx_no_errors]+1;
	  if DEF then lan_stats^[ltx_def] := lan_stats^[ltx_def]+1;
	end;
	if ubuf<>nil then
	with ubuf^ do
	begin
	  tx_user_buffs^[tx_ub_out]:=nil;
	  active_isc := no_isc;  { no longer busy }
	  TRY
	    if eot_proc.dummy_pr<>nil then call(eot_proc.real_proc,ubuf);
	  RECOVER begin end;
	end;
	tx_ub_out := (tx_ub_out+1) mod max_ring_elts;
      end; { with ... }
    end; { check_out }

  procedure de_allocate(info:lan_info_ptr);
    begin
      with info^ do
      begin
	with tx_ring_l^ do
	begin
	  tx_count := tx_count - 1;
	  if tx_count=0 then
	  begin
	    tx_next := txd_1; { reset to start of tx_buffer space }
	    tx_used := tx_next;
	  end
	  else
	  begin
	    tx_used.int := 0;
	    tx_used.L16 := ladr;
	    tx_used.H8 := hadr;
	    tx_used.int := tx_used.int - bcnt; { bcnt is always negative }
	  end;
	end;
	tx_ring_l := ADDR(tx_ring_l^,sizeof(tx_ring_elt_type));
	if tx_ring_l=txr_n then tx_ring_l:=txr_1;
      end;
    end; {de_allocate}

  procedure lan_isr(isribptr: pisrib);
    var
      io_info : pio_tmp_ptr;
      info    : lan_info_ptr;
      card    : card_base_ptr;
      stat    : csr0_type;
      status  : rx_status_type;
      done    : boolean;

    begin { lan_isr }
      io_info := ADDR(isribptr^);
      info := ADDR(io_info^.drv_misc);
      card := io_info^.card_addr;
      with card^ do
      begin
	if sc_reg.jab then
	begin { nasty failure }
	  card_reset(info,card);
	  card_start(io_info);
	end;
	stat := read_csr0(info^,card);
	write_rdp(info^,card,w_or(stat.uw,CSR0_INTR_ACK.uw));
	with stat do
	if ERR then
	with info^ do
	begin
	  if MERR then lan_stats^[lhw_merr] := lan_stats^[lhw_merr]+1;
	  if BABL then lan_stats^[lhw_babl] := lan_stats^[lhw_babl]+1;
	  if CERR then lan_stats^[ltx_no_heart] := lan_stats^[ltx_no_heart]+1;
	  if MISS then lan_stats^[lrx_miss_err] := lan_stats^[lrx_miss_err]+1;
	  if (MERR or BABL) then
	  begin { fatal failure }
	    card_reset(info,card);
	    card_state := cs_hw_failed;
	    clean_up(io_info,info,lb_hw_failed,lan_all_io);
	    escape(0); { get out now }
	  end;
	end;
	with info^ do
	begin
	 { check for out going data }
	  done := tx_count=0;
	  while not done do
	  begin
	    if check_out(io_info) then
	    begin
	      de_allocate(info); {return space to pool}
	      done := tx_count=0;
	    end
	    else done := TRUE;
	  end;
	 { try to read any input }
	  lan_read_buffer(info);
	 { check to see if the card should be re-started/re-configured }
	  if do_card_start then card_start(io_info);
	end; { with info }
      end; { with card }
    end; { lan_isr }

  procedure lan_rds(temp : ANYPTR; reg : io_word; var v: io_word);
  { READ CARD REGISTERS }
    type
      cp       = ^char;
      int_wrd  = record
		   case boolean of
		   TRUE :(i:integer);
		   FALSE:(w1:io_word; w2:io_word);
		 end;
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      card     : card_base_ptr;
      lreg     : int_wrd;
      i        : integer;

      function get_hl(anyvar val:int_wrd; high:boolean):io_word;
	begin
	  if high then get_hl := val.w1
		  else get_hl := val.w2;
	end;
    begin
      io_info := temp;
      with io_info^ do
      begin
	info := ADDR(drv_misc);
	card := card_addr;
	lreg.w1 := 0;
	lreg.w2 := reg;
	with info^ do
	case lreg.i of
	L_GET_INTLEVEL: v := card_intlevel;
	L_CARD_STATE  : v := ord(card_state);
	L_RECONFIG    : v := ord(do_card_start);
	L_MODE        : v := init_block.mode.all;
	L_NUM_RX_BUFS : v := num_rx_buffers;
	L_RX_BUF_SIZE : v := rx_buffer_size;
	L_NUM_TX_BUFS : v := num_tx_buffers;
	L_GET_TX_BUF_SIZE: v := tx_buffer_size;
	L_GET_STATS_LSW: v := get_hl(lan_stats,false);
	L_GET_STATS_MSW: v := get_hl(lan_stats,true);
	L_GET_FRAME_SIZE: v := last_rx_size;
	L_LINK_ADDR1..L_LINK_ADDR1+5:
			v := ord(local_link_address[reg-20]);
	L_INPUT_BUSY  : v := ord(in_bufptr<>nil);
	L_OUTPUT_BUSY : v := ord(out_bufptr<>nil);

	otherwise
	  if (reg>=L_MMASK0) and
	     (reg<=L_MMASK0+63) then
	    begin
	      reg := reg-L_MMASK0;
	      if (reg mod 16) > 7 then reg := reg-8
				  else reg := reg+8;
	      v := ord(init_block.ladrf.bits[reg]);
	    end
	  else io_escape(ioe_rds_wtc,io_info^.my_isc);
	end; { case }
      end;
    end; { lan_rds }

  procedure init_lan_stats(var stats:lan_stats_data);
    var i : lan_stats_type;
    begin
      for i := lhw_merr to ltx_retry_err do stats[i]:=0;
    end;

  procedure lan_wtc(temp : ANYPTR; reg : io_word; v: io_word);
  { WRITE TO CARD REGISTERS }
    type
      cp       = ^char;
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      card     : card_base_ptr;
      lreg     : record
		   case boolean of
		   TRUE :(i:integer);
		   FALSE:(w1:io_word; w2:io_word);
		 end;
      i        : integer;

    procedure fake_interrupt;
      var
	old_level : integer;
      begin
	old_level := intlevel;
	if old_level<info^.card_intlevel then
	begin
	   setintlevel(info^.card_intlevel);
	   TRY
	     lan_isr(pisrib(io_info)); { call the isr procedure }
	   RECOVER begin end;
	   setintlevel(old_level);
	end;
      end; { fake interrupt }

    begin
      io_info := temp;
      with io_info^ do
      begin
	info := ADDR(drv_misc);
	card := card_addr;
	lreg.w1 := 0; { do unsigned extension }
	lreg.w2 := reg;
	with info^ do
	case lreg.i of
	L_CARD_STATE:
	  begin
	    if v=ord(cs_card_reset) then card_reset(info,card)
	    else
	    if v=ord(cs_lance_ready) then
	    begin do_card_start := true;
		  fake_interrupt;
	    end;
	    { ignore anything else }
	  end;
	L_FORCE_INTERRUPT: fake_interrupt;
	L_RECONFIG      : do_card_start := v<>0;
	L_MODE          : init_block.mode.all := v;
	L_NUM_RX_BUFS   : num_rx_buffers := v;
	L_RX_BUF_SIZE   : rx_buffer_size := v;
	L_NUM_TX_BUFS   : num_tx_buffers := v;
	L_SET_MULTICAST_ALL:begin {set/clear all multicast mask bits}
			      if v<>0 then v := -1; { all ones }
			      init_block.ladrf.int1 := v;
			      init_block.ladrf.int2 := v;
			    end;
	L_INIT_STATS    : init_lan_stats(lan_stats^);
	L_REJECT_FRAME  : copy_bytes := 0;   { used to signal packet reject }
	L_LINK_ADDR1..L_LINK_ADDR1+5:
			  local_link_address[reg-20] := chr(v);
	L_SET_UISR      : perm_isr := io_info^.user_isr;
	L_CLEAR_UISR    : perm_isr.dummy_pr := nil;
	L_ABORT         : begin{ L_INPUT, L_OUTPUT, L_ALL_IO }
			    case v of
			      L_INPUT : clean_up(io_info,info,lb_abort,lan_input);
			      L_OUTPUT: clean_up(io_info,info,lb_abort,lan_output);
			      L_ALL_IO: clean_up(io_info,info,lb_abort,lan_all_io);
			      otherwise
				io_escape(ioe_misc,io_info^.my_isc);
			    end;
			  end;
	L_SET_MMASK,
	L_CLR_MMASK     : begin
			    if (V<0) or (V>63) then io_escape(ioe_misc,io_info^.my_isc);
			    if (V mod 16) > 7 then V := V-8
					      else V := V+8;
			    init_block.ladrf.bits[V]:=(lreg.i=L_SET_MMASK);
			  end;
	L_SET_DEFAULT_CONFIG :
	   begin
	     if hw_read_local_address(card^,local_link_address) then
	     begin
	       init_block.mode.ALL := default_mode;      { prom. etc. all false }
	       init_block.ladrf    := init_ladrf; { initialize the filter to all zeroes }
	       {set rcv variables}
	       rx_buffer_size := default_rx_buffer_size;
	       num_rx_buffers := default_num_rx_buffers;
	       {set tx variables}
	       num_tx_buffers := default_num_tx_buffers;
	       init_lan_stats(lan_stats^);
	     end
	     else
	     begin
	       card_reset(info,card);
	       card_state := cs_hw_failed;
	       clean_up(io_info,info,lb_hw_failed,lan_all_io);
	       io_escape(ioe_crd_dwn,io_info^.my_isc);
	     end;
	   end;
	L_SKIP_BYTES    : begin { called from user_isr or perm_isr }
			    if v<0 then io_escape(ioe_misc,io_info^.my_isc);
			    if v>=copy_bytes then copy_bytes := 0
					     else begin skip_bytes := v;
							copy_bytes := copy_bytes-v;
						  end;
			  end;
	otherwise
	  io_escape(ioe_rds_wtc,io_info^.my_isc);
	end; { case }
      end;
    end; { lan_wtc }

  procedure lan_write_buffer(info : lan_info_ptr);
    type
      cp = ^char;
    var
      ubufptr   : bp;
      required  : integer;
      avail1,avail2 : integer;
      old_level,hi_level : integer;
      card      : card_base_ptr;

    begin { lan_write_buffer }
      old_level := intlevel;
      TRY
	with info^, io_temps^ do
	begin
	  lan_stats^[ltx_requests]:=lan_stats^[ltx_requests]+1;
	  if old_level>card_intlevel then hi_level := old_level
				     else hi_level := card_intlevel;
	  ubufptr := out_bufptr; { snapshot out_bufptr }
	  if ubufptr=nil then escape(0); { request aborted }

	  card := card_addr;
	  if ubufptr^.term_count<lan_min_frame_len
	     then required := lan_min_frame_len
	     else required := ubufptr^.term_count;
	  repeat { until allocation is ok }
	    if required>tx_buffer_size then
	       io_escape(ioe_no_space,io_temps^.my_isc); { will never ever fit }
	    repeat { wait for a ring element and enough space to free up }
	      setintlevel(hi_level); { block ISR during space check }
	      if out_bufptr=nil then escape(0); { request aborted }
	      alloc_ok := false;
	      if tx_count=0 then
	      begin
		avail1 := tx_buffer_size;
		avail2 := 0;
	      end
	      else
	      if tx_next.int>tx_used.int then
	      begin
		avail1 := txd_n.int-tx_next.int;
		avail2 := tx_used.int-txd_1.int;
	      end
	      else
	      begin
		avail1 := tx_used.int-tx_next.int;
		avail2 := 0;
	      end;
	      alloc_ok := (tx_count<num_tx_buffers) and
			  ((avail1>=required) or (avail2>=required));
	      setintlevel(old_level); { let ISR run again }
	      if not alloc_ok then
	      with card^ do
	      begin
		if old_level>=card_intlevel then
		begin
		  repeat until sc_reg.ir;    { wait for interrupt request }
		  TRY
		    lan_isr(pisrib(io_temps)); { call the ISR procedure }
		  RECOVER begin end;
		end;
	      end;
	    until alloc_ok;
	    setintlevel(hi_level);      { block ISR until pointers are set }
	    if out_bufptr=nil then escape(0);            { request aborted }
	    if not alloc_ok then setintlevel(old_level); { let ISR run }
	  until alloc_ok;

	  { move from ram to the allocated space on the card }
	  with bp(out_bufptr)^ do
	  begin
	    if avail1<required then tx_next := txd_1;
	    moveleft(cp(buf_empty)^,cp(tx_next.ptr)^,term_count);
	  end;

	  with tx_ring_f^ do
	  begin
	    bcnt := - required;
	    tmd3 := TMD3_RETURN;
	    ladr := tx_next.L16;
	    hadr := tx_next.H8;
	    tmd1_0 := tmd1_0_return; { set own stp enp to let card have it }
	  end;

	  TX_COUNT := TX_COUNT + 1;

	  tx_next.int := tx_next.int + required;
	  if tx_next.int>=txd_n.int then tx_next := txd_1;

	  tx_ring_f := ADDR(tx_ring_f^,sizeof(tx_ring_elt_type));
	  if tx_ring_f = txr_n then tx_ring_f := txr_1;

	  with bp(out_bufptr)^ do
	  if eot_proc.dummy_pr=nil then
	  begin { cleanup & disconnect now if no eot_proc }
	    term_char  := lb_eot;
	    active_isc := no_isc;
	    out_bufptr := nil;
	  end;

	  tx_user_buffs^[tx_ub_in] := out_bufptr;
	  tx_ub_in := (tx_ub_in+1) mod max_ring_elts;
	  out_bufptr := nil;      { disconnect user buffer }
	  setintlevel(old_level); { clean up intlevel }
	end; { with info^ ... }
      RECOVER
	begin
	  setintlevel(old_level);
	  if escapecode<>0 then escape(escapecode);
	end;
      { call outbuf_proc if out_bufptr is nil }
      with info^, io_temps^ do
      begin
	if out_bufptr=nil then
	  if outbuf_proc.dummy_pr<>nil then
	    call(outbuf_proc.real_proc,my_isc);
      end;
    end; { lan_write_buffer }

  procedure lan_tfr(temp : ANYPTR; v : ANYPTR);
    label 1;
    var
      io_info  : pio_tmp_ptr;
      info     : lan_info_ptr;
      buffer   : BUFxINFOxPTR;
      utimer   : timer_rec;
      u_reg_rec: iompx_rec_ptr;
      continue : boolean;
      need_reg : boolean; { buffer must be registered }
    begin
      io_info := temp;
      info    := ADDR(io_info^.drv_misc);
      buffer  := v;
      with io_info^, buffer^ do
      begin
	need_reg := (usr_tfr=dummy_tfr_1) or (usr_tfr=dummy_tfr_2);
	if need_reg then
	begin
	  if (lmpx_info=nil) then io_escape(ioe_no_driver,my_isc)
	  else
	  if act_tfr<>no_tfr then io_escape(ioe_bad_tfr,my_isc);
	end;

	term_char := lb_pending;  { set for eot proc use }
	if info^.card_state<>cs_lance_ready then
	begin
	  if direction = to_memory then in_bufptr := nil
				   else out_bufptr:= nil;
	  term_char := lb_hw_failed;
	  io_escape(ioe_crd_dwn,my_isc);
	end;

	if (direction=from_memory) and (lmpx_info<>nil) then
	begin
	  if (act_tfr=no_tfr) or need_reg then
	  begin
	    call(lmpx_info^.find_iompx_buf,
		 my_isc,direction,buffer^,u_reg_rec);
	    if u_reg_rec<>nil then
	      with u_reg_rec^ do
	      begin
		if not need_reg then out_bufptr := nil;
		call(ops_proc,u_reg_rec,continue);
		if continue then out_bufptr := v
			    else goto 1; { all done }
	      end
	    else { buffer not registered }
	    if need_reg then io_escape(ioe_bad_tfr,my_isc);
	  end;
	end;

	if direction=to_memory then
	begin { read }
	  { is this a registered buffer ? }
	  if lmpx_info<>nil then
	    call(lmpx_info^.find_iompx_buf,
		 my_isc,direction,buffer^,u_reg_rec)
	  else u_reg_rec := nil;

	  { for optional registered buffers, free in_bufptr now
	    for required reqisteded buffers, ignore in_bufptr
	    then give the ops_proc (checker) a chance to
	    supply the data.
	  }
	  if u_reg_rec<>nil then
	  begin
	    with u_reg_rec^ do
	    begin
	      if not need_reg then in_bufptr := nil;
	      in_buffer := nil; { signal, call comming from iod_tfr }
	      call(ops_proc,u_reg_rec,continue);
	    end
	  end
	  else
	  if need_reg then io_escape(ioe_bad_tfr,my_isc)
		      else continue := true;

	  if continue then
	  begin { data to come from ISR }
	    active_isc := my_isc; { let ISR use the buffer }
	    { If the read has not been satisfied
	      and there is data in card buffer(s)
	      then force an interrupt to get data moveing. }
	    if (in_bufptr<>nil) then
	      if iostatus(my_isc,L_GET_FRAME_SIZE)<>0 then
		  iocontrol(my_isc,L_FORCE_INTERRUPT,0);
	  end
	  else
	  begin { ops_proc supplied the data }
	    if term_count=0 then term_char := lb_eot
			    else term_char := lb_short;
	    TRY
	      if eot_proc.dummy_pr<>nil then   { call the buffers eot proc }
	       call (eot_proc.real_proc,buffer);
	    RECOVER begin end;
	    goto 1;  { all done }
	  end;
	end { read }
	else
	begin { write }
	  active_isc := my_isc; { show transfer in progress }
	  lan_write_buffer(info);
	end; { write }

	{ check requested tfr mode and either wait or continue }
	if (usr_tfr<=serial_fastest) then
	begin { serial transfer }
	  if timeout=0 then repeat until active_isc=no_isc
	  else
	  begin
	    utimer.time := timeout;
	    start_timer(utimer);
	    repeat until (active_isc=no_isc) or time_expired(utimer);
	    if active_isc<>no_isc then io_escape(ioe_timeout,my_isc);
	  end;
	end;
	{ else overlapped transfer }
      end; { with io_info^, buffer^ }
    1:
    end; { lan_tfr }

  function lan_setup(sc : integer):boolean;
  { this procedure is used only during powerup }
    var
      info : lan_info_ptr;
      card : card_base_ptr;
      i,nb : integer;
      d_buf: BUFxINFOxPTR;
    begin
      info := ADDR(isc_table[sc].io_tmp_ptr^.drv_misc);
      card := isc_table[sc].io_tmp_ptr^.card_addr;
      with info^, init_block do { init_block here is in temp area }
      begin
	if hw_read_local_address(card^,local_link_address) then
	begin
	  card_state := cs_pre_init;
	  mode.ALL := default_mode;             { prom etc all false }
	  { copy link address to the init block }
	  { NOTE byte swapping }
	  padr[1]:=local_link_address[2];
	  padr[2]:=local_link_address[1];
	  padr[3]:=local_link_address[4];
	  padr[4]:=local_link_address[3];
	  padr[5]:=local_link_address[6];
	  padr[6]:=local_link_address[5];
	  ladrf:= init_ladrf; { initialize the filter to all zeroes }
	  {set rcv variables}
	  rx_buffer_size := default_rx_buffer_size;
	  num_rx_buffers := default_num_rx_buffers;
	  {set tx variables}
	  num_tx_buffers := default_num_tx_buffers;
	  {set default interface hooks}
	  io_temps := isc_table[sc].io_tmp_ptr;
	  card_intlevel := card^.sc_reg.intlevel+3;
	  do_card_start := FALSE; { card init block etc & copy are same }
	  new(lan_stats);
	  init_lan_stats(lan_stats^);
	  new(tx_user_buffs);
	  for i := 0 to max_ring_elts-1 do tx_user_buffs^[i]:=nil;
	  tx_ub_in := 0; tx_ub_out := 0;
	  perm_isr.dummy_pr := nil;
	  outbuf_proc.dummy_pr := nil;
	  new(d_buf);
	  newbytes(d_buf^.buf_ptr,lan_max_frame_len);
	  with d_buf^ do
	  begin {init. the driver buffer}
	    buf_fill := buf_ptr; buf_empty := buf_ptr;
	    term_count := lan_max_frame_len;
	    active_isc := sc;
	  end;
	  driver_buffer := d_buf;
	end
	else card_state := cs_hw_failed;
      end; {with}
      with isc_table[sc] do
      begin { hook up the drivers }
	new(io_drv_ptr);
	io_drv_ptr^ := dummy_drivers;
	with io_drv_ptr^ do
	begin
	  iod_init := lan_init;
	  iod_isr  := lan_isr;
	  iod_rds  := lan_rds;
	  iod_wtc  := lan_wtc;
	  iod_tfr  := lan_tfr;
	end;
      end;
      lan_setup := info^.card_state=cs_pre_init;
    end; {lan_setup}

  function laninit(var ehp:anyptr):boolean;
    var
      sc, i    : integer;
      lan_card : card_base_ptr;
      ok       : boolean;
      cp       : ^char;

    begin { laninit }
      { scan selectcode table for LAN cards }
      ok := false;
      for sc := iominisc to iomaxisc do
      with isc_table[sc] do
      begin
	if (card_type=other_card) and
	   ((card_id=0) or (card_id=hp98643)) then
	begin
	  lan_card := card_ptr;
	  if (lan_card^.id_reg.idb mod 128) = hp98643 then
	  begin
	    card_id := hp98643; { fix it }
	    TRY { has this card been setup already ? }
	      i := iostatus(sc,l_reconfig);
	      { if the above call worked then driver is already setup }
	    RECOVER
	    { check escape code etc.}
	    if (escapecode=ioescapecode) and
	       (ioe_result=ioe_no_driver) then
	    begin
	      { fixup the heap as required }
	      mark(cp);
	      if ord(cp)<ord(ehp) then release(ehp);
	      { init the dvr_temp area }
	      if lan_setup(sc) then
	      begin
		{ hook in the isr }
		permisrlink(io_drv_ptr^.iod_isr,        { isr }
			    ADDR(lan_card^.sc_reg,1),   { interrupt reg }
			    hex('C0'),hex('C0'),        { mask and value }
			    lan_card^.sc_reg.intlevel+3,{ interrupt priority }
			    ADDR(io_tmp_ptr^.myisrib)); { isr info pointer }
		{ start the card }
		card_start(io_tmp_ptr);
		ok := true;
	      end;
	    end;
	  end;
	end;
      end;
      laninit := ok;
      if ok then io_revid := io_revid + ' L3.22';
    end; { laninit }

  END; { LANDVR }
  { program LANIO }
  IMPORT
    loader, landvr;
  BEGIN
    if laninit(eheap) then markuser;
  END.
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.4
log
@Turned off $DEBUG
SFB
@
text
@@


31.3
log
@forgot to uncomment part of the search directive
RDQ

@
text
@d3 1
a3 1
$DEBUG ON $ $RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
@


31.2
log
@Defined dummy_tfr_1 & dummy_tfr_2 to mean that the
buffer for this transfer must be registered,  and that
for input operations, IN_BUFPTR in the select code table
is not to be examined or changed.

This change was made as a bug fix.  Before the change,
a transfer useing a registered buffer could not be done
if another 'normal' application had the input side totaly
consummed (like NRCs applications or pwsvt)
RDQ 16 dec 88

@
text
@d21 1
a21 1
$SEARCH 'LANDECS','LANASM'{,'IOLIB:KERNEL.CODE'}$
@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@d3 1
a3 1
$DEBUG OFF$ $RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
d6 1
a6 1
  3.22c
d12 6
d21 1
a21 1
$SEARCH 'LANDECS','LANASM','IOLIB:KERNEL.CODE'$
d1215 1
d1222 7
a1228 2
	if (usr_tfr=dummy_tfr_1) or (usr_tfr=dummy_tfr_2) then
	  io_escape(ioe_bad_tfr,my_isc);
d1241 1
a1241 1
	  if act_tfr=no_tfr then
d1248 1
a1248 1
		out_bufptr := nil;
d1252 3
a1254 1
	      end;
a1257 1
	act_tfr := INTR_tfr;
d1266 3
a1268 2
	  { for registered buffers, free in_bufptr now
	    and give the ops_proc (checker) a chance to
d1275 1
a1275 1
	      in_bufptr := nil;
d1280 3
a1282 1
	  else continue := true;
@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.4
log
@pws2rcs automatic delta on Thu Dec 8 15:31:09 MST 1988

A Change to the search directive was made.
(This was done to clean up the ci/newci massive diff problem).
@
text
@@


29.3
log
@move iompx hookup from CARD_START to CLEAN_UP
QUIST

(This is done to clean up the ci/newci massive diff problem).
@
text
@d15 1
a15 1
$SEARCH 'LANDECS','LANASM'{,'IOLIB:KERNEL.CODE'}$
@


29.2
log
@Added calls to IOMPX checker from LAN_TFR
more comments
QUIST

(This is done to clean up the ci/newci massive diff problems)
@
text
@d125 1
d128 10
d261 1
a261 1
      ans       : iompx_ans_rec;
a411 10
	{ check for IOMPX availability }
	if lmpx_info=nil then
	begin
	  call(io_error_link,iompx_request,ans.s);
	  if ans.s=iompx_answer then
	  begin
	    lmpx_info := ans.ptr;
	    lmpx_info^.isc_iompx_table[io_info^.my_isc].capable := true ;
	  end;
	end;
@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d6 6
d15 1
a15 1
$SEARCH 'LANDECS','LANASM','IOLIB:KERNEL.CODE'$
d20 1
a20 1
  function laninit:boolean;
d24 1
d196 1
d662 4
a665 1
	      end;
d1238 1
a1238 1
			    else goto 1;
d1246 1
a1246 1
	  { if this is to a registered buffer then free in_bufptr now }
a1250 1
	  if u_reg_rec<>nil then in_bufptr  := nil;
d1252 35
a1286 8
	  active_isc := my_isc; { let ISR use the buffer }
	  { If the read has not been satisfied
	    and there is data in card buffer(s)
	    then force an interrupt to get data moveing. }
	  if (in_bufptr<>nil) then
	    if iostatus(my_isc,L_GET_FRAME_SIZE)<>0 then
	      if (bp(in_bufptr)^.active_isc<>no_isc) then
		iocontrol(my_isc,L_FORCE_INTERRUPT,0);
d1293 1
d1380 1
a1380 1
  function laninit:boolean;
d1384 2
a1385 1
      ok  : boolean;
d1404 3
d1408 3
d1429 1
a1429 1
      if ok then io_revid := io_revid + ' L3.3';
d1437 1
a1437 1
    if laninit then markuser;
@


28.3
log
@
ipws2rcs automatic delta on Mon Oct 31 10:34:17 MST 1988
:w
:q
@
text
@@


28.2
log
@new version to support muliplexed io

@
text
@d9 1
a9 1
$SEARCH 'LANDECS','LANASM'$
@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@d1 1
a1 1
$SYSPROG,MODCAL$
d5 1
a5 15
   4 feb 88, clean up work, changed constants to symbols where ever feasable
	     eliminated & added io_escape calls, reworked lan_init and
	     other code to use a new procedure CLEAN_UP to clean up user
	     buffers in case of natural or user made disasters.
  16 feb 88, fixed default read to call the eot proc with a buffer pointer
	     as argument instead of eot_parm.
  3 mar 88,  removed usage of in_frame,  input now goes directly to
	     in_bufptr. removed procedures iolbuffer and iobuffer_reset.
	     changed lan_read_buffer to call inbound_ready before checking
	     the availability of the input buffer.  user_isr is called only
	     once per frame.  last_rx_size is now used to determine input
	     blockage and is valid when ever an input frame is available on
	     the card.  now use copy_bytes to signal frame reject.
  8 mar 88,  changed multicast mask register interface. now done via
	     L_SET_MMASK bitno.  L_CLR_MMASK bitno.  L_MMASK bitno.
a6 5
{ outstanding design/implementation issues
  1. what action should be taken when a read transfer requests less data
     than a single frame? currently the transfer is completed and the
     remaining data in the driver buffer is left there.
  2. should the multicast hashing code be made available?
a7 6
  NOTES: users need to be aware that the L_FORCE_INTERUPT call is not
	 to be done from a higher level ISR even if the CPU intlevel
	 has been set to a lower level.
	 ie
	 don't use these drivers if you have changed the intlevel.
}
d10 2
a11 1
IMPORT  SYSGLOBALS, IODECLARATIONS, GENERAL_0, ASM, LANDECS, LANASM, ISR;
d17 1
a17 1

d62 2
d110 1
a110 1
			class: ioclass);
a113 2
      ubufs : lan_bufs_ptr;
      markp : ^integer;
d116 2
a121 12
	mark(markp);  { need temporary heap space }
	if tc<>lb_hw_failed then
	begin  { need a local copy of tx_user_buffs^ }
	  new(ubufs);
	  with info^ do
	  for i := 0 to max_ring_elts-1 do
	  begin ubufs^[i] := tx_user_buffs^[i];
		tx_user_buffs^[i]:=nil;
	  end;
	end
	else ubufs := info^.tx_user_buffs;

a124 2
	if in_bufptr<>nil then
	with bp(in_bufptr)^ do
d126 16
a141 8
	  term_char := tc;
	  if eot_proc.dummy_pr<>nil then
	    call(eot_proc.real_proc,in_bufptr);
	  can_continue := (tc=lb_abort) or (tc=lb_reset);
	  if not (can_continue and
	    ((term_char=lb_pending) or (term_char=lb_reset))) then
	  begin in_bufptr := nil;
		active_isc:=no_isc;
d143 20
d177 6
a182 2
	    if eot_proc.dummy_pr<>nil then
	       call(eot_proc.real_proc,tempbp);
d190 1
a190 1
      { can continue from aborts but not resets }
d194 5
a198 2
	  if ubufs^[i]<>nil then
	  with bp(ubufs^[i])^ do
d202 11
a212 7
	    if eot_proc.dummy_pr<>nil then
	      call(eot_proc.real_proc,ubufs^[i]);
	    if (term_char<>lb_pending) or (tc<>lb_abort) then
	    begin
	      ubufs^[i]:=nil; { disconnect it }
	    end;
	    if tc=lb_abort then info^.tx_user_buffs^[i]:=ubufs^[i];
a215 1
      release(markp);
d220 5
a224 3
	if out_bufptr=nil then
	  if outbuf_proc.dummy_pr<>nil then
	    call(outbuf_proc.real_proc,my_isc);
d242 1
a242 1

d390 13
a402 2
      begin tc := lb_reset;
	    card^.sc_reg.ie := TRUE;
d406 1
a406 1
      { notify all user buffers of card reset }
a517 3
		  if BUFF then
		     lan_stats^[lrx_buff_err] := lan_stats^[lrx_buff_err]+1
		  else { don't count OVFL if BUFF }
d520 2
a527 1
		  lan_stats^[lrx_no_errors]:=lan_stats^[lrx_no_errors]+1;
a562 1
      skip_it : boolean;
a585 3
		skip_it    := FALSE;
		skip_bytes := 0;      { set defaults }
		copy_bytes := size;
d591 3
a596 1
		    skip_it := copy_bytes=0;
a601 1
		    skip_it := copy_bytes=0;
d605 1
a605 1
		if skip_it then skip_frame(info)
d623 2
a624 1
      working : boolean;
d628 2
a629 5
    begin { lan_read_buffer }
      io_info := info^.io_temps;
      working := inbound_ready(info,baddr,size) and
		 (io_info^.in_bufptr<>nil);
      while working do
d631 2
a632 1
	with info^, bp(io_info^.in_bufptr)^ do
d634 4
a637 13
	  if (active_isc<>no_isc) then
	  begin { move data from card buffer(s) to user buffer }
	    { adjust term_count (available buffer capacity)
		 and size       (bytes to move from card) }
	    term_char := lb_eot; { assume normal completion }
	    if term_count>=size then term_count := size
				else begin size := term_count;
					   term_char := lb_short;
				     end; {data was lost}
	    ring := rx_ring;
	    { assumed that skip_bytes is <= size }
	    { this is enforced by L_SKIP_BYTES and inbound_ready }
	    while skip_bytes>0 do
d639 8
a646 3
	      if size > rx_buffer_size then bsize := rx_buffer_size
				       else bsize := size;
	      if skip_bytes<bsize then
d648 6
a653 4
		ibp := baddr.ptr;
		ibp := ADDR(ibp^,skip_bytes);
		moveleft(ibp^,bp(buf_fill)^,bsize-skip_bytes);
		buf_fill := ADDR(cp(buf_fill)^,bsize-skip_bytes);
a654 3
	      size := size - bsize;
	      skip_bytes := skip_bytes - bsize;
	      if size>0 then next_baddr(info,ring,baddr);
d656 3
d660 23
a682 1
	    while size>0 do
d684 4
a687 6
	      if size > rx_buffer_size then bsize := rx_buffer_size
				       else bsize := size;
	      moveleft(bp(baddr.ptr)^,bp(buf_fill)^,bsize);
	      buf_fill := ADDR(cp(buf_fill)^,bsize);
	      size := size - bsize;
	      if size>0 then next_baddr(info,ring,baddr);
d689 4
a692 1
	    skip_frame(info); { let the card have its buffer(s) back }
d694 31
a724 1
	    with io_info^ do
d726 8
a733 5
	      ibp := in_bufptr;
	      in_bufptr := nil;                  { disconnect the users buffer }
	      active_isc := no_isc;              { un_busy the buffer }
	      if eot_proc.dummy_pr<>nil then     { call the buffers eot proc }
		 call (eot_proc.real_proc,ibp);
d735 10
a744 6
	    working := inbound_ready(info,baddr,size) and
		       (io_info^.in_bufptr<>nil);
	  end { move the data }
	  else working := false; { buffer not ready }
	end; { with info^ etc.. }
      end; { while working }
d793 3
a795 1
	  if eot_proc.dummy_pr<>nil then call(eot_proc.real_proc,ubuf);
a930 6
	L_MMASK       : begin
			  if (reg<0) or (reg>63) then io_escape(ioe_misc,io_info^.my_isc);
			  if (reg mod 16) > 7 then reg := reg-8
					      else reg := reg+8;
			  v := ord(init_block.ladrf.bits[reg]);
			end;
d933 9
a941 1
	  v := io_wp(ADDR(card^,lreg.i))^;
d967 1
a967 1
    procedure fake_interupt;
d980 1
a980 1
      end; { fake interupt }
a991 1
	L_GET_INTLEVEL:;
d998 1
a998 1
		  fake_interupt;
d1002 1
a1002 1
	L_FORCE_INTERUPT: fake_interupt;
d1030 4
a1033 5
			    if (reg<0) or (reg>63) then io_escape(ioe_misc,io_info^.my_isc);
			    if (reg mod 16) > 7 then reg := reg-8
						else reg := reg+8;

			    init_block.ladrf.bits[reg]:=(lreg.i=L_SET_MMASK);
d1064 1
a1064 1
	  io_wp(ADDR(card^,lreg.i))^ := v;
d1125 1
a1125 1
		  repeat until sc_reg.ir;    { wait for interupt request }
d1161 8
d1189 1
d1193 1
a1193 1
      buffer   : bp;
d1195 2
d1203 3
d1214 18
a1232 1
	active_isc := my_isc; { let ISR use it  }
d1235 15
a1249 6
	  { if un read data in card buffer then force interupt to get data moveing }
	  { check on in_bufptr is to reduce force_interupt calls }
	  if iostatus(my_isc,L_GET_FRAME_SIZE)<>0 then
	    if (in_bufptr<>nil) then
	     if (bp(in_bufptr)^.active_isc<>no_isc) then
		iocontrol(my_isc,L_FORCE_INTERUPT,0);
d1253 1
d1257 1
a1257 1
	if usr_tfr in [dummy_tfr_1..serial_fastest] then
d1265 1
a1265 1
	    if active_isc=no_isc then io_escape(my_isc,ord(ioe_timeout));
d1270 1
d1279 1
d1314 9
d1361 1
a1361 1
	    try { has this card been setup already ? }
d1364 1
a1364 1
	    recover
d1371 1
a1371 1
			    ADDR(lan_card^.sc_reg,1),   { interupt reg }
d1373 1
a1373 1
			    lan_card^.sc_reg.intlevel+3,{ interupt priority }
d1384 1
@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.2
log
@new interfaces
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d3 1
a3 1
$DEBUG OFF$$RANGE OFF$ $STACKCHECK OFF$ $OVFLCHECK OFF$
a4 33
  11 jan 88, In LAN_RDS, added pseudo reg 16 to access tx buffer size
	     changed otherwise clause to always do 16 bit "read"

  11 jan 88, In LAN_WTC, changed otherwise clause to always do 16 bit "write"
	     in FAKE_INTERUPT, made changes to minimize calls
	     to setintlevel.
  11 jan 88, bug: card id was being compared to 8 bits of id register
		  added mod to exclude remote bit.
  12 jan 88, bug: max size frames are to large for driver buffer.
		  adjusted size reported by SCAN_INBOUND to not include the CRC
		  removed references to crc_size in INBOUND_READY
		  and LAN_LOAD_BUFFER.
  12 jan 88, to reduce overhead in the ISR,
	     changed LAN_LOAD_BUFFER to a procedure and made the loop
	     internal to it instead of looping in LAN_ISR.
  13 jan 88, reworked DEFAULT_LC_READ & LAN_TFR to more closely follow
	     transfer use of buffer conventions.
  15 jan 88, changed calls to start_timer and time_expired to match PWS
	     conventions.
  15 jan 88, added timeout to serial transfer request
  15 jan 88, added call to USER_ISR to allow checking of link addresses
	     before a packet is moved from the card.
  18 jan 88, added statistics collection code.
  18 jan 88, added write_reg 17 to lan_wtc
  25 jan 88, restructured LAN_TFR to do timeouts on both input & output
	     output completion signaled in ISR after corresponding card
	     buffer has been sent/failed.
  27 jan 88, changed FAKE_INTERUPT to only call the ISR if the interupt
	     level is less than the card level.
	     ( this will prevent the card from being reset/reconfigured
	       at a bad time )
  27 jan 88, changed calls to fastmove to calls to moveleft for a little
	     more speed.
d9 11
d85 1
a128 9
  procedure iolbuffer_reset(anyvar buf : bp);
    begin
      with buf^ do
      begin
	buf_fill   := buf_ptr;
	buf_empty  := buf_ptr;
      end;
    end; { iolbuffer_reset }

d131 2
a132 1
			  tc : term_char_type);
d144 1
a144 1
	mark(markp);  { need temporary stack space }
d158 2
a159 1
	if in_bufptr <> nil then
d172 1
d176 1
d195 1
a196 2
	if ubufs^[i]<>nil then
	with bp(ubufs^[i])^ do
d198 2
a199 5
	  term_char := tc;
	  active_isc:= no_isc; { de-activate the buffer }
	  if eot_proc.dummy_pr<>nil then
	    call(eot_proc.real_proc,ubufs^[i]);
	  if (term_char<>lb_pending) or (tc<>lb_abort) then
d201 9
a209 1
	    ubufs^[i]:=nil; { disconnect it }
a210 1
	  if tc=lb_abort then info^.tx_user_buffs^[i]:=ubufs^[i];
d214 8
d243 1
a348 3
	  { reset & activate the driver buffer }
	  iolbuffer_reset(in_frame);
	  bp(in_frame)^.active_isc := io_info^.my_isc;
d382 1
d392 1
a392 1
      clean_up(io_info,info,tc);
d421 1
a421 1
	  clean_up(io_info,info,lb_abort);
d432 14
a445 11
      repeat
	with rx_ring^ do
	begin
	  mcnt   := clear_mcnt;
	  rmd1_0 := rmd1_0_init; { set own clear others }
	  { setup for next ring element }
	  rx_ring := ADDR(rx_ring^,sizeof(rx_ring_elt_type));
	  if rx_ring = rxr_n then rx_ring := rxr_1;
	end;
	{ check this next ring element }
      until rx_ring^.stp or rx_ring^.own;
d455 14
a468 11
      repeat
	with rx_ring^ do
	begin
	  done   := enp or err; { is this the last one in the frame? }
	  mcnt   := clear_mcnt;
	  rmd1_0 := rmd1_0_init; { set own clear others }
	  { setup for next ring element }
	  rx_ring := ADDR(rx_ring^,sizeof(rx_ring_elt_type));
	  if rx_ring = rxr_n then rx_ring := rxr_1;
	end;
      until done;
d574 5
a578 1
		skip_it := FALSE;
d581 7
d590 2
a591 4
		    last_rx_size := size; { set it for user_isr }
		    user_parm := bufptr.enh; { points to first rx buffer seg.}
		    call(user_isr.real_proc,user_parm);
		    skip_it := user_parm=nil;
d594 1
d608 1
a608 1
  procedure lan_load_buffer(info : lan_info_ptr);
d614 2
d617 5
a621 2
    begin { lan_load_buffer }
      with info^, bp(in_frame)^ do
d623 1
a623 6
      { if buffer is loaded then try to get link protocol code to unload it }
	if active_isc=no_isc then call(lan_read,info);

      { while the buffer is unloaded,  try to load it from the card }
	working := active_isc<>no_isc;
	while working do
d625 9
a633 4
	  if inbound_ready(info,baddr,size) then
	  begin { move data from card buffer(s) to driver buffer }
	    iolbuffer_reset(in_frame);
	    term_count := size;
d635 18
a662 9
	    active_isc := no_isc; { mark the buffer loaded }
	    { try to get link protocol code to unload it }
	    call(lan_read,info);
	    working := active_isc<>no_isc;
	  end
	  else working := false;
	end; { while working }
      end; { with info^ etc.. }
    end; { lan_load_buffer }
d664 16
d791 1
a791 1
	    clean_up(io_info,info,lb_hw_failed);
d809 1
a809 1
	  lan_load_buffer(info);
a848 1
	L_FORCE_INTERUPT:;    { call lan_isr }
a854 1
	L_SET_MULTICAST_ALL:; { set/clear all multicast mask bits }
d856 1
a856 1
	L_GET_STATS_MSW: v := get_hl(lan_stats,true);{ get lan_stats MSW }
d858 11
a868 8
	L_LINK_ADDR..L_LINK_ADDR+5:
			 v := ord(local_link_address[reg-20]);
	30..93: { multicast mask bits }
	   begin
	     i := reg-30;
	     if (i mod 16) > 7 then i := i-8 else i := i+8;
	     v := ord(init_block.ladrf.bits[i]);
	   end;
a937 1
	L_GET_TX_BUF_SIZE:; {read tx buffer size}
d944 2
a945 2
	L_REJECT_FRAME  : user_parm := NIL;   { used to signal packet reject }
	L_LINK_ADDR..L_LINK_ADDR+5:
d947 20
a966 1
	30..93: { multicast mask bits }
d968 18
a985 3
	     i := reg-30;
	     if (i mod 16) > 7 then i := i-8 else i := i+8;
	     init_block.ladrf.bits[i]:=v<>0;
d987 7
d1000 1
a1000 1
  procedure default_write(info : lan_info_ptr);
d1010 1
a1010 1
    begin { default_write }
d1102 1
a1102 8
    end; { default_write }

  procedure default_read(info : lan_info_ptr);
    type
      cp = ^char;
    var
      size : integer;
    begin { default_read }
d1105 3
a1107 27
	if in_bufptr<>nil then
	if bp(in_bufptr)^.active_isc<>no_isc then
	with bp(in_bufptr)^ do
	begin
	  size := term_count;
	  { check request against available data }
	  if size>bp(in_frame)^.term_count
	    then size := bp(in_frame)^.term_count;
	  moveleft(cp(bp(in_frame)^.buf_empty)^,cp(buf_fill)^,size);
	  { adjust pointer & counter on user buffer }
	  term_count := size;
	  buf_fill := ADDR(cp(buf_fill)^,size);
	  { adjust pointer & counter on driver buffer }
	  { driver buffer will not take more input until it is emptied }
	  with bp(in_frame)^ do
	  begin
	    buf_empty := ADDR(cp(buf_empty)^,size);
	    term_count := term_count-size;
	    if term_count=0 then active_isc := my_isc; { release driver buf }
	  end;
	  in_bufptr := nil;                  { disconnect the users buffer }
	  active_isc := no_isc;              { un_busy the buffer }
	  term_char := lb_eot;               { normal completion }
	  if eot_proc.dummy_pr<>nil then     { call users eot proc }
	     call (eot_proc.real_proc,eot_parm);
	end;
	{ if no available input buffer, do nothing }
d1109 1
a1109 1
    end; { default_read }
d1135 6
a1140 4
	  { if data in driver buffer then force interupt to get data moveing }
	  { check on in_bufptr is to reduce iocontrol calls }
	  if (bp(info^.in_frame)^.active_isc=no_isc) and (in_bufptr<>nil) then
	      iocontrol(my_isc,L_FORCE_INTERUPT,0);
d1144 1
a1144 1
	  call(info^.lan_write,info);
d1162 1
a1162 18
  procedure iolbuffer(anyvar buf : bp);
    begin
      new(buf);
      with buf^ do
      begin
	buf_size := lan_max_frame_len;
	newbytes(buf_ptr,buf_size);
	act_tfr := no_tfr;
	active_isc := no_isc;
	drv_tmp_ptr       := nil;
	eot_proc.dummy_sl := nil;
	eot_proc.dummy_pr := nil;
	eot_parm          := nil;
	dma_priority      := FALSE;
      end;
    end; { iolbuffer }

  procedure lan_setup(sc : integer);
d1173 31
a1203 31
	i := ord(hw_read_local_address(card^,local_link_address));
	card_state := cs_pre_init;
	mode.ALL := default_mode;             { prom etc all false }
	{ copy link address to the init block }
	{ NOTE byte swapping }
	padr[1]:=local_link_address[2];
	padr[2]:=local_link_address[1];
	padr[3]:=local_link_address[4];
	padr[4]:=local_link_address[3];
	padr[5]:=local_link_address[6];
	padr[6]:=local_link_address[5];
	ladrf:= init_ladrf; { initialize the filter to all zeroes }
	{set rcv variables}
	rx_buffer_size := default_rx_buffer_size;
	num_rx_buffers := default_num_rx_buffers;
	iolbuffer(in_frame);
	bp(in_frame)^.active_isc := sc; { activate the buffer }
	{set tx variables}
	num_tx_buffers := default_num_tx_buffers;
	{set default interface hooks}
	io_temps := isc_table[sc].io_tmp_ptr;
	lan_data := nil;
	lan_read := default_read;
	lan_write:= default_write;
	card_intlevel := card^.sc_reg.intlevel+3;
	do_card_start := FALSE; { card init block etc & copy are same }
	new(lan_stats);
	init_lan_stats(lan_stats^);
	new(tx_user_buffs);
	for i := 0 to max_ring_elts-1 do tx_user_buffs^[i]:=nil;
	tx_ub_in := 0; tx_ub_out := 0;
d1218 1
d1246 12
a1257 10
	      lan_setup(sc);
	      { hook in the isr }
	      permisrlink(io_drv_ptr^.iod_isr,        { isr }
			  ADDR(lan_card^.sc_reg,1),   { interupt reg }
			  hex('C0'),hex('C0'),        { mask and value }
			  lan_card^.sc_reg.intlevel+3,{ interupt priority }
			  ADDR(io_tmp_ptr^.myisrib)); { isr info pointer }
	      { start the card }
	      card_start(io_tmp_ptr);
	      ok := true;
@


24.2
log
@Pws2unix automatic delta on Tue Mar  1 09:01:42 MST 1988
@
text
@@


24.1
log
@initial RCS submission
@
text
@d167 3
d174 1
a174 1
	if tc=lb_reset then
d186 1
d193 3
a195 1
	  if (term_char<>lb_pending) or (tc<>lb_abort) then
d201 2
a203 1
	with bp(out_bufptr)^ do
d205 12
a216 6
	  term_char := tc;
	  if eot_proc.dummy_pr<>nil then
	    call(eot_proc.real_proc,in_bufptr);
	  if (term_char<>lb_pending) or (tc<>lb_abort) then
	  begin out_bufptr := nil;
		active_isc := no_isc;
d219 2
a220 1
      { notify all user buffers on the card of abort request }
d226 1
a230 1
	    active_isc := no_isc; { un busy the buffer }
d233 1
d263 2
d595 5
a599 6
		if not skip_it then
		begin
		  INBOUND_READY := TRUE;
		  done := TRUE;
		end
		else skip_frame(info);
d635 1
d637 1
a637 5
	      if size>0 then
	      begin
		next_baddr(info,ring,baddr);
		buf_fill := ADDR(cp(buf_fill)^,bsize);
	      end;
d682 1
a682 1
	  if ubuf<>nil then ubuf^.term_char := lb_sent; { packet was sent }
d695 1
a695 1
	  eot_parm := tx_ring_l; { status bits etc }
a696 1
	  active_isc := no_isc;  { no longer busy }
d698 1
a698 1
	tx_ub_out := (tx_ub_out+1) mod 64;
d867 1
a867 1
	old_level,card_level : integer;
a868 1
	card_level := card^.sc_reg.intlevel+3;
d870 1
a870 1
	if old_level<card_level then
d872 1
a872 1
	   setintlevel(card_level);
d933 1
a933 1
      ubufptr, temp2bp   : bp;
d936 1
a936 2
      old_level : integer;
      alloc_ok  : boolean;
d941 2
a942 4
      with info^, io_temps^ do
      begin
	ubufptr := out_bufptr; { snapshot out_bufptr }
	if ubufptr<>nil then
d944 6
d954 8
a961 27
	  if required>tx_buffer_size then
	     io_escape(ioe_no_space,io_temps^.my_isc); { will never ever fit }
	  repeat { wait for a ring element and enough space to free up }
	    setintlevel(7); { block ISRs during space check }
	    if tx_count=0 then
	    begin
	      avail1 := tx_buffer_size;
	      avail2 := 0;
	    end
	    else
	    if tx_next.int>tx_used.int then
	    begin
	      avail1 := txd_n.int-tx_next.int;
	      avail2 := tx_used.int-txd_1.int;
	    end
	    else
	    begin
	      avail1 := tx_used.int-tx_next.int;
	      avail2 := 0;
	    end;
	    setintlevel(old_level); { let ISRs run again }
	    alloc_ok := (tx_count<num_tx_buffers) and
			((avail1>=required) or (avail2>=required));
	    if not alloc_ok then
	    with card^ do
	    begin
	      if intlevel>=card_intlevel then
d963 13
a975 4
		repeat until sc_reg.ir;    { wait for interupt request }
		TRY
		  lan_isr(pisrib(io_temps)); { call the ISR procedure }
		RECOVER begin end;
d977 20
a996 2
	    end;
	  until alloc_ok or (out_bufptr=nil);
d998 1
a998 3
	  ubufptr := out_bufptr;
	  if ubufptr<>nil then
	  with ubufptr^ do
d1004 1
a1004 2
	  setintlevel(7);          { block ISRs until pointers are set }
	  if out_bufptr<>nil then
d1006 6
a1011 8
	    with tx_ring_f^ do
	    begin
	      bcnt := - required;
	      tmd3 := TMD3_RETURN;
	      ladr := tx_next.L16;
	      hadr := tx_next.H8;
	      tmd1_0 := tmd1_0_return; { set own stp enp to let card have buffer }
	    end;
d1013 1
a1013 2
	    TX_COUNT := TX_COUNT + 1;
	    lan_stats^[ltx_requests]:=lan_stats^[ltx_requests]+1;
d1015 2
a1016 2
	    tx_next.int := tx_next.int + required;
	    if tx_next.int>=txd_n.int then tx_next := txd_1;
d1018 2
a1019 2
	    tx_ring_f := ADDR(tx_ring_f^,sizeof(tx_ring_elt_type));
	    if tx_ring_f = txr_n then tx_ring_f := txr_1;
d1021 2
a1022 3
	    tx_user_buffs^[tx_ub_in] := out_bufptr;
	    tx_ub_in := (tx_ub_in+1) mod 64;
	  end;
d1025 5
a1030 2
	{ if no out_buffer then do nothing }
      end; { with info^ }
d1034 2
d1045 1
a1045 3
	  { get buffer capacity }
	  size := buf_size+integer(buf_ptr)-integer(buf_fill);
	  if size>=term_count then size := term_count;
d1049 4
a1052 2
	  moveleft(bp(bp(in_frame)^.buf_empty)^,bp(buf_fill)^,size);
	  term_count := size; { set amount actualy transfered }
d1055 5
a1059 5
	  bp(in_frame)^.buf_empty := ADDR(bp(bp(in_frame)^.buf_empty)^,size);
	  bp(in_frame)^.term_count := bp(in_frame)^.term_count-size;
	  if bp(in_frame)^.term_count=0 then
	  begin { release driver buffer for isr use }
	    bp(in_frame)^.active_isc := my_isc;
d1062 2
a1065 1
	  active_isc := no_isc;              { all done with users buffer }
@


1.1
log
@Initial revision
@
text
@@
