PageRenderTime 14ms CodeModel.GetById 12ms app.highlight 1ms RepoModel.GetById 0ms app.codeStats 0ms

/packages/amunits/src/otherlibs/zlib.pas

https://github.com/slibre/freepascal
Pascal | 311 lines | 216 code | 40 blank | 55 comment | 6 complexity | 29e97e367006516fe35e031f9115dc85 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{
  2  This file is part of the Free Pascal run time library.
  3
  4  A file in Amiga system run time library.
  5  Copyright (c) 2003 by Nils Sj�holm.
  6  member of the Amiga RTL development team.
  7
  8  This is a unit for zlib.library
  9
 10  See the file COPYING.FPC, included in this distribution,
 11  for details about the copyright.
 12
 13  This program is distributed in the hope that it will be useful,
 14  but WITHOUT ANY WARRANTY; without even the implied warranty of
 15  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 16
 17**********************************************************************}
 18{
 19  History:
 20
 21  First version of this unit.
 22  17 Jan 2003.
 23
 24  Changed cardinal > longword.
 25  Changed startcode for unit.
 26  12 Feb 2003.
 27
 28  nils.sjoholm@mailbox.swipnet.se
 29}
 30
 31
 32{$I useamigasmartlink.inc}
 33{$ifdef use_amiga_smartlink}
 34   {$smartlink on}
 35{$endif use_amiga_smartlink}
 36
 37UNIT ZLIB;
 38
 39INTERFACE
 40USES Exec;
 41
 42VAR ZLibBase : pLibrary;
 43
 44const
 45    ZLIBNAME : PChar = 'zlib.library';
 46
 47  { Version 1.0  }
 48  { Compression strategy  }
 49     GZ_STRATEGY_DEFAULT = 0;
 50     GZ_STRATEGY_FILTERED = 1;
 51     GZ_STRATEGY_HUFFMAN = 2;
 52  { some often used compression levels  }
 53     GZ_COMPRESS_NO = 0;
 54     GZ_COMPRESS_FASTEST = 1;
 55     GZ_COMPRESS_DEFAULT = 6;
 56     GZ_COMPRESS_BEST = 9;
 57
 58
 59FUNCTION GZ_Close(handle : POINTER) : LONGINT;
 60FUNCTION GZ_CompressMem(srcbuf : POINTER; srclen : longword; destbuf : POINTER; destlen : longword; strategy : longword; level : longword; VAR poutlen : longword) : LONGINT;
 61FUNCTION GZ_DecompressMem(srcbuf : POINTER; srclen : longword; destbuf : POINTER; destlen : longword) : LONGINT;
 62FUNCTION GZ_FGetC(handle : POINTER) : pLONGINT;
 63FUNCTION GZ_FGetS(handle : POINTER; buf : pCHAR; len : longword) : pCHAR;
 64FUNCTION GZ_FileLength(handle : POINTER) : longword;
 65FUNCTION GZ_Open(filename : pCHAR; openmode : longword; strategy : longword; level : longword) : POINTER;
 66FUNCTION GZ_OpenFromFH(fh : LONGINT; openmode : longword; strategy : longword; level : longword) : POINTER;
 67FUNCTION GZ_Read(handle : POINTER; buf : POINTER; len : longword) : LONGINT;
 68FUNCTION GZ_Write(handle : POINTER; buf : POINTER; len : longword) : LONGINT;
 69
 70{You can remove this include and use a define instead}
 71{$I useautoopenlib.inc}
 72{$ifdef use_init_openlib}
 73procedure InitZLIBLibrary;
 74{$endif use_init_openlib}
 75
 76{This is a variable that knows how the unit is compiled}
 77var
 78    ZLIBIsCompiledHow : longint;
 79
 80IMPLEMENTATION
 81
 82{$ifndef dont_use_openlib}
 83uses msgbox;
 84{$endif dont_use_openlib}
 85
 86FUNCTION GZ_Close(handle : POINTER) : LONGINT;
 87BEGIN
 88  ASM
 89        MOVE.L  A6,-(A7)
 90        MOVEA.L handle,A0
 91        MOVEA.L ZLibBase,A6
 92        JSR     -042(A6)
 93        MOVEA.L (A7)+,A6
 94        MOVE.L  D0,@RESULT
 95  END;
 96END;
 97
 98FUNCTION GZ_CompressMem(srcbuf : POINTER; srclen : longword; destbuf : POINTER; destlen : longword; strategy : longword; level : longword; VAR poutlen : longword) : LONGINT;
 99BEGIN
