head     56.3;
access   ;
symbols  ;
locks    ; strict;
comment  @# @;


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

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

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

55.1
date     91.08.25.10.18.30;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.12.35.33;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.46.50;  author jwh;  state Exp;
branches ;
next     54.1;

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

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

52.1
date     91.02.19.09.08.53;  author jwh;  state Exp;
branches ;
next     51.2;

51.2
date     91.02.01.11.24.49;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.08.15;  author jwh;  state Exp;
branches ;
next     50.2;

50.2
date     91.01.02.10.10.27;  author jwh;  state Exp;
branches ;
next     50.1;

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

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

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

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

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

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

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

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

42.1
date     90.01.23.17.41.53;  author jwh;  state Exp;
branches ;
next     41.2;

41.2
date     90.01.18.09.48.41;  author dew;  state Exp;
branches ;
next     41.1;

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

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

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

38.1
date     89.08.29.11.23.22;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.23.14.06.56;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.36.18;  author dew;  state Exp;
branches ;
next     1.2;

1.2
date     89.05.11.11.44.28;  author quist;  state Exp;
branches ;
next     1.1;

1.1
date     89.05.09.11.03.47;  author quist;  state Exp;
branches ;
next     ;


desc
@This file allows SRM comunications over LAN
this implements the LAN protocol for SRM-UX
RDQ 9 may 89

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$MODCAL$
$DEBUG OFF$ $RANGE OFF$ $ALLOW_PACKED ON$
{ this version of LANSRM is designed to use the IP-UDP protocols }
{ lines with comment patch #1 are needed to clear out_bufptr.
  The LAN driver should have cleared it before calling any
  wrapper procedure.
}
MODULE LANSRM;
 $SEARCH 'IOLIB:KERNEL'$
 $SEARCH 'IOLIB:LANASM','IOLIB:LANDECS'$
 { $SEARCH 'LANDECS'$ }

IMPORT SYSGLOBALS,LANDECS,
       IODECLARATIONS,GENERAL_0,
       ASM;

EXPORT
 $INCLUDE 'IOLIB:IOMPXDECS.TEXT'$
  { $INCLUDE 'IOMPXDECS.TEXT'$ }
  TYPE
    lsrm_unit_ptr   = ^lsrm_unit_entry;
    lsrm_unit_entry = record
			hostladdr : link_address_type;
			mynode    : shortint; { fake SRM node }
			hostnode  : shortint; { fake SRM node }
			my_ip     : integer;  { IP }
			host_ip   : integer;  { IP }
			my_port   : shortint; { UDP }
			host_port : shortint; { UDP }
			session   : shortint;
			sequence  : byte;
			connected : boolean;
		      end;
    lsrm_table_type = array [unitnum] of lsrm_unit_entry;
    lsrm_table_ptr  = ^lsrm_table_type;
    check_type      = (is_ok,is_done,is_reject);
  VAR
    iompx_info      : iompx_info_ptr;
    lsrm_unit_table : lsrm_table_ptr;
    lastunit        : unitnum;
    lastsc          : type_isc;

  procedure lansrm_init(var srmbuf : buf_info_type);
  function  lansrm_connect:boolean;
  procedure lansrm_ok(var sc:integer);
  procedure lansrm_reset(sc : integer);
  procedure lansrm_init_unit(un : integer);

