program Prog8252 (input,output);
{var Port: array [0..65535] of byte;
    PortW: array [0..65534] of Word;}

uses crt;
const Data = $378;
      Status = Data + 1;
      Control = Data + 2;

var Bits:byte;
    trash:byte;
    pis,soubor:string;
    slus:boolean;
    f:word;
    zapsat,cteno:array [0..8192] of byte;
    buf:file of byte;
    debug,skoncit:Boolean;
    size:integer;

procedure precti;forward;
procedure prectidata;forward;
procedure chcip; forward;

procedure cekej;
var w:real;
f:byte;
begin
for f:=1 to 3 do w:=f;
end;

procedure pausa;
begin
delay (3);
end;

procedure resetCH;
var f:byte;
begin
{Port[Control]:=11;}
pausa;
{delay (50);}
Port[Control]:=3;
{RESET do High, ostatni do Low, Int Disabled}
pausa;
delay (250);
end;


procedure clockdown;
begin
Port[Control]:=Port[Control] or 2;
cekej;
end;

procedure clockup;
begin
Port[Control]:=Port[Control] and $fd;
cekej;
end;

function slovo (posli:byte):byte;
var f,ctu,bit:byte;
begin
ctu:=0;
for f:=7 downto 0 do
  begin
    if (posli and $80 ) <> 0 then
     begin
     trash:=Port[Control];
     trash:=trash and $FE;
     Port[Control]:=trash;
     end
     else
     begin
     trash:=Port[Control];
     trash:=trash or $1;
     Port[Control]:=trash;
     end;

    posli:=posli Shl 1;
    clockup;
    bit:=0;
    bit:=  Port[Status] and $80;
    if bit = 0 then bit:=1 else bit:=0;
    cekej;
    if (Port[Status] and $80) = bit then writeln ('err in read ');
    if debug then if bit =  1 then write ('1') else write ('0');
    ctu:= ctu Shl 1;
    ctu:= ctu or bit;
    clockdown;
  end;
  if debug then write ('_');
  if keypressed then if ord(Readkey) = 27 then chcip;
slovo:=ctu;
end;

procedure enable;
begin
resetCH;
trash:=slovo($ac);
pausa;
trash:=slovo($53);
{trash:=slovo($4);}
pausa;
trash:=slovo($0);
pausa;
if debug then writeln ('Serial mode enabled');
end;

procedure ChipErase;
var k:char;
begin
write ('Erase both program (8k) and data (2k) memories ? [y/N]');
   Read (k);
   writeln;
   if (k = chr (13)) or (k='N') or (k='n') then chcip;

resetCH;
trash:=slovo($ac);
pausa;
{trash:=slovo($53);}
trash:=slovo($4);
pausa;
trash:=slovo($0);
pausa;
pausa;
pausa;
pausa;
debug:=true;
if debug then writeln ('Chip erased.');
end;

function RData (addr:word):byte;
var lo,hi:byte;
begin
write (chr(13),addr);
if addr > 8191 then writeln ('Maximum address (1FFF) exceeded !');
lo:=addr mod 256;
hi:=addr div 256;
hi:=hi shl 3;
hi:=hi and $f8;
hi:=hi or 1;
trash:=slovo (hi);
trash:=slovo(lo);
RData:=slovo(0);
end;

function RDatData (addr:word):byte;
var lo,hi:byte;
begin
write (chr(13),addr);
if addr > 2047 then writeln ('Maximum data address (07FF) exceeded !');
lo:=addr mod 256;
hi:=addr div 256;
hi:=hi shl 3;
hi:=hi and $38;
hi:=hi or 5;
trash:=slovo (hi);
trash:=slovo(lo);
RDatData:=slovo(0);
end;


procedure WData (addr:word;data:byte);
var lo,hi:byte;
begin
  write (chr(13),addr,' ...  ',data,'       ');
if addr > 8191 then writeln ('Maximum address (1FFF) exceeded !');
lo:=addr mod 256;
hi:=addr div 256;
hi:=hi shl 3;
hi:=hi and $f8;
hi:=hi or 2;
trash:=slovo (hi);
trash:=slovo(lo);
trash:=slovo(data);
pausa;
end;

procedure WDatData (addr:word;data:byte);
var lo,hi:byte;
begin
  write (chr(13),addr,' ...  ',data,'       ');
if addr > 2047 then writeln ('Maximum data address (07FF) exceeded !');
lo:=addr mod 256;
hi:=addr div 256;
hi:=hi shl 3;
hi:=hi and $38;
hi:=hi or 6;
trash:=slovo (hi);
trash:=slovo(lo);
trash:=slovo(data);
pausa;
end;



