|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 20736 (0x5100)
Types: TextFile
Names: »TEPROM2.PAS«
└─⟦dea633962⟧ Bits:30003306 PROMbrænder software til RC703
└─⟦this⟧ »TEPROM2.PAS«
(***********************)
(* program for *)
(* *)
(* EPROM BRÆNDER *)
(* *)
(* version 850329 *)
(* *)
(* release 2. *)
(* *)
(* af SGB & PTG *)
(***********************)
program teprom2;
type
jamaica=array(.0..$fff.) of byte;
hexstr=string(.4.);
var
ing,portkomando,skrald,rommax,programvalg,rom : integer;
filnavn,filnavn1 : string(.12.);
epromtype : string(.4.);
retur : string(.2.);
data,kor,ok:boolean;
romdata: jamaica;
datafil: file;
const
aff=' ';
afs=' ';
afl=' ';
und=' **********************************************';
unds=' -----------------------';
function hex(tal:integer):hexstr;
const
hexcifer:array(.0..15.) of char='0123456789abcdef';
var
h:hexstr;
test,c:integer;
begin
for c:=4 downto 1 do
begin
test:=tal;
test:=tal shr ((c*4)-4);
h(.c.):=hexcifer(.test and $f.);
write(h(.c.));
end;
hex:='';
end; (* slut på funktion hex *)
procedure ident;
var
a,man,dev:integer;
r:string(.1.);
begin
writeln(@12,afs,'IDENT CHECK');
writeln(afs,'===========',@10,@10,@10,@13);
if rom<>0 then
begin
port(.$20.):=portkomando or $21; (* read code + pow on *)
for a:=0 to 1 do
begin
port(.$22.):=a;
port(.$23.):=$00; (* high add + read com *)
if a=0 then man:=port(.$20.) else dev:=port(.$20.);
end;
port(.$20.):=portkomando; (* pow off *)
writeln(afs,'Manufacturer code (hex): ',hex(man),@10,@13,afs,
'Device code (hex): ',hex(dev));
end
else
writeln(afs,@27,@130,'fejl !! ',@27,@128,'Familieparameter ikke valgt !! ');
write(@10,@10,@13,afs,'Tast <retur>');
readln(r);
end; (* slut på procedure ident *)
procedure familie(var nr: integer);
var slut,ok: boolean;
const
rom16=$00;rom32=$02;rom32a=$0a;rom64=$0c;rom64a=$84;
rom128=$0e;rom128a=$86;rom256=$80;
begin
slut:=false;
repeat
write(@12,@10,afs,'F A M I L I E T Y P E ',@13,@10,unds,@10,@10,@10,@13);
writeln(aff,'1. EPROM-2716 vpp=25v vcc=5v st.p.50 msek');
writeln(aff,'2. EPROM-2732 vpp=25v vcc=5v st.p.50 msek');
writeln(aff,'3. EPROM-2732A vpp=21v vcc=5v st.p.50 msek');
writeln(aff,'4. EPROM-p2732A vpp=21v vcc=5v st.p.20 msek');
writeln(aff,'5. EPROM-2764 vpp=21v vcc=6v int.p1.(4 msek max 12 gange)');
writeln(aff,'6. EPROM-2764A vpp=12v vcc=6v int.p2.(3 msek max 24 gange)');
writeln(aff,'7. EPROM-p2764A vpp=12v vcc=6v int.p2.(3 msek max 24 gange)');
writeln(aff,'8. EPROM-27c64 vpp=12v vcc=6v int.p2.(3 msek max 24 gange)');
writeln(aff,'9. EPROM-27128 vpp=21v vcc=6v int.p1.(4 msek max 12 gange)');
writeln(aff,'10. EPROM-27128A vpp=12v vcc=6v int.p2.(3 msek max 24 gange)');
writeln(aff,'11. EPROM-p27128A vpp=12v vcc=6v int.p2.(3 msek max 24 gange)');
writeln(aff,'12. EPROM-27256 vpp=12v vcc=6v int.p2.(3 msek max 24 gange)');
case nr of
0: begin
gotoxy(8,17);
write(@27,@130,'->> INGEN FAMILIETYPE VALGT ',@27,@128);
end;
1: gotoxy(8,5);
2: gotoxy(8,6);
3: gotoxy(8,7);
4: gotoxy(8,8);
5: gotoxy(8,9);
6: gotoxy(8,10);
7: gotoxy(8,11);
8: gotoxy(8,12);
9: gotoxy(8,13);
10: gotoxy(8,14);
11: gotoxy(8,15);
12: gotoxy(8,16);
end;
if nr<>0 then write(@27,@130,'->>',@27,@128);
repeat
gotoxy(24,19);
write('valg: ');
read(retur);
if retur='' then slut:=true
else
val(retur,nr,skrald);
until (retur='') or (nr>=1) and (nr<=12);
case nr of
1: begin
epromtype:='.16';
rommax:=$07ff;
portkomando:=rom16;
end;
2: begin
epromtype:='.32';
rommax:=$0fff;
portkomando:=rom32;
end;
3: begin
epromtype:='.32';
rommax:=$0fff;
portkomando:=rom32a;
end;
4: begin
epromtype:='.32';
rommax:=$0fff;
portkomando:=rom32a;
end;
5: begin
epromtype:='.64';
rommax:=$1fff;
portkomando:=rom64;
end;
6: begin
epromtype:='.64';
rommax:=$1fff;
portkomando:=rom64a;
end;
7: begin
epromtype:='.64';
rommax:=$1fff;
portkomando:=rom64a;
end;
8: begin
epromtype:='.64';
rommax:=$1fff;
portkomando:=rom64a;
end;
9: begin
epromtype:='.128';
rommax:=$3fff;
portkomando:=rom128;
end;
10: begin
epromtype:='.128';
rommax:=$3fff;
portkomando:=rom128a;
end;
11:begin
epromtype:='.128';
rommax:=$3fff;
portkomando:=rom128a;
end;
12:begin
epromtype:='.256';
rommax:=$7fff;
portkomando:=rom256;
end;
end;
port(.$20.):=portkomando;
until slut;
end; (* slut på procedure familie *)
procedure verify;
label outt;
var
t,x,j,maxadd1,i,most,sum,rsum : integer;
vfejl : boolean;
svar: string(.3.);
begin
most:=rommax shr 12;
maxadd1:=rommax and $fff;
port(.$20.):=portkomando or $01; (* pow on comando *)
reset(datafil);
writeln(@13,@10,@10,afs,'verify startet');
vfejl:=false;
sum:=0;
rsum:=0;
for i:=0 to most do
begin
j:=i shl 4 + $00; (* mest betydende bit + read comando *)
blockread(datafil,romdata,32);
for x:=0 to maxadd1 do
begin
port(.$22.):=x and $00ff; (* init af loweradd *)
port(.$23.):=(x and $ff00) shr 8 +j; (* init af highadd + readcom *)
t:= port(.$20.);
if romdata(.x.) <> t then
begin
vfejl:=true;
ing:=(x+(i shl 12));
writeln(@13,@10,afs,'fejl i adresse (hex): ',hex(ing));
ing:= romdata(.x.);
writeln(afs,'forventet data (hex): ',hex(ing));
writeln(afs,'læst data (hex): ',hex(t),@10);
repeat
gotoxy(0,24);clreol;
write(@7,afs,'ønskes fortsat ckeck ja/nej ');
read(svar);
until (svar='ja') or (svar='nej');
if svar='nej' then goto outt;
end;
sum:=sum + romdata(.x.);
rsum:=rsum + port(.$20.);
end;
end;
if not vfejl then
begin
writeln(@13,@10,afs,'verify ok ' );
writeln(afs,'forventet sumcheck (hex): ',hex(sum));
writeln(afs,'eprom sumcheck (hex): ',hex(rsum));
end;
outt:
port(.$20.):= portkomando; (* pow off *)
end; (* slut på procedure verify *)
procedure eracheck(var eok : boolean);
var
x,j: integer;
begin
eok:=true;
port(.$20.):=portkomando or $01; (* pow on *)
x:=0;
repeat
port(.$22.):= x and $00ff;
port(.$23.):= (x and $ff00) shr 8 + $00;
if port(.$20.) <> $00ff then
begin
writeln(@10,afs,'ikke slettet ');
eok:=false;
end;
x:=x+1;
until (x=rommax) or (not eok);
if eok then
writeln(@10,afs,'eprom ok. Er slettet ');
port(.$20.):=portkomando; (* pow off *)
end; (* slut på procedure erackeck *)
procedure epromread(var maxadd : integer);
var j, maxadd1,i,most,x,y,sum:integer;
begin
writeln(@12,@13,@10,afs,'LÆSNING AF EPROM.');
writeln(afs,'-----------------',@10,@13,@10);
rewrite(datafil);
most:=maxadd shr 12;
maxadd1:=maxadd and $fff;
writeln(afs,'læsning startet: ',@10,@10,@13);
sum:=0;
port(.$20.):=portkomando or $01; (* pow on komando *)
for i:=0 to most do
begin
j:=i shl 4 +$00; (* init af high add + read com *)
for x:=0 to maxadd1 do
begin
port(.$22.):=x and $00ff; (* init af loweradd *)
port(.$23.):=(x and $ff00) shr 8 + j; (* init af highadd + readcom *)
romdata(.x.):=port(.$20.); (* input af data til array *)
sum:=(sum + romdata(.x.));
end;
blockwrite(datafil,romdata,32);
end;
port(.$20.):=portkomando and $fffe; (* pow off komando *)
write(@7,@13,@10,@10,afs,'decimalsum: ',sum,' hexsum: ', hex(sum),
@10,@13,@10,@10,afs,'tast <return> ');
data:=true;
read(retur);
end; (* slut på procedure readeprom *)
procedure epromwrite;
label fejl,fejl1;
type teller = array(.0..24.) of integer;
var
pulsteller: teller;
pulsl,maxpuls,pjat1,a,b,pulser,r,sumw,maxadd1,most,i,j,pow,x: integer;
ffejl,check : boolean;
svar : string(.3.);
begin
for i := 0 to 24 do pulsteller(.i.) := 0;
a:=0;b:=0;maxpuls:=0;
check:=true;sumw:=0;ok:=true;
pow:=port(.$23.) and $0002; (* check af brændspænding *)
if( rom<>0) and ( data) and (pow<>0) then
begin
eracheck(check);
if not check then
begin
repeat
write(afs,'ønskes brænding alligevel ? ja/nej : ');
readln(svar);
until (svar='ja') or (svar='nej');
if svar='nej' then check:=false else check:=true;
ffejl:=false;
end;
if check then
begin
seek(datafil,0);
if rom>=5 then
begin
port(.$20.):=portkomando or $21; (* read code +pow on *)
for skrald:= 0 to 1 do
begin
port(.$22.):=skrald;
port(.$23.):=$00; (* high add + read com *)
if skrald=0 then a:=port(.$20.) else b:=port(.$20.);
end;
if a<> $89 then
begin
ffejl:=false;
writeln(afs,'Manufacturer code ukendt !!');
end
else
begin
ffejl:=false;
write(afs,'Manufacturer code: hex:',hex(a));
writeln(' Device code: hex:',hex(b));
if b in(.$2,$83.) then (* intelligent 1. *)
begin
if (b=$2) and (portkomando<>$0c) then
begin ffejl:=true;goto fejl1;end;
if (b=$83) and (portkomando<>$0e) then
begin ffejl:=true;goto fejl1; end;
writeln(afs,'brændetype intelligent 1. ');
maxpuls:=12;
pulsl:=8;
end;
if b in (.$8,$7,$89,$4.) then (* intelligent 2. *)
begin
if (b in(.$8,$7.)) and (portkomando<>$84) then
begin ffejl:=true; goto fejl1; end;
if (b=$89) and (portkomando<>$86) then
begin ffejl:=true; goto fejl1;end;
if (b=$4) and (portkomando<>$80) then
begin ffejl:=true;goto fejl1;end;
writeln(afs,'brændetype intelligent 2. ');
maxpuls:=24;
pulsl:=6;
end;
end;
if maxpuls=0 then
begin
repeat
write(afs,'Ønskes EPROM brænding ja/nej ? : ');
readln(svar);
until (svar='ja') or (svar='nej');
if svar='ja' then
begin
if rom in(.5,9.) then
begin
maxpuls:=12;
pulsl:=8;
end
else
begin
maxpuls:=24;
pulsl:=6;
end;
end
else
ok:=false;
end;
if maxpuls<>0 then
begin
writeln(afs,'fastprogramering startet.');
most:= rommax shr 12;
maxadd1:= rommax and $fff;
port(.$20.):=portkomando or $11; (* vcc6v + pow on *)
port(.$20.):=portkomando or $51; (* vpp + vcc6v + pow on *)
for i:=0 to most do
begin
blockread(datafil,romdata,32);
j:=i shl 4 + $80; (* mest betydende bit + program comando *)
r:=i shl 4 + $00; (* mest betydende bit + read comando *)
for x:=0 to maxadd1 do
begin
port(.$24.):= $ef; (* brændetid sættes til 1msek. *)
pulser:=0;
pjat1 := romdata(.x.);
port(.$21.) := pjat1; (* data til eprom *)
repeat
port(.$22.):=x and $00ff; (* low add *)
port(.$23.):=(x and $ff00) shr 8 +j; (* high add + progcom *)
pulser:=pulser+1;
while (port(.$23.) and $01)<>1 do; (* wait ready *)
port(.$23.):=(x and $ff00) shr 8 + r; (* high add + readcom*)
skrald := port(.$20.);
until (pjat1 = skrald) or (pulser=maxpuls);
port(.$24.):=241-(pulser*pulsl); (* brændetid=pulsl*pulser msek *)
port(.$23.):=(x and $ff00) shr 8 + j; (* high add + progcom *)
pulsteller(.pulser.) := pulsteller(.pulser.) + 1;
while (port(.$23.) and $01<>1) do; (* wait ready *)
if pulser=maxpuls then
begin
port(.$23.):=(x and $ff00) shr 8 + r; (* high add + readcom *)
if port(.$20.)<>pjat1 then
begin
ok:=false;
ing:=x+(i shl 12);
writeln(afs,'defekt adresse (hex): ',hex(ing));
writeln(afs,'forventet data (hex): ',hex(pjat1));
ing:=port(.$20.);
writeln(afs,'læst data (hex): ',hex(ing));
port(.20.) := portkomando or $19;
goto fejl;
end;
end;
end;
end;
end;
port(.$20.):=portkomando or $19;
end;
if (rom<=4) then
begin
ffejl:=false;
writeln(afs,'Standardprogramering startet.');
if rom <> 4 then port(.$24.):=$8d else (* brændetid:= 50 msek. *)
port(.$24.):=$c9; (* brændetid:=20 msek *)
most:=rommax shr 12;
maxadd1:=rommax and $fff;
case rom of
1,2 : port(.$20.):= portkomando or $01; (*pow on *)
3,4,5 : port(.$20.):=portkomando or $09; (* type A + pow on *)
end;
for i:=0 to most do
begin
blockread(datafil,romdata,32);
j:=i shl 4 + $80;
for x:=0 to maxadd1 do
begin
port(.$21.):=romdata(.x.); (* data til eprom *)
port(.$22.):=x and $00ff; (* loweradd *)
port(.$23.):=(x and $ff00) shr 8 + j; (* higher add + progcom *)
while (port(.$23.) and $01)<>1 do;
port(.$23.):=(x and $ff00) shr 8 +i shl 4 +$00; (* high + readcom *)
if port(.$20.)<>romdata(.x.) then
begin
ing:=(i shl 12)+x;
writeln(afs,'fejl i adresse hex:',hex(ing));
ok:=false;
goto fejl;
end
else
sumw:=sumw+romdata(.x.);
end;
end;
end;
end;
end
else
begin
check:=false;
write(@13,@10,@10);
if rom=0 then
writeln(afs,@27,@130,'fejl !!!',@27,@128,' Familie parameter mangler.');
if not data then
writeln(afs,@27,@130,'fejl !!!',@27,@128,
' Epromdata mangler.');
if pow=0 then
writeln(afs,@27,@130,'fejl !!!',@27,@128,' Brændspænding mangler.');
end;
fejl:
if (rom>=5) and (check) and ok then
begin
if maxpuls=24 then b:=2 else b:=1;
writeln(@13,@10,afs,'Brændetids fordeling');
for x:=1 to b do
begin
for i := 1 to 12 do
write((i+(x-1)*12)*(5-b):6);
write(@13,@10,' ');
for i:=1 to 12 do
write('msek':6);
write(@13,@10, @32);
for j := 1 to 12 do write(pulsteller(.(j +(x-1)*12).):6);
writeln(@10);
end;
end;
writeln;
if ok and check then verify;
port(.$20.):=portkomando; (* pow off *)
fejl1:
if ffejl then
writeln(afs,'Forkert familieparameter valg ');
write(@7,@7,@13,@10,afs,'tryk < return > ');
readln(retur);
end; (* slut på procedure epromwrite *)
overlay PROCEDURE GEMROM;
VAR
tyt,a : integer;
roms : string(.3.);
filnavn: string(.14.);
disc : string(.1.);
text,text1: string(.14.);
testfil :file;
begin
writeln(@12,@10,afs,'GEM ROM(XXX) PÅ DISKETTE');
writeln(afs,'========================');
gotoxy(16,5);
if data then
begin
writeln('tastes < / > før filnavn, slettes standart navn < ro >.');
write(@13,@10,afs,'indtast filnavn: ro');
readln(text);
if rom=1 then tyt:=length(datafil) div 2 else tyt:=length(datafil);
str(tyt,roms);
a:=pos('/',text);
if a<>0 then
begin
text1:=copy(text,(a+1),(14-(a+1)));
filnavn:=concat(text1,'.',roms);
end
else
filnavn:=concat('ro',text,'.',roms);
write(afs,'På hvilken disc skal filen gemmes A/B : ');
readln(disc);
if ( disc='a') or (disc='b') then
begin
writeln(afs,'filnavn- ',filnavn);
filnavn:=concat(disc,':',filnavn);
assign(testfil,filnavn);
(*$i-*) reset(testfil) (*$i+*);
if iores= 0 then
begin
if a=0 then
writeln(afs,'fil - < ro',text,' > findes')
else
writeln(afs,'fil - < ',text1,' > findes');
end
else
begin
seek(datafil,0);
rewrite(testfil);
while not eof(datafil) do
begin
blockread(datafil,romdata,32);
blockwrite(testfil,romdata,32);
end;
end;
close(testfil);
end;
end
else
writeln(@13,@10,afs,'Der er ingen data at gemmme ');
write(@13,@10,@10,afs,'tast <return> ');
read(retur);
end; (* slut på procedure gemrom *)
overlay procedure hentrom;
var
filnavn : string(.14.);
disc : string(.1.);
testfil : file;
begin
writeln(@12,@10,afs,'HENT ROMXXX.XXX FRA DISKETTE.');
writeln(afs,'=============================');
repeat
gotoxy(16,5);
write(@13,@10,afs,'Fra hvilken disc skal filen hentes ? (a/b) : ');
readln(disc);
until (disc='a') or (disc='b');
write(afs,'Indtast filnavn : ');
readln(filnavn);
filnavn:=concat(disc,':',filnavn);
assign(testfil,filnavn);
(*$i-*) reset(testfil) (*$i+*);
if iores=0 then
begin
reset(datafil);
while not eof(testfil) do
begin
blockread(testfil,romdata,32);
blockwrite(datafil,romdata,32);
end;
writeln(@13,@10,@10,afs,'fil- ',filnavn,' er hentet ');
if (pos(epromtype,filnavn)=0) then writeln(afs,'Familietype skal ændres');
data:=true;
end
else
writeln(@13,@10,@10,afs,'fil- ',filnavn,' findes ikke ');
write(@13,@10,@10,afs,'tast <retur> ');
read(retur);
end; (* slut på procedure hentrom *)
(**********************************************************)
(* PROGRAMSTART *)
begin
for skrald:=$00 to $0fff do
romdata(.skrald.):=$ff;
rom:=0;data:=false;
filnavn:='romxxx.rom';
assign(datafil,filnavn);
port(.$24.):=$8d; (* init af clock til 50 msek. *)
repeat
writeln(@12);
gotoxy(23,4);
writeln('release 2.');
gotoxy(0,0);
write(@10,afl,' M E N U F O R E P R O M P R O G R A M : ',@10,@13,
und,@10,@10,@13);
writeln(@10,@10,afs,'1. FAMILIE PARAMETER.',@10,@13,afs,'2. LÆSNING AF EPROM.');
writeln(afs,'3. PROGRAMMERING AF EPROM.',@10,@13,afs,'4. VERIFY AF EPROM.');
writeln(afs,'5. HENT ROM(xxx) FRA DISKETTE.'@10,@13,afs,
'6. GEM ROM(xxx) PÅ DISKETTE',@13,@10,afs,'7. ERASE CHECK.');
writeln(afs,'8. IDENTIFIER CHECK.',@13,@10,afs,
'9. TILBAGE TIL CP/M',@10,@10,@13);
programvalg:=0;
repeat
gotoxy(1,15);
write(@13,afs,'programvalg: ');
readln(retur);
val(retur,programvalg,skrald)
until (programvalg>=1) and (programvalg<=9);
case programvalg of
1:familie(rom);
2:begin
if rom<>0 then epromread(rommax)
else
begin
write(@13,@10,@10,afl,'familie parameter er ikke valgt ! tast < return >');
read(retur);
end;
end;
3: begin
writeln(@12,@13,@10,@10,afs,'PROGRAMERING AF EPROM');
writeln(afs,'---------------------');
epromwrite;
end;
4:begin
writeln(@12,@13,@10,afs,' VERIFY PROGRAM ');
writeln(afs,'---------------');
if (rom<>0) and (data) then
verify
else
begin
if rom=0 then
writeln(@13,@10,@10,afs,@27,@130,'fejl !! ',
@27,@128,'Familieparameter mangler');
if not data then
writeln(@13,@10,@10,afs,@27,@130,'fejl !! ',
@27,@128,'Epromdata mangler.');
end;
write(@13,@10,@10,@7,afs,'tast <retur> ');
read(retur);
end;
5: hentrom;
6: gemrom;
7: begin
writeln(@12,@13,@10,afs,'ERASE CHECK');
writeln(afs,'-----------',@13,@10,@10,@10,@10);
if rom<>0 then
eracheck(ok)
else
writeln(afs,'familieparameter mangler');
write(@13,@10,@10,afs,'tast <retur> ');
readln(retur);
end;
8: ident;
9: begin
writeln(@12);
gotoxy(16,12);
writeln('E P R O M P R O G R A M L U K K E T : ',@10,@10,@10);
end;
end;
until programvalg=9;
close(datafil);
end.
«eof»