Patch title: Release 92 bulk changes
Abstract:
File: /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 


# 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 


if undocumented

  type ZipHeader
    field uInt32_li signature # 0
    field uInt16_li version # 4
    field uInt16_li flags # 6
    field uInt16_li compression # 8
    field uInt16_li time # 10
    field uInt16_li date # 12
    field uInt32_li crc # 14
    field uInt32_li compressed_size # 18
    field uInt32_li clear_size # 22
    field uInt16_li name_length # 26
    field uInt16_li extra_length # 28

  type ZipTail
    field uInt32_li signature # 0
    field uInt32_li crc # 4
    field uInt32_li compressed_size # 8
    field uInt32_li uncompressed_size # 12


#-----------------------------------------------------------


type CompressZlibStreamDriver
  field Link:Stream s
  field z_stream_s w
  field z_stream_s r
  field Int flags
  if undocumented
    field CBool gzip
#-----------------------------------------------------------


type CompressZlibStreamDriver
  field Link:Stream s
  field z_stream_s w
  field z_stream_s r
  field Int flags
  if undocumented
    field CBool gzip
    field CBool zip
    field CBool deflate
    field uInt w_crc w_size
    field uInt r_crc r_size
    field CBool deflate
    field uInt w_crc w_size
    field uInt r_crc r_size
    field Int zip_flags <- 0
    field Str name
    field DateTime datetime
StreamDriver maybe CompressZlibStreamDriver


method drv read buf mini maxi -> red
  oarg_rw CompressZlibStreamDriver drv ; arg Address buf ; a
StreamDriver maybe CompressZlibStreamDriver


method drv read buf mini maxi -> red
  oarg_rw CompressZlibStreamDriver drv ; arg Address buf ; a
  if undocumented and (drv:zip_flags .and. 2^16)<>0
    return 0
  drv:r next_out := buf
  drv:r avail_out := maxi
  part inflate
    while maxi-drv:r:avail_out<mini
      if drv:s:atend
        drv:r next_in := null
        drv:r avail_in := 0
        var Int old_avail_out := drv:r:avail_out
        inflate drv:r 4 # Z_FINISH
        if drv:r:avail_out=old_avail_out
          leave inflate
      else
        drv:r next_in := drv:s:stream_read_cur
        drv:r avail_in := (cast drv:s:stream_read_stop Int)-
        var Int old_avail_in := drv:r:avail_in ; var Int old
        inflate drv:r 0
        drv:s stream_read_cur := drv:r:next_in
        if drv:r:avail_in=old_avail_in and drv:r:avail_out=o
          leave inflate
  red := maxi-drv:r:avail_out
  if undocumented and drv:gzip
    drv r_crc := crc32_update drv:r_crc buf red
    drv r_size += red



method drv close -> status
  oarg_rw CompressZlibStreamDriver drv ; arg ExtendedStatus 
  status := success
  if (drv:flags .and. in)<>0
  drv:r next_out := buf
  drv:r avail_out := maxi
  part inflate
    while maxi-drv:r:avail_out<mini
      if drv:s:atend
        drv:r next_in := null
        drv:r avail_in := 0
        var Int old_avail_out := drv:r:avail_out
        inflate drv:r 4 # Z_FINISH
        if drv:r:avail_out=old_avail_out
          leave inflate
      else
        drv:r next_in := drv:s:stream_read_cur
        drv:r avail_in := (cast drv:s:stream_read_stop Int)-
        var Int old_avail_in := drv:r:avail_in ; var Int old
        inflate drv:r 0
        drv:s stream_read_cur := drv:r:next_in
        if drv:r:avail_in=old_avail_in and drv:r:avail_out=o
          leave inflate
  red := maxi-drv:r:avail_out
  if undocumented and drv:gzip
    drv r_crc := crc32_update drv:r_crc buf red
    drv r_size += red



