?? RIGHT := 110 ??
?? NEWTITLE := 'CREATE_SUBPRODUCT_CORRECTION Utility: RAP$GENERATE_OBJECT_CORRECTION Procedure.' ??
MODULE ram$generate_object_correction;

{ PURPOSE:
{   This module contains the procedures to generate a correction
{   for an object library.
{ DESIGN:
{   The compiled module resides in RAF$LIBRARY.
{
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rat$subproduct_info_types
?? POP ??
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc ocp$checksum
*copyc ocp$generate_object_correction
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc rap$write_file_from_memory
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] rap$generate_object_correction', EJECT ??

{ PURPOSE:
{   This procedure generates a correction for an object library.
{
{ DESIGN:
{
{
{ NOTES:
{

  PROCEDURE [XDCL] rap$generate_object_correction
    (    base_file: fst$file_reference;
         current_file: fst$file_reference;
         new_file: fst$file_reference;
         calculate_checksums: boolean;
         base_checksum: rat$checksum;
         current_checksum: rat$checksum;
         element_p {input/output} : ^rat$element;
     VAR status: ost$status);

    VAR
      checksum_seq_p: ^ SEQ ( * ),
      corrector_size: oct$corrector_size,
      local_status: ost$status,
      scratch_segment_pointer: amt$segment_pointer,
      scratch_sequence_p: ^SEQ ( * );

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

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

      VAR
        ignore_status: ost$status;

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

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

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

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

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

      ocp$generate_object_correction (base_file, current_file, calculate_checksums, base_checksum,
            current_checksum, scratch_sequence_p, corrector_size, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      element_p^.size := corrector_size;

      { Calculate the contents checksum of the object correction.}
      RESET scratch_sequence_p;
      NEXT checksum_seq_p: [[REP corrector_size OF cell]] IN scratch_sequence_p;
      element_p^.contents_checksum := ocp$checksum (checksum_seq_p);

      { Write the sequence in memory to the new file.}
      rap$write_file_from_memory (new_file, corrector_size, scratch_sequence_p, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

    END /main/;

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

    osp$disestablish_cond_handler;

  PROCEND rap$generate_object_correction;

MODEND ram$generate_object_correction;