procedure Help;
begin
{writeln;}
{writeln('Usage: prg8252.exe [-r|w|v] [-p378|p278|p3BC] filename[.bin]');}
writeln('Usage: prg8252.exe [-r|w|v|m|d|e] [filename[.bin]]');
writeln;
writeln ('      -r  .. read internal program EEPROM to file');
writeln ('      -w  .. write file into internal program EEPROM');
writeln ('      -v  .. verify internal program EEPROM with the file');
writeln ('      -m  .. write file into internal data EEPROM');
writeln ('      -d  .. dump internal data EEPROM to the file');
writeln ('      -e  .. chip erase (both program and data memory)');
writeln;
writeln ('Default option is -w');
writeln;
writeln ('This program is intended for serial communication with');
writeln ('Atmel AT89S8252 embedded processor via SPI interface.');
writeln ('In order to use it, connect:  RST  to pin 17');
writeln ('                              SCK  to pin 14');
writeln ('                              MOSI to pin 1 ');
writeln ('                              MISO to pin 11');
writeln ('of your printer port, attach crystal 24 MHz and power..');
writeln ('For further information about Atmel part see www.atmel.com;');
writeln ('schematics and updated version of this programmer you will');
writeln ('find at http://www.fmi.cz/jak.');
writeln;
writeln ('(c) 1997, Jakub Jiricek, E-mail: jak@fmi.cz');
halt (1);
end;

procedure getname (kolikaty:byte;var soubor:string);
var s:string;
begin
if Length (ParamStr(kolikaty))>13 then help;
if Pos ('.',ParamStr(kolikaty))=0 then soubor:=ParamStr(kolikaty)+'.bin'
else soubor:=ParamStr(kolikaty);
end;

procedure zapis;
var s:string;
    f:word;
    err:boolean;
    chyby:integer;
begin
GetDir(0,s); { 0 = Current drive }
{WriteLn('Current drive and directory: ', s);}
{$I-}
Assign(buf, soubor);
reset(buf);

{$I+}
  if (IOResult = 0) and (soubor <> '') then else begin
  writeln;
  writeln ('File ',soubor,' not found..');
  halt (1);
  end;

size := FileSize(buf);
if size > 8192 then begin
                    writeln ('Internal EEPROM memory is 8192 bytes only..');
                    halt (1);
                    end;
WriteLn('Sending ',size,' bytes to the chip (',soubor,')');
for f:=1 to size do read (buf,zapsat[f]);
Close(buf);

for f:=1 to size do
  begin
    WData (f-1,zapsat[f]);
 {   write (chr(13),f-1,' ...  ',zapsat[f],'       ');}
  end;
writeln (chr (13) + 'All data sent..     ');
writeln ('Verifying..');
precti;
err:=false;
chyby:=0;
for f:=1 to size do
begin
if zapsat[f]<>cteno[f] then
 begin
  writeln ('Value differs at ',f,'  written:',zapsat[f],'    read:',cteno[f]);
  err:=true;
  chyby:=chyby+1;
 end;
 if chyby=10 then f:=size;
end;
if not err then Writeln ('Verified ',size,' bytes, all OK..');
writeln;
end;


procedure pisdata;
var s:string;
    f:word;
    err:boolean;
begin
GetDir(0,s); { 0 = Current drive }
{WriteLn('Current drive and directory: ', s);}
{$I-}
Assign(buf, soubor);
reset(buf);

{$I+}
  if (IOResult = 0) and (soubor <> '') then else begin
  writeln;
  writeln ('File ',soubor,' not found..');
  halt (1);
  end;

size := FileSize(buf);
if size > 2048 then begin
                    writeln ('Internal data EEPROM memory is 2048 bytes only..');
                    halt (1);
                    end;
WriteLn('Sending ',size,' bytes to the chip (',soubor,')');
for f:=1 to size do read (buf,zapsat[f]);
Close(buf);

for f:=1 to size do
  begin
    WDatData (f-1,zapsat[f]);
 {   write (chr(13),f-1,' ...  ',zapsat[f],'       ');}
  end;
writeln (chr (13) + 'All data sent..     ');
writeln ('Verifying..');
prectiData;
err:=false;
for f:=1 to size do
begin
if zapsat[f]<>cteno[f] then
 begin
  writeln ('Value differs at ',f,'  written:',zapsat[f],'    read:',cteno[f]);
  err:=true;
 end;
