include/ntuple/qp_exe_var.h

0001 /*
0002  *  qp_exe_var.h  --
0003  *
0004  *  Original: 17-Jan-1995 12:02
0005  *
0006  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0007  *
0008  *  $Id$
0009  *
0010  *  $Log$
0011  *  Revision 1.7  1996/04/23 18:38:35  maartenb
0012  *  - Add RCS keywords
0013  *
0014  *
0015  */
0016
0017 {
0018     register RefCWN     *np;
0019     Int32           *ptr;
0020     int         index, size;
0021     bool            info_flag;
0022
0023     index = *pc++;
0024
0025     np = &CWNBlock[index];
0026
0027     if ( (opc & FC_DYNAMIC_INFO_BIT) != 0 ) {
0028         info_flag = TRUE;
0029         SHAPE_LOAD(pc);
0030     }
0031
0032     switch ( fc ) {
0033
0034     case FC_CWN_SCA_BOOL:
0035         NEW_FRAME( D_BOOL, 1, ptr );
0036         *ptr = *np->p;
0037         break;
0038
0039     case FC_CWN_SCA_UINT:
0040         NEW_FRAME( D_UINT, 1, ptr );
0041         *ptr = *np->p;
0042         break;
0043
0044     case FC_CWN_SCA_ULONG:
0045         NEW_FRAME( D_ULONG, 1, ptr );
0046         *((UInt64 *)ptr) = *((UInt64 *)np->p);
0047         break;
0048
0049     case FC_CWN_SCA_INT:
0050         NEW_FRAME( D_INT, 1, ptr );
0051         *ptr = *np->p;
0052         break;
0053
0054     case FC_CWN_SCA_LONG:
0055         NEW_FRAME( D_LONG, 1, ptr );
0056         *((Int64 *)ptr) = *((Int64 *)np->p);
0057         break;
0058
0059     case FC_CWN_SCA_FLOAT:
0060         NEW_FRAME( D_FLOAT, 1, ptr );
0061         *ptr = *np->p;
0062         break;
0063
0064     case FC_CWN_SCA_DOUBLE:
0065         NEW_FRAME( D_DOUBLE, 1, ptr );
0066         *((Float64 *)ptr) = *((Float64 *)np->p);
0067         break;
0068
0069     case FC_CWN_SCA_STR:
0070         NEW_FRAME( D_STR, 1, ptr );
0071         (void) memset( ptr, ' ', QP_STR_MAX );
0072         (void) memcpy( ptr, np->p, np->isize );
0073         break;
0074
0075
0076     case FC_CWN_MAT_BOOL:
0077         size = np->var_base;
0078         if ( np->varDim ) {
0079             size *= *CWNBlock[np->var_index].p ;
0080             if ( info_flag ) {
0081                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0082             }
0083         }
0084         NEW_FRAME( D_BOOL, size, ptr );
0085         (void) memcpy( ptr, np->p, size << 2 );
0086         break;
0087
0088     case FC_CWN_MAT_UINT:
0089         size = np->var_base;
0090         if ( np->varDim ) {
0091             size *= *CWNBlock[np->var_index].p ;
0092             if ( info_flag ) {
0093                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0094             }
0095         }
0096         NEW_FRAME( D_UINT, size, ptr );
0097         (void) memcpy( ptr, np->p, size << 2 );
0098         break;
0099
0100     case FC_CWN_MAT_ULONG:
0101         size = np->var_base;
0102         if ( np->varDim ) {
0103             size *= *CWNBlock[np->var_index].p ;
0104             if ( info_flag ) {
0105                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0106             }
0107         }
0108         NEW_FRAME( D_ULONG, size, ptr );
0109         (void) memcpy( ptr, np->p, size << 3 );
0110         break;
0111
0112     case FC_CWN_MAT_INT:
0113         size = np->var_base;
0114         if ( np->varDim ) {
0115             size *= *CWNBlock[np->var_index].p ;
0116             if ( info_flag ) {
0117                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0118             }
0119         }
0120         NEW_FRAME( D_INT, size, ptr );
0121         (void) memcpy( ptr, np->p, size << 2 );
0122         break;
0123
0124     case FC_CWN_MAT_LONG:
0125         size = np->var_base;
0126         if ( np->varDim ) {
0127             size *= *CWNBlock[np->var_index].p ;
0128             if ( info_flag ) {
0129                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0130             }
0131         }
0132         NEW_FRAME( D_LONG, size, ptr );
0133         (void) memcpy( ptr, np->p, size << 3 );
0134         break;
0135
0136     case FC_CWN_MAT_FLOAT:
0137         size = np->var_base;
0138         if ( np->varDim ) {
0139             size *= *CWNBlock[np->var_index].p ;
0140             if ( info_flag ) {
0141                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0142             }
0143         }
0144         NEW_FRAME( D_FLOAT, size, ptr );
0145         (void) memcpy( ptr, np->p, size << 2 );
0146         break;
0147
0148     case FC_CWN_MAT_DOUBLE:
0149         size = np->var_base;
0150         if ( np->varDim ) {
0151             size *= *CWNBlock[np->var_index].p ;
0152             if ( info_flag ) {
0153                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0154             }
0155         }
0156         NEW_FRAME( D_DOUBLE, size, ptr );
0157         (void) memcpy( ptr, np->p, size << 3 );
0158         break;
0159
0160     case FC_CWN_MAT_STR:
0161         size = np->var_base;
0162         if ( np->varDim ) {
0163             size *= *CWNBlock[np->var_index].p ;
0164             if ( info_flag ) {
0165                 SHAPE_ADJUST(*CWNBlock[np->var_index].p);
0166             }
0167         }
0168         NEW_FRAME( D_STR, size, ptr );
0169         (void) memset( ptr, ' ', size * QP_STR_MAX );
0170         {
0171             register int    i, n;
0172             register char   *source, *dest;
0173
0174             n = np->isize;
0175             source = (char *) np->p;
0176             dest = (char *) ptr;
0177             for ( i = size ; i > 0 ; i-- ) {
0178                 (void) memcpy( dest, source, n );
0179                 dest += QP_STR_MAX;
0180                 source += n;
0181             }
0182         }
0183         break;
0184
0185
0186     case FC_RWN_SCA_LOAD:
0187         qp_assert( 0 <= index && index < MAX_RWN_COLS );
0188         NEW_FRAME( D_FLOAT, 1, ptr );
0189         *(Float32 *)ptr = PAWIDN.x[index];
0190         break;
0191
0192     default:
0193         sf_report( "qp_exe_var.h: Unkown Fcode ( %d )\n", fc );
0194         *errp = R_INTERNAL_ERROR;
0195         running = FALSE;
0196         break;
0197     }
0198 }