method drv close -> status
  oarg_rw CompressZlibStreamDriver drv ; arg ExtendedStatus 
  status := success
  if (drv:flags .and. in)<>0
    if (inflateEnd drv:r)<>0
      status := failure
    if not undocumented or (drv:zip_flags .and. 2^16)=0
      if (inflateEnd drv:r)<>0
        status := failure
    if undocumented and drv:gzip
      drv:s raw_read addressof:(var uInt32 crc) uInt32:size
      drv:s raw_read addressof:(var uInt32 isize) uInt32:siz
      if isize%2n^32<>drv:r_size%2n^32 or crc<>drv:r_crc
        status := failure
    if undocumented and drv:gzip
      drv:s raw_read addressof:(var uInt32 crc) uInt32:size
      drv:s raw_read addressof:(var uInt32 isize) uInt32:siz
      if isize%2n^32<>drv:r_size%2n^32 or crc<>drv:r_crc
        status := failure
    if undocumented and drv:zip and (drv:zip_flags .and. 8)<>0
      drv:s raw_read addressof:(var ZipTail tail) ZipTail:size
  if (drv:flags .and. out)<>0
    if (deflateEnd drv:w)<>0
      status := failure
    if undocumented and drv:gzip
      var uInt32 crc := drv w_crc ; drv:s raw_write addresso
      var uInt32 isize := drv w_size; drv:s raw_write addres


method drv query command stream answer -> status
  oarg_rw CompressZlibStreamDriver drv ; arg Str command ; a
  if command="encoding"
    if undocumented
  if (drv:flags .and. out)<>0
    if (deflateEnd drv:w)<>0
      status := failure
    if undocumented and drv:gzip
      var uInt32 crc := drv w_crc ; drv:s raw_write addresso
      var uInt32 isize := drv w_size; drv:s raw_write addres


method drv query command stream answer -> status
  oarg_rw CompressZlibStreamDriver drv ; arg Str command ; a
  if command="encoding"
    if undocumented
      answer := shunt drv:gzip "gzip" drv:deflate "deflate" 
      answer := shunt drv:gzip "gzip" drv:zip "zip" drv:deflate "deflate" "zlib"
    else
      answer := "zlib"
    status := success
    else
      answer := "zlib"
    status := success
  eif undocumented and command="name"
    answer := drv name
    status := success
  eif undocumented and command="datetime"
    answer := string drv:datetime
    status := success
  else
    status := drv:s:stream_driver query command drv:s answer



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"
  else
    status := drv:s:stream_driver query command drv:s answer



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 CBool zip := options option "zip"
    var CBool deflate := gzip or zip or (options option "deflate")
  var Int level := options option "level" Int
  var Link:Stream s
  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
  var Int level := options option "level" Int
  var Link:Stream s
  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
        return failure:"not a gzip stream"
      if h:cm<>8
      if h:cm<>8
        return failure
        return failure:"no at gzip stream"
      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
      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
    if undocumented and zip
      s raw_read addressof:(var ZipHeader zh) ZipHeader:size
      if zh:signature<>04034B50h
        return failure:"not a zip stream"
      drv zip_flags := zh flags
      if zh:compressed_size=0 and zh:clear_size=0 and (zh:flags .and. 8)=0
        drv zip_flags += 2^16
      drv:name resize zh:name_length
      drv datetime := datetime 1980+zh:date\2^9 zh:date\2^5%2^4 zh:date%2^5 zh:time\2^11 zh:time\2^5%2^6 zh:time%2^5*2 0
      s raw_read drv:name:characters zh:name_length
      for (var Int i) 1 zh:extra_length
        s raw_read addressof:(var Byte drop) 1
    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
    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
      if (drv:zip_flags .and. 2^16)=0
        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
    else
      if (inflateInit drv:r)<>0
        return failure
  drv s :> s
  drv flags := flags
  if undocumented
    drv gzip := gzip
    drv zip := zip
    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_
    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_
  pliant_multi_file_system mount "zip:" "" "zip" compress_zlib_file_system