No changes between revisions
/Modules/PICPGR3/PICPGR301A/SW/4_02/!____!.TXT
0,0 → 1,66
Programator pro PIC 16C84
- dodelan hex format
- dodelany prepinace ( XT, LP, ...., CP )
- dodelana moznost spousteni programu v programatoru
 
verze 1_3:
- predelana procedura Delay tak, aby to chodilo i na rychlych PC
 
verze 1_31:
- dodelana konverze formatu souboru zejmena za ucelem snadne konverze
formatu HEX na format TEXT
 
verze 1_32
- zmenena knihovna DELAY za novou verzi ( podpora procesoru PentiumII
nad 250MHz )
 
verze 2.00
- dopnena moznost programovani EPROM ( a OTP ) verze procesoru PIC
- zmena v chovani prepinacu ( nejsou li nikde ani v datech ani jako
prepinace tak se config slovo neprogramuje
- pro EPROM programovani se musi config slovo zadat jen v datech
 
verze 3.00
- odvozena z verze 2.01
- zcela predelana vrstva propojeni s HW programatoru ( objektove, s vyhledem
na popdoru vice programovacich HW )
- od verze 3.00 existuji 2 vyvojove podverze
VAR_MIHO - s prazdnou podporou vice hardwaru
VAR_PEFI - s doplnenou podporou programataru ALL03
 
verze 3.01
- jen znovu prelozena verze 3.00 v plne verzi s podporou jak puvodniho
maleho programatoru tak i programatoru ALL03
- v teto verzi patrne nefunguji prikazy RUN, RESET a STOP
 
verze 3.10
- rozsahle opravy ( export a import dat, oprava prikazu RUN, STOP, RESET )
 
verze 3.11
- zavedeny konstanty do programu ( vyhled na procesory s vice ne 1K pameti )
 
Udelat: - zlepsit helpy - popis formatu
- exit chybove kody ( program, verify a erase )
- pipnout pri chybe
- zautomatizovat rozpoznani formatu souboru pri importu
- v textovem formatu zavest nedefinovane hodnoty ( nejlepe ?? )
- v textovem formatu definovat komentare
- v textovem exportu uvadet v komentari vyznam configuracniho slova
- v HEX exportu exportovat jen platna data ( to bude obtizne,
mozna bude nejsnazsi predelat datove buffery do objektu )
 
verze 4.01
- velmi rozsahle zmeny ve strukture programu
- podpora mnoha druhu procesoru ( databaze ) - povinny parametr
- error level
- zmeny v programovacich algoritmech ( zmena casu )
 
verze 4.02
- primo vychazi z verze 4.01
- doplnena podpora procesoru s algoritmem EPROM1 (stare procesory jako
je PIC12C508 a podobne)
 
Udelat: - podpora algoritmu EPROM3
- zpracovani prepinacu pro Cfg slovo jinych nez PIC16F
- export jen platnych dat ( HEX i TXT )

/Modules/PICPGR3/PICPGR301A/SW/4_02/DELAY.PAS
0,0 → 1,140
unit Delay;
 
{-----------------------------------------------------------------}
{ Definovane spozdeni, ktere funguje i na }
{ vykonnejsich pocitacich }
{ }
{ Verze 1.0 portovano by miho 96 }
{ 1.1 popora kratkych casu miho 98 }
{ 1.2 podpora rychlych CPU ( rozsireni DelayCnt1 na DWORD ) }
{-----------------------------------------------------------------}
 
{$I-,S-}
 
interface
 
 
procedure xDelay(MS: Word);
{-- cas uveden v milisekundach --}
 
 
procedure xDelayMicro(MicroS: Word);
{-- cas uveden v mikrosekundach --}
{ POZOR: Casy jsou vzdy o neco delsi a za normalnich podminek }
{ je cas delsi radove o nekolik mikrosekund }
{ ( na PC Pentium 75 to dela cca 6us ). }
 
 
implementation
 
 
var DelayCnt1:longint; { kalibrace casu po 1 ms }
DelayCnt55:longint; { totez pred vydelenim 55 }
 
 
procedure DelayLoop;
begin
asm
@@Loop: SUB AX,1 { DX:AX - pocitadlo DWORD }
SBB DX,0 { dekrement }
JC @@End { doteklo }
CMP BL,ES:[DI] { pri uplynuti tiku ( 55ms ) }
JE @@Loop { taky koncim }
@@End:
end;
end;
 
 
procedure Initialize;
{-- inicializace - kalibrace casu --}
begin
asm
MOV AX,40H { adresa bunky BIOS DATA s tiky }
MOV ES,AX { po 55 ms aktualizuje BIOS }
MOV DI,6CH
MOV BL,ES:[DI]
@@Wait: CMP BL,ES:[DI]
JE @@Wait { pockej na cely tik }
MOV BL,ES:[DI] { schovej si tik do BL }
MOV AX,-28 { piskvorcova konstanta ? asi }
CWD
CALL DelayLoop { pockej na konec tiku BL }
NOT AX { a pocitej cas v DS:AX}
NOT DX
MOV word ptr [DelayCnt55],AX { uschovej kalibraci }
MOV word ptr [DelayCnt55+2],DX
end; {asm}
DelayCnt1:=DelayCnt55 div 55; { uschovej kalibraci 1 ms }
end; {Initialize}
 
 
procedure xDelay(MS: Word);
{-- proved standardni spozdeni merene v milisekundach --}
begin
asm
MOV CX,MS { pocet milisekund }
JCXZ @@End { nulova hodnota - hned konci }
MOV AX,40H { adresa BIOS COM port - to je }
MOV ES,AX { jakakoli bunka, ktera se v }
XOR DI,DI { v provozu nemeni aby se netestoval }
MOV BL,ES:[DI] { casovac a presto mohla byt }
@@Loop: MOV AX,word ptr [DelayCnt1] { procedura DelayLoop stejna }
MOV DX,word ptr [DelayCnt1+2] { DX:AX kalibracni konsatnta }
CALL DelayLoop { pro spozdeni 1 ms }
LOOP @@Loop
@@End:
end; {asm}
end; {xDelay}
 
 
procedure xDelayMicro(MicroS: Word);
{-- procedura pro spozdeni zadavane v mikrosekundach --}
label Error;
begin {-- prepocitej zadany cas na pocet cyklu --}
asm
{-- DWORD * WORD / WORD -> DWORD --}
SUB DX,DX
MOV AX,WORD PTR[DelayCnt55+2]
MOV BX,55000
MOV CX,MicroS
DIV BX
PUSH DX
MUL CX
MOV DI,DX
AND DX,DX
POP DX
JNZ Error
MOV AX,WORD PTR[DelayCnt55]
DIV BX
PUSH DX
MUL CX
MOV SI,AX
ADD DI,DX
POP AX
JC Error
MUL CX
DIV BX
ADD SI,AX
ADC DI,0
PUSH SI
PUSH DI
{-- vlastni spozdeni --}
MOV AX,40H { opet konstantni bunka }
MOV ES,AX
XOR DI,DI
MOV BL,ES:[DI]
POP DX { DX:AX cas v poctech cyklu }
POP AX
CALL DelayLoop
end; {asm}
exit;
asm
Error: MOV AX,0FFFFH
MOV DX,AX
CALL DelayLoop
end; {asm}
end;
 
 
begin Initialize; { udelej kalibraci }
end.
/Modules/PICPGR3/PICPGR301A/SW/4_02/PICPGR.EXE
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Modules/PICPGR3/PICPGR301A/SW/4_02/PICPGR.PAS
0,0 → 1,931
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
 
program PicPgr(Input,Output);
 
{=============================================================}
{== Program pro programovani ruznych PICu ( FLASH i EPROM ) ==}
{=============================================================}
 
uses DELAY, { casova spozdeni }
PP_PGMHW, { ovladani hardwaru programatoru }
PP_COMON, { pomocne funkce }
PP_DEFS, { defince procesorove zavislych parametru }
PP_DATA, { ulozeni dat v pameti }
PP_IO; { import a export dat z/do souboru }
 
const ver : string[4] = '4.02'; { vzdy 4 znaky }
date : string[4] = '2001'; { vzdy 4 znaky }
 
{=============================================================}
{ Zmeny: }
{ 2.01 - vychozi verze pro tuto verzi }
{ 3.00 - predelana kompletne vrstva pro ovladani HW ( moznost }
{ popdory vice programatoru ) }
{ 3.01 - finalni verze s podporou programovani pres LPT port }
{ a na programatoru ALL03 }
{ 3.10 - pridana informace o zdoji dat pri vystupu v TXT }
{ formatu }
{ - cislovani radek pri vypisu chyby ve vstupnich datech }
{ - odstranena chyba exportu dat v HEX formatu }
{ - dodelana kontrola kontrolniho souctu HEX formatu }
{ - znovu zprovozneny prikazy RUN, STOP, RESET }
{ - zmena default obsahu pri konverzi z 0 na 3FFF }
{ 3.11 - cisla ve zdrojaku nahrazeny konstantami }
{ 4.00 - velmi rozsahle zmeny ve strukture }
{ - prepinani parametru podle typu soucastky }
{ - zmena Vpp z 12.0V na 13.0V }
{ - doplneno zpozdeni po zapnuti napajeni }
{ - zmena programovacich casu u C/F84 (20ms na 10ms) }
{ - podpora ErrorLevel pri programovani a verifikaci }
{ 4.01 - prvni realese verze z rady 4.x }
{ 4.02 -doplnena podpora algoritmu EEPROM1 PEFI }
{ Chybi: }
{ - podpora algoritmu EPROM3 }
{ - zpracovani prepinacu pro Cfg slovo jinych nez PIC16F }
{ - export jen platnych dat ( HEX i TXT ) }
{=============================================================}
 
 
{====== Rizeni programatoru - propojeni s HW ======}
 
const P:PGM_p = nil; { Inicializovana promenna }
 
procedure InitHW(Port:word);
{== Procedura inicializuje propojeni s HW ==}
begin if port<4 then P:=new(PGM_LPT_p,Init(Port))
else P:=new(PGM_ALL_P,Init(Port));
if P=nil then Error('Unable Init HW',0);
end; {InitHW}
 
const StartPICStat:boolean=false; { true po dobu programovani }
{ Tuto promennou nastavuje procedura StartPIC a vypina procedura }
{ StopPIC. Je tedy aktivni zejmena po dobu programovani a slouzi }
{ pro zajisteni vypnuti programovaciho napeti v pripade }
{ ze program skonci predcasne. }
 
procedure StartPIC(Voltage:real);
{== Zapnuti PIC pro programovani, cteni, verifikaci ==}
{ Voltage udava pracovni napajeci napeti }
begin StartPICStat:=true; { true znamena programovani }
{-- nastav definovany stav signalu --}
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(Voltage); { zapni napajeni }
P^.SetData(zero); { otevri budice }
P^.SetClock(zero);
xDelay(50); { ustaleni napeti }
P^.SetReset(one); { ukonci reset }
P^.SetVpp(13.0); { zapni Vpp }
 
xDelay(50); { ustaleni napeti }
end; {StartPIC}
 
procedure EndPIC;
{== Vypnuti PIC po programovani ==}
begin P^.SetData(tristate); { odpoj vystupy }
P^.SetClock(tristate);
P^.SetVpp(0); { odpoj Vpp }
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(0); { vypni Vcc }
xDelay(50); { pockej }
P^.SetReset(one); { a odpoj i reset ( pokud je napajeni zvenku ) }
{ tak se to rozbehne }
StartPICStat:=false; { false znamena konec programovani }
end; {EndPIC}
 
{====== Posilani prikazu a dat do a z procesoru ======}
 
procedure OutCommandPIC(Command:word);
{== Zapise prikaz ( bez dat ) do PIC ==}
var i:integer;
begin for i:=1 to 6 do
begin if (Command and 1)=1 then P^.SetData(one)
else P^.SetData(zero);
P^.SetClock(one);
P^.SetClock(zero);
Command:=Command shr 1;
end;
P^.SetData(tristate); { odpoj datovy vystup }
end; {OutCommandPIC}
 
procedure OutputDataPIC(Bits:word; Command:word; Data:word);
{== Zapise prikaz a data do PIC ==}
{ Prenasi se bud 14 ( obvody 12 nebo 14 bitu core ) nebo 16 ( soucastky }
{ s paritou pameti programu ) bitu }
var i:integer;
begin OutCommandPIC(Command);
P^.SetData(zero); { start bit 0 }
P^.SetClock(one);
P^.SetClock(zero);
for i:=1 to Bits do
begin if (Data and 1)=1 then P^.SetData(one) { data bit }
else P^.SetData(zero);
P^.SetClock(one);
P^.SetClock(zero);
Data:=Data shr 1;
end;
P^.SetData(zero); { stop bit 0 }
P^.SetClock(one);
P^.SetClock(zero);
end; {OutputDataPIC}
 
function InputDataPIC(Bits:word; Command:word):word;
{== Posli prikaz a vrat odpoved z PIC ==}
{ Precte zadany pocet bitu dat. Tento pocet nemusi }
{ nutne souhlasit s poctem platnych bitu dat }
{ ( napriklad u souvasti s delkou slova 12 bitu ). }
var Data:word;
i:integer;
b:word;
begin OutCommandPIC(Command); { zanecha DATA jako vstup }
Data:=0;
b:=1; { bitova maska }
P^.SetClock(one); { start bit }
P^.SetClock(zero);
for i:=1 to Bits do
begin P^.SetClock(one);
P^.SetClock(zero);
if P^.GetData then Data:=Data or b; { byla datova 1 }
b:=b shl 1; { posun masku }
end;
P^.SetClock(one); { stop bit }
P^.SetClock(zero);
InputDataPIC:=Data;
end; {InputDataPIC}
 
{====== Programovaci prikazy pro PIC ======}
 
const LoadConfiguration = $00;
LoadDataPM = $02;
ReadDataPM = $04;
IncrementAddress = $06;
BeginProgramming = $08;
BeginProgrammingOnlyCycle = $18; { _EE2_ - alternativa k BeginProgramming }
LoadDataDM = $03;
ReadDataDM = $05;
BulkErasePM = $09;
BulkEraseDM = $0B;
EndProgramming = $0E; { _EPROMx_ - jen pro EPROM verze }
Dis1 = $01; { _EEx_ - jen pro odstraneni code }
Dis2 = $07; { protection }
 
{====== Zpracovani parametru ======}
 
const Port : integer = -1; { Cislo portu pro komunikaci }
FileFormat: IO_t = _NIL_; { Format datoveho souboru }
CfgString : string = ''; { Sem si zapamatuji Cfg retezec }
{ Nenastaveny ( nepouzity ) prepinac je -1 }
 
{====== Zpracovani prepinacu ======}
 
function TestSwitch(var s:string; sw:string):boolean;
{== Pokud je sw soucasti retezce s vraci true a odstrani sw z retezce s ==}
var i:integer;
begin TestSwitch:=false;
{-- test --}
i:=pos(sw+' ',s+' ');
if i=0 then exit; { nenalezen }
{-- nalezen --}
s:=copy(s,1,i-1)+copy(s,i+length(sw)+1,255);
TestSwitch:=true;
end; {TestSwitch}
 
{====== Zpracovani Cfg parametru ======}
 
procedure CfgSwitches( var s:string; Ostre:boolean;
var Cfg:word; var CfgStat:boolean
);
{== Zpracuje prepinace konfiguracniho slova, pokud je predano true ==}
{ tak upravi hodnotu predaneho parametru. Uzere z retezce s }
{ prepinace, ktere zpracovala }
{ }
{ s retezec s parametry, zpracovane casti se uzerou }
{ Ostre true znamena, ze se maji data aktualizovat }
{ Cfg config data }
{ CfgStat priznak platnosti dat v poli Cfg }
{ }
begin {-- dle typu procesoru preda konkretni procedure --}
 
end; {CfgSwitches}
 
procedure DisplayConfigWord(Cfg:word; Cfg_Stat:boolean);
begin if Cfg_Stat
then begin write('Config Word: ');
HexWord(output,Cfg);
writeln;
end
else begin writeln('Config Word: none');
end;
end; {DisplayConfigWord}
 
procedure Switches(s:string; var Data:PicData_t);
{== Zpracovani prepinacu, volba typu soucastky, init datoveho objektu ==}
var ix:integer; { index do tabulky CfgDefAll}
Proc:ProcInfo_t; { informace o vybrane procesoru }
begin s:=UpStr(s);
{-- adresa portu --}
if TestSwitch(s,'LPT3' ) then Port := 3; { Z BIOS tabulky }
if TestSwitch(s,'LPT2' ) then Port := 2;
if TestSwitch(s,'LPT1' ) then Port := 1;
if TestSwitch(s,'ALL03') then Port := $2E0; { ALL03 porty }
{-- typ souboru --}
if TestSwitch(s,'HEX' ) then FileFormat:= _HEX_; { Moje cislovani filtru }
if TestSwitch(s,'TEXT' ) then FileFormat:= _TXT_;
if TestSwitch(s,'TXT' ) then FileFormat:= _TXT_;
{-- Default hodnoty --}
if Port = -1 then Port := 1;
if FileFormat = _NIL_ then FileFormat := _TXT_;
{-- typ a parametry soucastky --}
ProcFind(s,Proc);
if Proc.Name=''
then begin (* Volba default procesoru je zamerne zaslapnuta protoze mate uzivatele
ProcFind('PIC16F84',Proc); { Default hodnota }
*)
end
else if TestSwitch(s,Proc.Name) then; { Sezer pouzitou hodnotu }
Data.Init(Proc);
{-- prislusnost soucastky do skupiny pro Cfg prepinace --}
ix:=CfgFindProcGroup(Proc.Cfg,CfgDefAll); { i je index do konstanty CfgDefAll }
{-- zpracovani prepinacu specifickych pro Cfg slovo --}
{ s ... retezec s prepinacema, ktere jeste nebyly zpracovany }
{ ix ... index do tabulky CfgDefAll s informacemi o prepinacich skupiny }
CfgString:=CfgX; { prazdny ( sama 'X' Cfg retezec }
if ix>0 then
begin CfgString:=CfgTestKeyMultiple(s,CfgDefAll[ix]);
if CfgString='' then Error('Konflicting Cfg switch '+GetWord(s),0);
end;
if s<>'' then Error('Unrecognized switches: '+s,0);
end; {Switches}
 
{====== Hlavni cinnosti ( akce ) programu ======}
 
procedure Help;
{== Vypise navod k pouziti ==}
var i:integer;
Proc:ProcInfo_t;
begin writeln('Usage: PICPGR <what_to_do> [<file_name>] [switches]');
writeln;
writeln('PICPGR READ <file_name> [switches]');
writeln('PICPGR PROGRAM <file_name> [switches]');
writeln('PICPGR VERIFY <file_name> [switches]');
writeln('PICPGR ERASE [switches]');
writeln('PICPGR RUN [switches]');
writeln('PICPGR STOP [switches]');
writeln('PICPGR RESET [switches]');
writeln('PICPGR CONVERT <file_in> <file_out> [switches]');
writeln;
writeln('Exit: 0 O.K.');
writeln(' 1 Generic Error');
writeln(' 100 Program or Verify Error');
writeln;
writeln('Switches: LPT1*, LPT2, LPT3 Development Programmer via LPT');
writeln('*=default ALL03 HI-LO Programmer');
writeln(' TXT*, HEX Data File Format');
writeln(' PIC16F84* Processor''s name');
writeln;
PressEnter;
writeln('Note: Processor groups can have their''s own set of switches');
writeln(' for overiding of Config Word settins.');
writeln;
writeln(' Boolean type: CP, CP_ON, CP_OFF');
writeln(' ( CP is CP_ON )');
writeln;
writeln(' Binary string: CP_101');
writeln(' ( binary digit string must');
writeln(' have corect length )');
writeln;
writeln('Help function:');
writeln;
writeln('PICPGR Long help - all processors)');
writeln('PICPGR <proc_name> Short help - particular processor');
writeln;
{-- varianta podle toho, zda mne zajima konkretni procesor --}
ProcFind(GetParamLine(1),Proc);
if Proc.Name<>''
then begin {-- konkretni procesor --}
ProcDisplayInfo(Proc); { zobraz co je vybrane }
i:=CfgFindProcGroup(Proc.Cfg,CfgDefAll);
if i>0 then
begin writeln(Proc.Name+' specific switches for Config Word overiding:');
writeln;
CfgDisplayHelp(CfgDefAll[i]);
end;
end
else begin {-- neni konkretni procesor - zobraz vsechno --}
PressEnter;
CfgDisplayHelpAll(CfgDefAll);
PressEnter;
ProcDisplayInfoAll;
end;
halt(1);
end; {Help}
 
var Data:PicDataIo_t; { globalni promenna pro ulozeni dat }
{ globalni je proto, protoze se neda }
{ pouzit lokalni ( nevejde se na zasobnik ) }
 
procedure ToDoRead;
{== Bude se cist ==}
{ Precte obsah soucastky do pametovych bufferu }
var i:integer;
j:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Cteni --}
InitHW(Port);
writeln('Reading data from PIC ...');
StartPIC(5.0);
case Proc.Alg of
_EPROM1_:
begin {-- Read Program Memory --}
OutCommandPIC(IncrementAddress); {preskoc konfiguracni slovo}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM) and Proc.PM_Mask
);
OutCommandPIC(IncrementAddress);
end;
{-- Read Config Memory --}
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM) and Proc.CM_Mask
);
OutCommandPIC(IncrementAddress);
end;
{--- Read Config Word ---}
EndPIC;
StartPIC(5.0);
Data.StoreProc( Proc.Cfg_Base,
InputDataPIC(Proc.Bits,ReadDataPM) and Proc.Cfg_Mask
);
end;
_EPROM2_,
_EE1_,
_EE2_ :
begin {-- Read Program Memory --}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM) and Proc.PM_Mask
);
OutCommandPIC(IncrementAddress);
end;
{-- Read Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataDM) and Proc.DM_Mask
);
OutCommandPIC(IncrementAddress);
end;
{-- Read Config Memory --}
OutputDataPIC(Proc.Bits,LoadConfiguration,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM) and Proc.CM_Mask
);
OutCommandPIC(IncrementAddress);
end;
end;
_EPROM3_:
begin Error('Algorithm EPROM3 not yet supported',0);
end;
else Error('Algorithm not supported',0);
end; {case}
EndPIC;
{-- Vystup vysledku --}
Data.Export(paramstr(2),FileFormat,';Directly read from '+Proc.Name);
writeln('... Done');
end; {ToDoRead}
 
procedure Delta(adr,data1,data2:word);
{== Vypis info o rozdilu ==}
begin HexWord(output,adr);
write(': ');
HexWord(output,data1);
write('-');
HexWord(output,data2);
writeln;
end; {Delta}
 
procedure ToDoProgram;
{== Bude se programovat ==}
var i:integer;
err,count:integer;
data_wr:word; { data, ktera se maji zapsat }
data_rd:word; { data z kontrolniho cteni }
n:integer;
Proc:ProcInfo_t;
CfgStringTmp:string;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
InitHW(Port);
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Program --}
writeln('Programming data to PIC ...');
err:=0;
count:=0;
StartPIC(5.0);
{-- Program Program Memory --}
if Proc.PM_Len>0 then
begin
if Proc.Alg=_EPROM1_ then OutCommandPIC(IncrementAddress); {preskoc konfiguracni slovo}
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) then { platna data ? }
begin
data_wr:=Data.GetData(i); { vezmi data }
case Proc.Alg of
_EPROM1_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.PM_Mask;
inc(n);
until (n>8) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=n*11 downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
end;
inc(count);
end;
_EPROM2_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.PM_Mask;
inc(n);
until (n>25) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=3*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
end;
inc(count);
end;
_EPROM3_ :
begin Error('Algorithm EPROM3 not yet supported',0);
end;
_EE1_,
_EE2_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.PM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end; {od if testujicich platnost dat}
OutCommandPIC(IncrementAddress); { dalsi adresa PM }
end; {od cyklu for pres vsechny adresy}
{-- Program Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin
if Data.GetStat(i)
then
begin data_wr:=Data.GetData(i);
case Proc.Alg of
_EPROM1_,
_EPROM2_,
_EPROM3_ :
begin Error('Internal Error: Algorithm EPROMx does not know Data Memory',0);
end;
_EE1_,
_EE2_ :
begin OutputDataPIC(Proc.Bits,LoadDataDM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM) and Proc.DM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end;
OutCommandPIC(IncrementAddress);
end;
 
{-- priprav Config Word --}
if (CfgString<>'') and (CfgString<>CfgX)
then begin {-- prepinaci zmeneno Cfg slovo --}
writeln('Required Config Word: ',CfgString);
if Data.GetStat(Proc.Cfg_Base)
then begin {-- Cfg slovo bylo v datovem souboru --}
CfgStringTmp:=Word2Str(Data.GetData(Proc.Cfg_Base));
writeln('Config Word from data file: ',CfgStringTmp);
end
else begin {-- Cfg slovo nebylo v datovem souboru --}
CfgStringTmp:=CfgX; { prazdne slovo ( sama X ) }
end;
{-- sloz slovo ze souboru a z prepinacu --}
CfgString:=CfgOverride(CfgStringTmp,CfgString);
writeln('Result: ',CfgString);
{-- uloz slozene slovo do datoveho pole --}
Data.StoreProc(Proc.Cfg_Base,Str2Word(CfgString));
end;
 
{-- Program Config Memory --}
{--- algoritmus _EPROM1_ prikaz Load Configuration nezna}
if Proc.Alg<>_EPROM1_ then OutputDataPIC(Proc.Bits,LoadConfiguration,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin
if Data.GetStat(i)
then
begin data_wr:=Data.GetData(i);
case Proc.Alg of
_EPROM1_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.CM_Mask;
inc(n);
until (n>8) or (data_wr=data_rd);
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=11*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
end;
end;
_EPROM2_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.CM_Mask;
inc(n);
until (n>25) or (data_wr=data_rd);
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=3*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
end;
end;
_EPROM3_ :
begin Error('Algorithm EPROM3 not yet supported',0);
end;
_EE1_,
_EE2_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_wr xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end
else begin if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end;
OutCommandPIC(IncrementAddress);
end;
 
{--- u algoritmu _EPROM1_ se konfiguracni slovo programuje zvlast}
if Proc.Alg=_EPROM1_ then
if Data.GetStat(Proc.Cfg_Base) then
begin
{--- toto zajisti prechod na konfig. bunku}
EndPIC;
StartPIC(5.0);
data_wr:=Data.GetData(Proc.Cfg_Base);
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.Cfg_Mask;
inc(n);
until (n>8) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(Proc.Cfg_Mask,data_wr,data_rd);
inc(err);
end
else for n:=n*11 downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM,data_wr);
OutCommandPIC(BeginProgramming);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming);
end;
inc(count);
end;
end;
EndPIC;
writeln('... Done');
write('Programmed ',count,' Data Words, ');
case err of
0 : writeln('No diferences found');
1 : writeln(err,' diference found');
else writeln(err,' diferences found');
end;{case}
if err<>0 then exitcode:=100; { Jako by bylo halt(100) }
end; {ToDoProgram}
 
procedure ToDoVerify;
{== Porovnani obsahu soucastky se souborem ==}
var i:integer;
data_fi:word; { data z objektu }
data_rd:word; { data prectena ze soucastky }
err,count:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
InitHW(Port);
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Verify --}
writeln('Verifying ...');
err:=0;
count:=0;
StartPIC(5.0);
case Proc.Alg of { toto je jen test na podporovane algoritmy }
_EPROM1_,
_EPROM2_,
_EE1_,
_EE2_ :
begin {-- Verify Program Memory --}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.PM_Mask;
if data_fi <> data_rd
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress);
end;
{-- Verify Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM) and Proc.DM_Mask;
if data_rd <> data_fi
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress);
end;
{-- Verify Config Memory --}
OutputDataPIC(Proc.Bits,LoadConfiguration,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin
if Data.GetStat(i)
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_fi xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
end
else begin if data_fi <> data_rd
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
end;
inc(count);
end;
OutCommandPIC(IncrementAddress);
end;
end;
_EPROM3_:
begin Error('Algorithm EPROM3 not yet supported',0);
end;
else Error('Algorithm not supported',0);
end; {case}
EndPIC;
writeln('... Done');
write('Compared ',count,' Data Words, ');
case err of
0 : writeln('No diferences found');
1 : writeln(err,' diference found');
else writeln(err,' diferences found');
end;{case}
if err<>0 then exitcode:=100; { Jako by bylo halt(100) }
end; {ToDoVerify}
 
procedure ToDoErase;
{== Bude se pouze mazat ==}
var i:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
Switches(GetParamLine(2),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Erase --}
case Proc.Alg of
_EPROM1_,
_EPROM2_,
_EPROM3_ :
begin Error('Use UV light to erase EPROM processor!',0)
end;
_EE1_,
_EE2_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- postup pro odblokovani CP soucastky --}
OutputDataPIC(Proc.Bits,LoadConfiguration,$FFFF);
for i:=1 to Proc.CM_Len-1 do OutCommandPIC(IncrementAddress);
OutCommandPIC(Dis1);
OutCommandPIC(Dis2);
OutCommandPIC(BeginProgramming);
xDelayMicro(12000);
OutCommandPIC(Dis1);
OutCommandPIC(Dis2);
{-- Mazani datove pameti --}
{ Funguje na C84/F84/F877 ale postup je uveden jen }
{ u obvodu F84. Obvod C84 potrebuje stejny postup. }
OutputDataPIC(Proc.Bits,LoadDataDM,$FFFF);
OutCommandPIC(Dis1);
OutCommandPIC(Dis2);
OutCommandPIC(BeginProgramming);
xDelayMicro(10000);
OutCommandPIC(Dis1);
OutCommandPIC(Dis2);
EndPIC;
end;
else Error('Algorithm not supported',0);
end; {case}
end; {ToDoErase}
 
procedure ToDoRun;
{== Zapne napajeni a spusti program ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(5.0); { zapni napajeni }
xDelay(50); { pockej na ustaleni }
P^.SetReset(one); { skonci reset }
writeln('Running ...');
end; {ToDoRun}
 
procedure ToDoStop;
{== Vypne napajeni ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero);
P^.SetVcc(0);
writeln('... Stoped');
end; {ToDoStop}
 
procedure ToDoReset;
{== Provede Reset bez vypnuti napajeni ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero);
P^.SetVcc(5.0);
xDelay(50);
P^.SetReset(one);
writeln('... Reset ...');
end; {ToDoReset}
 
procedure ToDoConvert;
{== Procedura pro konverzi formatu souboru ==}
var s:string;
i:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<3 then Help; { chybi jmeno souboru }
Switches(GetParamLine(4),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Vystup dat --}
case FileFormat of
_HEX_ : FileFormat:=_TXT_;
_TXT_ : FileFormat:=_HEX_;
end; {case}
Data.Export(paramstr(3),FileFormat,';Converted from file '+paramstr(2));
writeln('Done');
end; {ToDoConvert}
 
{====== Hlavni program, Entry a Exit programy ======}
 
const OldExitProc:pointer=NIL; { Pro proceduru MyExitProc }
 
procedure MyExitProc;
{== Ukoncujici procedura pro pripad predcasneho ukonceni programu ==}
{ Tato procedura normalni nic ndela ale pokud je pri ukonceni }
{ programu nastaven priznak aktivity programovani zavola }
{ proceduru StopPIC. }
{ Promenne: StartPICStat .. true znamena aktivitu pri programovani }
{ P .. pointer na objekt zastupujici hardware }
far;
begin ExitProc:=OldExitProc;
if StartPICStat and (P<>nil) then EndPIC;
end; {MyExitProc}
 
begin assign(output,''); { aby slo vystup presmerovat do souboru }
rewrite(output);
writeln;
writeln('PIC Development Programmer');
writeln('==========================');
writeln('(c) miho ',date,' v ',ver);
writeln;
 
{-- test - zadny parametr --}
if paramcount=0 then Help;
{-- zaregistruj ukonceni pro pripad predcasneho skonceni programu --}
OldExitProc:=ExitProc;
ExitProc:=@MyExitProc;
{-- rozhodni cinnost --}
if UpStr(paramstr(1))='READ' then ToDoRead
else if UpStr(paramstr(1))='PROGRAM' then ToDoProgram
else if UpStr(paramstr(1))='VERIFY' then ToDoVerify
else if UpStr(paramstr(1))='ERASE' then ToDoErase
else if UpStr(paramstr(1))='RUN' then ToDoRun
else if UpStr(paramstr(1))='STOP' then ToDoStop
else if UpStr(paramstr(1))='RESET' then ToDoReset
else if UpStr(paramstr(1))='CONVERT' then ToDoConvert
else if UpStr(paramstr(1))='HELP' then Help
else Help;
Halt(exitcode); { Exitcode si nastavuji pri chybe pri programovani }
end. { nebo pri verifikaci. Je to treba uvest takto }
{ explicitne jinak se provede Halt(0). }
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_ALL03.PAS
0,0 → 1,532
unit PP_ALL03;
 
{$I-,S-}
 
{=========================================================}
{ }
{ Unita pro ovladani programatoru HI-LO model ALL-03 }
{ (c) DECROS pefi }
{---------------------------------------------------------}
{ Verze : 1.0.0 uvodni verze }
{ 1.0.1 preformatovani zdrojaku miho }
{ 1.0.2 prejmenovani na PP_ALL03.PAS }
{=========================================================}
 
interface
 
procedure ErrorProc;
{== vypise slovne obsah chyby ==}
 
procedure PowerOff;
{== vypne programator ==}
 
procedure Initialize(Baze :word);
{== ziniciuje programator a nastavi bazovou adresu programatoru ==}
 
procedure SetVoltageV1(Napeti : real);
{== nastavi napeti na prevodniku s vahou 0.4, napeti je zadavano ==}
{== ve voltech, max. napeti 9.6V. Zapina se jim programator, ==}
{== musi byt pouzit vzdy ==}
 
procedure SetVoltageV2(Napeti : real);
{== nastavi napeti na prevodniku s vahou 0.6, napeti je zadavano ==}
{== ve voltech, max. napeti 14.4V. ==}
 
procedure SetVoltageV3(Napeti : real);
{== nastavi napeti na prevodniku s vahou 1, napeti je zadavano ==}
{== ve voltech, max. napeti je 25V ==}
 
procedure SetBit(Pin,Stav:byte);
{== nastavi pin podle parametru Stav. Piny jsou v rozsahu 1-40, ==}
{== stav je 0 nebo 1. ==}
 
procedure GetBitProc (Pin:byte;var Stav:byte);
{== cte stav pinu,pin v rozsahu 1-40,Stav nabyva hodnot 0 nebo 1 ==}
 
function GetBit(Pin:byte):byte;
{== cte stav pinu, pin v rozsahu 1-40,vraci 0 nebo 1 ==}
 
procedure ConnectV1(Pin:byte;On:boolean);
{== pripojuje prevodnik V1 s vahou 0.4 k pinum, ==}
{== piny v rozsahu 24-32,34,36,40 ==}
 
procedure ConnectV2(Pin:byte;On:boolean);
{== pripojuje prevodnik V2 s vahou 0.6 k pinum. ==}
{== piny v rozsahu 9-32 ==}
 
procedure ConnectV3(Pin:byte;On:boolean);
{== pripojuje prevodnik V3 s vahou 1 k pinum. ==}
{== piny v rozsahu 1,5-7,9-32,36 ==}
 
procedure Gnd11(On:boolean);
{== prepina zem mezi piny 20 a 11, true=pin 11, false= pin20 ==}
 
procedure Led(On:boolean);
{== ovlada led s napisem 'GOOD', true= sviti, false= nesviti ==}
 
function ReadButton:boolean;
{== vypne programator a cte tlacitko s napisem 'YES' , ==}
{== true=stiknuto, false=uvolneno ==}
 
 
{=========================================================}
 
implementation
 
 
uses DELAY;
 
 
{== Definice konstant ==}
 
const InitNum = 22; { pocet registru }
 
const InitArray : array[1..InitNum,1..2] of byte =
{== zakladni inicializace tj. vsechny piny jako vstupni,prevodniky ==}
{== odpojeny od vsech pinu a vymulovany ==}
(
(231,0),(230,0),(229,0),
(238,0),(237,0),(241,0),
(242,0),(242,0),(243,0),
(232,0),(233,0),(234,0),
(235,0),(236,0),(224,255),
(225,255),(226,255),(227,255),
(228,255),(247,0),(239,0),
(245,0)
);
 
const PinSet : array[1..40,1..2] of byte =
{== tabulka pro ovladani jednotlivych pinu, na prvni pozici ==}
{== prislusny I/O registr na druhe pozici maska pinu v registru ==}
(
($E0,$01),($E0,$02),($E0,$04),($E0,$08),
($E0,$10),($E0,$20),($E0,$40),($E0,$80),
($E1,$01),($E1,$02),($E1,$04),($E1,$08),
($E1,$10),($E1,$20),($E1,$40),($E1,$80),
($E2,$01),($E2,$02),($E2,$04),($E2,$08),
($E2,$10),($E2,$20),($E2,$40),($E2,$80),
($E3,$01),($E3,$02),($E3,$04),($E3,$08),
($E3,$10),($E3,$20),($E3,$40),($E3,$80),
($E4,$01),($E4,$02),($E4,$04),($E4,$08),
($E4,$10),($E4,$20),($E4,$40),($E4,$80)
);
 
const PinConnectV1: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 0.4 k pinum, na prvni ==}
{== pozici registr pro pripojeni, na druhe pozici maska ==}
{== pinu v registru ==}
(
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($EE,$80),
($EE,$04),($EE,$02),($EE,$01),($ED,$80),
($ED,$40),($ED,$20),($ED,$10),($ED,$08),
($00,$00),($ED,$04),($00,$00),($ED,$02),
($00,$00),($00,$00),($00,$00),($ED,$01)
);
 
const PinConnectV2: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 0.6 k pinum, na prvni ==}
{== pozici registr pro pripojeni, na druhe pozici maska ==}
{== pinu v registru ==}
(
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($F1,$01),($F1,$02),($F1,$04),($F1,$08),
($F1,$10),($F1,$20),($F1,$40),($F1,$80),
($F2,$01),($F2,$02),($F2,$04),($F2,$08),
($F2,$10),($F2,$20),($F2,$40),($F2,$80),
($F3,$01),($F3,$02),($F3,$04),($F3,$08),
($F3,$10),($F3,$20),($F3,$40),($F3,$80),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00)
);
 
const PinConnectV3: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 1 k pinum, na prvni ==}
{== registr pro pripojeni, na druhe pozici maska pinu v registru ==}
(
($E8,$01),($00,$00),($00,$00),($00,$00),
($E8,$10),($E8,$20),($E8,$40),($00,$00),
($E9,$01),($E9,$02),($E9,$04),($E9,$08),
($E9,$10),($E9,$20),($E9,$40),($E9,$80),
($EA,$01),($EA,$02),($EA,$04),($EA,$08),
($EA,$10),($EA,$20),($EA,$40),($EA,$80),
($EB,$01),($EB,$02),($EB,$04),($EB,$08),
($EB,$10),($EB,$20),($EB,$40),($EB,$80),
($00,$00),($00,$00),($00,$00),($EC,$08),
($00,$00),($00,$00),($00,$00),($00,$00)
);
 
{== definice globalnich promennych ==}
 
var BazovaAdresa : word;
Error : integer; { cislo chyby }
PortStat : array[1..5] of byte; { aktualni stavy pinu }
ConnectV1Stat: array[1..2] of byte; { aktualni pripojeni prevodniku V1 }
ConnectV2Stat: array[1..3] of byte; { aktualni pripojeni prevodniku V2 }
ConnectV3Stat: array[1..5] of byte; { aktualni pripojeni prevodniku V3 }
GndStat : boolean; { =1 GND na 11, =0 GND na 20 }
 
 
{== vykonne procedury TPU ==}
 
 
{== Vytiskne hlaseni o chybe a ukonci program ==}
procedure ErrorProc;
begin
writeln;
write('Error: ');
case Error of
0:writeln('Zadna Chyba');
1:writeln('Napeti pro prevodnik mimo rozsah');
2:Writeln('Spatny stav pinu, mozne pouze 0 nebo 1');
3:Writeln('Pin mimo rozsah, mozne 1-40, u pripojeni prevodniku jen nektere');
end; {case}
writeln;
halt(1);
end; {End Error}
 
 
{== Zapise bajt do prislusneho registru programatoru ==}
procedure OutPort(Adr, Data : byte);
begin
asm
mov dx,BazovaAdresa
mov al,Adr
out dx,al
add dx,2
mov al,Data
out dx,al
end; {asm}
end; {OutPort}
 
 
{== Precte bajt a prislusneho registru programatoru ==}
function InPort(Adr : byte) : byte;
begin
asm
mov dx,BazovaAdresa
mov al,Adr
out dx,al
add dx,2
in al,dx
mov Adr,al
end; {asm}
InPort := Adr;
end;
 
 
{== Zinicializuje programator ==}
procedure PowerOff;
var n,i :byte;
begin
for i:= 1 to InitNum do
OutPort(InitArray[i,1],InitArray[i,2]);
 
{--- nastav otisk pinu}
for i:= 1 to 5 do
PortStat[i]:=255;
 
{--- nastav otisk pripojeni prevodniku V1}
for i:=1 to 2 do
ConnectV1Stat[i]:=0;
 
{--- nastav otisk pripojeni prevodniku V2}
for i:=1 to 3 do
ConnectV2Stat[i]:=0;
 
{--- nastav otisk pripojeni prevodniku V3}
for i:=1 to 5 do
ConnectV3Stat[i]:=0;
 
end; {PowerOff}
 
 
{== Inicializace programatoru se zadanim Bazove adresy ==}
procedure Initialize(Baze :word);
begin
BazovaAdresa:=Baze;
Error:=0;
GndStat:=false;
PowerOff;
end; {Initialize}
 
 
{== Zadani napeti pro prevodnik s vahou 0.4 ==}
procedure SetVoltageV1(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=9.6 then begin Voltage:=Round(((255/9.5)*Napeti));
OutPort(231,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV1}
 
 
{== Zadani napeti pro prevodnik s vahou 0.6 ==}
procedure SetVoltageV2(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=14.4 then begin Voltage:=Round(((255/14.4)*Napeti));
OutPort(230,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV2}
 
 
{== Zadani napeti pro prevodnik s vahou 1 ==}
procedure SetVoltageV3(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=25 then begin Voltage:=Round(((255/24)*Napeti));
OutPort(229,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV1}
 
 
{== Nastaveni pinu ==}
procedure SetBit(Pin,Stav:byte);
var PozReg:byte;
begin
if (Pin>=1) and (Pin<=40)
then begin
{--- urceni indexu I/O registru pro pole otisku}
if (Pin>=1) and (Pin<=8) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
 
if Stav=1
then begin
{--- pin do Log.1, zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PortStat[PozReg]); }
end
else Error:=2;
 
if Stav=0
then begin
{--- pin do log.0, zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] and not(PinSet[Pin,2]);
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PortStat[PozReg]); }
end
else Error:=2;
 
end
else Error:=3;
end; {SetBit}
 
 
{== Cteni bitu jako procedura ==}
procedure GetBitProc (Pin:byte;var Stav:byte);
var ReadBit:byte;
begin
if (Pin>=1) and (Pin<=40)
then begin
Readbit:=InPort(PinSet[Pin,1]) and PinSet[Pin,2];
if ReadBit=0 then Stav:=0
else Stav:=1;
end
else Error:=3;
end; {GetbitProc}
 
 
{== Cteni bitu jako funkce ==}
function GetBit(Pin:byte):byte;
var ReadBit:byte;
begin
Readbit:=InPort(PinSet[Pin,1]) and PinSet[Pin,2];
if ReadBit=0 then GetBit:=0
else GetBit:=1;
end; {Getbit}
 
 
{== Pripojeni prevodniku V1 s vahou 0.4 ==}
procedure ConnectV1(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit k pinum 24,26-32,34,36 a 40}
TestPin:=(Pin>=26) and (Pin<=32)or (Pin=24) or (Pin=34) or (Pin=36) or (Pin=40);
if TestPin
then begin
{ writeln('V1 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku}
if Pin=24 then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
 
{--- na pin se musi zapsat log.1, udelej zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr v poli otisku pripojeni}
if (Pin>=24) and (Pin<=27) then PozReg:=1
else PozReg:=2;
if On
then {--- udelej zaznam o pripojeni do otisku}
ConnectV1Stat[PozReg] := ConnectV1Stat[PozReg]
or PinConnectV1[Pin,2]
else {--- udelej zaznam o odpojeni do otisku}
ConnectV1Stat[PozReg] := ConnectV1Stat[PozReg]
and not( PinConnectV1[Pin,2]);
 
OutPort(PinConnectV1[Pin,1],ConnectV1Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV1}
 
 
{== Pripojeni prevodniku V2 s vahou 0.6 ==}
procedure ConnectV2(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit piny 9-32}
TestPin:=(Pin>=9) and (Pin<=32);
 
{--- pokud je pouzit pin 11 nebo 20 jako zem, nejze na nej ---}
{--- pripojit prevodnik ---}
if (Pin=11) and GndStat then TestPin:=false; { pin 11 je uzemen }
if (Pin=20) and Not(GndStat) then TestPin:=false; { pin20 je uzemen }
 
if TestPin
then begin
{ writeln('V2 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku}
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
 
{--- na pin je nutne zapsat log.1, udelej zapis do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];{nastav na pin log.1}
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr otisku pripojeni}
if (Pin>=9) and (Pin<=16) then PozReg:=1;
if (Pin>=17) and (Pin<=24) then PozReg:=2;
if (Pin>=25) and (Pin<=32) then PozReg:=3;
 
if On
then {--- udelej zaznam o pripojeni do otisku}
ConnectV2Stat[PozReg] := ConnectV2Stat[PozReg]
or PinConnectV2[Pin,2]
else ConnectV2Stat[PozReg] := ConnectV2Stat[PozReg]
and not(PinConnectV2[Pin,2]);
 
OutPort(PinConnectV2[Pin,1],ConnectV2Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV2}
 
 
{== Pripojeni prevodniku V3 s vahou 1 ==}
procedure ConnectV3(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit k pinum 1,5-7,9-32,a36}
TestPin:=(Pin>=9)and(Pin<=32)or(Pin=1)or((Pin>=5)and(Pin<=7))or(Pin=36);
 
{--- pokud je pouzit pin 11 nebo 20 pro zem, nelze na nej ---}
{--- pripojit prevodnik ---}
if (Pin=11) and GndStat then TestPin:=false; { pin 11 je uzemen }
if (Pin=20) and Not(GndStat) then TestPin:=false; { pin20 je uzemen }
 
if TestPin
then begin
{ writeln('V3 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku }
if (Pin>=1) and (Pin<=8) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
{ writeln(PozReg); }
 
{--- na pin nutno zapsat log.1 , udelej zapis do otisku }
PortStat[PozReg] := PortStat[PozReg]
or PinSet[Pin,2]; { nastav na pin log.1 }
 
OutPort(PinSet[Pin,1],PortStat[PozReg]);
 
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr otisku pripojeni}
if (Pin>=1) and (Pin<=7) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin=36) then PozReg:=5;
 
if On
then ConnectV3Stat[PozReg] := ConnectV3Stat[PozReg]
or PinConnectV3[Pin,2]
else ConnectV3Stat[PozReg] := ConnectV3Stat[PozReg]
and not(PinConnectV3[Pin,2]);
 
OutPort(PinConnectV3[Pin,1],ConnectV3Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV3}
 
 
{== Prepinani zeme mezi vyvody 11 nebo 20 ==}
{ True = pripojen Pin11 }
{ False = pripojen pin20 }
procedure Gnd11(On:boolean);
begin
if On then begin
OutPort($EF,1);
GndStat:=true;
end
else
begin
OutPort($EF,0);
GndStat:=false;
end;
end; {Gnd11}
 
 
{== Ovladani LED 'GOOD' ==}
{ True = sviti }
procedure Led(On:boolean);
begin
if On then OutPort($F7,$8)
else OutPort($F7,$0);
end; {Led}
 
 
{== Cteni tlacitka 'YES' ==}
{ True = stisknut }
function ReadButton:boolean;
begin
PowerOff;
xDelay(50);
writeln(InPort($E4));
if (InPort($E4)and $80)<>0 then ReadButton:=true
else ReadButton:=false;
end; {ReadButton}
 
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_CFG.PAS
0,0 → 1,298
 
{Toto je include soubor}
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice prepinacu pro skupiny procesoru pro definovani }
{ ( modifikaci ) konfiguracniho slova procesoru. }
{===========================================================================}
 
const CfgDefAll:CfgDef_t=
( {-- definice Cfg dat --}
( {-- Skupina procesoru C84 --}
ProcId : 'C84';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX1XXX';
Off : 'XXXXXXXXXX0XXX';
Bits : ''
),
( Key : 'CP';
On : 'XXXXXXXXX0XXXX';
Off : 'XXXXXXXXX1XXXX';
Bits : ''
),
(),(),(),(),(),(),()
)
),
( {-- Skupina procesoru F83, F84, .. --}
ProcId : 'F83';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '0000000000XXXX';
Off : '1111111111XXXX';
Bits : ''
),
(),(),(),(),(),(),()
)
),
( {-- Skupina procesoru F627, F628 --}
ProcId : 'F627';
Info : ( ( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXX2XX10'
),
( Key : 'LP';
On : 'XXXXXXXXX0XX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXX0XX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXX0XX10';
Off : '';
Bits : ''
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'MCLRE';
On : 'XXXXXXXX1XXXXX';
Off : 'XXXXXXXX0XXXXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0000XXXXXXXXXX';
Off : '1111XXXXXXXXXX';
Bits : '1010XXXXXXXXXX'
),
(),(),(),()
)
),
( {-- Skupina procesoru F870, ... --}
ProcId : 'F870';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX10'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '00XXXXXX00XXXX';
Off : '11XXXXXX11XXXX';
Bits : '10XXXXXX10XXXX'
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXXX1XXXXXXXXX';
Off : 'XXXX0XXXXXXXXX';
Bits : ''
),
(),(),()
)
),
( {-- Skupina procesoru F873, ... --}
ProcId : 'F873';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '00XXXXXX00XXXX';
Off : '11XXXXXX11XXXX';
Bits : '10XXXXXX10XXXX'
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXXX1XXXXXXXXX';
Off : 'XXXX0XXXXXXXXX';
Bits : ''
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
(),()
)
)
);
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_COMON.PAS
0,0 → 1,156
unit PP_COMON;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde jsou obecne uzivane pomocne procedury a funkce . }
{===========================================================================}
 
interface
 
function UpStr(str:string):string;
{== Prevede retezec na velka pismena ==}
 
procedure PressEnter;
{== Zobrazi hlasku a ceka na stisk klavesy ==}
 
procedure HexByte(var f:text;data:word);
{== Vytiskni byte jako 2 znaky ==}
 
procedure HexWord(var f:text;data:word);
{== Vytiskni word jako 4 znaky ==}
 
procedure HexWordSp(var f:text;data:word);
{== Vytiskni word jako 4 znaky a mezeru ==}
 
procedure HexAdr(var f:text;data:word);
{== Vytiskni adresu s dvojteckou ==}
 
procedure Error(ErrorStr:string; LineNumber:integer); (* !! *)
{== Vytiskne hlaseni o chybe a ukonci program ==}
{ Pokud je LinNumber<=0 pak se netiskne }
 
function DelSpace(s:string):string;
{== Vyhodi vsechny mezery ze zacatku retezce s ==}
 
function GetWord(s:string):string;
{== Vrati prvni slovo ze zadaneho retezce ==}
 
function DelWord(s:string):string;
{== Odstrihne prvni slovo z retezce ==}
 
procedure DisplayRange(Base, Len:word);
{== obrazi rozsah jako dvojici hex cisel ==}
 
function GetParamLine(First:integer):string;
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==}
 
implementation
 
function UpStr(str:string):string;
{== Prevede retezec na velka pismena ==}
var i:integer;
begin for i:=1 to length(str) do str[i]:=upcase(str[i]);
UpStr:=str;
end; {UpStr}
 
procedure PressEnter;
{== Zobrazi hlasku a ceka na stisk klavesy ==}
begin write('Press ENTER to continue ...');
readln;
writeln;
end; {PressEnter}
 
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
 
procedure HexByte(var f:text;data:word);
{== Vytiskni byte jako 2 znaky ==}
begin write(f, prevod[(data shr 4) and $F],
prevod[data and $F]);
end; {HexByte}
 
procedure HexWord(var f:text;data:word);
{== Vytiskni word jako 4 znaky ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F]);
end; {HexWord}
 
procedure HexWordSp(var f:text;data:word);
{== Vytiskni word jako 4 znaky a mezeru ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F],
' ');
end; {HexWordSp}
 
procedure HexAdr(var f:text;data:word);
{== Vytiskni adresu s dvojteckou ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F],
': ');
end; {HexAdr}
 
procedure Error(ErrorStr:string; LineNumber:integer);
{== Vytiskne hlaseni o chybe a ukonci program ==}
{ Pokud je LinNumber<=0 pak se netiskne }
begin writeln;
if LineNumber<=0 then writeln('FATAL: ',ErrorStr)
else writeln('FATAL @ Line ',LineNumber,': ',ErrorStr);
writeln;
halt(1);
end; {Error}
 
function DelSpace(s:string):string;
{== Vyhodi vsechny mezery ze zacatku retezce s ==}
var i:integer;
begin i:=1;
while (i<=length(s)) and (s[i]=' ')
do inc(i);
DelSpace:=copy(s,i,255);
end; {DelSpace}
 
function GetWord(s:string):string;
{== Vrati prvni slovo ze zadaneho retezce ==}
var t:string;
begin t:=DelSpace(s);
GetWord:=copy(t,1,pos(' ',t+' ')-1);
end; {GetWord}
 
function DelWord(s:string):string;
{== Odstrihne prvni slovo z retezce ==}
var t:string;
begin t:=DelSpace(s);
t:=copy(t,pos(' ',t+' ')+1,255);
DelWord:=DelSpace(t);
end; {DelWord}
 
procedure DisplayRange(Base, Len:word);
{== obrazi rozsah jako dvojici hex cisel ==}
begin if Len<>0
then begin hexword(Output,Base);
write('..');
hexword(Output,Base+Len-1);
write(' ');
end
else begin write('none ');
end;
end; {DisplayRange}
 
function GetParamLine(First:integer):string;
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==}
var i:integer;
s:string;
begin s:='';
if First<1 then exit;
for i:=First to paramcount do s:=s+paramstr(i)+' ';
GetParamLine:=UpStr(s);
end; {GetParamLine}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_DATA.PAS
0,0 → 1,158
unit PP_DATA;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice objektu pro ulozeni dat v pameti. }
{===========================================================================}
 
interface
 
uses PP_DEFS;
 
{===========================================================================}
{ Definice typu a konstant pro ulozeni dat ( delka buferu, typ ulozenych }
{ dat. }
{===========================================================================}
 
type DataItem_t=record { typ pro ulozeni jednoho datoveho slova }
W : word; { vlastni data }
S : boolean; { true znamena platna data }
end; {record}
 
type RangeType_t=
( _INVALID_, { adresa neprislusi zadne oblasti }
_PM_, { adresa spada do pameti programu }
_DM_, { adresa spada do pameti dat }
_CM_, { adresa spada do konfiguracni pameti }
_CFG_ { adresa je adresou zvlastniho konfig slova }
);
 
type PicData_t=object
{-- vlastni datove pole --}
_Buf : array[0..DataBufLen-1] of DataItem_t; { zde jsou data }
{-- informace o vybranem procesoru --}
_Proc:ProcInfo_t;
{-- metody --}
 
procedure Init(ProcInfo:ProcInfo_t);
{== Zapamatuje si typ procesoru ( jeho prametry ) a smaze datovou oblast ==}
 
procedure GetProcInfo(var ProcInfo:ProcInfo_t);
{== Vrati aktualni parametry procesoru ==}
 
function TestAdr(Adr:word):RangeType_t;
{== Vrati typ pametoveho prostoru pro zadanou adresu ==}
 
function Store(Adr:word;Data:word):boolean;
{== Ulozi data na zadanou adresu. Pri chybne adrese vraci true ==}
 
procedure StoreProc(Adr:word;Data:word);
{== Ulozi data na zadanou adresu. ==}
 
function GetStat(Adr:word):boolean;
{== Vrati priznak platnosti dat na zadane adrese, true znamena data platna ==}
 
function GetData(Adr:word):word;
{== Vrati data ze zadane adresy. Pri chybne adrese vraci same jednotky ==}
 
end; {object}
 
implementation
 
function InRange(What,Start,Finish:word):boolean;
{== Vraci true pokud What spada do rozsahu [Start..Finish] ==}
{ Pomocna funkce }
begin InRange:=(What>=Start) and (What<=Finish)
end; {InRange}
 
procedure PicData_t.Init(ProcInfo:ProcInfo_t);
{== Zapamatuje si typ procesoru ( jeho prametry ) a smaze datovou oblast ==}
var i:integer;
begin _Proc:=ProcInfo;
{-- inicializace bufferu --}
for i:=0 to DataBufLen-1 do begin _Buf[i].W:=0;
_Buf[i].S:=false;
end;
{-- inicializace jednotlivych oblasti--}
for i:=_Proc.PM_Base to _Proc.PM_Base+_Proc.PM_Len-1 do
_Buf[i].W:=_Proc.PM_Mask;
for i:=_Proc.DM_Base to _Proc.DM_Base+_Proc.DM_Len-1 do
_Buf[i].W:=_Proc.DM_Mask;
for i:=_Proc.CM_Base to _Proc.CM_Base+_Proc.CM_Len-1 do
_Buf[i].W:=_Proc.CM_Mask;
end; {Init}
 
procedure PicData_t.GetProcInfo(var ProcInfo:ProcInfo_t);
{== Vrati aktualni parametry procesoru ==}
begin ProcInfo:=_Proc;
end; {GetProcInfo}
 
function PicData_t.TestAdr(Adr:word):RangeType_t;
{== Vrati typ pametoveho prostoru pro zadanou adresu ==}
begin TestAdr:=_INVALID_; { nepasuje do zadneho rozsahu }
with _Proc do
begin if Name=''
then begin exit; { neni dany typ procesoru }
end;
if Adr>DataBufLen
then begin exit; { adresa mimo rozsah bufferu }
end;
if (PM_Len>0) and (Adr>=PM_Base) and (Adr<=PM_Base+PM_Len)
then begin TestAdr:=_PM_;
exit;
end;
if (CM_Len>0) and (Adr>=CM_Base) and (Adr<=CM_Base+CM_Len)
then begin TestAdr:=_CM_;
exit;
end;
if (DM_Len>0) and (Adr>=DM_Base) and (Adr<=DM_Base+DM_Len)
then begin TestAdr:=_DM_;
exit;
end;
if Adr=Cfg_Base
then begin TestAdr:=_CFG_;
exit;
end;
end;
end; {TestAdr}
 
function PicData_t.Store(Adr:word;Data:word):boolean;
{== Ulozi data na zadanou adresu. Pri chybne adrese vraci true ==}
begin case TestAdr(Adr) of
_INVALID_ : begin {-- chybna adresa - nic nedelej --}
Store:=true;
exit;
end;
_PM_ : data:=data and _Proc.PM_Mask; { maskuj data }
_DM_ : data:=data and _Proc.DM_Mask;
_CM_ : data:=data and _Proc.CM_Mask;
_CFG_ : data:=data and _Proc.Cfg_Mask;
end; {case}
{-- platna adresa - uloz data --}
Store:=false;
_Buf[Adr].S:=true; { datova polozka platna }
_Buf[Adr].W:=data; { vlastni data }
end; {Store}
 
procedure PicData_t.StoreProc(Adr:word;Data:word);
{== Ulozi data na zadanou adresu ==}
begin if Store(Adr, Data) then;
end; {StoreProc}
 
function PicData_t.GetStat(Adr:word):boolean;
{== Vrati priznak platnosti dat na zadane adrese, true znamena data platna ==}
begin GetStat:=false;
if TestAdr(Adr)=_INVALID_ then exit;
GetStat:=_Buf[Adr].S;
end; {GetStat}
 
function PicData_t.GetData(Adr:word):word;
{== Vrati data ze zadane adresy. Pri chybne adrese vraci same jednotky ==}
begin GetData:=$FFFF;
if TestAdr(Adr)=_INVALID_ then exit;
GetData:=_Buf[Adr].W;
end; {GetData}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_DEFS.PAS
0,0 → 1,525
unit PP_DEFS;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde jsou definice zavisle na vlastnostech jednotlivych procesoru. }
{ Dale jsou zde procedury, ktere prpimo souvisi s definovanymi datovymi }
{ strukturami }
{===========================================================================}
 
interface
 
uses PP_COMON; { jen procedura Error }
 
{===========================================================================}
{ Definice celkoveho rozsahu adresoveho prostoru pri programovani PICu }
{===========================================================================}
 
const DataBufLen=$4000; { Maximalne 2 x 8 K slov pameti programu }
{ dat a konfigurace }
 
{===========================================================================}
{ Definice typu a konstant souvisejicich se zpracovanim prepinacu pro }
{ definovani konfiguracniho slova. }
{===========================================================================}
 
{-- Definice konstant pro rozsah mezi --}
 
const CfgDefProcCount = 5; { pocet skupin procesoru }
CfgDefSwCount = 15; { maximalni pocet prepinacu u jedne skupiny }
CfgWordLen = 14; { maximalni pocet bitu Cfg slova }
CfgNameLen = 10; { maximalni delka jmena definice skupiny }
CfgKeyLen = 10; { maximalni delka prepinace }
 
{-- Definice typu pro popis jednoho prepinace --}
 
type CfgDefSw_t=record
Key : string[CfgKeyLen]; { jmeno prepinace }
On : string[CfgWordLen]; { hodnota pro stav _ON }
Off : string[CfgWordLen]; { hodnota pro stav _OFF }
Bits : string[CfgWordLen]; { definice pro _xxx u vicebitovych prepinacu }
end; {record}
 
{ Key definuje jmeno prepinace ( napr CP pro Code Protection ) }
{ On definuje stav jednotlivych bitu pro stav On }
{ Off definuje stav jednotlivych bity pro stav Off }
{ Bits definuje kam prijdou jednotlive bity vicebitoveho prepinace }
 
const CfgX:string[CfgWordLen]=''; { sama 'X' o delce Cfg slova }
 
{-- Definice typu pro popis jedne skupinu procesoru --}
 
type CfgDefProc_t=record
ProcId : string[CfgNameLen]; { jmeno skupiny procesoru }
Info : array[1..CfgDefSwCount] of CfgDefSw_t;
end; {record}
 
{-- Definice typu pro popis vsech skupin procesoru --}
 
type CfgDef_t=array[1..CfgDefProcCount] of CfgDefProc_t;
 
{-- Definice konstanty popisu prepinace s prazdnym obsahem --}
 
const CfgDefSwNull:CfgDefSw_t=
( Key : '';
On : '';
Off : '';
Bits : ''
);
 
{-- Vlastni definice vsech skupin procesoru --}
 
{$I PP_CFG.PAS} { Abychom tady nemeli tisic radek definice }
 
{===========================================================================}
{ Hlavicky funkci a procedur pro podporu zpracovani prepinacu }
{ modifikujicich konfiguracni slovo. }
{===========================================================================}
 
function CfgFindProcGroup(Par:string;var CfgDef:CfgDef_t):integer;
{== Vrati index do tabulky CfgDef pro zadane jmeno skupiny procesoru ==}
{ Pri nenalezeni vraci cilo 0 }
 
procedure CfgDisplayHelp(var CfgDefProc:CfgDefProc_t);
{== Zobrazi help pro Cfg prepinace zadane skupiny procesoru ==}
 
procedure CfgDisplayHelpAll(var CfgDef:CfgDef_t);
{== Zobrazi help od prepinacu Cfg slova pro vechny skupiny procesoru ==}
 
function CfgTestKey(Par:string;var CfgDefProc:CfgDefProc_t):string;
{== Otestuje parametr ( retezec s jednim prepinacem ) na vsechny ==}
{ prepinace dane skupiny procesoru a vrati vysledek jako }
{ tristavovy retezec. Pri chybe vraci prazdny retezec. }
 
function CfgOr(s1,s2:string):string;
{== Slouci dva Cfg retezce do jednoho. ==}
{ V pripade konfliktu vraci prazdny retezec }
 
function CfgOverride(s,os:string):string;
{== Modifikuje platne Cfg string s platnymi bity Cfg stringu os ==}
{ V pripade chybneho rozmeru retezcu vraci prazdny retezec }
 
function CfgTestKeyMultiple(var Pars:string;var CfgDefProc:CfgDefProc_t):string;
{== Zadavam retezec prepinacu a popis procesorove specifickych prepinacu. ==}
{ Zpracovane parametry z Pars vykousnu. Vracim Cfg slovo jako tristavovy }
{ retezec. }
{ Pokud je chyba, vracim prazdny retezec a v Pars je prepinac, ktery }
{ zpusobil chybu na prvni pozici }
 
function Word2Str(W:word):string;
{== Prevede binarni data W na retezec ( tristavovy ) ==}
 
function Str2Word(S:string):word;
{== Prevede Cfg string na binarni data ==}
{ Misto bitu 'X' da '1' }
 
{===========================================================================}
{ Definice typu a konstant popisujicich parametry jednotlivych procesoru. }
{===========================================================================}
 
{-- Definice konstant urcujicich meze -}
 
const ProcName_l = 14; { Maxialni delka jmena procesoru }
ProcCount = 78; { Pocet definovanych procesoru }
 
{-- Definice typu pro identifikaci programovaciho algoritmu --}
 
type ProcAlg_t=
( _NONE_, { Nedefinovana hodnota }
_NON2WIRE_, { Algoritmus neni seriovy ( nepodporuji ) }
{-- EPROM a OTP --}
_EPROM1_, { Stary algoritmus pro EPROM ( PIC12C5xx ) }
_EPROM2_, { Standardni EPROM }
_EPROM3_, { Standardni EPROM se slovem 16 bitu }
{-- EEPROM a FLASH --}
_EE1_, { Standardni Flash / EEPROM }
_EE2_ { Flash / EEPROM s prikazem }
{ Begin Programming Only Cycle }
);
 
{-- Definice typu informace o procesoru --}
 
type ProcNam_t=string[ProcName_l+1];
 
type ProcInfo_t=record
Name : ProcNam_t; { jmeno procesoru }
Alg : ProcAlg_t; { identifikace algoritmu }
Tprog : word; { programovaci cas v us }
Bits : word; { pocet predavanych bitu }
Cfg : string[CfgNameLen]; { druh konfiguracniho slova }
Cfg_Base, Cfg_Mask : word; { adresa Cfg a maska platnych bitu }
PM_Base, PM_Len, PM_Mask : word; { pamet programu }
CM_Base, CM_Len, CM_Mask : word; { pamet konfigurace }
DM_Base, DM_Len, DM_Mask : word; { pamet dat }
end; {record}
 
{-- Defince konstanty parametru procesoru s prazdnym obsahem --}
 
const ProcDummyInfo:ProcInfo_t =
( Name: '';
Alg: _NONE_;
Tprog: 0;
Bits: 0;
Cfg: '';
Cfg_Base: $0000;
Cfg_Mask: $0000;
PM_Base:$0000; PM_Len:$0000; PM_Mask:$0000;
CM_Base:$0000; CM_Len:$0000; CM_Mask:$0000;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
);
 
{-- Defice vlastniho popisu vsech procesoru --}
 
{$I PP_PROC.PAS}
 
{===========================================================================}
{ Hlavicky funkci a procedur souvisejicich s definici parametru procesoru. }
{===========================================================================}
 
procedure ProcDisplayAlg(Alg:ProcAlg_t;Tprog:word);
{== Zobrazi citelne jmeno algoritmu ==}
 
procedure ProcDisplayInfoAll;
{== Zobrazi info o vsech znamych procesorech ==}
{ Strankuje s pauzou }
 
procedure ProcDisplayInfo(ProcInfo:ProcInfo_t);
{== Zobrazi info o jednom procesoru i s nadpisem ==}
 
procedure ProcFind(s:string; var ProcInfo:ProcInfo_t);
{== Najde podle retezce informace o procesoru ==}
 
implementation
 
{===========================================================================}
{ Funkce a procedury pro podporu zpracovani prepinacu modifikujicich }
{ konfiguracni slovo. }
{===========================================================================}
 
function CfgFindProcGroup(Par:string;var CfgDef:CfgDef_t):integer;
{== Vrati index do tabulky CfgDef pro zadane jmeno skupiny procesoru ==}
{ Pri nenalezeni vraci cilo 0 }
var i:integer;
begin i:=CfgDefProcCount+1;
repeat dec(i);
until (i=0) or (Par=CfgDef[i].ProcId);
CfgFindProcGroup:=i;
end; {CfgFindProcGroup}
 
procedure CfgDisplayHelp(var CfgDefProc:CfgDefProc_t);
{== Zobrazi help pro Cfg prepinace zadane skupiny procesoru ==}
var i:integer;
begin write(CfgDefProc.ProcId:10,': ');
for i:=1 to CfgDefSwCount do
write(CfgDefProc.Info[i].Key,' ');
writeln;
end; {CfgDisplayHelp}
 
procedure CfgDisplayHelpAll(var CfgDef:CfgDef_t);
{== Zobrazi help od prepinacu Cfg slova pro vechny skupiny procesoru ==}
var i:integer;
begin writeln('Processor specific switches for Config Word overiding: ');
writeln;
for i:=1 to CfgDefProcCount do
CfgDisplayHelp(CfgDef[i]);
writeln;
end; {CfgDisplayHelpAll}
 
function CfgTestSingleKey(Par:string; Def:CfgDefSw_t):string;
{== Otestuje zda parametr Par odpovida definici Def a vrati retezec ==}
{ obsahujici konfig slovo ve tristavove logice. Pri chybe varci }
{ prazdny retezec }
{ Pomocna funkce }
var i:integer;
BitCount:integer; { pocet bitu 1..8 podle definice }
ParValue:byte; { sem se nactou bity z Par }
begin if pos(Def.Key,Par)=0 then begin CfgTestSingleKey:='';
exit;
end;
if Par=Def.Key+'_ON' then begin CfgTestSingleKey:=Def.On;
exit;
end;
if Par=Def.Key then begin CfgTestSingleKey:=Def.On;
exit;
end;
if Par=Def.Key+'_OFF' then begin CfgTestSingleKey:=Def.Off;
exit;
end;
if Def.Bits='' then begin CfgTestSingleKey:='';
exit;
end;
{-- pocet definovanych bitu --}
BitCount:=0;
for i:=1 to length(Def.Bits) do
begin if (Def.Bits[i] <> 'X') and not (Def.Bits[i] in ['0'..'7'])
then Error('Internal Error 1 at TestKey',0);
if Def.Bits[i] in ['0'..'7']
then if 1+byte(Def.Bits[i])-byte('0') > BitCount
then BitCount:=1+byte(Def.Bits[i])-byte('0');
end;
if BitCount=0 then Error('Internal Error 2 at TestKey',0);
if BitCount>8 then Error('Internal Error 3 at TestKey',0);
if length(Par)<>length(Def.Key)+1+BitCount
then begin CfgTestSingleKey:='';
exit;
end;
{-- precti bity --}
ParValue:=0;
for i:=1 to BitCount do
begin case Par[length(Def.Key)+1+i] of
'0' : ParValue:=ParValue*2;
'1' : ParValue:=ParValue*2+1;
else begin CfgTestSingleKey:='';
exit;
end;
end; {case}
end;
{-- sestav vysledek --}
CfgTestSingleKey[0]:=char(CfgWordLen);
for i:=1 to CfgWordLen do
begin if Def.Bits[i]='X'
then CfgTestSingleKey[i]:='X'
else if ((ParValue shr (byte(Def.Bits[i])-byte('0'))) and 1) = 0
then CfgTestSingleKey[i]:='0'
else CfgTestSingleKey[i]:='1';
end;
end; {CfgTestSingleKey}
 
function CfgTestKey(Par:string;var CfgDefProc:CfgDefProc_t):string;
{== Otestuje parametr ( retezec s jednim prepinacem ) na vsechny ==}
{ prepinace dane skupiny procesoru a vrati vysledek jako }
{ tristavovy retezec. Pri chybe vraci prazdny retezec. }
var i:integer;
s:string;
begin if Par='' then begin CfgTestKey:=''; { to je vlastne chyba, }
exit; { nevracim zadne slovo }
end;
i:=1;
repeat s:=CfgTestSingleKey(Par,CfgDefProc.Info[i]);
inc(i);
until (s<>'') or (i>CfgDefSwCount);
CfgTestKey:=s;
end; {CfgTestKey}
 
procedure CfgDisplayCfgBits(s:string);
{== Zobrazi citelne druh konfiguracnich bitu ==}
{ Pomocna procedura ( ProcDisplayInfoLine ) }
begin write(copy(s+' ',1,9));
end; {CfgDisplayCfgBits}
 
function CfgOr(s1,s2:string):string;
{== Slouci dva Cfg retezce do jednoho. ==}
{ V pripade konfliktu vraci prazdny retezec }
var i:integer;
begin CfgOr:='';
if length(s1)<>length(s2) then exit;
for i:=1 to length(s1) do
case s1[i] of
'0' : case s2[i] of
'0' : CfgOr[i]:='0';
'1' : exit;
'X' : CfgOr[i]:='0';
else exit;
end; {case}
'1' : case s2[i] of
'0' : exit;
'1' : CfgOr[i]:='1';
'X' : CfgOr[i]:='1';
else exit;
end; {case}
'X' : case s2[i] of
'0' : CfgOr[i]:='0';
'1' : CfgOr[i]:='1';
'X' : CfgOr[i]:='X';
else exit;
end; {case}
else exit; { chyba }
end; {case}
CfgOr[0]:=s1[0]; { delka retezce }
end; {CfgOr}
 
function CfgOverride(s,os:string):string;
{== Modifikuje platne Cfg string s platnymi bity Cfg stringu os ==}
{ V pripade chybneho rozmeru retezcu vraci prazdny retezec }
var i:integer;
begin CfgOverride:='';
if length(s)<>length(os) then exit;
for i:=1 to length(s) do
case os[i] of
'0' : CfgOverride[i]:='0';
'1' : CfgOverride[i]:='1';
'X' : CfgOverride[i]:=s[i];
else exit; { chyba }
end; {case}
CfgOverride[0]:=s[0]; { delka retezce }
end; {CfgOverride}
 
function CfgTestKeyMultiple(var Pars:string;var CfgDefProc:CfgDefProc_t):string;
{== Zadavam retezec prepinacu a popis procesorove specifickych prepinacu. ==}
{ Zpracovane parametry z Pars vykousnu. Vracim Cfg slovo jako tristavovy }
{ retezec. }
{ Pokud je chyba, vracim prazdny retezec a v Pars je prepinac, ktery }
{ zpusobil chybu na prvni pozici }
var CfgOne : string; { jeden klic ( prepinac ) }
CfgSuma : string; { mezisoucet klicu }
ErrStr : string; { meziuschova nezpracovatelnych klicu }
begin ErrStr:='';
CfgSuma:=CfgX;
while Pars<>'' do { dokud nezpracuji vse z retezce Pars }
begin {-- zpracuj jeden prepinac --}
CfgOne:=CfgTestKey(GetWord(Pars),CfgDefProc);
if CfgOne=''
then ErrStr:=ErrStr+' '+GetWord(Pars)
else begin CfgSuma:=CfgOr(CfgSuma,CfgOne);
if CfgSuma=''
then begin {-- konfliktni parametry --}
CfgTestKeyMultiple:='';
Pars:=Pars+ErrStr;
exit;
end;
end;
Pars:=DelWord(Pars);
end;
CfgTestKeyMultiple:=CfgSuma; { vysledne konfiguracni slovo }
Pars:=ErrStr; { prepinace, ktere neznam }
end; {CfgTestKeyMultiple}
 
function Word2Str(W:word):string;
{== Prevede binarni data W na retezec ( tristavovy ) ==}
var i:integer;
begin Word2Str[0]:=char(CfgWordLen); { delka retezce }
for i:=CfgWordLen downto 1 do
begin if ( W and 1 ) = 1 then Word2Str[i]:='1' { jednotlive bity }
else Word2Str[i]:='0';
W := W shr 1; { dalsi bit }
end;
end; {Word2Str}
 
function Str2Word(S:string):word;
{== Prevede Cfg string na binarni data ==}
{ Misto bitu 'X' da '1' }
var W:word;
i:integer;
begin W:=0;
for i:=1 to length(S) do
if S[i]<>'0' then W := ( W shl 1 ) + 1
else W := ( W shl 1 );
Str2Word:=W;
end; {Str2Word}
 
{===========================================================================}
{ Funkce a procedury souvisejicich s definici parametru procesoru. }
{===========================================================================}
 
procedure ProcDisplayAlg(Alg:ProcAlg_t;Tprog:word);
{== Zobrazi citelne jmeno algoritmu ==}
begin case Alg of
_NONE_ : write('NONE ');
_EPROM1_ : write('EPROM1 ');
_EPROM2_ : write('EPROM2 ');
_EPROM3_ : write('EPROM3 ');
_EE1_ : write('EE1 ');
_EE2_ : write('EE2 ');
_NON2WIRE_ : write('NON2WIRE');
else write('?? ');
end; {case}
write(Tprog:6,' '); { programovaci cas v us }
end; {ProcDisplayAlg}
 
procedure ProcDisplayInfoLine(ProcInfo:ProcInfo_t);
{== Zobrazi v lidske podobe nektere informace o procesoru ==}
var s:string;
i:integer;
begin s:=ProcInfo.Name;
for i:=length(s)+1 to ProcName_l do s:=s+' ';
write(s,' ');
ProcDisplayAlg(ProcInfo.Alg,ProcInfo.Tprog);
CfgDisplayCfgBits(ProcInfo.Cfg);
DisplayRange(ProcInfo.PM_Base,ProcInfo.PM_Len);
DisplayRange(ProcInfo.CM_Base,ProcInfo.CM_Len);
DisplayRange(ProcInfo.DM_Base,ProcInfo.DM_Len);
writeln;
end; {ProcDisplayInfoLine}
 
procedure ProcDisplayInfoHeader;
{== Zobrazi nadpis ==}
begin writeln('Proc Name Alg Tprog[us] Cfg Bits Pgm Memory Cfg Memory Dat Memory');
writeln('--------------------------------------------------------------------------');
end; {ProcDisplayInfoHeader}
 
procedure ProcDisplayInfoAll;
{== Zobrazi info o vsech znamych procesorech ==}
{ Strankuje s pauzou }
var i,j:integer;
begin i:=0;
while i<ProcCount do
begin ProcDisplayInfoHeader;
j:=0;
while (i<ProcCount) and (j<22) do
begin inc(i);
inc(j);
ProcDisplayInfoLine(ProcInfoAll[i]);
end;
if i<ProcCount then PressEnter;
end;
end; {ProcDisplayInfoAll}
 
procedure ProcDisplayInfo(ProcInfo:ProcInfo_t);
{== Zobrazi info o jednom procesoru i s nadpisem ==}
begin ProcDisplayInfoHeader;
ProcDisplayInfoLine(ProcInfo);
writeln;
end; {ProcDisplayInfo}
 
procedure ProcFind(s:string; var ProcInfo:ProcInfo_t);
{== Najde podle retezce informace o procesoru ==}
var i:integer;
begin {-- separace jmena procesoru z retezce --}
s:=upstr(s)+' ';
ProcInfo:=ProcDummyInfo;
i:=pos('PIC',s);
if i=0 then exit;
s:=copy(s,i,255);
i:=pos(' ',s);
s:=copy(s,1,i-1);
{-- nalezeni informaci --}
for i:=1 to ProcCount do
if (ProcInfoAll[i].Name+' ') = s+' '
then ProcInfo:=ProcInfoAll[i];
end; {ProcFind}
 
{===========================================================================}
{ Telo jednotky. }
{===========================================================================}
 
procedure VerifyProcInfo;
{== Procedura provede interni test konzistentnosti dat ==}
var i:integer;
begin for i:=1 to ProcCount do
with ProcInfoAll[i] do
begin {-- kontrola delky jmena procesoru --}
if length(Name) > ProcName_l
then Error('Internal Error: IE01',0);
{-- kontrola rozsahu pametovych prostoru --}
if PM_Base+PM_Len>DataBufLen
then Error('Internal Error: IE02',0);
if CM_Base+CM_Len>DataBufLen
then Error('Internal Error: IE03',0);
if DM_Base+DM_Len>DataBufLen
then Error('Internal Error: IE04',0);
{-- kontrola zda znam vsechny uvedene Cfg --}
if (ProcInfoAll[i].Cfg<>'') and (CfgFindProcGroup(ProcInfoAll[i].Cfg,CfgDefAll)=0)
then Error('Internal Error: IE5',0);
end;
end; {VerifyProcInfo}
 
var i:integer;
 
begin {-- kontroluje konzistentnost konstant --}
VerifyProcInfo;
{-- inicializace prazdne konstanty pro Cfg slovo ( same 'X' ) --}
CfgX[0]:=char(CfgWordLen);
for i:=1 to length(CfgX) do CfgX[i]:='X';
end.
 
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_IO.PAS
0,0 → 1,318
unit PP_IO;
 
{===========================================================================}
{ (c) miho / DECROS/ICZ 2000/2001/2002 }
{===========================================================================}
{ Zde jsou procedury a funkce pro vstup a vystup dat v definovanych }
{ formatech ( viz IO_t ). Je to objekt, ktery dedi datovy objekt. }
{===========================================================================}
{verze: }
{1.00 - Uvodni verze }
{1.01 - Uprava exportu Config Word pro obvody s _EPROM1_ PEFI }
 
interface
 
uses PP_COMON,
PP_DATA,
PP_DEFS;
 
const ItemPerLine=8; { Pocet polozek na jedne radce exportu }
 
type IO_t=
( _HEX_, { vyber IO filtru typu text }
_TXT_, { vyber IO filtru typu intel hex }
_NIL_ { neplatna volba }
);
 
type PicDataIo_t=object(PicData_t)
 
procedure Export( Name:string; Format:IO_t; Source:string);
{== Vystup dat z objektu do souboru ==}
 
procedure Import( Name:string; Format:IO_t);
{== Vstup dat ze souboru do datoveho objektu ==}
 
end; {object}
 
 
 
implementation
 
{===========================================================================}
{ Export dat do souboru }
{===========================================================================}
 
procedure _LineOut_TXT_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
{== Pomocna procedura vypise radek TXT dat z datatoveho objektu do souboru ==}
var i:integer;
begin HexWord(f,Adr);
write(f,': ');
for i:=0 to Count-1 do HexWordSp(f,Data.GetData(Adr+i));
writeln(f);
end; {_LineOut_TXT_}
 
procedure _LineOut_HEX_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
{== Pomocna procedura vypise radek HEX dat z datoveho objektu do souboru ==}
var i:integer;
dat:word;
suma:byte; { kontrolni soucet HEX }
procedure sum(data:word);
begin inc(suma,data);
inc(suma,data shr 8);
end; {sum}
begin suma:=0;
write(f,':10');
sum($10);
HexWord(f,Adr*2);
sum(Adr*2);
write(f,'00');
for i:=0 to Count-1 do begin dat:=Data.GetData(Adr+i);
HexByte(f,dat);
HexByte(f,dat shr 8);
sum(dat);
end;
HexByte(f,byte(-suma));
writeln(f);
end; {_LineOut_HEX_}
 
procedure PicDataIo_t.Export( Name:string; Format:IO_t; Source:string);
{== Vystup dat z objektu do souboru ==}
var f:text;
i:integer;
len:word;
Proc:ProcInfo_t;
begin Name:=UpStr(Name);
writeln('Exporting data to file: ',Name);
{== Zalozeni souboru ==}
assign(f,Name);
{$I-}
rewrite(f);
{$I+}
if ioresult<>0 then Error('Unable create file: '+Name,0);
{== Hlavicka souboru ==}
{$I-}
case format of
_TXT_ : begin writeln(f,source);
writeln(f);
end;
_HEX_ : ;
end; {case}
{== Telo souboru ( data ) ==}
{-- Pamet programu --}
GetProcInfo(Proc); { vytahni si parametry }
if Proc.PM_Len>0 then
begin i:=0;
while i<Proc.PM_Len do
begin if (i+ItemPerLine)<Proc.PM_Len
then len:=ItemPerLine
else len:=Proc.PM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.PM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.PM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
end;
{-- Pamet dat --}
if Proc.DM_Len>0 then
begin i:=0;
while i<Proc.DM_Len do
begin if (i+ItemPerLine)<Proc.DM_Len
then len:=ItemPerLine
else len:=Proc.DM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.DM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.DM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
end;
{-- Konfiguacni pamet --}
if Proc.CM_Len>0 then
begin i:=0;
while i<Proc.CM_Len do
begin if (i+ItemPerLine)<Proc.CM_Len
then len:=ItemPerLine
else len:=Proc.CM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.CM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.CM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
 
{-- konfiguracni slovo -- }
{-- jen u procesoru s algoritmem _EPROM1_,}
{-- tam neni soucasti konfig. pameti }
if Proc.Alg=_EPROM1_ then
begin
case format of
_TXT_ : _LineOut_TXT_(f,Proc.Cfg_Base,1,self);
_HEX_ : _LineOut_HEX_(f,Proc.Cfg_Base,1,self);
end; {case}
end;
 
{== Paticka souboru ==}
case format of
_TXT_ : ;
_HEX_ : writeln(f,':00000001FF');
end; {case}
{== Uzavreni souboru ==}
close(f);
{$I+}
if ioresult<>0 then Error('Unable write to file: '+name,0);
end; {Export}
 
{===========================================================================}
{ Import dat ze souboru }
{===========================================================================}
 
procedure _LineIn_TXT_(var s:string; var Data:PicData_t; LineNumber:integer);
{== Pomocna procedura zpracuje radku TXT textu a data ulozi do datoveho objektu ==}
var i:integer;
 
adr,dat:word;
valid:boolean;
procedure blank;
begin while ( (s[i]=' ') or (s[i]=#8) ) and (i<length(s)) do inc(i);
end;
procedure hex;
begin dat:=0;
valid:=false;
blank;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=true;
if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
else dat:=16*dat+(ord(s[i])-ord('A')+10);
inc(i);
end;
blank;
if s[i]<>':' then Error('Invalid file format, ":" expected',LineNumber);
inc(i);
if not valid then Error('Invalid file format, Address expected',LineNumber);
adr:=dat;
blank;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=false;
dat:=0;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=true;
if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
else dat:=16*dat+(ord(s[i])-ord('A')+10);
inc(i);
end;
blank;
if valid then begin if Data.Store(adr,dat)
then Error('Bad Address',LineNumber);
inc(adr);
end;
end;
if (s[i]<>';') and (s[i]<>'#')
then Error('Invalid file format, unexpected char "'+s[i]+'"',LineNumber);
end;
begin if length(s)=0 then exit;
i:=1;
blank;
s:=s+';';
while (i<=length(s)) and ( s[i]<>';' ) and (s[i]<>'#') do
begin {-- jednotliva cisla --}
hex;
end;
end; {_LineIn_TXT_}
 
procedure _LineIn_HEX_(var s:string; var Data:PicData_t; LineNumber:integer);
{== Pomocna procedura zpracuje radku HEX textu a data ulozi do datoveho objektu ==}
var i,j:integer;
adr,dat:word;
suma:byte;
function h(i:integer):byte;
begin if s[i]<='9' then h:=(ord(s[i])-ord('0'))
else h:=(ord(s[i])-ord('A')+10);
end;
begin {-- filtrace radky --}
j:=1; { vyhod blank znaky }
for i:=1 to length(s) do if (s[i]<>' ') and (s[i]<>#8) then
begin s[j]:=s[i];
inc(j);
end;
byte(s[0]):=j-1;
if s=':00000001FF' then exit; { ukoncovaci veta }
if s[1]<>':' then exit; { platny zacatek }
if length(s)=0 then exit; { prazdne radky nevadi }
if length(s)<13 then Error('Invalid file format, line too short',LineNumber);
{-- vytazeni cislic --}
for i:=2 to length(s) do
if not (s[i]in ['0'..'9']) and not (s[i]in ['A'..'F'])
then Error('Invalid file format, illegal char',LineNumber);
j:=16*h(2)+h(3); { pocet polozek }
if j and 1 = 1 then Error('Invalid file format, odd data count',LineNumber);
if length(s) <> j*2+11 then Error('Invalid file format, line length',LineNumber);
j:=j div 2;
{-- kontrola kontrolniho souctu HEX --}
suma:=0;
for i:=0 to 2*j+5-1 do
begin {$R-} suma:=suma+h(2+i*2)*16+h(3+i*2);
{$R+}
end;
if suma<>0 then Error('CheckSum Error',LineNumber);
{-- Nacteni dat --}
adr:=(( h(4) *16 + h(5)) *16 + h(6)) *16 + h(7);
if adr and 1 = 1 then Error('Invalid file format, odd addres',LineNumber);
adr:=adr shr 1;
if (s[8]<>'0') or (s[9]<>'0') then exit;
for i:=0 to j-1 do
begin dat:=( ( h(4*i+12) *16 + h(4*i+13)) *16
+ h(4*i+10)) *16 + h(4*i+11) ;
if Data.Store(adr,dat)
then Error('Bad Address',LineNumber);
inc(adr);
end;
end; {_LineIn_HEX_}
 
procedure PicDataIo_t.Import( Name:string; Format:IO_t);
{== Vstup dat ze souboru do datoveho objektu ==}
var f:text;
s:string;
LineNumber:integer;
begin name:=UpStr(name);
writeln('Importing data from file: ',name);
assign(f,name);
{$I-}
reset(f);
{$I+}
if ioresult<>0 then Error('Unable open file: '+name,0);
{$I-}
LineNumber:=0;
repeat inc(LineNumber); { pocitani cisla radky pro pripad chyby }
readln(f,s);
s:=UpStr(s);
case Format of
_TXT_ : _LineIn_TXT_(s,self,LineNumber);
_HEX_ : _LineIn_HEX_(s,self,LineNumber);
end; {case}
until eof(f);
close(f);
{$I+}
if ioresult<>0 then Error('Unable read from file: '+name,LineNumber);
{ pro testovani importu }
{ Export('a.a',_TXT_,';Test of Import procedure'); }
end; {Import}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_PGMHW.PAS
0,0 → 1,370
unit PP_PGMHW;
 
{== Ovladani programatoru ==}
 
{========================================================}
{ (c)DECROS 2000 miho, pefi }
{ 1.0 - ovladani programatoru pres LPT a ALL03 }
{ 1.1 - zmena vystupu cisla portu z DEC na HEX }
{ - doplneni xDelayMicro(1) u vazby na ALL03 }
{========================================================}
 
 
interface
 
uses DELAY,
PP_ALL03;
 
type Logical=(zero,one,tristate); { typ pro definovani stavu vystupu }
 
type PGM = object
{-- Rodicovsky objekt pro ovladani programatoru --}
 
_PortAdr : word; { adresa portu }
_Error : string; { retezec posledni chyby }
 
constructor Init(Port:word);
{== inicializuje a zapamatuje adresu ==}
 
procedure Error(S:string);
virtual;
{== vypise chybu ==}
 
procedure Info(S:string);
virtual;
{== vypise info ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_p=^PGM;
 
type PGM_LPT = object(PGM)
{-- Objekt ovladani programatoru pres LPT --}
 
_PortStat : byte;
 
constructor Init(Port:word);
{== inicializuje, vstupem je cislo portu ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_LPT_p=^PGM_LPT;
 
type PGM_ALL = object(PGM)
{-- Objekt ovladani programatoru ALL03 --}
 
_ProgAdr : word;
 
constructor Init(Port:word);
{== inicializuje, vstupem je cislo portu ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_ALL_p=^PGM_ALL;
 
implementation
 
function num2str(w:word):string;
{== Prevede cislo na retezec ( jako HEX cislo ) ===}
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var s:string;
begin s[0]:=#4;
s[1]:=prevod[(w shr 12) and $F];
s[2]:=prevod[(w shr 8) and $F];
s[3]:=prevod[(w shr 4) and $F];
s[4]:=prevod[(w shr 0) and $F];
if s[1]='0' then s:=copy(s,2,255);
if s[1]='0' then s:=copy(s,2,255);
if s[1]='0' then s:=copy(s,2,255);
num2str:=s;
end; {num2str}
 
{========================================================}
{ }
{ Programator prazdny prototyp }
{ miho }
{========================================================}
 
constructor PGM.Init(Port:word);
{== inicializuje a zapamatuje adresu ==}
begin _PortAdr:=0;
end; {Init}
 
procedure PGM.Error(S:string);
{== vypise chybu ==}
begin _Error:=s;
end; {Error}
 
procedure PGM.Info(S:string);
{== vypise info ==}
begin writeln('INFO: ',S);
end; {Error}
 
procedure PGM.SetVcc(Voltage:real);
{== nastav napajeni ==}
begin
end; {SetVcc}
 
procedure PGM.SetVpp(Voltage:real);
{== nastav programovaci napeti ==}
begin
end; {SetVpp}
 
procedure PGM.SetReset(Stat:Logical);
{== nastav signal RESET dle Stat ==}
begin
end; {SetReset}
 
procedure PGM.SetData(Stat:Logical);
{== nastav signal DATA dle Stat ==}
begin
end; {SetData}
 
procedure PGM.SetClock(Stat:Logical);
{== nastav signal CLOCK dle Stat ==}
begin
end; {SetClock}
 
function PGM.GetData:boolean;
{== precte stav datoveho vstupu ==}
begin
end; {GetData}
 
{========================================================}
{ }
{ Programator via printer port }
{ miho }
{========================================================}
 
const LPT_DATA = $01; { Datovy vystup - RB7 }
LPT_DATAOE = $02; { Povoleni vystupu }
LPT_CLOCK = $04; { Hodiny - RB6 }
LPT_CLOCKOE = $08; { Povoleni vystupu }
LPT_VCC = $10; { Zapnuti +5V }
LPT_VPP = $20; { Zapnuti +12V na MCLR }
LPT_RES = $40; { Pripojeni 0V na MCLR }
 
LPT_DATAIN = $40; { Maska bitu pro cteni dat }
 
 
constructor PGM_LPT.Init(Port:word);
var AdrTab:array[1..3]of word absolute 0:$408;{ tabulka LPT1..LPT3 z BIOSu }
{== inicializuje a zapamatuje adresu ==}
var w:word;
begin _PortAdr:=0;
_Error:='';
_PortStat:=0;
if (port<1) or (port>3) then Error('Invalid Port Number')
else _PortAdr:=AdrTab[Port];
if _PortAdr=0 then Error('Port not Registered in BIOS');
Info('Port Address '+num2str(_PortAdr)+'H');
if _Error<>'' then fail;
if _PortAdr<>0 then system.port[_PortAdr]:=_PortStat;
end; {Init}
 
procedure PGM_LPT.SetVcc(Voltage:real);
{== nastav napajeni ==}
begin if Voltage = 5.0 then _PortStat:=_PortStat or LPT_VCC
else _PortStat:=_PortStat and not LPT_VCC;
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetVcc}
 
procedure PGM_LPT.SetVpp(Voltage:real);
{== nastav programovaci napeti ==}
begin if Voltage=13.0
then _PortStat:= LPT_VPP or ( _PortStat and not LPT_RES )
else _PortStat:= _PortStat and not LPT_VPP;
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetVpp}
 
procedure PGM_LPT.SetReset(Stat:Logical);
{== nastav signal RESET dle Stat ==}
begin case Stat of
zero : begin SetVpp(0);
_PortStat:=_PortStat or LPT_RES;
end;
one : _PortStat:=_PortStat and not LPT_RES;
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetReset}
 
procedure PGM_LPT.SetData(Stat:Logical);
{== nastav signal DATA dle Stat ==}
begin case Stat of
zero : _PortStat := ( _PortStat and not LPT_DATA ) or LPT_DATAOE;
one : _PortStat := _PortStat or LPT_DATA or LPT_DATAOE;
tristate : _PortStat := ( _PortStat and not LPT_DATAOE and not LPT_DATA )
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetData}
 
procedure PGM_LPT.SetClock(Stat:Logical);
{== nastav signal CLOCK dle Stat ==}
begin case Stat of
zero : _PortStat := ( _PortStat and not LPT_CLOCK ) or LPT_CLOCKOE;
one : _PortStat := _PortStat or LPT_CLOCK or LPT_CLOCKOE;
tristate : _PortStat := ( _PortStat and not LPT_CLOCKOE and not LPT_CLOCK )
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetClock}
 
function PGM_LPT.GetData:boolean;
{== precte stav datoveho vstupu ==}
begin GetData:=(port[_PortAdr+1] and LPT_DATAIN) = LPT_DATAIN;
xDelayMicro(1);
end; {GetData}
 
 
{========================================================}
{ }
{ Programator ALL03 }
{ pefi }
{========================================================}
 
{ Tato cast v podstate jen vola funkce jednotky ProgAll }
 
const ALL_VCC = 30;
ALL_GND = 11;
ALL_VPP = 10;
ALL_CLOCK = 28;
ALL_DATA = 29;
 
Constructor PGM_All.Init(Port:Word);
{== provede inicializaci programatoru ==}
begin
Initialize(Port);
Gnd11(true); { pripoji zem na vyvodu 11 }
end;{End Init}
 
procedure PGM_All.SetVcc(Voltage:real);
{== zapina a vypina napajeni ==}
begin
SetVoltageV1(Voltage);
if Voltage=0 then ConnectV1(ALL_VCC,false)
else ConnectV1(ALL_VCC,true);
xDelayMicro(1);
end;{End SetVcc}
 
procedure PGM_All.SetVpp(Voltage:real);
{== zapina a vypina programovaci napeti ==}
begin
SetVoltageV2(Voltage);
if Voltage=0 then ConnectV2(ALL_VPP,false)
else ConnectV2(ALL_VPP,true);
xDelayMicro(1);
end;{EndSetVpp}
 
procedure PGM_All.SetReset(Stat:Logical);
{== nastavi nebo shodi signal Reset-VPP ==}
begin
ConnectV2(ALL_VPP,false);{nejdrive nutno Vpp odpojit}
if Stat = zero then SetBit(ALL_VPP,0)
else SetBit(ALL_VPP,1);
xDelayMicro(1);
end;{EndSetReset}
 
procedure PGM_All.SetData(Stat:Logical);
{== nastavi nebo shodi signal DATA ==}
begin
if Stat = zero then SetBit(ALL_DATA,0)
else SetBit(ALL_DATA,1);
xDelayMicro(1);
end;{End SetData}
 
procedure PGM_All.SetClock(Stat:Logical);
{== nastavi nebo shodi signal CLK ==}
begin
if Stat = zero then SetBit(ALL_CLOCK,0)
else SetBit(ALL_CLOCK,1);
xDelayMicro(1);
end;{End SetClock}
 
function PGM_All.GetData:boolean;
var
stav:byte;
begin
Stav:=GetBit(ALL_DATA);
if Stav=1 then GetData:=true
else GetData:=false;
xDelayMicro(1);
end;{End GetData}
 
end.
/Modules/PICPGR3/PICPGR301A/SW/4_02/PP_PROC.PAS
0,0 → 1,885
 
{Toto je include soubor}
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice vlastnosti vsech procesoru PIC, ktere tento program znam. }
{===========================================================================}
{verze: }
{ 1.00 - Uvodni verze }
{ 1.01 - Uprava definic procesoru 12C508/509 PEFI }
 
const ProcInfoAll:array[1..ProcCount] of ProcInfo_t =
(
{-- Programovane starym algoritmem EPROM --}
( Name: 'PIC12C508';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C508A';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C509';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C509A';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE518';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE519';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C505';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani standardnim algoritmem EPROM --}
( Name: 'PIC12C671';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C672';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE673';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE674';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC14000';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC14C000';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C554';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C556';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C558';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C61';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C71';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C64';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C710';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C711';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C63';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C63A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C64A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C66';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C67';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C72';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C72A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C76';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C77';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C620';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C620A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C621';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C621A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C622';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C622A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE623';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE624';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE625';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C712';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C716';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C745';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C765';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C923';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C924';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C773';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C774';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C717';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C770';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C771';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani standardnim algoritmem EPROM ale s paritou pameti programu ( 14 bit + 2 bity parita ) --}
( Name: 'PIC16C642';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C662';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C715';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani algoritmem EEPROM / FLASH --}
( Name: 'PIC16C84';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'C84';
Cfg_Base: $2007;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F83';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F84';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F84A';
Alg: _EE2_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
{}
( Name: 'PIC16F627';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $3DFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F628';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $3DFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
{}
( Name: 'PIC16F870'; { ! nemam zarucena data }
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F871'; { ! nemam zarucena data }
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F872';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F873';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F874';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F876';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F877';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
)
);
/Modules/PICPGR3/PICPGR301A/SW/4_12/!____!.TXT
0,0 → 1,78
Programator pro PIC 16C84
- dodelan hex format
- dodelany prepinace ( XT, LP, ...., CP )
- dodelana moznost spousteni programu v programatoru
 
verze 1_3:
- predelana procedura Delay tak, aby to chodilo i na rychlych PC
 
verze 1_31:
- dodelana konverze formatu souboru zejmena za ucelem snadne konverze
formatu HEX na format TEXT
 
verze 1_32
- zmenena knihovna DELAY za novou verzi ( podpora procesoru PentiumII
nad 250MHz )
 
verze 2.00
- dopnena moznost programovani EPROM ( a OTP ) verze procesoru PIC
- zmena v chovani prepinacu ( nejsou li nikde ani v datech ani jako
prepinace tak se config slovo neprogramuje
- pro EPROM programovani se musi config slovo zadat jen v datech
 
verze 3.00
- odvozena z verze 2.01
- zcela predelana vrstva propojeni s HW programatoru ( objektove, s vyhledem
na popdoru vice programovacich HW )
- od verze 3.00 existuji 2 vyvojove podverze
VAR_MIHO - s prazdnou podporou vice hardwaru
VAR_PEFI - s doplnenou podporou programataru ALL03
 
verze 3.01
- jen znovu prelozena verze 3.00 v plne verzi s podporou jak puvodniho
maleho programatoru tak i programatoru ALL03
- v teto verzi patrne nefunguji prikazy RUN, RESET a STOP
 
verze 3.10
- rozsahle opravy ( export a import dat, oprava prikazu RUN, STOP, RESET )
 
verze 3.11
- zavedeny konstanty do programu ( vyhled na procesory s vice ne 1K pameti )
 
Udelat: - zlepsit helpy - popis formatu
- exit chybove kody ( program, verify a erase )
- pipnout pri chybe
- zautomatizovat rozpoznani formatu souboru pri importu
- v textovem formatu zavest nedefinovane hodnoty ( nejlepe ?? )
- v textovem formatu definovat komentare
- v textovem exportu uvadet v komentari vyznam configuracniho slova
- v HEX exportu exportovat jen platna data ( to bude obtizne,
mozna bude nejsnazsi predelat datove buffery do objektu )
 
verze 4.01
- velmi rozsahle zmeny ve strukture programu
- podpora mnoha druhu procesoru ( databaze ) - povinny parametr
- error level
- zmeny v programovacich algoritmech ( zmena casu )
 
verze 4.02
- primo vychazi z verze 4.01
- doplnena podpora procesoru s algoritmem EPROM1 (stare procesory jako
je PIC12C508 a podobne)
 
verze 4.10
- doplnena podpora procesoru 16F87xA
- novy algoritmus EE3 - neni dopsan
 
verze 4.11
- doplnena podpora PIC16F827A/828A/848A (novy algoritmus EE4)
- doplnena podpora PIC16F818/819 (novy algoritmus EE5)
- dodelana podpora PIC16F87xA (algoritmus EE3)
 
verze 4.12
- kosmeticke zmeny
Udelat: - podpora algoritmu EPROM3
- zpracovani prepinacu pro Cfg slovo jinych nez PIC16F
- export jen platnych dat ( HEX i TXT )
- definici procesoru a algoritmu v samostatnem souboru (.DEF)

/Modules/PICPGR3/PICPGR301A/SW/4_12/DELAY.PAS
0,0 → 1,140
unit Delay;
 
{-----------------------------------------------------------------}
{ Definovane spozdeni, ktere funguje i na }
{ vykonnejsich pocitacich }
{ }
{ Verze 1.0 portovano by miho 96 }
{ 1.1 popora kratkych casu miho 98 }
{ 1.2 podpora rychlych CPU ( rozsireni DelayCnt1 na DWORD ) }
{-----------------------------------------------------------------}
 
{$I-,S-}
 
interface
 
 
procedure xDelay(MS: Word);
{-- cas uveden v milisekundach --}
 
 
procedure xDelayMicro(MicroS: Word);
{-- cas uveden v mikrosekundach --}
{ POZOR: Casy jsou vzdy o neco delsi a za normalnich podminek }
{ je cas delsi radove o nekolik mikrosekund }
{ ( na PC Pentium 75 to dela cca 6us ). }
 
 
implementation
 
 
var DelayCnt1:longint; { kalibrace casu po 1 ms }
DelayCnt55:longint; { totez pred vydelenim 55 }
 
 
procedure DelayLoop;
begin
asm
@@Loop: SUB AX,1 { DX:AX - pocitadlo DWORD }
SBB DX,0 { dekrement }
JC @@End { doteklo }
CMP BL,ES:[DI] { pri uplynuti tiku ( 55ms ) }
JE @@Loop { taky koncim }
@@End:
end;
end;
 
 
procedure Initialize;
{-- inicializace - kalibrace casu --}
begin
asm
MOV AX,40H { adresa bunky BIOS DATA s tiky }
MOV ES,AX { po 55 ms aktualizuje BIOS }
MOV DI,6CH
MOV BL,ES:[DI]
@@Wait: CMP BL,ES:[DI]
JE @@Wait { pockej na cely tik }
MOV BL,ES:[DI] { schovej si tik do BL }
MOV AX,-28 { piskvorcova konstanta ? asi }
CWD
CALL DelayLoop { pockej na konec tiku BL }
NOT AX { a pocitej cas v DS:AX}
NOT DX
MOV word ptr [DelayCnt55],AX { uschovej kalibraci }
MOV word ptr [DelayCnt55+2],DX
end; {asm}
DelayCnt1:=DelayCnt55 div 55; { uschovej kalibraci 1 ms }
end; {Initialize}
 
 
procedure xDelay(MS: Word);
{-- proved standardni spozdeni merene v milisekundach --}
begin
asm
MOV CX,MS { pocet milisekund }
JCXZ @@End { nulova hodnota - hned konci }
MOV AX,40H { adresa BIOS COM port - to je }
MOV ES,AX { jakakoli bunka, ktera se v }
XOR DI,DI { v provozu nemeni aby se netestoval }
MOV BL,ES:[DI] { casovac a presto mohla byt }
@@Loop: MOV AX,word ptr [DelayCnt1] { procedura DelayLoop stejna }
MOV DX,word ptr [DelayCnt1+2] { DX:AX kalibracni konsatnta }
CALL DelayLoop { pro spozdeni 1 ms }
LOOP @@Loop
@@End:
end; {asm}
end; {xDelay}
 
 
procedure xDelayMicro(MicroS: Word);
{-- procedura pro spozdeni zadavane v mikrosekundach --}
label Error;
begin {-- prepocitej zadany cas na pocet cyklu --}
asm
{-- DWORD * WORD / WORD -> DWORD --}
SUB DX,DX
MOV AX,WORD PTR[DelayCnt55+2]
MOV BX,55000
MOV CX,MicroS
DIV BX
PUSH DX
MUL CX
MOV DI,DX
AND DX,DX
POP DX
JNZ Error
MOV AX,WORD PTR[DelayCnt55]
DIV BX
PUSH DX
MUL CX
MOV SI,AX
ADD DI,DX
POP AX
JC Error
MUL CX
DIV BX
ADD SI,AX
ADC DI,0
PUSH SI
PUSH DI
{-- vlastni spozdeni --}
MOV AX,40H { opet konstantni bunka }
MOV ES,AX
XOR DI,DI
MOV BL,ES:[DI]
POP DX { DX:AX cas v poctech cyklu }
POP AX
CALL DelayLoop
end; {asm}
exit;
asm
Error: MOV AX,0FFFFH
MOV DX,AX
CALL DelayLoop
end; {asm}
end;
 
 
begin Initialize; { udelej kalibraci }
end.
/Modules/PICPGR3/PICPGR301A/SW/4_12/PICPGR.EXE
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Modules/PICPGR3/PICPGR301A/SW/4_12/PICPGR.PAS
0,0 → 1,1056
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
 
program PicPgr(Input,Output);
 
{=============================================================}
{== Program pro programovani ruznych PICu ( FLASH i EPROM ) ==}
{=============================================================}
 
uses DELAY, { casova spozdeni }
PP_PGMHW, { ovladani hardwaru programatoru }
PP_COMON, { pomocne funkce }
PP_DEFS, { defince procesorove zavislych parametru }
PP_DATA, { ulozeni dat v pameti }
PP_IO; { import a export dat z/do souboru }
 
const ver : string[4] = '4.12'; { vzdy 4 znaky }
date : string[4] = '2004'; { vzdy 4 znaky }
 
{=============================================================}
{ Zmeny: }
{ 2.01 - vychozi verze pro tuto verzi }
{ 3.00 - predelana kompletne vrstva pro ovladani HW ( moznost }
{ popdory vice programatoru ) }
{ 3.01 - finalni verze s podporou programovani pres LPT port }
{ a na programatoru ALL03 }
{ 3.10 - pridana informace o zdoji dat pri vystupu v TXT }
{ formatu }
{ - cislovani radek pri vypisu chyby ve vstupnich datech }
{ - odstranena chyba exportu dat v HEX formatu }
{ - dodelana kontrola kontrolniho souctu HEX formatu }
{ - znovu zprovozneny prikazy RUN, STOP, RESET }
{ - zmena default obsahu pri konverzi z 0 na 3FFF }
{ 3.11 - cisla ve zdrojaku nahrazena konstantami }
{ 4.00 - velmi rozsahle zmeny ve strukture }
{ - prepinani parametru podle typu soucastky }
{ - zmena Vpp z 12.0V na 13.0V }
{ - doplneno zpozdeni po zapnuti napajeni }
{ - zmena programovacich casu u C/F84 (20ms na 10ms) }
{ - podpora ErrorLevel pri programovani a verifikaci }
{ 4.01 - prvni realese verze z rady 4.x }
{ 4.02 - doplnena podpora algoritmu EEPROM1 PEFI }
{ 4.10 - doplnena podpora PIC16F87xA (novy algoritmus EE3 }
{ a nove prepinace, neni dodelana veririkace !) }
{ 4.11 - doplnena podpora PIC16F627A/628A/648A (novy alg EE4) }
{ doplnena podpora PIC16F818/819 (novy alg EE5) }
{ dodelana podpora PIC16F87xA (EE3) }
{ 4.12 - kosmeticke upravy }
{ Chybi: }
{ - podpora algoritmu EPROM3 }
{ - zpracovani prepinacu pro Cfg slovo jinych nez PIC16F }
{ - export jen platnych dat ( HEX i TXT ) }
{=============================================================}
 
 
{====== Rizeni programatoru - propojeni s HW ======}
 
const P:PGM_p = nil; { Inicializovana promenna }
 
procedure InitHW(Port:word);
{== Procedura inicializuje propojeni s HW ==}
begin if port<4 then P:=new(PGM_LPT_p,Init(Port))
else P:=new(PGM_ALL_P,Init(Port));
if P=nil then Error('Unable Init HW',0);
end; {InitHW}
 
const StartPICStat:boolean=false; { true po dobu programovani }
{ Tuto promennou nastavuje procedura StartPIC a vypina procedura }
{ StopPIC. Je tedy aktivni zejmena po dobu programovani a slouzi }
{ pro zajisteni vypnuti programovaciho napeti v pripade }
{ ze program skonci predcasne. }
 
procedure StartPIC(Voltage:real);
{== Zapnuti PIC pro programovani, cteni, verifikaci ==}
{ Voltage udava pracovni napajeci napeti }
begin StartPICStat:=true; { true znamena programovani }
{-- nastav definovany stav signalu --}
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(Voltage); { zapni napajeni }
P^.SetData(zero); { otevri budice }
P^.SetClock(zero);
xDelay(50); { ustaleni napeti }
P^.SetReset(one); { ukonci reset }
P^.SetVpp(13.0); { zapni Vpp }
 
xDelay(50); { ustaleni napeti }
end; {StartPIC}
 
procedure EndPIC;
{== Vypnuti PIC po programovani ==}
begin P^.SetData(tristate); { odpoj vystupy }
P^.SetClock(tristate);
P^.SetVpp(0); { odpoj Vpp }
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(0); { vypni Vcc }
xDelay(50); { pockej }
P^.SetReset(one); { a odpoj i reset ( pokud je napajeni zvenku ) }
{ tak se to rozbehne }
StartPICStat:=false; { false znamena konec programovani }
end; {EndPIC}
 
{====== Posilani prikazu a dat do a z procesoru ======}
 
procedure OutCommandPIC(Command:word);
{== Zapise prikaz ( bez dat ) do PIC ==}
var i:integer;
begin for i:=1 to 6 do
begin if (Command and 1)=1 then P^.SetData(one)
else P^.SetData(zero);
P^.SetClock(one);
P^.SetClock(zero);
Command:=Command shr 1;
end;
P^.SetData(tristate); { odpoj datovy vystup }
end; {OutCommandPIC}
 
procedure OutputDataPIC(Bits:word; Command:word; Data:word);
{== Zapise prikaz a data do PIC ==}
{ Prenasi se bud 14 ( obvody 12 nebo 14 bitu core ) nebo 16 ( soucastky }
{ s paritou pameti programu ) bitu }
var i:integer;
begin OutCommandPIC(Command);
P^.SetData(zero); { start bit 0 }
P^.SetClock(one);
P^.SetClock(zero);
for i:=1 to Bits do
begin if (Data and 1)=1 then P^.SetData(one) { data bit }
else P^.SetData(zero);
P^.SetClock(one);
P^.SetClock(zero);
Data:=Data shr 1;
end;
P^.SetData(zero); { stop bit 0 }
P^.SetClock(one);
P^.SetClock(zero);
end; {OutputDataPIC}
 
function InputDataPIC(Bits:word; Command:word):word;
{== Posli prikaz a vrat odpoved z PIC ==}
{ Precte zadany pocet bitu dat. Tento pocet nemusi }
{ nutne souhlasit s poctem platnych bitu dat }
{ ( napriklad u souvasti s delkou slova 12 bitu ). }
var Data:word;
i:integer;
b:word;
begin OutCommandPIC(Command); { zanecha DATA jako vstup }
Data:=0;
b:=1; { bitova maska }
P^.SetClock(one); { start bit }
P^.SetClock(zero);
for i:=1 to Bits do
begin P^.SetClock(one);
P^.SetClock(zero);
if P^.GetData then Data:=Data or b; { byla datova 1 }
b:=b shl 1; { posun masku }
end;
P^.SetClock(one); { stop bit }
P^.SetClock(zero);
InputDataPIC:=Data;
end; {InputDataPIC}
 
{====== Programovaci prikazy pro PIC ======}
 
const LoadConfiguration_00 = $00; { nastav PC na 2000H }
LoadDataPM_02 = $02; { predej data pro PM }
ReadDataPM_04 = $04; { precti data z PM }
IncrementAddress_06 = $06; { posun PC o 1 }
BeginProgramming_08 = $08; { zahaj programovani, u nekterych clenu i mazani radky }
BeginProgrammingOnlyCycle_18 = $18; { zacni zapisovat, obvykle bez mazani }
LoadDataDM_03 = $03; { predej data pro DM }
ReadDataDM_05 = $05; { precti data z DM }
BulkErasePM_09 = $09; { smaz celou PM (pokud neni zamcena) }
BulkEraseDM_0B = $0B; { smaz celou DM (pokud neni zamcena) }
EndProgramming_0E = $0E; { _EPROMx_ - jen pro EPROM verze }
EndProgramming_17 = $17; { _EE5_ ukonci programovani }
Dis1_01 = $01; { _EEx_ - jen pro odstraneni code }
Dis2_07 = $07; { protection }
ChipErase_1F = $1F; { smaz celou soucastku (u nekterych na to staci BulkErasePM pokud je PC 2007) }
 
{====== Zpracovani parametru ======}
 
const Port : integer = -1; { Cislo portu pro komunikaci }
FileFormat: IO_t = _NIL_; { Format datoveho souboru }
CfgString : string = ''; { Sem si zapamatuji Cfg retezec }
{ Nenastaveny ( nepouzity ) prepinac je -1 }
 
{====== Zpracovani prepinacu ======}
 
function TestSwitch(var s:string; sw:string):boolean;
{== Pokud je sw soucasti retezce s vraci true a odstrani sw z retezce s ==}
var i:integer;
begin TestSwitch:=false;
{-- test --}
i:=pos(sw+' ',s+' ');
if i=0 then exit; { nenalezen }
{-- nalezen --}
s:=copy(s,1,i-1)+copy(s,i+length(sw)+1,255);
TestSwitch:=true;
end; {TestSwitch}
 
{====== Zpracovani Cfg parametru ======}
 
procedure CfgSwitches( var s:string; Ostre:boolean;
var Cfg:word; var CfgStat:boolean
);
{== Zpracuje prepinace konfiguracniho slova, pokud je predano true ==}
{ tak upravi hodnotu predaneho parametru. Uzere z retezce s }
{ prepinace, ktere zpracovala }
{ }
{ s retezec s parametry, zpracovane casti se uzerou }
{ Ostre true znamena, ze se maji data aktualizovat }
{ Cfg config data }
{ CfgStat priznak platnosti dat v poli Cfg }
{ }
begin {-- dle typu procesoru preda konkretni procedure --}
 
end; {CfgSwitches}
 
procedure DisplayConfigWord(Cfg:word; Cfg_Stat:boolean);
begin if Cfg_Stat
then begin write('Config Word: ');
HexWord(output,Cfg);
writeln;
end
else begin writeln('Config Word: none');
end;
end; {DisplayConfigWord}
 
procedure Switches(s:string; var Data:PicData_t);
{== Zpracovani prepinacu, volba typu soucastky, init datoveho objektu ==}
var ix:integer; { index do tabulky CfgDefAll}
Proc:ProcInfo_t; { informace o vybrane procesoru }
begin s:=UpStr(s);
{-- adresa portu --}
if TestSwitch(s,'LPT3' ) then Port := 3; { Z BIOS tabulky }
if TestSwitch(s,'LPT2' ) then Port := 2;
if TestSwitch(s,'LPT1' ) then Port := 1;
if TestSwitch(s,'ALL03') then Port := $2E0; { ALL03 porty }
{-- typ souboru --}
if TestSwitch(s,'HEX' ) then FileFormat:= _HEX_; { Moje cislovani filtru }
if TestSwitch(s,'TEXT' ) then FileFormat:= _TXT_;
if TestSwitch(s,'TXT' ) then FileFormat:= _TXT_;
{-- Default hodnoty --}
if Port = -1 then Port := 1;
if FileFormat = _NIL_ then FileFormat := _TXT_;
{-- typ a parametry soucastky --}
ProcFind(s,Proc);
if Proc.Name=''
then begin (* Volba default procesoru je zamerne zaslapnuta protoze mate uzivatele
ProcFind('PIC16F84',Proc); { Default hodnota }
*)
end
else if TestSwitch(s,Proc.Name) then; { Sezer pouzitou hodnotu }
Data.Init(Proc);
{-- prislusnost soucastky do skupiny pro Cfg prepinace --}
ix:=CfgFindProcGroup(Proc.Cfg,CfgDefAll); { i je index do konstanty CfgDefAll }
{-- zpracovani prepinacu specifickych pro Cfg slovo --}
{ s ... retezec s prepinacema, ktere jeste nebyly zpracovany }
{ ix ... index do tabulky CfgDefAll s informacemi o prepinacich skupiny }
CfgString:=CfgX; { prazdny ( sama 'X' Cfg retezec }
if ix>0 then
begin CfgString:=CfgTestKeyMultiple(s,CfgDefAll[ix]);
if CfgString='' then Error('Konflicting Cfg switch '+GetWord(s),0);
end;
if s<>'' then Error('Unrecognized switches: '+s,0);
end; {Switches}
 
{====== Hlavni cinnosti ( akce ) programu ======}
 
procedure Help;
{== Vypise navod k pouziti ==}
var i:integer;
Proc:ProcInfo_t;
begin writeln('Usage: PICPGR <what_to_do> [<file_name>] [switches]');
writeln;
writeln('PICPGR READ <file_name> <procesor> [switches]');
writeln('PICPGR PROGRAM <file_name> <procesor> [switches]');
writeln('PICPGR VERIFY <file_name> <procesor> [switches]');
writeln('PICPGR ERASE <procesor> [switches]');
writeln('PICPGR RUN [switches]');
writeln('PICPGR STOP [switches]');
writeln('PICPGR RESET [switches]');
writeln('PICPGR CONVERT <file_in> <file_out> [switches]');
writeln;
writeln('Exit: 0 O.K.');
writeln(' 1 Generic Error');
writeln(' 100 Program or Verify Error');
writeln;
writeln('Switches: LPT1*, LPT2, LPT3 Development Programmer via LPT');
writeln('*=default ALL03 HI-LO Programmer');
writeln(' TXT*, HEX Data File Format');
writeln;
PressEnter;
writeln('Note: Processor groups can have their own set of switches');
writeln(' for overiding of Config Word settins.');
writeln;
writeln(' Boolean type: CP, CP_ON, CP_OFF');
writeln(' ( CP is CP_ON )');
writeln;
writeln(' Binary string: CP_101');
writeln(' ( binary digit string must');
writeln(' have corect length )');
writeln;
writeln('Help function:');
writeln;
writeln('PICPGR Long help - all processors)');
writeln('PICPGR <proc_name> Short help - particular processor');
writeln;
{-- varianta podle toho, zda mne zajima konkretni procesor --}
ProcFind(GetParamLine(1),Proc);
if Proc.Name<>''
then begin {-- konkretni procesor --}
ProcDisplayInfo(Proc); { zobraz co je vybrane }
i:=CfgFindProcGroup(Proc.Cfg,CfgDefAll);
if i>0 then
begin writeln(Proc.Name+' specific switches for Config Word overiding:');
writeln;
CfgDisplayHelp(CfgDefAll[i]);
end;
end
else begin {-- neni konkretni procesor - zobraz vsechno --}
PressEnter;
CfgDisplayHelpAll(CfgDefAll);
PressEnter;
ProcDisplayInfoAll;
end;
halt(1);
end; {Help}
 
var Data:PicDataIo_t; { globalni promenna pro ulozeni dat }
{ globalni je proto, protoze se neda }
{ pouzit lokalni ( nevejde se na zasobnik ) }
 
procedure ToDoRead;
{== Bude se cist ==}
{ Precte obsah soucastky do pametovych bufferu }
var i:integer;
j:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Cteni --}
InitHW(Port);
writeln('Reading data from PIC ...');
StartPIC(5.0);
case Proc.Alg of
_EPROM1_:
begin {-- Read Program Memory --}
OutCommandPIC(IncrementAddress_06); {preskoc konfiguracni slovo}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{-- Read Config Memory --}
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{--- Read Config Word ---}
EndPIC;
StartPIC(5.0);
Data.StoreProc( Proc.Cfg_Base,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.Cfg_Mask
);
end;
_EPROM2_,
_EE1_,
_EE2_,
_EE3_,
_EE4_,
_EE5_ :
begin {-- Read Program Memory --}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{-- Read Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{-- Read Config Memory --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
end;
_EPROM3_:
begin Error('Algorithm EPROM3 not yet supported',0);
end;
else Error('Algorithm not supported',0);
end; {case}
EndPIC;
{-- Vystup vysledku --}
Data.Export(paramstr(2),FileFormat,';Directly read from '+Proc.Name);
writeln('... Done');
end; {ToDoRead}
 
procedure Delta(adr,data1,data2:word);
{== Vypis info o rozdilu ==}
begin HexWord(output,adr);
write(': ');
HexWord(output,data1);
write('-');
HexWord(output,data2);
writeln;
end; {Delta}
 
procedure ToDoProgram;
{== Bude se programovat ==}
var i:integer;
err,count:integer;
data_wr:word; { data, ktera se maji zapsat }
data_rd:word; { data z kontrolniho cteni }
n:integer;
Proc:ProcInfo_t;
CfgStringTmp:string;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
InitHW(Port);
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Program --}
writeln('Programming data to PIC ...');
err:=0;
count:=0;
StartPIC(5.0);
{-- Program Program Memory --}
if Proc.PM_Len>0 then
begin
if Proc.Alg=_EPROM1_ then OutCommandPIC(IncrementAddress_06); {preskoc konfiguracni slovo}
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) then { platna data ? }
begin
data_wr:=Data.GetData(i); { vezmi data }
case Proc.Alg of
_EPROM1_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
inc(n);
until (n>8) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=n*11 downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
inc(count);
end;
_EPROM2_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
inc(n);
until (n>25) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=3*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
inc(count);
end;
_EPROM3_ :
begin Error('Algorithm EPROM3 not yet supported',0);
end;
_EE1_,
_EE2_,
_EE4_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
_EE3_,
_EE5_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgrammingOnlyCycle_18);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_17);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end; {od if testujicich platnost dat}
OutCommandPIC(IncrementAddress_06); { dalsi adresa PM }
end; {od cyklu for pres vsechny adresy}
 
(*
{-- Verify Programm Memory --}
{ Dela se jen u algoritmu, ktere nemohou verifikovat }
{ prubezne pri programovani (tedy ty, ktere pregramuji }
{ vice slov najednou }
{ Zatim zadne takove algoritmy kde by to neslo po jednotlivych slovech }
{ nemame. }
case Proc.Alg of
_EE3_ :
begin {-- Dodatecna verifikace --}
{!!!!!!!!!!!! asi bude treba reset citace }
write('... Verify Program Memory ...');
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_wr:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
end;
end; {case}
*)
 
{-- Program Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin
if Data.GetStat(i)
then
begin data_wr:=Data.GetData(i);
case Proc.Alg of
_EPROM1_,
_EPROM2_,
_EPROM3_ :
begin Error('Internal Error: Algorithm EPROMx does not know Data Memory',0);
end;
_EE1_,
_EE2_,
_EE3_,
_EE4_ :
begin OutputDataPIC(Proc.Bits,LoadDataDM_03,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
_EE5_ :
begin OutputDataPIC(Proc.Bits,LoadDataDM_03,data_wr);
OutCommandPIC(BeginProgrammingOnlyCycle_18);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_17);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end;
OutCommandPIC(IncrementAddress_06);
end;
 
{-- priprav Config Word --}
if (CfgString<>'') and (CfgString<>CfgX)
then begin {-- prepinaci zmeneno Cfg slovo --}
writeln('Required Config Word: ',CfgString);
if Data.GetStat(Proc.Cfg_Base)
then begin {-- Cfg slovo bylo v datovem souboru --}
CfgStringTmp:=Word2Str(Data.GetData(Proc.Cfg_Base));
writeln('Config Word from data file: ',CfgStringTmp);
end
else begin {-- Cfg slovo nebylo v datovem souboru --}
CfgStringTmp:=CfgX; { prazdne slovo ( sama X ) }
end;
{-- sloz slovo ze souboru a z prepinacu --}
CfgString:=CfgOverride(CfgStringTmp,CfgString);
writeln('Result: ',CfgString);
{-- uloz slozene slovo do datoveho pole --}
Data.StoreProc(Proc.Cfg_Base,Str2Word(CfgString));
end;
 
{-- Program Config Memory --}
{--- algoritmus _EPROM1_ prikaz Load Configuration nezna}
if Proc.Alg<>_EPROM1_ then OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin
if Data.GetStat(i)
then
begin data_wr:=Data.GetData(i);
case Proc.Alg of
_EPROM1_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
inc(n);
until (n>8) or (data_wr=data_rd);
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=11*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
end;
_EPROM2_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
inc(n);
until (n>25) or (data_wr=data_rd);
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=3*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
end;
_EPROM3_ :
begin Error('Algorithm EPROM3 not yet supported',0);
end;
_EE1_,
_EE2_,
_EE4_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_wr xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end
else begin if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end;
inc(count);
end;
_EE3_,
_EE5_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
if (Proc.Alg=_EE3_) and (i=Proc.Cfg_Base)
then begin {-- CFG slovo i algoritmu EE3 nejde preogramovat po jednotlivych slovech --}
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
end
else begin OutCommandPIC(BeginProgrammingOnlyCycle_18);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_17);
end;
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_wr xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end
else begin if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end;
OutCommandPIC(IncrementAddress_06);
end;
 
{--- u algoritmu _EPROM1_ se konfiguracni slovo programuje zvlast}
if Proc.Alg=_EPROM1_ then
if Data.GetStat(Proc.Cfg_Base) then
begin
{--- toto zajisti prechod na konfig. bunku}
EndPIC;
StartPIC(5.0);
data_wr:=Data.GetData(Proc.Cfg_Base);
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.Cfg_Mask;
inc(n);
until (n>8) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(Proc.Cfg_Mask,data_wr,data_rd);
inc(err);
end
else for n:=n*11 downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
inc(count);
end;
end;
EndPIC;
writeln('... Done');
write('Programmed ',count,' Data Words, ');
case err of
0 : writeln('No diferences found');
1 : writeln(err,' diference found');
else writeln(err,' diferences found');
end;{case}
if err<>0 then exitcode:=100; { Jako by bylo halt(100) }
end; {ToDoProgram}
 
procedure ToDoVerify;
{== Porovnani obsahu soucastky se souborem ==}
var i:integer;
data_fi:word; { data z objektu }
data_rd:word; { data prectena ze soucastky }
err,count:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
InitHW(Port);
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Verify --}
writeln('Verifying ...');
err:=0;
count:=0;
StartPIC(5.0);
case Proc.Alg of { toto je jen test na podporovane algoritmy }
_EPROM1_,
_EPROM2_,
_EE1_,
_EE2_,
_EE3_,
_EE4_,
_EE5_ :
begin {-- Verify Program Memory --}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_fi <> data_rd
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
{-- Verify Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask;
if data_rd <> data_fi
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
{-- Verify Config Memory --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin
if Data.GetStat(i)
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_fi xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
end
else begin if data_fi <> data_rd
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
end;
_EPROM3_:
begin Error('Algorithm EPROM3 not yet supported',0);
end;
else Error('Algorithm not supported',0);
end; {case}
EndPIC;
writeln('... Done');
write('Compared ',count,' Data Words, ');
case err of
0 : writeln('No diferences found');
1 : writeln(err,' diference found');
else writeln(err,' diferences found');
end;{case}
if err<>0 then exitcode:=100; { Jako by bylo halt(100) }
end; {ToDoVerify}
 
procedure ToDoErase;
{== Bude se pouze mazat ==}
var i:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
Switches(GetParamLine(2),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Erase --}
case Proc.Alg of
_EPROM1_,
_EPROM2_,
_EPROM3_ :
begin Error('Use UV light to erase EPROM processor!',0)
end;
_EE1_,
_EE2_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- postup pro odblokovani CP soucastky --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
for i:=1 to Proc.CM_Len-1 do OutCommandPIC(IncrementAddress_06);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(12000);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
{-- Mazani datove pameti --}
{ Funguje na C84/F84/F877 ale postup je uveden jen }
{ u obvodu F84. Obvod C84 potrebuje stejny postup. }
OutputDataPIC(Proc.Bits,LoadDataDM_03,$FFFF);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(10000);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
EndPIC;
end;
_EE3_,
_EE5_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- mazani cele soucastky jednim povelem --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF); {oblast konfig bitu aby se smazala i tato oblast }
OutCommandPIC(ChipErase_1F);
xDelayMicro(8000);
EndPIC;
end;
_EE4_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- mazani pameti programu a konfig oblasti --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF); {oblast konfig bitu aby se smazala i tato oblast }
OutputDataPIC(Proc.Bits,LoadDataPM_02,$FFFF);
OutCommandPIC(BulkErasePM_09);
xDelayMicro(5000);
OutputDataPIC(Proc.Bits,LoadDataDM_03,$FFFF);
OutCommandPIC(BulkEraseDM_0B);
xDelayMicro(5000);
EndPIC;
end
else Error('Algorithm not supported',0);
end; {case}
end; {ToDoErase}
 
procedure ToDoRun;
{== Zapne napajeni a spusti program ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(5.0); { zapni napajeni }
xDelay(50); { pockej na ustaleni }
P^.SetReset(one); { skonci reset }
writeln('Running ...');
end; {ToDoRun}
 
procedure ToDoStop;
{== Vypne napajeni ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero);
P^.SetVcc(0);
writeln('... Stoped');
end; {ToDoStop}
 
procedure ToDoReset;
{== Provede Reset bez vypnuti napajeni ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero);
P^.SetVcc(5.0);
xDelay(50);
P^.SetReset(one);
writeln('... Reset ...');
end; {ToDoReset}
 
procedure ToDoConvert;
{== Procedura pro konverzi formatu souboru ==}
var s:string;
i:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<3 then Help; { chybi jmeno souboru }
Switches(GetParamLine(4),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Vystup dat --}
case FileFormat of
_HEX_ : FileFormat:=_TXT_;
_TXT_ : FileFormat:=_HEX_;
end; {case}
Data.Export(paramstr(3),FileFormat,';Converted from file '+paramstr(2));
writeln('Done');
end; {ToDoConvert}
 
{====== Hlavni program, Entry a Exit programy ======}
 
const OldExitProc:pointer=NIL; { Pro proceduru MyExitProc }
 
procedure MyExitProc;
{== Ukoncujici procedura pro pripad predcasneho ukonceni programu ==}
{ Tato procedura normalni nic ndela ale pokud je pri ukonceni }
{ programu nastaven priznak aktivity programovani zavola }
{ proceduru StopPIC. }
{ Promenne: StartPICStat .. true znamena aktivitu pri programovani }
{ P .. pointer na objekt zastupujici hardware }
far;
begin ExitProc:=OldExitProc;
if StartPICStat and (P<>nil) then EndPIC;
end; {MyExitProc}
 
begin assign(output,''); { aby slo vystup presmerovat do souboru }
rewrite(output);
writeln;
writeln('PIC Development Programmer');
writeln('==========================');
writeln('(c) miho ',date,' v ',ver);
writeln;
 
{-- test - zadny parametr --}
if paramcount=0 then Help;
{-- zaregistruj ukonceni pro pripad predcasneho skonceni programu --}
OldExitProc:=ExitProc;
ExitProc:=@MyExitProc;
{-- rozhodni cinnost --}
if UpStr(paramstr(1))='READ' then ToDoRead
else if UpStr(paramstr(1))='PROGRAM' then ToDoProgram
else if UpStr(paramstr(1))='VERIFY' then ToDoVerify
else if UpStr(paramstr(1))='ERASE' then ToDoErase
else if UpStr(paramstr(1))='RUN' then ToDoRun
else if UpStr(paramstr(1))='STOP' then ToDoStop
else if UpStr(paramstr(1))='RESET' then ToDoReset
else if UpStr(paramstr(1))='CONVERT' then ToDoConvert
else if UpStr(paramstr(1))='HELP' then Help
else Help;
Halt(exitcode); { Exitcode si nastavuji pri chybe pri programovani }
end. { nebo pri verifikaci. Je to treba uvest takto }
{ explicitne jinak se provede Halt(0). }
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_ALL03.PAS
0,0 → 1,532
unit PP_ALL03;
 
{$I-,S-}
 
{=========================================================}
{ }
{ Unita pro ovladani programatoru HI-LO model ALL-03 }
{ (c) DECROS pefi }
{---------------------------------------------------------}
{ Verze : 1.0.0 uvodni verze }
{ 1.0.1 preformatovani zdrojaku miho }
{ 1.0.2 prejmenovani na PP_ALL03.PAS }
{=========================================================}
 
interface
 
procedure ErrorProc;
{== vypise slovne obsah chyby ==}
 
procedure PowerOff;
{== vypne programator ==}
 
procedure Initialize(Baze :word);
{== ziniciuje programator a nastavi bazovou adresu programatoru ==}
 
procedure SetVoltageV1(Napeti : real);
{== nastavi napeti na prevodniku s vahou 0.4, napeti je zadavano ==}
{== ve voltech, max. napeti 9.6V. Zapina se jim programator, ==}
{== musi byt pouzit vzdy ==}
 
procedure SetVoltageV2(Napeti : real);
{== nastavi napeti na prevodniku s vahou 0.6, napeti je zadavano ==}
{== ve voltech, max. napeti 14.4V. ==}
 
procedure SetVoltageV3(Napeti : real);
{== nastavi napeti na prevodniku s vahou 1, napeti je zadavano ==}
{== ve voltech, max. napeti je 25V ==}
 
procedure SetBit(Pin,Stav:byte);
{== nastavi pin podle parametru Stav. Piny jsou v rozsahu 1-40, ==}
{== stav je 0 nebo 1. ==}
 
procedure GetBitProc (Pin:byte;var Stav:byte);
{== cte stav pinu,pin v rozsahu 1-40,Stav nabyva hodnot 0 nebo 1 ==}
 
function GetBit(Pin:byte):byte;
{== cte stav pinu, pin v rozsahu 1-40,vraci 0 nebo 1 ==}
 
procedure ConnectV1(Pin:byte;On:boolean);
{== pripojuje prevodnik V1 s vahou 0.4 k pinum, ==}
{== piny v rozsahu 24-32,34,36,40 ==}
 
procedure ConnectV2(Pin:byte;On:boolean);
{== pripojuje prevodnik V2 s vahou 0.6 k pinum. ==}
{== piny v rozsahu 9-32 ==}
 
procedure ConnectV3(Pin:byte;On:boolean);
{== pripojuje prevodnik V3 s vahou 1 k pinum. ==}
{== piny v rozsahu 1,5-7,9-32,36 ==}
 
procedure Gnd11(On:boolean);
{== prepina zem mezi piny 20 a 11, true=pin 11, false= pin20 ==}
 
procedure Led(On:boolean);
{== ovlada led s napisem 'GOOD', true= sviti, false= nesviti ==}
 
function ReadButton:boolean;
{== vypne programator a cte tlacitko s napisem 'YES' , ==}
{== true=stiknuto, false=uvolneno ==}
 
 
{=========================================================}
 
implementation
 
 
uses DELAY;
 
 
{== Definice konstant ==}
 
const InitNum = 22; { pocet registru }
 
const InitArray : array[1..InitNum,1..2] of byte =
{== zakladni inicializace tj. vsechny piny jako vstupni,prevodniky ==}
{== odpojeny od vsech pinu a vymulovany ==}
(
(231,0),(230,0),(229,0),
(238,0),(237,0),(241,0),
(242,0),(242,0),(243,0),
(232,0),(233,0),(234,0),
(235,0),(236,0),(224,255),
(225,255),(226,255),(227,255),
(228,255),(247,0),(239,0),
(245,0)
);
 
const PinSet : array[1..40,1..2] of byte =
{== tabulka pro ovladani jednotlivych pinu, na prvni pozici ==}
{== prislusny I/O registr na druhe pozici maska pinu v registru ==}
(
($E0,$01),($E0,$02),($E0,$04),($E0,$08),
($E0,$10),($E0,$20),($E0,$40),($E0,$80),
($E1,$01),($E1,$02),($E1,$04),($E1,$08),
($E1,$10),($E1,$20),($E1,$40),($E1,$80),
($E2,$01),($E2,$02),($E2,$04),($E2,$08),
($E2,$10),($E2,$20),($E2,$40),($E2,$80),
($E3,$01),($E3,$02),($E3,$04),($E3,$08),
($E3,$10),($E3,$20),($E3,$40),($E3,$80),
($E4,$01),($E4,$02),($E4,$04),($E4,$08),
($E4,$10),($E4,$20),($E4,$40),($E4,$80)
);
 
const PinConnectV1: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 0.4 k pinum, na prvni ==}
{== pozici registr pro pripojeni, na druhe pozici maska ==}
{== pinu v registru ==}
(
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($EE,$80),
($EE,$04),($EE,$02),($EE,$01),($ED,$80),
($ED,$40),($ED,$20),($ED,$10),($ED,$08),
($00,$00),($ED,$04),($00,$00),($ED,$02),
($00,$00),($00,$00),($00,$00),($ED,$01)
);
 
const PinConnectV2: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 0.6 k pinum, na prvni ==}
{== pozici registr pro pripojeni, na druhe pozici maska ==}
{== pinu v registru ==}
(
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($F1,$01),($F1,$02),($F1,$04),($F1,$08),
($F1,$10),($F1,$20),($F1,$40),($F1,$80),
($F2,$01),($F2,$02),($F2,$04),($F2,$08),
($F2,$10),($F2,$20),($F2,$40),($F2,$80),
($F3,$01),($F3,$02),($F3,$04),($F3,$08),
($F3,$10),($F3,$20),($F3,$40),($F3,$80),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00)
);
 
const PinConnectV3: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 1 k pinum, na prvni ==}
{== registr pro pripojeni, na druhe pozici maska pinu v registru ==}
(
($E8,$01),($00,$00),($00,$00),($00,$00),
($E8,$10),($E8,$20),($E8,$40),($00,$00),
($E9,$01),($E9,$02),($E9,$04),($E9,$08),
($E9,$10),($E9,$20),($E9,$40),($E9,$80),
($EA,$01),($EA,$02),($EA,$04),($EA,$08),
($EA,$10),($EA,$20),($EA,$40),($EA,$80),
($EB,$01),($EB,$02),($EB,$04),($EB,$08),
($EB,$10),($EB,$20),($EB,$40),($EB,$80),
($00,$00),($00,$00),($00,$00),($EC,$08),
($00,$00),($00,$00),($00,$00),($00,$00)
);
 
{== definice globalnich promennych ==}
 
var BazovaAdresa : word;
Error : integer; { cislo chyby }
PortStat : array[1..5] of byte; { aktualni stavy pinu }
ConnectV1Stat: array[1..2] of byte; { aktualni pripojeni prevodniku V1 }
ConnectV2Stat: array[1..3] of byte; { aktualni pripojeni prevodniku V2 }
ConnectV3Stat: array[1..5] of byte; { aktualni pripojeni prevodniku V3 }
GndStat : boolean; { =1 GND na 11, =0 GND na 20 }
 
 
{== vykonne procedury TPU ==}
 
 
{== Vytiskne hlaseni o chybe a ukonci program ==}
procedure ErrorProc;
begin
writeln;
write('Error: ');
case Error of
0:writeln('Zadna Chyba');
1:writeln('Napeti pro prevodnik mimo rozsah');
2:Writeln('Spatny stav pinu, mozne pouze 0 nebo 1');
3:Writeln('Pin mimo rozsah, mozne 1-40, u pripojeni prevodniku jen nektere');
end; {case}
writeln;
halt(1);
end; {End Error}
 
 
{== Zapise bajt do prislusneho registru programatoru ==}
procedure OutPort(Adr, Data : byte);
begin
asm
mov dx,BazovaAdresa
mov al,Adr
out dx,al
add dx,2
mov al,Data
out dx,al
end; {asm}
end; {OutPort}
 
 
{== Precte bajt a prislusneho registru programatoru ==}
function InPort(Adr : byte) : byte;
begin
asm
mov dx,BazovaAdresa
mov al,Adr
out dx,al
add dx,2
in al,dx
mov Adr,al
end; {asm}
InPort := Adr;
end;
 
 
{== Zinicializuje programator ==}
procedure PowerOff;
var n,i :byte;
begin
for i:= 1 to InitNum do
OutPort(InitArray[i,1],InitArray[i,2]);
 
{--- nastav otisk pinu}
for i:= 1 to 5 do
PortStat[i]:=255;
 
{--- nastav otisk pripojeni prevodniku V1}
for i:=1 to 2 do
ConnectV1Stat[i]:=0;
 
{--- nastav otisk pripojeni prevodniku V2}
for i:=1 to 3 do
ConnectV2Stat[i]:=0;
 
{--- nastav otisk pripojeni prevodniku V3}
for i:=1 to 5 do
ConnectV3Stat[i]:=0;
 
end; {PowerOff}
 
 
{== Inicializace programatoru se zadanim Bazove adresy ==}
procedure Initialize(Baze :word);
begin
BazovaAdresa:=Baze;
Error:=0;
GndStat:=false;
PowerOff;
end; {Initialize}
 
 
{== Zadani napeti pro prevodnik s vahou 0.4 ==}
procedure SetVoltageV1(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=9.6 then begin Voltage:=Round(((255/9.5)*Napeti));
OutPort(231,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV1}
 
 
{== Zadani napeti pro prevodnik s vahou 0.6 ==}
procedure SetVoltageV2(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=14.4 then begin Voltage:=Round(((255/14.4)*Napeti));
OutPort(230,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV2}
 
 
{== Zadani napeti pro prevodnik s vahou 1 ==}
procedure SetVoltageV3(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=25 then begin Voltage:=Round(((255/24)*Napeti));
OutPort(229,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV1}
 
 
{== Nastaveni pinu ==}
procedure SetBit(Pin,Stav:byte);
var PozReg:byte;
begin
if (Pin>=1) and (Pin<=40)
then begin
{--- urceni indexu I/O registru pro pole otisku}
if (Pin>=1) and (Pin<=8) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
 
if Stav=1
then begin
{--- pin do Log.1, zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PortStat[PozReg]); }
end
else Error:=2;
 
if Stav=0
then begin
{--- pin do log.0, zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] and not(PinSet[Pin,2]);
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PortStat[PozReg]); }
end
else Error:=2;
 
end
else Error:=3;
end; {SetBit}
 
 
{== Cteni bitu jako procedura ==}
procedure GetBitProc (Pin:byte;var Stav:byte);
var ReadBit:byte;
begin
if (Pin>=1) and (Pin<=40)
then begin
Readbit:=InPort(PinSet[Pin,1]) and PinSet[Pin,2];
if ReadBit=0 then Stav:=0
else Stav:=1;
end
else Error:=3;
end; {GetbitProc}
 
 
{== Cteni bitu jako funkce ==}
function GetBit(Pin:byte):byte;
var ReadBit:byte;
begin
Readbit:=InPort(PinSet[Pin,1]) and PinSet[Pin,2];
if ReadBit=0 then GetBit:=0
else GetBit:=1;
end; {Getbit}
 
 
{== Pripojeni prevodniku V1 s vahou 0.4 ==}
procedure ConnectV1(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit k pinum 24,26-32,34,36 a 40}
TestPin:=(Pin>=26) and (Pin<=32)or (Pin=24) or (Pin=34) or (Pin=36) or (Pin=40);
if TestPin
then begin
{ writeln('V1 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku}
if Pin=24 then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
 
{--- na pin se musi zapsat log.1, udelej zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr v poli otisku pripojeni}
if (Pin>=24) and (Pin<=27) then PozReg:=1
else PozReg:=2;
if On
then {--- udelej zaznam o pripojeni do otisku}
ConnectV1Stat[PozReg] := ConnectV1Stat[PozReg]
or PinConnectV1[Pin,2]
else {--- udelej zaznam o odpojeni do otisku}
ConnectV1Stat[PozReg] := ConnectV1Stat[PozReg]
and not( PinConnectV1[Pin,2]);
 
OutPort(PinConnectV1[Pin,1],ConnectV1Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV1}
 
 
{== Pripojeni prevodniku V2 s vahou 0.6 ==}
procedure ConnectV2(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit piny 9-32}
TestPin:=(Pin>=9) and (Pin<=32);
 
{--- pokud je pouzit pin 11 nebo 20 jako zem, nejze na nej ---}
{--- pripojit prevodnik ---}
if (Pin=11) and GndStat then TestPin:=false; { pin 11 je uzemen }
if (Pin=20) and Not(GndStat) then TestPin:=false; { pin20 je uzemen }
 
if TestPin
then begin
{ writeln('V2 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku}
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
 
{--- na pin je nutne zapsat log.1, udelej zapis do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];{nastav na pin log.1}
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr otisku pripojeni}
if (Pin>=9) and (Pin<=16) then PozReg:=1;
if (Pin>=17) and (Pin<=24) then PozReg:=2;
if (Pin>=25) and (Pin<=32) then PozReg:=3;
 
if On
then {--- udelej zaznam o pripojeni do otisku}
ConnectV2Stat[PozReg] := ConnectV2Stat[PozReg]
or PinConnectV2[Pin,2]
else ConnectV2Stat[PozReg] := ConnectV2Stat[PozReg]
and not(PinConnectV2[Pin,2]);
 
OutPort(PinConnectV2[Pin,1],ConnectV2Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV2}
 
 
{== Pripojeni prevodniku V3 s vahou 1 ==}
procedure ConnectV3(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit k pinum 1,5-7,9-32,a36}
TestPin:=(Pin>=9)and(Pin<=32)or(Pin=1)or((Pin>=5)and(Pin<=7))or(Pin=36);
 
{--- pokud je pouzit pin 11 nebo 20 pro zem, nelze na nej ---}
{--- pripojit prevodnik ---}
if (Pin=11) and GndStat then TestPin:=false; { pin 11 je uzemen }
if (Pin=20) and Not(GndStat) then TestPin:=false; { pin20 je uzemen }
 
if TestPin
then begin
{ writeln('V3 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku }
if (Pin>=1) and (Pin<=8) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
{ writeln(PozReg); }
 
{--- na pin nutno zapsat log.1 , udelej zapis do otisku }
PortStat[PozReg] := PortStat[PozReg]
or PinSet[Pin,2]; { nastav na pin log.1 }
 
OutPort(PinSet[Pin,1],PortStat[PozReg]);
 
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr otisku pripojeni}
if (Pin>=1) and (Pin<=7) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin=36) then PozReg:=5;
 
if On
then ConnectV3Stat[PozReg] := ConnectV3Stat[PozReg]
or PinConnectV3[Pin,2]
else ConnectV3Stat[PozReg] := ConnectV3Stat[PozReg]
and not(PinConnectV3[Pin,2]);
 
OutPort(PinConnectV3[Pin,1],ConnectV3Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV3}
 
 
{== Prepinani zeme mezi vyvody 11 nebo 20 ==}
{ True = pripojen Pin11 }
{ False = pripojen pin20 }
procedure Gnd11(On:boolean);
begin
if On then begin
OutPort($EF,1);
GndStat:=true;
end
else
begin
OutPort($EF,0);
GndStat:=false;
end;
end; {Gnd11}
 
 
{== Ovladani LED 'GOOD' ==}
{ True = sviti }
procedure Led(On:boolean);
begin
if On then OutPort($F7,$8)
else OutPort($F7,$0);
end; {Led}
 
 
{== Cteni tlacitka 'YES' ==}
{ True = stisknut }
function ReadButton:boolean;
begin
PowerOff;
xDelay(50);
writeln(InPort($E4));
if (InPort($E4)and $80)<>0 then ReadButton:=true
else ReadButton:=false;
end; {ReadButton}
 
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_CFG.PAS
0,0 → 1,444
 
{Toto je include soubor}
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice prepinacu pro skupiny procesoru pro definovani }
{ ( modifikaci ) konfiguracniho slova procesoru. }
{===========================================================================}
 
{---> PP_DEFS - konstanta CfgDefProcCount definuje pocet polozek --}
const CfgDefAll:CfgDef_t=
( {-- definice Cfg dat --}
( {-- Skupina procesoru C84 --}
ProcId : 'C84';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX1XXX';
Off : 'XXXXXXXXXX0XXX';
Bits : ''
),
( Key : 'CP';
On : 'XXXXXXXXX0XXXX';
Off : 'XXXXXXXXX1XXXX';
Bits : ''
),
(),(),(),(),(),(),()
)
),
( {-- Skupina procesoru F83, F84, .. --}
ProcId : 'F83';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '0000000000XXXX';
Off : '1111111111XXXX';
Bits : ''
),
(),(),(),(),(),(),()
)
),
( {-- Skupina procesoru F627, F628 --}
ProcId : 'F627';
Info : ( ( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXX2XX10'
),
( Key : 'LP';
On : 'XXXXXXXXX0XX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXX0XX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXX0XX10';
Off : '';
Bits : ''
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'MCLRE';
On : 'XXXXXXXX1XXXXX';
Off : 'XXXXXXXX0XXXXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0000XXXXXXXXXX';
Off : '1111XXXXXXXXXX';
Bits : '1010XXXXXXXXXX'
),
(),(),(),()
)
),
( {-- Skupina procesoru F818/819 --}
ProcId : 'F818';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXX0XX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXX0XX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXX0XX10';
Off : '';
Bits : ''
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'MCLRE';
On : 'XXXXXXXX1XXXXX';
Off : 'XXXXXXXX0XXXXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXX11XXXXXXXXX';
Off : 'XXX00XXXXXXXXX';
Bits : 'XXX10XXXXXXXXX'
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
( Key : 'CCPMX_RB2';
On : 'X1XXXXXXXXXXXX';
Off : 'X0XXXXXXXXXXXX';
Bits : ''
),
( Key : 'CCPMX_RB3';
On : 'X0XXXXXXXXXXXX';
Off : 'X1XXXXXXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0XXXXXXXXXXXXX';
Off : '1XXXXXXXXXXXXX';
Bits : ''
),
()
)
),
( {-- Skupina procesoru F870, ... --}
ProcId : 'F870';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX10'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '00XXXXXX00XXXX';
Off : '11XXXXXX11XXXX';
Bits : '10XXXXXX10XXXX'
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXXX1XXXXXXXXX';
Off : 'XXXX0XXXXXXXXX';
Bits : ''
),
(),(),()
)
),
( {-- Skupina procesoru F873, ... --}
ProcId : 'F873';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '00XXXXXX00XXXX';
Off : '11XXXXXX11XXXX';
Bits : '10XXXXXX10XXXX'
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXXX1XXXXXXXXX';
Off : 'XXXX0XXXXXXXXX';
Bits : ''
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
(),()
)
),
( {-- Skupina procesoru F873A, ... --}
ProcId : 'F873A';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXX00XXXXXXXXX';
Off : 'XXX11XXXXXXXXX';
Bits : 'XXX10XXXXXXXXX'
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0XXXXXXXXXXXXX';
Off : '1XXXXXXXXXXXXX';
Bits : ''
),
(),()
)
)
);
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_COMON.PAS
0,0 → 1,156
unit PP_COMON;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde jsou obecne uzivane pomocne procedury a funkce . }
{===========================================================================}
 
interface
 
function UpStr(str:string):string;
{== Prevede retezec na velka pismena ==}
 
procedure PressEnter;
{== Zobrazi hlasku a ceka na stisk klavesy ==}
 
procedure HexByte(var f:text;data:word);
{== Vytiskni byte jako 2 znaky ==}
 
procedure HexWord(var f:text;data:word);
{== Vytiskni word jako 4 znaky ==}
 
procedure HexWordSp(var f:text;data:word);
{== Vytiskni word jako 4 znaky a mezeru ==}
 
procedure HexAdr(var f:text;data:word);
{== Vytiskni adresu s dvojteckou ==}
 
procedure Error(ErrorStr:string; LineNumber:integer); (* !! *)
{== Vytiskne hlaseni o chybe a ukonci program ==}
{ Pokud je LinNumber<=0 pak se netiskne }
 
function DelSpace(s:string):string;
{== Vyhodi vsechny mezery ze zacatku retezce s ==}
 
function GetWord(s:string):string;
{== Vrati prvni slovo ze zadaneho retezce ==}
 
function DelWord(s:string):string;
{== Odstrihne prvni slovo z retezce ==}
 
procedure DisplayRange(Base, Len:word);
{== obrazi rozsah jako dvojici hex cisel ==}
 
function GetParamLine(First:integer):string;
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==}
 
implementation
 
function UpStr(str:string):string;
{== Prevede retezec na velka pismena ==}
var i:integer;
begin for i:=1 to length(str) do str[i]:=upcase(str[i]);
UpStr:=str;
end; {UpStr}
 
procedure PressEnter;
{== Zobrazi hlasku a ceka na stisk klavesy ==}
begin write('Press ENTER to continue ...');
readln;
writeln;
end; {PressEnter}
 
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
 
procedure HexByte(var f:text;data:word);
{== Vytiskni byte jako 2 znaky ==}
begin write(f, prevod[(data shr 4) and $F],
prevod[data and $F]);
end; {HexByte}
 
procedure HexWord(var f:text;data:word);
{== Vytiskni word jako 4 znaky ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F]);
end; {HexWord}
 
procedure HexWordSp(var f:text;data:word);
{== Vytiskni word jako 4 znaky a mezeru ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F],
' ');
end; {HexWordSp}
 
procedure HexAdr(var f:text;data:word);
{== Vytiskni adresu s dvojteckou ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F],
': ');
end; {HexAdr}
 
procedure Error(ErrorStr:string; LineNumber:integer);
{== Vytiskne hlaseni o chybe a ukonci program ==}
{ Pokud je LinNumber<=0 pak se netiskne }
begin writeln;
if LineNumber<=0 then writeln('FATAL: ',ErrorStr)
else writeln('FATAL @ Line ',LineNumber,': ',ErrorStr);
writeln;
halt(1);
end; {Error}
 
function DelSpace(s:string):string;
{== Vyhodi vsechny mezery ze zacatku retezce s ==}
var i:integer;
begin i:=1;
while (i<=length(s)) and (s[i]=' ')
do inc(i);
DelSpace:=copy(s,i,255);
end; {DelSpace}
 
function GetWord(s:string):string;
{== Vrati prvni slovo ze zadaneho retezce ==}
var t:string;
begin t:=DelSpace(s);
GetWord:=copy(t,1,pos(' ',t+' ')-1);
end; {GetWord}
 
function DelWord(s:string):string;
{== Odstrihne prvni slovo z retezce ==}
var t:string;
begin t:=DelSpace(s);
t:=copy(t,pos(' ',t+' ')+1,255);
DelWord:=DelSpace(t);
end; {DelWord}
 
procedure DisplayRange(Base, Len:word);
{== obrazi rozsah jako dvojici hex cisel ==}
begin if Len<>0
then begin hexword(Output,Base);
write('..');
hexword(Output,Base+Len-1);
write(' ');
end
else begin write('none ');
end;
end; {DisplayRange}
 
function GetParamLine(First:integer):string;
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==}
var i:integer;
s:string;
begin s:='';
if First<1 then exit;
for i:=First to paramcount do s:=s+paramstr(i)+' ';
GetParamLine:=UpStr(s);
end; {GetParamLine}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_DATA.PAS
0,0 → 1,158
unit PP_DATA;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice objektu pro ulozeni dat v pameti. }
{===========================================================================}
 
interface
 
uses PP_DEFS;
 
{===========================================================================}
{ Definice typu a konstant pro ulozeni dat ( delka buferu, typ ulozenych }
{ dat. }
{===========================================================================}
 
type DataItem_t=record { typ pro ulozeni jednoho datoveho slova }
W : word; { vlastni data }
S : boolean; { true znamena platna data }
end; {record}
 
type RangeType_t=
( _INVALID_, { adresa neprislusi zadne oblasti }
_PM_, { adresa spada do pameti programu }
_DM_, { adresa spada do pameti dat }
_CM_, { adresa spada do konfiguracni pameti }
_CFG_ { adresa je adresou zvlastniho konfig slova }
);
 
type PicData_t=object
{-- vlastni datove pole --}
_Buf : array[0..DataBufLen-1] of DataItem_t; { zde jsou data }
{-- informace o vybranem procesoru --}
_Proc:ProcInfo_t;
{-- metody --}
 
procedure Init(ProcInfo:ProcInfo_t);
{== Zapamatuje si typ procesoru ( jeho prametry ) a smaze datovou oblast ==}
 
procedure GetProcInfo(var ProcInfo:ProcInfo_t);
{== Vrati aktualni parametry procesoru ==}
 
function TestAdr(Adr:word):RangeType_t;
{== Vrati typ pametoveho prostoru pro zadanou adresu ==}
 
function Store(Adr:word;Data:word):boolean;
{== Ulozi data na zadanou adresu. Pri chybne adrese vraci true ==}
 
procedure StoreProc(Adr:word;Data:word);
{== Ulozi data na zadanou adresu. ==}
 
function GetStat(Adr:word):boolean;
{== Vrati priznak platnosti dat na zadane adrese, true znamena data platna ==}
 
function GetData(Adr:word):word;
{== Vrati data ze zadane adresy. Pri chybne adrese vraci same jednotky ==}
 
end; {object}
 
implementation
 
function InRange(What,Start,Finish:word):boolean;
{== Vraci true pokud What spada do rozsahu [Start..Finish] ==}
{ Pomocna funkce }
begin InRange:=(What>=Start) and (What<=Finish)
end; {InRange}
 
procedure PicData_t.Init(ProcInfo:ProcInfo_t);
{== Zapamatuje si typ procesoru ( jeho prametry ) a smaze datovou oblast ==}
var i:integer;
begin _Proc:=ProcInfo;
{-- inicializace bufferu --}
for i:=0 to DataBufLen-1 do begin _Buf[i].W:=0;
_Buf[i].S:=false;
end;
{-- inicializace jednotlivych oblasti--}
for i:=_Proc.PM_Base to _Proc.PM_Base+_Proc.PM_Len-1 do
_Buf[i].W:=_Proc.PM_Mask;
for i:=_Proc.DM_Base to _Proc.DM_Base+_Proc.DM_Len-1 do
_Buf[i].W:=_Proc.DM_Mask;
for i:=_Proc.CM_Base to _Proc.CM_Base+_Proc.CM_Len-1 do
_Buf[i].W:=_Proc.CM_Mask;
end; {Init}
 
procedure PicData_t.GetProcInfo(var ProcInfo:ProcInfo_t);
{== Vrati aktualni parametry procesoru ==}
begin ProcInfo:=_Proc;
end; {GetProcInfo}
 
function PicData_t.TestAdr(Adr:word):RangeType_t;
{== Vrati typ pametoveho prostoru pro zadanou adresu ==}
begin TestAdr:=_INVALID_; { nepasuje do zadneho rozsahu }
with _Proc do
begin if Name=''
then begin exit; { neni dany typ procesoru }
end;
if Adr>DataBufLen
then begin exit; { adresa mimo rozsah bufferu }
end;
if (PM_Len>0) and (Adr>=PM_Base) and (Adr<=PM_Base+PM_Len)
then begin TestAdr:=_PM_;
exit;
end;
if (CM_Len>0) and (Adr>=CM_Base) and (Adr<=CM_Base+CM_Len)
then begin TestAdr:=_CM_;
exit;
end;
if (DM_Len>0) and (Adr>=DM_Base) and (Adr<=DM_Base+DM_Len)
then begin TestAdr:=_DM_;
exit;
end;
if Adr=Cfg_Base
then begin TestAdr:=_CFG_;
exit;
end;
end;
end; {TestAdr}
 
function PicData_t.Store(Adr:word;Data:word):boolean;
{== Ulozi data na zadanou adresu. Pri chybne adrese vraci true ==}
begin case TestAdr(Adr) of
_INVALID_ : begin {-- chybna adresa - nic nedelej --}
Store:=true;
exit;
end;
_PM_ : data:=data and _Proc.PM_Mask; { maskuj data }
_DM_ : data:=data and _Proc.DM_Mask;
_CM_ : data:=data and _Proc.CM_Mask;
_CFG_ : data:=data and _Proc.Cfg_Mask;
end; {case}
{-- platna adresa - uloz data --}
Store:=false;
_Buf[Adr].S:=true; { datova polozka platna }
_Buf[Adr].W:=data; { vlastni data }
end; {Store}
 
procedure PicData_t.StoreProc(Adr:word;Data:word);
{== Ulozi data na zadanou adresu ==}
begin if Store(Adr, Data) then;
end; {StoreProc}
 
function PicData_t.GetStat(Adr:word):boolean;
{== Vrati priznak platnosti dat na zadane adrese, true znamena data platna ==}
begin GetStat:=false;
if TestAdr(Adr)=_INVALID_ then exit;
GetStat:=_Buf[Adr].S;
end; {GetStat}
 
function PicData_t.GetData(Adr:word):word;
{== Vrati data ze zadane adresy. Pri chybne adrese vraci same jednotky ==}
begin GetData:=$FFFF;
if TestAdr(Adr)=_INVALID_ then exit;
GetData:=_Buf[Adr].W;
end; {GetData}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_DEFS.PAS
0,0 → 1,531
unit PP_DEFS;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde jsou definice zavisle na vlastnostech jednotlivych procesoru. }
{ Dale jsou zde procedury, ktere prpimo souvisi s definovanymi datovymi }
{ strukturami }
{===========================================================================}
 
interface
 
uses PP_COMON; { jen procedura Error }
 
{===========================================================================}
{ Definice celkoveho rozsahu adresoveho prostoru pri programovani PICu }
{===========================================================================}
 
const DataBufLen=$4000; { Maximalne 2 x 8 K slov pameti programu }
{ dat a konfigurace }
 
{===========================================================================}
{ Definice typu a konstant souvisejicich se zpracovanim prepinacu pro }
{ definovani konfiguracniho slova. }
{===========================================================================}
 
{-- Definice konstant pro rozsah mezi --}
 
const CfgDefProcCount = 7; { pocet skupin procesoru }
CfgDefSwCount = 15; { maximalni pocet prepinacu u jedne skupiny }
CfgWordLen = 14; { maximalni pocet bitu Cfg slova }
CfgNameLen = 10; { maximalni delka jmena definice skupiny }
CfgKeyLen = 10; { maximalni delka prepinace }
 
{-- Definice typu pro popis jednoho prepinace --}
 
type CfgDefSw_t=record
Key : string[CfgKeyLen]; { jmeno prepinace }
On : string[CfgWordLen]; { hodnota pro stav _ON }
Off : string[CfgWordLen]; { hodnota pro stav _OFF }
Bits : string[CfgWordLen]; { definice pro _xxx u vicebitovych prepinacu }
end; {record}
 
{ Key definuje jmeno prepinace ( napr CP pro Code Protection ) }
{ On definuje stav jednotlivych bitu pro stav On }
{ Off definuje stav jednotlivych bity pro stav Off }
{ Bits definuje kam prijdou jednotlive bity vicebitoveho prepinace }
 
const CfgX:string[CfgWordLen]=''; { sama 'X' o delce Cfg slova }
 
{-- Definice typu pro popis jedne skupinu procesoru --}
 
type CfgDefProc_t=record
ProcId : string[CfgNameLen]; { jmeno skupiny procesoru }
Info : array[1..CfgDefSwCount] of CfgDefSw_t;
end; {record}
 
{-- Definice typu pro popis vsech skupin procesoru --}
 
type CfgDef_t=array[1..CfgDefProcCount] of CfgDefProc_t;
 
{-- Definice konstanty popisu prepinace s prazdnym obsahem --}
 
const CfgDefSwNull:CfgDefSw_t=
( Key : '';
On : '';
Off : '';
Bits : ''
);
 
{-- Vlastni definice vsech skupin procesoru --}
 
{$I PP_CFG.PAS} { Abychom tady nemeli tisic radek definice }
 
{===========================================================================}
{ Hlavicky funkci a procedur pro podporu zpracovani prepinacu }
{ modifikujicich konfiguracni slovo. }
{===========================================================================}
 
function CfgFindProcGroup(Par:string;var CfgDef:CfgDef_t):integer;
{== Vrati index do tabulky CfgDef pro zadane jmeno skupiny procesoru ==}
{ Pri nenalezeni vraci cilo 0 }
 
procedure CfgDisplayHelp(var CfgDefProc:CfgDefProc_t);
{== Zobrazi help pro Cfg prepinace zadane skupiny procesoru ==}
 
procedure CfgDisplayHelpAll(var CfgDef:CfgDef_t);
{== Zobrazi help od prepinacu Cfg slova pro vechny skupiny procesoru ==}
 
function CfgTestKey(Par:string;var CfgDefProc:CfgDefProc_t):string;
{== Otestuje parametr ( retezec s jednim prepinacem ) na vsechny ==}
{ prepinace dane skupiny procesoru a vrati vysledek jako }
{ tristavovy retezec. Pri chybe vraci prazdny retezec. }
 
function CfgOr(s1,s2:string):string;
{== Slouci dva Cfg retezce do jednoho. ==}
{ V pripade konfliktu vraci prazdny retezec }
 
function CfgOverride(s,os:string):string;
{== Modifikuje platne Cfg string s platnymi bity Cfg stringu os ==}
{ V pripade chybneho rozmeru retezcu vraci prazdny retezec }
 
function CfgTestKeyMultiple(var Pars:string;var CfgDefProc:CfgDefProc_t):string;
{== Zadavam retezec prepinacu a popis procesorove specifickych prepinacu. ==}
{ Zpracovane parametry z Pars vykousnu. Vracim Cfg slovo jako tristavovy }
{ retezec. }
{ Pokud je chyba, vracim prazdny retezec a v Pars je prepinac, ktery }
{ zpusobil chybu na prvni pozici }
 
function Word2Str(W:word):string;
{== Prevede binarni data W na retezec ( tristavovy ) ==}
 
function Str2Word(S:string):word;
{== Prevede Cfg string na binarni data ==}
{ Misto bitu 'X' da '1' }
 
{===========================================================================}
{ Definice typu a konstant popisujicich parametry jednotlivych procesoru. }
{===========================================================================}
 
{-- Definice konstant urcujicich meze -}
 
const ProcName_l = 14; { Maxialni delka jmena procesoru }
ProcCount = 87; { Pocet definovanych procesoru }
 
{-- Definice typu pro identifikaci programovaciho algoritmu --}
 
type ProcAlg_t=
( _NONE_, { Nedefinovana hodnota }
_NON2WIRE_, { Algoritmus neni seriovy ( nepodporuji ) }
{-- EPROM a OTP --}
_EPROM1_, { Stary algoritmus pro EPROM ( PIC12C5xx ) }
_EPROM2_, { Standardni EPROM }
_EPROM3_, { Standardni EPROM se slovem 16 bitu }
{-- EEPROM a FLASH --}
_EE1_, { Standardni Flash / EEPROM }
_EE2_, { Flash / EEPROM s prikazem }
{ Begin Programming Only Cycle }
_EE3_, { Skupina 87xA }
_EE4_, { Skupina 627A/628A/648A (jiny erase) }
_EE5_ { Skupina 618/919 (jako EE3, jinak CFG slovo }
); {---> nezapomen aktualizovat ProcDisplayAlg --}
 
{-- Definice typu informace o procesoru --}
 
type ProcNam_t=string[ProcName_l+1];
 
type ProcInfo_t=record
Name : ProcNam_t; { jmeno procesoru }
Alg : ProcAlg_t; { identifikace algoritmu }
Tprog : word; { programovaci cas v us }
Bits : word; { pocet predavanych bitu }
Cfg : string[CfgNameLen]; { druh konfiguracniho slova }
Cfg_Base, Cfg_Mask : word; { adresa Cfg a maska platnych bitu }
PM_Base, PM_Len, PM_Mask : word; { pamet programu }
CM_Base, CM_Len, CM_Mask : word; { pamet konfigurace }
DM_Base, DM_Len, DM_Mask : word; { pamet dat }
end; {record}
 
{-- Defince konstanty parametru procesoru s prazdnym obsahem --}
 
const ProcDummyInfo:ProcInfo_t =
( Name: '';
Alg: _NONE_;
Tprog: 0;
Bits: 0;
Cfg: '';
Cfg_Base: $0000;
Cfg_Mask: $0000;
PM_Base:$0000; PM_Len:$0000; PM_Mask:$0000;
CM_Base:$0000; CM_Len:$0000; CM_Mask:$0000;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
);
 
{-- Defice vlastniho popisu vsech procesoru --}
 
{$I PP_PROC.PAS}
 
{===========================================================================}
{ Hlavicky funkci a procedur souvisejicich s definici parametru procesoru. }
{===========================================================================}
 
procedure ProcDisplayAlg(Alg:ProcAlg_t;Tprog:word);
{== Zobrazi citelne jmeno algoritmu ==}
 
procedure ProcDisplayInfoAll;
{== Zobrazi info o vsech znamych procesorech ==}
{ Strankuje s pauzou }
 
procedure ProcDisplayInfo(ProcInfo:ProcInfo_t);
{== Zobrazi info o jednom procesoru i s nadpisem ==}
 
procedure ProcFind(s:string; var ProcInfo:ProcInfo_t);
{== Najde podle retezce informace o procesoru ==}
 
implementation
 
{===========================================================================}
{ Funkce a procedury pro podporu zpracovani prepinacu modifikujicich }
{ konfiguracni slovo. }
{===========================================================================}
 
function CfgFindProcGroup(Par:string;var CfgDef:CfgDef_t):integer;
{== Vrati index do tabulky CfgDef pro zadane jmeno skupiny procesoru ==}
{ Pri nenalezeni vraci cilo 0 }
var i:integer;
begin i:=CfgDefProcCount+1;
repeat dec(i);
until (i=0) or (Par=CfgDef[i].ProcId);
CfgFindProcGroup:=i;
end; {CfgFindProcGroup}
 
procedure CfgDisplayHelp(var CfgDefProc:CfgDefProc_t);
{== Zobrazi help pro Cfg prepinace zadane skupiny procesoru ==}
var i:integer;
begin write(CfgDefProc.ProcId:10,': ');
for i:=1 to CfgDefSwCount do
write(CfgDefProc.Info[i].Key,' ');
writeln;
end; {CfgDisplayHelp}
 
procedure CfgDisplayHelpAll(var CfgDef:CfgDef_t);
{== Zobrazi help od prepinacu Cfg slova pro vechny skupiny procesoru ==}
var i:integer;
begin writeln('Processor specific switches for Config Word overiding: ');
writeln;
for i:=1 to CfgDefProcCount do
CfgDisplayHelp(CfgDef[i]);
writeln;
end; {CfgDisplayHelpAll}
 
function CfgTestSingleKey(Par:string; Def:CfgDefSw_t):string;
{== Otestuje zda parametr Par odpovida definici Def a vrati retezec ==}
{ obsahujici konfig slovo ve tristavove logice. Pri chybe varci }
{ prazdny retezec }
{ Pomocna funkce }
var i:integer;
BitCount:integer; { pocet bitu 1..8 podle definice }
ParValue:byte; { sem se nactou bity z Par }
begin if pos(Def.Key,Par)=0 then begin CfgTestSingleKey:='';
exit;
end;
if Par=Def.Key+'_ON' then begin CfgTestSingleKey:=Def.On;
exit;
end;
if Par=Def.Key then begin CfgTestSingleKey:=Def.On;
exit;
end;
if Par=Def.Key+'_OFF' then begin CfgTestSingleKey:=Def.Off;
exit;
end;
if Def.Bits='' then begin CfgTestSingleKey:='';
exit;
end;
{-- pocet definovanych bitu --}
BitCount:=0;
for i:=1 to length(Def.Bits) do
begin if (Def.Bits[i] <> 'X') and not (Def.Bits[i] in ['0'..'7'])
then Error('Internal Error 1 at TestKey',0);
if Def.Bits[i] in ['0'..'7']
then if 1+byte(Def.Bits[i])-byte('0') > BitCount
then BitCount:=1+byte(Def.Bits[i])-byte('0');
end;
if BitCount=0 then Error('Internal Error 2 at TestKey',0);
if BitCount>8 then Error('Internal Error 3 at TestKey',0);
if length(Par)<>length(Def.Key)+1+BitCount
then begin CfgTestSingleKey:='';
exit;
end;
{-- precti bity --}
ParValue:=0;
for i:=1 to BitCount do
begin case Par[length(Def.Key)+1+i] of
'0' : ParValue:=ParValue*2;
'1' : ParValue:=ParValue*2+1;
else begin CfgTestSingleKey:='';
exit;
end;
end; {case}
end;
{-- sestav vysledek --}
CfgTestSingleKey[0]:=char(CfgWordLen);
for i:=1 to CfgWordLen do
begin if Def.Bits[i]='X'
then CfgTestSingleKey[i]:='X'
else if ((ParValue shr (byte(Def.Bits[i])-byte('0'))) and 1) = 0
then CfgTestSingleKey[i]:='0'
else CfgTestSingleKey[i]:='1';
end;
end; {CfgTestSingleKey}
 
function CfgTestKey(Par:string;var CfgDefProc:CfgDefProc_t):string;
{== Otestuje parametr ( retezec s jednim prepinacem ) na vsechny ==}
{ prepinace dane skupiny procesoru a vrati vysledek jako }
{ tristavovy retezec. Pri chybe vraci prazdny retezec. }
var i:integer;
s:string;
begin if Par='' then begin CfgTestKey:=''; { to je vlastne chyba, }
exit; { nevracim zadne slovo }
end;
i:=1;
repeat s:=CfgTestSingleKey(Par,CfgDefProc.Info[i]);
inc(i);
until (s<>'') or (i>CfgDefSwCount);
CfgTestKey:=s;
end; {CfgTestKey}
 
procedure CfgDisplayCfgBits(s:string);
{== Zobrazi citelne druh konfiguracnich bitu ==}
{ Pomocna procedura ( ProcDisplayInfoLine ) }
begin write(copy(s+' ',1,9));
end; {CfgDisplayCfgBits}
 
function CfgOr(s1,s2:string):string;
{== Slouci dva Cfg retezce do jednoho. ==}
{ V pripade konfliktu vraci prazdny retezec }
var i:integer;
begin CfgOr:='';
if length(s1)<>length(s2) then exit;
for i:=1 to length(s1) do
case s1[i] of
'0' : case s2[i] of
'0' : CfgOr[i]:='0';
'1' : exit;
'X' : CfgOr[i]:='0';
else exit;
end; {case}
'1' : case s2[i] of
'0' : exit;
'1' : CfgOr[i]:='1';
'X' : CfgOr[i]:='1';
else exit;
end; {case}
'X' : case s2[i] of
'0' : CfgOr[i]:='0';
'1' : CfgOr[i]:='1';
'X' : CfgOr[i]:='X';
else exit;
end; {case}
else exit; { chyba }
end; {case}
CfgOr[0]:=s1[0]; { delka retezce }
end; {CfgOr}
 
function CfgOverride(s,os:string):string;
{== Modifikuje platne Cfg string s platnymi bity Cfg stringu os ==}
{ V pripade chybneho rozmeru retezcu vraci prazdny retezec }
var i:integer;
begin CfgOverride:='';
if length(s)<>length(os) then exit;
for i:=1 to length(s) do
case os[i] of
'0' : CfgOverride[i]:='0';
'1' : CfgOverride[i]:='1';
'X' : CfgOverride[i]:=s[i];
else exit; { chyba }
end; {case}
CfgOverride[0]:=s[0]; { delka retezce }
end; {CfgOverride}
 
function CfgTestKeyMultiple(var Pars:string;var CfgDefProc:CfgDefProc_t):string;
{== Zadavam retezec prepinacu a popis procesorove specifickych prepinacu. ==}
{ Zpracovane parametry z Pars vykousnu. Vracim Cfg slovo jako tristavovy }
{ retezec. }
{ Pokud je chyba, vracim prazdny retezec a v Pars je prepinac, ktery }
{ zpusobil chybu na prvni pozici }
var CfgOne : string; { jeden klic ( prepinac ) }
CfgSuma : string; { mezisoucet klicu }
ErrStr : string; { meziuschova nezpracovatelnych klicu }
begin ErrStr:='';
CfgSuma:=CfgX;
while Pars<>'' do { dokud nezpracuji vse z retezce Pars }
begin {-- zpracuj jeden prepinac --}
CfgOne:=CfgTestKey(GetWord(Pars),CfgDefProc);
if CfgOne=''
then ErrStr:=ErrStr+' '+GetWord(Pars)
else begin CfgSuma:=CfgOr(CfgSuma,CfgOne);
if CfgSuma=''
then begin {-- konfliktni parametry --}
CfgTestKeyMultiple:='';
Pars:=Pars+ErrStr;
exit;
end;
end;
Pars:=DelWord(Pars);
end;
CfgTestKeyMultiple:=CfgSuma; { vysledne konfiguracni slovo }
Pars:=ErrStr; { prepinace, ktere neznam }
end; {CfgTestKeyMultiple}
 
function Word2Str(W:word):string;
{== Prevede binarni data W na retezec ( tristavovy ) ==}
var i:integer;
begin Word2Str[0]:=char(CfgWordLen); { delka retezce }
for i:=CfgWordLen downto 1 do
begin if ( W and 1 ) = 1 then Word2Str[i]:='1' { jednotlive bity }
else Word2Str[i]:='0';
W := W shr 1; { dalsi bit }
end;
end; {Word2Str}
 
function Str2Word(S:string):word;
{== Prevede Cfg string na binarni data ==}
{ Misto bitu 'X' da '1' }
var W:word;
i:integer;
begin W:=0;
for i:=1 to length(S) do
if S[i]<>'0' then W := ( W shl 1 ) + 1
else W := ( W shl 1 );
Str2Word:=W;
end; {Str2Word}
 
{===========================================================================}
{ Funkce a procedury souvisejicich s definici parametru procesoru. }
{===========================================================================}
 
procedure ProcDisplayAlg(Alg:ProcAlg_t;Tprog:word);
{== Zobrazi citelne jmeno algoritmu ==}
begin case Alg of
_NONE_ : write('NONE ');
_EPROM1_ : write('EPROM1 ');
_EPROM2_ : write('EPROM2 ');
_EPROM3_ : write('EPROM3 ');
_EE1_ : write('EE1 ');
_EE2_ : write('EE2 ');
_EE3_ : write('EE3 ');
_EE4_ : write('EE4 ');
_EE5_ : write('EE5 ');
_NON2WIRE_ : write('NON2WIRE');
else write('?? ');
end; {case}
write(Tprog:6,' '); { programovaci cas v us }
end; {ProcDisplayAlg}
 
procedure ProcDisplayInfoLine(ProcInfo:ProcInfo_t);
{== Zobrazi v lidske podobe nektere informace o procesoru ==}
var s:string;
i:integer;
begin s:=ProcInfo.Name;
for i:=length(s)+1 to ProcName_l do s:=s+' ';
write(s,' ');
ProcDisplayAlg(ProcInfo.Alg,ProcInfo.Tprog);
CfgDisplayCfgBits(ProcInfo.Cfg);
DisplayRange(ProcInfo.PM_Base,ProcInfo.PM_Len);
DisplayRange(ProcInfo.CM_Base,ProcInfo.CM_Len);
DisplayRange(ProcInfo.DM_Base,ProcInfo.DM_Len);
writeln;
end; {ProcDisplayInfoLine}
 
procedure ProcDisplayInfoHeader;
{== Zobrazi nadpis ==}
begin writeln('Proc Name Alg Tprog[us] Cfg Bits Pgm Memory Cfg Memory Dat Memory');
writeln('--------------------------------------------------------------------------');
end; {ProcDisplayInfoHeader}
 
procedure ProcDisplayInfoAll;
{== Zobrazi info o vsech znamych procesorech ==}
{ Strankuje s pauzou }
var i,j:integer;
begin i:=0;
while i<ProcCount do
begin ProcDisplayInfoHeader;
j:=0;
while (i<ProcCount) and (j<22) do
begin inc(i);
inc(j);
ProcDisplayInfoLine(ProcInfoAll[i]);
end;
if i<ProcCount then PressEnter;
end;
end; {ProcDisplayInfoAll}
 
procedure ProcDisplayInfo(ProcInfo:ProcInfo_t);
{== Zobrazi info o jednom procesoru i s nadpisem ==}
begin ProcDisplayInfoHeader;
ProcDisplayInfoLine(ProcInfo);
writeln;
end; {ProcDisplayInfo}
 
procedure ProcFind(s:string; var ProcInfo:ProcInfo_t);
{== Najde podle retezce informace o procesoru ==}
var i:integer;
begin {-- separace jmena procesoru z retezce --}
s:=upstr(s)+' ';
ProcInfo:=ProcDummyInfo;
i:=pos('PIC',s);
if i=0 then exit;
s:=copy(s,i,255);
i:=pos(' ',s);
s:=copy(s,1,i-1);
{-- nalezeni informaci --}
for i:=1 to ProcCount do
if (ProcInfoAll[i].Name+' ') = s+' '
then ProcInfo:=ProcInfoAll[i];
end; {ProcFind}
 
{===========================================================================}
{ Telo jednotky. }
{===========================================================================}
 
procedure VerifyProcInfo;
{== Procedura provede interni test konzistentnosti dat ==}
var i:integer;
begin for i:=1 to ProcCount do
with ProcInfoAll[i] do
begin {-- kontrola delky jmena procesoru --}
if length(Name) > ProcName_l
then Error('Internal Error: IE01',0);
{-- kontrola rozsahu pametovych prostoru --}
if PM_Base+PM_Len>DataBufLen
then Error('Internal Error: IE02',0);
if CM_Base+CM_Len>DataBufLen
then Error('Internal Error: IE03',0);
if DM_Base+DM_Len>DataBufLen
then Error('Internal Error: IE04',0);
{-- kontrola zda znam vsechny uvedene Cfg --}
if (ProcInfoAll[i].Cfg<>'') and (CfgFindProcGroup(ProcInfoAll[i].Cfg,CfgDefAll)=0)
then Error('Internal Error: IE5',0);
end;
end; {VerifyProcInfo}
 
var i:integer;
 
begin {-- kontroluje konzistentnost konstant --}
VerifyProcInfo;
{-- inicializace prazdne konstanty pro Cfg slovo ( same 'X' ) --}
CfgX[0]:=char(CfgWordLen);
for i:=1 to length(CfgX) do CfgX[i]:='X';
end.
 
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_IO.PAS
0,0 → 1,318
unit PP_IO;
 
{===========================================================================}
{ (c) miho / DECROS/ICZ 2000/2001/2002 }
{===========================================================================}
{ Zde jsou procedury a funkce pro vstup a vystup dat v definovanych }
{ formatech ( viz IO_t ). Je to objekt, ktery dedi datovy objekt. }
{===========================================================================}
{verze: }
{1.00 - Uvodni verze }
{1.01 - Uprava exportu Config Word pro obvody s _EPROM1_ PEFI }
 
interface
 
uses PP_COMON,
PP_DATA,
PP_DEFS;
 
const ItemPerLine=8; { Pocet polozek na jedne radce exportu }
 
type IO_t=
( _HEX_, { vyber IO filtru typu text }
_TXT_, { vyber IO filtru typu intel hex }
_NIL_ { neplatna volba }
);
 
type PicDataIo_t=object(PicData_t)
 
procedure Export( Name:string; Format:IO_t; Source:string);
{== Vystup dat z objektu do souboru ==}
 
procedure Import( Name:string; Format:IO_t);
{== Vstup dat ze souboru do datoveho objektu ==}
 
end; {object}
 
 
 
implementation
 
{===========================================================================}
{ Export dat do souboru }
{===========================================================================}
 
procedure _LineOut_TXT_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
{== Pomocna procedura vypise radek TXT dat z datatoveho objektu do souboru ==}
var i:integer;
begin HexWord(f,Adr);
write(f,': ');
for i:=0 to Count-1 do HexWordSp(f,Data.GetData(Adr+i));
writeln(f);
end; {_LineOut_TXT_}
 
procedure _LineOut_HEX_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
{== Pomocna procedura vypise radek HEX dat z datoveho objektu do souboru ==}
var i:integer;
dat:word;
suma:byte; { kontrolni soucet HEX }
procedure sum(data:word);
begin inc(suma,data);
inc(suma,data shr 8);
end; {sum}
begin suma:=0;
write(f,':10');
sum($10);
HexWord(f,Adr*2);
sum(Adr*2);
write(f,'00');
for i:=0 to Count-1 do begin dat:=Data.GetData(Adr+i);
HexByte(f,dat);
HexByte(f,dat shr 8);
sum(dat);
end;
HexByte(f,byte(-suma));
writeln(f);
end; {_LineOut_HEX_}
 
procedure PicDataIo_t.Export( Name:string; Format:IO_t; Source:string);
{== Vystup dat z objektu do souboru ==}
var f:text;
i:integer;
len:word;
Proc:ProcInfo_t;
begin Name:=UpStr(Name);
writeln('Exporting data to file: ',Name);
{== Zalozeni souboru ==}
assign(f,Name);
{$I-}
rewrite(f);
{$I+}
if ioresult<>0 then Error('Unable create file: '+Name,0);
{== Hlavicka souboru ==}
{$I-}
case format of
_TXT_ : begin writeln(f,source);
writeln(f);
end;
_HEX_ : ;
end; {case}
{== Telo souboru ( data ) ==}
{-- Pamet programu --}
GetProcInfo(Proc); { vytahni si parametry }
if Proc.PM_Len>0 then
begin i:=0;
while i<Proc.PM_Len do
begin if (i+ItemPerLine)<Proc.PM_Len
then len:=ItemPerLine
else len:=Proc.PM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.PM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.PM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
end;
{-- Pamet dat --}
if Proc.DM_Len>0 then
begin i:=0;
while i<Proc.DM_Len do
begin if (i+ItemPerLine)<Proc.DM_Len
then len:=ItemPerLine
else len:=Proc.DM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.DM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.DM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
end;
{-- Konfiguacni pamet --}
if Proc.CM_Len>0 then
begin i:=0;
while i<Proc.CM_Len do
begin if (i+ItemPerLine)<Proc.CM_Len
then len:=ItemPerLine
else len:=Proc.CM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.CM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.CM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
 
{-- konfiguracni slovo -- }
{-- jen u procesoru s algoritmem _EPROM1_,}
{-- tam neni soucasti konfig. pameti }
if Proc.Alg=_EPROM1_ then
begin
case format of
_TXT_ : _LineOut_TXT_(f,Proc.Cfg_Base,1,self);
_HEX_ : _LineOut_HEX_(f,Proc.Cfg_Base,1,self);
end; {case}
end;
 
{== Paticka souboru ==}
case format of
_TXT_ : ;
_HEX_ : writeln(f,':00000001FF');
end; {case}
{== Uzavreni souboru ==}
close(f);
{$I+}
if ioresult<>0 then Error('Unable write to file: '+name,0);
end; {Export}
 
{===========================================================================}
{ Import dat ze souboru }
{===========================================================================}
 
procedure _LineIn_TXT_(var s:string; var Data:PicData_t; LineNumber:integer);
{== Pomocna procedura zpracuje radku TXT textu a data ulozi do datoveho objektu ==}
var i:integer;
 
adr,dat:word;
valid:boolean;
procedure blank;
begin while ( (s[i]=' ') or (s[i]=#8) ) and (i<length(s)) do inc(i);
end;
procedure hex;
begin dat:=0;
valid:=false;
blank;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=true;
if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
else dat:=16*dat+(ord(s[i])-ord('A')+10);
inc(i);
end;
blank;
if s[i]<>':' then Error('Invalid file format, ":" expected',LineNumber);
inc(i);
if not valid then Error('Invalid file format, Address expected',LineNumber);
adr:=dat;
blank;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=false;
dat:=0;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=true;
if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
else dat:=16*dat+(ord(s[i])-ord('A')+10);
inc(i);
end;
blank;
if valid then begin if Data.Store(adr,dat)
then Error('Bad Address',LineNumber);
inc(adr);
end;
end;
if (s[i]<>';') and (s[i]<>'#')
then Error('Invalid file format, unexpected char "'+s[i]+'"',LineNumber);
end;
begin if length(s)=0 then exit;
i:=1;
blank;
s:=s+';';
while (i<=length(s)) and ( s[i]<>';' ) and (s[i]<>'#') do
begin {-- jednotliva cisla --}
hex;
end;
end; {_LineIn_TXT_}
 
procedure _LineIn_HEX_(var s:string; var Data:PicData_t; LineNumber:integer);
{== Pomocna procedura zpracuje radku HEX textu a data ulozi do datoveho objektu ==}
var i,j:integer;
adr,dat:word;
suma:byte;
function h(i:integer):byte;
begin if s[i]<='9' then h:=(ord(s[i])-ord('0'))
else h:=(ord(s[i])-ord('A')+10);
end;
begin {-- filtrace radky --}
j:=1; { vyhod blank znaky }
for i:=1 to length(s) do if (s[i]<>' ') and (s[i]<>#8) then
begin s[j]:=s[i];
inc(j);
end;
byte(s[0]):=j-1;
if s=':00000001FF' then exit; { ukoncovaci veta }
if s[1]<>':' then exit; { platny zacatek }
if length(s)=0 then exit; { prazdne radky nevadi }
if length(s)<13 then Error('Invalid file format, line too short',LineNumber);
{-- vytazeni cislic --}
for i:=2 to length(s) do
if not (s[i]in ['0'..'9']) and not (s[i]in ['A'..'F'])
then Error('Invalid file format, illegal char',LineNumber);
j:=16*h(2)+h(3); { pocet polozek }
if j and 1 = 1 then Error('Invalid file format, odd data count',LineNumber);
if length(s) <> j*2+11 then Error('Invalid file format, line length',LineNumber);
j:=j div 2;
{-- kontrola kontrolniho souctu HEX --}
suma:=0;
for i:=0 to 2*j+5-1 do
begin {$R-} suma:=suma+h(2+i*2)*16+h(3+i*2);
{$R+}
end;
if suma<>0 then Error('CheckSum Error',LineNumber);
{-- Nacteni dat --}
adr:=(( h(4) *16 + h(5)) *16 + h(6)) *16 + h(7);
if adr and 1 = 1 then Error('Invalid file format, odd addres',LineNumber);
adr:=adr shr 1;
if (s[8]<>'0') or (s[9]<>'0') then exit;
for i:=0 to j-1 do
begin dat:=( ( h(4*i+12) *16 + h(4*i+13)) *16
+ h(4*i+10)) *16 + h(4*i+11) ;
if Data.Store(adr,dat)
then Error('Bad Address',LineNumber);
inc(adr);
end;
end; {_LineIn_HEX_}
 
procedure PicDataIo_t.Import( Name:string; Format:IO_t);
{== Vstup dat ze souboru do datoveho objektu ==}
var f:text;
s:string;
LineNumber:integer;
begin name:=UpStr(name);
writeln('Importing data from file: ',name);
assign(f,name);
{$I-}
reset(f);
{$I+}
if ioresult<>0 then Error('Unable open file: '+name,0);
{$I-}
LineNumber:=0;
repeat inc(LineNumber); { pocitani cisla radky pro pripad chyby }
readln(f,s);
s:=UpStr(s);
case Format of
_TXT_ : _LineIn_TXT_(s,self,LineNumber);
_HEX_ : _LineIn_HEX_(s,self,LineNumber);
end; {case}
until eof(f);
close(f);
{$I+}
if ioresult<>0 then Error('Unable read from file: '+name,LineNumber);
{ pro testovani importu }
{ Export('a.a',_TXT_,';Test of Import procedure'); }
end; {Import}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_PGMHW.PAS
0,0 → 1,370
unit PP_PGMHW;
 
{== Ovladani programatoru ==}
 
{========================================================}
{ (c)DECROS 2000 miho, pefi }
{ 1.0 - ovladani programatoru pres LPT a ALL03 }
{ 1.1 - zmena vystupu cisla portu z DEC na HEX }
{ - doplneni xDelayMicro(1) u vazby na ALL03 }
{========================================================}
 
 
interface
 
uses DELAY,
PP_ALL03;
 
type Logical=(zero,one,tristate); { typ pro definovani stavu vystupu }
 
type PGM = object
{-- Rodicovsky objekt pro ovladani programatoru --}
 
_PortAdr : word; { adresa portu }
_Error : string; { retezec posledni chyby }
 
constructor Init(Port:word);
{== inicializuje a zapamatuje adresu ==}
 
procedure Error(S:string);
virtual;
{== vypise chybu ==}
 
procedure Info(S:string);
virtual;
{== vypise info ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_p=^PGM;
 
type PGM_LPT = object(PGM)
{-- Objekt ovladani programatoru pres LPT --}
 
_PortStat : byte;
 
constructor Init(Port:word);
{== inicializuje, vstupem je cislo portu ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_LPT_p=^PGM_LPT;
 
type PGM_ALL = object(PGM)
{-- Objekt ovladani programatoru ALL03 --}
 
_ProgAdr : word;
 
constructor Init(Port:word);
{== inicializuje, vstupem je cislo portu ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_ALL_p=^PGM_ALL;
 
implementation
 
function num2str(w:word):string;
{== Prevede cislo na retezec ( jako HEX cislo ) ===}
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var s:string;
begin s[0]:=#4;
s[1]:=prevod[(w shr 12) and $F];
s[2]:=prevod[(w shr 8) and $F];
s[3]:=prevod[(w shr 4) and $F];
s[4]:=prevod[(w shr 0) and $F];
if s[1]='0' then s:=copy(s,2,255);
if s[1]='0' then s:=copy(s,2,255);
if s[1]='0' then s:=copy(s,2,255);
num2str:=s;
end; {num2str}
 
{========================================================}
{ }
{ Programator prazdny prototyp }
{ miho }
{========================================================}
 
constructor PGM.Init(Port:word);
{== inicializuje a zapamatuje adresu ==}
begin _PortAdr:=0;
end; {Init}
 
procedure PGM.Error(S:string);
{== vypise chybu ==}
begin _Error:=s;
end; {Error}
 
procedure PGM.Info(S:string);
{== vypise info ==}
begin writeln('INFO: ',S);
end; {Error}
 
procedure PGM.SetVcc(Voltage:real);
{== nastav napajeni ==}
begin
end; {SetVcc}
 
procedure PGM.SetVpp(Voltage:real);
{== nastav programovaci napeti ==}
begin
end; {SetVpp}
 
procedure PGM.SetReset(Stat:Logical);
{== nastav signal RESET dle Stat ==}
begin
end; {SetReset}
 
procedure PGM.SetData(Stat:Logical);
{== nastav signal DATA dle Stat ==}
begin
end; {SetData}
 
procedure PGM.SetClock(Stat:Logical);
{== nastav signal CLOCK dle Stat ==}
begin
end; {SetClock}
 
function PGM.GetData:boolean;
{== precte stav datoveho vstupu ==}
begin
end; {GetData}
 
{========================================================}
{ }
{ Programator via printer port }
{ miho }
{========================================================}
 
const LPT_DATA = $01; { Datovy vystup - RB7 }
LPT_DATAOE = $02; { Povoleni vystupu }
LPT_CLOCK = $04; { Hodiny - RB6 }
LPT_CLOCKOE = $08; { Povoleni vystupu }
LPT_VCC = $10; { Zapnuti +5V }
LPT_VPP = $20; { Zapnuti +12V na MCLR }
LPT_RES = $40; { Pripojeni 0V na MCLR }
 
LPT_DATAIN = $40; { Maska bitu pro cteni dat }
 
 
constructor PGM_LPT.Init(Port:word);
var AdrTab:array[1..3]of word absolute 0:$408;{ tabulka LPT1..LPT3 z BIOSu }
{== inicializuje a zapamatuje adresu ==}
var w:word;
begin _PortAdr:=0;
_Error:='';
_PortStat:=0;
if (port<1) or (port>3) then Error('Invalid Port Number')
else _PortAdr:=AdrTab[Port];
if _PortAdr=0 then Error('Port not Registered in BIOS');
Info('Port Address '+num2str(_PortAdr)+'H');
if _Error<>'' then fail;
if _PortAdr<>0 then system.port[_PortAdr]:=_PortStat;
end; {Init}
 
procedure PGM_LPT.SetVcc(Voltage:real);
{== nastav napajeni ==}
begin if Voltage = 5.0 then _PortStat:=_PortStat or LPT_VCC
else _PortStat:=_PortStat and not LPT_VCC;
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetVcc}
 
procedure PGM_LPT.SetVpp(Voltage:real);
{== nastav programovaci napeti ==}
begin if Voltage=13.0
then _PortStat:= LPT_VPP or ( _PortStat and not LPT_RES )
else _PortStat:= _PortStat and not LPT_VPP;
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetVpp}
 
procedure PGM_LPT.SetReset(Stat:Logical);
{== nastav signal RESET dle Stat ==}
begin case Stat of
zero : begin SetVpp(0);
_PortStat:=_PortStat or LPT_RES;
end;
one : _PortStat:=_PortStat and not LPT_RES;
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetReset}
 
procedure PGM_LPT.SetData(Stat:Logical);
{== nastav signal DATA dle Stat ==}
begin case Stat of
zero : _PortStat := ( _PortStat and not LPT_DATA ) or LPT_DATAOE;
one : _PortStat := _PortStat or LPT_DATA or LPT_DATAOE;
tristate : _PortStat := ( _PortStat and not LPT_DATAOE and not LPT_DATA )
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetData}
 
procedure PGM_LPT.SetClock(Stat:Logical);
{== nastav signal CLOCK dle Stat ==}
begin case Stat of
zero : _PortStat := ( _PortStat and not LPT_CLOCK ) or LPT_CLOCKOE;
one : _PortStat := _PortStat or LPT_CLOCK or LPT_CLOCKOE;
tristate : _PortStat := ( _PortStat and not LPT_CLOCKOE and not LPT_CLOCK )
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetClock}
 
function PGM_LPT.GetData:boolean;
{== precte stav datoveho vstupu ==}
begin GetData:=(port[_PortAdr+1] and LPT_DATAIN) = LPT_DATAIN;
xDelayMicro(1);
end; {GetData}
 
 
{========================================================}
{ }
{ Programator ALL03 }
{ pefi }
{========================================================}
 
{ Tato cast v podstate jen vola funkce jednotky ProgAll }
 
const ALL_VCC = 30;
ALL_GND = 11;
ALL_VPP = 10;
ALL_CLOCK = 28;
ALL_DATA = 29;
 
Constructor PGM_All.Init(Port:Word);
{== provede inicializaci programatoru ==}
begin
Initialize(Port);
Gnd11(true); { pripoji zem na vyvodu 11 }
end;{End Init}
 
procedure PGM_All.SetVcc(Voltage:real);
{== zapina a vypina napajeni ==}
begin
SetVoltageV1(Voltage);
if Voltage=0 then ConnectV1(ALL_VCC,false)
else ConnectV1(ALL_VCC,true);
xDelayMicro(1);
end;{End SetVcc}
 
procedure PGM_All.SetVpp(Voltage:real);
{== zapina a vypina programovaci napeti ==}
begin
SetVoltageV2(Voltage);
if Voltage=0 then ConnectV2(ALL_VPP,false)
else ConnectV2(ALL_VPP,true);
xDelayMicro(1);
end;{EndSetVpp}
 
procedure PGM_All.SetReset(Stat:Logical);
{== nastavi nebo shodi signal Reset-VPP ==}
begin
ConnectV2(ALL_VPP,false);{nejdrive nutno Vpp odpojit}
if Stat = zero then SetBit(ALL_VPP,0)
else SetBit(ALL_VPP,1);
xDelayMicro(1);
end;{EndSetReset}
 
procedure PGM_All.SetData(Stat:Logical);
{== nastavi nebo shodi signal DATA ==}
begin
if Stat = zero then SetBit(ALL_DATA,0)
else SetBit(ALL_DATA,1);
xDelayMicro(1);
end;{End SetData}
 
procedure PGM_All.SetClock(Stat:Logical);
{== nastavi nebo shodi signal CLK ==}
begin
if Stat = zero then SetBit(ALL_CLOCK,0)
else SetBit(ALL_CLOCK,1);
xDelayMicro(1);
end;{End SetClock}
 
function PGM_All.GetData:boolean;
var
stav:byte;
begin
Stav:=GetBit(ALL_DATA);
if Stav=1 then GetData:=true
else GetData:=false;
xDelayMicro(1);
end;{End GetData}
 
end.
/Modules/PICPGR3/PICPGR301A/SW/4_12/PP_PROC.PAS
0,0 → 1,988
 
{Toto je include soubor}
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice vlastnosti vsech procesoru PIC, ktere tento program znam. }
{===========================================================================}
{verze: }
{ 1.00 - Uvodni verze }
{ 1.01 - Uprava definic procesoru 12C508/509 PEFI }
{ 1.02 - Doplneny procesory 87xA MIHO }
{ 1.11 - Doplneny procesory 627A/628A/648A MIHO }
 
{---> PP_DEFS - zde je nadefinovany pocet procesoru a druhy algoritmu --}
{---> PP_CFG - zde jsou nadefinovany prepinace Cfg slova --}
const ProcInfoAll:array[1..ProcCount] of ProcInfo_t =
(
{-- Programovane starym algoritmem EPROM --}
( Name: 'PIC12C508';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C508A';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C509';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C509A';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE518';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE519';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C505';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani standardnim algoritmem EPROM --}
( Name: 'PIC12C671';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C672';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE673';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE674';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC14000';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC14C000';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C554';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C556';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C558';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C61';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C71';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C64';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C710';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C711';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C63';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C63A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C64A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C66';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C67';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C72';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C72A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C76';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C77';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C620';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C620A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C621';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C621A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C622';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C622A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE623';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE624';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE625';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C712';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C716';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C745';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C765';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C923';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C924';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C773';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C774';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C717';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C770';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C771';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani standardnim algoritmem EPROM ale s paritou pameti programu ( 14 bit + 2 bity parita ) --}
( Name: 'PIC16C642';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C662';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C715';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani algoritmem EEPROM / FLASH --}
( Name: 'PIC16C84';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'C84';
Cfg_Base: $2007;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F83';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F84';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F84A';
Alg: _EE2_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
{}
( Name: 'PIC16F627';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $3DFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F628';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $3DFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F627A';
Alg: _EE4_;
Tprog: 6000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $21FF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F628A';
Alg: _EE4_;
Tprog: 6000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $21FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F648A';
Alg: _EE4_;
Tprog: 6000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $21FF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F818';
Alg: _EE5_;
Tprog: 8000;
Bits: 14;
Cfg: 'F818';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F819';
Alg: _EE5_;
Tprog: 8000;
Bits: 14;
Cfg: 'F818';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
{}
( Name: 'PIC16F870'; { ! nemam zarucena data }
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F871'; { ! nemam zarucena data }
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F872';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F873';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F874';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F876';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F877';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F873A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F874A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F876A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F877A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
)
);
/Modules/PICPGR3/PICPGR301A/SW/4_12/TSTPGR.EXE
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Modules/PICPGR3/PICPGR301A/SW/4_12/tstpgr.PAS
0,0 → 1,96
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
{$M 16384,0,655360}
 
program TSTPGR(Input,Output);
 
{=============================================================}
{== Program pro testovani a ozivovani programatoru PICPGR ==}
{=============================================================}
 
{ (c)miho 2004 }
 
{=============================================================}
{ Historie: }
{ 1.00 Novy program }
{=============================================================}
 
 
uses CRT;
 
var PortAdr:word absolute 0:$408;
 
procedure key;
begin readln;
end;
 
begin {== Uvodni tisk ==}
 
writeln;
writeln('Test Utility for PICPGR');
writeln('=======================');
writeln('(c) miho 2004 v.1.00');
writeln;
 
{== Overeni dostupnosti portu LTP1 ==}
 
if PortAdr=0 then begin writeln('No LPT port available!');
halt(1);
end;
 
{== Testovaci posloupnost ==}
writeln('Action PGC PGD VDD ... GND VPP Comment');
writeln('-------------------------------------------------------------------------------');
port[PortAdr]:=0;
writeln('OFF X X 0V . 0V 0V Standard state OFF');
key;
 
port[PortAdr]:=$10;
writeln('Vdd ON X X +5V . 0V +5V');
key;
 
port[PortAdr]:=$50;
writeln('Vdd ON and RESET X X +5V . 0V 0V');
key;
 
port[PortAdr]:=$20;
writeln('Vpp ON X X 0V . 0V 0V Invalid state (missing Vdd)');
key;
 
port[PortAdr]:=$30;
writeln('Vpp and Vdd ON X X +5V . 0V +12V');
key;
 
port[PortAdr]:=$02;
writeln('Data 0 X L 0V . 0V 0V');
key;
 
port[PortAdr]:=$03;
writeln('Data 1 X H 0V . 0V 0V');
key;
 
port[PortAdr]:=$08;
writeln('Clock 0 L X 0V . 0V 0V');
key;
 
port[PortAdr]:=$0C;
writeln('Clock 1 H X 0V . 0V 0V');
key;
 
writeln;
writeln('Test PGD input, use 10k resistor to connect PDG to GND and VDD');
writeln;
port[PortAdr]:=$10;
 
repeat
if (port[PortAdr+1] and $40)<>0 then write('PGD State: H')
else write('PGD State: L');
write(#$0D);
until keypressed and (readkey=#$0D);
 
writeln;
writeln;
writeln('Action PGC PGD VDD ... GND VPP Comment');
writeln('-------------------------------------------------------------------------------');
port[PortAdr]:=$80+$3F;
writeln('OFF X X 0V . 0V 0V Alternative state OFF');
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/!____!.TXT
0,0 → 1,78
Programator pro PIC 16C84
- dodelan hex format
- dodelany prepinace ( XT, LP, ...., CP )
- dodelana moznost spousteni programu v programatoru
 
verze 1_3:
- predelana procedura Delay tak, aby to chodilo i na rychlych PC
 
verze 1_31:
- dodelana konverze formatu souboru zejmena za ucelem snadne konverze
formatu HEX na format TEXT
 
verze 1_32
- zmenena knihovna DELAY za novou verzi ( podpora procesoru PentiumII
nad 250MHz )
 
verze 2.00
- dopnena moznost programovani EPROM ( a OTP ) verze procesoru PIC
- zmena v chovani prepinacu ( nejsou li nikde ani v datech ani jako
prepinace tak se config slovo neprogramuje
- pro EPROM programovani se musi config slovo zadat jen v datech
 
verze 3.00
- odvozena z verze 2.01
- zcela predelana vrstva propojeni s HW programatoru ( objektove, s vyhledem
na popdoru vice programovacich HW )
- od verze 3.00 existuji 2 vyvojove podverze
VAR_MIHO - s prazdnou podporou vice hardwaru
VAR_PEFI - s doplnenou podporou programataru ALL03
 
verze 3.01
- jen znovu prelozena verze 3.00 v plne verzi s podporou jak puvodniho
maleho programatoru tak i programatoru ALL03
- v teto verzi patrne nefunguji prikazy RUN, RESET a STOP
 
verze 3.10
- rozsahle opravy ( export a import dat, oprava prikazu RUN, STOP, RESET )
 
verze 3.11
- zavedeny konstanty do programu ( vyhled na procesory s vice ne 1K pameti )
 
Udelat: - zlepsit helpy - popis formatu
- exit chybove kody ( program, verify a erase )
- pipnout pri chybe
- zautomatizovat rozpoznani formatu souboru pri importu
- v textovem formatu zavest nedefinovane hodnoty ( nejlepe ?? )
- v textovem formatu definovat komentare
- v textovem exportu uvadet v komentari vyznam configuracniho slova
- v HEX exportu exportovat jen platna data ( to bude obtizne,
mozna bude nejsnazsi predelat datove buffery do objektu )
 
verze 4.01
- velmi rozsahle zmeny ve strukture programu
- podpora mnoha druhu procesoru ( databaze ) - povinny parametr
- error level
- zmeny v programovacich algoritmech ( zmena casu )
 
verze 4.02
- primo vychazi z verze 4.01
- doplnena podpora procesoru s algoritmem EPROM1 (stare procesory jako
je PIC12C508 a podobne)
 
verze 4.10
- doplnena podpora procesoru 16F87xA
- novy algoritmus EE3 - neni dopsan
 
verze 4.11
- doplnena podpora PIC16F827A/828A/848A (novy algoritmus EE4)
- doplnena podpora PIC16F818/819 (novy algoritmus EE5)
- dodelana podpora PIC16F87xA (algoritmus EE3)
 
verze 4.12
- kosmeticke zmeny
Udelat: - podpora algoritmu EPROM3
- zpracovani prepinacu pro Cfg slovo jinych nez PIC16F
- export jen platnych dat ( HEX i TXT )
- definici procesoru a algoritmu v samostatnem souboru (.DEF)

/Modules/PICPGR3/PICPGR301A/SW/4_13/DELAY.PAS
0,0 → 1,140
unit Delay;
 
{-----------------------------------------------------------------}
{ Definovane spozdeni, ktere funguje i na }
{ vykonnejsich pocitacich }
{ }
{ Verze 1.0 portovano by miho 96 }
{ 1.1 popora kratkych casu miho 98 }
{ 1.2 podpora rychlych CPU ( rozsireni DelayCnt1 na DWORD ) }
{-----------------------------------------------------------------}
 
{$I-,S-}
 
interface
 
 
procedure xDelay(MS: Word);
{-- cas uveden v milisekundach --}
 
 
procedure xDelayMicro(MicroS: Word);
{-- cas uveden v mikrosekundach --}
{ POZOR: Casy jsou vzdy o neco delsi a za normalnich podminek }
{ je cas delsi radove o nekolik mikrosekund }
{ ( na PC Pentium 75 to dela cca 6us ). }
 
 
implementation
 
 
var DelayCnt1:longint; { kalibrace casu po 1 ms }
DelayCnt55:longint; { totez pred vydelenim 55 }
 
 
procedure DelayLoop;
begin
asm
@@Loop: SUB AX,1 { DX:AX - pocitadlo DWORD }
SBB DX,0 { dekrement }
JC @@End { doteklo }
CMP BL,ES:[DI] { pri uplynuti tiku ( 55ms ) }
JE @@Loop { taky koncim }
@@End:
end;
end;
 
 
procedure Initialize;
{-- inicializace - kalibrace casu --}
begin
asm
MOV AX,40H { adresa bunky BIOS DATA s tiky }
MOV ES,AX { po 55 ms aktualizuje BIOS }
MOV DI,6CH
MOV BL,ES:[DI]
@@Wait: CMP BL,ES:[DI]
JE @@Wait { pockej na cely tik }
MOV BL,ES:[DI] { schovej si tik do BL }
MOV AX,-28 { piskvorcova konstanta ? asi }
CWD
CALL DelayLoop { pockej na konec tiku BL }
NOT AX { a pocitej cas v DS:AX}
NOT DX
MOV word ptr [DelayCnt55],AX { uschovej kalibraci }
MOV word ptr [DelayCnt55+2],DX
end; {asm}
DelayCnt1:=DelayCnt55 div 55; { uschovej kalibraci 1 ms }
end; {Initialize}
 
 
procedure xDelay(MS: Word);
{-- proved standardni spozdeni merene v milisekundach --}
begin
asm
MOV CX,MS { pocet milisekund }
JCXZ @@End { nulova hodnota - hned konci }
MOV AX,40H { adresa BIOS COM port - to je }
MOV ES,AX { jakakoli bunka, ktera se v }
XOR DI,DI { v provozu nemeni aby se netestoval }
MOV BL,ES:[DI] { casovac a presto mohla byt }
@@Loop: MOV AX,word ptr [DelayCnt1] { procedura DelayLoop stejna }
MOV DX,word ptr [DelayCnt1+2] { DX:AX kalibracni konsatnta }
CALL DelayLoop { pro spozdeni 1 ms }
LOOP @@Loop
@@End:
end; {asm}
end; {xDelay}
 
 
procedure xDelayMicro(MicroS: Word);
{-- procedura pro spozdeni zadavane v mikrosekundach --}
label Error;
begin {-- prepocitej zadany cas na pocet cyklu --}
asm
{-- DWORD * WORD / WORD -> DWORD --}
SUB DX,DX
MOV AX,WORD PTR[DelayCnt55+2]
MOV BX,55000
MOV CX,MicroS
DIV BX
PUSH DX
MUL CX
MOV DI,DX
AND DX,DX
POP DX
JNZ Error
MOV AX,WORD PTR[DelayCnt55]
DIV BX
PUSH DX
MUL CX
MOV SI,AX
ADD DI,DX
POP AX
JC Error
MUL CX
DIV BX
ADD SI,AX
ADC DI,0
PUSH SI
PUSH DI
{-- vlastni spozdeni --}
MOV AX,40H { opet konstantni bunka }
MOV ES,AX
XOR DI,DI
MOV BL,ES:[DI]
POP DX { DX:AX cas v poctech cyklu }
POP AX
CALL DelayLoop
end; {asm}
exit;
asm
Error: MOV AX,0FFFFH
MOV DX,AX
CALL DelayLoop
end; {asm}
end;
 
 
begin Initialize; { udelej kalibraci }
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/PICPGR.EXE
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Modules/PICPGR3/PICPGR301A/SW/4_13/PICPGR.PAS
0,0 → 1,1057
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
 
program PicPgr(Input,Output);
 
{=============================================================}
{== Program pro programovani ruznych PICu ( FLASH i EPROM ) ==}
{=============================================================}
 
uses DELAY, { casova spozdeni }
PP_PGMHW, { ovladani hardwaru programatoru }
PP_COMON, { pomocne funkce }
PP_DEFS, { defince procesorove zavislych parametru }
PP_DATA, { ulozeni dat v pameti }
PP_IO; { import a export dat z/do souboru }
 
const ver : string[4] = '4.13'; { vzdy 4 znaky }
date : string[4] = '2004'; { vzdy 4 znaky }
 
{=============================================================}
{ Zmeny: }
{ 2.01 - vychozi verze pro tuto verzi }
{ 3.00 - predelana kompletne vrstva pro ovladani HW ( moznost }
{ popdory vice programatoru ) }
{ 3.01 - finalni verze s podporou programovani pres LPT port }
{ a na programatoru ALL03 }
{ 3.10 - pridana informace o zdoji dat pri vystupu v TXT }
{ formatu }
{ - cislovani radek pri vypisu chyby ve vstupnich datech }
{ - odstranena chyba exportu dat v HEX formatu }
{ - dodelana kontrola kontrolniho souctu HEX formatu }
{ - znovu zprovozneny prikazy RUN, STOP, RESET }
{ - zmena default obsahu pri konverzi z 0 na 3FFF }
{ 3.11 - cisla ve zdrojaku nahrazena konstantami }
{ 4.00 - velmi rozsahle zmeny ve strukture }
{ - prepinani parametru podle typu soucastky }
{ - zmena Vpp z 12.0V na 13.0V }
{ - doplneno zpozdeni po zapnuti napajeni }
{ - zmena programovacich casu u C/F84 (20ms na 10ms) }
{ - podpora ErrorLevel pri programovani a verifikaci }
{ 4.01 - prvni realese verze z rady 4.x }
{ 4.02 - doplnena podpora algoritmu EEPROM1 PEFI }
{ 4.10 - doplnena podpora PIC16F87xA (novy algoritmus EE3 }
{ a nove prepinace, neni dodelana veririkace !) }
{ 4.11 - doplnena podpora PIC16F627A/628A/648A (novy alg EE4) }
{ doplnena podpora PIC16F818/819 (novy alg EE5) }
{ dodelana podpora PIC16F87xA (EE3) }
{ 4.12 - kosmeticke upravy }
{ 4.13 - doplneny PIC16F87/88 }
{ Chybi: }
{ - podpora algoritmu EPROM3 }
{ - zpracovani prepinacu pro Cfg slovo jinych nez PIC16F }
{ - export jen platnych dat ( HEX i TXT ) }
{=============================================================}
 
 
{====== Rizeni programatoru - propojeni s HW ======}
 
const P:PGM_p = nil; { Inicializovana promenna }
 
procedure InitHW(Port:word);
{== Procedura inicializuje propojeni s HW ==}
begin if port<4 then P:=new(PGM_LPT_p,Init(Port))
else P:=new(PGM_ALL_P,Init(Port));
if P=nil then Error('Unable Init HW',0);
end; {InitHW}
 
const StartPICStat:boolean=false; { true po dobu programovani }
{ Tuto promennou nastavuje procedura StartPIC a vypina procedura }
{ StopPIC. Je tedy aktivni zejmena po dobu programovani a slouzi }
{ pro zajisteni vypnuti programovaciho napeti v pripade }
{ ze program skonci predcasne. }
 
procedure StartPIC(Voltage:real);
{== Zapnuti PIC pro programovani, cteni, verifikaci ==}
{ Voltage udava pracovni napajeci napeti }
begin StartPICStat:=true; { true znamena programovani }
{-- nastav definovany stav signalu --}
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(Voltage); { zapni napajeni }
P^.SetData(zero); { otevri budice }
P^.SetClock(zero);
xDelay(50); { ustaleni napeti }
P^.SetReset(one); { ukonci reset }
P^.SetVpp(13.0); { zapni Vpp }
 
xDelay(50); { ustaleni napeti }
end; {StartPIC}
 
procedure EndPIC;
{== Vypnuti PIC po programovani ==}
begin P^.SetData(tristate); { odpoj vystupy }
P^.SetClock(tristate);
P^.SetVpp(0); { odpoj Vpp }
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(0); { vypni Vcc }
xDelay(50); { pockej }
P^.SetReset(one); { a odpoj i reset ( pokud je napajeni zvenku ) }
{ tak se to rozbehne }
StartPICStat:=false; { false znamena konec programovani }
end; {EndPIC}
 
{====== Posilani prikazu a dat do a z procesoru ======}
 
procedure OutCommandPIC(Command:word);
{== Zapise prikaz ( bez dat ) do PIC ==}
var i:integer;
begin for i:=1 to 6 do
begin if (Command and 1)=1 then P^.SetData(one)
else P^.SetData(zero);
P^.SetClock(one);
P^.SetClock(zero);
Command:=Command shr 1;
end;
P^.SetData(tristate); { odpoj datovy vystup }
end; {OutCommandPIC}
 
procedure OutputDataPIC(Bits:word; Command:word; Data:word);
{== Zapise prikaz a data do PIC ==}
{ Prenasi se bud 14 ( obvody 12 nebo 14 bitu core ) nebo 16 ( soucastky }
{ s paritou pameti programu ) bitu }
var i:integer;
begin OutCommandPIC(Command);
P^.SetData(zero); { start bit 0 }
P^.SetClock(one);
P^.SetClock(zero);
for i:=1 to Bits do
begin if (Data and 1)=1 then P^.SetData(one) { data bit }
else P^.SetData(zero);
P^.SetClock(one);
P^.SetClock(zero);
Data:=Data shr 1;
end;
P^.SetData(zero); { stop bit 0 }
P^.SetClock(one);
P^.SetClock(zero);
end; {OutputDataPIC}
 
function InputDataPIC(Bits:word; Command:word):word;
{== Posli prikaz a vrat odpoved z PIC ==}
{ Precte zadany pocet bitu dat. Tento pocet nemusi }
{ nutne souhlasit s poctem platnych bitu dat }
{ ( napriklad u souvasti s delkou slova 12 bitu ). }
var Data:word;
i:integer;
b:word;
begin OutCommandPIC(Command); { zanecha DATA jako vstup }
Data:=0;
b:=1; { bitova maska }
P^.SetClock(one); { start bit }
P^.SetClock(zero);
for i:=1 to Bits do
begin P^.SetClock(one);
P^.SetClock(zero);
if P^.GetData then Data:=Data or b; { byla datova 1 }
b:=b shl 1; { posun masku }
end;
P^.SetClock(one); { stop bit }
P^.SetClock(zero);
InputDataPIC:=Data;
end; {InputDataPIC}
 
{====== Programovaci prikazy pro PIC ======}
 
const LoadConfiguration_00 = $00; { nastav PC na 2000H }
LoadDataPM_02 = $02; { predej data pro PM }
ReadDataPM_04 = $04; { precti data z PM }
IncrementAddress_06 = $06; { posun PC o 1 }
BeginProgramming_08 = $08; { zahaj programovani, u nekterych clenu i mazani radky }
BeginProgrammingOnlyCycle_18 = $18; { zacni zapisovat, obvykle bez mazani }
LoadDataDM_03 = $03; { predej data pro DM }
ReadDataDM_05 = $05; { precti data z DM }
BulkErasePM_09 = $09; { smaz celou PM (pokud neni zamcena) }
BulkEraseDM_0B = $0B; { smaz celou DM (pokud neni zamcena) }
EndProgramming_0E = $0E; { _EPROMx_ - jen pro EPROM verze }
EndProgramming_17 = $17; { _EE5_ ukonci programovani }
Dis1_01 = $01; { _EEx_ - jen pro odstraneni code }
Dis2_07 = $07; { protection }
ChipErase_1F = $1F; { smaz celou soucastku (u nekterych na to staci BulkErasePM pokud je PC 2007) }
 
{====== Zpracovani parametru ======}
 
const Port : integer = -1; { Cislo portu pro komunikaci }
FileFormat: IO_t = _NIL_; { Format datoveho souboru }
CfgString : string = ''; { Sem si zapamatuji Cfg retezec }
{ Nenastaveny ( nepouzity ) prepinac je -1 }
 
{====== Zpracovani prepinacu ======}
 
function TestSwitch(var s:string; sw:string):boolean;
{== Pokud je sw soucasti retezce s vraci true a odstrani sw z retezce s ==}
var i:integer;
begin TestSwitch:=false;
{-- test --}
i:=pos(sw+' ',s+' ');
if i=0 then exit; { nenalezen }
{-- nalezen --}
s:=copy(s,1,i-1)+copy(s,i+length(sw)+1,255);
TestSwitch:=true;
end; {TestSwitch}
 
{====== Zpracovani Cfg parametru ======}
 
procedure CfgSwitches( var s:string; Ostre:boolean;
var Cfg:word; var CfgStat:boolean
);
{== Zpracuje prepinace konfiguracniho slova, pokud je predano true ==}
{ tak upravi hodnotu predaneho parametru. Uzere z retezce s }
{ prepinace, ktere zpracovala }
{ }
{ s retezec s parametry, zpracovane casti se uzerou }
{ Ostre true znamena, ze se maji data aktualizovat }
{ Cfg config data }
{ CfgStat priznak platnosti dat v poli Cfg }
{ }
begin {-- dle typu procesoru preda konkretni procedure --}
 
end; {CfgSwitches}
 
procedure DisplayConfigWord(Cfg:word; Cfg_Stat:boolean);
begin if Cfg_Stat
then begin write('Config Word: ');
HexWord(output,Cfg);
writeln;
end
else begin writeln('Config Word: none');
end;
end; {DisplayConfigWord}
 
procedure Switches(s:string; var Data:PicData_t);
{== Zpracovani prepinacu, volba typu soucastky, init datoveho objektu ==}
var ix:integer; { index do tabulky CfgDefAll}
Proc:ProcInfo_t; { informace o vybrane procesoru }
begin s:=UpStr(s);
{-- adresa portu --}
if TestSwitch(s,'LPT3' ) then Port := 3; { Z BIOS tabulky }
if TestSwitch(s,'LPT2' ) then Port := 2;
if TestSwitch(s,'LPT1' ) then Port := 1;
if TestSwitch(s,'ALL03') then Port := $2E0; { ALL03 porty }
{-- typ souboru --}
if TestSwitch(s,'HEX' ) then FileFormat:= _HEX_; { Moje cislovani filtru }
if TestSwitch(s,'TEXT' ) then FileFormat:= _TXT_;
if TestSwitch(s,'TXT' ) then FileFormat:= _TXT_;
{-- Default hodnoty --}
if Port = -1 then Port := 1;
if FileFormat = _NIL_ then FileFormat := _TXT_;
{-- typ a parametry soucastky --}
ProcFind(s,Proc);
if Proc.Name=''
then begin (* Volba default procesoru je zamerne zaslapnuta protoze mate uzivatele
ProcFind('PIC16F84',Proc); { Default hodnota }
*)
end
else if TestSwitch(s,Proc.Name) then; { Sezer pouzitou hodnotu }
Data.Init(Proc);
{-- prislusnost soucastky do skupiny pro Cfg prepinace --}
ix:=CfgFindProcGroup(Proc.Cfg,CfgDefAll); { i je index do konstanty CfgDefAll }
{-- zpracovani prepinacu specifickych pro Cfg slovo --}
{ s ... retezec s prepinacema, ktere jeste nebyly zpracovany }
{ ix ... index do tabulky CfgDefAll s informacemi o prepinacich skupiny }
CfgString:=CfgX; { prazdny ( sama 'X' Cfg retezec }
if ix>0 then
begin CfgString:=CfgTestKeyMultiple(s,CfgDefAll[ix]);
if CfgString='' then Error('Konflicting Cfg switch '+GetWord(s),0);
end;
if s<>'' then Error('Unrecognized switches: '+s,0);
end; {Switches}
 
{====== Hlavni cinnosti ( akce ) programu ======}
 
procedure Help;
{== Vypise navod k pouziti ==}
var i:integer;
Proc:ProcInfo_t;
begin writeln('Usage: PICPGR <what_to_do> [<file_name>] [switches]');
writeln;
writeln('PICPGR READ <file_name> <procesor> [switches]');
writeln('PICPGR PROGRAM <file_name> <procesor> [switches]');
writeln('PICPGR VERIFY <file_name> <procesor> [switches]');
writeln('PICPGR ERASE <procesor> [switches]');
writeln('PICPGR RUN [switches]');
writeln('PICPGR STOP [switches]');
writeln('PICPGR RESET [switches]');
writeln('PICPGR CONVERT <file_in> <file_out> [switches]');
writeln;
writeln('Exit: 0 O.K.');
writeln(' 1 Generic Error');
writeln(' 100 Program or Verify Error');
writeln;
writeln('Switches: LPT1*, LPT2, LPT3 Development Programmer via LPT');
writeln('*=default ALL03 HI-LO Programmer');
writeln(' TXT*, HEX Data File Format');
writeln;
PressEnter;
writeln('Note: Processor groups can have their own set of switches');
writeln(' for overiding of Config Word settins.');
writeln;
writeln(' Boolean type: CP, CP_ON, CP_OFF');
writeln(' ( CP is CP_ON )');
writeln;
writeln(' Binary string: CP_101');
writeln(' ( binary digit string must');
writeln(' have corect length )');
writeln;
writeln('Help function:');
writeln;
writeln('PICPGR Long help - all processors)');
writeln('PICPGR <proc_name> Short help - particular processor');
writeln;
{-- varianta podle toho, zda mne zajima konkretni procesor --}
ProcFind(GetParamLine(1),Proc);
if Proc.Name<>''
then begin {-- konkretni procesor --}
ProcDisplayInfo(Proc); { zobraz co je vybrane }
i:=CfgFindProcGroup(Proc.Cfg,CfgDefAll);
if i>0 then
begin writeln(Proc.Name+' specific switches for Config Word overiding:');
writeln;
CfgDisplayHelp(CfgDefAll[i]);
end;
end
else begin {-- neni konkretni procesor - zobraz vsechno --}
PressEnter;
CfgDisplayHelpAll(CfgDefAll);
PressEnter;
ProcDisplayInfoAll;
end;
halt(1);
end; {Help}
 
var Data:PicDataIo_t; { globalni promenna pro ulozeni dat }
{ globalni je proto, protoze se neda }
{ pouzit lokalni ( nevejde se na zasobnik ) }
 
procedure ToDoRead;
{== Bude se cist ==}
{ Precte obsah soucastky do pametovych bufferu }
var i:integer;
j:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Cteni --}
InitHW(Port);
writeln('Reading data from PIC ...');
StartPIC(5.0);
case Proc.Alg of
_EPROM1_:
begin {-- Read Program Memory --}
OutCommandPIC(IncrementAddress_06); {preskoc konfiguracni slovo}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{-- Read Config Memory --}
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{--- Read Config Word ---}
EndPIC;
StartPIC(5.0);
Data.StoreProc( Proc.Cfg_Base,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.Cfg_Mask
);
end;
_EPROM2_,
_EE1_,
_EE2_,
_EE3_,
_EE4_,
_EE5_ :
begin {-- Read Program Memory --}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{-- Read Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
{-- Read Config Memory --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin Data.StoreProc( i,
InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask
);
OutCommandPIC(IncrementAddress_06);
end;
end;
_EPROM3_:
begin Error('Algorithm EPROM3 not yet supported',0);
end;
else Error('Algorithm not supported',0);
end; {case}
EndPIC;
{-- Vystup vysledku --}
Data.Export(paramstr(2),FileFormat,';Directly read from '+Proc.Name);
writeln('... Done');
end; {ToDoRead}
 
procedure Delta(adr,data1,data2:word);
{== Vypis info o rozdilu ==}
begin HexWord(output,adr);
write(': ');
HexWord(output,data1);
write('-');
HexWord(output,data2);
writeln;
end; {Delta}
 
procedure ToDoProgram;
{== Bude se programovat ==}
var i:integer;
err,count:integer;
data_wr:word; { data, ktera se maji zapsat }
data_rd:word; { data z kontrolniho cteni }
n:integer;
Proc:ProcInfo_t;
CfgStringTmp:string;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
InitHW(Port);
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Program --}
writeln('Programming data to PIC ...');
err:=0;
count:=0;
StartPIC(5.0);
{-- Program Program Memory --}
if Proc.PM_Len>0 then
begin
if Proc.Alg=_EPROM1_ then OutCommandPIC(IncrementAddress_06); {preskoc konfiguracni slovo}
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) then { platna data ? }
begin
data_wr:=Data.GetData(i); { vezmi data }
case Proc.Alg of
_EPROM1_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
inc(n);
until (n>8) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=n*11 downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
inc(count);
end;
_EPROM2_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
inc(n);
until (n>25) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=3*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
inc(count);
end;
_EPROM3_ :
begin Error('Algorithm EPROM3 not yet supported',0);
end;
_EE1_,
_EE2_,
_EE4_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
_EE3_,
_EE5_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgrammingOnlyCycle_18);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_17);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end; {od if testujicich platnost dat}
OutCommandPIC(IncrementAddress_06); { dalsi adresa PM }
end; {od cyklu for pres vsechny adresy}
 
(*
{-- Verify Programm Memory --}
{ Dela se jen u algoritmu, ktere nemohou verifikovat }
{ prubezne pri programovani (tedy ty, ktere pregramuji }
{ vice slov najednou }
{ Zatim zadne takove algoritmy kde by to neslo po jednotlivych slovech }
{ nemame. }
case Proc.Alg of
_EE3_ :
begin {-- Dodatecna verifikace --}
{!!!!!!!!!!!! asi bude treba reset citace }
write('... Verify Program Memory ...');
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_wr:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
end;
end; {case}
*)
 
{-- Program Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin
if Data.GetStat(i)
then
begin data_wr:=Data.GetData(i);
case Proc.Alg of
_EPROM1_,
_EPROM2_,
_EPROM3_ :
begin Error('Internal Error: Algorithm EPROMx does not know Data Memory',0);
end;
_EE1_,
_EE2_,
_EE3_,
_EE4_ :
begin OutputDataPIC(Proc.Bits,LoadDataDM_03,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
_EE5_ :
begin OutputDataPIC(Proc.Bits,LoadDataDM_03,data_wr);
OutCommandPIC(BeginProgrammingOnlyCycle_18);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_17);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask;
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end;
OutCommandPIC(IncrementAddress_06);
end;
 
{-- priprav Config Word --}
if (CfgString<>'') and (CfgString<>CfgX)
then begin {-- prepinaci zmeneno Cfg slovo --}
writeln('Required Config Word: ',CfgString);
if Data.GetStat(Proc.Cfg_Base)
then begin {-- Cfg slovo bylo v datovem souboru --}
CfgStringTmp:=Word2Str(Data.GetData(Proc.Cfg_Base));
writeln('Config Word from data file: ',CfgStringTmp);
end
else begin {-- Cfg slovo nebylo v datovem souboru --}
CfgStringTmp:=CfgX; { prazdne slovo ( sama X ) }
end;
{-- sloz slovo ze souboru a z prepinacu --}
CfgString:=CfgOverride(CfgStringTmp,CfgString);
writeln('Result: ',CfgString);
{-- uloz slozene slovo do datoveho pole --}
Data.StoreProc(Proc.Cfg_Base,Str2Word(CfgString));
end;
 
{-- Program Config Memory --}
{--- algoritmus _EPROM1_ prikaz Load Configuration nezna}
if Proc.Alg<>_EPROM1_ then OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin
if Data.GetStat(i)
then
begin data_wr:=Data.GetData(i);
case Proc.Alg of
_EPROM1_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
inc(n);
until (n>8) or (data_wr=data_rd);
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=11*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
end;
_EPROM2_ :
begin
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
inc(n);
until (n>25) or (data_wr=data_rd);
if data_rd <> data_wr
then begin Delta(i,data_wr,data_rd);
inc(err);
end
else for n:=3*n downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
end;
_EPROM3_ :
begin Error('Algorithm EPROM3 not yet supported',0);
end;
_EE1_,
_EE2_,
_EE4_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_wr xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end
else begin if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end;
inc(count);
end;
_EE3_,
_EE5_ :
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
if (Proc.Alg=_EE3_) and (i=Proc.Cfg_Base)
then begin {-- CFG slovo i algoritmu EE3 nejde preogramovat po jednotlivych slovech --}
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
end
else begin OutCommandPIC(BeginProgrammingOnlyCycle_18);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_17);
end;
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_wr xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end
else begin if data_wr <> data_rd
then begin Delta(i,data_wr,data_rd);
inc(err);
end;
end;
inc(count);
end;
else Error('Algorithm not supported',0);
end; {case}
end;
OutCommandPIC(IncrementAddress_06);
end;
 
{--- u algoritmu _EPROM1_ se konfiguracni slovo programuje zvlast}
if Proc.Alg=_EPROM1_ then
if Data.GetStat(Proc.Cfg_Base) then
begin
{--- toto zajisti prechod na konfig. bunku}
EndPIC;
StartPIC(5.0);
data_wr:=Data.GetData(Proc.Cfg_Base);
n:=0;
repeat
OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.Cfg_Mask;
inc(n);
until (n>8) or (data_rd=data_wr);
if data_rd<>data_wr
then begin Delta(Proc.Cfg_Mask,data_wr,data_rd);
inc(err);
end
else for n:=n*11 downto 0 do
begin OutputDataPIC(Proc.Bits,LoadDataPM_02,data_wr);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(Proc.Tprog);
OutCommandPIC(EndProgramming_0E);
end;
inc(count);
end;
end;
EndPIC;
writeln('... Done');
write('Programmed ',count,' Data Words, ');
case err of
0 : writeln('No diferences found');
1 : writeln(err,' diference found');
else writeln(err,' diferences found');
end;{case}
if err<>0 then exitcode:=100; { Jako by bylo halt(100) }
end; {ToDoProgram}
 
procedure ToDoVerify;
{== Porovnani obsahu soucastky se souborem ==}
var i:integer;
data_fi:word; { data z objektu }
data_rd:word; { data prectena ze soucastky }
err,count:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<2 then Help; { chybi jmeno souboru }
Switches(GetParamLine(3),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
InitHW(Port);
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Verify --}
writeln('Verifying ...');
err:=0;
count:=0;
StartPIC(5.0);
case Proc.Alg of { toto je jen test na podporovane algoritmy }
_EPROM1_,
_EPROM2_,
_EE1_,
_EE2_,
_EE3_,
_EE4_,
_EE5_ :
begin {-- Verify Program Memory --}
if Proc.PM_Len>0 then
for i:=Proc.PM_Base to Proc.PM_Base+Proc.PM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.PM_Mask;
if data_fi <> data_rd
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
{-- Verify Data Memory --}
if Proc.DM_Len>0 then
for i:=Proc.DM_Base to Proc.DM_Base+Proc.DM_Len-1 do
begin
if Data.GetStat(i) { platna data }
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataDM_05) and Proc.DM_Mask;
if data_rd <> data_fi
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
{-- Verify Config Memory --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
if Proc.CM_Len>0 then
for i:=Proc.CM_Base to Proc.CM_Base+Proc.CM_Len-1 do
begin
if Data.GetStat(i)
then begin data_fi:=Data.GetData(i);
data_rd:=InputDataPIC(Proc.Bits,ReadDataPM_04) and Proc.CM_Mask;
if i=Proc.Cfg_Base
then begin {-- Cfg bunka - maskuj --}
if ( ( data_fi xor data_rd ) and Proc.Cfg_Mask ) <> 0
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
end
else begin if data_fi <> data_rd
then begin Delta(i,data_fi,data_rd);
inc(err);
end;
end;
inc(count);
end;
OutCommandPIC(IncrementAddress_06);
end;
end;
_EPROM3_:
begin Error('Algorithm EPROM3 not yet supported',0);
end;
else Error('Algorithm not supported',0);
end; {case}
EndPIC;
writeln('... Done');
write('Compared ',count,' Data Words, ');
case err of
0 : writeln('No diferences found');
1 : writeln(err,' diference found');
else writeln(err,' diferences found');
end;{case}
if err<>0 then exitcode:=100; { Jako by bylo halt(100) }
end; {ToDoVerify}
 
procedure ToDoErase;
{== Bude se pouze mazat ==}
var i:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
Switches(GetParamLine(2),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Erase --}
case Proc.Alg of
_EPROM1_,
_EPROM2_,
_EPROM3_ :
begin Error('Use UV light to erase EPROM processor!',0)
end;
_EE1_,
_EE2_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- postup pro odblokovani CP soucastky --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF);
for i:=1 to Proc.CM_Len-1 do OutCommandPIC(IncrementAddress_06);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(12000);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
{-- Mazani datove pameti --}
{ Funguje na C84/F84/F877 ale postup je uveden jen }
{ u obvodu F84. Obvod C84 potrebuje stejny postup. }
OutputDataPIC(Proc.Bits,LoadDataDM_03,$FFFF);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
OutCommandPIC(BeginProgramming_08);
xDelayMicro(10000);
OutCommandPIC(Dis1_01);
OutCommandPIC(Dis2_07);
EndPIC;
end;
_EE3_,
_EE5_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- mazani cele soucastky jednim povelem --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF); {oblast konfig bitu aby se smazala i tato oblast }
OutCommandPIC(ChipErase_1F);
xDelayMicro(8000);
EndPIC;
end;
_EE4_ :
begin InitHW(Port);
writeln('Erasing PIC');
StartPIC(5.0);
{-- mazani pameti programu a konfig oblasti --}
OutputDataPIC(Proc.Bits,LoadConfiguration_00,$FFFF); {oblast konfig bitu aby se smazala i tato oblast }
OutputDataPIC(Proc.Bits,LoadDataPM_02,$FFFF);
OutCommandPIC(BulkErasePM_09);
xDelayMicro(5000);
OutputDataPIC(Proc.Bits,LoadDataDM_03,$FFFF);
OutCommandPIC(BulkEraseDM_0B);
xDelayMicro(5000);
EndPIC;
end
else Error('Algorithm not supported',0);
end; {case}
end; {ToDoErase}
 
procedure ToDoRun;
{== Zapne napajeni a spusti program ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero); { aktivuj reset }
P^.SetVcc(5.0); { zapni napajeni }
xDelay(50); { pockej na ustaleni }
P^.SetReset(one); { skonci reset }
writeln('Running ...');
end; {ToDoRun}
 
procedure ToDoStop;
{== Vypne napajeni ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero);
P^.SetVcc(0);
writeln('... Stoped');
end; {ToDoStop}
 
procedure ToDoReset;
{== Provede Reset bez vypnuti napajeni ==}
begin Switches(GetParamLine(2),Data); { typ procesoru, init Data }
InitHW(Port);
P^.SetReset(zero);
P^.SetVcc(5.0);
xDelay(50);
P^.SetReset(one);
writeln('... Reset ...');
end; {ToDoReset}
 
procedure ToDoConvert;
{== Procedura pro konverzi formatu souboru ==}
var s:string;
i:integer;
Proc:ProcInfo_t;
begin {-- Zpracovani parametru --}
if paramcount<3 then Help; { chybi jmeno souboru }
Switches(GetParamLine(4),Data); { typ procesoru, init Data }
Data.GetProcInfo(Proc); { vytahni info o procesoru }
if Proc.Name='' then Error('Processor type missing',0);
ProcDisplayInfo(Proc); { zobraz }
{-- Vstup dat --}
Data.Import(paramstr(2),FileFormat);
{-- Vystup dat --}
case FileFormat of
_HEX_ : FileFormat:=_TXT_;
_TXT_ : FileFormat:=_HEX_;
end; {case}
Data.Export(paramstr(3),FileFormat,';Converted from file '+paramstr(2));
writeln('Done');
end; {ToDoConvert}
 
{====== Hlavni program, Entry a Exit programy ======}
 
const OldExitProc:pointer=NIL; { Pro proceduru MyExitProc }
 
procedure MyExitProc;
{== Ukoncujici procedura pro pripad predcasneho ukonceni programu ==}
{ Tato procedura normalni nic ndela ale pokud je pri ukonceni }
{ programu nastaven priznak aktivity programovani zavola }
{ proceduru StopPIC. }
{ Promenne: StartPICStat .. true znamena aktivitu pri programovani }
{ P .. pointer na objekt zastupujici hardware }
far;
begin ExitProc:=OldExitProc;
if StartPICStat and (P<>nil) then EndPIC;
end; {MyExitProc}
 
begin assign(output,''); { aby slo vystup presmerovat do souboru }
rewrite(output);
writeln;
writeln('PIC Development Programmer');
writeln('==========================');
writeln('(c) miho ',date,' v ',ver);
writeln;
 
{-- test - zadny parametr --}
if paramcount=0 then Help;
{-- zaregistruj ukonceni pro pripad predcasneho skonceni programu --}
OldExitProc:=ExitProc;
ExitProc:=@MyExitProc;
{-- rozhodni cinnost --}
if UpStr(paramstr(1))='READ' then ToDoRead
else if UpStr(paramstr(1))='PROGRAM' then ToDoProgram
else if UpStr(paramstr(1))='VERIFY' then ToDoVerify
else if UpStr(paramstr(1))='ERASE' then ToDoErase
else if UpStr(paramstr(1))='RUN' then ToDoRun
else if UpStr(paramstr(1))='STOP' then ToDoStop
else if UpStr(paramstr(1))='RESET' then ToDoReset
else if UpStr(paramstr(1))='CONVERT' then ToDoConvert
else if UpStr(paramstr(1))='HELP' then Help
else Help;
Halt(exitcode); { Exitcode si nastavuji pri chybe pri programovani }
end. { nebo pri verifikaci. Je to treba uvest takto }
{ explicitne jinak se provede Halt(0). }
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_ALL03.PAS
0,0 → 1,532
unit PP_ALL03;
 
{$I-,S-}
 
{=========================================================}
{ }
{ Unita pro ovladani programatoru HI-LO model ALL-03 }
{ (c) DECROS pefi }
{---------------------------------------------------------}
{ Verze : 1.0.0 uvodni verze }
{ 1.0.1 preformatovani zdrojaku miho }
{ 1.0.2 prejmenovani na PP_ALL03.PAS }
{=========================================================}
 
interface
 
procedure ErrorProc;
{== vypise slovne obsah chyby ==}
 
procedure PowerOff;
{== vypne programator ==}
 
procedure Initialize(Baze :word);
{== ziniciuje programator a nastavi bazovou adresu programatoru ==}
 
procedure SetVoltageV1(Napeti : real);
{== nastavi napeti na prevodniku s vahou 0.4, napeti je zadavano ==}
{== ve voltech, max. napeti 9.6V. Zapina se jim programator, ==}
{== musi byt pouzit vzdy ==}
 
procedure SetVoltageV2(Napeti : real);
{== nastavi napeti na prevodniku s vahou 0.6, napeti je zadavano ==}
{== ve voltech, max. napeti 14.4V. ==}
 
procedure SetVoltageV3(Napeti : real);
{== nastavi napeti na prevodniku s vahou 1, napeti je zadavano ==}
{== ve voltech, max. napeti je 25V ==}
 
procedure SetBit(Pin,Stav:byte);
{== nastavi pin podle parametru Stav. Piny jsou v rozsahu 1-40, ==}
{== stav je 0 nebo 1. ==}
 
procedure GetBitProc (Pin:byte;var Stav:byte);
{== cte stav pinu,pin v rozsahu 1-40,Stav nabyva hodnot 0 nebo 1 ==}
 
function GetBit(Pin:byte):byte;
{== cte stav pinu, pin v rozsahu 1-40,vraci 0 nebo 1 ==}
 
procedure ConnectV1(Pin:byte;On:boolean);
{== pripojuje prevodnik V1 s vahou 0.4 k pinum, ==}
{== piny v rozsahu 24-32,34,36,40 ==}
 
procedure ConnectV2(Pin:byte;On:boolean);
{== pripojuje prevodnik V2 s vahou 0.6 k pinum. ==}
{== piny v rozsahu 9-32 ==}
 
procedure ConnectV3(Pin:byte;On:boolean);
{== pripojuje prevodnik V3 s vahou 1 k pinum. ==}
{== piny v rozsahu 1,5-7,9-32,36 ==}
 
procedure Gnd11(On:boolean);
{== prepina zem mezi piny 20 a 11, true=pin 11, false= pin20 ==}
 
procedure Led(On:boolean);
{== ovlada led s napisem 'GOOD', true= sviti, false= nesviti ==}
 
function ReadButton:boolean;
{== vypne programator a cte tlacitko s napisem 'YES' , ==}
{== true=stiknuto, false=uvolneno ==}
 
 
{=========================================================}
 
implementation
 
 
uses DELAY;
 
 
{== Definice konstant ==}
 
const InitNum = 22; { pocet registru }
 
const InitArray : array[1..InitNum,1..2] of byte =
{== zakladni inicializace tj. vsechny piny jako vstupni,prevodniky ==}
{== odpojeny od vsech pinu a vymulovany ==}
(
(231,0),(230,0),(229,0),
(238,0),(237,0),(241,0),
(242,0),(242,0),(243,0),
(232,0),(233,0),(234,0),
(235,0),(236,0),(224,255),
(225,255),(226,255),(227,255),
(228,255),(247,0),(239,0),
(245,0)
);
 
const PinSet : array[1..40,1..2] of byte =
{== tabulka pro ovladani jednotlivych pinu, na prvni pozici ==}
{== prislusny I/O registr na druhe pozici maska pinu v registru ==}
(
($E0,$01),($E0,$02),($E0,$04),($E0,$08),
($E0,$10),($E0,$20),($E0,$40),($E0,$80),
($E1,$01),($E1,$02),($E1,$04),($E1,$08),
($E1,$10),($E1,$20),($E1,$40),($E1,$80),
($E2,$01),($E2,$02),($E2,$04),($E2,$08),
($E2,$10),($E2,$20),($E2,$40),($E2,$80),
($E3,$01),($E3,$02),($E3,$04),($E3,$08),
($E3,$10),($E3,$20),($E3,$40),($E3,$80),
($E4,$01),($E4,$02),($E4,$04),($E4,$08),
($E4,$10),($E4,$20),($E4,$40),($E4,$80)
);
 
const PinConnectV1: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 0.4 k pinum, na prvni ==}
{== pozici registr pro pripojeni, na druhe pozici maska ==}
{== pinu v registru ==}
(
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($EE,$80),
($EE,$04),($EE,$02),($EE,$01),($ED,$80),
($ED,$40),($ED,$20),($ED,$10),($ED,$08),
($00,$00),($ED,$04),($00,$00),($ED,$02),
($00,$00),($00,$00),($00,$00),($ED,$01)
);
 
const PinConnectV2: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 0.6 k pinum, na prvni ==}
{== pozici registr pro pripojeni, na druhe pozici maska ==}
{== pinu v registru ==}
(
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00),
($F1,$01),($F1,$02),($F1,$04),($F1,$08),
($F1,$10),($F1,$20),($F1,$40),($F1,$80),
($F2,$01),($F2,$02),($F2,$04),($F2,$08),
($F2,$10),($F2,$20),($F2,$40),($F2,$80),
($F3,$01),($F3,$02),($F3,$04),($F3,$08),
($F3,$10),($F3,$20),($F3,$40),($F3,$80),
($00,$00),($00,$00),($00,$00),($00,$00),
($00,$00),($00,$00),($00,$00),($00,$00)
);
 
const PinConnectV3: array[1..40,1..2] of byte =
{== tabulka pro pripojeni prevodniku s vahou 1 k pinum, na prvni ==}
{== registr pro pripojeni, na druhe pozici maska pinu v registru ==}
(
($E8,$01),($00,$00),($00,$00),($00,$00),
($E8,$10),($E8,$20),($E8,$40),($00,$00),
($E9,$01),($E9,$02),($E9,$04),($E9,$08),
($E9,$10),($E9,$20),($E9,$40),($E9,$80),
($EA,$01),($EA,$02),($EA,$04),($EA,$08),
($EA,$10),($EA,$20),($EA,$40),($EA,$80),
($EB,$01),($EB,$02),($EB,$04),($EB,$08),
($EB,$10),($EB,$20),($EB,$40),($EB,$80),
($00,$00),($00,$00),($00,$00),($EC,$08),
($00,$00),($00,$00),($00,$00),($00,$00)
);
 
{== definice globalnich promennych ==}
 
var BazovaAdresa : word;
Error : integer; { cislo chyby }
PortStat : array[1..5] of byte; { aktualni stavy pinu }
ConnectV1Stat: array[1..2] of byte; { aktualni pripojeni prevodniku V1 }
ConnectV2Stat: array[1..3] of byte; { aktualni pripojeni prevodniku V2 }
ConnectV3Stat: array[1..5] of byte; { aktualni pripojeni prevodniku V3 }
GndStat : boolean; { =1 GND na 11, =0 GND na 20 }
 
 
{== vykonne procedury TPU ==}
 
 
{== Vytiskne hlaseni o chybe a ukonci program ==}
procedure ErrorProc;
begin
writeln;
write('Error: ');
case Error of
0:writeln('Zadna Chyba');
1:writeln('Napeti pro prevodnik mimo rozsah');
2:Writeln('Spatny stav pinu, mozne pouze 0 nebo 1');
3:Writeln('Pin mimo rozsah, mozne 1-40, u pripojeni prevodniku jen nektere');
end; {case}
writeln;
halt(1);
end; {End Error}
 
 
{== Zapise bajt do prislusneho registru programatoru ==}
procedure OutPort(Adr, Data : byte);
begin
asm
mov dx,BazovaAdresa
mov al,Adr
out dx,al
add dx,2
mov al,Data
out dx,al
end; {asm}
end; {OutPort}
 
 
{== Precte bajt a prislusneho registru programatoru ==}
function InPort(Adr : byte) : byte;
begin
asm
mov dx,BazovaAdresa
mov al,Adr
out dx,al
add dx,2
in al,dx
mov Adr,al
end; {asm}
InPort := Adr;
end;
 
 
{== Zinicializuje programator ==}
procedure PowerOff;
var n,i :byte;
begin
for i:= 1 to InitNum do
OutPort(InitArray[i,1],InitArray[i,2]);
 
{--- nastav otisk pinu}
for i:= 1 to 5 do
PortStat[i]:=255;
 
{--- nastav otisk pripojeni prevodniku V1}
for i:=1 to 2 do
ConnectV1Stat[i]:=0;
 
{--- nastav otisk pripojeni prevodniku V2}
for i:=1 to 3 do
ConnectV2Stat[i]:=0;
 
{--- nastav otisk pripojeni prevodniku V3}
for i:=1 to 5 do
ConnectV3Stat[i]:=0;
 
end; {PowerOff}
 
 
{== Inicializace programatoru se zadanim Bazove adresy ==}
procedure Initialize(Baze :word);
begin
BazovaAdresa:=Baze;
Error:=0;
GndStat:=false;
PowerOff;
end; {Initialize}
 
 
{== Zadani napeti pro prevodnik s vahou 0.4 ==}
procedure SetVoltageV1(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=9.6 then begin Voltage:=Round(((255/9.5)*Napeti));
OutPort(231,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV1}
 
 
{== Zadani napeti pro prevodnik s vahou 0.6 ==}
procedure SetVoltageV2(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=14.4 then begin Voltage:=Round(((255/14.4)*Napeti));
OutPort(230,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV2}
 
 
{== Zadani napeti pro prevodnik s vahou 1 ==}
procedure SetVoltageV3(Napeti : real);
var Voltage:Integer;
begin
if Napeti<=25 then begin Voltage:=Round(((255/24)*Napeti));
OutPort(229,Voltage);
end
else begin Error:=1;
end;
end; {SetVoltageV1}
 
 
{== Nastaveni pinu ==}
procedure SetBit(Pin,Stav:byte);
var PozReg:byte;
begin
if (Pin>=1) and (Pin<=40)
then begin
{--- urceni indexu I/O registru pro pole otisku}
if (Pin>=1) and (Pin<=8) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
 
if Stav=1
then begin
{--- pin do Log.1, zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PortStat[PozReg]); }
end
else Error:=2;
 
if Stav=0
then begin
{--- pin do log.0, zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] and not(PinSet[Pin,2]);
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PortStat[PozReg]); }
end
else Error:=2;
 
end
else Error:=3;
end; {SetBit}
 
 
{== Cteni bitu jako procedura ==}
procedure GetBitProc (Pin:byte;var Stav:byte);
var ReadBit:byte;
begin
if (Pin>=1) and (Pin<=40)
then begin
Readbit:=InPort(PinSet[Pin,1]) and PinSet[Pin,2];
if ReadBit=0 then Stav:=0
else Stav:=1;
end
else Error:=3;
end; {GetbitProc}
 
 
{== Cteni bitu jako funkce ==}
function GetBit(Pin:byte):byte;
var ReadBit:byte;
begin
Readbit:=InPort(PinSet[Pin,1]) and PinSet[Pin,2];
if ReadBit=0 then GetBit:=0
else GetBit:=1;
end; {Getbit}
 
 
{== Pripojeni prevodniku V1 s vahou 0.4 ==}
procedure ConnectV1(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit k pinum 24,26-32,34,36 a 40}
TestPin:=(Pin>=26) and (Pin<=32)or (Pin=24) or (Pin=34) or (Pin=36) or (Pin=40);
if TestPin
then begin
{ writeln('V1 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku}
if Pin=24 then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
 
{--- na pin se musi zapsat log.1, udelej zaznam do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr v poli otisku pripojeni}
if (Pin>=24) and (Pin<=27) then PozReg:=1
else PozReg:=2;
if On
then {--- udelej zaznam o pripojeni do otisku}
ConnectV1Stat[PozReg] := ConnectV1Stat[PozReg]
or PinConnectV1[Pin,2]
else {--- udelej zaznam o odpojeni do otisku}
ConnectV1Stat[PozReg] := ConnectV1Stat[PozReg]
and not( PinConnectV1[Pin,2]);
 
OutPort(PinConnectV1[Pin,1],ConnectV1Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV1}
 
 
{== Pripojeni prevodniku V2 s vahou 0.6 ==}
procedure ConnectV2(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit piny 9-32}
TestPin:=(Pin>=9) and (Pin<=32);
 
{--- pokud je pouzit pin 11 nebo 20 jako zem, nejze na nej ---}
{--- pripojit prevodnik ---}
if (Pin=11) and GndStat then TestPin:=false; { pin 11 je uzemen }
if (Pin=20) and Not(GndStat) then TestPin:=false; { pin20 je uzemen }
 
if TestPin
then begin
{ writeln('V2 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku}
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
 
{--- na pin je nutne zapsat log.1, udelej zapis do otisku}
PortStat[PozReg]:=PortStat[PozReg] or PinSet[Pin,2];{nastav na pin log.1}
OutPort(PinSet[Pin,1],PortStat[PozReg]);
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr otisku pripojeni}
if (Pin>=9) and (Pin<=16) then PozReg:=1;
if (Pin>=17) and (Pin<=24) then PozReg:=2;
if (Pin>=25) and (Pin<=32) then PozReg:=3;
 
if On
then {--- udelej zaznam o pripojeni do otisku}
ConnectV2Stat[PozReg] := ConnectV2Stat[PozReg]
or PinConnectV2[Pin,2]
else ConnectV2Stat[PozReg] := ConnectV2Stat[PozReg]
and not(PinConnectV2[Pin,2]);
 
OutPort(PinConnectV2[Pin,1],ConnectV2Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV2}
 
 
{== Pripojeni prevodniku V3 s vahou 1 ==}
procedure ConnectV3(Pin:byte;On:boolean);
var PozReg:byte;
TestPin:boolean;
begin
{--- lze pripojit k pinum 1,5-7,9-32,a36}
TestPin:=(Pin>=9)and(Pin<=32)or(Pin=1)or((Pin>=5)and(Pin<=7))or(Pin=36);
 
{--- pokud je pouzit pin 11 nebo 20 pro zem, nelze na nej ---}
{--- pripojit prevodnik ---}
if (Pin=11) and GndStat then TestPin:=false; { pin 11 je uzemen }
if (Pin=20) and Not(GndStat) then TestPin:=false; { pin20 je uzemen }
 
if TestPin
then begin
{ writeln('V3 ',Pin); }
 
{--- urceni indexu I/O registru pro pole otisku }
if (Pin>=1) and (Pin<=8) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin>=33) and (Pin<=40) then PozReg:=5;
{ writeln(PozReg); }
 
{--- na pin nutno zapsat log.1 , udelej zapis do otisku }
PortStat[PozReg] := PortStat[PozReg]
or PinSet[Pin,2]; { nastav na pin log.1 }
 
OutPort(PinSet[Pin,1],PortStat[PozReg]);
 
{ writeln(PinSet[Pin,1],' ',PortStat[PozReg]); }
 
{--- urci registr otisku pripojeni}
if (Pin>=1) and (Pin<=7) then PozReg:=1;
if (Pin>=9) and (Pin<=16) then PozReg:=2;
if (Pin>=17) and (Pin<=24) then PozReg:=3;
if (Pin>=25) and (Pin<=32) then PozReg:=4;
if (Pin=36) then PozReg:=5;
 
if On
then ConnectV3Stat[PozReg] := ConnectV3Stat[PozReg]
or PinConnectV3[Pin,2]
else ConnectV3Stat[PozReg] := ConnectV3Stat[PozReg]
and not(PinConnectV3[Pin,2]);
 
OutPort(PinConnectV3[Pin,1],ConnectV3Stat[PozReg]);
 
end
else Error:=3;
end; {ConnectV3}
 
 
{== Prepinani zeme mezi vyvody 11 nebo 20 ==}
{ True = pripojen Pin11 }
{ False = pripojen pin20 }
procedure Gnd11(On:boolean);
begin
if On then begin
OutPort($EF,1);
GndStat:=true;
end
else
begin
OutPort($EF,0);
GndStat:=false;
end;
end; {Gnd11}
 
 
{== Ovladani LED 'GOOD' ==}
{ True = sviti }
procedure Led(On:boolean);
begin
if On then OutPort($F7,$8)
else OutPort($F7,$0);
end; {Led}
 
 
{== Cteni tlacitka 'YES' ==}
{ True = stisknut }
function ReadButton:boolean;
begin
PowerOff;
xDelay(50);
writeln(InPort($E4));
if (InPort($E4)and $80)<>0 then ReadButton:=true
else ReadButton:=false;
end; {ReadButton}
 
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_CFG.PAS
0,0 → 1,523
 
{Toto je include soubor}
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice prepinacu pro skupiny procesoru pro definovani }
{ ( modifikaci ) konfiguracniho slova procesoru. }
{===========================================================================}
 
{---> PP_DEFS - konstanta CfgDefProcCount definuje pocet polozek --}
const CfgDefAll:CfgDef_t=
( {-- definice Cfg dat --}
( {-- Skupina procesoru C84 --}
ProcId : 'C84';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX1XXX';
Off : 'XXXXXXXXXX0XXX';
Bits : ''
),
( Key : 'CP';
On : 'XXXXXXXXX0XXXX';
Off : 'XXXXXXXXX1XXXX';
Bits : ''
),
(),(),(),(),(),(),()
)
),
( {-- Skupina procesoru F83, F84, .. --}
ProcId : 'F83';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '0000000000XXXX';
Off : '1111111111XXXX';
Bits : ''
),
(),(),(),(),(),(),()
)
),
( {-- Skupina procesoru F627, F628 --}
ProcId : 'F627';
Info : ( ( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXX2XX10'
),
( Key : 'LP';
On : 'XXXXXXXXX0XX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXX0XX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXX0XX10';
Off : '';
Bits : ''
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'MCLRE';
On : 'XXXXXXXX1XXXXX';
Off : 'XXXXXXXX0XXXXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0000XXXXXXXXXX';
Off : '1111XXXXXXXXXX';
Bits : '1010XXXXXXXXXX'
),
(),(),(),()
)
),
( {-- Skupina procesoru F818/819 --}
ProcId : 'F818';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXX0XX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXX0XX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXX0XX10';
Off : '';
Bits : ''
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'MCLRE';
On : 'XXXXXXXX1XXXXX';
Off : 'XXXXXXXX0XXXXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXX11XXXXXXXXX';
Off : 'XXX00XXXXXXXXX';
Bits : 'XXX10XXXXXXXXX'
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
( Key : 'CCPMX_RB2';
On : 'X1XXXXXXXXXXXX';
Off : 'X0XXXXXXXXXXXX';
Bits : ''
),
( Key : 'CCPMX_RB3';
On : 'X0XXXXXXXXXXXX';
Off : 'X1XXXXXXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0XXXXXXXXXXXXX';
Off : '1XXXXXXXXXXXXX';
Bits : ''
),
()
)
),
( {-- Skupina procesoru F87/88, ... --}
ProcId : 'F87';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXX0XX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXX0XX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXX0XX10';
Off : '';
Bits : ''
),
( Key : 'EXTCLK';
On : 'XXXXXXXXX0XX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXX2XX10'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'MCLRE';
On : 'XXXXXXXXXX1XXX';
Off : 'XXXXXXXXXX0XXX';
Bits : ''
),
( Key : 'BOREN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXX11XXXXXXXXX';
Off : 'XXX00XXXXXXXXX';
Bits : 'XXX10XXXXXXXXX'
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
( Key : 'CCPMX';
On : '';
Off : '';
Bits : 'X0XXXXXXXXXXXX'
),
( Key : 'CP';
On : '0XXXXXXXXXXXXX';
Off : '1XXXXXXXXXXXXX';
Bits : ''
)
)
),
( {-- Skupina procesoru F870, ... --}
ProcId : 'F870';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX10'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '00XXXXXX00XXXX';
Off : '11XXXXXX11XXXX';
Bits : '10XXXXXX10XXXX'
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXXX1XXXXXXXXX';
Off : 'XXXX0XXXXXXXXX';
Bits : ''
),
(),(),()
)
),
( {-- Skupina procesoru F873, ... --}
ProcId : 'F873';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'CP';
On : '00XXXXXX00XXXX';
Off : '11XXXXXX11XXXX';
Bits : '10XXXXXX10XXXX'
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXXX1XXXXXXXXX';
Off : 'XXXX0XXXXXXXXX';
Bits : ''
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
(),()
)
),
( {-- Skupina procesoru F873A, ... --}
ProcId : 'F873A';
Info : ( ( Key : 'LP';
On : 'XXXXXXXXXXXX00';
Off : '';
Bits : ''
),
( Key : 'XT';
On : 'XXXXXXXXXXXX01';
Off : '';
Bits : ''
),
( Key : 'HS';
On : 'XXXXXXXXXXXX10';
Off : '';
Bits : ''
),
( Key : 'RC';
On : 'XXXXXXXXXXXX11';
Off : '';
Bits : ''
),
( Key : 'FOSC';
On : '';
Off : '';
Bits : 'XXXXXXXXXXXX01'
),
( Key : 'WDTE';
On : 'XXXXXXXXXXX1XX';
Off : 'XXXXXXXXXXX0XX';
Bits : ''
),
( Key : 'PWRTE';
On : 'XXXXXXXXXX0XXX';
Off : 'XXXXXXXXXX1XXX';
Bits : ''
),
( Key : 'BODEN';
On : 'XXXXXXX1XXXXXX';
Off : 'XXXXXXX0XXXXXX';
Bits : ''
),
( Key : 'LVP';
On : 'XXXXXX1XXXXXXX';
Off : 'XXXXXX0XXXXXXX';
Bits : ''
),
( Key : 'CPD';
On : 'XXXXX0XXXXXXXX';
Off : 'XXXXX1XXXXXXXX';
Bits : ''
),
( Key : 'WRT';
On : 'XXX00XXXXXXXXX';
Off : 'XXX11XXXXXXXXX';
Bits : 'XXX10XXXXXXXXX'
),
( Key : 'DEBUG';
On : 'XX0XXXXXXXXXXX';
Off : 'XX1XXXXXXXXXXX';
Bits : ''
),
( Key : 'CP';
On : '0XXXXXXXXXXXXX';
Off : '1XXXXXXXXXXXXX';
Bits : ''
),
(),()
)
)
);
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_COMON.PAS
0,0 → 1,156
unit PP_COMON;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde jsou obecne uzivane pomocne procedury a funkce . }
{===========================================================================}
 
interface
 
function UpStr(str:string):string;
{== Prevede retezec na velka pismena ==}
 
procedure PressEnter;
{== Zobrazi hlasku a ceka na stisk klavesy ==}
 
procedure HexByte(var f:text;data:word);
{== Vytiskni byte jako 2 znaky ==}
 
procedure HexWord(var f:text;data:word);
{== Vytiskni word jako 4 znaky ==}
 
procedure HexWordSp(var f:text;data:word);
{== Vytiskni word jako 4 znaky a mezeru ==}
 
procedure HexAdr(var f:text;data:word);
{== Vytiskni adresu s dvojteckou ==}
 
procedure Error(ErrorStr:string; LineNumber:integer); (* !! *)
{== Vytiskne hlaseni o chybe a ukonci program ==}
{ Pokud je LinNumber<=0 pak se netiskne }
 
function DelSpace(s:string):string;
{== Vyhodi vsechny mezery ze zacatku retezce s ==}
 
function GetWord(s:string):string;
{== Vrati prvni slovo ze zadaneho retezce ==}
 
function DelWord(s:string):string;
{== Odstrihne prvni slovo z retezce ==}
 
procedure DisplayRange(Base, Len:word);
{== obrazi rozsah jako dvojici hex cisel ==}
 
function GetParamLine(First:integer):string;
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==}
 
implementation
 
function UpStr(str:string):string;
{== Prevede retezec na velka pismena ==}
var i:integer;
begin for i:=1 to length(str) do str[i]:=upcase(str[i]);
UpStr:=str;
end; {UpStr}
 
procedure PressEnter;
{== Zobrazi hlasku a ceka na stisk klavesy ==}
begin write('Press ENTER to continue ...');
readln;
writeln;
end; {PressEnter}
 
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
 
procedure HexByte(var f:text;data:word);
{== Vytiskni byte jako 2 znaky ==}
begin write(f, prevod[(data shr 4) and $F],
prevod[data and $F]);
end; {HexByte}
 
procedure HexWord(var f:text;data:word);
{== Vytiskni word jako 4 znaky ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F]);
end; {HexWord}
 
procedure HexWordSp(var f:text;data:word);
{== Vytiskni word jako 4 znaky a mezeru ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F],
' ');
end; {HexWordSp}
 
procedure HexAdr(var f:text;data:word);
{== Vytiskni adresu s dvojteckou ==}
begin write(f, prevod[(data shr 12) and $F],
prevod[(data shr 8) and $F],
prevod[(data shr 4) and $F],
prevod[data and $F],
': ');
end; {HexAdr}
 
procedure Error(ErrorStr:string; LineNumber:integer);
{== Vytiskne hlaseni o chybe a ukonci program ==}
{ Pokud je LinNumber<=0 pak se netiskne }
begin writeln;
if LineNumber<=0 then writeln('FATAL: ',ErrorStr)
else writeln('FATAL @ Line ',LineNumber,': ',ErrorStr);
writeln;
halt(1);
end; {Error}
 
function DelSpace(s:string):string;
{== Vyhodi vsechny mezery ze zacatku retezce s ==}
var i:integer;
begin i:=1;
while (i<=length(s)) and (s[i]=' ')
do inc(i);
DelSpace:=copy(s,i,255);
end; {DelSpace}
 
function GetWord(s:string):string;
{== Vrati prvni slovo ze zadaneho retezce ==}
var t:string;
begin t:=DelSpace(s);
GetWord:=copy(t,1,pos(' ',t+' ')-1);
end; {GetWord}
 
function DelWord(s:string):string;
{== Odstrihne prvni slovo z retezce ==}
var t:string;
begin t:=DelSpace(s);
t:=copy(t,pos(' ',t+' ')+1,255);
DelWord:=DelSpace(t);
end; {DelWord}
 
procedure DisplayRange(Base, Len:word);
{== obrazi rozsah jako dvojici hex cisel ==}
begin if Len<>0
then begin hexword(Output,Base);
write('..');
hexword(Output,Base+Len-1);
write(' ');
end
else begin write('none ');
end;
end; {DisplayRange}
 
function GetParamLine(First:integer):string;
{== slozi vsechny parametry od First a vrati UpCase tohoto slozeni ==}
var i:integer;
s:string;
begin s:='';
if First<1 then exit;
for i:=First to paramcount do s:=s+paramstr(i)+' ';
GetParamLine:=UpStr(s);
end; {GetParamLine}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_DATA.PAS
0,0 → 1,158
unit PP_DATA;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice objektu pro ulozeni dat v pameti. }
{===========================================================================}
 
interface
 
uses PP_DEFS;
 
{===========================================================================}
{ Definice typu a konstant pro ulozeni dat ( delka buferu, typ ulozenych }
{ dat. }
{===========================================================================}
 
type DataItem_t=record { typ pro ulozeni jednoho datoveho slova }
W : word; { vlastni data }
S : boolean; { true znamena platna data }
end; {record}
 
type RangeType_t=
( _INVALID_, { adresa neprislusi zadne oblasti }
_PM_, { adresa spada do pameti programu }
_DM_, { adresa spada do pameti dat }
_CM_, { adresa spada do konfiguracni pameti }
_CFG_ { adresa je adresou zvlastniho konfig slova }
);
 
type PicData_t=object
{-- vlastni datove pole --}
_Buf : array[0..DataBufLen-1] of DataItem_t; { zde jsou data }
{-- informace o vybranem procesoru --}
_Proc:ProcInfo_t;
{-- metody --}
 
procedure Init(ProcInfo:ProcInfo_t);
{== Zapamatuje si typ procesoru ( jeho prametry ) a smaze datovou oblast ==}
 
procedure GetProcInfo(var ProcInfo:ProcInfo_t);
{== Vrati aktualni parametry procesoru ==}
 
function TestAdr(Adr:word):RangeType_t;
{== Vrati typ pametoveho prostoru pro zadanou adresu ==}
 
function Store(Adr:word;Data:word):boolean;
{== Ulozi data na zadanou adresu. Pri chybne adrese vraci true ==}
 
procedure StoreProc(Adr:word;Data:word);
{== Ulozi data na zadanou adresu. ==}
 
function GetStat(Adr:word):boolean;
{== Vrati priznak platnosti dat na zadane adrese, true znamena data platna ==}
 
function GetData(Adr:word):word;
{== Vrati data ze zadane adresy. Pri chybne adrese vraci same jednotky ==}
 
end; {object}
 
implementation
 
function InRange(What,Start,Finish:word):boolean;
{== Vraci true pokud What spada do rozsahu [Start..Finish] ==}
{ Pomocna funkce }
begin InRange:=(What>=Start) and (What<=Finish)
end; {InRange}
 
procedure PicData_t.Init(ProcInfo:ProcInfo_t);
{== Zapamatuje si typ procesoru ( jeho prametry ) a smaze datovou oblast ==}
var i:integer;
begin _Proc:=ProcInfo;
{-- inicializace bufferu --}
for i:=0 to DataBufLen-1 do begin _Buf[i].W:=0;
_Buf[i].S:=false;
end;
{-- inicializace jednotlivych oblasti--}
for i:=_Proc.PM_Base to _Proc.PM_Base+_Proc.PM_Len-1 do
_Buf[i].W:=_Proc.PM_Mask;
for i:=_Proc.DM_Base to _Proc.DM_Base+_Proc.DM_Len-1 do
_Buf[i].W:=_Proc.DM_Mask;
for i:=_Proc.CM_Base to _Proc.CM_Base+_Proc.CM_Len-1 do
_Buf[i].W:=_Proc.CM_Mask;
end; {Init}
 
procedure PicData_t.GetProcInfo(var ProcInfo:ProcInfo_t);
{== Vrati aktualni parametry procesoru ==}
begin ProcInfo:=_Proc;
end; {GetProcInfo}
 
function PicData_t.TestAdr(Adr:word):RangeType_t;
{== Vrati typ pametoveho prostoru pro zadanou adresu ==}
begin TestAdr:=_INVALID_; { nepasuje do zadneho rozsahu }
with _Proc do
begin if Name=''
then begin exit; { neni dany typ procesoru }
end;
if Adr>DataBufLen
then begin exit; { adresa mimo rozsah bufferu }
end;
if (PM_Len>0) and (Adr>=PM_Base) and (Adr<=PM_Base+PM_Len)
then begin TestAdr:=_PM_;
exit;
end;
if (CM_Len>0) and (Adr>=CM_Base) and (Adr<=CM_Base+CM_Len)
then begin TestAdr:=_CM_;
exit;
end;
if (DM_Len>0) and (Adr>=DM_Base) and (Adr<=DM_Base+DM_Len)
then begin TestAdr:=_DM_;
exit;
end;
if Adr=Cfg_Base
then begin TestAdr:=_CFG_;
exit;
end;
end;
end; {TestAdr}
 
function PicData_t.Store(Adr:word;Data:word):boolean;
{== Ulozi data na zadanou adresu. Pri chybne adrese vraci true ==}
begin case TestAdr(Adr) of
_INVALID_ : begin {-- chybna adresa - nic nedelej --}
Store:=true;
exit;
end;
_PM_ : data:=data and _Proc.PM_Mask; { maskuj data }
_DM_ : data:=data and _Proc.DM_Mask;
_CM_ : data:=data and _Proc.CM_Mask;
_CFG_ : data:=data and _Proc.Cfg_Mask;
end; {case}
{-- platna adresa - uloz data --}
Store:=false;
_Buf[Adr].S:=true; { datova polozka platna }
_Buf[Adr].W:=data; { vlastni data }
end; {Store}
 
procedure PicData_t.StoreProc(Adr:word;Data:word);
{== Ulozi data na zadanou adresu ==}
begin if Store(Adr, Data) then;
end; {StoreProc}
 
function PicData_t.GetStat(Adr:word):boolean;
{== Vrati priznak platnosti dat na zadane adrese, true znamena data platna ==}
begin GetStat:=false;
if TestAdr(Adr)=_INVALID_ then exit;
GetStat:=_Buf[Adr].S;
end; {GetStat}
 
function PicData_t.GetData(Adr:word):word;
{== Vrati data ze zadane adresy. Pri chybne adrese vraci same jednotky ==}
begin GetData:=$FFFF;
if TestAdr(Adr)=_INVALID_ then exit;
GetData:=_Buf[Adr].W;
end; {GetData}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_DEFS.PAS
0,0 → 1,531
unit PP_DEFS;
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde jsou definice zavisle na vlastnostech jednotlivych procesoru. }
{ Dale jsou zde procedury, ktere prpimo souvisi s definovanymi datovymi }
{ strukturami }
{===========================================================================}
 
interface
 
uses PP_COMON; { jen procedura Error }
 
{===========================================================================}
{ Definice celkoveho rozsahu adresoveho prostoru pri programovani PICu }
{===========================================================================}
 
const DataBufLen=$4000; { Maximalne 2 x 8 K slov pameti programu }
{ dat a konfigurace }
 
{===========================================================================}
{ Definice typu a konstant souvisejicich se zpracovanim prepinacu pro }
{ definovani konfiguracniho slova. }
{===========================================================================}
 
{-- Definice konstant pro rozsah mezi --}
 
const CfgDefProcCount = 8; { pocet skupin procesoru }
CfgDefSwCount = 15; { maximalni pocet prepinacu u jedne skupiny }
CfgWordLen = 14; { maximalni pocet bitu Cfg slova }
CfgNameLen = 10; { maximalni delka jmena definice skupiny }
CfgKeyLen = 10; { maximalni delka prepinace }
 
{-- Definice typu pro popis jednoho prepinace --}
 
type CfgDefSw_t=record
Key : string[CfgKeyLen]; { jmeno prepinace }
On : string[CfgWordLen]; { hodnota pro stav _ON }
Off : string[CfgWordLen]; { hodnota pro stav _OFF }
Bits : string[CfgWordLen]; { definice pro _xxx u vicebitovych prepinacu }
end; {record}
 
{ Key definuje jmeno prepinace ( napr CP pro Code Protection ) }
{ On definuje stav jednotlivych bitu pro stav On }
{ Off definuje stav jednotlivych bity pro stav Off }
{ Bits definuje kam prijdou jednotlive bity vicebitoveho prepinace }
 
const CfgX:string[CfgWordLen]=''; { sama 'X' o delce Cfg slova }
 
{-- Definice typu pro popis jedne skupinu procesoru --}
 
type CfgDefProc_t=record
ProcId : string[CfgNameLen]; { jmeno skupiny procesoru }
Info : array[1..CfgDefSwCount] of CfgDefSw_t;
end; {record}
 
{-- Definice typu pro popis vsech skupin procesoru --}
 
type CfgDef_t=array[1..CfgDefProcCount] of CfgDefProc_t;
 
{-- Definice konstanty popisu prepinace s prazdnym obsahem --}
 
const CfgDefSwNull:CfgDefSw_t=
( Key : '';
On : '';
Off : '';
Bits : ''
);
 
{-- Vlastni definice vsech skupin procesoru --}
 
{$I PP_CFG.PAS} { Abychom tady nemeli tisic radek definice }
 
{===========================================================================}
{ Hlavicky funkci a procedur pro podporu zpracovani prepinacu }
{ modifikujicich konfiguracni slovo. }
{===========================================================================}
 
function CfgFindProcGroup(Par:string;var CfgDef:CfgDef_t):integer;
{== Vrati index do tabulky CfgDef pro zadane jmeno skupiny procesoru ==}
{ Pri nenalezeni vraci cilo 0 }
 
procedure CfgDisplayHelp(var CfgDefProc:CfgDefProc_t);
{== Zobrazi help pro Cfg prepinace zadane skupiny procesoru ==}
 
procedure CfgDisplayHelpAll(var CfgDef:CfgDef_t);
{== Zobrazi help od prepinacu Cfg slova pro vechny skupiny procesoru ==}
 
function CfgTestKey(Par:string;var CfgDefProc:CfgDefProc_t):string;
{== Otestuje parametr ( retezec s jednim prepinacem ) na vsechny ==}
{ prepinace dane skupiny procesoru a vrati vysledek jako }
{ tristavovy retezec. Pri chybe vraci prazdny retezec. }
 
function CfgOr(s1,s2:string):string;
{== Slouci dva Cfg retezce do jednoho. ==}
{ V pripade konfliktu vraci prazdny retezec }
 
function CfgOverride(s,os:string):string;
{== Modifikuje platne Cfg string s platnymi bity Cfg stringu os ==}
{ V pripade chybneho rozmeru retezcu vraci prazdny retezec }
 
function CfgTestKeyMultiple(var Pars:string;var CfgDefProc:CfgDefProc_t):string;
{== Zadavam retezec prepinacu a popis procesorove specifickych prepinacu. ==}
{ Zpracovane parametry z Pars vykousnu. Vracim Cfg slovo jako tristavovy }
{ retezec. }
{ Pokud je chyba, vracim prazdny retezec a v Pars je prepinac, ktery }
{ zpusobil chybu na prvni pozici }
 
function Word2Str(W:word):string;
{== Prevede binarni data W na retezec ( tristavovy ) ==}
 
function Str2Word(S:string):word;
{== Prevede Cfg string na binarni data ==}
{ Misto bitu 'X' da '1' }
 
{===========================================================================}
{ Definice typu a konstant popisujicich parametry jednotlivych procesoru. }
{===========================================================================}
 
{-- Definice konstant urcujicich meze -}
 
const ProcName_l = 14; { Maxialni delka jmena procesoru }
ProcCount = 89; { Pocet definovanych procesoru }
 
{-- Definice typu pro identifikaci programovaciho algoritmu --}
 
type ProcAlg_t=
( _NONE_, { Nedefinovana hodnota }
_NON2WIRE_, { Algoritmus neni seriovy ( nepodporuji ) }
{-- EPROM a OTP --}
_EPROM1_, { Stary algoritmus pro EPROM ( PIC12C5xx ) }
_EPROM2_, { Standardni EPROM }
_EPROM3_, { Standardni EPROM se slovem 16 bitu }
{-- EEPROM a FLASH --}
_EE1_, { Standardni Flash / EEPROM }
_EE2_, { Flash / EEPROM s prikazem }
{ Begin Programming Only Cycle }
_EE3_, { Skupina 87xA }
_EE4_, { Skupina 627A/628A/648A (jiny erase) }
_EE5_ { Skupina 618/919 (jako EE3, jinak CFG slovo }
); {---> nezapomen aktualizovat ProcDisplayAlg --}
 
{-- Definice typu informace o procesoru --}
 
type ProcNam_t=string[ProcName_l+1];
 
type ProcInfo_t=record
Name : ProcNam_t; { jmeno procesoru }
Alg : ProcAlg_t; { identifikace algoritmu }
Tprog : word; { programovaci cas v us }
Bits : word; { pocet predavanych bitu }
Cfg : string[CfgNameLen]; { druh konfiguracniho slova }
Cfg_Base, Cfg_Mask : word; { adresa Cfg a maska platnych bitu }
PM_Base, PM_Len, PM_Mask : word; { pamet programu }
CM_Base, CM_Len, CM_Mask : word; { pamet konfigurace }
DM_Base, DM_Len, DM_Mask : word; { pamet dat }
end; {record}
 
{-- Defince konstanty parametru procesoru s prazdnym obsahem --}
 
const ProcDummyInfo:ProcInfo_t =
( Name: '';
Alg: _NONE_;
Tprog: 0;
Bits: 0;
Cfg: '';
Cfg_Base: $0000;
Cfg_Mask: $0000;
PM_Base:$0000; PM_Len:$0000; PM_Mask:$0000;
CM_Base:$0000; CM_Len:$0000; CM_Mask:$0000;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
);
 
{-- Defice vlastniho popisu vsech procesoru --}
 
{$I PP_PROC.PAS}
 
{===========================================================================}
{ Hlavicky funkci a procedur souvisejicich s definici parametru procesoru. }
{===========================================================================}
 
procedure ProcDisplayAlg(Alg:ProcAlg_t;Tprog:word);
{== Zobrazi citelne jmeno algoritmu ==}
 
procedure ProcDisplayInfoAll;
{== Zobrazi info o vsech znamych procesorech ==}
{ Strankuje s pauzou }
 
procedure ProcDisplayInfo(ProcInfo:ProcInfo_t);
{== Zobrazi info o jednom procesoru i s nadpisem ==}
 
procedure ProcFind(s:string; var ProcInfo:ProcInfo_t);
{== Najde podle retezce informace o procesoru ==}
 
implementation
 
{===========================================================================}
{ Funkce a procedury pro podporu zpracovani prepinacu modifikujicich }
{ konfiguracni slovo. }
{===========================================================================}
 
function CfgFindProcGroup(Par:string;var CfgDef:CfgDef_t):integer;
{== Vrati index do tabulky CfgDef pro zadane jmeno skupiny procesoru ==}
{ Pri nenalezeni vraci cilo 0 }
var i:integer;
begin i:=CfgDefProcCount+1;
repeat dec(i);
until (i=0) or (Par=CfgDef[i].ProcId);
CfgFindProcGroup:=i;
end; {CfgFindProcGroup}
 
procedure CfgDisplayHelp(var CfgDefProc:CfgDefProc_t);
{== Zobrazi help pro Cfg prepinace zadane skupiny procesoru ==}
var i:integer;
begin write(CfgDefProc.ProcId:10,': ');
for i:=1 to CfgDefSwCount do
write(CfgDefProc.Info[i].Key,' ');
writeln;
end; {CfgDisplayHelp}
 
procedure CfgDisplayHelpAll(var CfgDef:CfgDef_t);
{== Zobrazi help od prepinacu Cfg slova pro vechny skupiny procesoru ==}
var i:integer;
begin writeln('Processor specific switches for Config Word overiding: ');
writeln;
for i:=1 to CfgDefProcCount do
CfgDisplayHelp(CfgDef[i]);
writeln;
end; {CfgDisplayHelpAll}
 
function CfgTestSingleKey(Par:string; Def:CfgDefSw_t):string;
{== Otestuje zda parametr Par odpovida definici Def a vrati retezec ==}
{ obsahujici konfig slovo ve tristavove logice. Pri chybe varci }
{ prazdny retezec }
{ Pomocna funkce }
var i:integer;
BitCount:integer; { pocet bitu 1..8 podle definice }
ParValue:byte; { sem se nactou bity z Par }
begin if pos(Def.Key,Par)=0 then begin CfgTestSingleKey:='';
exit;
end;
if Par=Def.Key+'_ON' then begin CfgTestSingleKey:=Def.On;
exit;
end;
if Par=Def.Key then begin CfgTestSingleKey:=Def.On;
exit;
end;
if Par=Def.Key+'_OFF' then begin CfgTestSingleKey:=Def.Off;
exit;
end;
if Def.Bits='' then begin CfgTestSingleKey:='';
exit;
end;
{-- pocet definovanych bitu --}
BitCount:=0;
for i:=1 to length(Def.Bits) do
begin if (Def.Bits[i] <> 'X') and not (Def.Bits[i] in ['0'..'7'])
then Error('Internal Error 1 at TestKey',0);
if Def.Bits[i] in ['0'..'7']
then if 1+byte(Def.Bits[i])-byte('0') > BitCount
then BitCount:=1+byte(Def.Bits[i])-byte('0');
end;
if BitCount=0 then Error('Internal Error 2 at TestKey',0);
if BitCount>8 then Error('Internal Error 3 at TestKey',0);
if length(Par)<>length(Def.Key)+1+BitCount
then begin CfgTestSingleKey:='';
exit;
end;
{-- precti bity --}
ParValue:=0;
for i:=1 to BitCount do
begin case Par[length(Def.Key)+1+i] of
'0' : ParValue:=ParValue*2;
'1' : ParValue:=ParValue*2+1;
else begin CfgTestSingleKey:='';
exit;
end;
end; {case}
end;
{-- sestav vysledek --}
CfgTestSingleKey[0]:=char(CfgWordLen);
for i:=1 to CfgWordLen do
begin if Def.Bits[i]='X'
then CfgTestSingleKey[i]:='X'
else if ((ParValue shr (byte(Def.Bits[i])-byte('0'))) and 1) = 0
then CfgTestSingleKey[i]:='0'
else CfgTestSingleKey[i]:='1';
end;
end; {CfgTestSingleKey}
 
function CfgTestKey(Par:string;var CfgDefProc:CfgDefProc_t):string;
{== Otestuje parametr ( retezec s jednim prepinacem ) na vsechny ==}
{ prepinace dane skupiny procesoru a vrati vysledek jako }
{ tristavovy retezec. Pri chybe vraci prazdny retezec. }
var i:integer;
s:string;
begin if Par='' then begin CfgTestKey:=''; { to je vlastne chyba, }
exit; { nevracim zadne slovo }
end;
i:=1;
repeat s:=CfgTestSingleKey(Par,CfgDefProc.Info[i]);
inc(i);
until (s<>'') or (i>CfgDefSwCount);
CfgTestKey:=s;
end; {CfgTestKey}
 
procedure CfgDisplayCfgBits(s:string);
{== Zobrazi citelne druh konfiguracnich bitu ==}
{ Pomocna procedura ( ProcDisplayInfoLine ) }
begin write(copy(s+' ',1,9));
end; {CfgDisplayCfgBits}
 
function CfgOr(s1,s2:string):string;
{== Slouci dva Cfg retezce do jednoho. ==}
{ V pripade konfliktu vraci prazdny retezec }
var i:integer;
begin CfgOr:='';
if length(s1)<>length(s2) then exit;
for i:=1 to length(s1) do
case s1[i] of
'0' : case s2[i] of
'0' : CfgOr[i]:='0';
'1' : exit;
'X' : CfgOr[i]:='0';
else exit;
end; {case}
'1' : case s2[i] of
'0' : exit;
'1' : CfgOr[i]:='1';
'X' : CfgOr[i]:='1';
else exit;
end; {case}
'X' : case s2[i] of
'0' : CfgOr[i]:='0';
'1' : CfgOr[i]:='1';
'X' : CfgOr[i]:='X';
else exit;
end; {case}
else exit; { chyba }
end; {case}
CfgOr[0]:=s1[0]; { delka retezce }
end; {CfgOr}
 
function CfgOverride(s,os:string):string;
{== Modifikuje platne Cfg string s platnymi bity Cfg stringu os ==}
{ V pripade chybneho rozmeru retezcu vraci prazdny retezec }
var i:integer;
begin CfgOverride:='';
if length(s)<>length(os) then exit;
for i:=1 to length(s) do
case os[i] of
'0' : CfgOverride[i]:='0';
'1' : CfgOverride[i]:='1';
'X' : CfgOverride[i]:=s[i];
else exit; { chyba }
end; {case}
CfgOverride[0]:=s[0]; { delka retezce }
end; {CfgOverride}
 
function CfgTestKeyMultiple(var Pars:string;var CfgDefProc:CfgDefProc_t):string;
{== Zadavam retezec prepinacu a popis procesorove specifickych prepinacu. ==}
{ Zpracovane parametry z Pars vykousnu. Vracim Cfg slovo jako tristavovy }
{ retezec. }
{ Pokud je chyba, vracim prazdny retezec a v Pars je prepinac, ktery }
{ zpusobil chybu na prvni pozici }
var CfgOne : string; { jeden klic ( prepinac ) }
CfgSuma : string; { mezisoucet klicu }
ErrStr : string; { meziuschova nezpracovatelnych klicu }
begin ErrStr:='';
CfgSuma:=CfgX;
while Pars<>'' do { dokud nezpracuji vse z retezce Pars }
begin {-- zpracuj jeden prepinac --}
CfgOne:=CfgTestKey(GetWord(Pars),CfgDefProc);
if CfgOne=''
then ErrStr:=ErrStr+' '+GetWord(Pars)
else begin CfgSuma:=CfgOr(CfgSuma,CfgOne);
if CfgSuma=''
then begin {-- konfliktni parametry --}
CfgTestKeyMultiple:='';
Pars:=Pars+ErrStr;
exit;
end;
end;
Pars:=DelWord(Pars);
end;
CfgTestKeyMultiple:=CfgSuma; { vysledne konfiguracni slovo }
Pars:=ErrStr; { prepinace, ktere neznam }
end; {CfgTestKeyMultiple}
 
function Word2Str(W:word):string;
{== Prevede binarni data W na retezec ( tristavovy ) ==}
var i:integer;
begin Word2Str[0]:=char(CfgWordLen); { delka retezce }
for i:=CfgWordLen downto 1 do
begin if ( W and 1 ) = 1 then Word2Str[i]:='1' { jednotlive bity }
else Word2Str[i]:='0';
W := W shr 1; { dalsi bit }
end;
end; {Word2Str}
 
function Str2Word(S:string):word;
{== Prevede Cfg string na binarni data ==}
{ Misto bitu 'X' da '1' }
var W:word;
i:integer;
begin W:=0;
for i:=1 to length(S) do
if S[i]<>'0' then W := ( W shl 1 ) + 1
else W := ( W shl 1 );
Str2Word:=W;
end; {Str2Word}
 
{===========================================================================}
{ Funkce a procedury souvisejicich s definici parametru procesoru. }
{===========================================================================}
 
procedure ProcDisplayAlg(Alg:ProcAlg_t;Tprog:word);
{== Zobrazi citelne jmeno algoritmu ==}
begin case Alg of
_NONE_ : write('NONE ');
_EPROM1_ : write('EPROM1 ');
_EPROM2_ : write('EPROM2 ');
_EPROM3_ : write('EPROM3 ');
_EE1_ : write('EE1 ');
_EE2_ : write('EE2 ');
_EE3_ : write('EE3 ');
_EE4_ : write('EE4 ');
_EE5_ : write('EE5 ');
_NON2WIRE_ : write('NON2WIRE');
else write('?? ');
end; {case}
write(Tprog:6,' '); { programovaci cas v us }
end; {ProcDisplayAlg}
 
procedure ProcDisplayInfoLine(ProcInfo:ProcInfo_t);
{== Zobrazi v lidske podobe nektere informace o procesoru ==}
var s:string;
i:integer;
begin s:=ProcInfo.Name;
for i:=length(s)+1 to ProcName_l do s:=s+' ';
write(s,' ');
ProcDisplayAlg(ProcInfo.Alg,ProcInfo.Tprog);
CfgDisplayCfgBits(ProcInfo.Cfg);
DisplayRange(ProcInfo.PM_Base,ProcInfo.PM_Len);
DisplayRange(ProcInfo.CM_Base,ProcInfo.CM_Len);
DisplayRange(ProcInfo.DM_Base,ProcInfo.DM_Len);
writeln;
end; {ProcDisplayInfoLine}
 
procedure ProcDisplayInfoHeader;
{== Zobrazi nadpis ==}
begin writeln('Proc Name Alg Tprog[us] Cfg Bits Pgm Memory Cfg Memory Dat Memory');
writeln('--------------------------------------------------------------------------');
end; {ProcDisplayInfoHeader}
 
procedure ProcDisplayInfoAll;
{== Zobrazi info o vsech znamych procesorech ==}
{ Strankuje s pauzou }
var i,j:integer;
begin i:=0;
while i<ProcCount do
begin ProcDisplayInfoHeader;
j:=0;
while (i<ProcCount) and (j<22) do
begin inc(i);
inc(j);
ProcDisplayInfoLine(ProcInfoAll[i]);
end;
if i<ProcCount then PressEnter;
end;
end; {ProcDisplayInfoAll}
 
procedure ProcDisplayInfo(ProcInfo:ProcInfo_t);
{== Zobrazi info o jednom procesoru i s nadpisem ==}
begin ProcDisplayInfoHeader;
ProcDisplayInfoLine(ProcInfo);
writeln;
end; {ProcDisplayInfo}
 
procedure ProcFind(s:string; var ProcInfo:ProcInfo_t);
{== Najde podle retezce informace o procesoru ==}
var i:integer;
begin {-- separace jmena procesoru z retezce --}
s:=upstr(s)+' ';
ProcInfo:=ProcDummyInfo;
i:=pos('PIC',s);
if i=0 then exit;
s:=copy(s,i,255);
i:=pos(' ',s);
s:=copy(s,1,i-1);
{-- nalezeni informaci --}
for i:=1 to ProcCount do
if (ProcInfoAll[i].Name+' ') = s+' '
then ProcInfo:=ProcInfoAll[i];
end; {ProcFind}
 
{===========================================================================}
{ Telo jednotky. }
{===========================================================================}
 
procedure VerifyProcInfo;
{== Procedura provede interni test konzistentnosti dat ==}
var i:integer;
begin for i:=1 to ProcCount do
with ProcInfoAll[i] do
begin {-- kontrola delky jmena procesoru --}
if length(Name) > ProcName_l
then Error('Internal Error: IE01',0);
{-- kontrola rozsahu pametovych prostoru --}
if PM_Base+PM_Len>DataBufLen
then Error('Internal Error: IE02',0);
if CM_Base+CM_Len>DataBufLen
then Error('Internal Error: IE03',0);
if DM_Base+DM_Len>DataBufLen
then Error('Internal Error: IE04',0);
{-- kontrola zda znam vsechny uvedene Cfg --}
if (ProcInfoAll[i].Cfg<>'') and (CfgFindProcGroup(ProcInfoAll[i].Cfg,CfgDefAll)=0)
then Error('Internal Error: IE5',0);
end;
end; {VerifyProcInfo}
 
var i:integer;
 
begin {-- kontroluje konzistentnost konstant --}
VerifyProcInfo;
{-- inicializace prazdne konstanty pro Cfg slovo ( same 'X' ) --}
CfgX[0]:=char(CfgWordLen);
for i:=1 to length(CfgX) do CfgX[i]:='X';
end.
 
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_IO.PAS
0,0 → 1,318
unit PP_IO;
 
{===========================================================================}
{ (c) miho / DECROS/ICZ 2000/2001/2002 }
{===========================================================================}
{ Zde jsou procedury a funkce pro vstup a vystup dat v definovanych }
{ formatech ( viz IO_t ). Je to objekt, ktery dedi datovy objekt. }
{===========================================================================}
{verze: }
{1.00 - Uvodni verze }
{1.01 - Uprava exportu Config Word pro obvody s _EPROM1_ PEFI }
 
interface
 
uses PP_COMON,
PP_DATA,
PP_DEFS;
 
const ItemPerLine=8; { Pocet polozek na jedne radce exportu }
 
type IO_t=
( _HEX_, { vyber IO filtru typu text }
_TXT_, { vyber IO filtru typu intel hex }
_NIL_ { neplatna volba }
);
 
type PicDataIo_t=object(PicData_t)
 
procedure Export( Name:string; Format:IO_t; Source:string);
{== Vystup dat z objektu do souboru ==}
 
procedure Import( Name:string; Format:IO_t);
{== Vstup dat ze souboru do datoveho objektu ==}
 
end; {object}
 
 
 
implementation
 
{===========================================================================}
{ Export dat do souboru }
{===========================================================================}
 
procedure _LineOut_TXT_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
{== Pomocna procedura vypise radek TXT dat z datatoveho objektu do souboru ==}
var i:integer;
begin HexWord(f,Adr);
write(f,': ');
for i:=0 to Count-1 do HexWordSp(f,Data.GetData(Adr+i));
writeln(f);
end; {_LineOut_TXT_}
 
procedure _LineOut_HEX_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
{== Pomocna procedura vypise radek HEX dat z datoveho objektu do souboru ==}
var i:integer;
dat:word;
suma:byte; { kontrolni soucet HEX }
procedure sum(data:word);
begin inc(suma,data);
inc(suma,data shr 8);
end; {sum}
begin suma:=0;
write(f,':10');
sum($10);
HexWord(f,Adr*2);
sum(Adr*2);
write(f,'00');
for i:=0 to Count-1 do begin dat:=Data.GetData(Adr+i);
HexByte(f,dat);
HexByte(f,dat shr 8);
sum(dat);
end;
HexByte(f,byte(-suma));
writeln(f);
end; {_LineOut_HEX_}
 
procedure PicDataIo_t.Export( Name:string; Format:IO_t; Source:string);
{== Vystup dat z objektu do souboru ==}
var f:text;
i:integer;
len:word;
Proc:ProcInfo_t;
begin Name:=UpStr(Name);
writeln('Exporting data to file: ',Name);
{== Zalozeni souboru ==}
assign(f,Name);
{$I-}
rewrite(f);
{$I+}
if ioresult<>0 then Error('Unable create file: '+Name,0);
{== Hlavicka souboru ==}
{$I-}
case format of
_TXT_ : begin writeln(f,source);
writeln(f);
end;
_HEX_ : ;
end; {case}
{== Telo souboru ( data ) ==}
{-- Pamet programu --}
GetProcInfo(Proc); { vytahni si parametry }
if Proc.PM_Len>0 then
begin i:=0;
while i<Proc.PM_Len do
begin if (i+ItemPerLine)<Proc.PM_Len
then len:=ItemPerLine
else len:=Proc.PM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.PM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.PM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
end;
{-- Pamet dat --}
if Proc.DM_Len>0 then
begin i:=0;
while i<Proc.DM_Len do
begin if (i+ItemPerLine)<Proc.DM_Len
then len:=ItemPerLine
else len:=Proc.DM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.DM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.DM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
end;
{-- Konfiguacni pamet --}
if Proc.CM_Len>0 then
begin i:=0;
while i<Proc.CM_Len do
begin if (i+ItemPerLine)<Proc.CM_Len
then len:=ItemPerLine
else len:=Proc.CM_Len-i;
case format of
_TXT_ : _LineOut_TXT_(f,Proc.CM_Base+i,len,self);
_HEX_ : _LineOut_HEX_(f,Proc.CM_Base+i,len,self);
end; {case}
i:=i+ItemPerLine;
end;
end;
{-- Oddelovac --}
case format of
_TXT_ : writeln(f);
_HEX_ : writeln(f);
end; {case}
 
{-- konfiguracni slovo -- }
{-- jen u procesoru s algoritmem _EPROM1_,}
{-- tam neni soucasti konfig. pameti }
if Proc.Alg=_EPROM1_ then
begin
case format of
_TXT_ : _LineOut_TXT_(f,Proc.Cfg_Base,1,self);
_HEX_ : _LineOut_HEX_(f,Proc.Cfg_Base,1,self);
end; {case}
end;
 
{== Paticka souboru ==}
case format of
_TXT_ : ;
_HEX_ : writeln(f,':00000001FF');
end; {case}
{== Uzavreni souboru ==}
close(f);
{$I+}
if ioresult<>0 then Error('Unable write to file: '+name,0);
end; {Export}
 
{===========================================================================}
{ Import dat ze souboru }
{===========================================================================}
 
procedure _LineIn_TXT_(var s:string; var Data:PicData_t; LineNumber:integer);
{== Pomocna procedura zpracuje radku TXT textu a data ulozi do datoveho objektu ==}
var i:integer;
 
adr,dat:word;
valid:boolean;
procedure blank;
begin while ( (s[i]=' ') or (s[i]=#8) ) and (i<length(s)) do inc(i);
end;
procedure hex;
begin dat:=0;
valid:=false;
blank;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=true;
if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
else dat:=16*dat+(ord(s[i])-ord('A')+10);
inc(i);
end;
blank;
if s[i]<>':' then Error('Invalid file format, ":" expected',LineNumber);
inc(i);
if not valid then Error('Invalid file format, Address expected',LineNumber);
adr:=dat;
blank;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=false;
dat:=0;
while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
do begin valid:=true;
if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
else dat:=16*dat+(ord(s[i])-ord('A')+10);
inc(i);
end;
blank;
if valid then begin if Data.Store(adr,dat)
then Error('Bad Address',LineNumber);
inc(adr);
end;
end;
if (s[i]<>';') and (s[i]<>'#')
then Error('Invalid file format, unexpected char "'+s[i]+'"',LineNumber);
end;
begin if length(s)=0 then exit;
i:=1;
blank;
s:=s+';';
while (i<=length(s)) and ( s[i]<>';' ) and (s[i]<>'#') do
begin {-- jednotliva cisla --}
hex;
end;
end; {_LineIn_TXT_}
 
procedure _LineIn_HEX_(var s:string; var Data:PicData_t; LineNumber:integer);
{== Pomocna procedura zpracuje radku HEX textu a data ulozi do datoveho objektu ==}
var i,j:integer;
adr,dat:word;
suma:byte;
function h(i:integer):byte;
begin if s[i]<='9' then h:=(ord(s[i])-ord('0'))
else h:=(ord(s[i])-ord('A')+10);
end;
begin {-- filtrace radky --}
j:=1; { vyhod blank znaky }
for i:=1 to length(s) do if (s[i]<>' ') and (s[i]<>#8) then
begin s[j]:=s[i];
inc(j);
end;
byte(s[0]):=j-1;
if s=':00000001FF' then exit; { ukoncovaci veta }
if s[1]<>':' then exit; { platny zacatek }
if length(s)=0 then exit; { prazdne radky nevadi }
if length(s)<13 then Error('Invalid file format, line too short',LineNumber);
{-- vytazeni cislic --}
for i:=2 to length(s) do
if not (s[i]in ['0'..'9']) and not (s[i]in ['A'..'F'])
then Error('Invalid file format, illegal char',LineNumber);
j:=16*h(2)+h(3); { pocet polozek }
if j and 1 = 1 then Error('Invalid file format, odd data count',LineNumber);
if length(s) <> j*2+11 then Error('Invalid file format, line length',LineNumber);
j:=j div 2;
{-- kontrola kontrolniho souctu HEX --}
suma:=0;
for i:=0 to 2*j+5-1 do
begin {$R-} suma:=suma+h(2+i*2)*16+h(3+i*2);
{$R+}
end;
if suma<>0 then Error('CheckSum Error',LineNumber);
{-- Nacteni dat --}
adr:=(( h(4) *16 + h(5)) *16 + h(6)) *16 + h(7);
if adr and 1 = 1 then Error('Invalid file format, odd addres',LineNumber);
adr:=adr shr 1;
if (s[8]<>'0') or (s[9]<>'0') then exit;
for i:=0 to j-1 do
begin dat:=( ( h(4*i+12) *16 + h(4*i+13)) *16
+ h(4*i+10)) *16 + h(4*i+11) ;
if Data.Store(adr,dat)
then Error('Bad Address',LineNumber);
inc(adr);
end;
end; {_LineIn_HEX_}
 
procedure PicDataIo_t.Import( Name:string; Format:IO_t);
{== Vstup dat ze souboru do datoveho objektu ==}
var f:text;
s:string;
LineNumber:integer;
begin name:=UpStr(name);
writeln('Importing data from file: ',name);
assign(f,name);
{$I-}
reset(f);
{$I+}
if ioresult<>0 then Error('Unable open file: '+name,0);
{$I-}
LineNumber:=0;
repeat inc(LineNumber); { pocitani cisla radky pro pripad chyby }
readln(f,s);
s:=UpStr(s);
case Format of
_TXT_ : _LineIn_TXT_(s,self,LineNumber);
_HEX_ : _LineIn_HEX_(s,self,LineNumber);
end; {case}
until eof(f);
close(f);
{$I+}
if ioresult<>0 then Error('Unable read from file: '+name,LineNumber);
{ pro testovani importu }
{ Export('a.a',_TXT_,';Test of Import procedure'); }
end; {Import}
 
begin
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_PGMHW.PAS
0,0 → 1,370
unit PP_PGMHW;
 
{== Ovladani programatoru ==}
 
{========================================================}
{ (c)DECROS 2000 miho, pefi }
{ 1.0 - ovladani programatoru pres LPT a ALL03 }
{ 1.1 - zmena vystupu cisla portu z DEC na HEX }
{ - doplneni xDelayMicro(1) u vazby na ALL03 }
{========================================================}
 
 
interface
 
uses DELAY,
PP_ALL03;
 
type Logical=(zero,one,tristate); { typ pro definovani stavu vystupu }
 
type PGM = object
{-- Rodicovsky objekt pro ovladani programatoru --}
 
_PortAdr : word; { adresa portu }
_Error : string; { retezec posledni chyby }
 
constructor Init(Port:word);
{== inicializuje a zapamatuje adresu ==}
 
procedure Error(S:string);
virtual;
{== vypise chybu ==}
 
procedure Info(S:string);
virtual;
{== vypise info ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_p=^PGM;
 
type PGM_LPT = object(PGM)
{-- Objekt ovladani programatoru pres LPT --}
 
_PortStat : byte;
 
constructor Init(Port:word);
{== inicializuje, vstupem je cislo portu ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_LPT_p=^PGM_LPT;
 
type PGM_ALL = object(PGM)
{-- Objekt ovladani programatoru ALL03 --}
 
_ProgAdr : word;
 
constructor Init(Port:word);
{== inicializuje, vstupem je cislo portu ==}
 
procedure SetVcc(Voltage:real);
virtual;
{== nastav napajeni ==}
 
procedure SetVpp(Voltage:real);
virtual;
{== nastav programovaci napeti ==}
 
procedure SetReset(Stat:Logical);
virtual;
{== nastav signal RESET dle Stat ==}
 
procedure SetData(Stat:Logical);
virtual;
{== nastav signal DATA dle Stat ==}
 
procedure SetClock(Stat:Logical);
virtual;
{== nastav signal CLOCK dle Stat ==}
 
function GetData:boolean;
virtual;
{== precte stav datoveho vstupu ==}
 
end; {object}
 
type PGM_ALL_p=^PGM_ALL;
 
implementation
 
function num2str(w:word):string;
{== Prevede cislo na retezec ( jako HEX cislo ) ===}
const prevod:array[0..15]of char=('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var s:string;
begin s[0]:=#4;
s[1]:=prevod[(w shr 12) and $F];
s[2]:=prevod[(w shr 8) and $F];
s[3]:=prevod[(w shr 4) and $F];
s[4]:=prevod[(w shr 0) and $F];
if s[1]='0' then s:=copy(s,2,255);
if s[1]='0' then s:=copy(s,2,255);
if s[1]='0' then s:=copy(s,2,255);
num2str:=s;
end; {num2str}
 
{========================================================}
{ }
{ Programator prazdny prototyp }
{ miho }
{========================================================}
 
constructor PGM.Init(Port:word);
{== inicializuje a zapamatuje adresu ==}
begin _PortAdr:=0;
end; {Init}
 
procedure PGM.Error(S:string);
{== vypise chybu ==}
begin _Error:=s;
end; {Error}
 
procedure PGM.Info(S:string);
{== vypise info ==}
begin writeln('INFO: ',S);
end; {Error}
 
procedure PGM.SetVcc(Voltage:real);
{== nastav napajeni ==}
begin
end; {SetVcc}
 
procedure PGM.SetVpp(Voltage:real);
{== nastav programovaci napeti ==}
begin
end; {SetVpp}
 
procedure PGM.SetReset(Stat:Logical);
{== nastav signal RESET dle Stat ==}
begin
end; {SetReset}
 
procedure PGM.SetData(Stat:Logical);
{== nastav signal DATA dle Stat ==}
begin
end; {SetData}
 
procedure PGM.SetClock(Stat:Logical);
{== nastav signal CLOCK dle Stat ==}
begin
end; {SetClock}
 
function PGM.GetData:boolean;
{== precte stav datoveho vstupu ==}
begin
end; {GetData}
 
{========================================================}
{ }
{ Programator via printer port }
{ miho }
{========================================================}
 
const LPT_DATA = $01; { Datovy vystup - RB7 }
LPT_DATAOE = $02; { Povoleni vystupu }
LPT_CLOCK = $04; { Hodiny - RB6 }
LPT_CLOCKOE = $08; { Povoleni vystupu }
LPT_VCC = $10; { Zapnuti +5V }
LPT_VPP = $20; { Zapnuti +12V na MCLR }
LPT_RES = $40; { Pripojeni 0V na MCLR }
 
LPT_DATAIN = $40; { Maska bitu pro cteni dat }
 
 
constructor PGM_LPT.Init(Port:word);
var AdrTab:array[1..3]of word absolute 0:$408;{ tabulka LPT1..LPT3 z BIOSu }
{== inicializuje a zapamatuje adresu ==}
var w:word;
begin _PortAdr:=0;
_Error:='';
_PortStat:=0;
if (port<1) or (port>3) then Error('Invalid Port Number')
else _PortAdr:=AdrTab[Port];
if _PortAdr=0 then Error('Port not Registered in BIOS');
Info('Port Address '+num2str(_PortAdr)+'H');
if _Error<>'' then fail;
if _PortAdr<>0 then system.port[_PortAdr]:=_PortStat;
end; {Init}
 
procedure PGM_LPT.SetVcc(Voltage:real);
{== nastav napajeni ==}
begin if Voltage = 5.0 then _PortStat:=_PortStat or LPT_VCC
else _PortStat:=_PortStat and not LPT_VCC;
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetVcc}
 
procedure PGM_LPT.SetVpp(Voltage:real);
{== nastav programovaci napeti ==}
begin if Voltage=13.0
then _PortStat:= LPT_VPP or ( _PortStat and not LPT_RES )
else _PortStat:= _PortStat and not LPT_VPP;
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetVpp}
 
procedure PGM_LPT.SetReset(Stat:Logical);
{== nastav signal RESET dle Stat ==}
begin case Stat of
zero : begin SetVpp(0);
_PortStat:=_PortStat or LPT_RES;
end;
one : _PortStat:=_PortStat and not LPT_RES;
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetReset}
 
procedure PGM_LPT.SetData(Stat:Logical);
{== nastav signal DATA dle Stat ==}
begin case Stat of
zero : _PortStat := ( _PortStat and not LPT_DATA ) or LPT_DATAOE;
one : _PortStat := _PortStat or LPT_DATA or LPT_DATAOE;
tristate : _PortStat := ( _PortStat and not LPT_DATAOE and not LPT_DATA )
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetData}
 
procedure PGM_LPT.SetClock(Stat:Logical);
{== nastav signal CLOCK dle Stat ==}
begin case Stat of
zero : _PortStat := ( _PortStat and not LPT_CLOCK ) or LPT_CLOCKOE;
one : _PortStat := _PortStat or LPT_CLOCK or LPT_CLOCKOE;
tristate : _PortStat := ( _PortStat and not LPT_CLOCKOE and not LPT_CLOCK )
end; {case}
if _PortAdr<>0 then port[_PortAdr]:=_PortStat;
xDelayMicro(1);
end; {SetClock}
 
function PGM_LPT.GetData:boolean;
{== precte stav datoveho vstupu ==}
begin GetData:=(port[_PortAdr+1] and LPT_DATAIN) = LPT_DATAIN;
xDelayMicro(1);
end; {GetData}
 
 
{========================================================}
{ }
{ Programator ALL03 }
{ pefi }
{========================================================}
 
{ Tato cast v podstate jen vola funkce jednotky ProgAll }
 
const ALL_VCC = 30;
ALL_GND = 11;
ALL_VPP = 10;
ALL_CLOCK = 28;
ALL_DATA = 29;
 
Constructor PGM_All.Init(Port:Word);
{== provede inicializaci programatoru ==}
begin
Initialize(Port);
Gnd11(true); { pripoji zem na vyvodu 11 }
end;{End Init}
 
procedure PGM_All.SetVcc(Voltage:real);
{== zapina a vypina napajeni ==}
begin
SetVoltageV1(Voltage);
if Voltage=0 then ConnectV1(ALL_VCC,false)
else ConnectV1(ALL_VCC,true);
xDelayMicro(1);
end;{End SetVcc}
 
procedure PGM_All.SetVpp(Voltage:real);
{== zapina a vypina programovaci napeti ==}
begin
SetVoltageV2(Voltage);
if Voltage=0 then ConnectV2(ALL_VPP,false)
else ConnectV2(ALL_VPP,true);
xDelayMicro(1);
end;{EndSetVpp}
 
procedure PGM_All.SetReset(Stat:Logical);
{== nastavi nebo shodi signal Reset-VPP ==}
begin
ConnectV2(ALL_VPP,false);{nejdrive nutno Vpp odpojit}
if Stat = zero then SetBit(ALL_VPP,0)
else SetBit(ALL_VPP,1);
xDelayMicro(1);
end;{EndSetReset}
 
procedure PGM_All.SetData(Stat:Logical);
{== nastavi nebo shodi signal DATA ==}
begin
if Stat = zero then SetBit(ALL_DATA,0)
else SetBit(ALL_DATA,1);
xDelayMicro(1);
end;{End SetData}
 
procedure PGM_All.SetClock(Stat:Logical);
{== nastavi nebo shodi signal CLK ==}
begin
if Stat = zero then SetBit(ALL_CLOCK,0)
else SetBit(ALL_CLOCK,1);
xDelayMicro(1);
end;{End SetClock}
 
function PGM_All.GetData:boolean;
var
stav:byte;
begin
Stav:=GetBit(ALL_DATA);
if Stav=1 then GetData:=true
else GetData:=false;
xDelayMicro(1);
end;{End GetData}
 
end.
/Modules/PICPGR3/PICPGR301A/SW/4_13/PP_PROC.PAS
0,0 → 1,1012
 
{Toto je include soubor}
 
{===========================================================================}
{ (c) miho / DECROS 2000 }
{===========================================================================}
{ Zde je definice vlastnosti vsech procesoru PIC, ktere tento program znam. }
{===========================================================================}
{verze: }
{ 1.00 - Uvodni verze }
{ 1.01 - Uprava definic procesoru 12C508/509 PEFI }
{ 1.02 - Doplneny procesory 87xA MIHO }
{ 1.11 - Doplneny procesory 627A/628A/648A MIHO }
{ 1.12 - Doplneny procesory 87/88 MIHO }
 
{---> PP_DEFS - zde je nadefinovany pocet procesoru a druhy algoritmu --}
{---> PP_CFG - zde jsou nadefinovany prepinace Cfg slova --}
const ProcInfoAll:array[1..ProcCount] of ProcInfo_t =
(
{-- Programovane starym algoritmem EPROM --}
( Name: 'PIC12C508';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C508A';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C509';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C509A';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE518';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$0FFF;
CM_Base:$0200; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE519';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C505';
Alg: _EPROM1_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $0FFF;
Cfg_Mask: $0FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$0FFF;
CM_Base:$0400; CM_Len:$0004; CM_Mask:$0FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani standardnim algoritmem EPROM --}
( Name: 'PIC12C671';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12C672';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE673';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC12CE674';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC14000';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC14C000';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C554';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C556';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C558';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C61';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C71';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C64';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C710';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C711';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C62B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C63';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C63A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C64A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C65B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C66';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C67';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C72';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C72A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C73B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C74B';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C76';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C77';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C620';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C620A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C621';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C621A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C622';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C622A';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE623';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE624';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16CE625';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C712';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C716';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C745';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C765';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C923';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C924';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C773';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C774';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C717';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C770';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C771';
Alg: _EPROM2_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani standardnim algoritmem EPROM ale s paritou pameti programu ( 14 bit + 2 bity parita ) --}
( Name: 'PIC16C642';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
( Name: 'PIC16C662';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{}
( Name: 'PIC16C715';
Alg: _EPROM3_;
Tprog: 100;
Bits: 14;
Cfg: '';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$0000; DM_Len:$0000; DM_Mask:$0000
),
{-- Programovani algoritmem EEPROM / FLASH --}
( Name: 'PIC16C84';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'C84';
Cfg_Base: $2007;
Cfg_Mask: $001F;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F83';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0200; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F84';
Alg: _EE1_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F84A';
Alg: _EE2_;
Tprog: 10000;
Bits: 14;
Cfg: 'F83';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
{}
( Name: 'PIC16F627';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $3DFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F628';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $3DFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F627A';
Alg: _EE4_;
Tprog: 6000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $21FF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F628A';
Alg: _EE4_;
Tprog: 6000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $21FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F648A';
Alg: _EE4_;
Tprog: 6000;
Bits: 14;
Cfg: 'F627';
Cfg_Base: $2007;
Cfg_Mask: $21FF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F818';
Alg: _EE5_;
Tprog: 8000;
Bits: 14;
Cfg: 'F818';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0400; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F819';
Alg: _EE5_;
Tprog: 8000;
Bits: 14;
Cfg: 'F818';
Cfg_Base: $2007;
Cfg_Mask: $3FFF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
{}
( Name: 'PIC16F87';
Alg: _EE5_;
Tprog: 1000;
Bits: 14;
Cfg: 'F87';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0020; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F88';
Alg: _EE5_;
Tprog: 1000;
Bits: 14;
Cfg: 'F87';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0020; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
{}
( Name: 'PIC16F870'; { ! nemam zarucena data }
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F871'; { ! nemam zarucena data }
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F872';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F870';
Cfg_Base: $2007;
Cfg_Mask: $33FF;
PM_Base:$0000; PM_Len:$0800; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0040; DM_Mask:$00FF
),
( Name: 'PIC16F873';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F874';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F876';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F877';
Alg: _EE2_;
Tprog: 5000;
Bits: 14;
Cfg: 'F873';
Cfg_Base: $2007;
Cfg_Mask: $3BFF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F873A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F874A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$1000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0080; DM_Mask:$00FF
),
( Name: 'PIC16F876A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
),
( Name: 'PIC16F877A';
Alg: _EE3_;
Tprog: 8000;
Bits: 14;
Cfg: 'F873A';
Cfg_Base: $2007;
Cfg_Mask: $2FCF;
PM_Base:$0000; PM_Len:$2000; PM_Mask:$3FFF;
CM_Base:$2000; CM_Len:$0008; CM_Mask:$3FFF;
DM_Base:$2100; DM_Len:$0100; DM_Mask:$00FF
)
);
/Modules/PICPGR3/PICPGR301A/SW/4_13/TSTPGR.EXE
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Modules/PICPGR3/PICPGR301A/SW/4_13/tstpgr.PAS
0,0 → 1,96
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
{$M 16384,0,655360}
 
program TSTPGR(Input,Output);
 
{=============================================================}
{== Program pro testovani a ozivovani programatoru PICPGR ==}
{=============================================================}
 
{ (c)miho 2004 }
 
{=============================================================}
{ Historie: }
{ 1.00 Novy program }
{=============================================================}
 
 
uses CRT;
 
var PortAdr:word absolute 0:$408;
 
procedure key;
begin readln;
end;
 
begin {== Uvodni tisk ==}
 
writeln;
writeln('Test Utility for PICPGR');
writeln('=======================');
writeln('(c) miho 2004 v.1.00');
writeln;
 
{== Overeni dostupnosti portu LTP1 ==}
 
if PortAdr=0 then begin writeln('No LPT port available!');
halt(1);
end;
 
{== Testovaci posloupnost ==}
writeln('Action PGC PGD VDD ... GND VPP Comment');
writeln('-------------------------------------------------------------------------------');
port[PortAdr]:=0;
writeln('OFF X X 0V . 0V 0V Standard state OFF');
key;
 
port[PortAdr]:=$10;
writeln('Vdd ON X X +5V . 0V +5V');
key;
 
port[PortAdr]:=$50;
writeln('Vdd ON and RESET X X +5V . 0V 0V');
key;
 
port[PortAdr]:=$20;
writeln('Vpp ON X X 0V . 0V 0V Invalid state (missing Vdd)');
key;
 
port[PortAdr]:=$30;
writeln('Vpp and Vdd ON X X +5V . 0V +12V');
key;
 
port[PortAdr]:=$02;
writeln('Data 0 X L 0V . 0V 0V');
key;
 
port[PortAdr]:=$03;
writeln('Data 1 X H 0V . 0V 0V');
key;
 
port[PortAdr]:=$08;
writeln('Clock 0 L X 0V . 0V 0V');
key;
 
port[PortAdr]:=$0C;
writeln('Clock 1 H X 0V . 0V 0V');
key;
 
writeln;
writeln('Test PGD input, use 10k resistor to connect PDG to GND and VDD');
writeln;
port[PortAdr]:=$10;
 
repeat
if (port[PortAdr+1] and $40)<>0 then write('PGD State: H')
else write('PGD State: L');
write(#$0D);
until keypressed and (readkey=#$0D);
 
writeln;
writeln;
writeln('Action PGC PGD VDD ... GND VPP Comment');
writeln('-------------------------------------------------------------------------------');
port[PortAdr]:=$80+$3F;
writeln('OFF X X 0V . 0V 0V Alternative state OFF');
end.