{ ---------------------------------------------------------------------
{
{ WISP.PAS V4.13 dd 23-Feb-2004
{
{ Tool to control
{    WISP  programmer hardware (obsolete)
{    Wisp628 programmer hardware (but for a limited range of targets)
{    WLoader 16f877 application loader  
{
{ see: http://www.voti.nl/wisptool 
{
{ Note: XWisp is the recommended PC software for Wisp628 and WLoader.
{
{ ---------------------------------------------------------------------
{
{ Copyright (C) 2000 .. 2004 Wouter van Ooijen
{
{ This application is free software; you can redistribute it and/or
{ modify it under the terms of the GNU Library General Public
{ License as published by the Free Software Foundation; either
{ version 2 of the License, or (at your option) any later version.
{
{ This application is distributed in the hope that it will be useful,
{ but WITHOUT ANY WARRANTY; without even the implied warranty of
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
{ Library General Public License for more details.
{ 
{ You should have received a copy of the GNU Library General Public
{ License along with this library; if not, write to the
{ Free Software Foundation, Inc., 59 Temple Place - Suite 330,
{ Boston, MA  02111-1307, USA.  
{
{ --------------------------------------------------------------------- }
{
{ ToDo list
{ - verification with code protection
{ - WLoader fuses discrepancy: just a warning    
{ - TTY show mode, add example, does not work?  
{ - put/get etc. picture
{
{ --------------------------------------------------------------------- }

uses dos, crt;

const version = '4.13';

function min( a, b : integer ) : integer; begin
   if a > b then min := b else min := a;
end;

const ModeTextIndex : integer = 1;
const ModeText : array[ 1..4] of string = (
   'B67T', 'B67I', 'AUXT', 'AUXI' );


{ --------------------------------------------------------------------- }
{
{ string things 
{
{ --------------------------------------------------------------------- }

const HexArray : string = '0123456789ABCDEF';

   { return decimal string of n }
function DecInt( n : integer ) : string;
   var s : string;
begin
   Str( n, s );
   DecInt := s;
end;

   { return one hex char from a 4 bits nibble }
function HexNibble( b : byte ) : char; begin
   HexNibble := HexArray[ 1 + ( b mod $10 ) ];
end;

   { return two hex chars from an 8 bits byte }
function HexByte( b : byte ) : string; begin
   HexByte := HexNibble( b div $10 ) + HexNibble( b mod $10 );
end;

   { return two hex chars from a (8 bit) char }
function HexChar( c : char ) : string; begin
   HexChar := HexByte( ord( c ) );
end;

   { return four hex chars from a 16 bit word }
function HexWord( w : word ) : string; begin
   HexWord := HexByte( hi( w ) ) + HexByte( lo( w ) );
end;

   { return 8 bit chars from an 8 bit byte }
function BinByte( b : byte ) : string;
   var s : string;
   var i : integer;
begin
   s := '';
   for i:= 1 to 8 do begin
      if odd( b ) then s := '1' + s else s := '0' + s;
      b := b div 2;
   end;
   BinByte := s;
end;

   { return a 4-bit nibble from one hex char }
function NibbleHex( c : char ) : byte; begin
   case c of
      '0'..'9': NibbleHex := ord( c ) - ord( '0' );
      'A'..'F': NibbleHex := ord( c ) - ord( 'A' ) + 10;
      'a'..'f': NibbleHex := ord( c ) - ord( 'a' ) + 10;
      else      Nibblehex := 0;
   end;
end;

   { return a 8-bit byte from two hex chars }
function ByteHex( s : string ) : byte; begin
   ByteHex := $10 * Nibblehex( s[ 1 ] ) + NibbleHex( s[ 2 ] );
end;

   { return a 16-bits word from four hex chars }
function WordHex( s : string ) : word; begin
   WordHex :=
      $1000 * NibbleHex( s[ 1 ] )
      + $100 * NibbleHex( s[ 2 ] )
      + $10 * NibbleHex( s[ 3 ] )
      + NibbleHex( s[ 4 ] )
end;

   { return substring of s starting at n, i long }
function Substr( s : string; n, i : integer ) : string; begin
   if ( i = 0 ) or ( n > length( s ) )
      then substr := ''
      else substr := s[ n ] + substr( s, n + 1, i - 1 );
end;

function LowCase( c : char ) : char; begin
   if ( c >= 'A' ) and ( c <= 'Z' ) then begin
      LowCase := chr( ord( c ) + ord( 'a' ) - ord( 'A' ) );
   end else begin
      LowCase := c;
   end;
end;

   { return uppercase version of s }
function UpStr( s : string ) : string;
   var i : integer;
begin
   for i:=1 to length( s ) do begin
      s[i] := upcase( s[ i ] );
   end;
   UpStr := s;
end;

   { return string version of integer x with leading zero's to length n }
function IntStr( x : longint; n : integer ) : string;
   var s : string;
begin
   str( x, s );
   while length(s) < n do begin
      s := '0' + s;
   end;
   IntStr := s;
end;

procedure Pivot( 
   x       : string; 
   c       : char; 
   var s1  : string; 
   var s2  : string 
);
   var i : integer;
   var found : boolean;
begin                              
   s1 := '';
   s2 := '';           
   found := false;
   for i:=1 to length( x ) do begin
      if x[ i ] = c then begin
         found := true;
      end else begin
         if found then begin
            s2 := s2 + x[ i ];
         end else begin
            s1 := s1 + x[ i ];
         end;
      end;
   end;
end;


{ --------------------------------------------------------------------- }
{
{ timing                                                                 
{
{ --------------------------------------------------------------------- }

var xx : longint;

  { return a monotonous time in milliseconds,
  { resolution according to BIOS timer interrupt. }
function TurboMilliSeconds : longint;
   var h,m,s,s100 : word;
   function f(x:word):longint;begin f:=x; end;
   var x : longint;
begin
   GetTime( h, m, s, s100 );
{   x :=  60 * 1000 * f(m) + 1000 * f(s) + 10 * f(s100);
   if x = xx then write('.') else begin
      writeln('tm=',x);
      xx := x;
   end; }
   TurboMilliSeconds := 60 * 1000 * f(m) + 1000 * f(s) + 10 * f(s100);
end;

   { return the number of clock ticks since power up }
function BiosTicks : longint;
   var l : word absolute $40:$6c;
   var h : word absolute $40:$6e;
begin
   write ( '{', l, ':', h, '}' );
   BiosTicks := longint(l) + longint(65536) * longint(h);
end;

   { return the PIT down counter value }
procedure short_delay; inline( $EB/$00/$EB/$00 );
function PitValue : longint;
   var c1, c2 : longint;
begin
   port[$43] := $00;        { latch counter 0 contents }
   short_delay;
   c1        := port[$40];  { read low byte  }
   short_delay;
   c2        := port[$40];  { read high byte }
writeln( '[ ', c1, ' ', c2, ' ',c1 + 256 * longint(c2), ' ]' );
   PitValue  := c1 + 256 * longint(c2);
end;

   { return the number of milliseconds since start up }
const BiosStart : longint = 0;
function Milliseconds : longint;
   var b : longint;
   var p : word;
   var Done : boolean;
begin
   Milliseconds := TurboMilliseconds;
{
   if BiosStart = 0 then BiosStart := BiosTicks;
   repeat
      b := BiosTicks;
      p := PitValue;
      Milliseconds := (((b - BiosStart + 1) * 65536 ) - p ) div 1193;
   until b = BiosTicks;
}
end;

   { return string version of current time }
function TimeStr : string;
   var h,m,s,s100 : word;
begin
   GetTime( h, m, s, s100 );
   TimeStr :=
      IntStr( h, 2 ) + ':' +
      IntStr( m, 2 ) + ':' +
      IntStr( s, 2 ) + '.' +
      IntStr( s100, 2 ) + ' (' +
      IntStr( TurboMilliseconds, 8 ) + ')';
end;

var TimeoutTime : longint;

   { start timeout of n milliseconds }
procedure StartTimeout( n : longint ) ; begin
   TimeoutTime := Milliseconds + n;
end;

   { return true iff started timeout has expired }
function Timeout : boolean; begin
   Timeout := Milliseconds >= TimeoutTime;
end;

   { delay for n milliseconds }
procedure Delay( n : longint ); begin
   StartTimeout( n );
   while not Timeout do ;
end;


{ --------------------------------------------------------------------- }
{
{ error handling and logging
{
{ --------------------------------------------------------------------- }

   { global flag's etc. }
var   LogFile        : text;
const LogOpen        : boolean = false;
const FlushEnable    : boolean = false;
const BeepEnable     : boolean = false;
const VerboseEnable  : boolean = false;
const DumpInterval   : integer = 16;  

   { make a sound
   { f = start frequency, fd = frequency delta,
   { d1 = sound duration, d2 = pause duration
   { n = number of sound/pause cycles }
procedure Beep( f, fd, d1, d2, n : integer );
   var i : integer;
begin
   for i:=1 to n do begin
      sound( f );
      delay( d1 );
      nosound;
      delay( d2 );
      f := f + fd;
   end;
end;

   { make an OK (rising) sound }
procedure BeepOK; begin
   if BeepEnable then begin
      beep( 1000, 100, 80, 20, 7 );
   end;
end;

   { make an Error (lowering) sound }
procedure BeepError; begin
   if BeepEnable then begin
      beep( 1000, -100, 80, 20, 7 );
   end;
end;

  { start logging to the indicated file }
procedure LogOpenFile( s : string ); begin
   if LogOpen then begin
      close( LogFile );
   end;
   assign( LogFile, s );
   rewrite( LogFile );
   LogOpen := true;
end;

  { log to the log file - if one is open - and
  { to the screen - if screen logging is enabled }
procedure Log( s : string ); begin
   if LogOpen then begin
      writeln( LogFile, TimeStr + ' ' + s );
      if FlushEnable then flush( LogFile );
   end;
   if VerboseEnable then begin
      writeln( TimeStr + ' ' + s );
   end;
end;

  { log to the screen and to the log file -
  { if one is open. }
procedure Show( s : string ); begin
   Log( s );
   if not VerboseEnable then begin
      writeln( TimeStr + ' ' + s );
   end;
end;  

procedure Set_DTR( r : boolean ); forward;
procedure WaitIgnoreSendString( s : string ); forward;

  { report a fatal error and quit }
const Quitting : boolean = false;
procedure Fatal( s : string ); begin
   if not Quitting then begin
      Quitting := true;
      writeln;
      Show( 'fatal: ' + s );
      if LogOpen then begin
         close( LogFile );
      end;
      BeepError;     
      Set_DTR( false );
      WaitIgnoreSendString( '0000G' );
   end;
   halt;
end;


{ --------------------------------------------------------------------- }
{
{ IO Port handling
{
{ --------------------------------------------------------------------- }

const
  TxDataReg = 0;                { transmitter data register            }
  RxDataReg = 0;                { reciever data register               }
  DivLow = 0;                   { divisor latch, low byte              }
  DivHigh = 1;                  { divisor latch, high byte             }
  IntrEnable = 1;               { interrupt enable register            }
  IntrId = 2;                   { interrupt identification register    }
  FifoCtrl = 2;                 { first-in/first-out buffer controller }
  LineCtrl = 3;                 { line controll register               }
  ModemCtrl = 4;                { modem controll register              }
  LineStatus = 5;               { line status register                 }
  ModemStatus = 6;              { modem status register                }
  ScratchReg = 7;               { scratch pad (free useable)           }

var PortBase : word;
var Ports    : array[ 1 .. 8 ] of word absolute $40 : $00;

   { init using port nr p with baudrate b }
procedure InitPort( p : integer; b : longint );
  var d : word;
begin
   PortBase := Ports[ p ];
{ PortBase := $3F8; }
   Log(
      'init port ' + HexByte( p ) +
      ' at ' + HexWord( PortBase ) +
      ' baudrate ' + IntStr( b, 0 ) +
      ' start'
   );

   { Calculate the divisor latch contents for the desired baud rate }
   D := (115200 div b);

   { Set the DLAB bit to 1, then write the divisor latch low and high bytes }
   Port[ PortBase + LineCtrl]   := $80;
   Port[ PortBase + DivLow]     := Lo(D);
   Port[ PortBase + DivHigh]    := Hi(D);

   { Now set the divisor latch bit to 0 and write the other values }
   Port[ PortBase + LineCtrl]   := $03;
   { Port[ PortBase + ModemCtrl]  := $0A; }
   Port[ PortBase + IntrEnable] := $00;

   Log( 'init port end' );
end;

procedure set_DTR( r : boolean );begin
   if r then begin
      Port[ PortBase + ModemCtrl] := Port[ PortBase + ModemCtrl] or 1;
   end else begin
      Port[ PortBase + ModemCtrl] := Port[ PortBase + ModemCtrl] and ( not 1 );
   end;
end;

procedure set_RTS( r : boolean );begin
   if r then begin
      Port[ PortBase + ModemCtrl] := Port[ PortBase + ModemCtrl] or 2;
   end else begin
      Port[ PortBase + ModemCtrl] := Port[ PortBase + ModemCtrl] and ( not 2 );
   end;
end;

const DTR_specified : boolean = false;

procedure ResetTarget; begin
   if not DTR_specified then begin
      set_DTR( true );
      delay( 100 );
      set_DTR( false );
      delay( 300 ); { was 100 }
   end;
end;

const tty_emulation : boolean = false;

const echo_device : boolean = false;

   { check line status, fatal if any error }
procedure CheckLineStatus;
   var s : word;
begin
   s := port[ PortBase + LineStatus ] and $0E;

   { enabling this check gives lots of framing errors, why? }
{   if not tty_emulation then begin
      if s <> 0 then Fatal( ' LineStatus : ' + BinByte( s ) );
   end;}

end;

   { ignore a possible line status error }
procedure IgnoreLineStatus;
   var d : word;
begin
   d := port[ PortBase + LineStatus ];
end;

   { return whether a received char is waiting }
function CharReady : boolean; begin
   CheckLineStatus;
   CharReady := port[ PortBase + LineStatus ] and $01 <> $00;
end;

   { return whether a char can be sent }
function SendReady : boolean; begin
   SendReady := port[ PortBase + LineStatus ] and $60 = $60;
{   SendReady := port[ PortBase + LineStatus ] and $20 = $20; }
end;

   { get received char }
procedure GetChar( var c : char ); begin
   c := chr( port[ PortBase ] );
   if true then begin
      if c >' '
         then Log( 'receive ['+c+'] ' + HexByte( ord( c ) ) )
         else Log( 'receive hex [' + HexByte( ord( c ) ) + ']' );
   end;
end;

   { send a char }
procedure SendChar( c : char ); begin
   if echo_device then begin
      Log( 'send ['+c+'] high bit set' );
      port[ PortBase ] := ord( c ) + 128;
   end else begin
      Log( 'send ['+c+'] ' + HexChar( c ) );
      port[ PortBase ] := ord( c );
   end;
end;

   { clear rceive status }
procedure ClearReceive;
   var c : char;
   var d : word;
begin
   Log( 'clear receive' );
   Delay( 100 );
   IgnoreLineStatus;
   while CharReady do begin
      while CharReady do GetChar( c );
      Delay( 100 );
   end;
   Log( 'clear receive end' );
   CheckLineStatus;
end;

   { clear rceive status }
procedure FastClearReceive;
   var c : char;
   var d : word;
begin
   Log( 'fast clear receive' );
   IgnoreLineStatus;
   while CharReady do begin
      while CharReady do GetChar( c );
      Delay( 100 );
   end;
   Log( 'clear receive end' );
   CheckLineStatus;
end;

   { wait for tranceiver empty and send a char }
procedure WaitSendChar( c : char ); begin
   StartTimeout( 100 );
   while not SendReady do begin
      CheckLineStatus;
      if Timeout then fatal( 'communication timeout on send' );
   end;
   SendChar( c );
end;

   { send a string, wait for ready for each char }
procedure WaitSendString( s : string );
var i : integer;
begin
   CheckLineStatus;
   for i:= 1 to length( s ) do begin
      WaitSendChar( s[ i ] );
   end;
end;

   { send a string, ignore incoming chars & line status }
procedure WaitIgnoreSendString( s : string );
var i : integer;
begin
   for i:= 1 to length( s ) do begin
      StartTimeout( 100 );
      while not SendReady do begin
         if Timeout then fatal( 'communication timeout on send' );
      end;
      SendChar( s[ i ] );
      Delay( 100 );
   end;
   IgnoreLineStatus;
end;

   { check line status and receive char }
procedure ReceiveChar( var c : char ); begin
   CheckLineStatus;
   GetChar( c );
end;

   { wait for char ready and receive char }
procedure WaitReceive( var c : char ); begin
   Log( 'wait for char' );
   StartTimeout( 1000 );
   while not CharReady do begin
      if Timeout then begin
         fatal( 'communication timeout on receive'
            + ' : check the power and the '
            + ' serial line to the WISP hardware and retry' );
      end;
   end;
   ReceiveChar( c );
   if ord( c ) > 128 then begin
      while not CharReady do begin
         if Timeout then begin
            fatal( 'communication timeout on receive'
               + ' : check the power and the '
               + ' serial line to the WISP hardware and retry' );
         end;
      end;
      ReceiveChar( c );
   end;
end;

   { send char, check echo }
procedure SendReceiveChar( cs, cr : char );
   var r : char;
begin
log( 'start waitsendchar' );
   FastClearReceive;
   WaitSendChar( cs );
log('sending done');
   WaitReceive( r );
log('receiving done');
   if r <> UpCase( cr ) then begin
      if LowCase( r ) = cr then begin
         { receive again for self-echoing hardware }
         echo_device := true;
         WaitReceive( r )
      end;
      if r <> UpCase( cr ) then  begin
         fatal(
            'send [' + cs + '] ' + BinByte( ord( cs ) ) +
            ' expected [' + cr + '] ' + BinByte( ord( cr ) ) +
            ' received [' + r + '] ' + BinByte( ord( r ) ) +
            ' : check the connection to the target and retry '
         );
      end;
   end;
end;

   { send string, check echo }
procedure SendReceive( s : string );
   var i : integer;
begin
   for i:=1 to length(s) do begin
      SendReceiveChar( s[ i ], s[ i ] );
   end;
end;

   { get response buffer (response to to x * 'n'), }
   { or up to a ' ' when the first char is a ' '   }
procedure GetLongResponse( x : integer; var s : string );
   var c : char;
   var i : integer;
begin
   s := '';
   FastClearReceive;  
   WaitSendChar( 'n' );    
   WaitReceive( c );
   if c = 'n' then begin
      WaitReceive( c );
   end;
   if c = ' ' then begin
      s := '';
      c := 'x';
      while ( c <> ' ' ) and ( length( s ) < 32 ) do begin
         WaitSendChar( 'n' );    
         WaitReceive( c );
         if c = 'n' then begin
            WaitReceive( c );
         end;
         if c <> ' ' then s := s + c;
      end;
   end else begin
      s := c;
      for i := 2 to x do begin
log( 'send <next>' );
         WaitSendChar( 'n' );
log('done <next>');
{ ignorelinestatus; }
         WaitReceive( c );
log('done <receive>');
         if c = 'n' then begin
            WaitReceive( c );
         end;
         s := s + c;
      end;
   end;
end;  

   { get response buffer (response to to x * 'n') }
procedure GetResponse( x : integer; var s : string );
   var c : char;
   var i : integer;
begin
   s := '';
   FastClearReceive;
   for i := 1 to x do begin
log( 'send <next>' );
      WaitSendChar( 'n' );
log('done <next>');
{ ignorelinestatus; }
      WaitReceive( c );
log('done <receive>');
      if c = 'n' then begin
         WaitReceive( c );
      end;
      s := s + c;
   end;
end;

   { get response from SX-Key }
procedure GetSX( q : string; x : byte; var s : string );
   var c : char;
   var i : byte;
begin
   s := '';
   {Fast} ClearReceive;
   StartTimeout( 1000 );

   for i:= 1 to length( q ) do begin
      if CharReady then begin
         ReceiveChar( c );
         s := s + c;
         x := x - 1;
      end;
      while not SendReady do begin
         if CharReady then begin
            ReceiveChar( c );
            s := s + c;
            x := x - 1;
         end;
         CheckLineStatus;
         if Timeout then begin
            i := port[ PortBase + LineStatus ];
            fatal(
               'communication timeout on send, status='
               + HexByte( i ) + ' ' + BinByte( i )
            );
         end;
      end;
      SendChar( q[ i ] );
   end;

   for i := 1 to x do begin
      while not CharReady do begin
         if Timeout then begin
            fatal( 'communication timeout on receive'
               + '(n=' + IntStr( x + 1 - i, 0 ) + ')'
               + ' : check the power and the '
               + ' serial line to the SX-Key and retry' );
         end;
      end;
      ReceiveChar( c );
      s := s + c;
   end;
end;

   { issue a line break }
procedure LineBreak; begin
   Log( 'line break start' );
   Port[ PortBase + LineCtrl] := $43;
   delay( 200 );
   Port[ PortBase + LineCtrl] := $03;
   delay( 100 );
   Log( 'line break end' );
end;

const show_hex : boolean = false;

   { emulate TTY on port p with baudrate b }
procedure EmulateTTY( p : word; m : string; b : longint );
   var cx, cr, c2 : char;
   var s : string;
begin
   tty_emulation := true;
   InitPort( p, b );
   cr := ' ';
   if b > 1000 then begin
      s :=
         IntStr( b div 1000, 0 )
         + 'k'
         + IntStr( b mod 1000, 0 );
   end else begin
      s := IntStr( b, 0 );
   end ;
   write( 'TTY mode ' + s + ' baud, ' );
   if m <> '' then write( m + ', ' );
   writeln( 'quit with <ESC><ESC>' );
   repeat
      IgnoreLineStatus;
      if CharReady then begin
         GetChar( cx );
{  writeln( 'x=' + HexByte( byte( cx ) ) ); }
         write( cx );
         if show_hex then
            write( '[' + HexChar( cx ) + ']' );
      end else if keypressed then begin
         c2 := cr;
         cr := readkey;
         WaitSendChar( cr );
      end;
   until (cr = chr(27)) and (c2 = chr(27));
   writeln; writeln( 'TTY mode end' );
   tty_emulation := false;
end;

{ --------------------------------------------------------------------- }
{
{ target handling
{
{ --------------------------------------------------------------------- }

type target_type = (
   pic_unknown,
   pic_12f629,
   pic_12f675,
   pic_16f630,
   pic_16f676,
   pic_16c84,
   pic_16f84,
   pic_16f84a,
   pic_16f627,
   pic_16f628,
   pic_16f73,
   pic_16f74,
   pic_16f76,
   pic_16f77,
   pic_16f870,
   pic_16f871,
   pic_16f872,
   pic_16f873,
   pic_16f874,
   pic_16f876,
   pic_16f877
);
const target : target_type = pic_unknown; 
const target_first = pic_unknown;
const target_last  = pic_16f877;

procedure Must_Know_Target;
begin
   if target = pic_unknown then begin
      fatal( 'target must be specified' );
   end;   
end;

type algorithm_type = (
   Algorithm_PIC16,
   Algorithm_PIC16A,
   Algorithm_PIC16C
);

const Algorithms : array[ algorithm_type ] of record
   Code   : string;
   Data   : string;
   Fuses  : string;
   ID     : string;
   Erase  : string;
end = (

 ( Code  : '000cx' ;
   Data  : '000dx' ;
   Fuses : '000fx' ;
   ID    : '000fx' ;
   Erase : '000ex' ),

 ( Code  : '001cx' ;
   Data  : '001dx' ;
   Fuses : '001fx' ;
   ID    : '001fx' ;
   Erase : '001cex' ),

 ( Code  : '004cx' ;
   Data  : '004dx' ;
   Fuses : '004fx' ;
   ID    : '004fx' ;
   Erase : '004ex' )
);   

type preserve_type = (
   Preserve_Nothing,
   Preserve_1K
);

const TargetInfo : array[ target_type ] of record
   Name            : string;
   Abbreviation    : string;
   RomSize         : integer;
   DataSize        : integer;
   ProtectionMask  : integer;
   Id              : integer;
   IdMask          : integer;
   ReadFuses       : boolean;
   Preserve        : preserve_type;
   Fixed_One       : integer;
   Fixed_Zero      : integer;
   Algorithm       : algorithm_type;
end = (                   

   (  Name            : '';
      Abbreviation    : '';
      RomSize         : 0;
      DataSize        : 0;
      ProtectionMask  : 0;
      Id              : 0;
      IdMask          : 0;
      ReadFuses       : false;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),

   (  Name            : '12f629';
      Abbreviation    : 'f629';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $3E7F;
      Id              : $0F80;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_1K;
      Fixed_One       : 0;
      Fixed_Zero      : $0E00;
      Algorithm       : Algorithm_PIC16C ),
      
   (  Name            : '12f675';
      Abbreviation    : 'f675';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $3E7F;
      Id              : $0FC0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_1K;
      Fixed_One       : 0;
      Fixed_Zero      : $0E00;
      Algorithm       : Algorithm_PIC16C ),
      
   (  Name            : '16f630';
      Abbreviation    : 'f630';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $3E7F;
      Id              : $10C0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_1K;
      Fixed_One       : 0;
      Fixed_Zero      : $0E00;
      Algorithm       : Algorithm_PIC16C ),
      
   (  Name            : '16f676';
      Abbreviation    : 'f676';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $3E7F;
      Id              : $10E0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_1K;
      Fixed_One       : 0;
      Fixed_Zero      : $0E00;
      Algorithm       : Algorithm_PIC16C ),
      
   (  Name            : '16c84';
      Abbreviation    : 'c84';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $000f;
      Id              : $0000;
      IdMask          : 0;
      ReadFuses       : false;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),

   (  Name            : '16f84';
      Abbreviation    : 'f84';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $000f;
      Id              : $0000;
      IdMask          : 0;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),

   (  Name            : '16f84a';
      Abbreviation    : 'f84a';
      RomSize         : 1024;
      DataSize        : 64;
      ProtectionMask  : $000f;
      Id              : $0560;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f627';
      Abbreviation    : 'f627';
      RomSize         : 1024;
      DataSize        : 128;
      ProtectionMask  : $02ff;
      Id              : $07e0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
   
   (  Name            : '16f628';
      Abbreviation    : 'f628';
      RomSize         : 2048;
      DataSize        : 128;
      ProtectionMask  : $02ff;
      Id              : $07c0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f73';
      Abbreviation    : 'f73';
      RomSize         : 4096;
      DataSize        : 128;
      ProtectionMask  : $3fef;
      Id              : $0600;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16A ),  
      
   (  Name            : '16f74';
      Abbreviation    : 'f74';
      RomSize         : 4096;
      DataSize        : 128;
      ProtectionMask  : $3fef;
      Id              : $0620;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16A ),
      
   (  Name            : '16f76';
      Abbreviation    : 'f76';
      RomSize         : 8192;
      DataSize        : 256;
      ProtectionMask  : $3fef;
      Id              : $0640;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16A ),
      
   (  Name            : '16f77';
      Abbreviation    : 'f77';
      RomSize         : 8192;
      DataSize        : 256;
      ProtectionMask  : $3fef;
      Id              : $0660;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16A ),
   
   (  Name            : '16f870';
      Abbreviation    : 'f870';
      RomSize         : 2048;
      DataSize        :  64;
      ProtectionMask  : $0ecf;
      Id              : $0d00;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f871';
      Abbreviation    : 'f871';
      RomSize         : 2048;
      DataSize        :  64;
      ProtectionMask  : $0cdf;
      Id              : $0d20;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),

   (  Name            : '16f872';
      Abbreviation    : 'f872';
      RomSize         : 2048;
      DataSize        :  64;
      ProtectionMask  : $0cdf;
      Id              : $08e0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f873';
      Abbreviation    : 'f873';
      RomSize         : 4096;
      DataSize        : 128;
      ProtectionMask  : $0cdf;
      Id              : $0960;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f874';
      Abbreviation    : 'f874';
      RomSize         : 4096;
      DataSize        : 128;
      ProtectionMask  : $0cdf;
      Id              : $0920;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f876';
      Abbreviation    : 'f876';
      RomSize         : 8192;
      DataSize        : 256;
      ProtectionMask  : $0cdf;
      Id              : $09e0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 ),
      
   (  Name            : '16f877';
      Abbreviation    : 'f877';
      RomSize         : 8192;
      DataSize        : 256;
      ProtectionMask  : $0cdf;
      Id              : $09a0;
      IdMask          : $001f;
      ReadFuses       : true;
      Preserve        : Preserve_Nothing;
      Fixed_One       : 0;
      Fixed_Zero      : 0;
      Algorithm       : Algorithm_PIC16 )
);
                                            

{ --------------------------------------------------------------------- }
{                                            
{ program image handling
{
{ --------------------------------------------------------------------- }

const Pic_Image_Last   = $4fff;
const Dummy_Value      = $ffff;
const Config_Address   = $2007;
type  Pic_Image        = record
   data : array[ 0 .. Pic_Image_Last ] of word;
end;

type Image_Part = ( code, data, code_1k, fuses );
type Image_Part_Set = set of Image_Part; 
const All_Parts : Image_Part_Set = [ code, data, fuses ];
const Preserved_Regions_1K : Image_Part_Set = [ code_1k, fuses ];

const Image_Info : array[ Image_Part ] of record
   name   : string;
   start  : word;
   first  : word;
   last   : word;
   mask   : word;
end = (
   ( name: 'code';     start: $0000; first: $0000; last: $1fff; mask: $3fff ),
   ( name: 'data';     start: $2100; first: $2100; last: $21ff; mask: $00ff ),
   ( name: 'code_1k';  start: $0000; first: $03FF; last: $03FF; mask: $3fff ),
   ( name: 'fuses';    start: $2000; first: $2007; last: $2007; mask: $3fff )
);

function Start_Command(
   Algorithm : Algorithm_Type;
   Part      : Image_Part
) : string;
begin
   Start_Command := '';
   if ( Part = code ) or ( Part = code_1k ) then begin
      Start_Command := Algorithms[ Algorithm ].Code;
   end;
   if Part = data then begin
      Start_Command := Algorithms[ Algorithm ].Data;
   end;
   if Part = fuses then begin
      Start_Command := Algorithms[ Algorithm ].Fuses;
   end;
end;
   
function Erase_Command(
   Algorithm : Algorithm_Type
) : string;
begin
   Erase_Command := Algorithms[ Algorithm ].Erase;
end;

procedure Add_Or_Remove(
   var Parts : Image_Part_Set;
   sign      : integer;
   Delta     : Image_Part_set
);
begin
   if sign > 0 then begin
      Parts := Parts + Delta;
   end else begin
      Parts := Parts - Delta;
   end;
end;

function Image_Get(
   var m : Pic_Image;
   address : word
): word;
begin
   Image_Get := m.data[ address ];
end;

procedure Image_Set(
   var m : Pic_Image;
   address : integer;
   d : word
);begin
   if ( address < 0 ) or ( address > Pic_Image_Last ) then begin
      fatal( 'image address out of range' );
   end;
   m.data[ address ] := d;
end;

function Image_Last( p : Image_Part ) : word;
   var n : integer;
begin
   
   if p = code then begin
      n := TargetInfo[ target ].RomSize;
   end else if p = data then begin
      n := $2100 + TargetInfo[ target ].DataSize;
   end else begin
      n := Pic_Image_Last;
   end;
   
   Image_Last := min( n, Image_Info[ p ].last );
end;

   { set image to all x, x+y x+2y etc. }
procedure Image_Set_All(
   var m : Pic_Image;
   x, y : word
);
   var i : integer;
begin
   for i := $0000 to Pic_Image_Last do begin
      Image_Set( m, i, x );
      x := x + y;
   end;
end;

   { set image to all dummy }
procedure Image_Clear( var m : Pic_Image ); begin
   Image_Set_All( m, Dummy_Value, 0 );
end;

   { accumulate a byte b to checksum s }
procedure accu1( var s : word; b : byte ); begin
   s := ( s + b ) mod $100;
end;

   { accumulate the two bytes from word w to checksum s }
procedure accu2( var s : word; w : word ); begin
   accu1( s, lo( w ) );
   accu1( s, hi( w ) );
end;

   { read one hex byte (two char) from f, accumulate checksum s }
function ReadHexByte( var f : text; var s : word ) : byte;
   var c1, c2 : char;
begin
   read( f, c1 );
   read( f, c2 );
   accu1( s, ByteHex( c1 + c2 ) );
   ReadHexByte := ByteHex( c1 + c2 );
end;

   { read one hex word (four char) from f, accumulate checksum s }
function ReadHexWord( var f : text; var s : word ) : word;
   var b : byte;
begin
   b := ReadHexByte( f, s );
   ReadHexWord := b + $100 * ReadHexByte( f, s );
end;

type Patch_List = ^Patch_Record;
     Patch_Record = record
   Address : integer;
   Value   : word;
   Next    : Patch_List;
end;

procedure Patch_List_Add( 
   var List  : Patch_List; 
   Address   : integer;
   Value     : word
); 
   var p : Patch_List;
begin                 
   new( p );
   p^.Address  := Address;
   p^.Value    := Value;
   p^.Next     := List;
   List        := p;
end;

procedure Patch_List_Apply(
   var Image  : Pic_Image;
   List       : Patch_List
); begin 
{ writeln( 'patch' ); }
   while List <> nil do begin
{ writeln( List^.Address, '=', List^.Value ); }
      Image_Set( Image, List^.Address, List^.Value );
      List := List^.Next;
   end;           
{ writeln( 'end patch' );  }
end;         

{ handling of fuses word(s) }
const Include_Fuses   : boolean = true;
const Fixed_Fuses     : boolean = false;
const Fuses_Value     : word    = 0;

Procedure Patch_Fuses(
   var m : Pic_Image
);
begin
   if Fixed_Fuses then begin
      Image_Set( m, Config_Address, Fuses_Value );
   end;   
   if not Include_Fuses then begin
      Image_Set( m, Config_Address, Dummy_Value );
   end;
end;

   { handling of the protection bits }
type Protection_Type = ( always, hex, never );
var Protection : Protection_Type;

procedure Patch_Protection(
   var m  : Pic_Image;
   var p  : Protection_Type
);
   var d : word;
begin                       
   d := Image_Get( m, Config_Address );
   if Include_Fuses then begin
      if p = always then begin
         Must_Know_Target;
         d := d and TargetInfo[ target ].ProtectionMask;
      end;
      if p = never then begin
         Must_Know_Target;
         d := d and TargetInfo[ target ].ProtectionMask;
      end;
   end;                                
   Image_Set( m, Config_Address, d );
end;

procedure Copy_And_Patch(
   var  Old         : Pic_Image;
   var Result       : Pic_Image;
   List             : Patch_List;
   Target           : target_type;
   var Preserved    : Pic_Image;
   var Do_Preserve  : boolean
);
var Fuses : Word;
begin
   Result := Old;
   Patch_List_Apply( Result, List );
   Patch_Fuses( Result );
   Patch_Protection( Result, Protection );
   Fuses := Image_Get( Result, $2007 );
   Fuses := Fuses and ( $3FFF xor TargetInfo[ Target ].Fixed_Zero );
   Fuses := Fuses or TargetInfo[ Target ].Fixed_One;
   Image_Set( Result, $2007, Fuses );
   if Do_Preserve then begin
      Image_Set( Result, $3FF, Image_Get( Preserved, $3FF ));
      Fuses := Image_Get( Result, $2007 ) and $0FFF;
      Fuses := Fuses or (Image_Get( Preserved, $2007 ) and $F000);
      Image_Set( Result, $2007, Fuses );
      { writeln;writeln( '===>', HexWord( Fuses )); }
   end;
end;   

   { read image m from hex file name }
procedure ReadHexImage( var m : Pic_Image; name : string );
   var f : text;
   var c : char;
   var s, n, a, t, i : word;
   var line : integer;
begin
   Log( 'read hex file ' + name + ' start' );
   Image_Clear( m );
   assign( f, name );
   {$I-} reset( f ); {$I+}
   if IOResult <> 0 then begin
      assign( f, name + '.hex' );
      {$I-} reset( f ); {$I+}
      if IOResult <> 0 then begin
         Fatal( 'file ' + name + ' not found' );
      end;
   end;
   line := 1;
   repeat
      read( f, c );
      if c <> ':' then begin
         fatal( 'hex file format error c=' + HexChar( c ) );
      end;
      s := 0;
      n := ReadHexByte( f, s );
      a := swap( ReadHexWord( f, s )) div 2;
      t := ReadHexByte( f, s );
      if t = 0 then begin
         for i := 1 to n div 2 do begin
            Image_Set( m, a, ReadHexWord( f, s ));
            inc( a );
         end;
         a := ReadHexByte( f, s );
         if s <> 0 then begin
            fatal( 'hex file checksum error in line ' + DecInt( line ));
         end;
         line := line + 1;
      end else if t = 4 then begin
         { ignore }
      end else begin
         if t <> 1 then begin
            fatal( 'hex file type error t=' + HexByte( t ));
         end;
         close( f );
         if Image_Get( m, Config_Address ) = Dummy_Value then begin
            writeln( 'no configuration word in hex-file' );
         end;
         Log( 'read hex file ' + name + ' end' );
         exit;
      end;
      readln(f);
   until false;
end;

   { write image m to hex file name }
procedure WriteHexImage( 
   var m  : Pic_Image; 
   name   : string;
   Parts  : Image_Part_Set
);
   var f : text;
   var c : char;
   var s, n, a, t, i, j, k : word;
   var p : Image_Part;
begin
   assign( f, name );
   rewrite( f );
   for p := code to fuses do 
   if p in Parts then 
   with Image_Info[p] do begin
      for i := first to Image_Last( p ) do if i mod 8 = 0 then begin
         j := i;
         k := j + 7;
         if k > Image_Last( p ) then k:= Image_Last( p );
         s := 0;
         write( f, ':' );
         write( f, HexByte( 2 * ( k - j + 1 )));
         accu2( s, 2 * ( k - j + 1 ));
         write( f, HexWord( 2 * j ));
         accu2( s, 2 * j );
         write( f, '00' );
         for n:= j to k do begin
            write( f, HexWord( swap( Image_Get( m, n ))));
            accu2( s, Image_Get( m, n ));
         end;
         writeln( f, HexByte( 256 - s ));
      end;
   end;
   writeln( f, ':00000001FF' );
   close( f );
end;

procedure ShowImage( var m : Pic_Image );
   var i : longint;
begin
   for i := $0000 to $4fff do
   if Image_Get( m, i ) <> $ffff then begin
      writeln( 'image:' + HexWord( i ) + ':' + HexWord( Image_Get( m, i )));
   end;
end;                                     

procedure DumpHexImage( var m : Pic_Image );
   var i : longint;
   var p : Image_Part;
   var d : word;
begin
   for p := code to fuses do if p <> code_1k then
   with Image_Info[p] do begin
      for i:= first to last do begin
         d := Image_Get( m, i );
         if ( d and mask ) <> mask then begin
            writeln( 'image ' + HexWord( i ) + ':' + HexWord( d ));
         end;
      end;
   end;
end;                                     




{ --------------------------------------------------------------------- }
{
{ programming via WISP
{
{ --------------------------------------------------------------------- }


var Device : string;

  { verify that a compatible WISP programmer is
  { connected to the currently selected serial port }
procedure WispCheck( id : word );
   var s, sv : string;
begin
   { just to clear the communication }
   WaitSendChar( 'v' );
   Delay( 100 );
   ClearReceive;

   { check ID }
   SendReceive( 'q' );
   GetResponse( 4, s );
   if (id <> 0) and (HexWord( id ) <> s) then begin
      fatal( 'device request ' + HexWord(id) + ' response ' + s );
   end;
   Log ( 'device request ' + HexWord(id) + ' response ' + s );

   { check device type }
   SendReceive( 't' );
   GetLongResponse( 4, Device ); 
   if 
      ( Device<> 'WISP' ) and 
      ( Device <> 'WLdr' ) and
      ( Device <> 'Wisp628' )
   then begin
      fatal ('Not a WISP, WLdr or Wisp628, type=' + Device );
   end;

   SendReceive( 'v' );
   GetLongResponse( 4, sv );
   writeln( 'hardware ' + Device + ' ' + sv );
end;

   { program image m using write command w }
procedure WispWrite(
   var m  : Pic_Image;
   w      : string;
   Parts  : Image_Part_Set
);
   var p        : Image_Part;
   var i,j,a    : integer;
   var d        : word;
   var NotMask  : word;
   var c        : char;
begin
{ ShowImage(m); }
   for p := code to fuses do 
   if p in Parts then begin
      SendReceive( Start_Command( TargetInfo[ target ].Algorithm, p ));
      a := Image_Info[p].start;
      for i := Image_Info[p].first to Image_Info[p].last do begin
         d := Image_Get( m, i );
         if i mod DumpInterval >= 0 then write(
            'program ' + Image_Info[p].name +
            ' i=' + HexWord( i ) +
            ' d=' + HexWord( d ) +
            char( 13 )
         );
         if d <> Dummy_Value then begin                                           
            while a < i do begin
               SendReceive( 'i' );
               a := a + 1;
            end;
            Log(
               'program ' + Image_Info[p].name +
               ' a=' + HexWord( i ) +
               ' d=' + HexWord( d )
            );                                      
            NotMask := ( not TargetInfo[ target ].ProtectionMask ) and $3FFF;
            if
               ( i = Config_Address )
               and ( not TargetInfo[ target ].ReadFuses )
               and ((( not d ) and NotMask ) <> 0 )
            then begin
               { program blind: protection enabled, so it might not read back }
{writeln; writeln( HexWord( NotMask ) + ' ' + HexWord( not d ) + ' ' + HexWord(( not d ) and NotMask ) );}
               SendReceive( HexWord( d ) );
               ClearReceive;
               WaitSendChar( w[1] );
            end else begin
               if ( i = Config_Address ) then begin
{writeln( 'w-config=' + HexWord( d ) );}
               end;
               SendReceive( HexWord( d ) + w[1] );
               ReceiveChar( c );
               if( c <> upcase( w[1] )) and ( c <> '?' ) then begin
                  fatal( w[1] + ' or ? expected, received ' + c );
               end;
            end;
         end;
      end;
      write( '                              ', char( 13 ) );
   end;
end;

   { veriy image m against the current content of the target }
procedure WispVerify(
   var m  : Pic_Image;
   Parts  : Image_Part_Set
);
   var p     : Image_Part;
   var i,j,a : integer;
   var x     : string;
   var data  : word;
begin
   for p := code to fuses do 
   if p in Parts then begin
      SendReceive( Start_Command( TargetInfo[ target ].Algorithm, p ));
      a := Image_Info[p].start;
      for i := Image_Info[p].first to Image_Info[p].last do begin
         data := Image_Get( m,  i );
         if i mod DumpInterval = 0 then write(
            'verify ' + Image_Info[p].name +
            ' a=' + HexWord( i - Image_Info[p].first ) +
            ' d=' + HexWord( data ),
            char( 13 )
         );
         Log(
            'verify ' + Image_Info[p].name +
            ' a=' + HexWord( i ) +
            ' d=' + HexWord( data )
         );
         if data <> Dummy_Value then begin
            while a < i do begin
               SendReceive( 'i' );
               a := a + 1;
            end;
            SendReceive( 'r' );
            GetResponse( 4, x );
            if ( Image_Info[p].mask and data )
               <> ( Image_Info[p].mask and WordHex( x )
            ) then begin
               fatal( 'verify ' + Image_Info[p].name +
                  ' at ' + HexWord( i - Image_Info[p].first ) +
                  ' expected ' + HexWord( data ) +
                  ' found ' + x
               );
            end;
         end;
      end;
      write( '                               ', char( 13 ) );
   end;
end;

   { read image m from the target }
procedure WispRead(
   var m  : Pic_Image;
   Parts  : Image_Part_Set
);
   var p     : Image_Part;
   var i     : integer;
   var x     : string;
   var a     : integer;
begin
   for p := code to fuses do 
   if p in Parts then begin
      SendReceive( Start_Command( TargetInfo[ target ].Algorithm, p ));
      a := Image_Info[p].start;
      for i := Image_Info[p].first to Image_Last( p ) do begin
         while a < i do begin
            SendReceive( 'i' );
            a := a + 1;
            { writeln( 'i=', HexWord( i ), ' skip to ', HexWord( a )); }
         end;
         SendReceive( 'r' );
         GetResponse( 4, x );
         Image_Set( m, i, WordHex( x ));
         if i mod DumpInterval = 0 then write(
            'read ' + Image_Info[p].name +
            ' a=' + HexWord( i - Image_Info[p].start ) +
            ' d=' + HexWord( Image_Get( m, i )),
            char( 13 )
         );
         { write( char(10) ); }
         Log(
            'read ' + Image_Info[p].name +
            ' a=' + HexWord( i ) +
            ' d=' + HexWord( Image_Get( m, i ))
         );
      end;
      write( '                               ', char( 13 ) );
   end;
end;

procedure WispReadPreserved(
   var m  : Pic_Image;
   var Restore  : boolean
); 
var x, y : word;
begin
   if TargetInfo[ target ].Preserve = Preserve_1K then begin
      WispRead( m, Preserved_Regions_1K );
      x := Image_Get( m, $03FF );
      y := Image_Get( m, $2007 );
      writeln( 'preserve oscal=' + HexWord( x ) + ' bg=' + HexByte( y shr 12 ));
      exit;
   end;
   Restore := false;
end;   

   { erase the target }
procedure WispErase( var Image : PIC_Image; Restore : boolean );
var Fuses : word;
begin
   SendReceive( Erase_Command( TargetInfo[ target ].Algorithm ));
   if Restore then begin
      Fuses := Image_Get( Image, $2007 ) or $01FF;
      Image_Set( Image, $2007, Fuses );   
      WispWrite( Image, 'w', Preserved_Regions_1K );
   end;
end;

   { put the target in the run mode }
procedure WispRun; begin
   SendReceive( '0000g' );
end;

   { put the target in the passtrough mode }
procedure WispPassthrough( k : string ); begin
   SendReceive( k );
   WaitSendChar( 'p' );
   Delay( 5 );
end;

   { burn the indicated ID }
procedure WispBurn( s : string ); begin
   SendReceive( s + 'u' );
end;    

function WhichChip( x : word ) : target_type;
   var t     : target_type;
begin
   for t := target_first to target_last do begin
      if TargetInfo[ t ].IdMask <> 0 then begin
         if ( x and not TargetInfo[ t ].IdMask ) = TargetInfo[ t ].Id then begin
            WhichChip := t;
            exit;
         end;
      end;
   end;
   WhichChip := pic_unknown;
end;
      
procedure WispCheckTarget; 
   var i     : integer;
   var s     : string;
   var x     : word;
   var t     : target_type;
begin
   SendReceive( Start_Command( TargetInfo[ target ].Algorithm, fuses ));
   for i := 1 to 6 do begin
      SendReceive( 'i' );      
   end;
   SendReceive( 'r' );
   GetResponse( 4, s );
   x := WordHex( s );   
   t := WhichChip( x );
   
   if target = pic_unknown then begin
       write( 'target auto-detect ... ' );
       if t = pic_unknown then begin
         writeln( 'Sorry, I can not determine the target chip type.' );
         writeln( 'Specify a target on the command line,' +
            ' or maybe the chip is defect?' );
         writeln( 'The Id that is read is ' + HexWord( x ) + '.' );
         fatal( 'No target, target is defect, target has no ID or target is not supported' );
      end;
      target := t;
      writeln( 
         'target is a ' + TargetInfo[ t ].Name + ' '
         + 'rev ' + HexByte( x and TargetInfo[ t ].IdMask ));
   end else begin
      writeln( 'target specified as ' + TargetInfo[ Target ].Name );
      
      if 
         ( target = pic_16c84 ) 
         or ( target = pic_16f84 ) 
      then begin
         if x <> $3FFF then begin
            writeln( 'Target appears to be a ' + TargetInfo[ t ].Name );
            fatal( 'Target does not match command line' );            
         end;
         
      end else begin                    
         if target <> t then begin
            if target = pic_unknown then begin
               writeln( 'Sorry, I can not determine the target chip type.' );
               writeln( 'Maybe the chip defect?' );
               writeln( 'The Id that is read is ' + HexWord( x ) + '.' );
               fatal( 'No target, target is defect or target is not supported' );
            end else begin            
               writeln( 'Target appears to be a ' + TargetInfo[ t ].Name );
               fatal( 'Target does not match command line' );
            end;
         end;
         writeln( 'target rev is ' + HexByte( x and TargetInfo[ t ].IdMask ));
      end;
   end;
end;


{ ******************** VCC regulation }

const CalFirst  = 39;
const CalLast   = 61;
var Calibration : array[ CalFirst .. CalLast ] of byte;
var Actuals     : array[ 0 .. 80 ] of real;

procedure CalibrationInit;
   var i : integer;
begin
   for i := 0 to 80 do begin
      Actuals[ i ] := 0.00;
   end;
end;

function ReadEeprom( a : byte ) : byte;
   var s : string;
begin
   SendReceive( HexByte( a ) + 'K' );
   GetResponse( 2, s );
   ReadEeprom := ByteHex( s );
end;

procedure WriteEeprom( a : byte; x : byte );
   var s : string;
   var y : byte;
begin
   SendReceive( HexByte( a ) + HexByte( x ) + 'M' );
   y := ReadEeprom( a );
   if x <> y then fatal( 'could not write WISP eeprom' );
end;

function CalAddress( x : byte ) : byte; begin
   CalAddress := x - CalFirst + 10;
end;

procedure ReadCalibration;
   var i : integer;
begin
   for i := CalFirst to CalLast do begin
      Calibration[ i ] := ReadEeprom( CalAddress( i ) );
   end;
end;

procedure CheckCalibration;
   var i : integer;
begin
   for i := CalFirst to CalLast - 1 do begin
      if Calibration[ i ] = Calibration[ i + 1 ] then begin
         fatal( 'wisp hardware is not calibrated' );
      end;
   end;
end;

procedure WriteCalibration;
   var i : integer;
begin
   for i := CalFirst to CalLast do begin
      WriteEeprom( CalAddress( i ), Calibration[ i ] );
   end;
end;

const Vcc_5_00 = 40;

function BestVcc( f : real ) : byte;
   var n : integer;
begin
   n := round( 10 * f );
   if n < CalFirst then n := CalFirst;
   if n > CalLast then n:= CalLast;
   BestVcc := Calibration[ n ];
end;

function VccByte( n : integer ) : word;
   var i,j   : integer;
   var a,b,m : word;
begin
   a := $F;
   b := $F;
   m := 1;
   for j:=1 to 4 do begin
      case n mod 3 of
         0 : b := b xor m;
         1 : a := a xor m;
         2 : ;
      end;
      n := n div 3;
      m := 2 * m;
   end;
   VccByte :=  16 * a + b;
end;

procedure Calibrate;
   var i, j, n : integer;
   var s : string;
   var w : byte;
   var target, error, largest : real;
   var f : text;
   var v : real;
begin  
   if Device <> 'WISP' then begin
      fatal( 'calibration is supported only for a WISP programmer' );
   end;
   writeln( 'VCC calibration:' );
   s := '';
   while s <> ' ' do begin
      writeln( 'enter file name to read (space + return for none)' );
      readln( s );
      if s <> '' then begin
         assign( f, s );
         {$I-}
         reset( f );
         {$I+}
         if IOResult = 0 then begin
            for i := 0 to 80 do begin
               readln( f, w, Actuals[ i ] );
            end;
            close( f );
            s := ' ';
         end;
      end;
   end;
   writeln( 'Enter the actual voltage and press' );
   writeln( 'return for each of the 81 settings, ' );
   writeln( 'enter space + return to abort the calibration' );
   largest := 0.0;
   for i := 0 to 80 do begin
      w := VccByte( i );
      SendReceive( HexByte( w ) + 'z' );
      write( i : 2 );
      write( ' ' );
      write( Actuals[ i ] : 4 : 2 );
      write( ' : ' );
      readln( s );
      if s = ' ' then begin
         writeln( 'calibration aborted' );
         exit;
      end;
      val( s, v, n );
      if n = 0 then begin
         Actuals[ i ] := v;
      end;
   end;
   largest := 0;
   for i := CalFirst to CalLast do begin
      n      := 0;
      target := ( 1.0 * i ) / 10;
      error  := 100.0;
      for j := 0 to 80 do begin
         if error > abs( Actuals[ j ] - target ) then begin
            n     := j;
            error := abs( Actuals[ n ] - target );
         end;
      end;
      calibration[ i ] := n;
      write( target : 4 : 2 );
      write( ' ' + HexByte( Calibration[ i ] ) );
      write( '=>' );
      write( Actuals[ n ] : 4 : 2 );
      write( ' E=' );
      write( error : 4 : 2 );
      if ( i - CalFirst + 1) mod 3 = 0 then begin
         writeln
      end else begin
         write( '   ' );
      end;
      if error > largest then begin
         largest := error;
         w := i;
      end;
   end;
   write( 'Emax=' );
   write( largest : 4 : 2 );
   write( ' for ' );
   writeln( ( 1.0 * w ) / 10 : 4 : 2 );
   s := '';
   while s <> ' ' do begin
      writeln( 'enter file name to write (space + return for none)' );
      readln( s );
      if s <> '' then begin
         assign( f, s );
         {$I-}
         rewrite( f );
         {$I+}
         if IOResult = 0 then begin
            for i := 0 to 80 do begin
               writeln( f, i : 2, '   ', Actuals[ i ] );
            end;
            close( f );
            s := ' ';
         end;
      end;
   end;
   WriteCalibration;
   write( 'Calibration done' );
end;

const VccHigh     : word = Vcc_5_00;
const VccLow      : word = Vcc_5_00;

procedure WispTwiceVerify(
   var m  : Pic_Image;
   Parts  : Image_Part_set
);
begin
   if ( VccHigh =  Vcc_5_00 ) and ( VccLow =  Vcc_5_00 ) then begin
      WispVerify( m, Parts );
   end else begin
      Show( 'Check with Vcc Low'  );
      SendReceive( HexByte( VccByte( VccLow ) ) + 'z' );
      delay( 2000 );
      WispVerify( m, Parts );
      Show( 'Check with Vcc High' );
      SendReceive( HexByte( VccByte( VccHigh ) ) + 'z' );
      delay( 2000 );
      WispVerify( m, Parts );
      SendReceive( '00z' );
   end;
end;

{ ******************** target testing }

   { test the target with an image constructed
   { from x and y, using write command w }
procedure WispOneTest(var m : Pic_Image; s, w : string; x, y : word ); begin
   writeln( s );
   Image_Set_All( m, x, y );
   Image_Set( m, Config_Address, Dummy_Value );
   WispWrite( m, w, [ code ] );
   WispTwiceVerify( m, [ code ] );
end;

   { perform a few tests on the target }
procedure WispTest( w : string );
   var p : ^Pic_Image;
begin
   new(p);
   WispOneTest( p^, '1,2,3...', w, 1,     1 );
   WispOneTest( p^, '1,4,7...', w, 1,     3 );
   WispOneTest( p^, 'all a5a5', w, $a5a5, 0 );
   WispOneTest( p^, 'all 5a5a', w, $5a5a, 0 );
   WispOneTest( p^, 'all 0',    w, $0,    0 );
   WispOneTest( p^, 'all ffff', w, $ffff, 0 );
end;

{ ******************** on-line help }
                            
const Help_Lines = 44;
type Help_String = string[ 39 ];
const Help_Text : array[ 1..Help_Lines ] of Help_String = (
   'BEEP      : beep at end               ',
   'BURN n    : set device id             ',
   'CALIBRATE : calibrate VCC             ',
   'CHECK     : buffer against target     ',
   'DTR x     : set DTR line              ',
   'DUMP      : dump buffer content       ',          
   'ERASE     : erase targets             ',
   'FLUSH     : flush logging             ',
   'FUSES x   : x=IGNORE, FILE or value   ',
   'GET       : target to buffer          ',
   'GO f      : erase, write f, check, run',
   'HEX       : hex values (TALK,TERM,TTY)',
   'ID n      : use device with ID n      ',
   'LAZY      : use lazy programming      ',   
   'LOAD f    : file f to buffer          ',
   'LOG f     : log to file f             ',   
   'NORESTORE : do not restore calibr.etc.',    
   'PASS m    : enable passthrough        ',    
   '            m=B67T, B67I, AUXT, AUXI  ',    
   'PATCH OFF : clear patch list          ',    
   'PATCH a=v : patch address a, value v  ',    
   'PAUSE m   : print m, wait for return  ',    
   'PORT P    : use serial port p         ',   
   'PORT b    : use baudrate b            ',   
   'PROTECT x : x=ON, OFF or FILE         ',   
   'PUT       : buffer to target          ',    
   'READ f    : get, save f               ',   
   'RTS x     : set RTS line              ',   
   'RUN       : put target in run mode    ',   
   'SAVE f    : buffer to file            ',    
   'SELECT x  : x[i] from +-CDFA          ',    
   'TALK      : talk to wisp              ',   
   'TARGET x  : specify target chip       ',   
   'TERM b    : TTY @ line, baudrate b    ',   
   'TEST      : test programmability      ',   
   'TIME      : show current time         ',   
   'TTY b     : TTY to target, baudrate b ',   
   'TTY [m] b : idem, for m see PASS      ',   
   'VCC l h   : set verify voltages       ',   
   'VERBOSE   : enable screen logging     ',   
   'VERIFY f  : load f, check             ',   
   'WAIT n    : wait (at least) N ms      ',   
   'WRITE f   : load f, put               ',
   '                                      ');
   
procedure Help; 
   var i : integer;
begin                  
   assign( output, '');
   rewrite( output );
   writeln( output, 'wisptool ' + version + '; see http://www.voti.nl/wisptool ');
   writeln(output, 'commands:' );
   for i := 1 to Help_Lines div 2 do begin
      writeln( output, Help_Text[ i ] + '   ' + Help_Text[ i + Help_Lines div 2 ] );
   end;
end;


{ ******************** command line handling }

var ComPort          : integer;
var WispID           : word;
var WriteCmd         : string;
var Image            : ^Pic_Image;
var Image2           : ^Pic_Image;
var Preserved_Image  : ^Pic_Image;
var Patches          : Patch_List;
var Parts            : Image_Part_Set;
const InitDone       : boolean = false;
const TargetDone     : boolean = false;
const Restore        : boolean = true;

const Wbus_Baudrate  : integer = 19200;

   { init using WISP on ComPort with ID WispID }
procedure WispInit( t : boolean ); begin
   if not InitDone then begin
      InitPort( ComPort, Wbus_Baudrate );
      ResetTarget;
      LineBreak;
      Log( 'wake up device ' + HexWord( WispID ) );
      WaitIgnoreSendString( HexWord( WispID ) + 'h' + '0000');
      ClearReceive;
      WispCheck( WispID );  
      InitDone := true;
   end;
   if t and ( not TargetDone ) then begin
      WispCheckTarget;
      if 
         ( Device = 'WISP' )
         and ( TargetInfo[ target ].Algorithm <> Algorithm_PIC16 )
      then begin
         fatal( 'this target can not be programmed with a WISP programmer' );
      end;
      if Restore then begin      
         WispReadPreserved( Preserved_Image^, Restore );
      end;
      TargetDone := true;
   end;
end;

   { verify availability of a next parameter and return it
   { increment i }
function NextParameter( var i : integer ) : string; begin
   if i = paramcount then begin
      fatal( 'missing argument for ' + UpStr( paramstr( i ) ) );
   end;
   i := i + 1;
   NextParameter := paramstr( i );
end;

function Polarity( s : string; var x : boolean ) : boolean; begin
   if ( s = '+' ) or ( s = 'ON' ) then begin
      x := true;
      Polarity := true;
   end else if ( s = '-' ) or ( s = 'OFF' )then begin
      x := false;
      Polarity := true;
   end else begin
      Polarity := false;
   end;
end;

   { handle parameter i }
procedure HandleParameter( var i : integer );
   var p, s, k    : string;
   var s1, s2     : string;
   var j, c       : integer;
   var v, v1, v2  : longint;
   var x          : real;
   var d          : word; 
   var t          : target_type;
   var sign       : integer;
   var flag       : boolean;
begin 

   p := UpStr( paramstr( i ) );

   if p = 'BEEP' then begin
      BeepEnable := true;
      exit;
   end;

   if p = 'BURN' then begin
      s := UpStr( NextParameter( i ) );
      if ( length( s ) <> 4 ) then begin
         fatal( 'BURN argument must be 4 hex chracters' );
      end;
      for j := 1 to 4 do case upcase( s[ j ] ) of
         '0'..'9', 'A'..'F' : ;
         else fatal( 'BURN argument must be 4 hex chracters' );
      end;
      WispInit( false );
      WispBurn( s );
      exit;
   end;

   if p ='CALIBRATE' then begin
      WispInit( false );
      Calibrate;
      InitDone := false;
      SendReceive( '00z' );
      exit;
   end;

   if p = 'CHECK' then begin
      WispInit( true );
      WispTwiceVerify( Image^, Parts );
      exit;
   end;
   
   if p = 'DTR' then begin
      s := NextParameter( i );
      if Polarity( UpStr( s ), flag ) then begin
         DTR_specified := true;
         set_DTR( flag );
      end else begin
         fatal( 'invalid DTR argument : ' + s );
      end;
      exit;
   end;

   if p = 'DUMP' then begin
      DumpHexImage( Image^ );
      exit;
   end;

   if p = 'ERASE' then begin
      WispInit( true );
      WispErase( Preserved_Image^, Restore );
      exit;
   end;

   if p = 'FLUSH' then begin
      FlushEnable := true;
      exit;
   end;

   if p = 'FUSES' then begin
      s := NextParameter( i );
      if UpStr( s ) = 'IGNORE' then begin
         Include_Fuses := false;
      end else if UpStr( s ) = 'FILE' then begin
         Include_Fuses := true;
         Fixed_Fuses   := false;
      end else begin
         val(s, v, c );
         if (c <> 0) or (v < 0) or (v > $ffff) then begin
            fatal( 'FUSES argument not valid (must be IGNORE, FILE or a value' );
         end;               
         Include_Fuses := true;
         Fixed_Fuses   := true;
         Fuses_Value   := v;
      end;
      exit;
   end;
   
   if p = 'GET' then begin
      WispInit( true );
      WispRead( Image^, Parts );
      exit;
   end;
   
   if p = 'GO' then begin
      WispInit( true );
      WispErase( Preserved_Image^, Restore );
      ReadHexImage( Image^, NextParameter( i ) );
{ writeln('config was ' + HexWord( Image[ ConfigAddress ] ) ); }
      Copy_And_Patch( Image^, Image2^, Patches, target, Preserved_Image^, Restore );
      WispWrite( Image2^, WriteCmd, Parts );
      WispTwiceVerify( Image2^, Parts );
      WispRun;
      exit;
   end;

   if p = 'HEX' then begin
      show_hex := true;
      exit;
   end;

   if p = 'ID' then begin
      s := NextParameter( i );
      val(s, v, c );
      if (c <> 0) or (v < 0) or (v > $ffff) then begin
         fatal( 'ID argument not valid' );
      end;
      WispID := v;
      exit;
   end;

   if p = 'LAZY' then begin
      WriteCmd := 'l';
      exit;
   end;
   
   if p = 'LOAD' then begin
      ReadHexImage( Image^, NextParameter( i ) );
      exit;
   end;   

   if p = 'LOG' then begin
      LogOpenFile( NextParameter( i ) );
      exit;
   end;

   if p = 'NORESTORE' then begin
      Restore := false;
      exit;
   end;

   if p = 'PASS' then begin
      s := UpStr( NextParameter( i ) );
      
      k := '0000';
      if s = 'B67T' then begin
         k := '0000';
         ModeTextIndex := 1;
      end else if s = 'B67I' then begin
         k := '0001';
         ModeTextIndex := 2;
      end else if s = 'AUXT' then begin
         k := '0010';
         ModeTextIndex := 3;
      end else if s = 'AUXI' then begin
         k := '0011';
         ModeTextIndex := 4;
      end;
         
      WispInit( false ); 
      writeln( 'passthrough mode ' + ModeText[ ModeTextIndex ] );
      WispPassthrough( k );
      InitDone := false;
      exit;
   end;
   
   if p = 'PATCH' then begin
      s := UpStr( NextParameter( i ) );     
      if s = 'OFF' then begin
         Patches := nil;
         exit;
      end;
      Pivot( s, '=', s1, s2 );
      val(s1, v1, c );
      if (c <> 0) or (v1 < 0) or (v1 > $ffff) then begin
         fatal( 'PATCH address argument not valid' );
      end; 
      val(s2, v2, c );
      if (c <> 0) or (v2 < 0) or (v2 > $ffff) then begin
         fatal( 'PATCH value argument not valid' );
      end;                          
      Patch_List_Add( Patches, v1, v2 );
      exit;
   end;
   
   if p = 'PAUSE' then begin
      s := NextParameter( i );
      writeln( '>>> ' + s );      
      writeln( '(press return to continue)' );      
      readln;
      exit;
   end;
   
   if p = 'PORT' then begin
      s := UpStr( NextParameter( i ) );
      if ( substr( s + '   ', 1, 3 ) = 'COM' ) then begin
         delete( s, 1, 3 );
      end;
      val(s, v, c );
      if (c <> 0) or (v < 1) then begin
         fatal( 'x PORT argument not valid' );
      end;
      if v <= 8 then begin
         ComPort := v;
         InitDone := false;
         exit;
      end else begin
         Wbus_Baudrate := v;
         exit;
      end
   end;

   if p = 'PROTECT' then begin
      s := UpStr( NextParameter( i ) );
      if s = 'ON' then begin
         Protection := always;
         exit;
      end;
      if s = 'OFF' then begin
         Protection := never;
         exit;
      end;
      if ( s = 'FILE' ) or ( s = 'IMAGE' ) then begin
         Protection := hex;
         exit;
      end;
      fatal( 'invalid protection argument ' + s );
   end;
   
   if p = 'PUT' then begin
      WispInit( true );
      Copy_And_Patch( Image^, Image2^, Patches, target, Preserved_Image^, Restore  );
      WispWrite( Image2^, WriteCmd, Parts );
      exit;
   end;   

   if p = 'READ' then begin
      WispInit( true );
      WispRead( Image^, Parts );
      Copy_And_Patch( Image^, Image2^, Patches, target, Preserved_Image^, Restore  );
      WriteHexImage( Image2^, NextParameter( i ), Parts );
      exit;
   end;

   if p = 'RTS' then begin
      s := UpStr( NextParameter( i ) );
      if Polarity( s, flag ) then begin
         set_RTS( flag );
      end else begin
         fatal( 'invalid RTS argument : ' + s );
      end;
      exit;
   end;

   if p = 'RUN' then begin
      WispInit( false );
      WispRun;
      exit;
   end;

   if p = 'SAVE' then begin
      Copy_And_Patch( Image^, Image2^, Patches, target, Preserved_Image^, Restore );
      WriteHexImage( Image2^, NextParameter( i ), Parts );
      exit;
   end;

   if p = 'SELECT' then begin
      s := UpStr( NextParameter( i ) );
      sign := 1;
      for j := 1 to length( s ) do begin
         case s[ j ] of
            'A' : Add_Or_Remove( Parts, sign, All_Parts );
            'C' : Add_Or_Remove( Parts, sign, [ code ] );
            'D' : Add_Or_Remove( Parts, sign, [ data ] );
            'F' : Add_Or_Remove( Parts, sign, [ fuses ] );
            '+' : sign := +1;
            '-' : sign := -1;
            else fatal( 'SELECT argument contains invalid character(s)' );
         end;
      end;
      exit;
   end;                                                                    
  
   if p = 'TALK' then begin
      WispInit( false );
      EmulateTTY( ComPort, 'chat with device', 19200 );
      InitDone := false;
      exit;
   end;

   if p = 'TARGET' then begin
      s := UpStr( NextParameter( i ) );    
      if s = 'AUTO' then begin
         Target := pic_unknown;
         exit;
      end;
      for t := target_first to target_last do begin
         if 
            ( UpStr( TargetInfo[ t ].Name ) = s )
            or ( UpStr( TargetInfo[ t ].Abbreviation ) = s )
         then begin
            Target := t;
            exit;
         end;
      end;
      fatal( 'invalid target argument ' + s );
   end;

   if p = 'TERM' then begin
      s := UpStr( NextParameter( i ) );

      if pos( 'K', s ) = 0 then begin
         val(s, v, c );
         if (c <> 0) or (v < 0) then begin
            fatal( 'TERM argument not valid' );
         end;
      end else begin
         val(substr(s, 1, pos('K',s) - 1), v, c);
         if (c <> 0) or (v < 0) then begin
            fatal( 'TERM argument not valid' );
         end;
         val(substr(s + '000', pos('K',s) + 1, 3 ), v2, c);
         if (c <> 0) or (v2 < 0) then begin
            fatal( 'TERM argument not valid' );
         end;
         v := 1000 * v + v2;
      end;

      EmulateTTY( ComPort, 'raw serial line', v );
      exit;
   end;

   if p = 'TEST' then begin
      WispInit( true );
      WispTest( WriteCmd );
      exit;
   end;

   if p = 'TIME' then begin
      Show( TimeStr );
      exit;
   end;

   if p = 'TTY' then begin
      s := UpStr( NextParameter( i ) );
      
      k := '0000';
      if s = 'B6T' then begin
         k := '0000';
         s := UpStr( NextParameter( i ) );
         ModeTextIndex := 1;
      end else if s = 'B6I' then begin
         k := '0001';
         s := UpStr( NextParameter( i ) );
         ModeTextIndex := 2;
      end else if s = 'AUXT' then begin
         k := '0002';
         s := UpStr( NextParameter( i ) );
         ModeTextIndex := 3;
      end else if s = 'AUXI' then begin
         k := '0003';
         s := UpStr( NextParameter( i ) );
         ModeTextIndex := 4;
      end;

      if pos( 'K', s ) = 0 then begin
         val(s, v, c );
         if (c <> 0) or (v < 0) then begin
            fatal( 'TTY argument not valid' );
         end;
      end else begin
         val(substr(s, 1, pos('K',s) - 1), v, c);
         if (c <> 0) or (v < 0) then begin
            fatal( 'TTY argument not valid' );
         end;
         val(substr(s + '000', pos('K',s) + 1, 3 ), v2, c);
         if (c <> 0) or (v2 < 0) then begin
            fatal( 'TTY argument not valid' );
         end;
         v := 1000 * v + v2;
      end;
      { writeln( 'k="' + k + '"' ); }

      WispInit( false );
      WispPassthrough( k );
      EmulateTTY( ComPort, ModeText[ ModeTextIndex ], v );
      InitDone := false;
      exit;
   end;

   if p = 'VCC' then begin
      WispInit( false );
      ReadCalibration;
      CheckCalibration;
      s := UpStr( NextParameter( i ) );
      val( s, x, d );
      if d <> 0 then fatal( 'first VCC argument not valid' );
      VccLow := BestVcc( x );
      s := UpStr( NextParameter( i ) );
      val( s, x, d );
      if d <> 0 then fatal( 'second VCC argument not valid' );
      VccHigh := BestVcc( x );
      exit;
   end;

   if p = 'VERBOSE' then begin
      DumpInterval := 1;
      VerboseEnable := true;
      exit;
   end;

   if p = 'VERIFY' then begin
      ReadHexImage( Image^, NextParameter( i ) );
      WispInit( true );
      WispTwiceVerify( Image^, Parts );
      exit;
   end;

   if p = 'WAIT' then begin
      s := UpStr( NextParameter( i ) );
      val(s, v, c );
      if (c <> 0) or (v < 1) then begin
         fatal( 'WAIT argument not valid' );
      end;
      Delay( v );
      exit;
   end;

   if p = 'WRITE' then begin
      ReadHexImage( Image^, NextParameter( i ) );
      WispInit( true );
      Copy_And_Patch( Image^, Image2^, Patches, target, Preserved_Image^, Restore );
      WispWrite( Image2^, WriteCmd, Parts );
      exit;
   end;

   fatal( 'invalid command ' + paramstr( i ) );
end;

procedure test;
   var s : string;
   var i,j : integer;
   var a, b: byte;
begin
   ComPort := 1;
   VerboseEnable := false;
   InitPort( ComPort, 57600 );
   ClearReceive;
   GetSX(  chr( 0 ) + 'SX-Key', 16, s );
   if true then begin
      for i := 1 to length(s) do begin
        write( HexChar( s[ i ] ) );
        write( ' ' );
      end;
      writeln;
   end;

   VerboseEnable := false;
   ClearReceive;
   GetSX(  chr( 3 ), 2, s );
   if true then begin
      for i := 1 to length(s) do begin
        write( HexChar( s[ i ] ) );
        write( ' ' );
      end;
      writeln;
   end;

   VerboseEnable := false;
   for i:= 1 to 2048 + 3 + 16 do begin

      delay( 100 );
      if false then ClearReceive;
      GetSX( chr(1), 4, s );
      if false then begin
         write( 'i=',i,'   ');
         for j := 1 to length(s) do begin
            write( HexChar( char( 256 - ord( s[ j ] ) ) ) );
            write( ' ' );
         end;
         writeln;
      end else begin
         if odd(i) then begin
            a := 256 - ord( s[ 2 ] );
         end else if false then begin
            b := 256 - ord( s[ 2 ] );
            write( ' ' );
            write( HexChar( char( b ) ) );
            write( HexChar( char( a ) ) );
            if i mod 16 = 0 then writeln;
         end else begin
            if i mod 10 = 0 then begin
               write( i,'    ', chr(13) );
            end;
         end;
      end;
   end;

end;

   { main: init, handle all parameters }
var i : integer;
begin
   CalibrationInit;
   ComPort     := 1;
   WispID      := $0000;
   WriteCmd    := 'w';
   i           := 1;
   Patches     := nil;
   Protection  := hex;
   Parts       := All_Parts;
   new( Image );
   new( Image2 );
   new( Preserved_Image );
   Image_Clear( Image^ );
   Image_Clear( Preserved_Image^ );
   set_RTS( false );
   set_DTR( false );

   if paramcount = 0 then begin
      Help;

   end else begin
      writeln('wisptool ' + version );
      while i <= paramcount do begin
         HandleParameter( i );
         i := i + 1;
      end;
      if LogOpen then close( LogFile );
      BeepOk;
      writeln( 'OK' );
   end;
end.