Example #1
0
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 );
}
Example #2
0
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();
    }
}