?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Real Memory Builder Command Handlers', EJECT ??
MODULE ocm$rmb_command_handlers;

{ PURPOSE:
{  Command processors for the Real Memory Builder.
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_expression_result
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parameter_list
*copyc clc$standard_file_names
*copyc oce$library_generator_errors
*copyc oce$rm_builder_exceptions
*copyc oce$ve_linker_exceptions
*copyc oct$build_options
*copyc ost$hardware_subranges
*copyc ost$page_size
*copyc ost$page_table
?? POP ??
*copyc clp$end_scan_command_file
*copyc clp$get_path_description
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$get_value_count
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc ocp$crack_program_name
*copyc ocp$create_transient_segment
*copyc ocp$generate_real_memory
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
?? POP ??
?? NEWTITLE := '  Global Variables', EJECT ??


  VAR
    ocv$rmb_scratch_seq: [XDCL] ^SEQ ( * );


  VAR
    rmb_generator_not_executed: boolean,

    command_file: [STATIC] amt$local_file_name := clc$current_command_input,
    build_options: oct$build_options;

?? OLDTITLE ??
?? NEWTITLE := '    RESET_MEMORY_BUILDER_PARAMETERS', EJECT ??

  PROCEDURE reset_memory_builder_parameters;






?? FMT (FORMAT := OFF) ??
  VAR
    default_build_options: [STATIC] oct$build_options :=

      [ { page_size }                 4096,
        { page_table_address }        0,
        { page_table_length }         4096,
        { load_address }              0,
        { load_offset }               0,
        { memory_map }                ['MEMORY_MAP'],
        { c170_memory_size }          0,
        { ssr_size }                  0,
        { job_exchange_address }      [occ$null, osc$null_name],
        { mtr_exchange_address }      [occ$null, osc$null_name],
        { pp_address_array_address }  [occ$null, osc$null_name],
        { pages_loaded_address }      [occ$null, osc$null_name],
        { page_size_address }         [occ$null, osc$null_name],
        { define_commands }           [*, *, *, *, *, *, *, *, *, *, *, *, *, nil],
        { load_files }                [osc$null_name, *, nil],
        { monitor_symbol_tables }     [osc$null_name, nil],
        { job_symbol_tables }         [osc$null_name, nil],
        { segment_commands }          [*, *, nil, occ$extend, *],
        { memory_commands }           [false, nil, *, occ$display_memory, *],
        { bytes_loaded_address }      [occ$null, osc$null_name],
        { building_ei }               FALSE];


?? FMT (FORMAT := ON) ??
    RESET ocv$rmb_scratch_seq;

    build_options := default_build_options;

    rmb_generator_not_executed := FALSE;


  PROCEND reset_memory_builder_parameters;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_EXCHANGE_NAME_PARAMETER', EJECT ??

  PROCEDURE crack_exchange_name_parameter (keyword: string ( * );
    VAR exchange_name: oct$exchange_name;
    VAR status: ost$status);


    VAR
      parameter_specified: boolean,
      parameter: clt$value,
      strng: string (39);


    clp$test_parameter (keyword, parameter_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter_specified THEN
      clp$get_value (keyword, 1, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF parameter.kind = clc$name_value THEN
        IF (parameter.name.value = 'MONITOR') OR (parameter.name.value = 'M') THEN
          exchange_name.address_space := occ$mtr;
        ELSEIF (parameter.name.value = 'JOB') OR (parameter.name.value = 'J') THEN
          exchange_name.address_space := occ$job;
        ELSE
          osp$set_status_abnormal ('OC', oce$e_invalid_address_space_id, '', status);
          RETURN;
        IFEND;
      ELSE
        osp$set_status_abnormal ('OC', cle$wrong_kind_of_value, 'NAME', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, parameter.descriptor, status);
        strng := ' for parameter';
        strng (16, 24) := keyword;
        osp$append_status_parameter (osc$status_parameter_delimiter, strng, status);
        RETURN;
      IFEND;

      clp$get_value (keyword, 2, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      ocp$crack_program_name (keyword, parameter, exchange_name.name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;


  PROCEND crack_exchange_name_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_SEGMENT_ATTRIBUTES_PARAM' ??
?? EJECT ??

  PROCEDURE crack_segment_attributes_param (keyword: string ( * );
    VAR hardware_attributes: ost$segment_access_control;
    VAR software_attributes: mmt$software_attribute_set;
    VAR parameter_specified: oct$parameters;
    VAR status: ost$status);




    VAR
      parameter: clt$value,
      number_of_sets: 0 .. clc$max_value_sets,
      i: 0 .. clc$max_value_sets,

      read_attributes: 0 .. clc$max_value_sets,
      write_attributes: 0 .. clc$max_value_sets,
      execute_attributes: 0 .. clc$max_value_sets;



    clp$get_set_count (keyword, number_of_sets, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF number_of_sets <> 0 THEN
      parameter_specified := parameter_specified + $oct$parameters [occ$attributes];
    IFEND;

    hardware_attributes.cache_bypass := FALSE;
    software_attributes := $mmt$software_attribute_set [];

    read_attributes := 0;
    write_attributes := 0;
    execute_attributes := 0;

    FOR i := 1 TO number_of_sets DO
      clp$get_value (keyword, i, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF parameter.name.value = 'RD' THEN
        hardware_attributes.read_privilege := osc$read_uncontrolled;
        read_attributes := read_attributes + 1;

      ELSEIF parameter.name.value = 'RK' THEN
        hardware_attributes.read_privilege := osc$read_key_lock_controlled;
        read_attributes := read_attributes + 1;
?? EJECT ??

      ELSEIF parameter.name.value = 'WT' THEN
        hardware_attributes.write_privilege := osc$write_uncontrolled;
        write_attributes := write_attributes + 1;

      ELSEIF parameter.name.value = 'WK' THEN
        hardware_attributes.write_privilege := osc$write_key_lock_controlled;
        write_attributes := write_attributes + 1;

      ELSEIF parameter.name.value = 'EX' THEN
        hardware_attributes.execute_privilege := osc$non_privileged;
        execute_attributes := execute_attributes + 1;

      ELSEIF parameter.name.value = 'LP' THEN
        hardware_attributes.execute_privilege := osc$local_privilege;
        execute_attributes := execute_attributes + 1;

      ELSEIF parameter.name.value = 'GP' THEN
        hardware_attributes.execute_privilege := osc$global_privilege;
        execute_attributes := execute_attributes + 1;

      ELSEIF parameter.name.value = 'BI' THEN
        hardware_attributes.read_privilege := osc$binding_segment;
        read_attributes := read_attributes + 1;

      ELSEIF parameter.name.value = 'CB' THEN
        hardware_attributes.cache_bypass := TRUE;

      ELSEIF parameter.name.value = 'WR' THEN
        software_attributes := software_attributes + $mmt$software_attribute_set [mmc$sa_wired];

      ELSEIF parameter.name.value = 'FX' THEN
        software_attributes := software_attributes + $mmt$software_attribute_set [mmc$sa_fixed];

      ELSEIF parameter.name.value = 'ST' THEN
        software_attributes := software_attributes + $mmt$software_attribute_set [mmc$sa_stack];

      ELSEIF parameter.name.value = 'RT' THEN
        software_attributes := software_attributes + $mmt$software_attribute_set [mmc$sa_read_transfer_unit];

      ELSEIF parameter.name.value = 'FB' THEN
        software_attributes := software_attributes + $mmt$software_attribute_set [mmc$sa_free_behind];

      ELSEIF parameter.name.value = 'NA' THEN
        software_attributes := software_attributes + $mmt$software_attribute_set [mmc$sa_no_append];

      IFEND;
    FOREND;
?? EJECT ??

    IF read_attributes = 0 THEN
      hardware_attributes.read_privilege := osc$non_readable;
    ELSEIF read_attributes > 1 THEN
      osp$set_status_abnormal ('OC', oce$e_seg_attribute_conflict, 'Multiple READ attributes', status);
      RETURN;
    IFEND;

    IF write_attributes = 0 THEN
      hardware_attributes.write_privilege := osc$non_writable;
    ELSEIF write_attributes > 1 THEN
      osp$set_status_abnormal ('OC', oce$e_seg_attribute_conflict, 'Multiple WRITE attributes', status);
      RETURN;
    IFEND;

    IF execute_attributes = 0 THEN
      hardware_attributes.execute_privilege := osc$non_executable;
    ELSEIF execute_attributes > 1 THEN
      osp$set_status_abnormal ('OC', oce$e_seg_attribute_conflict, 'Multiple EXECUTE attributes', status);
      RETURN;
    IFEND;

  PROCEND crack_segment_attributes_param;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_RING_BRACKETS_PARAMETER', EJECT ??

  PROCEDURE crack_ring_brackets_parameter (keyword: string ( * );
    VAR r1: ost$valid_ring;
    VAR r2: ost$valid_ring;
    VAR parameter_specified: oct$parameters;
    VAR status: ost$status);


    VAR
      parameter: clt$value,
      strng: string (2),
      l: integer;


    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      parameter_specified := parameter_specified + $oct$parameters [occ$ring_brackets];
      r1 := parameter.int.value;

      clp$get_value (keyword, 2, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      r2 := parameter.int.value;


      IF NOT (r1 <= r2) THEN
        STRINGREP (strng, l, r1);
        osp$set_status_abnormal ('OC', oce$e_invalid_ring1_ring2, strng (1, l), status);
        STRINGREP (strng, l, r2);
        osp$append_status_parameter (osc$status_parameter_delimiter, strng (1, l), status);
        RETURN;
      IFEND;
    IFEND;


  PROCEND crack_ring_brackets_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_KEY_LOCK_PARAMETER', EJECT ??

  PROCEDURE crack_key_lock_parameter (keyword: string ( * );
    VAR key_lock: ost$key_lock;
    VAR parameter_specified: oct$parameters;
    VAR status: ost$status);


    VAR
      parameter: clt$value,
      strng: string (80),
      l: integer;


    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      parameter_specified := parameter_specified + $oct$parameters [occ$gl_key];

      IF parameter.int.value = 0 THEN
        key_lock.global := FALSE;
      ELSE
        key_lock.global := TRUE;
        key_lock.value := parameter.int.value;
      IFEND;

      clp$get_value (keyword, 2, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF parameter.int.value = 0 THEN
        key_lock.local := FALSE;
      ELSE
        IF key_lock.global = TRUE THEN
          IF key_lock.value <> parameter.int.value THEN
            STRINGREP (strng, l, key_lock.value);
            osp$set_status_abnormal ('OC', oce$e_global_local_key_mismatch, strng (1, l), status);
            STRINGREP (strng, l, parameter.int.value);
            osp$append_status_parameter (osc$status_parameter_delimiter, strng (1, l), status);
            RETURN;
          ELSE
            key_lock.local := TRUE;
          IFEND;
        ELSE
          key_lock.local := TRUE;
          key_lock.value := parameter.int.value;
        IFEND;
      IFEND;
    IFEND;

  PROCEND crack_key_lock_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_SEGMENT_NUMBER_PARAMETER', EJECT ??

  PROCEDURE crack_segment_number_parameter (keyword: string ( * );
    VAR segment_number: ost$segment;
    VAR status: ost$status);


    VAR
      parameter: clt$value;


    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    segment_number := parameter.int.value;


  PROCEND crack_segment_number_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_ADDRESS_SPACE_PARAMETER', EJECT ??

  PROCEDURE crack_address_space_parameter (keyword: string ( * );
    VAR address_space: oct$address_space_id;
    VAR status: ost$status);


    VAR
      parameter: clt$value;


    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.name.value (1) = 'J' THEN
      address_space := occ$job;
    ELSEIF parameter.name.value (1) = 'M' THEN
      address_space := occ$mtr;
    ELSE
      address_space := occ$both;
    IFEND;

  PROCEND crack_address_space_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_ADDRESS_PARAMETER', EJECT ??

  PROCEDURE crack_address_parameter (keyword: string ( * );
    VAR rma: ost$real_memory_address;
    VAR status: ost$status);


    VAR
      parameter: clt$value;




    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rma := parameter.int.value;


  PROCEND crack_address_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_ACTIVE_SEGMENT_ID_PARAMETER', EJECT ??

  PROCEDURE crack_active_segment_id_param (keyword: string ( * );
    VAR asid: ost$asid;
    VAR parameter_specified: oct$parameters;
    VAR status: ost$status);


    VAR
      parameter: clt$value;




    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      parameter_specified := parameter_specified + $oct$parameters [occ$asid];
      asid := parameter.int.value;
    IFEND;


  PROCEND crack_active_segment_id_param;
?? OLDTITLE ??
?? NEWTITLE := '  CRACK_LENGTH_PARAMETER', EJECT ??

  PROCEDURE crack_length_parameter (keyword: string ( * );
    VAR segment_length: ost$segment_length;
    VAR status: ost$status);


    VAR
      parameter: clt$value;




    clp$get_value (keyword, 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    segment_length := parameter.int.value;


  PROCEND crack_length_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  DUPLICATE_LOAD_FILE', EJECT ??

  FUNCTION duplicate_load_file (file_name: amt$local_file_name;
        load_file_list: oct$load_file_list): boolean;


    VAR
      load_file: ^oct$load_file_list;


    load_file := ^load_file_list;

    REPEAT
      IF load_file^.name = file_name THEN
        duplicate_load_file := TRUE;
        RETURN;
      IFEND;

      load_file := load_file^.link;
    UNTIL load_file = NIL;

    duplicate_load_file := FALSE;


  FUNCEND duplicate_load_file;
?? OLDTITLE ??
?? NEWTITLE := '  DUPLICATE_SYMBOL_TABLE_FILE', EJECT ??

  FUNCTION duplicate_symbol_table_file (file_name: amt$local_file_name;
        symbol_table_list: oct$symbol_table_list): boolean;


    VAR
      symbol_table: ^oct$symbol_table_list;


    symbol_table := ^symbol_table_list;

    REPEAT
      IF symbol_table^.name = file_name THEN
        duplicate_symbol_table_file := TRUE;
        RETURN;
      IFEND;

      symbol_table := symbol_table^.link;
    UNTIL symbol_table = NIL;

    duplicate_symbol_table_file := FALSE;


  FUNCEND duplicate_symbol_table_file;
?? OLDTITLE ??
?? NEWTITLE := '    VERIFY_POWER_OF_TWO', EJECT ??

  PROCEDURE verify_power_of_two (number: integer;
    VAR status: ost$status);




    VAR
      l,
      num: integer,
      strng: string (80);



    num := number;

    WHILE num > 1 DO
      IF (num MOD 2) <> 0 THEN
        STRINGREP (strng, l, number);
        osp$set_status_abnormal ('OC', oce$e_integer_not_power_of_two, strng (1, l), status);
        RETURN;
      IFEND;

      num := num DIV 2;
    WHILEND;

  PROCEND verify_power_of_two;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$SET_BUILD_OPTIONS', EJECT ??

  PROCEDURE ocp$set_build_options (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt set_build_options_pdt (
{   page_size, ps: integer 2048 .. 16384
{   page_table_address, pta: integer 0 .. 0ffffffff(16)
{   page_table_length, ptl: integer 4096 .. 1048576
{   load_address, la: integer 0 .. 0ffffffff(16)
{   load_offset, lo: integer 0 .. 0ffffffff(16)
{   memory_map, mm: file
{   c170_memory_size, cms: integer 0 .. 0ffffffff(16)
{   ssr_size, ss: integer 0 .. 0ffffffff(16)
{   job_exchange_address, jea: list 2..2 1..1 of any
{   monitor_exchange_address, mea: list 2..2 1..1 of any
{   pp_address_array_address, paaa: list 2..2 1..1 of any
{   pages_loaded_address, pla: list 2..2 1..1 of any
{   page_size_address, psa: list 2..2 1..1 of any
{   bytes_loaded_address, bla : list 2..2 1..1 of any
{   building_environment_interface, bei: boolean = false
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      set_build_options_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^set_build_options_pdt_names, ^set_build_options_pdt_params];

    VAR
      set_build_options_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 32] of
        clt$parameter_name_descriptor := [['PAGE_SIZE', 1], ['PS', 1], ['PAGE_TABLE_ADDRESS', 2], ['PTA', 2],
        ['PAGE_TABLE_LENGTH', 3], ['PTL', 3], ['LOAD_ADDRESS', 4], ['LA', 4], ['LOAD_OFFSET', 5], ['LO', 5],
        ['MEMORY_MAP', 6], ['MM', 6], ['C170_MEMORY_SIZE', 7], ['CMS', 7], ['SSR_SIZE', 8], ['SS', 8], [
        'JOB_EXCHANGE_ADDRESS', 9], ['JEA', 9], ['MONITOR_EXCHANGE_ADDRESS', 10], ['MEA', 10], [
        'PP_ADDRESS_ARRAY_ADDRESS', 11], ['PAAA', 11], ['PAGES_LOADED_ADDRESS', 12], ['PLA', 12], [
        'PAGE_SIZE_ADDRESS', 13], ['PSA', 13], ['BYTES_LOADED_ADDRESS', 14], ['BLA', 14], [
        'BUILDING_ENVIRONMENT_INTERFACE', 15], ['BEI', 15], ['STATUS', 16], ['ST', 16]];

    VAR
      set_build_options_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 16] of
        clt$parameter_descriptor := [

{ PAGE_SIZE PS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 2048, 16384]],

{ PAGE_TABLE_ADDRESS PTA }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ PAGE_TABLE_LENGTH PTL }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 4096, 1048576]],

{ LOAD_ADDRESS LA }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ LOAD_OFFSET LO }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ MEMORY_MAP MM }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ C170_MEMORY_SIZE CMS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ SSR_SIZE SS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ JOB_EXCHANGE_ADDRESS JEA }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ MONITOR_EXCHANGE_ADDRESS MEA }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ PP_ADDRESS_ARRAY_ADDRESS PAAA }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ PAGES_LOADED_ADDRESS PLA }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ PAGE_SIZE_ADDRESS PSA }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ BYTES_LOADED_ADDRESS BLA }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ BUILDING_ENVIRONMENT_INTERFACE BEI }
      [[clc$optional_with_default, ^set_build_options_pdt_dv15], 1, 1, 1, 1, clc$value_range_not_allowed,
        [NIL, clc$boolean_value]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      set_build_options_pdt_dv15: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';

?? POP ??
?? EJECT ??

    VAR
      local_parameters: oct$build_options,
      parameter: clt$value,
      parameter_specified: boolean,
      page_table_address_set: boolean,
      segment_command: ^oct$define_command_list;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, set_build_options_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    local_parameters := build_options;

    clp$get_value ('PAGE_SIZE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      IF (parameter.int.value = 2048) OR (parameter.int.value = 4096) OR (parameter.int.value = 8192) OR
            (parameter.int.value = 16384) THEN
        local_parameters.page_size := parameter.int.value;
      ELSE
        osp$set_status_abnormal ('OC', oce$e_build_option_error, 'INVALID_PAGE_SIZE_PARAMETER', status);
        RETURN;
      IFEND;
    IFEND;

    clp$get_value ('PAGE_TABLE_ADDRESS', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      local_parameters.page_table_address := parameter.int.value;
      page_table_address_set := TRUE;
    ELSE
      page_table_address_set := FALSE;
    IFEND;

    clp$get_value ('PAGE_TABLE_LENGTH', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      verify_power_of_two (parameter.int.value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      local_parameters.page_table_length := parameter.int.value;
    IFEND;
?? EJECT ??

    clp$get_value ('LOAD_ADDRESS', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      local_parameters.load_address := parameter.int.value;
    IFEND;

    clp$get_value ('LOAD_OFFSET', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      local_parameters.load_offset := parameter.int.value;
    IFEND;

    clp$get_value ('MEMORY_MAP', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      local_parameters.memory_map := parameter.file;
    IFEND;

    clp$get_value ('C170_MEMORY_SIZE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      verify_power_of_two (parameter.int.value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      local_parameters.c170_memory_size := parameter.int.value;
    IFEND;

    clp$get_value ('SSR_SIZE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF parameter.kind <> clc$unknown_value THEN
      local_parameters.ssr_size := parameter.int.value;
    IFEND;
?? EJECT ??

    crack_exchange_name_parameter ('JOB_EXCHANGE_ADDRESS', local_parameters.job_exchange_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_exchange_name_parameter ('MONITOR_EXCHANGE_ADDRESS', local_parameters.monitor_exchange_address,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_exchange_name_parameter ('PP_ADDRESS_ARRAY_ADDRESS', local_parameters.pp_address_array_address,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_exchange_name_parameter ('PAGES_LOADED_ADDRESS', local_parameters.pages_loaded_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_exchange_name_parameter ('PAGE_SIZE_ADDRESS', local_parameters.page_size_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_exchange_name_parameter ('BYTES_LOADED_ADDRESS', local_parameters.bytes_loaded_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$get_value ('BUILDING_ENVIRONMENT_INTERFACE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    local_parameters.building_ei := parameter.bool.value;

    build_options := local_parameters;


    IF page_table_address_set THEN
      segment_command := build_options.define_commands.link;
      WHILE (segment_command <> NIL) AND (segment_command^.segment_id <> 'PAGE_TABLE') DO
        segment_command := segment_command^.link;
      WHILEND;
      IF segment_command <> NIL THEN
        segment_command^.address := build_options.page_table_address;
      IFEND;
    IFEND;

  PROCEND ocp$set_build_options;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$LOAD_MONITOR', EJECT ??

  PROCEDURE ocp$load_monitor (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt load_monitor_pdt (
{   virtual_image, vi: list of file = $required
{   symbol_table, symbol_tables, st: list of file
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      load_monitor_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^load_monitor_pdt_names,
        ^load_monitor_pdt_params];

    VAR
      load_monitor_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
        clt$parameter_name_descriptor := [['VIRTUAL_IMAGE', 1], ['VI', 1], ['SYMBOL_TABLE', 2], [
        'SYMBOL_TABLES', 2], ['ST', 2], ['STATUS', 3]];

    VAR
      load_monitor_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor
        := [

{ VIRTUAL_IMAGE VI }
      [[clc$required], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ SYMBOL_TABLE SYMBOL_TABLES ST }
      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,

      load_monitor_files: oct$load_file_list,
      last_load_monitor_file: ^oct$load_file_list,

      new_symbol_table_names: oct$symbol_table_list,
      last_new_symbol_table_name: ^oct$symbol_table_list,

      number_of_files: 0 .. clc$max_value_sets,
      file_number: 0 .. clc$max_value_sets;



    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, load_monitor_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('VIRTUAL_IMAGE', number_of_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    load_monitor_files.name := osc$null_name;
    load_monitor_files.link := NIL;
    last_load_monitor_file := ^load_monitor_files;

    FOR file_number := 1 TO number_of_files DO
      clp$get_value ('VIRTUAL_IMAGE', file_number, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF duplicate_load_file (parameter.file.local_file_name, load_monitor_files) OR duplicate_load_file
            (parameter.file.local_file_name, build_options.load_files) THEN
        osp$set_status_abnormal ('OC', oce$e_duplicate_file_named, parameter.file.local_file_name, status);
        RETURN;
      IFEND;

      NEXT last_load_monitor_file^.link IN ocv$rmb_scratch_seq;
      last_load_monitor_file := last_load_monitor_file^.link;
      IF last_load_monitor_file = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH1', status);
        RETURN;
      IFEND;

      last_load_monitor_file^.name := parameter.file.local_file_name;
      last_load_monitor_file^.address_space := occ$mtr;
    FOREND;
?? EJECT ??

    last_load_monitor_file^.link := NIL;

    last_load_monitor_file := ^build_options.load_files;
    WHILE last_load_monitor_file^.link <> NIL DO
      last_load_monitor_file := last_load_monitor_file^.link;
    WHILEND;
    last_load_monitor_file^.link := load_monitor_files.link;


    new_symbol_table_names.name := osc$null_name;
    new_symbol_table_names.link := NIL;
    last_new_symbol_table_name := ^new_symbol_table_names;


    clp$get_set_count ('SYMBOL_TABLE', number_of_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR file_number := 1 TO number_of_files DO
      clp$get_value ('SYMBOL_TABLE', file_number, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF duplicate_symbol_table_file (parameter.file.local_file_name, build_options.monitor_symbol_tables) OR
            duplicate_symbol_table_file (parameter.file.local_file_name, new_symbol_table_names) THEN
        osp$set_status_abnormal ('OC', oce$e_duplicate_file_named, parameter.file.local_file_name, status);
        RETURN;
      IFEND;

      NEXT last_new_symbol_table_name^.link IN ocv$rmb_scratch_seq;
      last_new_symbol_table_name := last_new_symbol_table_name^.link;
      IF last_new_symbol_table_name = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH1', status);
        RETURN;
      IFEND;

      last_new_symbol_table_name^.name := parameter.file.local_file_name;
    FOREND;

    last_new_symbol_table_name^.link := NIL;

    last_new_symbol_table_name := ^build_options.monitor_symbol_tables;
    WHILE last_new_symbol_table_name^.link <> NIL DO
      last_new_symbol_table_name := last_new_symbol_table_name^.link;
    WHILEND;
    last_new_symbol_table_name^.link := new_symbol_table_names.link;


  PROCEND ocp$load_monitor;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$LOAD_JOB', EJECT ??

  PROCEDURE ocp$load_job (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt load_job_pdt (
{   virtual_image, virtual_images, vi: list of file = $required
{   symbol_table, symbol_tables, st: list of file
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      load_job_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^load_job_pdt_names,
        ^load_job_pdt_params];

    VAR
      load_job_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
        clt$parameter_name_descriptor := [['VIRTUAL_IMAGE', 1], ['VIRTUAL_IMAGES', 1], ['VI', 1], [
        'SYMBOL_TABLE', 2], ['SYMBOL_TABLES', 2], ['ST', 2], ['STATUS', 3]];

    VAR
      load_job_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ VIRTUAL_IMAGE VIRTUAL_IMAGES VI }
      [[clc$required], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ SYMBOL_TABLE SYMBOL_TABLES ST }
      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,

      load_job_files: oct$load_file_list,
      last_load_job_file: ^oct$load_file_list,

      new_symbol_table_names: oct$symbol_table_list,
      last_new_symbol_table_name: ^oct$symbol_table_list,

      number_of_files: 0 .. clc$max_value_sets,
      file_number: 0 .. clc$max_value_sets;



    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, load_job_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$get_set_count ('VIRTUAL_IMAGE', number_of_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    load_job_files.name := osc$null_name;
    load_job_files.link := NIL;
    last_load_job_file := ^load_job_files;

    FOR file_number := 1 TO number_of_files DO
      clp$get_value ('VIRTUAL_IMAGE', file_number, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF duplicate_load_file (parameter.file.local_file_name, load_job_files) OR duplicate_load_file
            (parameter.file.local_file_name, build_options.load_files) THEN
        osp$set_status_abnormal ('OC', oce$e_duplicate_file_named, parameter.file.local_file_name, status);
        RETURN;
      IFEND;

      NEXT last_load_job_file^.link IN ocv$rmb_scratch_seq;
      last_load_job_file := last_load_job_file^.link;
      IF last_load_job_file = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH2', status);
        RETURN;
      IFEND;

      last_load_job_file^.name := parameter.file.local_file_name;
      last_load_job_file^.address_space := occ$job;
    FOREND;
?? EJECT ??

    last_load_job_file^.link := NIL;

    last_load_job_file := ^build_options.load_files;
    WHILE last_load_job_file^.link <> NIL DO
      last_load_job_file := last_load_job_file^.link;
    WHILEND;
    last_load_job_file^.link := load_job_files.link;

    new_symbol_table_names.name := osc$null_name;
    new_symbol_table_names.link := NIL;
    last_new_symbol_table_name := ^new_symbol_table_names;

    clp$get_set_count ('SYMBOL_TABLE', number_of_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR file_number := 1 TO number_of_files DO
      clp$get_value ('SYMBOL_TABLE', file_number, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF duplicate_symbol_table_file (parameter.file.local_file_name, build_options.job_symbol_tables) OR
            duplicate_symbol_table_file (parameter.file.local_file_name, new_symbol_table_names) THEN
        osp$set_status_abnormal ('OC', oce$e_duplicate_file_named, parameter.file.local_file_name, status);
        RETURN;
      IFEND;

      NEXT last_new_symbol_table_name^.link IN ocv$rmb_scratch_seq;
      last_new_symbol_table_name := last_new_symbol_table_name^.link;
      IF last_new_symbol_table_name = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH1', status);
        RETURN;
      IFEND;

      last_new_symbol_table_name^.name := parameter.file.local_file_name;
    FOREND;

    last_new_symbol_table_name^.link := NIL;

    last_new_symbol_table_name := ^build_options.job_symbol_tables;
    WHILE last_new_symbol_table_name^.link <> NIL DO
      last_new_symbol_table_name := last_new_symbol_table_name^.link;
    WHILEND;
    last_new_symbol_table_name^.link := new_symbol_table_names.link;


  PROCEND ocp$load_job;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$DEFINE_SEGMENT', EJECT ??

  PROCEDURE ocp$define_segment (parameter_list: clt$parameter_list;
    VAR status: ost$status);



{ pdt define_segment_pdt (
{   address_space, as: key monitor, m, job, j, both = $required
{   segment_identifier, si: name = $required
{   segment_number, sn: integer 0 .. osc$maximum_segment = $required
{   real_address, ra: integer 0 .. 0ffffffff(16)
{   length, l: integer 0 .. osc$max_segment_length = $required
{   attribute, attributes, a: list of key rd, rk, bi, wt, wk, ex, lp, gp, ...
{     cb, wr, sh, fx, st, rt, fb, na = $required
{   ring_brackets, rb: list 2..2 1..1 of integer osc$min_ring .. osc$max_ring = $required
{   active_segment_id, asid: integer 0 .. 0ffff(16)
{   global_local_key, glk: list 2..2 1..1 of integer 0..3f(16) = (0,0)
{   contiguous_memory_required, cmr: boolean = false
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      define_segment_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^define_segment_pdt_names, ^define_segment_pdt_params];

    VAR
      define_segment_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 23] of
        clt$parameter_name_descriptor := [['ADDRESS_SPACE', 1], ['AS', 1], ['SEGMENT_IDENTIFIER', 2], ['SI',
        2], ['SEGMENT_NUMBER', 3], ['SN', 3], ['REAL_ADDRESS', 4], ['RA', 4], ['LENGTH', 5], ['L', 5], [
        'ATTRIBUTE', 6], ['ATTRIBUTES', 6], ['A', 6], ['RING_BRACKETS', 7], ['RB', 7], ['ACTIVE_SEGMENT_ID',
        8], ['ASID', 8], ['GLOBAL_LOCAL_KEY', 9], ['GLK', 9], ['CONTIGUOUS_MEMORY_REQUIRED', 10], ['CMR', 10],
        ['STATUS', 11], ['ST', 11]];

    VAR
      define_segment_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 11] of
        clt$parameter_descriptor := [

{ ADDRESS_SPACE AS }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^define_segment_pdt_kv1, clc$keyword_value]],

{ SEGMENT_IDENTIFIER SI }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ SEGMENT_NUMBER SN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$maximum_segment]],

{ REAL_ADDRESS RA }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ LENGTH L }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$max_segment_length]],

{ ATTRIBUTE ATTRIBUTES A }
      [[clc$required], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [^define_segment_pdt_kv6,
        clc$keyword_value]],

{ RING_BRACKETS RB }
      [[clc$required], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, osc$min_ring,
        osc$max_ring]],

{ ACTIVE_SEGMENT_ID ASID }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffff(16)]],

{ GLOBAL_LOCAL_KEY GLK }
      [[clc$optional_with_default, ^define_segment_pdt_dv9], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 0, 3f(16)]],

{ CONTIGUOUS_MEMORY_REQUIRED CMR }
      [[clc$optional_with_default, ^define_segment_pdt_dv10], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      define_segment_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of ost$name := [
        'MONITOR', 'M', 'JOB', 'J', 'BOTH'];

    VAR
      define_segment_pdt_kv6: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 16] of ost$name := ['RD',
        'RK', 'BI', 'WT', 'WK', 'EX', 'LP', 'GP', 'CB', 'WR', 'SH', 'FX', 'ST', 'RT', 'FB', 'NA'];

    VAR
      define_segment_pdt_dv9: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := '(0,0)';

    VAR
      define_segment_pdt_dv10: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      address_specified: boolean,
      define_segment: ^oct$define_command_list,
      last_define_segment: ^oct$define_command_list;





    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, define_segment_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT define_segment IN ocv$rmb_scratch_seq;
    IF define_segment = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH3', status);
      RETURN;
    IFEND;

    define_segment^.link := NIL;
    define_segment^.parameters := $oct$parameters [];


    crack_address_space_parameter ('ADDRESS_SPACE', define_segment^.address_space, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('SEGMENT_IDENTIFIER', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind = clc$unknown_value THEN
      define_segment^.segment_id := osc$null_name;
    ELSE
      define_segment^.segment_id := parameter.name.value;
    IFEND;


?? EJECT ??
    crack_segment_number_parameter ('SEGMENT_NUMBER', define_segment^.segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$test_parameter ('REAL_ADDRESS', address_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF address_specified THEN
      crack_address_parameter ('REAL_ADDRESS', define_segment^.address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSEIF define_segment^.segment_id <> 'PAGE_TABLE' THEN
      osp$set_status_abnormal ('OC', cle$required_parameter_omitted, 'REAL_ADDRESS', status);
      RETURN;
    IFEND;




    crack_length_parameter ('LENGTH', define_segment^.length, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_segment_attributes_param ('ATTRIBUTES', define_segment^.hardware_attributes, define_segment^.
          software_attributes, define_segment^.parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_ring_brackets_parameter ('RING_BRACKETS', define_segment^.r1, define_segment^.r2, define_segment^.
          parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_active_segment_id_param ('ACTIVE_SEGMENT_ID', define_segment^.active_segment_id, define_segment^.
          parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_key_lock_parameter ('GLOBAL_LOCAL_KEY', define_segment^.key_lock, define_segment^.parameters,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CONTIGUOUS_MEMORY_REQUIRED', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    define_segment^.contiguous_space := parameter.bool.value;

    last_define_segment := ^build_options.define_commands;
    WHILE last_define_segment^.link <> NIL DO
      last_define_segment := last_define_segment^.link;
    WHILEND;

    last_define_segment^.link := define_segment;


    IF define_segment^.segment_id = 'PAGE_TABLE' THEN
      IF address_specified THEN
        build_options.page_table_address := define_segment^.address;
      ELSE
        define_segment^.address := build_options.page_table_address;
      IFEND;
    IFEND;


    rmb_generator_not_executed := TRUE;


  PROCEND ocp$define_segment;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$CHANGE_SEGMENT', EJECT ??

  PROCEDURE ocp$change_segment (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt change_segment_pdt (
{   address_space, as: key monitor, m, job, j, both = $required
{   segment_number, sn: integer 0 .. osc$maximum_segment = $required
{   attribute, attributes, a: list of key rd, rk, bi, wt, wk, ex, lp, gp, ...
{     cb, wr, sh, fx, st, rt, fb, na
{   ring_brackets, rb: list 2..2 1..1 of integer osc$min_ring .. osc$max_ring
{   active_segment_id, asid: integer 0 .. 0ffff(16)
{   global_local_key, glk: list 2..2 1..1 of integer 0..3f(16)
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      change_segment_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^change_segment_pdt_names, ^change_segment_pdt_params];

    VAR
      change_segment_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 15] of
        clt$parameter_name_descriptor := [['ADDRESS_SPACE', 1], ['AS', 1], ['SEGMENT_NUMBER', 2], ['SN', 2],
        ['ATTRIBUTE', 3], ['ATTRIBUTES', 3], ['A', 3], ['RING_BRACKETS', 4], ['RB', 4], ['ACTIVE_SEGMENT_ID',
        5], ['ASID', 5], ['GLOBAL_LOCAL_KEY', 6], ['GLK', 6], ['STATUS', 7], ['ST', 7]];

    VAR
      change_segment_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 7] of clt$parameter_descriptor
        := [

{ ADDRESS_SPACE AS }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^change_segment_pdt_kv1, clc$keyword_value]],

{ SEGMENT_NUMBER SN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$maximum_segment]],

{ ATTRIBUTE ATTRIBUTES A }
      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [^change_segment_pdt_kv3,
        clc$keyword_value]],

{ RING_BRACKETS RB }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, osc$min_ring,
        osc$max_ring]],

{ ACTIVE_SEGMENT_ID ASID }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffff(16)]],

{ GLOBAL_LOCAL_KEY GLK }
      [[clc$optional], 2, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 3f(16)]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      change_segment_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of ost$name := [
        'MONITOR', 'M', 'JOB', 'J', 'BOTH'];

    VAR
      change_segment_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 16] of ost$name := ['RD',
        'RK', 'BI', 'WT', 'WK', 'EX', 'LP', 'GP', 'CB', 'WR', 'SH', 'FX', 'ST', 'RT', 'FB', 'NA'];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      segment_command: ^oct$segment_command_list,
      duplicate_segment_command: ^oct$segment_command_list,
      last_segment_command: ^oct$segment_command_list;





    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, change_segment_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT segment_command IN ocv$rmb_scratch_seq;
    IF segment_command = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH4', status);
      RETURN;
    IFEND;

    segment_command^.link := NIL;
    segment_command^.parameters := $oct$parameters [];
    segment_command^.kind := occ$change;


    crack_address_space_parameter ('ADDRESS_SPACE', segment_command^.address_space, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_segment_number_parameter ('SEGMENT_NUMBER', segment_command^.segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_segment_attributes_param ('ATTRIBUTES', segment_command^.hardware_attributes, segment_command^.
          software_attributes, segment_command^.parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_ring_brackets_parameter ('RING_BRACKETS', segment_command^.r1, segment_command^.r2,
          segment_command^.parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
?? EJECT ??

    crack_active_segment_id_param ('ACTIVE_SEGMENT_ID', segment_command^.active_segment_id, segment_command^.
          parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_key_lock_parameter ('GLOBAL_LOCAL_KEY', segment_command^.key_lock, segment_command^.parameters,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    last_segment_command := ^build_options.segment_commands;
    WHILE last_segment_command^.link <> NIL DO
      last_segment_command := last_segment_command^.link;
    WHILEND;

    IF segment_command^.address_space = occ$both THEN
      NEXT duplicate_segment_command IN ocv$rmb_scratch_seq;
      IF duplicate_segment_command = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH9', status);
        RETURN;
      IFEND;

      duplicate_segment_command^ := segment_command^;
      duplicate_segment_command^.address_space := occ$mtr;

      last_segment_command^.link := duplicate_segment_command;
      last_segment_command := last_segment_command^.link;

      segment_command^.address_space := occ$job;
    IFEND;

    last_segment_command^.link := segment_command;

    rmb_generator_not_executed := TRUE;


  PROCEND ocp$change_segment;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$SHARE_SEGMENT', EJECT ??

  PROCEDURE ocp$share_segment (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt share_segment_pdt (
{   address_space, as: key monitor, m, job, j = $required
{   segment_number, sn: integer 0 .. osc$maximum_segment = $required
{   new_address_space, nas: key monitor, m, job, j = $required
{   new_segment_number, nsn: integer 0 .. osc$maximum_segment = $required
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      share_segment_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^share_segment_pdt_names,
        ^share_segment_pdt_params];

    VAR
      share_segment_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 10] of
        clt$parameter_name_descriptor := [['ADDRESS_SPACE', 1], ['AS', 1], ['SEGMENT_NUMBER', 2], ['SN', 2],
        ['NEW_ADDRESS_SPACE', 3], ['NAS', 3], ['NEW_SEGMENT_NUMBER', 4], ['NSN', 4], ['STATUS', 5], ['ST',
        5]];

    VAR
      share_segment_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 5] of clt$parameter_descriptor
        := [

{ ADDRESS_SPACE AS }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^share_segment_pdt_kv1, clc$keyword_value]],

{ SEGMENT_NUMBER SN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$maximum_segment]],

{ NEW_ADDRESS_SPACE NAS }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^share_segment_pdt_kv3, clc$keyword_value]],

{ NEW_SEGMENT_NUMBER NSN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$maximum_segment]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      share_segment_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := [
        'MONITOR', 'M', 'JOB', 'J'];

    VAR
      share_segment_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := [
        'MONITOR', 'M', 'JOB', 'J'];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      segment_command: ^oct$segment_command_list,
      last_segment_command: ^oct$segment_command_list;



    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, share_segment_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT segment_command IN ocv$rmb_scratch_seq;
    IF segment_command = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH5', status);
      RETURN;
    IFEND;

    segment_command^.link := NIL;
    segment_command^.kind := occ$share;


    crack_address_space_parameter ('ADDRESS_SPACE', segment_command^.address_space, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_segment_number_parameter ('SEGMENT_NUMBER', segment_command^.segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_address_space_parameter ('NEW_ADDRESS_SPACE', segment_command^.new_address_space, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_segment_number_parameter ('NEW_SEGMENT_NUMBER', segment_command^.new_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    last_segment_command := ^build_options.segment_commands;
    WHILE last_segment_command^.link <> NIL DO
      last_segment_command := last_segment_command^.link;
    WHILEND;
    last_segment_command^.link := segment_command;

    rmb_generator_not_executed := TRUE;

  PROCEND ocp$share_segment;
?? OLDTITLE ??
?? NEWTITLE := '    OCP$EXTEND_SEGMENT', EJECT ??

  PROCEDURE ocp$extend_segment (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt extend_segment_pdt (
{   address_space, as: key monitor, m, job, j = $required
{   segment_number, sn: integer 0 .. osc$maximum_segment = $required
{   length, l: integer 0 .. osc$max_segment_length = $required
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      extend_segment_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^extend_segment_pdt_names, ^extend_segment_pdt_params];

    VAR
      extend_segment_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
        clt$parameter_name_descriptor := [['ADDRESS_SPACE', 1], ['AS', 1], ['SEGMENT_NUMBER', 2], ['SN', 2],
        ['LENGTH', 3], ['L', 3], ['STATUS', 4], ['ST', 4]];

    VAR
      extend_segment_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor
        := [

{ ADDRESS_SPACE AS }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^extend_segment_pdt_kv1, clc$keyword_value]],

{ SEGMENT_NUMBER SN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$maximum_segment]],

{ LENGTH L }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
        osc$max_segment_length]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      extend_segment_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := [
        'MONITOR', 'M', 'JOB', 'J'];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      segment_command: ^oct$segment_command_list,
      last_segment_command: ^oct$segment_command_list;





    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, extend_segment_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT segment_command IN ocv$rmb_scratch_seq;
    IF segment_command = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH6', status);
      RETURN;
    IFEND;

    segment_command^.link := NIL;
    segment_command^.kind := occ$extend;


    crack_address_space_parameter ('ADDRESS_SPACE', segment_command^.address_space, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_segment_number_parameter ('SEGMENT_NUMBER', segment_command^.segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    crack_length_parameter ('LENGTH', segment_command^.extend_length, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    last_segment_command := ^build_options.segment_commands;
    WHILE last_segment_command^.link <> NIL DO
      last_segment_command := last_segment_command^.link;
    WHILEND;

    last_segment_command^.link := segment_command;

    rmb_generator_not_executed := TRUE;

  PROCEND ocp$extend_segment;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$DISPLAY_MEMORY', EJECT ??

  PROCEDURE ocp$display_memory (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt display_memory_pdt (
{   memory, m: key all, page_table, pt, memory_map, mm, monitor_exchange_package, mep ...
{   job_exchange_package, jep = $required
{   output, o: file
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_memory_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^display_memory_pdt_names, ^display_memory_pdt_params];

    VAR
      display_memory_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
        clt$parameter_name_descriptor := [['MEMORY', 1], ['M', 1], ['OUTPUT', 2], ['O', 2], ['STATUS', 3],
        ['ST', 3]];

    VAR
      display_memory_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor
        := [

{ MEMORY M }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^display_memory_pdt_kv1, clc$keyword_value]],

{ OUTPUT O }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      display_memory_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 9] of ost$name := ['ALL',
        'PAGE_TABLE', 'PT', 'MEMORY_MAP', 'MM', 'MONITOR_EXCHANGE_PACKAGE', 'MEP', 'JOB_EXCHANGE_PACKAGE',
        'JEP'];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      memory_command: ^oct$memory_command_list,
      last_memory_command: ^oct$memory_command_list;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_memory_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT memory_command IN ocv$rmb_scratch_seq;
    IF memory_command = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH7', status);
      RETURN;
    IFEND;

    memory_command^.file_name_specified := FALSE;
    memory_command^.link := NIL;
    memory_command^.kind := occ$display_memory;

    clp$get_value ('MEMORY', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.name.value = 'ALL' THEN
      memory_command^.memory := occ$all;
    ELSEIF (parameter.name.value = 'MEMORY_MAP') OR (parameter.name.value = 'MM') THEN
      memory_command^.memory := occ$memory_map;
    ELSEIF (parameter.name.value = 'PAGE_TABLE') OR (parameter.name.value = 'PT') THEN
      memory_command^.memory := occ$page_table;
    ELSEIF (parameter.name.value = 'MONITOR_EXCHANGE_PACKAGE') OR (parameter.name.value = 'MEP') THEN
      memory_command^.memory := occ$mps;
    ELSE
      memory_command^.memory := occ$jps;
    IFEND;
?? EJECT ??

    clp$get_value ('OUTPUT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      memory_command^.file_name_specified := TRUE;
      memory_command^.output := parameter.file;
    IFEND;

    last_memory_command := ^build_options.memory_commands;
    WHILE last_memory_command^.link <> NIL DO
      last_memory_command := last_memory_command^.link;
    WHILEND;
    last_memory_command^.link := memory_command;

    rmb_generator_not_executed := TRUE;

  PROCEND ocp$display_memory;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$DISPLAY_MEMORY_ADDRESS', EJECT ??

  PROCEDURE ocp$display_memory_address (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt display_mem_addr_pdt (
{   real_address, ra: integer 0 .. 0ffffffff(16) = $required
{   length, l: integer 1 .. osc$max_segment_length = $required
{   output, o: file
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_mem_addr_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^display_mem_addr_pdt_names, ^display_mem_addr_pdt_params];

    VAR
      display_mem_addr_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
        clt$parameter_name_descriptor := [['REAL_ADDRESS', 1], ['RA', 1], ['LENGTH', 2], ['L', 2], ['OUTPUT',
        3], ['O', 3], ['STATUS', 4], ['ST', 4]];

    VAR
      display_mem_addr_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of
        clt$parameter_descriptor := [

{ REAL_ADDRESS RA }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 0ffffffff(16)]],

{ LENGTH L }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1,
        osc$max_segment_length]],

{ OUTPUT O }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      memory_command: ^oct$memory_command_list,
      last_memory_command: ^oct$memory_command_list;



    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_mem_addr_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT memory_command IN ocv$rmb_scratch_seq;
    IF memory_command = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'RCH8', status);
      RETURN;
    IFEND;

    memory_command^.file_name_specified := FALSE;
    memory_command^.link := NIL;
    memory_command^.kind := occ$display_memory_address;


    crack_address_parameter ('REAL_ADDRESS', memory_command^.display_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$get_value ('LENGTH', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    memory_command^.length := parameter.int.value;
?? EJECT ??

    clp$get_value ('OUTPUT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      memory_command^.file_name_specified := TRUE;
      memory_command^.output := parameter.file;
    IFEND;

    last_memory_command := ^build_options.memory_commands;
    WHILE last_memory_command^.link <> NIL DO
      last_memory_command := last_memory_command^.link;
    WHILEND;
    last_memory_command^.link := memory_command;

    rmb_generator_not_executed := TRUE;

  PROCEND ocp$display_memory_address;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$RMB_GENERATE', EJECT ??

  PROCEDURE ocp$rmb_generate (parameter_list: clt$parameter_list;
    VAR status: ost$status);





{ pdt generate_pdt (
{   real_memory_image, rmi: file = $required
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      generate_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^generate_pdt_names,
        ^generate_pdt_params];

    VAR
      generate_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
        clt$parameter_name_descriptor := [['REAL_MEMORY_IMAGE', 1], ['RMI', 1], ['STATUS', 2], ['ST', 2]];

    VAR
      generate_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ REAL_MEMORY_IMAGE RMI }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??




    VAR
      parameter: clt$value;




    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, generate_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('REAL_MEMORY_IMAGE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ocp$generate_real_memory (build_options, parameter.file.local_file_name, status);

    IF status.condition <> oce$e_generate_status THEN
      reset_memory_builder_parameters;
    IFEND;

  PROCEND ocp$rmb_generate;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$QUIT', EJECT ??

  PROCEDURE ocp$quit (parameter_list: clt$parameter_list;
    VAR status: ost$status);





{ pdt quit_pdt ()

?? PUSH (LISTEXT := ON) ??

    VAR
      quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??




    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$end_scan_command_file (rmb_utility_name, status);

  PROCEND ocp$quit;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$BUILDRM', EJECT ??

  PROCEDURE [XDCL, #GATE] ocp$build_real_memory (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt build_real_memory_pdt (
{   status, st)

?? PUSH (LISTEXT := ON) ??

    VAR
      build_real_memory_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^build_real_memory_pdt_names, ^build_real_memory_pdt_params];

    VAR
      build_real_memory_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of
        clt$parameter_name_descriptor := [['STATUS', 1], ['ST', 1]];

    VAR
      build_real_memory_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1] of
        clt$parameter_descriptor := [

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??
?? EJECT ??
{ table rmb_command_list t=c s=local
{   command (set_build_options              ,set_build_option,  setbo) ocp$set_build_options cm=local
{   command (define_segment                 ,defs) ocp$define_segment cm=local
{   command (load_monitor                   ,loam) ocp$load_monitor cm=local
{   command (load_job                       ,loaj) ocp$load_job cm=local
{   command (change_segment                 ,chas) ocp$change_segment cm=local
{   command (share_segment                  ,shas) ocp$share_segment cm=local
{   command (extend_segment                 ,exts) ocp$extend_segment cm=local
{   command (display_memory                 ,dism) ocp$display_memory cm=local
{   command (display_memory_address         ,disma) ocp$display_memory_address cm=local
{   command (generate_real_memory           ,genrm) ocp$rmb_generate cm=local
{   command (quit                           ,qui) ocp$quit cm=local
{ tablend
?? PUSH (LISTEXT := ON) ??

VAR
  rmb_command_list: [STATIC, READ] ^clt$command_table :=
      ^rmb_command_list_entries,

  rmb_command_list_entries: [STATIC, READ] array [1 .. 23] of
      clt$command_table_entry := [
  {} ['CHANGE_SEGMENT                 ', clc$nominal_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^ocp$change_segment],
  {} ['CHAS                           ', clc$abbreviation_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^ocp$change_segment],
  {} ['DEFINE_SEGMENT                 ', clc$nominal_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^ocp$define_segment],
  {} ['DEFS                           ', clc$abbreviation_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^ocp$define_segment],
  {} ['DISM                           ', clc$abbreviation_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^ocp$display_memory],
  {} ['DISMA                          ', clc$abbreviation_entry, clc$advertised_entry, 9,
        clc$automatically_log, clc$linked_call, ^ocp$display_memory_address],
  {} ['DISPLAY_MEMORY                 ', clc$nominal_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^ocp$display_memory],
  {} ['DISPLAY_MEMORY_ADDRESS        ', clc$nominal_entry, clc$advertised_entry, 9,
        clc$automatically_log, clc$linked_call, ^ocp$display_memory_address],
  {} ['EXTEND_SEGMENT                 ', clc$nominal_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$linked_call, ^ocp$extend_segment],
  {} ['EXTS                           ', clc$abbreviation_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$linked_call, ^ocp$extend_segment],
  {} ['GENERATE_REAL_MEMORY           ', clc$nominal_entry, clc$advertised_entry, 10,
        clc$automatically_log, clc$linked_call, ^ocp$rmb_generate],
  {} ['GENRM                          ', clc$abbreviation_entry, clc$advertised_entry, 10,
        clc$automatically_log, clc$linked_call, ^ocp$rmb_generate],
  {} ['LOAD_JOB                       ', clc$nominal_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^ocp$load_job],
  {} ['LOAD_MONITOR                   ', clc$nominal_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^ocp$load_monitor],
  {} ['LOAJ                           ', clc$abbreviation_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^ocp$load_job],
  {} ['LOAM                           ', clc$abbreviation_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^ocp$load_monitor],
  {} ['QUI                            ', clc$abbreviation_entry, clc$advertised_entry, 11,
        clc$automatically_log, clc$linked_call, ^ocp$quit],
  {} ['QUIT                           ', clc$nominal_entry, clc$advertised_entry, 11,
        clc$automatically_log, clc$linked_call, ^ocp$quit],
  {} ['SETBO                          ', clc$abbreviation_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^ocp$set_build_options],
  {} ['SET_BUILD_OPTION               ', clc$alias_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^ocp$set_build_options],
  {} ['SET_BUILD_OPTIONS              ', clc$nominal_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^ocp$set_build_options],
  {} ['SHARE_SEGMENT                  ', clc$nominal_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^ocp$share_segment],
  {} ['SHAS                           ', clc$abbreviation_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^ocp$share_segment]];
?? POP ??
?? EJECT ??

    VAR
      parameter: clt$value,
      segment_pointer: amt$segment_pointer;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, build_real_memory_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    ocp$create_transient_segment (amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    ocv$rmb_scratch_seq := segment_pointer.sequence_pointer;

    reset_memory_builder_parameters;


    clp$push_utility (rmb_utility_name, clc$global_command_search, rmb_command_list, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$scan_command_file (command_file, rmb_utility_name, rmb_prompt_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

?? EJECT ??

    clp$pop_utility (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    IF rmb_generator_not_executed THEN
      osp$set_status_abnormal ('OC', oce$w_real_memory_not_generated, '', status);
    IFEND;


  PROCEND ocp$build_real_memory;

MODEND ocm$rmb_command_handlers;