100  ASM
101        MOVE.L  A6,-(A7)
102        MOVEA.L srcbuf,A0
103        MOVE.L  srclen,D0
104        MOVEA.L destbuf,A1
105        MOVE.L  destlen,D1
106        MOVE.L  strategy,D2
107        MOVE.L  level,D3
108        MOVEA.L poutlen,A2
109        MOVEA.L ZLibBase,A6
110        JSR     -114(A6)
111        MOVEA.L (A7)+,A6
112        MOVE.L  D0,@RESULT
113  END;
114END;
115
116FUNCTION GZ_DecompressMem(srcbuf : POINTER; srclen : longword; destbuf : POINTER; destlen : longword) : LONGINT;
117BEGIN
118  ASM
119        MOVE.L  A6,-(A7)
120        MOVEA.L srcbuf,A0
121        MOVE.L  srclen,D0
122        MOVEA.L destbuf,A1
123        MOVE.L  destlen,D1
124        MOVEA.L ZLibBase,A6
125        JSR     -120(A6)
126        MOVEA.L (A7)+,A6
127        MOVE.L  D0,@RESULT
128  END;
129END;
130
131FUNCTION GZ_FGetC(handle : POINTER) : pLONGINT;
132BEGIN
133  ASM
134        MOVE.L  A6,-(A7)
135        MOVEA.L handle,A0
136        MOVEA.L ZLibBase,A6
137        JSR     -060(A6)
138        MOVEA.L (A7)+,A6
139        MOVE.L  D0,@RESULT
140  END;
141END;
142
143FUNCTION GZ_FGetS(handle : POINTER; buf : pCHAR; len : longword) : pCHAR;
144BEGIN
145  ASM
146        MOVE.L  A6,-(A7)
147        MOVEA.L handle,A0
148        MOVEA.L buf,A1
149        MOVE.L  len,D0
150        MOVEA.L ZLibBase,A6
151        JSR     -054(A6)
152        MOVEA.L (A7)+,A6
153        MOVE.L  D0,@RESULT
154  END;
155END;
156
157FUNCTION GZ_FileLength(handle : POINTER) : longword;
158BEGIN
159  ASM
160        MOVE.L  A6,-(A7)
161        MOVEA.L handle,A0
162        MOVEA.L ZLibBase,A6
163        JSR     -138(A6)
164        MOVEA.L (A7)+,A6
165        MOVE.L  D0,@RESULT
166  END;
167END;
168
169FUNCTION GZ_Open(filename : pCHAR; openmode : longword; strategy : longword; level : longword) : POINTER;
170BEGIN
171  ASM
172        MOVE.L  A6,-(A7)
173        MOVEA.L filename,A0
174        MOVE.L  openmode,D0
175        MOVE.L  strategy,D1
176        MOVE.L  level,D2
177        MOVEA.L ZLibBase,A6
178        JSR     -030(A6)
179        MOVEA.L (A7)+,A6
180        MOVE.L  D0,@RESULT
181  END;
182END;
183
184FUNCTION GZ_OpenFromFH(fh : LONGINT; openmode : longword; strategy : longword; level : longword) : POINTER;
185BEGIN
186  ASM
187        MOVE.L  A6,-(A7)
188        MOVEA.L fh,A0
189        MOVE.L  openmode,D0
190        MOVE.L  strategy,D1
191        MOVE.L  level,D2
192        MOVEA.L ZLibBase,A6
193        JSR     -036(A6)
194        MOVEA.L (A7)+,A6
195        MOVE.L  D0,@RESULT
196  END;
197END;
198
199FUNCTION GZ_Read(handle : POINTER; buf : POINTER; len : longword) : LONGINT;
200BEGIN
201  ASM
202        MOVE.L  A6,-(A7)
203        MOVEA.L handle,A0
204        MOVEA.L buf,A1
205        MOVE.L  len,D0
206        MOVEA.L ZLibBase,A6
207        JSR     -048(A6)
208        MOVEA.L (A7)+,A6
209        MOVE.L  D0,@RESULT
210  END;
211END;
212
213FUNCTION GZ_Write(handle : POINTER; buf : POINTER; len : longword) : LONGINT;
214BEGIN
215  ASM
216        MOVE.L  A6,-(A7)
217        MOVEA.L handle,A0
218        MOVEA.L buf,A1
219        MOVE.L  len,D0
220        MOVEA.L ZLibBase,A6
221        JSR     -066(A6)
222        MOVEA.L (A7)+,A6
223        MOVE.L  D0,@RESULT
224  END;
225END;
226
227const
228    { Change VERSION and LIBVERSION to proper values }
229
230    VERSION : string[2] = '0';
231    LIBVERSION : longword = 0;
232
233{$ifdef use_init_openlib}
234  {$Info Compiling initopening of zlib.library}
235  {$Info don't forget to use InitZLIBLibrary in the beginning of your program}
236
237var
238    zlib_exit : Pointer;
239
240procedure ClosezlibLibrary;
241begin
242    ExitProc := zlib_exit;
243    if ZLibBase <> nil then begin
244        CloseLibrary(ZLibBase);
245        ZLibBase := nil;
246    end;
247end;
248
249procedure InitZLIBLibrary;
250begin
251    ZLibBase := nil;
252    ZLibBase := OpenLibrary(ZLIBNAME,LIBVERSION);
253    if ZLibBase <> nil then begin
254        zlib_exit := ExitProc;
255        ExitProc := @ClosezlibLibrary;
256    end else begin
257        MessageBox('FPC Pascal Error',
258        'Can''t open zlib.library version ' + VERSION + #10 +
259        'Deallocating resources and closing down',
260        'Oops');
261        halt(20);
262    end;
263end;
264
265begin
266    ZLIBIsCompiledHow := 2;
267{$endif use_init_openlib}
268
269{$ifdef use_auto_openlib}
270  {$Info Compiling autoopening of zlib.library}
271
272var
273    zlib_exit : Pointer;
274
275procedure ClosezlibLibrary;
276begin
277    ExitProc := zlib_exit;
278    if ZLibBase <> nil then begin
279        CloseLibrary(ZLibBase);
280        ZLibBase := nil;
281    end;
282end;
283
284begin
285    ZLibBase := nil;
286    ZLibBase := OpenLibrary(ZLIBNAME,LIBVERSION);
287    if ZLibBase <> nil then begin
288        zlib_exit := ExitProc;
289        ExitProc := @ClosezlibLibrary;
290        ZLIBIsCompiledHow := 1;
291    end else begin
292        MessageBox('FPC Pascal Error',
293        'Can''t open zlib.library version ' + VERSION + #10 +
294        'Deallocating resources and closing down',
295        'Oops');
296        halt(20);
297    end;
298
299{$endif use_auto_openlib}
300
301{$ifdef dont_use_openlib}
302begin
303    ZLIBIsCompiledHow := 3;
304   {$Warning No autoopening of zlib.library compiled}
305   {$Warning Make sure you open zlib.library yourself}
306{$endif dont_use_openlib}
307
308END. (* UNIT ZLIB *)
309
310
311