IMPLEMENT
$LINENUM 5000$
{ $SEARCH 'LANDECS','LANASM'$ }
  IMPORT LANASM;
  TYPE
    timeout_arr=array[1..4] of integer;

  CONST
    e_broadcast = #255#255#255#255#255#255;
    ip_protocol  = hex('0800');
    arp_protocol = hex('0806');

    udp_service_port = 570; { UDP server port number }
    udp_my_port      = 570; { UDP my port number }

    { Modified 1/2/91 JWH - now same as BASIC : }
    { connect_timeout is now a variable - it is set in }
    { routine lansrm_connect }

    { connect_timeout = 0500; .5 seconds }
    boot_connect_timeout = 20000;   { 20 seconds }
    broadcast_connect_timeout = 4000;   { 4 seconds }

    { Modified 1/2/91 JWH - now same as BASIC : }
    { connect_tries   = 2; }
    connect_tries   = 3;

    { Modified 1/2/91 JWH - now same as BASIC : }
    { op_timeout      = timeout_arr[15000, 5000, 700, 20000]; }
    op_timeout      = timeout_arr[60000, 15000, 5000, 60000];
    op_tries        = 3;

    { PACKET CODES }
    lsrm_request_code = 1;      { want to connect }
    lsrm_reply_code   = 129;
    tfr_request_code  = 2;      { data movement   }
    tfr_reply_code    = 130;
    { p_version         = 10; }     { protocol version }
    p_version         = 11;      { protocol version }
    { RETURN CODES }
    L_NO_ERROR = 0;
    L_LENGTHEN_TIMEOUT = 1;
    L_SERVER_BUSY      = 2;     { NI on server }
    L_BAD_SEQUENCE_NUMBER = 3;  { NI }
    L_BAD_SESSION= 4;   { NEED TO RECONNECT }
    L_BAD_SIZE   = 5;           { NI }
    L_BAD_PACKET = 6;           { NI }
    L_ABORTED    = 7;   { SERVER GOING DOWN, NI on server }

    ip_sap       = 6;
    udp_protocol = 17;
    ip_version   = 4;

  TYPE
    byte_ptr  = ^byte;
    cp        = ^char;

    bits1 = 0..1;
    bits2 = 0..3;
    bits3 = 0..7;
    bits4 = 0..15;
    bits5 = 0..31;
    bits6 = 0..63;
    bits7 = 0..127;
    bits8 = 0..255;
    bits13= 0..8191;
    bits14= 0..16383;
    bits16= 0..65535;
    bits21= 0..2097151;
    bits24= 0..16777215;

    ether_hdr_ptr = ^ether_hdr_type;
    ether_hdr_type = packed record
		       e_destination,
		       e_source   : link_address_type;
		       ether_type : shortint;
		     end;

    ip_hdr_ptr = ^ip_hdr;
    ip_hdr = packed record
	       version : bits4;
	       ihl     : bits4;
	       service : bits8;
	       length  : bits16;
	       id      : bits16;
	       flags   : bits3;
	       frag_offset : bits13;
	       ttl     : bits8;
	       protocol: bits8;
	       hdr_check      : shortint;
	       ip_source      : integer;
	       ip_destination : integer;
	     end;

    udp_hdr_ptr = ^udp_hdr;
    udp_hdr = packed record
		udp_source,
		udp_destination : bits16;
		udp_len  : bits16;
		udp_chk  : bits16;
	      end;

    arp_ptr = ^arp_rec;
    arp_rec = packed record
		htype : bits16;
		ptype : bits16;
		hal   : bits8;
		pal   : bits8;
		arp_op: bits16;
		senderl : link_address_type;
		senderp : integer;
		targetl : link_address_type;
		targetp : integer;
	      end;

    { lan_srm packet formats }
    lsrm_request_ptr = ^lsrm_request_type;
    lsrm_request_type = packed record { OUTBOUND }
			  rec_type    : shortint;{    1 }
			  ret_code    : shortint;{    0 }
			  option_code : shortint;{ reserved @@ 0 }
			  host_node   : shortint;
			  version     : shortint;{ protocol version }
			  my_station  : link_address_type;
			end;
    lsrm_reply_ptr = ^lsrm_reply_type;
    lsrm_reply_type = packed record { INBOUND }
			rec_type   : shortint;  { 129 }
			ret_code   : shortint;
			host_ip    : integer;   { may contain the host ip address }
			my_ip      : integer;   { IP }
			option_code: shortint;  { reserved @@ 0 }
			host_node  : shortint;  { host SRM node }
			version    : shortint;
			my_node    : shortint;
			my_station : link_address_type; { for verification }
			host_flag  : byte;     { = 0 get ip & station from headers,
						<> 0 use host_ip field & ARP to get station }
		       {sys_name   : string255;  not used }
		      end;

    tfr_request_ptr = ^tfr_request_type;
    tfr_data_type   = packed array[1..lan_max_frame_len] of char;
    tfr_data_ptr    = ^tfr_data_type;
    tfr_request_type = packed record { DATA IN & OUT }
			 rec_type   : shortint; { 2 | 130 }
			 ret_code   : shortint;
			 session_id : shortint; { echoed from last packet }
			 version    : shortint; { constant }
			 host_node  : shortint; { same as in contact record }
			 unum       : byte;  { unum + sequence_no }
			 sequence_no: byte;  { seen as single field by server }
			{data       : tfr_data_type;}
		       end;

    lsrm_sctable_eptr = ^lsrm_sctable_entry;
    lsrm_sctable_entry = record
			   localaddr : link_address_type;
			   mpxinw    : iompx_rec;
			 end;

    lsrm_sctable_type = array [type_isc] of lsrm_sctable_entry;
    lsrm_sctable_ptr  = ^lsrm_sctable_type;
    link_address_ptr  = ^link_address_type;

  CONST
    ll_hdr_size = sizeof(ether_hdr_type);
    ip_size  = sizeof(ip_hdr);
    udp_size = sizeof(udp_hdr);
    req_size = sizeof(lsrm_request_type);
    reply_size = sizeof(lsrm_reply_type);
    tfr_req_size = sizeof(tfr_request_type);

  VAR
    lsrm_sctable    : lsrm_sctable_ptr;
    inworkbuf,
    outworkbuf      : BUFxINFOxPTR;
    current_ip      : ip_hdr_ptr;       { ip/udp }
    op_done         : shortint;
    { Added 1/2/91 JWH : }
    connect_timeout : integer;

  FUNCTION  buffer_busy( VAR b_info: buf_info_type ): BOOLEAN;
    BEGIN
      WITH b_info DO buffer_busy := active_isc <> no_isc;
    END; { buffer_busy }

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER ) ;
    BEGIN
      WITH b_info DO
	BEGIN
	  { what about IOBUFFER to a already existant buffer ? }
	  { - the space will be thrown away. }

	  NEWBYTES(buf_ptr,t_count);

	  act_tfr   := no_tfr;
	  active_isc:= no_isc;
	  buf_size  := t_count;
	  buf_empty := buf_ptr;
	  buf_fill  := buf_ptr;

	  drv_tmp_ptr       := NIL;
	  eot_proc.dummy_sl := NIL;
	  eot_proc.dummy_pr := NIL;
	  eot_parm          := NIL;               {JPC  02/22/82}
	  dma_priority      := FALSE ;
	END; { of WITH DO }
    END; { iobuffer }

  FUNCTION  buffer_data(VAR b_info : buf_info_type ): INTEGER;
    BEGIN
      WITH b_info DO buffer_data:=INTEGER(buf_fill)-INTEGER(buf_empty);
    END; { buffer_data }

  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
    BEGIN
      WITH b_info DO
      BEGIN
	IF active_isc = no_isc THEN
	  BEGIN
	    buf_fill:=buf_ptr;
	    buf_empty:=buf_ptr;
	  END
	ELSE io_escape(ioe_buf_busy,no_isc);
      END; { of WITH DO }
    END; { buffer_reset }

  FUNCTION  buffer_space(VAR b_info: buf_info_type): INTEGER;
  BEGIN
    WITH b_info DO
    BEGIN
      IF ( buffer_data(b_info)=0 ) AND
	 ( active_isc = no_isc )   THEN buffer_reset(b_info);
      buffer_space:=buf_size+INTEGER(buf_ptr)-INTEGER(buf_fill);
    END; { of WITH DO }
  END; { buffer_space }

  procedure init_buffer(var buf : buf_info_type;
		    anyvar data : integer; size : integer);
    begin
      with buf do
      begin
	buf_ptr    := addr(data);
	buf_size   := size;
	buf_empty  := buf_ptr;
	buf_fill   := buf_ptr;
	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; { init_buffer }

  FUNCTION  transfer_setup ( device    : type_device;
			     t_tfr     : user_tfr_type;
			     t_dir     : dir_of_tfr ;
			     VAR b_info: buf_info_type ;
			     VAR t_cnt : INTEGER ): type_isc ;
    VAR io_isc : type_isc;
    BEGIN

      IF device>iomaxisc THEN io_isc := device DIV 100
			 ELSE io_isc := device;

      IF isc_table[io_isc].io_tmp_ptr = NIL
			 THEN io_escape(ioe_no_driver,io_isc);

      WITH b_info DO
      BEGIN
	{ test for tfr count }
	IF t_cnt=0 THEN io_escape(ioe_bad_cnt,no_isc);

	{ test for another tfr on this buffer }
	IF active_isc <> no_isc THEN io_escape(ioe_buf_busy,no_isc)
	ELSE
	  BEGIN
	    IF buffer_data(b_info)=0 THEN buffer_reset(b_info);
	  END;

	{ configure card based on direction and check for available space/data }
	IF t_dir= to_memory THEN
	BEGIN
	  IF (t_tfr<>dummy_tfr_1) and (t_tfr<>dummy_tfr_2) THEN
	    IF isc_table[io_isc].io_tmp_ptr^.in_bufptr <> NIL
	      THEN io_escape(ioe_isc_busy,io_isc);

	  IF buffer_space(b_info)<t_cnt THEN io_escape(ioe_no_space,io_isc);

	  IF (t_tfr<>dummy_tfr_1) and (t_tfr<>dummy_tfr_2) THEN
	    isc_table[io_isc].io_tmp_ptr^.in_bufptr :=  ADDR( b_info );
	END
	ELSE
	BEGIN { from_memory }
	  IF isc_table[io_isc].io_tmp_ptr^.out_bufptr <> NIL THEN
	      io_escape(ioe_isc_busy,io_isc);

	  IF buffer_data(b_info)<t_cnt THEN io_escape(ioe_no_data,io_isc);

	  isc_table[io_isc].io_tmp_ptr^.out_bufptr :=  ADDR( b_info );
	END; { of IF }

	drv_tmp_ptr:= isc_table[io_isc].io_tmp_ptr;
	act_tfr    := no_tfr;
	usr_tfr    := t_tfr;
	b_w_mode   := FALSE;                      { byte mode }
	end_mode   := FALSE;                      { no EOI }
	direction  := t_dir;
	term_char  := -1;                         { no termination character }
	term_count := t_cnt;

      END; { of WITH b_info DO }

      transfer_setup := io_isc;

    END; { of transfer_setup }

  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
    VAR io_isc    : type_isc;
	t_count   : INTEGER;
    BEGIN
      t_count:=x_count;
      io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

      { transfer temporary was set up in transfer_setup }

      WITH isc_table[io_isc]
      DO CALL ( io_drv_ptr^.iod_tfr ,
		isc_table[io_isc].io_tmp_ptr,
		ADDR(b_info) );
    END; { transfer }

  procedure copy_buffer_data(var src,dest  : buf_info_type;
				 skip,move : integer);
    begin
      if skip>0 then
      begin
	if skip>src.term_count then skip := src.term_count;
	src.buf_empty := ADDR(cp(src.buf_empty)^,skip);
	src.term_count := src.term_count - skip;
      end;

      if move>0 then
      begin
	if move>src.term_count then move := src.term_count;
	if move>dest.term_count then move := dest.term_count;
	moveleft(cp(src.buf_empty)^,cp(dest.buf_fill)^,move);
	src.term_count := src.term_count - move;
	src.buf_empty := ADDR(cp(src.buf_empty)^,move);
	dest.term_count := move;
	dest.buf_fill := ADDR(cp(dest.buf_fill)^,move);
      end;
    end; { copy_buffer_data }

  procedure build_frame(var dest   : buf_info_type;
			var unit_r : lsrm_unit_entry;
			var sc_r   : lsrm_sctable_entry;
			anyvar buf1: tfr_data_type; size1 : shortint;
			anyvar buf2: tfr_data_type; size2 : shortint);
    var
      tempp : anyptr;
    begin
      buffer_reset(dest);
      tempp := dest.buf_fill;
      { build the protocol stack into the buffer }
      with ether_hdr_ptr(tempp)^ do
      begin
	e_destination   := unit_r.hostladdr;
	e_source        := sc_r.localaddr;
	ether_type      := ip_protocol;
      end;
      tempp := addr(cp(tempp)^,ll_hdr_size);

      with ip_hdr_ptr(tempp)^ do
      begin
	version := ip_version;
	ihl     := ip_size div 4;
	service := 0;
	length  := ip_size + udp_size + size1 + size2;
	id      := 0;
	flags   := 0;
	frag_offset := 0;
	ttl     := 255;
	protocol:= udp_protocol;
	hdr_check := 0;
	ip_source := unit_r.my_ip;
	ip_destination := unit_r.host_ip;
	checksum1(hdr_check,cp(tempp)^,ip_size div 2);
      end;
      tempp := addr(cp(tempp)^,ip_size);

      with udp_hdr_ptr(tempp)^ do
      begin
	udp_source := unit_r.my_port;
	udp_destination := unit_r.host_port;
	udp_len  := udp_size + size1 + size2;
	udp_chk  := 0;  { no check sum }
      end;
      tempp := addr(cp(tempp)^,udp_size);

      { copy the data buffer(s) }
      if size1>0 then
      begin
	moveleft(buf1,cp(tempp)^,size1);
	tempp := addr(cp(tempp)^,size1);
      end;
      if size2>0 then
      begin
	moveleft(buf2,cp(tempp)^,size2);
	tempp := addr(cp(tempp)^,size2);
      end;

      dest.buf_fill := tempp;

    end; { build_frame }

  procedure eot_rearm(buf : ANYPTR);
    begin
      with BUFxINFOxPTR(buf)^ do
      begin
	if (term_char=lb_eot) or (term_char=lb_short) then
	begin
	  active_isc := lastsc;         { re-arm this buffer }
	  eot_proc.dummy_pr := nil ;    { kill the eot proc }
	end;
      end;
    end; { eot_rearm }

  procedure check_frame(var source : buf_info_type;
			var unit_r : lsrm_unit_entry;
			var sc_r   : lsrm_sctable_entry;
			var ok     : check_type;
			var data   : anyptr;
			var size   : shortint);
    label 1;
    var
      check   : shortint;
      tempbuf : buf_info_type;
    begin
      ok   := is_reject;
      data := source.buf_empty;
      with ether_hdr_ptr(data)^ do
      begin
	if ether_type=arp_protocol then
	with arp_ptr(addr(cp(data)^,14))^ do
	begin { arp }
	  if lsrm_unit_table^[lastunit].my_ip=0 then goto 1;
	  if not((htype=1) and           { ethernet }
		 (ptype=ip_protocol) and { ip }
		 (arp_op=1) and          { request }
		 (targetp = unit_r.my_ip)
		 ) then goto 1;
	  { now try to reply }
	  e_source := sc_r.localaddr ;
	  e_destination := senderl;
	  targetl := senderl;
	  targetp := senderp;
	  senderl := e_source;
	  senderp := unit_r.my_ip;
	  arp_op := 2; {reply}
	  check  := buffer_data(source);
	  init_buffer(tempbuf,cp(data)^,check);
	  tempbuf.buf_fill := addr(cp(tempbuf.buf_fill)^,check);
	  try
	    transfer(lastsc,overlap,from_memory,tempbuf,check);
	  recover begin end; { might not work }
	  ok := is_done;
	  goto 1;
	end
	else
	if (ether_type<>ip_protocol) then goto 1
	else
	if (e_destination<>sc_r.localaddr) then
	begin
	  if (e_destination<>e_broadcast) then goto 1;
	end;
      end;

      current_ip := addr(cp(data)^,14); { locate the IP header }
      { check ip for udp protocol }
      with current_ip^ do
      begin
	if not (version=ip_version) and
	       (protocol=udp_protocol) then goto 1;
	if length>lan_max_frame_len then goto 1;
	data := addr(current_ip^,ihl*4); { locate the UDP header }
      end;
      { check udp port number }
      if udp_hdr_ptr(data)^.udp_destination <> unit_r.my_port then goto 1;
      { looks like the right stuff so now check it in detail }

      with current_ip^ do
      begin
	checksum1(check,current_ip^,ihl*2);
	if check<>0 then goto 1;    { checksum failed }
	if frag_offset<>0 then goto 1; { can't handle fragments }
      end;

      with udp_hdr_ptr(data)^ do
      begin
	size := udp_len-8;
	data := addr(cp(data)^,udp_size); { point to data area }
      end;
      ok := is_ok;
     1:
    end; { check_frame }

  function get_host_ip:integer;
    begin
      get_host_ip := current_ip^.ip_source;
    end; { get_my_ip }

  procedure get_host_station(RBUF:BUFxINFOxPTR);
    begin { this will use ARP to find the host station address }
    end;

  PROCEDURE WRAPPER1(TEMP : ANYPTR; VAR B:BOOLEAN);
  { adds lower level protocol stuff to lsrm_reqest packet }

    BEGIN
      with iompx_rec_ptr(temp)^ do
      begin
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }

	build_frame(outworkbuf^,lsrm_unit_table^[lastunit],
				lsrm_sctable^[scode],
				cp(user_buffer^.buf_empty)^,buffer_data(user_buffer^),
				user_buffer,0); { these are dummy arguments }

	transfer(scode,serial_fastest,from_memory,outworkbuf^,buffer_data(outworkbuf^));

      end; { with mpxr^ }
      b   := false; { its gone }
    END; {WRAPPER1}

  PROCEDURE CHECKER1(TEMP : ANYPTR; VAR B:BOOLEAN);
    label 1;
    VAR
      mpxr   : iompx_rec_ptr;
      lutable: lsrm_unit_ptr;
      sctable: lsrm_sctable_eptr;
      dsize  : shortint; { total frame size }
      tempp  : anyptr;
      ok     : check_type;
    BEGIN
      mpxr := temp;
      b    := true;
      with mpxr^ do
      if in_buffer<>nil then
      begin
	lutable := addr(lsrm_unit_table^[lastunit]);
	sctable := addr(lsrm_sctable^[scode]);

	check_frame(in_buffer^,lutable^,sctable^,ok,tempp,dsize);
	if ok=is_done then
	{ signal that this data is accepted & setup to re-arm the buffer }
	begin  b:= false;
	       user_buffer^.eot_proc.real_proc := eot_rearm;
	end;
	if ok<>is_ok then goto 1;

	if dsize<sizeof(lsrm_reply_type) then goto 1;

	{ check the reply contents }
	with lsrm_reply_ptr(tempp)^ do
	begin
	  if not ((rec_type=lsrm_reply_code) and
		  (ret_code=0) and
		  (option_code=0) and
		  (version=p_version))
	     then goto 1;
	  if my_station<>sctable^.localaddr then goto 1;

	  { save addresses }
	  lutable^.my_ip := my_ip;
	  lutable^.hostnode := host_node;
	  { adjust addresses/ports as required }
	  if host_flag=0 then lutable^.host_ip := get_host_ip
			 else lutable^.host_ip := host_ip;
	  lutable^.host_port := udp_service_port;

	  with lutable^ do
	  begin
	    session   := -1;
	    sequence  := 0;
	    mynode    := my_node;
	    if host_flag<>0 then get_host_station(in_buffer);
	    hostladdr := ether_hdr_ptr(in_buffer^.buf_empty)^.e_source;
	  end;
	end;

	{ tell caller to complete the transfer }
	b := false;
	in_buffer^.term_count := 0; { checked/moved it all }
	with user_buffer^ do
	begin
	  cp(buf_fill)^ := 'G';
	  buf_fill := addr(cp(buf_fill)^,1);
	  term_count := 1;
	end;
      end; { with mpxr }
    1:
    END; {CHECKER1}

  { normal operations wrapper procedure }
  PROCEDURE WRAPPER2(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr    : iompx_rec_ptr;
      lutable : lsrm_unit_ptr;
      sctable : lsrm_sctable_eptr;
      old_seq : byte;
      do_rx,
      do_tx   : boolean;
      op_timer        : timer_rec;
      op_retries      : integer;
      lastsize        : integer;

      procedure load_work_buf;
	var
	  tfr: tfr_request_type;
	begin
	  with mpxr^ do
	  begin
	    with tfr do
	    begin
	      rec_type    := tfr_request_code;
	      ret_code    := 0;
	      session_id  := lutable^.session;
	      version     := p_version;
	      host_node   := lutable^.hostnode;
	      unum        := lastunit;
	      sequence_no := lutable^.sequence;
	    end; { with }

	    build_frame(outworkbuf^,lutable^,
				    sctable^,
				    tfr,sizeof(tfr),
				    cp(user_buffer^.buf_empty)^,buffer_data(user_buffer^));
	  end; { with }
	end; { load_work_buf }

    BEGIN { WRAPPER2 }
      mpxr := temp;
      with mpxr^ do
      begin
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }
	lutable := addr(lsrm_unit_table^[lastunit]);
	sctable := addr(lsrm_sctable^[scode]);
	with lutable^ do
	begin
	  if not connected then
	    if lansrm_connect then connected := true
			      else io_escape(ioe_dc_conn,lastsc);
	end;
	{ don't send the first byte of data }
	with user_buffer^ do
	begin
	  buf_empty := addr(cp(buf_empty)^,1);
	end;

	load_work_buf;

	with sctable^.mpxinw do
	  user_buffer := user_buffer^.eot_parm; { goto next input buffer }

	op_retries := op_tries;
	lastsize   := buffer_data(outworkbuf^);
	do_rx      := true;
	do_tx      := true;

	repeat
	  op_done  := -1;
	  if do_rx then
	    with sctable^.mpxinw do
	    begin
	      do_rx := false;
	      buffer_reset(user_buffer^);
	      transfer(scode,dummy_tfr_2,to_memory,user_buffer^,lan_max_frame_len);
	    end;

	  if do_tx then
	    begin
	      with outworkbuf^ do buf_empty := buf_ptr; { reset buf_empty }
	      transfer(scode,overlap_fastest,from_memory,outworkbuf^,lastsize);
	      while outworkbuf^.active_isc<>no_isc do; { wait for this to go out }
	    end;
	  do_tx := true;

	  { start timeout timeing }
	  op_timer.time := op_timeout[op_retries]; start_timer(op_timer);
	  op_retries := op_retries-1;

	  { wait for packet received or timeout }
	  repeat until (op_done<>-1) or time_expired(op_timer);

	  { set do_rx in case of need to loop again }
	  do_rx := op_done>0;

	  case op_done of
	   0:; { ok }
	   1,2:{ lengthen timeout or server busy }
	     begin      { go to long timeout }
	       op_retries := op_tries+1;
	       do_tx      := false;     { don't resend the packet }
	     end;
	   4:io_escape(ioe_dc_conn,lastsc); { bad_session }
	   7:io_escape(ioe_sr_fail,lastsc); { server going down }
	   otherwise
	     { timeout or unimplemented return code }
	     if (op_retries<=0) then
	       with sctable^.mpxinw do
	       begin
		 user_buffer^.active_isc := no_isc; { stop the transfer }
		 buffer_reset(user_buffer^);
		 lsrm_unit_table^[lastunit].connected := false;
		 io_escape(ioe_sr_fail,lastsc);
	       end;
	  end; { case }
	until op_done=0;
	{ fix up the callers buf_empty pointer }
	with user_buffer^ do buf_empty := addr(cp(buf_empty)^,buffer_data(user_buffer^));
      end; { with mpxr^ }
      b   := false; { tell caller the xfr is done }
    END; {WRAPPER2}

  PROCEDURE CHECKER2(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr   : iompx_rec_ptr;
    BEGIN
      mpxr := temp;
      with mpxr^ do
      begin
	if in_buffer=nil then
	begin { get data from inworkbuf }
	  if inworkbuf^.active_isc = no_isc then
	  begin { copy every thing }
	    copy_buffer_data(inworkbuf^,user_buffer^,0,maxint);
	    { if no more data in the source then switch to next buffer }
	    if inworkbuf^.term_count=0 then
	       inworkbuf := inworkbuf^.eot_parm;

	    if user_buffer^.term_count=0 then
	      io_escape(ioe_no_data,no_isc);
	    b := false; { data has been moved }
	  end
	  else io_escape(ioe_sr_fail,no_isc);
	end
	else b := true; { reject it }
      end;
    END; { CHECKER2 }

  PROCEDURE CHECKER3(TEMP : ANYPTR; VAR B:BOOLEAN);
    label 1;
    VAR
      mpxr   : iompx_rec_ptr;
      lutable: lsrm_unit_ptr;
      tempp  : anyptr;
      dsize  : shortint;
      ok     : check_type;
    BEGIN
      mpxr := temp;
      b    := true; { reject it }
      with mpxr^ do
      begin
	lutable := addr(lsrm_unit_table^[lastunit]);
	if in_buffer<>nil then
	with in_buffer^ do
	begin
	  check_frame(in_buffer^,lutable^,lsrm_sctable^[scode],ok,tempp,dsize);
	  if ok=is_done then
	  { signal that this data is accepted & setup to re-arm the buffer }
	  begin  b:= false;
		 user_buffer^.eot_proc.real_proc := eot_rearm;
	  end;
	  if ok<>is_ok then goto 1;

	  { check the reply contents }
	  with tfr_request_ptr(tempp)^ do
	  begin
	    if not ((rec_type=tfr_reply_code) and
		    (version = p_version) and
		    (host_node = lutable^.hostnode) and
		    (sequence_no=lutable^.sequence) and
		    (unum=lastunit)) then goto 1;
	    op_done := ret_code;
	  end;

	  if op_done=0 then
	  begin
	    { set the next expected sequence number }
	    lutable^.sequence := (lutable^.sequence+1) mod 256;
	    lutable^.session  := tfr_request_ptr(tempp)^.session_id;
	    {skip all lsrm header then move the data}
	    tempp := addr(cp(tempp)^,tfr_req_size);
	    dsize := dsize - tfr_req_size;
	    if dsize>0 then
	    begin
	      with user_buffer^ do
	      begin
		if dsize>term_count then dsize := term_count;
		moveleft(cp(tempp)^,cp(buf_fill)^,dsize);
		term_count := dsize;
		buf_fill := ADDR(cp(buf_fill)^,dsize);
	      end;
	    end;
	  end;
	  b := false;   { tell caller its processed }
	end; { with in_buffer }
      end; { with mpxr }
    1:
    END; {CHECKER3}

  function lansrm_connect:boolean;

    VAR
      mpxout,
      mpxin     : iompx_rec;
      lutable   : lsrm_unit_ptr;
      utable    : ^unitentry;

      bufin     : buf_info_type;
      datai     : char;

      bufout    : buf_info_type;
      datao     : lsrm_request_type;

      timer     : timer_rec;
      tries     : integer;
      i         : integer;

      done      : boolean;
      farea[-300] : link_address_ptr;

    BEGIN { lansrm_connect }
      done    := false;
      lutable := addr(lsrm_unit_table^[lastunit]);
      utable  := addr(unitable^[lastunit]);
      with lutable^ , iompx_info^ do
      begin
	with utable^ do
	begin
	  TRY
	    { setup the input side }
	    CALL(register_iompx_buf,
		 sc,TO_MEMORY,bufin,mpxin,FALSE,lutable,checker1);
	    { setup the output side }
	    CALL(register_iompx_buf,
		 sc,FROM_MEMORY,bufout,mpxout,FALSE,lutable,wrapper1);

	    { start the input transfer for one byte }
	    init_buffer(bufin,datai,1);
	    datai := 'F';
	    transfer(sc,dummy_tfr_2,to_memory,bufin,1);

	   { build & transmit the request }
	    with datao do
	    begin
	      rec_type    := lsrm_request_code;
	      ret_code    := 0;
	      option_code := 0;
	      host_node   := BA; { from unitable^ }
	      version     := p_version;
	      my_station  := lsrm_sctable^[lastsc].localaddr;
	    end;
	    { if boot device then use the host address else use the broadcast }
	    { Enhanced 1/2/91 JWH to set the connect_timeout variable JWH }
	    if BA=127 then
	      begin
	       lutable^.hostladdr := farea^;
	       connect_timeout := boot_connect_timeout;
	      end
	     else
	      begin
	       lutable^.hostladdr := e_broadcast;
	       connect_timeout := broadcast_connect_timeout;
	      end;
	    my_port := udp_my_port;

	    init_buffer(bufout,datao,sizeof(datao));
	    bufout.buf_fill := addr(bufout.buf_ptr^,sizeof(datao));
	    tries := connect_tries;
	    repeat
	      { send the request and start the timer }
	      transfer(sc,serial_fastest,from_memory,bufout,sizeof(datao));
	      timer.time := connect_timeout; start_timer(timer);
	      repeat
		if (not done) and (not buffer_busy(bufin)) then
		begin
		  done := datai='G';
		  if not done then { restart the input transfer }
		  begin
		    buffer_reset(bufin); datai := 'F';
		    transfer(sc,dummy_tfr_2,to_memory,bufin,1);
		  end;
		end; { while }
	      until done or time_expired(timer);
	      if not done then tries := tries-1;
	    until done or (tries=0);

	  RECOVER { suppress every error }
	    begin end;

	  call(unregister_iompx_buf,sc,TO_MEMORY,bufin);
	  call(unregister_iompx_buf,sc,FROM_MEMORY,bufout);

	end;
      end; {with lsrm_isc_table}
      lansrm_connect := done;
    END; { lansrm_connect }

  { called by table before it does a hook up }
  procedure lansrm_ok(var sc : integer);
    begin
      if iompx_info<>nil then
      begin
	if (sc>=minrealisc) and (sc<=maxrealisc) then
	begin
	  if (iompx_info^.isc_iompx_table[sc].capable) and
	     (isc_table[sc].card_id = hp98643) then SC := -SC;
	end;
      end;
    end; { lansrm_ok }

  procedure lansrm_reset(sc:integer);
    begin
      with lsrm_sctable^[sc].mpxinw do
      begin
	user_buffer^.active_isc := no_isc;
	inworkbuf := user_buffer^.eot_parm;
	inworkbuf^.active_isc := no_isc;
      end;
    end; { lansrm_reset }

  procedure lansrm_init_unit(un: integer);
    begin
      with lsrm_unit_table^[un] do
      begin
	 hostladdr := e_broadcast;
	 mynode    := 0;
	 hostnode  := 0;
	 my_ip     := 0;
	 host_ip   := -1;
	 my_port   := udp_my_port;
	 host_port := udp_service_port;
	 session   := -1;
	 sequence  := 0;
	 connected := false;
      end;
    end; { lansrm_init_unit }

  { if IOMPX is installed then
    scan the select codes for a LAN card & driver using IOMPX
    for each one found, register the srm driver buffer & a working buffer
    if any suitable interfaces were found, allocate & initialize the
    shadow unit table
  }
  procedure lansrm_init(var srmbuf : buf_info_type);
    VAR
      i,
      sc        : integer;
      ok        : boolean;
      ans       : iompx_ans_rec;
      lutable   : lsrm_unit_ptr;
      mpxout,
      mpxin     : iompx_rec_ptr;
      inworkbuf2   : BUFxINFOxPTR;
      BMSUS[-292]  : PACKED ARRAY [1..4] OF CHAR;
    BEGIN { LANSRM_INIT }
      mpxout := nil;
      mpxin  := nil;
      { allocate & init the shadow unit table }
      if lsrm_unit_table=nil then
      begin
	{ modify boot MSUS for power up from LAN }
	if ORD(BMSUS[1])=HEX('E2') then
	begin { booted from LAN }
	  BMSUS[2] := #8; { unit 8 }
	  BMSUS[4] := #127; { boot node }
	end;

	if iompx_info=nil then
	begin
	  call(io_error_link,iompx_request,ans.s);
	  ok := ans.s=iompx_answer;
	  if ok then iompx_info := ans.ptr;
	end;
	if ok then
	begin
	  ok := false;
	  for sc := minrealisc to maxrealisc do
	  with iompx_info^ do
	  begin
	    if isc_iompx_table[sc].capable then
	    with isc_table[sc] do
	    begin
	      if (card_id=hp98643) then
	      begin { register the buffers }
		if lsrm_sctable=nil then new(lsrm_sctable); { allocate shadow sc table }
		ok := true; { at least one setup }

		with lsrm_sctable^[sc] do
		for i := 1 to 6 do
		begin
		  localaddr[i] := chr(iostatus(sc,l_link_addr1-1+i));
		end;

		if inworkbuf=nil then
		begin
		  new(inworkbuf);
		  IOBUFFER(inworkbuf^,LAN_MAX_FRAME_LEN);
		  new(inworkbuf2);
		  IOBUFFER(inworkbuf2^,LAN_MAX_FRAME_LEN);
		  { chain link the buffers thru eot_parm }
		  inworkbuf^.eot_parm := inworkbuf2;
		  inworkbuf2^.eot_parm := inworkbuf;
		  new(outworkbuf);
		  IOBUFFER(outworkbuf^,LAN_MAX_FRAME_LEN);
		end;
		{ setup the input side }
		{ need unique registration records for each select code }
		new(mpxin);
		CALL(register_iompx_buf,
		     sc,TO_MEMORY,srmbuf,mpxin^,FALSE,lutable,checker2);
		with lsrm_sctable^[sc] do
		begin
		  CALL(register_iompx_buf,
		       sc,TO_MEMORY,inworkbuf^,mpxinw,FALSE,lutable,checker3);
		  lansrm_reset(sc);   { fix up data structures used by wrapper2 etc. }
		end;
		{ setup the output side }
		new(mpxout);
		CALL(register_iompx_buf,
		     sc,FROM_MEMORY,srmbuf,mpxout^,FALSE,lutable,wrapper2);
	      end;
	    end;
	  end;

	  if ok then
	  begin
	    new(lsrm_unit_table);
	    for i := 0 to maxunit do lansrm_init_unit(i);
	  end
	  else iompx_info := nil; { no LAN }
	end;
      end;
    END; { lansrm_init }

END. { MODULE LANSRM }


@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1106
$MODCAL$
$DEBUG OFF$ $RANGE OFF$ $ALLOW_PACKED ON$
{ this version of LANSRM is designed to use the IP-UDP protocols }
{ lines with comment patch #1 are needed to clear out_bufptr.
  The LAN driver should have cleared it before calling any
  wrapper procedure.
}
MODULE LANSRM;
 $SEARCH 'IOLIB:KERNEL'$
 $SEARCH 'IOLIB:LANASM','IOLIB:LANDECS'$
 { $SEARCH 'LANDECS'$ }

IMPORT SYSGLOBALS,LANDECS,
       IODECLARATIONS,GENERAL_0,
       ASM;

EXPORT
 $INCLUDE 'IOLIB:IOMPXDECS.TEXT'$
  { $INCLUDE 'IOMPXDECS.TEXT'$ }
  TYPE
    lsrm_unit_ptr   = ^lsrm_unit_entry;
    lsrm_unit_entry = record
			hostladdr : link_address_type;
			mynode    : shortint; { fake SRM node }
			hostnode  : shortint; { fake SRM node }
			my_ip     : integer;  { IP }
			host_ip   : integer;  { IP }
			my_port   : shortint; { UDP }
			host_port : shortint; { UDP }
			session   : shortint;
			sequence  : byte;
			connected : boolean;
		      end;
    lsrm_table_type = array [unitnum] of lsrm_unit_entry;
    lsrm_table_ptr  = ^lsrm_table_type;
    check_type      = (is_ok,is_done,is_reject);
  VAR
    iompx_info      : iompx_info_ptr;
    lsrm_unit_table : lsrm_table_ptr;
    lastunit        : unitnum;
    lastsc          : type_isc;

  procedure lansrm_init(var srmbuf : buf_info_type);
  function  lansrm_connect:boolean;
  procedure lansrm_ok(var sc:integer);
  procedure lansrm_reset(sc : integer);
  procedure lansrm_init_unit(un : integer);

IMPLEMENT
$LINENUM 5000$
{ $SEARCH 'LANDECS','LANASM'$ }
  IMPORT LANASM;
  TYPE
    timeout_arr=array[1..4] of integer;

  CONST
    e_broadcast = #255#255#255#255#255#255;
    ip_protocol  = hex('0800');
    arp_protocol = hex('0806');

    udp_service_port = 570; { UDP server port number }
    udp_my_port      = 570; { UDP my port number }

    { Modified 1/2/91 JWH - now same as BASIC : }
    { connect_timeout is now a variable - it is set in }
    { routine lansrm_connect }

    { connect_timeout = 0500; .5 seconds }
    boot_connect_timeout = 20000;   { 20 seconds }
    broadcast_connect_timeout = 4000;   { 4 seconds }

    { Modified 1/2/91 JWH - now same as BASIC : }
    { connect_tries   = 2; }
    connect_tries   = 3;

    { Modified 1/2/91 JWH - now same as BASIC : }
    { op_timeout      = timeout_arr[15000, 5000, 700, 20000]; }
    op_timeout      = timeout_arr[60000, 15000, 5000, 60000];
    op_tries        = 3;

    { PACKET CODES }
    lsrm_request_code = 1;      { want to connect }
    lsrm_reply_code   = 129;
    tfr_request_code  = 2;      { data movement   }
    tfr_reply_code    = 130;
    { p_version         = 10; }     { protocol version }
    p_version         = 11;      { protocol version }
    { RETURN CODES }
    L_NO_ERROR = 0;
    L_LENGTHEN_TIMEOUT = 1;
    L_SERVER_BUSY      = 2;     { NI on server }
    L_BAD_SEQUENCE_NUMBER = 3;  { NI }
    L_BAD_SESSION= 4;   { NEED TO RECONNECT }
    L_BAD_SIZE   = 5;           { NI }
    L_BAD_PACKET = 6;           { NI }
    L_ABORTED    = 7;   { SERVER GOING DOWN, NI on server }

    ip_sap       = 6;
    udp_protocol = 17;
    ip_version   = 4;

  TYPE
    byte_ptr  = ^byte;
    cp        = ^char;

    bits1 = 0..1;
    bits2 = 0..3;
    bits3 = 0..7;
    bits4 = 0..15;
    bits5 = 0..31;
    bits6 = 0..63;
    bits7 = 0..127;
    bits8 = 0..255;
    bits13= 0..8191;
    bits14= 0..16383;
    bits16= 0..65535;
    bits21= 0..2097151;
    bits24= 0..16777215;

    ether_hdr_ptr = ^ether_hdr_type;
    ether_hdr_type = packed record
		       e_destination,
		       e_source   : link_address_type;
		       ether_type : shortint;
		     end;

    ip_hdr_ptr = ^ip_hdr;
    ip_hdr = packed record
	       version : bits4;
	       ihl     : bits4;
	       service : bits8;
	       length  : bits16;
	       id      : bits16;
	       flags   : bits3;
	       frag_offset : bits13;
	       ttl     : bits8;
	       protocol: bits8;
	       hdr_check      : shortint;
	       ip_source      : integer;
	       ip_destination : integer;
	     end;

    udp_hdr_ptr = ^udp_hdr;
    udp_hdr = packed record
		udp_source,
		udp_destination : bits16;
		udp_len  : bits16;
		udp_chk  : bits16;
	      end;

    arp_ptr = ^arp_rec;
    arp_rec = packed record
		htype : bits16;
		ptype : bits16;
		hal   : bits8;
		pal   : bits8;
		arp_op: bits16;
		senderl : link_address_type;
		senderp : integer;
		targetl : link_address_type;
		targetp : integer;
	      end;

    { lan_srm packet formats }
    lsrm_request_ptr = ^lsrm_request_type;
    lsrm_request_type = packed record { OUTBOUND }
			  rec_type    : shortint;{    1 }
			  ret_code    : shortint;{    0 }
			  option_code : shortint;{ reserved @@ 0 }
			  host_node   : shortint;
			  version     : shortint;{ protocol version }
			  my_station  : link_address_type;
			end;
    lsrm_reply_ptr = ^lsrm_reply_type;
    lsrm_reply_type = packed record { INBOUND }
			rec_type   : shortint;  { 129 }
			ret_code   : shortint;
			host_ip    : integer;   { may contain the host ip address }
			my_ip      : integer;   { IP }
			option_code: shortint;  { reserved @@ 0 }
			host_node  : shortint;  { host SRM node }
			version    : shortint;
			my_node    : shortint;
			my_station : link_address_type; { for verification }
			host_flag  : byte;     { = 0 get ip & station from headers,
						<> 0 use host_ip field & ARP to get station }
		       {sys_name   : string255;  not used }
		      end;

    tfr_request_ptr = ^tfr_request_type;
    tfr_data_type   = packed array[1..lan_max_frame_len] of char;
    tfr_data_ptr    = ^tfr_data_type;
    tfr_request_type = packed record { DATA IN & OUT }
			 rec_type   : shortint; { 2 | 130 }
			 ret_code   : shortint;
			 session_id : shortint; { echoed from last packet }
			 version    : shortint; { constant }
			 host_node  : shortint; { same as in contact record }
			 unum       : byte;  { unum + sequence_no }
			 sequence_no: byte;  { seen as single field by server }
			{data       : tfr_data_type;}
		       end;

    lsrm_sctable_eptr = ^lsrm_sctable_entry;
    lsrm_sctable_entry = record
			   localaddr : link_address_type;
			   mpxinw    : iompx_rec;
			 end;

    lsrm_sctable_type = array [type_isc] of lsrm_sctable_entry;
    lsrm_sctable_ptr  = ^lsrm_sctable_type;
    link_address_ptr  = ^link_address_type;

  CONST
    ll_hdr_size = sizeof(ether_hdr_type);
    ip_size  = sizeof(ip_hdr);
    udp_size = sizeof(udp_hdr);
    req_size = sizeof(lsrm_request_type);
    reply_size = sizeof(lsrm_reply_type);
    tfr_req_size = sizeof(tfr_request_type);

  VAR
    lsrm_sctable    : lsrm_sctable_ptr;
    inworkbuf,
    outworkbuf      : BUFxINFOxPTR;
    current_ip      : ip_hdr_ptr;       { ip/udp }
    op_done         : shortint;
    { Added 1/2/91 JWH : }
    connect_timeout : integer;

  FUNCTION  buffer_busy( VAR b_info: buf_info_type ): BOOLEAN;
    BEGIN
      WITH b_info DO buffer_busy := active_isc <> no_isc;
    END; { buffer_busy }

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER ) ;
    BEGIN
      WITH b_info DO
	BEGIN
	  { what about IOBUFFER to a already existant buffer ? }
	  { - the space will be thrown away. }

	  NEWBYTES(buf_ptr,t_count);

	  act_tfr   := no_tfr;
	  active_isc:= no_isc;
	  buf_size  := t_count;
	  buf_empty := buf_ptr;
	  buf_fill  := buf_ptr;

	  drv_tmp_ptr       := NIL;
	  eot_proc.dummy_sl := NIL;
	  eot_proc.dummy_pr := NIL;
	  eot_parm          := NIL;               {JPC  02/22/82}
	  dma_priority      := FALSE ;
	END; { of WITH DO }
    END; { iobuffer }

  FUNCTION  buffer_data(VAR b_info : buf_info_type ): INTEGER;
    BEGIN
      WITH b_info DO buffer_data:=INTEGER(buf_fill)-INTEGER(buf_empty);
    END; { buffer_data }

  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
    BEGIN
      WITH b_info DO
      BEGIN
	IF active_isc = no_isc THEN
	  BEGIN
	    buf_fill:=buf_ptr;
	    buf_empty:=buf_ptr;
	  END
	ELSE io_escape(ioe_buf_busy,no_isc);
      END; { of WITH DO }
    END; { buffer_reset }

  FUNCTION  buffer_space(VAR b_info: buf_info_type): INTEGER;
  BEGIN
    WITH b_info DO
    BEGIN
      IF ( buffer_data(b_info)=0 ) AND
	 ( active_isc = no_isc )   THEN buffer_reset(b_info);
      buffer_space:=buf_size+INTEGER(buf_ptr)-INTEGER(buf_fill);
    END; { of WITH DO }
  END; { buffer_space }

  procedure init_buffer(var buf : buf_info_type;
		    anyvar data : integer; size : integer);
    begin
      with buf do
      begin
	buf_ptr    := addr(data);
	buf_size   := size;
	buf_empty  := buf_ptr;
	buf_fill   := buf_ptr;
	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; { init_buffer }

  FUNCTION  transfer_setup ( device    : type_device;
			     t_tfr     : user_tfr_type;
			     t_dir     : dir_of_tfr ;
			     VAR b_info: buf_info_type ;
			     VAR t_cnt : INTEGER ): type_isc ;
    VAR io_isc : type_isc;
    BEGIN

      IF device>iomaxisc THEN io_isc := device DIV 100
			 ELSE io_isc := device;

      IF isc_table[io_isc].io_tmp_ptr = NIL
			 THEN io_escape(ioe_no_driver,io_isc);

      WITH b_info DO
      BEGIN
	{ test for tfr count }
	IF t_cnt=0 THEN io_escape(ioe_bad_cnt,no_isc);

	{ test for another tfr on this buffer }
	IF active_isc <> no_isc THEN io_escape(ioe_buf_busy,no_isc)
	ELSE
	  BEGIN
	    IF buffer_data(b_info)=0 THEN buffer_reset(b_info);
	  END;

	{ configure card based on direction and check for available space/data }
	IF t_dir= to_memory THEN
	BEGIN
	  IF (t_tfr<>dummy_tfr_1) and (t_tfr<>dummy_tfr_2) THEN
	    IF isc_table[io_isc].io_tmp_ptr^.in_bufptr <> NIL
	      THEN io_escape(ioe_isc_busy,io_isc);

	  IF buffer_space(b_info)<t_cnt THEN io_escape(ioe_no_space,io_isc);

	  IF (t_tfr<>dummy_tfr_1) and (t_tfr<>dummy_tfr_2) THEN
	    isc_table[io_isc].io_tmp_ptr^.in_bufptr :=  ADDR( b_info );
	END
	ELSE
	BEGIN { from_memory }
	  IF isc_table[io_isc].io_tmp_ptr^.out_bufptr <> NIL THEN
	      io_escape(ioe_isc_busy,io_isc);

	  IF buffer_data(b_info)<t_cnt THEN io_escape(ioe_no_data,io_isc);

	  isc_table[io_isc].io_tmp_ptr^.out_bufptr :=  ADDR( b_info );
	END; { of IF }

	drv_tmp_ptr:= isc_table[io_isc].io_tmp_ptr;
	act_tfr    := no_tfr;
	usr_tfr    := t_tfr;
	b_w_mode   := FALSE;                      { byte mode }
	end_mode   := FALSE;                      { no EOI }
	direction  := t_dir;
	term_char  := -1;                         { no termination character }
	term_count := t_cnt;

      END; { of WITH b_info DO }

      transfer_setup := io_isc;

    END; { of transfer_setup }

  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
    VAR io_isc    : type_isc;
	t_count   : INTEGER;
    BEGIN
      t_count:=x_count;
      io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

      { transfer temporary was set up in transfer_setup }

      WITH isc_table[io_isc]
      DO CALL ( io_drv_ptr^.iod_tfr ,
		isc_table[io_isc].io_tmp_ptr,
		ADDR(b_info) );
    END; { transfer }

  procedure copy_buffer_data(var src,dest  : buf_info_type;
				 skip,move : integer);
    begin
      if skip>0 then
      begin
	if skip>src.term_count then skip := src.term_count;
	src.buf_empty := ADDR(cp(src.buf_empty)^,skip);
	src.term_count := src.term_count - skip;
      end;

      if move>0 then
      begin
	if move>src.term_count then move := src.term_count;
	if move>dest.term_count then move := dest.term_count;
	moveleft(cp(src.buf_empty)^,cp(dest.buf_fill)^,move);
	src.term_count := src.term_count - move;
	src.buf_empty := ADDR(cp(src.buf_empty)^,move);
	dest.term_count := move;
	dest.buf_fill := ADDR(cp(dest.buf_fill)^,move);
      end;
    end; { copy_buffer_data }

  procedure build_frame(var dest   : buf_info_type;
			var unit_r : lsrm_unit_entry;
			var sc_r   : lsrm_sctable_entry;
			anyvar buf1: tfr_data_type; size1 : shortint;
			anyvar buf2: tfr_data_type; size2 : shortint);
    var
      tempp : anyptr;
    begin
      buffer_reset(dest);
      tempp := dest.buf_fill;
      { build the protocol stack into the buffer }
      with ether_hdr_ptr(tempp)^ do
      begin
	e_destination   := unit_r.hostladdr;
	e_source        := sc_r.localaddr;
	ether_type      := ip_protocol;
      end;
      tempp := addr(cp(tempp)^,ll_hdr_size);

      with ip_hdr_ptr(tempp)^ do
      begin
	version := ip_version;
	ihl     := ip_size div 4;
	service := 0;
	length  := ip_size + udp_size + size1 + size2;
	id      := 0;
	flags   := 0;
	frag_offset := 0;
	ttl     := 255;
	protocol:= udp_protocol;
	hdr_check := 0;
	ip_source := unit_r.my_ip;
	ip_destination := unit_r.host_ip;
	checksum1(hdr_check,cp(tempp)^,ip_size div 2);
      end;
      tempp := addr(cp(tempp)^,ip_size);

      with udp_hdr_ptr(tempp)^ do
      begin
	udp_source := unit_r.my_port;
	udp_destination := unit_r.host_port;
	udp_len  := udp_size + size1 + size2;
	udp_chk  := 0;  { no check sum }
      end;
      tempp := addr(cp(tempp)^,udp_size);

      { copy the data buffer(s) }
      if size1>0 then
      begin
	moveleft(buf1,cp(tempp)^,size1);
	tempp := addr(cp(tempp)^,size1);
      end;
      if size2>0 then
      begin
	moveleft(buf2,cp(tempp)^,size2);
	tempp := addr(cp(tempp)^,size2);
      end;

      dest.buf_fill := tempp;

    end; { build_frame }

  procedure eot_rearm(buf : ANYPTR);
    begin
      with BUFxINFOxPTR(buf)^ do
      begin
	if (term_char=lb_eot) or (term_char=lb_short) then
	begin
	  active_isc := lastsc;         { re-arm this buffer }
	  eot_proc.dummy_pr := nil ;    { kill the eot proc }
	end;
      end;
    end; { eot_rearm }

  procedure check_frame(var source : buf_info_type;
			var unit_r : lsrm_unit_entry;
			var sc_r   : lsrm_sctable_entry;
			var ok     : check_type;
			var data   : anyptr;
			var size   : shortint);
    label 1;
    var
      check   : shortint;
      tempbuf : buf_info_type;
    begin
      ok   := is_reject;
      data := source.buf_empty;
      with ether_hdr_ptr(data)^ do
      begin
	if ether_type=arp_protocol then
	with arp_ptr(addr(cp(data)^,14))^ do
	begin { arp }
	  if lsrm_unit_table^[lastunit].my_ip=0 then goto 1;
	  if not((htype=1) and           { ethernet }
		 (ptype=ip_protocol) and { ip }
		 (arp_op=1) and          { request }
		 (targetp = unit_r.my_ip)
		 ) then goto 1;
	  { now try to reply }
	  e_source := sc_r.localaddr ;
	  e_destination := senderl;
	  targetl := senderl;
	  targetp := senderp;
	  senderl := e_source;
	  senderp := unit_r.my_ip;
	  arp_op := 2; {reply}
	  check  := buffer_data(source);
	  init_buffer(tempbuf,cp(data)^,check);
	  tempbuf.buf_fill := addr(cp(tempbuf.buf_fill)^,check);
	  try
	    transfer(lastsc,overlap,from_memory,tempbuf,check);
	  recover begin end; { might not work }
	  ok := is_done;
	  goto 1;
	end
	else
	if (ether_type<>ip_protocol) then goto 1
	else
	if (e_destination<>sc_r.localaddr) then
	begin
	  if (e_destination<>e_broadcast) then goto 1;
	end;
      end;

      current_ip := addr(cp(data)^,14); { locate the IP header }
      { check ip for udp protocol }
      with current_ip^ do
      begin
	if not (version=ip_version) and
	       (protocol=udp_protocol) then goto 1;
	if length>lan_max_frame_len then goto 1;
	data := addr(current_ip^,ihl*4); { locate the UDP header }
      end;
      { check udp port number }
      if udp_hdr_ptr(data)^.udp_destination <> unit_r.my_port then goto 1;
      { looks like the right stuff so now check it in detail }

      with current_ip^ do
      begin
	checksum1(check,current_ip^,ihl*2);
	if check<>0 then goto 1;    { checksum failed }
	if frag_offset<>0 then goto 1; { can't handle fragments }
      end;

      with udp_hdr_ptr(data)^ do
      begin
	size := udp_len-8;
	data := addr(cp(data)^,udp_size); { point to data area }
      end;
      ok := is_ok;
     1:
    end; { check_frame }

  function get_host_ip:integer;
    begin
      get_host_ip := current_ip^.ip_source;
    end; { get_my_ip }

  procedure get_host_station(RBUF:BUFxINFOxPTR);
    begin { this will use ARP to find the host station address }
    end;

  PROCEDURE WRAPPER1(TEMP : ANYPTR; VAR B:BOOLEAN);
  { adds lower level protocol stuff to lsrm_reqest packet }

    BEGIN
      with iompx_rec_ptr(temp)^ do
      begin
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }

	build_frame(outworkbuf^,lsrm_unit_table^[lastunit],
				lsrm_sctable^[scode],
				cp(user_buffer^.buf_empty)^,buffer_data(user_buffer^),
				user_buffer,0); { these are dummy arguments }

	transfer(scode,serial_fastest,from_memory,outworkbuf^,buffer_data(outworkbuf^));

      end; { with mpxr^ }
      b   := false; { its gone }
    END; {WRAPPER1}

  PROCEDURE CHECKER1(TEMP : ANYPTR; VAR B:BOOLEAN);
    label 1;
    VAR
      mpxr   : iompx_rec_ptr;
      lutable: lsrm_unit_ptr;
      sctable: lsrm_sctable_eptr;
      dsize  : shortint; { total frame size }
      tempp  : anyptr;
      ok     : check_type;
    BEGIN
      mpxr := temp;
      b    := true;
      with mpxr^ do
      if in_buffer<>nil then
      begin
	lutable := addr(lsrm_unit_table^[lastunit]);
	sctable := addr(lsrm_sctable^[scode]);

	check_frame(in_buffer^,lutable^,sctable^,ok,tempp,dsize);
	if ok=is_done then
	{ signal that this data is accepted & setup to re-arm the buffer }
	begin  b:= false;
	       user_buffer^.eot_proc.real_proc := eot_rearm;
	end;
	if ok<>is_ok then goto 1;

	if dsize<sizeof(lsrm_reply_type) then goto 1;

	{ check the reply contents }
	with lsrm_reply_ptr(tempp)^ do
	begin
	  if not ((rec_type=lsrm_reply_code) and
		  (ret_code=0) and
		  (option_code=0) and
		  (version=p_version))
	     then goto 1;
	  if my_station<>sctable^.localaddr then goto 1;

	  { save addresses }
	  lutable^.my_ip := my_ip;
	  lutable^.hostnode := host_node;
	  { adjust addresses/ports as required }
	  if host_flag=0 then lutable^.host_ip := get_host_ip
			 else lutable^.host_ip := host_ip;
	  lutable^.host_port := udp_service_port;

	  with lutable^ do
	  begin
	    session   := -1;
	    sequence  := 0;
	    mynode    := my_node;
	    if host_flag<>0 then get_host_station(in_buffer);
	    hostladdr := ether_hdr_ptr(in_buffer^.buf_empty)^.e_source;
	  end;
	end;

	{ tell caller to complete the transfer }
	b := false;
	in_buffer^.term_count := 0; { checked/moved it all }
	with user_buffer^ do
	begin
	  cp(buf_fill)^ := 'G';
	  buf_fill := addr(cp(buf_fill)^,1);
	  term_count := 1;
	end;
      end; { with mpxr }
    1:
    END; {CHECKER1}

  { normal operations wrapper procedure }
  PROCEDURE WRAPPER2(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr    : iompx_rec_ptr;
      lutable : lsrm_unit_ptr;
      sctable : lsrm_sctable_eptr;
      old_seq : byte;
      do_rx,
      do_tx   : boolean;
      op_timer        : timer_rec;
      op_retries      : integer;
      lastsize        : integer;

      procedure load_work_buf;
	var
	  tfr: tfr_request_type;
	begin
	  with mpxr^ do
	  begin
	    with tfr do
	    begin
	      rec_type    := tfr_request_code;
	      ret_code    := 0;
	      session_id  := lutable^.session;
	      version     := p_version;
	      host_node   := lutable^.hostnode;
	      unum        := lastunit;
	      sequence_no := lutable^.sequence;
	    end; { with }

	    build_frame(outworkbuf^,lutable^,
				    sctable^,
				    tfr,sizeof(tfr),
				    cp(user_buffer^.buf_empty)^,buffer_data(user_buffer^));
	  end; { with }
	end; { load_work_buf }

    BEGIN { WRAPPER2 }
      mpxr := temp;
      with mpxr^ do
      begin
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }
	lutable := addr(lsrm_unit_table^[lastunit]);
	sctable := addr(lsrm_sctable^[scode]);
	with lutable^ do
	begin
	  if not connected then
	    if lansrm_connect then connected := true
			      else io_escape(ioe_dc_conn,lastsc);
	end;
	{ don't send the first byte of data }
	with user_buffer^ do
	begin
	  buf_empty := addr(cp(buf_empty)^,1);
	end;

	load_work_buf;

	with sctable^.mpxinw do
	  user_buffer := user_buffer^.eot_parm; { goto next input buffer }

	op_retries := op_tries;
	lastsize   := buffer_data(outworkbuf^);
	do_rx      := true;
	do_tx      := true;

	repeat
	  op_done  := -1;
	  if do_rx then
	    with sctable^.mpxinw do
	    begin
	      do_rx := false;
	      buffer_reset(user_buffer^);
	      transfer(scode,dummy_tfr_2,to_memory,user_buffer^,lan_max_frame_len);
	    end;

	  if do_tx then
	    begin
	      with outworkbuf^ do buf_empty := buf_ptr; { reset buf_empty }
	      transfer(scode,overlap_fastest,from_memory,outworkbuf^,lastsize);
	      while outworkbuf^.active_isc<>no_isc do; { wait for this to go out }
	    end;
	  do_tx := true;

	  { start timeout timeing }
	  op_timer.time := op_timeout[op_retries]; start_timer(op_timer);
	  op_retries := op_retries-1;

	  { wait for packet received or timeout }
	  repeat until (op_done<>-1) or time_expired(op_timer);

	  { set do_rx in case of need to loop again }
	  do_rx := op_done>0;

	  case op_done of
	   0:; { ok }
	   1,2:{ lengthen timeout or server busy }
	     begin      { go to long timeout }
	       op_retries := op_tries+1;
	       do_tx      := false;     { don't resend the packet }
	     end;
	   4:io_escape(ioe_dc_conn,lastsc); { bad_session }
	   7:io_escape(ioe_sr_fail,lastsc); { server going down }
	   otherwise
	     { timeout or unimplemented return code }
	     if (op_retries<=0) then
	       with sctable^.mpxinw do
	       begin
		 user_buffer^.active_isc := no_isc; { stop the transfer }
		 buffer_reset(user_buffer^);
		 lsrm_unit_table^[lastunit].connected := false;
		 io_escape(ioe_sr_fail,lastsc);
	       end;
	  end; { case }
	until op_done=0;
	{ fix up the callers buf_empty pointer }
	with user_buffer^ do buf_empty := addr(cp(buf_empty)^,buffer_data(user_buffer^));
      end; { with mpxr^ }
      b   := false; { tell caller the xfr is done }
    END; {WRAPPER2}

  PROCEDURE CHECKER2(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr   : iompx_rec_ptr;
    BEGIN
      mpxr := temp;
      with mpxr^ do
      begin
	if in_buffer=nil then
	begin { get data from inworkbuf }
	  if inworkbuf^.active_isc = no_isc then
	  begin { copy every thing }
	    copy_buffer_data(inworkbuf^,user_buffer^,0,maxint);
	    { if no more data in the source then switch to next buffer }
	    if inworkbuf^.term_count=0 then
	       inworkbuf := inworkbuf^.eot_parm;

	    if user_buffer^.term_count=0 then
	      io_escape(ioe_no_data,no_isc);
	    b := false; { data has been moved }
	  end
	  else io_escape(ioe_sr_fail,no_isc);
	end
	else b := true; { reject it }
      end;
    END; { CHECKER2 }

  PROCEDURE CHECKER3(TEMP : ANYPTR; VAR B:BOOLEAN);
    label 1;
    VAR
      mpxr   : iompx_rec_ptr;
      lutable: lsrm_unit_ptr;
      tempp  : anyptr;
      dsize  : shortint;
      ok     : check_type;
    BEGIN
      mpxr := temp;
      b    := true; { reject it }
      with mpxr^ do
      begin
	lutable := addr(lsrm_unit_table^[lastunit]);
	if in_buffer<>nil then
	with in_buffer^ do
	begin
	  check_frame(in_buffer^,lutable^,lsrm_sctable^[scode],ok,tempp,dsize);
	  if ok=is_done then
	  { signal that this data is accepted & setup to re-arm the buffer }
	  begin  b:= false;
		 user_buffer^.eot_proc.real_proc := eot_rearm;
	  end;
	  if ok<>is_ok then goto 1;

	  { check the reply contents }
	  with tfr_request_ptr(tempp)^ do
	  begin
	    if not ((rec_type=tfr_reply_code) and
		    (version = p_version) and
		    (host_node = lutable^.hostnode) and
		    (sequence_no=lutable^.sequence) and
		    (unum=lastunit)) then goto 1;
	    op_done := ret_code;
	  end;

	  if op_done=0 then
	  begin
	    { set the next expected sequence number }
	    lutable^.sequence := (lutable^.sequence+1) mod 256;
	    lutable^.session  := tfr_request_ptr(tempp)^.session_id;
	    {skip all lsrm header then move the data}
	    tempp := addr(cp(tempp)^,tfr_req_size);
	    dsize := dsize - tfr_req_size;
	    if dsize>0 then
	    begin
	      with user_buffer^ do
	      begin
		if dsize>term_count then dsize := term_count;
		moveleft(cp(tempp)^,cp(buf_fill)^,dsize);
		term_count := dsize;
		buf_fill := ADDR(cp(buf_fill)^,dsize);
	      end;
	    end;
	  end;
	  b := false;   { tell caller its processed }
	end; { with in_buffer }
      end; { with mpxr }
    1:
    END; {CHECKER3}

  function lansrm_connect:boolean;

    VAR
      mpxout,
      mpxin     : iompx_rec;
      lutable   : lsrm_unit_ptr;
      utable    : ^unitentry;

      bufin     : buf_info_type;
      datai     : char;

      bufout    : buf_info_type;
      datao     : lsrm_request_type;

      timer     : timer_rec;
      tries     : integer;
      i         : integer;

      done      : boolean;
      farea[-300] : link_address_ptr;

    BEGIN { lansrm_connect }
      done    := false;
      lutable := addr(lsrm_unit_table^[lastunit]);
      utable  := addr(unitable^[lastunit]);
      with lutable^ , iompx_info^ do
      begin
	with utable^ do
	begin
	  TRY
	    { setup the input side }
	    CALL(register_iompx_buf,
		 sc,TO_MEMORY,bufin,mpxin,FALSE,lutable,checker1);
	    { setup the output side }
	    CALL(register_iompx_buf,
		 sc,FROM_MEMORY,bufout,mpxout,FALSE,lutable,wrapper1);

	    { start the input transfer for one byte }
	    init_buffer(bufin,datai,1);
	    datai := 'F';
	    transfer(sc,dummy_tfr_2,to_memory,bufin,1);

	   { build & transmit the request }
	    with datao do
	    begin
	      rec_type    := lsrm_request_code;
	      ret_code    := 0;
	      option_code := 0;
	      host_node   := BA; { from unitable^ }
	      version     := p_version;
	      my_station  := lsrm_sctable^[lastsc].localaddr;
	    end;
	    { if boot device then use the host address else use the broadcast }
	    { Enhanced 1/2/91 JWH to set the connect_timeout variable JWH }
	    if BA=127 then
	      begin
	       lutable^.hostladdr := farea^;
	       connect_timeout := boot_connect_timeout;
	      end
	     else
	      begin
	       lutable^.hostladdr := e_broadcast;
	       connect_timeout := broadcast_connect_timeout;
	      end;
	    my_port := udp_my_port;

	    init_buffer(bufout,datao,sizeof(datao));
	    bufout.buf_fill := addr(bufout.buf_ptr^,sizeof(datao));
	    tries := connect_tries;
	    repeat
	      { send the request and start the timer }
	      transfer(sc,serial_fastest,from_memory,bufout,sizeof(datao));
	      timer.time := connect_timeout; start_timer(timer);
	      repeat
		if (not done) and (not buffer_busy(bufin)) then
		begin
		  done := datai='G';
		  if not done then { restart the input transfer }
		  begin
		    buffer_reset(bufin); datai := 'F';
		    transfer(sc,dummy_tfr_2,to_memory,bufin,1);
		  end;
		end; { while }
	      until done or time_expired(timer);
	      if not done then tries := tries-1;
	    until done or (tries=0);

	  RECOVER { suppress every error }
	    begin end;

	  call(unregister_iompx_buf,sc,TO_MEMORY,bufin);
	  call(unregister_iompx_buf,sc,FROM_MEMORY,bufout);

	end;
      end; {with lsrm_isc_table}
      lansrm_connect := done;
    END; { lansrm_connect }

  { called by table before it does a hook up }
  procedure lansrm_ok(var sc : integer);
    begin
      if iompx_info<>nil then
      begin
	if (sc>=minrealisc) and (sc<=maxrealisc) then
	begin
	  if (iompx_info^.isc_iompx_table[sc].capable) and
	     (isc_table[sc].card_id = hp98643) then SC := -SC;
	end;
      end;
    end; { lansrm_ok }

  procedure lansrm_reset(sc:integer);
    begin
      with lsrm_sctable^[sc].mpxinw do
      begin
	user_buffer^.active_isc := no_isc;
	inworkbuf := user_buffer^.eot_parm;
	inworkbuf^.active_isc := no_isc;
      end;
    end; { lansrm_reset }

  procedure lansrm_init_unit(un: integer);
    begin
      with lsrm_unit_table^[un] do
      begin
	 hostladdr := e_broadcast;
	 mynode    := 0;
	 hostnode  := 0;
	 my_ip     := 0;
	 host_ip   := -1;
	 my_port   := udp_my_port;
	 host_port := udp_service_port;
	 session   := -1;
	 sequence  := 0;
	 connected := false;
      end;
    end; { lansrm_init_unit }

  { if IOMPX is installed then
    scan the select codes for a LAN card & driver using IOMPX
    for each one found, register the srm driver buffer & a working buffer
    if any suitable interfaces were found, allocate & initialize the
    shadow unit table
  }
  procedure lansrm_init(var srmbuf : buf_info_type);
    VAR
      i,
      sc        : integer;
      ok        : boolean;
      ans       : iompx_ans_rec;
      lutable   : lsrm_unit_ptr;
      mpxout,
      mpxin     : iompx_rec_ptr;
      inworkbuf2   : BUFxINFOxPTR;
      BMSUS[-292]  : PACKED ARRAY [1..4] OF CHAR;
    BEGIN { LANSRM_INIT }
      mpxout := nil;
      mpxin  := nil;
      { allocate & init the shadow unit table }
      if lsrm_unit_table=nil then
      begin
	{ modify boot MSUS for power up from LAN }
	if ORD(BMSUS[1])=HEX('E2') then
	begin { booted from LAN }
	  BMSUS[2] := #8; { unit 8 }
	  BMSUS[4] := #127; { boot node }
	end;

	if iompx_info=nil then
	begin
	  call(io_error_link,iompx_request,ans.s);
	  ok := ans.s=iompx_answer;
	  if ok then iompx_info := ans.ptr;
	end;
	if ok then
	begin
	  ok := false;
	  for sc := minrealisc to maxrealisc do
	  with iompx_info^ do
	  begin
	    if isc_iompx_table[sc].capable then
	    with isc_table[sc] do
	    begin
	      if (card_id=hp98643) then
	      begin { register the buffers }
		if lsrm_sctable=nil then new(lsrm_sctable); { allocate shadow sc table }
		ok := true; { at least one setup }

		with lsrm_sctable^[sc] do
		for i := 1 to 6 do
		begin
		  localaddr[i] := chr(iostatus(sc,l_link_addr1-1+i));
		end;

		if inworkbuf=nil then
		begin
		  new(inworkbuf);
		  IOBUFFER(inworkbuf^,LAN_MAX_FRAME_LEN);
		  new(inworkbuf2);
		  IOBUFFER(inworkbuf2^,LAN_MAX_FRAME_LEN);
		  { chain link the buffers thru eot_parm }
		  inworkbuf^.eot_parm := inworkbuf2;
		  inworkbuf2^.eot_parm := inworkbuf;
		  new(outworkbuf);
		  IOBUFFER(outworkbuf^,LAN_MAX_FRAME_LEN);
		end;
		{ setup the input side }
		{ need unique registration records for each select code }
		new(mpxin);
		CALL(register_iompx_buf,
		     sc,TO_MEMORY,srmbuf,mpxin^,FALSE,lutable,checker2);
		with lsrm_sctable^[sc] do
		begin
		  CALL(register_iompx_buf,
		       sc,TO_MEMORY,inworkbuf^,mpxinw,FALSE,lutable,checker3);
		  lansrm_reset(sc);   { fix up data structures used by wrapper2 etc. }
		end;
		{ setup the output side }
		new(mpxout);
		CALL(register_iompx_buf,
		     sc,FROM_MEMORY,srmbuf,mpxout^,FALSE,lutable,wrapper2);
	      end;
	    end;
	  end;

	  if ok then
	  begin
	    new(lsrm_unit_table);
	    for i := 0 to maxunit do lansrm_init_unit(i);
	  end
	  else iompx_info := nil; { no LAN }
	end;
      end;
    END; { lansrm_init }

END. { MODULE LANSRM }


@


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


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 12:27:56 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 1106
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 1106
$MODCAL$
$DEBUG OFF$ $RANGE OFF$ $ALLOW_PACKED ON$
{ this version of LANSRM is designed to use the IP-UDP protocols }
{ lines with comment patch #1 are needed to clear out_bufptr.
  The LAN driver should have cleared it before calling any
  wrapper procedure.
}
MODULE LANSRM;
 $SEARCH 'IOLIB:KERNEL'$
 $SEARCH 'IOLIB:LANASM','IOLIB:LANDECS'$
 { $SEARCH 'LANDECS'$ }

IMPORT SYSGLOBALS,LANDECS,
       IODECLARATIONS,GENERAL_0,
       ASM;

EXPORT
 $INCLUDE 'IOLIB:IOMPXDECS.TEXT'$
  { $INCLUDE 'IOMPXDECS.TEXT'$ }
  TYPE
    lsrm_unit_ptr   = ^lsrm_unit_entry;
    lsrm_unit_entry = record
			hostladdr : link_address_type;
			mynode    : shortint; { fake SRM node }
			hostnode  : shortint; { fake SRM node }
			my_ip     : integer;  { IP }
			host_ip   : integer;  { IP }
			my_port   : shortint; { UDP }
			host_port : shortint; { UDP }
			session   : shortint;
			sequence  : byte;
			connected : boolean;
		      end;
    lsrm_table_type = array [unitnum] of lsrm_unit_entry;
    lsrm_table_ptr  = ^lsrm_table_type;
    check_type      = (is_ok,is_done,is_reject);
  VAR
    iompx_info      : iompx_info_ptr;
    lsrm_unit_table : lsrm_table_ptr;
    lastunit        : unitnum;
    lastsc          : type_isc;

  procedure lansrm_init(var srmbuf : buf_info_type);
  function  lansrm_connect:boolean;
  procedure lansrm_ok(var sc:integer);
  procedure lansrm_reset(sc : integer);
  procedure lansrm_init_unit(un : integer);

IMPLEMENT
$LINENUM 5000$
{ $SEARCH 'LANDECS','LANASM'$ }
  IMPORT LANASM;
  TYPE
    timeout_arr=array[1..4] of integer;

  CONST
    e_broadcast = #255#255#255#255#255#255;
    ip_protocol  = hex('0800');
    arp_protocol = hex('0806');

    udp_service_port = 570; { UDP server port number }
    udp_my_port      = 570; { UDP my port number }

    { Modified 1/2/91 JWH - now same as BASIC : }
    { connect_timeout is now a variable - it is set in }
    { routine lansrm_connect }

    { connect_timeout = 0500; .5 seconds }
    boot_connect_timeout = 20000;   { 20 seconds }
    broadcast_connect_timeout = 4000;   { 4 seconds }

    { Modified 1/2/91 JWH - now same as BASIC : }
    { connect_tries   = 2; }
    connect_tries   = 3;

    { Modified 1/2/91 JWH - now same as BASIC : }
    { op_timeout      = timeout_arr[15000, 5000, 700, 20000]; }
    op_timeout      = timeout_arr[60000, 15000, 5000, 60000];
    op_tries        = 3;

    { PACKET CODES }
    lsrm_request_code = 1;      { want to connect }
    lsrm_reply_code   = 129;
    tfr_request_code  = 2;      { data movement   }
    tfr_reply_code    = 130;
    { p_version         = 10; }     { protocol version }
    p_version         = 11;      { protocol version }
    { RETURN CODES }
    L_NO_ERROR = 0;
    L_LENGTHEN_TIMEOUT = 1;
    L_SERVER_BUSY      = 2;     { NI on server }
    L_BAD_SEQUENCE_NUMBER = 3;  { NI }
    L_BAD_SESSION= 4;   { NEED TO RECONNECT }
    L_BAD_SIZE   = 5;           { NI }
    L_BAD_PACKET = 6;           { NI }
    L_ABORTED    = 7;   { SERVER GOING DOWN, NI on server }

    ip_sap       = 6;
    udp_protocol = 17;
    ip_version   = 4;

  TYPE
    byte_ptr  = ^byte;
    cp        = ^char;

    bits1 = 0..1;
    bits2 = 0..3;
    bits3 = 0..7;
    bits4 = 0..15;
    bits5 = 0..31;
    bits6 = 0..63;
    bits7 = 0..127;
    bits8 = 0..255;
    bits13= 0..8191;
    bits14= 0..16383;
    bits16= 0..65535;
    bits21= 0..2097151;
    bits24= 0..16777215;

    ether_hdr_ptr = ^ether_hdr_type;
    ether_hdr_type = packed record
		       e_destination,
		       e_source   : link_address_type;
		       ether_type : shortint;
		     end;

    ip_hdr_ptr = ^ip_hdr;
    ip_hdr = packed record
	       version : bits4;
	       ihl     : bits4;
	       service : bits8;
	       length  : bits16;
	       id      : bits16;
	       flags   : bits3;
	       frag_offset : bits13;
	       ttl     : bits8;
	       protocol: bits8;
	       hdr_check      : shortint;
	       ip_source      : integer;
	       ip_destination : integer;
	     end;

    udp_hdr_ptr = ^udp_hdr;
    udp_hdr = packed record
		udp_source,
		udp_destination : bits16;
		udp_len  : bits16;
		udp_chk  : bits16;
	      end;

    arp_ptr = ^arp_rec;
    arp_rec = packed record
		htype : bits16;
		ptype : bits16;
		hal   : bits8;
		pal   : bits8;
		arp_op: bits16;
		senderl : link_address_type;
		senderp : integer;
		targetl : link_address_type;
		targetp : integer;
	      end;

    { lan_srm packet formats }
    lsrm_request_ptr = ^lsrm_request_type;
    lsrm_request_type = packed record { OUTBOUND }
			  rec_type    : shortint;{    1 }
			  ret_code    : shortint;{    0 }
			  option_code : shortint;{ reserved @@ 0 }
			  host_node   : shortint;
			  version     : shortint;{ protocol version }
			  my_station  : link_address_type;
			end;
    lsrm_reply_ptr = ^lsrm_reply_type;
    lsrm_reply_type = packed record { INBOUND }
			rec_type   : shortint;  { 129 }
			ret_code   : shortint;
			host_ip    : integer;   { may contain the host ip address }
			my_ip      : integer;   { IP }
			option_code: shortint;  { reserved @@ 0 }
			host_node  : shortint;  { host SRM node }
			version    : shortint;
			my_node    : shortint;
			my_station : link_address_type; { for verification }
			host_flag  : byte;     { = 0 get ip & station from headers,
						<> 0 use host_ip field & ARP to get station }
		       {sys_name   : string255;  not used }
		      end;

    tfr_request_ptr = ^tfr_request_type;
    tfr_data_type   = packed array[1..lan_max_frame_len] of char;
    tfr_data_ptr    = ^tfr_data_type;
    tfr_request_type = packed record { DATA IN & OUT }
			 rec_type   : shortint; { 2 | 130 }
			 ret_code   : shortint;
			 session_id : shortint; { echoed from last packet }
			 version    : shortint; { constant }
			 host_node  : shortint; { same as in contact record }
			 unum       : byte;  { unum + sequence_no }
			 sequence_no: byte;  { seen as single field by server }
			{data       : tfr_data_type;}
		       end;

    lsrm_sctable_eptr = ^lsrm_sctable_entry;
    lsrm_sctable_entry = record
			   localaddr : link_address_type;
			   mpxinw    : iompx_rec;
			 end;

    lsrm_sctable_type = array [type_isc] of lsrm_sctable_entry;
    lsrm_sctable_ptr  = ^lsrm_sctable_type;
    link_address_ptr  = ^link_address_type;

  CONST
    ll_hdr_size = sizeof(ether_hdr_type);
    ip_size  = sizeof(ip_hdr);
    udp_size = sizeof(udp_hdr);
    req_size = sizeof(lsrm_request_type);
    reply_size = sizeof(lsrm_reply_type);
    tfr_req_size = sizeof(tfr_request_type);

  VAR
    lsrm_sctable    : lsrm_sctable_ptr;
    inworkbuf,
    outworkbuf      : BUFxINFOxPTR;
    current_ip      : ip_hdr_ptr;       { ip/udp }
    op_done         : shortint;
    { Added 1/2/91 JWH : }
    connect_timeout : integer;

  FUNCTION  buffer_busy( VAR b_info: buf_info_type ): BOOLEAN;
    BEGIN
      WITH b_info DO buffer_busy := active_isc <> no_isc;
    END; { buffer_busy }

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER ) ;
    BEGIN
      WITH b_info DO
	BEGIN
	  { what about IOBUFFER to a already existant buffer ? }
	  { - the space will be thrown away. }

	  NEWBYTES(buf_ptr,t_count);

	  act_tfr   := no_tfr;
	  active_isc:= no_isc;
	  buf_size  := t_count;
	  buf_empty := buf_ptr;
	  buf_fill  := buf_ptr;

	  drv_tmp_ptr       := NIL;
	  eot_proc.dummy_sl := NIL;
	  eot_proc.dummy_pr := NIL;
	  eot_parm          := NIL;               {JPC  02/22/82}
	  dma_priority      := FALSE ;
	END; { of WITH DO }
    END; { iobuffer }

  FUNCTION  buffer_data(VAR b_info : buf_info_type ): INTEGER;
    BEGIN
      WITH b_info DO buffer_data:=INTEGER(buf_fill)-INTEGER(buf_empty);
    END; { buffer_data }

  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
    BEGIN
      WITH b_info DO
      BEGIN
	IF active_isc = no_isc THEN
	  BEGIN
	    buf_fill:=buf_ptr;
	    buf_empty:=buf_ptr;
	  END
	ELSE io_escape(ioe_buf_busy,no_isc);
      END; { of WITH DO }
    END; { buffer_reset }

  FUNCTION  buffer_space(VAR b_info: buf_info_type): INTEGER;
  BEGIN
    WITH b_info DO
    BEGIN
      IF ( buffer_data(b_info)=0 ) AND
	 ( active_isc = no_isc )   THEN buffer_reset(b_info);
      buffer_space:=buf_size+INTEGER(buf_ptr)-INTEGER(buf_fill);
    END; { of WITH DO }
  END; { buffer_space }

  procedure init_buffer(var buf : buf_info_type;
		    anyvar data : integer; size : integer);
    begin
      with buf do
      begin
	buf_ptr    := addr(data);
	buf_size   := size;
	buf_empty  := buf_ptr;
	buf_fill   := buf_ptr;
	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; { init_buffer }

  FUNCTION  transfer_setup ( device    : type_device;
			     t_tfr     : user_tfr_type;
			     t_dir     : dir_of_tfr ;
			     VAR b_info: buf_info_type ;
			     VAR t_cnt : INTEGER ): type_isc ;
    VAR io_isc : type_isc;
    BEGIN

      IF device>iomaxisc THEN io_isc := device DIV 100
			 ELSE io_isc := device;

      IF isc_table[io_isc].io_tmp_ptr = NIL
			 THEN io_escape(ioe_no_driver,io_isc);

      WITH b_info DO
      BEGIN
	{ test for tfr count }
	IF t_cnt=0 THEN io_escape(ioe_bad_cnt,no_isc);

	{ test for another tfr on this buffer }
	IF active_isc <> no_isc THEN io_escape(ioe_buf_busy,no_isc)
	ELSE
	  BEGIN
	    IF buffer_data(b_info)=0 THEN buffer_reset(b_info);
	  END;

	{ configure card based on direction and check for available space/data }
	IF t_dir= to_memory THEN
	BEGIN
	  IF (t_tfr<>dummy_tfr_1) and (t_tfr<>dummy_tfr_2) THEN
	    IF isc_table[io_isc].io_tmp_ptr^.in_bufptr <> NIL
	      THEN io_escape(ioe_isc_busy,io_isc);

	  IF buffer_space(b_info)<t_cnt THEN io_escape(ioe_no_space,io_isc);

	  IF (t_tfr<>dummy_tfr_1) and (t_tfr<>dummy_tfr_2) THEN
	    isc_table[io_isc].io_tmp_ptr^.in_bufptr :=  ADDR( b_info );
	END
	ELSE
	BEGIN { from_memory }
	  IF isc_table[io_isc].io_tmp_ptr^.out_bufptr <> NIL THEN
	      io_escape(ioe_isc_busy,io_isc);

	  IF buffer_data(b_info)<t_cnt THEN io_escape(ioe_no_data,io_isc);

	  isc_table[io_isc].io_tmp_ptr^.out_bufptr :=  ADDR( b_info );
	END; { of IF }

	drv_tmp_ptr:= isc_table[io_isc].io_tmp_ptr;
	act_tfr    := no_tfr;
	usr_tfr    := t_tfr;
	b_w_mode   := FALSE;                      { byte mode }
	end_mode   := FALSE;                      { no EOI }
	direction  := t_dir;
	term_char  := -1;                         { no termination character }
	term_count := t_cnt;

      END; { of WITH b_info DO }

      transfer_setup := io_isc;

    END; { of transfer_setup }

  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
    VAR io_isc    : type_isc;
	t_count   : INTEGER;
    BEGIN
      t_count:=x_count;
      io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

      { transfer temporary was set up in transfer_setup }

      WITH isc_table[io_isc]
      DO CALL ( io_drv_ptr^.iod_tfr ,
		isc_table[io_isc].io_tmp_ptr,
		ADDR(b_info) );
    END; { transfer }

  procedure copy_buffer_data(var src,dest  : buf_info_type;
				 skip,move : integer);
    begin
      if skip>0 then
      begin
	if skip>src.term_count then skip := src.term_count;
	src.buf_empty := ADDR(cp(src.buf_empty)^,skip);
	src.term_count := src.term_count - skip;
      end;

      if move>0 then
      begin
	if move>src.term_count then move := src.term_count;
	if move>dest.term_count then move := dest.term_count;
	moveleft(cp(src.buf_empty)^,cp(dest.buf_fill)^,move);
	src.term_count := src.term_count - move;
	src.buf_empty := ADDR(cp(src.buf_empty)^,move);
	dest.term_count := move;
	dest.buf_fill := ADDR(cp(dest.buf_fill)^,move);
      end;
    end; { copy_buffer_data }

  procedure build_frame(var dest   : buf_info_type;
			var unit_r : lsrm_unit_entry;
			var sc_r   : lsrm_sctable_entry;
			anyvar buf1: tfr_data_type; size1 : shortint;
			anyvar buf2: tfr_data_type; size2 : shortint);
    var
      tempp : anyptr;
    begin
      buffer_reset(dest);
      tempp := dest.buf_fill;
      { build the protocol stack into the buffer }
      with ether_hdr_ptr(tempp)^ do
      begin
	e_destination   := unit_r.hostladdr;
	e_source        := sc_r.localaddr;
	ether_type      := ip_protocol;
      end;
      tempp := addr(cp(tempp)^,ll_hdr_size);

      with ip_hdr_ptr(tempp)^ do
      begin
	version := ip_version;
	ihl     := ip_size div 4;
	service := 0;
	length  := ip_size + udp_size + size1 + size2;
	id      := 0;
	flags   := 0;
	frag_offset := 0;
	ttl     := 255;
	protocol:= udp_protocol;
	hdr_check := 0;
	ip_source := unit_r.my_ip;
	ip_destination := unit_r.host_ip;
	checksum1(hdr_check,cp(tempp)^,ip_size div 2);
      end;
      tempp := addr(cp(tempp)^,ip_size);

      with udp_hdr_ptr(tempp)^ do
      begin
	udp_source := unit_r.my_port;
	udp_destination := unit_r.host_port;
	udp_len  := udp_size + size1 + size2;
	udp_chk  := 0;  { no check sum }
      end;
      tempp := addr(cp(tempp)^,udp_size);

      { copy the data buffer(s) }
      if size1>0 then
      begin
	moveleft(buf1,cp(tempp)^,size1);
	tempp := addr(cp(tempp)^,size1);
      end;
      if size2>0 then
      begin
	moveleft(buf2,cp(tempp)^,size2);
	tempp := addr(cp(tempp)^,size2);
      end;

      dest.buf_fill := tempp;

    end; { build_frame }

  procedure eot_rearm(buf : ANYPTR);
    begin
      with BUFxINFOxPTR(buf)^ do
      begin
	if (term_char=lb_eot) or (term_char=lb_short) then
	begin
	  active_isc := lastsc;         { re-arm this buffer }
	  eot_proc.dummy_pr := nil ;    { kill the eot proc }
	end;
      end;
    end; { eot_rearm }

  procedure check_frame(var source : buf_info_type;
			var unit_r : lsrm_unit_entry;
			var sc_r   : lsrm_sctable_entry;
			var ok     : check_type;
			var data   : anyptr;
			var size   : shortint);
    label 1;
    var
      check   : shortint;
      tempbuf : buf_info_type;
    begin
      ok   := is_reject;
      data := source.buf_empty;
      with ether_hdr_ptr(data)^ do
      begin
	if ether_type=arp_protocol then
	with arp_ptr(addr(cp(data)^,14))^ do
	begin { arp }
	  if lsrm_unit_table^[lastunit].my_ip=0 then goto 1;
	  if not((htype=1) and           { ethernet }
		 (ptype=ip_protocol) and { ip }
		 (arp_op=1) and          { request }
		 (targetp = unit_r.my_ip)
		 ) then goto 1;
	  { now try to reply }
	  e_source := sc_r.localaddr ;
	  e_destination := senderl;
	  targetl := senderl;
	  targetp := senderp;
	  senderl := e_source;
	  senderp := unit_r.my_ip;
	  arp_op := 2; {reply}
	  check  := buffer_data(source);
	  init_buffer(tempbuf,cp(data)^,check);
	  tempbuf.buf_fill := addr(cp(tempbuf.buf_fill)^,check);
	  try
	    transfer(lastsc,overlap,from_memory,tempbuf,check);
	  recover begin end; { might not work }
	  ok := is_done;
	  goto 1;
	end
	else
	if (ether_type<>ip_protocol) then goto 1
	else
	if (e_destination<>sc_r.localaddr) then
	begin
	  if (e_destination<>e_broadcast) then goto 1;
	end;
      end;

      current_ip := addr(cp(data)^,14); { locate the IP header }
      { check ip for udp protocol }
      with current_ip^ do
      begin
	if not (version=ip_version) and
	       (protocol=udp_protocol) then goto 1;
	if length>lan_max_frame_len then goto 1;
	data := addr(current_ip^,ihl*4); { locate the UDP header }
      end;
      { check udp port number }
      if udp_hdr_ptr(data)^.udp_destination <> unit_r.my_port then goto 1;
      { looks like the right stuff so now check it in detail }

      with current_ip^ do
      begin
	checksum1(check,current_ip^,ihl*2);
	if check<>0 then goto 1;    { checksum failed }
	if frag_offset<>0 then goto 1; { can't handle fragments }
      end;

      with udp_hdr_ptr(data)^ do
      begin
	size := udp_len-8;
	data := addr(cp(data)^,udp_size); { point to data area }
      end;
      ok := is_ok;
     1:
    end; { check_frame }

  function get_host_ip:integer;
    begin
      get_host_ip := current_ip^.ip_source;
    end; { get_my_ip }

  procedure get_host_station(RBUF:BUFxINFOxPTR);
    begin { this will use ARP to find the host station address }
    end;

  PROCEDURE WRAPPER1(TEMP : ANYPTR; VAR B:BOOLEAN);
  { adds lower level protocol stuff to lsrm_reqest packet }

    BEGIN
      with iompx_rec_ptr(temp)^ do
      begin
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }

	build_frame(outworkbuf^,lsrm_unit_table^[lastunit],
				lsrm_sctable^[scode],
				cp(user_buffer^.buf_empty)^,buffer_data(user_buffer^),
				user_buffer,0); { these are dummy arguments }

	transfer(scode,serial_fastest,from_memory,outworkbuf^,buffer_data(outworkbuf^));

      end; { with mpxr^ }
      b   := false; { its gone }
    END; {WRAPPER1}

  PROCEDURE CHECKER1(TEMP : ANYPTR; VAR B:BOOLEAN);
    label 1;
    VAR
      mpxr   : iompx_rec_ptr;
      lutable: lsrm_unit_ptr;
      sctable: lsrm_sctable_eptr;
      dsize  : shortint; { total frame size }
      tempp  : anyptr;
      ok     : check_type;
    BEGIN
      mpxr := temp;
      b    := true;
      with mpxr^ do
      if in_buffer<>nil then
      begin
	lutable := addr(lsrm_unit_table^[lastunit]);
	sctable := addr(lsrm_sctable^[scode]);

	check_frame(in_buffer^,lutable^,sctable^,ok,tempp,dsize);
	if ok=is_done then
	{ signal that this data is accepted & setup to re-arm the buffer }
	begin  b:= false;
	       user_buffer^.eot_proc.real_proc := eot_rearm;
	end;
	if ok<>is_ok then goto 1;

	if dsize<sizeof(lsrm_reply_type) then goto 1;

	{ check the reply contents }
	with lsrm_reply_ptr(tempp)^ do
	begin
	  if not ((rec_type=lsrm_reply_code) and
		  (ret_code=0) and
		  (option_code=0) and
		  (version=p_version))
	     then goto 1;
	  if my_station<>sctable^.localaddr then goto 1;

	  { save addresses }
	  lutable^.my_ip := my_ip;
	  lutable^.hostnode := host_node;
	  { adjust addresses/ports as required }
	  if host_flag=0 then lutable^.host_ip := get_host_ip
			 else lutable^.host_ip := host_ip;
	  lutable^.host_port := udp_service_port;

	  with lutable^ do
	  begin
	    session   := -1;
	    sequence  := 0;
	    mynode    := my_node;
	    if host_flag<>0 then get_host_station(in_buffer);
	    hostladdr := ether_hdr_ptr(in_buffer^.buf_empty)^.e_source;
	  end;
	end;

	{ tell caller to complete the transfer }
	b := false;
	in_buffer^.term_count := 0; { checked/moved it all }
	with user_buffer^ do
	begin
	  cp(buf_fill)^ := 'G';
	  buf_fill := addr(cp(buf_fill)^,1);
	  term_count := 1;
	end;
      end; { with mpxr }
    1:
    END; {CHECKER1}

  { normal operations wrapper procedure }
  PROCEDURE WRAPPER2(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr    : iompx_rec_ptr;
      lutable : lsrm_unit_ptr;
      sctable : lsrm_sctable_eptr;
      old_seq : byte;
      do_rx,
      do_tx   : boolean;
      op_timer        : timer_rec;
      op_retries      : integer;
      lastsize        : integer;

      procedure load_work_buf;
	var
	  tfr: tfr_request_type;
	begin
	  with mpxr^ do
	  begin
	    with tfr do
	    begin
	      rec_type    := tfr_request_code;
	      ret_code    := 0;
	      session_id  := lutable^.session;
	      version     := p_version;
	      host_node   := lutable^.hostnode;
	      unum        := lastunit;
	      sequence_no := lutable^.sequence;
	    end; { with }

	    build_frame(outworkbuf^,lutable^,
				    sctable^,
				    tfr,sizeof(tfr),
				    cp(user_buffer^.buf_empty)^,buffer_data(user_buffer^));
	  end; { with }
	end; { load_work_buf }

    BEGIN { WRAPPER2 }
      mpxr := temp;
      with mpxr^ do
      begin
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }
	lutable := addr(lsrm_unit_table^[lastunit]);
	sctable := addr(lsrm_sctable^[scode]);
	with lutable^ do
	begin
	  if not connected then
	    if lansrm_connect then connected := true
			      else io_escape(ioe_dc_conn,lastsc);
	end;
	{ don't send the first byte of data }
	with user_buffer^ do
	begin
	  buf_empty := addr(cp(buf_empty)^,1);
	end;

	load_work_buf;

	with sctable^.mpxinw do
	  user_buffer := user_buffer^.eot_parm; { goto next input buffer }

	op_retries := op_tries;
	lastsize   := buffer_data(outworkbuf^);
	do_rx      := true;
	do_tx      := true;

	repeat
	  op_done  := -1;
	  if do_rx then
	    with sctable^.mpxinw do
	    begin
	      do_rx := false;
	      buffer_reset(user_buffer^);
	      transfer(scode,dummy_tfr_2,to_memory,user_buffer^,lan_max_frame_len);
	    end;

	  if do_tx then
	    begin
	      with outworkbuf^ do buf_empty := buf_ptr; { reset buf_empty }
	      transfer(scode,overlap_fastest,from_memory,outworkbuf^,lastsize);
	      while outworkbuf^.active_isc<>no_isc do; { wait for this to go out }
	    end;
	  do_tx := true;

	  { start timeout timeing }
	  op_timer.time := op_timeout[op_retries]; start_timer(op_timer);
	  op_retries := op_retries-1;

	  { wait for packet received or timeout }
	  repeat until (op_done<>-1) or time_expired(op_timer);

	  { set do_rx in case of need to loop again }
	  do_rx := op_done>0;

	  case op_done of
	   0:; { ok }
	   1,2:{ lengthen timeout or server busy }
	     begin      { go to long timeout }
	       op_retries := op_tries+1;
	       do_tx      := false;     { don't resend the packet }
	     end;
	   4:io_escape(ioe_dc_conn,lastsc); { bad_session }
	   7:io_escape(ioe_sr_fail,lastsc); { server going down }
	   otherwise
	     { timeout or unimplemented return code }
	     if (op_retries<=0) then
	       with sctable^.mpxinw do
	       begin
		 user_buffer^.active_isc := no_isc; { stop the transfer }
		 buffer_reset(user_buffer^);
		 lsrm_unit_table^[lastunit].connected := false;
		 io_escape(ioe_sr_fail,lastsc);
	       end;
	  end; { case }
	until op_done=0;
	{ fix up the callers buf_empty pointer }
	with user_buffer^ do buf_empty := addr(cp(buf_empty)^,buffer_data(user_buffer^));
      end; { with mpxr^ }
      b   := false; { tell caller the xfr is done }
    END; {WRAPPER2}

  PROCEDURE CHECKER2(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr   : iompx_rec_ptr;
    BEGIN
      mpxr := temp;
      with mpxr^ do
      begin
	if in_buffer=nil then
	begin { get data from inworkbuf }
	  if inworkbuf^.active_isc = no_isc then
	  begin { copy every thing }
	    copy_buffer_data(inworkbuf^,user_buffer^,0,maxint);
	    { if no more data in the source then switch to next buffer }
	    if inworkbuf^.term_count=0 then
	       inworkbuf := inworkbuf^.eot_parm;

	    if user_buffer^.term_count=0 then
	      io_escape(ioe_no_data,no_isc);
	    b := false; { data has been moved }
	  end
	  else io_escape(ioe_sr_fail,no_isc);
	end
	else b := true; { reject it }
      end;
    END; { CHECKER2 }

  PROCEDURE CHECKER3(TEMP : ANYPTR; VAR B:BOOLEAN);
    label 1;
    VAR
      mpxr   : iompx_rec_ptr;
      lutable: lsrm_unit_ptr;
      tempp  : anyptr;
      dsize  : shortint;
      ok     : check_type;
    BEGIN
      mpxr := temp;
      b    := true; { reject it }
      with mpxr^ do
      begin
	lutable := addr(lsrm_unit_table^[lastunit]);
	if in_buffer<>nil then
	with in_buffer^ do
	begin
	  check_frame(in_buffer^,lutable^,lsrm_sctable^[scode],ok,tempp,dsize);
	  if ok=is_done then
	  { signal that this data is accepted & setup to re-arm the buffer }
	  begin  b:= false;
		 user_buffer^.eot_proc.real_proc := eot_rearm;
	  end;
	  if ok<>is_ok then goto 1;

	  { check the reply contents }
	  with tfr_request_ptr(tempp)^ do
	  begin
	    if not ((rec_type=tfr_reply_code) and
		    (version = p_version) and
		    (host_node = lutable^.hostnode) and
		    (sequence_no=lutable^.sequence) and
		    (unum=lastunit)) then goto 1;
	    op_done := ret_code;
	  end;

	  if op_done=0 then
	  begin
	    { set the next expected sequence number }
	    lutable^.sequence := (lutable^.sequence+1) mod 256;
	    lutable^.session  := tfr_request_ptr(tempp)^.session_id;
	    {skip all lsrm header then move the data}
	    tempp := addr(cp(tempp)^,tfr_req_size);
	    dsize := dsize - tfr_req_size;
	    if dsize>0 then
	    begin
	      with user_buffer^ do
	      begin
		if dsize>term_count then dsize := term_count;
		moveleft(cp(tempp)^,cp(buf_fill)^,dsize);
		term_count := dsize;
		buf_fill := ADDR(cp(buf_fill)^,dsize);
	      end;
	    end;
	  end;
	  b := false;   { tell caller its processed }
	end; { with in_buffer }
      end; { with mpxr }
    1:
    END; {CHECKER3}

  function lansrm_connect:boolean;

    VAR
      mpxout,
      mpxin     : iompx_rec;
      lutable   : lsrm_unit_ptr;
      utable    : ^unitentry;

      bufin     : buf_info_type;
      datai     : char;

      bufout    : buf_info_type;
      datao     : lsrm_request_type;

      timer     : timer_rec;
      tries     : integer;
      i         : integer;

      done      : boolean;
      farea[-300] : link_address_ptr;

    BEGIN { lansrm_connect }
      done    := false;
      lutable := addr(lsrm_unit_table^[lastunit]);
      utable  := addr(unitable^[lastunit]);
      with lutable^ , iompx_info^ do
      begin
	with utable^ do
	begin
	  TRY
	    { setup the input side }
	    CALL(register_iompx_buf,
		 sc,TO_MEMORY,bufin,mpxin,FALSE,lutable,checker1);
	    { setup the output side }
	    CALL(register_iompx_buf,
		 sc,FROM_MEMORY,bufout,mpxout,FALSE,lutable,wrapper1);

	    { start the input transfer for one byte }
	    init_buffer(bufin,datai,1);
	    datai := 'F';
	    transfer(sc,dummy_tfr_2,to_memory,bufin,1);

	   { build & transmit the request }
	    with datao do
	    begin
	      rec_type    := lsrm_request_code;
	      ret_code    := 0;
	      option_code := 0;
	      host_node   := BA; { from unitable^ }
	      version     := p_version;
	      my_station  := lsrm_sctable^[lastsc].localaddr;
	    end;
	    { if boot device then use the host address else use the broadcast }
	    { Enhanced 1/2/91 JWH to set the connect_timeout variable JWH }
	    if BA=127 then
	      begin
	       lutable^.hostladdr := farea^;
	       connect_timeout := boot_connect_timeout;
	      end
	     else
	      begin
	       lutable^.hostladdr := e_broadcast;
	       connect_timeout := broadcast_connect_timeout;
	      end;
	    my_port := udp_my_port;

	    init_buffer(bufout,datao,sizeof(datao));
	    bufout.buf_fill := addr(bufout.buf_ptr^,sizeof(datao));
	    tries := connect_tries;
	    repeat
	      { send the request and start the timer }
	      transfer(sc,serial_fastest,from_memory,bufout,sizeof(datao));
	      timer.time := connect_timeout; start_timer(timer);
	      repeat
		if (not done) and (not buffer_busy(bufin)) then
		begin
		  done := datai='G';
		  if not done then { restart the input transfer }
		  begin
		    buffer_reset(bufin); datai := 'F';
		    transfer(sc,dummy_tfr_2,to_memory,bufin,1);
		  end;
		end; { while }
	      until done or time_expired(timer);
	      if not done then tries := tries-1;
	    until done or (tries=0);

	  RECOVER { suppress every error }
	    begin end;

	  call(unregister_iompx_buf,sc,TO_MEMORY,bufin);
	  call(unregister_iompx_buf,sc,FROM_MEMORY,bufout);

	end;
      end; {with lsrm_isc_table}
      lansrm_connect := done;
    END; { lansrm_connect }

  { called by table before it does a hook up }
  procedure lansrm_ok(var sc : integer);
    begin
      if iompx_info<>nil then
      begin
	if (sc>=minrealisc) and (sc<=maxrealisc) then
	begin
	  if (iompx_info^.isc_iompx_table[sc].capable) and
	     (isc_table[sc].card_id = hp98643) then SC := -SC;
	end;
      end;
    end; { lansrm_ok }

  procedure lansrm_reset(sc:integer);
    begin
      with lsrm_sctable^[sc].mpxinw do
      begin
	user_buffer^.active_isc := no_isc;
	inworkbuf := user_buffer^.eot_parm;
	inworkbuf^.active_isc := no_isc;
      end;
    end; { lansrm_reset }

  procedure lansrm_init_unit(un: integer);
    begin
      with lsrm_unit_table^[un] do
      begin
	 hostladdr := e_broadcast;
	 mynode    := 0;
	 hostnode  := 0;
	 my_ip     := 0;
	 host_ip   := -1;
	 my_port   := udp_my_port;
	 host_port := udp_service_port;
	 session   := -1;
	 sequence  := 0;
	 connected := false;
      end;
    end; { lansrm_init_unit }

  { if IOMPX is installed then
    scan the select codes for a LAN card & driver using IOMPX
    for each one found, register the srm driver buffer & a working buffer
    if any suitable interfaces were found, allocate & initialize the
    shadow unit table
  }
  procedure lansrm_init(var srmbuf : buf_info_type);
    VAR
      i,
      sc        : integer;
      ok        : boolean;
      ans       : iompx_ans_rec;
      lutable   : lsrm_unit_ptr;
      mpxout,
      mpxin     : iompx_rec_ptr;
      inworkbuf2   : BUFxINFOxPTR;
      BMSUS[-292]  : PACKED ARRAY [1..4] OF CHAR;
    BEGIN { LANSRM_INIT }
      mpxout := nil;
      mpxin  := nil;
      { allocate & init the shadow unit table }
      if lsrm_unit_table=nil then
      begin
	{ modify boot MSUS for power up from LAN }
	if ORD(BMSUS[1])=HEX('E2') then
	begin { booted from LAN }
	  BMSUS[2] := #8; { unit 8 }
	  BMSUS[4] := #127; { boot node }
	end;

	if iompx_info=nil then
	begin
	  call(io_error_link,iompx_request,ans.s);
	  ok := ans.s=iompx_answer;
	  if ok then iompx_info := ans.ptr;
	end;
	if ok then
	begin
	  ok := false;
	  for sc := minrealisc to maxrealisc do
	  with iompx_info^ do
	  begin
	    if isc_iompx_table[sc].capable then
	    with isc_table[sc] do
	    begin
	      if (card_id=hp98643) then
	      begin { register the buffers }
		if lsrm_sctable=nil then new(lsrm_sctable); { allocate shadow sc table }
		ok := true; { at least one setup }

		with lsrm_sctable^[sc] do
		for i := 1 to 6 do
		begin
		  localaddr[i] := chr(iostatus(sc,l_link_addr1-1+i));
		end;

		if inworkbuf=nil then
		begin
		  new(inworkbuf);
		  IOBUFFER(inworkbuf^,LAN_MAX_FRAME_LEN);
		  new(inworkbuf2);
		  IOBUFFER(inworkbuf2^,LAN_MAX_FRAME_LEN);
		  { chain link the buffers thru eot_parm }
		  inworkbuf^.eot_parm := inworkbuf2;
		  inworkbuf2^.eot_parm := inworkbuf;
		  new(outworkbuf);
		  IOBUFFER(outworkbuf^,LAN_MAX_FRAME_LEN);
		end;
		{ setup the input side }
		{ need unique registration records for each select code }
		new(mpxin);
		CALL(register_iompx_buf,
		     sc,TO_MEMORY,srmbuf,mpxin^,FALSE,lutable,checker2);
		with lsrm_sctable^[sc] do
		begin
		  CALL(register_iompx_buf,
		       sc,TO_MEMORY,inworkbuf^,mpxinw,FALSE,lutable,checker3);
		  lansrm_reset(sc);   { fix up data structures used by wrapper2 etc. }
		end;
		{ setup the output side }
		new(mpxout);
		CALL(register_iompx_buf,
		     sc,FROM_MEMORY,srmbuf,mpxout^,FALSE,lutable,wrapper2);
	      end;
	    end;
	  end;

	  if ok then
	  begin
	    new(lsrm_unit_table);
	    for i := 0 to maxunit do lansrm_init_unit(i);
	  end
	  else iompx_info := nil; { no LAN }
	end;
      end;
    END; { lansrm_init }

END. { MODULE LANSRM }


@


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.2
log
@changed protocol version from 10 to 11.
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@d86 2
a87 1
    p_version         = 10;     { protocol version }
@


50.2
log
@Enhanced the timeout values for SRM/UX. Basically allow for more liberal
timeouts, especially when trying to connect with the device from which
booting took place. Syncs up with the values used for the BASIC
workstation and SRM/UX.

@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d64 15
a78 3
    connect_timeout = 0500; { .5 seconds }
    connect_tries   = 2;
    op_timeout      = timeout_arr[15000, 5000, 700, 20000];
d227 2
d921 11
a931 2
	    if BA=127 then lutable^.hostladdr := farea^
		      else lutable^.hostladdr := e_broadcast;
@


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.2
log
@Adjusted connect_timeout and connect_retries constants.
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@d64 2
a65 2
    connect_timeout = 4000; { 4 seconds }
    connect_tries   = 3;
@


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.2
log
@

         SRM-UX changes.
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d2 2
a3 2
$DEBUG OFF$
$RANGE OFF$
d9 3
a11 2
$SEARCH 'IOLIB:KERNEL'$
$SEARCH 'IOLIB:LANASM','IOLIB:LANDECS'$
d18 2
a19 1
  $INCLUDE 'IOLIB:IOMPXDECS.TEXT'$
d24 6
a29 2
			hostname  : vid;
			mynode    : shortint;
d36 1
d47 1
d51 1
d55 1
d57 8
a64 3
				    { 01  AA  BB  DD  BB  AA}
    lsmulticast = link_address_type[#001#170#187#221#187#170];
    connect_timeout = 3000; { 3 seconds }
d78 6
a83 6
    L_SERVER_BUSY      = 2;
    L_BAD_SEQUENCE_NUMBER = 3;
    L_BAD_SESSION      = 4; { NEED TO RECONNECT }
    L_BAD_SIZE   = 5;
    L_BAD_PACKET = 6;
    L_ABORTED = 7;          { SERVER GOING DOWN }
d85 3
a87 1
    lsrm_sap = HEX('708');
a88 4
    hp_ext_sap = HEX('F8');

    hdr_size = sizeof(ieee802_hp_ext_type);

d93 59
a151 1
    { LAN_SRM FRAME FORMATS }
d159 1
d165 2
d168 1
a168 1
			session_id : shortint;
d170 5
a174 2
			my_node    : shortint;  { not used }
			sys_name   : string255;
d176 1
d178 2
a179 1
    tfr_data_type   = packed array[1..1600] of char;
d181 1
a181 1
			 rec_type   : shortint;
d183 3
a185 1
			 session_id : shortint;
d188 1
a188 1
			 data       : tfr_data_type;
d191 1
d198 2
a199 2
    lsrm_sctable_ptr = ^lsrm_sctable_type;
    link_address_ptr = ^link_address_type;
d202 6
a207 7
    ll_overhead  = hdr_size - 14;
    tfr_overhead = ll_overhead + sizeof(tfr_request_type)
			       - sizeof(tfr_data_type);
    min_reply_len= ll_overhead + sizeof(lsrm_reply_type)
			       - 255;
    overhead = hdr_size + sizeof(tfr_request_type)
			- sizeof(tfr_data_type);
d213 1
a215 1

d273 19
d396 12
a407 7
  PROCEDURE WRAPPER1(TEMP : ANYPTR; VAR B:BOOLEAN);
    VAR
      mpxr  : iompx_rec_ptr;
      dsize : integer;
    BEGIN
      mpxr := temp;
      with mpxr^ do
d409 5
a413 1
	isc_table[scode].io_tmp_ptr^.out_bufptr := nil; { patch #1 }
d415 17
a431 2
	with user_buffer^ do
	  dsize := integer(buf_fill)-integer(buf_empty);
d433 30
a462 1
	with ieee_ext_hdr_ptr(outworkbuf^.buf_ptr)^ do
d464 2
a465 9
	  destination := lsrm_unit_table^[lastunit].hostladdr;
	  source      := lsrm_sctable^[scode].localaddr;
	  length      := ll_overhead + dsize;
	  dsap        := hp_ext_sap;
	  ssap        := hp_ext_sap;
	  cntrl       := 3;
	  hf1 := 0; hf2 := 0; hf3 := 0;
	  dxsap       := lsrm_sap;
	  sxsap       := lsrm_sap;
d467 2
d470 45
a514 1
	with outworkbuf^ do
d516 1
a516 4
	  buf_empty := buf_ptr;
	  buf_fill  := addr(buf_ptr^,hdr_size);
	  moveleft(cp(user_buffer^.buf_empty)^,cp(buf_fill)^,dsize);
	  buf_fill  := addr(cp(buf_fill)^,dsize);
d518 1
d520 12
a531 1
	transfer(scode,overlap_fastest,from_memory,outworkbuf^,hdr_size+dsize);
d533 40
d582 4
a585 2
      reply  : lsrm_reply_ptr;
      dsize  : integer;
a588 1
      if mpxr^.in_buffer<>nil then
d590 1
a591 2
	with in_buffer^ do
	  dsize := integer(buf_fill)-integer(buf_empty);
d593 14
a606 1
	with in_buffer^ do
d608 16
a623 1
	  with ieee_ext_hdr_ptr(buf_empty)^ do
d625 5
a629 7
	    if not ((destination=lsrm_sctable^[scode].localaddr) and
		    (dsap=hp_ext_sap) and
		    (ssap=hp_ext_sap)) then goto 1;
	    if not ((cntrl = 3) and
		    (dxsap = lsrm_sap) and
		    (sxsap = lsrm_sap) and
		    (length>= min_reply_len)) then goto 1;
d631 11
a641 30
	  { check the reply contents }
	  reply := addr(cp(buf_empty)^,hdr_size);
	  with reply^ do
	  begin
	    if not ((rec_type=lsrm_reply_code) and
		    (ret_code=0) and
		    (option_code=0) and
		    (version=p_version) and
		    (strlen(sys_name)>0)and
		    (strlen(sys_name)<=sizeof(vid)))
	       then goto 1;
	    with lutable^ do
	    begin
	      session   := session_id;
	      sequence  := 0;
	      mynode    := my_node;
	      hostname  := sys_name;
	      hostladdr := ieee_ext_hdr_ptr(buf_empty)^.source;
	    end;
	  end;
	  { tell caller to complete the transfer }
	  b := false;
	  term_count := 0; { checked/moved it all }
	  with user_buffer^ do
	  begin
	    cp(buf_fill)^ := 'G';
	    buf_fill := addr(cp(buf_fill)^,1);
	    term_count := 1;
	  end;
	end; { with in_buffer }
d649 1
a649 2
      mpxr  : iompx_rec_ptr;
      dsize : integer;
d651 1
d660 2
d665 1
a665 2
	    { create the LAN protocol headers }
	    with ieee_ext_hdr_ptr(outworkbuf^.buf_ptr)^ do
d667 8
a674 10
	      destination := lutable^.hostladdr;
	      source      := lsrm_sctable^[scode].localaddr;
	      length      := tfr_overhead + dsize;
	      dsap        := hp_ext_sap;
	      ssap        := hp_ext_sap;
	      cntrl       := 3;
	      hf1 := 0; hf2 := 0; hf3 := 0;
	      dxsap       := lsrm_sap;
	      sxsap       := lsrm_sap;
	    end;
d676 4
a679 19
	    with outworkbuf^ do
	    begin
	      { patch up pointers }
	      buf_empty := buf_ptr;
	      buf_fill  := addr(buf_ptr^,hdr_size);

	      with tfr_request_ptr(outworkbuf^.buf_fill)^ do
	      begin
		rec_type := tfr_request_code;
		ret_code := 0;
		session_id := lutable^.session;
		unum     := lastunit;
		sequence_no := lutable^.sequence;
		buf_fill := addr(data);     { set buf_fill }
	      end;

	      moveleft(cp(user_buffer^.buf_empty)^,cp(buf_fill)^,dsize);
	      buf_fill := ADDR(cp(buf_fill)^,dsize);
	    end;
d689 1
a699 1
	  dsize := term_count-1; {integer(buf_fill)-integer(buf_empty);}
d704 1
a704 1
	with lsrm_sctable^[lastsc].mpxinw do
d708 1
a708 1
	lastsize   := overhead+dsize;
d715 1
a715 1
	    with lsrm_sctable^[lastsc].mpxinw do
d747 2
a748 10
	   4:with lutable^ do { need to reconnect }
	     begin
	       old_seq   := lutable^.sequence; { save sequence # }
	       connected := lansrm_connect;
	       if not connected then io_escape(ioe_dc_conn,lastsc);
	       lutable^.sequence:= old_seq;  { restore sequence # }
	       op_retries := op_tries;  { restart retry counter }
	       load_work_buf;
	     end;
	   7: io_escape(ioe_sr_fail,lastsc); { server going down }
d752 1
a752 1
	       with lsrm_sctable^[lastsc].mpxinw do
d762 1
a762 1
	with user_buffer^ do buf_empty := addr(cp(buf_empty)^,dsize);
d798 3
a800 2
      reply  : tfr_request_ptr;
      dsize  : integer;
d810 5
a814 10
	  with ieee_ext_hdr_ptr(buf_empty)^ do
	  begin
	    if not ((destination=lsrm_sctable^[scode].localaddr) and
		    (dsap=hp_ext_sap) and
		    (ssap=hp_ext_sap)) then goto 1;
	    if not ((cntrl = 3) and
		    (dxsap = lsrm_sap) and
		    (sxsap = lsrm_sap) and
		    (length>=tfr_overhead)) then goto 1;
	    dsize := length-tfr_overhead;
d816 2
d819 1
a819 2
	  reply := addr(cp(buf_empty)^,hdr_size);
	  with reply^ do
d822 2
a823 1
		    (session_id=lutable^.session) and
a826 4
	    {$IOCHECK OFF$
	    WRITELN('SEQ = ',SEQUENCE_NO:1,', RET_code = ',ret_code:1);
	    IORESULT := 0;
	    $IOCHECK ON $}
d828 1
d833 14
a846 2
	    {skip all overhead then move the data}
	    copy_buffer_data(in_buffer^,user_buffer^,overhead,dsize);
a853 19
  procedure init_buffer(var buf : buf_info_type;
		    anyvar data : integer; size : integer);
    begin
      with buf do
      begin
	buf_ptr    := addr(data);
	buf_size   := size;
	buf_empty  := buf_ptr;
	buf_fill   := buf_ptr;
	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; { init_buffer }

a875 4
      {$IOCHECK OFF$
      WRITELN('CONNECT CALLED');
      IORESULT := 0;
      $IOCHECK ON $}
d904 1
d906 1
a906 1
	    { if boot device then use the host address else use the multicast }
d908 2
a909 1
		      else lutable^.hostladdr := lsmulticast;
d923 2
d926 1
a937 1
	  {if done then lansrm_reset(lastsc);}
a939 5
      {$IOCHECK OFF$
      WRITELN('CONNECT RESULT = ',DONE);
      IORESULT := 0;
      $IOCHECK ON $}

d966 17
d1073 1
a1073 7
	    for i := 0 to maxunit do
	      with lsrm_unit_table^[i] do
	      begin
		 hostladdr := lsmulticast;
		 hostname  := '';
		 connected := false;
	      end;
@


1.2
log
@
pws2rcs automatic delta on Thu May 11 11:32:36 MDT 1989
@
text
@@


1.1
log
@Initial revision
@
text
@d17 1
a17 1
  $INCLUDE 'IOMPXDECS.TEXT'$
@