end;
if not err then Writeln ('Verified ',size,' bytes, all OK..');
writeln;
end;


procedure precti;
var f:word;
begin
writeln ('Reading from program memory..');
for f:=1 to size do cteno[f]:=Rdata(f-1);
writeln (chr(13) + 'Internal program memory (',size,' bytes) read..');
end;

procedure prectiData;
var f:word;
begin
writeln ('Reading from data memory..');
for f:=1 to size do cteno[f]:=RDatdata(f-1);
writeln (chr(13) + 'Internal data memory (',size,' bytes) read..');
end;

procedure cti;
var f:word;
    k:char;
begin
size:= 8192;
writeln ('Reading from chip..');
writeln ('Creating file ',soubor);
{$I-}
Assign(buf, soubor);
Reset(buf);
Close(buf);
{$I+}
if (IOResult = 0) and (soubor <> '') then
 begin
   write ('File ',soubor,' already exists, overwrite [y/N]?');
   Read (k);
   writeln;
   if (k = chr (13)) or (k='N') or (k='n') then chcip;
 end;

rewrite(buf);

for f:=1 to size do begin
cteno[f]:=Rdata(f-1);
write (buf,cteno[f]);
end;
writeln (chr(13) + 'Internal program memory (',size,' bytes) read..');
close (buf);
end;

procedure ctidata;
var f:word;
    k:char;
begin
size:=2048;
writeln ('Reading from chip..');
writeln ('Creating file ',soubor);
{$I-}
Assign(buf, soubor);
Reset(buf);
Close(buf);
{$I+}
if (IOResult = 0) and (soubor <> '') then
 begin
   write ('File ',soubor,' already exists, overwrite [y/N]?');
   Read (k);
   writeln;
   if (k = chr (13)) or (k='N') or (k='n') then chcip;
 end;

rewrite(buf);

for f:=1 to size do begin
cteno[f]:=RDatData(f-1);
write (buf,cteno[f]);
end;
writeln (chr(13) + 'Internal data memory (',size,' bytes) read..');
close (buf);
end;


procedure kontrola;
var err:boolean;
begin
writeln ('Verify chip contents..');
{$I-}
Assign(buf, soubor);
reset(buf);

{$I+}
  if (IOResult = 0) and (soubor <> '') then else begin
  writeln;
  writeln ('File ',soubor,' not found..');
  halt (1);
  end;

size := FileSize(buf);
if size > 8192 then begin
                    writeln ('Internal EEPROM memory is 8192 bytes only..');
                    halt (1);
                    end;
WriteLn('Verifying ',size,' bytes of internal EEPROM..');
for f:=1 to size do read (buf,zapsat[f]);
Close(buf);
precti;
err:=false;
for f:=1 to size do
begin
if zapsat[f]<>cteno[f] then
 begin
  writeln ('Value differs at ',f,'  written:',zapsat[f],'    read:',cteno[f]);
  err:=true;
 end;
end;
if not err then Writeln ('Verified ',size,' bytes, all OK..');
writeln;
end;

procedure chcip;
begin
Port[Control]:=Port[Control] or 8;
halt (1);
end;

{******** MAIN ***}
begin
Port[Control]:=Port[Control] or 8;
debug:=false;
skoncit:=false;
enable;
writeln;
writeln ('Atmel AT89S8252 serial interface');
if (ParamCount <1) or (ParamStr(1) = '-h') or (ParamStr(1) = '/h')
or (ParamStr(1) = '?') or (ParamStr(1) = '/?') or (ParamStr(1) = 'help')
then help;

if ParamCount=1 then begin
if copy (ParamStr(1),1,1) <> '-' then
begin
getname(1,soubor);
zapis;
halt (1);
end else if copy (ParamStr(1),2,1) = 'e' then
begin
chiperase;
halt(1);
end else help;
end;

if ParamCount=2 then begin
  if copy(ParamStr(1),1,1) <> '-' then help;
  getname(2,soubor);
  if copy(ParamStr(1),2,1) = 'r' then cti else
    if copy(ParamStr(1),2,1) = 'w' then zapis else
      if copy(ParamStr(1),2,1) = 'v' then kontrola else
        if copy(ParamStr(1),2,1) = 'd' then ctidata else
          if copy(ParamStr(1),2,1) = 'm' then pisdata else
            if copy(ParamStr(1),2,1) = 'e' then chiperase else help;
  chcip;
end;

help;

{debug:=false;
writeln (rdata(22));
wdata (22,111);
writeln (rdata(22));}
Port[Control]:=Port[Control] or 8;
delay (400);
writeln;
end.