Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/vfilter/ccitt.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/multi.pli"

gvar Array:Int white black

function init
  white size := 2^14
  black size := 2^14
  for (var Int i) 0 2^14-1
    white i := undefined
    black i := undefined
init

white 100110101b := 0
white 1000111b := 1
white 10111b := 2
white 11000b := 3
white 11011b := 4
white 11100b := 5
white 11110b := 6
white 11111b := 7
white 110011b := 8
white 110100b := 9
white 100111b := 10
white 101000b := 11
white 1001000b := 12
white 1000011b := 13
white 1110100b := 14
white 1110101b := 15
white 1101010b := 16
white 1101011b := 17
white 10100111b := 18
white 10001100b := 19
white 10001000b := 20
white 10010111b := 21
white 10000011b := 22
white 10000100b := 23
white 10101000b := 24
white 10101011b := 25
white 10010011b := 26
white 10100100b := 27
white 10011000b := 28
white 100000010b := 29
white 100000011b := 30
white 100011010b := 31
white 100011011b := 32
white 100010010b := 33
white 100010011b := 34
white 100010100b := 35
white 100010101b := 36
white 100010110b := 37
white 100010111b := 38
white 100101000b := 39
white 100101001b := 40
white 100101010b := 41
white 100101011b := 42
white 100101100b := 43
white 100101101b := 44
white 100000100b := 45
white 100000101b := 46
white 100001010b := 47
white 100001011b := 48
white 101010010b := 49
white 101010011b := 50
white 101010100b := 51
white 101010101b := 52
white 100100100b := 53
white 100100101b := 54
white 101011000b := 55
white 101011001b := 56
white 101011010b := 57
white 101011011b := 58
white 101001010b := 9
white 101001011b := 60
white 100110010b := 61
white 100110011b := 62
white 100110100b := 63
white 111011b := 64
white 110010b := 128
white 1010111b := 192
white 10110111b := 256
white 100110110b := 320
white 100110111b := 384
white 101100100b := 448
white 101100101b := 512
white 101101000b := 576
white 101100111b := 640
white 1011001100b := 704
white 1011001101b := 768
white 1011010010b := 832
white 1011010011b := 896
white 1011010100b := 960
white 1011010101b := 1024
white 1011010110b := 1088
white 1011010111b := 1152
white 1011011000b := 1216
white 1011011001b := 1280
white 1011011010b := 1344
white 1011011011b := 1408
white 1010011000b := 1472
white 1010011001b := 1536
white 1010011010b := 1600
white 1011000b := 1664
white 1010011011b := 1728
white 100000001000b := 1792
white 100000001100b := 1856
white 100000001101b := 1920
white 1000000010010b := 1984
white 1000000010011b := 2048
white 1000000010100b := 2112
white 1000000010101b := 2176
white 1000000010110b := 2240
white 1000000010111b := 2304
white 1000000011100b := 2368
white 1000000011101b := 2432
white 1000000011110b := 2496
white 1000000011111b := 2560
white 1000000000001b := -1
white 1000000000000b := -2


black 10000110111b := 0
black 1010b := 1
black 111b := 2
black 110b := 3
black 1011b := 4
black 10011b := 5
black 10010b := 6
black 100011b := 7
black 1000101b := 8
black 1000100b := 9
black 10000100b := 10
black 10000101b := 11
black 10000111b := 12
black 100000100b := 13
black 100000111b := 14
black 1000011000b := 15
black 10000010111b := 16
black 10000011000b := 17
black 10000001000b := 18
black 100001100111b := 19
black 100001101000b := 20
black 100001101100b := 21
black 100000110111b := 22
black 100000101000b := 23
black 100000010111b := 24
black 100000011000b := 25
black 1000011001010b := 26
black 1000011001011b := 27
black 1000011001100b := 28
black 1000011001101b := 29
black 1000001101000b := 30
black 1000001101001b := 31
black 1000001101010b := 32
black 1000001101011b := 33
black 1000011010010b := 34
black 1000011010011b := 35
black 1000011010100b := 36
black 1000011010101b := 37
black 1000011010110b := 38
black 1000011010111b := 39
black 1000001101100b := 40
black 1000001101101b := 41
black 1000011011010b := 42
black 1000011011011b := 43
black 1000001010100b := 44
black 1000001010101b := 45
black 1000001010110b := 46
black 1000001010111b := 47
black 1000001100100b := 48
black 1000001100101b := 49
black 1000001010010b := 50
black 1000001010011b := 51
black 1000000100100b := 52
black 1000000110111b := 53
black 1000000111000b := 54
black 1000000100111b := 55
black 1000000101000b := 56
black 1000001011000b := 57
black 1000001011001b := 58
black 1000000101011b := 59
black 1000000101100b := 60
black 1000001011010b := 61
black 1000001100110b := 62
black 1000001100111b := 63
black 10000001111b := 64
black 1000011001000b := 128
black 1000011001001b := 192
black 1000001011011b := 256
black 1000000110011b := 320
black 1000000110100b := 384
black 1000000110101b := 448
black 10000001101100b := 512
black 10000001101101b := 576
black 10000001001010b := 640
black 10000001001011b := 704
black 10000001001100b := 768
black 10000001001101b := 832
black 10000001110010b := 896
black 10000001110011b := 960
black 10000001110100b := 1024
black 10000001110101b := 1088
black 10000001110110b := 1152
black 10000001110111b := 1216
black 10000001010010b := 1280
black 10000001010011b := 1344
black 10000001010100b := 1408
black 10000001010101b := 1472
black 10000001011010b := 1536
black 10000001011011b := 1600
black 10000001100100b := 1664
black 10000001100101b := 1728
black 100000001000b := 1792
black 100000001100b := 1856
black 100000001101b := 1920
black 1000000010010b := 1984
black 1000000010011b := 2048
black 1000000010100b := 2112
black 1000000010101b := 2176
black 1000000010110b := 2240
black 1000000010111b := 2304
black 1000000011100b := 2368
black 1000000011101b := 2432
black 1000000011110b := 2496
black 1000000011111b := 2560
black 1000000000001b := -1
black 1000000000000b := -2


