COMPILATION LISTING OF SEGMENT bcdmp Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/09/83 1056.7 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 bcdmp: proc (seg_ptr); 7 8 /* Procedure to dump a GCOS segment, printing less information than dump_segment. 9* Entry bcdmp prints bcw, then for each record, the rcw and its offset, and the 10* BCD or ASCII contents (BCD translated to ASCII for printing). Binary card 11* records just have their rcw and offset printed. 12* 13* Entry gcdmp prints just bcw and rcws, and their offsets. No record contents are 14* printed. 15* 16* Entry set_max_line_len gives the line length of the terminal, and by implication, 17* the number of rcw-offset pairs that will fit on a line (20 chars per). 18* The segment and offset to be dumped are specified by a pointer argument. Dumping 19* always begins at the beginning of a GCOS block (on a 320-word boundary). If the 20* offset in the pointer does not specify such an address, it will be rounded 21* DOWN, so dumping will begin at the start of the block in which the offset falls. 22* 23* This procedure can be called as a subroutine, or from db: 24* :=bcdmp(segno|offset) 25* 26* or by the dump_gcos (dgc) command, which accepts a pathname, offset, line length, 27* and -bcd (or -ch) argument. 28* 29* 30* WRITTEN BY T. CASEY, JULY 1974 31* 32**/ 33 34 dcl gcos_cv_gebcd_ascii_ ext entry (ptr, fixed bin, ptr); 35 36 dcl (command_query_ 37 , ioa_, ioa_$nnl 38 , com_err_ 39 , db 40 ) ext entry options (variable); 41 1 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 1 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 1 3 /* version number changed to 4, 08/10/78 WOS */ 1 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 1 5 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 1 6 1 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 1 8 2 version fixed bin, /* version of this structure - must be set, see below */ 1 9 2 switches aligned, /* various bit switch values */ 1 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 1 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 1 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 1 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 1 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 1 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 1 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 1 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 1 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 1 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 1 20 1 21 /* Limit of data defined for version 2 */ 1 22 1 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 1 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 1 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 1 26 /* minimum of 30 seconds required for repeat */ 1 27 /* otherwise, no repeat will occur */ 1 28 /* Limit of data defined for version 4 */ 1 29 1 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 1 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 1 32 1 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 1 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 1 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 1 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 1 37 1 38 /* END INCLUDE FILE query_info.incl.pl1 */ 42 43 44 dcl word bit (36) aligned based; 45 dcl char_string char (200) based; 46 47 dcl 1 bcw aligned based (block_ptr), 48 2 bsn bit (18) unaligned, 49 2 length bit (18) unaligned; 50 51 dcl 1 rcw aligned based (record_ptr), 52 2 length bit (18) unaligned, 53 2 eof bit (6) unaligned, 54 2 zeros bit (2) unaligned, 55 2 media_code bit (4) unaligned, 56 2 report_code bit (6) unaligned; 57 58 dcl (seg_ptr, block_ptr, record_ptr) ptr; 59 dcl offset fixed bin (35); 60 dcl (block_len, record_len, cur_line_len, i, medium) fixed bin; 61 dcl max_line_len fixed bin int static init (80); 62 63 dcl reply char (4) varying; 64 dcl me char (5); 65 dcl ascii_line char (200); 66 67 dcl bcdsw bit (1) aligned init ("1"b); 68 69 dcl (addr, addrel, fixed, index, rel, substr) builtin; 70 71 me = "bcdmp"; 72 73 start: 74 block_ptr = seg_ptr; 75 offset = fixed (rel (block_ptr)); 76 cur_line_len = 0; 77 78 i = mod (offset, 320); 79 if i ^= 0 then do; 80 offset = offset - i; 81 block_ptr = addrel (block_ptr, -i); 82 call com_err_ (0, me, "will start at offset: ^6o", offset); 83 end; 84 85 start_block: 86 block_len = fixed (bcw.length); 87 88 if cur_line_len ^= 0 then do; 89 call ioa_ (""); 90 cur_line_len = 0; 91 end; 92 93 call ioa_ ("^/^6o ^w", offset, block_ptr -> word); 94 if block_ptr -> word = (36)"0"b then do; 95 call com_err_ (0, me, "bcw = 0; aborting dump"); 96 goto exit; 97 end; 98 99 if block_len = 0 then goto next_block; 100 101 offset = offset + 1; 102 record_ptr = addrel (block_ptr, 1); 103 104 next_record: 105 record_len = fixed (rcw.length); 106 107 if record_len > block_len then do; 108 call com_err_ (0, me, "bad rcw:"); 109 goto new_line; 110 end; 111 112 if bcdsw then do; 113 114 if record_len = 0 then goto new_line; 115 116 ascii_line = ""; 117 118 medium = fixed (rcw.media_code); 119 120 if medium >= 5 then /* ascii */ 121 ascii_line = substr (addrel (record_ptr, 1) -> char_string, 1, record_len*4); 122 123 else if medium = 1 then /* binary card */ 124 ascii_line = "BINARY CARD"; 125 126 else do; /* else assume bcd */ 127 call gcos_cv_gebcd_ascii_ (addrel (record_ptr, 1), record_len*6, addr (ascii_line)); 128 129 /* COMMENT OUT: so we can see the !1 or !2 or whatever, at the end of the last word 130* substr (ascii_line, 1+index (ascii_line, "!")) = ""; /* END COMMENT OUT */ 131 substr (ascii_line, 1+record_len*6) = ""; /* but blank out the garbage after the last word */ 132 end; 133 134 call ioa_ ("^6o ^w ^a", offset, record_ptr -> word, ascii_line); 135 end; 136 137 else do; 138 if cur_line_len = 0 then goto new_line; 139 if cur_line_len + 20 > max_line_len then 140 new_line: do; 141 call ioa_$nnl ("^/^6o ^w", offset, record_ptr -> word); 142 cur_line_len = 20; 143 end; 144 else do; 145 call ioa_$nnl (" ^6o ^w", offset, record_ptr -> word); 146 cur_line_len = cur_line_len + 20; 147 end; 148 end; 149 150 if rcw.eof = "001111"b then do; 151 query_info.yes_or_no_sw = "1"b; 152 call command_query_ (addr (query_info), reply, me, "eof in rcw; do you wish to continue?"); 153 if reply = "no" then goto exit; 154 end; 155 156 offset = offset + record_len + 1; 157 record_ptr = addrel (record_ptr, record_len+1); 158 block_len = block_len - record_len - 1; 159 160 if block_len < 0 then do; 161 call com_err_ (0, me, "warning - remaining block length went negative - calling db"); 162 call db; 163 end; 164 165 if block_len <= 0 then 166 next_block: do; 167 block_ptr = addrel (block_ptr, 320); 168 offset = fixed (rel (block_ptr)); 169 goto start_block; 170 end; 171 172 goto next_record; 173 174 exit: 175 176 /* terminate the seg here, if we add code to initiate it later */ 177 178 call com_err_ (0, me, "returning to caller"); 179 return; 180 181 /* Entry to request printing of just block and record control words */ 182 183 gcdmp: entry (seg_ptr); 184 185 me = "gcdmp"; 186 bcdsw = "0"b; 187 goto start; 188 189 /* Entry to set max_line_length */ 190 191 set_max_line_len: entry (ll); 192 193 dcl ll fixed bin; 194 195 max_line_len = ll; 196 return; 197 198 end bcdmp; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/09/83 1006.5 bcdmp.pl1 >spec>on>09/07/83-gcos>bcdmp.pl1 42 1 03/11/83 1204.3 query_info_.incl.pl1 >ldd>include>query_info.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 69 ref 127 127 152 152 addrel builtin function dcl 69 ref 81 102 120 127 127 157 167 answer_iocbp 6 000100 automatic pointer initial level 2 dcl 1-7 set ref 1-7* ascii_line 000134 automatic char(200) unaligned dcl 65 set ref 116* 120* 123* 127 127 131* 134* bcdsw 000216 automatic bit(1) initial dcl 67 set ref 67* 112 186* bcw based structure level 1 dcl 47 block_len 000123 automatic fixed bin(17,0) dcl 60 set ref 85* 99 107 158* 158 160 165 block_ptr 000116 automatic pointer dcl 58 set ref 73* 75 81* 81 85 93 94 102 167* 167 168 char_string based char(200) unaligned dcl 45 ref 120 com_err_ 000022 constant entry external dcl 36 ref 82 95 108 161 174 command_query_ 000014 constant entry external dcl 36 ref 152 cp_escape_control 1(02) 000100 automatic bit(2) initial level 3 packed unaligned dcl 1-7 set ref 1-7* cur_line_len 000125 automatic fixed bin(17,0) dcl 60 set ref 76* 88 90* 138 139 142* 146* 146 db 000024 constant entry external dcl 36 ref 162 eof 0(18) based bit(6) level 2 packed unaligned dcl 51 ref 150 explanation_len 14 000100 automatic fixed bin(21,0) initial level 2 dcl 1-7 set ref 1-7* explanation_ptr 12 000100 automatic pointer initial level 2 dcl 1-7 set ref 1-7* fixed builtin function dcl 69 ref 75 85 104 118 168 gcos_cv_gebcd_ascii_ 000012 constant entry external dcl 34 ref 127 i 000126 automatic fixed bin(17,0) dcl 60 set ref 78* 79 80 81 ioa_ 000016 constant entry external dcl 36 ref 89 93 134 ioa_$nnl 000020 constant entry external dcl 36 ref 141 145 length 0(18) based bit(18) level 2 in structure "bcw" packed unaligned dcl 47 in procedure "bcdmp" ref 85 length based bit(18) level 2 in structure "rcw" packed unaligned dcl 51 in procedure "bcdmp" ref 104 literal_sw 1(05) 000100 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* ll parameter fixed bin(17,0) dcl 193 ref 191 195 max_line_len 000010 internal static fixed bin(17,0) initial dcl 61 set ref 139 195* me 000132 automatic char(5) unaligned dcl 64 set ref 71* 82* 95* 108* 152* 161* 174* 185* media_code 0(26) based bit(4) level 2 packed unaligned dcl 51 ref 118 medium 000127 automatic fixed bin(17,0) dcl 60 set ref 118* 120 123 offset 000122 automatic fixed bin(35,0) dcl 59 set ref 75* 78 80* 80 82* 93* 101* 101 134* 141* 145* 156* 156 168* padding 1(07) 000100 automatic bit(29) initial level 3 packed unaligned dcl 1-7 set ref 1-7* prompt_after_explanation 1(06) 000100 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* query_code 3 000100 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* query_info 000100 automatic structure level 1 dcl 1-7 set ref 152 152 question_iocbp 4 000100 automatic pointer initial level 2 dcl 1-7 set ref 1-7* rcw based structure level 1 dcl 51 record_len 000124 automatic fixed bin(17,0) dcl 60 set ref 104* 107 114 120 127 131 156 157 158 record_ptr 000120 automatic pointer dcl 58 set ref 102* 104 118 120 127 127 134 141 145 150 157* 157 rel builtin function dcl 69 ref 75 168 repeat_time 10 000100 automatic fixed bin(71,0) initial level 2 dcl 1-7 set ref 1-7* reply 000130 automatic varying char(4) dcl 63 set ref 152* 153 seg_ptr parameter pointer dcl 58 ref 6 73 183 status_code 2 000100 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* substr builtin function dcl 69 set ref 120 131* suppress_name_sw 1(01) 000100 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* suppress_spacing 1(04) 000100 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* switches 1 000100 automatic structure level 2 dcl 1-7 word based bit(36) dcl 44 set ref 93* 94 134* 141* 145* yes_or_no_sw 1 000100 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 151* 1-7* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. index builtin function dcl 69 query_info_version_3 internal static fixed bin(17,0) initial dcl 1-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 1-34 query_info_version_5 internal static fixed bin(17,0) initial dcl 1-35 query_info_version_6 internal static fixed bin(17,0) initial dcl 1-36 NAMES DECLARED BY EXPLICIT CONTEXT. bcdmp 000160 constant entry external dcl 6 exit 000737 constant label dcl 174 ref 96 153 gcdmp 000772 constant entry external dcl 183 new_line 000534 constant label dcl 139 ref 109 114 138 next_block 000727 constant label dcl 165 ref 99 next_record 000351 constant label dcl 104 ref 172 set_max_line_len 001010 constant entry external dcl 191 start 000170 constant label dcl 73 ref 187 start_block 000246 constant label dcl 85 ref 169 NAMES DECLARED BY CONTEXT OR IMPLICATION. mod builtin function ref 78 null builtin function ref 1-7 1-7 1-7 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1142 1170 1036 1152 Length 1362 1036 26 156 103 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME bcdmp 194 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 max_line_len bcdmp STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME bcdmp 000100 query_info bcdmp 000116 block_ptr bcdmp 000120 record_ptr bcdmp 000122 offset bcdmp 000123 block_len bcdmp 000124 record_len bcdmp 000125 cur_line_len bcdmp 000126 i bcdmp 000127 medium bcdmp 000130 reply bcdmp 000132 me bcdmp 000134 ascii_line bcdmp 000216 bcdsw bcdmp THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mod_fx1 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ db gcos_cv_gebcd_ascii_ ioa_ ioa_$nnl NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1 7 000121 67 000151 6 000155 71 000166 73 000170 75 000174 76 000177 78 000200 79 000203 80 000204 81 000212 82 000215 85 000246 88 000251 89 000253 90 000264 93 000265 94 000310 95 000312 96 000337 99 000340 101 000342 102 000346 104 000351 107 000354 108 000356 109 000402 112 000403 114 000405 116 000407 118 000412 120 000416 123 000430 127 000436 131 000462 134 000474 135 000525 138 000526 139 000530 141 000534 142 000557 143 000561 145 000562 146 000604 150 000606 151 000613 152 000615 153 000647 156 000654 157 000661 158 000666 160 000672 161 000673 162 000720 165 000725 167 000727 168 000732 169 000735 172 000736 174 000737 179 000767 183 000770 185 001000 186 001003 187 001004 191 001005 195 001016 196 001022 ----------------------------------------------------------- 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