program programator_Epromov ;
uses Crt,Multiio;
const eprlen:array[1..5] of word = (8*1024-1,16*1024-1,32*1024-1,
64*1024-1,4*1024-1);
idle = $FF;
type str2=string[2];
var inFile :File of byte;
TstFile :File;
filename :string[60];
Addr,LastAddr,
Offset :word;
Data :byte;
StatR :byte;
choice :char;
eprtype :byte;
selected, ok ,Mok :boolean;
windopen,
statline :boolean;
buff :array[0..64000] of byte;
message :string[79];
function BeriD:byte;
var wait:byte;
begin
for wait:=0 to 10 do BeriD:=ReadD; {Cakaj nekaj casa na podatek iz 8255}
BeriD:=ReadD;
end;
procedure filenameupcase;
var n:byte;
begin
for n:=1 to length(filename) do filename[n]:=upcase(filename[n]);
end;
procedure brisiekran;
begin
window(1,1,80,24);
TextColor(yellow);
TextBackground(black);
clrscr;
end;
procedure MainMenu;
begin
window(20,6,59,17);
TextColor(Yellow);
TextBackground(Blue);
clrscr;
TextColor(White);
TextBackground(Magenta);
gotoxy(5,2);
Write(' Glavni menu: ');
TextColor(Yellow);
TextBackground(Blue);
gotoxy(1,4);
writeln(' (S) Izberi Eprom, Kontroler ');
writeln(' (V) Preveri praznost Eproma');
writeln(' (L) Beri datoteko iz Diska');
writeln(' (W) Pisi datoteko na Disk');
writeln(' (B) Programiraj Eprom, Kontroler');
writeln(' (R) Beri Eprom v Buffer');
writeln(' (D) Prikazi Dump Spomina');
writeln(' (O) Offset za Dump in Prog');
writeln(' (X) Izhod v Sistem');
end;
procedure select;
const x=25;
y=-5;
begin
window(x+25,Y+19,X+40,y+24);
TextColor(Yellow);
TextBackground(red);
clrscr;
writeln('Izberi tip:');
writeln(' (1) 2764');
writeln(' (2) 27128');
writeln(' (3) 27256');
writeln(' (4) 27512');
write( ' (5) 8751H');
repeat
OK := true;
case readkey of
'1' : eprtype:=1;
'2' : eprtype:=2;
'3' : eprtype:=3;
{ '4' : eprtype:=4;}
'5' : eprtype:=5
else OK:=false;
end
until OK;
selected := true;
statline := true;
message:='Eprom ali kontroler je izbran';
end;
Procedure Status;
begin
window(1,1,80,4);
TextColor(Black);
TextBackground(green);
clrscr;
TextBackground(magenta);
Write(' S T A T U S');
clreol;writeln;
TextBackground(green);
write('Tip : ');
case eprtype of
1 : write('Eprom 2764');
2 : write('Eprom 27128');
3 : write('Eprom 27256');
4 : write('Eprom 27512');
5 : write('Kontroler 8751H');
end;
gotoxy(1,3);
Write('Datoteka v spominu : ',filename);
gotoxy(30,2);
write('Zadnji naslov:',Lastaddr:6);
gotoxy(60,2);
write('Offset:',offset:7);
gotoxy(1,4);
write('Sporocilo : ',message);
end;
procedure brisi;
begin
brisiekran;
mainmenu;
if statline then status;
end;
procedure inmenu;
begin
window(5,23,60,23);
TextColor(Black);
TextBackground(green);
clrscr;
end;
procedure clrinmenu;
begin
window(5,23,60,23);
TextColor(Black);
TextBackground(black);
clrscr;
end;
procedure load;
begin
inmenu;
Write('Ime datoteke: ');
Readln(filename);
{$I-}
assign(infile,filename);
reset(infile);
{$I+}
if (Ioresult <> 0) or (filename='') then
begin
message:='Nekaj ni vredu z imenom datoteke. Poskusaj ponovno.';
statline:=true;
exit;
end;
filenameupcase;
addr:=0;
write('Pocakaj malo! Berem z diska.');
while not eof(infile) do
begin
read(infile,data);
buff[addr]:=data;
inc(addr);
end;
lastAddr:=addr-1;
Close(infile);
message:='Datoteka '+filename+' prekopirana v spomin';
statline:=true;
end;
procedure save;
begin
inmenu;
write('Ime datoteke: ');
readln(filename);
{$I-}
assign(infile,filename);
rewrite(infile);
{$I+}
if (Ioresult <> 0) or (filename='') then
begin
message:='Nekaj ni vredu z imenom datoteke. Poskusaj ponovno.';
statline:=true;
exit;
end;
filenameupcase;
Write('Pocakaj malo! Pisem na disk');
for addr := 0 to lastaddr do write(infile,buff[addr]);
close(infile);
Message:='Podatki iz spomina prekopirani v datoteko '+filename;
statline:=true;
end;
procedure verify;
label ven;
var errors:byte;
begin
if not selected then select;
OK:=true;
WindOpen:=false;
errors:=0;
message:='Testiram praznost eproma';
status;
SetStatusABC(Output,Output,Output);
SetStatusDEF(Input,Input,Input);
Port[PC]:=0;
for addr:=0 to eprlen[eprtype] do
begin
Port[PA]:=lo(addr);
case eprtype of
1,2 : Port[PB]:=Hi(addr) OR 64;
3,4 : Port[PB]:=Hi(addr);
end;
If BeriD <> 255 then
begin
if not windopen then
begin
Window(5,6,60,20);
TextColor(black);
TextBackground(yellow);
clrscr;
windopen:=true;
end;
inc(errors);
if errors=50 then goto ven;
Writeln(' Napaka.. addr:',addr:7, ' podatek v epromu:',port[PD]);
OK:=false;
end;
end;
ven:
message:='Eprom je prazen';
if not OK then message:='Poskusaj ponovno zbrisati eprom oz. kontroler';
statline:=true;
end;
procedure beri;
begin
if not selected then select;
SetStatusABC(Output,Output,Output);
SetStatusDEF(Input,Input,Input);
port[PC]:=0;
inmenu;
write('Prosim pocakaj malo ...');
case eprtype of
1,2: begin
for addr := 0 to eprlen[eprtype] do
begin
port[PA]:=LO(addr);
port[PB]:=Hi(addr) or 64;
buff[addr]:=BeriD;
end;
end;
3,4: begin
for addr := 0 to eprlen[eprtype] do
begin
port[PA]:=LO(addr);
port[PB]:=Hi(addr);
buff[addr]:=BeriD;
end;
end;
end;
lastaddr:=addr;
statline:=true;
message:='Podatki iz eproma prekopirani v spomin';
filename:='EPROM';
end;
procedure izhod;
begin
brisiekran;
TextColor(yellow);
TextBackground(blue);
Write('(S)pisal Leon Kos 1989 , Cerknica C.4.maja 11A, tel: (061) 791084');
clreol;
TextColor(white);
TextBackground(black);
writeln;
halt;
end;
procedure dump;
label ven;
const x=-2;
y=2;
begin
Window(5+x,6+y,60+x,20+y);
TextColor(black);
TextBackground(LightGray);
clrscr;
port[PC]:=0;
for addr := offset to lastaddr do
begin
write(buff[addr]:4);
if addr mod 200 = 199 then
begin
inmenu;
write('Pritisni katerokoli tipko ali <ESC>');
if readkey = chr(27) then goto ven
else begin
Window(5+x,6+y,60+x,20+y);
TextBackground(LightGray);
end;
end;
end;
ven:
statline:=true;
message:='Dump eproma je koncan';
end;
procedure ofset;
begin
inmenu;
Write('Vstavi Offset: ');
{$I-}
read(offset);
{$I+}
if (ioresult=0) and (offset<=eprlen[eprtype]) then
message:='Offset nastavljen'
else
begin
message:='Napaka pri nastavljanju offseta!';
offset:=0
end;
statline:=true;
end;
procedure dipstikala;
var n:byte;
begin
window(25,7,55,20);
TextBackground(brown);
TextColor(white);
clrscr;
Writeln(' DIP Stikala');
Writeln;
For n:=1 to 10 do Writeln(' SW ',n:2);
window(31+8,9,31+40,20);
TextBackGround(Magenta);
case eprtype of
1,2,3:begin
Writeln(' OFF ');
Writeln(' ON ');
Writeln(' ON ');
Writeln(' OFF ');
end;
4: begin
Writeln(' ON ');
Writeln(' OFF ');
Writeln(' OFF ');
Writeln(' ON ');
end;
5: begin
Writeln(' ON/OFF ');
Writeln(' ON/OFF ');
Writeln(' ON/OFF ');
Writeln(' ON/OFF ');
end
end;
Writeln(' ON = Vpp ');
Writeln(' ON = A type ');
Writeln(' ON = 5/6Vcc ');
Writeln(' ON = 5Vcc ');
end;
procedure progwindow;
begin
window(36,11,45,13);
TextBackground(cyan);
clrscr;
window(37,12,44,12);
TextColor(black);
TextBackground(red);
clrscr;
end;
procedure check;
label ven;
begin
SetStatusABC(Output,Output,Output);
SetStatusDEF(Input,Input,Input);
message:='Preverjam identicnost eproma z datoteko';
status;
port[PC]:=0;
OK:=true;
for addr := 0+offset to lastaddr+offset do
begin
port[PA]:=LO(addr+offset);
case eprtype of
1,2: port[PB]:=Hi(addr) or 64;
3,4: port[PB]:=Hi(addr);
end;
if buff[addr-offset]<>BeriD then
begin
OK:=False;
goto ven;
end;
end;
ven:
end;
procedure prog128;
label ven;
const prog=242; {VPP on}
var AddrHi:byte;
begin
dipstikala;
inmenu;
write('Pritisni <Y> za nadaljevanje ali <ESC>');
choice:=readkey;
if (choice <> 'y') and (choice<>'Y') then goto ven;
ClrInMenu;
message:='Prosim pocakaj programiram eprom ...';
status;
progwindow;
SetStatusABC(Output,Output,Output);
SetStatusDEF(Output,Input,Input);
Port[PB] :=$FF;
Port[PC] :=prog;
for addr:=offset to lastaddr+offset do
if buff[addr-offset]<>255 then
begin
gotoxy(2,1);
write(addr:6);
Port[PA] :=Lo(addr);
addrHi :=Hi(Addr) OR 64;
Port[PB] :=addrHi;
Port[PD] :=buff[addr-offset];
port[PB] := addrHi AND 191;
delay(45);
port[PB] := addrHi OR 64;
end;
port[PC] := idle;
check;
if not OK then
begin
Message:='Eprom ni uspesno sprogramiran. Poskusaj znova!';
goto ven;
end;
message:='Eprom je uspesno sprogramiran';
ven:
port[PC] := idle;
end;
procedure prog256;
label ven;
const prog=243; {VPP on,CE,OE}
begin
dipstikala;
inmenu;
write('Pritisni <Y> za nadaljevanje ali <ESC>');
choice:=readkey;
if (choice <> 'y') and (choice<>'Y') then goto ven;
ClrInMenu;
message:='Prosim pocakaj programiram eprom ...';
status;
progwindow;
SetStatusABC(Output,Output,Output);
SetStatusDEF(Output,Input,Input);
Port[PB] :=$FF;
Port[PC] :=prog;
for addr:=0+offset to lastaddr+offset do
if buff[addr-offset]<>255 then
begin
gotoxy(2,1);
write(addr:6);
Port[PA] :=Lo(addr);
Port[PB] :=Hi(addr);
Port[PD] :=buff[addr-offset];
port[PC] :=242;
delay(45);
port[PC] :=243;
end;
port[PC] := idle;
check;
if not OK then
begin
Message:='Eprom ni uspesno sprogramiran. Poskusaj znova!';
goto ven;
end;
message:='Eprom je uspesno sprogramiran';
ven:
port[PC] := idle;
end;
procedure prog;
label ven;
begin
if not selected then select;
{ begin
select;
Message:='Nalozi se datoteko v spomin';
goto ven
end;
}
case eprtype of
1,2 : prog128;
3 : prog256
else
begin
message:='Ta tip eproma se ni se sprogramiran';
selected:=false;
goto ven
end;
end;
ven: statline:=true;
end;
PROCEDURE MAIN;
begin {main}
TextMode(CO80);
lastaddr:=0;
offset:=0;
selected:=false;
statline:=false;
message:='';
filename:='';
repeat
ClrInMenu;
mainMenu;
if statline then status;
SetStatusABC(Input,Input,Output);
SetStatusDEF(Input,Input,Input);
WriteC($FF);
repeat
MOK:=true;
Case readkey of
's','S' : Select;
'x','X',Chr(27) : izhod;
'l','L' : load;
'w','W' : save;
'v','V' : verify;
'r','R' : beri;
'd','D' : dump;
'b','B','p','P' : prog;
'o','O' : ofset;
' ' : brisi
else
begin
MOK:=false;
sound(12000);
delay(3);
nosound;
end;
end;
until MOK
until false;
end;
begin
erroraddr:=@main;
main;
end.