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(); } }