void CkComSize( sym_id sym_ptr, unsigned_32 size ) {
//=====================================================
// Check for matching sizes of common blocks.
char buff[MAX_SYMLEN+1];
intstar4 com_size;
com_size = GetComBlkSize( sym_ptr );
if( size != com_size ) {
if( size > com_size ) {
SetComBlkSize( sym_ptr, size );
}
if( ( sym_ptr->ns.flags & SY_COMSIZE_WARN ) == 0 ) {
// It's nice to give a warning message when the blank common
// block appears as different sizes even though the standard
// permits it.
if( sym_ptr->ns.flags & SY_BLANK_COMMON ) {
Warning( CM_BLANK_DIFF_SIZE );
} else {
STGetName( sym_ptr, buff );
Warning( CM_NAMED_DIFF_SIZE, buff );
}
sym_ptr->ns.flags |= SY_COMSIZE_WARN;
}
}
}
sym_id AddCB2GList( sym_id ste_ptr ) {
//=====================================
// Add a common block to the global list.
sym_id gbl;
unsigned_16 flags;
flags = ste_ptr->ns.flags;
gbl = SearchGList( ste_ptr );
if( gbl == NULL ) {
gbl = LnkNewGlobal( ste_ptr );
} else if( ( gbl->ns.flags & SY_CLASS ) != SY_COMMON ) {
PrevDef( gbl );
} else {
if( ( gbl->ns.flags & SY_SAVED ) != ( flags & SY_SAVED ) ) {
gbl->ns.flags |= SY_SAVED;
if( ( flags & SY_COMMON_LOAD ) == 0 ) {
NameWarn( SA_COMMON_NOT_SAVED, ste_ptr );
}
}
CkComSize( gbl, GetComBlkSize( ste_ptr ) );
if( flags & gbl->ns.flags & SY_IN_BLOCK_DATA ) {
NameErr( CM_BLKDATA_ALREADY, gbl );
}
gbl->ns.flags |= flags & ( SY_COMMON_INIT | SY_EQUIVED_NAME );
}
return( gbl );
}
cg_type SymPtrType( sym_id sym ) {
//================================
// Get type of pointer required to address given symbol.
sym_id leader;
cg_type p_type;
signed_32 offset;
com_eq *ce_ext;
unsigned_32 item_size;
segment_id leader_seg;
unsigned_16 flags;
flags = sym->ns.flags;
if( flags & SY_SUB_PARM ) {
// subprogram argument
if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
p_type = TY_CODE_PTR;
} else if( flags & SY_SUBSCRIPTED ) {
p_type = ArrayPtrType( sym );
} else {
p_type = TY_GLOBAL_POINTER;
}
} else if( flags & SY_IN_EQUIV ) {
leader = sym;
offset = 0;
for(;;) {
ce_ext = leader->ns.si.va.vi.ec_ext;
if( ce_ext->ec_flags & LEADER ) break;
offset += ce_ext->offset;
leader = ce_ext->link_eqv;
}
if( ce_ext->ec_flags & MEMBER_IN_COMMON ) {
offset += ce_ext->offset;
if( GetComBlkSize( ce_ext->com_blk ) <= MaxSegSize ) {
// common block fits in a segment
p_type = TY_GLOBAL_POINTER;
} else {
item_size = _SymSize( sym );
if( flags & SY_SUBSCRIPTED ) {
item_size *= sym->ns.si.va.dim_ext->num_elts;
}
if( offset + item_size <= MaxSegSize ) {
// object fits in first segment of common block
// (common block label is at start of first segment)
p_type = TY_GLOBAL_POINTER;
} else {
p_type = TY_HUGE_POINTER;
}
}
} else {
if( ce_ext->high - ce_ext->low <= MaxSegSize ) {
// equivalence set fits in a segment
p_type = TY_GLOBAL_POINTER;
} else {
item_size = _SymSize( sym );
if( flags & SY_SUBSCRIPTED ) {
item_size *= sym->ns.si.va.dim_ext->num_elts;
}
leader_seg = GetGlobalSeg( ce_ext->offset );
offset += ce_ext->offset;
if( ( GetGlobalSeg( offset ) == leader_seg ) &&
( GetGlobalSeg( offset + item_size ) == leader_seg ) ) {
// the entire item is in the same segment as the leader
p_type = TY_GLOBAL_POINTER;
} else {
p_type = TY_HUGE_POINTER;
}
}
}
} else if( flags & SY_IN_COMMON ) {
ce_ext = sym->ns.si.va.vi.ec_ext;
if( GetComBlkSize( ce_ext->com_blk ) <= MaxSegSize ) {
// common block fits in a segment
p_type = TY_GLOBAL_POINTER;
} else {
item_size = _SymSize( sym );
if( flags & SY_SUBSCRIPTED ) {
item_size *= sym->ns.si.va.dim_ext->num_elts;
}
if( ce_ext->com_blk->ns.flags & SY_EQUIVED_NAME ) {
if( ce_ext->offset + item_size <= MaxSegSize ) {
// object fits in first segment of common block
// (common block label is at start of first segment)
p_type = TY_GLOBAL_POINTER;
} else {
p_type = TY_HUGE_POINTER;
}
} else {
// each symbol in common block gets a label at the offset into
// the common block
if( GetComOffset( ce_ext->offset ) + item_size <= MaxSegSize ) {
// object fits in a segment
p_type = TY_GLOBAL_POINTER;
} else {
p_type = TY_HUGE_POINTER;
}
}
}
} else if( ( flags & SY_SUBSCRIPTED ) && _Allocatable( sym ) ) {
p_type = ArrayPtrType( sym );
} else if( ( flags & SY_SUBSCRIPTED ) || ( sym->ns.typ == FT_STRUCTURE ) ) {
item_size = _SymSize( sym );
if( flags & SY_SUBSCRIPTED ) {
item_size *= sym->ns.si.va.dim_ext->num_elts;
}
if( item_size > MaxSegSize ) {
p_type = TY_HUGE_POINTER;
} else if( item_size <= DataThreshold ) {
p_type = TY_LOCAL_POINTER;
} else {
p_type = TY_GLOBAL_POINTER;
}
} else {
p_type = TY_LOCAL_POINTER;
}
return( p_type );
}
