| /* data.c -- Implementation File (module.c template V1.0) |
| Copyright (C) 1995, 1996, 2002, 2003 Free Software Foundation, Inc. |
| Contributed by James Craig Burley. |
| |
| This file is part of GNU Fortran. |
| |
| GNU Fortran is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 2, or (at your option) |
| any later version. |
| |
| GNU Fortran is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with GNU Fortran; see the file COPYING. If not, write to |
| the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA |
| 02111-1307, USA. |
| |
| Related Modules: |
| |
| Description: |
| Do the tough things for DATA statement (and INTEGER FOO/.../-style |
| initializations), like implied-DO and suchlike. |
| |
| Modifications: |
| */ |
| |
| /* Include files. */ |
| |
| #include "proj.h" |
| #include "data.h" |
| #include "bit.h" |
| #include "bld.h" |
| #include "com.h" |
| #include "expr.h" |
| #include "global.h" |
| #include "malloc.h" |
| #include "st.h" |
| #include "storag.h" |
| #include "top.h" |
| |
| /* Externals defined here. */ |
| |
| |
| /* Simple definitions and enumerations. */ |
| |
| /* I picked this value as one that, when plugged into a couple of small |
| but nearly identical test cases I have called BIG-0.f and BIG-1.f, |
| causes BIG-1.f to take about 10 times as long (elapsed) to compile |
| (in f771 only) as BIG-0.f. These test cases differ in that BIG-0.f |
| doesn't put the one initialized variable in a common area that has |
| a large uninitialized array in it, while BIG-1.f does. The size of |
| the array is this many elements, as long as they all are INTEGER |
| type. Note that, as of 0.5.18, sparse cases are better handled, |
| so BIG-2.f now is used; it provides nonzero initial |
| values for all elements of the same array BIG-0 has. */ |
| #ifndef FFEDATA_sizeTOO_BIG_INIT_ |
| #define FFEDATA_sizeTOO_BIG_INIT_ 75*1024 |
| #endif |
| |
| /* Internal typedefs. */ |
| |
| typedef struct _ffedata_convert_cache_ *ffedataConvertCache_; |
| typedef struct _ffedata_impdo_ *ffedataImpdo_; |
| |
| /* Private include files. */ |
| |
| |
| /* Internal structure definitions. */ |
| |
| struct _ffedata_convert_cache_ |
| { |
| ffebld converted; /* Results of converting expr to following |
| type. */ |
| ffeinfoBasictype basic_type; |
| ffeinfoKindtype kind_type; |
| ffetargetCharacterSize size; |
| ffeinfoRank rank; |
| }; |
| |
| struct _ffedata_impdo_ |
| { |
| ffedataImpdo_ outer; /* Enclosing IMPDO construct. */ |
| ffebld outer_list; /* Item after my IMPDO on the outer list. */ |
| ffebld my_list; /* Beginning of list in my IMPDO. */ |
| ffesymbol itervar; /* Iteration variable. */ |
| ffetargetIntegerDefault increment; |
| ffetargetIntegerDefault final; |
| }; |
| |
| /* Static objects accessed by functions in this module. */ |
| |
| static ffedataImpdo_ ffedata_stack_ = NULL; |
| static ffebld ffedata_list_ = NULL; |
| static bool ffedata_reinit_; /* value_ should report REINIT error. */ |
| static bool ffedata_reported_error_; /* Error has been reported. */ |
| static ffesymbol ffedata_symbol_ = NULL; /* Symbol being initialized. */ |
| static ffeinfoBasictype ffedata_basictype_; /* Info on symbol. */ |
| static ffeinfoKindtype ffedata_kindtype_; |
| static ffestorag ffedata_storage_; /* If non-NULL, inits go into this parent. */ |
| static ffeinfoBasictype ffedata_storage_bt_; /* Info on storage. */ |
| static ffeinfoKindtype ffedata_storage_kt_; |
| static ffetargetOffset ffedata_storage_size_; /* Size of entire storage. */ |
| static ffetargetAlign ffedata_storage_units_; /* #units per storage unit. */ |
| static ffetargetOffset ffedata_arraysize_; /* Size of array being |
| inited. */ |
| static ffetargetOffset ffedata_expected_; /* Number of elements to |
| init. */ |
| static ffetargetOffset ffedata_number_; /* #elements inited so far. */ |
| static ffetargetOffset ffedata_offset_; /* Offset of next element. */ |
| static ffetargetOffset ffedata_symbolsize_; /* Size of entire sym. */ |
| static ffetargetCharacterSize ffedata_size_; /* Size of an element. */ |
| static ffetargetCharacterSize ffedata_charexpected_; /* #char to init. */ |
| static ffetargetCharacterSize ffedata_charnumber_; /* #chars inited. */ |
| static ffetargetCharacterSize ffedata_charoffset_; /* Offset of next char. */ |
| static ffedataConvertCache_ ffedata_convert_cache_; /* Fewer conversions. */ |
| static int ffedata_convert_cache_max_ = 0; /* #entries available. */ |
| static int ffedata_convert_cache_use_ = 0; /* #entries in use. */ |
| |
| /* Static functions (internal). */ |
| |
| static bool ffedata_advance_ (void); |
| static ffebld ffedata_convert_ (ffebld source, ffelexToken source_token, |
| ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt, |
| ffeinfoRank rk, ffetargetCharacterSize sz); |
| static ffetargetInteger1 ffedata_eval_integer1_ (ffebld expr); |
| static ffetargetOffset ffedata_eval_offset_ (ffebld subscripts, |
| ffebld dims); |
| static ffetargetCharacterSize ffedata_eval_substr_begin_ (ffebld expr); |
| static ffetargetCharacterSize ffedata_eval_substr_end_ (ffebld expr, |
| ffetargetCharacterSize min, ffetargetCharacterSize max); |
| static void ffedata_gather_ (ffestorag mst, ffestorag st); |
| static void ffedata_pop_ (void); |
| static void ffedata_push_ (void); |
| static bool ffedata_value_ (ffebld value, ffelexToken token); |
| |
| /* Internal macros. */ |
| |
| |
| /* ffedata_begin -- Initialize with list of targets |
| |
| ffebld list; |
| ffedata_begin(list); // ITEM... list of SYMTERs, ARRAYs, SUBSTRs, ... |
| |
| Remember the list. After this call, 0...n calls to ffedata_value must |
| follow, and then a single call to ffedata_end. */ |
| |
| void |
| ffedata_begin (ffebld list) |
| { |
| assert (ffedata_list_ == NULL); |
| ffedata_list_ = list; |
| ffedata_symbol_ = NULL; |
| ffedata_reported_error_ = FALSE; |
| ffedata_reinit_ = FALSE; |
| ffedata_advance_ (); |
| } |
| |
| /* ffedata_end -- End of initialization sequence |
| |
| if (ffedata_end(FALSE)) |
| // everything's ok |
| |
| Make sure the end of the list is valid here. */ |
| |
| bool |
| ffedata_end (bool reported_error, ffelexToken t) |
| { |
| reported_error |= ffedata_reported_error_; |
| |
| /* If still targets to initialize, too few initializers, so complain. */ |
| |
| if ((ffedata_symbol_ != NULL) && !reported_error) |
| { |
| reported_error = TRUE; |
| ffebad_start (FFEBAD_DATA_TOOFEW); |
| ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| } |
| |
| /* Pop off any impdo stacks (present only if ffedata_symbol_ != NULL). */ |
| |
| while (ffedata_stack_ != NULL) |
| ffedata_pop_ (); |
| |
| if (ffedata_list_ != NULL) |
| { |
| assert (reported_error); |
| ffedata_list_ = NULL; |
| } |
| |
| return TRUE; |
| } |
| |
| /* ffedata_gather -- Gather previously disparate initializations into one place |
| |
| ffestorag st; // A typeCBLOCK or typeLOCAL aggregate. |
| ffedata_gather(st); |
| |
| Prior to this call, st has no init or accretion info, but (presumably |
| at least one of) its subordinate storage areas has init or accretion |
| info. After this call, none of the subordinate storage areas has inits, |
| because they've all been moved into the newly created init/accretion |
| info for st. During this call, conflicting inits produce only one |
| error message. */ |
| |
| void |
| ffedata_gather (ffestorag st) |
| { |
| ffesymbol s; |
| ffebld b; |
| |
| /* Prepare info on the storage area we're putting init info into. */ |
| |
| ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_, |
| &ffedata_storage_units_, ffestorag_basictype (st), |
| ffestorag_kindtype (st)); |
| ffedata_storage_size_ = ffestorag_size (st) / ffedata_storage_units_; |
| assert (ffestorag_size (st) % ffedata_storage_units_ == 0); |
| |
| /* If a CBLOCK, gather all the init info for its explicit members. */ |
| |
| if ((ffestorag_type (st) == FFESTORAG_typeCBLOCK) |
| && (ffestorag_symbol (st) != NULL)) |
| { |
| s = ffestorag_symbol (st); |
| for (b = ffesymbol_commonlist (s); b != NULL; b = ffebld_trail (b)) |
| ffedata_gather_ (st, |
| ffesymbol_storage (ffebld_symter (ffebld_head (b)))); |
| } |
| |
| /* For CBLOCK or LOCAL, gather all the init info for equivalenced members. */ |
| |
| ffestorag_drive (ffestorag_list_equivs (st), ffedata_gather_, st); |
| } |
| |
| /* ffedata_value -- Provide some number of initial values |
| |
| ffebld value; |
| ffelexToken t; // Points to the value. |
| if (ffedata_value(1,value,t)) |
| // Everything's ok |
| |
| Makes sure the value is ok, then remembers it according to the list |
| provided to ffedata_begin. As many instances of the value may be |
| supplied as desired, as indicated by the first argument. */ |
| |
| bool |
| ffedata_value (ffetargetIntegerDefault rpt, ffebld value, ffelexToken token) |
| { |
| ffetargetIntegerDefault i; |
| |
| /* Maybe ignore zero values, to speed up compiling, even though we lose |
| checking for multiple initializations for now. */ |
| |
| if (!ffe_is_zeros () |
| && (value != NULL) |
| && (ffebld_op (value) == FFEBLD_opCONTER) |
| && ffebld_constant_is_zero (ffebld_conter (value))) |
| value = NULL; |
| else if ((value != NULL) |
| && (ffebld_op (value) == FFEBLD_opANY)) |
| value = NULL; |
| else |
| { |
| /* Must be a constant. */ |
| assert (value != NULL); |
| assert (ffebld_op (value) == FFEBLD_opCONTER); |
| } |
| |
| /* Later we can optimize certain cases by seeing that the target array can |
| take some number of values, and provide this number to _value_. */ |
| |
| if (rpt == 1) |
| ffedata_convert_cache_use_ = -1; /* Don't bother caching. */ |
| else |
| ffedata_convert_cache_use_ = 0; /* Maybe use the cache. */ |
| |
| for (i = 0; i < rpt; ++i) |
| { |
| if ((ffedata_symbol_ != NULL) |
| && !ffesymbol_is_init (ffedata_symbol_)) |
| { |
| ffesymbol_signal_change (ffedata_symbol_); |
| ffesymbol_update_init (ffedata_symbol_); |
| if (1 || ffe_is_90 ()) |
| ffesymbol_update_save (ffedata_symbol_); |
| #if FFEGLOBAL_ENABLED |
| if (ffesymbol_common (ffedata_symbol_) != NULL) |
| ffeglobal_init_common (ffesymbol_common (ffedata_symbol_), |
| token); |
| #endif |
| ffesymbol_signal_unreported (ffedata_symbol_); |
| } |
| if (!ffedata_value_ (value, token)) |
| return FALSE; |
| } |
| |
| return TRUE; |
| } |
| |
| /* ffedata_advance_ -- Advance initialization target to next item in list |
| |
| if (ffedata_advance_()) |
| // everything's ok |
| |
| Sets common info to characterize the next item in the list. Handles |
| IMPDO constructs accordingly. Does not handle advances within a single |
| item, as in the common extension "DATA CHARTYPE/33,34,35/", where |
| CHARTYPE is CHARACTER*3, for example. */ |
| |
| static bool |
| ffedata_advance_ (void) |
| { |
| ffebld next; |
| |
| /* Come here after handling an IMPDO. */ |
| |
| tail_recurse: /* :::::::::::::::::::: */ |
| |
| /* Assume we're not going to find a new target for now. */ |
| |
| ffedata_symbol_ = NULL; |
| |
| /* If at the end of the list, we're done. */ |
| |
| if (ffedata_list_ == NULL) |
| { |
| ffetargetIntegerDefault newval; |
| |
| if (ffedata_stack_ == NULL) |
| return TRUE; /* No IMPDO in progress, we is done! */ |
| |
| /* Iterate the IMPDO. */ |
| |
| newval = ffesymbol_value (ffedata_stack_->itervar) |
| + ffedata_stack_->increment; |
| |
| /* See if we're still in the loop. */ |
| |
| if (((ffedata_stack_->increment > 0) |
| ? newval > ffedata_stack_->final |
| : newval < ffedata_stack_->final) |
| || (((ffesymbol_value (ffedata_stack_->itervar) < 0) |
| == (ffedata_stack_->increment < 0)) |
| && ((ffesymbol_value (ffedata_stack_->itervar) < 0) |
| != (newval < 0)))) /* Overflow/underflow? */ |
| { /* Done with the loop. */ |
| ffedata_list_ = ffedata_stack_->outer_list; /* Restore list. */ |
| ffedata_pop_ (); /* Pop me off the impdo stack. */ |
| } |
| else |
| { /* Still in the loop, reset the list and |
| update the iter var. */ |
| ffedata_list_ = ffedata_stack_->my_list; /* Reset list. */ |
| ffesymbol_set_value (ffedata_stack_->itervar, newval); |
| } |
| goto tail_recurse; /* :::::::::::::::::::: */ |
| } |
| |
| /* Move to the next item in the list. */ |
| |
| next = ffebld_head (ffedata_list_); |
| ffedata_list_ = ffebld_trail (ffedata_list_); |
| |
| /* Really shouldn't happen. */ |
| |
| if (next == NULL) |
| return TRUE; |
| |
| /* See what kind of target this is. */ |
| |
| switch (ffebld_op (next)) |
| { |
| case FFEBLD_opSYMTER: /* Simple reference to scalar or array. */ |
| ffedata_symbol_ = ffebld_symter (next); |
| ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL |
| : ffestorag_parent (ffesymbol_storage (ffedata_symbol_)); |
| if (ffedata_storage_ != NULL) |
| { |
| ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_, |
| &ffedata_storage_units_, |
| ffestorag_basictype (ffedata_storage_), |
| ffestorag_kindtype (ffedata_storage_)); |
| ffedata_storage_size_ = ffestorag_size (ffedata_storage_) |
| / ffedata_storage_units_; |
| assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0); |
| } |
| |
| if ((ffesymbol_init (ffedata_symbol_) != NULL) |
| || (ffesymbol_accretion (ffedata_symbol_) != NULL) |
| || ((ffedata_storage_ != NULL) |
| && (ffestorag_init (ffedata_storage_) != NULL))) |
| { |
| #if 0 |
| ffebad_start (FFEBAD_DATA_REINIT); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| #else |
| ffedata_reinit_ = TRUE; |
| return TRUE; |
| #endif |
| } |
| ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_); |
| ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_); |
| if (ffesymbol_rank (ffedata_symbol_) == 0) |
| ffedata_arraysize_ = 1; |
| else |
| { |
| ffebld size = ffesymbol_arraysize (ffedata_symbol_); |
| |
| assert (size != NULL); |
| assert (ffebld_op (size) == FFEBLD_opCONTER); |
| assert (ffeinfo_basictype (ffebld_info (size)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (size)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter |
| (size)); |
| } |
| ffedata_expected_ = ffedata_arraysize_; |
| ffedata_number_ = 0; |
| ffedata_offset_ = 0; |
| ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER) |
| ? ffesymbol_size (ffedata_symbol_) : 1; |
| ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_; |
| ffedata_charexpected_ = ffedata_size_; |
| ffedata_charnumber_ = 0; |
| ffedata_charoffset_ = 0; |
| break; |
| |
| case FFEBLD_opARRAYREF: /* Reference to element of array. */ |
| ffedata_symbol_ = ffebld_symter (ffebld_left (next)); |
| ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL |
| : ffestorag_parent (ffesymbol_storage (ffedata_symbol_)); |
| if (ffedata_storage_ != NULL) |
| { |
| ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_, |
| &ffedata_storage_units_, |
| ffestorag_basictype (ffedata_storage_), |
| ffestorag_kindtype (ffedata_storage_)); |
| ffedata_storage_size_ = ffestorag_size (ffedata_storage_) |
| / ffedata_storage_units_; |
| assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0); |
| } |
| |
| if ((ffesymbol_init (ffedata_symbol_) != NULL) |
| || ((ffedata_storage_ != NULL) |
| && (ffestorag_init (ffedata_storage_) != NULL))) |
| { |
| #if 0 |
| ffebad_start (FFEBAD_DATA_REINIT); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| #else |
| ffedata_reinit_ = TRUE; |
| return TRUE; |
| #endif |
| } |
| ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_); |
| ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_); |
| if (ffesymbol_rank (ffedata_symbol_) == 0) |
| ffedata_arraysize_ = 1; /* Shouldn't happen in this case... */ |
| else |
| { |
| ffebld size = ffesymbol_arraysize (ffedata_symbol_); |
| |
| assert (size != NULL); |
| assert (ffebld_op (size) == FFEBLD_opCONTER); |
| assert (ffeinfo_basictype (ffebld_info (size)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (size)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter |
| (size)); |
| } |
| ffedata_expected_ = 1; |
| ffedata_number_ = 0; |
| ffedata_offset_ = ffedata_eval_offset_ (ffebld_right (next), |
| ffesymbol_dims (ffedata_symbol_)); |
| ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER) |
| ? ffesymbol_size (ffedata_symbol_) : 1; |
| ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_; |
| ffedata_charexpected_ = ffedata_size_; |
| ffedata_charnumber_ = 0; |
| ffedata_charoffset_ = 0; |
| break; |
| |
| case FFEBLD_opSUBSTR: /* Substring reference to scalar or array |
| element. */ |
| { |
| bool arrayref = ffebld_op (ffebld_left (next)) == FFEBLD_opARRAYREF; |
| ffebld colon = ffebld_right (next); |
| |
| assert (colon != NULL); |
| |
| ffedata_symbol_ = ffebld_symter (ffebld_left (arrayref |
| ? ffebld_left (next) : next)); |
| ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL |
| : ffestorag_parent (ffesymbol_storage (ffedata_symbol_)); |
| if (ffedata_storage_ != NULL) |
| { |
| ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_, |
| &ffedata_storage_units_, |
| ffestorag_basictype (ffedata_storage_), |
| ffestorag_kindtype (ffedata_storage_)); |
| ffedata_storage_size_ = ffestorag_size (ffedata_storage_) |
| / ffedata_storage_units_; |
| assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0); |
| } |
| |
| if ((ffesymbol_init (ffedata_symbol_) != NULL) |
| || ((ffedata_storage_ != NULL) |
| && (ffestorag_init (ffedata_storage_) != NULL))) |
| { |
| #if 0 |
| ffebad_start (FFEBAD_DATA_REINIT); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| #else |
| ffedata_reinit_ = TRUE; |
| return TRUE; |
| #endif |
| } |
| ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_); |
| ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_); |
| if (ffesymbol_rank (ffedata_symbol_) == 0) |
| ffedata_arraysize_ = 1; |
| else |
| { |
| ffebld size = ffesymbol_arraysize (ffedata_symbol_); |
| |
| assert (size != NULL); |
| assert (ffebld_op (size) == FFEBLD_opCONTER); |
| assert (ffeinfo_basictype (ffebld_info (size)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (size)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter |
| (size)); |
| } |
| ffedata_expected_ = arrayref ? 1 : ffedata_arraysize_; |
| ffedata_number_ = 0; |
| ffedata_offset_ = arrayref ? ffedata_eval_offset_ (ffebld_right |
| (ffebld_left (next)), ffesymbol_dims (ffedata_symbol_)) : 0; |
| ffedata_size_ = ffesymbol_size (ffedata_symbol_); |
| ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_; |
| ffedata_charnumber_ = 0; |
| ffedata_charoffset_ = ffedata_eval_substr_begin_ (ffebld_head (colon)); |
| ffedata_charexpected_ = ffedata_eval_substr_end_ (ffebld_head |
| (ffebld_trail (colon)), ffedata_charoffset_, |
| ffedata_size_) - ffedata_charoffset_ + 1; |
| } |
| break; |
| |
| case FFEBLD_opIMPDO: /* Implied-DO construct. */ |
| { |
| ffebld itervar; |
| ffebld start; |
| ffebld end; |
| ffebld incr; |
| ffebld item = ffebld_right (next); |
| |
| itervar = ffebld_head (item); |
| item = ffebld_trail (item); |
| start = ffebld_head (item); |
| item = ffebld_trail (item); |
| end = ffebld_head (item); |
| item = ffebld_trail (item); |
| incr = ffebld_head (item); |
| |
| ffedata_push_ (); |
| ffedata_stack_->outer_list = ffedata_list_; |
| ffedata_stack_->my_list = ffedata_list_ = ffebld_left (next); |
| |
| assert (ffeinfo_basictype (ffebld_info (itervar)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (itervar)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffedata_stack_->itervar = ffebld_symter (itervar); |
| if (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER) |
| { |
| ffebad_start (FFEBAD_DATA_EVAL); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_finish (); |
| ffedata_pop_ (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| assert (ffeinfo_basictype (ffebld_info (start)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (start)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffesymbol_set_value (ffedata_stack_->itervar, ffedata_eval_integer1_ (start)); |
| if (ffeinfo_basictype (ffebld_info (end)) != FFEINFO_basictypeINTEGER) |
| { |
| ffebad_start (FFEBAD_DATA_EVAL); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_finish (); |
| ffedata_pop_ (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| assert (ffeinfo_basictype (ffebld_info (end)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (end)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffedata_stack_->final = ffedata_eval_integer1_ (end); |
| |
| if (incr == NULL) |
| ffedata_stack_->increment = 1; |
| else |
| { |
| if (ffeinfo_basictype (ffebld_info (incr)) != FFEINFO_basictypeINTEGER) |
| { |
| ffebad_start (FFEBAD_DATA_EVAL); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_finish (); |
| ffedata_pop_ (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| assert (ffeinfo_basictype (ffebld_info (incr)) |
| == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (incr)) |
| == FFEINFO_kindtypeINTEGERDEFAULT); |
| ffedata_stack_->increment = ffedata_eval_integer1_ (incr); |
| if (ffedata_stack_->increment == 0) |
| { |
| ffebad_start (FFEBAD_DATA_ZERO); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_stack_->itervar)); |
| ffebad_finish (); |
| ffedata_pop_ (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| } |
| |
| if ((ffedata_stack_->increment > 0) |
| ? ffesymbol_value (ffedata_stack_->itervar) |
| > ffedata_stack_->final |
| : ffesymbol_value (ffedata_stack_->itervar) |
| < ffedata_stack_->final) |
| { |
| ffedata_reported_error_ = TRUE; |
| ffebad_start (FFEBAD_DATA_EMPTY); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_stack_->itervar)); |
| ffebad_finish (); |
| ffedata_pop_ (); |
| return FALSE; |
| } |
| } |
| goto tail_recurse; /* :::::::::::::::::::: */ |
| |
| case FFEBLD_opANY: |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| |
| default: |
| assert ("bad op" == NULL); |
| break; |
| } |
| |
| return TRUE; |
| } |
| |
| /* ffedata_convert_ -- Convert source expression to given type using cache |
| |
| ffebld source; |
| ffelexToken source_token; |
| ffelexToken dest_token; // Any appropriate token for "destination". |
| ffeinfoBasictype bt; |
| ffeinfoKindtype kt; |
| ffetargetCharactersize sz; |
| source = ffedata_convert_(source,source_token,dest_token,bt,kt,sz); |
| |
| Like ffeexpr_convert, but calls it only if necessary (if the converted |
| expression doesn't already exist in the cache) and then puts the result |
| in the cache. */ |
| |
| static ffebld |
| ffedata_convert_ (ffebld source, ffelexToken source_token, |
| ffelexToken dest_token, ffeinfoBasictype bt, |
| ffeinfoKindtype kt, ffeinfoRank rk, |
| ffetargetCharacterSize sz) |
| { |
| ffebld converted; |
| int i; |
| int max; |
| ffedataConvertCache_ cache; |
| |
| for (i = 0; i < ffedata_convert_cache_use_; ++i) |
| if ((bt == ffedata_convert_cache_[i].basic_type) |
| && (kt == ffedata_convert_cache_[i].kind_type) |
| && (sz == ffedata_convert_cache_[i].size) |
| && (rk == ffedata_convert_cache_[i].rank)) |
| return ffedata_convert_cache_[i].converted; |
| |
| converted = ffeexpr_convert (source, source_token, dest_token, bt, kt, rk, |
| sz, FFEEXPR_contextDATA); |
| |
| if (ffedata_convert_cache_use_ >= ffedata_convert_cache_max_) |
| { |
| if (ffedata_convert_cache_max_ == 0) |
| max = 4; |
| else |
| max = ffedata_convert_cache_max_ << 1; |
| |
| if (max > ffedata_convert_cache_max_) |
| { |
| cache = malloc_new_ks (malloc_pool_image (), |
| "FFEDATA cache", max * sizeof (*cache)); |
| if (ffedata_convert_cache_max_ != 0) |
| { |
| memcpy (cache, ffedata_convert_cache_, |
| ffedata_convert_cache_max_ * sizeof (*cache)); |
| malloc_kill_ks (malloc_pool_image (), ffedata_convert_cache_, |
| ffedata_convert_cache_max_ * sizeof (*cache)); |
| } |
| ffedata_convert_cache_ = cache; |
| ffedata_convert_cache_max_ = max; |
| } |
| else |
| return converted; /* In case int overflows! */ |
| } |
| |
| i = ffedata_convert_cache_use_++; |
| |
| ffedata_convert_cache_[i].converted = converted; |
| ffedata_convert_cache_[i].basic_type = bt; |
| ffedata_convert_cache_[i].kind_type = kt; |
| ffedata_convert_cache_[i].size = sz; |
| ffedata_convert_cache_[i].rank = rk; |
| |
| return converted; |
| } |
| |
| /* ffedata_eval_integer1_ -- Evaluate expression |
| |
| ffetargetIntegerDefault result; |
| ffebld expr; // must be kindtypeINTEGER1. |
| |
| result = ffedata_eval_integer1_(expr); |
| |
| Evalues the expression (which yields a kindtypeINTEGER1 result) and |
| returns the result. */ |
| |
| static ffetargetIntegerDefault |
| ffedata_eval_integer1_ (ffebld expr) |
| { |
| ffetargetInteger1 result; |
| ffebad error; |
| |
| assert (expr != NULL); |
| |
| switch (ffebld_op (expr)) |
| { |
| case FFEBLD_opCONTER: |
| return ffebld_constant_integer1 (ffebld_conter (expr)); |
| |
| case FFEBLD_opSYMTER: |
| return ffesymbol_value (ffebld_symter (expr)); |
| |
| case FFEBLD_opUPLUS: |
| return ffedata_eval_integer1_ (ffebld_left (expr)); |
| |
| case FFEBLD_opUMINUS: |
| error = ffetarget_uminus_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr))); |
| break; |
| |
| case FFEBLD_opADD: |
| error = ffetarget_add_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opSUBTRACT: |
| error = ffetarget_subtract_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opMULTIPLY: |
| error = ffetarget_multiply_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opDIVIDE: |
| error = ffetarget_divide_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opPOWER: |
| { |
| ffebld r = ffebld_right (expr); |
| |
| if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER) |
| || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT)) |
| error = FFEBAD_DATA_EVAL; |
| else |
| error = ffetarget_power_integerdefault_integerdefault (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (r)); |
| } |
| break; |
| |
| #if 0 /* Only for character basictype. */ |
| case FFEBLD_opCONCATENATE: |
| error =; |
| break; |
| #endif |
| |
| case FFEBLD_opNOT: |
| error = ffetarget_not_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr))); |
| break; |
| |
| #if 0 /* Only for logical basictype. */ |
| case FFEBLD_opLT: |
| error =; |
| break; |
| |
| case FFEBLD_opLE: |
| error =; |
| break; |
| |
| case FFEBLD_opEQ: |
| error =; |
| break; |
| |
| case FFEBLD_opNE: |
| error =; |
| break; |
| |
| case FFEBLD_opGT: |
| error =; |
| break; |
| |
| case FFEBLD_opGE: |
| error =; |
| break; |
| #endif |
| |
| case FFEBLD_opAND: |
| error = ffetarget_and_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opOR: |
| error = ffetarget_or_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opXOR: |
| error = ffetarget_xor_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opEQV: |
| error = ffetarget_eqv_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opNEQV: |
| error = ffetarget_neqv_integer1 (&result, |
| ffedata_eval_integer1_ (ffebld_left (expr)), |
| ffedata_eval_integer1_ (ffebld_right (expr))); |
| break; |
| |
| case FFEBLD_opPAREN: |
| return ffedata_eval_integer1_ (ffebld_left (expr)); |
| |
| #if 0 /* ~~ no idea how to do this */ |
| case FFEBLD_opPERCENT_LOC: |
| error =; |
| break; |
| #endif |
| |
| #if 0 /* not allowed by ANSI, but perhaps as an |
| extension someday? */ |
| case FFEBLD_opCONVERT: |
| switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr)))) |
| { |
| case FFEINFO_basictypeINTEGER: |
| switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr)))) |
| { |
| default: |
| error = FFEBAD_DATA_EVAL; |
| break; |
| } |
| break; |
| |
| case FFEINFO_basictypeREAL: |
| switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr)))) |
| { |
| default: |
| error = FFEBAD_DATA_EVAL; |
| break; |
| } |
| break; |
| } |
| break; |
| #endif |
| |
| #if 0 /* not valid ops */ |
| case FFEBLD_opREPEAT: |
| error =; |
| break; |
| |
| case FFEBLD_opBOUNDS: |
| error =; |
| break; |
| #endif |
| |
| #if 0 /* not allowed by ANSI, but perhaps as an |
| extension someday? */ |
| case FFEBLD_opFUNCREF: |
| error =; |
| break; |
| #endif |
| |
| #if 0 /* not valid ops */ |
| case FFEBLD_opSUBRREF: |
| error =; |
| break; |
| |
| case FFEBLD_opARRAYREF: |
| error =; |
| break; |
| #endif |
| |
| #if 0 /* not valid for integer1 */ |
| case FFEBLD_opSUBSTR: |
| error =; |
| break; |
| #endif |
| |
| default: |
| error = FFEBAD_DATA_EVAL; |
| break; |
| } |
| |
| if (error != FFEBAD) |
| { |
| ffebad_start (error); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_finish (); |
| result = 0; |
| } |
| |
| return result; |
| } |
| |
| /* ffedata_eval_offset_ -- Evaluate offset info array |
| |
| ffetargetOffset offset; // 0...max-1. |
| ffebld subscripts; // an opITEM list of subscript exprs. |
| ffebld dims; // an opITEM list of opBOUNDS exprs. |
| |
| result = ffedata_eval_offset_(expr); |
| |
| Evalues the expression (which yields a kindtypeINTEGER1 result) and |
| returns the result. */ |
| |
| static ffetargetOffset |
| ffedata_eval_offset_ (ffebld subscripts, ffebld dims) |
| { |
| ffetargetIntegerDefault offset = 0; |
| ffetargetIntegerDefault width = 1; |
| ffetargetIntegerDefault value; |
| ffetargetIntegerDefault lowbound; |
| ffetargetIntegerDefault highbound; |
| ffetargetOffset final; |
| ffebld subscript; |
| ffebld dim; |
| ffebld low; |
| ffebld high; |
| int rank = 0; |
| bool ok; |
| |
| while (subscripts != NULL) |
| { |
| ffeinfoKindtype sub_kind, low_kind, hi_kind; |
| ffebld sub1, low1, hi1; |
| |
| ++rank; |
| assert (dims != NULL); |
| |
| subscript = ffebld_head (subscripts); |
| dim = ffebld_head (dims); |
| |
| assert (ffeinfo_basictype (ffebld_info (subscript)) == FFEINFO_basictypeINTEGER); |
| if (ffebld_op (subscript) == FFEBLD_opCONTER) |
| { |
| /* Force to default - it's a constant expression ! */ |
| sub_kind = ffeinfo_kindtype (ffebld_info (subscript)); |
| sub1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val ( |
| sub_kind == FFEINFO_kindtypeINTEGER2 ? subscript->u.conter.expr->u.integer2 : |
| sub_kind == FFEINFO_kindtypeINTEGER3 ? subscript->u.conter.expr->u.integer3 : |
| sub_kind == FFEINFO_kindtypeINTEGER4 ? subscript->u.conter.expr->u.integer4 : |
| subscript->u.conter.expr->u.integer1), NULL); |
| value = ffedata_eval_integer1_ (sub1); |
| } |
| else |
| value = ffedata_eval_integer1_ (subscript); |
| |
| assert (ffebld_op (dim) == FFEBLD_opBOUNDS); |
| low = ffebld_left (dim); |
| high = ffebld_right (dim); |
| |
| if (low == NULL) |
| lowbound = 1; |
| else |
| { |
| assert (ffeinfo_basictype (ffebld_info (low)) == FFEINFO_basictypeINTEGER); |
| if (ffebld_op (low) == FFEBLD_opCONTER) |
| { |
| /* Force to default - it's a constant expression ! */ |
| low_kind = ffeinfo_kindtype (ffebld_info (low)); |
| low1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val ( |
| low_kind == FFEINFO_kindtypeINTEGER2 ? low->u.conter.expr->u.integer2 : |
| low_kind == FFEINFO_kindtypeINTEGER3 ? low->u.conter.expr->u.integer3 : |
| low_kind == FFEINFO_kindtypeINTEGER4 ? low->u.conter.expr->u.integer4 : |
| low->u.conter.expr->u.integer1), NULL); |
| lowbound = ffedata_eval_integer1_ (low1); |
| } |
| else |
| lowbound = ffedata_eval_integer1_ (low); |
| } |
| |
| assert (ffeinfo_basictype (ffebld_info (high)) == FFEINFO_basictypeINTEGER); |
| if (ffebld_op (high) == FFEBLD_opCONTER) |
| { |
| /* Force to default - it's a constant expression ! */ |
| hi_kind = ffeinfo_kindtype (ffebld_info (high)); |
| hi1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val ( |
| hi_kind == FFEINFO_kindtypeINTEGER2 ? high->u.conter.expr->u.integer2 : |
| hi_kind == FFEINFO_kindtypeINTEGER3 ? high->u.conter.expr->u.integer3 : |
| hi_kind == FFEINFO_kindtypeINTEGER4 ? high->u.conter.expr->u.integer4 : |
| high->u.conter.expr->u.integer1), NULL); |
| highbound = ffedata_eval_integer1_ (hi1); |
| } |
| else |
| highbound = ffedata_eval_integer1_ (high); |
| |
| if ((value < lowbound) || (value > highbound)) |
| { |
| char rankstr[10]; |
| |
| sprintf (rankstr, "%d", rank); |
| value = lowbound; |
| ffebad_start (FFEBAD_DATA_SUBSCRIPT); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_string (rankstr); |
| ffebad_finish (); |
| } |
| |
| subscripts = ffebld_trail (subscripts); |
| dims = ffebld_trail (dims); |
| |
| offset += width * (value - lowbound); |
| if (subscripts != NULL) |
| width *= highbound - lowbound + 1; |
| } |
| |
| assert (dims == NULL); |
| |
| ok = ffetarget_offset (&final, offset); |
| assert (ok); |
| |
| return final; |
| } |
| |
| /* ffedata_eval_substr_begin_ -- Evaluate begin-point of substr reference |
| |
| ffetargetCharacterSize beginpoint; |
| ffebld endval; // head(colon). |
| |
| beginpoint = ffedata_eval_substr_end_(endval); |
| |
| If beginval is NULL, returns 0. Otherwise makes sure beginval is |
| kindtypeINTEGERDEFAULT, makes sure its value is > 0, |
| and returns its value minus one, or issues an error message. */ |
| |
| static ffetargetCharacterSize |
| ffedata_eval_substr_begin_ (ffebld expr) |
| { |
| ffetargetIntegerDefault val; |
| |
| if (expr == NULL) |
| return 0; |
| |
| assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGERDEFAULT); |
| |
| val = ffedata_eval_integer1_ (expr); |
| |
| if (val < 1) |
| { |
| val = 1; |
| ffebad_start (FFEBAD_DATA_RANGE); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| } |
| |
| return val - 1; |
| } |
| |
| /* ffedata_eval_substr_end_ -- Evaluate end-point of substr reference |
| |
| ffetargetCharacterSize endpoint; |
| ffebld endval; // head(trail(colon)). |
| ffetargetCharacterSize min; // beginpoint of substr reference. |
| ffetargetCharacterSize max; // size of entity. |
| |
| endpoint = ffedata_eval_substr_end_(endval,dflt); |
| |
| If endval is NULL, returns max. Otherwise makes sure endval is |
| kindtypeINTEGERDEFAULT, makes sure its value is > min and <= max, |
| and returns its value minus one, or issues an error message. */ |
| |
| static ffetargetCharacterSize |
| ffedata_eval_substr_end_ (ffebld expr, ffetargetCharacterSize min, |
| ffetargetCharacterSize max) |
| { |
| ffetargetIntegerDefault val; |
| |
| if (expr == NULL) |
| return max - 1; |
| |
| assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER); |
| assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER1); |
| |
| val = ffedata_eval_integer1_ (expr); |
| |
| if ((val < (ffetargetIntegerDefault) min) |
| || (val > (ffetargetIntegerDefault) max)) |
| { |
| val = 1; |
| ffebad_start (FFEBAD_DATA_RANGE); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| } |
| |
| return val - 1; |
| } |
| |
| /* ffedata_gather_ -- Gather initial values for sym into master sym inits |
| |
| ffestorag mst; // A typeCBLOCK or typeLOCAL aggregate. |
| ffestorag st; // A typeCOMMON or typeEQUIV member. |
| ffedata_gather_(mst,st); |
| |
| If st has any initialization info, transfer that info into mst and |
| clear st's info. */ |
| |
| static void |
| ffedata_gather_ (ffestorag mst, ffestorag st) |
| { |
| ffesymbol s; |
| ffesymbol s_whine; /* Symbol to complain about in diagnostics. */ |
| ffebld b; |
| ffetargetOffset offset; |
| ffetargetOffset units_expected; |
| ffebitCount actual; |
| ffebldConstantArray array; |
| ffebld accter; |
| ffetargetCopyfunc fn; |
| void *ptr1; |
| void *ptr2; |
| size_t size; |
| ffeinfoBasictype bt; |
| ffeinfoKindtype kt; |
| ffeinfoBasictype ign_bt; |
| ffeinfoKindtype ign_kt; |
| ffetargetAlign units; |
| ffebit bits; |
| ffetargetOffset source_offset; |
| bool whine = FALSE; |
| |
| if (st == NULL) |
| return; /* Nothing to do. */ |
| |
| s = ffestorag_symbol (st); |
| |
| assert (s != NULL); /* Must have a corresponding symbol (else how |
| inited?). */ |
| assert (ffestorag_init (st) == NULL); /* No init info on storage itself. */ |
| assert (ffestorag_accretion (st) == NULL); |
| |
| if ((((b = ffesymbol_init (s)) == NULL) |
| && ((b = ffesymbol_accretion (s)) == NULL)) |
| || (ffebld_op (b) == FFEBLD_opANY) |
| || ((ffebld_op (b) == FFEBLD_opCONVERT) |
| && (ffebld_op (ffebld_left (b)) == FFEBLD_opANY))) |
| return; /* Nothing to do. */ |
| |
| /* b now holds the init/accretion expr. */ |
| |
| ffesymbol_set_init (s, NULL); |
| ffesymbol_set_accretion (s, NULL); |
| ffesymbol_set_accretes (s, 0); |
| |
| s_whine = ffestorag_symbol (mst); |
| if (s_whine == NULL) |
| s_whine = s; |
| |
| /* Make sure we haven't fully accreted during an array init. */ |
| |
| if (ffestorag_init (mst) != NULL) |
| { |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ()); |
| ffebad_string (ffesymbol_text (s_whine)); |
| ffebad_finish (); |
| return; |
| } |
| |
| bt = ffeinfo_basictype (ffebld_info (b)); |
| kt = ffeinfo_kindtype (ffebld_info (b)); |
| |
| /* Calculate offset for aggregate area. */ |
| |
| ffedata_charexpected_ = (bt == FFEINFO_basictypeCHARACTER) |
| ? ffebld_size (b) : 1; |
| ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, bt, |
| kt);/* Find out unit size of source datum. */ |
| assert (units % ffedata_storage_units_ == 0); |
| units_expected = ffedata_charexpected_ * units / ffedata_storage_units_; |
| offset = (ffestorag_offset (st) - ffestorag_offset (mst)) |
| / ffedata_storage_units_; |
| |
| /* Does an accretion array exist? If not, create it. */ |
| |
| if (ffestorag_accretion (mst) == NULL) |
| { |
| #if FFEDATA_sizeTOO_BIG_INIT_ != 0 |
| if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_) |
| { |
| char bignum[40]; |
| |
| sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_); |
| ffebad_start (FFEBAD_TOO_BIG_INIT); |
| ffebad_here (0, ffesymbol_where_line (s_whine), |
| ffesymbol_where_column (s_whine)); |
| ffebad_string (ffesymbol_text (s_whine)); |
| ffebad_string (bignum); |
| ffebad_finish (); |
| } |
| #endif |
| array = ffebld_constantarray_new (ffedata_storage_bt_, |
| ffedata_storage_kt_, ffedata_storage_size_); |
| accter = ffebld_new_accter (array, ffebit_new (ffe_pool_program_unit (), |
| ffedata_storage_size_)); |
| ffebld_set_info (accter, ffeinfo_new |
| (ffedata_storage_bt_, |
| ffedata_storage_kt_, |
| 1, |
| FFEINFO_kindENTITY, |
| FFEINFO_whereCONSTANT, |
| (ffedata_basictype_ == FFEINFO_basictypeCHARACTER) |
| ? 1 : FFETARGET_charactersizeNONE)); |
| ffestorag_set_accretion (mst, accter); |
| ffestorag_set_accretes (mst, ffedata_storage_size_); |
| } |
| else |
| { |
| accter = ffestorag_accretion (mst); |
| assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter)); |
| array = ffebld_accter (accter); |
| } |
| |
| /* Put value in accretion array at desired offset. */ |
| |
| fn = ffetarget_aggregate_ptr_memcpy (ffedata_storage_bt_, ffedata_storage_kt_, |
| bt, kt); |
| |
| switch (ffebld_op (b)) |
| { |
| case FFEBLD_opCONTER: |
| ffebld_constantarray_prepare (&ptr1, &ptr2, &size, array, ffedata_storage_bt_, |
| ffedata_storage_kt_, offset, |
| ffebld_constant_ptr_to_union (ffebld_conter (b)), |
| bt, kt); |
| (*fn) (ptr1, ptr2, size); /* Does the appropriate memcpy-like |
| operation. */ |
| ffebit_count (ffebld_accter_bits (accter), |
| offset, FALSE, units_expected, &actual); /* How many FALSE? */ |
| if (units_expected != (ffetargetOffset) actual) |
| { |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ()); |
| ffebad_string (ffesymbol_text (s)); |
| ffebad_finish (); |
| } |
| ffestorag_set_accretes (mst, |
| ffestorag_accretes (mst) |
| - actual); /* Decrement # of values |
| actually accreted. */ |
| ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected); |
| |
| /* If done accreting for this storage area, establish as initialized. */ |
| |
| if (ffestorag_accretes (mst) == 0) |
| { |
| ffestorag_set_init (mst, accter); |
| ffestorag_set_accretion (mst, NULL); |
| ffebit_kill (ffebld_accter_bits (ffestorag_init (mst))); |
| ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER); |
| ffebld_set_arrter (ffestorag_init (mst), |
| ffebld_accter (ffestorag_init (mst))); |
| ffebld_arrter_set_size (ffestorag_init (mst), |
| ffedata_storage_size_); |
| ffebld_arrter_set_pad (ffestorag_init (mst), 0); |
| ffecom_notify_init_storage (mst); |
| } |
| |
| return; |
| |
| case FFEBLD_opARRTER: |
| ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_, |
| ffedata_storage_kt_, offset, ffebld_arrter (b), |
| bt, kt); |
| size *= ffebld_arrter_size (b); |
| units_expected *= ffebld_arrter_size (b); |
| (*fn) (ptr1, ptr2, size); /* Does the appropriate memcpy-like |
| operation. */ |
| ffebit_count (ffebld_accter_bits (accter), |
| offset, FALSE, units_expected, &actual); /* How many FALSE? */ |
| if (units_expected != (ffetargetOffset) actual) |
| { |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ()); |
| ffebad_string (ffesymbol_text (s)); |
| ffebad_finish (); |
| } |
| ffestorag_set_accretes (mst, |
| ffestorag_accretes (mst) |
| - actual); /* Decrement # of values |
| actually accreted. */ |
| ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected); |
| |
| /* If done accreting for this storage area, establish as initialized. */ |
| |
| if (ffestorag_accretes (mst) == 0) |
| { |
| ffestorag_set_init (mst, accter); |
| ffestorag_set_accretion (mst, NULL); |
| ffebit_kill (ffebld_accter_bits (ffestorag_init (mst))); |
| ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER); |
| ffebld_set_arrter (ffestorag_init (mst), |
| ffebld_accter (ffestorag_init (mst))); |
| ffebld_arrter_set_size (ffestorag_init (mst), |
| ffedata_storage_size_); |
| ffebld_arrter_set_pad (ffestorag_init (mst), 0); |
| ffecom_notify_init_storage (mst); |
| } |
| |
| return; |
| |
| case FFEBLD_opACCTER: |
| ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_, |
| ffedata_storage_kt_, offset, ffebld_accter (b), |
| bt, kt); |
| bits = ffebld_accter_bits (b); |
| source_offset = 0; |
| |
| for (;;) |
| { |
| ffetargetOffset unexp; |
| ffetargetOffset siz; |
| ffebitCount length; |
| bool value; |
| |
| ffebit_test (bits, source_offset, &value, &length); |
| if (length == 0) |
| break; /* Exit the loop early. */ |
| siz = size * length; |
| unexp = units_expected * length; |
| if (value) |
| { |
| (*fn) (ptr1, ptr2, siz); /* Does memcpy-like operation. */ |
| ffebit_count (ffebld_accter_bits (accter), /* How many FALSE? */ |
| offset, FALSE, unexp, &actual); |
| if (!whine && (unexp != (ffetargetOffset) actual)) |
| { |
| whine = TRUE; /* Don't whine more than once for one gather. */ |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ()); |
| ffebad_string (ffesymbol_text (s)); |
| ffebad_finish (); |
| } |
| ffestorag_set_accretes (mst, |
| ffestorag_accretes (mst) |
| - actual); /* Decrement # of values |
| actually accreted. */ |
| ffebit_set (ffebld_accter_bits (accter), offset, 1, unexp); |
| } |
| source_offset += length; |
| offset += unexp; |
| ptr1 = ((char *) ptr1) + siz; |
| ptr2 = ((char *) ptr2) + siz; |
| } |
| |
| /* If done accreting for this storage area, establish as initialized. */ |
| |
| if (ffestorag_accretes (mst) == 0) |
| { |
| ffestorag_set_init (mst, accter); |
| ffestorag_set_accretion (mst, NULL); |
| ffebit_kill (ffebld_accter_bits (ffestorag_init (mst))); |
| ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER); |
| ffebld_set_arrter (ffestorag_init (mst), |
| ffebld_accter (ffestorag_init (mst))); |
| ffebld_arrter_set_size (ffestorag_init (mst), |
| ffedata_storage_size_); |
| ffebld_arrter_set_pad (ffestorag_init (mst), 0); |
| ffecom_notify_init_storage (mst); |
| } |
| |
| return; |
| |
| default: |
| assert ("bad init op in gather_" == NULL); |
| return; |
| } |
| } |
| |
| /* ffedata_pop_ -- Pop an impdo stack entry |
| |
| ffedata_pop_(); */ |
| |
| static void |
| ffedata_pop_ (void) |
| { |
| ffedataImpdo_ victim = ffedata_stack_; |
| |
| assert (victim != NULL); |
| |
| ffedata_stack_ = ffedata_stack_->outer; |
| |
| malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim)); |
| } |
| |
| /* ffedata_push_ -- Push an impdo stack entry |
| |
| ffedata_push_(); */ |
| |
| static void |
| ffedata_push_ (void) |
| { |
| ffedataImpdo_ baby; |
| |
| baby = malloc_new_ks (ffe_pool_program_unit (), "ffedataImpdo_", sizeof (*baby)); |
| |
| baby->outer = ffedata_stack_; |
| ffedata_stack_ = baby; |
| } |
| |
| /* ffedata_value_ -- Provide an initial value |
| |
| ffebld value; |
| ffelexToken t; // Points to the value. |
| if (ffedata_value(value,t)) |
| // Everything's ok |
| |
| Makes sure the value is ok, then remembers it according to the list |
| provided to ffedata_begin. */ |
| |
| static bool |
| ffedata_value_ (ffebld value, ffelexToken token) |
| { |
| |
| /* If already reported an error, don't do anything. */ |
| |
| if (ffedata_reported_error_) |
| return FALSE; |
| |
| /* If the value is an error marker, remember we've seen one and do nothing |
| else. */ |
| |
| if ((value != NULL) |
| && (ffebld_op (value) == FFEBLD_opANY)) |
| { |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| /* If too many values (no more targets), complain. */ |
| |
| if (ffedata_symbol_ == NULL) |
| { |
| ffebad_start (FFEBAD_DATA_TOOMANY); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| /* If ffedata_advance_ wanted to register a complaint, do it now |
| that we have the token to point at instead of just the start |
| of the whole statement. */ |
| |
| if (ffedata_reinit_) |
| { |
| ffebad_start (FFEBAD_DATA_REINIT); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| #if FFEGLOBAL_ENABLED |
| if (ffesymbol_common (ffedata_symbol_) != NULL) |
| ffeglobal_init_common (ffesymbol_common (ffedata_symbol_), token); |
| #endif |
| |
| /* Convert value to desired type. */ |
| |
| if (value != NULL) |
| { |
| if (ffedata_convert_cache_use_ == -1) |
| value = ffeexpr_convert |
| (value, token, NULL, ffedata_basictype_, |
| ffedata_kindtype_, 0, |
| (ffedata_basictype_ == FFEINFO_basictypeCHARACTER) |
| ? ffedata_charexpected_ : FFETARGET_charactersizeNONE, |
| FFEEXPR_contextDATA); |
| else /* Use the cache. */ |
| value = ffedata_convert_ |
| (value, token, NULL, ffedata_basictype_, |
| ffedata_kindtype_, 0, |
| (ffedata_basictype_ == FFEINFO_basictypeCHARACTER) |
| ? ffedata_charexpected_ : FFETARGET_charactersizeNONE); |
| } |
| |
| /* If we couldn't, bug out. */ |
| |
| if ((value != NULL) && (ffebld_op (value) == FFEBLD_opANY)) |
| { |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| /* Handle the case where initializes go to a parent's storage area. */ |
| |
| if (ffedata_storage_ != NULL) |
| { |
| ffetargetOffset offset; |
| ffetargetOffset units_expected; |
| ffebitCount actual; |
| ffebldConstantArray array; |
| ffebld accter; |
| ffetargetCopyfunc fn; |
| void *ptr1; |
| void *ptr2; |
| size_t size; |
| ffeinfoBasictype ign_bt; |
| ffeinfoKindtype ign_kt; |
| ffetargetAlign units; |
| |
| /* Make sure we haven't fully accreted during an array init. */ |
| |
| if (ffestorag_init (ffedata_storage_) != NULL) |
| { |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| /* Calculate offset. */ |
| |
| offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_; |
| |
| /* Is offset within range? If not, whine, but don't do anything else. */ |
| |
| if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_) |
| { |
| ffebad_start (FFEBAD_DATA_RANGE); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| /* Now calculate offset for aggregate area. */ |
| |
| ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, ffedata_basictype_, |
| ffedata_kindtype_); /* Find out unit size of |
| source datum. */ |
| assert (units % ffedata_storage_units_ == 0); |
| units_expected = ffedata_charexpected_ * units / ffedata_storage_units_; |
| offset *= units / ffedata_storage_units_; |
| offset += (ffestorag_offset (ffesymbol_storage (ffedata_symbol_)) |
| - ffestorag_offset (ffedata_storage_)) |
| / ffedata_storage_units_; |
| |
| assert (offset + units_expected - 1 <= ffedata_storage_size_); |
| |
| /* Does an accretion array exist? If not, create it. */ |
| |
| if (value != NULL) |
| { |
| if (ffestorag_accretion (ffedata_storage_) == NULL) |
| { |
| #if FFEDATA_sizeTOO_BIG_INIT_ != 0 |
| if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_) |
| { |
| char bignum[40]; |
| |
| sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_); |
| ffebad_start (FFEBAD_TOO_BIG_INIT); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_string (bignum); |
| ffebad_finish (); |
| } |
| #endif |
| array = ffebld_constantarray_new |
| (ffedata_storage_bt_, ffedata_storage_kt_, |
| ffedata_storage_size_); |
| accter = ffebld_new_accter (array, |
| ffebit_new (ffe_pool_program_unit (), |
| ffedata_storage_size_)); |
| ffebld_set_info (accter, ffeinfo_new |
| (ffedata_storage_bt_, |
| ffedata_storage_kt_, |
| 1, |
| FFEINFO_kindENTITY, |
| FFEINFO_whereCONSTANT, |
| (ffedata_basictype_ |
| == FFEINFO_basictypeCHARACTER) |
| ? 1 : FFETARGET_charactersizeNONE)); |
| ffestorag_set_accretion (ffedata_storage_, accter); |
| ffestorag_set_accretes (ffedata_storage_, ffedata_storage_size_); |
| } |
| else |
| { |
| accter = ffestorag_accretion (ffedata_storage_); |
| assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter)); |
| array = ffebld_accter (accter); |
| } |
| |
| /* Put value in accretion array at desired offset. */ |
| |
| fn = ffetarget_aggregate_ptr_memcpy |
| (ffedata_storage_bt_, ffedata_storage_kt_, |
| ffedata_basictype_, ffedata_kindtype_); |
| ffebld_constantarray_prepare |
| (&ptr1, &ptr2, &size, array, ffedata_storage_bt_, |
| ffedata_storage_kt_, offset, |
| ffebld_constant_ptr_to_union (ffebld_conter (value)), |
| ffedata_basictype_, ffedata_kindtype_); |
| (*fn) (ptr1, ptr2, size); /* Does the appropriate memcpy-like |
| operation. */ |
| ffebit_count (ffebld_accter_bits (accter), |
| offset, FALSE, units_expected, |
| &actual); /* How many FALSE? */ |
| if (units_expected != (ffetargetOffset) actual) |
| { |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| } |
| ffestorag_set_accretes (ffedata_storage_, |
| ffestorag_accretes (ffedata_storage_) |
| - actual); /* Decrement # of values |
| actually accreted. */ |
| ffebit_set (ffebld_accter_bits (accter), offset, |
| 1, units_expected); |
| |
| /* If done accreting for this storage area, establish as |
| initialized. */ |
| |
| if (ffestorag_accretes (ffedata_storage_) == 0) |
| { |
| ffestorag_set_init (ffedata_storage_, accter); |
| ffestorag_set_accretion (ffedata_storage_, NULL); |
| ffebit_kill (ffebld_accter_bits |
| (ffestorag_init (ffedata_storage_))); |
| ffebld_set_op (ffestorag_init (ffedata_storage_), |
| FFEBLD_opARRTER); |
| ffebld_set_arrter |
| (ffestorag_init (ffedata_storage_), |
| ffebld_accter (ffestorag_init (ffedata_storage_))); |
| ffebld_arrter_set_size (ffestorag_init (ffedata_storage_), |
| ffedata_storage_size_); |
| ffebld_arrter_set_pad (ffestorag_init (ffedata_storage_), |
| 0); |
| ffecom_notify_init_storage (ffedata_storage_); |
| } |
| } |
| |
| /* If still accreting, adjust specs accordingly and return. */ |
| |
| if (++ffedata_number_ < ffedata_expected_) |
| { |
| ++ffedata_offset_; |
| return TRUE; |
| } |
| |
| return ffedata_advance_ (); |
| } |
| |
| /* Figure out where the value goes -- in an accretion array or directly |
| into the final initial-value slot for the symbol. */ |
| |
| if ((ffedata_number_ != 0) |
| || (ffedata_arraysize_ > 1) |
| || (ffedata_charnumber_ != 0) |
| || (ffedata_size_ > ffedata_charexpected_)) |
| { /* Accrete this value. */ |
| ffetargetOffset offset; |
| ffebitCount actual; |
| ffebldConstantArray array; |
| ffebld accter = NULL; |
| |
| /* Calculate offset. */ |
| |
| offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_; |
| |
| /* Is offset within range? If not, whine, but don't do anything else. */ |
| |
| if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_) |
| { |
| ffebad_start (FFEBAD_DATA_RANGE); |
| ffest_ffebad_here_current_stmt (0); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| ffedata_reported_error_ = TRUE; |
| return FALSE; |
| } |
| |
| /* Does an accretion array exist? If not, create it. */ |
| |
| if (value != NULL) |
| { |
| if (ffesymbol_accretion (ffedata_symbol_) == NULL) |
| { |
| #if FFEDATA_sizeTOO_BIG_INIT_ != 0 |
| if (ffedata_symbolsize_ >= FFEDATA_sizeTOO_BIG_INIT_ ) |
| { |
| char bignum[40]; |
| |
| sprintf (&bignum[0], "%ld", (long) ffedata_symbolsize_); |
| ffebad_start (FFEBAD_TOO_BIG_INIT); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_string (bignum); |
| ffebad_finish (); |
| } |
| #endif |
| array = ffebld_constantarray_new |
| (ffedata_basictype_, ffedata_kindtype_, |
| ffedata_symbolsize_); |
| accter = ffebld_new_accter (array, |
| ffebit_new (ffe_pool_program_unit (), |
| ffedata_symbolsize_)); |
| ffebld_set_info (accter, ffeinfo_new |
| (ffedata_basictype_, |
| ffedata_kindtype_, |
| 1, |
| FFEINFO_kindENTITY, |
| FFEINFO_whereCONSTANT, |
| (ffedata_basictype_ |
| == FFEINFO_basictypeCHARACTER) |
| ? 1 : FFETARGET_charactersizeNONE)); |
| ffesymbol_set_accretion (ffedata_symbol_, accter); |
| ffesymbol_set_accretes (ffedata_symbol_, ffedata_symbolsize_); |
| } |
| else |
| { |
| accter = ffesymbol_accretion (ffedata_symbol_); |
| assert (ffedata_symbolsize_ |
| == (ffetargetOffset) ffebld_accter_size (accter)); |
| array = ffebld_accter (accter); |
| } |
| |
| /* Put value in accretion array at desired offset. */ |
| |
| ffebld_constantarray_put |
| (array, ffedata_basictype_, ffedata_kindtype_, |
| offset, ffebld_constant_union (ffebld_conter (value))); |
| ffebit_count (ffebld_accter_bits (accter), offset, FALSE, |
| ffedata_charexpected_, |
| &actual); /* How many FALSE? */ |
| if (actual != (unsigned long int) ffedata_charexpected_) |
| { |
| ffebad_start (FFEBAD_DATA_MULTIPLE); |
| ffebad_here (0, ffelex_token_where_line (token), |
| ffelex_token_where_column (token)); |
| ffebad_string (ffesymbol_text (ffedata_symbol_)); |
| ffebad_finish (); |
| } |
| ffesymbol_set_accretes (ffedata_symbol_, |
| ffesymbol_accretes (ffedata_symbol_) |
| - actual); /* Decrement # of values |
| actually accreted. */ |
| ffebit_set (ffebld_accter_bits (accter), offset, |
| 1, ffedata_charexpected_); |
| ffesymbol_signal_unreported (ffedata_symbol_); |
| } |
| |
| /* If still accreting, adjust specs accordingly and return. */ |
| |
| if (++ffedata_number_ < ffedata_expected_) |
| { |
| ++ffedata_offset_; |
| return TRUE; |
| } |
| |
| /* Else, if done accreting for this symbol, establish as initialized. */ |
| |
| if ((value != NULL) |
| && (ffesymbol_accretes (ffedata_symbol_) == 0)) |
| { |
| ffesymbol_set_init (ffedata_symbol_, accter); |
| ffesymbol_set_accretion (ffedata_symbol_, NULL); |
| ffebit_kill (ffebld_accter_bits (ffesymbol_init (ffedata_symbol_))); |
| ffebld_set_op (ffesymbol_init (ffedata_symbol_), FFEBLD_opARRTER); |
| ffebld_set_arrter (ffesymbol_init (ffedata_symbol_), |
| ffebld_accter (ffesymbol_init (ffedata_symbol_))); |
| ffebld_arrter_set_size (ffesymbol_init (ffedata_symbol_), |
| ffedata_symbolsize_); |
| ffebld_arrter_set_pad (ffestorag_init (ffedata_symbol_), 0); |
| ffecom_notify_init_symbol (ffedata_symbol_); |
| } |
| } |
| else if (value != NULL) |
| { |
| /* Simple, direct, one-shot assignment. */ |
| ffesymbol_set_init (ffedata_symbol_, value); |
| ffecom_notify_init_symbol (ffedata_symbol_); |
| } |
| |
| /* Call on advance function to get next target in list. */ |
| |
| return ffedata_advance_ (); |
| } |