$TITLE ('UDI Change Extension Routine')
$LARGE

DQ_CHANGE$EXTENSION: do;   /* UDI DQ$CHANGE$EXTENSION routine. */
 
/*************************************************************************/
/*                                                                       */
/*               D I S C L A I M E R   N O T I C E                       */
/*               -------------------   -----------                       */
/*                                                                       */
/*  This document and/or portions of the material and data furnished     */
/*  herewith, was developed under sponsorship of the U. S. Government.   */
/*  Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior  */
/*  University, nor their employees, nor their respective contractors,   */
/*  subcontractors, or their employees, makes any warranty, express or   */
/*  implied, or assumes any liability or responsibility for accuracy,    */
/*  completeness or usefulness of any information, apparatus, product    */
/*  or process disclosed, or represents that its use will not infringe   */
/*  privately-owned rights.  Mention of any product, its manufacturer,   */
/*  or suppliers shall not, nor is it intended to, imply approval, dis-  */
/*  approval, or fitness for any particular use.  The U. S. and the      */
/*  University at all times retain the right to use and disseminate same */
/*  for any purpose whatsoever.  Such distribution shall be made by the  */
/*  National Energy Software Center at the Argonne National Laboratory   */
/*  and only subject to the distributee furnishing satisfactory proof    */
/*  that he has a valid license from the Intel Corporation in effect.    */
/*                                                                       */
/*************************************************************************/

$INCLUDE (PLM$UDI:CUSTOMARY.LIT)
$INCLUDE (PLM$UDI:EXCEPT.LIT)
 
declare %PTR literally 'POINTER';

DQ$CHANGE$EXTENSION: procedure (path$p,extension$p,excep$p) public;
        declare (path$p,extension$p,excep$p) %PTR;
        declare (path based path$p) (46) byte,
                (extension based extension$p) (3) byte,
                (status based excep$p) byte;
        declare inside_directory byte;
        declare i integer;

        status = E$OK;

        inside_directory=FALSE;
        i=1;

        do while i<=path(0) and (inside_directory or path(i)<>'.');
           if path(i)='[' then
              inside_directory=TRUE;
           else if path(i)=']' then
              inside_directory=FALSE;
           i=i+1;
           end;

        i=i-1;

        if extension(0)<>' ' then do;
           if i>41 then
              status = E$STRING$BUF;
           else do;
              path(i+1)='.';
              path(i+2)=extension(0);
              path(i+3)=extension(1);
              path(i+4)=extension(2);
              i=i+4;
              end;
           end;

        path(0)=i;

        end DQ$CHANGE$EXTENSION;

end DQ_CHANGE$EXTENSION;