# tables.icn

# defines the data structures to support the kize compiler
# - global_symbol_table
# - local_symbol_table
# - static_memory

# support routes for the data structures
# - initialize_global_symbol_table
# - display_global_symbol_table
# - initialize_local_symbol_table
# - display_local_symbol_table
# - setup_static_memory

global global_symbol_table
global local_symbol_table

record constant_entry		(identifier,const_type,const_value)
record type_entry		(identifier,type_size,type_info)
record variable_entry           (identifier,variable_type,
                                 variable_address,indirect)
record procedure_entry		(identifier,formal_arguments,return_type)
record label_entry              (lnumber,lvalue)

# variable_information is the location where the data value may be found
# the location is stored in the source address register (SAR)
# the variable may be an atomic type, or structured type,
#    or a structure-qualified type, or a pointer-qualified type
record variable_location        (data_type)


#
# procedure evaluation and argument lists
# will be discussed in detail in a later chapter.
#

# procedure_evaluation results in at most one atomic data value
# however, the evaluated result is found at the top of the stack
record procedure_evaluation	(data_type)

# formal_arguments is a list of
record argument_entry           (identifier,data_type,call_by)

#
# structured data types (arrays and records)
# will be discussed in detail in a later chapter
#

# type_info is one of two categories:
record array_info		(no_elements,data_type)
record record_info		(field_descriptors)

# field descriptors is a list of
record field_descriptor		(identifier,field_type,field_offset)


global static_memory

# static_memory	is a list of memory allocations, either:
record define			(identifier,data_value)
record reserve			(identifier,data_size)

procedure initialize_global_symbol_table ()
  global_symbol_table            := table ()
  global_symbol_table ["INT"]    := type_entry ("INT",1,&null)
  global_symbol_table ["REAL"]   := type_entry ("REAL",1,&null)
  global_symbol_table ["STRING"] := type_entry ("STRING",1,&null)
  global_symbol_table ["MAIN"]   := procedure_entry ("MAIN",[],"INT")
  static_memory                  := []
end

procedure initialize_local_symbol_table (formal_argument_list)
  local_symbol_table            := table ()
  offset := *formal_argument_list + 2
  every (item := !formal_argument_list) do
  {
    offset := offset - 1
    if (item.call_by == "var") then
      indirect := "indirect"
    else
      indirect := &null
    local_symbol_table [item.identifier] :=
      variable_entry (item.identifier,item.data_type,
      offset,indirect)
  }
end

procedure display_global_symbol_table ()
  dashes := "----------------------------------------------------------"

  emit_comment (dashes)
  emit_blank_line ()
  emit_comment ("GLOBAL SYMBOL TABLE:")
  emit_blank_line ()

  emit_comment ("CONSTANTS")
  every (entry := !global_symbol_table) do
    if (isConstant(entry)) then
      write (left ("#",5),
             left (entry.identifier,15),
             left (entry.const_type,15),
             entry.const_value)
  emit_blank_line ()

  emit_comment ("TYPES")
  every (entry := !global_symbol_table) do
    if (isType(entry)) then
    {
      writes (left ("#",5),
              left (entry.identifier,15),
              left (entry.type_size,15))
      if (isAtomic(entry)) then
        write ("ATOM")
      else if (isArray(entry)) then
      # arrays are discussed in a later chapter
      {
        write ("ARRAY")
        write (left ("#",15),
               left (entry.type_info.no_elements,5),
               entry.type_info.data_type)
      }
      else if (isRecord(entry)) then
      # records are discussed in a later chapter
      {
        write ("RECORD")
        every (item := !(entry.type_info.field_descriptors)) do
          write (left ("#",15),
                 left (item.identifier,15),
                 left (item.field_type,15),
                 item.field_offset)
      }
      else
        stop ("unexpected item in global type table")
    }
  emit_blank_line ()

  emit_comment ("VARIABLES")
  every (entry := !global_symbol_table) do
    if (isVariable(entry)) then
      write (left ("#",5),
             left (entry.identifier,15),
             left (entry.variable_type,15),
             left (entry.variable_address,10),
             (\entry.indirect | ""))
  emit_blank_line ()

  emit_comment ("PROCEDURES")
  # procedures and argument lists are discussed in a later chapter
  every (entry := !global_symbol_table) do
    if (isProcedure(entry)) then
    {
      write (left ("#",5),
             left (entry.identifier,15),
             left (*entry.formal_arguments,15),
             \entry.return_type | "none")
      if (*entry.formal_arguments > 0) then
        every (arg := !entry.formal_arguments) do
          write (left ("#",15),
                 left (arg.identifier,15),
                 left (arg.data_type,15),
                 arg.call_by)
    }
  emit_blank_line ()
  emit_comment (dashes)
  emit_blank_line ()
