?? RIGHT := 110 ??
*copyc osd$default_pragmats
MODULE ram$compare_sl_decks;
?? PUSH (LISTEXT := ON) ??
*copyc ost$name
*copyc clt$path_name
*copyc rat$write_scl_commands
*copyc rat$corrector_size
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$put_next
*copyc amp$return
*copyc pmp$get_unique_name
*copyc clp$scan_command_line
*copyc clp$create_variable
*copyc clp$read_variable
*copyc clp$delete_variable
*copyc rap$get_decks
?? POP ??

*copyc rah$compare_sl_decks

  PROCEDURE [XDCL] rap$compare_sl_decks (name: ost$name;
        old_path: clt$path_name;
        old_path_length: 1 .. clc$max_path_name_size;
        new_path: clt$path_name;
        new_path_length: 1 .. clc$max_path_name_size;
    VAR decks_match: boolean;
    VAR status: ost$status);

    CONST
      number_of_commands = 77;

    VAR
      access_selections: amt$file_access_selections,
      ba: amt$file_byte_address,
      command: array [1 .. number_of_commands] of rat$write_scl_commands,
      command_fid: amt$file_identifier,
      command_file: ost$name,
      dhd_scl_var_name: string (31),
      i: 0 .. number_of_commands + 1,
      ignore_status: ost$status,
      j: rat$corrector_size,
      new_array: ^array [1 .. * ] of 0 .. 0ff(16),
      new_deck: ost$name,
      new_fid: amt$file_identifier,
      new_size: integer,
      new_source_deck: amt$segment_pointer,
      old_array: ^array [1 .. * ] of 0 .. 0ff(16),
      old_deck: ost$name,
      old_fid: amt$file_identifier,
      old_size: integer,
      old_source_deck: amt$segment_pointer,
      scope: clt$variable_scope,
      scope_xref: clt$variable_scope,
      size: integer,
      text: string (osc$max_string_size),
      var_ref: clt$variable_reference;

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

    amp$open (command_file, amc$record, NIL, command_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    decks_match := TRUE;

    STRINGREP (command [1].command, command [1].size, ' deck_headers_differ = false');
    STRINGREP (command [2].command, command [2].size, ' scu');
    STRINGREP (command [3].command, command [3].size, ' use_library b=', old_path (1, old_path_length));
    STRINGREP (command [4].command, command [4].size, '   old_a = $deck_header(', name, ',a)');
    STRINGREP (command [5].command, command [5].size, '   old_dd = $deck_header(', name, ',dd)');
    STRINGREP (command [6].command, command [6].size, '   old_p = $deck_header(', name, ',p)');
    STRINGREP (command [7].command, command [7].size, '   old_g = $deck_header(', name, ',g)');
    STRINGREP (command [8].command, command [8].size, '   old_c = $deck_header(', name, ',c)');
    STRINGREP (command [9].command, command [9].size, '   old_tc = $deck_header(', name, ',tc)');
    STRINGREP (command [10].command, command [10].size, '   old_w = $deck_header(', name, ',w)');
    STRINGREP (command [11].command, command [11].size, '   old_li = $deck_header(', name, ',li)');
    STRINGREP (command [12].command, command [12].size, '   old_e = $deck_header(', name, ',e)');
    STRINGREP (command [13].command, command [13].size, '   old_m = $deck_header(', name, ',m)');
    STRINGREP (command [14].command, command [14].size, '   old_alc = $deck_header(', name, ',alc)');
    STRINGREP (command [15].command, command [15].size, '   scu');
    STRINGREP (command [16].command, command [16].size, '   use_library b=', new_path (1, new_path_length));
    STRINGREP (command [17].command, command [17].size, '     new_a = $deck_header(', name, ',a)');
    STRINGREP (command [18].command, command [18].size, '     new_dd = $deck_header(', name, ',dd)');
    STRINGREP (command [19].command, command [19].size, '     new_p = $deck_header(', name, ',p)');
    STRINGREP (command [20].command, command [20].size, '     new_g = $deck_header(', name, ',g)');
    STRINGREP (command [21].command, command [21].size, '     new_c = $deck_header(', name, ',c)');
    STRINGREP (command [22].command, command [22].size, '     new_tc = $deck_header(', name, ',tc)');
    STRINGREP (command [23].command, command [23].size, '     new_w = $deck_header(', name, ',w)');
    STRINGREP (command [24].command, command [24].size, '     new_li = $deck_header(', name, ',li)');
    STRINGREP (command [25].command, command [25].size, '     new_e = $deck_header(', name, ',e)');
    STRINGREP (command [26].command, command [26].size, '     new_m = $deck_header(', name, ',m)');
    STRINGREP (command [27].command, command [27].size, '     new_alc = $deck_header(', name, ',alc)');
    STRINGREP (command [28].command, command [28].size, '     check_match: BLOCK');
    STRINGREP (command [29].command, command [29].size, '       deck_headers_differ = (old_a <> new_a)');
    STRINGREP (command [30].command, command [30].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [31].command, command [31].size, '       old_upper = $variable(old_dd,upper_bound)');
    STRINGREP (command [32].command, command [32].size, '       new_upper = $variable(new_dd,upper_bound)');
    STRINGREP (command [33].command, command [33].size,
      '       deck_headers_differ = (old_upper <> new_upper)');
    STRINGREP (command [34].command, command [34].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [35].command, command [35].size, '       FOR i = 1 to old_upper DO');
    STRINGREP (command [36].command, command [36].size,
      '         deck_headers_differ = (old_dd(i) <> new_dd(i))');
    STRINGREP (command [37].command, command [37].size, '         EXIT check_match WHEN deck_headers_differ');
    STRINGREP (command [38].command, command [38].size, '       FOREND');
    STRINGREP (command [39].command, command [39].size, '       deck_headers_differ = (old_p <> new_p)');
    STRINGREP (command [40].command, command [40].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [41].command, command [41].size, '       old_upper = $variable(old_g,upper_bound)');
    STRINGREP (command [42].command, command [42].size, '       new_upper = $variable(new_g,upper_bound)');
    STRINGREP (command [43].command, command [43].size,
      '       deck_headers_differ = (old_upper <> new_upper)');
    STRINGREP (command [44].command, command [44].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [45].command, command [45].size, '       FOR i = 1 to old_upper DO');
    STRINGREP (command [46].command, command [46].size,
      '         deck_headers_differ = (old_g(i) <> new_g(i))');
    STRINGREP (command [47].command, command [47].size, '         EXIT check_match WHEN deck_headers_differ');
    STRINGREP (command [48].command, command [48].size, '       FOREND');
    STRINGREP (command [49].command, command [49].size, '       deck_headers_differ = (old_c <> new_c)');
    STRINGREP (command [50].command, command [50].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [51].command, command [51].size, '       old_upper = $variable(old_tc,upper_bound)');
    STRINGREP (command [52].command, command [52].size, '       new_upper = $variable(new_tc,upper_bound)');
    STRINGREP (command [53].command, command [53].size,
      '       deck_headers_differ = (old_upper <> new_upper)');
    STRINGREP (command [54].command, command [54].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [55].command, command [55].size, '       FOR i = 1 to old_upper DO');
    STRINGREP (command [56].command, command [56].size,
      '         deck_headers_differ = (old_tc(i) <> new_tc(i))');
    STRINGREP (command [57].command, command [57].size, '         EXIT check_match WHEN deck_headers_differ');
    STRINGREP (command [58].command, command [58].size, '       FOREND');
    STRINGREP (command [59].command, command [59].size, '       deck_headers_differ = (old_w <> new_w)');
    STRINGREP (command [60].command, command [60].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [61].command, command [61].size, '       deck_headers_differ = (old_li <> new_li)');
    STRINGREP (command [62].command, command [62].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [63].command, command [63].size, '       deck_headers_differ = (old_e <> new_e)');
    STRINGREP (command [64].command, command [64].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [65].command, command [65].size, '       old_upper = $variable(old_m,upper_bound)');
    STRINGREP (command [66].command, command [66].size, '       new_upper = $variable(new_m,upper_bound)');
    STRINGREP (command [67].command, command [67].size,
      '       deck_headers_differ = (old_upper <> new_upper)');
    STRINGREP (command [68].command, command [68].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [69].command, command [69].size, '       FOR i = 1 to old_upper DO');
    STRINGREP (command [70].command, command [70].size,
      '         deck_headers_differ = (old_m(i) <> new_m(i))');
    STRINGREP (command [71].command, command [71].size, '         EXIT check_match WHEN deck_headers_differ');
    STRINGREP (command [72].command, command [72].size, '       FOREND');
    STRINGREP (command [73].command, command [73].size, '       deck_headers_differ = (old_alc <> new_alc)');
    STRINGREP (command [74].command, command [74].size, '       EXIT WHEN deck_headers_differ');
    STRINGREP (command [75].command, command [75].size, '     BLOCKEND check_match');
    STRINGREP (command [76].command, command [76].size, '   quit no');
    STRINGREP (command [77].command, command [77].size, ' quit no');

    FOR i := 1 TO number_of_commands DO
      amp$put_next (command_fid, ^command [i].command, command [i].size, ba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

    dhd_scl_var_name := 'DECK_HEADERS_DIFFER';
    scope.kind := clc$job_variable;
    scope_xref.kind := clc$xref_variable;

    clp$create_variable (dhd_scl_var_name, clc$boolean_value, 0, 0, 0, scope_xref, var_ref, status);
    IF status.normal THEN
      clp$delete_variable (dhd_scl_var_name, status);
      IF NOT status.normal AND (status.condition <> cle$unknown_variable) THEN
        RETURN;
      IFEND;

      clp$create_variable (dhd_scl_var_name, clc$boolean_value, 0, 0, 0, scope, var_ref, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    amp$close (command_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (text, size, ' include_file f=', command_file);
    clp$scan_command_line (text (1, size), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$return (command_file, ignore_status);

    clp$read_variable (dhd_scl_var_name, var_ref, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF var_ref.value.boolean_value^ [1].value THEN
      decks_match := FALSE;
      RETURN;
    IFEND;

    clp$delete_variable (dhd_scl_var_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

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

    rap$get_decks (name, old_path, old_path_length, new_path, new_path_length, old_deck, new_deck,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH access_selections: [1 .. 1];
    access_selections^ [1].key := amc$access_mode;
    access_selections^ [1].access_mode := $pft$usage_selections [pfc$read];

    amp$open (old_deck, amc$segment, access_selections, old_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (new_deck, amc$segment, access_selections, new_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (old_fid, amc$sequence_pointer, old_source_deck, status);
    IF NOT status.normal THEN
      IF status.condition = ame$read_of_empty_segment THEN
        old_size := 0;
      ELSE
        RETURN;
      IFEND;
    ELSE
      old_size := #SIZE (old_source_deck.sequence_pointer^);
    IFEND;

    amp$get_segment_pointer (new_fid, amc$sequence_pointer, new_source_deck, status);
    IF NOT status.normal THEN
      IF status.condition = ame$read_of_empty_segment THEN
        new_size := 0;
      ELSE
        RETURN;
      IFEND;
    ELSE
      new_size := #SIZE (new_source_deck.sequence_pointer^);
    IFEND;

    IF old_size <> new_size THEN
      decks_match := FALSE;

      amp$close (old_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      amp$close (new_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      STRINGREP (text, size, ' delete_file ', old_deck);
      clp$scan_command_line (text (1, size), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      STRINGREP (text, size, ' delete_file ', new_deck);
      clp$scan_command_line (text (1, size), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      RETURN;
    IFEND;

    IF old_size > 0 THEN
      NEXT old_array: [1 .. old_size] IN old_source_deck.sequence_pointer;
      NEXT new_array: [1 .. new_size] IN new_source_deck.sequence_pointer;
    IFEND;

  /search_for_difference/
    FOR j := 1 TO old_size DO
      IF old_array^ [j] <> new_array^ [j] THEN
        decks_match := FALSE;
        EXIT /search_for_difference/
      IFEND;
    FOREND /search_for_difference/;

    amp$close (old_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$close (new_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (text, size, ' delete_file ', old_deck);
    clp$scan_command_line (text (1, size), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (text, size, ' delete_file ', new_deck);
    clp$scan_command_line (text (1, size), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND rap$compare_sl_decks;
MODEND ram$compare_sl_decks;
