act_proc.pl1 11/11/89 1107.3r w 11/11/89 0804.6 312525 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-05-09,Fawcett), approve(88-05-10,MCR7904), audit(88-06-24,Farley), install(88-08-22,MR12.2-1087): This change provides a cleanup based on the evolution of process creation. END HISTORY COMMENTS */ /* format: style4 */ /* ACT_PROC - Procedure to create and/or activate a process . This procedure assumes that the calling process has directory privileges, . so that it can create the KST, PDS, and PIT in the new, upgraded process directory. Last Modified: (Date and reason) 08/05/71 by Richard H. Gumpertz to combine pds, pdf 08/10/72 by Richard G. Bratt to implement "no permanent storage" users 740726 by PG to add AIM & audit info 741210 by PG to use privileged initiate on KST, PDS, and PIT. 750601 by RE Mullen (for priority scheduler) to call set_work_class 10/13/75 by R. Bratt for prelinking 760101 by REM for for deadline scheduler 03/23/76 by S. Webber for new reconfiguration 02/22/77 by THVV for dsegs with branches May 1978 by T. Casey to use active_hardcore_data$pdir_quota as a default value rather than an upper limit on pdir quotas, . giving system and project administrators complete flexibility in using the per-user pdir quota mechanism. August 1978 by Greenberg for variable-size DSEG's and KST's. May 1979 by Mike Grady for ring 0 stack sharing. Modified July 1979 by T. Casey for MR8.0 to add set_pit_tty_info entry point for process preservation across hangups. Modified January 1981 by Benson I. Margulies for change of outer module on reconnection. Modified February 1983 by E. N. Kittlitz for default kst 256k connection enabling. Modified October 1984 by Keith Loepere to use fs_modes. Modified 1984-11-11 by E. Swenson for IPC event channel validation; act_proc$create initializes apte.ipc_r_offset. Modified December 1984 by Keith Loepere to set pds$throttle_segment_state_changes. Modified December 1984 by Keith Loepere for pdir_dir_quota. */ act_proc: procedure; /* Variables */ dcl PRELINKED_DIR char (64); dcl abs_ptr ptr; dcl bc fixed bin (24); dcl evolution fixed bin (17); /* tracks the creation of a process */ dcl 1 branch_info like create_branch_info aligned; /* need auto store for this structure */ dcl clr_size fixed bin; dcl code fixed bin (35); dcl ignore_code fixed bin (35); dcl cp ptr; dcl daemon_sw bit (1) aligned; dcl dbr fixed bin (71); dcl 1 dir_acl (3) aligned, /* structure for placing 3 ACLs on directories */ 2 userid char (32), 2 mode bit (36), 2 status_code fixed bin (35); dcl dir_aclp ptr; dcl dseg_ptr ptr; dcl dseg_size fixed bin (19); dcl dstep ptr; dcl esw fixed bin; dcl hd char (32); dcl i fixed bin; dcl is_absentee bit (1) aligned; dcl kst_ptr ptr; dcl kst_size fixed bin (19); dcl local_audit_event_flags bit (36) aligned; dcl lot_size fixed bin; dcl max_authorization bit (72) aligned; dcl max_lot fixed bin; dcl n fixed bin; dcl p ptr; dcl p1 ptr; dcl p2 ptr; dcl pdir_dir_quota fixed bin (17); dcl pdir_entry char (15); dcl pdir_path char (32); dcl pdir_quota fixed bin (17); dcl pds_astep ptr; dcl pds_ptr ptr; dcl pid bit (36) aligned; dcl process_authorization bit (72) aligned; dcl process_group char (32) aligned; dcl rings (3) fixed bin (3); dcl savring fixed bin; dcl 1 seg_acl (3) aligned, /* structure for placing 3 ACLs on segments */ 2 userid char (32), 2 mode bit (36), 2 exmode bit (36), 2 status_code fixed bin (35); dcl seg_aclp ptr; dcl seg_rb (3) fixed bin; dcl segno fixed bin; dcl stop_type bit (1) aligned; dcl template_dsegp ptr; dcl template_kstp ptr; dcl tsdw fixed bin (71); dcl work_class fixed bin; /* Based */ dcl 1 ack_name aligned based, 2 person char (32), 2 project char (32), 2 tag char (1); dcl based_dseg (0:n) fixed bin (71) based; dcl copy_audit bit (36) aligned based; dcl copy_authorization bit (72) aligned based; dcl copy_chn_name fixed bin (71) based; dcl copy_data (n) fixed bin based; dcl copy_dir_name char (32) aligned based; dcl copy_dstep bit (18) aligned based; dcl copy_event_count fixed bin based; dcl copy_group_id char (32) aligned based; dcl copy_home_dir char (64) aligned based; dcl copy_id bit (36) aligned based; dcl copy_prelinked_ring (7) bit (1) unaligned based; dcl copy_ptr ptr based; dcl copy_ring fixed bin based; dcl copy_size (0:7) fixed bin based; dcl copy_throttle_seg_state_chg bit (1) aligned based; dcl copy_time fixed bin (71) based; dcl 1 stack aligned based (sb), 2 header like stack_header, 2 first_frame fixed bin; /* External */ dcl abs_seg$ fixed bin ext; dcl active_all_rings_data$default_max_segno fixed bin (17) ext; dcl active_all_rings_data$hcscnt fixed bin (18) ext; dcl active_all_rings_data$max_segno fixed bin (17) ext; dcl active_all_rings_data$stack_base_segno fixed bin (18) ext; dcl active_hardcore_data$pdir_dir_quota fixed bin ext; dcl active_hardcore_data$pdir_quota fixed bin ext; dcl dseg$ fixed bin ext; dcl error_table_$ai_restricted fixed bin (35) external static; dcl error_table_$apt_full fixed bin (35) external static; dcl error_table_$invalid_subsystem fixed bin (35) ext; dcl error_table_$smallarg fixed bin (35) external static; dcl kst_seg$ fixed bin ext; dcl pds$ fixed bin ext; dcl pds$access_authorization bit (72) aligned external static; dcl 1 pds$access_name aligned external, 2 person char (32), 2 project char (32), 2 tag char (1); dcl pds$account_id bit (36) aligned external; dcl pds$apt_ptr ptr ext; dcl pds$audit_flags bit (36) aligned external static; dcl pds$clr_stack_size (0:7) fixed bin ext; dcl pds$covert_event_count fixed bin ext; dcl pds$dstep bit (18) aligned ext; dcl pds$first_covert_event_time fixed bin (71) ext; dcl pds$highest_ring fixed bin ext; dcl pds$home_dir char (168) aligned external; dcl pds$initial_procedure ptr ext; dcl pds$initial_ring fixed bin ext; dcl pds$interrupt_ring fixed bin ext; dcl pds$last_sp ptr ext aligned; dcl pds$lock_id bit (36) aligned ext; dcl pds$lot_stack_size (0:7) fixed bin ext; dcl pds$max_access_authorization bit (72) aligned external static; dcl pds$max_lot_size (0:7) fixed bin ext; dcl pds$prelinked_ring (7) bit (1) unaligned ext; dcl pds$process_dir_name char (32) aligned ext; dcl pds$process_group_id char (32) aligned ext; dcl pds$processid bit (36) aligned ext; dcl pds$term_channel fixed bin (71) ext; dcl pds$term_proc bit (36) aligned external; dcl pds$throttle_segment_state_changes bit (1) aligned ext; dcl sst$seg_state_change_limit fixed bin external; dcl sys_info$access_class_ceiling bit (72) aligned external static; dcl sys_info$default_256K_enable fixed bin ext; dcl sys_info$page_size fixed bin ext; dcl sys_info$time_of_bootload fixed bin (71) ext; dcl tc_data$pdscopyl fixed bin ext; dcl tc_data$stat (0:5) fixed bin ext; dcl tc_data$timax fixed bin ext; dcl template_pds$ fixed bin ext; /* Entries */ dcl acc_name_$elements entry (ptr, ptr, fixed bin (35)); dcl access_audit_$check_general_user entry (bit (36) aligned, bit (36) aligned, bit (72) aligned, bit (36) aligned) returns (bit (1) aligned); dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin, char (*) aligned, fixed bin, fixed bin, fixed bin (24), fixed bin (35)); dcl append$create_branch_ entry (char (*), char (*), ptr, fixed bin (35)); dcl asd_$replace_dall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35)); dcl asd_$replace_sall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35)); dcl chname$cfile entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl delentry$dfile entry (char (*), char (*), fixed bin (35)); dcl del_dir_tree entry (char (*), char (*), fixed bin (35)); dcl fs_modes entry (ptr, bit (36) aligned, bit (36) aligned, (3) fixed bin (3), fixed bin (35)); dcl get_ptrs_$given_astep ext entry (ptr) returns (fixed bin (71)); dcl getuid ext entry returns (bit (36) aligned); dcl grab_aste entry (ptr, fixed bin (18), fixed bin (35)) returns (ptr); dcl grab_aste$prewithdraw entry (ptr, fixed bin (18), fixed bin (35)) returns (ptr); dcl init_proc entry; dcl initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); dcl initiate$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); dcl initiate$priv_init entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); dcl level$get ext entry (fixed bin); dcl level$set ext entry (fixed bin); dcl pxss$empty_t ext entry (ptr); dcl pxss$get_entry ext entry (ptr); dcl pxss$set_work_class ext entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35)); dcl syserr$error_code entry options (variable); dcl terminate_$noname ext entry (ptr, fixed bin (35)); dcl unique_chars_ entry (bit (*)) returns (char (15)); /* constants */ dcl CREATE init (0) fixed bin static options (constant); dcl INFO init (1) fixed bin static options (constant); dcl NORMAL_EVOLUTION_TERMINATION init (1) fixed bin static options (constant); dcl REW_bit bit (5) static options (constant) init ("1110"b); dcl RW_mode fixed bin (5) initial (01010b) static options (constant); /* mode bits for segments we create */ dcl SMA_bit bit (5) static options (constant) init ("111"b); dcl SMA_mode fixed bin (5) initial (01011b) static options (constant); /* mode bits for directories we create */ dcl dir_rb (3) fixed bin static options (constant) init (7, 7, 7); /* builtins */ dcl (addr, baseno, baseptr, binary, bin, bit, clock, divide, fixed, length, max, min, null, ptr, rel, rtrim, size, string, substr, unspec) builtin; /* Parameters */ dcl a_code fixed bin (35) parameter; dcl ci_ptr ptr parameter; %page; create: entry (ci_ptr, a_code); evolution = NORMAL_EVOLUTION_TERMINATION; /* the normal evolution exit */ esw = CREATE; /* set entry switch indicating create entry */ cp = ci_ptr; /* copy input pointer */ call level$get (savring); /* save validation level */ call level$set (0); /* and reset to zero */ /* Validate the process authorization & max authorization against the system access_ceiling */ process_authorization = cp -> create_info.process_authorization; max_authorization = cp -> create_info.max_process_authorization; if ^aim_check_$greater_or_equal (sys_info$access_class_ceiling, max_authorization) then go to return_ai_error; if ^aim_check_$greater_or_equal (max_authorization, process_authorization) then do; return_ai_error: code = error_table_$ai_restricted; /* auth <= max <= ceiling */ go to EVOLUTION_CLEANUP (evolution); end; call pxss$get_entry (aptep); /* get an APT entry for the new process */ if aptep = null then do; /* if null, no more room */ code = error_table_$apt_full; /* return non-zero code */ go to EVOLUTION_CLEANUP (evolution); end; evolution = evolution + 1; /* ADD apte removal */ cp -> create_info.processid.rel_apte = rel (aptep); /* return rest of processid */ pid = string (cp -> create_info.processid); /* copy the processid */ pdir_entry = unique_chars_ ((pid)); pdir_path = ">process_dir_dir>" || pdir_entry; /* get path name */ process_group = cp -> create_info.process_group_id; /* copy process group id */ stop_type = "1"b; /* assume this is answering service 7.4 or higher */ /* Create an upgraded process directory */ pdir_quota = cp -> create_info.record_quota; if pdir_quota = 0 then /* if they blow it with the new pdir quota mechanism */ pdir_quota = active_hardcore_data$pdir_quota;/* be reasonable */ pdir_quota = max (pdir_quota, 20); /* make sure it's enough to get running */ pdir_dir_quota = cp -> create_info.dir_quota; if pdir_dir_quota = 0 then pdir_dir_quota = active_hardcore_data$pdir_dir_quota; pdir_dir_quota = max (pdir_dir_quota, 10); /* make sure it's enough to get running */ unspec (branch_info) = "0"b; branch_info.version = create_branch_version_2; branch_info.mode = substr (SMA_bit, 1, length (branch_info.mode)); branch_info.rings (1) = dir_rb (1); branch_info.rings (2) = dir_rb (2); branch_info.rings (3) = dir_rb (3); branch_info.userid = pds$process_group_id; branch_info.switches.dir_sw = "1"b; branch_info.switches.copy_sw = "0"b; branch_info.switches.chase_sw = "0"b; /* don't chase links */ branch_info.parent_ac_sw = "0"b; /* Upgrade the dir */ branch_info.switches.priv_upgrade_sw = "0"b; /* really move quota from >pdd */ branch_info.bitcnt = 0; branch_info.quota = pdir_quota; branch_info.dir_quota = pdir_dir_quota; branch_info.access_class = process_authorization; call append$create_branch_ (">process_dir_dir", pdir_entry, addr (branch_info), code); if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); do i = 1 to 3; /* set up access control lists */ seg_acl (i).mode = REW_bit; /* Default access for process dir segments is REW */ seg_acl (i).exmode = "0"b; /* and no extended mode set */ dir_acl (i).mode = SMA_bit; /* Default access for process dir is SMA */ end; evolution = evolution + 1; /* increment the evolution to include the process_dir */ seg_acl (1).userid = process_group; /* give access to created process first */ dir_acl (1).userid = process_group; seg_acl (2).userid = pds$process_group_id; /* give access to system control */ dir_acl (2).userid = pds$process_group_id; seg_acl (3).userid = "*.*.*"; /* ... everybody else */ dir_acl (3).userid = "*.*.*"; seg_acl (3).mode, /* give null access to everyone else */ dir_acl (3).mode = "0"b; seg_aclp = addr (seg_acl (1).userid); /* get pointer to segment ACL */ dir_aclp = addr (dir_acl (1).userid); /* get pointer to directory ACL */ daemon_sw = "1"b; /* Don't add "*.SysDaemon.*" to ACLs */ call asd_$replace_dall (">process_dir_dir", pdir_entry, dir_aclp, 3, daemon_sw, code); /* directory branch acl */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); call create_hardcore_seg ("dseg", dseg_ptr); /* create descriptor segment */ if dseg_ptr = null then go to EVOLUTION_CLEANUP (evolution); evolution = evolution + 1; /* increment the evolution to show the creation of segments */ call create_hardcore_seg ("kst", kst_ptr); /* create known segment table KST */ if kst_ptr = null then go to EVOLUTION_CLEANUP (evolution); call create_hardcore_seg ("pds", pds_ptr); /* create process data segment (PDS) */ if pds_ptr = null then go to EVOLUTION_CLEANUP (evolution); n = tc_data$pdscopyl; /* copy the template PDS */ pds_ptr -> copy_data = addr (template_pds$) -> copy_data; if cp -> create_info.version > 4 then PRELINKED_DIR = cp -> create_info.subsystem; else PRELINKED_DIR = ""; if PRELINKED_DIR ^= "" then do; template_dsegp, template_kstp = null (); /* init for cleanup */ call initiate (PRELINKED_DIR, "template_kst", "", 0, 0, template_kstp, code); if template_kstp = null () then do; bad_subsystem: code = error_table_$invalid_subsystem; go to EVOLUTION_CLEANUP (evolution); end; evolution = evolution + 1; /* Need to terminate reference to template_kst if abort */ if template_kstp -> kst.time_of_bootload ^= sys_info$time_of_bootload | ^template_kstp -> kst.template then go to bad_subsystem; call fs_modes (template_kstp, ("0"b), ("0"b), rings, code); if code ^= 0 | rings (1) ^= 0 then go to bad_subsystem; n = bin (rel (addr (template_kstp -> kst.kst_entry (template_kstp -> kst.highseg + 1)))); kst_ptr -> copy_data = template_kstp -> copy_data; ptr (pds_ptr, rel (addr (pds$prelinked_ring))) -> copy_prelinked_ring = kst_ptr -> kst.prelinked_ring; call terminate_$noname (template_kstp, code); if code ^= 0 then go to bad_subsystem; evolution = evolution - 1; /* decrement because reference to template_kst terminated */ end; /* Compute the sizes and locations of the LOT and CLR */ lot_size = cp -> create_info.lot_size; clr_size = cp -> create_info.cls_size; max_lot = cp -> create_info.kst_size; if max_lot = 0 then max_lot = active_all_rings_data$default_max_segno + 1; max_lot = min (max_lot, active_all_rings_data$max_segno + 1); if max_lot <= active_all_rings_data$hcscnt then do; code = error_table_$smallarg; call syserr$error_code (LOG, code, "act_proc: KST size specified (^d) less than minimum (^d). Creating process for ^a.", max_lot, active_all_rings_data$hcscnt, cp -> create_info.process_group_id); go to EVOLUTION_CLEANUP (evolution); end; /* Now fill in the per-process variables into the new pds */ if cp -> create_info.lot_in_stack then do; p = ptr (pds_ptr, rel (addr (pds$lot_stack_size (0)))); do i = 0 to 7; p -> copy_size (i) = lot_size; end; end; if cp -> create_info.cls_in_stack then do; p = ptr (pds_ptr, rel (addr (pds$clr_stack_size (0)))); do i = 0 to 7; p -> copy_size (i) = clr_size; end; end; p = ptr (pds_ptr, rel (addr (pds$max_lot_size (0)))); do i = 0 to 7; p -> copy_size (i) = max_lot; end; p = ptr (pds_ptr, rel (addr (pds$processid))); /* fill in process id */ p -> copy_id = pid; p = ptr (pds_ptr, rel (addr (pds$lock_id))); p -> copy_id = getuid (); /* Get lock ID */ p = ptr (pds_ptr, rel (addr (pds$apt_ptr))); /* fill in APT entry pointer */ p -> copy_ptr = aptep; p = ptr (pds_ptr, rel (addr (pds$account_id))); /* initialize pds$account id */ p -> copy_id = pds$account_id; p = ptr (pds_ptr, rel (addr (pds$process_dir_name))); /* initialize pds$process_dir_name */ p -> copy_dir_name = pdir_path; p = ptr (pds_ptr, rel (addr (pds$process_group_id))); /* initialize pds$process_group_id */ p -> copy_group_id = process_group; p = ptr (pds_ptr, rel (addr (pds$initial_ring))); /* copy intial ring into pds */ p -> copy_ring = cp -> create_info.initial_ring; p = ptr (pds_ptr, rel (addr (pds$initial_procedure))); p -> copy_ptr = addr (init_proc); /* Set initial procedure for process. */ p = ptr (pds_ptr, rel (addr (pds$last_sp))); sb = baseptr (active_all_rings_data$stack_base_segno); p -> copy_ptr = addr (stack.first_frame); /* Setup first time stack ptr */ p = ptr (pds_ptr, rel (addr (pds$interrupt_ring))); /* copy interrupt ring into pds */ p -> copy_ring = cp -> create_info.initial_ring; /* use initial ring for users */ p = ptr (pds_ptr, rel (addr (pds$highest_ring))); /* copy highest ring into pds */ p -> copy_ring = cp -> create_info.highest_ring; p = ptr (pds_ptr, rel (addr (pds$access_name))); /* fill in 3 part access name in pds */ call acc_name_$elements (addr (process_group), p, code); if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); if p -> ack_name.tag = "m" then is_absentee = "1"b; else is_absentee = "0"b; p1 = ptr (pds_ptr, rel (addr (pds$term_proc))); /* copy terminate process id into pds */ p1 -> copy_id = cp -> create_info.term_processid; p1 = ptr (pds_ptr, rel (addr (pds$term_channel)));/* copy terminate channel name into pds */ p1 -> copy_chn_name = cp -> create_info.term_channel; p = ptr (pds_ptr, rel (addr (pds$access_authorization))); p -> copy_authorization = process_authorization; p = ptr (pds_ptr, rel (addr (pds$max_access_authorization))); p -> copy_authorization = max_authorization; p = ptr (pds_ptr, rel (addr (pds$audit_flags))); p -> copy_audit = cp -> create_info.audit; seg_rb (1) = 0; /* create pit with rb of (0, 5, 5) */ seg_rb (2), seg_rb (3) = cp -> create_info.highest_ring; pit_ptr = null; call append$branchx (pdir_path, "pit", (RW_mode), seg_rb, process_group, 0, 0, 0, code); if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); call asd_$replace_sall (pdir_path, "pit", seg_aclp, 3, daemon_sw, code); if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); call initiate$priv_init (pdir_path, "pit", "", 0, 0, pit_ptr, code); if pit_ptr = null then go to EVOLUTION_CLEANUP (evolution); n = cp -> create_info.words_of_pit; /* copy the pit template */ pit_ptr -> copy_data = cp -> create_info.pit_ptr -> copy_data; p2 = ptr (pds_ptr, rel (addr (pds$home_dir))); if substr (ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir, 1, 5) ^= "[pd]>" then p2 -> copy_home_dir = ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir; else do; hd = substr (ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir, 6, 32); call append$branchx (pdir_path, hd, (SMA_mode), dir_rb, process_group, 1, 0, 0, code); if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); call asd_$replace_dall (pdir_path, hd, dir_aclp, 3, daemon_sw, code); /* directory acl */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); /* fill in true home directory in PIT */ p2 -> copy_home_dir = rtrim (pdir_path) || ">" || rtrim (hd); ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir = p2 -> copy_home_dir; end; call terminate_$noname (pit_ptr, code); /* terminate copy */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); aptep -> apte.processid = pid; /* set up process id in KPT entry */ aptep -> apte.access_authorization = cp -> create_info.process_authorization; work_class = cp -> create_info.work_class; /* Yes */ call pxss$set_work_class (pid, work_class, 0, code); /* Set it */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); /* Unable to set it */ /* go to common; /* go to activate this process */ /* */ /* activate: entry(aaptep, a_code); /* entry to activate an inactive process */ /* dcl aaptep ptr; /* pointer to KPT (APT) entry */ /* dcl ACTIVATE init (2) fixed bin static options (constant); */ /* esw = ACTIVATE; /* set entry switch for activate entry */ /* evolution = NORMAL_EVOLUTION_TERMINATION */ /* stop_type = "1"b; /* I guess. */ /* aptep = aaptep; /* pick up pointer to KPT entry */ /* pid = aptep -> apte.processid; /* pick up process id */ /* call level$get(savring); /* save validation level */ /* call level$set(0); /* reset validation level to zero */ /* pdir_entry = unique_chars_((pid)); /* compute process directory entry name */ /* pdir_path = ">process_dir_dir>" || pdir_entry; */ /* call initiate$priv_init (pdir_path, "dseg", "", 0, 0, dseg_ptr, code); /* initiate dseg */ /* if dseg_ptr = null then go to EVOLUTION_CLEANUP (evolution); */ /* call initiate$priv_init (pdir_path, "kst", "", 0, 0, kst_ptr, code); /* initiate KST */ /* if kst_ptr = null then go to EVOLUTION_CLEANUP (evolution); */ /* call initiate$priv_init (pdir_path, "pds", "", 0, 0, pds_ptr, code); /* initiate PDS */ /* if pds_ptr = null then go to EVOLUTION_CLEANUP (evolution); */ /* COMMENTED OUT BECAUSE IT'S NOT PRESENTLY USED. */ /* CAUTION: if the activate entry point is ever revieved then PRELINKED_DIR */ /* must be stored in the guys pds. Some where the segments need to */ /* be terminated if the activation is aborted. This should be in */ /* EVOLUTION_CLEANUP condition by the value of esw */ common: abs_ptr = addr (abs_seg$); /* create process code joins activate code here */ n = active_all_rings_data$hcscnt - 1; /* Set up descriptor segment for new process. */ /* copy all SDW's up to first stacks (ring 0) SDW */ dseg_ptr -> based_dseg = addr (dseg$) -> based_dseg; dseg_size = size (sdw) * max_lot; call set_ehs (dseg_ptr, "1"b, divide (dseg_size + sys_info$page_size - 1, sys_info$page_size, 17, 0)); segno = bin (baseno (addr (dseg$)), 18); /* Get segno of dseg */ dseg_ptr -> sdwa (segno).add = addr (tsdw) -> sdw.add; /* Fill in page table addr */ dseg_ptr -> sdwa (segno).bound = bit (fixed (divide (dseg_size + 15, 16, 17, 0) - 1, 14), 14); dseg_ptr -> sdwa (segno).entry_bound = bit (divide (active_all_rings_data$stack_base_segno, 8, 14, 0), 14); dstep = astep; /* Save ptr to ASTE for dseg */ unspec (dbr) = string (dseg_ptr -> sdwa (segno)); if PRELINKED_DIR ^= "" then do; call initiate$initiate_count (PRELINKED_DIR, "template_dseg", "", bc, 0, template_dsegp, code); if template_dsegp = null () then go to bad_subsystem; evolution = evolution + 1; /* Need to terminate reference to template_dseg if abort */ call fs_modes (template_dsegp, ("0"b), ("0"b), rings, code); if code ^= 0 then go to bad_subsystem; if rings (1) ^= 0 then go to bad_subsystem; n = divide (bc, 72, 17, 0) - active_all_rings_data$hcscnt; if n <= 0 then go to bad_subsystem; addr (dseg_ptr -> sdwa (active_all_rings_data$hcscnt)) -> based_dseg = addr (template_dsegp -> sdwa (active_all_rings_data$hcscnt)) -> based_dseg; call terminate_$noname (template_dsegp, code); evolution = evolution - 1; /* decrement because reference to template_dseg terminated */ end; p = ptr (pds_ptr, rel (addr (pds$dstep))); /* save pointer to hardcore DST entry */ p -> copy_dstep = rel (dstep); kst_size = size (kst) + size (kste) * (max_lot - active_all_rings_data$hcscnt + 1); if kst_ptr -> kst.highseg = 0 then kst_ptr -> kst.highseg = max_lot - 1; kst_ptr -> kst.allow_256K_connect = sys_info$default_256K_enable ^= 0; /* Init for non pre-linked process */ call set_ehs (kst_ptr, "0"b, divide (kst_size + sys_info$page_size - 1, sys_info$page_size, 17, 0)); segno = bin (baseno (addr (kst_seg$)), 18); dseg_ptr -> based_dseg (segno) = tsdw; call set_ehs (pds_ptr, "1"b, 4); /* Force PDS active and prewithdraw */ segno = bin (baseno (addr (pds$)), 18); dseg_ptr -> based_dseg (segno) = tsdw; pds_astep = astep; aptep -> apte.timax = tc_data$timax; /* initialize to default timax */ aptep -> apte.flags.state = bit (bin (4, 18), 18);/* set execution state to blocked */ tc_data$stat (4) = tc_data$stat (4) + 1; /* up count of blocked processes */ aptep -> apte.asteps.pds = rel (pds_astep); /* save ptr to PDS-AST entry */ aptep -> apte.asteps.dseg = rel (dstep); /* save ptr to hardcore DST entry */ aptep -> apte.dbr = dbr; /* save descriptor segment base register value */ aptep -> apte.flags2.batch = is_absentee; /* DIGS wants to know .. */ aptep -> apte.lock_id = ptr (pds_ptr, rel (addr (pds$lock_id))) -> copy_id; /* Place in pds as well */ aptep -> apte.ws_size = 0; /* assume no pages to start */ aptep -> apte.term_processid = ptr (pds_ptr, rel (addr (pds$term_proc))) -> copy_id; aptep -> apte.term_channel = ptr (pds_ptr, rel (addr (pds$term_channel))) -> copy_chn_name; aptep -> apte.deadline, /* set deadline here */ aptep -> apte.state_change_time = clock (); /* Initialize it */ local_audit_event_flags = "0"b; /* set throttle_segment_state_changes */ addr (local_audit_event_flags) -> audit_event_flags.grant = "1"b; addr (local_audit_event_flags) -> audit_event_flags.cc_10_100 = "1"b; ptr (pds_ptr, rel (addr (pds$throttle_segment_state_changes))) -> copy_throttle_seg_state_chg = access_audit_$check_general_user (local_audit_event_flags, "0"b, process_authorization, cp -> create_info.audit); ptr (pds_ptr, rel (addr (pds$covert_event_count))) -> copy_event_count = -sst$seg_state_change_limit; /* page_fault counts up to 0 */ ptr (pds_ptr, rel (addr (pds$first_covert_event_time))) -> copy_time = clock (); /**** Here we set up apte.ipc_r_offset. This is an 18-bit unsigned integer used by IPC to validate event channel names in conjunction with apte.ipc_r_factor. This latter number is determined later, when the process first runs, to provide an indeterminate delay between the creation of these values. The delay is necessary to make it difficult to guess the value of apte.ipc_r_factor given the value of apte.ipc_r_offset. */ aptep -> apte.ipc_r_offset = binary (substr (bit (binary (clock (), 54), 54), 37, 18), 18); /**** Set the value of apte.ipc_r_factor to zero for debugging purposes so that we can determine whether it is getting set or not later. */ aptep -> apte.ipc_r_factor = 0; call terminate_$noname (dseg_ptr, code); /* Terminate dseg */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); call terminate_$noname (kst_ptr, code); /* terminate KST */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); call terminate_$noname (pds_ptr, code); /* terminate PDS */ if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); if esw = CREATE then do; /* some special stuff left to do if create entry */ if cp -> create_info.timax > 0 then aptep -> apte.timax = cp -> create_info.timax; if cp -> create_info.user_processid ^= " " then do; /* additional name for process directory */ call chname$cfile (">process_dir_dir", pdir_entry, "", (cp -> create_info.user_processid), code); if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); end; end; code = 0; go to EVOLUTION_CLEANUP (NORMAL_EVOLUTION_TERMINATION); /* go set level and return */ EVOLUTION_CLEANUP (5): if esw = CREATE then do; if template_kstp ^= null () then call terminate_$noname (template_kstp, ignore_code); if template_dsegp ^= null () then call terminate_$noname (template_dsegp, ignore_code); end; EVOLUTION_CLEANUP (4): /* delete any segments that have been created */ if esw = CREATE then call del_dir_tree (">process_dir_dir", pdir_entry, ignore_code); EVOLUTION_CLEANUP (3): /* delete the process dir */ if esw = CREATE then call delentry$dfile (">process_dir_dir", pdir_entry, ignore_code); EVOLUTION_CLEANUP (2): /* Give back the APTE */ if esw = CREATE then call pxss$empty_t (aptep); EVOLUTION_CLEANUP (1): /* restore validation level */ call level$set (savring); /* tell caller what went wrong if any thing did. */ a_code = code; return; set_pit_tty_info: entry (a_pid, a_pitp, a_code); dcl a_pid bit (36) aligned parameter; dcl a_pitp ptr parameter; dcl pitp ptr; esw = INFO; /* Copy args */ pid = a_pid; pitp = a_pitp; code = 0; /* Bookkeeping */ call level$get (savring); /* save current validation level and set it to zero */ call level$set (0); evolution = NORMAL_EVOLUTION_TERMINATION; pdir_entry = unique_chars_ ((pid)); /* compute entry name of user's pdir */ pdir_path = ">process_dir_dir>" || pdir_entry; /* get full pathname of pdir */ pit_ptr = null; call initiate$priv_init (pdir_path, "pit", "", 0, 0, pit_ptr, code); /* initiate exiting pit */ if pit_ptr = null then go to EVOLUTION_CLEANUP (evolution); /* Copy new tty info from template pit into user's pit */ pit_ptr -> pit.tty = pitp -> pit.tty; pit_ptr -> pit.old_tty = pitp -> pit.old_tty; pit_ptr -> pit.terminal_access_class = pitp -> pit.terminal_access_class; pit_ptr -> pit.line_type = pitp -> pit.line_type; pit_ptr -> pit.term_type_name = pitp -> pit.term_type_name; pit_ptr -> pit.service_type = pitp -> pit.service_type; pit_ptr -> pit.charge_type = pitp -> pit.charge_type; pit_ptr -> pit.tty_answerback = pitp -> pit.tty_answerback; pit_ptr -> pit.tty_type = pitp -> pit.tty_type; pit_ptr -> pit.outer_module = pitp -> pit.outer_module; /* Clean up and return */ call terminate_$noname (pit_ptr, code); go to EVOLUTION_CLEANUP (evolution); /* go set level and return */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ create_hardcore_seg: procedure (seg_name, seg_ptr); /* internal procedure to create hardcore segments */ dcl seg_name char (*) parameter; /* segment branch name */ dcl seg_ptr ptr parameter; /* pointer to segment (returned) */ seg_rb (1), seg_rb (2), seg_rb (3) = 0; /* ring brackets of 0-0-0 on pds and kst */ seg_ptr = null; call append$branchx (pdir_path, seg_name, (RW_mode), seg_rb, process_group, 0, 0, 0, code); /* create branch */ if code ^= 0 then return; call asd_$replace_sall (pdir_path, seg_name, seg_aclp, 3, daemon_sw, code); if code ^= 0 then return; call initiate$priv_init (pdir_path, seg_name, "", 0, 0, seg_ptr, code); /* initiate created segment */ end create_hardcore_seg; set_ehs: proc (segptr, prw, size1); dcl prw bit (1) aligned parameter; dcl segptr ptr parameter; dcl size1 fixed bin parameter; dcl size2 fixed bin (18); size2 = 1024 * size1; if prw then astep = grab_aste$prewithdraw (segptr, size2, code); else astep = grab_aste (segptr, size2, code); /* force activate the entry */ if code ^= 0 then call syserr$error_code (1, code, "act_proc: from grab_aste"); tsdw = get_ptrs_$given_astep (astep); addr (tsdw) -> sdw.cache = "1"b; /* KST and PDS are non-shared */ return; end set_ehs; /* format: off */ %page; %include access_audit_eventflags; %page; %include apte; %page; %include aste; %page; %include create_branch_info; %page; %include create_info; %page; %include kst; %page; %include pit; %page; %include sdw; %page; %include stack_header; %page; %include syserr_constants; %page; %include user_attributes; %page; /* BEGIN MESSAGE DOCUMENTATION Message: act_proc: from grab_aste ERRORMESSAGE S: $crash T: $run M: In attempting to create a process, the system could not force the PDS or descriptor segment of that process to be activated and held active. ERRORMESSAGE is an error_table_ message. $err A: $recover Message: act_proc: KST size specified (SIZE) less than minimum (MIN_SIZE). Creating process for GROUPID. S: $log T: $run M: The project administrator (or system administrator) for user GROUPID set the kst_size parameter in the PDT to SIZE, which is less than the valid minimum MIN_SIZE. The process is not created. Note that a process with MINIMUM KST size will probably not be of any use. The minimum useful KST size is on the order of MINIMUM + 50. A: Change the PMF/PDT. END MESSAGE DOCUMENTATION */ /* format: on */ end act_proc;  check_trailer.alm 11/11/89 1107.3r w 11/11/89 0804.2 15435 " *********************************************************** " * * " * 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. * " * * " *********************************************************** " " check_trailer " " This program loops through the entire trailer segment searching " for any trailers which belong to a process which has been (is being) " destroyed. It is a debugging temporary program only. " " Modified 04/16/81, W. Olin Sibert, to get count of trailers from sst$n_trailers " name check_trailer entry check_trailer check_trailer: " " Call is: " " error = check_trailer(rel_dstep) " " dcl error bit (1) aligned, rel_dstep dixed bin (18) " lda pr0|2,* pick up the pointer to the DST entry stz pr0|4,* zero out return error code ldq sst$n_trailers get count of trailers in system qls 1 multiply by two (size of a trailer) eax0 0,ql and move to X0 ldq -1,du use mask for right half of word 1 of trailer entry epp2 str_seg$+0 get pointer to trailer segment itself loop: eax0 -2,x0 go to next trailer tmi ok if haven't found bad one by now we're OK cmk pr2|1,x0 compare a with rel(dstep) in trailer tze trouble the same, trouble. return "1"b tra loop ok: short_return trouble: lda =o400000,du return "1"b if error sta pr0|4,* short_return end  copy_stack_0.pl1 11/11/89 1107.3r w 11/11/89 0805.1 28530 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ copy_stack_0: proc (processid, to_ptr, code); /* Copies the stack_0 assigned to a specified process This routine examines stack_0_data for an active stack_0 assigned to the specified apte. If found, it is copied to the specified location using initializer_abs_seg; otherwise, an error code is returned. Written March 1981 by J. Bongiovanni */ /* Parameter */ dcl processid bit (36) aligned; /* process id which owns stack */ dcl to_ptr ptr; /* where to copy stack_0 */ dcl code fixed bin (35); /* error code */ /* Automatic */ dcl paptep bit (18); dcl sdte_found bit (1); dcl sdte_inx fixed bin; dcl stack_ptr ptr; dcl stack_sdw bit (72) aligned; dcl stack_sdw_ptr ptr; dcl stack_size fixed bin (19); /* Based */ dcl stack_copy (stack_size) fixed bin (35) aligned based; /* The following include files are referenced at the end of the program: sdw stack_0_data */ /* External */ dcl initializer_abs_seg$ external; dcl error_table_$bad_arg fixed bin (35) external; dcl error_table_$stack_not_active fixed bin (35) external; dcl sst$ external; /* Entry */ dcl get_ptrs_$given_astep entry (ptr) returns (bit (72) aligned); dcl privileged_mode_ut$swap_sdw entry (ptr, ptr); dcl sdw_util_$get_size entry (pointer, fixed bin (19)); %page; /* Check sdt for a stack belonging to this processid */ code = 0; sdtp = addr (stack_0_data$); paptep = substr (processid, 1, 18); /* apte offset */ if paptep="0"b then do; /* null offset - invalid */ code = error_table_$bad_arg; return; end; sdte_found = "0"b; do sdte_inx = 1 repeat sdte_inx + 1 while (sdte_inx<=sdt.num_stacks&^sdte_found); if stacks (sdte_inx).aptep=paptep then sdte_found = "1"b; end; if ^sdte_found then do; code = error_table_$stack_not_active; return; end; sdtep = addr (sdt.stacks (sdte_inx-1)); stack_ptr = addr (initializer_abs_seg$); stack_sdw_ptr = addr (stack_sdw); stack_sdw = get_ptrs_$given_astep (ptr (addr (sst$), sdte.astep)); /* build sdw for stack */ call sdw_util_$get_size (addr (stack_sdw), stack_size); call privileged_mode_ut$swap_sdw (stack_ptr, stack_sdw_ptr); /* initializer_abs_seg is now stack */ to_ptr -> stack_copy = stack_ptr -> stack_copy; stack_sdw = "0"b; call privileged_mode_ut$swap_sdw (stack_ptr, stack_sdw_ptr); return; %page; %include stack_0_data; end copy_stack_0;  create_hproc.pl1 11/11/89 1107.3r w 11/11/89 0805.2 102708 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ /* format: style4 */ create_hproc: proc (access_id, loaded, aptep, initial_procedure) returns (fixed bin (35)); /* Created by Webber for 29-0 (= MR5.0) */ /* Modified by VanVleck, Greenberg for in-hierarchy and hardcore-seg per-proc segments 4/77 */ /* Modified by Mike Grady for stack 0 sharing. May 1979 */ /* Modified by J. Bongiovanni to create a stack for non-early hprocs. December 1982 */ /* Modified 1984-11-16 by E. Swenson for IPC event channel validation. The values of R-Offset and R-Factor are initialized here for hprocs. */ /* Modified 1984-11-20 by Keith Loepere to rename terminate to terminate_. */ /* Modified 1984-12-11, BIM: give *.*.* RW In ring zero to segments. this permits ring_zero_peek_ and allows this to work outside of the Initializer. */ /* Parameters */ dcl access_id char (*) aligned; dcl loaded bit (1) aligned; dcl initial_procedure ptr; dcl adsp ptr; dcl apdsp ptr; dcl astkp ptr; /* Automatic */ dcl save_level uns fixed bin (3); dcl highseg fixed bin (18); dcl dseg_no fixed bin (18); dcl dsp ptr; dcl pds_ptr ptr; dcl stk_ptr ptr; dcl stk_astep ptr; dcl tcode fixed bin (35); dcl dseg_ptr ptr; dcl 1 pds_sdw aligned like sdw; dcl 1 dbr aligned like sdw; dcl 1 stk_sdw aligned like sdw; dcl dstep ptr; dcl astep ptr; dcl proc_id bit (36) aligned; dcl lock_id bit (36) aligned; dcl pds_no fixed bin; dcl append_entry bit (1); /* External */ dcl active_all_rings_data$hcscnt fixed bin (18) ext; dcl active_all_rings_data$stack_base_segno fixed bin (18) ext; dcl (dseg$, slt$) external; dcl error_table_$namedup fixed bin (35) external; dcl pds$apt_ptr ptr ext; dcl pds$stack_0_sdwp ptr ext; dcl pds$stack_0_ptr ptr ext; dcl pds$stacks (0:7) ptr ext; dcl pds$last_sp ptr ext; dcl pds$initial_procedure ptr ext; dcl pds$processid bit (36) aligned ext; dcl pds$lock_id bit (36) aligned ext; dcl pds$dstep bit (18) aligned ext; dcl pds$process_group_id char (32) aligned ext; dcl template_pds$ ext; dcl tc_data$pdscopyl fixed bin ext; /* Based */ dcl copy_pds (tc_data$pdscopyl) fixed bin based; dcl copy_id bit (36) aligned based; dcl copy_ptr ptr based; dcl copy_group_id char (32) aligned based; dcl copy_dstep bit (18) aligned based; dcl 1 based_dseg (0:highseg) aligned like sdw based; dcl 1 stack aligned based (sb), 2 header like stack_header, 2 first_frame fixed bin; /* Constant */ dcl seg_rb (3) fixed bin init (0, 0, 0) static options (constant); dcl dseg_size fixed bin static options (constant) init (3 * 1024); dcl PDS_SIZE fixed bin internal static options (constant) init (4096); dcl STACK_SIZE fixed bin internal static options (constant) init (16384); /* Entries */ dcl unique_chars_ entry (bit (*) aligned) returns (char (15)); dcl append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin, char (*) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl (level$get, level$set) entry (uns fixed bin (3)); dcl grab_aste$prewithdraw entry (ptr, fixed bin, fixed bin (35)) returns (ptr); dcl get_ptrs_$given_astep entry (ptr) returns (1 aligned like sdw); dcl get_ptrs_$given_segno entry (fixed bin (18)) returns (ptr); dcl initiate$priv_init entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); dcl terminate_$noname ext entry (ptr, fixed bin (35)); dcl truncate$trseg entry (ptr, fixed bin (19), fixed bin (35)); dcl pxss$get_entry entry (ptr); dcl getuid entry returns (bit (36) aligned); dcl pc_wired$wire_wait entry (ptr, fixed bin, fixed bin); /* Builtins */ dcl (addr, baseno, baseptr, bin, bit, divide, null, ptr, rel, size, unspec) builtin; dcl cleanup condition; /* */ /* First get a segment to be used as the PDS */ append_entry = "1"b; call pxss$get_entry (aptep); if aptep = null then return (1); proc_id = rel (aptep) || "666666"b3; call level$get (save_level); on cleanup call level$set (save_level); call level$set (0); call get_unique_segment ("pds", pds_ptr, astep, PDS_SIZE, tcode); if tcode ^= 0 then do; RETURN_ERROR: call level$set (save_level); return (tcode); end; /* Now get a descriptor segment */ call get_unique_segment ("dseg", dseg_ptr, dstep, dseg_size, tcode); if tcode ^= 0 then goto RETURN_ERROR; /* Now get a stack segment */ call get_unique_segment ("stack", stk_ptr, stk_astep, STACK_SIZE, tcode); if tcode ^= 0 then goto RETURN_ERROR; highseg = active_all_rings_data$hcscnt - 1; call level$set (save_level); revert cleanup; /* Develop the DBR from the dstep. */ join: dbr = get_ptrs_$given_astep (dstep); dsp = addr (dseg$); dseg_no = bin (baseno (dsp), 18); dseg_ptr -> based_dseg = dsp -> based_dseg; unspec (dseg_ptr -> sdwa (dseg_no)) = unspec (dbr); /* Fill in the stack base segno in the DBR so BOS will dump it. */ if append_entry then dbr.entry_bound = bit (divide (active_all_rings_data$stack_base_segno, 8, 14, 0), 14); /* Now get an APT entry and fill it in */ apte.hproc = "1"b; apte.state = bit (bin (4, 18), 18); /* initial state is blocked */ apte.timax = 4000000; apte.wct_index = pds$apt_ptr -> apte.wct_index; /* use parent's water closet */ apte.processid = proc_id; lock_id = getuid (); apte.lock_id = lock_id; apte.dseg = rel (dstep); apte.pds = rel (astep); unspec (apte.dbr) = unspec (dbr); /**** Here we set up apte.ipc_r_offset for the hardcore process. This is an 18-bit unsigned integer used by IPC to validate event channel names in conjunction with apte.ipc_r_factor. This latter number is determined later, in init_proc. This is done on order to provide an undeterministic delay between the initialization of these two numbers in order to make it difficult to guess one given the other. */ apte.ipc_r_offset = binary (substr (bit (binary (clock (), 54), 54), 37, 18), 18); /**** We defer the setting of R-Factor until after we take a few pages faults in order to make guessing R-Factor given R-Offset more difficult. */ /* Now initialize the PDS and fill in its SDW into the DSEG */ pds_no = bin (baseno (addr (pds$processid)), 18); pds_sdw = get_ptrs_$given_astep (astep); pds_sdw.cache = "1"b; dseg_ptr -> based_dseg (pds_no) = pds_sdw; pds_ptr -> copy_pds = addr (template_pds$) -> copy_pds; ptr (pds_ptr, rel (addr (pds$processid))) -> copy_id = proc_id; ptr (pds_ptr, rel (addr (pds$lock_id))) -> copy_id = lock_id; ptr (pds_ptr, rel (addr (pds$apt_ptr))) -> copy_ptr = aptep; ptr (pds_ptr, rel (addr (pds$process_group_id))) -> copy_group_id = access_id; ptr (pds_ptr, rel (addr (pds$dstep))) -> copy_dstep = rel (dstep); ptr (pds_ptr, rel (addr (pds$initial_procedure))) -> copy_ptr = initial_procedure; sdwp = addr (dseg$); if append_entry then do; /* fill in pds stack info with correct stuff */ stk_sdw = get_ptrs_$given_astep (stk_astep); unspec (dseg_ptr -> sdwa (active_all_rings_data$stack_base_segno)) = unspec (stk_sdw); ptr (pds_ptr, rel (addr (pds$stack_0_sdwp))) -> copy_ptr = addr (sdwa (active_all_rings_data$stack_base_segno)); ptr (pds_ptr, rel (addr (pds$stack_0_ptr))) -> copy_ptr, ptr (pds_ptr, rel (addr (pds$stacks (0)))) -> copy_ptr, sb = ptr (baseptr (active_all_rings_data$stack_base_segno), 0); stk_ptr -> stack_header_overlay = pds$stack_0_ptr -> stack_header_overlay; stk_ptr -> stack_header.stack_begin_ptr, stk_ptr -> stack_header.stack_end_ptr = ptr (sb, rel (addr (stack.first_frame))); end; else do; /* or for early hprocs */ ptr (pds_ptr, rel (addr (pds$stack_0_sdwp))) -> copy_ptr = addr (sdwa (bin (baseno (stk_ptr), 18))); ptr (pds_ptr, rel (addr (pds$stack_0_ptr))) -> copy_ptr, ptr (pds_ptr, rel (addr (pds$stacks (0)))) -> copy_ptr, sb = ptr (stk_ptr, 0); end; ptr (pds_ptr, rel (addr (pds$last_sp))) -> copy_ptr = addr (stack.first_frame); /* Now load the process if it must be loaded */ if loaded then do; /* the process is always to be loaded */ apte.loaded = "1"b; apte.always_loaded = "1"b; call pc_wired$wire_wait (astep, 0, 1); /* wire first page of PDS */ call pc_wired$wire_wait (dstep, 0, 1); /* wire first page of DSEG */ end; if append_entry then do; call terminate_$noname (pds_ptr, (0)); call terminate_$noname (dseg_ptr, (0)); call terminate_$noname (stk_ptr, (0)); end; /**** Now, after taking some page faults, we set R-Factor. The clock value should be unpredictably more advanced. */ apte.ipc_r_factor = binary (substr (bit (binary (clock (), 54), 54), 19, 36), 35); return (0); /* */ early_hproc: entry (access_id, loaded, aptep, initial_procedure, adsp, apdsp, astkp) returns (fixed bin (35)); /* This entry is called during initialization, when segments cannot be created via append. Pointers to two hardcore segments, adsp and apdsp, are supplied to specify segments to be used as the DSEG and PDS of the new process. These segments should be hardcore if this process is never to be deleted, or deciduous if they are later to be deleted. */ append_entry = "0"b; dseg_ptr = adsp; /* Copy args for common code. */ pds_ptr = apdsp; stk_ptr = astkp; astep = get_ptrs_$given_segno (bin (baseno (pds_ptr), 18)); /* Get dseg-seg ptr */ dstep = get_ptrs_$given_segno (bin (baseno (dseg_ptr), 18)); /* Ditto the pds */ call pxss$get_entry (aptep); if aptep = null then return (1); proc_id = rel (aptep) || "666666"b3; /* Fabricate process ID */ sltp = addr (slt$); highseg = slt.last_sup_seg; go to join; /* Do all the rest */ %page; /* Internal Procedure to create, initiate, and entry-activate a segment. */ get_unique_segment: proc (segment_suffix, segment_ptr, aste_ptr, segment_size, rcode); dcl segment_suffix char (*); dcl segment_ptr ptr; dcl aste_ptr ptr; dcl segment_size fixed bin; dcl rcode fixed bin (35); dcl seg_name char (32); seg_name = unique_chars_ (proc_id) || "." || segment_suffix; call append$branchx (">system_library_1", seg_name, RW_ACCESS_BIN, seg_rb, "*.*.*", /* The acl term effects us if this is not the Initializer */ 0, 0, 0, rcode); if rcode ^= 0 then if rcode ^= error_table_$namedup then return; call initiate$priv_init (">system_library_1", seg_name, "", 0, 0, segment_ptr, rcode); if rcode ^= 0 then return; call truncate$trseg (segment_ptr, 0, rcode); if rcode ^= 0 then return; aste_ptr = grab_aste$prewithdraw (segment_ptr, segment_size, rcode); if rcode ^= 0 then return; end get_unique_segment; /* format: off */ %page; %include access_mode_values; %page; %include sdw; %page; %include apte; %page; %include slt; %page; %include stack_header; /* format: on */ end create_hproc;  deact_proc.pl1 11/11/89 1107.3r w 11/11/89 0805.2 42885 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ deact_proc: proc; /* Changed by E Stone to remove destroy entry and to convert to v2 on 05/74 */ /* Modified 05/78 by J. A. Bush to add cleanup for processor testing */ /* Modified September 1981 by J. Bongiovanni for tc_util */ dcl code fixed bin (35); dcl save_ring fixed bin (3), /* validation level */ (sstp, pds_astep) ptr, name char (32) aligned; dcl delentry$dfile entry (char (*) aligned, char (*) aligned, fixed bin (35)), del_dir_tree entry (char (*) aligned, char (*) aligned, fixed bin (35)), unique_chars_ entry (bit (*) aligned) returns (char (15) aligned), level$get entry returns (fixed bin (3)), level$set entry (fixed bin (3)), pxss$stop_wakeup entry (bit (36) aligned, fixed bin), tc_util$process_status entry (ptr), pxss$empty_t ext entry (ptr), deactivate_segs ext entry (ptr), reconfig$destroy_cpu_test_env entry, ioam_$process_release entry (bit (36) aligned); dcl error_table_$action_not_performed fixed bin (35) ext, sst_seg$ fixed bin ext; dcl (addr, ptr) builtin; dcl 1 process_info based (pi_ptr) aligned, /* structure used to transfer accounting data */ 2 processid bit (36), 2 page_faults fixed bin (35), 2 aptep ptr, 2 ex_state fixed bin, 2 mp_state fixed bin, 2 last_block_time fixed bin (71), 2 cpu_time_used fixed bin (71), 2 paging_measure fixed bin (71), 2 virtual_cpu_time fixed bin (71), 2 reserved fixed bin (71); dcl 1 info aligned like process_info; % include apte; % include scs; /* */ /* The entry destroy_process_begin initiates the destruction of a process by stopping it in such a way that when the process stops it will send a wakeup to the process specified in apte.term_processid. The wakeup will be over the channel apte.term_channel. When the wakeup is received by the driving process (Answering Service?) the entry destroy_process_finish is called to return the final process statistics and to clean up the APT entry. As a final step destroy_process_finish deletes the process directory of the process just destroyed. */ destroy_process_begin: entry (pi_ptr, code); dcl pi_ptr ptr; info.processid = pi_ptr -> process_info.processid; /* get ID OF PROCESS TO STOP */ call pxss$stop_wakeup (info.processid, info.ex_state); /* stop it */ if info.ex_state = 0 then code = error_table_$action_not_performed; else code = 0; /* return non-zero code only if already stopped */ return; /* * * * * * * * * * * * * * * * * * * * * * * */ destroy_process_finish: entry (pi_ptr, code); info.processid = pi_ptr -> process_info.processid; /* get the process ID */ call tc_util$process_status (addr (info)); /* get the goods for the process */ /* check for stopped process */ if ^((info.ex_state = 5) & (info.mp_state = 1)) then do; code = error_table_$action_not_performed; /* return non-zero code only if not stopped */ return; end; sstp = addr (sst_seg$); pds_astep = ptr (sstp, info.aptep -> apte.asteps.pds); /* get pointer to pds for the process */ call deactivate_segs (pds_astep); /* deactivate the process */ info.aptep -> apte.lock_id = ""b; /* clear out the lock id */ info.aptep -> apte.processid = ""b; /* and the process id */ call pxss$empty_t (info.aptep); /* give back the APT entry */ call ioam_$process_release (info.processid); /* free any devices assigned to this process */ if scs$reconfig_lock = info.processid then /* is this process testing a processor? */ call reconfig$destroy_cpu_test_env; /* release CPU and SCU resources */ name = unique_chars_ (info.processid); /* get the PDIR name */ save_ring = level$get (); /* get (save) the validation level */ call level$set (0); /* do del_dir_tree from ring 0 */ call del_dir_tree (">process_dir_dir", name, code); if code = 0 then call delentry$dfile (">process_dir_dir", name, code); call level$set (save_ring); /* restore validation level */ pi_ptr -> process_info = info; /* copy back accounting information */ return; end deact_proc;  deactivate_segs.pl1 11/11/89 1107.3r w 11/11/89 0805.2 56943 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ deactivate_segs: proc (a_pds_astep); /* DEACTIVATE_SEGS -- remove all traces of a stopped process from the system */ /* Modified by R. Bratt 2/11/75 to lock the ast before attempting to delete trailers and to avoid attempting to delete trailers for hardcore segment numbers modified April 1975 by R. Bratt for new KST / RNT system modified April 1975 by R. Bratt for new access in KST / SDW scheme modified June 1976 by B. Greenberg to leave KST visible in trailer crashes. modified 06/76 by D. Vinograd to handle backup_abs_seg. modified Oct 31 76 by Greenberg for pc$truncate_deposit_all (stop losing dseg pages). modified 02/22/77 by THVV for dsegs with branches Modified 03/21/81, W. Olin Sibert, for ADP PTWs and get_ptrs_$given_sdw Modified 04/16/81, WOS, for sdw_util_, and to remove obsolete PDS unwiring code. Modified March 1982, J. Bongiovanni, to make sure KST exists before using it */ dcl a_pds_astep pointer parameter; dcl asp pointer; /* Pointer to abs_seg$ (overlays assorted segmets) */ dcl drsp pointer; /* Pointer to dir_seg$ (overlays the dead KST) */ dcl (dstep, kst_astep, pds_astep, seg_astep) pointer; /* Assorted ASTEPs */ dcl tsdw fixed bin (71); dcl tsdwp pointer; dcl rdstep bit (18) aligned; dcl (highseg, hcscnt, rel_dstep, i) fixed bin; dcl sdw_address fixed bin (26); dcl sdwp pointer; dcl bit18 bit (18) aligned based; dcl based_ptr ptr based; dcl sdwa (0 : 1023) fixed bin (71) aligned based; /* DSEG overlay */ dcl abs_seg$ fixed bin external static; dcl backup_abs_seg$ external static; dcl dir_seg$ fixed bin ext external static; dcl pds$dstep bit (18) external static; dcl sst_seg$ external static; dcl check_trailer entry (fixed bin) returns (bit (1) aligned); dcl get_ptrs_$given_astep entry (ptr) returns (fixed bin (71)); dcl get_ptrs_$given_sdw entry (pointer) returns (pointer); dcl grab_aste$release entry (ptr); dcl grab_aste$release_prewithdraw entry (ptr); dcl lock$lock_ast entry (); dcl lock$unlock_ast entry (); dcl pmut$swap_sdw entry (ptr, ptr); dcl setfaults$deltrailer entry (ptr, fixed bin (17), fixed bin (17)); dcl sdw_util_$get_address entry (pointer, fixed bin (26)); dcl syserr entry options (variable); dcl (baseno, ptr, rel, addr, fixed, null) builtin; /* */ pds_astep = a_pds_astep; /* copy argument */ asp = addr (abs_seg$); /* get needed pointers */ drsp = addr (dir_seg$); tsdwp = addr (tsdw); tsdw = get_ptrs_$given_astep (pds_astep); /* get pointer to PDS of process being deactivated */ call pmut$swap_sdw (asp, tsdwp); /* make abs_seg point to the PDS */ rdstep = ptr (asp, rel (addr (pds$dstep))) -> bit18; /* get dstep from the PDS */ dstep = ptr (addr (sst_seg$), rdstep); /* get a pointer to the DSEG ASTE */ kstp = ptr (asp, rel (addr (pds$kstp))) -> based_ptr; /* get pointer in HIS process to KST */ tsdw = get_ptrs_$given_astep (dstep); /* look at the DSEG */ call pmut$swap_sdw (asp, tsdwp); /* make the ABS-SEG work */ if kstp ^= null () then do; kst_astep = get_ptrs_$given_sdw (addr (asp -> sdwa (fixed (baseno (kstp), 18)))); tsdw = get_ptrs_$given_astep (kst_astep); /* make abs_seg point to the KST */ call pmut$swap_sdw (drsp, tsdwp); highseg = drsp -> kst.highest_used_segno; /* copy highseg from the KST header */ hcscnt = drsp -> kst.lowseg; /* get the hardcore seg count for later */ call grab_aste$release (kst_astep); /* Release the KST aste */ end; /* Used to unwire any wired PDS pages here, but since the PDS is no longer used as a ring zero stack, there is no need to do this any more. First page won't be wired, either, because process is stopped, and has been unloaded. */ call grab_aste$release_prewithdraw (pds_astep); /* Release the PDS aste */ if kstp ^= null () then do; rel_dstep = fixed (rdstep, 18); /* get rel(dstep) for deltrailer call */ tsdw = get_ptrs_$given_astep (dstep); /* make the abs_seg point to the descriptor segment */ call pmut$swap_sdw (asp, tsdwp); call lock$lock_ast; do i = hcscnt + 1 to highseg, /* loop through the KST entries */ fixed (baseno (addr (backup_abs_seg$)), 18); /* And the backup_abs_seg, just in case */ sdwp = addr (asp -> sdwa (i)); call sdw_util_$get_address (sdwp, sdw_address); if sdw_address ^= 0 then do; seg_astep = get_ptrs_$given_sdw (sdwp); call setfaults$deltrailer (seg_astep, i, rel_dstep); /* delete the trailer */ end; end; /* this check has been disabled for efficiency considerations, and beecause the class of software problems which caused it to go off have all been fixed. It should be made enablable by a tuning parameter if it is felt to be needed in the future. */ if "0"b then if check_trailer (rel_dstep) then call syserr (1, "deactivate_segs: unflushed trailer"); call lock$unlock_ast; end; /* Done with dseg */ call grab_aste$release_prewithdraw (dstep); /* release the DSEG aste */ tsdw = 0; call pmut$swap_sdw (asp, tsdwp); /* Clean up dseg */ call pmut$swap_sdw (drsp, tsdwp); return; %page; %include aste; %page; %include kst; /* */ /* BEGIN MESSAGE DOCUMENTATION Message: deactivate_segs: unflushed trailer S: $crash T: $run M: After destroying a process, the system found that some system trailer (specifying connection of that process to some segment) still exists for that process in str_seg. This indicates that some segment was improperly disconnected from the process at some time. $err A: $recover END MESSAGE DOCUMENTATION */ end deactivate_segs;  get_process_usage.pl1 11/11/89 1107.3r 11/11/89 0805.2 21555 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ get_process_usage: procedure (process_usage_pointer, code); /* Last Modified: 09/17/76 by R. Bratt to add seg_fault, bound_fault, vtoc_read, and vtoc_write meters. 01/08/85 by Keith Loepere to delete pd_page_faults. */ declare code fixed bin (35), pds$apt_ptr ext pointer, pds$cpu_time fixed bin (71) ext, pds$virtual_delta fixed bin (71) ext, pds$page_waits fixed bin (35) ext, pds$segment_faults fixed bin (35) ext, pds$bounds_faults fixed bin (35) ext, pds$vtoc_reads fixed bin (35) ext, pds$vtoc_writes fixed bin (35) ext, clock_ entry returns (fixed bin (52)); /* */ process_usage.number_can_return = 9; /* current number we can return */ code = 0; /* currently no error code can be returned */ aptep = pds$apt_ptr; if number_wanted < 1 then return; process_usage.cpu_time = clock_ ()-pds$cpu_time; if number_wanted < 2 then return; process_usage.paging_measure = apte.paging_measure; if number_wanted < 3 then return; process_usage.page_faults = pds$page_waits; if number_wanted < 4 then return; process_usage.pd_faults = 0; /* paging device */ if number_wanted < 5 then return; process_usage.virtual_cpu_time = clock_ () - pds$cpu_time - pds$virtual_delta; if number_wanted < 6 then return; process_usage.segment_faults = pds$segment_faults; if number_wanted < 7 then return; process_usage.bounds_faults = pds$bounds_faults; if number_wanted < 8 then return; process_usage.vtoc_reads = pds$vtoc_reads; if number_wanted < 9 then return; process_usage.vtoc_writes = pds$vtoc_writes; return; /* */ %include apte; /* */ %include process_usage; end;  grab_aste.pl1 11/11/89 1107.3r w 11/11/89 0805.2 59400 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ grab_aste: procedure (segptr, a_len, rcode) returns (ptr); /* This procedure is responsible for forcibly activating segments. The I/O Buffer Manager uses the _io entries, which also clean up the segment w.r.t. cache control. The directory containing the segment must not be locked when grab_aste is called. Bernard Greenberg, May 10, 1974 */ /* 5/8/75 by BSG for NSS */ /* 4/26/77 by BSG for aste.ddnp */ /* 12/1/78 by BSG for not crashing on activate errors */ /* 1/82 BIM for dir write lock to get exclusive lock */ dcl (segptr, /* pointer to segment. KST-recognized segment number */ a_astep) pointer; /* argument astep of segment on release calls. */ dcl (rcode, /* return error code */ code, /* code from called routines */ word) fixed bin (35); /* used for touching seg */ dcl do_io bit (1); /* flag for _io entry */ dcl prewithdraw bit (1); /* flag for page prewithdrawing */ dcl segno fixed bin (17); /* segno for syserr calls */ dcl dp ptr; /* ptr to dir */ dcl (null, baseno, ptr, fixed) builtin; dcl based_word (0:262143) fixed bin (35) based; dcl (len, a_len) fixed bin (18); dcl pno fixed bin; /* Page number when prewithdrawing seg */ dcl error_table_$dirseg fixed bin (35) ext; dcl sum$getbranch entry (ptr, bit (36) aligned, ptr, fixed bin (35)), lock$unlock_ast entry, activate entry (ptr, fixed bin (35)) returns (ptr), lock$dir_unlock entry (ptr), setfaults$cache entry (ptr, bit (1) aligned), syserr entry options (variable), syserr$error_code entry options (variable); /* */ %include dir_entry; %include aste; /* */ do_io = "0"b; /* set flag for no cache business */ prewithdraw = "0"b; go to grab_join; grab_aste_io: entry (segptr, a_len, rcode) returns (ptr); do_io = "1"b; /* set cache flags flag */ prewithdraw = "0"b; go to grab_join; prewithdraw: entry (segptr, a_len, rcode) returns (ptr); do_io = "0"b; prewithdraw = "1"b; grab_join: segno = fixed (baseno (segptr), 17); /* get segment number forr syserr calls */ len = divide (a_len + 1023, 1024, 17, 0); /* len = NUMBER OF PAGES in request */ call sum$getbranch (segptr, (36)"1"b /* WRITE */, ep, code); /* access entry, and lock dir. Root and mylock are not acceptable */ /* The point of locking the directory is so that nobody else can try to activate the segment while we try. Boundfaults and segfaults in this state are acceptable. */ if code ^= 0 then do; /* no errors are acceptable */ rcode = code; /* pass the buck */ return (null()); end; dp = ptr (ep, 0); /* get dir ptr for unlock call */ if ep -> entry.dirsw then do; /* we do not take kindly to ehs'ing dirs */ call lock$dir_unlock (dp); rcode = error_table_$dirseg; /* operation not allowed for dirs */ return (null()); end; astep = activate (ep, code); /* Force to be active. Must have large enough ASTE. */ if astep = null then do; /* Could be disk offline, etc. */ call lock$dir_unlock (dp); rcode = code; return (null ()); end; if astep -> aste.ehs then call syserr (1, "grab_aste: Attempt to re-use seg ^o", segno); astep -> aste.ddnp = "1"b; /* Don't deposit null pages- this protects against deactivation, but boundsfaults go thru, and segment moves reproduce the withdrawals! */ call lock$unlock_ast; /* Unlock AST to allow segmoves and boundsfaults */ if prewithdraw then pno = 1; else pno = len; /* Get prewithdraw range */ do pno = pno to len by 1; /* Touch all pages */ word = segptr -> based_word ((pno - 1) * 1024); /* Cause allocation */ /* aste.ddnp prevents against deallocation */ end; astep = activate (ep, code); if astep = null then call syserr$error_code (1, code, "grab_aste: failed to reactivate ^p", ep); astep -> aste.ddnp = prewithdraw; /* Conditionally turn off ddnp */ astep -> aste.ehs = "1"b; /* set entry hold active */ if do_io then do; /* if used for i/o, must disencache */ astep -> aste.any_access_on = "0"b; /* put in non-encached state */ astep -> aste.write_access_on, astep -> aste.inhibit_cache = "1"b; /* and make sure it stays there. */ call setfaults$cache (astep, "0"b); /* take it out of current caches */ end; call lock$unlock_ast; call lock$dir_unlock (dp); /* unlock dir, now that ehs is on */ rcode = 0; /* all is ok */ return (astep); /* return ast entry ptr */ /* */ release_io: entry (a_astep); /* entry to un-disencache and de-ehs */ do_io = "1"b; prewithdraw = "0"b; go to release_join; release_prewithdraw: entry (a_astep); /* Release nondepositable segments as ssch */ prewithdraw = "1"b; do_io = "0"b; go to release_join; release: entry (a_astep); do_io = "0"b; prewithdraw = "0"b; release_join: astep = a_astep; /* copy arg */ if ^astep -> aste.ehs then call syserr (1, "grab_aste: Unprotected segment: astep = ^p", astep); /* must have ehs on */ astep -> aste.ehs = "0"b; /* turn off ehs */ if do_io then astep -> aste.inhibit_cache = "0"b; /* resume standard cache control */ if prewithdraw then astep -> aste.ddnp = "0"b; return; /* BEGIN MESSAGE DOCUMENTATION Message: grab_aste: Attempt to reuse segno SSS S: $crash T: $run M: A call has been made to force active a segment already forced active. This indicates an inconsistency in the programming of the supervisor. $err A: $recover $notify Message: grab_aste: failed to reactivate PPPP ERRORMESSAGE S: $crash T: $run M: $err A: $recover $notify Message: grab_aste: Unprotected segment: astep = AAA S: $crash T: $run M: An attempt was made to release from forced activity a segment (whose AST entry is at AAA) which was not even in a state of forced activity. $err A: $inform $recover END MESSAGE DOCUMENTATION */ end;  init_proc.pl1 11/11/89 1107.3r w 11/11/89 0804.6 145989 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ init_proc: proc; /* This program is the first program executed (in ring 0) in a user, absentee, or daemon process. It is entered from special code in pxss via a return pointer left in the stack by build_template_pds. It is also called explicitly during initialization to get the initializer process into the user ring. Last modified (date and reason): 8/15/74 by S.Webber -- completely recoded to make references to the pit. 76/04/29 by T. Casey to fix bug in implementation of "-initproc path,direct", * allow path to be relative to homedir, * and to replace all instances of call syserr (2,...) (print with alarm and terminate process) by * call syserr (4,...) or (3,...) (log, or print with alarm), followed by * direct calls to terminate_proc$init_failure with a relevant error_table_ code. 77/03/29 by M. Weaver to call makestack explicitly because of moving search rules to user ring 79/03/01 by B. Margulies to set the working dir BEFORE calling makestack 79/03/05 by B. Margulies to never set the working directory for users without v_init_proc. 79/17/06 by B. Margulies to fix uninitialized variable bug introduced by above. 79/07/14 by Mike Grady for ring 0 stack sharing 81/10/05 by B. Margulies for new call_out mechanism. 81/11/23 by B. Margulies for new initial procedure. 84/11/05 by K. Loepere to rename terminate to terminate_. Modified 1984-11-11 by E. Swenson for IPC event channel validation. Here we set the value of apte.ipc_r_factor. */ /* Automatic */ dcl (pp, caller_ptr) ptr; dcl (i, j) fixed bin; dcl (d_len, e_len, hd_len, less_thans, po_len) fixed bin; dcl code fixed bin (35); dcl dirname char (168); dcl initial_proc char (32); dcl temp fixed bin (71); /* Entries */ dcl makestack entry (fixed bin); dcl fs_search$set_wdir entry (char (*), fixed bin (35)); dcl terminate_$noname entry (ptr, fixed bin (35)); dcl pmut$set_mask entry (fixed bin (71), fixed bin (71)); dcl level$set entry (fixed bin); dcl (syserr, syserr$error_code) entry options (variable); dcl terminate_proc$init_failure entry (fixed bin (35)); dcl initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl initialize_kst entry; dcl pathname_am$initialize ext entry; dcl call_outer_ring_ entry (ptr, char (*), char (*), fixed bin (3), fixed bin (35)); /* External */ dcl scs$open_level fixed bin (71) ext; dcl pds$stack_0_ptr ptr ext; dcl pds$stacks (0:7) ptr ext; dcl pds$process_dir_name char (32) aligned ext; dcl pds$process_group_id char (32) aligned ext; dcl pds$initial_ring fixed bin ext; dcl pds$apt_ptr pointer external; dcl error_table_$badpath ext fixed bin (35); dcl error_table_$bad_process_type ext fixed bin (35); /* Constants */ dcl (addr, index, length, null, reverse, rtrim, search, substr, verify) builtin; %page; /* First get a pointer to the PIT. Do this with a call to initiate since we know our process directory name */ call pathname_am$initialize (); /* initialize associative memory before doing anything */ call initialize_kst; /* before initiate can be called we must have a KST */ pds$stacks (0) = pds$stack_0_ptr; call level$set (pds$initial_ring); /* set user ring validation level before initiating */ call pmut$set_mask (scs$open_level, temp); /* Now dispatch on the process type */ /* our goal is to establish wdir before calling makestack, so as to allow the user to substitute a signal_ or unwinder_ if she has v_init_proc. In order to do this we must initiate pit to check attribute. Luckily, if you call initiate without a refname it doesnt attempt to use the rnt, which isnt there yet. We would like to call initiate with the refname of "pit_", but as it is we will have to leave that for the user ring to do. */ call initiate ((pds$process_dir_name), "pit", "", (0), (0), pp, code); if pp = null then do; call syserr$error_code (3, code, "init_proc: could not get pointer to pit for ^a", pds$process_group_id); call terminate_proc$init_failure (code); end; if pp -> pit.process_type = 0 then /* initializer */ initial_proc = "system_startup_"; else if pp -> pit.process_type < 4 then /* interactive, absentee, or daemon */ initial_proc = "initialize_process_"; else do; call syserr$error_code (3, "init_proc: bad process type (^d) given for ^a", pp -> pit.process_type, pds$process_group_id); call terminate_proc$init_failure (error_table_$bad_process_type); end; if initial_proc ^= "system_startup_" then /* skip this setting for initializer as vol may not be there */ if pp -> pit.at.vinitproc then /* if user is allowed to have his own process overseer */ call fs_search$set_wdir (pp -> pit.homedir, (0)); /* set initial working dir to homedir */ /* Otherwise avoid * setting wdir, so user can't violate vinitproc restriction * by putting a copy of xxxx_init_admin_ in his homedir */ /* The error code from fs_search is ignored; if we can't * set a working dir we do the best we can without one */ call makestack (pds$initial_ring); /* create stack, RNT and search rules */ /* Now initialize more of the process */ /* * Now get a pointer to the initial procedure - the first one to be executed in the user's initial ring. * * The default initial procedure for a user is user_init_admin_ for an interactive process, or absentee_init_admin_ * for an absentee process. The proper one was selected above (its name being stored in initial_proc) as a function * of the process type. The initial procedure calls the login responder (also known as the process overseer). * * The default process overseer for a user is process_overseer_. * * It is possible for a procedure to be specified, either in the user's pdt entry, or by the user on the login line, * to be called instead of one of these two default procedures. The keyword "initproc" is used to identify this * procedure in both cases, and the keyword "direct" is used to indicate that the procedure is to be called directly, * in place of the default initial procedure, rather than being called by the default initial procedure * in place of the default process overseer. It is the "direct" case which we must check for here. * * By default, we do not use the referencing_dir search rule when searching for the initial procedure. This * allows a user to have an initial procedure of the same name as the default, in his home directory, and have * it used instead of the installed one. This will only happen if the user has the vinitproc attribute, * since, to enforce vinitproc, we put off setting his working directory to his home directory until * after we get the pointer to the initial procedure, if he does not have that attribute. */ caller_ptr = null; /* caller_ptr points to something in the referencing directory */ /* * The implementation of the "direct" feature is being changed, in stages. * Originally, this procedure was to scan for the string ",direct" at the end of the process overseer name, * and upon finding it, eliminate that string, and call the procedure specified by the remainder of the pathname, directly. * Then, the switch, pit.dont_call_init_admin was defined, and parts of the answering service were changed to * check for the string ",direct", and upon finding it, eliminate it from the pathname and turn on that switch. * However, some parts of the answering service do not check for the string or set the switch, so for now, * this procedure must check for both indications, and must be sure to eliminate the string ",direct" from the pathname * before attempting to get a pointer to the segment, even when the switch is found to be on. * The lines that check for ",direct" may be deleted after all parts of the answering service have been changed to * eliminate that string from the pathname and turn on the switch. */ po_len = -1 + index (pp -> pit.login_responder, ",direct"); /* look for ",direct" */ if po_len >= 0 then goto direct; /* ",direct" is there, and po_len is the length of the pathname that preceeds it */ if pp -> pit.dont_call_init_admin then do; /* check for the "direct" option */ /* compute length of pathname without trailing blanks */ po_len = length (rtrim (pp -> pit.login_responder)); direct: /* come here if ",direct" is in the process overseer pathname */ /* If string contains any ">" or "<" characters, it is a pathname */ e_len = -1 + search (reverse (substr (pp -> pit.login_responder, 1, po_len)), "<>"); /* see if it does */ if e_len >= 0 then do; /* it is a pathname, and e_len is the length of the entryname */ d_len = po_len - e_len - 1; /* compute length of dirname part */ /* * Since expand_path_ is not available in ring zero, and it does not have * an ideal interface for use in this stage of process initialization anyway, * we do the equivalent pathname parsing in-line. This algorithm is copied from * expand_path_, modified to avoid unnecessary generality. */ initial_proc = substr (pp -> pit.login_responder, d_len + 2, e_len); /* copy the entryname */ if substr (pp -> pit.login_responder, 1, 1) = ">" then /* if we have a full pathname */ dirname = substr (pp -> pit.login_responder, 1, d_len); /* just copy the directory portion */ else do; /* relative pathname - build dirname, using pit.homedir */ hd_len = length (pp -> pit.homedir) - verify (reverse (pp -> pit.homedir), " ") + 1; /* compute length of home directory */ less_thans = -1 + verify (substr (pp -> pit.login_responder, 1, d_len + 2), "<"); /* count leading "<"s */ /* if there is nothing but "<"s before the entry name, the verify gives the index of the first char of the entry name, and the -1 makes the less_than count correct */ if index (substr (pp -> pit.login_responder, 1 + less_thans, d_len - less_thans + 1), "<") > 0 then do; /* if any non-leading less thans, bad syntax in path */ bad_path: call syserr (4, "init_proc: bad syntax in initial procedure name: ^a for ^a", pp -> pit.login_responder, pds$process_group_id); call terminate_proc$init_failure (error_table_$badpath); end; do i = 1 to less_thans; /* if there are no less thans, this loop is skipped */ j = index (reverse (substr (pp -> pit.homedir, 1, hd_len)), ">"); /* back up thru "less_thans" components and ">"s */ if j = 0 then /* if no more left, too many "<"s */ goto bad_path; /* just say bad path - don't bother with details */ hd_len = hd_len - j; /* shorten hd len by length of component and its leading ">" */ end; /* end less thans loop */ if hd_len > 166 then /* just a formality */ goto bad_path; if hd_len + d_len - less_thans + e_len + 2 > 168 then /* not just a formality */ goto bad_path; /* path too long */ /* now build the directory portion of the pathname */ if hd_len > 0 then /* if the less thans did not get us back to the root */ substr (dirname, 1, hd_len) = substr (pp -> pit.homedir, 1, hd_len); if d_len - less_thans > 0 then do; /* if ent rather than dir" */ substr (dirname, hd_len + 2) = substr (pp -> pit.login_responder, less_thans + 1, d_len - less_thans); end; end; /* end relative pathname */ /* * Try to initiate the segment specified by that pathname. Note that the pointer to it goes into caller_ptr, * which is used below, in the call to call_outer_ring_, to indicate the referencing directory. */ call initiate (dirname, initial_proc, initial_proc, 0, 0, caller_ptr, code); if caller_ptr = null then do; /* code could be error_table_$segknown if process is prelinked */ call syserr$error_code (4, code, "init_proc: can not get pointer to initial procedure: ^a>^a for ^a", dirname, initial_proc, pds$process_group_id); call terminate_proc$init_failure (code); end; end; /* end pathname */ /* End of in-line expand_path_ */ else initial_proc = substr (pp -> pit.login_responder, 1, po_len); /* must be an entry name */ end; /* end dont_call_init_admin (call process overseer directly) */ call terminate_$noname (pp, code); /* terminate the pit */ /**** The following code sets the value of apte.ipc_r_factor used in conjunction with apte.ipc_r_offset for IPC event channel validation. apte.ipc_r_offset was set in act_proc, and apte.ipc_r_factor is set here to allow for an unpredictable delay between setting the two values. This makes it difficult to guess the value of apte.ipc_r_factor given the value of apte.ipc_r_offset. Note we are modifying our own apte here. This should be ok since we can be sure that no one else will attempt to modify this value, and that the apte is not going anywhere while we are executing here in ring-0. */ aptep = pds$apt_ptr; apte.ipc_r_factor = binary (substr (bit (binary (clock (), 54), 54), 19, 36), 35); /* Now call out. this program does all the work of snapping the link */ /* caller_ptr will be nonnull if there was a pathname */ call call_outer_ring_ (caller_ptr, initial_proc, initial_proc, (pds$initial_ring), code); if code ^= 0 then do; call syserr$error_code (4, code, "init_proc: can not call out to initial procedure: ^a for ^a", initial_proc, pds$process_group_id); call terminate_proc$init_failure (code); end; /* format: off */ %page; %include apte; %page; %include pit; %page; %include user_attributes; %page; /* BEGIN MESSAGE DOCUMENTATION Message: init_proc: could not get pointer to pit for PERSON.PROJ.T ERROR_MESSAGE S: $beep T: $run M: The answering service has created the process directory for a new process incorrectly. The user cannot be logged in. A: $contact Message: init_proc: bad process type (N) given for PERSON.PROJ.T S: $beep T: $run M: The answering service has specified an unknown integer in the process type field. Incorrect arguments were passed to hphcs_$create_proc. The user cannot be logged in. A: $contact Message: init_proc: bad syntax in initial procedure name: STRING for PERSON.PROJ.T S: $log T: $run M: An illegal initial procedure name was specified for the user. The user may have given an incorrect -po argument, or the project's PDT may be wrong. No process is created. A: $ignore Message: init_proc: can not get pointer to initial procedure: PATH for PERSON.PROJ.T ERROR_MESSAGE S: $log T: $run M: The supervisor could not initiate the specified initial procedure PATH. The process overseer may be in invalid form, inaccessible, or missing. The user may have given an incorrect -po argument, or the project's PDT may be incorrect. A: $ignore Message: init_proc: can not call out to initial procedure: NAME for PERSON.PROJ.T ERROR_MESSAGE S: $log T: $run M: The supervisor could not snap a link to NAME$NAME. The process overseer may be in invalid form, inaccessible, or missing. The user may have given an incorrect -po argument, or the project's PDT may be incorrect. A: $ignore END MESSAGE DOCUMENTATION */ /* format: on */ end init_proc;  initialize_kst.pl1 11/11/89 1107.3r w 11/11/89 0805.3 29385 /****^ ****************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright (c) 1987 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * ****************************************************** */ initialize_kst: proc (); /* Initialize_kst is called during system initialization and process creation to initialize the Known Segment Table and the Reference Name Table. LAST MODIFIED: Feb 1983 by E. N. Kittlitz to set kst.allow_256K_connect for inzr Nov 1979 by Mike Grady to set pds$max_lot_size to kst size for inzr June 1979 by Mike Grady to not set stack_base_segno to pds for stack sharing September 1977 by B. Greenberg to keep Initialhzer KST below initsegs during initialization. March 1977 by M. Weaver to move rnt, search rule initialization to makestack October 1975 by R. Bratt to not preinitialize all kstes October 1975 by R. Bratt for prelinking March 1975 by R. Bratt for the new KST / RNT USAGE: - - - call initialize_kst(); */ % include kst; % include slt; dcl (baseno, addr, fixed, string) builtin; dcl first_time bit (1), this_is_initializer bit (1), highseg fixed bin, i fixed bin; dcl kst_seg$ ext, slt$ ext, pds$max_lot_size (0:7) fixed bin ext, pds$processid bit (36) aligned ext, tc_data$initializer_id bit (36) aligned ext, dseg$ (0: 1) fixed bin (71) ext, active_all_rings_data$stack_base_segno fixed bin (18) ext, /* segno of first stack segment */ (active_all_rings_data$hcscnt, active_all_rings_data$max_segno) ext fixed bin (17), pds$ fixed bin ext; kstp = addr (kst_seg$); /* Get a pointer to the KST seg */ this_is_initializer = (pds$processid = tc_data$initializer_id); /* set initializer flag */ if this_is_initializer then if kst.lowseg ^= 0 then first_time = "0"b; else first_time = "1"b; if this_is_initializer & first_time then do; highseg = addr (slt$) -> slt.first_init_seg - 1; kst.allow_256K_connect = "1"b; end; else highseg = active_all_rings_data$max_segno; if this_is_initializer & ^first_time then do; kst.highseg = highseg; /* Expand mx limit, init segs gone. */ pds$max_lot_size (*) = highseg + 1; return; end; pds$kstp = kstp; /* initialize pointer to kst */ if string (kst.prelinked_ring) = "0"b then do; /* only initialize if not prelinked process */ kst.lowseg = active_all_rings_data$hcscnt; if kst.highseg = 0 then kst.highseg = highseg; kst.highest_used_segno = kst.lowseg + 7; kst.free_list = "0"b; /* reserve kstes for stacks */ do i = kst.lowseg to kst.lowseg + 7; kst.kst_entry (i).fp = (18)"1"b; kst.kst_entry (i).segno = i; end; end; return; end initialize_kst;  stop_process.pl1 11/11/89 1107.3r w 11/11/89 0805.3 16047 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ stop_process: proc (a_process_id); /* Procedure used by a process to put itself into "stopped" state. Called by process-overseer on new_proc and logout. Changed to crash system if caller is initializer - E Stone Aug 1974 Converted to PL/I, C Garman, 3 Feb 1971. */ dcl a_process_id bit (36) aligned; dcl process_id bit (36) aligned, istate fixed bin; dcl pds$process_id bit (36) aligned ext, tc_data$initializer_id bit (36) aligned ext; dcl syserr entry options (variable); dcl pxss$stop entry (bit (36) aligned, fixed bin); process_id = a_process_id; /* Copy input */ if process_id = pds$process_id then do; /* See if proper process */ if process_id = tc_data$initializer_id then /* Might as well end it all */ call syserr (1, "stop_process: attempt to stop initializer process"); call pxss$stop (process_id, istate); end; /* That's all folks! */ /* BEGIN MESSAGE DOCUMENTATION Message: stop_process: attempt to stop initializer process S: $crash T: $run M: $err A: $recover END MESSAGE DOCUMENTATION */ end stop_process; 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