type t_ar=array[0..$FFFE]of byte;
const max_err=650000;
var ar:^t_ar;
size,pos:word;
dat:byte;
err:longint;
f:file;
procedure error(ms:string;_pos:word);
begin
writeln('ошибка приема ',ms,' в позиции ',_pos);
halt;
end;
begin
writeln('ZX to IBM ...');
new(ar);
size:=6912;
for pos:=0 to size do
 begin
err:=0;
repeat
inc(err);
if err>max_err then error('LO',pos);
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',pos);
until (port[$037A] and $04)=0;
dat:=((port[$0379] shl 1)and$F0)or dat;
ar^[pos]:=dat;
 end;
writeln('Writing ',pos,' byte');
assign(f,'file.dat');
rewrite(f,1);
blockwrite(f,ar^,pos);
close(f);
writeln('Ok');
dispose(ar);
end.