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 compare_expression: proc(ap,bp) reducible returns(bit(1) aligned);
 12 
 13 dcl       (ap,bp) ptr;        /* pointers at nodes to be compared */
 14 
 15 dcl       (a,b,r) ptr,
 16           (i,n) fixed bin,
 17           b_op_code bit(9) aligned,
 18           null builtin;
 19 
 20 %include list;
 21 %include nodes;
 22 %include operator;
 23 %include reference;
 24 %include symbol;
 25 %include op_codes;
 26 
 27           a = ap;
 28           b = bp;
 29 
 30           if a = b then goto exit;
 31 
 32           if a = null then goto fail;
 33           if b = null then goto fail;
 34 
 35           if a -> node.type ^= b -> node.type then goto fail;
 36 
 37           if a -> node.type = temporary_node then go to fail;
 38 
 39           if a -> node.type = token_node then go to fail;
 40 
 41           if a -> node.type = operator_node
 42           then do;
 43                b_op_code = b -> operator.op_code;
 44                if a -> operator.op_code ^= b_op_code then goto fail;
 45                if a -> operator.number ^= b -> operator.number then goto fail;
 46 
 47                do i = 1 to a -> operator.number;
 48                     if a -> operand(i) ^= b -> operand(i)
 49                     then if ^ compare_expression((a -> operand(i)),(b -> operand(i)))
 50                          then goto fail;
 51 
 52                     end;
 53 
 54                if b_op_code = std_call
 55                then do;
 56                     r = b -> operand(2);
 57                     if r -> node.type = operator_node
 58                          then r = r -> operand(1);
 59                     if r -> reference.symbol -> symbol.irreducible
 60                          then goto fail;
 61                     end;
 62 
 63                goto exit;
 64                end;
 65 
 66           if a -> node.type = list_node
 67           then do;
 68                if a -> list.number ^= b -> list.number then goto fail;
 69 
 70                do i = 1 to a -> list.number;
 71                     if a -> element(i) ^= b -> element(i)
 72                     then if ^ compare_expression((a -> element(i)),(b -> element(i)))
 73                          then goto fail;
 74 
 75                     end;
 76 
 77                goto exit;
 78                end;
 79 
 80           if a -> reference.symbol ^= b -> reference.symbol then goto fail;
 81           if a -> reference.c_length ^= b -> reference.c_length then goto fail;
 82           if a -> reference.c_offset ^= b -> reference.c_offset then goto fail;
 83           if a -> reference.units ^= b -> reference.units then goto fail;
 84           if a -> reference.array_ref ^= b -> reference.array_ref then goto fail;
 85           if a -> reference.modword_in_offset ^= b -> reference.modword_in_offset then goto fail;
 86 
 87           if a -> reference.length ^= b -> reference.length
 88           then if ^ compare_expression((a -> reference.length),(b -> reference.length))
 89                then goto fail;
 90 
 91           if a -> reference.offset ^= b -> reference.offset
 92           then if ^ compare_expression((a -> reference.offset),(b -> reference.offset))
 93                then goto fail;
 94 
 95           if a -> reference.qualifier ^= b -> reference.qualifier
 96           then if ^ compare_expression((a -> reference.qualifier),(b -> reference.qualifier))
 97                then goto fail;
 98 
 99 exit:     return("1"b);
100 
101 fail:     return("0"b);
102           end;