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 free_node:          proc(arg);
 12 
 13 dcl       (arg,p,q) ptr,
 14           nodetype fixed bin(15);
 15 
 16 dcl       pl1_stat_$free_ptr(18) ptr ext static;
 17 
 18 dcl       (fixed,null) builtin;
 19 
 20 
 21 
 22 %include pl1_tree_areas;
 23 %include nodes;
 24 %include symbol;
 25 %include token;
 26 %include block;
 27 %include statement;
 28 %include reference;
 29 %include array;
 30 %include list;
 31 %include context;
 32 %include label;
 33 %include operator;
 34 
 35                               /*   ^L   */
 36 
 37           p = arg;
 38           if p=null then goto ret;
 39 
 40           nodetype = fixed(p->node.type,15,0);
 41 
 42           if p->node.type=operator_node
 43           then do;
 44                     if p->operator.number=2
 45                     then do;
 46                               nodetype = fixed(list_node,15,0);
 47                               goto free_list;
 48                     end;
 49 
 50                     if p->operator.number^=3 then goto ret;
 51 
 52 free_operator:
 53                     p->operand(1) = pl1_stat_$free_ptr(nodetype);
 54 
 55                     goto set;
 56           end;
 57 
 58           if p->node.type=list_node | p->node.type=label_array_element_node
 59           then do;
 60                     if p->list.number=3
 61                     then do;
 62                               nodetype = fixed(operator_node,15,0);
 63                               goto free_operator;
 64                     end;
 65 
 66                     if p->list.number^=2 then goto ret;
 67 
 68 free_list:
 69                     p->list.element(1) = pl1_stat_$free_ptr(nodetype);
 70 
 71                     goto set;
 72           end;
 73 
 74           if p->node.type=reference_node
 75           then do;
 76                     p->reference.symbol = pl1_stat_$free_ptr(nodetype);
 77 
 78                     goto set;
 79           end;
 80 
 81           if p->node.type=symbol_node
 82           then do;
 83                     if p->symbol.block_node^=null
 84                     then      if p->symbol.block_node->block.end_declaration=p
 85                               then      goto ret;
 86 
 87                     p->symbol.next = pl1_stat_$free_ptr(nodetype);
 88 
 89                     if p->symbol.token ^= null
 90                     then do;
 91                               if p->symbol.token->token.declaration=p
 92                               then do;
 93                                         p->symbol.token->token.declaration = p->symbol.multi_use;
 94 
 95                                         goto set;
 96                               end;
 97 
 98                               q = p;
 99 
100                               do while(q->symbol.multi_use^=p);
101                                         q = q->symbol.multi_use;
102                               end;
103 
104                               q->symbol.multi_use = p->symbol.multi_use;
105                     end;
106 
107                     goto set;
108           end;
109 
110           if p->node.type=statement_node
111           then do;
112                     p->statement.back->statement.next = p->statement.next;
113                     p->statement.next->statement.back = p->statement.back;
114 
115                     p->statement.next = pl1_stat_$free_ptr(nodetype);
116 
117                     goto set;
118           end;
119 
120           goto ret;
121 
122 set:
123           pl1_stat_$free_ptr(nodetype) = p;
124 
125 ret:
126 
127 end free_node;