end

procedure display_local_symbol_table ()
  dashes := "----------------------------------------------------------"

  emit_comment (dashes)
  emit_blank_line ()
  emit_comment ("LOCAL SYMBOL TABLE:")
  emit_blank_line ()

  emit_comment ("LABELS")
  every (entry := !local_symbol_table) do
    if (isLabel(entry)) then
      write (left ("#",5),
             left (entry.lnumber,15),
             entry.lvalue)
  emit_blank_line ()

  emit_comment ("VARIABLES")
  every (entry := !local_symbol_table) do
    if (isVariable(entry)) then
      write (left ("#",5),
             left (entry.identifier,15),
             left (entry.variable_type,15),
             left (entry.variable_address,10),
             (\entry.indirect | ""))
  emit_blank_line ()
  emit_comment (dashes)
  emit_blank_line ()
end

procedure setup_static_memory ()
  every entry := !static_memory do
    if (type(entry) == "define") then
      emit_line ("_DEFINE",entry[1],entry[2])
    else # (type(entry) == "reserve")
      emit_line ("_RESERVE",entry[1],entry[2])
end

procedure isGlobal (ident)
  return \global_symbol_table[ident]
end

procedure isConstant (entry)
  return (type(entry) == "constant_entry")
end

procedure isType (entry)
  return type(entry) == "type_entry"
end

procedure isVariable (entry)
  return (type(entry) == "variable_entry")
end

procedure isProcedure (entry)
  return type(entry) == "procedure_entry"
end

procedure isLocal (ident)
  return \local_symbol_table[ident]
end

procedure isLabel (entry)
  return type(entry) == "label_entry"
end

# procedure isVariable (entry)
#   defined earler also applies to local identifiers
# end

procedure isAtomic (entry)
  return isType(entry) & (type(entry.type_info) == "null")
end

procedure isArray (entry)
  # arrays are discussed in a later chapter
  return isType(entry) & (type(entry.type_info) == "array_info")
end

procedure isRecord (entry)
  # records are discussed in a later chapter
  return isType(entry) & (type(entry.type_info) == "record_info")
end

procedure isPointer (data_type)
  # pointers are discussed in a later chapter
  if (data_type == "POINTER") then
    return data_type
  else if (data_type[1] == "^") then
  {
    target_type := data_type [2:0]
    if (\global_symbol_table [target_type]) then
      return "^" || target_type
    else
      return "^" || isPointer (target_type)
  }
  else
    fail
end

procedure resolve_types (a_type,b_type)
  if ((a_type == "STRING") | (b_type == "STRING")) then
    stop ("binary operations on STRINGs not permitted!")
  if ((member(ATOMIC,a_type)) & (member(ATOMIC,b_type))) then
    if ((a_type == "REAL") | (b_type == "REAL")) then
      return "REAL"
    else
      return "INT"
  # structured types and pointers are discussed in a later chapter
  else if (isType(isGlobal(a_type)) & isType(isGlobal(b_type))) then
    if (a_type == b_type) then
      return a_type
    else
      stop ("incompatible types (" || a_type || "," || b_type || ")")
  else if (isPointer(a_type) & isPointer(b_type)) then
    if (a_type == b_type) then
      return a_type
    else if (a_type == "POINTER") then
      return b_type
    else if (b_type == "POINTER") then
      return a_type
    else
      stop ("incompatible pointer types ("  || a_type || "," || b_type || ")")
  else
    stop ("incompatible types (" || a_type || "," || b_type || ")")
end