head     1.1;
access   paws bayes jws larry quist brad;
symbols  ;
locks    ; strict;
comment  @# @;


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


desc
@Base file for PWS 3.2 release.

@



1.1
log
@Initial revision
@
text
@$SYSPROG$ $MODCAL$
MODULE DUMPER;
$SEARCH 'LANDECS'$ $ALLOW_PACKED$
IMPORT SYSGLOBALS, iodeclarations, LANDECS;
EXPORT
  type
    memory = packed array [0..maxint] of char;
  procedure dumphexbyte(c : char);
  procedure dumpaddress(var a:link_address_type);
  procedure dumpbpacket(anyvar frame:bpointer;
			packet_size : shortint);
  procedure dumppacket(anyvar pp:bpointer;
		       packet_size : shortint);
  function dumppheader(anyvar p:ieee_ext_hdr_ptr):bpointer;
  procedure dumptxinfo(sc:integer);
  procedure dumpmemory(anyvar c : memory ; len: integer);

IMPLEMENT
  TYPE
    PACKED_MACHINE_NAME = PACKED ARRAY[1..20] OF CHAR;
    NAME_TYPE = STRING255;
  { BOOT FRAME FORMATS }
    BOOT_REQUEST_PTR = ^BOOT_REQUEST_TYPE;
    BOOT_REQUEST_TYPE = PACKED RECORD { OUTBOUND }
			  REC_TYPE    : BYTE;
			  RET_CODE    : BYTE;
			  SEQUENCE_NO : INTEGER;
			  UN_USED     : SHORTINT;
			  VERSION     : SHORTINT;
			  MACHINE     : PACKED_MACHINE_NAME;
			  FILE_NAME   : NAME_TYPE;
			END;
    BOOT_REPLY_PTR = ^BOOT_REPLY_TYPE;
    BOOT_REPLY_TYPE = PACKED RECORD { INBOUND }
			REC_TYPE   : BYTE;
			RET_CODE   : BYTE;
			SEQUENCE_NO: INTEGER;
			SESSION_ID : SHORTINT;
			VERSION    : SHORTINT;
			NAME       : NAME_TYPE;
		      END;
    READ_REQUEST_PTR = ^READ_REQUEST_TYPE;
    READ_REQUEST_TYPE = PACKED RECORD { OUTBOUND }
			  REC_TYPE   : BYTE;
			  RET_CODE   : BYTE;
			  DATA_OFFSET: INTEGER;
			  SESSION_ID : SHORTINT;
			  SIZE       : SHORTINT;
			END;
    READ_REPLY_PTR = ^READ_REPLY_TYPE;
    READ_REPLY_TYPE = PACKED RECORD { INBOUND }
			REC_TYPE   : BYTE;
			RET_CODE   : BYTE;
			DATA_OFFSET: INTEGER;
			SESSION_ID : SHORTINT;
			DATA       : PACKED ARRAY[1..1600] OF CHAR;
		      END;
    BOOT_DONE_PTR = ^BOOT_DONE_TYPE;
    BOOT_DONE_TYPE = PACKED RECORD { OUTBOUND }
		       REC_TYPE   : BYTE;
		       RET_CODE   : BYTE;
		       UN_USED    : INTEGER;
		       SESSION_ID : SHORTINT;
		     END;

  CONST
    { BOOT PACKET CODES }
    BOOT_REQUEST_CODE = 1;
    BOOT_REPLY_CODE   = 129;
    READ_REQUEST_CODE = 2;
    READ_REPLY_CODE   = 130;
    BOOT_DONE_CODE    = 3;
    { RETURN CODES }
    L_NO_ERROR = 0;
    L_EOF = 2;
    L_ABORT = 3;
    L_SERVER_BUSY = 4;
    L_CANT_FIND_FILE = 16;
    L_CANT_OPEN_FILE = 17;
    L_NO_SUCH_DEFAULT = 18;
    L_CANT_OPEN_DEFAULT = 19;
    L_BAD_SESSION_ID = 25;
    L_BAD_SEQUENCE_NUMBER = 26;
    L_BAD_PACKET = 27;
    L_BAD_OFFSET = 28;
    L_ERROR = 255;

  procedure dumphexbyte(c : char);
    const hex = '0123456789ABCDEF';
    begin
      write(hex[(ord(c) div 16)+1],hex[(ord(c) mod 16)+1]);
    end;

  procedure dumpaddress(var a:link_address_type);
    var i : integer;
    begin
      for i :=1 to 6 do dumphexbyte(a[i]);
      writeln;
    end;

  function dumppheader(anyvar p:IEEE_EXT_HDR_PTR):bpointer;
    begin
      with p^ do
      begin
	writeln('transport frame');
	write('destination= '); dumpaddress(destination);
	write('source     = '); dumpaddress(source);
	writeln('length     = ',length:1);
	writeln('DSAP= ',dsap:1,' SSAP= ',ssap:1,' CNTRL= ',cntrl:1);
	writeln('DXSAP= ',dxsap:1,' SXSAP= ',sxsap:1);
      end;
      dumppheader := addr(p^,sizeof(p^));
    end; { dumppheader }

  procedure dumpbpacket(anyvar frame:bpointer;
			packet_size : shortint);
  type
     gpptr = record
	      case integer of
	      0:(ptr : bpointer);
	      1:(p1  : boot_request_ptr);
	      2:(p2  : boot_reply_ptr);
	      3:(p3  : read_request_ptr);
	      4:(p4  : read_reply_ptr);
	      5:(p5  : boot_done_ptr);
	     end;
  var
    p : gpptr;
    s : ^string255;
    i : integer;
    n : integer;
  begin
    p.ptr := frame;
    with p.p1^ do
    begin
      writeln('boot frame');
      write('type   = ',rec_type:1);
      writeln(', return code = ',ret_code:1);
      if rec_type = boot_request_code then
	begin
	  write('sequence no = ',sequence_no:1);
	  write(', unused field = ',un_used:1);
	  write(', version = ',version:1);
	  writeln(', machine = ',machine);
	  write('filename = ');
	  n := packet_size-(sizeof(boot_request_type)-sizeof(name_type));
	  if n>0 then n := strlen(file_name);
	  if n=0 then write('NO file name')
		 else write(file_name);
	  writeln;
	end
      else
      if rec_type=boot_reply_code then
      with p.p2^ do
      begin
	write('sequence no = ',sequence_no:1);
	write(', session id = ',session_id:1);
	writeln(', version = ',version:1);
	write('name = ');
	n := packet_size-(sizeof(boot_reply_type)-sizeof(name_type));
	if n>0 then n := strlen(name);
	if n=0 then write('NO name')
	       else write(name);
	writeln;
      end
      else
      if rec_type=read_request_code then
      with p.p3^ do
      begin
	write('offset = ',data_offset:1);
	write(', session id = ',session_id:1);
	writeln(', size = ',size:1);
      end
      else
      if rec_type=read_reply_code then
      with p.p4^ do
      begin
	write('offset = ',data_offset:1);
	write(', session id = ',session_id:1);
	writeln(', record has ',packet_size-8:1,' data bytes');
      end
      else
      if rec_type=boot_done_code then
      with p.p5^ do
      begin
	write('unused field = ',un_used:1);
	writeln(', session id = ',session_id:1);
      end
      else writeln('unknown frame type');
    end;
    writeln;
  end; { dumpbpacket }

  procedure dumppacket(anyvar pp:bpointer;
		       packet_size : shortint);
    VAR P : BPOINTER;
    begin
      P := PP;
      p := dumppheader(p);
      dumpbpacket(p,packet_size);
    end; { dumppacket }

  procedure dumptxinfo(sc:integer);
    var
      info : lan_info_ptr;
    begin
      writeln('tx info, sc= ',sc:1);
      info := addr(isc_table[sc].io_tmp_ptr^.drv_misc);
      with info^ do
      begin
	write('tx_count = ',tx_count:1);
	write(', tx_next = ',tx_next.int:1);
	write(', tx_r1 = ',ord(txr_1):1,' tx_rn = ',ord(txr_n):1);
	write(', tx_ring_f = ',ord(tx_ring_f):1);
	writeln;
      end;
    end;

  procedure dumpmemory(anyvar c : memory ; len: integer);
     var i, j : integer;
     begin
       i := 0;
       while i < len do
       begin
	 write(i,' ');
	 for j := i to i+15 do { one row }
	 begin { hex representation }
	   if j>=len then write('  ')
		     else dumphexbyte(c[j]);
	   write(' ');
	 end;
	 write('|');
	 for j := i to i+15 do
	 begin { character representation }
	   if j>=len then write(' ')
	   else
	   if (c[j]<' ') OR (c[j]>#128) then write('.')
					else write(c[j]);
	 end;
	 writeln;
	 i := i + 16;
       end;
     end; { dumpmemory }
  END. { dumper }
@
