module size
//
//	All routines used for the determination of the size of a data
//	object are contained in this module.
//
//	It is common to all PRAXIS compilers, however size differences
//	are communicated by the data object size definitions provided by
//	TARGET
//
// MODIFICATIONS: version 7.2
// Nov-01-1984	F. Holloway	Added Defined_size function(s)
// Nov-11-1984	F. Holloway	Packed size of range determined by
//				precision unless predifined integer
//
export round_size,
       packed_size,
       unpck,
       pkoff,			// computing offsets in packed array
       size,
       byte_size,
       log2,
       sign_extend
	//---------------version 7.2-------FH------------------
	,defined_size
	//------------------------------------------------------


//-------version 7.2 ------------------
import dcl_integer from NAMES

//--------------------------------
import
    word_size,
    addressable_unit_size,
    character_size,
    align_size,
    target_real_size,
    target_long_real_size,
    pointer_size,
    lock_size
from TARGET

import w_size,
       b_size,
       lessp,
       lessequalp
from UNSIGNED

import tree,
       max_integer,
       prec_bits,
       get_kind,
       extract_type,
       reduce_ref,

       // pack_form enumeration constants
	//--------------Version 7.2 -----------FH -------------
	///no_pack, close_pack, tight_pack,
	pack_form,
	//-----------------------------------

       // tree_form enumeration constants
       integer_type, real_type, logical_type, char_type, boolean_type,
       lock_type, cond_type, pointer_type, func_type, proc_type, nil_type,
       general_type, undef_type, formal_array, array_type, struct_type,
       formal_subrange, discrete_external, subrange_type, enum_type,
       long_real_type, cardinal_type, set_type, hidden_type,sized_general
	//------------version 7.2 ------------FH------------------
	,decl_kind ,state_decl ,decl_field , decl_alternative
	,next_tree,print_node
	//--------------------------------------------------------
  from TREE

import get_type,type_ref from VALID

import get_low, get_high from HILOW

function sign_extend(p: tree)
//----------------------------------------------------------------------
//
// Abstract:
//	Given a type P find out whether sign extension is needed
//	on loading.
//
// Parameters:
//	P:	Type to check.
//
// Results:
//	Returns TRUE if sign extension needed.
//
// Design:
% if PDP11
//	Char_type is treated as signed since its high order bit
//	is always 0 and signed load is shorter for a byte than
//	unsigned load.
% endif
//
//--------------------------------------------------------------------
    returns result: boolean initially false
    select get_kind(type_ref(p)) from
      	case boolean_type,
% if PDP11
	   char_type,
% endif
	   integer_type:
	      result:=true

    endselect
endfunction {sign_extend}

function round_size(size: max_integer)
//
// Abstract:
//	Return the size rounded up to an even word boundary.
//
// Parameters:
//	Size:	Size to be rounded.
//
// Results:
//	Returns size rounded up to an even word boundary.
//
// Design:
//	Add 15 bits for rounding the truncate to a multiple of 16.
//
    returns round_size: max_integer initially
		w_size(size+(align_size-1))*align_size
endfunction {round_size}

function pkoff(index: max_integer, comp_size: max_integer)
    returns offset: max_integer
//
//	Computes the bit offset of the INDEX given that each
//	component has COMP_SIZE bits and using CLOSE_PACK.
//
    if not lessp(comp_size,align_size) do
	offset := index*comp_size
    otherwise
	declare ( per_word: 1..align_size initially align_size / comp_size)
	offset := (index/per_word)*align_size+(index mod per_word)*comp_size
    endif
endfunction {pkoff}


// forward declarations for scoping
forward function packed_size(p: tree) returns result_size: max_integer
forward function size(p: tree) returns result_size: max_integer

function array_size(p: tree) returns array_size: max_integer
//----------------------------------------------------------------------
//
// Abstract:
//	Get the size of an array. p is a non-NIL pointer to an array type.
//
// Parameters:
//	P:	Non-NIL pointer to an array type
//
// Results:
//	Returns size of the array
//
// Side Effects:
//	None.
//
// Errors:
//	None.
//
// Design:
//	Compute size for each special case.
//
//--------------------------------------------------------------------
  declare
      index_type: tree initially p@.index_type
      comp_type: tree initially extract_type(p)
      rnge: max_integer initially get_high(index_type)-get_low(index_type)+1
  enddeclare

    select p@.array_packing from
      case no_pack:
	  array_size:=round_size(rnge*size(comp_type))

      case close_pack:
	  array_size := pkoff(rnge,packed_size(comp_type))
	  if not lessp(array_size,align_size) do
	      array_size := round_size(array_size)
	  endif

      case tight_pack:
	  array_size:=rnge*packed_size(comp_type)
    endselect
