Patch title: Release 87 bulk changes
Abstract:
File: /pliant/language/stream/zlib.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


method fs open name options flags stream support -> status
  oarg_rw CompressZlibFileSystem fs ; arg Str name options ;
  if undocumented
    var CBool gzip := options option "gzip"
    var CBool deflate := gzip or (options option "deflate")
  var Int level := options option "level" Int
  var Link:Stream s
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


method fs open name options flags stream support -> status
  oarg_rw CompressZlibFileSystem fs ; arg Str name options ;
  if undocumented
    var CBool gzip := options option "gzip"
    var CBool deflate := gzip or (options option "deflate")
  var Int level := options option "level" Int
  var Link:Stream s
  if addressof:support<>null
  if exists:support
    s :> support
  else
    var Link:Stream s :> new Stream
    s open name options (flags .and. in+out+append+safe)
    if s=failure
      return failure
  var Link:CompressZlibStreamDriver drv :> new CompressZlibS
  if (flags .and. out)<>0
    if (options option "header" Str)<>""
      s writeline (options option "header" Str)
      s writeline ""
    if undocumented and gzip
      var GzipHeader h
      h id1 := 1Fh ; h id2 := 8Bh ; h cm := 8 ; h flg := 0 ;
      s raw_write addressof:h GzipHeader:size
      drv w_crc := 0 ; drv w_size := 0
    memory_clear (addressof drv:w) z_stream_s:size
    drv:w data_type := 2
    if pliant_alloc
      drv:w zalloc := (the_function pliant_zalloc Address uI
      drv:w zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (deflateInit2 drv:w (shunt level=defined level -1) 
        return failure
    else
      if (deflateInit drv:w (shunt level=defined level -1))<
        return failure
  if (flags .and. in)<>0
    if (options option "header")
      while s:readline<>""
        void
    if undocumented and gzip
      s raw_read addressof:(var GzipHeader h) GzipHeader:siz
      if h:id1<>1Fh or h:id2<>8Bh
        return failure
      if h:cm<>8
        return failure
      if (h:flg .and. 2^2)<>0 # FEXTRA
        s raw_read addressof:(var uInt16_li xlen) 2
        while xlen>=0 and not s:atend
          s read_available (var Address adr) (var Int size) 
          xlen -= size
      if (h:flg .and. 2^3)<>0 # FNAME
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
      if (h:flg .and. 2^4)<>0 # COMMENT
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
      if (h:flg .and. 2^1)<>0 # FHCRC
        s raw_read addressof:(var uInt16 crc16) 2
      drv r_crc := 0 ; drv r_size := 0
    memory_clear (addressof drv:r) z_stream_s:size
    drv:r data_type := 2
    if pliant_alloc
      drv:r zalloc := (the_function pliant_zalloc Address uI
      drv:r zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (inflateInit2 drv:r (shunt deflate -15 15))<>0
        return failure
    else
      if (inflateInit drv:r)<>0
        return failure
  drv s :> s
  drv flags := flags
  if undocumented
    drv gzip := gzip
    drv deflate := deflate
  stream stream_driver :> drv
  status := success


gvar CompressZlibFileSystem compress_zlib_file_system
pliant_multi_file_system mount "zlib:" "" compress_zlib_file
if undocumented
  pliant_multi_file_system mount "deflate:" "" "deflate" com
  pliant_multi_file_system mount "gzip:" "" "gzip" compress_
    s :> support
  else
    var Link:Stream s :> new Stream
    s open name options (flags .and. in+out+append+safe)
    if s=failure
      return failure
  var Link:CompressZlibStreamDriver drv :> new CompressZlibS
  if (flags .and. out)<>0
    if (options option "header" Str)<>""
      s writeline (options option "header" Str)
      s writeline ""
    if undocumented and gzip
      var GzipHeader h
      h id1 := 1Fh ; h id2 := 8Bh ; h cm := 8 ; h flg := 0 ;
      s raw_write addressof:h GzipHeader:size
      drv w_crc := 0 ; drv w_size := 0
    memory_clear (addressof drv:w) z_stream_s:size
    drv:w data_type := 2
    if pliant_alloc
      drv:w zalloc := (the_function pliant_zalloc Address uI
      drv:w zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (deflateInit2 drv:w (shunt level=defined level -1) 
        return failure
    else
      if (deflateInit drv:w (shunt level=defined level -1))<
        return failure
  if (flags .and. in)<>0
    if (options option "header")
      while s:readline<>""
        void
    if undocumented and gzip
      s raw_read addressof:(var GzipHeader h) GzipHeader:siz
      if h:id1<>1Fh or h:id2<>8Bh
        return failure
      if h:cm<>8
        return failure
      if (h:flg .and. 2^2)<>0 # FEXTRA
        s raw_read addressof:(var uInt16_li xlen) 2
        while xlen>=0 and not s:atend
          s read_available (var Address adr) (var Int size) 
          xlen -= size
      if (h:flg .and. 2^3)<>0 # FNAME
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
      if (h:flg .and. 2^4)<>0 # COMMENT
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
      if (h:flg .and. 2^1)<>0 # FHCRC
        s raw_read addressof:(var uInt16 crc16) 2
      drv r_crc := 0 ; drv r_size := 0
    memory_clear (addressof drv:r) z_stream_s:size
    drv:r data_type := 2
    if pliant_alloc
      drv:r zalloc := (the_function pliant_zalloc Address uI
      drv:r zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (inflateInit2 drv:r (shunt deflate -15 15))<>0
        return failure
    else
      if (inflateInit drv:r)<>0
        return failure
  drv s :> s
  drv flags := flags
  if undocumented
    drv gzip := gzip
    drv deflate := deflate
  stream stream_driver :> drv
  status := success


gvar CompressZlibFileSystem compress_zlib_file_system
pliant_multi_file_system mount "zlib:" "" compress_zlib_file
if undocumented
  pliant_multi_file_system mount "deflate:" "" "deflate" com
  pliant_multi_file_system mount "gzip:" "" "gzip" compress_