sym_id STFreeName( sym_id sym_ptr ) {
//==========================================
// Free a symbol name.
if( ( sym_ptr->u.ns.flags & SY_CLASS ) == SY_COMMON ) {
sym_ptr = FreeLink( (void **)sym_ptr );
} else {
if( ( sym_ptr->u.ns.flags & SY_CLASS ) == SY_VARIABLE ) {
if( sym_ptr->u.ns.flags & SY_SUBSCRIPTED ) {
if( sym_ptr->u.ns.si.va.u.dim_ext != NULL ) {
FMemFree( sym_ptr->u.ns.si.va.u.dim_ext );
}
}
if( sym_ptr->u.ns.flags & SY_IN_EC ) {
if( sym_ptr->u.ns.si.va.vi.ec_ext != NULL ) {
FMemFree( sym_ptr->u.ns.si.va.vi.ec_ext );
}
}
} else if( ( sym_ptr->u.ns.flags & SY_CLASS ) == SY_SUBPROGRAM ) {
if( ( sym_ptr->u.ns.flags & SY_SUBPROG_TYPE ) == SY_STMT_FUNC ) {
FreeSFHeader( sym_ptr );
}
}
sym_ptr = STFree( sym_ptr );
}
return( sym_ptr );
}
void FiniProcCmd( void ) {
//===========================
if( IncludePath != NULL ) {
FMemFree( IncludePath );
}
}
void FiniLabels( int label_type ) {
//====================================
// Free specified class of labels.
label_entry **owner;
label_entry *curr;
owner = (label_entry **)&LabelList;
for(;;) {
curr = *owner;
if( curr == NULL ) break;
if( ( curr->label & FORMAT_LABEL ) == label_type ) {
if( ( CGFlags & CG_FATAL ) == 0 ) {
if( curr->label & FORMAT_LABEL ) {
BEFiniBack( curr->handle );
BEFreeBack( curr->handle );
} else {
InfoError( CP_ERROR, "unfreed label" );
BEFiniLabel( curr->handle );
}
}
*owner = curr->link;
FMemFree( curr );
} else {
owner = &curr->link;
}
}
}
void ConstCat( int size ) {
//============================
itnode *last_node;
byte *dest;
int opn_size;
int size_left;
byte *string;
itnode *link_node;
last_node = CITNode;
string = FMemAlloc( size );
size_left = size;
dest = string;
for(;;) {
opn_size = last_node->value.cstring.len;
memcpy( dest, last_node->value.cstring.strptr, opn_size );
size_left -= opn_size;
if( size_left == 0 ) break;
last_node = last_node->link;
dest += opn_size;
}
CITNode->value.cstring.strptr = (char *)string;
CITNode->value.cstring.len = size;
CITNode->size = size;
link_node = last_node->link;
last_node->link = NULL;
FreeITNodes( CITNode->link );
CITNode->link = link_node;
AddConst( CITNode );
CITNode->value.cstring.strptr = (char *)&CITNode->sym_ptr->u.lt.value;
FMemFree( string );
}
void FIncludePathFini( void )
//==============================
{
if( FIncludePath != NULL ) {
FMemFree( FIncludePath );
}
}
void FiniComIO( void ) {
//===================
if( TermBuff != &TokenBuff ) {
FMemFree( TermBuff );
}
}
void CLIClear( void ) {
/****************/
int x = 0;
for( x = 0; x < DW_DEBUG_MAX; x++ ) {
if ( ( Sections[x].sec_type == FILE_SECTION ) && Sections[x].u1.fp ) {
SDClose( Sections[x].u1.fp );
if ( Sections[x].u2.filename ) {
SDScratch( Sections[x].u2.filename );
FMemFree( Sections[x].u2.filename );
}
} else if ((Sections[x].sec_type == MEM_SECTION) && Sections[x].u2.data){
FMemFree( Sections[x].u2.data );
}
memset( &(Sections[x] ), 0, sizeof( section_data ) );
}
}
static void CLIZeroWrite( dw_sectnum sect, uint size ) {
/*************************************************/
char *btmp;
btmp = FMemAlloc( size+1 );
memset( btmp, 0, size );
CLIWrite( sect, btmp, size );
FMemFree( btmp );
}
void EquivResolve( void ) {
//======================
// Resolve equivalence relations.
act_eq_entry *eq_set;
act_eq_entry *eq_head;
act_eq_entry *eqv_entry;
act_eq_entry *next_eq_entry;
intstar4 offset;
intstar4 lead_offset;
eq_set = EquivSets;
while( eq_set != NULL ) {
eq_head = eq_set;
lead_offset = CheckSubscr( eq_head );
if( eq_head->substr != 0 ) {
lead_offset += CheckSubStr( eq_head );
}
eqv_entry = eq_head->next_eq_entry;
// in case of an error, we may only have one member in an
// equivalence set - make him a leader since every equivalence
// set requires one
if( eqv_entry == NULL ) {
eq_head->name_equived->ns.si.va.vi.ec_ext->ec_flags |= LEADER;
} else {
for(;;) {
offset = CheckSubscr( eqv_entry );
if( eqv_entry->substr != 0 ) {
offset += CheckSubStr( eqv_entry );
}
GenEquivSet( eq_head, eqv_entry, lead_offset, offset );
next_eq_entry = eqv_entry->next_eq_entry;
FMemFree( eqv_entry );
eqv_entry = next_eq_entry;
if( eqv_entry == NULL ) break;
}
}
eq_set = eq_head->next_eq_set;
FMemFree( eq_head );
}
EquivSets = NULL;
}
void FreeSFHeader( sym_id sym ) {
//==================================
// Free statement function header.
if( sym->u.ns.si.sf.header != NULL ) {
FreeChain( &sym->u.ns.si.sf.header->parm_list );
FMemFree( sym->u.ns.si.sf.header );
sym->u.ns.si.sf.header = NULL;
}
}
void FreeGlobalSegs( void ) {
//========================
// Free global segment list.
global_seg *curr_seg;
while( GlobalSeg != NULL ) {
curr_seg = GlobalSeg;
GlobalSeg = curr_seg->link;
FMemFree( curr_seg );
}
}
static void FreeMacros( bool free_perm ) {
//============================================
// Free macros.
macro_entry *link;
while( MacroList != NULL ) {
link = MacroList->link;
if( !free_perm && ( MacroList->status == MACRO_PERMANENT ) ) break;
FMemFree( MacroList );
MacroList = link;
}
}
void FiniObj( void ) {
//=======================
// Release memory allocated for object code.
if( ObjCode != NULL ) {
FMemFree( ObjCode );
ObjCode = NULL;
}
if( PageFile != NULL ) {
SDClose( PageFile );
PageFile = NULL;
SDScratch( PageFileBuff );
}
}
static void BIWalkList( sym_list **list, func action, int nuke_list ) {
//=====================================================================
sym_list *tmp;
tmp = *list;
while( tmp ) {
action( tmp->id, tmp->dbh );
tmp = tmp->link;
if ( nuke_list ) {
FMemFree( *list );
*list = tmp;
}
}
}
static void CLIWrite( dw_sectnum sect, const void *block, dw_size_t size ) {
/*********************************************************************/
char *temp;
section_data *cur_sec;
cur_sec = &Sections[sect];
if ( cur_sec->sec_type == DEFAULT_SECTION ) {
if ( ( initial_section_type == DEFAULT_SECTION ) ||
( initial_section_type == FILE_SECTION ) ) {
cur_sec->sec_type = FILE_SECTION;
SDSetAttr( REC_FIXED | SEEK );
temp = tmpnam( NULL );
cur_sec->u2.filename = FMemAlloc( strlen( temp ) + 1 );
strcpy( cur_sec->u2.filename, temp );
cur_sec->u1.fp = SDOpen( temp, UPDATE_FILE );
chkIOErr( cur_sec->u1.fp, SM_OPENING_FILE, temp );
} else {
cur_sec->sec_type = initial_section_type;
cur_sec->u1.size = MEM_INCREMENT;
cur_sec->u2.data = FMemAlloc( MEM_INCREMENT );
}
}
switch( cur_sec->sec_type ) {
case( MEM_SECTION ):
if ( cur_sec->u1.size <= ( cur_sec->cur_offset + size ) ) {
temp = FMemAlloc( cur_sec->u1.size + MEM_INCREMENT );
memcpy( temp, cur_sec->u2.data, cur_sec->u1.size );
FMemFree( cur_sec->u2.data );
cur_sec->u2.data = temp;
cur_sec->u1.size += MEM_INCREMENT;
}
memcpy( ( cur_sec->u2.data + cur_sec->cur_offset ), block, size );
break;
case( FILE_SECTION ):
SDWrite( cur_sec->u1.fp, (byte *)block, size );
chkIOErr( cur_sec->u1.fp, SM_IO_WRITE_ERR, "temporary file" );
break;
default:
Error( CP_FATAL_ERROR, "Internal browse generator error" );
CSuicide();
};
cur_sec->cur_offset += size;
if( cur_sec->cur_offset > cur_sec->max_offset ) {
cur_sec->max_offset = cur_sec->cur_offset;
}
}
static dw_handle BIGetUnionType( sym_id ste_ptr ) {
//=================================================
// get a union type of a non named symbol
struct fstruct *fs;
dw_handle ret;
symbol data;
long max = 0;
long map = 0;
char buff[12];
ret = DWStruct( cBIId, DW_ST_UNION );
fs = ste_ptr->u.ns.xt.record;
// find the largest size of map
while( fs ) {
if ( fs->size > max ) {
max = fs->size;
}
fs = &fs->link->u.sd;
}
// Start the union declaration
DWDeclPos( cBIId, CurrFile->rec, 0 );
DWBeginStruct( cBIId, ret, max, ste_ptr->u.ns.name, 0, 0 );
fs = ste_ptr->u.ns.xt.record;
data.u.ns.xt.record = FMemAlloc( sizeof( fstruct) );
while( fs ) {
memset( data.u.ns.xt.record, 0, sizeof( fstruct ) );
memcpy( data.u.ns.xt.record, fs, sizeof( fmap ) );
data.u.ns.si.va.u.dim_ext = NULL;
data.u.ns.u1.s.typ = FT_STRUCTURE;
strcpy( data.u.ns.name, "MAP" );
strcat( data.u.ns.name, itoa( map, buff, 10 ) );
data.u.ns.u2.name_len = strlen( data.u.ns.name );
strcpy( data.u.ns.xt.record->name, data.u.ns.name );
data.u.ns.xt.record->name_len = data.u.ns.u2.name_len;
map++;
DWAddField( cBIId, BIGetType( &data ), justJunk, data.u.ns.name, 0 );
fs = &fs->link->u.sd;
}
FMemFree( data.u.ns.xt.record );
DWEndStruct( cBIId );
return( ret );
}
void MacroUNDEFINE( char *macro, uint macro_len ) {
//====================================================
// Define a macro.
macro_entry **me;
macro_entry *free_me;
for( me = &MacroList; *me != NULL; me = &(*me)->link ) {
if( (*me)->name_len != macro_len ) continue;
if( memicmp( (*me)->name, macro, macro_len ) == 0 ) {
free_me = *me;
*me = free_me->link;
FMemFree( free_me );
return;
}
}
}
sym_id FreeREntry( sym_id sym ) {
//================================
sym_id fd;
fd = sym->u.sd.fl.sym_fields;
while( fd != NULL ) {
if( fd->u.fd.typ == FT_UNION ) {
FreeRList( fd->u.fd.xt.sym_record );
} else {
if( fd->u.fd.dim_ext != NULL ) {
FMemFree( fd->u.fd.dim_ext );
}
}
fd = FreeLink( (void **)fd );
}
return( FreeLink( (void **)sym ) );
}
void DoneLabel( label_id label ) {
//===================================
// Free specified label since it will no longer be referenced.
label_entry **owner;
label_entry *curr;
owner = (label_entry **)&LabelList;
for(;;) {
curr = *owner;
if( curr->label == label ) break;
owner = &curr->link;
}
*owner = curr->link;
BEFiniLabel( curr->handle );
FMemFree( curr );
}
void EqPurge(void) {
//=================
// Free up all of the equivalence information
act_eq_entry *eq_set;
act_eq_entry *old;
while( EquivSets != NULL ) {
eq_set = EquivSets;
EquivSets = eq_set->next_eq_set;
for(;;) {
old = eq_set;
eq_set = old->next_eq_entry;
FMemFree( old );
if( eq_set == NULL ) break;
}
}
}
static void PathOption( opt_entry *optn, char *ptr )
//============================================================
// Process "INCPATH=" option.
{
char *p;
char *old_list;
int old_len;
int len;
optn = optn;
len = strlen( ptr );
// skip quotes
if( ptr[0] == '"' && ptr[len - 1] == '"' ) {
len -= 2;
++ptr;
ptr[len] = NULLCHAR;
}
if( len == 0 )
return;
if( IncludePath == NULL ) {
p = IncludePath = FMemAlloc( len + 1 );
} else {
old_list = IncludePath;
old_len = strlen( old_list );
IncludePath = FMemAlloc( old_len + 1 + len + 1 );
memcpy( IncludePath, old_list, len );
FMemFree( old_list );
p = IncludePath + old_len;
}
while( *ptr != NULLCHAR ) {
if( p != IncludePath )
*p++ = PATH_LIST_SEP;
ptr = GetPathElement( ptr, NULL, &p );
}
*p = NULLCHAR;
}
void CpParameter( void ) {
//=====================
// Compile PARAMETER statement.
//
// PARAMETER (P1=E1,...,Pn=En), n > 0
uint parm_size;
byte *lit;
byte *string;
int lit_len;
sym_id sym;
sym_id value_id;
TYPE typ;
byte assign_val;
ReqNOpn();
AdvanceITPtr();
ReqOpenParen();
for(;;) {
if( ReqName( NAME_VARIABLE ) ) {
sym = LkSym();
typ = sym->u.ns.u1.s.typ;
assign_val = TRUE;
if( sym->u.ns.flags & (SY_USAGE | SY_SUB_PARM | SY_IN_EC) ) {
IllName( sym );
assign_val = FALSE;
} else if( typ == FT_STRUCTURE ) {
IllType( sym );
assign_val = FALSE;
} else {
CkSymDeclared( sym );
}
AdvanceITPtr();
ReqEquSign();
parm_size = sym->u.ns.xt.size;
if( typ == FT_STRUCTURE ) {
ConstExpr( FT_NO_TYPE );
} else if( _IsTypeLogical( typ ) ) {
CLogicExpr();
} else if( typ == FT_CHAR ) {
CCharExpr();
} else {
CArithExpr();
}
if( !AError && assign_val ) {
if( typ == FT_CHAR ) {
string = (byte *)CITNode->value.cstring.strptr;
if( CITNode->size < parm_size ) {
lit = FMemAlloc( parm_size );
lit_len = CITNode->size;
memcpy( lit, string, lit_len );
memset( lit + lit_len, ' ', parm_size - lit_len );
value_id = STLit( lit, parm_size );
FMemFree( lit );
} else {
if( parm_size == 0 ) { // *(*)
parm_size = CITNode->size;
}
value_id = STLit( string, parm_size );
}
} else {
if( !_IsTypeLogical( typ ) ) {
CnvTo( CITNode, typ, parm_size );
}
value_id = STConst( &CITNode->value, typ, parm_size );
}
sym->u.ns.flags |= SY_USAGE | SY_PARAMETER | SY_TYPE;
sym->u.ns.xt.size = parm_size;
sym->u.ns.si.pc.value = value_id;
}
}
AdvanceITPtr();
if( !RecComma() ) break;
}
ReqCloseParen();
if( ReqNOpn() ) {
AdvanceITPtr();
ReqEOS();
}
}
static void CLIFree( void *p ) {
/******************************/
FMemFree( p );
}