1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* procedure to merge attributes from t (template) into s (symbol).
 12    Return value is "1"b if some attribute could not be merged, else "0"b
 13    Modified 780712 by PG to modify s only if no errors occurred
 14 */
 15 
 16 merge_attributes:
 17           procedure (bv_s, bv_t) returns (bit (1) aligned);
 18 
 19 /* parameters */
 20 
 21 declare   (bv_s, bv_t) ptr parameter;
 22 
 23 /* automatic */
 24 
 25 declare   (dummy_qualifier, s, t) ptr;
 26 declare   1 dummy aligned like symbol;
 27 declare   e bit(1) aligned;
 28 
 29 /* builtins */
 30 
 31 declare   (null,string) builtin;
 32 
 33 /* program */
 34 
 35           t = bv_t;
 36           s = bv_s;
 37 
 38           /* Make a copy of s in case an error is found later... */
 39 
 40           dummy = s -> symbol;                              /* structure assignment */
 41           dummy_qualifier = dummy.reference -> reference.qualifier;
 42           e = "0"b;
 43 
 44           /* Now merge into the dummy symbol, setting the error flag if applicable. */
 45 
 46           string(dummy.attributes) = string(dummy.attributes) | string(t->symbol.attributes);
 47 
 48           if dummy.initial = null
 49           then dummy.initial = copy_expression(t->symbol.initial);
 50           else if t->symbol.initial ^= null then e="1"b;
 51 
 52           if dummy.general = null
 53           then dummy.general = t->symbol.general;
 54           else if t->symbol.general ^= null then e="1"b;
 55 
 56           if dummy.equivalence = null
 57           then dummy.equivalence = t->symbol.equivalence;
 58           else if t->symbol.equivalence ^= null then e="1"b;
 59 
 60           if dummy.array = null
 61           then dummy.array = copy_expression(t->symbol.array);
 62           else if t->symbol.array ^= null then e="1"b;
 63 
 64           if dummy_qualifier = null
 65           then dummy_qualifier = t->symbol.reference->reference.qualifier;
 66           else if t->symbol.reference->reference.qualifier ^= null then e = "1"b;
 67 
 68           if dummy.dcl_size = null
 69           then if t->symbol.returns
 70                then if t->symbol.dcl_size ^= null
 71                     then do;
 72                          dummy.dcl_size = copy_expression(t->symbol.dcl_size);
 73                          dummy.dcl_size->symbol.token =
 74                               create_token(dummy.token->token.string||"[return_value]",(identifier));
 75                          end;
 76                     else;
 77                else dummy.dcl_size = copy_expression(t->symbol.dcl_size);
 78           else if t->symbol.dcl_size ^= null then e="1"b;
 79 
 80           if dummy.c_dcl_size = 0
 81           then do;
 82                     dummy.c_dcl_size = t->symbol.c_dcl_size;
 83                     dummy.scale = t->symbol.scale;
 84                end;
 85           else do;
 86                     if t->symbol.c_dcl_size ^= 0 then e="1"b;
 87                     if t->symbol.scale ^= 0 then e="1"b;
 88                end;
 89 
 90           /* If no errors were discovered, it is OK to change the input node. */
 91 
 92           if e = "0"b
 93           then do;
 94                     s -> symbol = dummy;                    /* structure assignment */
 95                     dummy.reference -> reference.qualifier = dummy_qualifier;
 96                end;
 97 
 98           return(e);
 99 
100 /* include files */
101 
102 %include symbol;
103 %include reference;
104 %include token;
105 %include token_types;
106 %include language_utility;
107 
108      end /* merge attributes */;