bootload_fs.pl1 07/20/88 1256.2r w 07/19/88 1535.0 207666 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bootload_fs: procedure options (variable); /* format: style4,indattr,insnl,delnl */ /* command interface to bootload_fs_ for service use. Benson I. Margulies November 1980 Miscelaneous fixes and renaming, Keith Loepere, May 1984. */ dcl bootload_fs_$init entry (bit (1) aligned, fixed bin (19), fixed bin (35)); dcl bootload_fs_$get entry (char (*), ptr, fixed bin (21), fixed bin (21), fixed bin (35)); dcl bootload_fs_$put entry (char (*), ptr, fixed bin (21), bit (1) aligned, fixed bin (35)); dcl bootload_fs_$list entry (area (*), ptr, fixed bin (35)); dcl bootload_fs_$delete entry (char (*), fixed bin (35)); dcl bootload_fs_$rename entry (char (*), char (*), fixed bin (35)); dcl hcs_$fs_get_seg_ptr entry (char (*), ptr, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl initiate_file_$create entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35)); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); dcl cu_$af_arg_count entry (fixed bin, fixed bin (35)); 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 expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl get_pdir_ entry () returns (char (168)); dcl get_system_free_area_ entry () returns (ptr); dcl command_query_ entry () options (variable); dcl com_err_ entry () options (variable); dcl com_err_$suppress_name entry () options (variable); dcl mdc_$pvname_info entry (char (*), bit (36) aligned, char (*), bit (36) aligned, fixed bin, fixed bin (35)); dcl hphcs_$read_partition entry (bit (36) aligned, char (*), fixed bin (35), pointer, fixed bin (18), fixed bin (35)); dcl hphcs_$write_partition entry (bit (36) aligned, char (*), fixed bin (35), pointer, fixed bin (18), fixed bin (35)); dcl adjust_bit_count_ entry (char (168) aligned, char (32) aligned, bit (1) aligned, fixed bin (35), fixed bin (35)) ; dcl ioa_ entry () options (variable); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl char_count fixed bin (21); dcl seg_bits bit (bit_count) unal based; dcl bit_count_for_abc fixed bin (35); dcl new_part_length fixed bin (19); dcl bit_count fixed bin (24); dcl part_name char (4) unal; dcl answer char (32) varying; dcl pv_name char (32); dcl lvname char (32); dcl (t_pvid, lvid) bit (36) aligned; dcl device_type fixed bin; dcl code fixed bin (35); dcl file_name char (32); dcl dir_name char (168); dcl entryname char (32); dcl which_key fixed bin; dcl ap pointer; dcl al fixed bin (21); dcl argument char (al) based (ap); dcl areap pointer; dcl force bit (1); dcl must_be_new bit (1) aligned; dcl part_length fixed bin (18); dcl current_argument fixed bin; dcl an_area based (areap) area (1024); dcl seg_ptr pointer; dcl n_arguments fixed bin; dcl n_key_arguments fixed bin; dcl i fixed bin; %page; %include query_info; %include bootload_fs_list; %include access_mode_values; %include terminate_file; %page; dcl sys_info$max_seg_size fixed bin (35) ext static; dcl (cleanup, bootload_fs_bad_arg_parse) condition; dcl ( error_table_$action_not_performed, error_table_$active_function, error_table_$bad_arg, error_table_$bad_conversion, error_table_$inconsistent, error_table_$item_too_big, error_table_$noentry, error_table_$not_act_fnc, error_table_$too_many_args ) fixed bin (35) ext static; dcl Me char (11) init ("bootload_fs") int static options (constant); dcl Suffix char (7) init ("boot_fs") int static options (constant); dcl Write_partition init (2) fixed bin int static options (constant); dcl 1 Operations (11) int static aligned options (constant), 2 long_name char (32) unal init ("read_partition", "write_partition", "use_partition", "save_partition", "discard_partition", "init_partition", "read_file", "write_file", "list_files", "delete_file", "rename_file"), 2 medium_name char (32) unal init ("", "", "", "svpart", "", "", "read", "write", "list", "delete", "rename"), 2 short_name char (32) unal init ("rpart", "wpart", "upart", "spart", "dpart", "ipart", "r", "w", "ls", "dl", "rn"), 2 min_arguments init (2, 2, 1, 1, 0, 0, 2, 2, 0, 1, 2) fixed bin, 2 max_arguments init (2, 3, 1, 1, 1, 2, 2, 3, 0, 1, 2) fixed bin, 2 usage char (132) unal init ("pv_name part_name", /* read_partition */ "pv_name part_name", /* write_partition */ "path", /* use_partition */ "path", /* save_partition */ "{-control_arg}", /* discard_partition */ "{-control_arg}", /* init_partition */ "file_name path", /* read_file */ "path file_name", /* write_file */ "", /* list_files */ "file_name", /* delete_file */ "old_file_name new_file_name"); /* rename_file */ dcl 1 static_info internal static aligned, 2 flags aligned, ( 3 partition_valid, 3 temp_valid, 3 pv_info_valid ) bit (1) unal init (""b), 2 temp aligned, 3 tsp pointer, 3 dir_name char (168) unaligned, 3 entryname char (32) unal, 2 pv_info aligned, 3 name char (32) unal, 3 pvid bit (36) aligned, 3 part char (4) unal, 3 length fixed bin (35); dcl (addr, divide, hbound, index, length, min, null) builtin; call cu_$af_arg_count (n_arguments, code); if code = error_table_$not_act_fnc then code = 0; else if code = 0 then code = error_table_$active_function; if code ^= 0 then do; call com_err_ (code, Me); return; end; if n_arguments = 0 then do; call com_err_$suppress_name (0, Me, "Usage: bootload_fs Key {arguments}"); return; end; call init_arguments; call get_next_argument; do which_key = 1 to hbound (Operations, 1) while (argument ^= Operations (which_key).long_name & argument ^= Operations (which_key).medium_name & argument ^= Operations (which_key).short_name); end; if which_key > hbound (Operations, 1) then do; call com_err_ (error_table_$bad_arg, Me, "The ^a keyword does not exist.", argument); return; end; n_key_arguments = n_arguments - 1; if n_key_arguments < Operations (which_key).min_arguments | n_key_arguments > Operations (which_key).max_arguments then do; call com_err_$suppress_name (0, Me, "Usage: bootload_fs ^a ^a", Operations (which_key).long_name, Operations (which_key).usage); return; end; goto Keywords (which_key); /* frazzle the rope -- from now on its command by command */ %page; Keywords (2 /* write_partition */): /* These two parse the arguments identically */ force = ""b; if n_key_arguments = 1 then do; /* check for -force */ call get_this_argument (1); if argument = "-force" | argument = "-fc" then force = "1"b; else do; if index (argument, "-") = 1 then call com_err_ (error_table_$bad_arg, Me, "Invalid control argument ^a.", argument); else call com_err_ (error_table_$inconsistent, Me, "Both a Pvname and a Partition name must be given."); end; end; if static_info.pv_info_valid & n_key_arguments = 0 then goto PART_INFO_KNOWN; /* saving back where we had it */ /* else fall through into get code to find out about partition from arguments */ Keywords (1 /* read_partition */): call get_next_argument; /* unspecific, and we know its there */ pv_name = argument; call get_next_argument; if length (argument) > 4 then do; call com_err_ (error_table_$bad_arg, Me, "Partition names may be only 4 characters. ^a.", argument); return; end; part_name = argument; call mdc_$pvname_info (pv_name, t_pvid, lvname, lvid, device_type, code); if code ^= 0 then do; call com_err_ (code, Me, "Pv ^a.", pv_name); return; end; call get_part_info (t_pvid, part_name, part_length, code); if code ^= 0 then do; call com_err_ (code, Me, "Partition ^a on Pv ^a.", part_name, pv_name); return; end; if part_length > sys_info$max_seg_size then do; call com_err_ (0, Me, "Warning: Partition ^a on Pv ^a, length ^d, is longer than a segment. Only ^d words will be used.", part_name, pv_name, part_length, sys_info$max_seg_size); end; static_info.pv_info.name = pv_name; static_info.pv_info.part = part_name; static_info.pv_info.length = part_length; static_info.pv_info.pvid = t_pvid; static_info.pv_info_valid = "1"b; PART_INFO_KNOWN: if ^static_info.partition_valid then do; if which_key = Write_partition then do; call com_err_ (error_table_$action_not_performed, Me, "There is no partition to write."); return; end; call get_temp; end; /* split functions again */ goto READ_WRITE (which_key); READ_WRITE (1): /* read partition */ call ioa_ ("Starting read of Partition ^a of Pv ^a.", static_info.pv_info.part, static_info.pv_info.name); call hphcs_$read_partition (static_info.pv_info.pvid, static_info.pv_info.part, (0) /* beginning */, static_info.tsp, min (sys_info$max_seg_size, static_info.pv_info.length), code); /* read the data to temp seg */ if code ^= 0 then do; call com_err_ (code, Me, "Could not read partition."); return; end; call ioa_ ("Read completed."); static_info.partition_valid = "1"b; /* the temp segment now constains a partition */ return; /* End of Read_partition */ READ_WRITE (2): /* write partition */ /* at this point we supposedly know that there is a partition image in the temp segment. Query and write */ if ^force then do; query_info.version = query_info_version_4; query_info.yes_or_no_sw = "1"b; call command_query_ (addr (query_info), answer, Me, "Writing current partition into the ^a partition of volume ^a. ^/This operation will destroy the current contents of the partition. ^/Do you wish to proceed?" , static_info.pv_info.part, static_info.pv_info.name); if answer ^= "yes" then return; end; call ioa_ ("Starting write to Partition ^a of Pv ^a.", static_info.pv_info.part, static_info.pv_info.name); call hphcs_$write_partition (static_info.pv_info.pvid, static_info.pv_info.part, (0) /* beginning */, static_info.tsp, min (static_info.pv_info.length, sys_info$max_seg_size), code); if code ^= 0 then do; call com_err_ (code, Me, "Could not write partition."); return; end; call ioa_ ("Write completed."); return; /* end of write partition */ %page; Keywords (3 /* use partition */): call get_next_argument; /* its there */ seg_ptr = null (); on cleanup call clean_seg; call expand_pathname_$add_suffix (argument, Suffix, dir_name, entryname, code); if code ^= 0 then go to use_part_error; seg_ptr = null (); call initiate_file_ (dir_name, entryname, RW_ACCESS, seg_ptr, bit_count, code); if seg_ptr = null () then do; use_part_error: call com_err_ (code, Me, "^a", argument); return; end; if static_info.partition_valid then do; query_info.yes_or_no_sw = "1"b; query_info.version = query_info_version_4; call command_query_ (addr (query_info), answer, Me, "Information in working partition will be lost. ^[^/(copy of Partition ^a of Pv ^a)^;^]^/Do you wish to proceed?" , static_info.pv_info_valid, static_info.pv_info.part, static_info.pv_info.name); if answer ^= "yes" then return; end; static_info.tsp -> seg_bits = seg_ptr -> seg_bits;/* copy to temp segment */ static_info.partition_valid = "1"b; call bootload_fs_$init ("0"b, (0), code); /* inquire as to whether it is valid to warn early */ if code ^= 0 then call com_err_ (code, Me); return; /* end of use partition */ %page; Keywords (4 /* save partition */): if ^static_info.partition_valid then do; call com_err_ (error_table_$action_not_performed, Me, "No working partition to save."); return; end; call get_next_argument; on cleanup call clean_seg; call expand_pathname_$add_suffix (argument, Suffix, dir_name, entryname, code); if code ^= 0 then go to save_part_error; seg_ptr = null (); call initiate_file_$create (dir_name, entryname, RW_ACCESS, seg_ptr, ("0"b), (0), code); if seg_ptr = null () then do; save_part_error: call com_err_ (code, Me, "^a", argument); return; end; call adjust_bit_count_ ((static_info.temp.dir_name), (static_info.temp.entryname), ""b, bit_count_for_abc, code) ; bit_count = bit_count_for_abc; if bit_count < 0 then do; call com_err_ (code, Me, "Adjusting bc on temp seg."); call clean_seg; end; seg_ptr -> seg_bits = static_info.tsp -> seg_bits;/* home */ call terminate_file_ (seg_ptr, bit_count, TERM_FILE_BC | TERM_FILE_TERM, code); if code ^= 0 then call com_err_ (code, Me, "^a", argument); return; /* end of save partition */ %page; Keywords (5 /* discard */): /* throw out all static information, to avoid gratuitous queries and the like */ force = ""b; if n_key_arguments = 1 then do; /* perhaps -fc */ call get_next_argument; if argument = "-fc" | argument = "-force" then force = "1"b; else if index (argument, "-") = 1 then call com_err_ (error_table_$bad_arg, Me, "^a.", argument); else call com_err_ (error_table_$inconsistent, Me, "Spurious argument ^a.", argument); end; if static_info.partition_valid & ^force then do; query_info.version = query_info_version_4; query_info.yes_or_no_sw = "1"b; call command_query_ (addr (query_info), answer, Me, "Do you really want to discard the working partition?") ; if answer ^= "yes" then return; end; static_info.partition_valid = ""b; static_info.temp_valid = ""b; call terminate_file_ (static_info.tsp, 0, TERM_FILE_TRUNC, code); static_info.pv_info_valid = ""b; return; /* end of discard-partition */ %page; Keywords (6 /* init partition */): /* the two both look for -force */ new_part_length = -1; force = ""b; do i = 1 to n_key_arguments; call get_next_argument; if index (argument, "-") = 1 then do; if argument = "-force" | argument = "-fc" then force = "1"b; else do; call com_err_ (error_table_$bad_arg, Me, "^a.", argument); return; end; end; else do; /* has to be a length */ if new_part_length > -1 then do; call com_err_ (error_table_$too_many_args, Me, "Only one length may be supplied."); return; end; new_part_length = cv_dec_check_ (argument, code); if code ^= 0 then do; call com_err_ (error_table_$bad_conversion, Me, "Unable to convert ^a to an integer.", argument); return; end; end; if new_part_length > sys_info$max_seg_size then do; call com_err_ (error_table_$item_too_big, Me, "Bootload file partition may not be bigger than a segment."); return; end; end; /* have the info */ if new_part_length = -1 then new_part_length = sys_info$max_seg_size; if static_info.partition_valid & ^force then do; query_info.version = query_info_version_4; query_info.yes_or_no_sw = "1"b; call command_query_ (addr (query_info), answer, Me, "Do you really want to reinitialize the working partition?"); if answer ^= "yes" then return; end; call get_temp; static_info.partition_valid = "1"b; call bootload_fs_$init ("1"b, new_part_length, code); /* reinitialize */ if code ^= 0 then call com_err_ (code, Me); return; /* end of init partition */ %page; Keywords (7 /* read file */): if ^static_info.partition_valid then do; call com_err_ (error_table_$action_not_performed, Me, "No working partition exists. Use init_partition or read_partition."); return; end; call get_next_argument; /* file_name */ file_name = argument; call get_next_argument; /* get the pathname */ call expand_pathname_ (argument, dir_name, entryname, code); if code ^= 0 then do; call com_err_ (code, Me, "^a.", argument); return; end; seg_ptr = null (); call initiate_file_$create (dir_name, entryname, RW_ACCESS, seg_ptr, ("0"b), (0), code); if seg_ptr = null () then do; call com_err_ (code, Me, "^a>^a.", dir_name, entryname); return; end; call bootload_fs_$get (file_name, seg_ptr, sys_info$max_seg_size * 4, char_count, code); if code ^= 0 then do; call com_err_ (code, Me, "^a", file_name); call clean_seg; return; end; call terminate_file_ (seg_ptr, char_count * 9, TERM_FILE_BC | TERM_FILE_TERM, code); if code ^= 0 then call com_err_ (code, Me, "^a", argument); return; /* ent of get file */ %page; Keywords (8 /* write file */): if ^static_info.partition_valid then do; call com_err_ (error_table_$action_not_performed, Me, "No working partition exists. Use init_partition or read_partition."); return; end; call get_next_argument; /* get the pathname */ call expand_pathname_ (argument, dir_name, entryname, code); if code ^= 0 then do; call com_err_ (code, Me, "^a.", argument); return; end; seg_ptr = null (); call initiate_file_ (dir_name, entryname, R_ACCESS, seg_ptr, bit_count, code); if seg_ptr = null () then do; call com_err_ (code, Me, "^a>^a.", dir_name, entryname); return; end; call get_next_argument; /* file_name */ file_name = argument; must_be_new = ""b; if n_key_arguments = 3 then do; /* positional, but its only a (capitalist) tool */ call get_next_argument; if argument = "-new" then must_be_new = "1"b; else do; if index (argument, "-") = 1 then call com_err_ (error_table_$bad_arg, Me, "^a.", argument); else call com_err_ (error_table_$too_many_args, Me, "^a is extraneous.", argument); call clean_seg; return; end; end; call bootload_fs_$put (file_name, seg_ptr, divide (bit_count, 9, 21, 0), must_be_new, code); if code ^= 0 then call com_err_ (code, Me, "^a.", file_name); call clean_seg; return; /* end of put file */ %page; Keywords (9 /* list files */): if ^static_info.partition_valid then do; call com_err_ (error_table_$action_not_performed, Me, "No working partition exists."); return; end; areap = get_system_free_area_ (); call bootload_fs_$list (an_area, bootload_fs_list_ptr, code); if code ^= 0 then do; if code = error_table_$noentry then call ioa_ ("No files."); else call com_err_ (code, Me); return; end; call ioa_ ("Length^-File Name^/"); do i = 1 to bootload_fs_list.n_files; call ioa_ ("^d^-^a", bootload_fs_list.files (i).length, bootload_fs_list.files (i).name); end; free bootload_fs_list; return; /* end of list files */ %page; Keywords (10 /* delete */): if ^static_info.partition_valid then do; call com_err_ (error_table_$action_not_performed, Me, "No working partition exists."); return; end; call get_next_argument; call bootload_fs_$delete (argument, code); if code ^= 0 then call com_err_ (code, Me, "^a", argument); return; /* end of delete */ %page; Keywords (11 /* rename */): if ^static_info.partition_valid then do; call com_err_ (error_table_$action_not_performed, Me, "No working partition exists."); return; end; call get_next_argument; file_name = argument; call get_next_argument; call bootload_fs_$rename (file_name, argument, code); if code ^= 0 then call com_err_ (code, Me, "^a", file_name); return; /* end of rename */ %page; clean_seg: procedure; if seg_ptr ^= null () then call terminate_file_ (seg_ptr, (0), TERM_FILE_TERM, code); return; end clean_seg; init_arguments: procedure; dcl code fixed bin (35); current_argument = 1; return; get_next_argument: entry; call cu_$arg_ptr (current_argument, ap, al, code); if code ^= 0 then signal condition (bootload_fs_bad_arg_parse); current_argument = current_argument + 1; return; get_this_argument: entry (n); dcl n fixed bin; call cu_$arg_ptr (n, ap, al, code); if code ^= 0 then signal condition (bootload_fs_bad_arg_parse); return; end init_arguments; get_temp: procedure; dcl Partition_name char (32) static options (constant) init ("bootload_file_partition"); dcl refname_ptr ptr; if ^static_info.temp_valid then do; static_info.tsp = null (); static_info.temp.dir_name = get_pdir_ (); static_info.temp.entryname = Partition_name; call hcs_$make_seg (static_info.temp.dir_name, static_info.temp.entryname, Partition_name, RW_ACCESS_BIN, static_info.tsp, code); /* initiate with refname so bootload_fs_ can find */ if static_info.tsp = null () then do; call com_err_ (code, Me, "Can't initiate working file system."); go to RETURN; end; call hcs_$fs_get_seg_ptr (Partition_name, refname_ptr, code); if code ^= 0 | refname_ptr ^= static_info.tsp then do; call com_err_ (code, Me, "Refname ^a does not refer to temp file system in [pd].", Partition_name); call terminate_file_ (static_info.tsp, 0, TERM_FILE_TRUNC, code); go to RETURN; end; static_info.temp_valid = "1"b; end; end get_temp; %page; get_part_info: procedure (id, name, n_words, code); dcl id bit (36) aligned; dcl name char (4) unal; dcl n_words fixed bin (18); dcl code fixed bin (35); dcl phcs_$read_disk_label entry (bit (36) aligned, pointer, fixed bin (35)); labelp = null (); on cleanup begin; if labelp ^= null () then free label; end; allocate label; call phcs_$read_disk_label (id, labelp, code); if code ^= 0 then goto RETURN; code = error_table_$noentry; do i = 1 to label.nparts; if parts (i).part = name then do; n_words = parts (i).nrec * 1024; code = 0; end; end; RETURN: free label; return; %include fs_vol_label; end get_part_info; RETURN: return; end bootload_fs;  get_flagbox.pl1 06/01/84 1543.5r w 06/01/84 1426.2 42417 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Modified 9/83 by Keith Loepere for bce_command string */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ get_flagbox: proc; dcl af_result_len fixed bin; dcl af_result_ptr ptr; dcl arg_count fixed bin; dcl arg_len fixed bin; dcl arg_ptr ptr; dcl code fixed bin (35); dcl bce_command char (128); dcl flag_num fixed bin; dcl flags bit (36); dcl flags_to_reset bit (36) init ("0"b); dcl flags_to_set bit (36) init ("0"b); dcl name char (12) init ("get_flagbox"); dcl not_active_fnc bit (1) init ("0"b); dcl result char (256) var; dcl af_result char (af_result_len) var based (af_result_ptr); dcl arg char (arg_len) based (arg_ptr); dcl error_table_$badopt fixed bin (35) ext; dcl error_table_$not_act_fnc fixed bin (35) ext; dcl active_fnc_err_ entry options (variable); dcl active_fnc_err_$suppress_name entry options (variable); dcl com_err_ entry options (variable); dcl com_err_$suppress_name entry options (variable); dcl cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl phcs_$get_bce_command entry (char (128)); dcl phcs_$get_flagbox entry (bit (36)); dcl hphcs_$set_bce_command entry (char (128)); dcl hphcs_$set_flagbox entry (bit (36), bit (36)); dcl ioa_ entry options (variable); dcl requote_string_ entry (char (*)) returns (char (*)); dcl substr builtin; %page; call cu_$af_return_arg (arg_count, af_result_ptr, af_result_len, code); if code ^= 0 then if code = error_table_$not_act_fnc then do; not_active_fnc = "1"b; code = 0; end; if arg_count ^= 1 | code ^= 0 then do; if not_active_fnc then call com_err_$suppress_name (code, name, "Usage is: ^a .", name); else call active_fnc_err_$suppress_name (code, name, "Usage is: ^a .", name); return; end; call cu_$arg_ptr (1, arg_ptr, arg_len, code); if arg = "bce_command" then do; call phcs_$get_bce_command (bce_command); result = requote_string_ (bce_command); end; else do; flag_num = cv_dec_check_ (arg, code); if code ^= 0 then do; do flag_num = 1 to 36 while (arg ^= flagbox_flag_names (flag_num)); end; if flag_num > 36 then go to fail; end; call phcs_$get_flagbox (flags); if substr (flags, flag_num, 1) then result = "true"; else result = "false"; end; if not_active_fnc then call ioa_ (result); else af_result = result; return; %page; set_flagbox: entry; name = "set_flagbox"; not_active_fnc = "1"b; call cu_$arg_count (arg_count, code); if arg_count ^= 2 | code ^= 0 then do; call com_err_$suppress_name (code, name, "Usage is: ^a .", name); return; end; call cu_$arg_ptr (1, arg_ptr, arg_len, code); if arg = "bce_command" then do; call cu_$arg_ptr (2, arg_ptr, arg_len, code); bce_command = arg; call hphcs_$set_bce_command (bce_command); end; else do; flag_num = cv_dec_check_ (arg, code); if code ^= 0 then do; do flag_num = 1 to 36 while (arg ^= flagbox_flag_names (flag_num)); end; if flag_num > 36 then go to fail; end; call cu_$arg_ptr (2, arg_ptr, arg_len, code); if arg = "true" then substr (flags_to_set, flag_num, 1) = "1"b; else if arg = "false" then substr (flags_to_reset, flag_num, 1) = "1"b; else go to fail; call hphcs_$set_flagbox (flags_to_set, flags_to_reset); end; return; /* ------------------------------------------------------- */ fail: code = error_table_$badopt; if not_active_fnc then call com_err_ (code, name, arg); else call active_fnc_err_ (code, name, arg); return; %page; %include flagbox_flags; end get_flagbox; 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