/* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ initialize_peek_limits: proc; /* Program to define regions of hardcore which can be accessed via metering_ring_zero_peek_. The latter is a ring-1 gate which calls a routine to "filter" ring_zero_peek_ requests for users who do not have access to phcs_ (of course, such users must have access to metering_ring_zero_peek_). This program builds a table of accessible regions from an ASCII segment. This table resides in >sl1>ring_zero_meter_limits.table. This program should be run as part of system_start_up.ec. Until it runs, no hardcore area is available via metering_ring_zero_peek_. Command call sequence: initialize_peek_limits where is the path name of the ASCII segment. Normally, is >system_library_1>ring_zero_meter_limits.ascii, which is loaded from Collection 3; however, it can be site-supplied. The format of the ASCII segment is as follows. There is a statement for each hardcore region, in one of the following forms: : ; : ; : ; : ; : ; where is either the name of a hardcore segment or a hardcore segment number is either an offset into the segment (decimal) which is the first word of an accessible region, or the name of an externally accessible symbol in the segment which represents the first word of an accessible region is the length of the accessible region in words is the name of an externally accessible symbol in the segment which represents the first word beyond the end of the accessible region. If is not supplied, the accessible region is assumed to begin at offset 0 within the segment. If only is supplied, the accessible region is the entire segment. Written December 80 by J. Bongiovanni */ /* */ /* Automatic */ dcl abs_filename char (168); dcl any_parse bit (1); dcl bc fixed bin (24); dcl begin_offset fixed bin (18); dcl code fixed bin (35); dcl delim_type fixed bin; dcl dirname char (168); dcl end_offset fixed bin (18); dcl entryname char (32); dcl field_ptr ptr; dcl field_l fixed bin (21); dcl field_type fixed bin; dcl filename_l fixed bin (21); dcl filename_p ptr; dcl file_l fixed bin (21); dcl file_ptr ptr; dcl high_seg fixed bin; dcl ignore bit (1); dcl low_seg fixed bin; dcl marrayp ptr; dcl nargs fixed bin; dcl one_begin bit (1); dcl one_seg bit (1); dcl rcode fixed bin (35); dcl seg_no fixed bin; dcl seg_ptr ptr; dcl type fixed bin; /* Static */ dcl LIMITSEG_DIR char (17) init (">system_library_1") int static options (constant); dcl LIMITSEG_NAME char (28) init ("ring_zero_meter_limits.table"); dcl MAX_OFFSET fixed bin (19) init (262143) int static options (constant); dcl my_name char (22) init ("initialize_peek_limits") int static options (constant); dcl (NUMERIC init (0), NON_NUMERIC init (1)) fixed bin int static options (constant); dcl (SEMI init (1), COLON init (2), WHITE_SPACE init (3), END_OF_SCAN init (4)) fixed bin int static options (constant); /* Based */ dcl field char (field_l) based (field_ptr); dcl filename char (filename_l) based (filename_p); %include meter_limits; dcl 1 meter_limits_array (0:1) aligned based (marrayp) like meter_limits_entry; /* Entry */ dcl com_err_ entry options (variable); dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)); dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)); dcl get_temp_segment_ entry (char(*), ptr, fixed bin(35)); dcl hcs_$high_low_seg_count entry (fixed bin, fixed bin); dcl hcs_$initiate_count entry (char(*), char(*), char(*), fixed bin(24), fixed bin(2), ptr, fixed bin(35)); dcl hcs_$terminate_noname entry (ptr, fixed bin(35)); dcl installation_tools_$patch_path entry (char(*), char(*), fixed bin (18), ptr, fixed bin (18), fixed bin (35)); dcl release_temp_segment_ entry (char(*), ptr, fixed bin(35)); dcl ring0_get_$definition entry (ptr, char(*), char(*), fixed bin(18), fixed bin, fixed bin (35)); dcl ring0_get_$segptr entry (char(*), char(*), ptr, fixed bin (35)); /* External */ dcl error_table_$badsyntax fixed bin (35) external; dcl error_table_$segknown fixed bin (35) external; dcl error_table_$zero_length_seg fixed bin (35) external; /* Condition */ dcl cleanup condition; dcl size condition; /* Builtin */ dcl addr builtin; dcl baseno builtin; dcl baseptr builtin; dcl bin builtin; dcl currentsize builtin; dcl divide builtin; dcl fixed builtin; dcl index builtin; dcl null builtin; dcl ptr builtin; dcl rel builtin; dcl rtrim builtin; dcl search builtin; dcl verify builtin; /* */ code = 0; file_ptr, mtablep = null(); on cleanup call Mr_Clean; call get_temp_segment_ (my_name, mtablep, code); if code^=0 then call Complain ("Cannot get temp segment"); meter_limits_table.initialized = "1"b; call hcs_$high_low_seg_count (high_seg, low_seg); meter_limits_table.high_seg_no = low_seg - 1; /* highest supervisor seg number */ marrayp = ptr (mtablep, currentsize (meter_limits_table)); /* first allocatable entry */ call cu_$arg_count (nargs); if nargs^=1 then call Complain ("Usage is: initialize_peek_limits "); call cu_$arg_ptr (1, filename_p, filename_l, code); call expand_pathname_ (filename, dirname, entryname, code); if code^=0 then call Complain (filename); abs_filename = rtrim (dirname) || ">" || rtrim (entryname); call hcs_$initiate_count (dirname, entryname, "", bc, 0, file_ptr, code); if code^=0&code^=error_table_$segknown then call Complain (abs_filename); if bc=0 then do; code = error_table_$zero_length_seg; call Complain (abs_filename); end; file_l = divide (bc, 9, 21); /* */ /* romp through input file and build table of allowable peek regions */ delim_type = 0; seg_no = -1; begin_offset = 0; end_offset = MAX_OFFSET; any_parse, one_seg, one_begin, ignore = "0"b; on size goto syntax_error; do while (delim_type^=END_OF_SCAN); call next_field (file_ptr, file_l, field_ptr, field_l, delim_type, field_type); if delim_type = COLON then do; /* field is segment name or number */ if^ignore then do; any_parse = "1"b; if one_seg then do; /* already have segment name or number */ syntax_error: code = error_table_$badsyntax; call Complain (abs_filename); end; if field_type = NUMERIC then seg_no = fixed (field, 17); else do; call ring0_get_$segptr ("", field, seg_ptr, rcode); if rcode^=0 then do; call com_err_ (0, my_name, "Segment ^a not found.", field); ignore = "1"b; end; seg_no = bin (baseno (seg_ptr), 17); end; one_seg = "1"b; end; end; else if delim_type = WHITE_SPACE then do; /* begin offset or symbol */ if ^ignore then do; any_parse = "1"b; if one_begin then goto syntax_error; if seg_no = -1 then goto syntax_error; if field_type = NUMERIC then begin_offset = fixed (field, 18); else do; call ring0_get_$definition (baseptr (seg_no), "", field, begin_offset, type, rcode); if rcode^=0 then do; call com_err_ (0, my_name, "Symbol ^a not found.", field); ignore = "1"b; end; end; one_begin = "1"b; end; end; else if delim_type = SEMI then do; /* end symbol or length */ if ^ignore then do; if seg_no = -1 then goto syntax_error; if field^="" then do; /* no end or length => whole segment accessible */ if field_type=NUMERIC then do; if fixed (field, 18)>= MAX_OFFSET+1 then goto syntax_error; end_offset = begin_offset + fixed (field) -1; end; else do; call ring0_get_$definition (baseptr (seg_no), "", field, end_offset, type, rcode); if rcode^=0 then do; call com_err_ (0, my_name, "Symbol ^a not found.", field); ignore = "1"b; end; end_offset = end_offset - 1; end; end; end; if ^ignore then do; if seg_no<0 | seg_no>meter_limits_table.high_seg_no then goto syntax_error; if begin_offset>end_offset then goto syntax_error; mentryp = marrayp; meter_limits_entry.thread = meter_limits_table.thread_head (seg_no); meter_limits_entry.begin_offset = begin_offset; meter_limits_entry.end_offset = end_offset; meter_limits_table.thread_head (seg_no) = fixed (rel (mentryp)); marrayp = addr (meter_limits_array (1));/* point to next free */ end; ignore, any_parse, one_seg, one_begin = "0"b; begin_offset = 0; end_offset = MAX_OFFSET; end; else if any_parse then goto syntax_error; /* end of text in middle of statement */ end; revert size; call installation_tools_$patch_path (LIMITSEG_DIR, LIMITSEG_NAME, 0, mtablep, bin (rel (marrayp), 18), code); if code^=0 then call Complain ("Cannot copy into " || rtrim (LIMITSEG_DIR) || ">" || rtrim (LIMITSEG_NAME)); call Mr_Clean; EXIT: return; /* */ /* Internal procedure to print an error message and terminate */ Complain: proc (why); dcl why char (*); call com_err_ (code, my_name, why); goto EXIT; end Complain; /* Internal procedure to clean up before quitting (normal or otherwise */ Mr_Clean: proc; dcl acode fixed bin (35); if file_ptr^=null() then call hcs_$terminate_noname (file_ptr, acode); if mtablep^=null() then call release_temp_segment_ (my_name, mtablep, acode); end Mr_Clean; /* */ /* Internal procedure to scan a text for the next field, return that field, and an indication of the delimeter following the field. Additionally, the text pointers are updated for the next call. In this scan, PL1-type comments are bypassed */ next_field: proc (scan_ptr, scan_len, field_ptr, field_len, del_type, field_type); dcl scan_ptr ptr; /* pointer to start of text */ dcl scan_len fixed bin (21); /* length of text */ dcl field_ptr ptr; /* pointer to start of field */ dcl field_len fixed bin (21); /* length of field */ dcl del_type fixed bin; /* indicates delimeter following field */ dcl field_type fixed bin; /* indicates numeric or non-numeric */ dcl l fixed bin; dcl DELIM char (5) init (" :;") int static options (constant); /* space, NL, TAB, :, ; */ dcl WS_DELIM char (3) init (" ") int static options (constant); /* space, NL, TAB */ dcl field char (field_len) based (field_ptr); dcl next_1 char (1) based (scan_ptr); dcl next_2 char (2) based (scan_ptr); dcl scan char (scan_len) based (scan_ptr); dcl scan_array (scan_len) char (1) based (scan_ptr); if scan_len<=0 then do; zero_length: delim_type = END_OF_SCAN; return; end; if ^remove_white_space() then goto zero_length; /* ran out of text */ field_ptr = scan_ptr; l = search (scan, DELIM); /* look for delimeter after field */ if l=0 then field_len = scan_len; /* text ends with this field */ else field_len = l-1; scan_ptr = addr (scan_array (field_len+1)); /* next place to look for field */ scan_len = scan_len - field_len; /* remaining chars in text */ if ^remove_white_space() /* only white space remaining in text */ then del_type = WHITE_SPACE; else if next_1=";" then del_type = SEMI; else if next_1=":" then del_type = COLON; else del_type = WHITE_SPACE; if del_type^=WHITE_SPACE then do; /* bump pointer past delimeter */ scan_ptr = addr (scan_array (2)); scan_len = scan_len - 1; end; if verify (field, "0123456789") = 0 then field_type = NUMERIC; else field_type = NON_NUMERIC; return; /* Internal procedure to next_field which removes white space by adjusting scan_ptr and scan_len to skip over such. PL1-type comments are also bypassed here. A bit(1) value is returned to indicate end of text - "0"b for end-of-text, "1"b otherwise */ remove_white_space: proc returns (bit (1)); dcl l fixed bin (21); do while ("1"b); if scan_len<=0 then do; /* no text left--easy case */ return_empty: scan_ptr = addr (scan_array (scan_len + 1)); scan_len = 0; /* set end of text */ return ("0"b); end; l = verify (scan, WS_DELIM); if l=0 then goto return_empty; /* ran out of text */ scan_ptr = addr (scan_array (l)); /* point to first non-delimeter */ scan_len = scan_len-l+1; if next_2="/*" then do; /* PL1-type comment */ l = index (scan, "*/"); /* end of comment */ if l=0 then return ("0"b); /* no end of comment */ scan_ptr = addr (scan_array (l+2)); /* point to 1st character past end of comment */ scan_len = scan_len-l-1; end; else return ("1"b); end; end remove_white_space; end next_field; end initialize_peek_limits; */ ----------------------------------------------------------- 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 */