Patch title: Release 92 bulk changes
Abstract:
File: /util/encoding/pack4.pli
Key:
    Removed line
    Added line
# a very efficient and fast compression method for encoding text + image
# at very high resolution (such as 2400 dpi)

module "/pliant/language/unsafe.pli"


constant FALSE (cast false CBool)
constant TRUE (cast true CBool)

function memory_equal adr1 adr2 size -> c
  arg Address adr1 adr2 ; arg Int size ; arg CBool c
  var Address a1 := adr1 ; var Address a2 := adr2
  var Int remain := size
  while remain>=Int:size
    if (a1 map Int)<>(a2 map Int)
      return FALSE
    a1 := a1 translate Int 1 ; a2 := a2 translate Int 1 ; remain -= Int size
  while remain>0
    if (a1 map Int8)<>(a2 map Int8)
      return FALSE
    a1 := a1 translate Int8 1 ; a2 := a2 translate Int8 1 ; remain -= 1
  c := TRUE

function memory_search_difference adr1 adr2 size -> offset
  arg Address adr1 adr2 ; arg Int size ; arg Int offset
  var Address a1 := adr1 ; var Address a2 := adr2
  var Int remain := size
  while remain>=Int:size and (a1 map Int)=(a2 map Int)
    a1 := a1 translate Int 1 ; a2 := a2 translate Int 1 ; remain -= Int size
  while remain>0 and (a1 map Int8)=(a2 map Int8)
    a1 := a1 translate Int8 1 ; a2 := a2 translate Int8 1 ; remain -= 1
  offset := size-remain


function read_int ptr flag count
  arg_rw Address ptr ; arg_w Int flag count
  var Int i := ptr map uInt8 ; ptr := ptr translate uInt8 1
  flag := i .and. 192
  i := i .and. 63
  if i=0
    count := ptr map uInt16 ; ptr := ptr translate uInt16 1
    if count=0
      count := ptr map uInt32 ; ptr := ptr translate uInt32 1
  else
    count := i

function write_int flag count ptr
  arg Int flag count ; arg_rw Address ptr
  if count<64
    ptr map uInt8 := flag+count ; ptr := ptr translate uInt8 1
  else
    ptr map uInt8 := flag ; ptr := ptr translate uInt8 1
    if count<2^16
      ptr map uInt16 := count ; ptr := ptr translate uInt16 1
    else
      ptr map uInt16 := 0 ; ptr := ptr translate uInt16 1
      ptr map uInt32 := count ; ptr := ptr translate uInt32 1


# 00xxxxxx n diffent (n pixels coming next)
# 01xxxxxx n same (1 pixel coming next)
# 10xxxxxx n copy previous (ie copy top)
# 11xxxxxx n alternate

function pack4_encode src dest unit count previous -> csize
  arg Address src dest ; arg Int unit count ; arg Address previous ; arg Int csize
  var Address s := src ; var Address stop := src translate Byte count*unit
  var Address d := dest
  var Int delta := shunt previous<>null (cast previous Int).-.(cast src Int) 0
  var Address alt := null
  while s<>stop
    if delta<>0
      var Int step := memory_search_difference s (s translate Byte delta) (cast stop Int) .-. (cast s Int)
      step \= unit
      if step>0
        # copy previous
        alt := shunt s<>src and not (memory_equal (s translate Byte -unit) s unit) (s translate Byte -unit) alt
        write_int 128 step d
        s := s translate Byte step*unit
    if s<>stop
      var Address new_alt := shunt s<>src and not (memory_equal (s translate Byte -unit) s unit) (s translate Byte -unit) alt
      if alt<>null and (memory_equal s alt unit)
        # copy alt
        s := s translate Byte unit ; var Int step := 1
        while s<>stop and (memory_equal s alt unit)
          s := s translate Byte unit ; step += 1
        write_int 192 step d
      eif { var Address s2 := s translate Byte unit ; s2<>stop and (memory_equal s2 s unit) }
        # n same
        s2 := s2 translate Byte unit ; var Int step := 2
        while s2<>stop and (memory_equal s2 s unit)
          s2 := s2 translate Byte unit ; step += 1
        write_int 64 step d
        memory_copy s d unit ; d := d translate Byte unit
        s := s2
      else
        # n different
        var Address s2 := s translate Byte unit ; var Int step := 1
        while s2<>stop and { var Address s3 := s2 translate Byte unit ; (s3=stop or not (memory_equal s3 s2 unit)) and (delta=0 or not (memory_equal (s2 translate Byte delta) s2 unit)) }
          s2 := s3 ; step += 1
        write_int 0 step d
        step *= unit
        memory_copy s d step ; d := d translate Byte step
        s := s2
      alt := new_alt
  csize := (cast d Int).-.(cast dest Int)


function pack4_decode src dest unit count previous -> csize
  arg Address src dest ; arg Int unit count ; arg Address previous ; arg Int csize
  var Address s := src
  var Address d := dest ; var Address stop := dest translate Byte count*unit
  var Int delta := (cast previous Int) .-. (cast dest Int)
  var Address alt := null
  while d<>stop
    var Address old := d
    read_int s (var Int flag) (var Int step)
    if flag=0
      # n different
      step *= unit
      memory_copy s d step ; s := s translate Byte step ; d := d translate Byte step
    eif flag=64
      # n same
      while step>0
        memory_copy s d unit ; d := d translate Byte unit
        step -= 1
      s := s translate Byte unit
    eif flag=128
      # copy previous
      step *= unit
      memory_copy (d translate Byte delta) d step ; d := d translate Byte step
    else
      # n alternate
      while step>0
        memory_copy alt d unit ; d := d translate Byte unit
        step -= 1
    if old<>dest and not (memory_equal (old translate Byte -unit) old unit)
      alt := old translate Byte -unit
  csize := (cast s Int).-.(cast src Int)


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


