diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/Makefile.rtl | 8 | ||||
| -rw-r--r-- | gcc/ada/adaint.c | 997 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 1 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 86 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 20 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 13 | ||||
| -rw-r--r-- | gcc/ada/s-asthan.adb | 58 | ||||
| -rw-r--r-- | gcc/ada/s-asthan.ads | 57 | ||||
| -rw-r--r-- | gcc/ada/s-filofl.ads | 53 | ||||
| -rw-r--r-- | gcc/ada/s-fishfl.ads | 53 | ||||
| -rw-r--r-- | gcc/ada/s-fvadfl.ads | 51 | ||||
| -rw-r--r-- | gcc/ada/s-fvaffl.ads | 51 | ||||
| -rw-r--r-- | gcc/ada/s-fvagfl.ads | 51 | ||||
| -rw-r--r-- | gcc/ada/s-os_lib.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-po32gl.adb | 98 | ||||
| -rw-r--r-- | gcc/ada/s-po32gl.ads | 80 | ||||
| -rw-r--r-- | gcc/ada/s-vaflop.adb | 505 | ||||
| -rw-r--r-- | gcc/ada/s-vaflop.ads | 230 | ||||
| -rw-r--r-- | gcc/ada/s-vmexta.adb | 187 | ||||
| -rw-r--r-- | gcc/ada/s-vmexta.ads | 67 | ||||
| -rw-r--r-- | gcc/ada/sem_vfpt.adb | 140 | ||||
| -rw-r--r-- | gcc/ada/sem_vfpt.ads | 55 | ||||
| -rw-r--r-- | gcc/ada/socket.c | 52 |
24 files changed, 86 insertions, 2846 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4e5bbb5..08dc0bc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,20 @@ 2014-08-01 Robert Dewar <dewar@adacore.com> + * gnat_rm.texi: Remove VMS specific rules for pragma Ident. + * Makefile.rtl, adaint.c, gnat_rm.texi, s-asthan.adb, s-asthan.ads, + s-filofl.ads, s-fishfl.ads, s-fvadfl.ads, s-fvaffl.ads, s-fvagfl.ads, + s-po32gl.adb, s-po32gl.ads, s-vaflop.adb, s-vaflop.ads, s-vmexta.adb, + s-vmexta.ads, sem_vfpt.adb, sem_vfpt.ads, socket.c: Remove VMS specific + code. + * gcc-interface/decl.c, gcc-interface/Makefile.in, + gcc-interface/Make-lang.in: Ditto. Also remove refs to rTX. + +2014-08-01 Pascal Obry <obry@adacore.com> + + * s-os_lib.ads: Rename File_Size to Large_File_Size. + +2014-08-01 Robert Dewar <dewar@adacore.com> + * a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads, a-numaux-darwin.adb, a-numaux-darwin.ads, a-numaux.ads, a-numaux-libc-x86.ads: Fix bad package header comments. diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 306be0e..cfab8cf 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -44,7 +44,6 @@ GNATRTL_TASKING_OBJS= \ g-signal$(objext) \ g-tastus$(objext) \ g-thread$(objext) \ - s-asthan$(objext) \ s-inmaop$(objext) \ s-interr$(objext) \ s-intman$(objext) \ @@ -540,15 +539,10 @@ GNATRTL_NONTASKING_OBJS= \ s-ficobl$(objext) \ s-filatt$(objext) \ s-fileio$(objext) \ - s-filofl$(objext) \ s-finmas$(objext) \ s-finroo$(objext) \ - s-fishfl$(objext) \ s-flocon$(objext) \ s-fore$(objext) \ - s-fvadfl$(objext) \ - s-fvaffl$(objext) \ - s-fvagfl$(objext) \ s-gearop$(objext) \ s-geveop$(objext) \ s-gloloc$(objext) \ @@ -674,7 +668,6 @@ GNATRTL_NONTASKING_OBJS= \ s-traent$(objext) \ s-unstyp$(objext) \ s-utf_32$(objext) \ - s-vaflop$(objext) \ s-valboo$(objext) \ s-valcha$(objext) \ s-valdec$(objext) \ @@ -690,7 +683,6 @@ GNATRTL_NONTASKING_OBJS= \ s-veboop$(objext) \ s-vector$(objext) \ s-vercon$(objext) \ - s-vmexta$(objext) \ s-wchcnv$(objext) \ s-wchcon$(objext) \ s-wchjis$(objext) \ diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index ecf961d..44839ea 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -71,12 +71,6 @@ #include <sys/pstat.h> #endif -#ifdef VMS -#define _POSIX_EXIT 1 -#define HOST_EXECUTABLE_SUFFIX ".exe" -#define HOST_OBJECT_SUFFIX ".obj" -#endif - #ifdef __PikeOS__ #define __BSD_VISIBLE 1 #endif @@ -87,9 +81,6 @@ #include <sys/stat.h> #include <fcntl.h> #include <time.h> -#ifdef VMS -#include <unixio.h> -#endif #if defined (__vxworks) || defined (__ANDROID__) /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */ @@ -147,7 +138,7 @@ UINT CurrentCCSEncoding; #include <utime.h> #undef VMOS_DEV -#elif !defined (VMS) +#else #include <utime.h> #endif @@ -174,75 +165,17 @@ UINT CurrentCCSEncoding; #endif #if defined (_WIN32) -#elif defined (VMS) - -/* Header files and definitions for __gnat_set_file_time_name. */ - -#define __NEW_STARLET 1 -#include <vms/rms.h> -#include <vms/atrdef.h> -#include <vms/fibdef.h> -#include <vms/stsdef.h> -#include <vms/iodef.h> -#include <errno.h> -#include <vms/descrip.h> -#include <string.h> -#include <unixlib.h> - -/* 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 ... */ -typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) )); -struct dsc$descriptor_fib -{ - unsigned int fib$l_len; - __fibdef_ptr32 fib$l_addr; -}; - -/* I/O Status Block. */ -struct IOSB -{ - unsigned short status, count; - unsigned int devdep; -}; - -static char *tryfile; -/* Variable length string. */ -struct vstring -{ - short length; - char string[NAM$C_MAXRSS+1]; -}; - -#define SYI$_ACTIVECPU_CNT 0x111e -extern int LIB$GETSYI (int *, unsigned int *); -extern unsigned int LIB$CALLG_64 (unsigned long long argument_list [], - int (*user_procedure)(void)); - -#else -#include <utime.h> -#endif - -#if defined (_WIN32) #include <process.h> -#endif - -#if defined (_WIN32) - #include <dir.h> #include <windows.h> #include <accctrl.h> #include <aclapi.h> #undef DIR_SEPARATOR #define DIR_SEPARATOR '\\' + +#else +#include <utime.h> #endif #include "adaint.h" @@ -315,27 +248,12 @@ char __gnat_path_separator = PATH_SEPARATOR; as well. This is only a temporary work-around for 3.11b. */ #ifndef GNAT_LIBRARY_TEMPLATE -#if defined (VMS) -#define GNAT_LIBRARY_TEMPLATE "*.olb" -#else #define GNAT_LIBRARY_TEMPLATE "lib*.a" #endif -#endif const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE; -/* This variable is used in hostparm.ads to say whether the host is a VMS - system. */ -#ifdef VMS -int __gnat_vmsp = 1; -#else -int __gnat_vmsp = 0; -#endif - -#if defined (VMS) -#define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */ - -#elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__) +#if defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__) #define GNAT_MAX_PATH_LEN PATH_MAX #else @@ -382,37 +300,7 @@ int __gnat_use_acl = 1; system provides the routine readdir_r. */ #undef HAVE_READDIR_R -#if defined(VMS) && defined (__LONG_POINTERS) - -/* Return a 32 bit pointer to an array of 32 bit pointers - given a 64 bit pointer to an array of 64 bit pointers */ - -typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI))); - -static __char_ptr_char_ptr32 -to_ptr32 (char **ptr64) -{ - int argc; - __char_ptr_char_ptr32 short_argv; - - for (argc = 0; ptr64[argc]; argc++) - ; - - /* Reallocate argv with 32 bit pointers. */ - short_argv = (__char_ptr_char_ptr32) decc$malloc - (sizeof (__char_ptr32) * (argc + 1)); - - for (argc = 0; ptr64[argc]; argc++) - short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]); - - short_argv[argc] = (__char_ptr32) 0; - return short_argv; - -} -#define MAYBE_TO_PTR32(argv) to_ptr32 (argv) -#else #define MAYBE_TO_PTR32(argv) argv -#endif static const char ATTR_UNSET = 127; @@ -485,12 +373,7 @@ __gnat_to_gm_time (OS_Time *p_time, int *p_year, int *p_month, int *p_day, time++; #endif -#ifdef VMS - res = localtime (&time); -#else res = gmtime (&time); -#endif - if (res) { *p_year = res->tm_year; @@ -533,7 +416,7 @@ __gnat_readlink (char *path ATTRIBUTE_UNUSED, char *buf ATTRIBUTE_UNUSED, size_t bufsiz ATTRIBUTE_UNUSED) { -#if defined (_WIN32) || defined (VMS) \ +#if defined (_WIN32) \ || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__) return -1; #else @@ -549,7 +432,7 @@ int __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED, char *newpath ATTRIBUTE_UNUSED) { -#if defined (_WIN32) || defined (VMS) \ +#if defined (_WIN32) \ || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__) return -1; #else @@ -560,7 +443,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED, /* Try to lock a file, return 1 if success. */ #if defined (__vxworks) || defined (__nucleus__) \ - || defined (_WIN32) || defined (VMS) || defined (__PikeOS__) + || defined (_WIN32) || defined (__PikeOS__) /* Version that does not use link. */ @@ -632,14 +515,7 @@ __gnat_try_lock (char *dir, char *file) int __gnat_get_maximum_file_name_length (void) { -#if defined (VMS) - if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS")) - return -1; - else - return 39; -#else return -1; -#endif } /* Return nonzero if file names are case sensitive. */ @@ -658,7 +534,7 @@ __gnat_get_file_names_case_sensitive (void) && sensitive[1] == '\0') file_names_case_sensitive_cache = sensitive[0] - '0'; else -#if defined (VMS) || defined (WINNT) || defined (__APPLE__) +#if defined (WINNT) || defined (__APPLE__) file_names_case_sensitive_cache = 0; #else file_names_case_sensitive_cache = 1; @@ -672,7 +548,7 @@ __gnat_get_file_names_case_sensitive (void) int __gnat_get_env_vars_case_sensitive (void) { -#if defined (VMS) || defined (WINNT) +#if defined (WINNT) return 0; #else return 1; @@ -697,9 +573,6 @@ __gnat_get_current_dir (char *dir, int *length) WS2SC (dir, wdir, GNAT_MAX_PATH_LEN); -#elif defined (VMS) - /* Force Unix style, which is what GNAT uses internally. */ - getcwd (dir, *length, 0); #else getcwd (dir, *length); #endif @@ -888,38 +761,7 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED, S2WS (wpath, path, GNAT_MAX_PATH_LEN); return _tfopen (wpath, wmode); -#elif defined (VMS) - if (vms_form == 0) - return decc$fopen (path, mode); - else - { - char *local_form = (char *) alloca (strlen (vms_form) + 1); - /* Allocate an argument list of guaranteed ample length. */ - unsigned long long *arg_list = - (unsigned long long *) alloca (strlen (vms_form) + 3); - char *ptrb, *ptre; - int i; - - arg_list [1] = (unsigned long long) path; - arg_list [2] = (unsigned long long) mode; - strcpy (local_form, vms_form); - - /* Given a string such as "\"rfm=udf\",\"rat=cr\"" - Split it into an argument list as "rfm=udf","rat=cr". */ - ptrb = local_form; - for (i = 0; *ptrb; i++) - { - ptrb = strchr (ptrb, '"'); - ptre = strchr (ptrb + 1, '"'); - *ptre = 0; - arg_list [i + 3] = (unsigned long long) (ptrb + 1); - ptrb = ptre + 1; - } - arg_list [0] = i + 2; - /* CALLG_64 returns int , fortunately (FILE *) on VMS is a - always a 32bit pointer. */ - return LIB$CALLG_64 (arg_list, &decc$fopen); - } + #else return GNAT_FOPEN (path, mode); #endif @@ -946,39 +788,6 @@ __gnat_freopen (char *path, S2WS (wpath, path, GNAT_MAX_PATH_LEN); return _tfreopen (wpath, wmode, stream); -#elif defined (VMS) - if (vms_form == 0) - return decc$freopen (path, mode, stream); - else - { - char *local_form = (char *) alloca (strlen (vms_form) + 1); - /* Allocate an argument list of guaranteed ample length. */ - unsigned long long *arg_list = - (unsigned long long *) alloca (strlen (vms_form) + 4); - char *ptrb, *ptre; - int i; - - arg_list [1] = (unsigned long long) path; - arg_list [2] = (unsigned long long) mode; - arg_list [3] = (unsigned long long) stream; - strcpy (local_form, vms_form); - - /* Given a string such as "\"rfm=udf\",\"rat=cr\"" - Split it into an argument list as "rfm=udf","rat=cr". */ - ptrb = local_form; - for (i = 0; *ptrb; i++) - { - ptrb = strchr (ptrb, '"'); - ptre = strchr (ptrb + 1, '"'); - *ptre = 0; - arg_list [i + 4] = (unsigned long long) (ptrb + 1); - ptrb = ptre + 1; - } - arg_list [0] = i + 3; - /* CALLG_64 returns int , fortunately (FILE *) on VMS is a - always a 32bit pointer. */ - return LIB$CALLG_64 (arg_list, &decc$freopen); - } #else return freopen (path, mode, stream); #endif @@ -993,11 +802,7 @@ __gnat_open_read (char *path, int fmode) if (fmode) o_fmode = O_TEXT; -#if defined (VMS) - /* Optional arguments mbc,deq,fop increase read performance. */ - fd = open (path, O_RDONLY | o_fmode, 0444, - "mbc=16", "deq=64", "fop=tef"); -#elif defined (__vxworks) +#if defined (__vxworks) fd = open (path, O_RDONLY | o_fmode, 0444); #elif defined (__MINGW32__) { @@ -1015,15 +820,6 @@ __gnat_open_read (char *path, int fmode) #if defined (__MINGW32__) #define PERM (S_IREAD | S_IWRITE) -#elif defined (VMS) -/* Excerpt from DECC C RTL Reference Manual: - To create files with OpenVMS RMS default protections using the UNIX - system-call functions umask, mkdir, creat, and open, call mkdir, creat, - and open with a file-protection mode argument of 0777 in a program - that never specifically calls umask. These default protections include - correctly establishing protections based on ACLs, previous versions of - files, and so on. */ -#define PERM 0777 #else #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH) #endif @@ -1037,10 +833,7 @@ __gnat_open_rw (char *path, int fmode) if (fmode) o_fmode = O_TEXT; -#if defined (VMS) - fd = open (path, O_RDWR | o_fmode, PERM, - "mbc=16", "deq=64", "fop=tef"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1063,10 +856,7 @@ __gnat_open_create (char *path, int fmode) if (fmode) o_fmode = O_TEXT; -#if defined (VMS) - fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM, - "mbc=16", "deq=64", "fop=tef"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1084,11 +874,7 @@ int __gnat_create_output_file (char *path) { int fd; -#if defined (VMS) - fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM, - "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk", - "shr=del,get,put,upd"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1106,11 +892,7 @@ int __gnat_create_output_file_new (char *path) { int fd; -#if defined (VMS) - fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM, - "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk", - "shr=del,get,put,upd"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1133,10 +915,7 @@ __gnat_open_append (char *path, int fmode) if (fmode) o_fmode = O_TEXT; -#if defined (VMS) - fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM, - "mbc=16", "deq=64", "fop=tef"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1161,10 +940,7 @@ __gnat_open_new (char *path, int fmode) if (fmode) o_fmode = O_TEXT; -#if defined (VMS) - fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM, - "mbc=16", "deq=64", "fop=tef"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1178,9 +954,7 @@ __gnat_open_new (char *path, int fmode) return fd < 0 ? -1 : fd; } -/* Open a new temp file. Return error (-1) if the file already exists. - Special options for VMS allow the file to be shared between parent and child - processes, however they really slow down output. Used in gnatchop. */ +/* Open a new temp file. Return error (-1) if the file already exists. */ int __gnat_open_new_temp (char *path, int fmode) @@ -1205,17 +979,7 @@ __gnat_open_new_temp (char *path, int fmode) if (fmode) o_fmode = O_TEXT; -#if defined (VMS) - /* Passing rfm=stmlf for binary files seems questionable since it results - in having an extraneous line feed added after every call to CRTL write, - so pass rfm=udf (aka undefined) instead. */ - fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM, - fmode ? "rfm=stmlf" : "rfm=udf", "ctx=rec", "rat=none", - "shr=del,get,put,upd", "mbc=16", "deq=64", "fop=tef"); -#else fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM); -#endif - return fd < 0 ? -1 : fd; } @@ -1224,9 +988,7 @@ __gnat_open (char *path, int fmode) { int fd; -#if defined (VMS) - fd = open (path, fmode, PERM, "mbc=16", "deq=64", "fop=tef"); -#elif defined (__MINGW32__) +#if defined (__MINGW32__) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1295,12 +1057,7 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr) if (ret != 0) { attr->timestamp = (OS_Time)-1; } else { -#ifdef VMS - /* VMS has file versioning. */ - attr->timestamp = (OS_Time)statbuf.st_ctime; -#else attr->timestamp = (OS_Time)statbuf.st_mtime; -#endif } } @@ -1660,168 +1417,6 @@ __gnat_set_file_time_name (char *name, time_t time_stamp) CloseHandle (h); return; -#elif defined (VMS) - struct FAB fab; - struct NAM nam; - - struct - { - unsigned long long backup, create, expire, revise; - unsigned int uic; - union - { - unsigned short value; - struct - { - unsigned system : 4; - unsigned owner : 4; - unsigned group : 4; - unsigned world : 4; - } bits; - } prot; - } Fat = { 0, 0, 0, 0, 0, { 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 }, - { 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}; - - /* Convert parameter name (a file spec) to host file form. Note that this - is needed on VMS to prepare for subsequent calls to VMS RMS library - routines. Note that it would not work to call __gnat_to_host_dir_spec - as was done in a previous version, since this fails silently unless - the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF - (directory not found) condition is signalled. */ - tryfile = (char *) __gnat_to_host_file_spec (name); - - /* 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. */ - memset (&fib, 0, 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); - - { - time_t t; - - /* Set creation time to requested time. */ - unix_time_to_vms (time_stamp, newtime); - - t = time ((time_t) 0); - - /* Set revision time to now in local time. */ - unix_time_to_vms (t, 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; @@ -2605,11 +2200,7 @@ __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED) { /* The child. */ if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0) -#if defined (VMS) - return -1; /* execv is in parent context on VMS. */ -#else _exit (1); -#endif } /* The parent. */ @@ -2683,15 +2274,6 @@ __gnat_number_of_cpus (void) GetSystemInfo (&sysinfo); cores = (int) sysinfo.dwNumberOfProcessors; -#elif defined (VMS) - int code = SYI$_ACTIVECPU_CNT; - unsigned int res; - int status; - - status = LIB$GETSYI (&code, &res); - if ((status & 1) != 0) - cores = res; - #elif defined (_WRS_CONFIG_SMP) unsigned int vxCpuConfiguredGet (void); @@ -2934,11 +2516,7 @@ __gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED) { /* The child. */ if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0) -#if defined (VMS) - return -1; /* execv is in parent context on VMS. */ -#else _exit (1); -#endif } return pid; @@ -3155,12 +2733,8 @@ __gnat_locate_exec_on_path (char *exec_name) return __gnat_locate_exec (exec_name, apath_val); #else - -#ifdef VMS - char *path_val = "/VAXC$PATH"; -#else char *path_val = getenv ("PATH"); -#endif + if (path_val == NULL) return NULL; apath_val = (char *) alloca (strlen (path_val) + 1); strcpy (apath_val, path_val); @@ -3168,492 +2742,8 @@ __gnat_locate_exec_on_path (char *exec_name) #endif } -#ifdef VMS - -/* These functions are used to translate to and from VMS and Unix syntax - file, directory and path specifications. */ - -#define MAXPATH 256 -#define MAXNAMES 256 -#define NEW_CANONICAL_FILELIST_INCREMENT 64 - -static char new_canonical_dirspec [MAXPATH]; -static char new_canonical_filespec [MAXPATH]; -static char new_canonical_pathspec [MAXNAMES*MAXPATH]; -static unsigned new_canonical_filelist_index; -static unsigned new_canonical_filelist_in_use; -static unsigned new_canonical_filelist_allocated; -static char **new_canonical_filelist; -static char new_host_pathspec [MAXNAMES*MAXPATH]; -static char new_host_dirspec [MAXPATH]; -static char new_host_filespec [MAXPATH]; - -/* Routine is called repeatedly by decc$from_vms via - __gnat_to_canonical_file_list_init until it returns 0 or the expansion - runs out. */ - -static int -wildcard_translate_unix (char *name) -{ - char *ver; - char buff [MAXPATH]; - - strncpy (buff, name, MAXPATH); - buff [MAXPATH - 1] = (char) 0; - ver = strrchr (buff, '.'); - - /* Chop off the version. */ - if (ver) - *ver = 0; - - /* Dynamically extend the allocation by the increment. */ - if (new_canonical_filelist_in_use == new_canonical_filelist_allocated) - { - new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT; - new_canonical_filelist = (char **) xrealloc - (new_canonical_filelist, - new_canonical_filelist_allocated * sizeof (char *)); - } - - new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff); - - return 1; -} - -/* Translate a wildcard VMS file spec into a list of Unix file specs. First do - full translation and copy the results into a list (_init), then return them - one at a time (_next). If onlydirs set, only expand directory files. */ - -int -__gnat_to_canonical_file_list_init (char *filespec, int onlydirs) -{ - int len; - char buff [MAXPATH]; - - len = strlen (filespec); - strncpy (buff, filespec, MAXPATH); - - /* Only look for directories */ - if (onlydirs && !strstr (&buff [len-5], "*.dir")) - strncat (buff, "*.dir", MAXPATH); - - buff [MAXPATH - 1] = (char) 0; - - decc$from_vms (buff, wildcard_translate_unix, 1); - - /* Remove the .dir extension. */ - if (onlydirs) - { - int i; - char *ext; - - for (i = 0; i < new_canonical_filelist_in_use; i++) - { - ext = strstr (new_canonical_filelist[i], ".dir"); - if (ext) - *ext = 0; - } - } - - return new_canonical_filelist_in_use; -} - -/* Return the next filespec in the list. */ - -char * -__gnat_to_canonical_file_list_next (void) -{ - return new_canonical_filelist[new_canonical_filelist_index++]; -} - -/* Free storage used in the wildcard expansion. */ - -void -__gnat_to_canonical_file_list_free (void) -{ - int i; - - for (i = 0; i < new_canonical_filelist_in_use; i++) - free (new_canonical_filelist[i]); - - free (new_canonical_filelist); - - new_canonical_filelist_in_use = 0; - new_canonical_filelist_allocated = 0; - new_canonical_filelist_index = 0; - new_canonical_filelist = 0; -} - -/* The functional equivalent of decc$translate_vms routine. - Designed to produce the same output, but is protected against - malformed paths (original version ACCVIOs in this case) and - does not require VMS-specific DECC RTL. */ - -#define NAM$C_MAXRSS 1024 - -char * -__gnat_translate_vms (char *src) -{ - static char retbuf [NAM$C_MAXRSS + 1]; - char *srcendpos, *pos1, *pos2, *retpos; - int disp, path_present = 0; - - if (!src) - return NULL; - - srcendpos = strchr (src, '\0'); - retpos = retbuf; - - /* Look for the node and/or device in front of the path. */ - pos1 = src; - pos2 = strchr (pos1, ':'); - - if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) - { - /* There is a node name. "node_name::" becomes "node_name!". */ - disp = pos2 - pos1; - strncpy (retbuf, pos1, disp); - retpos [disp] = '!'; - retpos = retpos + disp + 1; - pos1 = pos2 + 2; - pos2 = strchr (pos1, ':'); - } - - if (pos2) - { - /* There is a device name. "dev_name:" becomes "/dev_name/". */ - *(retpos++) = '/'; - disp = pos2 - pos1; - strncpy (retpos, pos1, disp); - retpos = retpos + disp; - pos1 = pos2 + 1; - *(retpos++) = '/'; - } - else - /* No explicit device; we must look ahead and prepend /sys$disk/ if - the path is absolute. */ - if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos) - && !strchr (".-]>", *(pos1 + 1))) - { - strncpy (retpos, "/sys$disk/", 10); - retpos += 10; - } - - /* Process the path part. */ - while (*pos1 == '[' || *pos1 == '<') - { - path_present++; - pos1++; - if (*pos1 == ']' || *pos1 == '>') - { - /* Special case, [] translates to '.'. */ - *(retpos++) = '.'; - pos1++; - } - else - { - /* '[000000' means root dir. It can be present in the middle of - the path due to expansion of logical devices, in which case - we skip it. */ - if (!strncmp (pos1, "000000", 6) && path_present > 1 && - (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) - { - pos1 += 6; - if (*pos1 == '.') pos1++; - } - else if (*pos1 == '.') - { - /* Relative path. */ - *(retpos++) = '.'; - } - - /* There is a qualified path. */ - while (*pos1 && *pos1 != ']' && *pos1 != '>') - { - switch (*pos1) - { - case '.': - /* '.' is used to separate directories. Replace it with '/' - but only if there isn't already '/' just before. */ - if (*(retpos - 1) != '/') - *(retpos++) = '/'; - pos1++; - if (pos1 + 1 < srcendpos - && *pos1 == '.' - && *(pos1 + 1) == '.') - { - /* Ellipsis refers to entire subtree; replace - with '**'. */ - *(retpos++) = '*'; - *(retpos++) = '*'; - *(retpos++) = '/'; - pos1 += 2; - } - break; - case '-' : - /* When after '.' '[' '<' is equivalent to Unix ".." but - there may be several in a row. */ - if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' || - *(pos1 - 1) == '<') - { - while (*pos1 == '-') - { - pos1++; - *(retpos++) = '.'; - *(retpos++) = '.'; - *(retpos++) = '/'; - } - retpos--; - break; - } - /* Otherwise fall through to default. */ - default: - *(retpos++) = *(pos1++); - } - } - pos1++; - } - } - - if (pos1 < srcendpos) - { - /* Now add the actual file name, until the version suffix if any */ - if (path_present) - *(retpos++) = '/'; - pos2 = strchr (pos1, ';'); - disp = pos2? (pos2 - pos1) : (srcendpos - pos1); - strncpy (retpos, pos1, disp); - retpos += disp; - if (pos2 && pos2 < srcendpos) - { - /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */ - *retpos++ = '.'; - disp = srcendpos - pos2 - 1; - strncpy (retpos, pos2 + 1, disp); - retpos += disp; - } - } - - *retpos = '\0'; - - return retbuf; -} - -/* Translate a VMS syntax directory specification in to Unix syntax. If - PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax - found, return input string. Also translate a dirname that contains no - slashes, in case it's a logical name. */ - -char * -__gnat_to_canonical_dir_spec (char *dirspec, int prefixflag) -{ - int len; - - strcpy (new_canonical_dirspec, ""); - if (strlen (dirspec)) - { - char *dirspec1; - - if (strchr (dirspec, ']') || strchr (dirspec, ':')) - { - strncpy (new_canonical_dirspec, - __gnat_translate_vms (dirspec), - MAXPATH); - } - else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0) - { - strncpy (new_canonical_dirspec, - __gnat_translate_vms (dirspec1), - MAXPATH); - } - else - { - strncpy (new_canonical_dirspec, dirspec, MAXPATH); - } - } - - len = strlen (new_canonical_dirspec); - if (prefixflag && new_canonical_dirspec [len-1] != '/') - strncat (new_canonical_dirspec, "/", MAXPATH); - - new_canonical_dirspec [MAXPATH - 1] = (char) 0; - - return new_canonical_dirspec; - -} - -/* Translate a VMS syntax file specification into Unix syntax. - If no indicators of VMS syntax found, check if it's an uppercase - alphanumeric_ name and if so try it out as an environment - variable (logical name). If all else fails return the - input string. */ - -char * -__gnat_to_canonical_file_spec (char *filespec) -{ - char *filespec1; - - strncpy (new_canonical_filespec, "", MAXPATH); - - if (strchr (filespec, ']') || strchr (filespec, ':')) - { - char *tspec = (char *) __gnat_translate_vms (filespec); - - if (tspec != (char *) -1) - strncpy (new_canonical_filespec, tspec, MAXPATH); - } - else if ((strlen (filespec) == strspn (filespec, - "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_")) - && (filespec1 = getenv (filespec))) - { - char *tspec = (char *) __gnat_translate_vms (filespec1); - - if (tspec != (char *) -1) - strncpy (new_canonical_filespec, tspec, MAXPATH); - } - else - { - strncpy (new_canonical_filespec, filespec, MAXPATH); - } - - new_canonical_filespec [MAXPATH - 1] = (char) 0; - - return new_canonical_filespec; -} - -/* Translate a VMS syntax path specification into Unix syntax. - If no indicators of VMS syntax found, return input string. */ - -char * -__gnat_to_canonical_path_spec (char *pathspec) -{ - char *curr, *next, buff [MAXPATH]; - - if (pathspec == 0) - return pathspec; - - /* If there are /'s, assume it's a Unix path spec and return. */ - if (strchr (pathspec, '/')) - return pathspec; - - new_canonical_pathspec[0] = 0; - curr = pathspec; - - for (;;) - { - next = strchr (curr, ','); - if (next == 0) - next = strchr (curr, 0); - - strncpy (buff, curr, next - curr); - buff[next - curr] = 0; - - /* Check for wildcards and expand if present. */ - if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "...")) - { - int i, dirs; - - dirs = __gnat_to_canonical_file_list_init (buff, 1); - for (i = 0; i < dirs; i++) - { - char *next_dir; - - next_dir = __gnat_to_canonical_file_list_next (); - strncat (new_canonical_pathspec, next_dir, MAXPATH); - - /* Don't append the separator after the last expansion. */ - if (i+1 < dirs) - strncat (new_canonical_pathspec, ":", MAXPATH); - } - - __gnat_to_canonical_file_list_free (); - } - else - strncat (new_canonical_pathspec, - __gnat_to_canonical_dir_spec (buff, 0), MAXPATH); - - if (*next == 0) - break; - - strncat (new_canonical_pathspec, ":", MAXPATH); - curr = next + 1; - } - - new_canonical_pathspec [MAXPATH - 1] = (char) 0; - - return new_canonical_pathspec; -} - -static char filename_buff [MAXPATH]; - -static int -translate_unix (char *name, int type ATTRIBUTE_UNUSED) -{ - strncpy (filename_buff, name, MAXPATH); - filename_buff [MAXPATH - 1] = (char) 0; - return 0; -} - -/* Translate a Unix syntax directory specification into VMS syntax. The - PREFIXFLAG has no effect, but is kept for symmetry with - to_canonical_dir_spec. If indicators of VMS syntax found, return input - string. */ - -char * -__gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED) -{ - int len = strlen (dirspec); - - strncpy (new_host_dirspec, dirspec, MAXPATH); - new_host_dirspec [MAXPATH - 1] = (char) 0; - - if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':')) - return new_host_dirspec; - - while (len > 1 && new_host_dirspec[len - 1] == '/') - { - new_host_dirspec[len - 1] = 0; - len--; - } - - decc$to_vms (new_host_dirspec, translate_unix, 1, 2); - strncpy (new_host_dirspec, filename_buff, MAXPATH); - new_host_dirspec [MAXPATH - 1] = (char) 0; - - return new_host_dirspec; -} - -/* Translate a Unix syntax file specification into VMS syntax. - If indicators of VMS syntax found, return input string. */ - -char * -__gnat_to_host_file_spec (char *filespec) -{ - strncpy (new_host_filespec, "", MAXPATH); - if (strchr (filespec, ']') || strchr (filespec, ':')) - { - strncpy (new_host_filespec, filespec, MAXPATH); - } - else - { - decc$to_vms (filespec, translate_unix, 1, 1); - strncpy (new_host_filespec, filename_buff, MAXPATH); - } - - new_host_filespec [MAXPATH - 1] = (char) 0; - - return new_host_filespec; -} - -void -__gnat_adjust_os_resource_limits (void) -{ - SYS$ADJWSL (131072, 0); -} - -#else /* VMS */ - -/* Dummy functions for Osint import for non-VMS systems. */ +/* Dummy functions for Osint import for non-VMS systems. + ??? To be removed. */ int __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED, @@ -3709,8 +2799,6 @@ __gnat_adjust_os_resource_limits (void) { } -#endif - #if defined (__mips_vxworks) int _flush_cache (void) @@ -3719,35 +2807,6 @@ _flush_cache (void) } #endif -#if defined (IS_CROSS) \ - || (! ((defined (sparc) || defined (i386)) && defined (sun) \ - && defined (__SVR4)) \ - && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \ - && ! (defined (linux) && defined (__ia64__)) \ - && ! (defined (linux) && defined (powerpc)) \ - && ! defined (__FreeBSD__) \ - && ! defined (__Lynx__) \ - && ! defined (__hpux__) \ - && ! defined (__APPLE__) \ - && ! defined (_AIX) \ - && ! defined (VMS) \ - && ! defined (__MINGW32__)) - -/* Dummy function to satisfy g-trasym.o. See the preprocessor conditional - just above for a list of native platforms that provide a non-dummy - version of this procedure in libaddr2line.a. */ - -void -convert_addresses (const char *file_name ATTRIBUTE_UNUSED, - void *addrs ATTRIBUTE_UNUSED, - int n_addr ATTRIBUTE_UNUSED, - void *buf ATTRIBUTE_UNUSED, - int *len ATTRIBUTE_UNUSED) -{ - *len = 0; -} -#endif - #if defined (_WIN32) int __gnat_argument_needs_quote = 1; #else @@ -3788,7 +2847,7 @@ int __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED, int mode ATTRIBUTE_UNUSED) { -#if defined (VMS) || (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \ +#if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \ defined (__nucleus__) return -1; @@ -3931,11 +2990,7 @@ __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED, int __gnat_binder_supports_auto_init (void) { -#ifdef VMS - return 0; -#else - return 1; -#endif + return 1; } /* Indicates that Stand-Alone Libraries are automatically initialized through @@ -3943,7 +2998,7 @@ __gnat_binder_supports_auto_init (void) int __gnat_sals_init_using_constructors (void) { -#if defined (__vxworks) || defined (__Lynx__) || defined (VMS) +#if defined (__vxworks) || defined (__Lynx__) return 0; #else return 1; diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index b2c6498..fd44eb8 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -414,7 +414,6 @@ GNAT_ADA_OBJS = \ ada/sem_smem.o \ ada/sem_type.o \ ada/sem_util.o \ - ada/sem_vfpt.o \ ada/sem_warn.o \ ada/set_targ.o \ ada/sinfo-cn.o \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 892119b..dddbf75 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1643,28 +1643,32 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),) g-soliop.ads<g-soliop-mingw.ads \ $(ATOMICS_TARGET_PAIRS) - ifeq ($(strip $(filter-out rtx_w32 rtx_rtss,$(THREAD_KIND))),) - LIBGNAT_TARGET_PAIRS += \ - s-intman.adb<s-intman-dummy.adb \ - s-osinte.ads<s-osinte-rtx.ads \ - s-osprim.adb<s-osprim-rtx.adb \ - s-taprop.adb<s-taprop-rtx.adb \ - $(X86_TARGET_PAIRS) - - EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o - - ifeq ($(strip $(filter-out rtx_w32,$(THREAD_KIND))),) - LIBGNAT_TARGET_PAIRS += system.ads<system-rtx.ads + LIBGNAT_TARGET_PAIRS += \ + a-exetim.adb<a-exetim-mingw.adb \ + a-exetim.ads<a-exetim-mingw.ads \ + a-intnam.ads<a-intnam-mingw.ads \ + g-sercom.adb<g-sercom-mingw.adb \ + s-trasym.adb<s-trasym-dwarf.adb \ + s-tsmona.adb<s-tsmona-mingw.adb \ + s-interr.adb<s-interr-sigaction.adb \ + s-intman.adb<s-intman-mingw.adb \ + s-mudido.adb<s-mudido-affinity.adb \ + s-osinte.ads<s-osinte-mingw.ads \ + s-osprim.adb<s-osprim-mingw.adb \ + s-taprop.adb<s-taprop-mingw.adb - EH_MECHANISM=-gcc + ifeq ($(strip $(filter-out x86_64%,$(target_cpu))),) + ifeq ($(strip $(MULTISUBDIR)),/32) + LIBGNAT_TARGET_PAIRS += \ + $(X86_TARGET_PAIRS) \ + system.ads<system-mingw.ads + SO_OPTS= -m32 -Wl,-soname, else - LIBGNAT_TARGET_PAIRS += \ - system.ads<system-rtx-rtss.ads \ - s-parame.adb<s-parame-vxworks.adb - - EH_MECHANISM= + LIBGNAT_TARGET_PAIRS += \ + $(X86_64_TARGET_PAIRS) \ + system.ads<system-mingw-x86_64.ads + SO_OPTS = -m64 -Wl,-soname, endif - else LIBGNAT_TARGET_PAIRS += \ a-exetim.adb<a-exetim-mingw.adb \ @@ -1691,31 +1695,24 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),) SO_OPTS = -m64 -Wl,-soname, endif else - ifeq ($(strip $(MULTISUBDIR)),/64) - LIBGNAT_TARGET_PAIRS += \ - $(X86_64_TARGET_PAIRS) \ - system.ads<system-mingw-x86_64.ads - SO_OPTS = -m64 -Wl,-soname, - else - LIBGNAT_TARGET_PAIRS += \ - $(X86_TARGET_PAIRS) \ - system.ads<system-mingw.ads - SO_OPTS = -m32 -Wl,-soname, - endif + LIBGNAT_TARGET_PAIRS += \ + $(X86_TARGET_PAIRS) \ + system.ads<system-mingw.ads + SO_OPTS = -m32 -Wl,-soname, endif + endif - EXTRA_GNATRTL_NONTASKING_OBJS = \ - s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o - EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o - EXTRA_LIBGNAT_SRCS+=mingw32.h - MISCLIB = -lws2_32 + EXTRA_GNATRTL_NONTASKING_OBJS = \ + s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o + EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o + EXTRA_LIBGNAT_SRCS+=mingw32.h + MISCLIB = -lws2_32 - # ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT - # auto-import support for array/record will be done. - GNATLIB_SHARED = gnatlib-shared-win32 + # ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT + # auto-import support for array/record will be done. + GNATLIB_SHARED = gnatlib-shared-win32 - EH_MECHANISM=-gcc - endif + EH_MECHANISM=-gcc TOOLS_TARGET_PAIRS= \ mlib-tgt-specific.adb<mlib-tgt-specific-mingw.adb \ @@ -2426,7 +2423,6 @@ ADA_EXCLUDE_SRCS =\ s-bbthre.ads s-bbtiev.adb s-bbtiev.ads s-bbtime.adb s-bbtime.ads \ s-bcprmu.adb s-bcprmu.ads s-btstch.adb s-btstch.ads \ s-init.ads s-init.adb \ - s-po32gl.adb s-po32gl.ads \ s-stache.adb s-stache.ads \ s-thread.ads \ s-vxwext.adb s-vxwext.ads \ @@ -2977,14 +2973,6 @@ s-tasdeb.o : s-tasdeb.adb s-tasdeb.ads $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \ $< $(OUTPUT_OPTION) -# force debugging information on s-vaflop.o so that it is always -# possible to call the VAX float debug print routines. -# force at least -O so that the inline assembly works. - -s-vaflop.o : s-vaflop.adb s-vaflop.ads - $(CC) -c -O $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) $(ADA_INCLUDES) \ - $< $(OUTPUT_OPTION) - # force no function reordering on a-except.o because of the exclusion bounds # mechanism (see the source file for more detailed information). # force debugging information on a-except.o so that it is always diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index d7ac29d..859838d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1921,18 +1921,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; case E_Floating_Point_Type: - /* If this is a VAX floating-point type, use an integer of the proper - size. All the operations will be handled with ASM statements. */ - if (Vax_Float (gnat_entity)) - { - gnu_type = make_signed_type (esize); - TYPE_VAX_FLOATING_POINT_P (gnu_type) = 1; - SET_TYPE_DIGITS_VALUE (gnu_type, - UI_To_gnu (Digits_Value (gnat_entity), - sizetype)); - break; - } - /* The type of the Low and High bounds can be our type if this is a type from Standard, so set them at the end of the function. */ gnu_type = make_node (REAL_TYPE); @@ -1941,12 +1929,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; case E_Floating_Point_Subtype: - if (Vax_Float (gnat_entity)) - { - gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); - break; - } - /* See the E_Signed_Integer_Subtype case for the rationale. */ if (!definition && Present (Ancestor_Subtype (gnat_entity)) @@ -5296,7 +5278,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If this is an enumeration or floating-point type, we were not able to set the bounds since they refer to the type. These are always static. */ if ((kind == E_Enumeration_Type && Present (First_Literal (gnat_entity))) - || (kind == E_Floating_Point_Type && !Vax_Float (gnat_entity))) + || (kind == E_Floating_Point_Type)) { tree gnu_scalar_type = gnu_type; tree gnu_low_bound, gnu_high_bound; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 24db2f2..8913236 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -3387,17 +3387,8 @@ pragma Ident (static_string_EXPRESSION); @end smallexample @noindent -This pragma provides a string identification in the generated object file, -if the system supports the concept of this kind of identification string. -This pragma is allowed only in the outermost declarative part or -declarative items of a compilation unit. If more than one @code{Ident} -pragma is given, only the last one processed is effective. -@cindex OpenVMS -On OpenVMS systems, the effect of the pragma is identical to the effect of -the DEC Ada 83 pragma of the same name. Note that in DEC Ada 83, the -maximum allowed length is 31 characters, so if it is important to -maintain compatibility with this compiler, you should obey this length -limit. +This pragma is identical in effect to pragma @code{Comment}. It is provided +for compatibility with other Ada compilers providing this pragma. @node Pragma Implementation_Defined @unnumberedsec Pragma Implementation_Defined diff --git a/gcc/ada/s-asthan.adb b/gcc/ada/s-asthan.adb deleted file mode 100644 index 5cce410..0000000 --- a/gcc/ada/s-asthan.adb +++ /dev/null @@ -1,58 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUNT-TIME COMPONENTS -- --- -- --- S Y S T E M . A S T _ H A N D L I N G -- --- -- --- B o d y -- --- -- --- Copyright (C) 1996-2009, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the dummy version used on non-VMS systems - -package body System.AST_Handling is - - ------------------------ - -- Create_AST_Handler -- - ------------------------ - - function Create_AST_Handler - (Taskid : Ada.Task_Identification.Task_Id; - Entryno : Natural) return System.Aux_DEC.AST_Handler - is - begin - raise Program_Error with "AST is implemented only on VMS systems"; - return System.Aux_DEC.No_AST_Handler; - end Create_AST_Handler; - - procedure Expand_AST_Packet_Pool - (Requested_Packets : Natural; - Actual_Number : out Natural; - Total_Number : out Natural) - is - begin - raise Program_Error with "AST is implemented only on VMS systems"; - end Expand_AST_Packet_Pool; - -end System.AST_Handling; diff --git a/gcc/ada/s-asthan.ads b/gcc/ada/s-asthan.ads deleted file mode 100644 index 6ee2228..0000000 --- a/gcc/ada/s-asthan.ads +++ /dev/null @@ -1,57 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . A S T _ H A N D L I N G -- --- -- --- S p e c -- --- -- --- Copyright (C) 1996-2009, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Runtime support for Handling of AST's (Used on VMS implementations only) - -with Ada.Task_Identification; -with System; -with System.Aux_DEC; - -package System.AST_Handling is - - function Create_AST_Handler - (Taskid : Ada.Task_Identification.Task_Id; - Entryno : Natural) return System.Aux_DEC.AST_Handler; - -- This function implements the appropriate semantics for a use of the - -- AST_Entry pragma. See body for details of implementation approach. - -- The parameters are the Task_Id for the task containing the entry - -- and the entry Index for the specified entry. - - procedure Expand_AST_Packet_Pool - (Requested_Packets : Natural; - Actual_Number : out Natural; - Total_Number : out Natural); - -- This function takes a request for zero or more extra AST packets and - -- returns the number actually added to the pool and the total number - -- now available or in use. - -- This function is not yet fully implemented. - -end System.AST_Handling; diff --git a/gcc/ada/s-filofl.ads b/gcc/ada/s-filofl.ads deleted file mode 100644 index 3f40af8..0000000 --- a/gcc/ada/s-filofl.ads +++ /dev/null @@ -1,53 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F A T _ I E E E _ L O N G _ F L O A T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains an instantiation of the floating-point attribute --- runtime routines for IEEE long float. This is used on VMS targets where --- we can't just use Long_Float, since this may have been mapped to Vax_Float --- using a Float_Representation configuration pragma. - --- TO BE RMOVED ??? - -with System.Fat_Gen; - -package System.Fat_IEEE_Long_Float is - pragma Pure; - - type Fat_IEEE_Long is digits 15; - - -- Note the only entity from this package that is accessed by Rtsfind - -- is the name of the package instantiation. Entities within this package - -- (i.e. the individual floating-point attribute routines) are accessed - -- by name using selected notation. - - package Attr_IEEE_Long is new System.Fat_Gen (Fat_IEEE_Long); - -end System.Fat_IEEE_Long_Float; diff --git a/gcc/ada/s-fishfl.ads b/gcc/ada/s-fishfl.ads deleted file mode 100644 index c5f1bac..0000000 --- a/gcc/ada/s-fishfl.ads +++ /dev/null @@ -1,53 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F A T _ I E E E _ S H O R T _ F L O A T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains an instantiation of the floating-point attribute --- runtime routines for IEEE short float. This is used on VMS targets where --- we can't just use Float, since this may have been mapped to Vax_Float --- using a Float_Representation configuration pragma. - --- TO BE REMOVED ??? - -with System.Fat_Gen; - -package System.Fat_IEEE_Short_Float is - pragma Pure; - - type Fat_IEEE_Short is digits 6; - - -- Note the only entity from this package that is accessed by Rtsfind - -- is the name of the package instantiation. Entities within this package - -- (i.e. the individual floating-point attribute routines) are accessed - -- by name using selected notation. - - package Attr_IEEE_Short is new System.Fat_Gen (Fat_IEEE_Short); - -end System.Fat_IEEE_Short_Float; diff --git a/gcc/ada/s-fvadfl.ads b/gcc/ada/s-fvadfl.ads deleted file mode 100644 index c5fedaf..0000000 --- a/gcc/ada/s-fvadfl.ads +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F A T _ V A X _ D _ F L O A T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains an instantiation of the floating-point attribute --- runtime routines for VAX D-float for use on VMS targets. - --- TO BE REMOVED ??? - -with System.Fat_Gen; - -package System.Fat_VAX_D_Float is - pragma Pure; - - type Fat_VAX_D is digits 9; - - -- Note the only entity from this package that is accessed by Rtsfind - -- is the name of the package instantiation. Entities within this package - -- (i.e. the individual floating-point attribute routines) are accessed - -- by name using selected notation. - - package Attr_VAX_D_Float is new System.Fat_Gen (Fat_VAX_D); - -end System.Fat_VAX_D_Float; diff --git a/gcc/ada/s-fvaffl.ads b/gcc/ada/s-fvaffl.ads deleted file mode 100644 index fddcb64..0000000 --- a/gcc/ada/s-fvaffl.ads +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F A T _ V A X _ F _ F L O A T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains an instantiation of the floating-point attribute --- runtime routines for VAX F-float for use on VMS targets. - --- TO BE REMOVED ??? - -with System.Fat_Gen; - -package System.Fat_VAX_F_Float is - pragma Pure; - - type Fat_VAX_F is digits 6; - - -- Note the only entity from this package that is accessed by Rtsfind - -- is the name of the package instantiation. Entities within this package - -- (i.e. the individual floating-point attribute routines) are accessed - -- by name using selected notation. - - package Attr_VAX_F_Float is new System.Fat_Gen (Fat_VAX_F); - -end System.Fat_VAX_F_Float; diff --git a/gcc/ada/s-fvagfl.ads b/gcc/ada/s-fvagfl.ads deleted file mode 100644 index 15bbc56..0000000 --- a/gcc/ada/s-fvagfl.ads +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F A T _ V A X _ G _ F L O A T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains an instantiation of the floating-point attribute --- runtime routines for VAX F-float for use on VMS targets. - --- TO BE REMOVED ??? - -with System.Fat_Gen; - -package System.Fat_VAX_G_Float is - pragma Pure; - - type Fat_VAX_G is digits 15; - - -- Note the only entity from this package that is accessed by Rtsfind - -- is the name of the package instantiation. Entities within this package - -- (i.e. the individual floating-point attribute routines) are accessed - -- by name using selected notation. - - package Attr_VAX_G_Float is new System.Fat_Gen (Fat_VAX_G); - -end System.Fat_VAX_G_Float; diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 78a3eeb..9231403 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -426,12 +426,12 @@ package System.OS_Lib is -- to the current position (origin = SEEK_CUR), end of file (origin = -- SEEK_END), or start of file (origin = SEEK_SET). - type File_Size is range -(2 ** 63) .. (2 ** 63) - 1; + type Large_File_Size is range -(2 ** 63) .. (2 ** 63) - 1; function File_Length (FD : File_Descriptor) return Long_Integer; pragma Import (C, File_Length, "__gnat_file_length_long"); - function File_Length64 (FD : File_Descriptor) return File_Size; + function File_Length64 (FD : File_Descriptor) return Large_File_Size; pragma Import (C, File_Length64, "__gnat_file_length"); -- Get length of file from file descriptor FD diff --git a/gcc/ada/s-po32gl.adb b/gcc/ada/s-po32gl.adb deleted file mode 100644 index 54acf26..0000000 --- a/gcc/ada/s-po32gl.adb +++ /dev/null @@ -1,98 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P O O L _ 3 2 _ G L O B A L -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with System.Storage_Pools; use System.Storage_Pools; -with System.Memory; - -package body System.Pool_32_Global is - - package SSE renames System.Storage_Elements; - - -------------- - -- Allocate -- - -------------- - - overriding procedure Allocate - (Pool : in out Unbounded_No_Reclaim_Pool_32; - Address : out System.Address; - Storage_Size : SSE.Storage_Count; - Alignment : SSE.Storage_Count) - is - pragma Warnings (Off, Pool); - pragma Warnings (Off, Alignment); - - begin - Address := Memory.Alloc32 (Memory.size_t (Storage_Size)); - - -- The call to Alloc returns an address whose alignment is compatible - -- with the worst case alignment requirement for the machine; thus the - -- Alignment argument can be safely ignored. - - if Address = Null_Address then - raise Storage_Error; - end if; - end Allocate; - - ---------------- - -- Deallocate -- - ---------------- - - overriding procedure Deallocate - (Pool : in out Unbounded_No_Reclaim_Pool_32; - Address : System.Address; - Storage_Size : SSE.Storage_Count; - Alignment : SSE.Storage_Count) - is - pragma Warnings (Off, Pool); - pragma Warnings (Off, Storage_Size); - pragma Warnings (Off, Alignment); - - begin - Memory.Free (Address); - end Deallocate; - - ------------------ - -- Storage_Size -- - ------------------ - - overriding function Storage_Size - (Pool : Unbounded_No_Reclaim_Pool_32) - return SSE.Storage_Count - is - pragma Warnings (Off, Pool); - - begin - -- The 32 bit heap is limited to 2 GB of memory - - return SSE.Storage_Count (2 ** 31); - end Storage_Size; - -end System.Pool_32_Global; diff --git a/gcc/ada/s-po32gl.ads b/gcc/ada/s-po32gl.ads deleted file mode 100644 index 578fbec..0000000 --- a/gcc/ada/s-po32gl.ads +++ /dev/null @@ -1,80 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P O O L _ 3 2 _ G L O B A L -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Storage pool corresponding to default global storage pool used for types --- designated by a 32 bits access type for which no storage pool is specified. --- This is specific to VMS. - -with System; -with System.Storage_Pools; -with System.Storage_Elements; - -package System.Pool_32_Global is - pragma Elaborate_Body; - -- Needed to ensure that library routines can execute allocators - - -- Allocation strategy: - - -- Call to malloc/free for each Allocate/Deallocate - -- No user specifiable size - -- No automatic reclaim - -- Minimal overhead - - -- Pool simulating the allocation/deallocation strategy used by the - -- compiler for access types globally declared. - - type Unbounded_No_Reclaim_Pool_32 is new - System.Storage_Pools.Root_Storage_Pool with null record; - - overriding function Storage_Size - (Pool : Unbounded_No_Reclaim_Pool_32) - return System.Storage_Elements.Storage_Count; - - overriding procedure Allocate - (Pool : in out Unbounded_No_Reclaim_Pool_32; - Address : out System.Address; - Storage_Size : System.Storage_Elements.Storage_Count; - Alignment : System.Storage_Elements.Storage_Count); - - overriding procedure Deallocate - (Pool : in out Unbounded_No_Reclaim_Pool_32; - Address : System.Address; - Storage_Size : System.Storage_Elements.Storage_Count; - Alignment : System.Storage_Elements.Storage_Count); - - -- Pool object used by the compiler when implicit Storage Pool objects are - -- explicitly referred to. For instance when writing something like: - -- for T'Storage_Pool use Q'Storage_Pool; - -- and Q'Storage_Pool hasn't been defined explicitly. - - Global_Pool_32_Object : Unbounded_No_Reclaim_Pool_32; - -end System.Pool_32_Global; diff --git a/gcc/ada/s-vaflop.adb b/gcc/ada/s-vaflop.adb deleted file mode 100644 index e36c356..0000000 --- a/gcc/ada/s-vaflop.adb +++ /dev/null @@ -1,505 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is a dummy body for use on non-Alpha systems so that the library --- can compile. This dummy version uses ordinary conversions and other --- arithmetic operations. It is used only for testing purposes in the --- case where the -gnatdm switch is used to force testing of VMS features --- on non-VMS systems. - -with System.IO; - -package body System.Vax_Float_Operations is - pragma Warnings (Off); - -- Warnings about infinite recursion when the -gnatdm switch is used - - ----------- - -- Abs_F -- - ----------- - - function Abs_F (X : F) return F is - begin - return abs X; - end Abs_F; - - ----------- - -- Abs_G -- - ----------- - - function Abs_G (X : G) return G is - begin - return abs X; - end Abs_G; - - ----------- - -- Add_F -- - ----------- - - function Add_F (X, Y : F) return F is - begin - return X + Y; - end Add_F; - - ----------- - -- Add_G -- - ----------- - - function Add_G (X, Y : G) return G is - begin - return X + Y; - end Add_G; - - ------------ - -- D_To_G -- - ------------ - - function D_To_G (X : D) return G is - begin - return G (X); - end D_To_G; - - -------------------- - -- Debug_Output_D -- - -------------------- - - procedure Debug_Output_D (Arg : D) is - begin - System.IO.Put (D'Image (Arg)); - end Debug_Output_D; - - -------------------- - -- Debug_Output_F -- - -------------------- - - procedure Debug_Output_F (Arg : F) is - begin - System.IO.Put (F'Image (Arg)); - end Debug_Output_F; - - -------------------- - -- Debug_Output_G -- - -------------------- - - procedure Debug_Output_G (Arg : G) is - begin - System.IO.Put (G'Image (Arg)); - end Debug_Output_G; - - -------------------- - -- Debug_String_D -- - -------------------- - - Debug_String_Buffer : String (1 .. 32); - -- Buffer used by all Debug_String_x routines for returning result - - function Debug_String_D (Arg : D) return System.Address is - Image_String : constant String := D'Image (Arg) & ASCII.NUL; - Image_Size : constant Integer := Image_String'Length; - - begin - Debug_String_Buffer (1 .. Image_Size) := Image_String; - return Debug_String_Buffer (1)'Address; - end Debug_String_D; - - -------------------- - -- Debug_String_F -- - -------------------- - - function Debug_String_F (Arg : F) return System.Address is - Image_String : constant String := F'Image (Arg) & ASCII.NUL; - Image_Size : constant Integer := Image_String'Length; - - begin - Debug_String_Buffer (1 .. Image_Size) := Image_String; - return Debug_String_Buffer (1)'Address; - end Debug_String_F; - - -------------------- - -- Debug_String_G -- - -------------------- - - function Debug_String_G (Arg : G) return System.Address is - Image_String : constant String := G'Image (Arg) & ASCII.NUL; - Image_Size : constant Integer := Image_String'Length; - - begin - Debug_String_Buffer (1 .. Image_Size) := Image_String; - return Debug_String_Buffer (1)'Address; - end Debug_String_G; - - ----------- - -- Div_F -- - ----------- - - function Div_F (X, Y : F) return F is - begin - return X / Y; - end Div_F; - - ----------- - -- Div_G -- - ----------- - - function Div_G (X, Y : G) return G is - begin - return X / Y; - end Div_G; - - ---------- - -- Eq_F -- - ---------- - - function Eq_F (X, Y : F) return Boolean is - begin - return X = Y; - end Eq_F; - - ---------- - -- Eq_G -- - ---------- - - function Eq_G (X, Y : G) return Boolean is - begin - return X = Y; - end Eq_G; - - ------------ - -- F_To_G -- - ------------ - - function F_To_G (X : F) return G is - begin - return G (X); - end F_To_G; - - ------------ - -- F_To_Q -- - ------------ - - function F_To_Q (X : F) return Q is - begin - return Q (X); - end F_To_Q; - - ------------ - -- F_To_S -- - ------------ - - function F_To_S (X : F) return S is - begin - return S (X); - end F_To_S; - - ------------ - -- G_To_D -- - ------------ - - function G_To_D (X : G) return D is - begin - return D (X); - end G_To_D; - - ------------ - -- G_To_F -- - ------------ - - function G_To_F (X : G) return F is - begin - return F (X); - end G_To_F; - - ------------ - -- G_To_Q -- - ------------ - - function G_To_Q (X : G) return Q is - begin - return Q (X); - end G_To_Q; - - ------------ - -- G_To_T -- - ------------ - - function G_To_T (X : G) return T is - begin - return T (X); - end G_To_T; - - ---------- - -- Le_F -- - ---------- - - function Le_F (X, Y : F) return Boolean is - begin - return X <= Y; - end Le_F; - - ---------- - -- Le_G -- - ---------- - - function Le_G (X, Y : G) return Boolean is - begin - return X <= Y; - end Le_G; - - ---------- - -- Lt_F -- - ---------- - - function Lt_F (X, Y : F) return Boolean is - begin - return X < Y; - end Lt_F; - - ---------- - -- Lt_G -- - ---------- - - function Lt_G (X, Y : G) return Boolean is - begin - return X < Y; - end Lt_G; - - ----------- - -- Mul_F -- - ----------- - - function Mul_F (X, Y : F) return F is - begin - return X * Y; - end Mul_F; - - ----------- - -- Mul_G -- - ----------- - - function Mul_G (X, Y : G) return G is - begin - return X * Y; - end Mul_G; - - ---------- - -- Ne_F -- - ---------- - - function Ne_F (X, Y : F) return Boolean is - begin - return X /= Y; - end Ne_F; - - ---------- - -- Ne_G -- - ---------- - - function Ne_G (X, Y : G) return Boolean is - begin - return X /= Y; - end Ne_G; - - ----------- - -- Neg_F -- - ----------- - - function Neg_F (X : F) return F is - begin - return -X; - end Neg_F; - - ----------- - -- Neg_G -- - ----------- - - function Neg_G (X : G) return G is - begin - return -X; - end Neg_G; - - -------- - -- pd -- - -------- - - procedure pd (Arg : D) is - begin - System.IO.Put_Line (D'Image (Arg)); - end pd; - - -------- - -- pf -- - -------- - - procedure pf (Arg : F) is - begin - System.IO.Put_Line (F'Image (Arg)); - end pf; - - -------- - -- pg -- - -------- - - procedure pg (Arg : G) is - begin - System.IO.Put_Line (G'Image (Arg)); - end pg; - - ------------ - -- Q_To_F -- - ------------ - - function Q_To_F (X : Q) return F is - begin - return F (X); - end Q_To_F; - - ------------ - -- Q_To_G -- - ------------ - - function Q_To_G (X : Q) return G is - begin - return G (X); - end Q_To_G; - - ------------ - -- S_To_F -- - ------------ - - function S_To_F (X : S) return F is - begin - return F (X); - end S_To_F; - - -------------- - -- Return_D -- - -------------- - - function Return_D (X : D) return D is - begin - return X; - end Return_D; - - -------------- - -- Return_F -- - -------------- - - function Return_F (X : F) return F is - begin - return X; - end Return_F; - - -------------- - -- Return_G -- - -------------- - - function Return_G (X : G) return G is - begin - return X; - end Return_G; - - ----------- - -- Sub_F -- - ----------- - - function Sub_F (X, Y : F) return F is - begin - return X - Y; - end Sub_F; - - ----------- - -- Sub_G -- - ----------- - - function Sub_G (X, Y : G) return G is - begin - return X - Y; - end Sub_G; - - ------------ - -- T_To_G -- - ------------ - - -- This function must be located before T_To_D for frontend inlining - - function T_To_G (X : T) return G is - begin - return G (X); - end T_To_G; - - ------------ - -- T_To_D -- - ------------ - - function T_To_D (X : T) return D is - begin - return G_To_D (T_To_G (X)); - end T_To_D; - - ------------- - -- Valid_D -- - ------------- - - -- For now, convert to IEEE and do Valid test on result. This is not quite - -- accurate, but is good enough in practice. - - function Valid_D (Arg : D) return Boolean is - Val : constant T := G_To_T (D_To_G (Arg)); - begin - return Val'Valid; - end Valid_D; - - ------------- - -- Valid_F -- - ------------- - - -- For now, convert to IEEE and do Valid test on result. This is not quite - -- accurate, but is good enough in practice. - - function Valid_F (Arg : F) return Boolean is - Val : constant S := F_To_S (Arg); - begin - return Val'Valid; - end Valid_F; - - ------------- - -- Valid_G -- - ------------- - - -- For now, convert to IEEE and do Valid test on result. This is not quite - -- accurate, but is good enough in practice. - - function Valid_G (Arg : G) return Boolean is - Val : constant T := G_To_T (Arg); - begin - return Val'Valid; - end Valid_G; - -end System.Vax_Float_Operations; diff --git a/gcc/ada/s-vaflop.ads b/gcc/ada/s-vaflop.ads deleted file mode 100644 index 1cb077e..0000000 --- a/gcc/ada/s-vaflop.ads +++ /dev/null @@ -1,230 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1997-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains runtime routines for handling the non-IEEE --- floating-point formats used on the Vax. - --- TO BE REMOVED ??? - -package System.Vax_Float_Operations is - - type D is digits 9; - type G is digits 15; - type F is digits 6; - type S is digits 6; - type T is digits 15; - - type Q is range -2 ** 63 .. +(2 ** 63 - 1); - -- 64-bit signed integer - - -------------------------- - -- Conversion Functions -- - -------------------------- - - function D_To_G (X : D) return G; - function G_To_D (X : G) return D; - -- Conversions between D float and G float - - function G_To_F (X : G) return F; - function F_To_G (X : F) return G; - -- Conversions between F float and G float - - function F_To_S (X : F) return S; - function S_To_F (X : S) return F; - -- Conversions between F float and IEEE short - - function G_To_T (X : G) return T; - function T_To_G (X : T) return G; - -- Conversions between G float and IEEE long - - function F_To_Q (X : F) return Q; - function Q_To_F (X : Q) return F; - -- Conversions between F float and 64-bit integer - - function G_To_Q (X : G) return Q; - function Q_To_G (X : Q) return G; - -- Conversions between G float and 64-bit integer - - function T_To_D (X : T) return D; - -- Conversion from IEEE long to D_Float (used for literals) - - -------------------------- - -- Arithmetic Functions -- - -------------------------- - - function Abs_F (X : F) return F; - function Abs_G (X : G) return G; - -- Absolute value of F/G float - - function Add_F (X, Y : F) return F; - function Add_G (X, Y : G) return G; - -- Addition of F/G float - - function Div_F (X, Y : F) return F; - function Div_G (X, Y : G) return G; - -- Division of F/G float - - function Mul_F (X, Y : F) return F; - function Mul_G (X, Y : G) return G; - -- Multiplication of F/G float - - function Neg_F (X : F) return F; - function Neg_G (X : G) return G; - -- Negation of F/G float - - function Sub_F (X, Y : F) return F; - function Sub_G (X, Y : G) return G; - -- Subtraction of F/G float - - -------------------------- - -- Comparison Functions -- - -------------------------- - - function Eq_F (X, Y : F) return Boolean; - function Eq_G (X, Y : G) return Boolean; - -- Compares for X = Y - - function Le_F (X, Y : F) return Boolean; - function Le_G (X, Y : G) return Boolean; - -- Compares for X <= Y - - function Lt_F (X, Y : F) return Boolean; - function Lt_G (X, Y : G) return Boolean; - -- Compares for X < Y - - function Ne_F (X, Y : F) return Boolean; - function Ne_G (X, Y : G) return Boolean; - -- Compares for X /= Y - - ---------------------- - -- Return Functions -- - ---------------------- - - function Return_D (X : D) return D; - function Return_F (X : F) return F; - function Return_G (X : G) return G; - -- Deal with returned value for an imported function where the function - -- result is of VAX Float type. Usually nothing needs to be done, and these - -- functions return their argument unchanged. But for the case of VMS Alpha - -- the return value is already in $f0, so we need to trick the compiler - -- into thinking that we are moving X to $f0. See bodies for this case - -- for the Asm sequence generated to achieve this. - - ---------------------------------- - -- Routines for Valid Attribute -- - ---------------------------------- - - function Valid_D (Arg : D) return Boolean; - function Valid_F (Arg : F) return Boolean; - function Valid_G (Arg : G) return Boolean; - -- Test whether Arg has a valid representation - - ---------------------- - -- Debug Procedures -- - ---------------------- - - procedure Debug_Output_D (Arg : D); - procedure Debug_Output_F (Arg : F); - procedure Debug_Output_G (Arg : G); - pragma Export (Ada, Debug_Output_D); - pragma Export (Ada, Debug_Output_F); - pragma Export (Ada, Debug_Output_G); - -- These routines output their argument in decimal string form, with - -- no terminating line return. They are provided for implicit use by - -- the pre gnat-3.12w GDB, and are retained for backwards compatibility. - - function Debug_String_D (Arg : D) return System.Address; - function Debug_String_F (Arg : F) return System.Address; - function Debug_String_G (Arg : G) return System.Address; - pragma Export (Ada, Debug_String_D); - pragma Export (Ada, Debug_String_F); - pragma Export (Ada, Debug_String_G); - -- These routines return a decimal C string image of their argument. - -- They are provided for implicit use by the debugger, in response to - -- the special encoding used for Vax floating-point types (see Exp_Dbug - -- for details). They supersede the above Debug_Output_D/F/G routines - -- which didn't work properly with GDBTK. - - procedure pd (Arg : D); - procedure pf (Arg : F); - procedure pg (Arg : G); - pragma Export (Ada, pd); - pragma Export (Ada, pf); - pragma Export (Ada, pg); - -- These are like the Debug_Output_D/F/G procedures except that they - -- output a line return after the output. They were originally present - -- for direct use in GDB before GDB recognized Vax floating-point - -- types, and are retained for backwards compatibility. - -private - pragma Inline_Always (D_To_G); - pragma Inline_Always (F_To_G); - pragma Inline_Always (F_To_Q); - pragma Inline_Always (F_To_S); - pragma Inline_Always (G_To_D); - pragma Inline_Always (G_To_F); - pragma Inline_Always (G_To_Q); - pragma Inline_Always (G_To_T); - pragma Inline_Always (Q_To_F); - pragma Inline_Always (Q_To_G); - pragma Inline_Always (S_To_F); - pragma Inline_Always (T_To_G); - - pragma Inline_Always (Abs_F); - pragma Inline_Always (Abs_G); - pragma Inline_Always (Add_F); - pragma Inline_Always (Add_G); - pragma Inline_Always (Div_G); - pragma Inline_Always (Div_F); - pragma Inline_Always (Mul_F); - pragma Inline_Always (Mul_G); - pragma Inline_Always (Neg_G); - pragma Inline_Always (Neg_F); - pragma Inline_Always (Return_D); - pragma Inline_Always (Return_F); - pragma Inline_Always (Return_G); - pragma Inline_Always (Sub_F); - pragma Inline_Always (Sub_G); - - pragma Inline_Always (Eq_F); - pragma Inline_Always (Eq_G); - pragma Inline_Always (Le_F); - pragma Inline_Always (Le_G); - pragma Inline_Always (Lt_F); - pragma Inline_Always (Lt_G); - pragma Inline_Always (Ne_F); - pragma Inline_Always (Ne_G); - - pragma Inline_Always (Valid_D); - pragma Inline_Always (Valid_F); - pragma Inline_Always (Valid_G); - -end System.Vax_Float_Operations; diff --git a/gcc/ada/s-vmexta.adb b/gcc/ada/s-vmexta.adb deleted file mode 100644 index 1164ff8..0000000 --- a/gcc/ada/s-vmexta.adb +++ /dev/null @@ -1,187 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . V M S _ E X C E P T I O N _ T A B L E -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-2013, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is an Alpha/VMS package - -with System.HTable; -pragma Elaborate_All (System.HTable); -with System.Storage_Elements; use System.Storage_Elements; - -package body System.VMS_Exception_Table is - - type HTable_Headers is range 1 .. 37; - - type Exception_Code_Data; - type Exception_Code_Data_Ptr is access all Exception_Code_Data; - - -- The following record maps an imported VMS condition to an - -- Ada exception. - - type Exception_Code_Data is record - Code : Exception_Code; - Except : SSL.Exception_Data_Ptr; - HTable_Ptr : Exception_Code_Data_Ptr; - end record; - - procedure Set_HT_Link - (T : Exception_Code_Data_Ptr; - Next : Exception_Code_Data_Ptr); - - function Get_HT_Link (T : Exception_Code_Data_Ptr) - return Exception_Code_Data_Ptr; - - function Hash (F : Exception_Code) return HTable_Headers; - function Get_Key (T : Exception_Code_Data_Ptr) return Exception_Code; - - package Exception_Code_HTable is new System.HTable.Static_HTable ( - Header_Num => HTable_Headers, - Element => Exception_Code_Data, - Elmt_Ptr => Exception_Code_Data_Ptr, - Null_Ptr => null, - Set_Next => Set_HT_Link, - Next => Get_HT_Link, - Key => Exception_Code, - Get_Key => Get_Key, - Hash => Hash, - Equal => "="); - - ------------------ - -- Base_Code_In -- - ------------------ - - function Base_Code_In - (Code : Exception_Code) return Exception_Code - is - begin - return To_Address (To_Integer (Code) and not 2#0111#); - end Base_Code_In; - - --------------------- - -- Coded_Exception -- - --------------------- - - function Coded_Exception - (X : Exception_Code) return SSL.Exception_Data_Ptr - is - Res : Exception_Code_Data_Ptr; - - begin - Res := Exception_Code_HTable.Get (X); - - if Res /= null then - return Res.Except; - else - return null; - end if; - - end Coded_Exception; - - ----------------- - -- Get_HT_Link -- - ----------------- - - function Get_HT_Link - (T : Exception_Code_Data_Ptr) return Exception_Code_Data_Ptr - is - begin - return T.HTable_Ptr; - end Get_HT_Link; - - ------------- - -- Get_Key -- - ------------- - - function Get_Key (T : Exception_Code_Data_Ptr) - return Exception_Code - is - begin - return T.Code; - end Get_Key; - - ---------- - -- Hash -- - ---------- - - function Hash - (F : Exception_Code) return HTable_Headers - is - Headers_Magnitude : constant Exception_Code := - Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1); - - begin - return HTable_Headers - (To_Address ((To_Integer (F) mod To_Integer (Headers_Magnitude)) + 1)); - end Hash; - - ---------------------------- - -- Register_VMS_Exception -- - ---------------------------- - - procedure Register_VMS_Exception - (Code : Exception_Code; - E : SSL.Exception_Data_Ptr) - is - -- We bind the exception data with the base code found in the - -- input value, that is with the severity bits masked off. - - Excode : constant Exception_Code := Base_Code_In (Code); - - begin - -- The exception data registered here is mostly filled prior to this - -- call and by __gnat_error_handler when the exception is raised. We - -- still need to fill a couple of components for exceptions that will - -- be used as propagation filters (exception data pointer registered - -- as choices in the unwind tables): in some import/export cases, the - -- exception pointers for the choice and the propagated occurrence may - -- indeed be different for a single import code, and the personality - -- routine attempts to match the import codes in this case. - - E.Lang := 'V'; - E.Foreign_Data := Excode; - - if Exception_Code_HTable.Get (Excode) = null then - Exception_Code_HTable.Set (new Exception_Code_Data'(Excode, E, null)); - end if; - end Register_VMS_Exception; - - ----------------- - -- Set_HT_Link -- - ----------------- - - procedure Set_HT_Link - (T : Exception_Code_Data_Ptr; - Next : Exception_Code_Data_Ptr) - is - begin - T.HTable_Ptr := Next; - end Set_HT_Link; - -end System.VMS_Exception_Table; diff --git a/gcc/ada/s-vmexta.ads b/gcc/ada/s-vmexta.ads deleted file mode 100644 index 5ad3f3c..0000000 --- a/gcc/ada/s-vmexta.ads +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . V M S _ E X C E P T I O N _ T A B L E -- --- -- --- S p e c -- --- -- --- Copyright (C) 1997-2013, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package is usually used only on OpenVMS systems in the case --- where there is at least one Import/Export exception present. - -with System.Standard_Library; - -package System.VMS_Exception_Table is - - package SSL renames System.Standard_Library; - - subtype Exception_Code is System.Address; - - procedure Register_VMS_Exception - (Code : Exception_Code; - E : SSL.Exception_Data_Ptr); - -- Register an exception in hash table mapping with a VMS condition code. - -- - -- The table is used by exception code (the personnality routine) to detect - -- wether a VMS exception (aka condition) is known by the Ada code. In - -- that case, the identity of the imported or exported exception is used - -- to create the occurrence. - - -- LOTS more comments needed here regarding the entire scheme ??? - -private - - -- The following functions are directly called (without import/export) in - -- init.c by __gnat_handle_vms_condition. - - function Base_Code_In (Code : Exception_Code) return Exception_Code; - -- Value of Code with the severity bits masked off - - function Coded_Exception (X : Exception_Code) - return SSL.Exception_Data_Ptr; - -- Given a VMS condition, find and return its allocated Ada exception - -end System.VMS_Exception_Table; diff --git a/gcc/ada/sem_vfpt.adb b/gcc/ada/sem_vfpt.adb deleted file mode 100644 index b2e495a..0000000 --- a/gcc/ada/sem_vfpt.adb +++ /dev/null @@ -1,140 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S E M _ V F P T -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with CStand; use CStand; -with Einfo; use Einfo; -with Stand; use Stand; - -package body Sem_VFpt is - - ----------------- - -- Set_D_Float -- - ----------------- - - procedure Set_D_Float (E : Entity_Id) is - VAXDF_Digits : constant := 9; - - begin - Init_Size (Base_Type (E), 64); - Init_Alignment (Base_Type (E)); - Init_Digits_Value (Base_Type (E), VAXDF_Digits); - Set_Float_Bounds (Base_Type (E)); - - Init_Size (E, 64); - Init_Alignment (E); - Init_Digits_Value (E, VAXDF_Digits); - Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); - end Set_D_Float; - - ----------------- - -- Set_F_Float -- - ----------------- - - procedure Set_F_Float (E : Entity_Id) is - VAXFF_Digits : constant := 6; - - begin - Init_Size (Base_Type (E), 32); - Init_Alignment (Base_Type (E)); - Init_Digits_Value (Base_Type (E), VAXFF_Digits); - Set_Float_Bounds (Base_Type (E)); - - Init_Size (E, 32); - Init_Alignment (E); - Init_Digits_Value (E, VAXFF_Digits); - Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); - end Set_F_Float; - - ----------------- - -- Set_G_Float -- - ----------------- - - procedure Set_G_Float (E : Entity_Id) is - VAXGF_Digits : constant := 15; - - begin - Init_Size (Base_Type (E), 64); - Init_Alignment (Base_Type (E)); - Init_Digits_Value (Base_Type (E), VAXGF_Digits); - Set_Float_Bounds (Base_Type (E)); - - Init_Size (E, 64); - Init_Alignment (E); - Init_Digits_Value (E, VAXGF_Digits); - Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); - end Set_G_Float; - - ------------------- - -- Set_IEEE_Long -- - ------------------- - - procedure Set_IEEE_Long (E : Entity_Id) is - IEEEL_Digits : constant := 15; - - begin - Init_Size (Base_Type (E), 64); - Init_Alignment (Base_Type (E)); - Init_Digits_Value (Base_Type (E), IEEEL_Digits); - Set_Float_Rep (Base_Type (E), IEEE_Binary); - Set_Float_Bounds (Base_Type (E)); - - Init_Size (E, 64); - Init_Alignment (E); - Init_Digits_Value (E, IEEEL_Digits); - Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); - end Set_IEEE_Long; - - -------------------- - -- Set_IEEE_Short -- - -------------------- - - procedure Set_IEEE_Short (E : Entity_Id) is - IEEES_Digits : constant := 6; - - begin - Init_Size (Base_Type (E), 32); - Init_Alignment (Base_Type (E)); - Init_Digits_Value (Base_Type (E), IEEES_Digits); - Set_Float_Rep (Base_Type (E), IEEE_Binary); - Set_Float_Bounds (Base_Type (E)); - - Init_Size (E, 32); - Init_Alignment (E); - Init_Digits_Value (E, IEEES_Digits); - Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); - end Set_IEEE_Short; - - ------------------------------ - -- Set_Standard_Fpt_Formats -- - ------------------------------ - - procedure Set_Standard_Fpt_Formats is - begin - Set_IEEE_Short (Standard_Float); - Set_IEEE_Long (Standard_Long_Float); - Set_IEEE_Long (Standard_Long_Long_Float); - end Set_Standard_Fpt_Formats; - -end Sem_VFpt; diff --git a/gcc/ada/sem_vfpt.ads b/gcc/ada/sem_vfpt.ads deleted file mode 100644 index 1c94866..0000000 --- a/gcc/ada/sem_vfpt.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S E M _ V F P T -- --- -- --- S p e c -- --- -- --- Copyright (C) 1997-2014, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains specialized routines for handling the Alpha --- floating point formats. It is used only in Alpha implementations. --- Note that this means that the caller can assume that we are on an --- Alpha implementation, and that Vax floating-point formats are valid. - -with Types; use Types; - -package Sem_VFpt is - - procedure Set_D_Float (E : Entity_Id); - -- Sets the given floating-point entity to have Vax D_Float format - - procedure Set_F_Float (E : Entity_Id); - -- Sets the given floating-point entity to have Vax F_Float format - - procedure Set_G_Float (E : Entity_Id); - -- Sets the given floating-point entity to have Vax G_Float format - - procedure Set_IEEE_Short (E : Entity_Id); - -- Sets the given floating-point entity to have IEEE Short format - - procedure Set_IEEE_Long (E : Entity_Id); - -- Sets the given floating-point entity to have IEEE Long format - - procedure Set_Standard_Fpt_Formats; - -- This procedure sets the appropriate formats for the standard - -- floating-point types in Standard, based on the setting of - -- the flags Opt.Float_Format and Opt.Float_Format_Long - -end Sem_VFpt; diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 310de25..4a9e6ad 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -37,39 +37,7 @@ #include "gsocket.h" -#if defined(VMS) -/* - * For VMS, gsocket.h can't include sockets-related DEC C header files - * when building the runtime (because these files are in a DEC C text library - * (DECC$RTLDEF.TLB) not accessible to GCC). So, we generate a separate header - * file along with s-oscons.ads and include it here. - */ -# include "s-oscons.h" - -/* - * We also need the declaration of struct hostent/servent, which s-oscons - * can't provide, so we copy it manually here. This needs to be kept in synch - * with the definition of that structure in the DEC C headers, which - * hopefully won't change frequently. - */ -typedef char *__netdb_char_ptr __attribute__ (( mode (SI) )); -typedef __netdb_char_ptr *__netdb_char_ptr_ptr __attribute__ (( mode (SI) )); - -struct hostent { - __netdb_char_ptr h_name; - __netdb_char_ptr_ptr h_aliases; - int h_addrtype; - int h_length; - __netdb_char_ptr_ptr h_addr_list; -}; - -struct servent { - __netdb_char_ptr s_name; - __netdb_char_ptr_ptr s_aliases; - int s_port; - __netdb_char_ptr s_proto; -}; -#elif defined(__FreeBSD__) +#if defined(__FreeBSD__) typedef unsigned int IOCTL_Req_T; #else typedef int IOCTL_Req_T; @@ -142,7 +110,7 @@ __gnat_disable_all_sigpipes (void) #endif } -#if defined (_WIN32) || defined (__vxworks) || defined (VMS) +#if defined (_WIN32) || defined (__vxworks) /* * Signalling FDs operations are implemented in Ada for these platforms * (see subunit GNAT.Sockets.Thin.Signalling_Fds). @@ -509,15 +477,6 @@ __gnat_get_h_errno (void) { return -1; } -#elif defined (VMS) - /* h_errno is defined as follows in OpenVMS' version of <netdb.h>. - * However this header file is not available when building the GNAT - * runtime library using GCC, so we are hardcoding the definition - * directly. Note that the returned address is thread-specific. - */ - extern int *decc$h_errno_get_addr (); - return *decc$h_errno_get_addr (); - #elif defined (__rtems__) /* At this stage in the tool build, no networking .h files are available. * Newlib does not provide networking .h files and RTEMS is not built yet. @@ -550,11 +509,6 @@ __gnat_socket_ioctl (int fd, IOCTL_Req_T req, int *arg) { #ifndef HAVE_INET_PTON -#ifdef VMS -# define in_addr_t int -# define inet_addr decc$inet_addr -#endif - int __gnat_inet_pton (int af, const char *src, void *dst) { switch (af) { @@ -592,7 +546,7 @@ __gnat_inet_pton (int af, const char *src, void *dst) { } return (rc == 0); -#elif defined (__hpux__) || defined (VMS) +#elif defined (__hpux__) in_addr_t addr; int rc = -1; |