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 show_declaration: proc;
 12 
 13 /*        Modified: 29 Nov 1979 by PCK to print tree level indented listing */
 14 /*        Modified: 25 Jun 1980 by PCK to properly indent block listing */
 15 
 16 dcl       missing(10) bit(1) int static,
 17           (i,j,n,code) fixed bin(17),
 18           tree_level fixed bin initial(0),
 19           p ptr,
 20           display_symbol ext entry(ptr,fixed bin),
 21           symb(10) char(68) varying int static,
 22           cu_$arg_count ext entry(fixed bin(17)),
 23           cu_$arg_ptr ext entry(fixed bin(17),ptr,fixed bin(17),fixed bin(17)),
 24           n_args fixed bin(17) int static,
 25           ioa_ ext entry options(variable),
 26           pl1_stat_$root ptr ext static;
 27 
 28 dcl       (length,null) builtin;
 29 
 30 dcl       arg_string char(n) based;
 31 
 32 %include block;
 33 %include symbol;
 34 
 35           call cu_$arg_count(n_args);
 36           if n_args=0 then return;
 37 
 38           j = 0;
 39           do i = 1 to n_args;
 40                call cu_$arg_ptr(i,p,n,code);
 41 
 42                if code ^= 0
 43                then do;
 44                     call ioa_("NO ARG ^d",i);
 45                     return;
 46                     end;
 47 
 48                if n = 0 then go to loop;
 49 
 50                if j >= 10
 51                then do;
 52                     call ioa_("Only 10 symbols allowed");
 53                     n_args = 10;
 54                     goto l;
 55                     end;
 56 
 57                j = j + 1;
 58                symb(j) = p -> arg_string;
 59                missing(j) = "1"b;
 60 loop:     end;
 61 
 62           if j = 0 then return;
 63           n_args=j;
 64 
 65 l:        call search(pl1_stat_$root,tree_level+1);
 66 
 67           do i = 1 to n_args;
 68                if missing(i)
 69                then call ioa_("No declaration found for ^a",symb(i));
 70                end;
 71 
 72           return;
 73 
 74 search:        proc(pt,tree_level);
 75 
 76 dcl            pt ptr;        /* points at block node */
 77 dcl            tree_level fixed bin;
 78 
 79 dcl       (p,q) ptr;
 80 
 81 %include token;
 82 
 83                if pt = null then return;
 84 
 85                call ioa_("^/^vxStart of block ^p",tree_level,pt);
 86 
 87                p = pt -> block.declaration;
 88                do while(p ^= null);
 89 
 90                     q = p -> symbol.token;
 91                     n = q -> token.size;
 92 
 93                     do i = 1 to n_args;
 94                          if n = length(symb(i))
 95                          then if symb(i) = q -> token.string
 96                          then do;
 97                               missing(i) = "0"b;
 98                               call display_symbol(p,tree_level+1);
 99                               goto do_next;
100                               end;
101                     end;
102 
103 do_next:            p = p -> symbol.next;
104                     end;
105 
106                q = pt -> block.son;
107 
108                do while(q^=null);
109                     call search((q),tree_level+1);
110                     q = q -> block.brother;
111                end;
112 
113                call ioa_("^vxEnd of block ^p^/",tree_level,pt);
114                end;
115 
116           end show_declaration;