COMPILATION LISTING OF SEGMENT fort_display Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/27/84 0814.9 mst Thu Options: optimize map 1 /* ****************************************************** 2* * * 3* * Copyright, (C) Honeywell Limited, 1983 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* ****************************************************** */ 9 10 /* format: style3,^delnl,ifthenstmt,^indattr,indcom,indend,^inditerdo,^indnoniterdo,indnoniterend,linecom */ 11 fort_display: 12 proc options (variable); 13 14 /* Written: June 1976 eew 15* 16*Modified: 17* 31 January 1977 David Levin - fix bug with "display" cmd. 18* 24 February 1977 Gabriel Chang - to display the quadruple region. 19* 25 October 1978 Paul Smee - changes for large common and arrays. 20**/ 21 22 dcl display_entries$fdisplay entry (ptr) external static variable; 23 24 dcl com_err_ entry options (variable); 25 dcl cu_$arg_count entry (fixed bin); 26 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 27 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 28 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 29 30 dcl arg_ptr ptr; 31 dcl code fixed bin (35); 32 dcl p_name char (12) aligned int static options (constant) init ("fort_display"); 33 34 dcl (i, nargs, arg_len) fixed bin; 35 dcl j fixed bin (18); 36 dcl arg_error bit (1) aligned; 37 dcl decimal_base bit (1) aligned; 38 dcl have_value bit (1) aligned; 39 dcl starting_offset_set bit (1) aligned; 40 dcl stopping_offset_set bit (1) aligned; 41 dcl two_args bit (1) aligned; 42 43 dcl an_arg char (arg_len) based (arg_ptr); 44 45 dcl (addr, string, unspec, verify) builtin; 46 47 dcl 1 command_structure structure aligned, 1 1 1 2 /* BEGIN fort_command_structure.incl.pl1 1 3* 1 4* Created: June 1976. 1 5* 1 6* Modified: 1 7* February 24, 1977 by G.D. Chang for the optimizer. 1 8* December 3, 1976, David Levin reorder subfields. 1 9* November 16, 1976 By D.S.Levin to allow long names. 1 10* October 9, 1978 by Paul E. Smee for larger common and arrays. 1 11**/ 1 12 1 13 2 region unaligned structure, 1 14 3 operand bit(1), 1 15 3 polish bit(1), 1 16 3 quadruple bit(1), 1 17 1 18 2 operator unaligned structure, 1 19 3 with_argument, 1 20 4 number_arg, 1 21 5 display bit(1), 1 22 5 stmnt bit(1), 1 23 5 bucket bit(1), 1 24 4 character_arg, 1 25 5 declaration bit(1), 1 26 1 27 3 without_args, 1 28 4 dump bit(1), 1 29 4 cur_stmnt bit(1), 1 30 4 list_subprograms bit(1), 1 31 4 list_symbols bit(1), 1 32 4 list_labels bit(1), 1 33 4 list_polish_string bit(1), 1 34 4 list_word_consts bit(1), 1 35 4 list_dw_constants bit(1), 1 36 4 list_char_constants bit(1), 1 37 4 list_lib_names bit(1), 1 38 4 node_summary bit(1), 1 39 1 40 2 options unaligned structure, 1 41 3 walk bit(1), 1 42 3 brief bit(1), 1 43 1 44 2 starting_offset fixed bin (18) unsigned, 1 45 2 stopping_offset fixed bin (18) unsigned, 1 46 1 47 2 dcl_name char(256) varying; 1 48 1 49 /* END fort_command_structure.incl.pl1 */ 1 50 48 49 50 /* Begin by initializing. */ 51 52 arg_error = "0"b; /* check all arguments, but remember errors. */ 53 decimal_base = "0"b; /* numeric base is octal by default */ 54 have_value = "0"b; /* no numeric field encountered yet. */ 55 two_args = "0"b; /* Off - one arg only; ON - one or two */ 56 starting_offset_set = "0"b; 57 stopping_offset_set = "0"b; 58 59 unspec (command_structure) = "0"b; 60 61 /* Now get user arguments */ 62 63 call cu_$arg_count (nargs); 64 65 if nargs = 0 66 then do; /* no user arguments, use default */ 67 operator.display = "1"b; 68 end; 69 70 /* process all user arguments */ 71 72 else do; 73 74 do i = 1 to nargs; 75 76 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 77 /* get next argument string */ 78 79 if operator.declaration & dcl_name = "" 80 then dcl_name = an_arg; 81 82 else if an_arg = "dec" 83 then if have_value 84 then do; 85 call com_err_ (0, p_name, "Numeric value preceded ""dec"" keyword."); 86 arg_error = "1"b; 87 end; 88 else decimal_base = "1"b; 89 90 else if an_arg = "op" | an_arg = "operand" 91 then region.operand = "1"b; 92 93 else if an_arg = "pl" | an_arg = "polish" 94 then region.polish = "1"b; 95 96 else if an_arg = "quad" | an_arg = "qd" 97 then region.quadruple = "1"b; 98 99 else if an_arg = "display" | an_arg = "ds" 100 then if (string (operator.with_argument) ^= "0"b) & ^operator.display 101 then do; 102 call com_err_ (0, p_name, "^a conflicts with previous argument", an_arg); 103 arg_error = "1"b; 104 end; 105 else two_args, operator.display = "1"b; 106 107 else if an_arg = "walk" 108 then options.walk = "1"b; 109 110 else if an_arg = "dump" 111 then operator.dump = "1"b; 112 113 else if an_arg = "st" 114 then if string (operator.with_argument) ^= "0"b 115 then do; 116 call com_err_ (0, p_name, "^a conflicts with previous argument", an_arg); 117 arg_error = "1"b; 118 end; 119 else decimal_base, operator.stmnt = "1"b; 120 121 else if an_arg = "dcl" 122 then if string (operator.with_argument) ^= "0"b 123 then do; 124 call com_err_ (0, p_name, "^a conflicts with previous argument", an_arg); 125 arg_error = "1"b; 126 end; 127 else operator.declaration = "1"b; 128 129 else if an_arg = "cur_statement" | an_arg = "cur_stmnt" | an_arg = "cur_st" 130 then operator.cur_stmnt = "1"b; 131 132 else if an_arg = "brief" | an_arg = "bf" 133 then options.brief = "1"b; 134 135 else if an_arg = "consts" 136 then operator.list_word_consts = "1"b; 137 138 else if an_arg = "char_consts" 139 then operator.list_char_constants = "1"b; 140 141 else if an_arg = "lib_names" 142 then operator.list_lib_names = "1"b; 143 144 else if an_arg = "summary" 145 then operator.node_summary = "1"b; 146 147 else if an_arg = "bucket" 148 then if string (operator.with_argument) ^= "0"b 149 then do; 150 call com_err_ (0, p_name, "^a conflicts with previous argument", an_arg); 151 arg_error = "1"b; 152 end; 153 else decimal_base, two_args, operator.bucket = "1"b; 154 155 else if substr (an_arg, 1, 10) = "subprogram" | an_arg = "subpgm" 156 then operator.list_subprograms = "1"b; 157 158 else if verify (substr (an_arg, 1, 1), "0123456789") = 0 159 then do; 160 have_value = "1"b; 161 162 if string (region) = "0"b then region.operand = "1"b; 163 164 if string (operator.with_argument) = "0"b then operator.display = "1"b; 165 166 if decimal_base 167 then j = cv_dec_check_ (an_arg, code); 168 else j = cv_oct_check_ (an_arg, code); 169 170 if code ^= 0 | j < 0 171 then do; 172 call com_err_ (0, p_name, "Syntax error in numeric constant. ^a", an_arg); 173 arg_error = "1"b; 174 end; 175 176 if starting_offset_set 177 then if stopping_offset_set | ^two_args 178 then do; 179 call com_err_ (0, p_name, "Too many numeric constants."); 180 arg_error = "1"b; 181 end; 182 else do; 183 stopping_offset = j; 184 stopping_offset_set = "1"b; 185 end; 186 else do; 187 starting_offset = j; 188 stopping_offset = j; 189 starting_offset_set = "1"b; 190 end; 191 end; 192 193 else if an_arg = "" /* ignore null arguments */ 194 then ; 195 196 else do; 197 call com_err_ (0, p_name, "Unrecognized argument, ^a.", an_arg); 198 arg_error = "1"b; 199 end; 200 end; /* loop thru arguments */ 201 202 /* validate our input */ 203 204 if operator.declaration 205 then do; 206 if dcl_name = "" 207 then do; 208 call com_err_ (0, p_name, "No name given."); 209 arg_error = "1"b; 210 end; 211 212 if have_value | decimal_base 213 then do; 214 call com_err_ (0, p_name, "dcl conflicts with other arguments."); 215 arg_error = "1"b; 216 end; 217 end; 218 219 else if operator.dump 220 then if string (region) = "0"b 221 then region.operand = "1"b; 222 else ; 223 224 else if have_value /* remaining tests assume no value given */ 225 then ; 226 227 else if string (operator.number_arg) ^= "0"b /* must have arg */ 228 then do; 229 call com_err_ (0, p_name, "No number given."); 230 arg_error = "1"b; 231 end; 232 233 else if string (operator.without_args) = "0"b 234 then do; 235 call com_err_ (0, p_name, "No operator given."); 236 arg_error = "1"b; 237 end; 238 239 end; /* do block for user arguments */ 240 241 if ^arg_error then call display_entries$fdisplay (addr (command_structure)); 242 243 end fort_display; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/27/84 0751.7 fort_display.pl1 >spec>online>fort_recompile>fort_display.pl1 48 1 03/27/82 0439.4 fort_command_structure.incl.pl1 >ldd>include>fort_command_structure.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 45 ref 241 241 an_arg based char unaligned dcl 43 set ref 79 82 90 90 93 93 96 96 99 99 102* 107 110 113 116* 121 124* 129 129 129 132 132 135 138 141 144 147 150* 155 155 158 166* 168* 172* 193 197* arg_error 000107 automatic bit(1) dcl 36 set ref 52* 86* 103* 117* 125* 151* 173* 180* 198* 209* 215* 230* 236* 241 arg_len 000105 automatic fixed bin(17,0) dcl 34 set ref 76* 79 82 90 90 93 93 96 96 99 99 102 102 107 110 113 116 116 121 124 124 129 129 129 132 132 135 138 141 144 147 150 150 155 155 158 166 166 168 168 172 172 193 197 197 arg_ptr 000100 automatic pointer dcl 30 set ref 76* 79 82 90 90 93 93 96 96 99 99 102 107 110 113 116 121 124 129 129 129 132 132 135 138 141 144 147 150 155 155 158 166 168 172 193 197 brief 0(19) 000115 automatic bit(1) level 3 packed unaligned dcl 47 set ref 132* bucket 0(05) 000115 automatic bit(1) level 5 packed unaligned dcl 47 set ref 153* character_arg 0(06) 000115 automatic structure level 4 packed unaligned dcl 47 code 000102 automatic fixed bin(35,0) dcl 31 set ref 76* 166* 168* 170 com_err_ 000012 constant entry external dcl 24 ref 85 102 116 124 150 172 179 197 208 214 229 235 command_structure 000115 automatic structure level 1 dcl 47 set ref 59* 241 241 cu_$arg_count 000014 constant entry external dcl 25 ref 63 cu_$arg_ptr 000016 constant entry external dcl 26 ref 76 cur_stmnt 0(08) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 129* cv_dec_check_ 000020 constant entry external dcl 27 ref 166 cv_oct_check_ 000022 constant entry external dcl 28 ref 168 dcl_name 3 000115 automatic varying char(256) level 2 dcl 47 set ref 79 79* 206 decimal_base 000110 automatic bit(1) dcl 37 set ref 53* 88* 119* 153* 166 212 declaration 0(06) 000115 automatic bit(1) level 5 packed unaligned dcl 47 set ref 79 127* 204 display 0(03) 000115 automatic bit(1) level 5 packed unaligned dcl 47 set ref 67* 99 105* 164* display_entries$fdisplay 000010 external static entry variable dcl 22 ref 241 dump 0(07) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 110* 219 have_value 000111 automatic bit(1) dcl 38 set ref 54* 82 160* 212 224 i 000103 automatic fixed bin(17,0) dcl 34 set ref 74* 76* j 000106 automatic fixed bin(18,0) dcl 35 set ref 166* 168* 170 183 187 188 list_char_constants 0(15) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 138* list_lib_names 0(16) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 141* list_subprograms 0(09) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 155* list_word_consts 0(13) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 135* nargs 000104 automatic fixed bin(17,0) dcl 34 set ref 63* 65 74 node_summary 0(17) 000115 automatic bit(1) level 4 packed unaligned dcl 47 set ref 144* number_arg 0(03) 000115 automatic structure level 4 packed unaligned dcl 47 set ref 227 operand 000115 automatic bit(1) level 3 packed unaligned dcl 47 set ref 90* 162* 219* operator 0(03) 000115 automatic structure level 2 packed unaligned dcl 47 options 0(18) 000115 automatic structure level 2 packed unaligned dcl 47 p_name 000000 constant char(12) initial dcl 32 set ref 85* 102* 116* 124* 150* 172* 179* 197* 208* 214* 229* 235* polish 0(01) 000115 automatic bit(1) level 3 packed unaligned dcl 47 set ref 93* quadruple 0(02) 000115 automatic bit(1) level 3 packed unaligned dcl 47 set ref 96* region 000115 automatic structure level 2 packed unaligned dcl 47 set ref 162 219 starting_offset 1 000115 automatic fixed bin(18,0) level 2 unsigned dcl 47 set ref 187* starting_offset_set 000112 automatic bit(1) dcl 39 set ref 56* 176 189* stmnt 0(04) 000115 automatic bit(1) level 5 packed unaligned dcl 47 set ref 119* stopping_offset 2 000115 automatic fixed bin(18,0) level 2 unsigned dcl 47 set ref 183* 188* stopping_offset_set 000113 automatic bit(1) dcl 40 set ref 57* 176 184* string builtin function dcl 45 ref 99 113 121 147 162 164 219 227 233 two_args 000114 automatic bit(1) dcl 41 set ref 55* 105* 153* 176 unspec builtin function dcl 45 set ref 59* verify builtin function dcl 45 ref 158 walk 0(18) 000115 automatic bit(1) level 3 packed unaligned dcl 47 set ref 107* with_argument 0(03) 000115 automatic structure level 3 packed unaligned dcl 47 set ref 99 113 121 147 164 without_args 0(07) 000115 automatic structure level 3 packed unaligned dcl 47 set ref 233 NAME DECLARED BY EXPLICIT CONTEXT. fort_display 000172 constant entry external dcl 11 NAME DECLARED BY CONTEXT OR IMPLICATION. substr builtin function ref 155 158 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1602 1626 1502 1612 Length 2026 1502 24 164 77 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fort_display 196 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fort_display 000100 arg_ptr fort_display 000102 code fort_display 000103 i fort_display 000104 nargs fort_display 000105 arg_len fort_display 000106 j fort_display 000107 arg_error fort_display 000110 decimal_base fort_display 000111 have_value fort_display 000112 starting_offset_set fort_display 000113 stopping_offset_set fort_display 000114 two_args fort_display 000115 command_structure fort_display THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_var call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr cv_dec_check_ cv_oct_check_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. display_entries$fdisplay LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000171 52 000177 53 000200 54 000201 55 000202 56 000203 57 000204 59 000205 63 000210 65 000216 67 000220 68 000222 74 000223 76 000231 79 000246 82 000270 85 000300 86 000325 87 000327 88 000330 90 000333 93 000346 96 000361 99 000374 102 000412 103 000446 104 000450 105 000451 107 000456 110 000465 113 000474 116 000503 117 000537 118 000541 119 000542 121 000547 124 000556 125 000612 126 000614 127 000615 129 000620 132 000637 135 000652 138 000661 141 000670 144 000677 147 000706 150 000715 151 000751 152 000753 153 000754 155 000762 158 000775 160 001005 162 001007 164 001014 166 001021 168 001051 170 001076 172 001102 173 001136 176 001140 179 001146 180 001173 181 001175 183 001176 184 001200 185 001202 187 001203 188 001205 189 001206 191 001210 193 001211 197 001216 198 001252 200 001254 204 001256 206 001261 208 001266 209 001316 212 001320 214 001324 215 001351 217 001353 219 001354 222 001364 224 001365 227 001370 229 001373 230 001423 231 001425 233 001426 235 001431 236 001456 241 001460 243 001473 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved