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_statement: proc(string);
 12 
 13 /*        Modified: 29 Nov 1979 by PCK to print a tree level indented listing */
 14 /*        Modified: 24 Jun 1980 by PCK to properly indent the output of show_stm */
 15 
 16 dcl       string    char(*);  /* source id of statement to show */
 17 
 18 dcl       (k,n) fixed bin(15),
 19           tree_level fixed bin initial(0),
 20           ln fixed bin(15),
 21           (sn,fn) fixed bin(6),
 22           p ptr,
 23           number int static fixed bin(31),
 24           any int static bit(1),
 25           pl1_stat_$root ptr ext,
 26           ioa_ entry options(variable),
 27           cv_dec_ entry(char(*) aligned) returns(fixed bin),
 28           display_statement entry(ptr,bit(1) aligned,fixed bin);
 29 
 30 dcl       (fixed,index,null,substr) builtin;
 31 
 32 
 33 %include block;
 34 %include statement;
 35 
 36 if pl1_stat_$root = null
 37    then do;
 38           call ioa_("No tree available");
 39           return;
 40         end;
 41 if string = "" then do;
 42           call ioa_("show_statement line#.statement# (s# is opt.)");
 43           return;
 44           end;
 45 
 46           fn = 0;
 47 
 48           n = index(string,".");
 49 
 50           if n = 0
 51           then do;
 52                any = "1"b;
 53                ln = cv_dec_((string));
 54                sn = 0;
 55                end;
 56           else do;
 57                any = "0"b;
 58                k = index(substr(string,n+1),".");
 59                if k = 0
 60                then do;
 61                     ln = cv_dec_(substr(string,1,n-1));
 62                     sn = cv_dec_(substr(string,n+1));
 63                     end;
 64                else do;
 65                     fn = cv_dec_(substr(string,1,n-1));
 66                     ln = cv_dec_(substr(string,n+1,k-1));
 67                     sn = cv_dec_(substr(string,n+k+1));
 68                     end;
 69                end;
 70 
 71           if any then call ioa_("Searching for line ^d",ln);
 72           else call ioa_("Searching for statement ^d on line ^d",sn,ln);
 73 
 74           number = 0;
 75           call show_stm(pl1_stat_$root -> block.son,tree_level+1);
 76 
 77           if number = 0 then call ioa_("Statement not found.");
 78 
 79 show_stm:      proc(ptx,tree_level);
 80 
 81 dcl            ptx ptr unaligned;
 82 dcl            tree_level fixed bin;
 83 
 84 dcl            (p,q,pt) ptr;
 85 
 86                pt = ptx;
 87                if pt = null then return;
 88 
 89                call ioa_("^/^vxStart of block ^p",tree_level,pt);
 90 
 91                p = pt -> block.prologue;
 92 
 93                call check_stm(p,tree_level);
 94 
 95                p = pt -> block.main;
 96 
 97                call check_stm(p,tree_level);
 98 
 99                q = pt -> block.son;
100 
101 
102 
103                do while(q^=null);
104                     call show_stm((q),tree_level+1);
105                     q = q -> block.brother;
106                end;
107 
108                call ioa_("^vxEnd of block ^p^/",tree_level,pt);
109 
110                end;
111 
112 
113 check_stm:     proc(pt,tree_level);
114 
115 dcl            (pt,q) ptr,
116                tree_level fixed bin,
117                this_sn fixed bin(9);
118 
119                q = pt;
120                do while(q ^= null);
121 
122                     if any then this_sn = 0;
123                     else this_sn = fixed(q -> statement.statement_number,5);
124 
125                     if fixed(q -> statement.line_number,14) = ln
126                     then if this_sn = sn
127                          then if fixed(q -> statement.file_number,8) = fn
128                               then do;
129                                    number = number + 1;
130                                    call display_statement(q,"1"b,tree_level+1);
131                                    end;
132 
133                     q = q -> statement.next;
134                     end;
135 
136                end;
137 
138           end;