check_mst.pl1 07/16/87 1350.1r 07/15/87 1602.4 77904 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-01-13,GDixon), approve(87-04-16,MCR7614), audit(87-05-21,Farley), install(87-07-15,MR12.1-1040): Add support for storing boot program as first segment of MST image stored in a file. END HISTORY COMMENTS */ /* format: style2 */ /* Command version of Multics checker */ /* Written long ago by someone who probably wouldn't admit it today, anyway */ /* Modified 26 June 1981, W. Olin Sibert, to call get_collection_$init and avoid creeping sizes */ /* Completely rewritten 7/82 BIM */ check_mst: ckm: procedure; dcl ( error_table_$noarg, error_table_$inconsistent, error_table_$too_many_args, error_table_$badopt, error_table_$bad_conversion, error_table_$bad_arg ) ext static fixed bin (35); dcl density fixed bin; dcl thing_name char (168); dcl filename char (168); dcl code fixed bin (35); dcl (file, positional, tape) bit (1) aligned; /* file --> -file, positional --> positional control arg seen, tape --> -tape */ dcl ap pointer; dcl al fixed bin (21); dcl argument char (al) based (ap); dcl argx fixed bin; dcl n_args fixed bin; dcl (addr, before, binary, char, fixed, null, string) builtin; dcl (get_temp_segments_, release_temp_segments_) entry (char (*), dim (*) ptr, fixed bin (35)); dcl ioa_ entry options (variable); dcl checker_print_$init entry; dcl define_area_ entry (ptr, fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl tape_reader_$init entry (char (*), char (*), fixed bin, bit (1) aligned, fixed bin (35)); dcl tape_reader_$final entry; dcl com_err_ entry options (variable); dcl cu_$arg_count entry entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl get_wdir_ entry returns (char (168)); dcl checker_init_meters_ entry; dcl checker_load_MST_ entry; dcl checker_crossref_ entry; dcl sslt_manager_$init entry (ptr); dcl sslt_init_ entry (ptr, ptr); dcl cleanup condition; dcl checker_fatal_error_ condition; dcl conversion condition; %page; %include iox_modes; %page; %include iox_entries; %page; %include area_info; dcl 1 AI aligned like area_info; %page; %include checker_dcls_; dcl sys_info$max_seg_size fixed bin (35) ext; dcl ME char (32) init ("check_mst") int static options (constant); call cu_$arg_count (n_args, code); if code ^= 0 then do; call com_err_ (code, ME); return; end; thing_name = ""; positional = "0"b; file = "0"b; tape = "0"b; density = 0; checker_data_$severity = 0; do argx = 1 to n_args; call cu_$arg_ptr (argx, ap, al, (0)); if char (argument, 1) ^= "-" then do; if positional /* only one positional allowed */ then do; call com_err_ (error_table_$too_many_args, ME, "Only one MST may be supplied. ^a cannot be processed.", argument); return; end; positional = "1"b; thing_name = argument; end; else if argument = "-severity" | argument = "-sv" then do; if argx = n_args then do; call com_err_ (error_table_$noarg, ME, "-severity must be followed by a severity number."); return; end; on conversion begin; call com_err_ (error_table_$bad_conversion, ME, "Invalid severity number ^a.", argument); go to RETURN; end; argx = argx + 1; call cu_$arg_ptr (argx, ap, al, (0)); checker_data_$severity = fixed (argument); revert conversion; if checker_data_$severity > 4 | checker_data_$severity < 0 then do; call com_err_ (error_table_$bad_arg, ME, "-severity must be followed by N, for 0 <= N <= 4."); return; end; end; else if argument = "-tape" then do; if file | tape then DUP_INPUT: do; call com_err_ (error_table_$inconsistent, ME, "-tape and -file may not both be specified."); return; end; tape = "1"b; end; else if argument = "-file" then do; if file | tape then goto DUP_INPUT; file = "1"b; end; else if argument = "-density" | argument = "-den" then do; if argx = n_args then do; call com_err_ (error_table_$noarg, ME, "-density must be followed by a density."); return; end; argx = argx + 1; call cu_$arg_ptr (argx, ap, al, (0)); if char (argument, 1) = "-" then do; call com_err_ (error_table_$noarg, ME, "-density must be followed by a density, but a control argument, ^a, was found.", argument); return; end; on conversion begin; call com_err_ (error_table_$bad_conversion, ME, "^a is not a valid density.", argument) ; go to RETURN; end; density = binary (argument); revert conversion; end; else do; call com_err_ (error_table_$badopt, ME, "Unrecognized control argument ^a", argument); RETURN: return; end; end; if ^file & ^tape then tape = "1"b; if thing_name = "" then do; call com_err_ (error_table_$noarg, ME, "No input specified."); return; end; if file & density ^= 0 then do; call com_err_ (error_table_$inconsistent, ME, "-density may not be specified with -file."); return; end; thing_name = before (thing_name, ","); /* in case of ,den= */ checker_data_$temp_ptrs (*) = null (); checker_data_$input_iocbp, checker_data_$output_iocbp = null; on cleanup call clean_up; call get_temp_segments_ (ME, checker_data_$temp_ptrs, code); if code ^= 0 then do; call com_err_ (code, ME, "No temp segs to be had."); go to EXIT; end; call tape_reader_$init (ME, thing_name, density, file, code); if code ^= 0 then go to EXIT; AI.version = area_info_version_1; AI.owner = "check_mst"; AI.size = sys_info$max_seg_size; AI.areap = checker_data_$area_ptr; string (AI.control) = ""b; AI.no_freeing = "1"b; AI.extend = "1"b; call define_area_ (addr (AI), code); if code ^= 0 then do; call com_err_ (code, "check_mst", "Could not define def area."); go to EXIT; end; call expand_pathname_$add_suffix (thing_name, "ckrout", (""), filename, code); filename = pathname_ (get_wdir_ (), (filename)); call iox_$attach_name ("checker_output_", checker_data_$output_iocbp, "vfile_ " || filename, null (), code); if code ^= 0 then do; outerr: call com_err_ (code, "check_mst", "checker output file"); go to EXIT; end; call iox_$open (checker_data_$output_iocbp, Stream_output, "0"b, code); if code ^= 0 then go to outerr; call ioa_ ("Begin checker"); call checker_init_meters_; call checker_print_$init; call sslt_init_ (checker_data_$slt_ptr, checker_data_$name_table_ptr); call sslt_manager_$init (checker_data_$slt_ptr); /* initialize "simulated slt" */ on checker_fatal_error_ begin; call com_err_ (0, ME, "Fatal error. Checker run aborted."); go to EXIT; end; call checker_load_MST_; call checker_crossref_; call tape_reader_$final; call ioa_ ("End checker"); EXIT: call clean_up; return; clean_up: proc; if checker_data_$temp_ptrs (1) ^= null () then call release_temp_segments_ (ME, checker_data_$temp_ptrs, code); checker_data_$temp_ptrs (*) = null; call tape_reader_$final (); if checker_data_$output_iocbp ^= null then do; call iox_$close (checker_data_$output_iocbp, code); call iox_$detach_iocb (checker_data_$output_iocbp, code); checker_data_$output_iocbp = null; end; return; end; end check_mst;  checker_crossref_.pl1 06/01/84 1546.7r w 06/01/84 1426.8 137943 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* checker_crossref_ -- Program to look at all the links in an MST */ /* and see if they can be resolved */ /* format: style2 */ /* Modified December 1983 by Keith Loepere for non-loaded collections; also so that temp segs in one minor collection can reference segs in another minor collection within the same major collection. */ checker_crossref_: procedure; %include checker_dcls_; %page; %include slte; %include slt; %page; declare 1 list_head aligned based, 2 first ptr unaligned, 2 count fixed bin; declare 1 segment_not_found_head aligned like list_head; declare 1 found_online_head aligned like list_head; declare 1 entrypoint_not_found_head aligned like list_head; declare 1 special_link_head aligned like list_head; declare ONLINE fixed bin init (-2) int static options (constant); declare SEGMENT_NOT_FOUND fixed bin init (-1) int static options (constant); declare ENTRYPOINT_NOT_FOUND fixed bin init (-4) int static options (constant); declare SPECIAL_LINK fixed bin init (-3) int static options (constant); declare SELF_LINK fixed bin init (-5) int static options (constant); declare 1 IL_arg aligned, 2 segname char (32) aligned, 2 entryname char (33) aligned, 2 expression char (8) aligned, 2 modifier char (4) aligned, 2 trap char (32) aligned; declare cep pointer; declare cx fixed bin; declare 1 chain_entry based (cep), 2 next ptr unal, 2 linker char (32) unal, 2 link char (256) unal; declare checker_print_$error entry () options (variable); declare checker_print_$error_term entry () options (variable); declare checker_print_ entry () options (variable); declare checker_print_$page entry; declare checker_print_$skip entry; declare hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); declare ioa_ entry () options (variable); declare interpret_link_$given_exp entry (ptr, fixed bin (18), bit (6), ptr, fixed bin (35)); declare hash_$opt_size entry (fixed bin) returns (fixed bin); declare hash_$in entry (ptr, char (*), bit (36) aligned, fixed bin (35)); declare hash_$make entry (ptr, fixed bin, fixed bin (35)); declare hash_$search entry (ptr, char (*), bit (36) aligned, fixed bin (35)); declare get_definition_ entry (ptr, char (*), char (*), ptr, fixed bin (35)); declare get_temp_segment_ entry (char (*), ptr, fixed bin (35)); declare release_temp_segment_ entry (char (*), ptr, fixed bin (35)); declare error_table_$no_ext_sym fixed bin (35) ext static; declare error_table_$seg_not_found fixed bin (35) ext static; declare cleanup condition; declare htp pointer; declare (hbound, null, length, rtrim, char, substr, ptr, addr, unspec) builtin; declare ME init ("checker_crossref_") int static options (constant) char (32); htp = null; on cleanup begin; if htp ^= null () then call release_temp_segment_ (ME, htp, (0)); end; call get_temp_segment_ (ME, htp, (0)); call hash_$make (htp, hash_$opt_size (5000), (0));/* hash table to remember where we found (that we found) a given segname */ segment_not_found_head.first, found_online_head.first, entrypoint_not_found_head.first, special_link_head.first = null; segment_not_found_head.count, found_online_head.count, entrypoint_not_found_head.count, special_link_head.count = 0; call checker_print_$page; call checker_print_ ("Begin Crossreference:"); call checker_print_$skip; call ioa_ ("Begin Crossreference."); sltp = checker_data_$slt_ptr; names_ptr = checker_data_$name_table_ptr; call FILL_HASH_TABLE; do cx = 0 to hbound (meters.per_collection, 1) while (meters.per_collection (cx).read & cx <= checker_data_$last_supervisor_collection); if checker_data_$loaded (cx) then call COLLECTION (cx); end; call REPORT; call ioa_ ("Done Crossreference."); call release_temp_segment_ (ME, htp, (0)); return; COLLECTION: procedure (collection); declare collection fixed bin; declare 1 PC aligned like meters.per_collection defined (meters.per_collection (collection)); declare segment_number fixed bin (18); call ioa_ ("Checking collection ^d.^d.", checker_data_$collection_names (collection).major, checker_data_$collection_names (collection).minor); do segment_number = PC.first_segment repeat meters.per_segment (segment_number).next while (segment_number ^< 0); if addr (slt.seg (segment_number)) -> slte_uns.ringbrack (1) = 0 & meters.per_segment (segment_number).link_ptr ^= null then call LOOK_AT_LINKS (segment_number, (meters.per_segment (segment_number).link_ptr), (meters.per_segment (segment_number).defs_ptr)); end; return; end COLLECTION; LOOK_AT_LINKS: procedure (segment_number, links_ptr, defs_ptr); declare segment_number fixed bin (18); declare defs_ptr ptr; declare links_ptr pointer; declare exp_relp fixed bin (18); declare modifier bit (6); declare segment_name char (32); declare lx fixed bin; declare def_section_ptr ptr; def_section_ptr = addr (defs_ptr -> segment_defs.definitions); segment_name = NAME (segment_number); segment_links_ptr = links_ptr; do lx = 1 to segment_links.n_links; exp_relp = segment_links.expression_relps (lx); modifier = segment_links.modifiers (lx); call PROCESS_LINK (segment_number, segment_name, def_section_ptr, exp_relp, modifier); end; end LOOK_AT_LINKS; PROCESS_LINK: procedure (segment_number, segment_name, defs_ptr, exp_relp, modifier); declare segment_number fixed bin (18); declare segment_name char (32); declare defs_ptr pointer; declare exp_relp fixed bin (18); declare modifier bit (6); declare link_entrypoint char (32); declare found_in_segno fixed bin; declare 1 (linking_slte, linked_slte) aligned like slte_uns; declare link_printed_rep char (256); /* Get the name that this references */ call interpret_link_$given_exp (addr (IL_arg), exp_relp, modifier, defs_ptr, (0)); sltep = addr (slt.seg (segment_number)); linking_slte = slte_uns; /* Look for the definitions */ if substr (IL_arg.entryname, 1, 1) = "|" then link_entrypoint = ""; else link_entrypoint = substr (IL_arg.entryname, 2); found_in_segno = SEARCH (IL_arg.segname, link_entrypoint, linking_slte.ringbrack (2) > 0); link_printed_rep = LINK_REP (); /* IL_arg is global */ if found_in_segno ^< 0 then do; /* hardcore segment */ sltep = addr (slt.seg (found_in_segno)); linked_slte = slte_uns; if linking_slte.temp_seg & checker_data_$collection_names (meters.per_segment (found_in_segno).collection).major > checker_data_$collection_names (meters.per_segment (segment_number).collection).major then call checker_print_$error (CHECKER_ERROR, (0), "crossref", "Temp seg ^a link ^a: target is in a later collection.", segment_name, link_printed_rep); else if linking_slte.temp_seg & linked_slte.temp_seg & checker_data_$collection_names (meters.per_segment (found_in_segno).collection).major ^= checker_data_$collection_names (meters.per_segment (segment_number).collection).major then call checker_print_$error (CHECKER_ERROR, (0), "crossref", "Temp seg ^a link ^a: target is temp segment in a different collection.", segment_name, link_printed_rep); else if linked_slte.temp_seg & checker_data_$collection_names (meters.per_segment (found_in_segno).collection).major < checker_data_$collection_names (meters.per_segment (segment_number).collection).major then call checker_print_$error (CHECKER_ERROR, (0), "crossref", "Seg ^a link ^a links to earlier temp seg.", segment_name, link_printed_rep); /* Check for ring order here */ end; else if found_in_segno = ONLINE then call ADD_TO_CHAIN (segment_name, link_printed_rep, found_online_head); else if found_in_segno = SEGMENT_NOT_FOUND then call ADD_TO_CHAIN (segment_name, link_printed_rep, segment_not_found_head); else if found_in_segno = ENTRYPOINT_NOT_FOUND then call ADD_TO_CHAIN (segment_name, link_printed_rep, entrypoint_not_found_head); else if found_in_segno = SPECIAL_LINK then call ADD_TO_CHAIN (segment_name, link_printed_rep, special_link_head); /* other case is SELF, which is okay */ end PROCESS_LINK; SEARCH: procedure (segname, entrypoint, runs_in_user_ring) returns (fixed bin); declare segname char (*) aligned; declare entrypoint char (*); /* "" for numeric based links */ declare segno_in_word bit (36) aligned; declare segno fixed bin (35); declare runs_in_user_ring bit (1) aligned; declare code fixed bin (35); declare (cx, sx) fixed bin (18); declare s_ptr pointer; declare segname_u char (32); declare def_section_ptr pointer; declare searched_hardcore bit (1) aligned; searched_hardcore = "0"b; segname_u = segname; if segname_u = "*symbol" | segname_u = "*system" | segname_u = "*defs" then return (SPECIAL_LINK); else if char (segname_u, 1) = "*" then return (SELF_LINK); call hash_$search (htp, segname_u, segno_in_word, code); if code = 0 then do; unspec (segno) = segno_in_word; go to HAVE_SEGNO; end; /* Try online */ SEARCH_ONLINE: call hcs_$make_ptr (null (), segname_u, entrypoint, s_ptr, code); if s_ptr ^= null then return (ONLINE); else do; if code = error_table_$no_ext_sym | searched_hardcore /* return original error */ then return (ENTRYPOINT_NOT_FOUND); else return (SEGMENT_NOT_FOUND); end; HAVE_SEGNO: if entrypoint = "" then return (segno); /* easy enough */ sx = segno; if meters.per_segment (sx).defs_ptr = null then go to NO_ENTRYPOINT; def_section_ptr = addr (meters.per_segment (sx).defs_ptr -> segment_defs.definitions); call get_definition_ (def_section_ptr, segname_u, entrypoint, (null), code); if code ^= 0 then NO_ENTRYPOINT: do; if ^runs_in_user_ring | searched_hardcore then return (ENTRYPOINT_NOT_FOUND); else do; searched_hardcore = "1"b; go to SEARCH_ONLINE; end; end; return (segno); end SEARCH; NAME: procedure (s) returns (char (32)) reducible; declare s fixed bin (18); return (ptr (checker_data_$name_table_ptr, addr (slt.seg (s)) -> slte_uns.names_ptr) -> segnam.names (1).name); end NAME; LINK_REP: procedure returns (char (256)); declare arep char (256); arep = rtrim (IL_arg.segname) || rtrim (IL_arg.entryname) || rtrim (IL_arg.expression) || rtrim (IL_arg.modifier) || " " || IL_arg.trap; return (arep); end LINK_REP; ADD_TO_CHAIN: procedure (sn, lrep, head); declare sn char (*); /* segment name making the link */ declare lrep char (256); /* the link offending */ declare 1 head aligned like list_head; /* the chain */ declare new_cep ptr; declare prev_cep ptr; allocate chain_entry in (checker_area) set (new_cep); new_cep -> chain_entry.linker = sn; new_cep -> chain_entry.link = lrep; new_cep -> chain_entry.next = null; head.count = head.count + 1; if head.first = null then do; head.first = new_cep; return; end; prev_cep = null; do cep = head.first repeat chain_entry.next while (cep ^= null); if sn < chain_entry.linker then INSERT: do; /* insert here */ new_cep -> chain_entry.next = cep; if prev_cep = null /* to beginning */ then head.first = new_cep; else prev_cep -> chain_entry.next = new_cep; return; end; else if sn = chain_entry.linker then do; /* look for multiples on this segname */ do cep = cep repeat chain_entry.next while (cep ^= null); if lrep < chain_entry.link then go to INSERT; if sn ^= chain_entry.linker then go to INSERT; /* last on this segname */ prev_cep = cep; end; go to OFF_END; end; prev_cep = cep; end; OFF_END: /* prev_cep -> last one */ prev_cep -> chain_entry.next = new_cep; end ADD_TO_CHAIN; REPORT: procedure; if entrypoint_not_found_head.count > 0 then do; call THROW; call checker_print_$error (CHECKER_SEVERE, (0), "crossref", "Links exist to entrypoints not defined."); call checker_print_$skip; call PRINT_CHAIN (entrypoint_not_found_head.first, CHECKER_ERROR, error_table_$no_ext_sym); end; if segment_not_found_head.count > 0 then do; call THROW; call checker_print_$error (CHECKER_SEVERE, (0), "crossref", "Links exist to segments not found."); call checker_print_$skip; call PRINT_CHAIN (segment_not_found_head.first, CHECKER_ERROR, error_table_$seg_not_found); end; if found_online_head.count > 0 then do; call THROW; call checker_print_$error (CHECKER_WARNING, (0), "crossref", "Links exist to segments found only online."); call checker_print_$skip; call PRINT_CHAIN (found_online_head.first, 0, 0); end; if special_link_head.count > 0 then do; call THROW; call checker_print_$error (CHECKER_WARNING, (0), "crossref", "Links exist to special ""*"" segnames."); call checker_print_$skip; call PRINT_CHAIN (special_link_head.first, 0, 0); end; return; THROW: procedure; call checker_print_$page; call checker_print_$skip; end THROW; PRINT_CHAIN: procedure (first_cep, severity, code); declare first_cep ptr unal; declare last_s char (32); declare severity fixed bin; declare code fixed bin (35); declare line char (136); declare column fixed bin; line = ""; column = 1; last_s = ""; do cep = first_cep repeat chain_entry.next while (cep ^= null); if chain_entry.linker ^= last_s then do; if column > 1 then call checker_print_ ("^a", line); /* leftovers */ call checker_print_$skip; call checker_print_ ("^a", chain_entry.linker); line = ""; column = 1; end; last_s = chain_entry.linker; if length (rtrim (chain_entry.link)) <= length (line) - column + 1 then begin; declare next char (length (rtrim (chain_entry.link)) + 1) defined (line) position (column); next = chain_entry.link; column = column + length (next); end; else do; call checker_print_ ("^a", line); column = length (rtrim (chain_entry.link)) + 2; line = chain_entry.link; end; if severity > 0 then call checker_print_$error_term (severity, code, "", "^a links to ^a.", chain_entry.linker, chain_entry.link); end; if column > 1 then call checker_print_ ("^a", line); /* leftovers */ end PRINT_CHAIN; end REPORT; FILL_HASH_TABLE: procedure; declare sx fixed bin (18); declare nx fixed bin; do sx = slt.first_sup_seg to slt.last_sup_seg, slt.first_init_seg to slt.last_init_seg; namep = ptr (checker_data_$name_table_ptr, addr (slt.seg (sx)) -> slte_uns.names_ptr); do nx = 1 to segnam.count; call hash_$in (htp, segnam.names (nx).name, unspec (sx), (0)); end; end; end FILL_HASH_TABLE; end checker_crossref_;  checker_data_.cds 07/16/87 1350.1r 07/15/87 1601.9 33291 /* *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* HISTORY COMMENTS: 1) change(87-01-13,GDixon), approve(87-04-16,MCR7614), audit(87-05-21,Farley), install(87-07-15,MR12.1-1040): Add support for storing boot program as first segment of MST image stored in a file. END HISTORY COMMENTS */ /* CHECKER_DATA_ -- static data for the MST checker subsystem */ /* The bulk of the data is actually kept in a temporary area */ /* found by a pointer here. Needless to say, the checker is */ /* nonrecursive. */ /* Modified December 1983 by Keith Loepere for collections that aren't loaded into segments and other subtleties. */ /* Modified January 1985 by Keith Loepere so that collection 3 isn't claimed to take up defintions_, etc. */ /* format: style3,idind30 */ checker_data_: proc; dcl 1 cdsa like cds_args auto aligned; dcl 1 checker_stat aligned auto, 2 input_iocbp ptr, /* checker input switch */ 2 output_iocbp ptr, /* checker output switch */ 2 temp_ptrs bit (0), /* Look at all the following as an array for g_t_segments_ */ 2 slt_ptr bit (0), /* simulated SLT (sslt) */ 2 sslt_ptr ptr init (null ()), 2 area_ptr ptr init (null ()), /* area in which most static data is put */ 2 name_table_ptr bit (0), /* simulated name_table */ 2 sname_table_ptr ptr init (null ()), 2 buffer_ptr ptr init (null ()), /* Tape reader buffer */ 2 meter_ptr ptr init (null ()), /* big structure of checker meters */ 2 severity fixed bin, /* worst error encountered */ 2 file_attachment bit (1) init ("0"b);/* MST is a file. */ dcl 1 checker_text aligned, 2 last_wired_collection fixed bin init (4), /* make_segs_paged runs here, paging defs, etc. */ 2 last_text_wired_collection fixed bin init (2), /* after this, text is not loaded directly into memory */ 2 last_supervisor_collection fixed bin init (5), /* after this load into >sl1 */ 2 collection_names (0:10) aligned, 3 major fixed bin init (0, 0, 1, 1, 1, 2, 3, (4) 0), 3 minor fixed bin init (0, 5, 0, 2, 5, 0, 0, (4) 0), 2 loaded (0:10) bit (1) aligned init ("1"b, "0"b, "1"b, "0"b, "1"b, "1"b, "0"b, (4) (1)"0"b), /* objects in collection are loaded into segments */ 2 n_temp_ptrs fixed bin init (4); dcl code fixed bin (35); dcl create_data_segment_ entry (ptr, fixed bin (35)); dcl com_err_ entry options (variable); dcl (addr, size, string) builtin; %page; %include cds_args; cdsa.sections (1).p = addr (checker_text); cdsa.sections (1).len = size (checker_text); cdsa.sections (1).struct_name = "checker_text"; cdsa.sections (2).p = addr (checker_stat); cdsa.sections (2).len = size (checker_stat); cdsa.sections (2).struct_name = "checker_stat"; cdsa.seg_name = "checker_data_"; cdsa.num_exclude_names = 0; string (cdsa.switches) = "0"b; cdsa.switches.have_static = "1"b; cdsa.switches.have_text = "1"b; call create_data_segment_ (addr (cdsa), code); if code ^= 0 then call com_err_ (code, "checker_data_"); return; end checker_data_;  checker_init_meters_.pl1 06/04/84 1601.8rew 06/04/84 1242.1 12267 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style2 */ checker_init_meters_: procedure; /* Put appropriate values in checker_data_$meters_ptr -> meters */ /* BIM 8/82 */ %include checker_dcls_; %include hc_definitions_seg; declare cx fixed bin; declare sx fixed bin; declare (currentsize, hbound, lbound, null, unspec) builtin; declare 1 auto_definitions_ aligned like definitions; allocate meters in (checker_area); unspec (meters) = ""b; /* zero, presumptively */ meters.sizes = -1; meters.wired_definitions_used, meters.paged_definitions_used = currentsize (auto_definitions_); /* count in the DOT */ do cx = lbound (meters.per_collection, 1) to hbound (meters.per_collection, 1); meters.per_collection (cx).first_segment, meters.per_collection.last_segment = -1; end; do sx = lbound (meters.per_segment, 1) to hbound (meters.per_segment, 1); meters.per_segment (sx).link_ptr = null; meters.per_segment (sx).defs_ptr = null; meters.per_segment (sx).next = -1; end; return; end checker_init_meters_;  checker_load_MST_.pl1 07/16/87 1350.1r 07/15/87 1602.4 351594 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-01-13,GDixon), approve(87-04-16,MCR7614), audit(87-05-21,Farley), install(87-07-15,MR12.1-1040): Add support for storing boot program as first segment of MST image stored in a file. END HISTORY COMMENTS */ /* checker_load_MST_.pl1 -- eat an entire Multics system tape */ /* format: style2 */ /* BIM 8/82, bugfix to linkage sections 11/82 */ /* Modified by Keith Loepere to handle collections in which objects aren't loaded into segments. */ /* Modified 3/84 by Keith Loepere for "unpaged segs" and bugfixes. */ /* Modified 1/85 by Keith Loepere to really understand unloaded collections. */ checker_load_MST_: procedure; /* This program reads an MST, building the data structure */ /* needed to do a crossreference later. As it goes, it checks */ /* for a variety of errors. Emphasis is given to errors made */ /* be the preparer of the header file, RATHER than on generate_mst */ /* gratuitously screwing up. Useful data on each segment is printed, */ /* and serious errors (overflowed segments) produce com_err_ calls. */ /* We expect tape_reader_ to signal MST_tape_eof_ if it runs out of */ /* tape. */ dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); dcl checker_print_ entry options (variable); dcl checker_print_$error entry options (variable); dcl checker_print_$skip entry; dcl checker_print_$page entry; dcl ioa_ entry () options (variable); dcl tape_reader_ entry (ptr, fixed bin (18)); dcl sslt_manager_$build_entry entry (ptr, ptr, fixed bin (17)); dcl sslt_manager_$get_seg_num entry (char (32), fixed bin (18), fixed bin (35)); dcl object_info_$brief entry (ptr, fixed bin (24), ptr, fixed bin (35)); dcl com_err_ entry () options (variable); dcl error_table_$namedup fixed bin (35) ext static; dcl sys_info$max_seg_size fixed bin (35) ext static; dcl ME char (32) init ("checker_load_MST_") int static options (constant); dcl (addr, addrel, after, baseno, before, bin, char, currentsize, divide, hbound, index, max, min, ptr, substr, sum, unspec, size) builtin; dcl collection_started bit (1) aligned; dcl header_ptr pointer; dcl header_area (1000) bit (36) aligned; dcl HEADER_MAX_SIZE fixed bin init (1000) int static options (constant); declare 1 control_word aligned, 2 type fixed bin (18) uns unal, 2 count fixed bin (18) uns unal; declare 1 collection_mark aligned, 2 major fixed bin (18) uns unal, 2 minor fixed bin (18) uns unal; declare ( SEGMENT init (1), HEADER init (0), COLLECTION_MARK init (2) ) fixed bin (18) uns int static options (constant); /* format: off */ %page; %include slt; %page; %include slte; %page; %include object_link_dcls; %page; %include definition_dcls; %page; %include checker_dcls_; %page; %include object_info; %page; %include tape_mult_boot_info; /* format: on */ dcl 1 oi aligned like object_info; dcl 1 cur_slte aligned like slte_uns; dcl Collection fixed bin; dcl code fixed bin (35); dcl hc_seg_ptr ptr; dcl segment_name character (32); dcl segment_number fixed bin (18); dcl nx fixed bin; dcl (first, second, third) char (32); dcl MST_tape_eof_ condition; %page; sltp = checker_data_$slt_ptr; /* pointer to simulated slt */ names_ptr = checker_data_$name_table_ptr; sltep, header_ptr = addr (header_area); namep = addrel (header_ptr, size (slte)); /* SLT entry is 4 words long */ call CHECK_BOOTABLE_LABEL; /* First, report on the collection 0 segments. Trust the data that */ /* sslt_init_ put in the slt for bound_bootload_1 */ call checker_print_ ("Begin collection 0.0:"); meters.per_collection (0).read = "1"b; Collection = 0; /* The first control word :: the header for BBL1 */ call Read_Control_Word; if control_word.type ^= HEADER then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Tape does not begin with header record."); call tape_reader_ (addr (header_area), (control_word.count)); /* take the header */ do segment_number = slt.first_sup_seg to slt.last_sup_seg; call checker_print_$skip; call PROCESS_SLTE (segment_number); /* do for slte data */ end; do segment_number = slt.first_init_seg to slt.last_init_seg; call checker_print_$skip; call PROCESS_SLTE (segment_number); /* ditto */ end; call checker_print_$skip; call checker_print_ ("End collection 0.0"); call COLLECTION_SUMMARY; /* Read in the first segment, which has already been described by the */ /* collection 0 template. This code could be expanded to check if */ /* it bears some reasonable resemblance to the template. */ call Read_Control_Word; /* Control word for first seg */ call tape_reader_ (checker_data_$buffer_ptr, (control_word.count)); /* Fine, preliminaries are set */ on MST_tape_eof_ go to NO_MORE_COLLECTIONS; do while ("1"b); Collection = Collection + 1; if Collection > hbound (meters.per_collection, 1) then do; call com_err_ (code, ME, "More than ^d collections.", Collection - 1); return; end; call LOAD_ONE_COLLECTION; call COLLECTION_SUMMARY; end; NO_MORE_COLLECTIONS: call TOTAL_SUMMARY; return; /* Let our caller move on to the cref */ %page; LOAD_ONE_COLLECTION: procedure; declare expect_link bit (1) aligned; declare expect_defs bit (1) aligned; declare 1 prev_slte aligned like slte_uns; declare text_segment_number fixed bin (18); unspec (prev_slte) = ""b; expect_link, expect_defs = "0"b; text_segment_number = -1; collection_started = "0"b; LOAD_LOOP: call Read_Control_Word; /* Allow EOF to take on last collection */ if ^collection_started then do; meters.per_collection (Collection).read = "1"b; call checker_print_$page; call checker_print_ ("Begin collection ^d.^d: ^[WIRED ENVIROMNENT^]", checker_data_$collection_names (Collection).major, checker_data_$collection_names (Collection).minor, Collection <= checker_data_$last_wired_collection); collection_started = "1"b; end; call checker_print_$skip; if control_word.type = COLLECTION_MARK then do; if expect_link | expect_defs then do; call checker_print_$error (CHECKER_SEVERE, (0), "tape format", " Collection ended without expected ^[definitions^;linkage^] segment.", expect_link); end; if control_word.count ^= 1 then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Collection mark not one word long."); call tape_reader_ (addr (collection_mark), (control_word.count)); if collection_mark.major ^= checker_data_$collection_names (Collection).major | collection_mark.minor ^= checker_data_$collection_names (Collection).minor then call checker_print_$error (CHECKER_WARNING, (0), "collection mark", "Collection ^d.^d ended with mark ^d.^d.", checker_data_$collection_names (Collection).major, checker_data_$collection_names (Collection).minor, collection_mark.major, collection_mark.minor); meters.per_collection (Collection).mark.major = collection_mark.major; meters.per_collection (Collection).mark.minor = collection_mark.minor; call checker_print_ ("Collection mark ^d.^d", collection_mark.major, collection_mark.minor); call ioa_ ("Read collection ^d.^d", collection_mark.major, collection_mark.minor); return; end; else if control_word.type ^= HEADER then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Segment ^a was not followed by a header record.", segment_name); /* Process header record */ if (control_word.count > HEADER_MAX_SIZE) | (control_word.count < 4) then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Header size ^d unreasonable.", control_word.count); /* So far, a well-formed tape */ /* Check in a segment */ call tape_reader_ (addr (header_area), (control_word.count)); cur_slte = addr (header_area) -> slte_uns; /* check for duplicated segment names */ segment_name = segnam.names (1).name; /* primary name */ if checker_data_$loaded (Collection) then do nx = 1 to segnam.count; call sslt_manager_$get_seg_num (segnam.names (nx).name, segment_number, code); if code = 0 then call checker_print_$error (CHECKER_SEVERE, error_table_$namedup, "segment_name", "Name ^a already on seg # ^o", segnam.names (nx).name, segment_number); end; /* Now get control word for seg itself */ call Read_Control_Word; if control_word.type ^= SEGMENT then call checker_print_$error (CHECKER_FATAL, (0), segment_name, "Segment header not followed by contents."); if ^checker_data_$loaded (Collection) /* object is specially handled */ then do; call PROCESS_SPECIAL_SLTE (addr (header_area)); call tape_reader_ (checker_data_$buffer_ptr, (control_word.count)); go to LOAD_LOOP; end; if ^cur_slte.defs & ^(cur_slte.link_sect & prev_slte.combine_link) then do; /* If a segment is to be created ... */ call sslt_manager_$build_entry (addr (header_area), hc_seg_ptr, (0)); segment_number = bin (baseno (hc_seg_ptr), 18); call PROCESS_SLTE (segment_number); /* classify and record */ /* and set cur_slte to be the version slt_manager_ cooked up */ end; /* now see what sort of beast */ if cur_slte.firmware_seg then do; call tape_reader_ (checker_data_$buffer_ptr, (control_word.count)); go to LOAD_LOOP; end; if cur_slte.link_sect /* somebodies linkage */ then do; if ^expect_link /* orphan linkage ? */ then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Unexpected linkage section ^a.", segment_name); expect_link = "0"b; expect_defs = "1"b; /* just as night follows day */ if prev_slte.combine_link /* this is to be combined */ then call ENTER_COMBINED_LINKAGE; else call ENTER_UNCOMBINED_LINKAGE; end; else if cur_slte.defs then do; if ^expect_defs then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Unexpected definitions seg ^a.", segment_name); call ENTER_DEFINITIONS; expect_defs = "0"b; end; else do; /* A text section, by george */ if expect_link | expect_defs then call checker_print_$error (CHECKER_FATAL, (0), "tape format", "Unexpected text section ^a.", segment_name); expect_link = cur_slte.link_provided; call ENTER_TEXT; text_segment_number = segment_number; end; prev_slte = cur_slte; go to LOAD_LOOP; %page; ENTER_TEXT: procedure; call tape_reader_ (checker_data_$buffer_ptr, (control_word.count)); /* skip it, at least */ if cur_slte.ringbrack (1) = 0 /* hardcore segments have no linkage, or linkage */ /* stripped off */ then return; /* For user ring segments, the linkage and defs are still in the segment */ if cur_slte.bit_count ^= (control_word.count * 36)/* match? */ then return; oi.version_number = object_info_version_2; call object_info_$brief (checker_data_$buffer_ptr, (cur_slte.bit_count), addr (oi), code); if code = 0 then do; call PROCESS_LINKAGE (segment_number, oi.linkp, (oi.llng)); call PROCESS_DEFS (segment_number, oi.defp, (oi.dlng)); end; end ENTER_TEXT; %page; ENTER_COMBINED_LINKAGE: procedure; /* See what linkage section is in question */ if /* tree */ prev_slte.link_sect_wired then if prev_slte.init_seg then do; /* WI linkage */ if Collection <= checker_data_$last_wired_collection then do; meters.wired_wi_linkage_used = meters.wired_wi_linkage_used + control_word.count; call CHECK (meters.wired_wi_linkage_size, meters.wired_wi_linkage_used, "1"b /*wired*/, "wi_linkage", meters.overflown.wired_wi_linkage); end; meters.paged_wi_linkage_used = meters.paged_wi_linkage_used + control_word.count; call CHECK (meters.paged_wi_linkage_size, meters.paged_wi_linkage_used, "0"b, "wi_linkage", meters.overflown.paged_wi_linkage); meters.per_collection (Collection).wi_linkage_used = meters.per_collection (Collection).wi_linkage_used + control_word.count; end; else do; /* WS linkage */ if Collection <= checker_data_$last_wired_collection then do; meters.wired_ws_linkage_used = meters.wired_ws_linkage_used + control_word.count; call CHECK (meters.wired_ws_linkage_size, meters.wired_ws_linkage_used, "1"b, "ws_linkage", meters.overflown.wired_ws_linkage); end; meters.paged_ws_linkage_used = meters.paged_ws_linkage_used + control_word.count; call CHECK (meters.paged_ws_linkage_size, meters.paged_ws_linkage_used, "0"b, "ws_linkage", meters.overflown.paged_ws_linkage); meters.per_collection (Collection).ws_linkage_used = meters.per_collection (Collection).ws_linkage_used + control_word.count; end; else if prev_slte.init_seg /* AI linkage */ then do; if Collection <= checker_data_$last_wired_collection then do; meters.wired_ai_linkage_used = meters.wired_ai_linkage_used + control_word.count; call CHECK (meters.wired_ai_linkage_size, meters.wired_ai_linkage_used, "1"b, "ai_linkage", meters.overflown.wired_ai_linkage); end; meters.paged_ai_linkage_used = meters.paged_ai_linkage_used + control_word.count; call CHECK (meters.paged_ai_linkage_size, meters.paged_ai_linkage_used, "0"b, "ai_linkage", meters.overflown.paged_ai_linkage); meters.per_collection (Collection).ai_linkage_used = meters.per_collection (Collection).ai_linkage_used + control_word.count; end; else do; /* AS linkage */ if Collection <= checker_data_$last_wired_collection then do; meters.wired_as_linkage_used = meters.wired_as_linkage_used + control_word.count; call CHECK (meters.wired_as_linkage_size, meters.wired_as_linkage_used, "1"b, "as_linkage", meters.overflown.wired_as_linkage); end; meters.paged_as_linkage_used = meters.paged_as_linkage_used + control_word.count; call CHECK (meters.paged_as_linkage_size, meters.paged_as_linkage_used, "1"b, "as_linkage", meters.overflown.paged_ai_linkage); meters.per_collection (Collection).as_linkage_used = meters.per_collection (Collection).as_linkage_used + control_word.count; end; ENTER_UNCOMBINED_LINKAGE: entry; call tape_reader_ (checker_data_$buffer_ptr, (control_word.count)); checker_data_$buffer_ptr -> linkage_header.segment_number = text_segment_number; call PROCESS_LINKAGE (text_segment_number, checker_data_$buffer_ptr, (control_word.count)); return; %page; CHECK: procedure (limit, amount, paged, name, printed); declare limit fixed bin; declare amount fixed bin; declare paged bit (1) aligned; declare name char (32); declare printed bit (1) unaligned; if limit < 0 then return; /* as yet unknown */ if amount < limit then return; /* clear */ if ^printed then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " ^[PAGED^;WIRED^] ^a OVERFLOW. Increase ^[max_length^;cur_length^] of ^a.", paged, name, paged, name) ; else printed = "1"b; end CHECK; end ENTER_COMBINED_LINKAGE; %page; ENTER_DEFINITIONS: procedure; if Collection <= checker_data_$last_wired_collection then meters.wired_definitions_used = meters.wired_definitions_used + control_word.count; meters.paged_definitions_used = meters.paged_definitions_used + control_word.count; meters.per_collection (Collection).definitions_used = meters.per_collection (Collection).definitions_used + control_word.count; if meters.wired_definitions_size > 0 then if Collection <= checker_data_$last_wired_collection then if meters.wired_definitions_used > meters.wired_definitions_size then do; if ^meters.overflown.wired_definitions then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " WIRED DEFINITIONS OVERFLOW. Increase cur_length for definitions_"); meters.overflown.wired_definitions = "1"b; end; else ; else if meters.paged_definitions_used > meters.paged_definitions_size then do; if ^meters.overflown.paged_definitions then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " PAGED DEFINITIONS OVERFLOW. Increase max_length of definitions_."); meters.overflown.paged_definitions = "1"b; end; call tape_reader_ (checker_data_$buffer_ptr, (control_word.count)); call PROCESS_DEFS (text_segment_number, checker_data_$buffer_ptr, (control_word.count)); end ENTER_DEFINITIONS; %page; PROCESS_LINKAGE: procedure (segment_number, link_ptr, links_length); declare segment_number fixed bin (18); declare link_ptr pointer; declare links_ptr pointer; declare links_length fixed bin (18) uns; declare links_count fixed bin; declare lx fixed bin; declare section_length fixed bin; section_length = min (links_length, link_ptr -> virgin_linkage_header.linkage_section_lng); if section_length ^> size (virgin_linkage_header) then return; links_count = divide (section_length, 2, 17, 0); /* 2 words each */ if links_count = 0 then return; /* and see if the count we have is good */ links_ptr = addrel (link_ptr, link_ptr -> linkage_header.begin_links); begin; declare 1 links (1:links_count) aligned like object_link based (links_ptr); do lx = 1 to links_count; if links (lx).tag ^= "46"b3 | links (lx).mbz ^= "0"b | links (lx).mbz2 ^= "0"b then do; links_count = lx - 1; goto COUNTED; end; end; COUNTED: end; a_n_links = links_count; allocate segment_links in (checker_area); unspec (segment_links.per_link) = ""b; begin; declare 1 links (1:links_count) aligned like object_link based (links_ptr); do lx = 1 to links_count; segment_links.expression_relps (lx) = links (lx).expression_relp; segment_links.modifiers (lx) = links (lx).modifier; end; end; meters.per_segment (segment_number).link_ptr = segment_links_ptr; end PROCESS_LINKAGE; %page; PROCESS_DEFS: procedure (segno, defs_ptr, defs_length); declare defs_ptr pointer; declare defs_length fixed bin (18) uns; declare dptr pointer; declare segno fixed bin (18); a_defs_length = defs_length; allocate segment_defs in (checker_area); dptr = addr (segment_defs.definitions); begin; declare to (defs_length) bit (36) aligned based (dptr); declare from (defs_length) bit (36) aligned based (defs_ptr); to = from; end; meters.per_segment (segno).defs_ptr = segment_defs_ptr; end PROCESS_DEFS; end LOAD_ONE_COLLECTION; %page; PROCESS_SLTE: procedure (p_segment_number); declare p_segment_number fixed bin (18); declare p_sltep ptr; declare segment_number fixed bin (18); declare this_sltep ptr; declare 1 this_slte aligned like slte_uns based (this_sltep); declare this_namep ptr; declare this_pathp ptr; declare this_aclp ptr; declare a_name char (32); declare next_name fixed bin; declare aclx fixed bin; declare (word_length, wired_length) fixed bin (19); declare paged_length fixed bin; segment_number = p_segment_number; this_sltep = addr (slt.seg (segment_number)); this_namep = ptr (checker_data_$name_table_ptr, this_slte.names_ptr); if this_sltep -> slte.branch_required then do; this_pathp = ptr (checker_data_$name_table_ptr, this_slte.path_ptr); this_aclp = addr (this_pathp -> path.acls); end; call REPORT_SEGMENT; /* meter this object */ meters.per_collection (Collection).segment_count = meters.per_collection (Collection).segment_count + 1; if Collection <= checker_data_$last_wired_collection then do; meters.wired_sdw_count = meters.wired_sdw_count + 1; meters.wired_slte_count = meters.wired_slte_count + 1; meters.wired_nt_used = meters.wired_nt_used + currentsize (this_namep -> segnam); if this_slte.branch_required then meters.wired_nt_used = meters.wired_nt_used + currentsize (this_pathp -> path); if this_slte.acl_provided then meters.wired_nt_used = meters.wired_nt_used + currentsize (this_aclp -> acls) - 1; /* overlaps path */ if meters.wired_nt_size > 0 then if meters.wired_nt_used > meters.wired_nt_size then do; if ^meters.overflown.wired_nt then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " WIRED NAME_TABLE OVERFLOW. Increase cur_length of name_table in template_slt_.cds" ); meters.overflown.wired_nt = "1"b; end; end; else do; meters.paged_sdw_count = meters.paged_sdw_count + 1; meters.paged_slte_count = meters.paged_slte_count + 1; meters.paged_nt_used = meters.paged_nt_used + currentsize (this_namep -> segnam); if this_slte.branch_required then meters.paged_nt_used = meters.paged_nt_used + currentsize (this_pathp -> path); if this_slte.acl_provided then meters.paged_nt_used = meters.paged_nt_used + currentsize (this_aclp -> acls) - 1; /* overlaps path */ if meters.paged_nt_size > 0 then if meters.paged_nt_used > meters.paged_nt_size then do; if ^meters.overflown.paged_nt then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " PAGED NAME_TABLE OVERFLOW. Increase max_length of name_table in template_slt_.cds" ); meters.overflown.paged_nt = "1"b; end; end; if Collection <= checker_data_$last_text_wired_collection then if ^this_slte.layout_seg /* not taken from free pool */ then meters.per_collection (Collection).words_used = meters.per_collection (Collection).words_used + wired_length; meters.per_collection (Collection).name_table_used = meters.per_collection (Collection).name_table_used + currentsize (this_namep -> segnam); if this_slte.branch_required then meters.per_collection (Collection).name_table_used = meters.per_collection (Collection).name_table_used + currentsize (this_pathp -> path); if this_slte.acl_provided then meters.name_table_used = meters.name_table_used + currentsize (this_aclp -> acls) - 1; if this_slte.paged then meters.per_collection (Collection).pages_used = meters.per_collection (Collection).pages_used + paged_length; if this_slte.wired & this_slte.paged then meters.per_collection (Collection).wired_pages_used = meters.per_collection (Collection).wired_pages_used + paged_length; if this_slte.temp_seg then meters.per_collection (Collection).temp_segment_count = meters.per_collection (Collection).temp_segment_count + 1; else if this_slte.init_seg then meters.per_collection (Collection).init_segment_count = meters.per_collection (Collection).init_segment_count + 1; else meters.per_collection (Collection).perm_segment_count = meters.per_collection (Collection).perm_segment_count + 1; if this_slte.ringbrack (1) > 0 then do; meters.per_collection (Collection).user_ring_segment_count = meters.per_collection (Collection).user_ring_segment_count + 1; meters.per_collection (Collection).user_ring_segment_pages = meters.per_collection (Collection).user_ring_segment_pages + paged_length; end; if meters.per_collection (Collection).first_segment = -1 then meters.per_collection (Collection).last_segment, meters.per_collection (Collection).first_segment = segment_number; else do; meters.per_segment (meters.per_collection (Collection).last_segment).next = segment_number; meters.per_collection (Collection).last_segment = segment_number; end; meters.per_segment (segment_number).collection = Collection; call INTERESTING_SEGMENT; return; %page; PROCESS_SPECIAL_SLTE: entry (p_sltep); this_sltep = p_sltep; this_namep = addrel (this_sltep, size (slte)); if this_sltep -> slte.branch_required then do; this_pathp = addrel (this_namep, currentsize (this_namep -> segnam)); this_aclp = addr (this_pathp -> path.acls); end; call REPORT_SEGMENT; /* meter this object */ meters.per_collection (Collection).segment_count = meters.per_collection (Collection).segment_count + 1; if Collection <= checker_data_$last_wired_collection then meters.per_collection (Collection).words_used = meters.per_collection (Collection).words_used + wired_length; if this_slte.paged then meters.per_collection (Collection).pages_used = meters.per_collection (Collection).pages_used + paged_length; if this_slte.wired & this_slte.paged then meters.per_collection (Collection).wired_pages_used = meters.per_collection (Collection).wired_pages_used + paged_length; if Collection <= checker_data_$last_supervisor_collection then meters.per_collection (Collection).temp_segment_count = meters.per_collection (Collection).temp_segment_count + 1; else meters.per_collection (Collection).perm_segment_count = meters.per_collection (Collection).perm_segment_count + 1; if this_slte.ringbrack (1) > 0 then do; meters.per_collection (Collection).user_ring_segment_count = meters.per_collection (Collection).user_ring_segment_count + 1; meters.per_collection (Collection).user_ring_segment_pages = meters.per_collection (Collection).user_ring_segment_pages + paged_length; end; return; %page; INTERESTING_SEGMENT: procedure; /* See if this segment is one whose size is a limiter */ /* use the global "segment_name" for comparisons */ if segment_name = "ai_linkage" then call SIZES (meters.wired_ai_linkage_size, meters.paged_ai_linkage_size); else if segment_name = "as_linkage" then call SIZES (meters.wired_as_linkage_size, meters.paged_as_linkage_size); else if segment_name = "wi_linkage" then call SIZES (meters.wired_wi_linkage_size, meters.paged_wi_linkage_size); else if segment_name = "ws_linkage" then call SIZES (meters.wired_ws_linkage_size, meters.paged_ws_linkage_size); else if segment_name = "definitions_" then call SIZES (meters.wired_definitions_size, meters.paged_definitions_size); else if segment_name = "name_table" then call SIZES (meters.wired_nt_size, meters.paged_nt_size); else if segment_name = "dseg" then do; meters.wired_sdw_count = divide (wired_length, 2, 18, 0); meters.paged_sdw_count = 2048; /* not available from header */ end; else if segment_name = "slt" then do; meters.wired_slte_count = divide (wired_length - 8, 4, 19, 0); /* header is 4 words slte is 8 words */ meters.paged_slte_count = divide ((paged_length * 1024) - 8, 4, 19, 0); end; return; SIZES: procedure (wired_to_set, paged_to_set); declare (wired_to_set, paged_to_set) fixed bin; wired_to_set = wired_length; paged_to_set = paged_length * 1024; end SIZES; end INTERESTING_SEGMENT; SEG_PAGED: procedure returns (bit (1) aligned); /* Should we report paged length? */ return (this_slte.ringbrack (1) > 0 /* all user ring segments */ | Collection > checker_data_$last_wired_collection /* loaded paged */ | (Collection ^> checker_data_$last_wired_collection & /* else */ (this_slte.paged & ^this_slte.temp_seg)) /* must stay around */); end SEG_PAGED; %page; REPORT_SEGMENT: procedure; segment_name = this_namep -> segnam.names (1).name; call checker_print_ ( "^32a^2x^[^3o^;^3x^s^]^2x(^1d, ^1d, ^1d)^50t^[read ^]^[execute ^]^[write ^]^[privileged ^]^[encacheable ^]^[gate ^]^[wired^]", segment_name, checker_data_$loaded (Collection), segment_number, slte_uns.ringbrack, substr (this_slte.access, 1, 1), substr (this_slte.access, 2, 1), substr (this_slte.access, 3, 1), substr (this_slte.access, 4, 1), this_slte.cache, this_slte.ringbrack (3) > this_slte.ringbrack (2), this_slte.wired | this_slte.firmware_seg); /* firmware segs are wired */ /* use the namep from the header */ if this_namep -> segnam.count > 1 then a_name = this_namep -> segnam.names (2).name; else a_name = ""; if ^this_slte.init_seg & ^this_slte.temp_seg & ^this_slte.per_process & ^this_slte.firmware_seg then next_name = 2; else do; call checker_print_ ("^5x^32a^50t^[init seg; ^]^[temp seg; ^]^[per process; ^]^[firmware^]", a_name, this_slte.init_seg, this_slte.temp_seg, this_slte.per_process, this_slte.firmware_seg); next_name = 3; end; word_length = divide (this_slte.bit_count, 36, 24, 0); wired_length = divide (word_length + 1023, 1024, 18, 0) * 1024; paged_length = max (this_slte.cur_length, this_slte.max_length); if this_namep -> segnam.count >= next_name then do; a_name = this_namep -> segnam.names (next_name).name; next_name = next_name + 1; end; else a_name = ""; if this_slte.abs_seg then call checker_print_ ("^5x^32a^50tabs seg -- no storage allocated.", a_name); else call checker_print_ ( "^5x^32a^50t^[wired length: ^d words;^;^s^] ^[paged length: ^d pages;^;^s^] ^[max length: ^d pages;^;^s^]", a_name, Collection ^> checker_data_$last_wired_collection, wired_length, SEG_PAGED (), paged_length, this_slte.branch_required & (this_slte.max_length ^= paged_length & this_slte.max_length ^= 0), this_slte.max_length); if this_slte.branch_required then do; if this_namep -> segnam.count >= next_name then do; a_name = this_namep -> segnam.names (next_name).name; next_name = next_name + 1; end; else a_name = ""; call checker_print_ ("^5x^32a^50tpath: ^a>^a", a_name, this_pathp -> path.name, segment_name); end; if next_name ^> this_namep -> segnam.count then begin; declare namex fixed bin; do namex = next_name to this_namep -> segnam.count by 4; if namex + 3 > this_namep -> segnam.count then do; go to RESIDUE (this_namep -> segnam.count - namex + 1); RESIDUE (1): call checker_print_ ("^5x^32a", this_namep -> segnam.names (namex).name); go to EXIT_NAMES; RESIDUE (2): call checker_print_ ("^5x^32a^x^32a", this_namep -> segnam.names (namex).name, this_namep -> segnam.names (namex + 1).name); go to EXIT_NAMES; RESIDUE (3): call checker_print_ ("^5x^32a^x^32a^x^32a", this_namep -> segnam.names (namex).name, this_namep -> segnam.names (namex + 1).name, this_namep -> segnam.names (namex + 2).name); EXIT_NAMES: end; else call checker_print_ ("^5x^32a^x^32a^x^32a^x^32a", this_namep -> segnam.names (namex).name, this_namep -> segnam.names (namex + 1).name, this_namep -> segnam.names (namex + 2).name, this_namep -> segnam.names (namex + 3).name); end; end; if this_slte.acl_provided then do; do aclx = 1 to this_aclp -> acls.count; call checker_print_ ("^5x^[null^]^[r^]^[e^]^[w^]^10t^32a", substr (this_aclp -> acls.mode (aclx), 1, 3) = "000"b, substr (this_aclp -> acls.mode (aclx), 1, 1), substr (this_aclp -> acls.mode (aclx), 2, 1), substr (this_aclp -> acls.mode (aclx), 3, 1), this_aclp -> acls.userid (aclx)); end; end; /* Now check for mistakes */ if this_slte.temp_seg & ^this_slte.init_seg then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Temp seg but not init seg, will not be deleted."); if ^substr (this_slte.access, 1, 1) & ^this_slte.abs_seg then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " No read access in SDW"); if this_slte.branch_required & ^this_slte.paged then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Only paged segments may have branches."); if this_slte.branch_required & this_slte.init_seg then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Init segs may not have branches."); if this_slte.paged & (this_slte.max_length ^= 0) & (this_slte.max_length < this_slte.cur_length) then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Max length < Cur length."); if this_slte.paged & (this_slte.cur_length * 1024) < word_length then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Cur length < Bit count."); if this_slte.ringbrack (1) > this_slte.ringbrack (2) | this_slte.ringbrack (1) > this_slte.ringbrack (3) | this_slte.ringbrack (2) > this_slte.ringbrack (3) then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Illegal ring bracket order."); if (this_slte.ringbrack (1) > 0 | this_slte.ringbrack (2) > 0 | this_slte.ringbrack (3) > 0) & ^this_slte.branch_required then call checker_print_ (CHECKER_SEVERE, (0), segment_name, " Gate has no branch."); if this_slte.branch_required then do; if this_pathp -> path.size = 0 then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Zero length branch pathname."); if char (this_pathp -> path.name, 1) ^= ">" then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Pathname must begin with > ."); call absolute_pathname_ (this_pathp -> path.name, (""), code); if code ^= 0 then call checker_print_$error (CHECKER_SEVERE, code, segment_name, " Bad pathname: ^a.", this_pathp -> path.name); end; if this_slte.acl_provided then do aclx = 1 to this_aclp -> acls.count; first = before (this_aclp -> acls.userid (aclx), "."); second = before (after (this_aclp -> acl.userid (aclx), "."), "."); third = after (after (this_aclp -> acls.userid (aclx), "."), "."); if first = "" | second = "" | third = "" | index (third, ".") > 0 then call checker_print_$error (CHECKER_SEVERE, (0), segment_name, " Invalid Access Name Format in ^a.", this_aclp -> acls.userid (aclx)); end; return; end REPORT_SEGMENT; end PROCESS_SLTE; %page; Read_Control_Word: proc; call tape_reader_ (addr (control_word), 1); end Read_Control_Word; %page; COLLECTION_SUMMARY: procedure; declare 1 PC aligned like meters.per_collection defined (meters.per_collection (Collection)); call checker_print_$page; call checker_print_ ("Summary of Collection: ^d.^d", PC.mark.major, PC.mark.minor); call checker_print_$skip; call checker_print_ ("Segments read:^32t^d; ^d temp, ^d init, ^d perm(^d user ring)", PC.segment_count, PC.temp_segment_count, PC.init_segment_count, PC.perm_segment_count, PC.user_ring_segment_count); if Collection <= checker_data_$last_wired_collection then call checker_print_ ("Wired storage:^32t^d words.", PC.words_used); call checker_print_ ("Paged storage:^32t^d pages.", PC.pages_used); call checker_print_ ("Wired paged storage:^32t^d pages.", PC.wired_pages_used); if PC.user_ring_segment_count > 0 then call checker_print_ ("User ring pages:^32t^d pages.", PC.user_ring_segment_pages); call checker_print_$skip; if Collection <= checker_data_$last_supervisor_collection & checker_data_$loaded (Collection) then do; call checker_print_ ("Combined linkage usage: Active Wired (in words)"); call checker_print_ ("-----------------------|------|------"); call checker_print_ (" init: ^6d^x^6d", PC.ai_linkage_used, PC.wi_linkage_used); call checker_print_ (" sup: ^6d^x^6d", PC.as_linkage_used, PC.ws_linkage_used); call checker_print_$skip; call checker_print_ ("Definitions Used: ^5d words.", PC.definitions_used); call checker_print_ ("Name Table Used: ^5d words.", PC.name_table_used); end; end COLLECTION_SUMMARY; %page; TOTAL_SUMMARY: procedure; call checker_print_$page; call checker_print_ ("Total Summary:"); call checker_print_$skip; call checker_print_ ("total segments: ^d.", sum (meters.per_collection.segment_count)); call checker_print_ (" temp: ^d.", sum (meters.per_collection.temp_segment_count)); call checker_print_ (" init: ^d.", sum (meters.per_collection.init_segment_count)); call checker_print_ (" perm: ^d.", sum (meters.per_collection.perm_segment_count)); call checker_print_ (" user ring: ^d.", sum (meters.per_collection.user_ring_segment_count)); call checker_print_ ("Wired Environment Usage"); call checker_print_ (" Name Size Used"); call USAGE ("ai_linkage", meters.wired_ai_linkage_size, meters.wired_ai_linkage_used, meters.overflown.wired_ai_linkage); call USAGE ("wi_linkage", meters.wired_wi_linkage_size, meters.wired_wi_linkage_used, meters.overflown.wired_wi_linkage); call USAGE ("as_linkage", meters.wired_as_linkage_size, meters.wired_as_linkage_used, meters.overflown.wired_as_linkage); call USAGE ("ws_linkage", meters.wired_ws_linkage_size, meters.wired_ws_linkage_used, meters.overflown.wired_ws_linkage); call USAGE ("definitions", meters.wired_definitions_size, meters.wired_definitions_used, meters.overflown.wired_definitions); call USAGE ("name table", meters.wired_nt_size, meters.wired_nt_used, meters.overflown.wired_nt); call checker_print_$skip; call checker_print_ ("Paged Environment Usage"); call checker_print_ (" Name Size Used"); call USAGE ("ai_linkage", meters.paged_ai_linkage_size, meters.paged_ai_linkage_used, meters.overflown.paged_ai_linkage); call USAGE ("wi_linkage", meters.paged_wi_linkage_size, meters.paged_wi_linkage_used, meters.overflown.paged_wi_linkage); call USAGE ("as_linkage", meters.paged_as_linkage_size, meters.paged_as_linkage_used, meters.overflown.paged_as_linkage); call USAGE ("ws_linkage", meters.paged_ws_linkage_size, meters.paged_ws_linkage_used, meters.overflown.paged_ws_linkage); call USAGE ("definitions", meters.paged_definitions_size, meters.paged_definitions_used, meters.overflown.paged_definitions); call USAGE ("name table", meters.paged_nt_size, meters.paged_nt_used, meters.overflown.paged_nt); return; USAGE: procedure (name, size, used, overflown); declare name char (*); declare size fixed bin; declare used fixed bin; declare overflown bit (1) unaligned; call checker_print_ ("^[*****^;^5x^]^20a^x^6d^36t^6d^43t^[OVERFLOWN^]", overflown, name, size, used, overflown); end USAGE; end TOTAL_SUMMARY; %page; CHECK_BOOTABLE_LABEL: procedure; declare 1 BPI aligned like boot_program_info; declare tape_reader_$rewind entry (char (32), fixed bin (21)); call tape_reader_$rewind (BPI.boot_program_name, BPI.boot_program_text_length); if BPI.boot_program_name = "" then do; call checker_print_ ("No bootable label on MST."); return; /* No boot program */ end; call checker_print_ ("Boot program: ^a, ^d words.", BPI.boot_program_name, BPI.boot_program_text_length); call checker_print_$skip; end CHECK_BOOTABLE_LABEL; end checker_load_MST_;  checker_print_.pl1 06/04/84 1601.8rew 06/04/84 1242.1 36522 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* CHECKER_PRINT_ - Output Routine for the MST Checker. Initial coding - T. Skinner, June 10, 1969 Revised by N. I. Morris, October 1, 1969 iox'ed November 2, 1976 by N. I. Morris */ /* Modified BIM 8/82 new checker */ checker_print_: procedure options (variable); %include checker_dcls_; %page; dcl iox_$error_output ptr ext static; dcl check_mst_severity_ fixed bin external; dcl checker_data_$time_string char (24) static; dcl com_err_ entry () options (variable); dcl ioa_ entry options (variable); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); dcl ioa_$rsnnl entry() options (variable); dcl ioa_$ioa_switch entry () options (variable); dcl cu_$arg_list_ptr entry returns (pointer); dcl date_time_ entry (fixed bin (71), char (*)); dcl error_table_$fatal_error fixed bin(35) ext static; dcl (cs, ff) fixed bin; dcl (output_buffer, file_message) char (136); dcl message char (100) aligned; dcl segname char (32); dcl prefix char (24); dcl severity fixed bin; dcl based_fb fixed bin based; dcl based_fb_35 fixed bin (35) based; dcl ap pointer; dcl al fixed bin (21); dcl argument char (al) based (ap); dcl code fixed bin (35); dcl error_switch bit (1) aligned; dcl term_switch bit (1) aligned; dcl (clock, max, rtrim) builtin; dcl checker_fatal_error_ condition; error_switch = "0"b; cs = 1; /* control arg */ ff = 2; /* first substitute arg */ go to COMMON; error: entry options (variable); /* call checker_print_$error (SEVERITY, CODE, segname, cs, arg1 ... argn); */ term_switch = "0"b; go to ERROR_COMMON; error_term: entry options (variable); term_switch = "1"b; /* Print only on terminal */ ERROR_COMMON: error_switch = "1"b; cs = 4; ff = 5; call cu_$arg_ptr (1, ap, (0), (0)); severity = ap -> based_fb; call cu_$arg_ptr (2, ap, (0), (0)); code = ap -> based_fb_35; call cu_$arg_ptr (3, ap, al, (0)); segname = argument; COMMON: output_buffer = ""; call ioa_$general_rs (cu_$arg_list_ptr (), cs, ff, output_buffer, (0), "1"b, "0"b); if ^error_switch then do; if output_buffer ^= "" then call ioa_$ioa_switch (checker_data_$output_iocbp, "^a", output_buffer); return; end; prefix = ERROR_NAMES (severity); message = ""; if code ^= 0 then call convert_status_code_ (code, (8)" ", message); if ^term_switch then call ioa_$ioa_switch (checker_data_$output_iocbp, "***** ^a: ^a ^a", prefix, message, output_buffer); check_mst_severity_ = max (check_mst_severity_, severity); if severity <= checker_data_$severity then return; /* No print on terminal */ call ioa_$ioa_switch (iox_$error_output, ""); call ioa_$ioa_switch (iox_$error_output, "^a ^a: ^a ^a", prefix, segname, message, output_buffer); return; page: entry; call ioa_$ioa_switch (checker_data_$output_iocbp, "^|"); return; skip: entry; call ioa_$ioa_switch (checker_data_$output_iocbp, ""); return; init: entry; check_mst_severity_ = 0; return; final: entry; if check_mst_severity_ > 2 then call com_err_ (error_table_$fatal_error, "check_mst", "Errors of severity 3 encountered."); return; end checker_print_;  compare_mst.pl1 07/16/87 1350.1r 07/15/87 1716.0 449658 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ compare_mst: proc; /* format: off */ /* This command mounts two mst tapes (the names of which are given as arguments) and compares them, printing out all significant changes. Written 9/20/74 by C. D. Tavares. Rewritten by Kobziar 3/75 to handle additions, deletions, and moves. Also allows saving of segment contents if they are different, and header copmparisons corrected to ignore acl pad field. Can compare any number of collections, ie. service or bos tapes. Modified 11/05/80, W. Olin Sibert, to add -file control argument. Modified 06/08/84, Keith Loepere, to work when an object appears on a tape more than once. */ /****^ HISTORY COMMENTS: 1) change(87-01-12,GDixon), approve(87-04-16,MCR7614), audit(87-05-21,Farley), install(87-07-15,MR12.1-1040): Add support for comparing MST data coming from either tape or disk files, via -master_file and -copy_file control args. Add a severity variable to allow testing of success/fail of the compare operation. Modernize code somewhat (it needs more work, at some point in future, however). END HISTORY COMMENTS */ %page; dcl REWP char (64) static aligned options(constant) initial ("NULL P W WP E E P EW EWPR R PR W R WPRE RE PERW REWP"); dcl OFF_ON char (8) static aligned options(constant) initial ("OFF ON "); dcl (UNSET init(0), MASTER init(1), COPY init(2)) fixed bin int static options(constant); dcl abs_changes fixed bin int static options(constant) init (45); dcl mst_name (2) char (19) varying int static options(constant) initial ("compare_mst.master.", "compare_mst.copy."); dcl rew char (24) static aligned options(constant) initial ("n w e ewr r wre rew"); dcl arg char(argl) based(argp), opt char(optl) based(optp); dcl bits (bit_len) bit (1) unaligned based (bits_ptr); /* for index comparisons */ dcl 1 bootstrap_header aligned based, /* special format for bound_bootload_0 header */ 2 header_control_word like mst1.header_control_word aligned, 2 slte like slte aligned, 2 minus_ones (18) fixed bin (35), /* bad filler */ 2 segment_control_word like mst1.segment_control_word aligned; dcl 1 collection_mark_data based, 2 pad bit (36), /* header word */ 2 major fixed bin (18) uns unal, 2 minor fixed bin (18) uns unal; dcl header_words (bit_len) based fixed bin; /* entire header */ dcl 1 mst1 aligned based (mst_ptr (1)), /* Format of an MST segment header */ 2 header aligned, 3 header_control_word aligned, 4 collection_mark bit (18) unaligned, /* if non-zero, this is a 2-word collection mark only */ 4 header_length fixed bin (17) unaligned, /* length of REST of header, not counting first 2 wds */ 3 slte like slte aligned, /* first word of slte is a dummy, rest used */ 3 names_array aligned, /* this is always there, except for bound_bootload_0 */ 4 n_names fixed bin aligned, /* number of names */ 4 name_element (n_names (1)) aligned, 5 n_chars fixed bin aligned, /* number of chars in each name */ 5 name char (32) aligned, /* the name */ 3 pathname_array (has_branch (1)) aligned, /* This may or may not be there, hence the zero subscripting */ 4 pathname_length fixed bin aligned,/* pathname is exactly this long, plus spaces to fill */ 4 pathname char (path_length (1)) aligned, /* out to end of a word */ 3 acl_structure (has_acl (1)) aligned, /* This also may or may not be there */ 4 n_acls fixed bin, /* number of acl entries */ 4 acl (n_acls (1)) aligned, /* Each acl */ 5 accessname char (32) aligned, 5 mode bit (3) aligned, /* r, e, w */ 5 pad (2) fixed bin, 3 segment_control_word aligned, /* This tells about the segment following */ 4 ident fixed bin (17) unaligned, /* This is always a one */ 4 segment_length fixed bin (17) unaligned; /* in words, of seg following */ dcl 1 mst2 based (mst_ptr (2)) aligned, /* same thing as mst1; look up there. */ 2 header aligned, 3 header_control_word aligned, 4 collection_mark bit (18) unaligned, 4 header_length fixed bin (17) unaligned, 3 slte like slte aligned, 3 names_array aligned, 4 n_names fixed bin aligned, 4 name_element (n_names (2)) aligned, 5 n_chars fixed bin aligned, 5 name char (32) aligned, 3 pathname_array (has_branch (2)) aligned, 4 pathname_length fixed bin aligned, 4 pathname char (path_length (2)) aligned, 3 acl_structure (has_acl (2)) aligned, 4 n_acls fixed bin, 4 acl (n_acls (2)) aligned, 5 accessname char (32) aligned, 5 mode bit (3) aligned, 5 pad (2) fixed bin, 3 segment_control_word aligned, 4 ident fixed bin (17) unaligned, 4 segment_length fixed bin (17) unaligned; dcl segment_1 (seg_length (1)) based fixed bin; dcl segment_2 (seg_length (2)) based fixed bin; dcl sys_id_pickup char (8) aligned based; dcl 1 tp_name based aligned, 2 order_info, /* info that we maintain relative to an object's order on the tape. */ 3 name char (32), /* primary name of seg */ 3 org_index fixed bin, /* value of org sequence in list before sort */ 3 major_collection fixed bin, /* segment contained within */ 3 minor_collection fixed bin, 3 sw unaligned, /* status of this seg */ 4 col bit (1), /* indicates a collection mark */ 4 add bit (1), 4 del bit (1), 4 mov bit (1), 2 info_ptr ptr, /* pts to seg body if saving or moved */ 2 head_ptr ptr, /* pts to header if seg has been moved */ 2 move_index fixed bin, /* points to second list's correspondin g seg */ 2 pos_n fixed bin; /* points to place in list where orjg name now is stored */ dcl 1 tp1_names (name_count (1)) based (np (1)) aligned like tp_name; dcl 1 tp2_names (name_count (2)) based (np (2)) aligned like tp_name; dcl argl fixed bin(21); dcl anp (2) ptr; dcl argp pointer; dcl arg_count fixed bin; dcl argx fixed bin; dcl atd char(256); dcl bit_len fixed bin; dcl bits_ptr pointer; dcl boot_label (2) bit(1) aligned; dcl boot_ptr (2) ptr; dcl bootstrap_sw (2) bit (1) aligned; dcl 1 bpi (2) aligned like boot_program_info; dcl code fixed bin (35); dcl collection bit (1) aligned; dcl copy_ptr ptr; dcl has_acl dimension (2) fixed bin; dcl has_branch dimension (2) fixed bin; dcl have_sysid bit (1) aligned; dcl i fixed bin; dcl in_den (2) fixed bin; dcl in_file_name (2) char(168); dcl in_tape_name (2) char(32); dcl iocb_ptr (2) ptr; dcl j fixed bin; dcl k fixed bin; dcl l1_index fixed bin; dcl l2_index fixed bin; dcl master_copy fixed bin; dcl mst_ptr (2) pointer; dcl mst_ptr_hold (2) ptr; dcl n_acls dimension (2) fixed bin; dcl n_names dimension (2) fixed bin; dcl name_count (2) fixed bin; dcl name_len fixed bin(18) uns unal; dcl nelemt fixed bin (21); dcl np (2) ptr; dcl optl fixed bin(21); dcl optp ptr; dcl path_length dimension (2) fixed bin; dcl saving bit (1); dcl sci_ptr ptr; dcl seg_len fixed bin(18) uns unal; dcl seg_length (2) fixed bin; dcl segment_name char (32); dcl set fixed bin; dcl skip_1 bit (1) aligned; dcl sys_id (2) char (8) aligned; dcl absolute_pathname_ entry (char(*), char(*), fixed bin(35)); dcl com_err_ entry options (variable); dcl cu_$arg_list_ptr entry returns(ptr); dcl get_shortest_path_ entry (char(*)) returns(char(168)); dcl get_wdir_ entry returns (char (168)); dcl initiate_file_$create entry (char(*), char(*), bit(*), ptr, bit(1) aligned, fixed bin(24), fixed bin(35)); dcl ioa_ entry options (variable); dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)); dcl iox_$close entry (ptr, fixed bin (35)); dcl iox_$control entry (ptr, char(*), ptr, fixed bin(35)); dcl iox_$detach_iocb entry (ptr, fixed bin (35)); dcl iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); dcl parse_tape_reel_name_ entry (char(*), char(*)); dcl ssu_$abort_subsystem entry() options(variable); dcl ssu_$arg_count entry (ptr, fixed bin); dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21)); dcl ssu_$destroy_invocation entry (ptr); dcl ssu_$get_temp_segment entry (ptr, char(*), ptr); dcl ssu_$standalone_invocation entry (ptr, char(*), char(*), ptr, entry, fixed bin(35)); dcl terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)); dcl unique_chars_ entry (bit(*)) returns(char(15)); dcl compare_mst_severity_ fixed bin ext static init(0); dcl (error_table_$bad_arg, error_table_$badopt, error_table_$end_of_info, error_table_$inconsistent, error_table_$noarg) fixed bin (35) external static; dcl (abs, addr, binary, char, convert, divide, index, length, ltrim, max, null, ptr, reverse, rtrim, size, string, substr) builtin; dcl cleanup condition; %page; compare_mst_severity_ = 4; bits_ptr = null (); boot_ptr = null (); iocb_ptr = null (); mst_ptr_hold = null (); np = null (); sci_ptr = null(); on cleanup call clean_up; call ssu_$standalone_invocation (sci_ptr, "compare_mst", "1.0", cu_$arg_list_ptr(), exit_proc, code); if code ^= 0 then call com_err_ ("compare_mst", code, "Creating standalone ssu_ subsystem."); bootstrap_sw = "0"b; /* set for first pass */ have_sysid = "0"b; saving = "0"b; call ssu_$arg_count (sci_ptr, arg_count); in_file_name, in_tape_name = ""; in_den = UNSET; master_copy = UNSET; do argx = 1 to arg_count; call ssu_$arg_ptr (sci_ptr, argx, argp, argl); if index (arg, "-") = 1 then do; if arg = "-save" then saving = "1"b; else if arg = "-master_volume" | arg = "-mvol" then do; master_copy = MASTER; SETTAPE: in_tape_name(master_copy), in_file_name(master_copy) = ""; if argx = arg_count then call ssu_$abort_subsystem (sci_ptr, error_table_$noarg, "^a must be followed by a tape volume name.", arg); else do; argx = argx + 1; call ssu_$arg_ptr (sci_ptr, argx, optp, optl); in_tape_name(master_copy) = opt; end; end; else if arg = "-master_file" | arg = "-mf" then do; master_copy = MASTER; SETFILE: in_tape_name(master_copy), in_file_name(master_copy) = ""; if argx = arg_count then call ssu_$abort_subsystem (sci_ptr, error_table_$noarg, "^a must be followed by a file name.", arg); else do; argx = argx + 1; call ssu_$arg_ptr (sci_ptr, argx, optp, optl); in_file_name(master_copy) = opt; end; master_copy = UNSET; end; else if (arg = "-copy_volume" | arg = "-cvol") then do; master_copy = COPY; go to SETTAPE; end; else if (arg = "-copy_file" | arg = "-cf") then do; master_copy = COPY; go to SETFILE; end; else if arg = "-density" | arg = "-den" then do; if argx = arg_count then call ssu_$abort_subsystem (sci_ptr, error_table_$noarg, "^a must be followed by a tape density.", arg); else do; argx = argx + 1; call ssu_$arg_ptr (sci_ptr, argx, optp, optl); if opt = "800" | opt = "1600" | opt = "6250" then do; if master_copy = UNSET then call ssu_$abort_subsystem (sci_ptr, error_table_$inconsistent, "^a ^a must follow either -mvol or -cvol.", arg, opt); else in_den(master_copy) = convert(in_den(1), opt); end; else call ssu_$abort_subsystem (sci_ptr, error_table_$bad_arg, "^a ^a^/Allowed densities are: 800, 1600, 6250.", arg, opt); end; end; else call ssu_$abort_subsystem (sci_ptr, error_table_$badopt, arg); end; else if in_tape_name(MASTER) = "" & in_file_name(MASTER) = "" then in_tape_name(MASTER) = arg; else if in_tape_name(COPY) = "" & in_file_name(COPY) = "" then in_tape_name(COPY) = arg; else call ssu_$abort_subsystem (sci_ptr, error_table_$bad_arg, arg); end; do i = MASTER to COPY; if in_tape_name(i) = "" & in_file_name(i) = "" then call ssu_$abort_subsystem (sci_ptr, error_table_$noarg, "^/A ^[master^;copy^] tape or file must be specified via -^[m^;c^]vol or -^[m^;c^]f.", i, i, i); end; do i = MASTER to COPY; call ssu_$get_temp_segment (sci_ptr, "boot pgm", boot_ptr(i)); call ssu_$get_temp_segment (sci_ptr, "buffer", mst_ptr_hold(i)); call ssu_$get_temp_segment (sci_ptr, "tape names", np(i)); call get_in_medium (i); end; mst_ptr = mst_ptr_hold; call ssu_$get_temp_segment (sci_ptr, "bit seg", bits_ptr); compare_mst_severity_ = 0; %page; call ioa_ ("^/Begin comparison."); if boot_label(MASTER) ^= boot_label(COPY) then do; call ioa_ ( "^/^[Master^;Copy^] MST has a bootload label program, while ^[Master^;Copy^] MST does not.", boot_label(MASTER), boot_label(COPY)); compare_mst_severity_ = max(compare_mst_severity_, 3); end; else if boot_label(MASTER) then do; if bpi(MASTER).boot_program_name ^= bpi(COPY).boot_program_name then do; call ioa_ ("Boot program names disagree. Master: ^a Copy: ^a", bpi(MASTER).boot_program_name, bpi(COPY).boot_program_name); compare_mst_severity_ = max(compare_mst_severity_, 3); end; else if bpi(MASTER).boot_program_text_length ^= bpi(COPY).boot_program_text_length then do; call ioa_ ("Boot program lengths disagree. Master: ^d Copy: ^d", bpi(MASTER).boot_program_text_length, bpi(COPY).boot_program_text_length); compare_mst_severity_ = max(compare_mst_severity_, 3); end; else do; seg_length(MASTER) = bpi(MASTER).boot_program_text_length; seg_length(COPY) = bpi(COPY).boot_program_text_length; mst_ptr = bpi.boot_program_ptr; segment_name = "bootload label program"; call check_segments(); mst_ptr = mst_ptr_hold; end; end; %page; call read_tape (MASTER); /* rewind first tape */ call rewind_in_medium (MASTER); call read_tape (COPY); if have_sysid then call ioa_ ("System ^a to ^a", sys_id (MASTER), sys_id (COPY)); /* rewind tape COPY */ call rewind_in_medium (COPY); call sort_names (MASTER); call sort_names (COPY); call list_comp; /* get add,del,and mov bits set up */ bootstrap_sw = "0"b; /* reset for second pass */ l1_index, l2_index = 1; skip_1 = "0"b; %page; /* now do the dirty work */ do while ((l1_index ^> name_count (MASTER)) & (l2_index ^> name_count (COPY))); j = tp2_names (l2_index).pos_n; /* use tape order to process names */ if skip_1 then do; skip_1 = "0"b; goto try_2; end; i = tp1_names (l1_index).pos_n; call read_header (MASTER, collection); if collection then if ^tp1_names (i).sw.col then do; out_of_sync: compare_mst_severity_ = max(compare_mst_severity_, 3); call ssu_$abort_subsystem (sci_ptr, 0, "tape out of sync."); end; else do; if tp1_names (i).sw.del then do; call ioa_ ("^a mark deleted.", tp1_names (i).name); compare_mst_severity_ = max(compare_mst_severity_, 3); end; l1_index = l1_index + 1; goto loop_cont; end; else if segment_name ^= tp1_names (i).name then goto out_of_sync; if tp1_names (i).sw.del then do; call ioa_ ("^a deleted", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); call skip_block (MASTER); l1_index = l1_index + 1; goto loop_cont; end; /* if moved, has first been read in already ? */ if tp1_names (i).sw.mov then if tp1_names (i).move_index ^= 0 then do; /* top segment already in */ set = tp1_names (i).move_index; /* pick up other list offset */ mst_ptr (COPY) = tp2_names (set).head_ptr; call header_setup_2; call check_headers; call read_segment (MASTER); mst_ptr (COPY) = tp2_names (set).info_ptr; call check_segments; mst_ptr (COPY) = mst_ptr_hold (COPY); l1_index = l1_index + 1; goto loop_cont; end; else do; /* save the header and body */ call ioa_ ("^a moved down.", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); call ssu_$get_temp_segment (sci_ptr, "header", tp1_names(i).head_ptr); bit_len = mst1.header_length + 2; tp1_names (i).head_ptr -> header_words = mst_ptr (MASTER) -> header_words; call ssu_$get_temp_segment (sci_ptr, "info", tp1_names(i).info_ptr); mst_ptr (MASTER) = tp1_names (i).info_ptr; call read_segment (MASTER); mst_ptr (MASTER) = mst_ptr_hold (MASTER); l1_index = l1_index + 1; goto loop_cont; end; try_2: call read_header (COPY, collection); if collection then if ^tp2_names (j).sw.col then goto out_of_sync; else do; if tp2_names (j).sw.add then do; call ioa_ ("^a mark added.", tp2_names (j).name); compare_mst_severity_ = max(compare_mst_severity_, 3); end; l2_index = l2_index + 1; skip_1 = "1"b; goto loop_cont; end; else if segment_name ^= tp2_names (j).name then goto out_of_sync; if tp2_names (j).sw.add then do; call ioa_ ("^a added.", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); if saving then do; call initiate_file_$create (get_wdir_(), "tp2." || segment_name, RW_ACCESS, tp2_names (j).info_ptr, "0"b, 0, code); if tp2_names (j).info_ptr = null then goto make_x; mst_ptr (COPY) = tp2_names (j).info_ptr; call read_segment (COPY); mst_ptr (COPY) = mst_ptr_hold (COPY); call terminate_file_ (tp2_names(j).info_ptr, seg_length(COPY) * BITS_PER_WORD, TERM_FILE_TRUNC_BC_TERM, code); end; else call skip_block (COPY); l2_index = l2_index + 1; skip_1 = "1"b; goto loop_cont; end; if tp2_names (j).sw.mov then if tp2_names (j).move_index ^= 0 then do; set = tp2_names (j).move_index; mst_ptr (MASTER) = tp1_names (set).head_ptr; call header_setup_1; call check_headers; call read_segment (COPY); mst_ptr (MASTER) = tp1_names (set).info_ptr; call check_segments; mst_ptr (MASTER) = mst_ptr_hold (MASTER); l2_index = l2_index + 1; skip_1 = "1"b; goto loop_cont; end; else do; call ioa_ ("^a moved up.", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); call ssu_$get_temp_segment (sci_ptr, "hdr." || segment_name, tp2_names (j).head_ptr); bit_len = mst2.header_length + 2; tp2_names (j).head_ptr -> header_words = mst_ptr (COPY) -> header_words; call ssu_$get_temp_segment (sci_ptr, "tp2." || segment_name, tp2_names (j).info_ptr); mst_ptr (COPY) = tp2_names (j).info_ptr; call read_segment (COPY); mst_ptr (COPY) = mst_ptr_hold (COPY); l2_index = l2_index + 1; skip_1 = "1"b; goto loop_cont; end; /* compare segments */ call check_headers; call read_segment (MASTER); call read_segment (COPY); call check_segments; l1_index = l1_index + 1; l2_index = l2_index + 1; loop_cont: end; /* do while */ if l1_index > name_count (MASTER) then if l2_index ^> name_count (COPY) then i = 2; else goto detach_and_return; /* process end of longer tape */ else i = 1; if i = 1 then j = l1_index; else j = l2_index; do while (j ^> name_count (i)); call read_header (i, collection); if collection then goto incr_j; k = np (i) -> tp1_names (j).pos_n; if segment_name ^= np (i) -> tp1_names (k).name then goto out_of_sync; if np (i) -> tp1_names (k).sw.add then do; call ioa_ ("^a added.", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); if saving then do; call initiate_file_$create (get_wdir_ (), "tp2." || segment_name, RW_ACCESS, mst_ptr (i), ""b, 0, code); if mst_ptr (i) = null then goto make_x; call read_segment (i); call terminate_file_ (mst_ptr (i), seg_length(i) * BITS_PER_WORD, TERM_FILE_TRUNC_BC_TERM, code); mst_ptr (i) = mst_ptr_hold (i); end; else call skip_block (i); end; else do; /* must be deleted */ call skip_block (i); call ioa_ ("^a deleted.", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); end; incr_j: j = j + 1; end; call ioa_ ("End of comparison.^/"); detach_and_return: call clean_up; return; /* successful job finish */ exit_proc: procedure; go to detach_and_return; end exit_proc; make_x: compare_mst_severity_ = max(compare_mst_severity_, 4); call ssu_$abort_subsystem (sci_ptr, code, "Making -save segment in working directory."); go to detach_and_return; %page; clean_up: proc; do i = MASTER to COPY; if iocb_ptr (i) = null () then go to CLEAN; call iox_$close (iocb_ptr (i), code); call iox_$detach_iocb (iocb_ptr (i), code); CLEAN: end; call ssu_$destroy_invocation (sci_ptr); end; %page; get_data: proc (index, data_ptr, data_words); dcl index fixed bin, data_ptr ptr, data_words fixed bin(18) uns unal; call iox_$get_chars (iocb_ptr(index), data_ptr, data_words * CHARS_PER_WORD, (0), code); if code = error_table_$end_of_info then go to detach_and_return; else if code ^= 0 then do; call ssu_$abort_subsystem (sci_ptr, code, "Tape error on ^[master^;copy^] tape.", index); end; end get_data; get_in_file: proc (index); dcl index fixed bin; dcl 1 control_word aligned, 2 type fixed bin (17) unaligned, 2 count fixed bin (18) uns unal; call absolute_pathname_ (in_file_name(index), in_file_name(index), code); if code ^= 0 then call ssu_$abort_subsystem (sci_ptr, code, "^[-if^;-of^] ^a.", index, in_file_name); in_file_name(index) = get_shortest_path_ (in_file_name(index)); call iox_$attach_name (mst_name(index) || unique_chars_(""b), iocb_ptr(index), "vfile_ " || in_file_name(index) || " -old", null, code); if code ^= 0 then call ssu_$abort_subsystem (sci_ptr, code, "Cannot attach input file ^a.", in_file_name(index)); REWIND_FILE: call iox_$open (iocb_ptr(index), Stream_input, ("0"b), code); if code ^= 0 then call ssu_$abort_subsystem (sci_ptr, code, "Cannot open input file ^a.", in_file_name(index)); call get_data (index, addr (control_word), size(control_word)); if control_word.type = -1 then do; /* bootload program control word */ /* It is written as a name, followed by the pgm. */ bpi(index).version = BOOT_PROGRAM_INFO_VERSION_1; /* set version */ boot_label(index) = "1"b; /* set flag to copy onto output tape */ name_len = divide (length (bpi(index).boot_program_name), CHARS_PER_WORD, 18, 0); seg_len = control_word.count - name_len; /* set copy length */ call get_data (index, addr (bpi(index).boot_program_name), name_len); call get_data (index, boot_ptr(index), seg_len); /* copy boot program in to temp seg */ bpi(index).boot_program_ptr = boot_ptr(index); /* set new boot program ptr */ bpi(index).boot_program_text_length = seg_len; end; else do; boot_label(index) = "0"b; call iox_$close (iocb_ptr(index), (0)); call iox_$open (iocb_ptr(index), Stream_input, ""b, (0)); end; return; rewind_in_file: entry (index); call iox_$close (iocb_ptr(index), code); if code ^= 0 then do; compare_mst_severity_ = max(compare_mst_severity_, 4); call ssu_$abort_subsystem (sci_ptr, code, "error in reopening. Aborting."); end; go to REWIND_FILE; end get_in_file; get_in_medium: proc (index); dcl index fixed bin; if in_file_name(index) ^= "" then call get_in_file (index); else if in_tape_name(index) ^= "" then call get_in_tape (index); return; rewind_in_medium: entry (index); if in_file_name(index) ^= "" then call rewind_in_file (index); else call rewind_in_tape (index); end get_in_medium; get_in_tape: proc (index); dcl index fixed bin; dcl copy (seg_len) fixed bin(35) based; call parse_tape_reel_name_ (in_tape_name(index), atd); if in_den(index) ^= UNSET then atd = rtrim (atd) || " -density " || ltrim (char (in_den(index))); call iox_$attach_name (mst_name(index) || unique_chars_ (""b), iocb_ptr(index), "tape_mult_ " || rtrim (atd), null, code); if code ^= 0 then call ssu_$abort_subsystem (sci_ptr, code, "Cannot attach input tape ^a.", in_tape_name(index)); REWIND_TAPE: call iox_$open (iocb_ptr(index), Stream_input, ("0"b), code); if code ^= 0 then call ssu_$abort_subsystem (sci_ptr, code, "Cannot open input tape ^a.", in_tape_name(index)); bpi(index).version = BOOT_PROGRAM_INFO_VERSION_1; /* set version */ call iox_$control (iocb_ptr(index), "get_boot_program", addr (bpi(index)), code); if code ^= 0 then call ssu_$abort_subsystem (sci_ptr, code, "Getting bootload program info from input tape ^a.", in_tape_name(index)); if bpi(index).boot_program_ptr ^= null then do; /* if this tape has a boot label... */ boot_label(index) = "1"b; /* set flag to copy onto output tape */ seg_len = bpi(index).boot_program_text_length; /* set copy length */ boot_ptr(index) -> copy = bpi(index).boot_program_ptr -> copy; /* copy boot program in to temp seg */ bpi(index).boot_program_ptr = boot_ptr(index); /* set new boot program ptr */ end; else boot_label(index) = "0"b; return; rewind_in_tape: entry (index); call iox_$close (iocb_ptr (index), code); if code ^= 0 then do; compare_mst_severity_ = max(compare_mst_severity_, 4); call ssu_$abort_subsystem (sci_ptr, code, "error in rewind, aborting"); end; go to REWIND_TAPE; end get_in_tape; %page; read_header: proc (index, found_mark); dcl found_mark bit (1) aligned; dcl index fixed bin; /* Get two words. The first word will tell you how many more words to read to complete the header (i.e., it is the header length minus 2.) If the collection mark is on, however, it is complete in itself. In that case, you must reach in and get a whole fresh header. */ call iox_$get_chars (iocb_ptr (index), mst_ptr (index), 8, nelemt, code); /* read 2 words */ if code = 0 then do; if mst_ptr (index) -> mst1.collection_mark then do; found_mark = "1"b; /* don't read rest of header; there is none */ return; end; else call iox_$get_chars (iocb_ptr (index), ptr (mst_ptr (index), 2), mst_ptr (index) -> mst1.header_length * 4, nelemt, code); /* read rest of header */ if code ^= 0 then call check_status; found_mark = "0"b; if index = 1 then call header_setup_1; else call header_setup_2; end; else if code ^= error_table_$end_of_info then call check_status; end; %page; header_setup_1: proc; n_names (MASTER) = mst_ptr (MASTER) -> mst1.n_names; /* pull out number of names */ if n_names (MASTER) = -1 then do; /* special bootstrap processing */ if bootstrap_sw (MASTER) then do; call ioa_ ("second bound_bootload_0 found on master tape. Aborting."); compare_mst_severity_ = max(compare_mst_severity_, 3); goto detach_and_return; end; bootstrap_sw (MASTER) = "1"b; n_names (MASTER) = 0; has_acl (MASTER) = 0; n_acls (MASTER) = 0; has_branch (MASTER) = 0; path_length (MASTER) = 0; segment_name = "bound_bootload_0"; seg_length (MASTER) = mst_ptr (MASTER) -> bootstrap_header.segment_length; end; else do; has_acl (MASTER) = binary (mst_ptr (MASTER) -> mst1.slte.acl_provided); /* is there an acl? */ has_branch (MASTER) = binary (mst_ptr (MASTER) -> mst1.slte.branch_required); /* is there a pathname? */ if has_branch (MASTER) = 1 then path_length (MASTER) = mst_ptr (MASTER) -> mst1.pathname_length (1); /* get length */ else path_length (MASTER) = 0; if has_acl (MASTER) = 1 then n_acls (MASTER) = mst_ptr (MASTER) -> mst1.n_acls (1); else n_acls (MASTER) = 0; segment_name = mst_ptr (MASTER) -> mst1.name (MASTER); seg_length (MASTER) = mst_ptr (MASTER) -> mst1.segment_length; end; end; header_setup_2: proc; /* must use references based on mst2 varibs */ n_names (COPY) = mst_ptr (COPY) -> mst2.n_names; if n_names (COPY) = -1 then do; if bootstrap_sw (COPY) then do; call ioa_ ("second bound_bootload_0 found on copy tape. Aborting."); compare_mst_severity_ = max(compare_mst_severity_, 3); goto detach_and_return; end; bootstrap_sw(COPY) = "1"b; n_names (COPY) = 0; has_acl (COPY) = 0; n_acls (COPY) = 0; has_branch (COPY) = 0; path_length (COPY) = 0; segment_name = "bound_bootload_0"; seg_length (COPY) = mst_ptr (COPY) -> bootstrap_header.segment_length; end; else do; has_acl (COPY) = binary (mst_ptr (COPY) -> mst2.slte.acl_provided); has_branch (COPY) = binary (mst_ptr (COPY) -> mst2.slte.branch_required); if has_branch (COPY) = 1 then path_length (COPY) = mst_ptr (COPY) -> mst2.pathname_length (1); else path_length (COPY) = 0; if has_acl (COPY) = 1 then n_acls (COPY) = mst_ptr (COPY) -> mst2.n_acls (1); else n_acls (COPY) = 0; segment_name = mst_ptr (COPY) -> mst2.name (1); seg_length (COPY) = mst_ptr (COPY) -> mst2.segment_length; end; end; %page; check_headers: proc; if mst1.header_length ^= mst2.header_length then goto header_discrepancy; bit_len = mst1.header_length + 2; /* comparison of headers here */ bits = mst_ptr (MASTER) -> header_words = mst_ptr (COPY) -> header_words; if (^string (bits)) ^= ""b then if ((n_acls (MASTER) = 0) | (n_acls (COPY) = 0)) then goto header_discrepancy; else do; /* zero pad in acl structure */ do k = 1 to n_acls (MASTER); mst1.acl (1, k).pad (1), mst1.acl (1, k).pad (2) = 0; end; do k = 1 to n_acls (COPY); mst2.acl (1, k).pad (1), mst2.acl (1, k).pad (2) = 0; end; bits = mst_ptr (MASTER) -> header_words = mst_ptr (COPY) -> header_words; if (^string (bits)) ^= ""b then goto header_discrepancy; end; return; header_discrepancy: call ioa_ ("^/Segment ^a:", segment_name); compare_mst_severity_ = max(compare_mst_severity_, 3); /* Now find out exactly why. */ if mst_ptr (MASTER) -> mst1.access ^= mst_ptr (COPY) -> mst2.access then call ioa_ ("^-SDW access has changed from ^a to ^a", substr (REWP, binary (mst_ptr (MASTER) -> mst1.access) * 4 + 1, 4), substr (REWP, binary (mst_ptr (COPY) -> mst2.access) * 4 + 1, 4)); if mst_ptr (MASTER) -> mst1.cache ^= mst_ptr (COPY) -> mst2.cache then call ioa_ ("^-Cache bit has changed from ^a to ^a", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.cache) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.cache) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.wired ^= mst_ptr (COPY) -> mst2.wired then call ioa_ ("^-Wired bit has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.wired) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.wired) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.paged ^= mst_ptr (COPY) -> mst2.paged then call ioa_ ("^-Paged bit has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.paged) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.paged) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.per_process ^= mst_ptr (COPY) -> mst2.per_process then call ioa_ ("^-Per-process bit has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.per_process) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.per_process) * 4 + 1, 3)); %page; if mst_ptr (MASTER) -> mst1.acl_provided ^= mst_ptr (COPY) -> mst2.acl_provided then call ioa_ ("^-ACL-provided switch has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.acl_provided) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.acl_provided) * 4 + 1, 3)); else if has_acl (MASTER) = 1 then if n_acls (MASTER) ^= n_acls (COPY) then goto print_acls; else do; bit_len = 11 * n_acls (MASTER) + 1; anp (MASTER) = addr (mst1.acl_structure (1)); anp (COPY) = addr (mst2.acl_structure (1)); bits = anp (MASTER) -> header_words = anp (COPY) -> header_words; if (^string (bits)) ^= ""b then do; print_acls: call ioa_ ("^-Number of ACLs was ^d, now is ^d.", n_acls (MASTER), n_acls (COPY)); if abs (n_acls (MASTER) - n_acls (COPY)) > abs_changes then do; too_much: compare_mst_severity_ = max(compare_mst_severity_, 4); call ssu_$abort_subsystem (sci_ptr, 0, "Probable bad tape, aborting."); goto detach_and_return; end; call ioa_ ("^5xACL was:"); do k = 1 to n_acls (MASTER); call ioa_ ("^-^3a ^a", substr (rew, binary (mst_ptr (MASTER) -> mst1.acl (1, k).mode) * 3 + 1, 3), mst_ptr (MASTER) -> mst1.acl (1, k).accessname); end; call ioa_ ("^5xACL is:"); do k = 1 to n_acls (COPY); call ioa_ ("^-^3a ^a", substr (rew, binary (mst_ptr (COPY) -> mst2.acl (1, k).mode) * 3 + 1, 3), mst_ptr (COPY) -> mst2.acl (1, k).accessname); end; end; end; if mst_ptr (MASTER) -> mst1.branch_required ^= mst_ptr (COPY) -> mst2.branch_required then call ioa_ ("^-Hierarchy-branch required indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.branch_required) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.branch_required) * 4 + 1, 3)); else if has_branch (MASTER) = 1 then if mst_ptr (MASTER) -> mst1.pathname (1) ^= mst_ptr (COPY) -> mst2.pathname (1) then call ioa_ ("^-Pathname has changed from ^a to ^a.", mst_ptr (MASTER) -> mst1.pathname (1), mst_ptr (COPY) -> mst2.pathname (1)); if mst_ptr (MASTER) -> mst1.init_seg ^= mst_ptr (COPY) -> mst2.init_seg then call ioa_ ("^-Initialization-seg indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.init_seg) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.init_seg) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.temp_seg ^= mst_ptr (COPY) -> mst2.temp_seg then call ioa_ ("^-Temp-seg indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.temp_seg) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.temp_seg) * 4 + 1, 3)); %page; if mst_ptr (MASTER) -> mst1.link_provided ^= mst_ptr (COPY) -> mst2.link_provided then call ioa_ ("^-Linkage-provided indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.link_provided) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.link_provided) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.link_sect ^= mst_ptr (COPY) -> mst2.link_sect then call ioa_ ("^-Linkage-segment indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.link_sect) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.link_sect) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.link_sect_wired ^= mst_ptr (COPY) -> mst2.link_sect_wired then call ioa_ ("^-Linkage-wired indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.link_sect_wired) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.link_sect_wired) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.combine_link ^= mst_ptr (COPY) -> mst2.combine_link then call ioa_ ("^-Combine-linkage switch has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.combine_link) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.combine_link) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.pre_linked ^= mst_ptr (COPY) -> mst2.pre_linked then call ioa_ ("^-Pre-linked indicator has changed from ^a to ^a.", substr (OFF_ON, binary (mst_ptr (MASTER) -> mst1.pre_linked) * 4 + 1, 3), substr (OFF_ON, binary (mst_ptr (COPY) -> mst2.pre_linked) * 4 + 1, 3)); if mst_ptr (MASTER) -> mst1.cur_length ^= mst_ptr (COPY) -> mst2.cur_length then call ioa_ ("^-Cur-length has changed from ^o to ^o.", binary (mst_ptr (MASTER) -> mst1.cur_length, 35), binary (mst_ptr (COPY) -> mst2.cur_length, 35)); if mst_ptr (MASTER) -> mst1.ringbrack (1) ^= mst_ptr (COPY) -> mst2.ringbrack (1) | mst_ptr (MASTER) -> mst1.ringbrack (2) ^= mst_ptr (COPY) -> mst2.ringbrack (2) | mst_ptr (MASTER) -> mst1.ringbrack (3) ^= mst_ptr (COPY) -> mst2.ringbrack (3) then call ioa_ ("^-Ring brackets have changed from ^d,^d,^d to ^d,^d,^d.", binary (mst_ptr (MASTER) -> mst1.ringbrack (1), 35), binary (mst_ptr (MASTER) -> mst1.ringbrack (2), 35), binary (mst_ptr (MASTER) -> mst1.ringbrack (3), 35), binary (mst_ptr (COPY) -> mst2.ringbrack (1), 35), binary (mst_ptr (COPY) -> mst2.ringbrack (2), 35), binary (mst_ptr (COPY) -> mst2.ringbrack (3), 35)); if mst_ptr (MASTER) -> mst1.segno ^= mst_ptr (COPY) -> mst2.segno then call ioa_ ("^-Segment number has changed from ^o to ^o.", binary (mst_ptr (MASTER) -> mst1.segno, 35), binary (mst_ptr (COPY) -> mst2.segno, 35)); if mst_ptr (MASTER) -> mst1.max_length ^= mst_ptr (COPY) -> mst2.max_length then call ioa_ ("^-Max length has changed from ^o to ^o.", binary (mst_ptr (MASTER) -> mst1.max_length, 35), binary (mst_ptr (COPY) -> mst2.max_length, 35)); if mst_ptr (MASTER) -> mst1.bit_count ^= mst_ptr (COPY) -> mst2.bit_count then call ioa_ ("^-Bit count has changed from ^d to ^d.", binary (mst_ptr (MASTER) -> mst1.bit_count, 35), binary (mst_ptr (COPY) -> mst2.bit_count, 35)); %page; if n_names (MASTER) = 0 then return; /* bound_bootload_0 */ if n_names (MASTER) ^= n_names (COPY) then goto print_names; else do; bit_len = 9 * n_names (MASTER) + 1; anp (MASTER) = addr (mst1.names_array); anp (COPY) = addr (mst2.names_array); bits = anp (MASTER) -> header_words = anp (COPY) -> header_words; if (^string (bits)) ^= ""b then do; print_names: call ioa_ ("^-Number of names was ^d, now is ^d.", n_names (MASTER), n_names (COPY)); if abs (n_names (MASTER) - n_names (COPY)) > abs_changes then goto too_much; call ioa_ ("^5xNames were:"); do k = 1 to n_names (MASTER); call ioa_ ("^-^a", mst_ptr (MASTER) -> mst1.name (k)); end; call ioa_ ("^5xNames are:"); do k = 1 to n_names (COPY); call ioa_ ("^-^a", mst_ptr (COPY) -> mst2.name (k)); end; end; end; if mst_ptr (MASTER) -> mst1.segment_length ^= mst_ptr (COPY) -> mst2.segment_length then call ioa_ ("^-Segment length has changed from ^o to ^o.", mst_ptr (MASTER) -> mst1.segment_length, mst_ptr (COPY) -> mst2.segment_length); end; %page; skip_block: proc (index); dcl index fixed bin; /* positioning not supported, so just read */ call iox_$get_chars (iocb_ptr (index), mst_ptr (index), seg_length (index) * 4, nelemt, code); if code ^= 0 then call check_status; end; read_segment: proc (index); dcl index fixed bin; call iox_$get_chars (iocb_ptr (index), mst_ptr (index), seg_length (index) * 4, nelemt, code); if code ^= 0 then call check_status; end; check_status: proc; compare_mst_severity_ = max(compare_mst_severity_, 4); call ssu_$abort_subsystem (sci_ptr, code, "Error in manipulating tapes."); end; read_tape: proc (index); dcl index fixed bin parameter; dcl i fixed bin; dcl last_collection_mark fixed bin; dcl name_index fixed bin; dcl 1 tp_names (name_count (index)) based (np (index)) aligned like tp_name; last_collection_mark = 0; name_index, name_count (index) = 0; do while (code ^= error_table_$end_of_info); /* get the whole tape */ call read_header (index, collection); if code = 0 then do; name_index, name_count (index) = name_count (index) + 1; tp_names (name_index).org_index = name_index; tp_names (name_index).pos_n = name_index; /* init */ tp_names (name_index).head_ptr = null; tp_names (name_index).info_ptr = null; if index = 1 then tp_names (name_index).sw.del = "1"b; /* assume not on other tape */ else tp_names (name_index).sw.add = "1"b; /* assume everything new */ if collection then do; do i = last_collection_mark + 1 to name_index; /* record collection contained within */ tp_names (i).major_collection = mst_ptr (index) -> collection_mark_data.major; tp_names (i).minor_collection = mst_ptr (index) -> collection_mark_data.minor; end; last_collection_mark = name_index; tp_names (name_index).name = "collection." || ltrim (char (mst_ptr (index) -> collection_mark_data.major)) || "." || ltrim (char (mst_ptr (index) -> collection_mark_data.minor)); tp_names (name_index).sw.col = "1"b; end; else do; tp_names (name_index).name = segment_name; call skip_block (index); if segment_name = "active_all_rings_data" then do; have_sysid = "1"b; sys_id (index) = mst_ptr (index) -> sys_id_pickup; end; end; end; end; if substr (tp_names (name_index).name, 1, 10) ^= "collection" then do; call ioa_ ("tape ^d does not end in a collection mark.", index); compare_mst_severity_ = max(compare_mst_severity_, 3); end; return; end; %page; check_segments: proc; if seg_length (MASTER) ^= seg_length (COPY) then goto check_saving; bit_len = seg_length (MASTER); /* ready for bit comparison */ bits = mst_ptr (MASTER) -> segment_1 = mst_ptr (COPY) -> segment_1; /* set up equal bits */ if (^string (bits)) ^= ""b then goto segment_contents_discrepancy; /* something has been changed. */ return; segment_contents_discrepancy: k = index (string (bits), "0"b) - 1; /* j tells which word first noticed as changed */ call ioa_ ("^/Segment ^a contains differences from word ^o.", segment_name, k); compare_mst_severity_ = max(compare_mst_severity_, 3); k = bit_len - index (reverse (string (bits)), "0"b); call ioa_ ("^-last difference found at word ^o.", k); check_saving: if saving then do; call initiate_file_$create (get_wdir_ (), "tp1." || segment_name, RW_ACCESS, copy_ptr, ""b, 0, code); if copy_ptr = null then return; copy_ptr -> segment_1 = mst_ptr (MASTER) -> segment_1; call terminate_file_ (copy_ptr, size(segment_1) * BITS_PER_WORD, TERM_FILE_TRUNC_BC_TERM, code); call initiate_file_$create (get_wdir_ (), "tp2." || segment_name, RW_ACCESS, copy_ptr, ""b, 0, code); if copy_ptr = null then return; copy_ptr -> segment_2 = mst_ptr (COPY) -> segment_2; call terminate_file_ (copy_ptr, size(segment_2) * BITS_PER_WORD, TERM_FILE_TRUNC_BC_TERM, code); end; return; end; %page; sort_names: proc (index); /* shell sort, keeping track of original position */ dcl index fixed bin; dcl 1 hold_info aligned like tp_name.order_info; dcl sd fixed bin; dcl si fixed bin; dcl sj fixed bin; dcl sk fixed bin; dcl 1 tp_names (name_count (index)) aligned based (np (index)) like tp_name; sd = name_count (index); down: sd = 1 + 2 * divide (sd, 4, 17, 0); do si = 1 to name_count (index) - sd; sj = si + sd; up: sk = sj - sd; if tp_names (sk).name <= tp_names (sj).name then goto ok; hold_info = tp_names (sk).order_info; tp_names (sk).order_info = tp_names (sj).order_info; tp_names (tp_names (sk).org_index).pos_n = sk; tp_names (sj).order_info = hold_info; tp_names (tp_names (sj).org_index).pos_n = sj; if sk > sd then do; sj = sk; goto up; end; ok: end; if sd > 1 then goto down; end; %page; name_search: proc (tp_name_ptr, index, ret_ans); /* See if name exists on list(index). Do binary search, preferring the object in the same collection as before. */ dcl index fixed bin; dcl ret_ans fixed bin; dcl tp_name_ptr ptr; dcl low_index fixed bin; dcl high_index fixed bin; dcl 1 tp_names (name_count (index)) aligned based (np (index)) like tp_name; ret_ans = 0; low_index = 1; high_index = name_count (index); do while (high_index > low_index); k = divide (low_index + high_index, 2, 17); if tp_names (k).name = tp_name_ptr -> tp_name.name then go to match; else if tp_names (k).name < tp_name_ptr -> tp_name.name then low_index = k + 1; /* name in high half of subdivision */ else high_index = k - 1; /* low half */ end; if high_index < 1 then return; if low_index > name_count (index) then return; if tp_names (high_index).name = tp_name_ptr -> tp_name.name then do; k = high_index; match: /* Name the same; look for the one in the same collection. */ do ret_ans = k to name_count (index) while (tp_name_ptr -> tp_name.name = tp_names (ret_ans).name), k - 1 to 1 by -1 while (tp_name_ptr -> tp_name.name = tp_names (ret_ans).name); if tp_name_ptr -> tp_name.major_collection = tp_names (ret_ans).major_collection & tp_name_ptr -> tp_name.minor_collection = tp_names (ret_ans).minor_collection then return; end; ret_ans = ret_ans + 1; /* pick first one found */ end; return; end; %page; list_comp: proc; /* find out what's added, deleted, or moved */ /* process in original order to get add/del counts rigHt */ dcl add_count fixed bin; dcl del_count fixed bin; dcl offset_1 fixed bin; dcl offset_2 fixed bin; do i = 1 to name_count (MASTER); call name_search (addr (tp1_names (tp1_names (i).pos_n)), 2, offset_1); if offset_1 = 0 then go to d_lp_c; /* remains marked as deleted */ else do; tp1_names (tp1_names (i).pos_n).sw.del = "0"b; tp2_names (offset_1).sw.add = "0"b; end; d_lp_c: end; /* check for movement by matching list position */ i, j = 1; add_count, del_count = 0; /* need process only shortest list */ do while ((i <= name_count (MASTER)) & (j <= name_count (COPY))); if tp1_names (tp1_names (i).pos_n).sw.del | tp1_names (tp1_names (i).pos_n).move_index ^= 0 then do; i = i + 1; go to l_cont; end; if tp2_names (tp2_names (j).pos_n).sw.add | tp2_names (tp2_names (j).pos_n).move_index ^= 0 then do; j = j + 1; go to l_cont; end; /* if names equal then ok */ if tp1_names (tp1_names (i).pos_n).name = tp2_names (tp2_names (j).pos_n).name then do; i = i + 1; j = j + 1; goto l_cont; end; /* see which side moved */ call name_search (addr (tp1_names (tp1_names (i).pos_n)), COPY, offset_2); call name_search (addr (tp2_names (tp2_names (j).pos_n)), MASTER, offset_1); /* find out which is farther, ignore adds,deletes */ del_count = tp1_names (offset_1).org_index - tp1_names (tp1_names (i).pos_n).org_index; add_count = tp2_names (offset_2).org_index - tp2_names (tp2_names (j).pos_n).org_index; /* mark one as moved */ if del_count > add_count then do; /* first tape's match is lower */ tp2_names (tp2_names (j).pos_n).sw.mov = "1"b; tp1_names (offset_1).sw.mov = "1"b; tp1_names (offset_1).move_index = tp2_names (j).pos_n; j = j + 1; goto l_cont; end; else do; tp1_names (tp1_names (i).pos_n).sw.mov = "1"b; tp2_names (offset_2).sw.mov = "1"b; tp2_names (offset_2).move_index = tp1_names (i).pos_n; i = i + 1; goto l_cont; end; l_cont: end; /* do while */ end; /* proc */ %page; %include access_mode_values; %page; %include iox_modes; %page; %include slte; %page; %include system_constants; %page; %include tape_mult_boot_info; %page; %include terminate_file; end;  sslt_init_.pl1 12/15/83 1138.2r 12/15/83 1135.0 14130 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* sslt_init_.pl1 -- copies template slt from template_slt_ into temp segs */ /* for the checker. BIM 7/2/82 */ /* format: style2 */ sslt_init_: procedure (slt_ptr, name_table_ptr); declare (slt_ptr, name_table_ptr) pointer parameter; %include slt; declare addr builtin; declare template_slt_$slt_length fixed bin ext; declare template_slt_$name_table_length fixed bin ext; declare template_slt_$t_slt bit (36) aligned ext; declare template_slt_$t_name_table bit (36) aligned ext; declare move_slt (template_slt_$slt_length) bit (36) aligned based; declare move_nt (template_slt_$name_table_length) bit (36) aligned based; declare (init_tox, init_fromx, x) fixed bin; slt_ptr -> move_slt = addr (template_slt_$t_slt) -> move_slt; name_table_ptr -> move_nt = addr (template_slt_$t_name_table) -> move_nt; sltp = slt_ptr; /* It still remains to relocate the init segs in their proper place */ init_fromx = slt.last_sup_seg + 1; init_tox = slt.first_init_seg; do x = 0 to slt.last_init_seg - slt.first_init_seg; slt.seg (init_tox + x) = slt.seg (init_fromx + x); slt.seg (init_fromx + x) = 0; end; slt_ptr -> slt.name_seg_ptr = name_table_ptr; return; end sslt_init_;  sslt_manager_.alm 11/05/86 1353.6r w 11/04/86 1039.4 92142 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Segment Loading Table Manager MSPM BL.2.02 " " " " T.H. Van Vleck 5/19/67 " " Rewritten by N. I. Morris 12/27/67 " " Last modified by N. I. Morris 08/12/76 " " " " This program is a utility routine for use in system " " initialization. It is first called by the Bootstrap " " Initializer, and remains useful well into the execution " " of the Initializer Control Program. " " " " Note: THIS IS NOT A PURE PROCEDURE " " " " The Segment Loading Table (SLT) contains an entry for " " each segment that is part of the Multics Initializer " " or hard-core supervisor. Each entry contains useful " " information about the segment, such as its name, number, " " linkage status, etc. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name slt_manager " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " Miscellaneous Equivalences: equ wdsnm,32/4 words per segment name include slt include slte include stack_header include stack_frame " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " call slt_manager$init(sltptr) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " use transfer_vector entry init tra init use main init: epplb ap|2,* lb -> SLT pointer epplb lb|0,* lb -> SLT sprilb slt_ptr save pointer to the SLT eppab lb|slt.name_seg_ptr,* ab -> name table segment eppbb lb|slt.first_sup_seg bb -> limits for sup segs tsx2 search search for and hash in sup seg names eppbb lb|slt.first_init_seg bb -> limits for init segs tsx2 search search for and hash in init seg names tra return search: ldq bb|1 get last seg to examine sbq bb|0 minus first seg to examine eax5 1,ql number of segs to examine in X5 ldq bb|0 first seg to examine in Q eax7 0,ql place segno in X7 mpy slte_size,dl compute SLT index epplp lb|slt.seg,ql lp -> SLT entry search_loop: eax5 -1,5 test for completion tmi 0,2 return if not in this half of S(S)LT ldx0 lp|slte.names_ptr pick up pointer to names eppbp ab|segnam.name,0 bp -> first name tsx6 hash_in insert names in hash table epplp lp|slte_size step to next SLT entry eax7 1,7 step segment number tra search_loop and keep looking " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " call slt_manager$build_entry(header, segptr, err) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " use transfer_vector entry build_entry tra build_entry use main build_entry: tsx1 setup set everything up eppbp ap|2,* bp -> header pointer eppbp bp|0,* bp -> header lda bp|slte.init_seg_word is this an initialization segment? cana slte.init_seg,dl .. tze sup if zero, supervisor segment aos lb|slt.last_init_seg otherwise, init segment ldq lb|slt.last_init_seg segment number in Q tra jn .. sup: aos lb|slt.last_sup_seg supervisor segment ldq lb|slt.last_sup_seg segment number in Q cmpq lb|slt.first_init_seg are we overlapping the init segs? trc error fatal error if so jn: lls 36+18 shift to left-half of A ora itspair make an ITS pair staq ap|4,* and return pointer to segment lrl 36+18 back to the right-half Q mpy slte_size,dl multiply by length of SLT entry epplp lb|slt.seg,ql lp -> slot for new SLT entry mlr (pr),(pr) fill in the SLT entry desc9a bp|0,slte_size*4 desc9a lp|0,slte_size*4 eppbp bp|slte_size bp -> next part of header eppab lb|slt.name_seg_ptr,* ab -> SLT name table lxl1 ab|name_seg.next_loc X1 contains first unused location stx1 lp|slte.names_ptr set name pointer in SLT entry eppab ab|0,1 ab -> place for names ldq bp|segnam.count count of names in Q mpy wdsnm+1,dl multiply by length of each name adlq 1,dl add 1 for name count itself qls 2 multiply by 4 mlr (pr,rl),(pr,rl) copy the names desc9a bp|0,ql desc9a ab|0,ql a9bd bp|0,ql step pointers a9bd ab|0,ql .. lda lp|slte.branch_required_word Look for branch-required switch cana slte.branch_required,dl Is path provided tze end_entry No, all finished for this entry eax1 ab|0 X1 -> path name sxl1 lp|slte.path_ptr set path name pointer in SLT entry ldq bp|0 character count of path name in Q adlq 7,dl add in to cover count and round up qrl 2 round off qls 2 .. mlr (pr,rl),(pr,rl) copy the path name desc9a bp|0,ql desc9a ab|0,ql a9bd bp|0,ql step pointers a9bd ab|0,ql .. ldq lp|slte.acl_provided_word see if ACL was provided canq slte.acl_provided,du check the bit tze end_entry no ACL provided ldq bp|0 get number of ACL items mpy 11,dl multiply by item size adlq 1,dl and add one for size word qls 2 get character count mlr (pr,rl),(pr,rl) copy the ACL desc9a bp|0,ql desc9a ab|0,ql a9bd ab|0,ql bump output pointer end_entry: eax1 ab|0 X1 -> free space in name table epbpab ab|0 ab -> base of name table segment sxl1 ab|name_seg.next_loc save first unused loc'n in name table ldx0 lp|slte.names_ptr get pointer to names again ldx7 ap|4,* X7 contains segment number eppbp ab|segnam.name,0 bp -> first name tsx6 hash_in hash in these names tra return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " call slt_manager$get_seg_ptr(name, ptr, err) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " use transfer_vector entry get_seg_ptr tra get_seg_ptr use main get_seg_ptr: tsx6 get_seg go search the SLT ora itspair make segno into an ITS pair ldq 0,dl clear the Q staq ap|4,* and return the pointer tra return return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " call slt_manager$get_seg_num(name, num, err) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " use transfer_vector entry get_seg_num tra get_seg_num use main get_seg_num: tsx6 get_seg go search the SLT arl 18 right-justify the segment number sta ap|4,* and return the segment number tra return return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " call slt_manager$get_text_link_ptr(name, text_ptr, link_ptr, err) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " use transfer_vector entry get_text_link_ptr tra get_text_link_ptr use main get_text_link_ptr: tsx6 get_seg go search the SLT ora itspair make segno into a pointer ldq 0,dl clear the Q staq ap|4,* return text pointer eppbp sb|stack_header.lot_ptr,* bp -> LOT szn bp|0,au linkage for this segment? tze no_lkg if not, return null lkg ptr lprpbp bp|0,au bp -> linkage spribp ap|6,* return linkage ptr to caller tra return and return no_lkg: ldaq nullptr make link pointer null staq ap|6,* .. tra return and then return " GET_SEG - Search the SLT for a Name. get_seg: tsx1 setup go to save sequence and initialization eppbp ap|2,* bp -> segment name (char(32) aligned) tsx1 hash_name generate hash code from name ldx2 ab|name_seg.ht,al get start of thread from hash table get_seg_loop: tze error if zero thread, name not found eppbb ab|0,2 bb -> name cmpc (pr),(pr) is this the one? desc9a bp|0,32 desc9a bb|segnam.name-segnam.hp,32 tze get_seg_found if so, return info ldx2 bb|0 get thread to next name tra get_seg_loop and loop get_seg_found: lda segnam.ref,dl set referenced bit orsa bb|0 .. lda bb|0 get thread word als 18-segnam.segno_shift shift segno to AU ana segnam.segno_mask,du and mask tra 0,6 return to caller with segno in AU " ERROR - Error Return Sequence. error: ldx7 ap|0 pick up number of arguments aos ap|0,7* set the error code " RETURN - Return Sequence. return: eppap sp|stack_frame.operator_ptr,* restore ptr to caller's ops rtcd sp|stack_frame.return_ptr return to caller " HASH_IN - Enter Names for New Segment in Hash Table. hash_in: lxl3 bp|-segnam.name count of names in X3 hloop: tsx1 hash_name generate hash code from this name ldx1 ab|name_seg.ht,al X1 contains hash table entry eax0 bp|-segnam.name+segnam.hp X0 -> new name stx0 ab|name_seg.ht,al add new name to hash thread stx1 bp|-segnam.name+segnam.hp chain new entry to list sxl7 bp|-segnam.name+segnam.hp insert segno in thread word eppbp bp|wdsnm+1 step to next name eax3 -1,3 count names tnz hloop loop until all names processed tra 0,6 " HASH_NAME - Generate Hash Code from Segment Name. hash_name: ldq bp|0 get first word of name erq bp|2 exclusive in two more words erq bp|3 .. div 127,dl divide to generate hash code tra 0,1 return with hash code in A " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Subroutines. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " SETUP - Execute SAVE Sequence and Get Pointer to SLT Segment. setup: ldx0 ap|0 pick up number of arguments stz ap|0,0* zero out the error code epbplb slt_ptr,* lb -> base of SLT segment epplp lb|slt.seg lp -> beginning of SLT entries eppab lb|slt.name_seg_ptr,* ab -> name table segment tra 0,1 return to caller " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Storage and Constants. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " even itspair: its 0,0 ITS pair template nullptr: its -1,1 null pointer segref checker_data_,slt_ptr join /text/transfer_vector,main end slt_manager  tape_reader_.pl1 07/16/87 1350.1r 07/15/87 1602.4 67563 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-01-13,GDixon), approve(87-04-16,MCR7614), audit(87-05-21,Farley), install(87-07-15,MR12.1-1040): Add support for storing boot program as first segment of MST image stored in a file. END HISTORY COMMENTS */ /* TAPE_READER_ - Procedure to Read MST Checker Input Tape. iox'ed 11/3/76 by Noel I. Morris */ /* Modified 8/82 BIM signal EOF, backup */ /* format: style2 */ tape_reader_: proc (Data_ptr, N_words); dcl Data_ptr ptr; dcl N_words fixed bin (18); dcl atd char (256); dcl attach_descrip_ptr ptr; dcl code fixed bin (35); dcl 1 control_word aligned, 2 type fixed bin (17) unaligned, 2 count fixed bin (18) uns unal, (name_len, seg_len) fixed bin (18); dcl attach_descrip char (500) varying based (attach_descrip_ptr); dcl checker_data_$buffer_ptr ptr ext; dcl checker_data_$input_iocbp ptr ext; dcl checker_data_$file_attachment bit (1) aligned ext; dcl error_table_$end_of_info fixed bin (35) ext; dcl (addr, char, divide, length, ltrim, min, null, rtrim, size, substr) builtin; dcl com_err_ entry () options (variable), sub_err_ entry () options (variable); dcl MST_tape_eof_ condition; if N_words = 0 then return; call iox_$get_chars (checker_data_$input_iocbp, Data_ptr, N_words * 4, (0), code); if code = error_table_$end_of_info then signal MST_tape_eof_; else if code ^= 0 then call sub_err_ (code, "checker_tape", ACTION_CANT_RESTART, null (), (0), "Error reading MST."); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* REWIND: */ /* 1) Close I/O switch to which MST attached. */ /* 2) Reopen the switch, thereby repositioning to beginning of MST. */ /* 3) Read, skip-over boot program. On tape, boot program is in the tape */ /* label, invisible to iox_$get_chars. In a file, boot program is the */ /* first "segment" stored in MST file, and IS visible to iox_$get_chars. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ rewind: entry (boot_prog_name, boot_prog_len); dcl boot_prog_name char (32), boot_prog_len fixed bin (21); call iox_$close (checker_data_$input_iocbp, code); if code ^= 0 then call sub_err_ (code, "checker_tape", ACTION_CANT_RESTART, null (), (0), "Error closing MST."); call iox_$open (checker_data_$input_iocbp, Stream_input, ""b, code); if code ^= 0 then call sub_err_ (code, "checker_tape", ACTION_CANT_RESTART, null (), (0), "Error reopening MST."); bpi.version = BOOT_PROGRAM_INFO_VERSION_1; bpi.boot_program_name = ""; bpi.boot_program_text_length = 0; bpi.boot_program_ptr = null; if checker_data_$file_attachment then do; /* file input */ call tape_reader_ (addr (control_word), size (control_word)); if control_word.type = -1 then do; /* bootload program control word */ /* It is written as a name, followed by the pgm. */ /* set version */ name_len = divide (length (boot_program_info.boot_program_name), CHARS_PER_WORD, 18, 0); seg_len = control_word.count - name_len; /* set copy length */ call tape_reader_ (addr (bpi.boot_program_name), name_len); call tape_reader_ (checker_data_$buffer_ptr, seg_len); /* copy boot program in to temp seg */ bpi.boot_program_text_length = seg_len; end; else do; call iox_$close (checker_data_$input_iocbp, (0)); call iox_$open (checker_data_$input_iocbp, Stream_input, ""b, (0)); end; end; else do; /* tape input */ call iox_$control (checker_data_$input_iocbp, "get_boot_program", addr (boot_program_info), code); if code ^= 0 then do; /* can't do it */ call sub_err_ (code, "checker_tape", ACTION_CANT_RESTART, null (), (0), "Error getting boot program info from MST."); return; end; end; boot_prog_name = bpi.boot_program_name; boot_prog_len = bpi.boot_program_text_length; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* INITIALIZATION: */ /* 1) If generate_mst -hold was given, then the mst_tape I/O switch remains */ /* attached to the MST. Use it if it is attached. */ /* 2) Otherwise, make our own attachment to appropriate tape or file. For */ /* files, remember to skip over the boot program. */ /* 3) Record in checker_data_$file_attachment whether we are dealing with */ /* an MST tape or a tape image stored in a file. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ init: entry (CALLER, name, density, file, Acode); dcl CALLER char (*), name char (*), density fixed bin, file bit (1) aligned, Acode fixed bin (35); checker_data_$file_attachment = "0"b; call iox_$look_iocb ("mst_tape", checker_data_$input_iocbp, Acode); if Acode = 0 then call iox_$open (checker_data_$input_iocbp, Stream_input, ""b, Acode); if Acode = 0 then do; /* ALREADY THERE */ attach_descrip_ptr = checker_data_$input_iocbp -> iocb.actual_iocb_ptr -> iocb.attach_descrip_ptr; if substr (attach_descrip, 1, min (length (attach_descrip), length ("vfile_ "))) = "vfile_ " then checker_data_$file_attachment = "1"b; end; else do; /* not yet attached */ if file then do; atd = "vfile_ " || rtrim (name) || " -old"; checker_data_$file_attachment = "1"b; end; else do; atd = "tape_mult_ " || rtrim (name); if density ^= 0 then atd = rtrim (atd) || " -density " || ltrim (char (density)); end; call iox_$attach_name ("mst_tape", checker_data_$input_iocbp, atd, null (), Acode); if Acode ^= 0 then do; call com_err_ (Acode, CALLER, "Attaching ^a.", atd); return; end; call iox_$open (checker_data_$input_iocbp, Stream_input, "0"b, Acode); if Acode ^= 0 then do; call com_err_ (Acode, CALLER, "Opening mst tape input."); return; end; end; call rewind (bpi.boot_program_name, bpi.boot_program_text_length); /* position beyond boot pgm*/ return; final: entry; if checker_data_$input_iocbp ^= null then do; call iox_$close (checker_data_$input_iocbp, code); call iox_$detach_iocb (checker_data_$input_iocbp, code); checker_data_$input_iocbp = null; end; return; %include iocb; %include iox_entries; %include iox_modes; %include sub_err_flags; %include system_constants; %include tape_mult_boot_info; dcl 1 bpi aligned like boot_program_info; end tape_reader_;  template_slt_.alm 06/01/84 1546.7r w 06/01/84 1426.8 90900 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1983 * " * * " *********************************************************** name template_slt_ " Modified '82 for bootload Multics 10.2 " Modified '83 for adp by Keith Loepere. include bootload_equs include slt include slte include unpaged_page_tables " segdef slt_length segdef name_table_length segdef t_slt segdef t_name_table segdef dseg,adp_dseg segdef upt,init_upt,adp_upt,adp_init_upt segdef dsbr,adp_dsbr macro seg set s.1,0 set s.2,0 &=&2,sup&[ set sup_segno,sup_segno+1 set s.segno,sup_segno &; set init_segno,init_segno+1 set s.segno,init_segno set s.2,s.2+slte_uns.init_seg &] equ &1_seg_num,s.segno use names dec 1 " count vfd 18/0,1/0,5/0,12/s.segno aci "&1",32 set s.path,0 set s.rings,0 set s.max_length,0 set s.cur_length,0 set s.absloc,0 set s.access,0 set sf.abs_seg,0 set seg_index,seg_index+1 equ &1_index,seg_index &end bool a.read,10 bool a.execute,04 bool a.write,02 bool a.privileged,01 macro access &R&( set s.access,s.access+a.&i &) &end macro flags &R&( set s.1,s.1+slte_uns.&i set sf.&i,1 &) &end macro flags2 &R&( set s.2,s.2+slte_uns.&i &) &end macro absloc set_o s.cur_length,&2 set s.max_length,(s.cur_length/1024) set_o s.absloc,&1 &end macro allocate set_o s.cur_length,&1 set s.max_length,(s.cur_length/1024) set s.absloc,first_free_word set first_free_word,first_free_word+s.cur_length &end macro branch set s.2,s.2+slte_uns.branch_required set s.path,name_seg_size set s.rings,R055 &end macro unpaged_seg maclist on use sltes maclist object zero name_seg_size+sl1_path_size+10*seg_index,s.path vfd 4/s.access,14/s.1,18/s.2 vfd 9/((s.cur_length+1023)/1024),9/s.rings,18/s.segno vfd 3/0,9/s.max_length,24/36*s.cur_length maclist on use template_dseg maclist object vfd 24/s.absloc,9/s.rings,1/(1-sf.abs_seg),2/0 vfd 1/0,14/(s.cur_length/16-1),4/s.access,1/1,1/1,1/0,14/0 maclist on use adp_template_dseg maclist object vfd 22/(s.absloc/16),4/0,1/(1-sf.abs_seg),9/s.rings vfd 14/(s.cur_length/16-1),4/0,12/0,4/s.access,1/1,1/1 maclist on use definitions maclist off segdef &1_ptr segdef &1_absloc segdef &1_lth even maclist on &1_ptr: its s.segno,0 &1_absloc: vfd 36/s.absloc &1_lth: vfd 36/s.cur_length maclist off &end macro paged_seg &=&2,sup&[ use template_upt set s.upt_address,upt_end+upt_absloc+upt_entry.ptws &; use template_init_upt set s.upt_address,iupt_end+iupt_absloc+upt_entry.ptws &] maclist on use sltes maclist object zero name_seg_size+sl1_path_size+10*seg_index,s.path vfd 4/s.access,14/s.1,18/s.2 vfd 9/((s.cur_length+1023)/1024),9/s.rings,18/s.segno vfd 3/0,9/s.max_length,24/36*s.cur_length maclist off &^=&3,norm&[ set s.page_table_length,s.max_length &; set s.page_table_length,(s.cur_length/1024) &] maclist on use template_dseg maclist object vfd 24/s.upt_address,9/s.rings,1/1,2/0 vfd 1/0,14/(s.page_table_length*64-1),4/s.access,1/0,1/1,1/0,14/0 maclist on use adp_template_dseg maclist object vfd 26/s.upt_address,1/1,9/s.rings vfd 8/(s.page_table_length-1),10/0,12/0,4/s.access,1/0,1/1 maclist off &=&2,init&[ set iupt_end,iupt_end+upt_entry.ptws+(((s.page_table_length)+1)/2)*2 maclist on use template_init_upt &; set upt_end,upt_end+upt_entry.ptws+(((s.page_table_length)+1)/2)*2 maclist on use template_upt &] maclist object vfd 36/s.page_table_length vfd 36/s.segno maclist off &^=&3,abs_seg&[ set s.running_absloc,s.absloc dup (s.cur_length/1024) maclist object vfd 18/(s.running_absloc/64),4o/10,1/1,1/0,2/0,1/0,1/0,1/0,1/0,1/0,1/1,1/0,1/1,2/1 maclist off set s.running_absloc,s.running_absloc+1024 dupend &;&] &^=&3,norm&[ dup (s.max_length-(s.cur_length/1024)) maclist object " pad with bad pages vfd 18/0,4o/10,1/1,1/0,2/0,1/0,1/0,1/0,1/0,1/0,1/1,1/0,1/0,2/1 dupend &;&] even maclist on &=&2,init&[ use adp_template_init_upt &; use adp_template_upt &] maclist object vfd 36/s.page_table_length vfd 36/s.segno maclist off &^=&3,abs_seg&[ set s.running_absloc,s.absloc dup (s.cur_length/1024) maclist object vfd 2/0,16/(s.running_absloc/1024),4/0,1/0,1/1,1/0,1/0,1/0,3/0,1/1,1/1,1/0,1/1,1/0,1/0 maclist off set s.running_absloc,s.running_absloc+1024 dupend &;&] &^=&3,norm&[ dup (s.max_length-(s.cur_length/1024)) maclist object " pad with bad pages vfd 2/0,16/0,4/0,1/0,1/1,1/0,1/0,1/0,3/0,1/1,1/0,1/0,1/0,1/0,1/0 dupend &;&] even maclist on use definitions maclist off segdef &1_ptr segdef &1_absloc segdef &1_lth even maclist on &1_ptr: its s.segno,0 &1_absloc: vfd 36/s.absloc &1_lth: vfd 36/s.cur_length maclist off &end " equ FIRST_SUP_SEG,0 equ FIRST_INIT_SEG,256 bool R055,055 set sup_segno,FIRST_SUP_SEG-1 set init_segno,FIRST_INIT_SEG-1 set upt_end,upt.first_entry set iupt_end,upt.first_entry set seg_index,-1 set first_free_word,prb_absloc+prb_lth use template_dseg dseg: use adp_template_dseg adp_dseg: use template_upt org upt.first_entry use template_init_upt org upt.first_entry use adp_template_upt org upt.first_entry use adp_template_init_upt org upt.first_entry use names sl1_path: dec 17 " count aci ">system_library_1",17 dec 0 " ACL equ sl1_path_size,*-sl1_path maclist off seg dseg,sup " The DSEG must be segment 0. access read,write flags wired,paged,per_process allocate 2000 set s.max_length,8 paged_seg dseg,init,norm " dseg is perm but page table is temp " since it becomes paged use .text dsbr: vfd 24/s.upt_address,12/0 vfd 1/0,14/(1024/16-1),4/0,1/0,4/0,12/0 adp_dsbr: vfd 26/s.upt_address,10/0 vfd 8/(1024/1024-1),6/0,4/0,12/0,4/0,1/0,1/0 seg bos_toehold,sup access read,write flags wired,layout_seg absloc 10000,2000 paged_seg bos_toehold,sup,norm seg config_deck,sup access read,write absloc 12000,10000 flags abs_seg,paged branch paged_seg config_deck,init,norm becomes paged seg dn355_mailbox,sup access read,write flags wired,layout_seg absloc 3400,3000 unpaged_seg dn355_mailbox,sup seg fault_vector,sup access read,write flags wired,layout_seg absloc 0,600 unpaged_seg fault_vector,sup seg flagbox,sup access read,write flags wired,layout_seg absloc fgbx_absloc,fgbx_lth paged_seg flagbox,sup,norm seg name_table,sup access read,write flags paged allocate 14000 set s.max_length,12 branch paged_seg name_table,init,norm seg slt,sup " The SLT must be segment 7. access read,write flags paged allocate 4000 branch paged_seg slt,init,norm seg toehold_data,sup access read,write flags wired,layout_seg absloc toedata_absloc,toedata_lth paged_seg toehold_data,sup,norm seg iom_mailbox,sup access read,write flags wired,layout_seg absloc 1200,2200 unpaged_seg iom_mailbox,sup seg unpaged_page_tables,sup access read,write flags wired,layout_seg absloc upt_absloc,upt_lth paged_seg unpaged_page_tables,sup,norm seg toehold,sup access read,write flags wired,layout_seg absloc toe_absloc,toe_lth paged_seg toehold,sup,norm seg breakpoint_page,sup access read,write flags wired,layout_seg absloc bkpt_absloc,bkpt_lth paged_seg breakpoint_page,sup,norm seg bound_bootload_0,init access read,execute,write,privileged flags paged,abs_seg " we destroy ourselves absloc bbl0_absloc,bbl0_lth paged_seg bound_bootload_0,init,norm seg physical_record_buffer,init access read,write flags paged absloc prb_absloc,prb_lth paged_seg physical_record_buffer,init,norm seg abs_seg0,init access read,execute,write,privileged flags abs_seg set s.max_length,256 set s.cur_length,0 paged_seg abs_seg0,init,abs_seg seg int_unpaged_page_tables,init access read,write flags paged,abs_seg " we destroy ourselves absloc iupt_absloc,iupt_lth paged_seg int_unpaged_page_tables,init,norm seg early_dump,init access read,execute,write,privileged flags abs_seg set s.max_length,1 set s.cur_length,0 paged_seg early_dump,init,abs_seg use slt_header t_slt: its name_table_seg_num,0 vfd 36/first_free_word vfd 36/FIRST_SUP_SEG vfd 36/sup_segno vfd 36/FIRST_INIT_SEG vfd 36/init_segno dec 0 equ name_words,name_seg_size+sl1_path_size+(seg_index+1)*10 use name_header t_name_table: zero 0,name_words bss ,name_seg_size-1 use template_header name_table_length: vfd 36/name_words slt_length: vfd 36/slt.seg+(seg_index+1)*slte_size " This is so the checker can find things in this segment. use map even zero t_slt,t_name_table zero -1,-1 use template_upt org 0 upt: vfd 36/0 " sst_absloc vfd 36/0 " sst_last_loc vfd 36/upt_absloc " upt_absloc vfd 36/upt_absloc+upt_lth-1 " upt_last_loc vfd 36/iupt_absloc " iupt_absloc vfd 36/iupt_absloc+iupt_lth-1 " iupt_last_loc vfd 36/upt_end vfd 36/upt_lth use template_init_upt org 0 init_upt: vfd 36/0 " sst_absloc vfd 36/0 " sst_last_loc vfd 36/upt_absloc " upt_absloc vfd 36/upt_absloc+upt_lth-1 " upt_last_loc vfd 36/iupt_absloc " iupt_absloc vfd 36/iupt_absloc+iupt_lth-1 " iupt_last_loc vfd 36/iupt_end vfd 36/iupt_lth use adp_template_upt org 0 adp_upt: vfd 36/0 " sst_absloc vfd 36/0 " sst_last_loc vfd 36/upt_absloc " upt_absloc vfd 36/upt_absloc+upt_lth-1 " upt_last_loc vfd 36/iupt_absloc " iupt_absloc vfd 36/iupt_absloc+iupt_lth-1 " iupt_last_loc vfd 36/upt_end vfd 36/upt_lth use adp_template_init_upt org 0 adp_init_upt: vfd 36/0 " sst_absloc vfd 36/0 " sst_last_loc vfd 36/upt_absloc " upt_absloc vfd 36/upt_absloc+upt_lth-1 " upt_last_loc vfd 36/iupt_absloc " iupt_absloc vfd 36/iupt_absloc+iupt_lth-1 " iupt_last_loc vfd 36/iupt_end vfd 36/iupt_lth join /text/template_header join /text/slt_header,sltes join /text/name_header,names join /text/template_dseg join /text/adp_template_dseg join /text/definitions join /text/template_upt join /text/adp_template_upt join /text/template_init_upt join /text/adp_template_init_upt join /text/map " this MUST be last end bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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