endfunction {array_size}

function log2(n: max_integer) returns log2: max_integer initially 0
      if n < 0 do
	  n:=-n-1
      endif
      repeat
	log2 *= + 1
	n *= / 2
      until n=0
endfunction {log2}



function packed_size(p: tree)
//----------------------------------------------------------------------
//
// Abstract:
//	Find the minimum size of a datum or type.
//
// Parameters:
//	P:	The datum or type whose size is desired.
//
// Results:
//	Returns size in bits
//
// Side Effects:
//	None.
//
// Errors:
//	None.
//
// Design:
//	Look at each case of type and compute its size.
//	For all error cases assume a word size
//
//--------------------------------------------------------------------
    returns result_size: max_integer initially word_size

    p:=reduce_ref(get_type(p))
    if p = nil do return endif
    select get_kind(p) from
      case integer_type,
	   cardinal_type,
	   logical_type:
	  result_size:=p@.precision

      case real_type:
	  result_size:=target_real_size

      case char_type:
	  result_size := character_size

      case long_real_type:
	  result_size:=target_long_real_size

      case lock_type:
	  result_size:=lock_size

      case boolean_type:
	  result_size:=1

      case cond_type,
	   pointer_type,
	   func_type,
	   proc_type,
	   nil_type,
	   sized_general,
	   general_type:
	  result_size:=pointer_size

      case undef_type:		// if its size is evaluated must be 16
	  p@.size_unresolved:=false
	  result_size:=pointer_size

      case formal_array:
	  result_size:=10000	// just make it large

      case array_type:
	  result_size:=array_size(p)

      case struct_type:
	  result_size:=p@.struct_size

      case formal_subrange:
	  result_size:=word_size		// one word for formal variable

      case set_type:
	  declare( element_type: tree initially p@.element_type )
	  result_size := get_high(element_type)-get_low(element_type)+1

      case enum_type, discrete_external:
	  result_size := log2(get_high(p))

      case hidden_type:
	  result_size := p@.size

	case subrange_type:
	    //-----------version 7.2 --------------------------
	    declare
		PP : tree initially reduce_ref(extract_type (p))
	    enddeclare
	    if pp <> nil do
		if  get_kind(pp) = integer_type 
			and PP <> dcl_integer@.type_info  do
		    	
		    // user defined integer, use precision regardless of range

		    result_size := pp@.precision
		    
		otherwise
		   
		    // do what older versions did

		    result_size := max(log2(get_high(p)),log2(get_low(p)))
		    select get_kind(reduce_ref(extract_type(p))) from
			case integer_type, boolean_type:
				result_size *= + 1
		    endselect
		endif
	    endif
	    //------------------------------------------
    endselect
endfunction {packed_size}


function unpck(s: max_integer)
//----------------------------------------------------------------------
//
// Abstract:
//	Find unpacked size of an object given its packed size
//
// Parameters:
//	S:	Packed size of an object
//
// Results:
//	Returns the unpacked size
//
// Side Effects:
//	None.
//
// Errors:
//	None.
//
// Design:
//
//--------------------------------------------------------------------
    returns result_size: max_integer initially s
    if lessequalp(result_size,addressable_unit_size) do
	result_size:=addressable_unit_size
    otherwise 
	result_size:=round_size(result_size)
    endif
endfunction {unpck}


function size(p: tree)
//
//	Returns the unpacked size of a datum or a type
//
//	P: Tree node for datum or the type
//
    returns result_size: max_integer initially
	unpck(packed_size(p))
endfunction {size}


function byte_size(p: tree)
//----------------------------------------------------------------------
//
// Abstract:
//	Return size of unpacked datum in bytes.
//
// Parameters:
//	P:	The datum or type whose size is desired.
//
// Results:
//	Returns the size in bytes of this datum or a datum of this type.
//
// Side Effects:
//	None.
//
// Errors:
//	None.
//
// Design:
//
//--------------------------------------------------------------------
    returns byte_size: max_integer initially b_size(round_size(size(p)))
endfunction {byte_size}