function pack4_plan_encode src dest unit count previous -> csize
  arg Address src dest ; arg Int unit count ; arg Address previous ; arg Int csize
  var Address s := src ; var Address stop := src translate Byte count*unit
  var Address d := dest
  var Int delta := shunt previous<>null (cast previous Int).-.(cast src Int) 0
  var Address alt := null
  while s<>stop
    if delta<>0
      var Int value := s map uInt8
      var Address new_alt := shunt s<>src and (s map uInt8 -unit)<>value (s translate Byte -unit) alt
      var Int step := 0
      while s<>stop and (s map uInt8 delta)=value
        s := s translate Byte unit ; step += 1
      if step>0
        # copy previous
        write_int 128 step d
        alt := new_alt
    if s<>stop
      var Int value := s map uInt8
      var Address new_alt := shunt s<>src and (s map uInt8 -unit)<>value (s translate Byte -unit) alt
      if alt<>null and (alt map uInt8)=value
        # copy alt
        s := s translate Byte unit ; var Int step := 1
        while s<>stop and (s map uInt8)=(alt map uInt8)
          s := s translate Byte unit ; step += 1
        write_int 192 step d
      eif { var Address s2 := s translate Byte unit ; s2<>stop and (s2 map uInt8)=value }
        # n same
        s := s2 translate Byte unit ; var Int step := 2
        while s<>stop and (s map uInt8)=value
          s := s translate Byte unit ; step += 1
        write_int 64 step d
        d map uInt8 := value ; d := d translate uInt8
      else
        # n different
        var Address s2 := s translate Byte unit ; var Int step := 1
        while s2<>stop and { var Address s3 := s2 translate Byte unit ; (s3=stop or (s3 map uInt8)<>(s2 map uInt8)) and (delta=0 or (s2 map uInt8 delta)<>(s2 map uInt8)) }
          s2 := s3 ; step += 1
        write_int 0 step d
        while s<>s2
          d map uInt8 := s map uInt8 ; s := s translate Byte unit ; d := d translate Byte 1
      alt := new_alt
  csize := (cast d Int).-.(cast dest Int)

function pack4_plans_encode src dest unit count previous -> csize
  arg Address src dest ; arg Int unit count ; arg Address previous ; arg Int csize
  csize := 0
  for (var Int p) 0 unit-1
    csize += pack4_plan_encode (src translate Byte p) (dest translate Byte csize) unit count previous


function pack4_plan_decode src dest unit count -> csize
  arg Address src dest ; arg Int unit count ; arg Int csize
function bytes_copy src src_step dest dest_step count
  arg Address src dest ; arg Int src_step dest_step count
  var Address s := src
  var Address stop := src translate Byte src_step*count
  var Address d := dest
  while s<>stop
    d map uInt8 := s map uInt8
    s := s translate Byte src_step
    d := d translate Byte dest_step

function pack4_plan_decode src dest unit count previous -> csize
  arg Address src dest ; arg Int unit count ; arg Address previous ; arg Int csize
  var Address s := src
  var Address d := dest ; var Address stop := dest translate Byte count*unit
  var Int delta := shunt previous<>null (cast previous Int).-.(cast src Int) 0
  var Address alt := null
  while d<>stop
    var Address old := d
    read_int s (var Int flag) (var Int step)
    if flag=0
      # n different
      while step>0
        d map uInt8 := s map uInt8 ; s := s translate Byte 1 ; d := d translate Byte unit
        step -= 1
    eif flag=64
      # n same
      var Int value := s map uInt8 ; s := s translate Byte 1
      while step>0
        d map uInt8 := value ; d := d translate Byte unit
        step -= 1
    eif flag=128
      # copy previous
      if delta<>0
        bytes_copy (d translate Byte delta) unit d unit step
      d := d translate Byte step*unit
    else
      # n alternate
      var Int value := alt map uInt8
      while step>0
        d map uInt8 := value ; d := d translate Byte unit
        step -= 1
    if old<>dest and (old map uInt8 -unit)<>(old map uInt8)
      alt := old translate Byte -unit
  csize := (cast s Int).-.(cast src Int)

function pack4_plan_decode src dest unit count -> csize
  arg Address src dest ; arg Int unit count ; arg Int csize
  csize := pack4_plan_decode src dest unit count null

function pack4_plans_decode src dest unit count previous -> csize
  arg Address src dest ; arg Int unit count ; arg Address previous ; arg Int csize
  if previous<>null
    memory_copy previous dest count*unit
  csize := 0
  for (var Int p) 0 unit-1
    csize += pack4_plan_decode (src translate Byte csize) (dest translate Byte p) unit count


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


export pack4_encode pack4_decode
export pack4_plan_encode pack4_plan_decode
export pack4_plans_encode pack4_plans_decode