?? TITLE := 'NOS/VE - MMM$SEGMENT_MANAGER_SYSTEM_CORE' ??
MODULE mmm$segment_manager_system_core;

?? RIGHT := 110 ??
?? NEWTITLE := '  TYPE Declarations required for this module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_byte_address
*copyc amt$segment_pointer
*copyc dfe$error_condition_codes
*copyc dmt$disk_file_descriptor
*copyc dmt$error_condition_codes
*copyc dmt$new_file_attribute
*copyc gft$system_file_identifier
*copyc gft$file_desc_entry_p
*copyc gft$locked_file_desc_entry_p
*copyc mmc$shadow_allocation_size
*copyc mme$condition_codes
*copyc mmt$access_selections
*copyc mmt$rb_change_segment_table
*copyc mmt$rb_fetch_offset_mod_pages
*copyc mmt$rb_ring1_segment_request
*copyc mmt$rb_ring1_server_seg_request
*copyc mmt$rb_set_get_segment_length
*copyc mmt$segment_attrib_descriptor
*copyc osc$asid_ei
*copyc osc$purge_map_and_cache
*copyc osd$virtual_address
*copyc oss$mainframe_paged_literal
*copyc ost$caller_identifier
*copyc ost$execution_control_block
*copyc ost$heap
*copyc ost$monitor_fault
*copyc ost$status
*copyc ost$system_privilege_map
*copyc rmc$mass_storage_class
*copyc sft$file_space_limit_kind
*copyc syt$user_defined_condition
?? POP ??
?? TITLE := '  External Procedures referenced in this module', EJECT ??
*copyc dfp$set_server_eoi
*copyc dmp$allocate_file_space_r1
*copyc dmp$create_disk_file
*copyc dmp$destroy_file
*copyc dmp$fetch_eoi
*copyc dmp$free_server_file_tables
*copyc dmp$get_disk_file_descriptor_p
*copyc dmp$get_initialized_addresses
*copyc dmp$get_total_allocated_length
*copyc dmp$mm_log_sft_delete
*copyc dpp$put_critical_message
*copyc dmp$reallocate_file_space
*copyc dmp$sparse_allocate
*copyc dmv$active_volume_table
*copyc gfp$assign_fde
*copyc gfp$free_fde
*copyc gfp$get_eoi_from_fde
*copyc gfp$get_fde_p
*copyc gfp$lock_fde
*copyc gfp$unlock_fde_p
*copyc gfp$get_locked_fde_p
*copyc i#build_adaptable_heap_pointer
*copyc i#build_adaptable_seq_pointer
*copyc i#call_monitor
*copyc i#enable_traps
*copyc i#move
*copyc i#restore_traps
*copyc mmp$advise_in
*copyc mmp$advise_out
*copyc mmp$assign_contiguous_memory
*copyc mmp$convert_ps_transfer_size
*copyc mmp$free_pages
*copyc mmp$get_max_sdt_sdtx_pointer
*copyc mmp$get_sdt_entry_p
*copyc mmp$get_sdtx_entry_p
*copyc mmp$touch_all_pages
*copyc mmp$unlock_segment
*copyc mmp$write_modified_pages
*copyc osp$begin_system_activity
*copyc osp$end_system_activity
*copyc osp$set_status_condition
*copyc osp$system_error
*copyc pmp$cycle
*copyc pmp$delay
*copyc pmf$executing_task_xcb
*copyc pmf$task_xcb
*copyc pmp$find_executing_task_xcb
*copyc pmp$find_task_xcb
*copyc pmp$get_executing_task_gtid
*copyc pmp$set_system_flag
*copyc pmp$zero_out_table
*copyc syp$cause_condition
*copyc syp$establish_condition_handler
*copyc syp$mfh_for_hang_task
*copyc syp$set_status_from_mtr_status
*copyc syp$return_jobs_r1_resources
*copyc syp$terminate_task
?? TITLE := '  External Variables referenced in this module', EJECT ??
*copyc dmv$idle_system
*copyc gfv$null_sfid
*copyc jmv$executing_within_system_job
*copyc jmv$jcb
*copyc jmv$system_ijl_ordinal
*copyc jmv$task_private_templ_p
*copyc mmv$ast_p
*copyc mmv$big_segment
*copyc mmv$first_transient_seg_index
*copyc mmv$max_pages_no_file
*copyc mmv$page_map_offsets
*copyc mmv$page_streaming_prestream
*copyc mmv$page_streaming_transfer
*copyc mmv$preset_conversion_table
*copyc mmv$shadow_by_segnum
*copyc osv$job_fixed_heap
*copyc osv$cpus_logically_on
*copyc osv$cpus_physically_configured
*copyc osv$page_size
*copyc syv$job_initialization_complete
?? TITLE := '  Global Declarations defined and used in this module', EJECT ??

  CONST
    max_specified_transfer_size = 1048576; { Limit user specified transfer size to 1MB (1,048,576)

{  Define global variables used by this module.

  VAR
    mmv$sfid_match: [XDCL] integer,
    mmv$sfid_mismatch: [XDCL] integer,
    mmv$sparse_threshold: [XDCL] integer := 30 * 4096, {Arbitrary number}

    mmv$default_sdt_entry: [READ, oss$mainframe_paged_literal] mmt$segment_descriptor :=
          [[osc$vl_regular_segment, osc$non_executable, osc$read_uncontrolled, osc$write_uncontrolled, 1, 1,
          0, [FALSE, FALSE, 0]], 0, 0],
    mmv$default_sdtx_entry: [XDCL, #GATE, READ, oss$mainframe_paged_literal]
          mmt$segment_descriptor_extended := [1, mmc$sas_allow_access, * , mmc$si_none,
          mmc$srs_not_reserved, [], mmc$sar_write_extend, mmc$lss_none, [0, 0, * , mmc$ssk_none, FALSE],
          sfc$no_limit, [0, 0, 2, 0, FALSE, FALSE, FALSE], osc$max_segment_length];

?? TITLE := '  ASID FUNCTIONS - (from common decks)', EJECT ??
*copyc mmp$asid_functions
?? TITLE := '  DESTROY_SEGMENT', EJECT ??

  PROCEDURE destroy_segment
    (    xsfid: gft$system_file_identifier;
         fde_entry_p: gft$file_desc_entry_p;
         file_limits_enforced: sft$file_space_limit_kind;
     VAR status: ost$status);

    VAR
      rb: mmt$rb_ring1_segment_request,
      sfid: gft$system_file_identifier;

    sfid := xsfid;
    IF fde_entry_p^.media = gfc$fm_transient_segment THEN
      IF fde_entry_p^.asti <> 0 THEN
        rb.reqcode := syc$rc_ring1_segment_request;
        rb.request := mmc$sr1_delete_seg_sfid;
        rb.sfid := sfid;
        i#call_monitor (#LOC (rb), #SIZE (rb));
      IFEND;
      gfp$free_fde (fde_entry_p, sfid);
    ELSE
      dmp$destroy_file (sfid, file_limits_enforced, status);
    IFEND;

  PROCEND destroy_segment;
?? TITLE := '  EXPAND_SEGMENT_TABLE', EJECT ??

  PROCEDURE expand_segment_table
    (    xcb_p: ^ost$execution_control_block;
     VAR status: ost$status);

{
{   The purpose of this procedure is to expand the SDT and SDTX when a segment table full
{ situation is encountered when adding a new segment.  Currently, the maximum number of
{ segments a task can have open/attached is 4095.
{

    CONST
      segment_table_size_increase = 32;

    VAR
      new_sdt_length: integer, {must be an integer variable}
      new_table_size: ost$segment_length,
      old_sdt_length: ost$segment,
      old_sdt_offset: 0 .. 0ffffffff(16),
      old_sdtx_offset: 0 .. 0ffffffff(16),
      old_sdt_p: ^cell,
      old_sdtx_p: ^cell,
      new_sdt_p: ^mmt$segment_descriptor_table,
      new_sdtx_p: ^mmt$segment_descriptor_table_ex,
      request_block: mmt$rb_change_segment_table;

    status.normal := TRUE;

{ Save the following values, so that the old SDT and SDTX can be freed after
{ the new ones are successsfully allocated.

    old_sdt_offset := xcb_p^.sdt_offset;
    old_sdtx_offset := xcb_p^.sdtx_offset;
    old_sdt_length := xcb_p^.xp.segment_table_length;

    new_sdt_length := xcb_p^.xp.segment_table_length + segment_table_size_increase;

    IF ((new_sdt_length + 1) * 8) > osv$page_size THEN
      new_sdt_length := ((((new_sdt_length + 1) * 8) + osv$page_size) DIV osv$page_size);
      new_table_size := new_sdt_length * osv$page_size;
      new_sdt_length := ((new_sdt_length * osv$page_size) DIV 8) - 1;
    IFEND;

    IF new_sdt_length >= 4096 THEN
      new_sdt_length := 4095;
    IFEND;

    IF new_sdt_length = xcb_p^.xp.segment_table_length THEN
      osp$set_status_condition (mme$segment_table_is_full, status);
      RETURN; {----->
    IFEND;

    ALLOCATE new_sdt_p: [0 .. new_sdt_length] IN osv$job_fixed_heap^;

    IF ((new_sdt_length + 1) * 8) > osv$page_size THEN
      mmp$free_pages (new_sdt_p, new_table_size, osc$nowait, status);
      mmp$assign_contiguous_memory (new_sdt_p, new_table_size, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    ELSE
      pmp$zero_out_table (#LOC (new_sdt_p^), #SIZE (new_sdt_p^));
    IFEND;

{  Allocate and zero out the SDTX.

    ALLOCATE new_sdtx_p: [0 .. new_sdt_length] IN osv$job_fixed_heap^;

    pmp$zero_out_table (#LOC (new_sdtx_p^), #SIZE (new_sdtx_p^));

{  Issue monitor request to move old segment table to new segment table, update segment table
{  address and segment table length in task's exchange package.

    request_block.request_code := syc$rc_change_segment_table;
    request_block.new_sdt_offset := #OFFSET (new_sdt_p);
    request_block.new_sdtx_offset := #OFFSET (new_sdtx_p);
    request_block.new_sdt_length := new_sdt_length;
    i#call_monitor (#LOC (request_block), #SIZE (request_block));
    syp$set_status_from_mtr_status (request_block.status, status);
    IF NOT status.normal THEN
      osp$system_error ('Error in change segment table monitor request.', ^status);
      RETURN; {----->
    IFEND;

{  Free the old SDT and SDTX tables.
{  NOTE: Job monitor's SDT and SDTX are not allocated, hence they can not be freed unless they
{        have been expanded once.

    IF (old_sdt_length * 8) > osv$page_size THEN
      mmp$free_pages (#ADDRESS (1, osc$segnum_job_fixed_heap, old_sdtx_offset),
            (old_sdt_length * #SIZE (mmt$segment_descriptor_extended)), osc$wait, status);
    IFEND;
    IF old_sdt_offset >= #OFFSET (osv$job_fixed_heap) THEN
      old_sdt_p := #ADDRESS (1, osc$segnum_job_fixed_heap, old_sdt_offset);
      old_sdtx_p := #ADDRESS (1, osc$segnum_job_fixed_heap, old_sdtx_offset);
      FREE old_sdt_p IN osv$job_fixed_heap^;
      FREE old_sdtx_p IN osv$job_fixed_heap^;
    IFEND;

  PROCEND expand_segment_table;

?? TITLE := '  FIND_AVAILABLE_SEGMENT_NUMBER', EJECT ??

  PROCEDURE [INLINE] find_available_segment_number
    (    xcb_p: ^ost$execution_control_block;
         segment_res_state: mmt$segment_reservation_state;
     VAR segnum: ost$segment;
     VAR status: ost$status);

    VAR
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      segment_table_length: integer;


    {  Find an available segment number.

    status.normal := TRUE;
    segnum := mmv$first_transient_seg_index - 1;
    segment_table_length := xcb_p^.xp.segment_table_length;
    mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);

    REPEAT
      IF segnum < 0FFF(16) THEN
        segnum := segnum + 1;
      ELSE
        osp$set_status_condition (mme$segment_table_is_full, status);
        RETURN; {----->
      IFEND;
      IF segnum > segment_table_length THEN
        expand_segment_table (xcb_p, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        segment_table_length := xcb_p^.xp.segment_table_length;
      IFEND;
    UNTIL (sdt_p^.st [segnum].ste.vl = osc$vl_invalid_entry) AND
          (sdtx_p^.sdtx_table [segnum].segment_reservation_state = segment_res_state);

  PROCEND find_available_segment_number;

?? TITLE := '  STORE_STE_IN_SEGMENT_TABLE', EJECT ??

  PROCEDURE store_ste_in_segment_table
    (    xsdt_entry: mmt$segment_descriptor;
         sfid: gft$system_file_identifier;
         ste_p: ^mmt$segment_descriptor;
         fde_entry_p: gft$locked_file_desc_entry_p;
         segnum: ost$segment);

{ This routine is tricky so make sure you understand it before changing it!!!!!!!!!!!
{ This routine stores a STE entry into the segment table. If the ASID in the new ste
{ entry is zero then the procedure is straightforward.
{ If, however, the STE already has an ASID then things get more complicated since monitor may be
{ changing the ASID asynchronously while this routine is running.
{       . NEVER let a STE entry get into the segment table if the ASID/ASTI dont match
{       . after putting an entry in with a non-zero ASID, check the AST to see if the AST.SFID
{         agrees with the SDTX.SFID. IF they agree all is well. Otherwise, clear the ASID/ASTI to zero;
{         the assumption is that Memory Manager changed the ASID. The correct ASID will be fetched
{         on the first page fault. (this should not happen very much.)

    VAR
      aste_p: ^mmt$active_segment_table_entry,
      asid: ost$asid,
      asti: mmt$ast_index,
      rb: mmt$rb_ring1_segment_request,
      sdt_entry: mmt$segment_descriptor;

    sdt_entry := xsdt_entry;
    asti := fde_entry_p^.asti;
    IF (asti = 0) OR (sdt_entry.ste.asid = 0FFFF(16)) OR (mmv$ast_p = NIL) THEN
      ste_p^ := sdt_entry;
    ELSE
      sdt_entry.asti := asti;
      mmp$asid (asti, asid);
      sdt_entry.ste.asid := asid;
      ste_p^ := sdt_entry;
      aste_p := ^mmv$ast_p^ [sdt_entry.asti];

      IF (aste_p^.in_use) AND (aste_p^.sfid = sfid) AND

      (((sfid.residence = gfc$tr_job) AND (aste_p^.ijl_ordinal = jmv$jcb.ijl_ordinal)) OR

      ((sfid.residence = gfc$tr_system) AND

      (((aste_p^.queue_id = mmc$pq_job_working_set) AND (aste_p^.ijl_ordinal = jmv$jcb.ijl_ordinal) AND
            ((fde_entry_p^.queue_status = gfc$qs_job_working_set) OR
            ((fde_entry_p^.queue_status = gfc$qs_job_shared) AND (fde_entry_p^.attach_count = 1)))) OR

      (((aste_p^.queue_id >= mmc$pq_shared_first) AND (aste_p^.queue_id <= mmc$pq_shared_last)) AND
            (aste_p^.ijl_ordinal = jmv$system_ijl_ordinal) AND
            ((fde_entry_p^.queue_status = gfc$qs_global_shared) OR
            ((fde_entry_p^.queue_status = gfc$qs_job_shared) AND (fde_entry_p^.attach_count > 1))))))) THEN

        mmv$sfid_match := mmv$sfid_match + 1;
      ELSE
        mmv$sfid_mismatch := mmv$sfid_mismatch + 1;
        ste_p^ := xsdt_entry;

{ If the file is job shared and there is more that one user (attach) of the file, the above tests which
{ would have allowed the asid to be stored may have failed because pages of the file are being kept in
{ the working set and should now be kept in the shared queue.  (Or they may have failed because the
{ asid changed--we can't be sure by looking at the ast.queue_id.)  Issue a monitor request to straighten
{ out job shared files.  If there is more than one user, pages of job shared files must be removed
{ from the jws of the original job and moved to the shared queue before a second user can reference
{ any of the pages.

        IF (fde_entry_p^.queue_status = gfc$qs_job_shared) AND (fde_entry_p^.attach_count > 1) THEN
          rb.reqcode := syc$rc_ring1_segment_request;
          rb.request := mmc$sr1_remove_job_shared_pages;
          rb.system_file_id := sfid;
          rb.segment_number := segnum;
          rb.server_file := FALSE;
          i#call_monitor (#LOC (rb), #SIZE (rb));
        IFEND;
      IFEND;
    IFEND;
  PROCEND store_ste_in_segment_table;

?? TITLE := '  ADD_SDT_SDTX_ENTRY', EJECT ??
*copy mmh$add_sdt_sdtx_entry

  PROCEDURE add_sdt_sdtx_entry
    (    sdt_entry: mmt$segment_descriptor;
         sdtx_entry: mmt$segment_descriptor_extended;
         fde_entry_p: gft$locked_file_desc_entry_p;
         shared_taskid_array: ^array [1 .. * ] of pmt$task_id;
         segment_number: ost$segment);

    VAR
      cache_bypass: boolean,
      cell_p: ^cell,
      i: integer,
      local_sdt: mmt$segment_descriptor,
      local_sdtx: mmt$segment_descriptor_extended,
      pva_p: ^ost$pva,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      shadow_fde_p: gft$locked_file_desc_entry_p,
      task_sdt_p: ^mmt$segment_descriptor,
      task_sdtx_p: ^mmt$segment_descriptor_extended,
      task_xcb: ^ost$execution_control_block,
      xcb_p: ^ost$execution_control_block;

    local_sdt := sdt_entry;
    local_sdtx := sdtx_entry;

    pmp$find_executing_task_xcb (xcb_p);

{ Set cache bypass if required for multiprocessing.
    cache_bypass := FALSE;
    IF osv$cpus_physically_configured > 1 THEN
      IF (local_sdt.ste.xp = osc$non_executable) OR ((local_sdt.ste.xp <> osc$non_executable) AND
            (local_sdt.ste.wp <> osc$non_writable)) THEN

{ I dont think we need a clause for global_unnamed files because it appears
{ that they would drop out anyway.

        IF (fde_entry_p^.file_kind <> gfc$fk_unnamed_file) THEN
          IF (fde_entry_p^.queue_status = gfc$qs_job_working_set) THEN
            IF (jmv$jcb.ijle_p^.multiprocessing_allowed) THEN
              cache_bypass := TRUE;
              local_sdt.ste.vl := osc$vl_cache_bypass;
            IFEND;
          ELSE
            IF (fde_entry_p^.queue_status = gfc$qs_global_shared) THEN
              cache_bypass := TRUE;
              local_sdt.ste.vl := osc$vl_cache_bypass;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;


{  Add sdt_entry to the task's segment descriptor table (SDT) and the sdtx_entry to the
{  segment descriptor table extended (SDTX).

    sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segment_number);
    sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segment_number);
    local_sdtx.segment_reservation_state := sdtx_entry_p^.segment_reservation_state;
    mmp$set_segment_access_rights (local_sdt, local_sdtx);

    sdtx_entry_p^ := local_sdtx;
    store_ste_in_segment_table (local_sdt, local_sdtx.sfid, sdt_entry_p, fde_entry_p, segment_number);
    fde_entry_p^.open_count := fde_entry_p^.open_count + 1;

    IF local_sdtx.shadow_info.shadow_segment_kind <> mmc$ssk_none THEN
      gfp$get_locked_fde_p (local_sdtx.shadow_info.shadow_sfid, shadow_fde_p);
      shadow_fde_p^.open_count := shadow_fde_p^.open_count + 1;
      gfp$unlock_fde_p (shadow_fde_p);
    IFEND;

{If a stack segment was just created, update the TOS pointer.

    IF mmc$sa_stack IN sdtx_entry.software_attribute_set THEN
      cell_p := #ADDRESS (local_sdt.ste.r1, segment_number,
            (mmv$page_map_offsets [mmc$pmo_user_stack] * osv$page_size) + mmc$ring_crossing_offset);
      pva_p := #LOC (cell_p);
      xcb_p^.xp.tos_registers [local_sdt.ste.r1].pva := pva_p^;
      fde_entry_p^.stack_for_ring := local_sdt.ste.r1;
      IF local_sdt.ste.r1 > 3 THEN
        sdtx_entry_p^.file_limits_enforced := sfc$temp_file_space_limit;
      IFEND;
    IFEND;

    IF shared_taskid_array <> NIL THEN

      { Mmc$sa_stack is removed from the software attribute set before the sdtx entry of the segment
      { is propagated to all of the other tasks. The task which opens the stack segment will be
      { the only task with mmc$sa_stack in its sdtx entry.

      local_sdtx.software_attribute_set := local_sdtx.software_attribute_set -
            $mmt$software_attribute_set [mmc$sa_stack];
      FOR i := LOWERBOUND (shared_taskid_array^) TO UPPERBOUND (shared_taskid_array^) DO
        pmp$find_task_xcb (shared_taskid_array^ [i], task_xcb);
        IF task_xcb <> xcb_p THEN
          task_sdt_p := mmp$get_sdt_entry_p (task_xcb, segment_number);
          task_sdtx_p := mmp$get_sdtx_entry_p (task_xcb, segment_number);
          task_sdtx_p^ := local_sdtx;
          mmp$set_segment_access_rights (local_sdt, task_sdtx_p^);
          store_ste_in_segment_table (local_sdt, local_sdtx.sfid, task_sdt_p, fde_entry_p, segment_number);
          fde_entry_p^.open_count := fde_entry_p^.open_count + 1;
        IFEND;
      FOREND;
    IFEND;

    IF (osv$cpus_logically_on > 1) AND (NOT cache_bypass) THEN
      cell_p := #ADDRESS (1, segment_number, 0);
      #PURGE_BUFFER (osc$pva_purge_segment_cache, cell_p);
    IFEND;

  PROCEND add_sdt_sdtx_entry;

?? TITLE := '  MMP$ASSIGN_MASS_STORAGE', EJECT ??
{
{ Purpose:
{    This procedure assigns disk space for all pages currently assigned to a segment/file.
{    If necessary, it converts a transient file into a disk file.
{
{  segment_number: If non zero, this specifies the segment number
{  sfid: If segment number is zero, this is the SFID of the file
{  min_allocation_length: Normally zero. If zero disk space is assigned to all
{     pages that exist in the file. If non-zero, contiguous disk space is assign for
{     offset zero thru this offset. NOTE if
{

  PROCEDURE [XDCL, #GATE] mmp$assign_mass_storage
    (    segment_number: ost$segment;
         xsfid: gft$system_file_identifier;
         min_allocation_length: ost$segment_length;
     VAR status: ost$status);

    VAR
      assign_active: amt$file_byte_address,
      fde_p: gft$locked_file_desc_entry_p,
      file_attributes_p: ^array [1 .. * ] of dmt$file_attribute,
      file_limits: sft$file_space_limit_kind,
      length_to_allocate: ost$segment_length,
      max_pages_no_file: integer,
      page_streaming_ts_shift: 0 .. 15,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      sfid: gft$system_file_identifier,
      xcb_p: ^ost$execution_control_block;


    status.normal := TRUE;

    xcb_p := pmf$executing_task_xcb ();
    IF segment_number <> 0 THEN
      sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segment_number);
      file_limits := sdtx_entry_p^.file_limits_enforced;
      assign_active := sdtx_entry_p^.assign_active;
      sfid := sdtx_entry_p^.sfid;
      IF (mmc$sa_wired IN sdtx_entry_p^.software_attribute_set) OR
            (mmc$sa_fixed IN sdtx_entry_p^.software_attribute_set) THEN
        osp$set_status_condition (mme$segment_not_pageable, status);
        RETURN; {----->
      IFEND;
    ELSE
      file_limits := sfc$no_limit;
      assign_active := mmc$assign_active_escaped;
      sfid := xsfid;
    IFEND;


    gfp$get_locked_fde_p (sfid, fde_p);

    IF NOT dmv$idle_system THEN
      IF fde_p^.media = gfc$fm_transient_segment THEN
        IF fde_p^.flags.active_shadow_file THEN
          PUSH file_attributes_p: [1 .. 3];
          file_attributes_p^ [2].keyword := dmc$requested_allocation_size;
          file_attributes_p^ [2].requested_allocation_size := mmc$shadow_allocation_size;
          file_attributes_p^ [3].keyword := dmc$requested_transfer_size;
          file_attributes_p^ [3].requested_transfer_size := mmc$shadow_allocation_size;
        ELSE
          PUSH file_attributes_p: [1 .. 1];
        IFEND;
        file_attributes_p^ [1].keyword := dmc$class;
        IF jmv$executing_within_system_job THEN
          file_attributes_p^ [1].class := rmc$msc_system_critical_files;
        ELSE
          file_attributes_p^ [1].class := rmc$msc_user_temporary_files;
        IFEND;
        dmp$create_disk_file (fde_p, file_attributes_p, 0, sfid, status);
        IF (segment_number <> 0) AND NOT sdtx_entry_p^.stream.transfer_size_specified THEN
          mmp$convert_ps_transfer_size (fde_p^.transfer_unit_size, page_streaming_ts_shift);
          sdtx_entry_p^.stream.transfer_size := page_streaming_ts_shift;
        IFEND;
      IFEND;

      IF status.normal THEN
        length_to_allocate := fde_p^.eoi_byte_address;
        IF (min_allocation_length > 0) OR (length_to_allocate < mmv$sparse_threshold) OR
              (fde_p^.media = gfc$fm_served_file) THEN
          IF length_to_allocate < min_allocation_length THEN
            length_to_allocate := min_allocation_length;
          IFEND;
          dmp$allocate_file_space_r1 (sfid, 0, length_to_allocate, 0, osc$nowait, file_limits, status);
        ELSE
          dmp$sparse_allocate (sfid, assign_active, file_limits, status);
        IFEND;
      IFEND;
    IFEND;

    gfp$unlock_fde_p (fde_p);

{ If everything worked OK, clear the assign active flag in the SDTX or XCB since there cannot
{ be any more escaped allocation or allocation required.

    IF status.normal THEN
      IF segment_number <> 0 THEN
        sdtx_entry_p^.assign_active := mmc$assign_active_null;
      ELSE
        xcb_p^.assign_active_sfid := gfv$null_sfid;
      IFEND;
    IFEND

  PROCEND mmp$assign_mass_storage;

?? TITLE := '  MMP$BUILD_SEGMENT', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$build_segment
    (    attrib: mmt$segment_attrib_descriptor;
         shared_taskid_array: ^array [1 .. * ] of pmt$task_id;
     VAR segment_pointer: mmt$segment_pointer;
     VAR status: ost$status);

    VAR
      i: integer,
      fde_entry_p: gft$file_desc_entry_p,
      file_hash: 0 .. 255,
      locked_fde_entry_p: gft$locked_file_desc_entry_p,
      page_streaming_ts_shift: 0 .. 15,
      page_streaming_transfer_size: integer,
      sdt_entry: mmt$segment_descriptor,
      sdtx_entry: mmt$segment_descriptor_extended,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      segment_length: ost$segment_length,
      segment_number: ost$segment,
      segment_res_state: mmt$segment_reservation_state,
      sfid: gft$system_file_identifier,
      shadow_fde_p: gft$file_desc_entry_p,
      shadow_sdt_p: ^mmt$segment_descriptor,
      shadow_sdtx_p: ^mmt$segment_descriptor_extended,
      task_xcb: ^ost$execution_control_block,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    sdt_entry := mmv$default_sdt_entry;
    sdtx_entry := mmv$default_sdtx_entry;
    sdt_entry.ste.r1 := attrib.validating_ring_number;
    sdt_entry.ste.r2 := attrib.validating_ring_number;
    sdtx_entry.open_validating_ring_number := attrib.validating_ring_number;
    sdtx_entry.file_limits_enforced := attrib.file_limits_to_enforce;
    segment_number := 0;
    IF shared_taskid_array <> NIL THEN
      FOR i := LOWERBOUND (shared_taskid_array^) TO UPPERBOUND (shared_taskid_array^) DO
        pmp$find_task_xcb (shared_taskid_array^ [i], task_xcb);
        IF task_xcb = NIL THEN
          osp$set_status_condition (mme$invalid_shared_taskid, status);
          RETURN; {----->
        IFEND;
      FOREND;
    IFEND;
    IF attrib.sfid = gfv$null_sfid THEN
      gfp$assign_fde (gfc$tr_job, segment_number, sfid, fde_entry_p);
      IF fde_entry_p = NIL THEN
        osp$set_status_condition (mme$unable_to_assign_fde, status);
        RETURN; {----->
      IFEND;
      gfp$get_locked_fde_p (sfid, locked_fde_entry_p);
      locked_fde_entry_p^.queue_status := gfc$qs_job_working_set;
      locked_fde_entry_p^.file_kind := gfc$fk_unnamed_file;
    ELSE
      sfid := attrib.sfid;
      gfp$get_locked_fde_p (sfid, locked_fde_entry_p);
      IF locked_fde_entry_p = NIL THEN
        osp$set_status_condition (mme$invalid_sfid, status);
        RETURN; {----->
      IFEND;
    IFEND;

    sdtx_entry.sfid := sfid;

  /user_attributes/
    BEGIN
      IF attrib.user_attributes <> NIL THEN
        FOR i := LOWERBOUND (attrib.user_attributes^) TO UPPERBOUND (attrib.user_attributes^) DO
          CASE attrib.user_attributes^ [i].keyword OF
          = mmc$kw_null_keyword =
          = mmc$kw_ring_numbers =
            IF (attrib.user_attributes^ [i].r1 > attrib.user_attributes^ [i].r2) OR
                  (attrib.user_attributes^ [i].r2 = 0) THEN
              osp$set_status_condition (mme$invalid_ring_brackets, status);
              EXIT /user_attributes/; {----->
            IFEND;
            sdt_entry.ste.r1 := attrib.user_attributes^ [i].r1;
            sdt_entry.ste.r2 := attrib.user_attributes^ [i].r2;
          = mmc$kw_segment_number =
            segment_number := attrib.user_attributes^ [i].segnum;
          = mmc$kw_hardware_attributes =
            IF mmc$ha_read IN attrib.user_attributes^ [i].hardware_attri_set THEN
              sdt_entry.ste.rp := osc$read_uncontrolled;
            ELSE
              sdt_entry.ste.rp := osc$non_readable;
            IFEND;
            IF mmc$ha_binding IN attrib.user_attributes^ [i].hardware_attri_set THEN
              IF attrib.validating_ring_number <= 3 THEN
                sdt_entry.ste.rp := osc$binding_segment;
              ELSE
                osp$set_status_condition (mme$binding_attribute_invalid, status);
                EXIT /user_attributes/; {----->
              IFEND;
            IFEND;
            IF mmc$ha_write IN attrib.user_attributes^ [i].hardware_attri_set THEN
              sdt_entry.ste.wp := osc$write_uncontrolled;
            ELSE
              sdt_entry.ste.wp := osc$non_writable;
            IFEND;
            IF mmc$ha_cache_bypass IN attrib.user_attributes^ [i].hardware_attri_set THEN
              sdt_entry.ste.vl := osc$vl_cache_bypass;
            ELSE
              sdt_entry.ste.vl := osc$vl_regular_segment;
            IFEND;
            IF mmc$ha_execute IN attrib.user_attributes^ [i].hardware_attri_set THEN
              sdt_entry.ste.xp := osc$non_privileged;
            ELSE
              IF mmc$ha_execute_local IN attrib.user_attributes^ [i].hardware_attri_set THEN
                sdt_entry.ste.xp := osc$local_privilege;
              ELSE
                IF (mmc$ha_execute_global IN attrib.user_attributes^ [i].hardware_attri_set) AND
                      (attrib.validating_ring_number > 1) THEN
                  osp$set_status_condition (mme$execute_global_invalid, status);
                  EXIT /user_attributes/; {----->
                ELSE
                  sdt_entry.ste.xp := osc$non_executable;
                IFEND;
              IFEND;
            IFEND;
          = mmc$kw_software_attributes =
            IF attrib.validating_ring_number <= 3 THEN
              sdtx_entry.software_attribute_set := attrib.user_attributes^ [i].software_attri_set;
            ELSEIF ((attrib.validating_ring_number <= 6) AND (($mmt$software_attribute_set [mmc$sa_stack] *
                  attrib.user_attributes^ [i].software_attri_set) <> $mmt$software_attribute_set [])) OR
                  ((attrib.validating_ring_number > 6) AND (($mmt$software_attribute_set
                  [mmc$sa_wired, mmc$sa_fixed, mmc$sa_stack] * attrib.user_attributes^ [i].
                  software_attri_set) <> $mmt$software_attribute_set [])) THEN
              osp$set_status_condition (mme$software_attribute_invalid, status);
              EXIT /user_attributes/; {----->
            ELSE
              sdtx_entry.software_attribute_set := attrib.user_attributes^ [i].software_attri_set;
            IFEND;
          = mmc$kw_error_exit_procedure =
            osp$set_status_condition (mme$unsupported_keyword, status);
            EXIT /user_attributes/; {----->
          = mmc$kw_max_segment_length =
            locked_fde_entry_p^.file_limit := attrib.user_attributes^ [i].max_length;
          = mmc$kw_gl_key =
            sdt_entry.ste.key_lock := attrib.user_attributes^ [i].gl_key;
          = mmc$kw_clear_space =
          = mmc$kw_preset_value =
            locked_fde_entry_p^.preset_value := attrib.user_attributes^ [i].preset_value;
          = mmc$kw_segment_access_control =
            IF attrib.user_attributes^ [i].access_control.cache_bypass = TRUE THEN
              sdt_entry.ste.vl := osc$vl_cache_bypass;
            ELSE
              sdt_entry.ste.vl := osc$vl_regular_segment;
            IFEND;

            IF (attrib.user_attributes^ [i].access_control.execute_privilege = osc$global_privilege) AND
                  (attrib.validating_ring_number > 1) THEN
              osp$set_status_condition (mme$execute_global_invalid, status);
              EXIT /user_attributes/; {----->
            ELSE
              sdt_entry.ste.xp := attrib.user_attributes^ [i].access_control.execute_privilege;
            IFEND;

            IF (attrib.user_attributes^ [i].access_control.read_privilege = osc$binding_segment) AND
                  (attrib.validating_ring_number > 3) THEN
              osp$set_status_condition (mme$binding_attribute_invalid, status);
              EXIT /user_attributes/; {----->
            IFEND;
            sdt_entry.ste.rp := attrib.user_attributes^ [i].access_control.read_privilege;
            sdt_entry.ste.wp := attrib.user_attributes^ [i].access_control.write_privilege;
          = mmc$kw_asid =
            IF attrib.validating_ring_number <> 1 THEN
              osp$set_status_condition (mme$asid_specified, status);
              EXIT /user_attributes/; {----->
            IFEND;

            IF (attrib.user_attributes^ [i].asid = osc$asid_ei) OR
                  (attrib.user_attributes^ [i].asid = osc$asid_eie) OR
                  (attrib.user_attributes^ [i].asid = osc$asid_nos) THEN
              sdt_entry.ste.asid := attrib.user_attributes^ [i].asid;
            ELSE
              osp$set_status_condition (mme$invalid_asid_specified, status);
              EXIT /user_attributes/; {----->
            IFEND;
          = mmc$kw_wired_segment =
            sdtx_entry.software_attribute_set := sdtx_entry.software_attribute_set +
                  $mmt$software_attribute_set [mmc$sa_wired];
            locked_fde_entry_p^.file_limit := attrib.user_attributes^ [i].wired_segment_length;
          = mmc$kw_inheritance =
            sdtx_entry.inheritance := attrib.user_attributes^ [i].inheritance;
          = mmc$kw_shadow_segment =
            IF ((attrib.user_attributes^ [i].shadow_length MOD mmc$shadow_allocation_size) <> 0) THEN
              osp$set_status_condition (mme$length_not_0_mod_16384, status);
              EXIT /user_attributes/; {----->
            IFEND;
            IF ((#OFFSET (attrib.user_attributes^ [i].shadow_p) MOD mmc$shadow_allocation_size) <> 0) THEN
              osp$set_status_condition (mme$address_not_0_mod_16384, status);
              EXIT /user_attributes/; {----->
            IFEND;
            sdtx_entry.shadow_info.shadow_length_page_count :=
                  attrib.user_attributes^ [i].shadow_length DIV osv$page_size;
            sdtx_entry.shadow_info.shadow_start_page_number := #OFFSET (attrib.user_attributes^ [i].
                  shadow_p) DIV osv$page_size;
            mmp$validate_segment_number (#SEGMENT (attrib.user_attributes^ [i].shadow_p),
                  shadow_sdt_p, shadow_sdtx_p, status);
            IF NOT status.normal THEN
              EXIT /user_attributes/; {----->
            IFEND;
            IF shadow_sdtx_p^.shadow_info.shadow_segment_kind <> mmc$ssk_none THEN
              osp$set_status_condition (mme$invalid_shadow_segment, status);
              EXIT /user_attributes/; {----->
            IFEND;
            sdtx_entry.shadow_info.shadow_segment_kind := mmc$ssk_segment_number;
            sdtx_entry.shadow_info.shadow_segment_number := #SEGMENT (attrib.user_attributes^ [i].shadow_p);
            sdtx_entry.shadow_info.shadow_sfid := shadow_sdtx_p^.sfid;
            locked_fde_entry_p^.flags.active_shadow_file := TRUE;
            shadow_sdtx_p^.shadow_info.passive_for_shadow_by_segnum := TRUE;
          = mmc$kw_ps_transfer_size =
            page_streaming_transfer_size := attrib.user_attributes^ [i].ps_transfer_size;
            IF page_streaming_transfer_size > max_specified_transfer_size THEN
              page_streaming_transfer_size := max_specified_transfer_size;
            IFEND;
            mmp$convert_ps_transfer_size (page_streaming_transfer_size, page_streaming_ts_shift);
            sdtx_entry.stream.transfer_size := page_streaming_ts_shift;
            sdtx_entry.stream.transfer_size_specified := TRUE;
          ELSE
            EXIT /user_attributes/; {----->
          CASEND;
        FOREND;
      IFEND;

{  Find an available segment number if the caller did not supply one.

      xcb_p := pmf$executing_task_xcb ();

      IF segment_number = 0 THEN
        IF shared_taskid_array = NIL THEN
          segment_res_state := mmc$srs_not_reserved;
        ELSE
          segment_res_state := mmc$srs_reserved_shared_stack;
        IFEND;
        find_available_segment_number (xcb_p, segment_res_state, segment_number, status);
      ELSE
        mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
        IF NOT status.normal AND (status.condition = mme$segment_number_not_in_use) THEN
          status.normal := TRUE;
          WHILE (segment_number > xcb_p^.xp.segment_table_length) DO
            expand_segment_table (xcb_p, status);
            IF NOT status.normal THEN
              EXIT /user_attributes/; {----->
            IFEND;
          WHILEND;
        ELSEIF status.normal THEN
          osp$set_status_condition (mme$segment_number_is_in_use, status);
        IFEND;
      IFEND;
    END /user_attributes/;

    IF NOT status.normal THEN
      gfp$unlock_fde_p (locked_fde_entry_p);
      IF attrib.sfid = gfv$null_sfid THEN
        gfp$free_fde (fde_entry_p, sfid);
      IFEND;
      RETURN; {----->
    IFEND;

    locked_fde_entry_p^.last_segment_number := segment_number;
    locked_fde_entry_p^.global_task_id := xcb_p^.global_task_id;

    IF (mmc$sa_read_transfer_unit IN sdtx_entry.software_attribute_set) THEN
      sdtx_entry.stream.sequential_accesses := mmv$page_streaming_prestream;
    IFEND;

    IF NOT sdtx_entry.stream.transfer_size_specified THEN
      mmp$convert_ps_transfer_size (locked_fde_entry_p^.transfer_unit_size, page_streaming_ts_shift);
      IF mmv$page_streaming_transfer > 0 THEN {override transfer size with mmv$page_streaming_transfer
        mmp$convert_ps_transfer_size (mmv$page_streaming_transfer, page_streaming_ts_shift);
      IFEND;
      sdtx_entry.stream.transfer_size := page_streaming_ts_shift;
    IFEND;

    add_sdt_sdtx_entry (sdt_entry, sdtx_entry, locked_fde_entry_p, shared_taskid_array, segment_number);

    IF locked_fde_entry_p^.file_limit < osc$maximum_offset THEN
      segment_length := locked_fde_entry_p^.file_limit;
    ELSE
      segment_length := osc$maximum_offset;
    IFEND;

    CASE attrib.pointer_kind OF
    = mmc$sequence_pointer =
      i#build_adaptable_seq_pointer (sdt_entry.ste.r1, segment_number, 0 {offset} , segment_length, 0,
            segment_pointer.seq_pointer);
    = mmc$heap_pointer =
      i#build_adaptable_heap_pointer (sdt_entry.ste.r1, segment_number, 0 {offset} , segment_length,
            segment_pointer.heap_pointer);
    ELSE
      segment_pointer.cell_pointer := #ADDRESS (sdt_entry.ste.r1, segment_number, 0 {offset} );
    CASEND;

    gfp$unlock_fde_p (locked_fde_entry_p);

  PROCEND mmp$build_segment;
?? TITLE := '  MMP$CHANGE_SEG_INHERITANCE_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$change_seg_inheritance_r1
    (    segment_number: ost$segment;
         validating_ring: ost$valid_ring;
         segment_inheritance: mmt$segment_inheritance;
     VAR status: ost$status);

    VAR
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF (validating_ring > sdt_entry_p^.ste.r2) THEN
      osp$set_status_condition (mme$ring_violation, status);
      RETURN; {----->
    IFEND;

    IF (segment_inheritance = mmc$si_transfer_segment) AND (sdtx_entry_p^.inheritance = mmc$si_none) THEN
      sdtx_entry_p^.inheritance := mmc$si_transfer_segment;
    ELSEIF (segment_inheritance = mmc$si_share_segment) AND (sdtx_entry_p^.inheritance = mmc$si_none) THEN
      sdtx_entry_p^.inheritance := mmc$si_share_segment;
    ELSE
      osp$set_status_condition (mme$illegal_segment_origin_chg, status);
    IFEND;

  PROCEND mmp$change_seg_inheritance_r1;

?? TITLE := '  MMP$CHANGE_SEGMENT_NUMBER_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$change_segment_number_r1
    (    old_segment_number: ost$segment;
         new_segment_number: ost$segment;
         validating_ring_number: ost$valid_ring;
     VAR status: ost$status);

    VAR
      dummy_sdte_p: ^mmt$segment_descriptor,
      dummy_sdtxe_p: ^mmt$segment_descriptor_extended,
      fde_entry_p: gft$locked_file_desc_entry_p,
      new_sdt_entry: mmt$segment_descriptor,
      new_sdtx_entry: mmt$segment_descriptor_extended,
      old_sdt_p: ^mmt$segment_descriptor,
      old_sdtx_p: ^mmt$segment_descriptor_extended,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

    mmp$fetch_sdt_sdtx_locked_fde (old_segment_number, old_sdt_p, old_sdtx_p, fde_entry_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF (validating_ring_number > old_sdtx_p^.open_validating_ring_number) THEN
      gfp$unlock_fde_p (fde_entry_p);
      osp$set_status_condition (mme$ring_violation, status);
      RETURN; {----->
    IFEND;

    mmp$validate_segment_number (new_segment_number, dummy_sdte_p, dummy_sdtxe_p, status);
    IF NOT status.normal AND (status.condition = mme$segment_number_not_in_use) THEN
      status.normal := TRUE;
      WHILE (new_segment_number > xcb_p^.xp.segment_table_length) DO
        expand_segment_table (xcb_p, status);
        IF NOT status.normal THEN
          gfp$unlock_fde_p (fde_entry_p);
          RETURN; {----->
        IFEND;
      WHILEND;
    ELSEIF status.normal THEN
      gfp$unlock_fde_p (fde_entry_p);
      osp$set_status_condition (mme$segment_number_is_in_use, status);
      RETURN; {----->
    IFEND;

    new_sdt_entry := old_sdt_p^;
    new_sdtx_entry := old_sdtx_p^;

    add_sdt_sdtx_entry (new_sdt_entry, new_sdtx_entry, fde_entry_p, NIL, new_segment_number);

    mmp$invalidate_segment (old_segment_number, 1, NIL {shared_taskid} , status);

    gfp$unlock_fde_p (fde_entry_p);

  PROCEND mmp$change_segment_number_r1;
?? TITLE := '  MMP$CHANGE_STACK_ATTRIBUTE_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$change_stack_attribute_r1
    (    stack_pages_to_be_freed: boolean;
         caller_ring: ost$valid_ring;
     VAR status: ost$status);

    VAR
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();
    xcb_p^.stack_pages_saved [caller_ring] := NOT (stack_pages_to_be_freed);

  PROCEND mmp$change_stack_attribute_r1;
?? TITLE := '  MMP$CLOSE_ASID_BASED_SEGMENT', EJECT ??

  PROCEDURE [XDCL] mmp$close_asid_based_segment
    (    segment_number: ost$segment;
     VAR status: ost$status);

    VAR
      pva: ^cell,
      sdt_entry_p: ^mmt$segment_descriptor,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

    IF segment_number > xcb_p^.xp.segment_table_length THEN
      osp$set_status_condition (mme$segment_number_too_big, status);
      RETURN; {----->
    IFEND;

    sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segment_number);
    IF sdt_entry_p^.ste.vl = osc$vl_invalid_entry THEN
      osp$set_status_condition (mme$segment_number_not_in_use, status);
      RETURN; {----->
    IFEND;

{  Delete the Segment table entry.

    pva := #ADDRESS (1, segment_number, 0);
    #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, pva);
    sdt_entry_p^.ste.vl := osc$vl_invalid_entry;

  PROCEND mmp$close_asid_based_segment;
?? TITLE := '  MMP$CLOSE_DEVICE_FILE', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$close_device_file
    (    segment_number: ost$segment;
     VAR status: ost$status);

    VAR
      fde_entry_p: gft$locked_file_desc_entry_p,
      pva: ^cell,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    mmp$fetch_sdt_sdtx_locked_fde (segment_number, sdt_entry_p, sdtx_entry_p, fde_entry_p, status);

{  Delete the Segment table entry.
    pva := #ADDRESS (1, segment_number, 0);
    #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, pva);
    sdt_entry_p^.ste.vl := osc$vl_invalid_entry;
    fde_entry_p^.open_count := fde_entry_p^.open_count - 1;
    gfp$unlock_fde_p (fde_entry_p);

  PROCEND mmp$close_device_file;
?? TITLE := '  MMP$CREATE_INHERITED_SDT', EJECT ??
*copy mmh$create_inherited_sdt

  PROCEDURE [XDCL, #GATE] mmp$create_inherited_sdt
    (    task_id: pmt$task_id;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      child_sdt_entry_p: ^mmt$segment_descriptor,
      child_sdtx_entry_p: ^mmt$segment_descriptor_extended,
      child_xcb_p {new task xcb pointer} : ^ost$execution_control_block,
      fde_entry_p: gft$locked_file_desc_entry_p,
      local_sdtp: ^mmt$segment_descriptor_table,
      local_sdtxp: ^mmt$segment_descriptor_table_ex,
      local_status: ost$status,
      new_sdt_length: integer,
      new_table_size: ost$segment_length,
      parent_sdt_p: mmt$max_sdt_p,
      parent_sdtx_p: mmt$max_sdtx_p,
      parent_xcb_p {current task xcb pointer} : ^ost$execution_control_block,
      pva: ^cell,
      rma: integer,
      sdt_entry: mmt$segment_descriptor,
      sdtx_entry: mmt$segment_descriptor_extended,
      segnum: ost$segment,
      sfid: gft$system_file_identifier,
      software_attribute_set: mmt$software_attribute_set,
      stl {segment table length} : ost$segment;

    status.normal := TRUE;

    child_xcb_p := pmf$task_xcb (task_id);
    IF child_xcb_p = NIL THEN
      osp$set_status_condition (mme$invalid_task_id, status);
      RETURN; {----->
    IFEND;

    parent_xcb_p := pmf$executing_task_xcb ();

    stl := parent_xcb_p^.xp.segment_table_length;
    mmp$get_max_sdt_sdtx_pointer (parent_xcb_p, parent_sdt_p, parent_sdtx_p);
    WHILE ((parent_sdtx_p^.sdtx_table [stl].inheritance = mmc$si_none) OR
          (parent_sdt_p^.st [stl].ste.vl = osc$vl_invalid_entry)) AND
          (parent_sdtx_p^.sdtx_table [stl].segment_reservation_state <> mmc$srs_reserved_shared_stack) AND
          (stl > mmc$default_sdt_length) DO
      stl := stl - 1;
    WHILEND;

    ALLOCATE local_sdtp: [0 .. stl] IN osv$job_fixed_heap^;

    IF ((stl + 1) * 8) > osv$page_size THEN
      new_sdt_length := ((((stl + 1) * 8) + osv$page_size) DIV osv$page_size);
      new_table_size := new_sdt_length * osv$page_size;
    IFEND;

{  Allocate and initialize the SDT.
    IF ((stl + 1) * 8) > osv$page_size THEN
      mmp$free_pages (local_sdtp, new_table_size, osc$nowait, status);
      mmp$assign_contiguous_memory (local_sdtp, new_table_size, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    ELSE
      pmp$zero_out_table (#LOC (local_sdtp^), #SIZE (local_sdtp^));
    IFEND;


{  Allocate and zero out the SDTX.

    ALLOCATE local_sdtxp: [0 .. stl] IN osv$job_fixed_heap^;
    pmp$zero_out_table (#LOC (local_sdtxp^), #SIZE (local_sdtxp^));
    #real_memory_address (local_sdtp, rma);
    child_xcb_p^.xp.segment_table_address_1 := rma DIV 10000(16);
    child_xcb_p^.xp.segment_table_address_2 := rma MOD 10000(16);
    child_xcb_p^.xp.segment_table_length := stl;
    child_xcb_p^.sdt_offset := #OFFSET (local_sdtp);
    child_xcb_p^.sdtx_offset := #OFFSET (local_sdtxp);

{  Create the SDT and SDTX in the new task.

  /create_sdt_and_sdtx/
    FOR segnum := 0 TO stl DO
      IF (parent_sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry) AND
            ((parent_sdtx_p^.sdtx_table [segnum].inheritance <> mmc$si_none) OR
            (parent_sdtx_p^.sdtx_table [segnum].segment_reservation_state = mmc$srs_reserved_shared_stack))
            THEN
        sdt_entry := parent_sdt_p^.st [segnum];
        sdt_entry.ste.asid := 0;
        sdt_entry.asti := 0;
        sdtx_entry := parent_sdtx_p^.sdtx_table [segnum];
        IF (sdtx_entry.shadow_info.shadow_segment_kind <> mmc$ssk_none) AND
              (sdtx_entry.shadow_info.shadow_segment_kind <> mmc$ssk_segment_number) THEN
          sdtx_entry.shadow_info.shadow_segment_kind := mmc$ssk_none;
          sdtx_entry.shadow_info.passive_for_shadow_by_segnum := FALSE;
          sdtx_entry.sfid := sdtx_entry.shadow_info.shadow_sfid;
        IFEND;

        sdtx_entry.assign_active := mmc$assign_active_null;

{ New FDE entries must be created for the task template segments.

        IF sdtx_entry.inheritance = mmc$si_new_segment THEN
          gfp$assign_fde (gfc$tr_job, 0 {segment_number} , sfid, fde_entry_p);
          IF fde_entry_p <> NIL THEN
            sfid.file_hash := segnum;
            fde_entry_p^.open_count := 1;
            fde_entry_p^.attach_count := 1;
            fde_entry_p^.file_kind := gfc$fk_unnamed_file;
            fde_entry_p^.file_hash := segnum;
            fde_entry_p^.last_segment_number := segnum;
            IF mmc$sa_stack IN sdtx_entry.software_attribute_set THEN
              fde_entry_p^.stack_for_ring := sdt_entry.ste.r1;
            IFEND;
            IF sdtx_entry.shadow_info.shadow_segment_kind = mmc$ssk_segment_number THEN
              fde_entry_p^.flags.active_shadow_file := TRUE;
            IFEND;
            sdtx_entry.sfid := sfid;
          ELSE
            osp$set_status_condition (mme$unable_to_assign_fde, status);
            RETURN; {----->
          IFEND;
        ELSEIF parent_sdtx_p^.sdtx_table [segnum].inheritance = mmc$si_transfer_segment THEN
          sdtx_entry.inheritance := mmc$si_none;
          pva := #ADDRESS (1, segnum, 0);
          #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, pva);
          parent_sdt_p^.st [segnum].ste.vl := osc$vl_invalid_entry;
        ELSEIF sdtx_entry.open_validating_ring_number > 1 THEN
          gfp$get_locked_fde_p (sdtx_entry.sfid, fde_entry_p);
          fde_entry_p^.open_count := fde_entry_p^.open_count + 1;
          gfp$unlock_fde_p (fde_entry_p);
          sdtx_entry.software_attribute_set := sdtx_entry.software_attribute_set -
                $mmt$software_attribute_set [mmc$sa_stack];
        IFEND;
        child_sdt_entry_p := mmp$get_sdt_entry_p (child_xcb_p, segnum);
        child_sdtx_entry_p := mmp$get_sdtx_entry_p (child_xcb_p, segnum);
        child_sdt_entry_p^ := sdt_entry;
        child_sdtx_entry_p^ := sdtx_entry;

      ELSEIF (parent_sdtx_p^.sdtx_table [segnum].segment_reservation_state =
            mmc$srs_reserved_shared_stack) AND (parent_sdt_p^.st [segnum].ste.vl = osc$vl_invalid_entry) THEN
        sdtx_entry := parent_sdtx_p^.sdtx_table [segnum];
        sdtx_entry.segment_reservation_state := mmc$srs_reserved_shared_stack;
        child_sdtx_entry_p := mmp$get_sdtx_entry_p (child_xcb_p, segnum);
        child_sdtx_entry_p^ := sdtx_entry;
      IFEND;
    FOREND /create_sdt_and_sdtx/;

  PROCEND mmp$create_inherited_sdt;
?? TITLE := '  MMP$DELETE_INHERITED_SDT', EJECT ??
{
{   The purpose of this request is to clean up any segments and decrement any
{ fde.open_counts that mmp$create_inherited_sdt modified.  This is called ONLY
{ for cases where mmp$create_inherited_sdt completed successfully but for
{ some other reason (i.e. create_ada_enviroment failed) the task is not fully
{ initiated and therefore will not go thru normal task termination to clean
{ things up.
{
{        MMP$DELETE_INHERITED_SDT (TASK_ID, STATUS)
{
{ TASKID: (input) This parameter specifies the task being cleaned up.
{
{ STATUS: (output) This parameter is where the request status is returned.
{

  PROCEDURE [XDCL, #GATE] mmp$delete_inherited_sdt
    (    task_id: pmt$task_id;
     VAR status: ost$status);

    VAR
      fde_entry_p: gft$file_desc_entry_p,
      local_sdt_p: ^cell,
      local_sdtx_p: ^cell,
      open_count: integer,
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      sfid: gft$system_file_identifier,
      segnum: ost$segment,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$task_xcb (task_id);
    IF xcb_p = NIL THEN
      osp$set_status_condition (mme$invalid_task_id, status);
      RETURN; {----->
    IFEND;

    mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);

  /scan_sdt_for_inherited_segs/
    FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO
      IF (sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry) THEN
        IF (sdtx_p^.sdtx_table [segnum].inheritance = mmc$si_new_segment) THEN
          sfid := sdtx_p^.sdtx_table [segnum].sfid;
          gfp$get_fde_p (sfid, fde_entry_p);
          IF fde_entry_p^.open_count <> 1 THEN
            osp$system_error (' FDE.OPEN_COUNT incorrect', NIL);
          IFEND;
          fde_entry_p^.open_count := fde_entry_p^.open_count - 1;
          gfp$free_fde (fde_entry_p, sfid);
        ELSEIF (sdtx_p^.sdtx_table [segnum].open_validating_ring_number > 1) THEN
          gfp$get_locked_fde_p (sdtx_p^.sdtx_table [segnum].sfid, fde_entry_p);
          open_count := fde_entry_p^.open_count - 1;
          fde_entry_p^.open_count := open_count;
          gfp$unlock_fde_p (fde_entry_p);
          IF open_count < 0 THEN
            osp$system_error ('FDE.OPEN_COUNT incorrect', NIL);
          IFEND;
          IF (open_count = 0) AND ((fde_entry_p^.file_kind = gfc$fk_unnamed_file) OR
                (fde_entry_p^.file_kind = gfc$fk_global_unnamed)) THEN
            destroy_segment (sdtx_p^.sdtx_table [segnum].sfid, fde_entry_p,
                  sdtx_p^.sdtx_table [segnum].file_limits_enforced, status);
          IFEND;
        IFEND;
      IFEND;
    FOREND /scan_sdt_for_inherited_segs/;

{  Release the SDT and SDTX table space.

    local_sdt_p := #ADDRESS (1, osc$segnum_job_fixed_heap, xcb_p^.sdt_offset);
    local_sdtx_p := #ADDRESS (1, osc$segnum_job_fixed_heap, xcb_p^.sdtx_offset);
    IF #SIZE (local_sdt_p^) > osv$page_size THEN
      mmp$free_pages (#ADDRESS (1, #SEGMENT (local_sdt_p), #OFFSET (local_sdt_p)), #SIZE (local_sdt_p^),
            osc$wait, status);
    IFEND;
    FREE local_sdtx_p IN osv$job_fixed_heap^;
    FREE local_sdt_p IN osv$job_fixed_heap^;

  PROCEND mmp$delete_inherited_sdt;
?? TITLE := '  MMP$DELETE_NON_INHERITED_SEGS', EJECT ??
*copy mmh$delete_non_inherited_segs

  PROCEDURE [XDCL, #GATE] mmp$delete_non_inherited_segs
    (VAR status: ost$status);

    VAR
      pointer: mmt$segment_pointer,
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      segnum: ost$segment,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

{  Close all user segments.

    mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);
    FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO
      IF ((sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry) AND
            (sdtx_p^.sdtx_table [segnum].open_validating_ring_number > 1)) THEN
        mmp$invalidate_segment (segnum, 1, NIL {shared_taskid_array} , status);
      IFEND;
    FOREND;

  PROCEND mmp$delete_non_inherited_segs;
?? TITLE := '  MMP$FETCH_OFFSET_MOD_PAGES_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$fetch_offset_mod_pages_r1
    (    segment_number: ost$segment;
         xsfid: gft$system_file_identifier;
         return_unallocated_offsets: boolean;
     VAR offset_list: ^array [ * ] of ost$segment_offset;
     VAR offsets_returned: integer;
     VAR status: ost$status);

    TYPE
      offset_array = array [1 .. * ] of ost$segment_offset;

    VAR
      i: integer,
      offset_array_index: integer,
      offset_count: integer,
      offset_p: ^offset_array,
      request_block: mmt$rb_fetch_offset_mod_pages,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      sfid: gft$system_file_identifier;

    status.normal := TRUE;

{  Allocate array to hold all the offsets for the modified pages.

    ALLOCATE offset_p: [1 .. UPPERBOUND (offset_list^)] IN osv$job_fixed_heap^;

{  Touch all of the pages allocated so that referencing them in
{  monitor will not cause a page fault.

    mmp$touch_all_pages (offset_p, #SIZE (offset_p^));

{  Issue monitor function to return offsets for modified pages.

{ If the segment number is non-zero, then the sfid passed into the request
{ is invalid. The correct sfid must be set from the segment's SDTX entry.

    IF segment_number <> 0 THEN
      mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      sfid := sdtx_entry_p^.sfid;
    ELSE
      sfid := xsfid;
    IFEND;

    request_block.reqcode := syc$rc_fetch_offset_mod_pages;
    request_block.sfid := sfid;
    request_block.offsets_returned := UPPERBOUND (offset_list^);
    request_block.offset_list := offset_p;
    request_block.return_unallocated_offsets := return_unallocated_offsets;

    i#call_monitor (#LOC (request_block), #SIZE (request_block));
    syp$set_status_from_mtr_status (request_block.status, status);
    IF NOT status.normal THEN
      FREE offset_p IN osv$job_fixed_heap^;
      RETURN; {----->
    IFEND;

{  If array not large enough to hold all offsets, create list_overflow condition.

    IF (request_block.offsets_returned > UPPERBOUND (offset_list^)) OR
          (request_block.offsets_returned = 0) THEN
      FREE offset_p IN osv$job_fixed_heap^;
      offsets_returned := request_block.offsets_returned;
      RETURN; {----->
    IFEND;

{  Move offsets to caller's offset list.

    FOR i := 1 TO request_block.offsets_returned DO
      offset_list^ [i] := offset_p^ [i];
    FOREND;

    offsets_returned := request_block.offsets_returned;
    FREE offset_p IN osv$job_fixed_heap^;

  PROCEND mmp$fetch_offset_mod_pages_r1;

?? TITLE := '  MMP$FETCH_SDT_SDTX_LOCKED_FDE', EJECT ??

  PROCEDURE [XDCL] mmp$fetch_sdt_sdtx_locked_fde
    (    segment_number: ost$segment;
     VAR sdt_entry_p: ^mmt$segment_descriptor;
     VAR sdtx_entry_p: ^mmt$segment_descriptor_extended;
     VAR locked_fde_p: gft$locked_file_desc_entry_p;
     VAR status: ost$status);

    VAR
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

    IF segment_number > xcb_p^.xp.segment_table_length THEN
      IF segment_number > 4095 THEN
        osp$set_status_condition (mme$segment_number_too_big, status);
      ELSE
        osp$set_status_condition (mme$segment_number_not_in_use, status);
      IFEND;
      RETURN; {----->
    IFEND;

    sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segment_number);
    sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segment_number);
    IF sdt_entry_p^.ste.vl = osc$vl_invalid_entry THEN
      osp$set_status_condition (mme$segment_number_not_in_use, status);
    ELSE
      gfp$get_locked_fde_p (sdtx_entry_p^.sfid, locked_fde_p);
    IFEND;

  PROCEND mmp$fetch_sdt_sdtx_locked_fde;

?? TITLE := '  MMP$FETCH_SEGMENT_ATTRIBUTES_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$fetch_segment_attributes_r1
    (    segment_number: ost$segment;
         validating_ring: ost$valid_ring;
     VAR seg_attributes: ^array [ * ] of mmt$attribute_descriptor;
     VAR status: ost$status);

    VAR
      fde_entry_p: gft$locked_file_desc_entry_p,
      i: integer,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    status.normal := TRUE;
    mmp$fetch_sdt_sdtx_locked_fde (segment_number, sdt_entry_p, sdtx_entry_p, fde_entry_p, status);

    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    FOR i := LOWERBOUND (seg_attributes^) TO UPPERBOUND (seg_attributes^) DO
      CASE seg_attributes^ [i].keyword OF
      = mmc$kw_ring_numbers =
        seg_attributes^ [i].r1 := sdt_entry_p^.ste.r1;
        seg_attributes^ [i].r2 := sdt_entry_p^.ste.r2;
      = mmc$kw_segment_number =
        seg_attributes^ [i].segnum := segment_number;
      = mmc$kw_current_segment_length =
        seg_attributes^ [i].current_length := gfp$get_eoi_from_fde (fde_entry_p);
      = mmc$kw_max_segment_length =
        IF fde_entry_p^.file_limit < UPPERVALUE (seg_attributes^ [i].max_length) THEN
          seg_attributes^ [i].max_length := fde_entry_p^.file_limit;
        ELSE
          seg_attributes^ [i].max_length := UPPERVALUE (seg_attributes^ [i].max_length);
        IFEND;
      = mmc$kw_gl_key =
        seg_attributes^ [i].gl_key := sdt_entry_p^.ste.key_lock;
      = mmc$kw_hardware_attributes =
        seg_attributes^ [i].hardware_attri_set := $mmt$hardware_attribute_set [];
        CASE sdt_entry_p^.ste.rp OF
        = osc$read_uncontrolled =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_read];
        = osc$read_key_lock_controlled =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_read_key_lock];
        = osc$binding_segment =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_binding]
        ELSE
        CASEND;
        CASE sdt_entry_p^.ste.wp OF
        = osc$write_uncontrolled =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_write];
        = osc$write_key_lock_controlled =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_write_key_lock];
        ELSE
        CASEND;
        CASE sdt_entry_p^.ste.xp OF
        = osc$non_privileged =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_execute];
        = osc$local_privilege =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_execute_local];
        = osc$global_privilege =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_execute_global];
        ELSE
        CASEND;
        CASE sdt_entry_p^.ste.vl OF
        = osc$vl_cache_bypass =
          seg_attributes^ [i].hardware_attri_set := seg_attributes^ [i].hardware_attri_set +
                $mmt$hardware_attribute_set [mmc$ha_cache_bypass];
        ELSE
        CASEND;
      = mmc$kw_software_attributes =
        seg_attributes^ [i].software_attri_set := sdtx_entry_p^.software_attribute_set;
      = mmc$kw_error_exit_procedure =
        seg_attributes^ [i].err_exit_proc := NIL;
      = mmc$kw_preset_value =
        seg_attributes^ [i].preset_value := fde_entry_p^.preset_value;
      = mmc$kw_inheritance =
        seg_attributes^ [i].inheritance := sdtx_entry_p^.inheritance;
      = mmc$kw_clear_space =
        seg_attributes^ [i].clear_space := FALSE;
      = mmc$kw_segment_access_control =
        IF sdt_entry_p^.ste.vl = osc$vl_cache_bypass THEN
          seg_attributes^ [i].access_control.cache_bypass := TRUE;
        ELSE
          seg_attributes^ [i].access_control.cache_bypass := FALSE;
        IFEND;
        seg_attributes^ [i].access_control.execute_privilege := sdt_entry_p^.ste.xp;
        seg_attributes^ [i].access_control.read_privilege := sdt_entry_p^.ste.rp;
        seg_attributes^ [i].access_control.write_privilege := sdt_entry_p^.ste.wp;
      ELSE
        osp$set_status_condition (mme$unsupported_keyword, status);
      CASEND;
    FOREND;

    gfp$unlock_fde_p (fde_entry_p);

  PROCEND mmp$fetch_segment_attributes_r1;

?? TITLE := '  MMP$GET_ALLOCATED_ADDRESSES_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$get_allocated_addresses_r1
    (    segment_number: ost$segment;
         validating_ring: ost$valid_ring;
         starting_byte_address: ost$segment_offset;
     VAR addr_list: ^array [ * ] of dmt$addr_length_pair;
     VAR addr_returned: integer;
     VAR list_overflow: boolean;
     VAR status: ost$status);

    VAR
      allocated_length: amt$file_byte_address,
      dfd_p: ^dmt$disk_file_descriptor,
      fde_entry_p: gft$locked_file_desc_entry_p,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    IF (sdt_entry_p^.ste.rp = osc$non_readable) OR (validating_ring > sdt_entry_p^.ste.r2) THEN
      osp$set_status_condition (mme$ring_violation, status);
      RETURN; {----->
    IFEND;

    IF starting_byte_address = 0 THEN
      gfp$get_locked_fde_p (sdtx_entry_p^.sfid, fde_entry_p);
      dmp$get_disk_file_descriptor_p (fde_entry_p, dfd_p);
      dmp$get_total_allocated_length (fde_entry_p, allocated_length);
      gfp$unlock_fde_p (fde_entry_p);
      IF allocated_length = dfd_p^.highest_offset_allocated THEN
        {Return 1 address pair if not sparsely allocated
        addr_returned := 1;
        list_overflow := FALSE;
        addr_list^ [LOWERBOUND (addr_list^)].addr := 0;
        addr_list^ [LOWERBOUND (addr_list^)].length := fde_entry_p^.eoi_byte_address;
        RETURN; {----->
      IFEND;
    IFEND;

    dmp$get_initialized_addresses (sdtx_entry_p^.sfid, starting_byte_address, addr_list^, addr_returned,
          list_overflow, status);

  PROCEND mmp$get_allocated_addresses_r1;

?? TITLE := '  MMP$GET_SDT_FOR_JOB_TEMPLATE', EJECT ??

  PROCEDURE [XDCL] mmp$get_sdt_for_job_template
    (    pva: ^cell;
     VAR sdt_entry: mmt$segment_descriptor;
     VAR sdtx_entry: mmt$segment_descriptor_extended;
     VAR status: ost$status);


    VAR
      fde_entry_p: gft$locked_file_desc_entry_p,
      rb: mmt$rb_ring1_segment_request,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      segnum: ost$segment;

    segnum := #SEGMENT (pva);
    mmp$fetch_sdt_sdtx_locked_fde (segnum, sdt_entry_p, sdtx_entry_p, fde_entry_p, status);
    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;

    fde_entry_p^.flags.global_template_file := TRUE;
    sdtx_entry_p^.inheritance := mmc$si_share_segment;
    sdtx_entry_p^.open_validating_ring_number := 0;
    sdtx_entry_p^.file_limits_enforced := sfc$no_limit;
    sdtx_entry := sdtx_entry_p^;
    sdt_entry := sdt_entry_p^;
    sdt_entry.ste.asid := 0;
    gfp$unlock_fde_p (fde_entry_p);

{ Issue a monitor request to make the global logs shared.

    rb.reqcode := syc$rc_ring1_segment_request;
    rb.request := mmc$sr1_share_global_logs;
    rb.system_file_id := sdtx_entry_p^.sfid;
    rb.segment_number := segnum;
    rb.server_file := FALSE;
    i#call_monitor (#LOC (rb), #SIZE (rb));

  PROCEND mmp$get_sdt_for_job_template;
?? TITLE := '  MMP$GET_SEGMENT_LENGTH_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$get_segment_length_r1
    (    segment_number: ost$segment;
         validating_ring_number: ost$valid_ring;
     VAR segment_length: ost$segment_length;
     VAR status: ost$status);

    VAR
      fde_p: gft$file_desc_entry_p,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;

{  Verify that caller is within read bracket of the segment.

    IF validating_ring_number > sdt_entry_p^.ste.r2 THEN
      osp$set_status_condition (mme$caller_not_in_read_bracket, status);
      RETURN; {----->
    IFEND;

    gfp$get_fde_p (sdtx_entry_p^.sfid, fde_p);
    segment_length := gfp$get_eoi_from_fde (fde_p);

  PROCEND mmp$get_segment_length_r1;
?? TITLE := '  MMP$INITIATE_SHADOWING_R1', EJECT ??
*copyc mmh$initiate_shadowing_r1

  PROCEDURE [XDCL, #GATE] mmp$initiate_shadowing_r1
    (    segment_pointer: ^cell;
         validating_ring_number: ost$valid_ring;
         shadow_segment_kind: mmt$shadow_segment_kind;
     VAR status: ost$status);

    VAR
      fde_p: gft$locked_file_desc_entry_p,
      new_fde_p: gft$file_desc_entry_p,
      new_sfid: gft$system_file_identifier,
      segment_length: ost$segment_length,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;


    mmp$fetch_sdt_sdtx_locked_fde (#SEGMENT (segment_pointer), sdt_entry_p, sdtx_entry_p, fde_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;


  /fde_locked/
    BEGIN
      IF (sdt_entry_p^.ste.r1 < validating_ring_number) OR (sdtx_entry_p^.open_validating_ring_number <= 1) OR
            (sdtx_entry_p^.shadow_info.shadow_segment_kind <> mmc$ssk_none) OR
            (mmc$sa_stack IN sdtx_entry_p^.software_attribute_set) THEN
        osp$set_status_condition (mme$init_shadow_improper_seg, status);
        EXIT /fde_locked/; {----->
      IFEND;

      gfp$assign_fde (gfc$tr_job, 0, new_sfid, new_fde_p);
      IF new_fde_p = NIL THEN
        osp$set_status_condition (mme$unable_to_assign_fde, status);
        EXIT /fde_locked/; {----->
      IFEND;
      new_fde_p^.allocation_unit_size := mmc$shadow_allocation_size;
      new_fde_p^.open_count := 1;
      new_fde_p^.attach_count := 1;
      new_fde_p^.flags.active_shadow_file := TRUE;

      IF shadow_segment_kind = mmc$ssk_read_only_file THEN
        sdt_entry_p^.ste.wp := osc$write_uncontrolled;
        sdtx_entry_p^.access_rights := mmc$sar_write_extend;
      IFEND;

      mmp$get_segment_length_r1 (#SEGMENT (segment_pointer), 1, segment_length, status);

      sdtx_entry_p^.shadow_info.shadow_segment_kind := shadow_segment_kind;
      sdtx_entry_p^.shadow_info.shadow_sfid := sdtx_entry_p^.sfid;
      sdtx_entry_p^.shadow_info.shadow_start_page_number := 0;
      sdtx_entry_p^.shadow_info.shadow_length_page_count := (((segment_length + 16384 - 1) DIV 16384) *
            16384) DIV osv$page_size;
      new_fde_p^.file_limit := fde_p^.file_limit;
      sdtx_entry_p^.sfid := new_sfid;

      {  Purge buffer space for PASSIVE segment and set ASID to zero.

      sdt_entry_p^.ste.asid := 0;
      #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, segment_pointer);

    END /fde_locked/;

    gfp$unlock_fde_p (fde_p);

  PROCEND mmp$initiate_shadowing_r1;
?? TITLE := '  MMP$INIT_SYSTEM_PRIVILEGE_MAP', EJECT ??
*copyc mmh$init_system_privilege_map

  PROCEDURE [XDCL, #GATE] mmp$init_system_privilege_map
    (    offset: ost$segment_offset);

    VAR
      i: ost$segment,
      leftover: boolean,
      mapend: ost$segment,
      mp_p: ^ost$system_privilege_map,
      sdt_entry_p: ^mmt$segment_descriptor,
      ste: ost$segment_descriptor,
      xcb_p: ^ost$execution_control_block;

{ Calculate where the map is in mainframe pageable.
{ Note - hard-coded [1] must be changed if multiple task private segments exist.

    mp_p := #ADDRESS (1, #SEGMENT (jmv$task_private_templ_p^.segment [1].content),
          #OFFSET (jmv$task_private_templ_p^.segment [1].content) + offset);

{ Find the system job XCB.

    xcb_p := pmf$executing_task_xcb ();

{ Capture the system privilege segments.
{ Insure no array bounds errors.

    IF xcb_p^.xp.segment_table_length < UPPERBOUND (ost$system_privilege_map) THEN
      leftover := TRUE;
      mapend := xcb_p^.xp.segment_table_length;
    ELSE
      leftover := FALSE;
      mapend := UPPERBOUND (ost$system_privilege_map);
    IFEND;

{ Compute the bits for which both segment table entries and map entries exist.

    FOR i := 0 TO mapend DO
      sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, i);
      ste := sdt_entry_p^.ste;
      mp_p^ [i] := (ste.vl <> osc$vl_invalid_entry) AND (ste.xp <> osc$non_executable);
    FOREND;

{ Clear any leftover bits.

    IF leftover THEN
      FOR i := mapend + 1 TO UPPERBOUND (ost$system_privilege_map) DO
        mp_p^ [i] := FALSE;
      FOREND;
    IFEND;

  PROCEND mmp$init_system_privilege_map;
?? TITLE := '  MMP$ISSUE_RING1_SEGMENT_REQUEST', EJECT ??

  PROCEDURE [XDCL] mmp$issue_ring1_segment_request
    (VAR rb: mmt$rb_ring1_segment_request);

    VAR
      count: integer,
      status: ost$status,
      sfid: gft$system_file_identifier;

{   Mmp$process_wmp_status (mtr) will set init_new_io to FALSE if the call is reissued for the wait option.

    rb.init_new_io := TRUE;
    FOR count := 1 TO 4 DO
      i#call_monitor (#LOC (rb), #SIZE (rb));
      IF NOT rb.status.normal THEN
        IF rb.status.condition = mme$io_write_error THEN
          CASE rb.request OF
          = mmc$sr1_detach_file, mmc$sr1_flush_delete_seg_sfid, mmc$sr1_flush_seg_segnum =
            {Only attempt reallocate for these requests
            sfid := rb.sfid;
          ELSE
            RETURN; {----->
          CASEND;
        ELSE
          RETURN; {----->
        IFEND;
      ELSE
        RETURN; {----->
      IFEND;
      IF count = 4 THEN
        RETURN; {----->
      IFEND;
      dmp$reallocate_file_space (sfid, TRUE, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      rb.init_new_io := TRUE;
    FOREND;

  PROCEND mmp$issue_ring1_segment_request;

?? TITLE := '  MMP$INVALIDATE_SEGMENT', EJECT ??
*copy mmh$invalidate_segment

  PROCEDURE [XDCL, #GATE] mmp$invalidate_segment
    (    segment_number: ost$segment;
         validating_ring_number: ost$valid_ring;
         shared_taskid_array: ^array [1 .. * ] of pmt$task_id;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      fde_entry_p: gft$locked_file_desc_entry_p,
      i: integer,
      open_count: integer, {must be integer}
      pva: ^cell,
      rb: mmt$rb_ring1_segment_request,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      segnum: ost$segment,
      shadow_fde_p: gft$locked_file_desc_entry_p,
      shadow_open_count: gft$open_count,
      shadow_sfid: gft$system_file_identifier,
      task_xcb: ^ost$execution_control_block,
      task_sdt_entry_p: ^mmt$segment_descriptor,
      xcb_p: ^ost$execution_control_block;

    IF shared_taskid_array <> NIL THEN
      FOR i := LOWERBOUND (shared_taskid_array^) TO UPPERBOUND (shared_taskid_array^) DO
        pmp$find_task_xcb (shared_taskid_array^ [i], task_xcb);
        IF task_xcb = NIL THEN
          osp$set_status_condition (mme$invalid_shared_taskid, status);
          RETURN; {----->
        IFEND;
      FOREND;
    IFEND;

    #CALLER_ID (caller_id);
    mmp$fetch_sdt_sdtx_locked_fde (segment_number, sdt_entry_p, sdtx_entry_p, fde_entry_p, status);
    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;

    pva := #ADDRESS (caller_id.ring, segment_number, 0);

{***KLUDGE- the first conditional is necessary to delete task private in
{           job termination.
    IF (caller_id.ring > 2) AND (validating_ring_number > sdtx_entry_p^.open_validating_ring_number) THEN
      gfp$unlock_fde_p (fde_entry_p);
      osp$set_status_condition (mme$invalid_close_segment_req, status);
      RETURN; {----->
    IFEND; {***KLUDGE***}

{  Clear any segment locks left by the user.

    IF sdtx_entry_p^.segment_lock >= mmc$lss_lock_for_read_user THEN
      mmp$unlock_segment (pva, mmc$lus_free, osc$nowait, status);
      IF NOT status.normal THEN
        gfp$unlock_fde_p (fde_entry_p);
        osp$system_error ('Unexpected mmp$unlock_segment error', ^status);
      IFEND;
    IFEND;

    xcb_p := pmf$executing_task_xcb ();
    IF shared_taskid_array <> NIL THEN
      FOR i := LOWERBOUND (shared_taskid_array^) TO UPPERBOUND (shared_taskid_array^) DO
        pmp$find_task_xcb (shared_taskid_array^ [i], task_xcb);
        IF xcb_p <> task_xcb THEN
          task_sdt_entry_p := mmp$get_sdt_entry_p (task_xcb, segment_number);
          task_sdt_entry_p^.ste.vl := osc$vl_invalid_entry;
          fde_entry_p^.open_count := fde_entry_p^.open_count - 1;
        IFEND;
      FOREND;
    IFEND;

    open_count := 1;
    IF sdtx_entry_p^.shadow_info.shadow_segment_kind <> mmc$ssk_none THEN
      gfp$get_locked_fde_p (sdtx_entry_p^.shadow_info.shadow_sfid, shadow_fde_p);
      shadow_fde_p^.open_count := shadow_fde_p^.open_count - 1;
      shadow_open_count := shadow_fde_p^.open_count;
      gfp$unlock_fde_p (shadow_fde_p);
      IF (shadow_open_count = 0) AND ((shadow_fde_p^.file_kind = gfc$fk_unnamed_file) OR
            (shadow_fde_p^.file_kind = gfc$fk_global_unnamed)) THEN
        destroy_segment (sdtx_entry_p^.shadow_info.shadow_sfid, shadow_fde_p, sfc$temp_file_space_limit,
              status); {Can only destroy temp files}
      IFEND;
    ELSEIF sdtx_entry_p^.shadow_info.passive_for_shadow_by_segnum THEN
      mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);
      FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO
        IF (sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry) AND
              (sdtx_p^.sdtx_table [segnum].shadow_info.shadow_segment_number = segment_number) AND
              (sdtx_p^.sdtx_table [segnum].shadow_info.shadow_segment_kind = mmc$ssk_segment_number) THEN
          sdtx_p^.sdtx_table [segnum].shadow_info.shadow_segment_kind := mmc$ssk_none;
          sdtx_p^.sdtx_table [segnum].shadow_info.passive_for_shadow_by_segnum := FALSE;
          open_count := open_count + 1;
        IFEND;
      FOREND;
    IFEND;

    open_count := fde_entry_p^.open_count - open_count;
    fde_entry_p^.open_count := open_count;
    gfp$unlock_fde_p (fde_entry_p);
    IF open_count < 0 THEN
      osp$system_error ('MM - neg open count in invalidate', NIL);
    IFEND;

{ The asid must be zeroed out before calling destroy_segment.  Destroy_segment will free
{ the ast entry and the file descriptor entry for local files.  The segment must not be valid
{ with a non-zero asid after file tables are freed, or swapin (reset_sdt_xcb_tables) will
{ process a segment for which file tables no longer exist.

    sdt_entry_p^.ste.asid := 0;
    #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, pva);
    sdt_entry_p^.ste.vl := osc$vl_invalid_entry;

    IF (open_count = 0) THEN
      IF ((fde_entry_p^.file_kind = gfc$fk_unnamed_file) OR (fde_entry_p^.file_kind = gfc$fk_global_unnamed))
            THEN
        destroy_segment (sdtx_entry_p^.sfid, fde_entry_p, sdtx_entry_p^.file_limits_enforced, status);
      ELSEIF (fde_entry_p^.attach_count = 0) THEN
        IF (fde_entry_p^.media = gfc$fm_served_file) THEN
          dmp$free_server_file_tables (sdtx_entry_p^.sfid, status);
        ELSEIF (fde_entry_p^.file_kind <= gfc$fk_last_permanent_file) THEN
          dmp$mm_log_sft_delete (sdtx_entry_p^.sfid, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND mmp$invalidate_segment;
?? TITLE := '  MMP$JOB_DELETE_INHERITED_SDT', EJECT ??
*copy mmh$job_delete_inherited_sdt

  PROCEDURE [XDCL, #GATE] mmp$job_delete_inherited_sdt;

    VAR
      fde_entry_p: gft$locked_file_desc_entry_p,
      i: integer,
      rb: mmt$rb_ring1_segment_request,
      ring_1_stack_segnum: ost$segment,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      segnum: ost$segment,
      status: ost$status,
      str: string (80),
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;

    xcb_p := pmf$executing_task_xcb ();
    ring_1_stack_segnum := xcb_p^.xp.tos_registers [1].pva.seg;

  /scan_sdt_for_inherited_segs/
    FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO
      sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segnum);
      IF (sdt_entry_p^.ste.vl <> osc$vl_invalid_entry) THEN
        sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segnum);
        IF (sdtx_entry_p^.open_validating_ring_number > 0) AND (segnum <> osc$segnum_job_fixed_heap) AND
              (segnum <> ring_1_stack_segnum) THEN
          gfp$get_fde_p (sdtx_entry_p^.sfid, fde_entry_p);

          IF fde_entry_p <> NIL THEN

{  Close segment (free memory and ASID and return backing store if it exists), have to call device
{  manager to return backing store during job termination.

            IF (fde_entry_p^.media = gfc$fm_transient_segment) THEN
              IF fde_entry_p^.asti <> 0 THEN
                rb.reqcode := syc$rc_ring1_segment_request;
                rb.request := mmc$sr1_delete_seg_segnum;
                rb.segnum := segnum;
                i#call_monitor (#LOC (rb), #SIZE (rb));
              IFEND;
            ELSE
              IF (fde_entry_p^.open_count = 1) AND (fde_entry_p^.file_kind > gfc$fk_last_permanent_file) THEN
                fde_entry_p^.open_count := 0;
                dmp$destroy_file (sdtx_entry_p^.sfid, sdtx_entry_p^.file_limits_enforced, status);
                sdt_entry_p^.ste.vl := osc$vl_invalid_entry; {Must be after call to destroy for job recovery}
              ELSE
                mmp$invalidate_segment (segnum, 1, NIL {shared_taskid_array} , status);
              IFEND;
            IFEND;
          ELSE

{ Don't know, what to do here. It obviously can happen (see Red crash of 21. Aug 06)
{ But we can't do much, as even mmp$invalidate_segment references the fde without checking for NIL.
{ And we ended up here because of a NIL pointer in cd.global_file_information during BAM cleanup.

            STRINGREP (str, i, 'FDE is NIL for Seg ', segnum, ' in MMP$JOB_DELETE_INHERITED_SDT');
            dpp$put_critical_message (str (1, i), status);

          IFEND;

        IFEND;
      IFEND;
    FOREND /scan_sdt_for_inherited_segs/;

    syp$return_jobs_r1_resources;

  PROCEND mmp$job_delete_inherited_sdt;
?? TITLE := '  MMP$JOB_MULTIPROCESSING_CONTROL', EJECT ??

  PROCEDURE [XDCL] mmp$job_multiprocessing_control
    (    enable: boolean;
     VAR status: ost$status);

    VAR
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      segnum: ost$segment,
      vl: (osc$vl_invalid_entry, osc$vl_reserved, osc$vl_regular_segment, osc$vl_cache_bypass),
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();
    IF enable THEN
      vl := osc$vl_cache_bypass;
    ELSE
      vl := osc$vl_regular_segment;
    IFEND;

    mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);
    FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO
      IF (sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry)
{   } AND (segnum <> osc$segnum_job_fixed_heap)
{   } AND (sdtx_p^.sdtx_table [segnum].inheritance = mmc$si_share_segment)
{   } AND (sdtx_p^.sdtx_table [segnum].open_validating_ring_number <> 0) THEN
        sdt_p^.st [segnum].ste.vl := vl;
      IFEND;
    FOREND;

  PROCEND mmp$job_multiprocessing_control;

?? TITLE := '  MMP$MFH_FOR_SEGMENT_MANAGER', EJECT ??
*copy mmh$mfh_for_segment_manager

  PROCEDURE [XDCL, #GATE] mmp$mfh_for_segment_manager;

    VAR
      allocated_length: amt$file_byte_address,
      ctime: 0 .. 0ffffffffffff(16),
      gtid: ost$global_task_id,
      status: ost$status,
      xcb_p: ^ost$execution_control_block;

{ Allow escaped allocation if the task has system tables locked.

    xcb_p := pmf$executing_task_xcb ();
    IF xcb_p^.system_table_lock_count > 255 THEN
      xcb_p^.stlc_allocation := TRUE;
      RETURN; {----->
    IFEND;

    mmp$process_file_alloc (allocated_length, status);
    IF NOT status.normal THEN
      IF (status.condition <> dfe$family_not_served) AND (status.condition <> dfe$server_not_active) AND
            (status.condition <> dfe$server_has_terminated) THEN
        ctime := #FREE_RUNNING_CLOCK (0);
        REPEAT
          pmp$delay (1000, status);
          mmp$process_file_alloc (allocated_length, status);
        UNTIL (status.normal) OR ((#FREE_RUNNING_CLOCK (0) - ctime) > 10000000);
        IF NOT status.normal THEN
          pmp$get_executing_task_gtid (gtid);
          pmp$set_system_flag (mmc$failed_file_alloc_flag, gtid, status);
          IF NOT status.normal THEN
            osp$system_error ('Error setting system flag-MMSMSC', NIL);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND mmp$mfh_for_segment_manager;
?? TITLE := '  MMP$MFH_SHADOW_FILE_REFERENCE', EJECT ??

  PROCEDURE [XDCL] mmp$mfh_shadow_file_reference;

{ The purpose of this procedure is to move data from the shadowed file to the active
{ file.  A page fault had occurred and the page was found to reside on the shadowed
{ file.  Mmp$page_pull filled in the necessary information in the XCB and set the
{ monitor flag, mmc$mf_shadow_file_reference.  The ring 1 trap handler called this
{ procedure.

    VAR
      i: integer,
      in_memory: boolean,
      rma: integer,
      status: ost$status,
      traps: 0 .. 3,
      xcb_p: ^ost$execution_control_block;

    PROCEDURE condition_handler
      (    monitor_fault: ost$monitor_fault;
           save_area: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      VAR
        handler_status: ost$status,
        system_core_condition_p: ^syt$system_core_condition;

      IF monitor_fault.identifier = syc$system_core_condition THEN
        system_core_condition_p := #LOC (monitor_fault.system_core_condition);
        IF system_core_condition_p^.condition = syc$user_defined_condition THEN
          IF system_core_condition_p^.user_defined_condition = syc$udc_volume_unavailable THEN
            pmp$set_system_flag (mmc$volume_unavailable_flag, xcb_p^.global_task_id, handler_status);
            IF NOT handler_status.normal THEN
              osp$system_error ('Error setting system flag--mfh shadow', NIL);
            IFEND;
            mmp$free_pages (xcb_p^.shadow_reference_info.destination_pva,
                  xcb_p^.shadow_reference_info.page_count * osv$page_size, osc$wait, handler_status);
            i#restore_traps (traps);
            EXIT mmp$mfh_shadow_file_reference; {----->
          IFEND;
        IFEND;

{ Other conditions could possibly be handled, if necessary.

      IFEND;

    PROCEND condition_handler;

    xcb_p := pmf$executing_task_xcb ();
    in_memory := TRUE;

  /memory_check/
    FOR i := 0 TO xcb_p^.shadow_reference_info.page_count - 1 DO
      #real_memory_address (#ADDRESS (1, #SEGMENT (xcb_p^.shadow_reference_info.source_pva),
            #OFFSET (xcb_p^.shadow_reference_info.source_pva) + i * osv$page_size), rma);
      IF rma < 0 THEN
        in_memory := FALSE;
        EXIT /memory_check/; {----->
      IFEND;
    FOREND /memory_check/;

    IF NOT in_memory THEN
      mmp$advise_in (xcb_p^.shadow_reference_info.source_pva,
            xcb_p^.shadow_reference_info.page_count * osv$page_size, status);
    IFEND;

{ Establish a condition handler and enable traps.  If the source page is on a unavailable volume,
{ the task needs to be able to trap and go wait on an unavailable volume, not hang in ring 1.

    #SPOIL (xcb_p);
    syp$establish_condition_handler (^condition_handler);
    i#enable_traps (traps);
    #SPOIL (traps);

    i#move (xcb_p^.shadow_reference_info.source_pva, xcb_p^.shadow_reference_info.destination_pva,
          xcb_p^.shadow_reference_info.page_count * osv$page_size);

    i#restore_traps (traps);

  PROCEND mmp$mfh_shadow_file_reference;
?? TITLE := '  MMP$MFH_VOLUME_UNAVAILABLE', EJECT ??

  PROCEDURE [XDCL] mmp$mfh_volume_unavailable;

    VAR
      gtid: ost$global_task_id,
      ignore_status: ost$status,
      mmv$vol_unavailable_timer: [XDCL] integer := 0,
      mmv$pf_system_core,
      mmv$pf_job_template: [XDCL] integer := 0,
      msg: string (80),
      psa: ^ost$minimum_save_area,
      status: ost$status,
      strl: integer,
      str: string (80),
      timer: integer,
      xcb: ^ost$execution_control_block;

    psa := #PREVIOUS_SAVE_AREA ();
    {This code assumes:
    { Page fault for bad disk; trap to TH; TH calls this procedure
    IF #RING (psa^.a2_previous_save_area) = 1 THEN

      mmv$pf_system_core := mmv$pf_system_core + 1;
      {We have interrupted the system core
      {Allow rollback - then check for system tables locked
      syp$cause_condition (syc$udc_volume_unavailable);

      {We still have control, so we must wait
      {If there are system resources tied up, we will be in trouble
      pmp$delay (30000, status);
      mmv$vol_unavailable_timer := mmv$vol_unavailable_timer + 1;
      IF mmv$vol_unavailable_timer > 4 THEN
        { send message}
        msg := 'Jobs are waiting on unavailable volume/s.';
        dpp$put_critical_message (msg, ignore_status);

        mmv$vol_unavailable_timer := 0;
      IFEND;

      {Return and attempt page fault again
    ELSE

      mmv$pf_job_template := mmv$pf_job_template + 1;
      {We have interrupted the job template
      pmp$get_executing_task_gtid (gtid);
      pmp$set_system_flag (mmc$volume_unavailable_flag, gtid, status);
      IF NOT status.normal THEN
        osp$system_error ('Error setting system flag-MMSMSC', NIL);
      IFEND;
    IFEND;

  PROCEND mmp$mfh_volume_unavailable;

?? TITLE := '  MMP$MM_MOVE_MOD_SERVER_PAGE', EJECT ??

*copyc mmh$mm_move_mod_server_page

  PROCEDURE [XDCL] mmp$mm_move_mod_server_page
    (    system_file_id: gft$system_file_identifier;
         destination_pva: ^cell;
     VAR byte_offset: ost$segment_offset;
     VAR status: ost$status);

    VAR
      rb_ring1_server_seg_request: mmt$rb_ring1_server_seg_request;

    status.normal := TRUE;

    rb_ring1_server_seg_request.reqcode := syc$rc_ring1_server_seg_request;
    rb_ring1_server_seg_request.sfid := system_file_id;
    rb_ring1_server_seg_request.request := mmc$ssr1_move_modified_df_page;
    rb_ring1_server_seg_request.destination_pva := destination_pva;
    rb_ring1_server_seg_request.byte_offset := 07fffffff(16); {dummy initialization}

    i#call_monitor (#LOC (rb_ring1_server_seg_request), #SIZE (rb_ring1_server_seg_request));

    byte_offset := rb_ring1_server_seg_request.byte_offset;
    syp$set_status_from_mtr_status (rb_ring1_server_seg_request.status, status);

  PROCEND mmp$mm_move_mod_server_page;
?? TITLE := '  MMP$OPEN_ASID_BASED_SEGMENT', EJECT ??

  PROCEDURE [XDCL] mmp$open_asid_based_segment
    (    sdt_entry: mmt$segment_descriptor;
         sdtx_entry: mmt$segment_descriptor_extended;
     VAR segment_number: ost$segment;
     VAR status: ost$status);

    VAR
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      segnum: ost$segment,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

    find_available_segment_number (xcb_p, mmc$srs_not_reserved, segnum, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{  Add sdt_entry to the task's segment descriptor table (SDT)
    sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segnum);
    sdt_entry_p^ := sdt_entry;
    sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segnum);
    sdtx_entry_p^ := sdtx_entry;

    segment_number := segnum;

  PROCEND mmp$open_asid_based_segment;

?? TITLE := '  MMP$OPEN_FILE_BY_SFID', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$open_file_by_sfid
    (    sfid: gft$system_file_identifier;
         r1: ost$valid_ring;
         r2: ost$valid_ring;
         sequential_random_selection: mmt$access_selections;
         read_write_access_selection: mmt$segment_access_rights;
     VAR segment_number: ost$segment;
     VAR status: ost$status);

    VAR
      fde_entry_p: gft$locked_file_desc_entry_p,
      page_streaming_ts_shift: 0 .. 15,
      sdt_entry: mmt$segment_descriptor,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      segment_res_state: mmt$segment_reservation_state,
      segnum: ost$segment,
      ste: mmt$segment_descriptor,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

{  Find an available segment number if the caller did not supply one.

    segment_res_state := mmc$srs_not_reserved;
    find_available_segment_number (xcb_p, segment_res_state, segnum, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{  Add sdt_entry to the task's segment descriptor table (SDT) and the sdtx_entry to the
{  segment descriptor table extended (SDTX).

    sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segnum);
    sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segnum);
{ THIS SDTX ENTRY SHOULD BE THE DEV FILE

    sdtx_entry_p^ := mmv$default_sdtx_entry;
    sdtx_entry_p^.sfid := sfid;
    sdt_entry := mmv$default_sdt_entry;
    sdt_entry.ste.r1 := r1;
    sdt_entry.ste.r2 := r2;
    gfp$get_locked_fde_p (sfid, fde_entry_p);
    fde_entry_p^.open_count := fde_entry_p^.open_count + 1;
    gfp$unlock_fde_p (fde_entry_p);
    IF osv$cpus_physically_configured > 1 THEN
      sdt_entry.ste.vl := osc$vl_cache_bypass;
    IFEND;
    IF read_write_access_selection = mmc$sar_read THEN
      sdt_entry.ste.wp := osc$non_writable;
    IFEND;
    IF sequential_random_selection = mmc$as_sequential THEN
      sdtx_entry_p^.software_attribute_set := $mmt$software_attribute_set
            [mmc$sa_read_transfer_unit, mmc$sa_free_behind];
      sdtx_entry_p^.stream.sequential_accesses := mmv$page_streaming_prestream;
    IFEND;
    mmp$convert_ps_transfer_size (16384, page_streaming_ts_shift); {force transfer size of 16384
    sdtx_entry_p^.stream.transfer_size := page_streaming_ts_shift;
    mmp$set_segment_access_rights (sdt_entry, sdtx_entry_p^);

    store_ste_in_segment_table (sdt_entry, sfid, sdt_entry_p, fde_entry_p, segnum);

    segment_number := segnum;

  PROCEND mmp$open_file_by_sfid;
?? TITLE := '  MMP$OS_PREALLOCATE_FILE_SPACE', EJECT ??
*copyc mmh$os_preallocate_file_space

  PROCEDURE [XDCL, #GATE] mmp$os_preallocate_file_space
    (    process_virtual_address: ^cell;
         length: ost$segment_length;
         maximum_wait_seconds: integer;
     VAR status: ost$status);

    VAR
      bytes_to_allocate: integer,
      current_time: 0 .. 0ffffffffffff(16),
      delay_status: ost$status,
      dfd_p: ^dmt$disk_file_descriptor,
      eoi: amt$file_byte_address,
      segment_number: ost$segment,
      sd_p: ^mmt$segment_descriptor,
      sdtx_p: ^mmt$segment_descriptor_extended;

    segment_number := #SEGMENT (process_virtual_address);
    mmp$validate_segment_number (segment_number, sd_p, sdtx_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    dmp$fetch_eoi (sdtx_p^.sfid, eoi, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    bytes_to_allocate := length - eoi;
    IF bytes_to_allocate <= 0 THEN
      RETURN; {----->
    IFEND;

    current_time := #FREE_RUNNING_CLOCK (0);
    REPEAT
      mmp$assign_mass_storage (segment_number, sdtx_p^.sfid, length, status);
      IF NOT status.normal AND (status.condition = dme$unable_to_alloc_all_space) THEN
        pmp$delay (1000, delay_status);
      IFEND;
    UNTIL status.normal OR ((#FREE_RUNNING_CLOCK (0) - current_time) > (maximum_wait_seconds * 1000000));

  PROCEND mmp$os_preallocate_file_space;
?? TITLE := '  MMP$PRESET_PAGE_STREAMING', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$preset_page_streaming_r1
    (    segment_number: ost$segment;
         validating_ring_number: ost$valid_ring;
         preset_and_save_fb_and_ts: boolean;
         temp_transfer_size: integer;
     VAR saved_transfer_size: 0 .. 15;
     VAR saved_free_behind: boolean;
     VAR status: ost$status);

{  Validate the pva and get a pointer to the segment descriptor.

    VAR
      page_streaming_ts_shift: 0 .. 15,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    status.normal := TRUE;
    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{  Verify that the pointer is in the read bracket of the segment.

    IF (validating_ring_number > sdt_entry_p^.ste.r2) OR (validating_ring_number > sdt_entry_p^.ste.r2) THEN
      osp$set_status_condition (mme$ring_violation, status);
      RETURN; {----->
    IFEND;

    IF preset_and_save_fb_and_ts THEN

{  Save the current setting of transfer size and free behind.  Then set transfer size as specified,
{  and if the streaming boolean is false, set the preset_streaming boolean = TRUE.

      saved_free_behind := (mmc$sa_free_behind IN sdtx_entry_p^.software_attribute_set);
      IF NOT saved_free_behind THEN
        sdtx_entry_p^.software_attribute_set := sdtx_entry_p^.software_attribute_set +
              $mmt$software_attribute_set [mmc$sa_free_behind];
      IFEND;
      saved_transfer_size := sdtx_entry_p^.stream.transfer_size;
      mmp$convert_ps_transfer_size (temp_transfer_size, page_streaming_ts_shift);

      IF sdtx_entry_p^.stream.transfer_size < page_streaming_ts_shift THEN
        sdtx_entry_p^.stream.transfer_size := page_streaming_ts_shift;
      IFEND;
      IF NOT sdtx_entry_p^.stream.streaming THEN
        sdtx_entry_p^.stream.preset_streaming := TRUE;
        IF sdtx_entry_p^.stream.sequential_accesses < mmv$page_streaming_prestream THEN
          sdtx_entry_p^.stream.sequential_accesses := mmv$page_streaming_prestream;
        IFEND;
      IFEND;

    ELSE

{ reset SDTX with the saved transfer size and free behind from a previous call to mmp$preset_page_streaming

      sdtx_entry_p^.stream.preset_streaming := FALSE;
      IF NOT saved_free_behind THEN
        sdtx_entry_p^.software_attribute_set := sdtx_entry_p^.software_attribute_set *
              (-$mmt$software_attribute_set [mmc$sa_free_behind]);
      IFEND;
      IF sdtx_entry_p^.stream.transfer_size > saved_transfer_size THEN
        sdtx_entry_p^.stream.transfer_size := saved_transfer_size;
      IFEND;
    IFEND;

  PROCEND mmp$preset_page_streaming_r1;

?? TITLE := '  MMP$PROCESS_FILE_ALLOC', EJECT ??
*copyc mmh$process_file_alloc

  PROCEDURE [XDCL, #GATE] mmp$process_file_alloc
    (VAR allocated_length: amt$file_byte_address;
     VAR status: ost$status);

    VAR
      accumulated_allocated_length: amt$file_byte_address,
      fde_p: gft$locked_file_desc_entry_p,
      flush_pages: boolean,
      rb: mmt$rb_ring1_segment_request,
      segnum: integer,
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      tstatus: ost$status,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    osp$begin_system_activity;
    accumulated_allocated_length := 0;
    rb.reqcode := syc$rc_ring1_segment_request;
    rb.request := mmc$sr1_flush_avail_modified;
    xcb_p := pmf$executing_task_xcb ();
    mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);

  /allocate_loop/
    FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO

      IF segnum = 0 THEN
        IF xcb_p^.assign_active_sfid <> gfv$null_sfid THEN
          gfp$get_locked_fde_p (xcb_p^.assign_active_sfid, fde_p);
          IF fde_p <> NIL THEN
            mmp$assign_mass_storage (0, xcb_p^.assign_active_sfid, 0, tstatus);
            gfp$unlock_fde_p (fde_p);
          IFEND;
        IFEND;

      ELSEIF (sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry) AND
            (sdtx_p^.sdtx_table [segnum].assign_active <> mmc$assign_active_null) THEN
        rb.sfid := sdtx_p^.sdtx_table [segnum].sfid;
        gfp$get_fde_p (rb.sfid, fde_p);
        flush_pages := (fde_p^.media = gfc$fm_transient_segment);
        mmp$assign_mass_storage (segnum, gfv$null_sfid, 0, tstatus);
        IF tstatus.normal THEN
          IF flush_pages THEN
            i#call_monitor (#LOC (rb), #SIZE (rb));
          IFEND;
        ELSEIF (tstatus.condition = dme$unable_to_alloc_all_space) OR
              (tstatus.condition = dme$unable_to_get_fd_lock) OR
              (tstatus.condition = dfe$family_not_served) OR (tstatus.condition = dfe$server_not_active) OR
              (tstatus.condition = dfe$server_has_terminated) THEN
          IF (tstatus.condition = dme$unable_to_alloc_all_space) THEN
            gfp$get_fde_p (rb.sfid, fde_p);
            dmp$get_total_allocated_length (fde_p, allocated_length);
            accumulated_allocated_length := accumulated_allocated_length + allocated_length;
          IFEND;
          status := tstatus;
        ELSEIF tstatus.condition = dme$unable_to_create_fdt_entry THEN
          syp$terminate_task (osc$rtr_sft_full);
          EXIT /allocate_loop/; {----->
        ELSE
          osp$end_system_activity;
          syp$mfh_for_hang_task;
        IFEND;
      IFEND;
    FOREND /allocate_loop/;

    allocated_length := accumulated_allocated_length;

    osp$end_system_activity;
  PROCEND mmp$process_file_alloc;

?? TITLE := '  MMP$RESERVE_SEGMENT_NUMBER', EJECT ??
*copyc mmh$reserve_segment_number

  PROCEDURE [XDCL, #GATE] mmp$reserve_segment_number_r1
    (    ada_stack_flag: boolean;
     VAR segment_num_list: ^array [ * ] of ost$segment;
     VAR status: ost$status);

    VAR
      segment_table_length: integer,
      i: integer,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      xcb_p: ^ost$execution_control_block,
      segnum: ost$segment;

    xcb_p := pmf$executing_task_xcb ();

    status.normal := TRUE;
    segnum := mmv$first_transient_seg_index - 1;
    segment_table_length := xcb_p^.xp.segment_table_length;

    FOR i := LOWERBOUND (segment_num_list^) TO UPPERBOUND (segment_num_list^) DO
      REPEAT
        segnum := segnum + 1;
        IF segnum > segment_table_length THEN
          expand_segment_table (xcb_p, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          segment_table_length := xcb_p^.xp.segment_table_length;
        IFEND;
        sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segnum);
        sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segnum);
      UNTIL (sdt_entry_p^.ste.vl = osc$vl_invalid_entry) AND
            (sdtx_entry_p^.segment_reservation_state = mmc$srs_not_reserved);
      IF ada_stack_flag THEN
        sdtx_entry_p^.segment_reservation_state := mmc$srs_reserved_shared_stack;
      ELSE
        sdtx_entry_p^.segment_reservation_state := mmc$srs_reserved;
      IFEND;
      segment_num_list^ [i] := segnum;
    FOREND;

  PROCEND mmp$reserve_segment_number_r1;
?? TITLE := '  MMP$SET_ACCESS_MODE', EJECT ??
*copy mmh$set_access_mode

  PROCEDURE [INLINE] mmp$set_access_mode
    (    segment_descriptor: ost$segment_descriptor;
     VAR access_mode: pft$usage_selections);

    access_mode := $pft$usage_selections [];

    IF segment_descriptor.xp <> osc$non_executable THEN
      access_mode := access_mode + $pft$usage_selections [pfc$execute];
    IFEND;

    IF segment_descriptor.rp <> osc$non_readable THEN
      access_mode := access_mode + $pft$usage_selections [pfc$read];
    IFEND;

    IF segment_descriptor.wp <> osc$non_writable THEN
      access_mode := access_mode + $pft$usage_selections [pfc$shorten] + $pft$usage_selections [pfc$append] +
            $pft$usage_selections [pfc$modify];
    IFEND;

  PROCEND mmp$set_access_mode;
?? TITLE := '  MMP$SET_ACCESS_SELECTIONS_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$set_access_selections_r1
    (    segment_number: ost$segment;
         validating_ring_number: ost$valid_ring;
         access_selections: mmt$access_selections;
     VAR status: ost$status);

    VAR
      sd_p: ^mmt$segment_descriptor,
      sdtx_p: ^mmt$segment_descriptor_extended;

{  Validate the pva and get a pointer to the segment descriptor.

    mmp$validate_segment_number (segment_number, sd_p, sdtx_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{  Verify that the pointer is in the read bracket of the segment.

    IF (validating_ring_number > sd_p^.ste.r2) THEN
      osp$set_status_condition (mme$ring_violation, status);
      RETURN; {----->
    IFEND;
    IF access_selections = mmc$as_sequential THEN
      sdtx_p^.software_attribute_set := sdtx_p^.software_attribute_set +
            $mmt$software_attribute_set [mmc$sa_read_transfer_unit, mmc$sa_free_behind];
    ELSEIF access_selections = mmc$as_random THEN
      sdtx_p^.software_attribute_set := sdtx_p^.software_attribute_set -
            $mmt$software_attribute_set [mmc$sa_read_transfer_unit, mmc$sa_free_behind];
    ELSEIF access_selections = mmc$as_read_tu THEN
      sdtx_p^.software_attribute_set := sdtx_p^.software_attribute_set +
            $mmt$software_attribute_set [mmc$sa_read_transfer_unit] -
            $mmt$software_attribute_set [mmc$sa_free_behind];
    IFEND;

    IF (mmc$sa_read_transfer_unit IN sdtx_p^.software_attribute_set) THEN
      IF sdtx_p^.stream.sequential_accesses < mmv$page_streaming_prestream THEN
        sdtx_p^.stream.sequential_accesses := mmv$page_streaming_prestream;
      IFEND;
    IFEND;
  PROCEND mmp$set_access_selections_r1;

?? TITLE := '  MMP$SET_SEGMENT_ACCESS_RIGHTS', EJECT ??

  PROCEDURE [XDCL, INLINE] mmp$set_segment_access_rights
    (    sd: mmt$segment_descriptor;
     VAR sdtx: mmt$segment_descriptor_extended);

    IF sd.ste.wp = osc$non_writable THEN
      sdtx.access_rights := mmc$sar_read;
    ELSEIF mmc$sa_no_append IN sdtx.software_attribute_set THEN
      sdtx.access_rights := mmc$sar_modify;
    ELSE
      sdtx.access_rights := mmc$sar_write_extend;
    IFEND;

  PROCEND mmp$set_segment_access_rights;
?? TITLE := '  MMP$SET_SEGMENT_LENGTH_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$set_segment_length_r1
    (    segment_number: ost$segment;
         validating_ring_number: ost$valid_ring;
         segment_length: ost$segment_length;
     VAR status: ost$status);

{
{   The purpose of this procedure is to set or get the segment length for the
{ specified segment.  Whether to set or get segment length is based on the
{ 'set_or_get_segment_length' parameter.
{

    VAR
      request_block: mmt$rb_set_get_segment_length,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;

{  Verify that caller is within write bracket and has write access.

    IF validating_ring_number > sdt_entry_p^.ste.r1 THEN
      osp$set_status_condition (mme$caller_not_in_write_bracket, status);
      RETURN; {----->
    ELSEIF sdt_entry_p^.ste.wp = osc$non_writable THEN
      osp$set_status_condition (mme$no_write_access, status);
      RETURN; {----->
    IFEND;

    gfp$get_fde_p (sdtx_entry_p^.sfid, request_block.fde_p);
    request_block.request_code := syc$rc_set_get_segment_length;
    request_block.subfunction_code := mmc$sf_set_segment_length_fde_p;
    request_block.segment_length := segment_length;

    i#call_monitor (#LOC (request_block), #SIZE (request_block));

  PROCEND mmp$set_segment_length_r1;

?? TITLE := '  MMP$STORE_SEGMENT_ATTRIBUTES_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$store_segment_attributes_r1
    (    segment_number: ost$segment;
         validating_ring: ost$valid_ring;
         system_privilege: boolean;
         segment_attributes: ^array [ * ] of mmt$attribute_descriptor;
     VAR status: ost$status);

    VAR
      access_mode: pft$usage_selections,
      scratch_segment_number: ost$segment,
      fde_entry_p: gft$locked_file_desc_entry_p,
      i: integer,
      pva: ^cell,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;

{  Validate the pva and get a pointer to the segment descriptor.

    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF (validating_ring > sdtx_entry_p^.open_validating_ring_number) OR (validating_ring > 6) THEN
      osp$set_status_condition (mme$ring_violation, status);
      RETURN; {----->
    IFEND;

{  Validate that attributes can be modified.

    FOR i := LOWERBOUND (segment_attributes^) TO UPPERBOUND (segment_attributes^) DO
      CASE segment_attributes^ [i].keyword OF
      = mmc$kw_null_keyword =
      = mmc$kw_ring_numbers =
      = mmc$kw_max_segment_length =
      = mmc$kw_error_exit_procedure =
        osp$set_status_condition (mme$unsupported_keyword, status);
        RETURN; {----->
      = mmc$kw_hardware_attributes =
        IF (mmc$ha_execute_local IN segment_attributes^ [i].hardware_attri_set) AND (validating_ring > 3) THEN
          osp$set_status_condition (mme$execute_local_invalid, status);
          RETURN; {----->
        IFEND;

        IF (mmc$ha_binding IN segment_attributes^ [i].hardware_attri_set) AND (validating_ring > 3) THEN
          osp$set_status_condition (mme$binding_attribute_invalid, status);
          RETURN; {----->
        IFEND;

        IF (NOT (mmc$ha_execute IN segment_attributes^ [i].hardware_attri_set)) AND
              (NOT (mmc$ha_execute_local IN segment_attributes^ [i].hardware_attri_set)) AND
              (mmc$ha_execute_global IN segment_attributes^ [i].hardware_attri_set) AND
              (validating_ring > 1) THEN
          osp$set_status_condition (mme$execute_global_invalid, status);
          RETURN; {----->
        IFEND;

        IF (mmc$ha_write IN segment_attributes^ [i].hardware_attri_set) AND
              (sdt_entry_p^.ste.wp = osc$non_writable) THEN
          IF (validating_ring > 3) OR ((validating_ring <= 3) AND (NOT system_privilege)) THEN
            osp$set_status_condition (mme$write_uncontrolled_invalid, status);
            RETURN; {----->
          IFEND;
        IFEND;

      = mmc$kw_segment_access_control =
        IF segment_attributes^ [i].access_control.execute_privilege = osc$local_privilege THEN
          osp$set_status_condition (mme$execute_local_invalid, status);
        IFEND;

        IF (segment_attributes^ [i].access_control.execute_privilege = osc$global_privilege) AND
              (validating_ring > 1) THEN
          osp$set_status_condition (mme$execute_global_invalid, status);
          RETURN; {----->
        IFEND;

        IF (segment_attributes^ [i].access_control.read_privilege = osc$binding_segment) AND
              (validating_ring > 3) THEN
          osp$set_status_condition (mme$binding_attribute_invalid, status);
          RETURN; {----->
        IFEND;

        IF (segment_attributes^ [i].access_control.write_privilege = osc$write_uncontrolled) AND
              (sdt_entry_p^.ste.wp = osc$non_writable) THEN
          IF (validating_ring > 3) OR ((validating_ring <= 3) AND (NOT system_privilege)) THEN
            osp$set_status_condition (mme$write_uncontrolled_invalid, status);
            RETURN; {----->
          IFEND;
        IFEND;
      ELSE
        osp$set_status_condition (mme$set_unmodifiable_attribute, status);
        RETURN; {----->
      CASEND;
    FOREND;

{  Change the attributes.

    FOR i := LOWERBOUND (segment_attributes^) TO UPPERBOUND (segment_attributes^) DO
      CASE segment_attributes^ [i].keyword OF
      = mmc$kw_null_keyword =
      = mmc$kw_ring_numbers =
        sdt_entry_p^.ste.r1 := segment_attributes^ [i].r1;
        sdt_entry_p^.ste.r2 := segment_attributes^ [i].r2;
      = mmc$kw_max_segment_length =
        gfp$get_locked_fde_p (sdtx_entry_p^.sfid, fde_entry_p);
        fde_entry_p^.file_limit := segment_attributes^ [i].max_length;
        gfp$unlock_fde_p (fde_entry_p);
      = mmc$kw_error_exit_procedure =
      = mmc$kw_hardware_attributes =
        IF mmc$ha_read IN segment_attributes^ [i].hardware_attri_set THEN
          sdt_entry_p^.ste.rp := osc$read_uncontrolled;
        ELSE
          sdt_entry_p^.ste.rp := osc$non_readable;
        IFEND;

        IF mmc$ha_binding IN segment_attributes^ [i].hardware_attri_set THEN
          sdt_entry_p^.ste.rp := osc$binding_segment;
        IFEND;

        IF mmc$ha_write IN segment_attributes^ [i].hardware_attri_set THEN
          sdt_entry_p^.ste.wp := osc$write_uncontrolled;
        ELSE
          sdt_entry_p^.ste.wp := osc$non_writable;
        IFEND;

        IF mmc$ha_cache_bypass IN segment_attributes^ [i].hardware_attri_set THEN
          sdt_entry_p^.ste.vl := osc$vl_cache_bypass;
        ELSE
          sdt_entry_p^.ste.vl := osc$vl_regular_segment;
        IFEND;

        IF mmc$ha_execute IN segment_attributes^ [i].hardware_attri_set THEN
          sdt_entry_p^.ste.xp := osc$non_privileged;
        ELSEIF mmc$ha_execute_local IN segment_attributes^ [i].hardware_attri_set THEN
          sdt_entry_p^.ste.xp := osc$local_privilege;
        ELSE
          sdt_entry_p^.ste.xp := osc$non_executable;
        IFEND;

      = mmc$kw_segment_access_control =
        IF segment_attributes^ [i].access_control.cache_bypass = TRUE THEN
          sdt_entry_p^.ste.vl := osc$vl_cache_bypass;
        ELSE
          sdt_entry_p^.ste.vl := osc$vl_regular_segment;
        IFEND;

        sdt_entry_p^.ste.xp := segment_attributes^ [i].access_control.execute_privilege;
        sdt_entry_p^.ste.rp := segment_attributes^ [i].access_control.read_privilege;
        sdt_entry_p^.ste.wp := segment_attributes^ [i].access_control.write_privilege;
      ELSE
      CASEND;
    FOREND;

    pva := #ADDRESS (1, segment_number, 0);
    #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, pva);

  PROCEND mmp$store_segment_attributes_r1;
?? TITLE := '  MMP$TASK_DELETE_INHERITED_SDT', EJECT ??
*copy mmh$task_delete_inherited_sdt

  PROCEDURE [XDCL, #GATE] mmp$task_delete_inherited_sdt
    (    task_id: pmt$task_id;
     VAR status: ost$status);

    VAR
      fde_entry_p: gft$file_desc_entry_p,
      local_sdt_p: ^cell,
      local_sdtx_p: ^cell,
      rb: mmt$rb_ring1_segment_request,
      sdt_p: mmt$max_sdt_p,
      sdtx_p: mmt$max_sdtx_p,
      segnum: ost$segment,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$task_xcb (task_id);
    IF xcb_p = NIL THEN
      osp$set_status_condition (mme$invalid_task_id, status);
      RETURN; {----->
    IFEND;

    mmp$get_max_sdt_sdtx_pointer (xcb_p, sdt_p, sdtx_p);

  /scan_sdt_for_inherited_segs/
    FOR segnum := 0 TO xcb_p^.xp.segment_table_length DO
      IF (sdt_p^.st [segnum].ste.vl <> osc$vl_invalid_entry) AND
            (sdtx_p^.sdtx_table [segnum].inheritance = mmc$si_new_segment) THEN

{  Close or delete the segment based on whether it is assigned to a file or not.
        gfp$get_fde_p (sdtx_p^.sdtx_table [segnum].sfid, fde_entry_p);
        IF fde_entry_p^.open_count <> 1 THEN
          osp$system_error (' FDE.OPEN_COUNT incorrect', NIL);
        IFEND;
        fde_entry_p^.open_count := fde_entry_p^.open_count - 1;
        destroy_segment (sdtx_p^.sdtx_table [segnum].sfid, fde_entry_p,
              sdtx_p^.sdtx_table [segnum].file_limits_enforced, status);
      IFEND;
    FOREND /scan_sdt_for_inherited_segs/;

{  Release the SDT and SDTX table space.

    local_sdt_p := #ADDRESS (1, osc$segnum_job_fixed_heap, xcb_p^.sdt_offset);
    local_sdtx_p := #ADDRESS (1, osc$segnum_job_fixed_heap, xcb_p^.sdtx_offset);
    IF #SIZE (local_sdt_p^) > osv$page_size THEN
      mmp$free_pages (#ADDRESS (1, #SEGMENT (local_sdt_p), #OFFSET (local_sdt_p)), #SIZE (local_sdt_p^),
            osc$wait, status);
    IFEND;
    FREE local_sdtx_p IN osv$job_fixed_heap^;
    FREE local_sdt_p IN osv$job_fixed_heap^;

  PROCEND mmp$task_delete_inherited_sdt;
?? TITLE := '  MMP$TERMINATE_SHADOWING_R1', EJECT ??
*copy mmh$terminate_shadowing_r1

  PROCEDURE [XDCL, #GATE] mmp$terminate_shadowing_r1
    (    segment_number: ost$segment;
     VAR status: ost$status);

    VAR
      fde_entry_p: gft$locked_file_desc_entry_p,
      open_count: gft$open_count,
      pva: ^cell,
      rb: mmt$rb_ring1_segment_request,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended;


    pva := #ADDRESS (1, segment_number, 0);
    mmp$fetch_sdt_sdtx_locked_fde (segment_number, sdt_entry_p, sdtx_entry_p, fde_entry_p, status);
    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;


{  Verify if shadow active. Only READ_WRITE shadowed segments can be terminated

    IF sdtx_entry_p^.shadow_info.shadow_segment_kind <> mmc$ssk_read_write_file THEN
      osp$set_status_condition (mme$invalid_shadow_segment, status);
      gfp$unlock_fde_p (fde_entry_p);
      RETURN; {----->
    IFEND;


{  Clear any segment locks left by the user.

    IF sdtx_entry_p^.segment_lock >= mmc$lss_lock_for_read_user THEN
      mmp$unlock_segment (pva, mmc$lus_free, osc$nowait, status);
      IF NOT status.normal THEN
        gfp$unlock_fde_p (fde_entry_p);
        osp$system_error ('Unexpected mmp$unlock_segment error', ^status);
      IFEND;
    IFEND;

{ Decrement active file open count. Delete the active FDE if open count is now zero.

    fde_entry_p^.open_count := fde_entry_p^.open_count - 1;
    open_count := fde_entry_p^.open_count;
    gfp$unlock_fde_p (fde_entry_p);

    IF open_count = 0 THEN
      destroy_segment (sdtx_entry_p^.sfid, fde_entry_p, sdtx_entry_p^.file_limits_enforced, status);
    IFEND;

{  Change segment table entry to be unshadowed.

    sdt_entry_p^.ste.asid := 0;
    sdtx_entry_p^.sfid := sdtx_entry_p^.shadow_info.shadow_sfid;
    sdtx_entry_p^.shadow_info.shadow_segment_kind := mmc$ssk_none;
    sdtx_entry_p^.shadow_info.passive_for_shadow_by_segnum := FALSE;

    #PURGE_BUFFER (osc$pva_purge_all_page_seg_map, pva);

  PROCEND mmp$terminate_shadowing_r1;
?? TITLE := '  MMP$VALIDATE_SEGMENT_NUMBER', EJECT ??
*copy mmh$validate_segment_number

  PROCEDURE [XDCL, #GATE] mmp$validate_segment_number
    (    segment_number: ost$segment;
     VAR sdt_entry_p: ^mmt$segment_descriptor;
     VAR sdtx_entry_p: ^mmt$segment_descriptor_extended;
     VAR status: ost$status);

    VAR
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    xcb_p := pmf$executing_task_xcb ();

    IF segment_number > xcb_p^.xp.segment_table_length THEN
      IF segment_number > 4095 THEN
        osp$set_status_condition (mme$segment_number_too_big, status);
      ELSE
        osp$set_status_condition (mme$segment_number_not_in_use, status);
      IFEND;
      RETURN; {----->
    IFEND;

    sdt_entry_p := mmp$get_sdt_entry_p (xcb_p, segment_number);
    sdtx_entry_p := mmp$get_sdtx_entry_p (xcb_p, segment_number);
    IF sdt_entry_p^.ste.vl = osc$vl_invalid_entry THEN
      osp$set_status_condition (mme$segment_number_not_in_use, status);
    IFEND;

  PROCEND mmp$validate_segment_number;

?? TITLE := '  MMP$VERIFY_NO_SPACE_AVAILABLE', EJECT ??
*copyc mmh$verify_no_space_available

  PROCEDURE [XDCL, #GATE] mmp$verify_no_space_available
    (    process_virtual_address: ^cell;
     VAR no_space_available: boolean;
     VAR status: ost$status);

    VAR
      dfd_p: ^dmt$disk_file_descriptor,
      fde_entry_p: gft$file_desc_entry_p,
      fmd_p: ^dmt$file_medium_descriptor,
      sdt_entry_p: ^mmt$segment_descriptor,
      sdtx_entry_p: ^mmt$segment_descriptor_extended,
      segment_number: ost$segment;

    no_space_available := FALSE;

    segment_number := #SEGMENT (process_virtual_address);
    mmp$validate_segment_number (segment_number, sdt_entry_p, sdtx_entry_p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    gfp$get_locked_fde_p (sdtx_entry_p^.sfid, fde_entry_p);
    dmp$get_disk_file_descriptor_p (fde_entry_p, dfd_p);
    IF dfd_p <> NIL THEN
      fmd_p := dfd_p^.p_fmd;

      WHILE fmd_p <> NIL DO
        {
        { Insure the segment number in fmd_p is the same as the segment number in dfd_p.
        {
        fmd_p := #ADDRESS (#RING (dfd_p), #SEGMENT (dfd_p), #OFFSET (fmd_p));
        IF fmd_p^.volume_assigned THEN
          no_space_available := (dmv$active_volume_table.table_p^ [fmd_p^.avt_index].
                mass_storage.space_gone) OR (NOT dmv$active_volume_table.table_p^ [fmd_p^.avt_index].
                mass_storage.allocation_allowed);
        IFEND;
        fmd_p := fmd_p^.p_next_fmd;
      WHILEND;
    IFEND;
    gfp$unlock_fde_p (fde_entry_p);

  PROCEND mmp$verify_no_space_available;
?? OLDTITLE, OLDTITLE ??
MODEND mmm$segment_manager_system_core;

