?? RIGHT := 110 ??
?? NEWTITLE := 'PACKAGE_SOFTWARE Utility: PACKAGE_SOFTWARE Utility Command.' ??
MODULE ram$package_software;

{ PURPOSE:
{   This module contains the procedure to set up and control the
{   software packing process.
{
{ DESIGN:
{   This module contains the command table and pdt for package software.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rat$scratch_segment
?? POP ??
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$scan_parameter_list
*copyc clp$scan_command_file
*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 osv$control_codes_to_quest_mark

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

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

  VAR
    rav$pacs_utility_name: [XDCL] ost$name := 'PACKAGE_SOFTWARE';

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

{ PURPOSE:
{   This procedure sets up the environment for package_software.
{
{
{   RAV$PACS_SCRATCH_SEGMENT is created so that other procedures
{   within PACS will not all have to create their own scratch
{   segment.
{
{ NOTES:
{
{

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


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

?? PUSH (LISTEXT := ON) ??

  VAR
    pacs_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^pacs_pdt_names, ^pacs_pdt_params];

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

  VAR
    pacs_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=pacs_command_table t=command s=xdcl
{ command n=(apply_object_correction, appoc) p=rap$apply_object_correction_cmd cm=xref a=hidden
{ command n=(checksum_file, chef) p=rap$checksum_file_command cm=xref a=hidden
{ command n=(create_order_definition, create_order_definitions, creod)   p=rap$create_order_definition     ..
{                     cm=xref
{ command n=(create_subproduct_correction, cresc) p=rap$create_subproduct_corr cm=xref
{ command n=(define_subproduct, defs) p=rap$define_subproduct cm=xref
{ command n=(display_packing_list, displ) p=rap$display_packing_list_pacs cm=xref
{ command n=(generate_object_correction, genoc)   p=rap$generate_object_corr_cmd cm=xref a=hidden
{ command n=(display_subproduct_information, dissi)   p=rap$display_subproduct_info cm=xref
{ command n=(load_packing_list, loapl) p=rap$load_packing_list_pacs_cmd   cm=xref
{ command n=(quit, qui) p=rap$quit_pacs cm=xref
{ command n=(read_tailored_file, reatf) p=rap$read_tailored_file cm=xref
{ command n=(verify_subproduct, vers) p=rap$verify_subproduct_command cm=xref
{ command n=(write_order, wrio) p=rap$write_order cm=proc
{ command n=(rap$write_disk_order) p=rap$write_disk_order cm=proc a=hidden
{ command n=(rap$write_tape_order) p=rap$write_tape_order cm=proc a=hidden
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  pacs_command_table: [XDCL, READ] ^clt$command_table := ^pacs_command_table_entries,

  pacs_command_table_entries: [STATIC, READ] array [1 .. 29] of clt$command_table_entry := [
  {} ['APPLY_OBJECT_CORRECTION        ', clc$nominal_entry, clc$hidden_entry, 1, clc$automatically_log,
         clc$linked_call, ^rap$apply_object_correction_cmd],
  {} ['APPOC                          ', clc$abbreviation_entry, clc$hidden_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$apply_object_correction_cmd],
  {} ['CHECKSUM_FILE                  ', clc$nominal_entry, clc$hidden_entry, 2, clc$automatically_log,
         clc$linked_call, ^rap$checksum_file_command],
  {} ['CHEF                           ', clc$abbreviation_entry, clc$hidden_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$checksum_file_command],
  {} ['CREATE_ORDER_DEFINITION        ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$create_order_definition],
  {} ['CREATE_ORDER_DEFINITIONS       ', clc$alias_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$create_order_definition],
  {} ['CREATE_SUBPRODUCT_CORRECTION   ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$create_subproduct_corr],
  {} ['CREOD                          ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$create_order_definition],
  {} ['CRESC                          ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$create_subproduct_corr],
  {} ['DEFINE_SUBPRODUCT              ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$define_subproduct],
  {} ['DEFS                           ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$define_subproduct],
  {} ['DISPL                          ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$display_packing_list_pacs],
  {} ['DISPLAY_PACKING_LIST           ', clc$nominal_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$display_packing_list_pacs],
  {} ['DISPLAY_SUBPRODUCT_INFORMATION ', clc$nominal_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^rap$display_subproduct_info],
  {} ['DISSI                          ', clc$abbreviation_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^rap$display_subproduct_info],
  {} ['GENERATE_OBJECT_CORRECTION     ', clc$nominal_entry, clc$hidden_entry, 7, clc$automatically_log,
         clc$linked_call, ^rap$generate_object_corr_cmd],
  {} ['GENOC                          ', clc$abbreviation_entry, clc$hidden_entry, 7,
        clc$automatically_log, clc$linked_call, ^rap$generate_object_corr_cmd],
  {} ['LOAD_PACKING_LIST              ', clc$nominal_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^rap$load_packing_list_pacs_cmd],
  {} ['LOAPL                          ', clc$abbreviation_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^rap$load_packing_list_pacs_cmd],
  {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^rap$quit_pacs],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^rap$quit_pacs],
  {} ['RAP$WRITE_DISK_ORDER           ', clc$nominal_entry, clc$hidden_entry, 14,
        clc$automatically_log, clc$proc_call, 'RAP$WRITE_DISK_ORDER'],
  {} ['RAP$WRITE_TAPE_ORDER           ', clc$nominal_entry, clc$hidden_entry, 15,
        clc$automatically_log, clc$proc_call, 'RAP$WRITE_TAPE_ORDER'],
  {} ['READ_TAILORED_FILE             ', clc$nominal_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^rap$read_tailored_file],
  {} ['REATF                          ', clc$abbreviation_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^rap$read_tailored_file],
  {} ['VERIFY_SUBPRODUCT              ', clc$nominal_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^rap$verify_subproduct_command],
  {} ['VERS                           ', clc$abbreviation_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^rap$verify_subproduct_command],
  {} ['WRIO                           ', clc$abbreviation_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$proc_call, 'RAP$WRITE_ORDER'],
  {} ['WRITE_ORDER                    ', clc$nominal_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$proc_call, 'RAP$WRITE_ORDER']];

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

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

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

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

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

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

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

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

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

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

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

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

?? POP ??


    VAR
      local_status: ost$status,
      scratch_segment_pointer: amt$segment_pointer;


?? 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 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;

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

    scratch_segment_pointer.kind := amc$sequence_pointer;
    scratch_segment_pointer.sequence_pointer := NIL;

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

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

      clp$push_utility (rav$pacs_utility_name, clc$global_command_search, pacs_command_table, NIL, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      clp$scan_command_file (clc$current_command_input, rav$pacs_utility_name, 'PACS', status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      clp$pop_utility (status);

    END /main/;

    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;

    osp$disestablish_cond_handler;

  PROCEND rap$package_software;

MODEND ram$package_software;
