COMPILATION LISTING OF SEGMENT basic_system Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1058.95_Tue_mdt 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 basic_system: bsys: bs: procedure; 12 13 14 /* A line numbered editor for use with the BASIC language, with facilities for 15* listing, deleting, and running programs. J.M. Broughton -- April 1973 */ 16 17 18 declare 19 20 hcs_$make_seg entry (aligned char(*), aligned char(*), aligned char(*), 21 fixed bin(5), ptr, fixed bin(35)), 22 hcs_$initiate_count entry (aligned char(*), aligned char(*), aligned char(*), 23 fixed bin(24), fixed bin(12), ptr, fixed bin(35)), 24 hcs_$set_bc_seg entry (ptr, fixed bin(24), fixed bin(35)), /* sets bit count given pointer to segment */ 25 hcs_$truncate_seg entry (ptr, fixed bin, fixed bin(35)), /* truncates segment given pointer */ 26 hcs_$terminate_noname entry (pointer, fixed bin(35)), /* terminates a segment */ 27 hcs_$delentry_seg entry ( pointer, fixed bin(35)), /* deletes a segment */ 28 ioa_ entry options (variable), /* output formating routine */ 29 ioa_$rsnnl entry options (variable), /* writes into a string */ 30 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin(35)), /* fetches arguments */ 31 cu_$cp entry (ptr, fixed bin, fixed bin(35)), /* calls the command processor */ 32 cu_$cl entry, /* forces return to command level */ 33 cu_$ptr_call entry(ptr), /* calls routine specified by ptr */ 34 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin(35)), /* expands pathname */ 35 com_err_ entry options (variable), /* error printing routine */ 36 timer_manager_$cpu_call entry(fixed bin(71),bit(2),entry), /* sets up cpu timer */ 37 timer_manager_$reset_cpu_call entry(entry); /* resets cpu timer */ 38 39 declare 40 41 sys_info$max_seg_size ext fixed (35), 42 iox_$user_input ext ptr, 43 iox_$user_output ext ptr; 44 45 declare 46 47 basic_ entry(ptr, fixed bin, ptr, ptr, ptr, fixed bin), 48 basic_resequence_ entry (fixed bin, fixed bin, ptr, ptr, /* routine to sequence a program from n by m */ 49 fixed bin, fixed bin, fixed bin(35)); 50 51 declare 52 53 id char(12) aligned static init("basic_system"), /* name of entry to this routine */ 54 language char(6) aligned static init(".basic"); /* suffix for program names */ 55 56 declare 57 58 old_linum char(10) aligned; /* keeps previous line num for get */ 59 60 declare 61 62 1 segment based aligned, /* temporary segment, allocated as follows: */ 63 2 program (0:21503) fixed bin(35), /* program as edited, for save or compilation */ 64 2 text (0:44031) fixed bin(35), /* area to place source while editing */ 65 66 1 table (0:99999) based aligned, /* table of line information */ 67 2 indx fixed bin(17) unal, /* offset of line from start of "txt" */ 68 2 chcount fixed bin(17) unal, /* number of characters in line */ 69 70 long_string char(262144) aligned based, /* string overlayed on lines */ 71 72 ch(0:262143) char(1) unaligned based, /* string overlay */ 73 74 copy_overlay (count) fixed bin(35) based, /* overlay for saving segment */ 75 count fixed bin(17); /* word count of segment to be saved */ 76 77 declare 78 79 name char(lname) based (np), /* the name of the program to be edited (arg) */ 80 lname fixed bin, /* length of argument */ 81 np pointer, /* pointer to argument, returned by cu_ */ 82 dirname char(168) aligned, /* directory part of segment pathname */ 83 ename char(32) aligned, /* entry portion of pathname */ 84 source char(168) aligned, /* relative pathname of program with ".basic" suffix */ 85 prog char(32) aligned, /* entry name stripped of suffix */ 86 cs char(168) based aligned; /* based input string, overlayed on "txt" */ 87 88 declare 89 90 sptr pointer, /* pointer to source */ 91 tptr pointer, /* pointer to base of temporary segment */ 92 txt pointer, /* points to part containing lines */ 93 tbl pointer, /* points to table of line information */ 94 inp pointer, /* pointer to input string */ 95 obj pointer, /* pointer to object segment created by basic */ 96 main pointer; /* pointer to entry point of basic program */ 97 98 declare 99 100 (perm_tptr, /* permanent pointers */ 101 perm_tbl, 102 perm_obj) ptr static init(null); 103 104 declare 105 106 error_table_$noentry fixed bin(35) external, /* system error code for none existant file */ 107 status bit(72) aligned, /* i/o status code */ 108 code fixed bin(35), /* error code */ 109 110 program_interrupt condition, /* we must have a handler for this condition */ 111 cleanup condition, /* must have a procedure called on non-local return */ 112 113 level fixed bin static init(0), /* recursion level */ 114 115 (i, j) fixed bin, /* omnipresent temporaries */ 116 k fixed bin(21), 117 nl char(1) static aligned initial (" 118 "), tab char(1) static aligned initial(" "), /* newline and tab characters */ 119 chr char(1) aligned, /* temporary used various places */ 120 s char(1), /* used for plural(s) */ 121 time_limit fixed bin(71) initial (0), /* limit on execution time, 0 -> none */ 122 (js, jt) fixed bin initial(0), /* offsets from sptr, and txt */ 123 numl fixed bin, /* length of line number */ 124 csize fixed bin(24), /* size of source in characters */ 125 (first, last) fixed bin, /* first and last line no. for list, delete */ 126 increment fixed bin defined (last), /* increment for resequence command */ 127 linum fixed bin, /* line number */ 128 err_count fixed bin, /* number of errors in basic program */ 129 lmax fixed bin initial(1), /* highest line number */ 130 (newline, compiling initial ("0"b), save_sw, known, /* various flags -- guess */ 131 resequencing initial ("0"b), reading initial ("0"b)) bit(1) aligned, 132 (null, addr, fixed, divide, index, substr, mod, max, /* helpful functions */ 133 min, unspec, verify, search, string, convert) builtin; 134 135 declare 136 137 input_iocb ptr int static, /* iox_ ptr for user_input */ 138 output_iocb ptr int static, /* iox_ ptr for user_output */ 139 buffer char(159); 140 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 1 3* version number to IOX2. */ 1 4 /* format: style2 */ 1 5 1 6 dcl 1 iocb aligned based, /* I/O control block. */ 1 7 2 version character (4) aligned, /* IOX2 */ 1 8 2 name char (32), /* I/O name of this block. */ 1 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 14 2 reserved bit (72), /* Reserved for future use. */ 1 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 17 /* open(p,mode,not_used,s) */ 1 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_line(p,bufptr,buflen,actlen,s) */ 1 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 24 /* put_chars(p,bufptr,buflen,s) */ 1 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 26 /* modes(p,newmode,oldmode,s) */ 1 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 28 /* position(p,u1,u2,s) */ 1 29 2 control entry (ptr, char (*), ptr, fixed (35)), 1 30 /* control(p,order,infptr,s) */ 1 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 32 /* read_record(p,bufptr,buflen,actlen,s) */ 1 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* write_record(p,bufptr,buflen,s) */ 1 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 36 /* rewrite_record(p,bufptr,buflen,s) */ 1 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* seek_key(p,key,len,s) */ 1 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 41 /* read_key(p,key,len,s) */ 1 42 2 read_length entry (ptr, fixed (21), fixed (35)), 1 43 /* read_length(p,len,s) */ 1 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 1 45 /* open_file(p,mode,desc,not_used,s) */ 1 46 2 close_file entry (ptr, char (*), fixed bin (35)), 1 47 /* close_file(p,desc,s) */ 1 48 2 detach entry (ptr, char (*), fixed bin (35)); 1 49 /* detach(p,desc,s) */ 1 50 1 51 declare iox_$iocb_version_sentinel 1 52 character (4) aligned external static; 1 53 1 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 141 142 143 /***************************************** Internal Subroutines ***********************************************/ 144 145 146 147 get_line_number: procedure (place) returns (fixed bin); 148 149 declare 150 151 place, d fixed bin(17), 152 error bit(1) initial ("1"b), /* indicates if there are leading chars */ 153 line fixed bin; /* line number */ 154 155 line = 0; /* initialize line number */ 156 157 do numl = 0 by 1; /* scan line */ 158 chr = txt->ch(place+numl); /* get current line */ 159 d = index("0123456789", chr) - 1; /* compute the digit */ 160 if d < 0 /* test if really a digit */ 161 then do; 162 if error /* has a digit been found yet */ 163 then do; /* number hasn't been started */ 164 if (chr^=" ") & (chr^=tab) /* flush leading white space */ 165 then return (-1); /* indicate that something is wrong */ 166 end; 167 else do; /* end of the line number */ 168 newline = (chr = nl); /* set newline indicator */ 169 return (line); /* finished */ 170 end; 171 end; 172 else do; 173 line = (line*10)+d; /* compute line number */ 174 error = "0"b; /* a digit has been found */ 175 end; 176 end; /* of do group */ 177 178 end get_line_number; 179 180 181 182 get_lines: procedure (place); /* sets "first" and "last" for list, delete */ 183 184 declare place fixed bin; /* points to location in text */ 185 186 first = get_line_number (place); /* get first line number */ 187 if first < 0 then go to mistake; 188 if newline 189 then do; /* set defaults */ 190 if resequencing /* for rseq or list, delete */ 191 then last = 10; /* increment defined(last) */ 192 else last = first; 193 end; 194 else do; /* get the other one */ 195 last = get_line_number (place+numl); /* set "last" from next position */ 196 if last < 0 | ^newline then go to mistake; /* format error */ 197 if resequencing then return; /* don't set increment to ... */ 198 last = min(lmax, last); /* so we don't have to do so much work */ 199 end; 200 return; 201 202 mistake: 203 call error ("Bad line number specification.", "", "0"b); 204 205 end get_lines; /* finished */ 206 207 208 209 error: procedure (message, info, fatal); /* generalized error routine */ 210 211 declare 212 213 message char(*) aligned, /* error message -- "" -> code */ 214 info char(*) aligned, /* additional info on error */ 215 fatal bit(1) aligned; /* does this error terminate execution */ 216 217 resequencing, compiling = "0"b; /* just to make sure */ 218 219 if message = "" 220 then call com_err_ (code, id, info); /* use standard error code */ 221 else call ioa_ ("^a ^a", message, info); /* use ioa_ to tell user about error */ 222 223 if fatal 224 then call cu_$cl; /* get back to command level */ 225 else if reading /* are we gettting the source */ 226 then go to move; /* yes, continue */ 227 else do; /* no, reset and go on to next command */ 228 call input_iocb -> iocb.control (input_iocb, "resetread", null(), code); 229 call ioa_ ("RESET"); 230 go to next; 231 end; 232 233 end error; 234 235 236 237 get_seg: proc(name,type,pt); 238 239 declare 240 241 name char(*) aligned, /* name of temporary */ 242 type fixed bin(5), /* access type */ 243 pt ptr; /* set to point at segment */ 244 245 call hcs_$make_seg("", name, "", type, pt, code); /* make the segment */ 246 if pt = null then call error("", name, "1"b); /* complain if error */ 247 248 end get_seg; 249 250 251 252 clean_up: proc; 253 254 if compiling & (time_limit ^= 0) then call timer_manager_$reset_cpu_call(cpu_limit); 255 256 if level = 1 257 then do; 258 259 /* truncate segs to zero length and leave initiated */ 260 261 call hcs_$truncate_seg(tptr, 0, code); 262 call hcs_$truncate_seg(tbl, 0, code); 263 call hcs_$truncate_seg(obj, 0, code); 264 end; 265 else do; 266 267 /* delete segs */ 268 269 270 call hcs_$delentry_seg(tptr, code); 271 call hcs_$delentry_seg(tbl, code); 272 call hcs_$delentry_seg(obj, code); 273 end; 274 275 level = level - 1; 276 277 end clean_up; 278 279 280 281 cpu_limit: proc; 282 283 compiling = "1"b; 284 call ioa_("Time limit exceeded."); 285 goto edit; 286 end; 287 288 /**************************************** Execution Begins Here ***********************************************/ 289 290 291 292 start: /* Begin Setup */ 293 294 on program_interrupt begin; /* return here after quits */ 295 if resequencing then do; /* we were resequencing */ 296 call ioa_ ("Resequencing aborted."); /* tell the user */ 297 resequencing = "0"b; /* reset indicator */ 298 end; 299 else if compiling then do; /* were we compiling the program */ 300 call ioa_ ("Execution aborted."); /* ditto */ 301 compiling = "0"b; 302 if time_limit ^= 0 then call timer_manager_$reset_cpu_call(cpu_limit); 303 end; 304 go to edit; 305 end; 306 307 308 level = level + 1; /* bump recursion level */ 309 310 if level = 1 311 then do; 312 313 input_iocb = iox_$user_input; 314 output_iocb = iox_$user_output; 315 if perm_tptr = null 316 then do; 317 318 /* first time at level 1, create permanent scratch segments */ 319 320 call get_seg("basic_system_text_",01011b,perm_tptr); 321 call get_seg("basic_system_table_",01011b,perm_tbl); 322 call get_seg("basic_system_object_",01111b,perm_obj); 323 end; 324 325 tptr = perm_tptr; 326 tbl = perm_tbl; 327 obj = perm_obj; 328 end; 329 else do; 330 331 /* create temporary segments for recursion levels > 1 */ 332 333 call get_seg("",01011b,tptr); 334 call get_seg("",01011b,tbl); 335 call get_seg("",01111b,obj); 336 end; 337 338 on cleanup call clean_up; /* cleanup temporaries in case of errors/quits */ 339 txt = addr(tptr->segment.text); /* set pointer to program storage area */ 340 341 /* Get program to be edited */ 342 343 call cu_$arg_ptr (1, np, lname, code); /* fetch the argument */ 344 if lname = 0 | code ^= 0 then do; /* no name was specified */ 345 known = "0"b; /* we must get a name before a save */ 346 call ioa_ ("Input.^/"); /* enter edit mode directly */ 347 go to next; 348 end; 349 known = "1"b; /* we will not need a name */ 350 source = name; /* align argument string */ 351 352 get_source: /* get source segment */ 353 k = index(source," "); 354 if k ^= 0 355 then if substr(source,k+1) ^= "" 356 then do; 357 known = "0"b; 358 call error ("Improper segment name.", source, "0"b); 359 end; 360 if index (source, language) = 0 /* if no suffix then ... */ 361 then do; 362 substr(source, lname+1, 6) = language; /* insert one */ 363 lname = lname + 6; /* adjust name length */ 364 end; 365 call expand_path_ (addr(source), lname, addr(dirname), addr(ename), code); 366 if code ^= 0 then call error ("", source, "0"b); /* expand relative pathnames */ 367 prog = substr(ename, 1, index(ename, language)-1); /* keep stripped name around for compiler */ 368 call ioa_$rsnnl ("^a>^a", source, i, dirname, ename); /* remember full path name in "source" */ 369 call hcs_$initiate_count (dirname, ename, "", csize, 0, sptr, code); 370 if sptr = null then do; /* get pointer to and bit count of segment */ 371 if code ^= error_table_$noentry 372 then call error ("", source, "1"b); 373 else do; 374 call ioa_ ("Program not found.^/Input.^/"); 375 go to next; /* go directly to next */ 376 end; 377 end; 378 csize = divide(csize,9,17,0); /* compute character count */ 379 380 381 /* Move source into temporary segment */ 382 383 384 move: 385 reading = "1"b; /* indicate that we are reading source */ 386 old_linum = "-1"; /* initialize to before firt line */ 387 do while (js < csize); /* scan the entire segment */ 388 k = index (substr(sptr->long_string, js+1), nl); /* find the end of the line */ 389 if k = 0 then k = csize - js; /* file does not have a newline at the end */ 390 substr (txt->long_string, jt+1, k) = /* move line into text area */ 391 substr (sptr->long_string, js+1, k); 392 js = js + k; /* increment pointer in source */ 393 linum = get_line_number (jt); /* get this line's number */ 394 if linum < 0 /* invalid line number encountered? */ 395 then call error ("Bad line number in source. Line deleted after line", old_linum, "0"b); 396 else if linum > 99999 /* is line number too large? */ 397 then call error ("Line number in source too large. Line deleted after line", old_linum, "0"b); 398 lmax = max(lmax, linum); /* highest ? */ 399 old_linum = substr(convert(old_linum, linum), 6); /* save for possible diagnostic */ 400 tbl->table(linum).indx = jt; /* "jt" is the index of the first char. */ 401 tbl->table(linum).chcount = k; /* compute length in characters */ 402 jt = jt + k + 3; 403 jt = jt - mod(jt,4); /* align next line on word boundary */ 404 end; 405 reading = "0"b; /* reset */ 406 407 408 /* Process input lines */ 409 410 edit: 411 call ioa_ ("Edit.^/"); /* enter edit mode */ 412 413 next: 414 inp = addr(txt->ch(jt)); /* get place to put next line */ 415 call input_iocb -> iocb.get_line (input_iocb, inp, 158, k, code); 416 if code ^= 0 then do; 417 call com_err_ (code, "basic_system"); 418 go to next; 419 end; 420 if k <= 1 then go to next; /* blank line */ 421 j = verify(inp->cs," "); /* get index of first non-white character */ 422 if j > 1 then do; /* if not first char, then get significant part */ 423 k = k - j + 1; /* get new length */ 424 substr(inp->cs, 1, k) = substr(inp->cs, j, k); /* move line back into alignment */ 425 end; 426 427 if search(substr(inp->cs, 1, 1), "0123456789") > 0 428 then do; 429 linum = get_line_number (jt); /* find the line number */ 430 if linum < 0 then call error ("Bad line number.", "", "0"b); 431 else if linum > 99999 then call error ("Line number too large.", "", "0"b); 432 if newline 433 then tbl->table(linum).chcount = 0; /* if just a line number, delete the line */ 434 else do; /* else insert the line */ 435 lmax = max(lmax, linum); /* which is the highest */ 436 tbl->table(linum).indx = jt; /* set the index */ 437 tbl->table(linum).chcount = k; /* set the count */ 438 jt = jt + k + 3; 439 jt = jt-mod(jt,4); /* set the next jt */ 440 end; 441 go to next; /* next line */ 442 end; 443 444 if substr(inp->cs, 1, 3) = "run" then /* is this the run command */ 445 if substr(inp->cs, 4, 1) = nl then go to run; /* we not allow anything else */ 446 447 if substr(inp->cs, 1, 4) = "save" then go to save; /* is this the save command? */ 448 449 if substr(inp->cs, 1, 4) = "list" then go to list; /* is this the list command? */ 450 451 if substr(inp->cs, 1, 4) = "quit" then /* is this the quit command? */ 452 if substr(inp->cs, 5, 1) = nl then go to quit; 453 454 if substr(inp->cs, 1, 6) = "delete" then go to delete; /* is this the delete command? */ 455 456 if substr(inp->cs, 1, 4) = "rseq" then go to resequence; /* is this the command to resequence */ 457 458 if substr(inp->cs, 1, 4) = "exec" /* execute a Multics command */ 459 then do; 460 call cu_$cp (addr(inp->ch(4)), k-4, code); /* call the command processor */ 461 go to next; 462 end; 463 464 if substr(inp->cs, 1, 4) = "time" /* specify a run-time limit on the program */ 465 then do; 466 time_limit = get_line_number (jt+4); /* use the line number routine to get the no. */ 467 if time_limit < 0 then call error("Negative time limit given.","","0"b); 468 go to next; 469 end; 470 471 if substr(inp->cs, 1, 3) = "get" /* clear buffers and get new source */ 472 then do; 473 known = "0"b; /* we don't have a name for the file ... yet */ 474 if substr (inp->cs, 4, 1) = nl /* was a name given in the command */ 475 then call ioa_ ("Input.^/"); /* no -- get one later */ 476 else do; 477 j = verify (substr(inp->cs, 4), " ") + 3; /* find start of name */ 478 if j = 0 then call error ("Improper syntax in get command.", "", "0"b); 479 lname = index (substr(inp->cs, j), nl) - 1; /* find out length of name */ 480 source = substr (inp->cs, j , lname); /* get name */ 481 known = "1"b; /* got it */ 482 end; 483 484 call hcs_$truncate_seg (tptr, 0, code); /* zero out temporaries */ 485 if code ^= 0 then call error ("", "Temporary.", "1"b); 486 call hcs_$truncate_seg (tbl, 0, code); 487 if code ^= 0 then call error ("", "Temporary.", "1"b); 488 lmax, js, jt = 0; /* nothing left */ 489 490 if known 491 then go to get_source; /* fetch the segment */ 492 else go to next; /* otherwise enter edit mode directly */ 493 494 end; /* of get command */ 495 496 call ioa_ ("Command not understood."); /* all else has failed */ 497 call input_iocb -> iocb.control (input_iocb, "resetread", null(), code); 498 call ioa_("RESET"); 499 go to next; 500 501 502 /* Routines to list, delete, run, etc. */ 503 504 505 run: 506 save_sw = "0"b; /* run, not save */ 507 508 finish: /* pack lines into base of segment */ 509 j = 1; /* set character pointer */ 510 do k = 0 to lmax; /* look at all possible lines */ 511 if tbl->table(k).chcount ^= 0 then 512 substr (tptr->long_string, j, tbl->table(k).chcount) = /* pack lines into base of segment */ 513 substr (txt->long_string, tbl->table(k).indx+1, tbl->table(k).chcount); 514 j = j + tbl->table(k).chcount; 515 end; 516 j = j - 1; 517 518 if save_sw /* how did we get here */ 519 then do; /* save the program */ 520 call hcs_$make_seg (dirname, ename, "", 01011b, sptr, code); /* create the segment */ 521 if sptr = null then call error ("", source, "0"b); 522 count = divide(j+3,4,17,0); /* get word count */ 523 sptr->copy_overlay = tptr->copy_overlay; /* copy the program */ 524 call hcs_$set_bc_seg (sptr, fixed(j*9,24,0), code); /* set a bit count consistant with its length */ 525 if code ^= 0 then call error ("", source, "0"b); 526 call hcs_$truncate_seg (sptr, count, code); /* truncate it to its new size in words */ 527 if code ^= 0 then call error ("", source, "0"b); 528 go to edit; /* continue */ 529 end; 530 else do; /* compile and run the program */ 531 compiling = "1"b; /* set the compile flag */ 532 call hcs_$truncate_seg(obj,0,code); /* truncate object segment */ 533 if code ^= 0 then call error("","","0"b); 534 535 call basic_(tptr,j,obj,null,main,err_count); /* run the compiler */ 536 537 if err_count = 0 538 then if main = null 539 then call ioa_("No main program."); /* must have main program */ 540 else if time_limit = 0 then call cu_$ptr_call(main); 541 else do; 542 call timer_manager_$cpu_call(time_limit,"11"b,cpu_limit); 543 call cu_$ptr_call(main); 544 call timer_manager_$reset_cpu_call(cpu_limit); 545 end; 546 else do; 547 if err_count = 1 then s = ""; else s = "s"; 548 call ioa_("^d error^a found, no execution.",err_count,s); 549 end; 550 551 compiling = "0"b; /* turn off flag */ 552 go to edit; /* resume editing */ 553 end; 554 555 save: /* we want to save the program */ 556 save_sw = "1"b; /* this is a save, not a run */ 557 if substr(inp->cs, 5, 1) = nl /* test if a name was given */ 558 then if known /* no, check if a name has been given */ 559 then go to finish; /* assume orignal as the default */ 560 else call error ("No name given.", "", "0"b); /* we haven't been given a name */ 561 562 j = verify (substr(inp->cs, 5), " ") + 4; /* ignore leading white space */ 563 if j = 0 then call error ("Improper syntax in save command.", "", "0"b); 564 lname = index (substr(inp->cs, j), nl) - 1; /* get length of name */ 565 source = substr(inp->cs, j, lname); /* remove it from the line */ 566 k = index(source, " "); 567 if k ^= 0 568 then if substr(source,k+1) ^= "" 569 then do; 570 known = "0"b; /* name is no longer valid */ 571 call error ("Improper segment name.", source, "0"b); 572 end; 573 if index(source, language) = 0 /* is there a suffix */ 574 then do; 575 substr(source, lname+1, 6) = language; /* insert one if not */ 576 lname = lname + 6; /* update length */ 577 end; 578 call expand_path_ (addr(source), lname, addr(dirname), addr(ename), code); 579 if code ^= 0 then call error ("", source, "0"b); /* expand the pathname */ 580 prog = substr(ename, 1, index(ename, language)-1); /* remember stripped entry name */ 581 call ioa_$rsnnl ("^a>^a", source, i, dirname, ename); /* and full path name */ 582 known = "1"b; /* we now have a name */ 583 go to finish; 584 585 list: /* list some lines */ 586 if substr(inp->cs, 5, 1) = nl /* no lines given, list all */ 587 then do; 588 first = 0; /* set defaults, first to zero */ 589 last = lmax; /* and last to the maximum line number */ 590 end; 591 else call get_lines (jt + 4); /* find out which lines were given */ 592 593 if first > last then do; /* we can't allow this */ 594 i = last; /* exchange */ 595 last = first; 596 first = i; 597 end; 598 599 if first ^= last 600 then call output_iocb -> put_chars (output_iocb, addr(nl), 1, code); /* a new line for looks */ 601 else if tbl->table.chcount(first) = 0 /* if only one line check if it exists */ 602 then call error ("No line.", "", "0"b); 603 604 do i = first to last; /* search all possible lines */ 605 k = tbl->table(i).chcount; /* get character count */ 606 substr(buffer, 1, k+1) = substr(txt->long_string, tbl->table(i).indx + 1, k) || nl; 607 if k ^= 0 then call output_iocb -> iocb.put_chars (output_iocb, addr(buffer), k, code);/* list only those lines with */ 608 end; /* none zero count */ 609 610 call output_iocb -> iocb.put_chars (output_iocb, addr(nl), 1, code); /* another one */ 611 go to next; 612 613 quit: call clean_up; /* clean up and return */ 614 return; /* goodbye */ 615 616 delete: /* delete some lines */ 617 if substr(inp->cs, 7, 1) = nl /* no lines specified */ 618 then call error ("No line numbers given.", "", "0"b); 619 else do; 620 if substr(inp->cs, 7, 4) = " all" /* delete all lines */ 621 then do; 622 first = 0; /* like list, first set to zero */ 623 last = lmax; /* last to maximum */ 624 end; 625 else call get_lines (jt + 6); /* get line numbers */ 626 end; 627 628 do i = first to last; /* delete these lines */ 629 tbl->table(i).chcount = 0; /* count = 0 indicates null line */ 630 end; 631 632 go to next; 633 634 resequence: /* resequence the line numbers of a program */ 635 resequencing = "1"b; /* turn indicator on in case of a quit */ 636 637 if substr(inp->cs, 5, 1) = nl /* get values for resequencing */ 638 then do; 639 first = 100; /* if none set defaults */ 640 increment = 10; /* start at 100 and go by 10 */ 641 end; 642 else call get_lines (jt + 4); 643 644 call basic_resequence_ (first, increment, tbl, txt, jt, lmax, code); 645 if code ^= 0 then call error ("", "Error occurred while resequencing.", "0"b); 646 resequencing = "0"b; /* finished */ 647 648 go to edit; 649 650 end basic_system; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1058.9 basic_system.pl1 >udd>sm>ds>w>ml>basic_system.pl1 141 1 05/20/83 1946.4 iocb.incl.pl1 >ldd>incl>iocb.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 104 ref 339 365 365 365 365 365 365 413 460 460 578 578 578 578 578 578 599 599 607 607 610 610 basic_ 000072 constant entry external dcl 45 ref 535 basic_resequence_ 000074 constant entry external dcl 45 ref 644 buffer 000337 automatic char(159) packed unaligned dcl 135 set ref 606* 607 607 ch based char(1) array packed unaligned dcl 60 set ref 158 413 460 460 chcount 0(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 60 set ref 401* 432* 437* 511 511 511 514 601 605 629* chr 000313 automatic char(1) dcl 104 set ref 158* 159 164 164 168 cleanup 000302 stack reference condition dcl 104 ref 338 code 000272 automatic fixed bin(35,0) dcl 104 set ref 219* 228* 245* 261* 262* 263* 270* 271* 272* 343* 344 365* 366 369* 371 415* 416 417* 460* 484* 485 486* 487 497* 520* 524* 525 526* 527 532* 533 578* 579 599* 607* 610* 644* 645 com_err_ 000060 constant entry external dcl 18 ref 219 417 compiling 000332 automatic bit(1) initial dcl 104 set ref 104* 217* 254 283* 299 301* 531* 551* control 66 based entry variable level 2 dcl 1-6 ref 228 497 convert builtin function dcl 104 ref 399 copy_overlay based fixed bin(35,0) array dcl 60 set ref 523* 523 count 000103 automatic fixed bin(17,0) dcl 60 set ref 522* 523 526* cs based char(168) dcl 77 set ref 421 424* 424 427 444 444 447 449 451 451 454 456 458 464 471 474 477 479 480 557 562 564 565 585 616 620 637 csize 000323 automatic fixed bin(24,0) dcl 104 set ref 369* 378* 378 387 389 cu_$arg_ptr 000046 constant entry external dcl 18 ref 343 cu_$cl 000052 constant entry external dcl 18 ref 223 cu_$cp 000050 constant entry external dcl 18 ref 460 cu_$ptr_call 000054 constant entry external dcl 18 ref 540 543 d 000420 automatic fixed bin(17,0) dcl 149 set ref 159* 160 173 dirname 000110 automatic char(168) dcl 77 set ref 365 365 368* 369* 520* 578 578 581* divide builtin function dcl 104 ref 378 522 ename 000162 automatic char(32) dcl 77 set ref 365 365 367 367 368* 369* 520* 578 578 580 580 581* err_count 000327 automatic fixed bin(17,0) dcl 104 set ref 535* 537 547 548* error 000421 automatic bit(1) initial packed unaligned dcl 149 set ref 149* 162 174* error_table_$noentry 000076 external static fixed bin(35,0) dcl 104 ref 371 expand_path_ 000056 constant entry external dcl 18 ref 365 578 fatal parameter bit(1) dcl 211 ref 209 223 first 000324 automatic fixed bin(17,0) dcl 104 set ref 186* 187 192 588* 593 595 596* 599 601 604 622* 628 639* 644* fixed builtin function dcl 104 ref 524 524 get_line 42 based entry variable level 2 dcl 1-6 ref 415 hcs_$delentry_seg 000040 constant entry external dcl 18 ref 270 271 272 hcs_$initiate_count 000032 constant entry external dcl 18 ref 369 hcs_$make_seg 000030 constant entry external dcl 18 ref 245 520 hcs_$set_bc_seg 000034 constant entry external dcl 18 ref 524 hcs_$truncate_seg 000036 constant entry external dcl 18 ref 261 262 263 484 486 526 532 i 000310 automatic fixed bin(17,0) dcl 104 set ref 368* 581* 594* 596 604* 605 606* 628* 629* id 000010 internal static char(12) initial dcl 51 set ref 219* increment defined fixed bin(17,0) dcl 104 set ref 640* 644* index builtin function dcl 104 ref 159 352 360 367 388 479 564 566 573 580 indx based fixed bin(17,0) array level 2 packed packed unaligned dcl 60 set ref 400* 436* 511 606 info parameter char dcl 211 set ref 209 219* 221* inp 000264 automatic pointer dcl 88 set ref 413* 415* 421 424 424 427 444 444 447 449 451 451 454 456 458 460 460 464 471 474 477 479 480 557 562 564 565 585 616 620 637 input_iocb 000024 internal static pointer dcl 135 set ref 228 228* 313* 415 415* 497 497* ioa_ 000042 constant entry external dcl 18 ref 221 229 284 296 300 346 374 410 474 496 498 537 548 ioa_$rsnnl 000044 constant entry external dcl 18 ref 368 581 iocb based structure level 1 dcl 1-6 iox_$user_input 000066 external static pointer dcl 39 ref 313 iox_$user_output 000070 external static pointer dcl 39 ref 314 j 000311 automatic fixed bin(17,0) dcl 104 set ref 421* 422 423 424 477* 478 479 480 508* 511 514* 514 516* 516 522 524 524 535* 562* 563 564 565 js 000320 automatic fixed bin(17,0) initial dcl 104 set ref 104* 387 388 389 390 392* 392 488* jt 000321 automatic fixed bin(17,0) initial dcl 104 set ref 104* 390 393* 400 402* 402 403* 403 403 413 429* 436 438* 438 439* 439 439 466 488* 591 625 642 644* k 000312 automatic fixed bin(21,0) dcl 104 set ref 352* 354 354 388* 389 389* 390 390 392 401 402 415* 420 423* 423 424 424 437 438 460 510* 511 511 511 511 514* 566* 567 567 605* 606 606 607 607* known 000334 automatic bit(1) dcl 104 set ref 345* 349* 357* 473* 481* 490 557 570* 582* language 000000 constant char(6) initial dcl 51 ref 360 362 367 573 575 580 last 000325 automatic fixed bin(17,0) dcl 104 set ref 190* 192* 195* 196 198* 198 589* 593 594 595* 599 604 623* 628 640* 640 644 644 level 000022 internal static fixed bin(17,0) initial dcl 104 set ref 256 275* 275 308* 308 310 line 000422 automatic fixed bin(17,0) dcl 149 set ref 155* 169 173* 173 linum 000326 automatic fixed bin(17,0) dcl 104 set ref 393* 394 396 398 399 400 401 429* 430 431 432 435 436 437 lmax 000330 automatic fixed bin(17,0) initial dcl 104 set ref 104* 198 398* 398 435* 435 488* 510 589 623 644* lname 000104 automatic fixed bin(17,0) dcl 77 set ref 343* 344 350 362 363* 363 365* 479* 480 564* 565 575 576* 576 578* long_string based char(262144) dcl 60 set ref 388 390* 390 511* 511 606 main 000270 automatic pointer dcl 88 set ref 535* 537 540* 543* max builtin function dcl 104 ref 398 435 message parameter char dcl 211 set ref 209 219 221* min builtin function dcl 104 ref 198 mod builtin function dcl 104 ref 403 439 name parameter char dcl 239 in procedure "get_seg" set ref 237 245* 246* name based char packed unaligned dcl 77 in procedure "bs" ref 350 newline 000331 automatic bit(1) dcl 104 set ref 168* 188 196 432 nl 000023 internal static char(1) initial dcl 104 set ref 168 388 444 451 474 479 557 564 585 599 599 606 610 610 616 637 np 000106 automatic pointer dcl 77 set ref 343* 350 null builtin function dcl 104 ref 228 228 246 315 370 497 497 521 535 535 537 numl 000322 automatic fixed bin(17,0) dcl 104 set ref 157* 158* 195 obj 000266 automatic pointer dcl 88 set ref 263* 272* 327* 335* 532* 535* old_linum 000100 automatic char(10) dcl 56 set ref 386* 394* 396* 399* 399 output_iocb 000026 internal static pointer dcl 135 set ref 314* 599 599* 607 607* 610 610* perm_obj 000020 internal static pointer initial dcl 98 set ref 322* 327 perm_tbl 000016 internal static pointer initial dcl 98 set ref 321* 326 perm_tptr 000014 internal static pointer initial dcl 98 set ref 315 320* 325 place parameter fixed bin(17,0) dcl 149 in procedure "get_line_number" ref 147 158 place parameter fixed bin(17,0) dcl 184 in procedure "get_lines" set ref 182 186* 195 prog 000244 automatic char(32) dcl 77 set ref 367* 580* program_interrupt 000274 stack reference condition dcl 104 ref 292 pt parameter pointer dcl 239 set ref 237 245* 246 put_chars 52 based entry variable level 2 dcl 1-6 ref 599 607 610 reading 000336 automatic bit(1) initial dcl 104 set ref 104* 225 384* 405* resequencing 000335 automatic bit(1) initial dcl 104 set ref 104* 190 197 217* 295 297* 634* 646* s 000314 automatic char(1) packed unaligned dcl 104 set ref 547* 547* 548* save_sw 000333 automatic bit(1) dcl 104 set ref 505* 518 555* search builtin function dcl 104 ref 427 segment based structure level 1 dcl 60 source 000172 automatic char(168) dcl 77 set ref 350* 352 354 358* 360 362* 365 365 366* 368* 371* 480* 521* 525* 527* 565* 566 567 571* 573 575* 578 578 579* 581* sptr 000254 automatic pointer dcl 88 set ref 369* 370 388 390 520* 521 523 524* 526* substr builtin function dcl 104 set ref 354 362* 367 388 390* 390 399 424* 424 427 444 444 447 449 451 451 454 456 458 464 471 474 477 479 480 511* 511 557 562 564 565 567 575* 580 585 606* 606 616 620 637 tab constant char(1) initial dcl 104 ref 164 table based structure array level 1 dcl 60 tbl 000262 automatic pointer dcl 88 set ref 262* 271* 326* 334* 400 401 432 436 437 486* 511 511 511 511 514 601 605 606 629 644* text 52000 based fixed bin(35,0) array level 2 dcl 60 set ref 339 time_limit 000316 automatic fixed bin(71,0) initial dcl 104 set ref 104* 254 302 466* 467 540 542* timer_manager_$cpu_call 000062 constant entry external dcl 18 ref 542 timer_manager_$reset_cpu_call 000064 constant entry external dcl 18 ref 254 302 544 tptr 000256 automatic pointer dcl 88 set ref 261* 270* 325* 333* 339 484* 511 523 535* txt 000260 automatic pointer dcl 88 set ref 158 339* 390 413 511 606 644* type parameter fixed bin(5,0) dcl 239 set ref 237 245* verify builtin function dcl 104 ref 421 477 562 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. hcs_$terminate_noname 000000 constant entry external dcl 18 iox_$iocb_version_sentinel external static char(4) dcl 1-51 status automatic bit(72) dcl 104 string builtin function dcl 104 sys_info$max_seg_size external static fixed bin(35,0) dcl 39 unspec builtin function dcl 104 NAMES DECLARED BY EXPLICIT CONTEXT. basic_system 000406 constant entry external dcl 11 bs 000366 constant entry external dcl 11 bsys 000376 constant entry external dcl 11 clean_up 004001 constant entry internal dcl 252 ref 338 613 cpu_limit 004143 constant entry internal dcl 281 ref 254 254 302 302 542 542 544 544 delete 003214 constant label dcl 616 ref 454 edit 001357 constant label dcl 410 ref 285 304 528 552 648 error 003516 constant entry internal dcl 209 ref 202 246 358 366 371 394 396 430 431 467 478 485 487 521 525 527 533 560 563 571 579 601 616 645 finish 002147 constant label dcl 508 ref 557 583 get_line_number 003347 constant entry internal dcl 147 ref 186 195 393 429 466 get_lines 003436 constant entry internal dcl 182 ref 591 625 642 get_seg 003700 constant entry internal dcl 237 ref 320 321 322 333 334 335 get_source 000760 constant label dcl 352 ref 490 list 003012 constant label dcl 585 ref 449 mistake 003505 constant label dcl 202 set ref 187 196 move 001226 constant label dcl 384 ref 225 next 001372 constant label dcl 413 ref 230 347 375 418 420 441 461 468 492 499 611 632 quit 003207 constant label dcl 613 ref 451 resequence 003267 constant label dcl 634 ref 456 run 002146 constant label dcl 505 ref 444 save 002545 constant label dcl 555 ref 447 start 000414 constant label dcl 292 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5424 5524 5130 5434 Length 6036 5130 100 275 273 20 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME bs 456 external procedure is an external procedure. get_line_number internal procedure shares stack frame of external procedure bs. get_lines internal procedure shares stack frame of external procedure bs. error internal procedure shares stack frame of external procedure bs. get_seg internal procedure shares stack frame of external procedure bs. clean_up 82 internal procedure is called by several nonquick procedures. cpu_limit 76 internal procedure is assigned to an entry variable. on unit on line 292 76 on unit on unit on line 338 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 id bs 000014 perm_tptr bs 000016 perm_tbl bs 000020 perm_obj bs 000022 level bs 000023 nl bs 000024 input_iocb bs 000026 output_iocb bs STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME bs 000100 old_linum bs 000103 count bs 000104 lname bs 000106 np bs 000110 dirname bs 000162 ename bs 000172 source bs 000244 prog bs 000254 sptr bs 000256 tptr bs 000260 txt bs 000262 tbl bs 000264 inp bs 000266 obj bs 000270 main bs 000272 code bs 000310 i bs 000311 j bs 000312 k bs 000313 chr bs 000314 s bs 000316 time_limit bs 000320 js bs 000321 jt bs 000322 numl bs 000323 csize bs 000324 first bs 000325 last bs 000326 linum bs 000327 err_count bs 000330 lmax bs 000331 newline bs 000332 compiling bs 000333 save_sw bs 000334 known bs 000335 resequencing bs 000336 reading bs 000337 buffer bs 000420 d get_line_number 000421 error get_line_number 000422 line get_line_number THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ent_var_desc call_ent_var call_ext_out_desc call_ext_out call_int_this call_int_other return_mac move_label_var make_label_var tra_ext_1 mdfx1 signal_op enable_op shorten_stack ext_entry int_entry set_chars_eis index_chars_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. basic_ basic_resequence_ com_err_ cu_$arg_ptr cu_$cl cu_$cp cu_$ptr_call expand_path_ hcs_$delentry_seg hcs_$initiate_count hcs_$make_seg hcs_$set_bc_seg hcs_$truncate_seg ioa_ ioa_$rsnnl timer_manager_$cpu_call timer_manager_$reset_cpu_call THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$noentry iox_$user_input iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 104 000352 11 000365 292 000414 295 000430 296 000433 297 000446 298 000450 299 000451 300 000453 301 000466 302 000470 304 000506 308 000511 310 000513 313 000516 314 000521 315 000524 320 000530 321 000555 322 000606 325 000634 326 000637 327 000641 328 000643 333 000644 334 000651 335 000656 338 000663 339 000705 343 000711 344 000730 345 000734 346 000735 347 000750 349 000751 350 000753 352 000760 354 000771 357 001001 358 001002 360 001012 362 001021 363 001025 365 001027 366 001054 367 001063 368 001075 369 001127 370 001171 371 001175 374 001207 375 001222 378 001223 384 001226 386 001230 387 001233 388 001237 389 001255 390 001261 392 001266 393 001267 394 001271 396 001304 398 001316 399 001323 400 001335 401 001342 402 001345 403 001350 404 001355 405 001356 410 001357 413 001372 415 001376 416 001420 417 001422 418 001444 420 001445 421 001450 422 001463 423 001465 424 001471 427 001475 429 001505 430 001507 431 001525 432 001537 435 001546 436 001553 437 001560 438 001563 439 001566 441 001573 444 001574 447 001606 449 001611 451 001613 454 001622 456 001627 458 001632 460 001634 461 001654 464 001655 466 001657 467 001667 468 001700 471 001701 473 001704 474 001705 477 001725 478 001737 479 001750 480 001770 481 001773 484 001775 485 002011 486 002025 487 002041 488 002055 490 002060 492 002062 496 002063 497 002077 498 002132 499 002145 505 002146 508 002147 510 002151 511 002157 514 002175 515 002176 516 002200 518 002202 520 002204 521 002243 522 002254 523 002260 524 002266 525 002304 526 002313 527 002326 528 002335 531 002336 532 002340 533 002354 535 002363 537 002406 540 002434 542 002446 543 002466 544 002475 545 002507 547 002510 547 002515 548 002517 551 002543 552 002544 555 002545 557 002547 560 002556 562 002571 563 002604 564 002615 565 002635 566 002640 567 002651 570 002661 571 002662 573 002672 575 002701 576 002705 578 002707 579 002734 580 002743 581 002755 582 003007 583 003011 585 003012 588 003017 589 003020 590 003022 591 003023 593 003030 594 003033 595 003035 596 003037 599 003041 601 003066 604 003101 605 003111 606 003115 607 003140 608 003162 610 003164 611 003206 613 003207 614 003213 616 003214 620 003233 622 003240 623 003241 624 003243 625 003244 628 003251 629 003261 630 003264 632 003266 634 003267 637 003271 639 003276 640 003300 641 003302 642 003303 644 003310 645 003333 646 003345 648 003346 147 003347 149 003351 155 003353 157 003354 158 003356 159 003366 160 003376 162 003377 164 003401 166 003411 168 003412 169 003417 171 003422 173 003423 174 003427 176 003430 178 003432 182 003436 186 003440 187 003450 188 003452 190 003454 192 003461 193 003462 195 003463 196 003471 197 003475 198 003500 200 003504 202 003505 205 003515 209 003516 217 003534 219 003536 221 003570 223 003614 225 003626 228 003630 229 003663 230 003676 233 003677 237 003700 245 003711 246 003747 248 003777 252 004000 254 004006 256 004026 261 004032 262 004046 263 004063 264 004100 270 004101 271 004112 272 004124 275 004136 277 004141 281 004142 283 004150 284 004153 285 004171 ----------------------------------------------------------- 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