/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

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