sym_id STConst( void *ptr, TYPE typ, uint size ) {
//=================================================
// Search the symbol table for a constant. If the constant is not in the
// symbol table, add it to the symbol table.
unsigned hash_value;
sym_id head;
sym_id tail;
ftn_type *c_ptr = ptr;
if( _IsTypeLogical( typ ) ) {
c_ptr->logstar4 = c_ptr->logstar1;
}
hash_value = CalcHash( ptr, size );
head = ConstHashTable[ hash_value ].h_head;
if( head != NULL ) {
tail = ConstHashTable[ hash_value ].h_tail;
for(;;) {
if( head->u.cn.typ == typ ) {
if( memcmp( c_ptr, &head->u.cn.value, size ) == 0 ) {
return( head );
}
}
if( head == tail ) break;
head = head->u.cn.link;
}
}
head = FMemAlloc( sizeof( constant ) - sizeof( ftn_type ) + size );
memcpy( &head->u.cn.value, c_ptr, size );
head->u.cn.typ = typ;
head->u.cn.size = size;
head->u.cn.address = NULL;
HashInsert( ConstHashTable, hash_value, &CList, head );
return( head );
}
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();
}
}