Patch title: Release 94 bulk changes
Abstract:
File: /pliant/util/pml/generic.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/type/misc/blob.pli"
module "stream.pli"


gvar Array:Int binary_sizes
gvar (Array Link:Type) binary_types
gvar Array:Str binary_labels

type BinaryError
  void

type BinaryUnknown
  void


function setup_tables
  binary_sizes size := 256
  binary_types size := 256
  binary_labels size := 256
  for (var Int i) 0 128
    binary_types i :> BinaryError
    binary_sizes i := undefined
  for (var Int i) 0 31
    binary_types 128+i :> Int
    binary_sizes 128+i := 1
  for (var Int i) 0 15
    binary_types 160+i :> Str
    binary_sizes 160+i := 1+i
    binary_types 176+i :> Ident
    binary_sizes 176+i := 1+i
  for (var Int i) 0 1
    binary_types 192+i :> Bool
    binary_sizes 192+i := 1
  binary_types 194 :> Int # undefined
  binary_sizes 194 := 1
  binary_types 195 :> Void # padding
  binary_sizes 195 := 1

  binary_types 196 :> BinaryUnknown # close
  binary_sizes 196 := 1
  binary_types 197 :> BinaryUnknown # open
  binary_sizes 197 := 1
  binary_types 198 :> BinaryUnknown # close top level
  binary_sizes 198 := 1
  binary_types 199 :> BinaryUnknown # open top level
  binary_sizes 199 := 1

  binary_types 200 :> BinaryUnknown # speratator
  binary_sizes 200 := 1
  binary_types 201 :> Date
  binary_sizes 201 := 1+Date:size
  binary_types 202 :> Time
  binary_sizes 202 := 1+Time:size
  binary_types 203 :> DateTime
  binary_sizes 203 := 1+Float:size

  binary_types 204 :> Float32
  binary_sizes 204 := 1+Float32:size
  binary_types 205 :> Float
  binary_sizes 205 := 1+Float:size
  binary_types 206 :> BinaryUnknown
  binary_sizes 206 := 1
  binary_types 207 :> BinaryUnknown
  binary_sizes 207 := 1

  for (var Int i) 0 3
    binary_types 208+i :> Int
    binary_sizes 208+i := 1+2^i
    binary_types 212+i :> uInt
    binary_sizes 212+i := 1+2^i
    binary_types 216+i :> BinaryUnknown # number with type as first byte
    binary_sizes 216+i := 2+2^i
    binary_types 220+i :> BinaryUnknown # application
    binary_sizes 220+i := 1+2^i
  for (var Int i) 224 231
    binary_types i :> Intn
    binary_sizes i := undefined
  for (var Int i) 232 235
    binary_types i :> Str
    binary_sizes i := undefined
  for (var Int i) 236 239
    binary_types i :> Ident
    binary_sizes i := undefined
  for (var Int i) 240 243
    binary_types i :> Blob
    binary_sizes i := undefined
  for (var Int i) 244 251
    binary_types i :> BinaryUnknown # string or blob with type as first byte
    binary_sizes i := undefined
  for (var Int i) 252 255
    binary_types i :> BinaryUnknown # application
    binary_sizes i := undefined
  for (var Int i) 0 255
    var Pointer:Type t :> binary_types i 
    binary_labels i := shunt t=BinaryError "error" (t:name parse "Binary" any) "" t:name
  binary_labels 196 := "close"
  binary_labels 197 := "open"
  binary_labels 198 := "close top"
  binary_labels 199 := "open top"
  binary_labels 200 := "separator"
  for (var Int i) 0 3
    binary_labels 206 := "custom"
    binary_labels 207 := "custom"
    binary_labels 220+i := "custom"
    binary_labels 252+i := "custom"
setup_tables


method s ilabel -> l
  arg_rw Stream s ; arg Str l
  l := binary_labels s:pick_uInt8


method s itype -> t
  arg_rw Stream s ; arg_R Type t
  t :> binary_types s:pick_uInt8


method s isize -> size
  arg_rw Stream s ; arg Int size
  var Int h := s pick_uInt8
  if h<224
    size := binary_sizes h
  else
    if processor_is_low_indian
      var Int n := 2^(h .and. 3)
      if Int:size<8 and n>Int:size
        size := undefined
      else
        size := 0
        if (s pick 1 addressof:size n)=failure
          return undefined
        size := size .+. 1+n
        if size<0
          size := undefined
    else
      var Int n := h .and. 3
      if n=0
        if (s pick 1 addressof:(var uInt8 u8) 1)=failure
          return undefined
        size := 1+u8
      eif n=1
        if (s pick 1 addressof:(var uInt16_li u16) 2)=failure
          return undefined
        size := 1+u16
      eif n=2
        if (s pick 1 addressof:(var uInt32_li u32) 4)=failure
          return undefined
        size := 1 .+. u32
        if Int:size<8 and size<0
          size := undefined
      else
        size := undefined
    

method s iforward -> status
  arg_rw Stream s ; arg Status status
  var Int size := s isize
  if size<>undefined
    status := s forward size
  else
    status := failure


method s iskip -> status
  arg_rw Stream s ; arg Status status
  var Int l := 0
  part forward
    var Int h := s pick_uInt8
    if h=11000100b
      l -= 1
    eif h=11000101b
      l += 1
    if s:iforward=failure
      return failure
    if l>0
      restart forward
  status := shunt l=0 success failure


export BinaryError BinaryUnknown
export '. ilabel' '. itype' '. isize' '. iforward' '. iskip'



function pml_size_update buffer bufsize size more_start more_stop -> ready
  arg Address buffer ; arg Int bufsize ; arg_rw Int size more_start more_stop ; arg CBool ready
  for (var Int i) 0 more_stop-more_start
    if i=bufsize
      size -= bufsize
      return false
    var Int b := buffer map uInt8 i
    if more_start>=Int:size-1
      if more_start>=Int:size or b>=128
        size := undefined
        return true
    size += 2^(8*more_start)
    if size<0
      size := undefined
      return true
    more_start += 1
  ready := true

function pml_size buffer bufsize size more_start more_stop -> ready
  arg Address buffer ; arg Int bufsize ; arg_w Int size more_start more_stop ; arg CBool ready
  check bufsize>0
  var Int h := buffer map uInt8
  if h<224
    size := binary_sizes h
    ready := true
  else
    size := 1
    more_start := 0
    more_stop := 2^(h .and. 3)
    ready := pml_size_update (buffer translate uInt8 1) bufsize-1 size more_start more_stop
    
export pml_size pml_size_update