1 {
2 Copyright (c) 1998-2002 by Peter Vreman
3
4 Contains the base stuff for writing for object files to disk
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ****************************************************************************
21 }
22 unit owbase;
23
24 {$i fpcdefs.inc}
25
26 interface
27 uses
28 cstreams,
29 cclasses;
30
31 type
32 tobjectwriter=class
33 private
34 f : TCCustomFileStream;
35 opened : boolean;
36 buf : pchar;
37 bufidx : longword;
38 procedure writebuf;
39 protected
40 fsize,
41 fobjsize : longword;
42 public
43 constructor create;
44 constructor createAr(const Aarfn:string);virtual;
45 destructor destroy;override;
createfilenull46 function createfile(const fn:string):boolean;virtual;
47 procedure closefile;virtual;
48 procedure writesym(const sym:string);virtual;
49 procedure write(const b;len:longword);virtual;
50 procedure WriteZeros(l:longword);
51 procedure writearray(a:TDynamicArray);
52 property Size:longword read FSize;
53 property ObjSize:longword read FObjSize;
54 end;
55
56 tobjectwriterclass = class of tobjectwriter;
57
58 tobjectreader=class
59 private
60 f : TCCustomFileStream;
61 opened : boolean;
62 buf : pchar;
63 ffilename : string;
64 bufidx,
65 bufmax : longint;
readbufnull66 function readbuf:boolean;
67 protected
getfilenamenull68 function getfilename : string;virtual;
GetPosnull69 function GetPos: longint;virtual;
GetIsArchivenull70 function GetIsArchive: boolean;virtual;
71 public
72 constructor create;
73 constructor createAr(const Aarfn:string;allow_nonar:boolean=false);virtual;
74 destructor destroy;override;
openfilenull75 function openfile(const fn:string):boolean;virtual;
76 procedure closefile;virtual;
77 procedure seek(len:longint);virtual;
readnull78 function read(out b;len:longint):boolean;virtual;
readarraynull79 function readarray(a:TDynamicArray;len:longint):boolean;
80 property filename : string read getfilename;
81 property size:longint read bufmax;
82 property Pos:longint read GetPos;
83 property IsArchive: boolean read GetIsArchive;
84 end;
85
86 tobjectreaderclass = class of tobjectreader;
87
88 implementation
89
90 uses
91 SysUtils,
92 verbose, globals;
93
94 const
95 bufsize = 32768;
96
97
98 {****************************************************************************
99 TObjectWriter
100 ****************************************************************************}
101
102 constructor tobjectwriter.create;
103 begin
104 getmem(buf,bufsize);
105 bufidx:=0;
106 opened:=false;
107 fsize:=0;
108 end;
109
110
111 destructor tobjectwriter.destroy;
112 begin
113 if opened then
114 closefile;
115 freemem(buf,bufsize);
116 end;
117
118 constructor tobjectwriter.createAr(const Aarfn:string);
119 begin
120 InternalError(2015041901);
121 end;
122
123
tobjectwriter.createfilenull124 function tobjectwriter.createfile(const fn:string):boolean;
125 begin
126 createfile:=false;
127 f:=CFileStreamClass.Create(fn,fmCreate);
128 if CStreamError<>0 then
129 begin
130 Message2(exec_e_cant_create_objectfile,fn,IntToStr(CStreamError));
131 exit;
132 end;
133 bufidx:=0;
134 fsize:=0;
135 fobjsize:=0;
136 opened:=true;
137 createfile:=true;
138 end;
139
140
141 procedure tobjectwriter.closefile;
142 var
143 fn : string;
144 begin
145 if bufidx>0 then
146 writebuf;
147 fn:=f.filename;
148 f.free;
149 { Remove if size is 0 }
150 if size=0 then
151 DeleteFile(fn);
152 opened:=false;
153 fsize:=0;
154 fobjsize:=0;
155 end;
156
157
158 procedure tobjectwriter.writebuf;
159 begin
160 f.write(buf^,bufidx);
161 bufidx:=0;
162 end;
163
164
165 procedure tobjectwriter.writesym(const sym:string);
166 begin
167 end;
168
169
170 procedure tobjectwriter.write(const b;len:longword);
171 var
172 p : pchar;
173 bufleft,
174 idx : longword;
175 begin
176 inc(fsize,len);
177 inc(fobjsize,len);
178 p:=pchar(@b);
179 idx:=0;
180 while len>0 do
181 begin
182 bufleft:=bufsize-bufidx;
183 if len>bufleft then
184 begin
185 move(p[idx],buf[bufidx],bufleft);
186 dec(len,bufleft);
187 inc(idx,bufleft);
188 inc(bufidx,bufleft);
189 writebuf;
190 end
191 else
192 begin
193 move(p[idx],buf[bufidx],len);
194 inc(bufidx,len);
195 exit;
196 end;
197 end;
198 end;
199
200
201 procedure tobjectwriter.WriteZeros(l:longword);
202 var
203 empty : array[0..1023] of byte;
204 begin
205 if l>sizeof(empty) then
206 begin
207 fillchar(empty,sizeof(empty),0);
208 while l>sizeof(empty) do
209 begin
210 Write(empty,sizeof(empty));
211 Dec(l,sizeof(empty));
212 end;
213 if l>0 then
214 Write(empty,l);
215 end
216 else if l>0 then
217 begin
218 fillchar(empty,l,0);
219 Write(empty,l);
220 end;
221 end;
222
223
224 procedure tobjectwriter.writearray(a:TDynamicArray);
225 var
226 hp : pdynamicblock;
227 begin
228 hp:=a.firstblock;
229 while assigned(hp) do
230 begin
231 write(hp^.data,hp^.used);
232 hp:=hp^.next;
233 end;
234 end;
235
236
237 {****************************************************************************
238 TObjectReader
239 ****************************************************************************}
240
241 constructor tobjectreader.create;
242 begin
243 buf:=nil;
244 bufidx:=0;
245 bufmax:=0;
246 ffilename:='';
247 opened:=false;
248 end;
249
250
251 destructor tobjectreader.destroy;
252 begin
253 if opened then
254 closefile;
255 end;
256
257
258 constructor tobjectreader.createAr(const Aarfn:string;allow_nonar:boolean=false);
259 begin
260 InternalError(2015081401);
261 end;
262
263
tobjectreader.openfilenull264 function tobjectreader.openfile(const fn:string):boolean;
265 begin
266 openfile:=false;
267 f:=CFileStreamClass.Create(fn,fmOpenRead);
268 if CStreamError<>0 then
269 begin
270 Comment(V_Error,'Can''t open object file: '+fn);
271 exit;
272 end;
273 ffilename:=fn;
274 bufmax:=f.Size;
275 getmem(buf,bufmax);
276 f.read(buf^,bufmax);
277 f.free;
278 bufidx:=0;
279 opened:=true;
280 openfile:=true;
281 end;
282
283
284 procedure tobjectreader.closefile;
285 begin
286 opened:=false;
287 bufidx:=0;
288 bufmax:=0;
289 freemem(buf);
290 end;
291
292
tobjectreader.readbufnull293 function tobjectreader.readbuf:boolean;
294 begin
295 result:=bufidx<bufmax;
296 end;
297
298
299 procedure tobjectreader.seek(len:longint);
300 begin
301 bufidx:=len;
302 end;
303
304
tobjectreader.readnull305 function tobjectreader.read(out b;len:longint):boolean;
306 begin
307 result:=true;
308 if bufidx+len>bufmax then
309 begin
310 result:=false;
311 len:=bufmax-bufidx;
312 end;
313 move(buf[bufidx],b,len);
314 inc(bufidx,len);
315 end;
316
317
tobjectreader.readarraynull318 function tobjectreader.readarray(a:TDynamicArray;len:longint):boolean;
319 begin
320 result:=true;
321 if bufidx+len>bufmax then
322 begin
323 result:=false;
324 len:=bufmax-bufidx;
325 end;
326 a.write(buf[bufidx],len);
327 inc(bufidx,len);
328 end;
329
tobjectreader.getfilenamenull330 function tobjectreader.getfilename : string;
331 begin
332 result:=ffilename;
333 end;
334
tobjectreader.GetPosnull335 function tobjectreader.GetPos: longint;
336 begin
337 Result:=bufidx;
338 end;
339
340
tobjectreader.GetIsArchivenull341 function tobjectreader.GetIsArchive: boolean;
342 begin
343 Result:=false;
344 end;
345
346 end.
347