/packages/amunits/src/otherlibs/zlib.pas
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