COMPILATION LISTING OF SEGMENT tmg Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1705.6 mst Mon Options: optimize map 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 table: 12 tmg: proc(name); 13 14 dcl name char(*); 15 16 dcl (in_pos,in_length,ll,out_pos,line_no,unique, 17 code,n,m,i,j) fixed bin, 18 (input_pt,output_pt,output_hold) ptr, 19 had_if bit(1), 20 first_time bit(1) int static init("1"b), 21 c char(1), 22 (vf,vg,sourcename,outputname) char(32) varying, 23 what char(8), 24 op_code char(12) varying, 25 line char(132) varying, 26 ent char(32), 27 (temppath,dir,wdir) char(168); 28 29 dcl sw(16) label local int static; 30 31 dcl (addr,divide,index,length,null,substr) builtin; 32 33 dcl n_special fixed bin int static init(16), 34 special(16) char(8) init("if","ifnot","flipto","jump","put", 35 "fetch","get_fx2","compile","cplalt","cplsave","load","add", 36 "switch","erase","bump","drop") int static; 37 38 dcl n_tests fixed bin int static init(11), 39 test(11) char(4) init("q2","q3","a2","a3","c2","c3","z2","z3", 40 "atm2", "atm3", "atm4") int static; 41 42 dcl n_switches fixed bin int static init(5), 43 switches(5) char(8) init("code","op","type1","type2","type3") int static; 44 45 dcl (com_err_,ioa_,ioa_$rsnp,ioa_$rsnpnnl) entry options(variable), 46 hcs_$initiate_count entry(char(*),char(*),char(*),fixed bin, 47 fixed bin,ptr,fixed bin), 48 expand_path_ entry(ptr,fixed bin,ptr,ptr,fixed bin), 49 get_wdir_ entry() returns(char(168)), 50 tssi_$get_segment entry(char(*),char(*),ptr,ptr,fixed bin), 51 tssi_$finish_segment entry(ptr,fixed bin(24),bit(36) aligned,ptr,fixed bin); 52 53 dcl ( nl init(" 54 "), 55 quote init(""""), 56 star init("*"), 57 tab init(" "), 58 colon init(":")) char(1) int static; 59 60 dcl my_name char(3) int static init("tmg"); 61 62 dcl input char(in_length) aligned based(input_pt); 63 64 dcl output char(262144) aligned based(output_pt); 65 66 dcl 1 output_structure aligned based(output_pt), 67 2 skip unaligned char(out_pos - 1), 68 2 output_line unaligned char(132); 69 70 if first_time 71 then do; 72 sw(1) = if; 73 sw(2) = ifnot; 74 sw(3) = flipto; 75 sw(4) = jump; 76 sw(5) = put; 77 sw(6) = fetch; 78 sw(7) = get_fx2; 79 sw(8) = compile; 80 sw(9) = cplalt; 81 sw(10) = cplsave; 82 sw(11) = load; 83 sw(12) = add; 84 sw(13) = switch; 85 sw(14) = erase; 86 sw(15) = bump; 87 sw(16) = drop; 88 first_time = "0"b; 89 end; 90 91 temppath = name; 92 call expand_path_(addr(temppath),length(name),addr(dir),addr(ent),code); 93 94 if code ^= 0 95 then do; 96 call com_err_(code,my_name,temppath); 97 return; 98 end; 99 100 n = index(ent," "); 101 if n = 0 then n = 33; 102 n = n - 1; 103 104 sourcename = substr(ent,1,n) || ".table"; 105 outputname = substr(ent,1,n) || ".alm"; 106 107 call hcs_$initiate_count(dir,(sourcename),"",in_length,1,input_pt,code); 108 109 if input_pt = null 110 then do; 111 call com_err_(code,my_name,sourcename); 112 return; 113 end; 114 115 if in_length = 0 116 then do; 117 call com_err_(0,my_name,"Zero length input."); 118 return; 119 end; 120 121 wdir = get_wdir_(); 122 call tssi_$get_segment(wdir,(outputname),output_pt,output_hold,code); 123 124 if code ^= 0 125 then do; 126 out_err: call com_err_(code,my_name,outputname); 127 return; 128 end; 129 130 in_length = divide(in_length,9,17,0); 131 in_pos, out_pos, unique = 1; 132 line_no = 0; 133 had_if = "0"b; 134 135 find_nl: if in_pos >= in_length then goto done; 136 137 ll = index(substr(input,in_pos),nl); 138 139 if ll = 0 then goto done; 140 line_no = line_no + 1; 141 142 if ll = 1 143 then do; 144 in_pos = in_pos + 1; 145 put_nl: substr(output,out_pos,1) = nl; 146 out_pos = out_pos + 1; 147 goto find_nl; 148 end; 149 150 line = substr(input,in_pos,ll); 151 in_pos = in_pos + ll; 152 153 c = substr(line,1,1); 154 155 if c = quote 156 then do; 157 put_line: substr(output,out_pos,length(line)) = line; 158 out_pos = out_pos + length(line); 159 goto find_nl; 160 end; 161 162 if c = star 163 then do; 164 165 if ll = 3 166 then if substr(line,2,1) ^= star then goto star_err; 167 else do; 168 call ioa_$rsnp("^-zero^-0,128",output_line,n); 169 out_pos = out_pos + n; 170 goto put_lab; 171 end; 172 173 if ll = 2 174 then do; 175 put_lab: if had_if 176 then do; 177 call ioa_$rsnpnnl("L^d:",output_line,n,unique); 178 out_pos = out_pos + n; 179 unique = unique + 1; 180 had_if = "0"b; 181 end; 182 183 goto find_nl; 184 end; 185 186 star_err: call com_err_(0,my_name,"Illegal use of ""*"" in line # ^d:^/^a",line_no,line); 187 goto find_nl; 188 end; 189 190 /* check for labels */ 191 192 labels: n = index(line,colon); 193 194 if n ^= 0 195 then do; 196 substr(output,out_pos,n) = substr(line,1,n); 197 out_pos = out_pos + n; 198 199 if n = length(line)-1 then goto put_nl; 200 201 line = substr(line,n+1); 202 goto labels; 203 end; 204 205 /* having eliminated all labels, the first character 206* on the line should now be a tab */ 207 208 if substr(line,1,1) ^= tab 209 then do; 210 err: call com_err_(0,my_name,"Syntax error in line # ^d:^/^a",line_no,line); 211 goto find_nl; 212 end; 213 214 /* pickup op code */ 215 216 n = index(substr(line,2),tab); 217 if n = 0 then n = length(line) - 1; 218 219 op_code = substr(line,2,n-1); 220 221 /* check for one of our special pseudo-ops */ 222 223 do i = 1 to n_special; 224 if op_code = special(i) then goto found; 225 end; 226 227 /* not special op code */ 228 229 goto put_line; 230 231 /* have pseudo-op, get variable field */ 232 233 found: if n >= length(line) - 1 then vf = ""; 234 else do; 235 m = index(substr(line,n+2),tab); 236 if m = 0 then m = length(line)-n-1; 237 vf = substr(line,n+2,m-1); 238 end; 239 240 goto sw(i); 241 242 /* conditional, check to make sure vf specifies legal test */ 243 244 if: 245 ifnot: do j = 1 to n_tests; 246 if vf = test(j) then goto if_ok; 247 end; 248 249 what = "Test"; 250 251 err2: call com_err_(0,my_name,"^a ""^a"" not known, ""^a"" on line # ^d:^/^a",what,vf,op_code, 252 line_no,line); 253 goto find_nl; 254 255 if_ok: call ioa_$rsnpnnl("^-vfd^-18/L^d,9/^d,9/128+^d^a",output_line,n,unique,i,j,line); 256 had_if = "1"b; 257 goto inc; 258 259 /* switch, extract code from variable field */ 260 261 switch: n = index(vf,","); 262 if n = 0 263 then do; 264 call com_err_(0,my_name,"Variable field error, switch on line # ^d:^/^a",line_no,line); 265 goto find_nl; 266 end; 267 268 vg = substr(vf,n+1); 269 270 do j = 1 to n_switches; 271 if vg = switches(j) then goto switch_ok; 272 end; 273 274 what = "Switch"; 275 vf = vg; 276 goto err2; 277 278 switch_ok: 279 call ioa_$rsnpnnl("^-vfd^-18/^a,9/13,9/128+^d^a",output_line,n,substr(vf,1,n-1), 280 j,line); 281 goto inc; 282 283 drop: 284 bump: 285 erase: 286 flipto: 287 jump: 288 put: 289 fetch: 290 get_fx2: 291 compile: 292 cplalt: 293 cplsave: 294 load: 295 add: call ioa_$rsnpnnl("^-vfd^-18/^a,9/^d,9/128^a",output_line,n,vf,i,line); 296 inc: out_pos = out_pos + n; 297 goto find_nl; 298 299 done: call tssi_$finish_segment(output_pt,out_pos*9 - 9,"1010"b,output_hold,code); 300 301 if code ^= 0 then goto out_err; 302 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1508.9 tmg.pl1 >dumps>old>recomp>tmg.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 31 ref 92 92 92 92 92 92 c 000123 automatic char(1) unaligned dcl 16 set ref 153* 155 162 code 000106 automatic fixed bin(17,0) dcl 16 set ref 92* 94 96* 107* 111* 122* 124 126* 299* 301 colon constant char(1) initial unaligned dcl 53 ref 192 com_err_ 000114 constant entry external dcl 45 ref 96 111 117 126 186 210 251 264 dir 000322 automatic char(168) unaligned dcl 16 set ref 92 92 107* divide builtin function dcl 31 ref 130 ent 000240 automatic char(32) unaligned dcl 16 set ref 92 92 100 104 105 expand_path_ 000124 constant entry external dcl 45 ref 92 first_time 000010 internal static bit(1) initial unaligned dcl 16 set ref 70 88* get_wdir_ 000126 constant entry external dcl 45 ref 121 had_if 000122 automatic bit(1) unaligned dcl 16 set ref 133* 175 180* 256* hcs_$initiate_count 000122 constant entry external dcl 45 ref 107 i 000111 automatic fixed bin(17,0) dcl 16 set ref 223* 224* 240 255* 283* in_length 000101 automatic fixed bin(17,0) dcl 16 set ref 107* 115 130* 130 135 137 150 in_pos 000100 automatic fixed bin(17,0) dcl 16 set ref 131* 135 137 144* 144 150 151* 151 index builtin function dcl 31 ref 100 137 192 216 235 261 input based char dcl 62 ref 137 150 input_pt 000114 automatic pointer dcl 16 set ref 107* 109 137 150 ioa_$rsnp 000116 constant entry external dcl 45 ref 168 ioa_$rsnpnnl 000120 constant entry external dcl 45 ref 177 255 278 283 j 000112 automatic fixed bin(17,0) dcl 16 set ref 244* 246* 255* 270* 271* 278* length builtin function dcl 31 ref 92 92 157 158 199 217 233 236 line 000176 automatic varying char(132) dcl 16 set ref 150* 153 157 157 158 165 186* 192 196 199 201* 201 208 210* 216 217 219 233 235 236 237 251* 255* 264* 278* 283* line_no 000104 automatic fixed bin(17,0) dcl 16 set ref 132* 140* 140 186* 210* 251* 264* ll 000102 automatic fixed bin(17,0) dcl 16 set ref 137* 139 142 150 151 165 173 m 000110 automatic fixed bin(17,0) dcl 16 set ref 235* 236 236* 237 my_name 000112 internal static char(3) initial unaligned dcl 60 set ref 96* 111* 117* 126* 186* 210* 251* 264* n 000107 automatic fixed bin(17,0) dcl 16 set ref 100* 101 101* 102* 102 104 105 168* 169 177* 178 192* 194 196 196 197 199 201 216* 217 217* 219 233 235 236 237 255* 261* 262 268 278* 278 278 283* 296 n_special constant fixed bin(17,0) initial dcl 33 ref 223 n_switches constant fixed bin(17,0) initial dcl 42 ref 270 n_tests constant fixed bin(17,0) initial dcl 38 ref 244 name parameter char unaligned dcl 14 ref 11 11 91 92 92 nl constant char(1) initial unaligned dcl 53 ref 137 145 null builtin function dcl 31 ref 109 op_code 000172 automatic varying char(12) dcl 16 set ref 219* 224 251* out_pos 000103 automatic fixed bin(17,0) dcl 16 set ref 131* 145 146* 146 157 158* 158 168 169* 169 177 178* 178 196 197* 197 255 278 283 296* 296 299 output based char(262144) dcl 64 set ref 145* 157* 196* output_hold 000120 automatic pointer dcl 16 set ref 122* 299* output_line based char(132) level 2 packed unaligned dcl 66 set ref 168* 177* 255* 278* 283* output_pt 000116 automatic pointer dcl 16 set ref 122* 145 157 168 177 196 255 278 283 299* output_structure based structure level 1 dcl 66 outputname 000157 automatic varying char(32) dcl 16 set ref 105* 122 126* quote constant char(1) initial unaligned dcl 53 ref 155 sourcename 000146 automatic varying char(32) dcl 16 set ref 104* 107 111* special 000025 constant char(8) initial array unaligned dcl 33 ref 224 star constant char(1) initial unaligned dcl 53 ref 162 165 substr builtin function dcl 31 set ref 104 105 137 145* 150 153 157* 165 196* 196 201 208 216 219 235 237 268 278 278 sw 000012 internal static label variable local array dcl 29 set ref 72* 73* 74* 75* 76* 77* 78* 79* 80* 81* 82* 83* 84* 85* 86* 87* 240 switches 000000 constant char(8) initial array unaligned dcl 42 ref 271 tab constant char(1) initial unaligned dcl 53 ref 208 216 235 temppath 000250 automatic char(168) unaligned dcl 16 set ref 91* 92 92 96* test 000012 constant char(4) initial array unaligned dcl 38 ref 246 tssi_$finish_segment 000132 constant entry external dcl 45 ref 299 tssi_$get_segment 000130 constant entry external dcl 45 ref 122 unique 000105 automatic fixed bin(17,0) dcl 16 set ref 131* 177* 179* 179 255* vf 000124 automatic varying char(32) dcl 16 set ref 233* 237* 246 251* 261 268 275* 278 278 283* vg 000135 automatic varying char(32) dcl 16 set ref 268* 271 275 wdir 000374 automatic char(168) unaligned dcl 16 set ref 121* 122* what 000170 automatic char(8) unaligned dcl 16 set ref 249* 251* 274* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ioa_ 000000 constant entry external dcl 45 NAMES DECLARED BY EXPLICIT CONTEXT. add 001764 constant label dcl 283 ref 83 bump 001764 constant label dcl 283 ref 86 compile 001764 constant label dcl 283 ref 79 cplalt 001764 constant label dcl 283 ref 80 cplsave 001764 constant label dcl 283 ref 81 done 002032 constant label dcl 299 ref 135 139 drop 001764 constant label dcl 283 ref 87 erase 001764 constant label dcl 283 ref 85 err 001254 constant label dcl 210 err2 001451 constant label dcl 251 ref 276 fetch 001764 constant label dcl 283 ref 77 find_nl 000753 constant label dcl 135 ref 147 159 183 187 211 253 265 297 flipto 001764 constant label dcl 283 ref 74 found 001362 constant label dcl 233 ref 224 get_fx2 001764 constant label dcl 283 ref 78 if 001430 constant label dcl 244 ref 72 if_ok 001523 constant label dcl 255 ref 246 ifnot 001430 constant label dcl 244 ref 73 inc 002027 constant label dcl 296 ref 257 281 jump 001764 constant label dcl 283 ref 75 labels 001210 constant label dcl 192 ref 202 load 001764 constant label dcl 283 ref 82 out_err 000720 constant label dcl 126 ref 301 put 001764 constant label dcl 283 ref 76 put_lab 001111 constant label dcl 175 ref 170 put_line 001027 constant label dcl 157 ref 229 put_nl 001002 constant label dcl 145 ref 199 star_err 001152 constant label dcl 186 ref 165 switch 001573 constant label dcl 261 ref 84 switch_ok 001706 constant label dcl 278 ref 271 table 000256 constant entry external dcl 11 tmg 000240 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2200 2334 2062 2210 Length 2532 2062 134 161 116 104 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tmg 398 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 first_time tmg 000012 sw tmg 000112 my_name tmg STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tmg 000100 in_pos tmg 000101 in_length tmg 000102 ll tmg 000103 out_pos tmg 000104 line_no tmg 000105 unique tmg 000106 code tmg 000107 n tmg 000110 m tmg 000111 i tmg 000112 j tmg 000114 input_pt tmg 000116 output_pt tmg 000120 output_hold tmg 000122 had_if tmg 000123 c tmg 000124 vf tmg 000135 vg tmg 000146 sourcename tmg 000157 outputname tmg 000170 what tmg 000172 op_code tmg 000176 line tmg 000240 ent tmg 000250 temppath tmg 000322 dir tmg 000374 wdir tmg THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ expand_path_ get_wdir_ hcs_$initiate_count ioa_$rsnp ioa_$rsnpnnl tssi_$finish_segment tssi_$get_segment NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000235 70 000271 72 000273 73 000276 74 000301 75 000304 76 000307 77 000312 78 000315 79 000320 80 000323 81 000326 82 000331 83 000334 84 000337 85 000342 86 000345 87 000350 88 000353 91 000354 92 000361 94 000406 96 000410 97 000431 100 000432 101 000443 102 000446 104 000450 105 000471 107 000512 109 000564 111 000571 112 000612 115 000613 117 000615 118 000645 121 000646 122 000655 124 000715 126 000720 127 000741 130 000742 131 000745 132 000751 133 000752 135 000753 137 000756 139 000775 140 000776 142 000777 144 001001 145 001002 146 001007 147 001010 150 001011 151 001020 153 001022 155 001025 157 001027 158 001036 159 001040 162 001041 165 001043 168 001053 169 001104 170 001106 173 001107 175 001111 177 001113 178 001145 179 001147 180 001150 183 001151 186 001152 187 001207 192 001210 194 001222 196 001223 197 001230 199 001231 201 001235 202 001247 208 001250 210 001254 211 001311 216 001312 217 001325 219 001331 223 001341 224 001350 225 001357 229 001361 233 001362 235 001370 236 001407 237 001414 240 001424 244 001430 246 001437 247 001445 249 001447 251 001451 253 001522 255 001523 256 001570 257 001572 261 001573 262 001605 264 001606 265 001643 268 001644 270 001656 271 001665 272 001674 274 001676 275 001700 276 001705 278 001706 281 001762 283 001764 296 002027 297 002031 299 002032 301 002057 302 002061 ----------------------------------------------------------- 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