COMPILATION LISTING OF SEGMENT dfast_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1553.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 dfast_: proc (person_id, arg_home_dir, project_id, tty_line_id, logout_arg); 7 8 /* This procedure is the listener for DFAST as well as the parser for edit commands. */ 9 10 dcl arg_home_dir char (*); /* home directory from pit */ 11 dcl project_id char (*); /* project_id for tty command */ 12 dcl tty_line_id char (*); /* tty line */ 13 dcl logout_arg char (*); /* = "hold" for HELLO */ 14 dcl person_id char (*); /* name at login */ 15 16 17 /* constants */ 18 19 dcl command_names char (148) int static options (constant) init 20 ("com,edi,lis,tty,bri,nbr,sor,ren,new,uns,sav,rep,old,bui,app,ign,scr,use,bye,goo,hel,PUN,bil,len,sys,exp,ful,hal,one,two,TAP,KEY,DIR,typ,run"); 21 22 /* * 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 */ 23 24 dcl READ fixed bin init (1) int static options (constant); /* directory_: read into the current segment. */ 25 dcl SAVE fixed bin init (2) int static options (constant); /* directory_: store only if the segment does not exist. */ 26 dcl REPLACE fixed bin init (3) int static options (constant); /* directory_: store only if the segment does exist. */ 27 dcl DELETE fixed bin init (4) int static options (constant); /* directory_: delete the segment */ 28 dcl TRUNCATE fixed bin init (6) int static options (constant); /* directory_: truncate the segment. */ 29 dcl APPEND fixed bin init (1) int static options (constant); /* edit_: append alter to current segment */ 30 dcl SORT fixed bin init (2) int static options (constant); /* edit_: merge alter and current and sort */ 31 dcl BUILD fixed bin int static options (constant) init (5); /* edit_: append to current segment */ 32 dcl ALTER fixed bin int static options (constant) init (6); /* edit_: append to alter segment */ 33 dcl LENGTH fixed bin int static options (constant) init (7); /* edit_: merge temporary segments and give length */ 34 dcl arg_delimit char (4) int static options (constant) init (" ,;"); /* tab blank comma semi-colon */ 35 dcl dfast_name char (5) int static options (constant) init ("dfast"); 36 dcl white_space char (2) int static options (constant) init (" "); /* tab blank */ 37 dcl character_set char (68) int static options (constant) init (">._-0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ "); 38 dcl digit char (10) defined (character_set) pos (5); /* digits */ 39 dcl letter char (52) defined (character_set) pos (15); /* letters */ 40 dcl name_char char (68) defined (character_set) pos (1); /* legal segment name characters */ 41 dcl lowercase_letters char (26) defined (character_set) pos (15); 42 dcl uppercase_letters char (26) defined (character_set) pos (41); 43 44 /* automatic */ 45 46 dcl input char (256); 47 dcl input_length fixed bin; /* line length without the new-line */ 48 dcl arg char (256) var; 49 dcl ready bit (1); /* ON if ready message should be printed */ 50 dcl (length, index, verify, substr, addr, divide, search, null, translate) builtin; 51 dcl (i, num_1, request) fixed bin; 52 dcl header bit (1) unal; /* ON = list with header */ 53 dcl sort bit (1) unal; /* dfast_line_edit_: ON sort; OFF no sort */ 54 dcl string char (256) var; 55 dcl code fixed bin (35); 56 57 dcl quit condition; 58 59 60 /* external */ 61 62 dcl clock_ entry () returns (fixed bin (71)); 63 dcl condition_ entry (char (*), entry); 64 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); 65 dcl date_time_ entry (fixed bin (71), char (*)); 66 dcl error_table_$long_record fixed bin (35) ext; 67 dcl dfast_command_processor_ entry (ptr, char (*), char (*), fixed bin (35)); 68 dcl dfast_compile_ entry (ptr, fixed bin (35)); 69 dcl dfast_directory_ entry (fixed bin, char (*), ptr, ptr, fixed bin (35)); 70 dcl dfast_edit_ entry (fixed bin, char (*), ptr, fixed bin (35)); 71 dcl dfast_error_ entry (fixed bin (35), char (*), char (*)); 72 dcl dfast_explain_ entry (char (*) var, char (*), fixed bin (35)); 73 dcl dfast_line_edit_ entry (char (256) var, ptr, bit (1) unal, fixed bin (35)); 74 dcl dfast_list_ entry (ptr, char (*), fixed bin, bit (1) unal, bit (1) unal, fixed bin (35)); 75 dcl dfast_merge_ entry (bit (1), ptr, fixed bin (35)); 76 dcl fast_related_data_$in_fast_or_dfast bit (1) aligned ext; 77 dcl fast_related_data_$in_dfast bit (1) aligned ext; 78 dcl dfast_run_ entry (ptr, fixed bin (35)); 79 dcl dfast_set_system_ entry (char (256) var, bit (1) unal, char (*), fixed bin (35)); 80 dcl dfast_terminal_control_ entry (fixed bin, char (*), ptr, fixed bin (35)); 81 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 82 dcl hmu entry options (variable); 83 dcl ioa_$ioa_switch entry options (variable); 84 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin, fixed bin (35)); 85 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); 86 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 87 dcl iox_$user_input ptr ext static; 88 dcl iox_$user_output ptr ext static; 89 dcl resource_usage entry (); 90 91 dcl sys_info$max_seg_size fixed bin (35) ext; 92 93 dcl edit_info_ptr ptr; 94 dcl 1 f aligned like dfast_edit_info; 1 1 /* BEGIN INCLUDE FILE -- dfast_edit_info.incl.pl1 1 2* written 5/75 by S.E.Barr 1 3**/ 1 4 dcl 1 dfast_edit_info aligned based (edit_info_ptr), 1 5 2 flags aligned, 1 6 3 brief_mode bit (1) unal, /* ON if short messages to be used */ 1 7 3 build_mode bit (1) unal, /* On if in build mode */ 1 8 3 source_segment bit (1) unal, /* ON if segment is source */ 1 9 3 edit_done bit (1) unal, /* ON if current segment has been edited since save */ 1 10 3 basic_system bit (1) unal, /* ON if basic, OFF if fortran */ 1 11 3 caps_mode bit (1) unal, /* ON if running in CAPS mode */ 1 12 3 dbasic bit (1) unal, /* ON if double prec basic */ 1 13 3 pad bit (29) unal, 1 14 2 system_info aligned, 1 15 3 max_seg_size fixed bin (21), /* maximum segment size in characters */ 1 16 3 user_name char (32) aligned, /* person id */ 1 17 3 tty_id char (6) unal, /* terminal id of the form "ttynnn" */ 1 18 3 current_name char (256) var aligned, /* name of current segment */ 1 19 3 current_length fixed bin (21), /* length in characters of current segment */ 1 20 3 alter_length fixed bin (21), /* length in characters of the alter segment */ 1 21 3 current_ptr ptr, /* ptr to current segment */ 1 22 3 alter_ptr ptr, 1 23 3 home_dir char (168) var, /* home directory from pit */ 1 24 3 user_id char (32) var, /* login id */ 1 25 3 project_id char (32) var, /* login home directory */ 1 26 3 source_directory char (168) aligned, /* directory of where the source was. For COMPILE. */ 1 27 3 source_entryname char (32); /* name of the source. For COMPILE. */ 1 28 1 29 /* END INCLUDE FILE -- dfast_edit_info.incl.pl1 */ 95 2 1 /* BEGIN INCLUDE ... dfast_error_codes.incl.pl1 */ 2 2 2 3 dcl error_alt_empty fixed bin (35) int static init (1)options (constant); 2 4 dcl error_max_size fixed bin (35) int static init (2)options (constant); 2 5 dcl error_cur_empty fixed bin (35) int static init (3)options (constant); 2 6 dcl error_not_saved fixed bin (35) int static init (4)options (constant); 2 7 dcl error_name_dup fixed bin (35) int static init (5)options (constant); 2 8 dcl error_long_rec fixed bin (35) int static init (6)options (constant); 2 9 dcl error_unknown_arg fixed bin (35) int static init (7)options (constant); 2 10 dcl error_no_expl fixed bin (35) int static init (8)options (constant); 2 11 dcl error_bad_name fixed bin (35) int static init (9)options (constant); 2 12 dcl error_bad_req fixed bin (35) int static init (10)options (constant); 2 13 dcl error_syntax_string fixed bin (35) int static init (11)options (constant); 2 14 dcl error_name_miss fixed bin (35) int static init (12)options (constant); 2 15 dcl error_no_comp fixed bin (35) int static init (13)options (constant); 2 16 dcl error_no_main fixed bin (35) int static init (14)options (constant); 2 17 dcl error_block_spec fixed bin (35) int static init (15)options (constant); 2 18 dcl error_obj_nop fixed bin (35) int static init (16)options (constant); 2 19 dcl error_sav_cur fixed bin (35) int static init (17)options (constant); 2 20 dcl error_bad_type fixed bin (35) int static init (18)options (constant); 2 21 dcl error_unkn_sys fixed bin (35) int static init (19)options (constant); 2 22 dcl error_no_suffix fixed bin (35) int static init (20)options (constant); 2 23 dcl error_no_nl fixed bin (35) int static init (21)options (constant); 2 24 dcl error_bad_sort fixed bin (35) int static init (22)options (constant); 2 25 dcl error_no_num fixed bin (35) int static init (23)options (constant); 2 26 dcl error_line_miss fixed bin (35) int static init (24)options (constant); 2 27 dcl error_request_miss fixed bin (35) int static init (25)options (constant); 2 28 dcl error_bad_line fixed bin (35) int static init (26)options (constant); 2 29 dcl error_no_string fixed bin (35) int static init (27)options (constant); 2 30 dcl error_line_order fixed bin (35) int static init (28)options (constant); 2 31 dcl error_max_lines fixed bin (35) int static init (29)options (constant); 2 32 dcl error_bad_pathname fixed bin (35) int static init (30)options (constant); 2 33 dcl error_access_mode fixed bin (35) int static init (31)options (constant); 2 34 dcl error_delimiter_miss fixed bin (35) int static init (32)options (constant); 2 35 dcl error_size_fixed_record fixed bin (35) int static init (33)options (constant); 2 36 dcl error_bad_rec_len fixed bin (35) int static init (34)options (constant); 2 37 dcl error_string_size fixed bin (35) int static init (35)options (constant); 2 38 dcl error_max_line_number fixed bin (35) int static init (36)options (constant); 2 39 dcl error_max_args fixed bin (35) int static init (37)options (constant); 2 40 dcl error_name_sys fixed bin (35) int static init (38)options (constant); 2 41 dcl error_dprint_map fixed bin (35) int static init (39)options (constant); 2 42 dcl error_max_num fixed bin (35) int static options (constant) init (40); 2 43 dcl error_edit_max_num fixed bin (35) int static options (constant) init (41); 2 44 dcl error_un_num_text fixed bin (35) int static options (constant) init (42); 2 45 dcl error_no_new_line fixed bin (35) int static options (constant) init (43); 2 46 2 47 /* END INCLUDE ... dfast_error_codes.incl.pl1 */ 96 97 /* */ 98 99 call initial; 100 if code ^= 0 then return; 101 on quit begin; 102 ready = "1"b; 103 call iox_$control (iox_$user_input, "resetread", addr (input), code); 104 call ioa_$ioa_switch (iox_$user_output, "QUIT^/"); 105 goto READY; 106 end; 107 call condition_ ("any_other", any_other_handler); 108 109 /* * This loop prints the ready message and reads a line from the terminal. These conventions are used: 110* * 111* * 1. Special case the BUILD mode. 112* * a. If the line contains only a new_line character, BUILD mode is terminated. 113* * b. Otherwise the line is appended to the end of the current_file. 114* * 2. Blank lines are ignored. 115* * 3. Text lines begin with a digit and are stored in temporary segment alt to be merged later. 116* * 4. Command lines: 117* * a. Single command lines begin with an alphabetic character. Only the first three characters 118* * are used. 119* * b. Multi-command lines begin with any character except a digit or an alphabetic charcter. 120* * (ie. /tty/run/lis ) 121**/ 122 123 READY: 124 do while ("1"b); 125 if ready then do; 126 call date_time_ (clock_ (), input); 127 call ioa_$ioa_switch (iox_$user_output, "ready ^a^/", substr (input, 11, 4)); 128 end; 129 ready = "0"b; 130 131 call iox_$get_line (iox_$user_input, addr (input), 256, input_length, code); 132 133 if code ^= 0 then do; 134 if code = error_table_$long_record then call dfast_error_ (error_long_rec, "", ""); 135 end; 136 137 else if f.build_mode then do; 138 if input_length = 1 then do; 139 f.build_mode = "0"b; 140 ready = "1"b; 141 end; 142 143 else call dfast_edit_ (BUILD, substr (input, 1, input_length), edit_info_ptr, code); 144 end; 145 146 else do; 147 i = verify (substr (input, 1, input_length -1), white_space); 148 149 if i > 0 then do; 150 if index (digit, substr (input, i, 1)) > 0 151 then call dfast_edit_ (ALTER, substr (input, i, input_length - i + 1), edit_info_ptr, code); 152 153 else do; /* command */ 154 if ^f.brief_mode then ready = "1"b; 155 156 if index (letter, substr (input, i, 1)) > 0 157 then call command (substr (input, i, input_length - i), code); 158 else call multi_command ((i)); 159 end; 160 end; 161 end; 162 163 end; 164 165 RETURN: return; 166 167 /* */ 168 169 /* This procedure is used to find the next argument on the line. It expects the form: 170* 171* [blank | tab] [argument] [blank | tab | comma | semi-colon] 172* 173* Any of the fields may be null. If no argument and no delimitor is found, then the procedure returns "0"b. 174* Otherwise "1"b is returned. 175**/ 176 get_arg: proc (line, argument) returns (bit (1)); 177 178 dcl argument char (256) var; /* next argument (output) */ 179 180 dcl line char (256) var; /* input buffer */ 181 dcl line_length fixed bin; /* length of line on input */ 182 dcl argument_length fixed bin; /* length of argument */ 183 dcl start fixed bin; /* index in line of start of argument */ 184 185 line_length = length (line); 186 187 if line_length > 0 then do; 188 189 start = verify (line, white_space); 190 if start > 0 then do; 191 argument_length = search (substr (line, start), arg_delimit); 192 193 if argument_length = 0 then argument_length = line_length - start + 1; 194 else argument_length = argument_length - 1; 195 argument = substr (line, start, argument_length); 196 start = start + argument_length + 1; /* move beyond the argument delimitor */ 197 if start > line_length then line = ""; 198 else line = substr (line, start, line_length - start + 1); 199 200 return ("1"b); 201 end; 202 end; 203 return ("0"b); 204 end get_arg; 205 206 /* */ 207 line_number: proc (string, num) returns (bit (1)); 208 dcl string char (*) var; 209 dcl num fixed bin; 210 211 num = cv_dec_check_ ((string), code); 212 if code = 0 then do; 213 if num > 0 then return ("1"b); 214 else call dfast_error_ (error_bad_line, "", (arg)); 215 end; 216 else return ("0"b); 217 end line_number; 218 219 220 /* */ 221 /* This procedure parses the line for a pathname and verifies that it contains legal characters. 222* If the name is not found and request is set, the user is queried for a name. 223* * 224* * Code Pathname Explaination 225* * 226* * 0 ^= "" A legal pathname was found and is returned. 227* * 0 = "" No pathname was given and the query was not requested. 228* * bad_name (not set) The pathname given contained one or more illegal characters. 229* * name_miss (not set) The name was not given on the line or with the query and request was set. 230**/ 231 get_name: proc (line, name, request, code); 232 233 dcl line char (256) var; 234 dcl name char (*) var; /* pathname (output) */ 235 dcl request bit (1); /* ON if should request name (input) */ 236 dcl code fixed bin (35); 237 238 if ^get_arg (line, arg) then do; 239 if ^request then do; 240 name = ""; 241 return; 242 end; 243 244 call get_user_response ("0"b, "enter name: ", arg); 245 if arg = "" then code = error_name_miss; 246 end; 247 248 if code = 0 then do; 249 if verify (arg, name_char) > 0 then code = error_bad_name; 250 else name = arg; 251 end; 252 253 if code ^= 0 then if code ^= error_name_miss then call dfast_error_ (code, dfast_name, (arg)); 254 255 return; 256 257 end get_name; 258 259 /* */ 260 /* This command parses the command line for a command and executes it. It returns code: 261* 262* * code = 0 The command was successfully completed or was a null command. 263* * code ^= 0 An error prevented the command from being completed. 264**/ 265 command: proc (line, code); 266 267 dcl line char (256) var; 268 dcl code fixed bin (35); 269 270 if get_arg (line, arg) then do; 271 arg = translate (arg, lowercase_letters, uppercase_letters); 272 if length ((arg)) > 2 then do; 273 request = index (command_names, substr (arg, 1, 3)); 274 if request ^= 0 then do; 275 request = divide (request +3, 4, 17); 276 goto command_label (request); 277 end; 278 end; 279 call dfast_command_processor_ (edit_info_ptr, (arg), (line), code); 280 end; 281 282 return; 283 284 285 /* */ 286 /* * compile [fortran | basic] 287**/ 288 command_label (1): 289 290 if get_arg (line, arg) then call set_system (code); 291 if code = 0 then call dfast_compile_ (edit_info_ptr, code); 292 return; 293 294 /* * edit [] 295**/ 296 297 command_label (2): 298 if arg = "editns" | arg = "edins" then sort = "0"b; 299 else sort = "1"b; 300 301 call dfast_line_edit_ (line, edit_info_ptr, sort, code); 302 return; 303 304 305 /* list: omit header if user is in brief_mode or request was lisn, lisnh, listnh 306* [alt | cur] [] [] 307**/ 308 command_label (3): 309 310 if f.brief_mode then header = "0"b; 311 else if substr (arg, length (arg), 1) = "n" then header = "0"b; 312 else if substr (arg, length (arg) -1, 2) = "nh" then header = "0"b; 313 else header = "1"b; 314 315 call parse_list_punch (line, header, "0"b); 316 317 return; 318 319 /* tty */ 320 command_label (4): 321 322 if f.basic_system then if f.dbasic then string = "dbasic"; 323 else string = "basic"; 324 else string = "fortran"; 325 call ioa_$ioa_switch (iox_$user_output, "name = ^a, system = ^a, user = ^a.^a, line = ^a", 326 f.current_name, string, person_id, project_id, tty_line_id); 327 328 return; 329 330 /* brief */ 331 command_label (5): 332 f.brief_mode = "1"b; 333 ready = "0"b; 334 335 return; 336 337 /* nbrief */ 338 command_label (6): 339 340 f.brief_mode = "0"b; 341 return; 342 343 /* sort */ 344 command_label (7): 345 346 call dfast_edit_ (SORT, "", edit_info_ptr, code); 347 return; 348 349 /* * rename [] 350* * new [] 351**/ 352 command_label (8): 353 command_label (9): 354 355 call get_name (line, string, "1"b, code); 356 if code = 0 then do; 357 if index (string, ">") = 0 then do; 358 f.current_name = string; 359 call dfast_set_system_ (f.current_name, f.basic_system, "", 0); /* ignore code: OK if no suffix */ 360 end; 361 else do; 362 code = error_bad_name; 363 call dfast_error_ (code, "name", (string)); 364 end; 365 end; 366 else if code = error_name_miss then code = 0; /* ignore a chage of mind by user */ 367 if request = 9 then call reset_edit_info; 368 369 return; 370 371 372 373 /* * unsave [] 374**/ 375 command_label (10): 376 377 call segment_control (line, DELETE); 378 return; 379 380 /* save [] 381**/ 382 command_label (11): 383 384 call segment_control (line, SAVE); 385 return; 386 387 /* * replace [] 388**/ 389 command_label (12): 390 391 call segment_control (line, REPLACE); 392 return; 393 394 /* * old [] [] 395**/ 396 command_label (13): 397 398 call segment_control (line, READ); 399 if code = 0 then do; 400 if f.source_segment then do; 401 call dfast_set_system_ (f.current_name, f.basic_system, "", code); 402 if code ^= 0 then do; 403 code = 0; 404 if get_arg (line, arg) then call set_system (code); 405 else do; 406 call get_user_response ("0"b, "enter system name: ", arg); 407 call set_system (code); 408 do while (code ^= 0); 409 call get_user_response ("1"b, "answer 'basic', 'dbasic', or 'fortran': ", arg); 410 call set_system (code); 411 end; 412 end; 413 end; 414 end; 415 end; 416 return; 417 418 /* build */ 419 command_label (14): 420 421 if ^f.source_segment then call dfast_error_ (error_obj_nop, "build", ""); 422 else do; 423 if f.alter_length > 0 then call dfast_merge_ ("0"b, edit_info_ptr, code); 424 if code = 0 then f.build_mode = "1"b; 425 end; 426 427 return; 428 429 /* append */ 430 command_label (15): 431 432 call dfast_edit_ (APPEND, "", edit_info_ptr, code); 433 return; 434 435 /* ignore */ 436 command_label (16): 437 438 f.alter_length = 0; 439 return; 440 441 /* scratch */ 442 command_label (17): 443 444 if verify (line, white_space) = 0 then call reset_edit_info; 445 else call segment_control (line, TRUNCATE); 446 447 return; 448 449 450 /* user */ 451 command_label (18): 452 453 call hmu (); 454 return; 455 456 /* bye and goodbye */ 457 command_label (19): 458 command_label (20): 459 460 logout_arg = ""; 461 call bye_request; 462 return; 463 464 465 /* * hello 466* * 467* * help 468**/ 469 command_label (21): 470 471 if arg = "hello" then do; 472 logout_arg = "-hold"; 473 call bye_request; 474 return; 475 end; 476 477 else call dfast_explain_ ("", "help", code); 478 return; 479 480 /* punch */ 481 command_label (22): 482 483 call parse_list_punch (line, "0"b, "1"b); 484 return; 485 486 487 /* bill */ 488 command_label (23): 489 490 call resource_usage; 491 return; 492 493 /* length */ 494 command_label (24): 495 496 call dfast_edit_ (LENGTH, "", edit_info_ptr, code); 497 return; 498 499 /* * system [fortran | basic] 500**/ 501 command_label (25): 502 503 if ^get_arg (line, arg) then call get_user_response ("1"b, "enter system: ", arg); 504 505 call set_system (code); 506 507 return; 508 509 /* * explain 510**/ 511 command_label (26): 512 513 call dfast_explain_ (line, "explain", code); 514 return; 515 516 /* These commands change the input/output mode of the terminal. The order is important. 517* * 518* * (27) fullduplex 519* * (28) halfduplex 520* * (29) one_case 521* * (30) two_case 522* * (31) tape 523* * (32) keyboard 524* * (33) direct 525**/ 526 command_label (27): 527 command_label (28): 528 command_label (29): 529 command_label (30): 530 command_label (31): 531 command_label (32): 532 command_label (33): 533 534 call dfast_terminal_control_ (request - 26, "", edit_info_ptr, code); 535 if request = 33 then ready = "1"b; 536 return; 537 538 /* * type 539* * 540* * ::= tn300 | tty37 | tty33 541**/ 542 command_label (34): 543 544 if ^get_arg (line, arg) then arg = ""; 545 call dfast_terminal_control_ (request - 26, (arg), edit_info_ptr, code); 546 return; 547 548 /* * run [fortran | basic] 549**/ 550 command_label (35): 551 552 if get_arg (line, arg) then call set_system (code); 553 if code = 0 then call dfast_run_ (edit_info_ptr, code); 554 return; 555 556 end command; 557 558 /* */ 559 /* This procedure is used to read into or store from the current segment and to delete segments 560* If a pathname is given on the line, it is used. Otherwise the current name is used. 561* If no pathname is given and the current name is "no name", then and error message is printed and an error 562* code is returned. 563**/ 564 565 segment_control: proc (line, action); 566 567 dcl line char (256) var; 568 dcl action fixed bin; /* directory_: read, save, replace, delete */ 569 dcl request bit (1); /* get_name: ON if should request name */ 570 571 if f.current_name = "no name" then request = "1"b; 572 else request = "0"b; 573 574 call get_name (line, string, request, code); 575 576 if code = error_name_miss then call dfast_error_ (code, dfast_name, ""); 577 else if code = 0 then do; 578 if string = "" then string = f.current_name; 579 call dfast_directory_ (action, (string), edit_info_ptr, null, code); 580 if action ^= DELETE then f.edit_done = "0"b; 581 end; 582 583 return; 584 585 end segment_control; 586 587 /* */ 588 /* * This procedure prints a message and then reads one line from user_input. If the line contains 589* * at least one non_blank character, response is set and the procedure returns. If a blank 590* * line is input, there are two actions depending on repeat: 591* * 592* * "1"b the message is printed again. 593* * "0"b response is set to "" and the procedure returns 594**/ 595 get_user_response: proc (repeat, message, response); 596 597 dcl repeat bit (1); /* ON if should repeat for blank lines */ 598 dcl message char (*); 599 dcl response char (*) var; /* the response enterred by the user */ 600 601 dcl temp_buffer char (256); 602 dcl amt_read fixed bin; /* num_characters read */ 603 dcl start fixed bin; /* index of start of response */ 604 dcl num_chars fixed bin; /* number of characters in response */ 605 606 response = ""; 607 608 do while ("1"b); 609 call iox_$put_chars (iox_$user_output, addr (message), length (message), code); 610 call iox_$get_line (iox_$user_input, addr (temp_buffer), 256, amt_read, code); 611 amt_read = amt_read - 1; 612 if amt_read > 0 then do; 613 start = verify (substr (temp_buffer, 1, amt_read), white_space); 614 if start > 0 then do; 615 num_chars = index (substr (temp_buffer, start, amt_read), white_space) -1; 616 if num_chars = -1 then num_chars = amt_read - start + 1; 617 response = substr (temp_buffer, start, num_chars); 618 return; 619 end; 620 end; 621 622 if ^repeat then return; 623 end; 624 625 end get_user_response; 626 627 /* */ 628 /* * This procedure parses arg for a system name. Only the first three letters are used. 629* * The system may be fortran or basic or dbasic. The system can not be changed: 630* * 1. If the current segment is object code. 631* * 2. If the system would conflict with the current name. 632**/ 633 set_system: proc (code); 634 635 dcl code fixed bin (35); 636 dcl tag char (7); 637 638 string = substr (arg, 1, 3); 639 if f.source_segment then do; 640 call dfast_set_system_ (f.current_name, f.basic_system, tag, (0)); 641 if string = "bas" | string = "dba" then do; 642 if tag = "fortran" then code = error_name_sys; 643 if code = 0 then do; 644 f.basic_system = "1"b; 645 if string = "dba" then f.dbasic = "1"b; 646 else f.dbasic = "0"b; 647 end; 648 end; 649 650 else if string = "for" then do; 651 if tag = "basic" then code = error_name_sys; 652 if code = 0 then f.basic_system, f.dbasic = "0"b; 653 end; 654 else code = error_unkn_sys; 655 end; 656 657 else do; /* Can't override system in object segment */ 658 if string = "bas" & f.basic_system & ^f.dbasic then; 659 if string = "dba" & f.basic_system & f.dbasic then; 660 else if string = "for" then if ^f.basic_system then; 661 else code = error_obj_nop; 662 end; 663 664 if code ^= 0 then do; 665 if code = error_name_sys then arg = f.current_name; 666 call dfast_error_ (code, "system", (arg)); 667 end; 668 669 return; 670 671 end set_system; 672 673 /* */ 674 /* This procedure parses an input line with more than one command. The first character 675* on the line is the delimitor. Null commands are legal. 676**/ 677 678 multi_command: proc (start); 679 680 dcl start fixed bin; /* index of input of command delimitor character */ 681 dcl command_delimitor char (1); /* command delimitor character */ 682 dcl len fixed bin; /* length of command */ 683 684 command_delimitor = substr (input, start, 1); 685 start = start + 1; 686 input_length = input_length - 1; /* drop the new-line character */ 687 688 code = 0; 689 do while (start <= input_length & code = 0); 690 691 len = index (substr (input, start, input_length - start + 1), command_delimitor); 692 if len = 0 then len = input_length - start +2; 693 call command (substr (input, start, len -1), code); 694 695 start = start + len; 696 end; 697 698 return; 699 700 end multi_command; 701 702 /* */ 703 /* This code clears the edit info for the initialization and the scratch and new commands. 704**/ 705 reset_edit_info: proc; 706 707 f.current_length = 0; 708 f.alter_length = 0; 709 f.edit_done = "0"b; 710 f.source_segment = "1"b; 711 712 return; 713 714 end reset_edit_info; 715 716 /* */ 717 /* This procedure parses the arguments for the list and the punch commands. 718* * 719* * list 720* * punch 721* * 722* * temporary segment id = alt list the alter file. 723* * = cur list the current file. 724* * = "" Merge the alter and current files and then list. 725* * 726* * line number n List the file beginning with the line number n. 727**/ 728 parse_list_punch: proc (line, header, punch); 729 730 dcl line char (256) var; 731 dcl header bit (1) unal; /* ON if should print header */ 732 dcl punch bit (1) unal; /* ON if should punch; OFF if should list */ 733 734 num_1 = -1; /* default is entire segment */ 735 string = ""; /* default is merge with alter and then list */ 736 if get_arg (line, arg) then do; 737 string = substr (arg, 1, 3); 738 if string = "cur" | string = "alt" then do; 739 if get_arg (line, arg) then do; 740 if ^line_number (arg, num_1) then code = error_unknown_arg; 741 end; 742 end; 743 else do; 744 string = ""; 745 if ^line_number (arg, num_1) then code = error_unknown_arg; 746 end; 747 748 end; 749 750 if code = 0 then call dfast_list_ (edit_info_ptr, (string), num_1, header, punch, code); 751 752 else do; 753 if punch then string = "punch"; 754 else string = "list"; 755 call dfast_error_ (code, (string), (arg)); 756 end; 757 758 return; 759 760 end parse_list_punch; 761 762 /* */ 763 bye_request: proc; 764 765 766 if f.edit_done | f.alter_length > 0 then do; 767 call get_user_response ("0"b, "editing will be lost if you quit. Do you want to quit ? ", arg); 768 do while ("1"b); 769 if arg = "yes" | arg = "YES" then goto RETURN; 770 if arg = "no" | arg = "NO" then return; 771 call get_user_response ("1"b, "answer 'yes' or 'no': ", arg); 772 end; 773 end; 774 goto RETURN; 775 776 777 end bye_request; 778 779 /* */ 780 /* This procedure sets up the PI handler and gets two scratch buffers in the process directory. */ 781 782 initial: proc; 783 784 dcl ptr_array (2) ptr based; 785 786 code = 0; 787 edit_info_ptr = addr (f); 788 f.home_dir = arg_home_dir; 789 f.current_ptr = null; 790 call get_temp_segments_ (dfast_name, addr (f.current_ptr) -> ptr_array, code); 791 if code ^= 0 then call dfast_error_ (code, dfast_name, "current_segment"); 792 f.max_seg_size = sys_info$max_seg_size; 793 794 f.current_name = "no name"; 795 f.basic_system = "1"b; 796 f.brief_mode, f.build_mode = "0"b; 797 call reset_edit_info; 798 799 fast_related_data_$in_fast_or_dfast = "1"b; /* switches for BASIC */ 800 fast_related_data_$in_dfast = "1"b; 801 802 803 ready = "1"b; 804 805 return; 806 807 end initial; 808 809 /* */ 810 any_other_handler: proc (mcptr, cond_name, wcptr, info_ptr, cont); 811 812 dcl mcptr ptr, 813 cond_name char (*), 814 wcptr ptr, 815 info_ptr ptr, 816 cont bit (1) aligned; 817 dcl area area (300); 818 dcl (i, l) fixed bin; 819 dcl NEW_LINE char (1) init (" 820 "); 821 dcl message_len fixed bin (21); 822 dcl message char (message_len) based (message_ptr); 823 dcl message_ptr ptr; 824 825 dcl condition_interpreter_ entry (ptr, ptr, fixed bin (21), fixed bin, ptr, char (*), ptr, ptr); 826 827 if cond_name = "command_error" | 828 cond_name = "command_question" | cond_name = "string_size" then return; 829 830 call condition_interpreter_ (addr (area), message_ptr, message_len, 1, mcptr, cond_name, wcptr, info_ptr); 831 if cond_name = "command_abort_" then goto READY; 832 if message_len > 0 then do; 833 834 /* * This code modifies the error message to remove the shriek name and the phrase "(in process dir)" 835* * 836* * Error: ... condition by !BBBJFbDjnMccfW.temp.0310$main_|50 (line 20) (in process dir) 837* * 838* * Error: ... condition by main_|50 (line 20) 839**/ 840 if substr (message, 2, 6) = "Error:" then do; 841 l = index (substr (message, 2), NEW_LINE); 842 if l > 0 then do; 843 i = index (substr (message, 2, l), "by !"); 844 if i > 0 then do; 845 i = i + 4; 846 if substr (message, i+15, 5) = ".temp" & substr (message, i + 25, 1) = "$" then do; 847 substr (message, i) = substr (message, i+26, message_len - i -26+1); 848 message_len = message_len - 26; 849 i = index (substr (message, 1, l+1), "(in process dir)"); 850 if i > 0 then do; 851 substr (message, i) = substr (message, i+16); 852 message_len = message_len - 16; 853 end; 854 end; 855 end; 856 end; 857 end; 858 859 call iox_$put_chars (iox_$user_output, message_ptr, message_len, code); 860 end; 861 862 if cond_name = "finish" then return; 863 864 goto READY; 865 866 end any_other_handler; 867 868 end dfast_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1552.0 dfast_.pl1 >spec>on>comp-dir>dfast_.pl1 95 1 03/27/82 0439.4 dfast_edit_info.incl.pl1 >ldd>include>dfast_edit_info.incl.pl1 96 2 03/27/82 0439.4 dfast_error_codes.incl.pl1 >ldd>include>dfast_error_codes.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. ALTER 000137 constant fixed bin(17,0) initial dcl 32 set ref 150* APPEND 000210 constant fixed bin(17,0) initial dcl 29 set ref 430* BUILD 000211 constant fixed bin(17,0) initial dcl 31 set ref 143* DELETE 000212 constant fixed bin(17,0) initial dcl 27 set ref 375* 580 LENGTH 000067 constant fixed bin(17,0) initial dcl 33 set ref 494* NEW_LINE 000556 automatic char(1) initial unaligned dcl 819 set ref 819* 841 READ 000210 constant fixed bin(17,0) initial dcl 24 set ref 396* REPLACE 000213 constant fixed bin(17,0) initial dcl 26 set ref 389* SAVE 000215 constant fixed bin(17,0) initial dcl 25 set ref 382* SORT 000215 constant fixed bin(17,0) initial dcl 30 set ref 344* TRUNCATE 000137 constant fixed bin(17,0) initial dcl 28 set ref 445* action parameter fixed bin(17,0) dcl 568 set ref 565 579* 580 addr builtin function dcl 50 ref 103 103 131 131 609 609 610 610 787 790 830 830 alter_length 117 000422 automatic fixed bin(21,0) level 3 dcl 94 set ref 423 436* 708* 766 amt_read 001100 automatic fixed bin(17,0) dcl 602 set ref 610* 611* 611 612 613 615 616 area 000100 automatic area(300) dcl 817 set ref 817* 830 830 arg 000201 automatic varying char(256) dcl 48 set ref 214 238* 244* 245 249 250 253 270* 271* 271 272 273 279 288* 297 297 311 311 312 312 404* 406* 409* 469 501* 501* 542* 542* 545 550* 638 665* 666 736* 737 739* 740* 745* 755 767* 769 769 770 770 771* arg_delimit 000066 constant char(4) initial unaligned dcl 34 ref 191 arg_home_dir parameter char unaligned dcl 10 ref 6 788 argument parameter varying char(256) dcl 178 set ref 176 195* argument_length 000735 automatic fixed bin(17,0) dcl 182 set ref 191* 193 193* 194* 194 195 196 basic_system 0(04) 000422 automatic bit(1) level 3 packed unaligned dcl 94 set ref 320 359* 401* 640* 644* 652* 658 659 660 795* brief_mode 000422 automatic bit(1) level 3 packed unaligned dcl 94 set ref 154 308 331* 338* 796* build_mode 0(01) 000422 automatic bit(1) level 3 packed unaligned dcl 94 set ref 137 139* 424* 796* character_set 000043 constant char(68) initial unaligned dcl 37 ref 150 150 156 156 249 249 271 271 271 271 clock_ 000010 constant entry external dcl 62 ref 126 126 code parameter fixed bin(35,0) dcl 635 in procedure "set_system" set ref 633 642* 643 651* 652 654* 661* 664 665 666* code 000411 automatic fixed bin(35,0) dcl 55 in procedure "dfast_" set ref 100 103* 131* 133 134 143* 150* 156* 211* 212 574* 576 576* 577 579* 609* 610* 688* 689 693* 740* 745* 750 750* 755* 786* 790* 791 791* 859* code parameter fixed bin(35,0) dcl 268 in procedure "command" set ref 265 279* 288* 291 291* 301* 344* 352* 356 362* 363* 366 366* 399 401* 402 403* 404* 407* 408 410* 423* 424 430* 477* 494* 505* 511* 526* 545* 550* 553 553* code parameter fixed bin(35,0) dcl 236 in procedure "get_name" set ref 231 245* 248 249* 253 253 253* command_delimitor 001122 automatic char(1) unaligned dcl 681 set ref 684* 691 command_names 000070 constant char(148) initial unaligned dcl 19 ref 273 cond_name parameter char unaligned dcl 812 set ref 810 827 827 827 830* 831 862 condition_ 000012 constant entry external dcl 63 ref 107 condition_interpreter_ 000102 constant entry external dcl 825 ref 830 cont parameter bit(1) dcl 812 ref 810 current_length 116 000422 automatic fixed bin(21,0) level 3 dcl 94 set ref 707* current_name 15 000422 automatic varying char(256) level 3 dcl 94 set ref 325* 358* 359* 401* 571 578 640* 665 794* current_ptr 120 000422 automatic pointer level 3 dcl 94 set ref 789* 790 cv_dec_check_ 000014 constant entry external dcl 64 ref 211 date_time_ 000016 constant entry external dcl 65 ref 126 dbasic 0(06) 000422 automatic bit(1) level 3 packed unaligned dcl 94 set ref 320 645* 646* 652* 658 659 dfast_command_processor_ 000022 constant entry external dcl 67 ref 279 dfast_compile_ 000024 constant entry external dcl 68 ref 291 dfast_directory_ 000026 constant entry external dcl 69 ref 579 dfast_edit_ 000030 constant entry external dcl 70 ref 143 150 344 430 494 dfast_edit_info based structure level 1 dcl 1-4 dfast_error_ 000032 constant entry external dcl 71 ref 134 214 253 363 419 576 666 755 791 dfast_explain_ 000034 constant entry external dcl 72 ref 477 511 dfast_line_edit_ 000036 constant entry external dcl 73 ref 301 dfast_list_ 000040 constant entry external dcl 74 ref 750 dfast_merge_ 000042 constant entry external dcl 75 ref 423 dfast_name 000064 constant char(5) initial unaligned dcl 35 set ref 253* 576* 790* 791* dfast_run_ 000050 constant entry external dcl 78 ref 553 dfast_set_system_ 000052 constant entry external dcl 79 ref 359 401 640 dfast_terminal_control_ 000054 constant entry external dcl 80 ref 526 545 digit defined char(10) unaligned dcl 38 ref 150 divide builtin function dcl 50 ref 275 edit_done 0(03) 000422 automatic bit(1) level 3 packed unaligned dcl 94 set ref 580* 709* 766 edit_info_ptr 000420 automatic pointer dcl 93 set ref 143* 150* 279* 291* 301* 344* 423* 430* 494* 526* 545* 553* 579* 750* 787* error_bad_line 000155 constant fixed bin(35,0) initial dcl 2-28 set ref 214* error_bad_name constant fixed bin(35,0) initial dcl 2-11 ref 249 362 error_long_rec 000137 constant fixed bin(35,0) initial dcl 2-8 set ref 134* error_name_miss constant fixed bin(35,0) initial dcl 2-14 ref 245 253 366 576 error_name_sys constant fixed bin(35,0) initial dcl 2-40 ref 642 651 665 error_obj_nop 000135 constant fixed bin(35,0) initial dcl 2-18 set ref 419* 661 error_table_$long_record 000020 external static fixed bin(35,0) dcl 66 ref 134 error_unkn_sys constant fixed bin(35,0) initial dcl 2-21 ref 654 error_unknown_arg constant fixed bin(35,0) initial dcl 2-9 ref 740 745 f 000422 automatic structure level 1 dcl 94 set ref 787 fast_related_data_$in_dfast 000046 external static bit(1) dcl 77 set ref 800* fast_related_data_$in_fast_or_dfast 000044 external static bit(1) dcl 76 set ref 799* flags 000422 automatic structure level 2 dcl 94 get_temp_segments_ 000056 constant entry external dcl 81 ref 790 header parameter bit(1) unaligned dcl 731 in procedure "parse_list_punch" set ref 728 750* header 000306 automatic bit(1) unaligned dcl 52 in procedure "dfast_" set ref 308* 311* 312* 313* 315* hmu 000060 constant entry external dcl 82 ref 451 home_dir 124 000422 automatic varying char(168) level 3 dcl 94 set ref 788* i 000554 automatic fixed bin(17,0) dcl 818 in procedure "any_other_handler" set ref 843* 844 845* 845 846 846 847 847 847 849* 850 851 851 i 000303 automatic fixed bin(17,0) dcl 51 in procedure "dfast_" set ref 147* 149 150 150 150 150 150 156 156 156 156 156 158 index builtin function dcl 50 ref 150 156 273 357 615 691 841 843 849 info_ptr parameter pointer dcl 812 set ref 810 830* input 000100 automatic char(256) unaligned dcl 46 set ref 103 103 126* 127 127 131 131 143 143 147 150 150 150 156 156 156 684 691 693 693 input_length 000200 automatic fixed bin(17,0) dcl 47 set ref 131* 138 143 143 147 150 150 156 156 686* 686 689 691 692 ioa_$ioa_switch 000062 constant entry external dcl 83 ref 104 127 325 iox_$control 000066 constant entry external dcl 85 ref 103 iox_$get_line 000064 constant entry external dcl 84 ref 131 610 iox_$put_chars 000070 constant entry external dcl 86 ref 609 859 iox_$user_input 000072 external static pointer dcl 87 set ref 103* 131* 610* iox_$user_output 000074 external static pointer dcl 88 set ref 104* 127* 325* 609* 859* l 000555 automatic fixed bin(17,0) dcl 818 set ref 841* 842 843 849 len 001123 automatic fixed bin(17,0) dcl 682 set ref 691* 692 692* 693 693 695 length builtin function dcl 50 ref 185 272 311 312 609 609 letter defined char(52) unaligned dcl 39 ref 156 line parameter varying char(256) dcl 233 in procedure "get_name" set ref 231 238* line parameter varying char(256) dcl 730 in procedure "parse_list_punch" set ref 728 736* 739* line parameter varying char(256) dcl 267 in procedure "command" set ref 265 270* 279 288* 301* 315* 352* 375* 382* 389* 396* 404* 442 445* 481* 501* 511* 542* 550* line parameter varying char(256) dcl 180 in procedure "get_arg" set ref 176 185 189 191 195 197* 198* 198 line parameter varying char(256) dcl 567 in procedure "segment_control" set ref 565 574* line_length 000734 automatic fixed bin(17,0) dcl 181 set ref 185* 187 193 197 198 logout_arg parameter char unaligned dcl 13 set ref 6 457* 472* lowercase_letters defined char(26) unaligned dcl 41 ref 271 max_seg_size 2 000422 automatic fixed bin(21,0) level 3 dcl 94 set ref 792* mcptr parameter pointer dcl 812 set ref 810 830* message based char unaligned dcl 822 in procedure "any_other_handler" set ref 840 841 843 846 846 847* 847 849 851* 851 message parameter char unaligned dcl 598 in procedure "get_user_response" set ref 595 609 609 609 609 message_len 000557 automatic fixed bin(21,0) dcl 821 set ref 830* 832 840 841 843 846 846 847 847 847 848* 848 849 851 851 852* 852 859* message_ptr 000560 automatic pointer dcl 823 set ref 830* 840 841 843 846 846 847 847 849 851 851 859* name parameter varying char dcl 234 set ref 231 240* 250* name_char defined char(68) unaligned dcl 40 ref 249 null builtin function dcl 50 ref 579 579 789 num parameter fixed bin(17,0) dcl 209 set ref 207 211* 213 num_1 000304 automatic fixed bin(17,0) dcl 51 set ref 734* 740* 745* 750* num_chars 001102 automatic fixed bin(17,0) dcl 604 set ref 615* 616 616* 617 person_id parameter char unaligned dcl 14 set ref 6 325* project_id parameter char unaligned dcl 11 set ref 6 325* ptr_array based pointer array dcl 784 set ref 790* punch parameter bit(1) unaligned dcl 732 set ref 728 750* 753 quit 000412 stack reference condition dcl 57 ref 101 ready 000302 automatic bit(1) unaligned dcl 49 set ref 102* 125 129* 140* 154* 333* 535* 803* repeat parameter bit(1) unaligned dcl 597 ref 595 622 request 000770 automatic bit(1) unaligned dcl 569 in procedure "segment_control" set ref 571* 572* 574* request parameter bit(1) unaligned dcl 235 in procedure "get_name" ref 231 239 request 000305 automatic fixed bin(17,0) dcl 51 in procedure "dfast_" set ref 273* 274 275* 275 276 367 526 535 545 resource_usage 000076 constant entry external dcl 89 ref 488 response parameter varying char dcl 599 set ref 595 606* 617* search builtin function dcl 50 ref 191 sort 000307 automatic bit(1) unaligned dcl 53 set ref 297* 299* 301* source_segment 0(02) 000422 automatic bit(1) level 3 packed unaligned dcl 94 set ref 400 419 639 710* start 001101 automatic fixed bin(17,0) dcl 603 in procedure "get_user_response" set ref 613* 614 615 616 617 start parameter fixed bin(17,0) dcl 680 in procedure "multi_command" set ref 678 684 685* 685 689 691 691 692 693 693 695* 695 start 000736 automatic fixed bin(17,0) dcl 183 in procedure "get_arg" set ref 189* 190 191 193 195 196* 196 197 198 198 string 000310 automatic varying char(256) dcl 54 in procedure "dfast_" set ref 320* 323* 324* 325* 352* 357 358 363 574* 578 578* 579 638* 641 641 645 650 658 659 660 735* 737* 738 738 744* 750 753* 754* 755 string parameter varying char dcl 208 in procedure "line_number" ref 207 211 substr builtin function dcl 50 set ref 127 127 143 143 147 150 150 150 156 156 156 191 195 198 273 311 312 613 615 617 638 684 691 693 693 737 840 841 843 846 846 847* 847 849 851* 851 sys_info$max_seg_size 000100 external static fixed bin(35,0) dcl 91 ref 792 system_info 2 000422 automatic structure level 2 dcl 94 tag 001112 automatic char(7) unaligned dcl 636 set ref 640* 642 651 temp_buffer 001000 automatic char(256) unaligned dcl 601 set ref 610 610 613 615 617 translate builtin function dcl 50 ref 271 tty_line_id parameter char unaligned dcl 12 set ref 6 325* uppercase_letters defined char(26) unaligned dcl 42 ref 271 verify builtin function dcl 50 ref 147 189 249 442 613 wcptr parameter pointer dcl 812 set ref 810 830* white_space constant char(2) initial unaligned dcl 36 ref 147 189 442 613 615 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_access_mode internal static fixed bin(35,0) initial dcl 2-33 error_alt_empty internal static fixed bin(35,0) initial dcl 2-3 error_bad_pathname internal static fixed bin(35,0) initial dcl 2-32 error_bad_rec_len internal static fixed bin(35,0) initial dcl 2-36 error_bad_req internal static fixed bin(35,0) initial dcl 2-12 error_bad_sort internal static fixed bin(35,0) initial dcl 2-24 error_bad_type internal static fixed bin(35,0) initial dcl 2-20 error_block_spec internal static fixed bin(35,0) initial dcl 2-17 error_cur_empty internal static fixed bin(35,0) initial dcl 2-5 error_delimiter_miss internal static fixed bin(35,0) initial dcl 2-34 error_dprint_map internal static fixed bin(35,0) initial dcl 2-41 error_edit_max_num internal static fixed bin(35,0) initial dcl 2-43 error_line_miss internal static fixed bin(35,0) initial dcl 2-26 error_line_order internal static fixed bin(35,0) initial dcl 2-30 error_max_args internal static fixed bin(35,0) initial dcl 2-39 error_max_line_number internal static fixed bin(35,0) initial dcl 2-38 error_max_lines internal static fixed bin(35,0) initial dcl 2-31 error_max_num internal static fixed bin(35,0) initial dcl 2-42 error_max_size internal static fixed bin(35,0) initial dcl 2-4 error_name_dup internal static fixed bin(35,0) initial dcl 2-7 error_no_comp internal static fixed bin(35,0) initial dcl 2-15 error_no_expl internal static fixed bin(35,0) initial dcl 2-10 error_no_main internal static fixed bin(35,0) initial dcl 2-16 error_no_new_line internal static fixed bin(35,0) initial dcl 2-45 error_no_nl internal static fixed bin(35,0) initial dcl 2-23 error_no_num internal static fixed bin(35,0) initial dcl 2-25 error_no_string internal static fixed bin(35,0) initial dcl 2-29 error_no_suffix internal static fixed bin(35,0) initial dcl 2-22 error_not_saved internal static fixed bin(35,0) initial dcl 2-6 error_request_miss internal static fixed bin(35,0) initial dcl 2-27 error_sav_cur internal static fixed bin(35,0) initial dcl 2-19 error_size_fixed_record internal static fixed bin(35,0) initial dcl 2-35 error_string_size internal static fixed bin(35,0) initial dcl 2-37 error_syntax_string internal static fixed bin(35,0) initial dcl 2-13 error_un_num_text internal static fixed bin(35,0) initial dcl 2-44 NAMES DECLARED BY EXPLICIT CONTEXT. READY 000607 constant label dcl 123 ref 105 831 864 RETURN 001142 constant label dcl 165 set ref 769 774 any_other_handler 004645 constant entry internal dcl 810 ref 107 107 bye_request 004446 constant entry internal dcl 763 ref 461 473 command 001554 constant entry internal dcl 265 ref 156 693 command_label 000000 constant label array(35) dcl 288 ref 276 dfast_ 000427 constant entry external dcl 6 get_arg 001143 constant entry internal dcl 176 ref 238 270 288 404 501 542 550 736 739 get_name 001406 constant entry internal dcl 231 ref 352 574 get_user_response 003474 constant entry internal dcl 595 ref 244 406 409 501 767 771 initial 004526 constant entry internal dcl 782 ref 99 line_number 001262 constant entry internal dcl 207 ref 740 745 multi_command 004117 constant entry internal dcl 678 ref 158 parse_list_punch 004211 constant entry internal dcl 728 ref 315 481 reset_edit_info 004201 constant entry internal dcl 705 ref 367 442 797 segment_control 003321 constant entry internal dcl 565 ref 375 382 389 396 445 set_system 003644 constant entry internal dcl 633 ref 288 404 407 410 505 550 NAME DECLARED BY CONTEXT OR IMPLICATION. empty builtin function ref 817 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6346 6452 5753 6356 Length 6754 5753 104 265 373 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfast_ 1112 external procedure is an external procedure. on unit on line 101 88 on unit get_arg internal procedure shares stack frame of external procedure dfast_. line_number internal procedure shares stack frame of external procedure dfast_. get_name internal procedure shares stack frame of external procedure dfast_. command internal procedure shares stack frame of external procedure dfast_. segment_control internal procedure shares stack frame of external procedure dfast_. get_user_response internal procedure shares stack frame of external procedure dfast_. set_system internal procedure shares stack frame of external procedure dfast_. multi_command internal procedure shares stack frame of external procedure dfast_. reset_edit_info internal procedure shares stack frame of external procedure dfast_. parse_list_punch internal procedure shares stack frame of external procedure dfast_. bye_request internal procedure shares stack frame of external procedure dfast_. initial internal procedure shares stack frame of external procedure dfast_. any_other_handler 409 internal procedure is assigned to an entry variable. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME any_other_handler 000100 area any_other_handler 000554 i any_other_handler 000555 l any_other_handler 000556 NEW_LINE any_other_handler 000557 message_len any_other_handler 000560 message_ptr any_other_handler dfast_ 000100 input dfast_ 000200 input_length dfast_ 000201 arg dfast_ 000302 ready dfast_ 000303 i dfast_ 000304 num_1 dfast_ 000305 request dfast_ 000306 header dfast_ 000307 sort dfast_ 000310 string dfast_ 000411 code dfast_ 000420 edit_info_ptr dfast_ 000422 f dfast_ 000734 line_length get_arg 000735 argument_length get_arg 000736 start get_arg 000770 request segment_control 001000 temp_buffer get_user_response 001100 amt_read get_user_response 001101 start get_user_response 001102 num_chars get_user_response 001112 tag set_system 001122 command_delimitor multi_command 001123 len multi_command THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return tra_ext signal enable shorten_stack ext_entry_desc int_entry int_entry_desc set_cs_eis index_cs_eis verify_eis translate_3 empty THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. clock_ condition_ condition_interpreter_ cv_dec_check_ date_time_ dfast_command_processor_ dfast_compile_ dfast_directory_ dfast_edit_ dfast_error_ dfast_explain_ dfast_line_edit_ dfast_list_ dfast_merge_ dfast_run_ dfast_set_system_ dfast_terminal_control_ get_temp_segments_ hmu ioa_$ioa_switch iox_$control iox_$get_line iox_$put_chars resource_usage THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$long_record fast_related_data_$in_dfast fast_related_data_$in_fast_or_dfast iox_$user_input iox_$user_output sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000422 99 000466 100 000467 101 000471 102 000505 103 000510 104 000541 105 000560 107 000563 125 000607 126 000611 127 000635 129 000666 131 000667 133 000712 134 000714 135 000736 137 000737 138 000742 139 000745 140 000747 141 000751 143 000752 144 001005 147 001007 149 001023 150 001024 153 001101 154 001102 156 001107 158 001135 163 001141 165 001142 176 001143 185 001145 187 001150 189 001151 190 001164 191 001165 193 001204 194 001212 195 001214 196 001225 197 001231 198 001235 200 001250 203 001255 207 001262 211 001273 212 001326 213 001331 214 001341 215 001372 216 001374 217 001402 231 001406 238 001417 239 001435 240 001443 241 001445 244 001446 245 001460 248 001470 249 001473 250 001504 253 001515 255 001552 265 001554 270 001556 271 001573 272 001616 273 001622 274 001631 275 001632 276 001635 279 001636 280 001705 282 001706 288 001707 291 001734 292 001750 297 001751 299 001765 301 001767 302 002005 308 002006 311 002013 312 002023 313 002032 315 002034 317 002051 320 002052 323 002066 324 002074 325 002101 328 002146 331 002147 333 002151 335 002152 338 002153 341 002155 344 002156 347 002204 352 002205 356 002233 357 002236 358 002250 359 002255 360 002305 362 002306 363 002310 364 002343 365 002344 366 002345 367 002350 369 002354 375 002355 378 002366 382 002367 385 002400 389 002401 392 002412 396 002413 399 002424 400 002427 401 002432 402 002461 403 002464 404 002465 406 002512 407 002522 408 002531 409 002534 410 002544 411 002553 416 002554 419 002555 423 002604 424 002624 427 002631 430 002632 433 002660 436 002661 439 002662 442 002663 445 002702 447 002712 451 002713 454 002720 457 002721 461 002727 462 002730 469 002731 472 002736 473 002744 474 002745 477 002746 478 002773 481 002774 484 003013 488 003014 491 003021 494 003022 497 003050 501 003051 505 003102 507 003111 511 003112 514 003136 526 003137 535 003167 536 003174 542 003175 545 003214 546 003255 550 003257 553 003304 554 003320 565 003321 571 003323 572 003333 574 003335 576 003360 577 003405 578 003407 579 003421 580 003464 583 003473 595 003474 606 003512 609 003515 610 003537 611 003562 612 003564 613 003566 614 003600 615 003601 616 003612 617 003620 618 003632 622 003633 623 003642 625 003643 633 003644 638 003646 639 003653 640 003656 641 003706 642 003720 643 003727 644 003732 645 003734 646 003744 648 003746 650 003747 651 003754 652 003767 653 003776 654 003777 655 004002 658 004003 659 004024 660 004036 661 004046 664 004050 665 004053 666 004062 667 004115 669 004116 678 004117 684 004121 685 004126 686 004127 688 004131 689 004132 691 004140 692 004155 693 004162 695 004174 696 004177 698 004200 705 004201 707 004202 708 004203 709 004204 710 004206 712 004210 728 004211 734 004213 735 004215 736 004216 737 004233 738 004240 739 004252 740 004270 742 004300 744 004301 745 004302 750 004312 752 004362 753 004363 754 004377 755 004403 756 004444 758 004445 763 004446 766 004447 767 004454 769 004464 770 004476 771 004511 772 004524 774 004525 782 004526 786 004527 787 004530 788 004532 789 004544 790 004546 791 004567 792 004620 794 004623 795 004627 796 004631 797 004635 799 004636 800 004641 803 004642 805 004643 810 004644 817 004660 819 004663 827 004665 830 004704 831 004752 832 004764 840 004766 841 004773 842 005005 843 005006 844 005016 845 005017 846 005021 847 005032 848 005057 849 005061 850 005071 851 005072 852 005122 859 005124 862 005142 864 005151 ----------------------------------------------------------- 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