#include <sys/wait.h>
#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
+#elif defined (VMS)
+#include <rms.h>
+#include <atrdef.h>
+#include <fibdef.h>
+#include <stsdef.h>
+#include <iodef.h>
+#include <errno.h>
+#include <descrip.h>
+#include <string.h>
+#include <unixlib.h>
+
+struct utimbuf
+{
+ time_t actime;
+ time_t modtime;
+};
+
+#define NOREAD 0x01
+#define NOWRITE 0x02
+#define NOEXECUTE 0x04
+#define NODELETE 0x08
+
+/* use native 64-bit arithmetic */
+#define unix_time_to_vms(X,Y) \
+ { unsigned long long reftime, tmptime = (X); \
+ $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
+ SYS$BINTIM (&unixtime, &reftime); \
+ Y = tmptime * 10000000 + reftime; }
+
+/* descrip.h doesn't have everything ... */
+struct dsc$descriptor_fib
+{
+ unsigned long fib$l_len;
+ struct fibdef *fib$l_addr;
+};
+
+struct IOSB
+{
+ unsigned short status, count;
+ unsigned long devdep;
+};
+
+static char *tryfile;
+
+struct vstring
+{
+ short length;
+ char string [NAM$C_MAXRSS+1];
+};
+
+
+#else
+#include <utime.h>
+#endif
+
+#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
#include <process.h>
#endif
#endif
}
+/* Set the file time stamp */
+
+void
+__gnat_set_file_time_name (name, time_stamp)
+ char *name;
+ time_t time_stamp;
+{
+#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
+#elif defined (VMS)
+ struct FAB fab;
+ struct NAM nam;
+
+ struct
+ {
+ unsigned long long backup, create, expire, revise;
+ unsigned long uic;
+ union
+ {
+ unsigned short value;
+ struct
+ {
+ unsigned system : 4;
+ unsigned owner : 4;
+ unsigned group : 4;
+ unsigned world : 4;
+ } bits;
+ } prot;
+ } Fat = { 0 };
+
+ ATRDEF atrlst []
+ = {
+ { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
+ { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
+ { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
+ { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
+ n{ ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
+ { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
+ { 0, 0, 0}
+ };
+
+ FIBDEF fib;
+ struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
+
+ struct IOSB iosb;
+
+ unsigned long long newtime;
+ unsigned long long revtime;
+ long status;
+ short chan;
+
+ struct vstring file;
+ struct dsc$descriptor_s filedsc
+ = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
+ struct vstring device;
+ struct dsc$descriptor_s devicedsc
+ = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
+ struct vstring timev;
+ struct dsc$descriptor_s timedsc
+ = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
+ struct vstring result;
+ struct dsc$descriptor_s resultdsc
+ = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
+
+ tryfile = (char *) __gnat_to_host_dir_spec (name, 0);
+
+ /* Allocate and initialize a fab and nam structures. */
+ fab = cc$rms_fab;
+ nam = cc$rms_nam;
+
+ nam.nam$l_esa = file.string;
+ nam.nam$b_ess = NAM$C_MAXRSS;
+ nam.nam$l_rsa = result.string;
+ nam.nam$b_rss = NAM$C_MAXRSS;
+ fab.fab$l_fna = tryfile;
+ fab.fab$b_fns = strlen (tryfile);
+ fab.fab$l_nam = &nam;
+
+ /*Validate filespec syntax and device existence. */
+ status = SYS$PARSE (&fab, 0, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+
+ file.string [nam.nam$b_esl] = 0;
+
+ /* Find matching filespec. */
+ status = SYS$SEARCH (&fab, 0, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+
+ file.string [nam.nam$b_esl] = 0;
+ result.string [result.length=nam.nam$b_rsl] = 0;
+
+ /* Get the device name and assign an IO channel. */
+ strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
+ devicedsc.dsc$w_length = nam.nam$b_dev;
+ chan = 0;
+ status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+
+ /* Initialize the FIB and fill in the directory id field. */
+ bzero (&fib, sizeof (fib));
+ fib.fib$w_did [0] = nam.nam$w_did [0];
+ fib.fib$w_did [1] = nam.nam$w_did [1];
+ fib.fib$w_did [2] = nam.nam$w_did [2];
+ fib.fib$l_acctl = 0;
+ fib.fib$l_wcc = 0;
+ strcpy (file.string, (strrchr (result.string, ']') + 1));
+ filedsc.dsc$w_length = strlen (file.string);
+ result.string [result.length = 0] = 0;
+
+ /* Open and close the file to fill in the attributes. */
+ status
+ = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
+ &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+ if ((iosb.status & 1) != 1)
+ LIB$SIGNAL (iosb.status);
+
+ result.string [result.length] = 0;
+ status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
+ &fibdsc, 0, 0, 0, &atrlst, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+ if ((iosb.status & 1) != 1)
+ LIB$SIGNAL (iosb.status);
+
+ /* Set creation time to requested time */
+ unix_time_to_vms (time_stamp, newtime);
+
+ {
+ time_t t;
+ struct tm *ts;
+
+ t = time ((time_t) 0);
+ ts = localtime (&t);
+
+ /* Set revision time to now in local time. */
+ unix_time_to_vms (t + ts->tm_gmtoff, revtime);
+ }
+
+ /* Reopen the file, modify the times and then close. */
+ fib.fib$l_acctl = FIB$M_WRITE;
+ status
+ = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
+ &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+ if ((iosb.status & 1) != 1)
+ LIB$SIGNAL (iosb.status);
+
+ Fat.create = newtime;
+ Fat.revise = revtime;
+
+ status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
+ &fibdsc, 0, 0, 0, &atrlst, 0);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+ if ((iosb.status & 1) != 1)
+ LIB$SIGNAL (iosb.status);
+
+ /* Deassign the channel and exit. */
+ status = SYS$DASSGN (chan);
+ if ((status & 1) != 1)
+ LIB$SIGNAL (status);
+#else
+ struct utimbuf utimbuf;
+ time_t t;
+
+ /* Set modification time to requested time */
+ utimbuf.modtime = time_stamp;
+
+ /* Set access time to now in local time */
+ t = time ((time_t) 0);
+ utimbuf.actime = mktime (localtime (&t));
+
+ utime (name, &utimbuf);
+#endif
+}
+
void
__gnat_get_env_value_ptr (name, len, value)
char *name;
-- --
-- B o d y --
-- --
--- $Revision: 1.1 $
+-- $Revision$
-- --
-- Copyright (C) 1998-2001 Ada Core Technologies, Inc. --
-- --
Compilation_Mode : Boolean := False;
Overwrite_Files : Boolean := False;
+ Preserve_Mode : Boolean := False;
Quiet_Mode : Boolean := False;
Source_References : Boolean := False;
Verbose_Mode : Boolean := False;
procedure Error_Msg (Message : String);
-- Produce an error message on standard error output
+ procedure File_Time_Stamp (Name : C_File_Name; Time : OS_Time);
+ -- Given the name of a file or directory, Name, set the
+ -- time stamp. This function must be used for an unopened file.
+
function Files_Exist return Boolean;
-- Check Unit.Table for possible file names that already exist
-- in the file system. Returns true if files exist, False otherwise
procedure Write_Unit
(Source : access String;
Num : Unit_Num;
+ TS_Time : OS_Time;
Success : out Boolean);
-- Write one compilation unit of the source to file
end if;
end Error_Msg;
+ ---------------------
+ -- File_Time_Stamp --
+ ---------------------
+
+ procedure File_Time_Stamp (Name : C_File_Name; Time : OS_Time) is
+ procedure Set_File_Time (Name : C_File_Name; Time : OS_Time);
+ pragma Import (C, Set_File_Time, "__gnat_set_file_time_name");
+
+ begin
+ Set_File_Time (Name, Time);
+ end File_Time_Stamp;
+
-----------------
-- Files_Exist --
-----------------
-- Scan options first
loop
- case Getopt ("c gnat? h k? q r v w x") is
+ case Getopt ("c gnat? h k? p q r v w x") is
when ASCII.NUL =>
exit;
Kset := True;
end;
+ when 'p' =>
+ Preserve_Mode := True;
+
when 'q' =>
Quiet_Mode := True;
begin
Put_Line
("Usage: gnatchop [-c] [-h] [-k#] " &
- "[-r] [-q] [-v] [-w] [-x] file [file ...] [dir]");
+ "[-r] [-p] [-q] [-v] [-w] [-x] file [file ...] [dir]");
New_Line;
Put_Line
"no more than 8 characters");
Put_Line
+ (" -p preserve time stamp, output files will " &
+ "have same stamp as input");
+
+ Put_Line
(" -q quiet mode, no output of generated file " &
"names");
FD : File_Descriptor;
Buffer : String_Access;
Success : Boolean;
+ TS_Time : OS_Time;
begin
FD := Open_Read (Name'Address, Binary);
+ TS_Time := File_Time_Stamp (FD);
if FD = Invalid_FD then
Error_Msg ("cannot open " & File.Table (Input).Name.all);
for Num in 1 .. Unit.Last loop
if Unit.Table (Num).Chop_File = Input then
- Write_Unit (Buffer, Num, Success);
+ Write_Unit (Buffer, Num, TS_Time, Success);
exit when not Success;
end if;
end loop;
procedure Write_Unit
(Source : access String;
Num : Unit_Num;
+ TS_Time : OS_Time;
Success : out Boolean)
is
Info : Unit_Info renames Unit.Table (Num);
end if;
Close (FD);
+
+ if Preserve_Mode then
+ File_Time_Stamp (Name'Address, TS_Time);
+ end if;
+
end Write_Unit;
-- Start of processing for gnatchop
OSDN Git Service