//--------------------------Version 7.2 --------FH-----------------
//
// Defined_size funtions(s)
// The following 3 recursive funtions determine the exact defined
// size of any type as specified by the programmer.  No rounding
// or other hokus-pokus occurs.
//
// references:
// scan_list, resolve_type in MDECL; packed_size in SIZE
//----------------------------------------------------------------

forward function defined_size (p:tree, packing:pack_form) 
	returns result: max_integer initially 0

function defined_array_size (p:tree, packing:pack_form) 
	returns result: max_integer initially 0
	exception NOT_ARRAY_TYPE
	if get_kind(p) <> array_type do raise NOT_ARRAY_TYPE endif
	declare
	    index_type		: tree initially p@.index_type
	    component_type	: tree	initially extract_type(p)
	    rnge		: max_integer initially get_high(index_type) - get_low(index_type) + 1
	enddeclare
	result := rnge * defined_size(component_type,packing)
endfunction

function defined_struct_size (fields_of_struct:tree, packing:pack_form)
	returns result: max_integer initially 0
    while fields_of_struct <> nil do

	exception NOT_STRUCT_FIELD
	if get_kind (fields_of_struct) <> state_decl do
	    raise NOT_STRUCT_FIELD
	endif

	select decl_kind (fields_of_struct) from
	    case decl_field:
		declare (Temp_result : max_integer initially 0)
		temp_result := defined_size (fields_of_struct,packing)
		result *= + temp_result
		//import outstr,outint,outbuf from OUTIO
		//outstr ("; fields_of_struct = ")
		//print_node (fields_of_struct)
		//outstr (" defined_size = ")
		//outint (temp_result,12)
		//outbuf ()

	    case decl_alternative:
		declare
		    biggest_result : max_integer initially 0
		enddeclare
		for q := fields_of_struct@.alternates then next_tree(q) while q<>nil do
		    declare
			body_of_q	: tree initially q@.body
			temp : max_integer 
				initially defined_struct_size (body_of_q,packing)
		    enddeclare
		    if not lessequalp (temp, biggest_result) do
			biggest_result := temp
		    endif
		endfor
		result *= + biggest_result
	endselect
	fields_of_struct := next_tree (fields_of_struct)
    endwhile
endfunction

// primary entry to determine the defined size of any type.
// enter here with packing parameter = unpacked, which is the default condition

function defined_size (p:tree, packing:pack_form) 
	returns result: max_integer initially 0

    p := reduce_ref(get_type(p))
    if p = nil do return endif
    select get_kind(p) from
	case integer_type, cardinal_type, logical_type:
	    select packing from
		case no_pack:
		    result := unpck(p@.precision)
		case close_pack:
		    result:=p@.precision
	    endselect
	case real_type:
	    result:=target_real_size
 	case char_type:
	    result := character_size
 	case long_real_type:
	    result:=target_long_real_size
 	case lock_type:
	    result:=lock_size
 	case boolean_type:
	    select packing from
		case no_pack:
		    result := unpck (1)
		case close_pack: 
		    result:=1
	    endselect
 	case cond_type,	pointer_type, func_type, proc_type,
	   nil_type, sized_general, general_type:
	    result:=pointer_size
 	case undef_type: // if its size is to be evaluated must be 16
	  result:=pointer_size
 	case formal_array:
	  result:=10000	// just make it large
 	case array_type:
	  result := defined_array_size(p, p@.array_packing)
 	case struct_type:
	  result := defined_struct_size (p@.field_list, p@.struct_packing)
 	case formal_subrange:
	  result:=word_size	// one word for formal variable
 	case set_type:
	    declare
		element_type: tree initially p@.element_type 
	     	temp_result  : max_integer initially get_high(element_type)-get_low(element_type)+1
	    enddeclare 
 	    select packing from
		case no_pack:
		    result := unpck (temp_result)
		case close_pack:
		    result := temp_result
	    endselect
	case enum_type, discrete_external:
	    result := log2(get_high(p))
	    select packing from
		case no_pack:
		    result := unpck(result)
	    endselect
 	case hidden_type:
	  result := p@.size
 	case subrange_type:
	    result := max(log2(get_high(p)),log2(get_low(p)))
	    select get_kind(reduce_ref(extract_type(p))) from
	      	case integer_type, boolean_type:
		    result *= + 1
	    endselect
	    select packing from
		case no_pack:
		    result := unpck(result)
	    endselect
    endselect
endfunction	
endmodule