type CcittStreamDriver
  field Link:Stream s
  field uInt8 ebits ; field uInt emask
  field uInt code ; field CBool use_white
  field uInt8 cbits ; field uInt cmask
  field Int whites blacks
  field Int line column line_size
StreamDriver maybe CcittStreamDriver

method drv read buf mini maxi -> red
  oarg_rw CcittStreamDriver drv ; arg Address buf ; arg Int mini maxi red
  implicit drv
    red := 0
    while red<mini and not s:atend
      if whites>0
        cbits := cbits .and. .not. cmask ; cmask \= 2 ; whites -= 1
        if cmask=0
          buf map uInt8 red := cbits ; red += 1 ; cmask := 128
      eif blacks>0
        cbits := cbits .or. cmask ; cmask \= 2 ; blacks -= 1
        if cmask=0
          buf map uInt8 red := cbits ; red += 1 ; cmask := 128
      else
        if emask=0
          drv:s raw_read addressof:ebits 1
          # console "encoded read " (cast ebits Int) eol
          emask := 128
        code *= 2
        if (ebits .and. emask)<>0
          code += 1
        emask \= 2
        if use_white
          if code>=constant:(cast white:size uInt)
            console "CCITT group 3 encoding error " ((string code "radix 2") 1 99) " at line " line " column " column " file offset " (drv:s query "seek") eol
            return 0
          eif white:code<>undefined
            # console "white code " ((string code "radix 2") 1 99) " -> " white:code " " column+white:code "/" line_size eol
            if white:code>=0
              whites := white code
              column += whites
              if white:code<64
                use_white := false
            else
              if black:code=(-1)
                if column<>line_size
                  console "line " line " -> " column eol
                column := 0 ; line += 1
            code := 1
        else
          if code>=constant:(cast black:size uInt)
            console "CCITT group 3 encoding error " ((string code "radix 2") 1 99) " at line " line " column " column " file offset " (drv:s query "seek") eol
            return 0
          eif black:code<>undefined
            # console "black code " ((string code "radix 2") 1 99) " -> " black:code " " column+black:code "/" line_size eol
            if black:code>=0
              blacks := black code
              column += blacks
              if black:code<64
                use_white := true
            else
              if black:code=(-1)
                if column<>line_size
                  console "line " line " -> " column eol
                column := 0 ; line += 1
                use_white := true
            code := 1


method drv query command stream answer -> status
  oarg_rw CcittStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status 
  status := drv:s:stream_driver query command drv:s answer

method drv close -> status
  arg_rw CcittStreamDriver drv ; arg ExtendedStatus status
  console "close at " drv:line " " drv:column eol
  status := success

type CcittFileSystem
  void
FileSystem maybe CcittFileSystem

method fs open name options flags stream support -> status
  oarg_rw CcittFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  var Link:CcittStreamDriver drv :> new CcittStreamDriver
  if exists:support
    drv s :> support
  else
    drv s :> new Stream
    drv:s open name options (flags .and. in+out+append+safe)
    if drv:s=failure
      return failure
  drv emask := 0
  drv code := 1
  drv use_white := true
  drv cmask := 128
  drv whites := 0
  drv blacks := 0
  drv line := 0 ; drv column := 0
  drv line_size := options option "line_size" Int undefined
  stream stream_driver :> drv
  status := success

gvar CcittFileSystem ccitt_file_system
pliant_multi_file_system mount "ccitt:" "" ccitt_file_system