const max_err=6500000;
type t_mem=array[0..$FFFE]of byte;
var
_s:string;
fl:text;
a,b,r,f:^t_mem;
dat:byte;
err:longint;
pos:word;
procedure error(ms:string;_pos:word);
begin
writeln('ошибка приема ',ms,' в позиции ',_pos);
halt;
end;
procedure getDats(var ddt:byte);
 begin
err:=0;
repeat
inc(err);
if err>max_err then error('LO',0);
until (port[$037A] and $04)<>0;
dat:=(port[$0379] shr 3)and$0F;
err:=0;
repeat
inc(err);
if err>max_err then error('HI',0);
until (port[$037A] and $04)=0;
ddt:=((port[$0379] shl 1)and$F0)or dat;
 end;
var s:string;
const HX='0123456789ABCDEF';
function writeB(_dt:byte):string;
begin
writeB:='$'+s[(_dt shr 4)+1]+s[(_dt and $0F)+1];
end;
function writeF(b:byte):string;
var s:string;
begin
s:='';
if (b and $80)=0 then s:=s+'s' else s:=s+'S';
if (b and $40)=0 then s:=s+'z' else s:=s+'Z';
if (b and $20)=0 then s:=s+'0' else s:=s+'1';
if (b and $10)=0 then s:=s+'h' else s:=s+'H';
if (b and $08)=0 then s:=s+'0' else s:=s+'1';
if (b and $04)=0 then s:=s+'v' else s:=s+'V';
if (b and $02)=0 then s:=s+'n' else s:=s+'N';
if (b and $01)=0 then s:=s+'c' else s:=s+'C';
writeF:=s;
end;

begin
new(a);
new(b);
new(r);
new(f);

s:=HX;
assign(fl,'c:\add.dat');
rewrite(fl);
writeln('Get dats...');
for pos:=0 to $FFFF do
 begin
getDats(dat);
a^[pos]:=dat;
getDats(dat);
b^[pos]:=dat;
getDats(dat);
r^[pos]:=dat;
getDats(dat);
f^[pos]:=dat;
 end;
writeln('Write result...');
for pos:=0 to $FFFF do
 begin
_s:='A:=';
_s:=_s+writeB(a^[pos]);
_s:=_s+' B:=';
_s:=_s+writeB(b^[pos]);
_s:=_s+' R:=';
_s:=_s+writeB(r^[pos]);
_s:=_s+' F:=';
_s:=_s+writeF(f^[pos]);
writeln(fl,_s);
 end;
writeln('Ok');
dispose(a);
dispose(b);
dispose(r);
dispose(f);
end.