COMPILATION LISTING OF SEGMENT make_commands Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1642.6 mst Thu 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 make_commands: procedure (); 12 13 /* 14* 15* Coded for the Limited Service System May 1970 by R. Frankston 16* Modified by Dan Bricklin Nov 1970 17* Updated 7/22/76 to current version PL/I by S. Herbst 18* Modified March 1977 by M. R. Jordan to correct errors and update to use expand_pathname_ (MCR #2576) 19* 20**/ 21 22 23 24 /* 25* 26* make_commands, mc 27* 28* Usage: 29* 30* make_commands 31* 32* Where: 33* 34* is the pathname of the input segment. The .ct suffix may 35* be included but is not necessary (it will be assumed). The 36* make_commands command will build a command table from the ASCII input 37* segment to be used by transform_command_ whenever the 38* command_processor_ recieves a command from the listen_ procedure. The 39* table built is named where is the entry name 40* of with the .ct suffix removed and is located in the 41* working direcory. The output segment must be named lss_command_list_ 42* to be used by the limited_service_subsystem_ or 43* limited_command_system_ process overseers. If the 44* limited_command_system_ process overseer is used, the output segment 45* must be located in the project directory. 46* 47**/ 48 49 dcl NL char (1) aligned internal static options (constant) init (" 50 "); 51 dcl aclinfo_ptr ptr; 52 dcl arg_ptr ptr; 53 dcl arglen fixed bin; 54 dcl before builtin; 55 dcl bit_count fixed bin (24); 56 dcl ch char (arglen) based (arg_ptr) unaligned; 57 dcl chr char (1) aligned; 58 dcl chs char (100) aligned based (input_pointer); 59 dcl cleanup condition; 60 dcl code fixed bin (35); 61 dcl com_err_ ext entry options (variable); 62 dcl command_pointer ptr; 63 dcl cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)); 64 dcl cv_dec_ ext entry (char (*) aligned) returns (fixed bin (35)); 65 dcl dirname char (168); 66 dcl divide builtin; 67 dcl ename char (32); 68 dcl error_occurred bit (1) aligned; 69 dcl error_table_$segknown external fixed bin (35); 70 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 71 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 72 dcl first fixed bin; 73 dcl fixed builtin; 74 dcl hcs_$initiate_count ext entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 75 dcl i fixed bin; 76 dcl in_comment bit (1) aligned; 77 dcl index builtin; 78 dcl input_pointer pointer; 79 dcl ioa_ ext entry options (variable); 80 dcl j fixed bin; 81 dcl length builtin; 82 dcl line char (256) aligned varying; 83 dcl lineno fixed bin; 84 dcl min builtin; 85 dcl n fixed bin; 86 dcl name_len fixed bin; 87 dcl next_free fixed bin; 88 dcl null builtin; 89 dcl output_name char (32); 90 dcl paren bit (1) aligned; 91 dcl path_len fixed bin; 92 dcl rtrim builtin; 93 dcl s fixed bin; 94 dcl skip bit (1) aligned; 95 dcl start_line fixed bin; 96 dcl start_name fixed bin; 97 dcl substr builtin; 98 dcl temp1 fixed bin; 99 dcl tssi_$get_segment entry (char (*), char (*), ptr, ptr, fixed bin (35)); 100 dcl tssi_$finish_segment entry (ptr, fixed bin (24), bit (36) aligned, ptr, fixed bin (35)); 101 dcl tssi_$clean_up_segment entry (ptr); 102 103 /* 104* 105* The following structure is used as temporary storage for the command 106* transformation information until we can determine just exactly how many 107* commands there are. 108* 109**/ 110 111 112 dcl 1 commands aligned, 113 2 com_info (200), 114 3 name char (32), 115 3 path char (168), 116 3 len fixed bin (71); 117 118 119 /* 120* 121* The following table is the template for the final output segment created 122* by this command. The table contains information for mapping commands 123* typed to actual command segment names. Also information for the governor 124* is save in this structure. 125* 126* */ 127 128 129 dcl 1 table based (command_pointer) aligned, 130 2 ratio fixed bin (17), 131 2 interval_len fixed bin (17), 132 2 number_of_names fixed bin (71), 133 2 names (code refer (number_of_names)) char (32) aligned, 134 2 pointers (code refer (number_of_names)) aligned, 135 3 where fixed bin (17), 136 3 length fixed bin (17), 137 2 paths char (100) aligned; 138 139 goto common; 140 141 142 mc: entry (); 143 144 145 common: 146 147 148 call cu_$arg_ptr (1, arg_ptr, arglen, code); 149 if code ^= 0 then do; 150 call com_err_ (code, "make_commands", "Usage is: ""make_commands """); 151 return; 152 end; 153 154 call expand_pathname_$add_suffix (ch, "ct", dirname, ename, code); 155 if code ^= 0 then do; 156 in_err: call com_err_ (code, "make_commands", "^a", ch); 157 return; 158 end; 159 call hcs_$initiate_count (dirname, ename, "", bit_count, 01b, input_pointer, code); 160 if code ^= 0 then if code ^= error_table_$segknown then do; 161 if dirname = ">" then call com_err_ (code, "make_commands", ">^a", ename); 162 else call com_err_ (code, "make_commands", "^a>^a", dirname, ename); 163 return; 164 end; 165 166 output_name = substr (ename, 1, length (rtrim (ename))-3); 167 call expand_pathname_ (output_name, dirname, ename, code); 168 if code ^= 0 then do; 169 out_err: call com_err_ (code, "make_commands", "^a", output_name); 170 return; 171 end; 172 aclinfo_ptr = null (); 173 on cleanup 174 begin; 175 if aclinfo_ptr ^= null () then call tssi_$clean_up_segment (aclinfo_ptr); 176 end; 177 call tssi_$get_segment (dirname, ename, command_pointer, aclinfo_ptr, code); 178 if command_pointer = null then go to out_err; 179 180 /* 181* 182* Now parse the input segment and build a temporary table of the results of 183* that parse. 184* 185**/ 186 187 188 temp1 = divide (bit_count, 9, 17, 0); 189 n = 0; 190 s, lineno, start_line = 1; 191 paren, in_comment, skip, error_occurred = "0"b; 192 do i = 1 to temp1; 193 if in_comment then 194 if substr (chs, i-1, 2) = "*/" then do; 195 in_comment = "0"b; 196 chr = " "; 197 go to blank; 198 end; 199 else go to next; 200 chr = substr (chs, i, 1); 201 if chr = NL then do; 202 lineno = lineno + 1; 203 go to next; 204 end; 205 if skip then do; 206 if chr = ";" then skip = "0"b; 207 s = 1; 208 start_line = i+1; 209 go to next; 210 end; 211 if chr = "/" then 212 if i < temp1 then 213 if substr (chs, i+1, 1) = "*" then do; 214 in_comment = "1"b; 215 go to next; 216 end; 217 if chr = " " then do; 218 blank: if s = 2 then if paren then do; 219 s = 1; 220 name_len = 0; 221 end; 222 else s = 3; 223 if s = 5 then s = 6; 224 go to next; 225 end; 226 227 if chr = " " then do; /* tab */ 228 if s = 1|s = 4 then go to next; 229 go to error; 230 end; 231 232 if chr = "(" then do; 233 if ^paren & s = 1 then do; 234 paren = "1"b; 235 first = n+1; 236 go to next; 237 end; 238 go to error; 239 end; 240 241 if chr = ")" then do; 242 if paren then do; 243 if s = 2 then s = 3; 244 if s ^= 3 then go to error; 245 paren = "0"b; 246 go to next; 247 end; 248 go to error; 249 end; 250 251 if chr = ":" then do; 252 if paren then go to error; 253 if s = 2|s = 3 then do; 254 s = 4; 255 go to next; 256 end; 257 go to error; 258 end; 259 260 if chr = ";" then do; 261 if s = 4 then do; 262 do j = first to n; 263 commands.path (j) = commands.name (n); 264 commands.len (j) = name_len; 265 end; 266 s = 1; 267 start_line = i+1; 268 go to next; 269 end; 270 if s = 5|s = 6 then do; 271 do j = first to n-1; 272 commands.len (j) = path_len; 273 commands.path (j) = commands.path (n); 274 end; 275 commands.len (n) = path_len; 276 s = 1; 277 start_line = i+1; 278 go to next; 279 end; 280 go to error; 281 end; 282 283 /* other characters */ 284 285 if s = 1 then do; 286 s = 2; 287 n = n+1; 288 if ^paren then first = n; 289 if n>200 then do; 290 call com_err_ (0, "make_commands", "Max number of names (200) exceeded, terminating run."); 291 return; 292 end; 293 commands.name (n) = " "; 294 name_len = 0; 295 start_name = i; 296 end; 297 if s = 2 then do; 298 name_len = name_len + 1; 299 substr (commands.name (n), name_len, 1) = chr; 300 go to next; 301 end; 302 if s = 4 then do; 303 s = 5; 304 path_len = 0; 305 commands.path (n) = " "; 306 end; 307 if s = 5 then do; 308 path_len = path_len+1; 309 substr (commands.path (n), path_len, 1) = chr; 310 go to next; 311 end; 312 error: line = substr (chs, start_line, min (index (substr (chs, i, temp1-i+1), ";")+i-1, temp1)-start_line+1); 313 call com_err_ (0, "make_commands", "Syntax error on line ^d, around char #^d of statement: ^a", 314 lineno, i-start_line, line); 315 error_occurred, skip = "1"b; 316 317 next: end; 318 319 if s ^= 1 then do; 320 call com_err_ (0, "make_commands", "Last statement doesn't end with a semi-colon."); 321 give_up: call com_err_ (0, "make_commands", "At least one syntax error, compilation is aborted."); 322 return; 323 end; 324 325 if error_occurred then go to give_up; 326 327 /* 328* 329* Now we must build the commands table from the data gathered thus far. 330* 331**/ 332 333 334 next_free = 1; 335 j = 1; 336 ratio, interval_len = 0; 337 if commands.name (1) = "ratio" then if commands.name (2) = "interval" then do; 338 ratio = cv_dec_ (commands.path (1)); 339 interval_len = cv_dec_ (commands.path (2)); 340 call ioa_ ("ratio = ^d, interval = ^d", ratio, interval_len); 341 j = 3; 342 end; 343 number_of_names = n - j + 1; 344 do i = j to n; 345 table.names (i-j+1) = commands.name (i); 346 pointers.where (i-j+1) = next_free; 347 next_free = next_free + commands.len (i); 348 if i>j then if commands.path (i) = commands.path (i-1) then do; 349 next_free = pointers.where (i-j+1); 350 pointers.where (i-j+1) = pointers.where (i-j); 351 end; 352 pointers.length (i-j+1) = commands.len (i); 353 substr (paths, pointers.where (i-j+1), pointers.length (i-j+1)) = substr (commands.path (i), 1, pointers.length (i-j+1)); 354 end; 355 i = 4 + 10*number_of_names + divide (next_free+2, 4, 17, 0); 356 call tssi_$finish_segment (command_pointer, fixed (i*36, 24), "110"b, aclinfo_ptr, code); 357 revert cleanup; 358 if code ^= 0 then go to out_err; 359 return; 360 361 end make_commands; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1613.4 make_commands.pl1 >dumps>old>recomp>make_commands.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. NL constant char(1) initial dcl 49 ref 201 aclinfo_ptr 000100 automatic pointer dcl 51 set ref 172* 175 175* 177* 356* arg_ptr 000102 automatic pointer dcl 52 set ref 145* 154 156 arglen 000104 automatic fixed bin(17,0) dcl 53 set ref 145* 154 154 156 156 bit_count 000105 automatic fixed bin(24,0) dcl 55 set ref 159* 188 ch based char unaligned dcl 56 set ref 154* 156* chr 000106 automatic char(1) dcl 57 set ref 196* 200* 201 206 211 217 227 232 241 251 260 299 309 chs based char(100) dcl 58 ref 193 200 211 312 312 cleanup 000110 stack reference condition dcl 59 ref 173 357 code 000116 automatic fixed bin(35,0) dcl 60 set ref 145* 149 150* 154* 155 156* 159* 160 160 161* 162* 167* 168 169* 177* 356* 358 com_err_ 000010 constant entry external dcl 61 ref 150 156 161 162 169 290 313 320 321 com_info 000340 automatic structure array level 2 dcl 112 command_pointer 000120 automatic pointer dcl 62 set ref 177* 178 336 336 338 339 340 340 343 345 346 349 350 350 352 353 353 353 353 355 356* commands 000340 automatic structure level 1 dcl 112 cu_$arg_ptr 000012 constant entry external dcl 63 ref 145 cv_dec_ 000014 constant entry external dcl 64 ref 338 339 dirname 000122 automatic char(168) unaligned dcl 65 set ref 154* 159* 161 162* 167* 177* divide builtin function dcl 66 ref 188 355 ename 000174 automatic char(32) unaligned dcl 67 set ref 154* 159* 161* 162* 166 166 167* 177* error_occurred 000204 automatic bit(1) dcl 68 set ref 191* 315* 325 error_table_$segknown 000016 external static fixed bin(35,0) dcl 69 ref 160 expand_pathname_ 000020 constant entry external dcl 70 ref 167 expand_pathname_$add_suffix 000022 constant entry external dcl 71 ref 154 first 000205 automatic fixed bin(17,0) dcl 72 set ref 235* 262 271 288* fixed builtin function dcl 73 ref 356 356 hcs_$initiate_count 000024 constant entry external dcl 74 ref 159 i 000206 automatic fixed bin(17,0) dcl 75 set ref 192* 193 200 208 211 211 267 277 295 312 312 312 313* 344* 345 345 346 347 348 348 348 349 350 350 352 352 353 353 353 353* 355* 356 356 in_comment 000207 automatic bit(1) dcl 76 set ref 191* 193 195* 214* index builtin function dcl 77 ref 312 input_pointer 000210 automatic pointer dcl 78 set ref 159* 193 200 211 312 312 interval_len 1 based fixed bin(17,0) level 2 dcl 129 set ref 336* 339* 340* ioa_ 000026 constant entry external dcl 79 ref 340 j 000212 automatic fixed bin(17,0) dcl 80 set ref 262* 263 264* 271* 272 273* 335* 341* 343 344 345 346 348 349 350 350 352 353 353 353 len 62 000340 automatic fixed bin(71,0) array level 3 dcl 112 set ref 264* 272* 275* 347 352 length based fixed bin(17,0) array level 3 in structure "table" dcl 129 in procedure "make_commands" set ref 352* 353 353 length builtin function dcl 81 in procedure "make_commands" ref 166 line 000213 automatic varying char(256) dcl 82 set ref 312* 313* lineno 000314 automatic fixed bin(17,0) dcl 83 set ref 190* 202* 202 313* min builtin function dcl 84 ref 312 n 000315 automatic fixed bin(17,0) dcl 85 set ref 189* 235 262 263 271 273 275 287* 287 288 289 293 299 305 309 343 344 name 000340 automatic char(32) array level 3 dcl 112 set ref 263 293* 299* 337 337 345 name_len 000316 automatic fixed bin(17,0) dcl 86 set ref 220* 264 294* 298* 298 299 names 4 based char(32) array level 2 dcl 129 set ref 345* next_free 000317 automatic fixed bin(17,0) dcl 87 set ref 334* 346 347* 347 349* 355 null builtin function dcl 88 ref 172 175 178 number_of_names 2 based fixed bin(71,0) level 2 dcl 129 set ref 343* 346 349 350 350 352 353 353 353 353 353 355 output_name 000320 automatic char(32) unaligned dcl 89 set ref 166* 167* 169* paren 000330 automatic bit(1) dcl 90 set ref 191* 218 233 234* 242 245* 252 288 path 10 000340 automatic char(168) array level 3 dcl 112 set ref 263* 273* 273 305* 309* 338* 339* 348 348 353 path_len 000331 automatic fixed bin(17,0) dcl 91 set ref 272 275 304* 308* 308 309 paths based char(100) level 2 dcl 129 set ref 353* pointers based structure array level 2 dcl 129 ratio based fixed bin(17,0) level 2 dcl 129 set ref 336* 338* 340* rtrim builtin function dcl 92 ref 166 s 000332 automatic fixed bin(17,0) dcl 93 set ref 190* 207* 218 219* 222* 223 223* 228 228 233 243 243* 244 253 253 254* 261 266* 270 270 276* 285 286* 297 302 303* 307 319 skip 000333 automatic bit(1) dcl 94 set ref 191* 205 206* 315* start_line 000334 automatic fixed bin(17,0) dcl 95 set ref 190* 208* 267* 277* 312 312 313 start_name 000335 automatic fixed bin(17,0) dcl 96 set ref 295* substr builtin function dcl 97 set ref 166 193 200 211 299* 309* 312 312 353* 353 table based structure level 1 dcl 129 temp1 000336 automatic fixed bin(17,0) dcl 98 set ref 188* 192 211 312 312 tssi_$clean_up_segment 000034 constant entry external dcl 101 ref 175 tssi_$finish_segment 000032 constant entry external dcl 100 ref 356 tssi_$get_segment 000030 constant entry external dcl 99 ref 177 where based fixed bin(17,0) array level 3 dcl 129 set ref 346* 349 350* 350 353 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. before builtin function dcl 54 NAMES DECLARED BY EXPLICIT CONTEXT. blank 000777 constant label dcl 218 ref 197 common 000171 constant label dcl 145 ref 139 error 001337 constant label dcl 312 set ref 229 238 244 248 252 257 280 give_up 001504 constant label dcl 321 ref 325 in_err 000303 constant label dcl 156 make_commands 000155 constant entry external dcl 11 mc 000164 constant entry external dcl 142 next 001446 constant label dcl 317 ref 193 203 209 215 224 228 236 246 255 268 278 300 310 out_err 000553 constant label dcl 169 ref 178 358 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2222 2260 2044 2232 Length 2452 2044 36 155 155 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME make_commands 10724 external procedure is an external procedure. on unit on line 173 68 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME make_commands 000100 aclinfo_ptr make_commands 000102 arg_ptr make_commands 000104 arglen make_commands 000105 bit_count make_commands 000106 chr make_commands 000116 code make_commands 000120 command_pointer make_commands 000122 dirname make_commands 000174 ename make_commands 000204 error_occurred make_commands 000205 first make_commands 000206 i make_commands 000207 in_comment make_commands 000210 input_pointer make_commands 000212 j make_commands 000213 line make_commands 000314 lineno make_commands 000315 n make_commands 000316 name_len make_commands 000317 next_free make_commands 000320 output_name make_commands 000330 paren make_commands 000331 path_len make_commands 000332 s make_commands 000333 skip make_commands 000334 start_line make_commands 000335 start_name make_commands 000336 temp1 make_commands 000340 commands make_commands THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mpfx2 enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr cv_dec_ expand_pathname_ expand_pathname_$add_suffix hcs_$initiate_count ioa_ tssi_$clean_up_segment tssi_$finish_segment tssi_$get_segment THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000154 139 000162 142 000163 145 000171 149 000210 150 000212 151 000242 154 000243 155 000301 156 000303 157 000341 159 000342 160 000405 161 000412 162 000451 163 000507 166 000510 167 000525 168 000551 169 000553 170 000606 172 000607 173 000611 175 000625 176 000640 177 000641 178 000671 188 000675 189 000700 190 000701 191 000705 192 000711 193 000720 195 000727 196 000730 197 000732 200 000733 201 000740 202 000743 203 000744 205 000745 206 000747 207 000753 208 000755 209 000760 211 000761 214 000772 215 000774 217 000775 218 000777 219 001004 220 001006 221 001007 222 001010 223 001012 224 001016 227 001017 228 001021 229 001026 232 001027 233 001031 234 001036 235 001040 236 001043 238 001044 241 001045 242 001047 243 001051 244 001056 245 001060 246 001061 248 001062 251 001063 252 001065 253 001067 254 001074 255 001076 257 001077 260 001100 261 001102 262 001105 263 001114 264 001125 265 001130 266 001132 267 001134 268 001137 270 001140 271 001144 272 001154 273 001161 274 001170 275 001172 276 001200 277 001202 278 001205 280 001206 285 001207 286 001212 287 001214 288 001215 289 001221 290 001224 291 001255 293 001256 294 001263 295 001264 297 001266 298 001271 299 001272 300 001304 302 001305 303 001307 304 001311 305 001312 307 001320 308 001323 309 001324 310 001336 312 001337 313 001373 315 001443 317 001446 319 001450 320 001453 321 001504 322 001535 325 001536 334 001540 335 001542 336 001543 337 001546 338 001556 339 001575 340 001615 341 001640 343 001642 344 001651 345 001660 346 001674 347 001714 348 001717 349 001731 350 001733 352 001742 353 001751 354 001775 355 001777 356 002012 357 002035 358 002036 359 002040 ----------------------------------------------------------- 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