?? RIGHT := 110 ??
?? NEWTITLE := 'PACKAGE_SOFTWARE Utility: CREATE_ORDER_DEFINITION Subutility.' ??
MODULE ram$create_order_definition;

{ PURPOSE:
{   This module contains the command to establish the CREATE_ORDER_DEFINITION
{   subutility environment.
{
{ DESIGN:
{   The command table and two memory sequences for processing
{   order definitions are created.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{


?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rac$pacs_processor_version
*copyc rac$sif_file_name
*copyc rac$subproduct_info_level
*copyc cld$path_description
*copyc rae$package_software_cc
*copyc rat$order_contents_list
*copyc rat$packing_list_types
*copyc rat$scratch_segment
*copyc rat$sequence_descriptor_types
*copyc rat$subproduct_info_types
*copyc rat$tape_information
?? POP ??
*copyc clp$get_value
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc mmp$create_scratch_segment
*copyc mmp$create_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$delete_segment
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc pmp$get_date
*copyc pmp$get_time
*copyc rap$add_name_to_path_ref
*copyc rap$get_file_path_and_ref

?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    rav$creod_scratch_segment: [XDCL] rat$scratch_segment;

  VAR
    rav$creod_utility_name: [XDCL] ost$name := 'CREATE_ORDER_DEFINITION';

  VAR
    rav$order_contents_count: [XDCL] rat$subproduct_count;

  VAR
    rav$order_contents_list_p: [XDCL] ^rat$order_contents_list;

  VAR
    rav$packing_list_header_p: [XDCL] ^rat$packing_list_header;

  VAR
    rav$packing_list_seq_p: [XDCL] ^rat$packing_list_sequence;

  VAR
    rav$tape_information: [XDCL] rat$tape_information;

?? TITLE := '[XDCL] rap$create_order_definition', EJECT ??

{ PURPOSE:
{   This procedure opens the utility and creates a scratch sequence and
{   the packing list sequence.
{
{ DESIGN:
{   The utility is opened and the two sequences are created.
{
{
{
{
{ NOTES:
{

  PROCEDURE [XDCL] rap$create_order_definition
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt creod_pdt (
{   status            : var of status = $optional
{   )

?? PUSH (LISTEXT := ON) ??

  VAR
    creod_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^creod_pdt_names, ^creod_pdt_params
      ];

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

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

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

?? POP ??

{ table n=creod_command_table t=command s=xdcl
{ command n=(add_subproduct, adds) p=rap$add_subproduct cm=xref
{ command n=(define_order, defo) p=rap$define_order cm=xref
{ command n=(define_tape_attributes, define_tape_attribute, defta) p=rap$define_tape_attributes cm=xref
{ command n=(determine_number_of_tapes, detnot) p=rap$determine_number_of_tapes cm=xref
{ command n=(write_definition, wrid) p=rap$write_definition cm=xref
{ command n=(quit, qui) p=rap$quit_creod cm=xref
{ tablend

?? PUSH (LISTEXT := ON) ??
VAR
  creod_command_table: [XDCL, READ] ^clt$command_table := ^creod_command_table_entries,

  creod_command_table_entries: [STATIC, READ] array [1 .. 16] of  clt$command_table_entry := [
  {} ['ADDS                           ', clc$abbreviation_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$add_subproduct],
  {} ['ADD_SUBPRODUCT                 ', clc$nominal_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$add_subproduct],
  {} ['ADD_SUBPRODUCTS                ', clc$alias_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$add_subproduct],
  {} ['DEFINE_ORDER                   ', clc$nominal_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$define_order],
  {} ['DEFINE_ORDERS                  ', clc$alias_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$define_order],
  {} ['DEFINE_TAPE_ATTRIBUTE          ', clc$alias_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$define_tape_attributes],
  {} ['DEFINE_TAPE_ATTRIBUTES         ', clc$nominal_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$define_tape_attributes],
  {} ['DEFO                           ', clc$abbreviation_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$define_order],
  {} ['DEFTA                          ', clc$abbreviation_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$define_tape_attributes],
  {} ['DETERMINE_NUMBER_OF_TAPES      ', clc$nominal_entry, clc$hidden_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$determine_number_of_tapes],
  {} ['DETNOT                         ', clc$abbreviation_entry, clc$hidden_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$determine_number_of_tapes],
  {} ['QUI                            ', clc$abbreviation_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$quit_creod],
  {} ['QUIT                           ', clc$nominal_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$quit_creod],
  {} ['WRID                           ', clc$abbreviation_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$write_definition],
  {} ['WRITE_DEFINITION               ', clc$nominal_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$write_definition],
  {} ['WRITE_DEFINITIONS              ', clc$alias_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$write_definition]];

  PROCEDURE [XREF] rap$add_subproduct (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$define_order (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$define_tape_attributes (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$quit_creod (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$write_definition (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$determine_number_of_tapes (parameter_list: clt$parameter_list;
    VAR status: ost$status);

?? POP ??


    VAR
      info_segment_pointer: mmt$segment_pointer,
      local_status: ost$status,
      scratch_segment_pointer: amt$segment_pointer,
      write_definition_needed_flag_p: ^BOOLEAN;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF info_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (info_segment_pointer, 1, ignore_status);
        info_segment_pointer.seq_pointer := NIL;
      IFEND;

      IF scratch_segment_pointer.sequence_pointer <> NIL THEN
        mmp$delete_scratch_segment (scratch_segment_pointer, ignore_status);
        scratch_segment_pointer.sequence_pointer := NIL;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    rav$order_contents_count := 0;
    rav$order_contents_list_p := NIL;
    rav$packing_list_header_p := NIL;
    rav$packing_list_seq_p := NIL;
    rav$tape_information.tape_type := 'UNKNOWN';

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

    info_segment_pointer.kind := mmc$sequence_pointer;
    info_segment_pointer.seq_pointer := NIL;
    scratch_segment_pointer.kind := amc$sequence_pointer;
    scratch_segment_pointer.sequence_pointer := NIL;

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

      mmp$create_segment (NIL, mmc$sequence_pointer, 1, info_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      rav$packing_list_seq_p := info_segment_pointer.seq_pointer;

      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, scratch_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      rav$creod_scratch_segment.sequence_p := scratch_segment_pointer.sequence_pointer;
      RESET rav$creod_scratch_segment.sequence_p;

      NEXT write_definition_needed_flag_p IN rav$creod_scratch_segment.sequence_p;
      write_definition_needed_flag_p^ := FALSE;
      NEXT rav$creod_scratch_segment.reset_p IN rav$creod_scratch_segment.sequence_p;

      clp$push_utility (rav$creod_utility_name, clc$global_command_search, creod_command_table, NIL, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$scan_command_file (clc$current_command_input, rav$creod_utility_name, 'CREOD', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$pop_utility (status);

    END /main/;

    osp$disestablish_cond_handler;

    IF info_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (info_segment_pointer, 1, local_status);
      info_segment_pointer.seq_pointer := NIL;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    IF scratch_segment_pointer.sequence_pointer <> NIL THEN
      mmp$delete_scratch_segment (scratch_segment_pointer, local_status);
      scratch_segment_pointer.sequence_pointer := NIL;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND rap$create_order_definition;

MODEND ram$create_order_definition;
