?? RIGHT := 110 ??
?? NEWTITLE := 'CREATE_ORDER_DEFINITION Subutility: WRITE_DEFINITION Subcommand.' ??
MODULE ram$write_definition;

{ PURPOSE:
{   This module contains the procedures that complete the order definition and
{   write the packing list and the order data file into the order catalog.
{
{ DESIGN:
{   An order catalog is not to be confused with a PACS catalog.
{
{   An order catalog is required by WRITE_DEFINITION as a place to create files
{   important to order filling (writing).  The order catalog is created by
{   WRITE_DEFINITION and therefore cannot exist prior to the execution of
{   WRITE_DEFINITION.  After an order definition is written the catalog will
{   contain a packing list and an order data file.
{
{      1. The packing list is shipped with the order and is required to
{         install and maintain the ordered software at the site.  A packing
{         list is a segment access file.  The packing list is originally
{         created in memory and then written into the order catalog.
{
{      2. The order data file contains information used in the writing of
{         the order by WRITE_ORDER.  The order data file is a text file that
{         when "included" will create SCL variables containing order data.
{
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{   Multiple calls to WRITE_DEFINITION without calling the QUIT command between
{   each call will create excess space in the packing list.
{
{   6/8/89
{   According to the tape project:
{
{   For 9 track:
{
{   1. VE writes 4128 byte blocks by default. (Of the 4128 bytes, 14 bytes are
{      header information.
{   2. Each block followed by inter-record-gap (IRG) which equals .3 of an inch
{      +/- .1 of an inch.
{   3. A tape mark plus its associated header and trailer labels (80 characters
{      per label) occupies about 3 inches of tape.  A tape mark is 2.5 inches
{      +/- .5 inches.
{   4. The label and tape marks which separate ansi_files in a multiple file
{      ANSI tape are about 9 inches.  The sequence is: file1, TM, EOF1, EOF2,
{      TM, HDR1, HDR2, TM, file2.
{
{   For 18 track:
{
{   1. VE writes 32640 byte blocks by default. (Of the 32640 bytes, 14 bytes are
{      header information.
{   2. Each block followed by inter-record-gap (IRG) which equals .079 of an inch
{      + .039/- .016 of an inch.
{   3. A tape mark plus its associated header and trailer labels (80 characters
{      per label) occupies less than 1 inch of tape.  A tape mark is .039 inches
{      +/- .011 inches.
{   4. The label and tape marks which separate ansi_files in a multiple file
{      ANSI tape are less than 1 inch.  The sequence is: file1, TM, EOF1, EOF2,
{      TM, HDR1, HDR2, TM, file2.
{
{   From our experimentation:
{   1. A 600 foot MT9$1600 tape can hold approximately 8,985,000 bytes.
{      That's 1248 bytes per inch.
{      That's 14,975 bytes per foot.
{   2. A 600 foot MT9$6250 tape can hold approximately 29,716,000 bytes.
{      That's 4127 bytes per inch.
{      That's 49,527 bytes per foot.
{   3. A 540 foot MT18$38000 tape can hold approximately 223,000,000 bytes.
{      That's 34,413 bytes per inch.
{      That's 412,962 bytes per foot.
{
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rac$not_assigned
*copyc rac$order_data_file_name
*copyc rac$packing_list_name
*copyc rac$sif_file_name
*copyc rac$tape_types
*copyc rae$package_software_cc
*copyc amt$file_byte_address
*copyc ost$string
*copyc rat$string
*copyc rat$tape
?? POP ??
*copyc i#current_sequence_position
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$set_segment_eoi
*copyc clp$evaluate_file_reference
*copyc clp$evaluate_parameters
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc pfp$define_catalog
*copyc pmp$get_date
*copyc pmp$get_unique_name
*copyc rap$add_name_to_path_ref
*copyc rap$get_file_path
*copyc smp$begin_sort_specification
*copyc smp$end_specification
*copyc smp$from_memory_area
*copyc smp$key
*copyc smp$to_memory_area
*copyc rap$open_file
*copyc rav$creod_scratch_segment
*copyc rav$order_contents_count
*copyc rav$order_contents_list_p
*copyc rav$packing_list_header_p
*copyc rav$packing_list_seq_p
*copyc rav$subproduct_type
*copyc rav$tape_information

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

  CONST
    bytes_per_foot_mt9$1600 = 14975,
    bytes_per_foot_mt9$6250 = 49527,
    bytes_per_foot_mt18$38000 = 412962,
    bytes_per_tape_gap_mt9$1600 = (75 * bytes_per_foot_mt9$1600) DIV 100, {9 inch gap}
    bytes_per_tape_gap_mt9$6260 = (75 * bytes_per_foot_mt9$6250) DIV 100, {9 inch gap}
    bytes_per_tape_gap_mt18$38000 = (bytes_per_foot_mt18$38000) DIV 12; {1 inch gap}


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

{ PURPOSE:
{   This interface completes the order definition and writes the packing list
{   and the order data file into the order catalog.
{
{ DESIGN:
{   This is the main driver.
{
{   When processing orders to be written to tape:  The sorting of the contents
{   list before and after the the assignment of the contents list to tape is
{   required.  The first sort places the contents list into descending order by
{   priority and size.  The assignment algorithm is set up assuming this
{   ordering.  The second sort, rearranges the contents list into the order each
{   item was assigned.  The writing of the order data file and the creating of the
{   subproduct indexer assumes this ordering.
{
{   When processing disk orders there is no sorting required of the contents
{   list.  The contents list items are assigned to the disk file in the order
{   they were added (ADD_SUBPRODUCT).
{
{ NOTES:
{

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


{ pdt wrid_pdt (
{  order_catalog, oc : file = $required
{  tape_list         : (BY_NAME, HIDDEN) list of name = $optional
{  status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 4] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 4, 15, 10, 5, 48, 561],
    clc$command, 4, 3, 1, 0, 1, 0, 3, ''], [
    ['OC                             ',clc$abbreviation_entry, 1],
    ['ORDER_CATALOG                  ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['TAPE_LIST                      ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$hidden_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$optional_parameter,
  0, 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [5, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$order_catalog = 1,
      p$tape_list = 2,
      p$status = 3;

    VAR
      pvt: array [1 .. 3] of clt$parameter_value;


    VAR
      disk_subproduct_indexer_p: ^rat$disk_subproduct_indexer,
      order_catalog_p: ^pft$path,
      order_catalog_ref_p: ^fst$file_reference,
      tape_list_p: ^rat$primary_tape,
      write_definition_needed_flag_p: ^boolean;


    status.normal := TRUE;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF rav$order_contents_count < rac$first_subproduct_entry THEN
      osp$set_status_abnormal ('RA', rae$no_subproducts_ordered, '', status);
      RETURN;
    IFEND;

    IF (rav$packing_list_header_p^.order_medium = rac$tape) AND
          (rav$tape_information.tape_type = 'UNKNOWN') THEN
      osp$set_status_abnormal ('RA', rae$tape_attributes_not_defined, '', status);
      RETURN;
    IFEND;

    RESET rav$creod_scratch_segment.sequence_p TO rav$creod_scratch_segment.reset_p;

    order_catalog_ref_p := pvt [p$order_catalog].value^.file_value;
    create_order_catalog (order_catalog_ref_p, rav$creod_scratch_segment, order_catalog_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF rav$packing_list_header_p^.order_medium = rac$tape THEN

      estimate_tape_packing_list_size (rav$packing_list_seq_p, rav$tape_information, rav$order_contents_count,
            rav$order_contents_list_p);

      sort_order_contents ('PRIORITY_AND_SIZE', rav$order_contents_count, rav$order_contents_list_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      assign_order_contents_to_tape (pvt [p$tape_list].value, rav$tape_information, rav$order_contents_list_p,
            tape_list_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      sort_order_contents ('POSITION_ASSIGNED', rav$order_contents_count, rav$order_contents_list_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      create_tape_subproduct_indexer (rav$order_contents_count, rav$order_contents_list_p,
            rav$tape_information, tape_list_p, rav$packing_list_header_p, rav$packing_list_seq_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      write_tape_order_data_file (rav$packing_list_header_p, rav$order_contents_list_p, rav$tape_information,
            tape_list_p, order_catalog_ref_p, status);

    ELSE { medium is disk }

      estimate_disk_packing_list_size (rav$packing_list_seq_p, rav$order_contents_count,
            rav$order_contents_list_p);

      assign_order_contents_to_disk (rav$order_contents_list_p, order_catalog_p, rav$packing_list_header_p,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      create_disk_subproduct_indexer (rav$order_contents_count, rav$order_contents_list_p,
            rav$packing_list_header_p, rav$packing_list_seq_p, disk_subproduct_indexer_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      write_disk_order_data_file (rav$packing_list_header_p, rav$order_contents_list_p,
            disk_subproduct_indexer_p, order_catalog_ref_p, status);

    IFEND;

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    write_packing_list (order_catalog_ref_p, rav$packing_list_seq_p, status);

    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;

  PROCEND rap$write_definition;

?? TITLE := 'add_volume_to_tape', EJECT ??

{ PURPOSE:
{   This procedure assigns an additional tape volume to the current tape.
{
{ DESIGN:
{   An additional volume record is added to the end of the current tape's
{   additional volume linked list.  The ADDITIONAL_VOL_P points to the last
{   additional volume added (if additional volumes already exist).
{
{   The tape is designated as full by setting the bytes assigned field
{   with the maximum usable bytes for the tape.
{
{ NOTES:
{   The first tape size in the tape information record's size field will be
{   the largest size defined.  This is the size we will use.
{

  PROCEDURE add_volume_to_tape
    (VAR tape_info: rat$tape_information;
     VAR tape_vsn: string (6);
     VAR vsn_list_p: ^rat$tape_vsn_list;
     VAR tape_p: ^rat$primary_tape;
     VAR additional_vol_p: ^rat$additional_volume;
     VAR status: ost$status);


    VAR
      new_additional_vol_p: ^rat$additional_volume;


    status.normal := TRUE;

    get_next_vsn (tape_vsn, vsn_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT new_additional_vol_p IN rav$creod_scratch_segment.sequence_p;
    IF new_additional_vol_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    new_additional_vol_p^.evsn := tape_vsn;
    new_additional_vol_p^.rvsn := tape_vsn;
    new_additional_vol_p^.size := tape_info.sizes [1];
    new_additional_vol_p^.bytes_assigned := tape_info.sizes [1].usable_bytes;
    new_additional_vol_p^.next_volume_p := NIL;

    IF tape_p^.next_volume_p = NIL THEN
      tape_p^.next_volume_p := new_additional_vol_p;
    ELSE
      additional_vol_p^.next_volume_p := new_additional_vol_p;
    IFEND;

    additional_vol_p := new_additional_vol_p;

    tape_info.number_of_tapes := tape_info.number_of_tapes + 1;

  PROCEND add_volume_to_tape;

?? TITLE := 'assign_order_contents_to_disk', EJECT ??

{ PURPOSE:
{   This procedure assigns the ordered subproducts and packing list to the
{   required disk file.
{
{ DESIGN:
{   The total bytes required for the order is calculated.  This value cannot
{   exceed the maximum bytes allowed for a file.
{
{   The backup catalog path is created.  The subproducts will be backed up to
{   this catalog when the order is written.  There is no special arranging
{   algorithm required, the subproducts will be backed up in the same sequence
{   as they were added to the order.
{
{ NOTES:
{

  PROCEDURE assign_order_contents_to_disk
    (    contents_list_p: ^rat$order_contents_list;
         order_catalog_p: ^pft$path;
     VAR packing_list_header_p: ^rat$packing_list_header;
     VAR status: ost$status);


    VAR
      backup_catalog_path: string (fsc$max_path_size),
      backup_catalog_name: ost$name,
      i: integer,
      length: integer,
      total_bytes: integer;


    status.normal := TRUE;

    total_bytes := 0;
    FOR i := 1 TO UPPERBOUND (contents_list_p^) DO
      total_bytes := total_bytes + contents_list_p^ [i].size;
    FOREND;

    IF total_bytes > amc$file_byte_limit THEN
      osp$set_status_abnormal ('RA', rae$exceeded_max_size_disk_ordr, '', status);
      RETURN;
    IFEND;

    pmp$get_unique_name (backup_catalog_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (backup_catalog_path, length, ':', order_catalog_p^
          [1] (1, clp$trimmed_string_size (order_catalog_p^ [1])), '.', order_catalog_p^ [2]
          (1, clp$trimmed_string_size (order_catalog_p^ [2])), '.', backup_catalog_name);

    packing_list_header_p^.disk_backup_catalog (1, * ) := backup_catalog_path (1, length);
    packing_list_header_p^.disk_path (1, * ) := '';

  PROCEND assign_order_contents_to_disk;

?? TITLE := 'assign_order_contents_to_tape', EJECT ??

{ PURPOSE:
{   This procedure assigns the ordered subproducts and packing list to the
{   required tapes.  The order contents list is returned with the position
{   assigned for each subproduct set.  Also a list of tapes is returned.
{
{ DESIGN:
{   The subproduct tape assignment algorithm uses a best fit approach.
{   The order contents list has previously been sorted by priority and
{   size in decending order.  Looping through the contents list the
{   contents items are added to a tape until it is full or all contents
{   items have been assigned.  Additional tapes are added as required.
{
{     Assumptions and Requirements
{
{     1.  Minimize the number of tapes needed.  The ideal or theoretical
{         number of tapes is the number of tapes required when the
{         subproducts are backed up together as one multi-volume set.
{
{     2.  In general, tapes will be independent backups that can be
{         accessed asynchronously.  The only exception is when a subproduct
{         is too large to fit on a single tape.  Then the tape will become
{         multi-volume, with the additional tape volumes containing only
{         the subproduct in question.
{
{     3.  A subproduct will only be allowed to span across tapes when the
{         subproduct is larger than one tape.
{
{     4.  Files larger than one tape are not an issue since subproducts
{         will be allowed to be larger than one tape.
{
{     5.  When dealing with a subproduct larger than one tape the following
{         rules apply:
{
{           A tape can only be assigned one subproduct belonging to the
{           "too large" category.  A tape assigned a subproduct of this type
{           then is designated as the 1st tape of a multi-volume set.
{           (This means a separate multi-volume set will be defined for
{           each subproduct of type "too large".)
{
{           The subproduct is assigned to as many additional tape volumes
{           as the subproduct can completely fill.  Once the amount left
{           to be assigned is less than a single tape the remainder is
{           assigned to the 1st tape of the multi-volume set.
{
{           The subproduct causing the need for multi-volumes is the only
{           subproduct that can be assigned to the additional tapes of the
{           multi-volume set.
{
{           Additional subproducts are assigned to the 1st tape until the
{           tape is "completed".
{
{           The subproduct of type "too large" must be the last subproduct
{           backed up to the 1st tape of the multi-volume set.  This is
{           accomplished by setting the assigned field (of the "too large"
{           subproduct's contents record) to -1.  Once all the other
{           subproducts have had a chance to be assigned to the tape, the
{           assigned field will be set to the next available value.
{
{     6.  The largest tape size defined will be used in the tape
{         assignment algorithm.  Adjustments to smaller tape sizes (if
{         allowed) will be made after the assignments have been made.  When
{         adjusting a multi-volume tape place the smallest tape as the last
{         tape in the volume.
{
{ NOTES:
{   The tape sizes are assumed to be sorted from largest to smallest.
{   The first tape size is used during the assignment.
{

  PROCEDURE assign_order_contents_to_tape
    (    tape_list_parameter_p: ^clt$data_value;
     VAR tape_info: rat$tape_information;
     VAR contents_list_p: ^rat$order_contents_list;
     VAR tape_list_p: ^rat$primary_tape;
     VAR status: ost$status);


    CONST
      assigned_last_to_tape = -1;

    VAR
      additional_volume_p: ^rat$additional_volume,
      contents_assigned: integer,
      contents_index: integer,
      bytes_per_tape_gap: integer,
      contents_item_tape_size: integer,
      free_bytes: integer,
      i: integer,
      j: integer,
      max_bytes_per_tape: integer,
      multi_volume: boolean,
      tape_p: ^rat$primary_tape,
      vsn_list_p: ^rat$tape_vsn_list,
      tape_vsn: string (6);


    status.normal := TRUE;

    initialize_tape_assignment (tape_list_parameter_p, contents_list_p, tape_info, vsn_list_p, tape_list_p,
          tape_p, tape_vsn, max_bytes_per_tape, bytes_per_tape_gap, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    contents_assigned := 0;

    WHILE contents_assigned < UPPERBOUND (contents_list_p^) DO

{ One interation will complete the assignment to one tape.

      start_assignment_to_tape (contents_assigned, tape_info, tape_list_p, tape_p, tape_vsn, vsn_list_p,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      free_bytes := max_bytes_per_tape;
      multi_volume := FALSE;

{
{   Search the contents list to find subproducts that have not been assigned to a tape.
{

      FOR i := 1 TO UPPERBOUND (contents_list_p^) DO

        IF contents_list_p^ [i].position_assigned = rac$not_assigned THEN

          contents_item_tape_size := contents_list_p^ [i].size + bytes_per_tape_gap;

{
{   If the size of the subproduct is smaller than the number of bytes left on the tape,
{   assign the subproduct to the tape.
{

          IF contents_item_tape_size <= free_bytes THEN

            contents_assigned := contents_assigned + 1;

{
{   Indicate the position that the subproduct will have on the tape by setting
{   the position assigned to the number of contents that have been assigned.
{

            contents_list_p^ [i].position_assigned := contents_assigned;
            free_bytes := free_bytes - contents_item_tape_size;

          ELSEIF (multi_volume = FALSE) AND (contents_item_tape_size > max_bytes_per_tape) THEN

{
{   Determine if part of the multi volume subproduct can be assigned to the present tape vsn.
{

            IF (contents_item_tape_size MOD max_bytes_per_tape) <= free_bytes THEN

              multi_volume := TRUE;
              contents_list_p^ [i].position_assigned := assigned_last_to_tape;
              free_bytes := free_bytes - (contents_item_tape_size MOD max_bytes_per_tape);
              contents_index := i;

              FOR j := 1 TO (contents_item_tape_size DIV max_bytes_per_tape) DO
                add_volume_to_tape (tape_info, tape_vsn, vsn_list_p, tape_p, additional_volume_p, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              FOREND;

            IFEND;

          IFEND;

        IFEND;

      FOREND;

      IF multi_volume = TRUE THEN
        contents_assigned := contents_assigned + 1;
        contents_list_p^ [contents_index].position_assigned := contents_assigned;
        tape_info.number_of_multi_vol_sets := tape_info.number_of_multi_vol_sets + 1;
      IFEND;
      end_assignment_to_tape (contents_assigned, free_bytes, tape_info, tape_p, additional_volume_p);

    WHILEND;

  PROCEND assign_order_contents_to_tape;

?? TITLE := 'bytes_to_feet', EJECT ??

{ PURPOSE:
{   This function converts bytes to feet.
{
{ DESIGN:
{   The density representation of bytes per inch is required in the conversion.
{
{ NOTES:
{
{

  FUNCTION bytes_to_feet
    (    bytes: integer;
         density: ost$name): integer;


    IF density = rac$mt9$6250 THEN
      bytes_to_feet := bytes DIV bytes_per_foot_mt9$6250;
    ELSEIF density = rac$mt9$1600 THEN
      bytes_to_feet := bytes DIV bytes_per_foot_mt9$1600;
    ELSE { density = rac$mt18$38000 }
      bytes_to_feet := bytes DIV bytes_per_foot_mt18$38000;
    IFEND;

  FUNCEND bytes_to_feet;

?? TITLE := 'create_disk_subproduct_indexer', EJECT ??

{ PURPOSE:
{   This procedure creates the disk_subproduct_indexer within the packing list.
{
{ DESIGN:
{   The disk subproduct indexer array is created 1 size less then the order
{   contents list (the item in the contents list for the packing list is not
{   used in the subproduct indexer array).  The indexer is created at the end of
{   the packing list sequence.  The packing list header fields are set to
{   "recognize" the disk subproduct indexer.  Finally, the fields of the disk
{   subproduct indexer are set from the corresponding order contents list
{   fields.
{
{ NOTES:
{   The assumption is made that the current position pointer in the packing list
{   is at end of sequence.
{
{   Also that the packing list should be the first item in the order contents
{   list.  The "[i - 1]" indexing assumes this fact.
{

  PROCEDURE create_disk_subproduct_indexer
    (    contents_count: rat$subproduct_count;
         contents_list_p: ^rat$order_contents_list;
     VAR packing_list_header_p: ^rat$packing_list_header;
     VAR packing_list_seq_p: ^rat$packing_list_sequence;
     VAR disk_subproduct_indexer_p: ^rat$disk_subproduct_indexer;
     VAR status: ost$status);


    VAR
      backup_file_name: ost$name,
      i: integer;


    status.normal := TRUE;

    NEXT disk_subproduct_indexer_p: [1 .. (contents_count - 1)] IN packing_list_seq_p;
    IF disk_subproduct_indexer_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    packing_list_header_p^.subproduct_count := contents_count - 1;
    packing_list_header_p^.disk_subproduct_indexer_p := #REL (disk_subproduct_indexer_p, packing_list_seq_p^);

    FOR i := rac$first_subproduct_entry TO contents_count DO

      pmp$get_unique_name (backup_file_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      disk_subproduct_indexer_p^ [i - 1].subproduct_seq_length := contents_list_p^ [i].subproduct_seq_length;
      disk_subproduct_indexer_p^ [i - 1].subproduct_seq_p := contents_list_p^ [i].subproduct_seq_p;
      disk_subproduct_indexer_p^ [i - 1].backup_file := backup_file_name;
      disk_subproduct_indexer_p^ [i - 1].auto_install := contents_list_p^ [i].auto_install;
    FOREND;

  PROCEND create_disk_subproduct_indexer;

?? TITLE := 'create_order_catalog', EJECT ??

{ PURPOSE:
{   This procedure creates the order catalog.  In so doing, the order catalog is
{   verified to be non-exsistent, and the user is verified to have the necessary
{   privileges to create and write in this catalog.
{
{ DESIGN:
{   The order catalog path was specified as an input parameter of
{   WRITE_DEFINITION.  The input value is formated as a path reference string
{   and a path container array.  The path container array is required to
{   create the catalog and the former is passed back for further processing.
{   If the order catalog exists or the user does not have the necessary write
{   priveleges, a bad status will be returned.
{
{ NOTES:
{
{

  PROCEDURE create_order_catalog
    (    order_catalog_ref_p: ^fst$file_reference;
     VAR scratch_segment: rat$scratch_segment;
     VAR order_catalog_p: ^pft$path;
     VAR status: ost$status);


    status.normal := TRUE;

    rap$get_file_path (order_catalog_ref_p, scratch_segment.sequence_p, order_catalog_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pfp$define_catalog (order_catalog_p^, status);

  PROCEND create_order_catalog;

?? TITLE := 'create_scl_primary_vsn_list', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to convert the list of primary vsns to an
{   SCL list.
{
{ DESIGN:
{   The primary vsns are located by traversing the tape list along the next tape
{   pointers.  The RVSN is used as the vsn value.
{
{ NOTES:
{   The assumption is made that the tape list has at least one entry.
{

  PROCEDURE create_scl_primary_vsn_list
    (    tape_list_p: ^rat$primary_tape;
     VAR primary_vsns: rat$string);


    VAR
      length: integer,
      tape_p: ^rat$primary_tape,
      vsns: string (osc$max_string_size);


    STRINGREP (vsns, length, '(''', tape_list_p^.rvsn (1, clp$trimmed_string_size (tape_list_p^.rvsn)), '''');
    tape_p := tape_list_p^.next_tape_p;

    WHILE tape_p <> NIL DO
      STRINGREP (vsns, length, vsns (1, length), ',''', tape_p^.
            rvsn (1, clp$trimmed_string_size (tape_p^.rvsn)), '''');
      tape_p := tape_p^.next_tape_p;
    WHILEND;

    STRINGREP (primary_vsns.value, primary_vsns.length, vsns (1, length), ')');

  PROCEND create_scl_primary_vsn_list;

?? TITLE := 'create_scl_tape_data_lists', EJECT ??

{ PURPOSE:
{   This procedure creates the SCL tape data lists for the order data file.
{
{ DESIGN:
{   The tape data lists are created by following the primary tape's additional
{   volume pointers along the linked list (if any).
{
{   The length of measure used during the assignment algorithm is bytes.  This
{   is converted to feet for the SCL tape data lists.
{
{ NOTES:
{
{

  PROCEDURE create_scl_tape_data_lists
    (    tape_p: ^rat$primary_tape;
         density: ost$name;
     VAR assigned: rat$string;
     VAR evsn: rat$string;
     VAR rvsn: rat$string;
     VAR size: rat$string;
     VAR usable: rat$string);


    VAR
      additional_vol_p: ^rat$additional_volume;


    STRINGREP (evsn.value, evsn.length, '(''', tape_p^.evsn (1, clp$trimmed_string_size (tape_p^.evsn)),
          '''');
    STRINGREP (rvsn.value, rvsn.length, '(''', tape_p^.rvsn (1, clp$trimmed_string_size (tape_p^.rvsn)),
          '''');
    STRINGREP (size.value, size.length, '(', tape_p^.size.feet);
    STRINGREP (usable.value, usable.length, '(', bytes_to_feet (tape_p^.size.usable_bytes, density));
    STRINGREP (assigned.value, assigned.length, '(', bytes_to_feet (tape_p^.bytes_assigned, density));

    additional_vol_p := tape_p^.next_volume_p;
    WHILE additional_vol_p <> NIL DO
      STRINGREP (evsn.value, evsn.length, evsn.value (1, evsn.length),
            ', ''', additional_vol_p^.evsn (1, clp$trimmed_string_size (additional_vol_p^.evsn)), '''');
      STRINGREP (rvsn.value, rvsn.length, rvsn.value (1, rvsn.length),
            ', ''', additional_vol_p^.rvsn (1, clp$trimmed_string_size (additional_vol_p^.rvsn)), '''');
      STRINGREP (size.value, size.length, size.value (1, size.length), ', ', additional_vol_p^.size.feet);
      STRINGREP (usable.value, usable.length, usable.value (1, usable.length),
            ', ', bytes_to_feet (additional_vol_p^.size.usable_bytes, density));
      STRINGREP (assigned.value, assigned.length, assigned.value (1, assigned.length),
            ', ', bytes_to_feet (additional_vol_p^.bytes_assigned, density));

      additional_vol_p := additional_vol_p^.next_volume_p;
    WHILEND;

    STRINGREP (evsn.value, evsn.length, evsn.value (1, evsn.length), ')');
    STRINGREP (rvsn.value, rvsn.length, rvsn.value (1, rvsn.length), ')');
    STRINGREP (size.value, size.length, size.value (1, size.length), ')');
    STRINGREP (usable.value, usable.length, usable.value (1, usable.length), ')');
    STRINGREP (assigned.value, assigned.length, assigned.value (1, assigned.length), ')');

  PROCEND create_scl_tape_data_lists;

?? TITLE := 'create_tape_subproduct_indexer', EJECT ??

{ PURPOSE:
{   This procedure creates the tape_subproduct_indexer and the tape_vsns list at
{   the current end of the packing list sequence.
{
{ DESIGN:
{   The tape_subproduct_indexer array is created 1 size less then the order
{   contents list (the item in the contents list for the packing list is not
{   used in the subproduct indexer array).  The indexer is created at the end of
{   the packing list sequence.  The packing list header fields are set to
{   "recognize" the tape_subproduct_indexer.
{
{   The tape_vsns list is create at the current end of the packing list.  This
{   is indexed by the tape_subproduct_indexer and contains the RVSN and EVSN
{   strings for all the tapes.  There are 2 parts to the list:  First, an array
{   1 to m of vsn records (where m is the number of primary tapes).  Second,
{   each (if any) additional volume required by the primary tapes is added to
{   the end of the packing list sequence.  Additional_volume_p connects them
{   with their primary tape record.
{
{   The tape list provides the information for creating the tape_vsn section.
{
{   While processing each tape list item the subproducts that are assigned to
{   that tape have their tape_subproduct_indexer entries initialized.  The
{   fields of the tape_subproduct_indexer are set from the corresponding order
{   contents list fields.
{
{ NOTES:
{   The assumption is made that the current position pointer in the packing list
{   is at end of sequence.
{
{   Also that the packing list should be the first item in the order contents
{   list.  The "[i - 1]" indexing assumes this fact.
{

  PROCEDURE create_tape_subproduct_indexer
    (    contents_count: rat$subproduct_count;
         contents_list_p: ^rat$order_contents_list;
         tape_info: rat$tape_information;
         tape_list_p: ^rat$primary_tape;
     VAR packing_list_header_p: ^rat$packing_list_header;
     VAR packing_list_seq_p: ^rat$packing_list_sequence;
     VAR status: ost$status);


    VAR
      additional_volume_p: ^rat$additional_volume,
      additional_vol_vsn_p: ^rat$tape_vsn,
      assignment_range_lowerbound: integer,
      file_sequence_number: integer,
      i: integer,
      index: integer,
      tape_p: ^rat$primary_tape,
      tape_subproduct_indexer_p: ^rat$tape_subproduct_indexer,
      tape_vsn_list_p: ^rat$tape_vsns,
      tape_vsn_p: ^rat$tape_vsn;


    status.normal := TRUE;

    NEXT tape_subproduct_indexer_p: [1 .. (contents_count - 1)] IN packing_list_seq_p;
    IF tape_subproduct_indexer_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    packing_list_header_p^.subproduct_count := contents_count - 1;
    packing_list_header_p^.tape_subproduct_indexer_p := #REL (tape_subproduct_indexer_p, packing_list_seq_p^);

    NEXT tape_vsn_list_p: [1 .. tape_info.number_of_primary_tapes] IN packing_list_seq_p;
    IF tape_vsn_list_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    packing_list_header_p^.primary_tape_count := tape_info.number_of_primary_tapes;
    packing_list_header_p^.tape_vsns_p := #REL (tape_vsn_list_p, packing_list_seq_p^);

    tape_p := tape_list_p;

    FOR index := 1 TO packing_list_header_p^.primary_tape_count DO
      tape_vsn_list_p^ [index].recorded_vsn := tape_p^.rvsn;
      tape_vsn_list_p^ [index].external_vsn := tape_p^.evsn;
      tape_vsn_p := ^tape_vsn_list_p^ [index];
      additional_volume_p := tape_p^.next_volume_p;
      WHILE additional_volume_p <> NIL DO
        NEXT additional_vol_vsn_p IN packing_list_seq_p;
        IF additional_vol_vsn_p = NIL THEN
          osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
          RETURN;
        IFEND;

        additional_vol_vsn_p^.recorded_vsn := additional_volume_p^.rvsn;
        additional_vol_vsn_p^.external_vsn := additional_volume_p^.evsn;
        tape_vsn_p^.additional_volume_p := #REL (additional_vol_vsn_p, packing_list_seq_p^);
        tape_vsn_p := additional_vol_vsn_p;
        additional_volume_p := additional_volume_p^.next_volume_p;
      WHILEND;

      tape_vsn_p^.additional_volume_p := NIL;

      IF tape_p^.assignment_range_lowerbound = 1 THEN

{ Adjust lowerbound and file sequence number to skip over the packing list.

        assignment_range_lowerbound := rac$first_subproduct_entry;
        file_sequence_number := rac$first_subproduct_entry;
      ELSE
        assignment_range_lowerbound := tape_p^.assignment_range_lowerbound;
        file_sequence_number := 1;
      IFEND;

      FOR i := assignment_range_lowerbound TO tape_p^.assignment_range_upperbound DO
        tape_subproduct_indexer_p^ [i - 1].subproduct_seq_length := contents_list_p^ [i].
              subproduct_seq_length;
        tape_subproduct_indexer_p^ [i - 1].subproduct_seq_p := contents_list_p^ [i].subproduct_seq_p;
        tape_subproduct_indexer_p^ [i - 1].primary_tape_vsn := index;
        tape_subproduct_indexer_p^ [i - 1].tape_file_sequence_number := file_sequence_number;
        tape_subproduct_indexer_p^ [i - 1].auto_install := contents_list_p^ [i].auto_install;
        file_sequence_number := file_sequence_number + 1;
      FOREND;

      tape_p := tape_p^.next_tape_p;
    FOREND;

  PROCEND create_tape_subproduct_indexer;

?? TITLE := 'end_assignment_to_tape', EJECT ??

{ PURPOSE:
{   This procedure is called when a tape or multi volume tape has been
{   assigned as many subproducts as it can contain.
{
{ DESIGN:
{   The tape size is adjusted down to the smallest tape that will
{   hold the bytes assigned.  When the tape is multi-volume the
{   size adjustment is made to the last tape of the volume set.
{
{   When the tape is multi-volume the bytes assigned field for the last
{   volume and the first are swapped (this reflects the actual byte
{   dispersal when the tapes are written).  This swap is done regardless
{   of whether or not there was a size adjustment.
{
{ NOTES:
{   The first tape size on list is the largest.  The tape size array
{   is ordered by size from largest to smallest.
{   The additional_volume pointer is pointing to the last volume of the
{   tape (if multi-volume).
{

  PROCEDURE end_assignment_to_tape
    (    assigned: integer;
         free_bytes: integer;
         tape_info: rat$tape_information;
     VAR tape_p: ^rat$primary_tape;
     VAR additional_volume_p: ^rat$additional_volume);


    VAR
      bytes_assigned: integer,
      i: integer;


    tape_p^.assignment_range_upperbound := assigned;
    tape_p^.bytes_assigned := tape_p^.size.usable_bytes - free_bytes;

  /adjust_tape_size/
    FOR i := UPPERBOUND (tape_info.sizes) DOWNTO 2 DO
      IF tape_p^.bytes_assigned <= tape_info.sizes [i].usable_bytes THEN
        IF tape_p^.next_volume_p = NIL THEN
          tape_p^.size := tape_info.sizes [i];
        ELSE
          additional_volume_p^.size := tape_info.sizes [i];
        IFEND;
        EXIT /adjust_tape_size/;
      IFEND;
    FOREND /adjust_tape_size/;

    IF tape_p^.next_volume_p <> NIL THEN
      bytes_assigned := additional_volume_p^.bytes_assigned;
      additional_volume_p^.bytes_assigned := tape_p^.bytes_assigned;
      tape_p^.bytes_assigned := bytes_assigned;
    IFEND;

  PROCEND end_assignment_to_tape;

?? TITLE := 'estimate_disk_packing_list_size', EJECT ??

{ PURPOSE:
{   This procedure estimates the size required for the packing list
{   when the order medium is defined for disk.
{
{ DESIGN:
{   The packing list currently contains the sequence_descriptor,
{   packing_list_header, and the SIF's for all the subproducts ordered.
{   The size for the disk_subproduct_indexer is estimated and added to
{   the current packing list size.  The estimation for the
{   disk_subproduct_indexer is based on the number of subproducts
{   ordered * the size of the index record.
{
{ NOTES:
{   Contents count includes the packing list.  This is adjusted
{   when computing the packing_list size.
{

  PROCEDURE estimate_disk_packing_list_size
    (    packing_list_seq_p: ^rat$packing_list_sequence;
         contents_count: rat$subproduct_count;
     VAR contents_list_p: ^rat$order_contents_list);


    VAR
      subproduct_indexer_size: integer;


    subproduct_indexer_size := (#SIZE (rat$disk_subproduct_index) * contents_count - 1);

    contents_list_p^ [rac$packing_list_entry].size := i#current_sequence_position (packing_list_seq_p) +
          subproduct_indexer_size;

  PROCEND estimate_disk_packing_list_size;

?? TITLE := 'estimate_tape_packing_list_size', EJECT ??

{ PURPOSE:
{   This procedure estimates the size required for the packing list when the
{   order medium is defined as tape.
{
{ DESIGN:
{   The packing list currently contains the sequence_descriptor,
{   packing_list_header, and the SIF's for all the subproducts ordered.  The
{   sizes for the tape_subproduct_indexer and tape_vsns are estimated and
{   added to the current packing list size.  The estimation for the
{   tape_subproduct_indexer is based on the number of subproducts ordered *
{   the size of the index record.  The estimation for the tape_vsns is based
{   on the size of the tape vsn record * a general guess factor for the
{   number of tapes at the specified tape density.  (The general guess is
{   assuming an order of 400 mega bytes and 2400 foot tapes for 9 track and
{   540 foot tapes for 18 track.)
{
{ NOTES:
{   Contents count includes the packing list.  This is not adjusted when
{   computing the packing_list size.  It is felt that this provides a small
{   cushion for error in the size estimation.
{

  PROCEDURE estimate_tape_packing_list_size
    (    packing_list_seq_p: ^rat$packing_list_sequence;
         tape_info: rat$tape_information;
         contents_count: rat$subproduct_count;
     VAR contents_list_p: ^rat$order_contents_list);


    CONST
      tape_factor_mt9$1600 = 12,
      tape_factor_mt9$6250 = 4,
      tape_factor_mt18$38000 = 2;

    VAR
      subproduct_indexer_size: integer;


    IF tape_info.tape_type = rac$mt9$6250 THEN
      subproduct_indexer_size := (#SIZE (rat$tape_subproduct_index) * contents_count) +
            (#SIZE (rat$tape_vsn) * tape_factor_mt9$6250);
    ELSEIF tape_info.tape_type = rac$mt9$1600 THEN
      subproduct_indexer_size := (#SIZE (rat$tape_subproduct_index) * contents_count) +
            (#SIZE (rat$tape_vsn) * tape_factor_mt9$1600);
    ELSE {tape_type = rac$mt18$38000}
      subproduct_indexer_size := (#SIZE (rat$tape_subproduct_index) * contents_count) +
            (#SIZE (rat$tape_vsn) * tape_factor_mt18$38000);
    IFEND;

    contents_list_p^ [rac$packing_list_entry].size := i#current_sequence_position (packing_list_seq_p) +
          subproduct_indexer_size;

  PROCEND estimate_tape_packing_list_size;

?? TITLE := 'get_next_vsn', EJECT ??

{ PURPOSE:
{   This procedure returns the next available vsn.  The next available
{   vsn is based on the vsn passed in.  If an empty string is passed in
{   the vsn seed is returned.
{
{ DESIGN:
{   The next vsn is generated by incrementing the last character of
{   the vsn string passed in.  Incremental range is the uppercase
{   alpha ('A'..'Z') and numbers ('0'..'9').  This means there is
{   a maximum of 36 unique tape vsns.  When this limit is reached
{   an error is returned.
{
{ NOTES:
{   This assumes the vsn is uppercase alpha or numbers.
{

  PROCEDURE get_next_vsn
    (VAR vsn: string (6);
     VAR vsn_list_p: ^rat$tape_vsn_list;
     VAR status: ost$status);


    CONST
      max_number_of_tapes = 36;

    VAR
      character: string (1),
      ignore_length: integer,
      length: 0 .. 6,
      max_tapes_str: string (3);


    IF vsn_list_p <> NIL THEN
      vsn := vsn_list_p^.vsn;
      vsn_list_p := vsn_list_p^.next_vsn_p;
    ELSEIF vsn = '' THEN
      vsn := rav$tape_information.vsn_seed;
    ELSE
      length := clp$trimmed_string_size (vsn);

      IF vsn (length, 1) = '9' THEN {switch to alpha}
        character := 'A';
      ELSEIF vsn (length, 1) = 'Z' THEN {switch to numbers}
        character := '0';
      ELSE
        character := $CHAR ($INTEGER (vsn (length, 1)) + 1);
      IFEND;

      vsn (length, 1) := character;

      IF vsn = rav$tape_information.vsn_seed THEN
        STRINGREP (max_tapes_str, ignore_length, max_number_of_tapes);
        osp$set_status_abnormal ('RA', rae$exceeded_max_tapes_allowed, max_tapes_str, status);
        RETURN;
      IFEND;
    IFEND;

  PROCEND get_next_vsn;

?? TITLE := 'initialize_tape_assignment', EJECT ??

{ PURPOSE:
{   This procedure initializes the variables required by the tape
{   assignment algorithm.
{
{ DESIGN:
{   The usable length in bytes for each tape size is calculated.
{   This is determined by the percent usable value and the tape
{   density.  The usable bytes for the largest tape size becomes the
{   maximum bytes allowed.
{
{   The theoretical number of tapes is calculated for statistical
{   comparision (by others) with the actual tapes required.
{   This value is the number of tapes required when the
{   subproducts are backed up together as one multi-volume set.
{   This is calculated by adding up all the sizes of the order contents
{   and adding the size of a tape file gap for each content item (since
{   each content item will be a discrete backup file on the tape).
{   This is then divided by the maximum bytes for the largest tape.
{   One tape is added to this value to account for a reminder lost
{   using integer division.  Example:
{                            Total bytes in all subproducts = 9,000,000
{                            Total bytes per tape = 2,000,000
{                            9,000,000 DIV 2,000,000 = 4
{                            But 4 tapes will only hold 8,000,000 bytes
{                            So the number of tapes must be 4 + 1 = 5.
{ NOTES:
{   The first tape size on list is the largest.
{
{

  PROCEDURE initialize_tape_assignment
    (    tape_list_parameter_p: ^clt$data_value;
         contents_list_p: ^rat$order_contents_list;
     VAR tape_info: rat$tape_information;
     VAR vsn_list_p: ^rat$tape_vsn_list;
     VAR tape_list_p: ^rat$primary_tape;
     VAR tape_p: ^rat$primary_tape;
     VAR tape_vsn: string (6);
     VAR max_bytes_per_tape: integer;
     VAR bytes_per_tape_gap: integer;
     VAR status: ost$status);


    VAR
      current_tape_p: ^clt$data_value,
      i: integer,
      new_vsn_p: ^rat$tape_vsn_list,
      number_of_tapes_theoretical: integer,
      total_bytes: integer,
      usable_feet: integer,
      vsn_p: ^rat$tape_vsn_list;


    FOR i := 1 TO UPPERBOUND (tape_info.sizes) DO

      IF tape_info.sizes [i].feet <> 0 THEN
        usable_feet := (tape_info.sizes [i].feet * tape_info.percent_usable) DIV 100;

        IF tape_info.tape_type = rac$mt9$6250 THEN
          tape_info.sizes [i].usable_bytes := usable_feet * bytes_per_foot_mt9$6250;
        ELSEIF tape_info.tape_type = rac$mt9$1600 THEN
          tape_info.sizes [i].usable_bytes := usable_feet * bytes_per_foot_mt9$1600;
        ELSE { tape type = rac$mt18$38000 }
          tape_info.sizes [i].usable_bytes := usable_feet * bytes_per_foot_mt18$38000;
        IFEND;

      IFEND;

    FOREND;

    max_bytes_per_tape := tape_info.sizes [1].usable_bytes;

    IF tape_info.tape_type = rac$mt9$6250 THEN
      bytes_per_tape_gap := bytes_per_tape_gap_mt9$6260;
    ELSEIF tape_info.tape_type = rac$mt9$1600 THEN
      bytes_per_tape_gap := bytes_per_tape_gap_mt9$1600;
    ELSE { tape type = rac$mt18$38000 }
      bytes_per_tape_gap := bytes_per_tape_gap_mt18$38000;
    IFEND;

    total_bytes := 0;
    FOR i := 1 TO UPPERBOUND (contents_list_p^) DO
      total_bytes := total_bytes + contents_list_p^ [i].size + bytes_per_tape_gap;
    FOREND;

    number_of_tapes_theoretical := total_bytes DIV max_bytes_per_tape + 1;

    tape_info.number_of_tapes := 0;
    tape_info.number_of_primary_tapes := 0;
    tape_info.number_of_multi_vol_sets := 0;
    tape_info.number_of_tapes_theoretical := number_of_tapes_theoretical;

    tape_list_p := NIL;
    tape_vsn := '';
    vsn_list_p := NIL;

    current_tape_p := tape_list_parameter_p;
    WHILE current_tape_p <> NIL DO

      NEXT new_vsn_p IN rav$creod_scratch_segment.sequence_p;
      IF new_vsn_p = NIL THEN
        osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
        RETURN;
      IFEND;

      new_vsn_p^.vsn := current_tape_p^.element_value^.name_value;
      new_vsn_p^.next_vsn_p := NIL;

      IF vsn_list_p = NIL THEN
        vsn_list_p := new_vsn_p;
      ELSE
        vsn_p^.next_vsn_p := new_vsn_p;
      IFEND;
      vsn_p := new_vsn_p;

      current_tape_p := current_tape_p^.link;

    WHILEND;

  PROCEND initialize_tape_assignment;

?? TITLE := 'sort_order_contents', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to sort the order contents list by
{   the specified keys (fields).
{
{ DESIGN:
{   The sorting is performed by the standard NOS/VE Sort/Merge interfaces.
{   The sort_key parameter defines the type of sort that is performed.
{   The supported sorts are:
{
{     1. Sort by priority and size fields.  This sort is done prior to
{        the assignment of the contents list to tape.  The tape assignment
{        algorithm requires the contents list to be sorted in this way.
{
{     2. Sort by position assigned.  Once the contents has been assigned
{        this sort puts the contents list into the correct assignment order
{        for writing the order data file and packing list's
{        tape subproduct_indexer.
{
{   The contents list is rewritten to a new location within the scratch
{   segment.  The pointer to the contents list is reset to point to the
{   new (sorted) contents list.
{
{ NOTES:
{   The result_array is used by the sorting interfaces to return status
{   information about the sort.  At this time, this information is being
{   ignored.
{

  PROCEDURE sort_order_contents
    (    sort_key: string ( * <= osc$max_name_size);
         contents_count: rat$subproduct_count;
     VAR contents_list_p: ^rat$order_contents_list;
     VAR status: ost$status);


    VAR
      new_contents_list_p: ^rat$order_contents_list,
      order_catalog_p: ^pft$path,
      result_array: smt$info_array;


    status.normal := TRUE;
    result_array [1] := 0; {Number of result elements returned in this array.}

    NEXT new_contents_list_p: [1 .. contents_count] IN rav$creod_scratch_segment.sequence_p;
    IF new_contents_list_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    smp$begin_sort_specification (result_array, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    smp$from_memory_area (#LOC (contents_list_p^), 'FIXED', #SIZE (rat$order_contents), contents_count,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    smp$to_memory_area (#LOC (new_contents_list_p^), 'FIXED', #SIZE (rat$order_contents), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF sort_key = 'PRIORITY_AND_SIZE' THEN

      smp$key (1, #SIZE (rat$subproduct_priority), 'INTEGER', 'D', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      smp$key ((1 + #SIZE (rat$subproduct_priority)), #SIZE (rat$subproduct_size), 'INTEGER', 'D', status);

    ELSE { sort_key = 'POSITION_ASSIGNED' }

      smp$key ((1 + #SIZE (rat$subproduct_priority) + #SIZE (rat$subproduct_size)),
            #SIZE (rat$position_assigned), 'INTEGER', 'A', status);

    IFEND;

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    smp$end_specification (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    contents_list_p := new_contents_list_p;

  PROCEND sort_order_contents;

?? TITLE := 'start_assignment_to_tape', EJECT ??

{ PURPOSE:
{   This procedure adds a new primary tape to the tape list.
{   This tape becomes the current tape of assignment.
{
{ DESIGN:
{   A new tape record is added to the tape list.  The tape list
{   is a linked list of tape records.  There is one record per
{   primary tape.  If the tape is required to be multi-volume
{   additional volume records are linked to the tape record
{   (this is done in ADD_VOLUME_TO_TAPE).
{
{   The assignment_range_lowerbound (and assignment_range_upperbound)
{   will index into the order contents list after it has been sorted
{   by priority assigned (this is after assignment is complete).
{   This index range gives us the contents items assigned to this tape.
{
{ NOTES:
{   The first tape size in the tape information record's size field
{   will be the largest size defined.  This is the size we will use.
{

  PROCEDURE start_assignment_to_tape
    (    assigned: integer;
     VAR tape_info: rat$tape_information;
     VAR tape_list_p: ^rat$primary_tape;
     VAR tape_p: ^rat$primary_tape;
     VAR tape_vsn: string (6);
     VAR vsn_list_p: ^rat$tape_vsn_list;
     VAR status: ost$status);


    VAR
      new_tape_p: ^rat$primary_tape;


    status.normal := TRUE;

    get_next_vsn (tape_vsn, vsn_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT new_tape_p IN rav$creod_scratch_segment.sequence_p;
    IF new_tape_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    new_tape_p^.evsn := tape_vsn;
    new_tape_p^.rvsn := tape_vsn;
    new_tape_p^.size := tape_info.sizes [1];
    new_tape_p^.bytes_assigned := 0;
    new_tape_p^.assignment_range_lowerbound := assigned + 1;
    new_tape_p^.assignment_range_upperbound := 0;
    new_tape_p^.next_volume_p := NIL;
    new_tape_p^.next_tape_p := NIL;

    IF tape_list_p = NIL THEN
      tape_list_p := new_tape_p;
    ELSE
      tape_p^.next_tape_p := new_tape_p;
    IFEND;
    tape_p := new_tape_p;

    tape_info.number_of_tapes := tape_info.number_of_tapes + 1;
    tape_info.number_of_primary_tapes := tape_info.number_of_primary_tapes + 1;

  PROCEND start_assignment_to_tape;

?? TITLE := 'write_disk_order_data_file', EJECT ??

{ PURPOSE:
{   This procedure writes the order data file into the order catalog for disk
{   orders.
{
{ DESIGN:
{   The order data file contains information used in the writing of the order by
{   WRITE_ORDER.  The order data file is a text file that when "included" will
{   create SCL variables containing order data.
{
{   The file has two parts; a SCL variable declarations part and a SCL variable
{   initializations part.
{
{ NOTES:
{
{

  PROCEDURE write_disk_order_data_file
    (    packing_list_header_p: ^rat$packing_list_header;
         contents_list_p: ^rat$order_contents_list;
         disk_subproduct_indexer_p: ^rat$disk_subproduct_indexer;
         order_catalog_ref_p: ^fst$file_reference;
     VAR status: ost$status);


    VAR
      file_opened: boolean,
      local_status: ost$status,
      order_data_file_id: amt$file_identifier,
      order_data_file_ref_p: ^fst$file_reference;


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

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If the file has been opened, it will be closed before the
{   the procedure returns.
{
{ NOTES:
{
{

    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 file_opened THEN
        fsp$close_file (order_data_file_id, ignore_status);
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    file_opened := FALSE;

    rap$add_name_to_path_ref (order_catalog_ref_p, rac$order_data_file_name,
          rav$creod_scratch_segment.sequence_p, order_data_file_ref_p);

    rap$open_file (order_data_file_ref_p, amc$record, fsc$modify, TRUE, NIL, order_data_file_id, file_opened,
          status);
    IF NOT status.normal THEN
      file_opened := FALSE;
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

  /write_file/
    BEGIN

      write_disk_scl_declarations (packing_list_header_p, disk_subproduct_indexer_p, order_data_file_id,
            status);
      IF NOT status.normal THEN
        EXIT /write_file/;
      IFEND;

      write_disk_scl_initializations (contents_list_p, disk_subproduct_indexer_p, order_data_file_id, status);

    END /write_file/;

    IF file_opened THEN
      fsp$close_file (order_data_file_id, local_status);
      file_opened := FALSE;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND write_disk_order_data_file;

?? TITLE := 'write_disk_scl_declarations', EJECT ??

{ PURPOSE:
{   This procedure writes the SCL variable declaration lines for a disk order.
{
{ DESIGN:
{   The declaration lines are constructed and put to the order data file using
{   a local procedure.  The status is checked within the local procedure to limit
{   the number of times it has to be checked in the main procedure.
{
{ NOTES:
{

  PROCEDURE write_disk_scl_declarations
    (    packing_list_header_p: ^rat$packing_list_header;
         disk_subproduct_indexer_p: ^rat$disk_subproduct_indexer;
         order_data_file_id: amt$file_identifier;
     VAR status: ost$status);


    VAR
      date_defined: ost$date,
      ignore_byte_address: amt$file_byte_address,
      order_type: ost$name,
      packing_list_name: [STATIC] ost$name := rac$packing_list_name,
      sif_file_name: [STATIC] ost$name := rac$sif_file_name,
      subproduct_count: integer;

?? NEWTITLE := 'format', EJECT ??

{ PURPOSE:
{   This procedure writes an initial string and a boolean, integer, or string
{   to a file.
{
{ DESIGN:
{   If the pointer to the boolean, string, or integer is not NIL, the initial
{   string and the boolean, string, or integer is written to the file.
{
{ NOTES:
{   Status is checked at the beginning of this procedure to determine if the
{   command should be completed.  This was done to limit the status check to
{   one place rather than after each call to this procedure in the main procedure.
{
{

    PROCEDURE write_formatted_line
      (    initial_string: string ( * );
           boolean_p: ^boolean;
           integer_p: ^integer;
           string_p: ^string ( * );
           closing_string: string ( * ));

      VAR
        length: integer,
        output_line: string (osc$max_string_size);


      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF boolean_p <> NIL THEN
        STRINGREP (output_line, length, initial_string, boolean_p^, closing_string);
      ELSEIF integer_p <> NIL THEN
        STRINGREP (output_line, length, initial_string, integer_p^, closing_string);
      ELSEIF string_p <> NIL THEN
        STRINGREP (output_line, length, initial_string, string_p^, closing_string);
      ELSE
        STRINGREP (output_line, length, initial_string, closing_string);
      IFEND;

      amp$put_next (order_data_file_id, ^output_line, length, ignore_byte_address, status);

    PROCEND write_formatted_line;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    pmp$get_date (osc$ordinal_date, date_defined, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    order_type := rav$subproduct_type [packing_list_header_p^.order_type];
    subproduct_count := UPPERBOUND (disk_subproduct_indexer_p^);

    write_formatted_line ('" The following variable declarations are critical to the "', NIL, NIL, NIL, '');
    write_formatted_line ('" writing of the order they define.  It is very important "', NIL, NIL, NIL, '');
    write_formatted_line ('" that these values are not modified.                     "', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('VAR                                           ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  order_identifier: name = ', NIL, NIL, ^packing_list_header_p^.order_identifier,
          '');
    write_formatted_line ('  order_type: name = ', NIL, NIL, ^order_type, '');
    write_formatted_line ('  date_defined: string 7 = ''', NIL, NIL, ^date_defined.ordinal, '''');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  packing_list_name: name = ', NIL, NIL, ^packing_list_name, '');
    write_formatted_line ('  sif_file_name: name = ', NIL, NIL, ^sif_file_name, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  order_medium: name = DISK', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  disk_backup_catalog: file = ', NIL, NIL,
          ^packing_list_header_p^.disk_backup_catalog (1, clp$trimmed_string_size
          (packing_list_header_p^.disk_backup_catalog)), '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');


    write_formatted_line ('  subproducts: array 1..', NIL, ^subproduct_count, NIL, ' of RECORD');
    write_formatted_line ('      name: name                              ', NIL, NIL, NIL, '');
    write_formatted_line ('      level: name                             ', NIL, NIL, NIL, '');
    write_formatted_line ('      licensed_product: name                  ', NIL, NIL, NIL, '');
    write_formatted_line ('      type: name                              ', NIL, NIL, NIL, '');
    write_formatted_line ('      pacs_catalog: file                      ', NIL, NIL, NIL, '');
    write_formatted_line ('      auto_install: boolean                   ', NIL, NIL, NIL, '');
    write_formatted_line ('      backup_file: name                       ', NIL, NIL, NIL, '');
    write_formatted_line ('      sif_identifier: name                    ', NIL, NIL, NIL, '');
    write_formatted_line ('    RECEND                                    ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('VAREND                                        ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

  PROCEND write_disk_scl_declarations;

?? TITLE := 'write_disk_scl_initializations', EJECT ??

{ PURPOSE:
{   This procedure writes the SCL variable initialization lines for a disk
{   order.
{
{ DESIGN:
{   Lines are added to the order data file to initialize an SCL variable array
{   that contains subproduct information.
{
{   The lines are constructed into a data array and then written to EOI of the
{   order data file.
{
{ NOTES:
{   The contents list contains an item for the packing list.  The SCL variable
{   being initialized is for subproduct information, therefore the packing list
{   item is excluded.  The packing list is assumed to be the first item in the
{   order contents list.  The "[i - 1]" indexing adjusts for this fact.
{

  PROCEDURE write_disk_scl_initializations
    (    contents_list_p: ^rat$order_contents_list;
         disk_subproduct_indexer_p: ^rat$disk_subproduct_indexer;
         order_data_file_id: amt$file_identifier;
     VAR status: ost$status);


    VAR
      data: array [1 .. 9] of rat$string,
      i: integer,
      ignore_byte_address: amt$file_byte_address,
      j: integer,
      subproduct_type: ost$name;

    status.normal := TRUE;

    FOR i := rac$first_subproduct_entry TO UPPERBOUND (contents_list_p^) DO
      subproduct_type := rav$subproduct_type [contents_list_p^ [i].subproduct_type];

      STRINGREP (data [1].value, data [1].length, '     ');
      STRINGREP (data [2].value, data [2].length, 'subproducts(', (i - 1), ').name = ',
            contents_list_p^ [i].name);
      STRINGREP (data [3].value, data [3].length, 'subproducts(', (i - 1), ').level = ',
            contents_list_p^ [i].level);
      STRINGREP (data [4].value, data [4].length, 'subproducts(', (i - 1), ').licensed_product = ',
            contents_list_p^ [i].licensed_product);
      STRINGREP (data [5].value, data [5].length, 'subproducts(', (i - 1), ').type = ', subproduct_type);
      STRINGREP (data [6].value, data [6].length, 'subproducts(', (i - 1), ').pacs_catalog = ',
            contents_list_p^ [i].pacs_catalog.path (1, contents_list_p^ [i].pacs_catalog.size));
      STRINGREP (data [7].value, data [7].length, 'subproducts(', (i - 1), ').auto_install = ',
            contents_list_p^ [i].auto_install);
      STRINGREP (data [8].value, data [8].length, 'subproducts(', (i - 1), ').backup_file = ',
            disk_subproduct_indexer_p^ [i - 1].backup_file);
      STRINGREP (data [9].value, data [9].length, 'subproducts(', (i - 1), ').sif_identifier = ',
            contents_list_p^ [i].sif_identifier);

      FOR j := 1 TO UPPERBOUND (data) DO
        amp$put_next (order_data_file_id, ^data [j].value, data [j].length, ignore_byte_address, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
    FOREND;

  PROCEND write_disk_scl_initializations;

?? TITLE := 'write_packing_list', EJECT ??

{ PURPOSE:
{   This procedure writes the PACKING LIST sequence to a permanent file in the
{   order catalog.
{
{ DESIGN:
{   A permanent file is opened in write mode and the SIF sequence in memory is
{   transferred to the permanent file.
{
{ NOTES:
{   The assumption is made that the current position pointer in the packing list
{   is at end of sequence.
{
{   In variable naming, 'P_LIST' is used as a short form for packing list.
{

  PROCEDURE write_packing_list
    (    order_catalog_ref_p: ^fst$file_reference;
     VAR packing_list_sequence_p: ^rat$packing_list_sequence;
     VAR status: ost$status);


    VAR
      file_opened: boolean,
      local_status: ost$status,
      packing_list_file_id: amt$file_identifier,
      packing_list_file_ref_p: ^fst$file_reference,
      packing_list_file_segment_p: amt$segment_pointer,
      packing_list_file_seq_p: ^SEQ ( * ),
      packing_list_seq_p: ^SEQ ( * ),
      packing_list_sequence_size: integer;

?? 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 file_opened THEN
        fsp$close_file (packing_list_file_id, ignore_status);
        file_opened := FALSE;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    file_opened := FALSE;

    rap$add_name_to_path_ref (order_catalog_ref_p, rac$packing_list_name,
          rav$creod_scratch_segment.sequence_p, packing_list_file_ref_p);

    rap$open_file (packing_list_file_ref_p, amc$segment, fsc$modify, TRUE, NIL, packing_list_file_id,
          file_opened, status);
    IF NOT status.normal THEN
      file_opened := FALSE;
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

  /write_file/
    BEGIN

      amp$get_segment_pointer (packing_list_file_id, amc$sequence_pointer, packing_list_file_segment_p,
            status);
      IF NOT status.normal THEN
        EXIT /write_file/;
      IFEND;

      packing_list_sequence_size := i#current_sequence_position (packing_list_sequence_p);

      RESET packing_list_sequence_p;
      NEXT packing_list_seq_p: [[REP packing_list_sequence_size OF cell]] IN packing_list_sequence_p;
      IF packing_list_seq_p = NIL THEN
        osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
        RETURN;
      IFEND;

      RESET packing_list_file_segment_p.sequence_pointer;
      NEXT packing_list_file_seq_p: [[REP packing_list_sequence_size OF cell]] IN
            packing_list_file_segment_p.sequence_pointer;
      IF packing_list_file_seq_p = NIL THEN
        osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
        RETURN;
      IFEND;

      packing_list_file_seq_p^ := packing_list_seq_p^;

      amp$set_segment_eoi (packing_list_file_id, packing_list_file_segment_p, status);

    END /write_file/;

    IF file_opened THEN
      fsp$close_file (packing_list_file_id, local_status);
      file_opened := FALSE;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND write_packing_list;

?? TITLE := 'write_tape_order_data_file', EJECT ??

{ PURPOSE:
{   This procedure writes the order data file into the order catalog for tape
{   orders.
{
{ DESIGN:
{   The order data file contains information used in the writing of the order by
{   WRITE_ORDER.  The order data file is a text file that when "included" will
{   create SCL variables containing order data.
{
{   The file has two parts; a SCL variable declarations part and a SCL variable
{   initializations part.
{
{ NOTES:
{

  PROCEDURE write_tape_order_data_file
    (    packing_list_header_p: ^rat$packing_list_header;
         contents_list_p: ^rat$order_contents_list;
         tape_info: rat$tape_information;
         tape_list_p: ^rat$primary_tape;
         order_catalog_ref_p: ^fst$file_reference;
     VAR status: ost$status);


    VAR
      file_opened: boolean,
      local_status: ost$status,
      order_data_file_id: amt$file_identifier,
      order_data_file_ref_p: ^fst$file_reference;


?? 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 file_opened THEN
        fsp$close_file (order_data_file_id, ignore_status);
        file_opened := FALSE;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    file_opened := FALSE;

    rap$add_name_to_path_ref (order_catalog_ref_p, rac$order_data_file_name,
          rav$creod_scratch_segment.sequence_p, order_data_file_ref_p);

    rap$open_file (order_data_file_ref_p, amc$record, fsc$modify, TRUE, NIL, order_data_file_id, file_opened,
          status);
    IF NOT status.normal THEN
      file_opened := FALSE;
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

  /write_file/
    BEGIN

      write_tape_scl_declarations (packing_list_header_p, tape_info, tape_list_p, contents_list_p,
            order_data_file_id, status);
      IF NOT status.normal THEN
        EXIT /write_file/;
      IFEND;

      write_tape_scl_initializations (tape_info, tape_list_p, contents_list_p, order_data_file_id, status);

    END /write_file/;

    IF file_opened THEN
      fsp$close_file (order_data_file_id, local_status);
      file_opened := FALSE;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND write_tape_order_data_file;

?? TITLE := 'write_tape_scl_declarations', EJECT ??

{ PURPOSE:
{   This procedure writes the SCL variable declaration lines for a tape order.
{
{ DESIGN:
{   The declaration lines are constructed and put to the order data file using
{   a local procedure.  The status is checked within the local procedure to limit
{   the number of times it has to be checked in the main procedure.
{
{ NOTES:
{

  PROCEDURE write_tape_scl_declarations
    (    packing_list_header_p: ^rat$packing_list_header;
         tape_info: rat$tape_information;
         tape_list_p: ^rat$primary_tape;
         contents_list_p: ^rat$order_contents_list;
         order_data_file_id: amt$file_identifier;
     VAR status: ost$status);


    VAR
      date_defined: ost$date,
      ignore_byte_address: amt$file_byte_address,
      order_type: ost$name,
      packing_list_name: [STATIC] ost$name := rac$packing_list_name,
      percent_usable: integer,
      primary_vsns: rat$string,
      sif_file_name: [STATIC] ost$name := rac$sif_file_name,
      subproduct_count: integer;


?? NEWTITLE := 'format', EJECT ??

{ PURPOSE:
{   This procedure writes an initial string and a boolean, integer, or string
{   to a file.
{
{ DESIGN:
{   If the pointer to the boolean, string, or integer is not NIL, the initial
{   string and the boolean, string, or integer is written to the file.
{
{ NOTES:
{   Status is checked at the beginning of this procedure to determine if the
{   command should be completed.  This was done to limit the status check to
{   one place rather than after each call to this procedure in the main procedure.
{
{

    PROCEDURE write_formatted_line
      (    initial_string: string ( * );
           boolean_p: ^boolean;
           integer_p: ^integer;
           string_p: ^string ( * );
           closing_string: string ( * ));

      VAR
        length: integer,
        output_line: string (osc$max_string_size);


      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF boolean_p <> NIL THEN
        STRINGREP (output_line, length, initial_string, boolean_p^, closing_string);
      ELSEIF integer_p <> NIL THEN
        STRINGREP (output_line, length, initial_string, integer_p^, closing_string);
      ELSEIF string_p <> NIL THEN
        STRINGREP (output_line, length, initial_string, string_p^, closing_string);
      ELSE
        STRINGREP (output_line, length, initial_string, closing_string);
      IFEND;

      amp$put_next (order_data_file_id, ^output_line, length, ignore_byte_address, status);

    PROCEND write_formatted_line;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    pmp$get_date (osc$ordinal_date, date_defined, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    order_type := rav$subproduct_type [packing_list_header_p^.order_type];

    percent_usable := tape_info.percent_usable;
    subproduct_count := UPPERBOUND (contents_list_p^) - 1;

    create_scl_primary_vsn_list (tape_list_p, primary_vsns);

    write_formatted_line ('" The following variable declarations are critical to the "', NIL, NIL, NIL, '');
    write_formatted_line ('" writing of the order they define.  It is very important "', NIL, NIL, NIL, '');
    write_formatted_line ('" that these values are not modified.  The one exception  "', NIL, NIL, NIL, '');
    write_formatted_line ('" is the TAPE''s EVSN field.                              "', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('VAR                                           ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  order_identifier: name = ', NIL, NIL, ^packing_list_header_p^.order_identifier,
          '');
    write_formatted_line ('  order_type: name = ', NIL, NIL, ^order_type, '');
    write_formatted_line ('  date_defined: string 7 = ''', NIL, NIL, ^date_defined.ordinal, '''');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  packing_list_name: name = ', NIL, NIL, ^packing_list_name, '');
    write_formatted_line ('  sif_file_name: name = ', NIL, NIL, ^sif_file_name, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  order_medium: name = TAPE', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  tape_type: name = ', NIL, NIL, ^tape_info.tape_type, '');
    write_formatted_line ('  percent_usable_tape: integer 1..100 = ', NIL, ^percent_usable, NIL, '');
    write_formatted_line ('  number_of_tapes: integer = ', NIL, ^tape_info.number_of_tapes, NIL, '');
    write_formatted_line ('  number_of_primary_tapes: integer = ', NIL, ^tape_info.number_of_primary_tapes,
          NIL, '');
    write_formatted_line ('  number_of_multi_vol_sets: integer = ', NIL, ^tape_info.number_of_multi_vol_sets,
          NIL, '');
    write_formatted_line ('  number_of_tapes_theoretical: integer = ', NIL,
          ^tape_info.number_of_tapes_theoretical, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  primary_vsns: list 1..', NIL, ^tape_info.number_of_primary_tapes, NIL,
          ' of string 1..6 = ..');
    write_formatted_line ('    ', NIL, NIL, ^primary_vsns.value (1, primary_vsns.length), '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  tapes: array 1..', NIL, ^tape_info.number_of_primary_tapes, NIL, ' of RECORD');
    write_formatted_line ('      evsn: list of string 1..6               ', NIL, NIL, NIL, '');
    write_formatted_line ('      rvsn: list of string 1..6               ', NIL, NIL, NIL, '');
    write_formatted_line ('      size: list of integer                   ', NIL, NIL, NIL, '');
    write_formatted_line ('      usable_length: list of integer          ', NIL, NIL, NIL, '');
    write_formatted_line ('      length_assigned: list of integer        ', NIL, NIL, NIL, '');
    write_formatted_line ('      subproducts_index_lowerbound: integer   ', NIL, NIL, NIL, '');
    write_formatted_line ('      subproducts_index_upperbound: integer   ', NIL, NIL, NIL, '');
    write_formatted_line ('    RECEND                                    ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

    write_formatted_line ('  subproducts: array 1..', NIL, ^subproduct_count, NIL, ' of RECORD');
    write_formatted_line ('      name: name                              ', NIL, NIL, NIL, '');
    write_formatted_line ('      level: name                             ', NIL, NIL, NIL, '');
    write_formatted_line ('      licensed_product: name                  ', NIL, NIL, NIL, '');
    write_formatted_line ('      type: name                              ', NIL, NIL, NIL, '');
    write_formatted_line ('      pacs_catalog: file                      ', NIL, NIL, NIL, '');
    write_formatted_line ('      auto_install: boolean              ', NIL, NIL, NIL, '');
    write_formatted_line ('      tape_index: integer                     ', NIL, NIL, NIL, '');
    write_formatted_line ('      sif_identifier: name                    ', NIL, NIL, NIL, '');
    write_formatted_line ('    RECEND                                    ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');
    write_formatted_line ('VAREND                                        ', NIL, NIL, NIL, '');
    write_formatted_line ('                                              ', NIL, NIL, NIL, '');

  PROCEND write_tape_scl_declarations;

?? TITLE := 'write_tape_scl_initializations', EJECT ??

{ PURPOSE:
{   This procedure writes the SCL variable initialization lines for a tape
{   order.
{
{ DESIGN:
{   Lines are added to the order data file to initialize two SCL variable
{   arrays.  The first is for tape information.  The second is for subproduct
{   information.  The two SCL variables have fields that "tie" them together.
{
{   The lines are constructed into a data array and then written to EOI of the
{   order data file.
{
{ NOTES:
{   The contents list contains an item for the packing list.  The SCL variable
{   being initialized for the subproducts does not include the packing list item.
{   The packing list is assumed to be the first item in the order contents
{   list.  The "[i - 1]" indexing adjusts for this fact.
{

  PROCEDURE write_tape_scl_initializations
    (    tape_info: rat$tape_information;
         tape_list_p: ^rat$primary_tape;
         contents_list_p: ^rat$order_contents_list;
         order_data_file_id: amt$file_identifier;
     VAR status: ost$status);


    VAR
      additional_vol_p: ^rat$additional_volume,
      assigned: rat$string,
      assignment_range_lowerbound: integer,
      tape_data: array [1 .. 8] of rat$string,
      subproduct_data: array [1 .. 9] of rat$string,
      evsn: rat$string,
      i: integer,
      ignore_byte_address: amt$file_byte_address,
      j: integer,
      rvsn: rat$string,
      size: rat$string,
      subproduct_type: ost$name,
      tape_indexes_p: ^array [ * ] of integer,
      tape_p: ^rat$primary_tape,
      usable: rat$string;


    status.normal := TRUE;

    PUSH tape_indexes_p: [1 .. UPPERBOUND (contents_list_p^)];
    IF tape_indexes_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
      RETURN;
    IFEND;

    i := 1;
    tape_p := tape_list_p;

    WHILE tape_p <> NIL DO

      create_scl_tape_data_lists (tape_p, tape_info.tape_type, assigned, evsn, rvsn, size, usable);

      STRINGREP (tape_data [1].value, tape_data [1].length, '     ');
      STRINGREP (tape_data [2].value, tape_data [2].length, 'tapes(', i, ').evsn = ', evsn.
            value (1, evsn.length));
      STRINGREP (tape_data [3].value, tape_data [3].length, 'tapes(', i, ').rvsn = ', rvsn.
            value (1, rvsn.length));
      STRINGREP (tape_data [4].value, tape_data [4].length, 'tapes(', i, ').size = ', size.
            value (1, size.length));
      STRINGREP (tape_data [5].value, tape_data [5].length, 'tapes(', i, ').usable_length = ', usable.
            value (1, usable.length));
      STRINGREP (tape_data [6].value, tape_data [6].length, 'tapes(', i, ').length_assigned = ',
            assigned.value (1, assigned.length));

      IF tape_p^.assignment_range_lowerbound = 1 THEN

{ Adjust lowerbound to skip over the packing list.

        assignment_range_lowerbound := rac$first_subproduct_entry;
      ELSE
        assignment_range_lowerbound := tape_p^.assignment_range_lowerbound;
      IFEND;

      STRINGREP (tape_data [7].value, tape_data [7].length, 'tapes(', i, ').subproducts_index_lowerbound = ',
            (assignment_range_lowerbound - 1));
      STRINGREP (tape_data [8].value, tape_data [8].length, 'tapes(', i, ').subproducts_index_upperbound = ',
            (tape_p^.assignment_range_upperbound - 1));

      FOR j := 1 TO UPPERBOUND (tape_data) DO
        amp$put_next (order_data_file_id, ^tape_data [j].value, tape_data [j].length, ignore_byte_address,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

      FOR j := tape_p^.assignment_range_lowerbound TO tape_p^.assignment_range_upperbound DO
        tape_indexes_p^ [j] := i;
      FOREND;

      i := i + 1;
      tape_p := tape_p^.next_tape_p;
    WHILEND;


    FOR i := rac$first_subproduct_entry TO UPPERBOUND (contents_list_p^) DO
      subproduct_type := rav$subproduct_type [contents_list_p^ [i].subproduct_type];

      STRINGREP (subproduct_data [1].value, subproduct_data [1].length, '     ');
      STRINGREP (subproduct_data [2].value, subproduct_data [2].length, 'subproducts(', (i - 1), ').name = ',
            contents_list_p^ [i].name);
      STRINGREP (subproduct_data [3].value, subproduct_data [3].length, 'subproducts(', (i - 1), ').level = ',
            contents_list_p^ [i].level);
      STRINGREP (subproduct_data [4].value, subproduct_data [4].length, 'subproducts(', (i - 1),
            ').licensed_product = ', contents_list_p^ [i].licensed_product);
      STRINGREP (subproduct_data [5].value, subproduct_data [5].length, 'subproducts(', (i - 1), ').type = ',
            subproduct_type);
      STRINGREP (subproduct_data [6].value, subproduct_data [6].length, 'subproducts(', (i - 1),
            ').pacs_catalog = ', contents_list_p^ [i].pacs_catalog.
            path (1, contents_list_p^ [i].pacs_catalog.size));
      STRINGREP (subproduct_data [7].value, subproduct_data [7].length, 'subproducts(', (i - 1),
            ').auto_install = ', contents_list_p^ [i].auto_install);
      STRINGREP (subproduct_data [8].value, subproduct_data [8].length, 'subproducts(', (i - 1),
            ').tape_index = ', tape_indexes_p^ [i]);
      STRINGREP (subproduct_data [9].value, subproduct_data [9].length, 'subproducts(', (i - 1),
            ').sif_identifier = ', contents_list_p^ [i].sif_identifier);

      FOR j := 1 TO UPPERBOUND (subproduct_data) DO
        amp$put_next (order_data_file_id, ^subproduct_data [j].value, subproduct_data [j].
              length, ignore_byte_address, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
    FOREND;

  PROCEND write_tape_scl_initializations;

MODEND ram$write_definition;

