Patch title: Release 85 bulk changes
Abstract:
File: /pliant/protocol/http/stack.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"

constant default_buffer_size 1024


type HtmlBuffer
  field ListNode_ node
  field Address cursor stop

type HtmlTransition
  field Int kind # 0 = mark, 1 = assignment
  field Pointer:HtmlTransition previous
  field Address a0 a1 a2 a3

type HtmlExtra
  field Str id
  field Str value
  field Pointer:HtmlExtra next # must be the last field

type HtmlStack
  field Array:Address map
  field Pointer:HtmlTransition last_record
  field Pointer:HtmlBuffer buffer
  field List_ buffers
  field Pointer:HtmlExtra first_extra
  field (Pointer Pointer:HtmlExtra) last_extra


gvar Array:Arrow attr_default
gvar Sem sem

gvar HtmlBuffer no_buffer
memory_clear addressof:no_buffer HtmlBuffer:size


function html_stack_slot type default -> index
  arg Type type ; arg Address default ; arg Int index
  sem request
  index := attr_default size
  var Arrow d := entry_new type
  if default<>null
    type copy_instance default d
  attr_default += d
  sem release


function build e
  arg_w HtmlStack e
  e buffer :> no_buffer
  e last_record :> null map HtmlTransition
  e first_extra :> null map HtmlExtra
  e last_extra :>> e first_extra

function destroy e
  arg_w HtmlStack e
  if (exists e:last_record)
    error error_id_mismatch "missing HtmlStack rewind instruction"
  var Pointer:ListNode_ n :> e:buffers first
  while exists:n
    var Pointer:ListNode_ nn :> n next
    memory_free addressof:n
    n :> nn

method e initialize
  arg_rw HtmlStack e
  var Int old_size := e:map size
  sem rd_request
  e:map size := attr_default size
  for (var Int i) old_size e:map:size-1
    e:map i := attr_default i
  sem rd_release


method e allocate size -> adr
  arg_rw HtmlStack e ; arg Int size ; arg Address adr
  var Pointer:HtmlBuffer b :> e buffer
  part try
    if (cast b:stop Int).-.(cast b:cursor Int)<size
      b :> (addressof b:node:next) map HtmlBuffer
      if exists:b
        b cursor := addressof:b translate HtmlBuffer 1
        e buffer :> b
        restart try
      var Int bsize := max default_buffer_size size
      b :> (memory_allocate HtmlBuffer:size+bsize addressof:e) map HtmlBuffer
      b cursor := addressof:b translate HtmlBuffer 1
      b stop := b:cursor translate Byte bsize
      e:buffers append b:node
      e buffer :> b
  adr := b cursor
  b cursor := b:cursor translate Byte size


method e map index -> adr
  arg HtmlStack e ; arg Int index ; arg Address adr
  adr := e:map index


method e mark
  arg_rw HtmlStack e
  var Pointer:HtmlTransition t :> (e allocate HtmlTransition:size) map HtmlTransition
  t kind := 0
  t previous :> e last_record
  t a0 := addressof e:buffer
  t a1 := e:buffer cursor
  t a2 := addressof e:first_extra
  t a3 := addressof Pointer:HtmlExtra e:last_extra
  e last_record :> t
  e first_extra :> null map HtmlExtra
  e last_extra :>> e first_extra

method e rewind
  arg_rw HtmlStack e
  var Pointer:HtmlTransition t :> e last_record
  while t:kind=1
    (t:a1 map Type) destroy_instance e:map:(cast t:a0 Int)
    e:map (cast t:a0 Int) := t a2
    t :> t previous
  e buffer :> t:a0 map HtmlBuffer
  e:buffer cursor := t a1
  e first_extra :> t:a2 map HtmlExtra
  e last_extra :>> t:a3 map Pointer:HtmlExtra
  e last_record :> t previous


method e push index value type
  arg_rw HtmlStack e ; arg Int index ; arg Address value ; arg Type type
  check (entry_type attr_default:index)=type
  var Pointer:HtmlTransition t :> (e allocate HtmlTransition:size) map HtmlTransition
  t kind := 1
  t previous :> e last_record
  t a0 := cast index Address
  t a1 := addressof type
  t a2 := e:map index
  e last_record :> t
  var Address a := e allocate type:size
  type build_instance a
  type copy_instance value a
  e:map index := a


method e set id value
  arg_rw HtmlStack e ; arg Str id value
  var Pointer:HtmlExtra ex :> (e allocate HtmlExtra:size+id:len+value:len) map HtmlExtra
  HtmlExtra build_instance addressof:ex
  ex:id set (addressof:ex translate HtmlExtra 1) id:len false
  memory_copy id:characters ex:id:characters id:len
  ex:value set (ex:id:characters translate Char id:len) value:len false
  memory_copy value:characters ex:value:characters value:len
  ex next :> null map HtmlExtra
  e last_extra :> ex
  e last_extra :>> ex next

  
method e walk id value
  arg HtmlStack e ; arg_w Str id value
  id set ((addressof Pointer:HtmlExtra e:first_extra) translate Pointer:HtmlExtra 1) 0 false

method e another id value -> available
  arg HtmlStack e ; arg_w Str id ; arg_rw Str value ; arg CBool available
  var Pointer:HtmlExtra ex :> id:characters map HtmlExtra -1
  ex :> ex next
  if exists:ex
    id set ex:id:characters ex:id:len false
    value set ex:value:characters ex:value:len false
    available := true
  else
    id := ""
    value := ""
    available := false


export html_stack_slot
export HtmlStack '. initialize' '. mark' '. rewind'
export '. map' '. push'
export '. set' '. walk' '. another'