Rev 204 Rev 830
1 unit PP_IO; 1 unit PP_IO;
2   2  
3 {===========================================================================} 3 {===========================================================================}
4 { (c) miho / DECROS/ICZ 2000/2001/2002 } 4 { (c) miho / DECROS/ICZ 2000/2001/2002 }
5 {===========================================================================} 5 {===========================================================================}
6 { Zde jsou procedury a funkce pro vstup a vystup dat v definovanych } 6 { Zde jsou procedury a funkce pro vstup a vystup dat v definovanych }
7 { formatech ( viz IO_t ). Je to objekt, ktery dedi datovy objekt. } 7 { formatech ( viz IO_t ). Je to objekt, ktery dedi datovy objekt. }
8 {===========================================================================} 8 {===========================================================================}
9 {verze: } 9 {verze: }
10 {1.00 - Uvodni verze } 10 {1.00 - Uvodni verze }
11 {1.01 - Uprava exportu Config Word pro obvody s _EPROM1_ PEFI } 11 {1.01 - Uprava exportu Config Word pro obvody s _EPROM1_ PEFI }
12   12  
13 interface 13 interface
14   14  
15 uses PP_COMON, 15 uses PP_COMON,
16 PP_DATA, 16 PP_DATA,
17 PP_DEFS; 17 PP_DEFS;
18   18  
19 const ItemPerLine=8; { Pocet polozek na jedne radce exportu } 19 const ItemPerLine=8; { Pocet polozek na jedne radce exportu }
20   20  
21 type IO_t= 21 type IO_t=
22 ( _HEX_, { vyber IO filtru typu text } 22 ( _HEX_, { vyber IO filtru typu text }
23 _TXT_, { vyber IO filtru typu intel hex } 23 _TXT_, { vyber IO filtru typu intel hex }
24 _NIL_ { neplatna volba } 24 _NIL_ { neplatna volba }
25 ); 25 );
26   26  
27 type PicDataIo_t=object(PicData_t) 27 type PicDataIo_t=object(PicData_t)
28   28  
29 procedure Export( Name:string; Format:IO_t; Source:string); 29 procedure Export( Name:string; Format:IO_t; Source:string);
30 {== Vystup dat z objektu do souboru ==} 30 {== Vystup dat z objektu do souboru ==}
31   31  
32 procedure Import( Name:string; Format:IO_t); 32 procedure Import( Name:string; Format:IO_t);
33 {== Vstup dat ze souboru do datoveho objektu ==} 33 {== Vstup dat ze souboru do datoveho objektu ==}
34   34  
35 end; {object} 35 end; {object}
36   36  
37   37  
38   38  
39 implementation 39 implementation
40   40  
41 {===========================================================================} 41 {===========================================================================}
42 { Export dat do souboru } 42 { Export dat do souboru }
43 {===========================================================================} 43 {===========================================================================}
44   44  
45 procedure _LineOut_TXT_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t); 45 procedure _LineOut_TXT_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
46 {== Pomocna procedura vypise radek TXT dat z datatoveho objektu do souboru ==} 46 {== Pomocna procedura vypise radek TXT dat z datatoveho objektu do souboru ==}
47 var i:integer; 47 var i:integer;
48 begin HexWord(f,Adr); 48 begin HexWord(f,Adr);
49 write(f,': '); 49 write(f,': ');
50 for i:=0 to Count-1 do HexWordSp(f,Data.GetData(Adr+i)); 50 for i:=0 to Count-1 do HexWordSp(f,Data.GetData(Adr+i));
51 writeln(f); 51 writeln(f);
52 end; {_LineOut_TXT_} 52 end; {_LineOut_TXT_}
53   53  
54 procedure _LineOut_HEX_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t); 54 procedure _LineOut_HEX_(var f:text; Adr:word; Count:word; var Data:PicDataIo_t);
55 {== Pomocna procedura vypise radek HEX dat z datoveho objektu do souboru ==} 55 {== Pomocna procedura vypise radek HEX dat z datoveho objektu do souboru ==}
56 var i:integer; 56 var i:integer;
57 dat:word; 57 dat:word;
58 suma:byte; { kontrolni soucet HEX } 58 suma:byte; { kontrolni soucet HEX }
59 procedure sum(data:word); 59 procedure sum(data:word);
60 begin inc(suma,data); 60 begin inc(suma,data);
61 inc(suma,data shr 8); 61 inc(suma,data shr 8);
62 end; {sum} 62 end; {sum}
63 begin suma:=0; 63 begin suma:=0;
64 write(f,':10'); 64 write(f,':10');
65 sum($10); 65 sum($10);
66 HexWord(f,Adr*2); 66 HexWord(f,Adr*2);
67 sum(Adr*2); 67 sum(Adr*2);
68 write(f,'00'); 68 write(f,'00');
69 for i:=0 to Count-1 do begin dat:=Data.GetData(Adr+i); 69 for i:=0 to Count-1 do begin dat:=Data.GetData(Adr+i);
70 HexByte(f,dat); 70 HexByte(f,dat);
71 HexByte(f,dat shr 8); 71 HexByte(f,dat shr 8);
72 sum(dat); 72 sum(dat);
73 end; 73 end;
74 HexByte(f,byte(-suma)); 74 HexByte(f,byte(-suma));
75 writeln(f); 75 writeln(f);
76 end; {_LineOut_HEX_} 76 end; {_LineOut_HEX_}
77   77  
78 procedure PicDataIo_t.Export( Name:string; Format:IO_t; Source:string); 78 procedure PicDataIo_t.Export( Name:string; Format:IO_t; Source:string);
79 {== Vystup dat z objektu do souboru ==} 79 {== Vystup dat z objektu do souboru ==}
80 var f:text; 80 var f:text;
81 i:integer; 81 i:integer;
82 len:word; 82 len:word;
83 Proc:ProcInfo_t; 83 Proc:ProcInfo_t;
84 begin Name:=UpStr(Name); 84 begin Name:=UpStr(Name);
85 writeln('Exporting data to file: ',Name); 85 writeln('Exporting data to file: ',Name);
86 {== Zalozeni souboru ==} 86 {== Zalozeni souboru ==}
87 assign(f,Name); 87 assign(f,Name);
88 {$I-} 88 {$I-}
89 rewrite(f); 89 rewrite(f);
90 {$I+} 90 {$I+}
91 if ioresult<>0 then Error('Unable create file: '+Name,0); 91 if ioresult<>0 then Error('Unable create file: '+Name,0);
92 {== Hlavicka souboru ==} 92 {== Hlavicka souboru ==}
93 {$I-} 93 {$I-}
94 case format of 94 case format of
95 _TXT_ : begin writeln(f,source); 95 _TXT_ : begin writeln(f,source);
96 writeln(f); 96 writeln(f);
97 end; 97 end;
98 _HEX_ : ; 98 _HEX_ : ;
99 end; {case} 99 end; {case}
100 {== Telo souboru ( data ) ==} 100 {== Telo souboru ( data ) ==}
101 {-- Pamet programu --} 101 {-- Pamet programu --}
102 GetProcInfo(Proc); { vytahni si parametry } 102 GetProcInfo(Proc); { vytahni si parametry }
103 if Proc.PM_Len>0 then 103 if Proc.PM_Len>0 then
104 begin i:=0; 104 begin i:=0;
105 while i<Proc.PM_Len do 105 while i<Proc.PM_Len do
106 begin if (i+ItemPerLine)<Proc.PM_Len 106 begin if (i+ItemPerLine)<Proc.PM_Len
107 then len:=ItemPerLine 107 then len:=ItemPerLine
108 else len:=Proc.PM_Len-i; 108 else len:=Proc.PM_Len-i;
109 case format of 109 case format of
110 _TXT_ : _LineOut_TXT_(f,Proc.PM_Base+i,len,self); 110 _TXT_ : _LineOut_TXT_(f,Proc.PM_Base+i,len,self);
111 _HEX_ : _LineOut_HEX_(f,Proc.PM_Base+i,len,self); 111 _HEX_ : _LineOut_HEX_(f,Proc.PM_Base+i,len,self);
112 end; {case} 112 end; {case}
113 i:=i+ItemPerLine; 113 i:=i+ItemPerLine;
114 end; 114 end;
115 {-- Oddelovac --} 115 {-- Oddelovac --}
116 case format of 116 case format of
117 _TXT_ : writeln(f); 117 _TXT_ : writeln(f);
118 _HEX_ : writeln(f); 118 _HEX_ : writeln(f);
119 end; {case} 119 end; {case}
120 end; 120 end;
121 {-- Pamet dat --} 121 {-- Pamet dat --}
122 if Proc.DM_Len>0 then 122 if Proc.DM_Len>0 then
123 begin i:=0; 123 begin i:=0;
124 while i<Proc.DM_Len do 124 while i<Proc.DM_Len do
125 begin if (i+ItemPerLine)<Proc.DM_Len 125 begin if (i+ItemPerLine)<Proc.DM_Len
126 then len:=ItemPerLine 126 then len:=ItemPerLine
127 else len:=Proc.DM_Len-i; 127 else len:=Proc.DM_Len-i;
128 case format of 128 case format of
129 _TXT_ : _LineOut_TXT_(f,Proc.DM_Base+i,len,self); 129 _TXT_ : _LineOut_TXT_(f,Proc.DM_Base+i,len,self);
130 _HEX_ : _LineOut_HEX_(f,Proc.DM_Base+i,len,self); 130 _HEX_ : _LineOut_HEX_(f,Proc.DM_Base+i,len,self);
131 end; {case} 131 end; {case}
132 i:=i+ItemPerLine; 132 i:=i+ItemPerLine;
133 end; 133 end;
134 {-- Oddelovac --} 134 {-- Oddelovac --}
135 case format of 135 case format of
136 _TXT_ : writeln(f); 136 _TXT_ : writeln(f);
137 _HEX_ : writeln(f); 137 _HEX_ : writeln(f);
138 end; {case} 138 end; {case}
139 end; 139 end;
140 {-- Konfiguacni pamet --} 140 {-- Konfiguacni pamet --}
141 if Proc.CM_Len>0 then 141 if Proc.CM_Len>0 then
142 begin i:=0; 142 begin i:=0;
143 while i<Proc.CM_Len do 143 while i<Proc.CM_Len do
144 begin if (i+ItemPerLine)<Proc.CM_Len 144 begin if (i+ItemPerLine)<Proc.CM_Len
145 then len:=ItemPerLine 145 then len:=ItemPerLine
146 else len:=Proc.CM_Len-i; 146 else len:=Proc.CM_Len-i;
147 case format of 147 case format of
148 _TXT_ : _LineOut_TXT_(f,Proc.CM_Base+i,len,self); 148 _TXT_ : _LineOut_TXT_(f,Proc.CM_Base+i,len,self);
149 _HEX_ : _LineOut_HEX_(f,Proc.CM_Base+i,len,self); 149 _HEX_ : _LineOut_HEX_(f,Proc.CM_Base+i,len,self);
150 end; {case} 150 end; {case}
151 i:=i+ItemPerLine; 151 i:=i+ItemPerLine;
152 end; 152 end;
153 end; 153 end;
154 {-- Oddelovac --} 154 {-- Oddelovac --}
155 case format of 155 case format of
156 _TXT_ : writeln(f); 156 _TXT_ : writeln(f);
157 _HEX_ : writeln(f); 157 _HEX_ : writeln(f);
158 end; {case} 158 end; {case}
159   159  
160 {-- konfiguracni slovo -- } 160 {-- konfiguracni slovo -- }
161 {-- jen u procesoru s algoritmem _EPROM1_,} 161 {-- jen u procesoru s algoritmem _EPROM1_,}
162 {-- tam neni soucasti konfig. pameti } 162 {-- tam neni soucasti konfig. pameti }
163 if Proc.Alg=_EPROM1_ then 163 if Proc.Alg=_EPROM1_ then
164 begin 164 begin
165 case format of 165 case format of
166 _TXT_ : _LineOut_TXT_(f,Proc.Cfg_Base,1,self); 166 _TXT_ : _LineOut_TXT_(f,Proc.Cfg_Base,1,self);
167 _HEX_ : _LineOut_HEX_(f,Proc.Cfg_Base,1,self); 167 _HEX_ : _LineOut_HEX_(f,Proc.Cfg_Base,1,self);
168 end; {case} 168 end; {case}
169 end; 169 end;
170   170  
171 {== Paticka souboru ==} 171 {== Paticka souboru ==}
172 case format of 172 case format of
173 _TXT_ : ; 173 _TXT_ : ;
174 _HEX_ : writeln(f,':00000001FF'); 174 _HEX_ : writeln(f,':00000001FF');
175 end; {case} 175 end; {case}
176 {== Uzavreni souboru ==} 176 {== Uzavreni souboru ==}
177 close(f); 177 close(f);
178 {$I+} 178 {$I+}
179 if ioresult<>0 then Error('Unable write to file: '+name,0); 179 if ioresult<>0 then Error('Unable write to file: '+name,0);
180 end; {Export} 180 end; {Export}
181   181  
182 {===========================================================================} 182 {===========================================================================}
183 { Import dat ze souboru } 183 { Import dat ze souboru }
184 {===========================================================================} 184 {===========================================================================}
185   185  
186 procedure _LineIn_TXT_(var s:string; var Data:PicData_t; LineNumber:integer); 186 procedure _LineIn_TXT_(var s:string; var Data:PicData_t; LineNumber:integer);
187 {== Pomocna procedura zpracuje radku TXT textu a data ulozi do datoveho objektu ==} 187 {== Pomocna procedura zpracuje radku TXT textu a data ulozi do datoveho objektu ==}
188 var i:integer; 188 var i:integer;
189   189  
190 adr,dat:word; 190 adr,dat:word;
191 valid:boolean; 191 valid:boolean;
192 procedure blank; 192 procedure blank;
193 begin while ( (s[i]=' ') or (s[i]=#8) ) and (i<length(s)) do inc(i); 193 begin while ( (s[i]=' ') or (s[i]=#8) ) and (i<length(s)) do inc(i);
194 end; 194 end;
195 procedure hex; 195 procedure hex;
196 begin dat:=0; 196 begin dat:=0;
197 valid:=false; 197 valid:=false;
198 blank; 198 blank;
199 while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F']) 199 while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
200 do begin valid:=true; 200 do begin valid:=true;
201 if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0')) 201 if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
202 else dat:=16*dat+(ord(s[i])-ord('A')+10); 202 else dat:=16*dat+(ord(s[i])-ord('A')+10);
203 inc(i); 203 inc(i);
204 end; 204 end;
205 blank; 205 blank;
206 if s[i]<>':' then Error('Invalid file format, ":" expected',LineNumber); 206 if s[i]<>':' then Error('Invalid file format, ":" expected',LineNumber);
207 inc(i); 207 inc(i);
208 if not valid then Error('Invalid file format, Address expected',LineNumber); 208 if not valid then Error('Invalid file format, Address expected',LineNumber);
209 adr:=dat; 209 adr:=dat;
210 blank; 210 blank;
211 while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F']) 211 while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
212 do begin valid:=false; 212 do begin valid:=false;
213 dat:=0; 213 dat:=0;
214 while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F']) 214 while (s[i]in ['0'..'9']) or (s[i]in ['A'..'F'])
215 do begin valid:=true; 215 do begin valid:=true;
216 if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0')) 216 if s[i]<='9' then dat:=16*dat+(ord(s[i])-ord('0'))
217 else dat:=16*dat+(ord(s[i])-ord('A')+10); 217 else dat:=16*dat+(ord(s[i])-ord('A')+10);
218 inc(i); 218 inc(i);
219 end; 219 end;
220 blank; 220 blank;
221 if valid then begin if Data.Store(adr,dat) 221 if valid then begin if Data.Store(adr,dat)
222 then Error('Bad Address',LineNumber); 222 then Error('Bad Address',LineNumber);
223 inc(adr); 223 inc(adr);
224 end; 224 end;
225 end; 225 end;
226 if (s[i]<>';') and (s[i]<>'#') 226 if (s[i]<>';') and (s[i]<>'#')
227 then Error('Invalid file format, unexpected char "'+s[i]+'"',LineNumber); 227 then Error('Invalid file format, unexpected char "'+s[i]+'"',LineNumber);
228 end; 228 end;
229 begin if length(s)=0 then exit; 229 begin if length(s)=0 then exit;
230 i:=1; 230 i:=1;
231 blank; 231 blank;
232 s:=s+';'; 232 s:=s+';';
233 while (i<=length(s)) and ( s[i]<>';' ) and (s[i]<>'#') do 233 while (i<=length(s)) and ( s[i]<>';' ) and (s[i]<>'#') do
234 begin {-- jednotliva cisla --} 234 begin {-- jednotliva cisla --}
235 hex; 235 hex;
236 end; 236 end;
237 end; {_LineIn_TXT_} 237 end; {_LineIn_TXT_}
238   238  
239 procedure _LineIn_HEX_(var s:string; var Data:PicData_t; LineNumber:integer); 239 procedure _LineIn_HEX_(var s:string; var Data:PicData_t; LineNumber:integer);
240 {== Pomocna procedura zpracuje radku HEX textu a data ulozi do datoveho objektu ==} 240 {== Pomocna procedura zpracuje radku HEX textu a data ulozi do datoveho objektu ==}
241 var i,j:integer; 241 var i,j:integer;
242 adr,dat:word; 242 adr,dat:word;
243 suma:byte; 243 suma:byte;
244 function h(i:integer):byte; 244 function h(i:integer):byte;
245 begin if s[i]<='9' then h:=(ord(s[i])-ord('0')) 245 begin if s[i]<='9' then h:=(ord(s[i])-ord('0'))
246 else h:=(ord(s[i])-ord('A')+10); 246 else h:=(ord(s[i])-ord('A')+10);
247 end; 247 end;
248 begin {-- filtrace radky --} 248 begin {-- filtrace radky --}
249 j:=1; { vyhod blank znaky } 249 j:=1; { vyhod blank znaky }
250 for i:=1 to length(s) do if (s[i]<>' ') and (s[i]<>#8) then 250 for i:=1 to length(s) do if (s[i]<>' ') and (s[i]<>#8) then
251 begin s[j]:=s[i]; 251 begin s[j]:=s[i];
252 inc(j); 252 inc(j);
253 end; 253 end;
254 byte(s[0]):=j-1; 254 byte(s[0]):=j-1;
255 if s=':00000001FF' then exit; { ukoncovaci veta } 255 if s=':00000001FF' then exit; { ukoncovaci veta }
256 if s[1]<>':' then exit; { platny zacatek } 256 if s[1]<>':' then exit; { platny zacatek }
257 if length(s)=0 then exit; { prazdne radky nevadi } 257 if length(s)=0 then exit; { prazdne radky nevadi }
258 if length(s)<13 then Error('Invalid file format, line too short',LineNumber); 258 if length(s)<13 then Error('Invalid file format, line too short',LineNumber);
259 {-- vytazeni cislic --} 259 {-- vytazeni cislic --}
260 for i:=2 to length(s) do 260 for i:=2 to length(s) do
261 if not (s[i]in ['0'..'9']) and not (s[i]in ['A'..'F']) 261 if not (s[i]in ['0'..'9']) and not (s[i]in ['A'..'F'])
262 then Error('Invalid file format, illegal char',LineNumber); 262 then Error('Invalid file format, illegal char',LineNumber);
263 j:=16*h(2)+h(3); { pocet polozek } 263 j:=16*h(2)+h(3); { pocet polozek }
264 if j and 1 = 1 then Error('Invalid file format, odd data count',LineNumber); 264 if j and 1 = 1 then Error('Invalid file format, odd data count',LineNumber);
265 if length(s) <> j*2+11 then Error('Invalid file format, line length',LineNumber); 265 if length(s) <> j*2+11 then Error('Invalid file format, line length',LineNumber);
266 j:=j div 2; 266 j:=j div 2;
267 {-- kontrola kontrolniho souctu HEX --} 267 {-- kontrola kontrolniho souctu HEX --}
268 suma:=0; 268 suma:=0;
269 for i:=0 to 2*j+5-1 do 269 for i:=0 to 2*j+5-1 do
270 begin {$R-} suma:=suma+h(2+i*2)*16+h(3+i*2); 270 begin {$R-} suma:=suma+h(2+i*2)*16+h(3+i*2);
271 {$R+} 271 {$R+}
272 end; 272 end;
273 if suma<>0 then Error('CheckSum Error',LineNumber); 273 if suma<>0 then Error('CheckSum Error',LineNumber);
274 {-- Nacteni dat --} 274 {-- Nacteni dat --}
275 adr:=(( h(4) *16 + h(5)) *16 + h(6)) *16 + h(7); 275 adr:=(( h(4) *16 + h(5)) *16 + h(6)) *16 + h(7);
276 if adr and 1 = 1 then Error('Invalid file format, odd addres',LineNumber); 276 if adr and 1 = 1 then Error('Invalid file format, odd addres',LineNumber);
277 adr:=adr shr 1; 277 adr:=adr shr 1;
278 if (s[8]<>'0') or (s[9]<>'0') then exit; 278 if (s[8]<>'0') or (s[9]<>'0') then exit;
279 for i:=0 to j-1 do 279 for i:=0 to j-1 do
280 begin dat:=( ( h(4*i+12) *16 + h(4*i+13)) *16 280 begin dat:=( ( h(4*i+12) *16 + h(4*i+13)) *16
281 + h(4*i+10)) *16 + h(4*i+11) ; 281 + h(4*i+10)) *16 + h(4*i+11) ;
282 if Data.Store(adr,dat) 282 if Data.Store(adr,dat)
283 then Error('Bad Address',LineNumber); 283 then Error('Bad Address',LineNumber);
284 inc(adr); 284 inc(adr);
285 end; 285 end;
286 end; {_LineIn_HEX_} 286 end; {_LineIn_HEX_}
287   287  
288 procedure PicDataIo_t.Import( Name:string; Format:IO_t); 288 procedure PicDataIo_t.Import( Name:string; Format:IO_t);
289 {== Vstup dat ze souboru do datoveho objektu ==} 289 {== Vstup dat ze souboru do datoveho objektu ==}
290 var f:text; 290 var f:text;
291 s:string; 291 s:string;
292 LineNumber:integer; 292 LineNumber:integer;
293 begin name:=UpStr(name); 293 begin name:=UpStr(name);
294 writeln('Importing data from file: ',name); 294 writeln('Importing data from file: ',name);
295 assign(f,name); 295 assign(f,name);
296 {$I-} 296 {$I-}
297 reset(f); 297 reset(f);
298 {$I+} 298 {$I+}
299 if ioresult<>0 then Error('Unable open file: '+name,0); 299 if ioresult<>0 then Error('Unable open file: '+name,0);
300 {$I-} 300 {$I-}
301 LineNumber:=0; 301 LineNumber:=0;
302 repeat inc(LineNumber); { pocitani cisla radky pro pripad chyby } 302 repeat inc(LineNumber); { pocitani cisla radky pro pripad chyby }
303 readln(f,s); 303 readln(f,s);
304 s:=UpStr(s); 304 s:=UpStr(s);
305 case Format of 305 case Format of
306 _TXT_ : _LineIn_TXT_(s,self,LineNumber); 306 _TXT_ : _LineIn_TXT_(s,self,LineNumber);
307 _HEX_ : _LineIn_HEX_(s,self,LineNumber); 307 _HEX_ : _LineIn_HEX_(s,self,LineNumber);
308 end; {case} 308 end; {case}
309 until eof(f); 309 until eof(f);
310 close(f); 310 close(f);
311 {$I+} 311 {$I+}
312 if ioresult<>0 then Error('Unable read from file: '+name,LineNumber); 312 if ioresult<>0 then Error('Unable read from file: '+name,LineNumber);
313 { pro testovani importu } 313 { pro testovani importu }
314 { Export('a.a',_TXT_,';Test of Import procedure'); } 314 { Export('a.a',_TXT_,';Test of Import procedure'); }
315 end; {Import} 315 end; {Import}
316   316  
317 begin 317 begin
318 end. 318 end.