!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  Translate from VAX FORTRAN conventions to IBM FORTRAN conventions:
!!
!!    Extract in-line (!-type) comments and place them at the beginning
!!	of the appropriate statement
!!    Turn blank lines into comment lines
!!    Turn *-comments into C-style comment lines
!!    Turn D-lines into comment lines
!!    Translate from VAX include-statements to IBM include-statements.
!!    Turn '***' in lines with a single-quote to '%%%' (at Jeff's request)
!!
!!  REQUIRES (calls) the TPU procedures CJC_FIX_LABELS (found in
!!  [XCC.EVE]F_PRETTY.TPU) and CJC_DETAB (found in [XCC.EVE]DETAB.TPU).
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

PROCEDURE  cjc_ibmize_fortran

LOCAL	start_mark     ,
        end_mark       ,
        comment_str    ,
        col            ,
        a_loc          ,
        b_loc          ,
        include_str    ,
        include_name   ,
        qual_mark      ;

ON_ERROR

    if ( error = TPU$_STRNOTFOUND )  then
        !!  DO NOTHING !!
        !!  (needing this conditional is an idiocy courtesy of DEC )
    else
        message ( "error in procedure IBMize" ) ;
        return ;
    endif ;

ENDON_ERROR ;

    cjc_fix_labels ;
    cjc_detab ;

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  fix-up in-line comments ( signalled by !'s
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( '!' , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;
        erase_character ( 1 ) ;
        start_mark  := mark ( NONE ) ;

        position ( search ( LINE_END , FORWARD ) ) ;
        move_horizontal ( -1 ) ;
        end_mark  :=  mark ( NONE ) ;

        !  extract the comment
        position ( a_loc ) ;
        comment_str  :=  erase_character (
                                         length (
                                                create_range (
                                                             start_mark ,
                                                             end_mark ,
                                                             NONE
                                                             )
                                                )
                                         ) ;

        loop		!  move to line beginning the current statement

            position ( search ( LINE_BEGIN , REVERSE ) ) ;
            col  :=  1 ;
            loop
                exitif ( get_info ( current_buffer , "character" ) <> ' ' ) ;
                exitif ( get_info ( current_buffer , "offset_column" ) > 5 ) ;
                col  :=  col + 1 ;
                move_horizontal ( 1 ) ;
            endloop ;
            exitif ( get_info ( current_buffer , "offset_column" ) > 5 ) ;
            move_vertical ( -1 ) ;
        endloop ;

        position ( search ( LINE_BEGIN , REVERSE ) ) ;
        copy_text ( 'C     ' ) ;
        copy_text ( comment_str ) ;
        split_line ;

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  change UNDERSCORES to DOLLAR-SIGNS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( '_' , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;
        erase_character ( 1 )  ;
        copy_text ( '$' ) ;

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  change '***'  to  '%%%' in lines containing single-quotes
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( '***' , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( search ( LINE_BEGIN , REVERSE ) ) ;

        b_loc  :=  search ( "'" , FORWARD ) ;
        if ( b_loc <> 0 )  then
            if ( beginning_of ( b_loc )
                 < beginning_of ( search ( LINE_END , FORWARD ) ) )  then

                position ( a_loc ) ;
                erase_character ( 3 )  ;
                copy_text ( '%%%' ) ;

            endif ;
        endif

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  make comments of lines with only blanks and tabs on them
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( LINE_BEGIN
                                & eve$pattern_whitespace
                                & LINE_END ,
                                FORWARD
                              ) ;

        exitif ( a_loc = 0 ) ;

        position ( a_loc ) ;
        erase_character ( length ( a_loc ) ) ;

        copy_text ( 'C' ) ;

    endloop ;



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  make comments of empty lines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( LINE_BEGIN & LINE_END , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;
        copy_text ( 'C' ) ;

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  process asterisk-comments
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( LINE_BEGIN & '*' , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;
        if ( get_info ( current_buffer , "offset_column" ) = 1 ) then
            erase_character ( 1 ) ;
            copy_text ( 'C' ) ;
        endif ;

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  make D-lines into comment-lines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( LINE_BEGIN & 'D' , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;

        if ( get_info ( current_buffer , "offset_column" ) = 1 ) then
            erase_character ( 1 ) ;
            copy_text ( 'C' ) ;
        endif ;

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  eliminate '/LIST' qualifiers from INCLUDEs
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( '/LIST' , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;
        erase_character ( 5 ) ;

    endloop ;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  handle INCLUDEs
!!  NOTE -- the only occurences of INCLUDE and single-quotes on a
!!  single line should be in include-statements
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    position ( beginning_of ( current_buffer ) ) ;

    loop	

        a_loc  :=  search ( "INCLUDE" , FORWARD ) ;
        exitif ( a_loc = 0 ) ;
        position ( a_loc ) ;

        a_loc :=  beginning_of ( search ( "'" , FORWARD ) ) ;
        if ( a_loc < beginning_of ( search ( LINE_END, FORWARD ) ) ) then
            position ( a_loc ) ;
            erase_character ( 1 ) ;
            start_mark  :=  mark ( NONE ) ;
            position ( search ( "'" , FORWARD ) ) ;
            erase_character ( 1 ) ;
            end_mark  :=  mark ( NONE ) ;

            position ( start_mark ) ;

            include_str  :=  erase_character (
                                             length (
                                                    create_range (
                                                                 start_mark ,
                                                                 end_mark   ,
                                                                 NONE
                                                                 )
                                                    )
                                             ) ;

            message ( 'Processing include-file  ' + include_str ) ;

            copy_text (
                      '('  + file_parse ( include_str , '' , '' , NAME )  + ')'
                      ) ;

            position ( end_mark ) ;

        else
            move_vertical ( 1 ) ;
            position ( search ( LINE_BEGIN , REVERSE ) ) ;
        endif ;

    endloop ;



ENDPROCEDURE ;