home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / norskdata / ndkdeb.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  5KB  |  165 lines
  1. (*  tab p;
  2.  *
  3.  *      Routines for output of debug-info.
  4.  *
  5.  *      Globals:
  6.  *          DbgOut : text       - where all the debug goes.
  7.  *          Debug : boolean     - controls wether debug is wanted or not.
  8.  * 
  9.  *      All routines test on the value of "Debug" - no testing
  10.  *      neccesary before calling any of these routines.
  11.  *
  12. *)
  13.  
  14.     procedure   DbgNL;
  15.     (*  Globals     :   Debug   ( read )
  16.                         DbgOut
  17.         SideEffects :   Finishes current line on debug-file
  18.     *)
  19.     begin
  20.         if Debug then writeln(DbgOut);
  21.     end;
  22.  
  23.     procedure   DbgInt( n : integer );
  24.     (*  Globals     :   Debug ( read )
  25.                         DbgOut
  26.         SideEffects :   Writes an integer on DbgOut with default field width
  27.     *)
  28.     begin
  29.         if Debug then write( DbgOut , n );
  30.     end;
  31.  
  32.     procedure PrintChar( ch : char );
  33.     begin
  34.         if ch IN (.succ(' ')..'~'.) then
  35.             write( DbgOut, ch )
  36.         else
  37.             if ch='/' then 
  38.                 write( DbgOut, '//' )
  39.             else
  40.                 write( DbgOut, '/', ord( ch ):3:8, '/' );
  41.     end;
  42.  
  43.     procedure   DbgChar( ch : char );
  44.     (*  Globals     :   Debug ( read )
  45.                         DbgOut
  46.         SideEffects :   Outputs a character on DbgOut.
  47.     *)
  48.     begin
  49.         if Debug then
  50.             PrintChar(ch);
  51.     end;
  52.  
  53.     procedure   DbgWrite( Str : StringType );
  54.     (*  Abstract    :   Outputs a string to Debug-file. Terminator is '$'.
  55.         Globals     :   Debug   ( read )
  56.                         DbgOut
  57.         SideEffects :   Writes a string on DbgOut
  58.         Input Params:   Str - String to be written
  59.     *)
  60.     var     i : integer;
  61.     begin
  62.         if Debug then
  63.         begin
  64.             i := MinString;
  65.             while   (Str(.i.) <> '$')
  66.                 and (i < MaxString) do
  67.             begin
  68.                 write( DbgOut, Str(.i.) );
  69.                 i := i + 1;
  70.             end;
  71.         end;
  72.     end;
  73.  
  74.     procedure   DbgState( S : KermitStates );
  75.     begin
  76.         if Debug then
  77.             case S of
  78.                 FileData    :   Write( DbgOut, 'FileData  ');
  79.                 Init        :   Write( DbgOut, 'Init      ');
  80.                 Break       :   Write( DbgOut, 'Break     ');
  81.                 FileHeader  :   Write( DbgOut, 'FileHeader');
  82.                 EOFile      :   Write( DbgOut, 'EOFile    ');
  83.                 Complete    :   Write( DbgOut, 'Complete  ');
  84.                 Abort       :   Write( DbgOut, 'Abort     ');
  85.             end;
  86.     end;
  87.  
  88.     procedure   DbgPacket ( Pack : Packet );
  89.     (*  Abstract    :   Outputs a packet on debug-file.
  90.                         Does a Writeln on debug-file.
  91.         Globals     :   Debug   ( read )
  92.                         DbgOut
  93.         InputParams :   Pack  - Packet to be written on DbgOut.
  94.         SideEffects :   Outputs packet and "NewLine" to DbgOut.
  95.         Uses        :   UnChar
  96.     *)
  97.     var     i : integer;
  98.     begin
  99.         if Debug then
  100.         begin
  101.             with Pack do
  102.             if PType IN LegalPackets then
  103.             begin
  104.                 write(DbgOut,'Packet: ');
  105.                 PrintChar(count);
  106.                 PrintChar(seq);
  107.                 PrintChar(pType);
  108.                 if count < ' ' then
  109.                     write(DbgOut,'/////// Bad count field in packet! //////')
  110.                 else
  111.                     for i := MinString to ord( UnChar ( count ) ) - 3 do
  112.                         PrintChar( Data(.i.) );
  113.             end else
  114.             begin
  115.                 write(DbgOut,' DbgPacket: Invalid packet type ');
  116.             end;
  117.             writeln(DbgOut);
  118.         end;
  119.     end;
  120.  
  121.     procedure DbgShowPacket(VAR Pack:Packet);
  122.     (*  Abstract        :   Writes a packet to the Debug file
  123.                             as DbgPacket, but in greater detail *)
  124.  
  125.     var     i,packlen : integer;
  126.     begin
  127.         if Debug then
  128.         with Pack do begin
  129.             write(DbgOut,'DbgShowPacket: ');
  130.             if Mark<>SOH then begin
  131.                 writeln(DbgOut,' *** Bad StartOfHeader character: / ',ord(Mark):3:8,'/'  );
  132.             end;
  133.             write(DbgOut,'  Seq =');
  134.             if seq<' ' then 
  135.                 write(DbgOut, ' BAD')
  136.             else
  137.                 write(DbgOut, ord(UnChar(seq)):4 );
  138.             if count<' ' then
  139.                 writeln(DbgOut,'  *** Bad Packet Lenght *** ')
  140.             else begin
  141.                 PackLen := ord( UnChar(count) );
  142.                 write( DbgOut,'  Count = ',PackLen);
  143.                 write( DbgOut,'  PType = ');
  144.                 PrintChar( PType );
  145.                 Writeln( DbgOut );
  146.                 if PackLen>MaxString - 3 then PackLen := MaxString - 3;
  147.                 for i:=MinString to PackLen-3 do
  148.                     PrintChar( data(.i.) );
  149.                 writeln( DbgOut );
  150.             end;
  151.         end (* with *);
  152.     end;
  153.  
  154.  
  155.     procedure DbgFileName( VAR Fn : NameType );
  156.     (*  Abstract    :   Writes a file name to the debug file *)
  157.     VAR i : integer;
  158.     begin
  159.         if Debug then
  160.             with Fn do
  161.                 for i := 1 to valid do
  162.                     write( DbgOut, String(.i.) );
  163.     end;
  164. 
  165.