mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-22 07:54:25 +00:00
75 lines
3.0 KiB
Plaintext
75 lines
3.0 KiB
Plaintext
$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;
|