summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am3
-rw-r--r--job.c37
-rw-r--r--job.h1
-rw-r--r--main.c56
-rw-r--r--makefile.com11
-rw-r--r--makefile.vms17
-rw-r--r--makeint.h56
-rw-r--r--vms_exit.c95
-rw-r--r--vms_export_symbol.c523
-rw-r--r--vms_export_symbol_test.com37
-rw-r--r--vms_progname.c463
-rw-r--r--vmsjobs.c210
12 files changed, 1371 insertions, 138 deletions
diff --git a/Makefile.am b/Makefile.am
index 204ab32..d2451b8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -79,7 +79,8 @@ EXTRA_DIST = README build.sh.in $(man_MANS) \
README.W32 NMakefile config.h.W32 build_w32.bat subproc.bat \
make_msvc_net2003.sln make_msvc_net2003.vcproj \
README.VMS makefile.vms makefile.com config.h-vms \
- vmsdir.h vmsfunctions.c vmsify.c \
+ vmsdir.h vmsfunctions.c vmsify.c vms_exit.c vms_progname.c \
+ vms_export_symbol.c vms_export_symbol_test.com \
gmk-default.scm gmk-default.h
# This is built during configure, but behind configure's back
diff --git a/job.c b/job.c
index 2989249..3baa5c7 100644
--- a/job.c
+++ b/job.c
@@ -59,9 +59,21 @@ int batch_mode_shell = 0;
#elif defined (VMS)
# include <descrip.h>
+# include <stsdef.h>
const char *default_shell = "";
int batch_mode_shell = 0;
+#define strsignal vms_strsignal
+char * vms_strsignal (int status);
+
+#ifndef C_FACILITY_NO
+# define C_FACILITY_NO 0x350000
+#endif
+#ifndef VMS_POSIX_EXIT_MASK
+# define VMS_POSIX_EXIT_MASK (C_FACILITY_NO | 0xA000)
+#endif
+
+
#elif defined (__riscos__)
const char *default_shell = "";
@@ -504,21 +516,6 @@ child_error (struct child *child,
l += strlen (pre) + strlen (post);
-#ifdef VMS
- if ((exit_code & 1) != 0)
- {
- OUTPUT_UNSET ();
- return;
- }
- /* Check for a Posix compatible VMS style exit code:
- decode and print the Posix exit code */
- if ((exit_code & 0x35a000) == 0x35a000)
- error(NILF, l + INTSTR_LENGTH, _("%s[%s] Error %d%s"), pre, f->name,
- ((exit_code & 0x7f8) >> 3), post);
- else
- error(NILF, l + INTSTR_LENGTH, _("%s[%s] Error 0x%x%s"), pre, f->name,
- exit_code, post);
-#else
if (exit_sig == 0)
error (NILF, l + INTSTR_LENGTH,
_("%s[%s] Error %d%s"), pre, f->name, exit_code, post);
@@ -528,7 +525,6 @@ child_error (struct child *child,
error (NILF, l + strlen (s) + strlen (dump),
_("%s[%s] %s%s%s"), pre, f->name, s, dump, post);
}
-#endif /* VMS */
OUTPUT_UNSET ();
}
@@ -678,8 +674,17 @@ reap_children (int block, int err)
if (any_local)
{
#ifdef VMS
+ /* Todo: This needs more untangling multi-process support */
+ /* Just do single child process support now */
vmsWaitForChildren (&status);
pid = c->pid;
+
+ /* VMS failure status can not be fully translated */
+ status = $VMS_STATUS_SUCCESS (c->cstatus) ? 0 : (1 << 8);
+
+ /* A Posix failure can be exactly translated */
+ if ((c->cstatus & VMS_POSIX_EXIT_MASK) == VMS_POSIX_EXIT_MASK)
+ status = (c->cstatus >> 3 & 255) << 8;
#else
#ifdef WAIT_NOHANG
if (!block)
diff --git a/job.h b/job.h
index 3c921ba..36a2cb3 100644
--- a/job.h
+++ b/job.h
@@ -99,6 +99,7 @@ struct child
char *comname; /* Temporary command file name */
int efn; /* Completion event flag number */
int cstatus; /* Completion status */
+ int vms_launch_status; /* non-zero if lib$spawn, etc failed */
#endif
unsigned int command_line; /* Index into command_lines. */
diff --git a/main.c b/main.c
index 7f14cba..b2d169c 100644
--- a/main.c
+++ b/main.c
@@ -47,6 +47,10 @@ this program. If not, see <http://www.gnu.org/licenses/>. */
#ifdef _AMIGA
int __stack = 20000; /* Make sure we have 20K of stack space */
#endif
+#ifdef VMS
+int vms_use_mcr_command = 0;
+int vms_always_use_cmd_file = 0;
+#endif
void init_dir (void);
void remote_setup (void);
@@ -1190,14 +1194,38 @@ main (int argc, char **argv, char **envp)
}
}
#endif
- if (program == 0)
#ifdef VMS
- program = vms_progname(argv[0]);
+ set_program_name (argv[0]);
+ program = program_name;
+ {
+ const char *value;
+ value = getenv ("GNV$MAKE_USE_MCR");
+ if (value != NULL)
+ vms_use_mcr_command = 1;
+
+ value = getenv ("GNV$MAKE_USE_CMD_FILE");
+ if (value != NULL)
+ switch (value[0])
+ {
+ case '1':
+ case 'T':
+ case 't':
+ case 'e':
+ case 'E':
+ vms_always_use_cmd_file = 1;
+ break;
+ default:
+ vms_always_use_cmd_file = 0;
+ }
+ }
+ if (need_vms_symbol () && !vms_use_mcr_command)
+ create_foreign_command (program_name, argv[0]);
#else
+ if (program == 0)
program = argv[0];
-#endif
else
++program;
+#endif
}
/* Set up to access user data (files). */
@@ -1593,8 +1621,12 @@ main (int argc, char **argv, char **envp)
/* The extra indirection through $(MAKE_COMMAND) is done
for hysterical raisins. */
+
#ifdef VMS
- define_variable_cname("MAKE_COMMAND", vms_command(argv[0]), o_default, 0);
+ if (vms_use_mcr_command)
+ define_variable_cname ("MAKE_COMMAND", vms_command (argv[0]), o_default, 0);
+ else
+ define_variable_cname ("MAKE_COMMAND", program, o_default, 0);
#else
define_variable_cname ("MAKE_COMMAND", argv[0], o_default, 0);
#endif
@@ -1742,7 +1774,7 @@ main (int argc, char **argv, char **envp)
_("Makefile from standard input specified twice."));
#ifdef VMS
-# define DEFAULT_TMPDIR "sys$scratch:"
+# define DEFAULT_TMPDIR "/sys$scratch/"
#else
# ifdef P_tmpdir
# define DEFAULT_TMPDIR P_tmpdir
@@ -1900,7 +1932,7 @@ main (int argc, char **argv, char **envp)
no_default_sh_exe = !find_and_set_default_shell (NULL);
#endif /* WINDOWS32 */
-#if defined (__MSDOS__) || defined (__EMX__)
+#if defined (__MSDOS__) || defined (__EMX__) || defined (VMS)
/* We need to know what kind of shell we will be using. */
{
extern int _is_unixy_shell (const char *_path);
@@ -2355,12 +2387,18 @@ main (int argc, char **argv, char **envp)
{
*p = alloca (40);
sprintf (*p, "%s=%u", MAKELEVEL_NAME, makelevel);
+#ifdef VMS
+ vms_putenv_symbol (*p);
+#endif
}
else if (strneq (*p, "MAKE_RESTARTS=", CSTRLEN ("MAKE_RESTARTS=")))
{
*p = alloca (40);
sprintf (*p, "MAKE_RESTARTS=%s%u",
OUTPUT_IS_TRACED () ? "-" : "", restarts);
+#ifdef VMS
+ vms_putenv_symbol (*p);
+#endif
restarts = 0;
}
}
@@ -2385,6 +2423,9 @@ main (int argc, char **argv, char **envp)
sprintf (b, "MAKE_RESTARTS=%s%u",
OUTPUT_IS_TRACED () ? "-" : "", restarts);
putenv (b);
+#ifdef __VMS
+ vms_putenv_symbol (b);
+#endif
}
fflush (stdout);
@@ -2529,8 +2570,7 @@ main (int argc, char **argv, char **envp)
makefile_status = MAKE_TROUBLE;
break;
case us_failed:
- /* Updating failed. POSIX.2 specifies exit status >1 for this;
- but in VMS, there is only success and failure. */
+ /* Updating failed. POSIX.2 specifies exit status >1 for this; */
makefile_status = MAKE_FAILURE;
break;
}
diff --git a/makefile.com b/makefile.com
index fe37c05..748bfff 100644
--- a/makefile.com
+++ b/makefile.com
@@ -74,8 +74,9 @@ $ endif
$ filelist = "alloca ar arscan commands default dir expand file function " + -
"guile hash implicit job load main misc read remake " + -
"remote-stub rule output signame variable version " + -
- "vmsfunctions vmsify vpath " + -
- "[.glob]glob [.glob]fnmatch getopt1 getopt strcache"
+ "vmsfunctions vmsify vpath vms_progname vms_exit " + -
+ "vms_export_symbol [.glob]glob [.glob]fnmatch getopt1 " + -
+ "getopt strcache"
$!
$ copy config.h-vms config.h
$ n=0
@@ -131,6 +132,7 @@ $!-----------------------------------------------------------------------------
$!
$ compileit : subroutine
$ ploc = f$locate("]",p1)
+$! filnam = p1
$ if ploc .lt. f$length(p1)
$ then
$ objdir = f$extract(0, ploc+1, p1)
@@ -139,8 +141,9 @@ $ else
$ objdir := []
$ write optf objdir+p1
$ endif
-$ cc'ccopt'/include=([],[.glob])/obj='objdir' -
- /define=("allocated_variable_expand_for_file=alloc_var_expand_for_file","unlink=remove","HAVE_CONFIG_H","VMS") -
+$ cc'ccopt'/nested=none/include=([],[.glob])/obj='objdir' -
+ /define=("allocated_variable_expand_for_file=alloc_var_expand_for_file",-
+ "unlink=remove","HAVE_CONFIG_H","VMS") -
'p1'
$ exit
$ endsubroutine : compileit
diff --git a/makefile.vms b/makefile.vms
index ad5ded7..cabb1bb 100644
--- a/makefile.vms
+++ b/makefile.vms
@@ -32,9 +32,12 @@ CP = copy
#
ifeq ($(CC),cc)
-CFLAGS = $(defines) /include=([],[.glob])/prefix=(all,except=(glob,globfree))/standard=relaxed/warn=(disable=questcompare)
+cinclude = /nested=none/include=([],[.glob])
+cprefix = /prefix=(all,except=(glob,globfree))
+cwarn = /standard=relaxed/warn=(disable=questcompare)
+CFLAGS = $(defines) $(cinclude)$(cprefix)$(cwarn)
else
-CFLAGS = $(defines) /include=([],[.glob])
+CFLAGS = $(defines) $(cinclude)
endif
#LDFLAGS = /deb
LDFLAGS =
@@ -93,13 +96,14 @@ guile = ,guile.obj
objs = commands.obj,job.obj,output.obj,dir.obj,file.obj,misc.obj,hash.obj,\
load.obj,main.obj,read.obj,remake.obj,rule.obj,implicit.obj,\
default.obj,variable.obj,expand.obj,function.obj,strcache.obj,\
- vpath.obj,version.obj$(guile)\
- $(ARCHIVES)$(ALLOCA)$(extras)$(getopt)$(glob)
+ vpath.obj,version.obj,vms_progname.obj,vms_exit.obj,\
+ vms_export_symbol.obj$(guile)$(ARCHIVES)$(extras)$(getopt)$(glob)
srcs = commands.c job.c output.c dir.c file.c misc.c guile.c hash.c \
load.c main.c read.c remake.c rule.c implicit.c \
default.c variable.c expand.c function.c strcache.c \
- vpath.c version.c vmsfunctions.c vmsify.c $(ARCHIVES_SRC) $(ALLOCASRC) \
+ vpath.c version.c vmsfunctions.c vmsify.c vms_progname.c vms_exit.c \
+ vms_export_symbol.c $(ARCHIVES_SRC) $(ALLOCASRC) \
commands.h dep.h filedef.h job.h output.h makeint.h rule.h variable.h
@@ -168,6 +172,9 @@ vmsfunctions.obj: vmsfunctions.c makeint.h config.h gnumake.h gettext.h \
vmsify.obj: vmsify.c
vpath.obj: vpath.c makeint.h config.h gnumake.h gettext.h filedef.h hash.h \
variable.h
+vms_progname.obj: vms_progname.c
+vms_exit.obj: vms_exit.c
+vms_export_symbol.obj: vms_export_symbol.c
config.h: config.h-vms
$(CP) $< $@
diff --git a/makeint.h b/makeint.h
index fdcae75..6223936 100644
--- a/makeint.h
+++ b/makeint.h
@@ -99,6 +99,15 @@ extern int errno;
# define isblank(c) ((c) == ' ' || (c) == '\t')
#endif
+#ifdef __VMS
+/* In strict ANSI mode, VMS compilers should not be defining the
+ VMS macro. Define it here instead of a bulk edit for the correct code.
+ */
+# ifndef VMS
+# define VMS
+# endif
+#endif
+
#ifdef HAVE_UNISTD_H
# include <unistd.h>
/* Ultrix's unistd.h always defines _POSIX_VERSION, but you only get
@@ -201,6 +210,9 @@ unsigned int get_path_max (void);
# include <perror.h>
/* Needed to use alloca on VMS. */
# include <builtins.h>
+
+extern int vms_use_mcr_command;
+extern int vms_always_use_cmd_file;
#endif
#ifndef __attribute__
@@ -622,8 +634,33 @@ extern const char *program;
#endif
#ifdef VMS
-const char *vms_command(const char *argv0);
-const char *vms_progname(const char *argv0);
+const char *vms_command (const char *argv0);
+const char *vms_progname (const char *argv0);
+
+void vms_exit (int);
+# define _exit(foo) vms_exit(foo)
+# define exit(foo) vms_exit(foo)
+
+extern char *program_name;
+
+void
+set_program_name (const char *arv0);
+
+int
+need_vms_symbol (void);
+
+int
+create_foreign_command (const char *command, const char *image);
+
+int
+vms_export_dcl_symbol (const char *name, const char *value);
+
+int
+vms_putenv_symbol (const char *string);
+
+void
+vms_restore_symbol (const char *string);
+
#endif
extern char *starting_directory;
@@ -643,18 +680,9 @@ extern int handling_fatal_signal;
#endif
-#ifdef VMS
-/* These are the VMS __posix_exit compliant exit codes, constructed out of
- STS$M_INHIB_MSG, C facility code, a POSIX condition code mask, MAKE_NNN<<3 and
- the coresponding VMS severity, here STS$K_SUCCESS and STS$K_ERROR. */
-# define MAKE_SUCCESS 0x1035a001
-# define MAKE_TROUBLE 0x1035a00a
-# define MAKE_FAILURE 0x1035a012
-#else
-# define MAKE_SUCCESS 0
-# define MAKE_TROUBLE 1
-# define MAKE_FAILURE 2
-#endif
+#define MAKE_SUCCESS 0
+#define MAKE_TROUBLE 1
+#define MAKE_FAILURE 2
/* Set up heap debugging library dmalloc. */
diff --git a/vms_exit.c b/vms_exit.c
new file mode 100644
index 0000000..050550a
--- /dev/null
+++ b/vms_exit.c
@@ -0,0 +1,95 @@
+/* vms_exit.c
+ *
+ * Wrapper for the VMS exit() command to tranlate UNIX codes to be
+ * encoded for POSIX, but also have VMS severity levels.
+ * The posix_exit() variant only sets a severity level for status code 1.
+ *
+ * Author: John E. Malmberg
+ */
+
+/* Copyright (C) 2014 Free Software Foundation, Inc.
+
+GNU Make is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation; either version 3 of the License, or (at your option) any later
+version.
+
+GNU Make is distributed in the hope that it will be useful, but WITHOUT 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 along with
+this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* Per copyright assignment agreement with the Free Software Foundation
+ this software may be available under under other license agreements
+ and copyrights. */
+
+#include <makeint.h>
+
+#include <stsdef.h>
+void
+decc$exit (int status);
+#ifndef C_FACILITY_NO
+# define C_FACILITY_NO 0x350000
+#endif
+
+/* Lowest legal non-success VMS exit code is 8 */
+/* GNU make only defines codes 0, 1, 2 */
+/* So assume any exit code > 8 is a VMS exit code */
+
+#ifndef MAX_EXPECTED_EXIT_CODE
+# define MAX_EXPECTED_EXIT_CODE 7
+#endif
+
+/* Build a Posix Exit with VMS severity */
+void
+vms_exit (int status)
+{
+ int vms_status;
+ /* Fake the __posix_exit with severity added */
+ /* Undocumented correct way to do this. */
+ vms_status = 0;
+
+ /* The default DECC definition is not compatible with doing a POSIX_EXIT */
+ /* So fix it. */
+ if (status == EXIT_FAILURE)
+ status = MAKE_FAILURE;
+
+ /* Trivial case exit success */
+ if (status == 0)
+ decc$exit (STS$K_SUCCESS);
+
+ /* Is this a VMS status then just take it */
+ if (status > MAX_EXPECTED_EXIT_CODE)
+ {
+ /* Make sure that the message inhibit is set since message has */
+ /* already been displayed. */
+ vms_status = status | STS$M_INHIB_MSG;
+ decc$exit (vms_status);
+ }
+
+ /* Unix status codes are limited to 1 byte, so anything larger */
+ /* is a probably a VMS exit code and needs to be passed through */
+ /* A lower value can be set for a macro. */
+ /* Status 0 is always passed through as it is converted to SS$_NORMAL */
+ /* Always set the message inhibit bit */
+ vms_status = C_FACILITY_NO | 0xA000 | STS$M_INHIB_MSG;
+ vms_status |= (status << 3);
+
+ /* STS$K_ERROR is for status that stops makefile that a simple */
+ /* Rerun of the makefile will not fix. */
+
+ if (status == MAKE_FAILURE)
+ vms_status |= STS$K_ERROR;
+ else if (status == MAKE_TROUBLE)
+ {
+ /* Make trouble is for when make was told to do nothing and */
+ /* found that a target was not up to date. Since a second */
+ /* of make will produce the same condition, this is of */
+ /* Error severity */
+ vms_status |= STS$K_ERROR;
+ }
+ decc$exit (vms_status);
+}
diff --git a/vms_export_symbol.c b/vms_export_symbol.c
new file mode 100644
index 0000000..2cc7367
--- /dev/null
+++ b/vms_export_symbol.c
@@ -0,0 +1,523 @@
+/* File: vms_export_symbol.c
+ *
+ * Some programs need special environment variables deported as DCL
+ * DCL symbols.
+ */
+
+/* Copyright (C) 2014 Free Software Foundation, Inc.
+
+GNU Make is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation; either version 3 of the License, or (at your option) any later
+version.
+
+GNU Make is distributed in the hope that it will be useful, but WITHOUT 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 along with
+this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* Per copyright assignment agreement with the Free Software Foundation
+ this software may be available under under other license agreements
+ and copyrights. */
+
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <errno.h>
+
+#include <descrip.h>
+#include <stsdef.h>
+#include <ssdef.h>
+#include <unixlib.h>
+#include <libclidef.h>
+
+#pragma member_alignment save
+#pragma nomember_alignment longword
+struct item_list_3
+{
+ unsigned short len;
+ unsigned short code;
+ void * bufadr;
+ unsigned short * retlen;
+};
+
+
+#pragma member_alignment
+
+int
+LIB$GET_SYMBOL (const struct dsc$descriptor_s * symbol,
+ struct dsc$descriptor_s * value,
+ unsigned short * value_len,
+ const unsigned long * table);
+
+int
+LIB$SET_SYMBOL (const struct dsc$descriptor_s * symbol,
+ const struct dsc$descriptor_s * value,
+ const unsigned long * table);
+
+int
+LIB$DELETE_SYMBOL (const struct dsc$descriptor_s * symbol,
+ const unsigned long * table);
+
+#define MAX_DCL_SYMBOL_LEN (255)
+#define MAX_DCL_SYMBOL_VALUE (1024)
+
+struct dcl_symbol
+{
+ struct dcl_symbol * link;
+ struct dsc$descriptor_s name_desc;
+ struct dsc$descriptor_s value_desc;
+ char name[MAX_DCL_SYMBOL_LEN + 1]; /* + 1 byte for null terminator */
+ char value[MAX_DCL_SYMBOL_VALUE +1]; /* + 1 byte for null terminator */
+ char pad[3]; /* Pad structure to longword allignment */
+};
+
+static struct dcl_symbol * vms_dcl_symbol_head = NULL;
+
+/* Restore symbol state to original condition. */
+static unsigned long
+clear_dcl_symbol (struct dcl_symbol * symbol)
+{
+
+ const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM;
+ int status;
+
+ if (symbol->value_desc.dsc$w_length == (unsigned short)-1)
+ status = LIB$DELETE_SYMBOL (&symbol->name_desc, &symtbl);
+ else
+ status = LIB$SET_SYMBOL (&symbol->name_desc,
+ &symbol->value_desc, &symtbl);
+ return status;
+}
+
+
+/* Restore all exported symbols to their original conditions */
+static void
+clear_exported_symbols (void)
+{
+
+ struct dcl_symbol * symbol;
+
+ symbol = vms_dcl_symbol_head;
+
+ /* Walk the list of symbols. This is done durring exit,
+ * so no need to free memory.
+ */
+ while (symbol != NULL)
+ {
+ clear_dcl_symbol (symbol);
+ symbol = symbol->link;
+ }
+
+}
+
+
+/* Restore the symbol back to the original value
+ * symbol name is either a plain name or of the form "symbol=name" where
+ * the name portion is ignored.
+ */
+void
+vms_restore_symbol (const char * string)
+{
+
+ struct dcl_symbol * symbol;
+ char name[MAX_DCL_SYMBOL_LEN + 1];
+ int status;
+ char * value;
+ int name_len;
+
+ symbol = vms_dcl_symbol_head;
+
+ /* Isolate the name from the value */
+ value = strchr (string, '=');
+ if (value != NULL)
+ {
+ /* Copy the name from the string */
+ name_len = (value - string);
+ }
+ else
+ name_len = strlen (string);
+
+ if (name_len > MAX_DCL_SYMBOL_LEN)
+ name_len = MAX_DCL_SYMBOL_LEN;
+
+ strncpy (name, string, name_len);
+ name[name_len] = 0;
+
+ /* Walk the list of symbols. The saved symbol is not freed
+ * symbols are likely to be overwritten multiple times, so this
+ * saves time in saving them each time.
+ */
+ while (symbol != NULL)
+ {
+ int result;
+ result = strcmp (symbol->name, name);
+ if (result == 0)
+ {
+ clear_dcl_symbol (symbol);
+ break;
+ }
+ symbol = symbol->link;
+ }
+}
+
+int
+vms_export_dcl_symbol (const char * name, const char * value)
+{
+
+ struct dcl_symbol * symbol;
+ struct dcl_symbol * next;
+ struct dcl_symbol * link;
+ int found;
+ const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM;
+ struct dsc$descriptor_s value_desc;
+ int string_len;
+ int status;
+ char new_value[MAX_DCL_SYMBOL_VALUE + 1];
+ char * dollarp;
+
+ next = vms_dcl_symbol_head;
+ link = vms_dcl_symbol_head;
+
+ /* Is symbol already exported? */
+ found = 0;
+ while ((found == 0) && (link != NULL))
+ {
+ int x;
+ found = !strncasecmp (link->name, name, MAX_DCL_SYMBOL_LEN);
+ if (found)
+ symbol = link;
+ next = link;
+ link = link->link;
+ }
+
+ /* New symbol, set it up */
+ if (found == 0)
+ {
+ symbol = malloc (sizeof (struct dcl_symbol));
+ if (symbol == NULL)
+ return SS$_INSFMEM;
+
+ /* Construct the symbol descriptor, used for both saving
+ * the old symbol and creating the new symbol.
+ */
+ symbol->name_desc.dsc$w_length = strlen (name);
+ if (symbol->name_desc.dsc$w_length > MAX_DCL_SYMBOL_LEN)
+ symbol->name_desc.dsc$w_length = MAX_DCL_SYMBOL_LEN;
+
+ strncpy (symbol->name, name, symbol->name_desc.dsc$w_length);
+ symbol->name[symbol->name_desc.dsc$w_length] = 0;
+ symbol->name_desc.dsc$a_pointer = symbol->name;
+ symbol->name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
+ symbol->name_desc.dsc$b_class = DSC$K_CLASS_S;
+
+ /* construct the value descriptor, used only for saving
+ * the old symbol.
+ */
+ symbol->value_desc.dsc$a_pointer = symbol->value;
+ symbol->value_desc.dsc$w_length = MAX_DCL_SYMBOL_VALUE;
+ symbol->value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
+ symbol->value_desc.dsc$b_class = DSC$K_CLASS_S;
+ }
+
+ if (found == 0)
+ {
+ unsigned long old_symtbl;
+ unsigned short value_len;
+
+ /* Look up the symbol */
+ status = LIB$GET_SYMBOL (&symbol->name_desc, &symbol->value_desc,
+ &value_len, &old_symtbl);
+ if (!$VMS_STATUS_SUCCESS (status))
+ value_len = (unsigned short)-1;
+ else if (old_symtbl != symtbl)
+ value_len = (unsigned short)-1;
+
+ symbol->value_desc.dsc$w_length = value_len;
+
+ /* Store it away */
+ if (value_len != (unsigned short) -1)
+ symbol->value[value_len] = 0;
+
+ /* Make sure atexit scheduled */
+ if (vms_dcl_symbol_head == NULL)
+ {
+ vms_dcl_symbol_head = symbol;
+ atexit (clear_exported_symbols);
+ }
+ else
+ {
+ /* Extend the chain */
+ next->link = symbol;
+ }
+ }
+
+ /* Create or replace a symbol */
+ value_desc.dsc$a_pointer = new_value;
+ string_len = strlen (value);
+ if (string_len > MAX_DCL_SYMBOL_VALUE)
+ string_len = MAX_DCL_SYMBOL_VALUE;
+
+ strncpy (new_value, value, string_len);
+ new_value[string_len] = 0;
+
+ /* Special handling for GNU Make. GNU Make doubles the dollar signs
+ * in environment variables read in from getenv(). Make exports symbols
+ * with the dollar signs already doubled. So all $$ must be converted
+ * back to $.
+ * If the first $ is not doubled, then do not convert at all.
+ */
+ dollarp = strchr (new_value, '$');
+ while (dollarp && dollarp[1] == '$')
+ {
+ int left;
+ dollarp++;
+ left = string_len - (dollarp - new_value - 1);
+ string_len--;
+ if (left > 0)
+ {
+ memmove (dollarp, &dollarp[1], left);
+ dollarp = strchr (&dollarp[1], '$');
+ }
+ else
+ {
+ /* Ended with $$, simple case */
+ dollarp[1] = 0;
+ break;
+ }
+ }
+ value_desc.dsc$w_length = string_len;
+ value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
+ value_desc.dsc$b_class = DSC$K_CLASS_S;
+ status = LIB$SET_SYMBOL (&symbol->name_desc, &value_desc, &symtbl);
+ return status;
+}
+
+/* export a DCL symbol using a string in the same syntax as putenv */
+int
+vms_putenv_symbol (const char * string)
+{
+
+ char name[MAX_DCL_SYMBOL_LEN + 1];
+ int status;
+ char * value;
+ int name_len;
+
+ /* Isolate the name from the value */
+ value = strchr (string, '=');
+ if (value == NULL)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ /* Copy the name from the string */
+ name_len = (value - string);
+ if (name_len > MAX_DCL_SYMBOL_LEN)
+ name_len = MAX_DCL_SYMBOL_LEN;
+
+ strncpy (name, string, name_len);
+ name[name_len] = 0;
+
+ /* Skip past the "=" */
+ value++;
+
+ /* Export the symbol */
+ status = vms_export_dcl_symbol (name, value);
+
+ /* Convert the error to Unix format */
+ if (!$VMS_STATUS_SUCCESS (status))
+ {
+ errno = EVMSERR;
+ vaxc$errno = status;
+ return -1;
+ }
+ return 0;
+}
+
+#if __CRTL_VER >= 70301000
+# define transpath_parm transpath
+#else
+static char transpath[MAX_DCL_SYMBOL_VALUE];
+#endif
+
+/* Helper callback routine for converting Unix paths to VMS */
+static int
+to_vms_action (char * vms_spec, int flag, char * transpath_parm)
+{
+ strncpy (transpath, vms_spec, MAX_DCL_SYMBOL_VALUE - 1);
+ transpath[MAX_DCL_SYMBOL_VALUE - 1] = 0;
+ return 0;
+}
+
+#ifdef __DECC
+# pragma message save
+ /* Undocumented extra parameter use triggers a ptrmismatch warning */
+# pragma message disable ptrmismatch
+#endif
+
+/* Create a foreign command only visible to children */
+int
+create_foreign_command (const char * command, const char * image)
+{
+ char vms_command[MAX_DCL_SYMBOL_VALUE + 1];
+ int status;
+
+ vms_command[0] = '$';
+ vms_command[1] = 0;
+ if (image[0] == '/')
+ {
+#if __CRTL_VER >= 70301000
+ /* Current decc$to_vms is reentrant */
+ decc$to_vms (image, to_vms_action, 0, 1, &vms_command[1]);
+#else
+ /* Older decc$to_vms is not reentrant */
+ decc$to_vms (image, to_vms_action, 0, 1);
+ strncpy (&vms_command[1], transpath, MAX_DCL_SYMBOL_VALUE - 1);
+ vms_command[MAX_DCL_SYMBOL_VALUE] = 0;
+#endif
+ }
+ else
+ {
+ strncpy (&vms_command[1], image, MAX_DCL_SYMBOL_VALUE - 1);
+ vms_command[MAX_DCL_SYMBOL_VALUE] = 0;
+ }
+ status = vms_export_dcl_symbol (command, vms_command);
+
+ return status;
+}
+#ifdef __DECC
+# pragma message restore
+#endif
+
+
+#ifdef DEBUG
+
+int
+main(int argc, char ** argv, char **env)
+{
+
+ char value[MAX_DCL_SYMBOL_VALUE +1];
+ int status = 0;
+ int putenv_status;
+ int vms_status;
+ struct dsc$descriptor_s name_desc;
+ struct dsc$descriptor_s value_desc;
+ const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM;
+ unsigned short value_len;
+ unsigned long old_symtbl;
+ int result;
+ const char * vms_command = "vms_export_symbol";
+ const char * vms_image = "test_image.exe";
+ const char * vms_symbol1 = "test_symbol1";
+ const char * value1 = "test_value1";
+ const char * vms_symbol2 = "test_symbol2";
+ const char * putenv_string = "test_symbol2=value2";
+ const char * value2 = "value2";
+
+ /* Test creating a foreign command */
+ vms_status = create_foreign_command (vms_command, vms_image);
+ if (!$VMS_STATUS_SUCCESS (vms_status))
+ {
+ printf("Create foreign command failed: %d\n", vms_status);
+ status = 1;
+ }
+
+ name_desc.dsc$a_pointer = (char *)vms_command;
+ name_desc.dsc$w_length = strlen (vms_command);
+ name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
+ name_desc.dsc$b_class = DSC$K_CLASS_S;
+
+ value_desc.dsc$a_pointer = value;
+ value_desc.dsc$w_length = MAX_DCL_SYMBOL_VALUE;
+ value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
+ value_desc.dsc$b_class = DSC$K_CLASS_S;
+
+ vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc,
+ &value_len, &old_symtbl);
+ if (!$VMS_STATUS_SUCCESS (vms_status))
+ {
+ printf ("lib$get_symbol for command failed: %d\n", vms_status);
+ status = 1;
+ }
+
+ value[value_len] = 0;
+ result = strncasecmp (&value[1], vms_image, value_len - 1);
+ if (result != 0)
+ {
+ printf ("create_foreign_command failed! expected '%s', got '%s'\n",
+ vms_image, &value[1]);
+ status = 1;
+ }
+
+ /* Test exporting a symbol */
+ vms_status = vms_export_dcl_symbol (vms_symbol1, value1);
+ if (!$VMS_STATUS_SUCCESS (vms_status))
+ {
+ printf ("vms_export_dcl_symbol for command failed: %d\n", vms_status);
+ status = 1;
+ }
+
+ name_desc.dsc$a_pointer = (char *)vms_symbol1;
+ name_desc.dsc$w_length = strlen (vms_symbol1);
+ vms_status = LIB$GET_SYMBOL(&name_desc, &value_desc,
+ &value_len, &old_symtbl);
+ if (!$VMS_STATUS_SUCCESS(vms_status))
+ {
+ printf ("lib$get_symbol for command failed: %d\n", vms_status);
+ status = 1;
+ }
+
+ value[value_len] = 0;
+ result = strncmp (value, value1, value_len);
+ if (result != 0)
+ {
+ printf ("vms_export_dcl_symbol failed! expected '%s', got '%s'\n",
+ value1, value);
+ status = 1;
+ }
+
+ /* Test putenv for DCL symbols */
+ putenv_status = vms_putenv_symbol (putenv_string);
+ if (putenv_status != 0)
+ {
+ perror ("vms_putenv_symbol");
+ status = 1;
+ }
+
+ name_desc.dsc$a_pointer = (char *)vms_symbol2;
+ name_desc.dsc$w_length = strlen(vms_symbol2);
+ vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc,
+ &value_len, &old_symtbl);
+ if (!$VMS_STATUS_SUCCESS (vms_status))
+ {
+ printf ("lib$get_symbol for command failed: %d\n", vms_status);
+ status = 1;
+ }
+
+ value[value_len] = 0;
+ result = strncmp (value, value2, value_len);
+ if (result != 0)
+ {
+ printf ("vms_putenv_symbol failed! expected '%s', got '%s'\n",
+ value2, value);
+ status = 1;
+ }
+
+ vms_restore_symbol (putenv_string);
+ vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc,
+ &value_len, &old_symtbl);
+ if ($VMS_STATUS_SUCCESS (vms_status))
+ {
+ printf ("lib$get_symbol for command succeeded, should have failed\n");
+ status = 1;
+ }
+
+ exit (status);
+}
+
+#endif
diff --git a/vms_export_symbol_test.com b/vms_export_symbol_test.com
new file mode 100644
index 0000000..4345f44
--- /dev/null
+++ b/vms_export_symbol_test.com
@@ -0,0 +1,37 @@
+$! VMS_EXPORT_SYMBOL_TEST.COM
+$!
+$! Verify the VMS_EXPORT_SYMBOL.C module
+$!
+$! 22-May-2014 J. Malmberg
+$!
+$!=========================================================================
+$!
+$ cc/names=(as_is)/define=(DEBUG=1,_POSIX_EXIT=1) vms_export_symbol.c
+$!
+$ link vms_export_symbol
+$!
+$ delete vms_export_symbol.obj;*
+$!
+$! Need a foreign command to test.
+$ vms_export_symbol := $sys$disk:[]vms_export_symbol.exe
+$ save_export_symbol = vms_export_symbol
+$!
+$ vms_export_symbol
+$ if $severity .ne. 1
+$ then
+$ write sys$output "Test program failed!";
+$ endif
+$!
+$ if vms_export_symbol .nes. save_export_symbol
+$ then
+$ write sys$output "Test failed to restore foreign command!"
+$ endif
+$ if f$type(test_export_symbol) .nes. ""
+$ then
+$ write sys$output "Test failed to clear exported symbol!"
+$ endif
+$ if f$type(test_putenv_symbol) .nes. ""
+$ then
+$ write sys$output "Test failed to clear putenv exported symbol!"
+$ endif
+$!
diff --git a/vms_progname.c b/vms_progname.c
new file mode 100644
index 0000000..199ed32
--- /dev/null
+++ b/vms_progname.c
@@ -0,0 +1,463 @@
+/* File: vms_progname.c
+ *
+ * This module provides a fixup of the program name.
+ *
+ * This module is designed to be a plug in replacement for the
+ * progname module used by many GNU utilities with a few enhancements
+ * needed for GNU Make.
+ *
+ * It does not support the HAVE_DECL_PROGRAM_INVOCATION_* macros at this
+ * time.
+ *
+ * Make sure that the program_name string is set as close as possible to
+ * what the original command was given.
+ *
+ * When run from DCL, The argv[0] element is initialized with an absolute
+ * path name. The decc$ feature logical names can control the format
+ * of this pathname. In some cases it causes the UNIX format name to be
+ * formatted incorrectly.
+ *
+ * This DCL provided name is usually incompatible with what is expected to
+ * be provided by Unix programs and needs to be replaced.
+ *
+ * When run from an exec() call, the argv[0] element is initialized by the
+ * program. This name is compatible with what is expected to be provided
+ * by Unix programs and should be passed through unchanged.
+ *
+ * The DCL provided name can be detected because it always contains the
+ * device name.
+ *
+ * DCL examples:
+ * devname:[dir]program.exe;1 Normal VMS - remove path and .EXE;n
+ * devname:[dir]facility$program.exe;1 Facility also needs removal.
+ * /devname/dir/program.exe
+ * /DISK$VOLUME/dir/program.exe.1 Bug version should not be there.
+ * /DISK$VOLUME/dir/program. Bug Period should not be there.
+ *
+ */
+
+/* Copyright (C) 2014 Free Software Foundation, Inc.
+
+GNU Make is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation; either version 3 of the License, or (at your option) any later
+version.
+
+GNU Make is distributed in the hope that it will be useful, but WITHOUT 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 along with
+this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* Per copyright assignment agreement with the Free Software Foundation
+ this software may be available under under other license agreements
+ and copyrights. */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <stdlib.h>
+
+#include <descrip.h>
+#include <dvidef.h>
+#include <efndef.h>
+#include <fscndef.h>
+#include <stsdef.h>
+
+#ifdef USE_PROGNAME_H
+# include "progname.h"
+#endif
+
+#pragma member_alignment save
+#pragma nomember_alignment longword
+struct item_list_3
+{
+ unsigned short len;
+ unsigned short code;
+ void * bufadr;
+ unsigned short * retlen;
+};
+
+struct filescan_itmlst_2
+{
+ unsigned short length;
+ unsigned short itmcode;
+ char * component;
+};
+
+#pragma member_alignment
+
+int
+SYS$GETDVIW (unsigned long efn,
+ unsigned short chan,
+ const struct dsc$descriptor_s * devnam,
+ const struct item_list_3 * itmlst,
+ void * iosb,
+ void (* astadr)(unsigned long),
+ unsigned long astprm,
+ void * nullarg);
+
+int
+SYS$FILESCAN (const struct dsc$descriptor_s * srcstr,
+ struct filescan_itmlst_2 * valuelist,
+ unsigned long * fldflags,
+ struct dsc$descriptor_s *auxout,
+ unsigned short * retlen);
+
+/* String containing name the program is called with.
+ To be initialized by main(). */
+
+const char *program_name = NULL;
+
+static int internal_need_vms_symbol = 0;
+
+static char vms_new_nam[256];
+
+int
+need_vms_symbol (void)
+{
+ return internal_need_vms_symbol;
+}
+
+
+void
+set_program_name (const char *argv0)
+{
+ int status;
+ int result;
+
+#ifdef DEBUG
+ printf ("original argv0 = %s\n", argv0);
+#endif
+
+ /* Posix requires non-NULL argv[0] */
+ if (argv0 == NULL)
+ {
+ fputs ("A NULL argv[0] was passed through an exec system call.\n",
+ stderr);
+ abort ();
+ }
+
+ program_name = argv0;
+ result = 0;
+ internal_need_vms_symbol = 0;
+
+ /* If the path name starts with a /, then it is an absolute path */
+ /* that may have been generated by the CRTL instead of the command name */
+ /* If it is the device name between the slashes, then this was likely */
+ /* from the run command and needs to be fixed up. */
+ /* If the DECC$POSIX_COMPLIANT_PATHNAMES is set to 2, then it is the */
+ /* DISK$VOLUME that will be present, and it will still need to be fixed. */
+ if (argv0[0] == '/')
+ {
+ char * nextslash;
+ int length;
+ struct item_list_3 itemlist[3];
+ unsigned short dvi_iosb[4];
+ char alldevnam[64];
+ unsigned short alldevnam_len;
+ struct dsc$descriptor_s devname_dsc;
+ char diskvolnam[256];
+ unsigned short diskvolnam_len;
+
+ internal_need_vms_symbol = 1;
+
+ /* Get some information about the disk */
+ /*--------------------------------------*/
+ itemlist[0].len = (sizeof alldevnam) - 1;
+ itemlist[0].code = DVI$_ALLDEVNAM;
+ itemlist[0].bufadr = alldevnam;
+ itemlist[0].retlen = &alldevnam_len;
+ itemlist[1].len = (sizeof diskvolnam) - 1 - 5;
+ itemlist[1].code = DVI$_VOLNAM;
+ itemlist[1].bufadr = &diskvolnam[5];
+ itemlist[1].retlen = &diskvolnam_len;
+ itemlist[2].len = 0;
+ itemlist[2].code = 0;
+
+ /* Add the prefix for the volume name. */
+ /* SYS$GETDVI will append the volume name to this */
+ strcpy (diskvolnam, "DISK$");
+
+ nextslash = strchr (&argv0[1], '/');
+ if (nextslash != NULL)
+ {
+ length = nextslash - argv0 - 1;
+
+ /* Cast needed for HP C compiler diagnostic */
+ devname_dsc.dsc$a_pointer = (char *)&argv0[1];
+ devname_dsc.dsc$w_length = length;
+ devname_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+ devname_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+ status = SYS$GETDVIW (EFN$C_ENF, 0, &devname_dsc, itemlist,
+ dvi_iosb, NULL, 0, 0);
+ if (!$VMS_STATUS_SUCCESS (status))
+ {
+ /* If the sys$getdviw fails, then this path was passed by */
+ /* An exec() program and not from DCL, so do nothing */
+ /* An example is "/tmp/program" where tmp: does not exist */
+#ifdef DEBUG
+ printf ("sys$getdviw failed with status %d\n", status);
+#endif
+ result = 0;
+ }
+ else if (!$VMS_STATUS_SUCCESS (dvi_iosb[0]))
+ {
+#ifdef DEBUG
+ printf ("sys$getdviw failed with iosb %d\n", dvi_iosb[0]);
+#endif
+ result = 0;
+ }
+ else
+ {
+ char * devnam;
+ int devnam_len;
+ char argv_dev[64];
+
+ /* Null terminate the returned alldevnam */
+ alldevnam[alldevnam_len] = 0;
+ devnam = alldevnam;
+ devnam_len = alldevnam_len;
+
+ /* Need to skip past any leading underscore */
+ if (devnam[0] == '_')
+ {
+ devnam++;
+ devnam_len--;
+ }
+
+ /* And remove the trailing colon */
+ if (devnam[devnam_len - 1] == ':')
+ {
+ devnam_len--;
+ devnam[devnam_len] = 0;
+ }
+
+ /* Null terminate the returned volnam */
+ diskvolnam_len += 5;
+ diskvolnam[diskvolnam_len] = 0;
+
+ /* Check first for normal CRTL behavior */
+ if (devnam_len == length)
+ {
+ strncpy (vms_new_nam, &argv0[1], length);
+ vms_new_nam[length] = 0;
+ result = (strcasecmp (devnam, vms_new_nam) == 0);
+ }
+
+ /* If we have not got a match, check for POSIX Compliant */
+ /* behavior. To be more accurate, we could also check */
+ /* to see if that feature is active. */
+ if ((result == 0) && (diskvolnam_len == length))
+ {
+ strncpy (vms_new_nam, &argv0[1], length);
+ vms_new_nam[length] = 0;
+ result = (strcasecmp (diskvolnam, vms_new_nam) == 0);
+ }
+ }
+ }
+ }
+ else
+ {
+ /* The path did not start with a slash, so it could be VMS format */
+ /* If it is vms format, it has a volume/device in it as it must */
+ /* be an absolute path */
+ struct dsc$descriptor_s path_desc;
+ int status;
+ unsigned long field_flags;
+ struct filescan_itmlst_2 item_list[5];
+ char * volume;
+ char * name;
+ int name_len;
+ char * ext;
+
+ path_desc.dsc$a_pointer = (char *)argv0; /* cast ok */
+ path_desc.dsc$w_length = strlen (argv0);
+ path_desc.dsc$b_dtype = DSC$K_DTYPE_T;
+ path_desc.dsc$b_class = DSC$K_CLASS_S;
+
+ /* Don't actually need to initialize anything buf itmcode */
+ /* I just do not like uninitialized input values */
+
+ /* Sanity check, this must be the same length as input */
+ item_list[0].itmcode = FSCN$_FILESPEC;
+ item_list[0].length = 0;
+ item_list[0].component = NULL;
+
+ /* If the device is present, then it if a VMS spec */
+ item_list[1].itmcode = FSCN$_DEVICE;
+ item_list[1].length = 0;
+ item_list[1].component = NULL;
+
+ /* we need the program name and type */
+ item_list[2].itmcode = FSCN$_NAME;
+ item_list[2].length = 0;
+ item_list[2].component = NULL;
+
+ item_list[3].itmcode = FSCN$_TYPE;
+ item_list[3].length = 0;
+ item_list[3].component = NULL;
+
+ /* End the list */
+ item_list[4].itmcode = 0;
+ item_list[4].length = 0;
+ item_list[4].component = NULL;
+
+ status = SYS$FILESCAN ((const struct dsc$descriptor_s *)&path_desc,
+ item_list, &field_flags, NULL, NULL);
+
+
+ if ($VMS_STATUS_SUCCESS (status) &&
+ (item_list[0].length == path_desc.dsc$w_length) &&
+ (item_list[1].length != 0))
+ {
+
+ char * dollar;
+ int keep_ext;
+ int i;
+
+ /* We need the filescan to be successful, */
+ /* same length as input, and a volume to be present */
+ internal_need_vms_symbol = 1;
+
+ /* We will assume that we only get to this path on a version */
+ /* of VMS that does not support the EFS character set */
+
+ /* There may be a xxx$ prefix on the image name. Linux */
+ /* programs do not handle that well, so strip the prefix */
+ name = item_list[2].component;
+ name_len = item_list[2].length;
+ dollar = strrchr (name, '$');
+ if (dollar != NULL)
+ {
+ dollar++;
+ name_len = name_len - (dollar - name);
+ name = dollar;
+ }
+
+ strncpy (vms_new_nam, name, name_len);
+ vms_new_nam[name_len] = 0;
+
+ /* Commit to using the new name */
+ program_name = vms_new_nam;
+
+ /* We only keep the extension if it is not ".exe" */
+ keep_ext = 0;
+ ext = item_list[3].component;
+
+ if (item_list[3].length != 1)
+ {
+ keep_ext = 1;
+ if (item_list[3].length == 4)
+ {
+ if ((ext[1] == 'e' || ext[1] == 'E') &&
+ (ext[2] == 'x' || ext[2] == 'X') &&
+ (ext[3] == 'e' || ext[3] == 'E'))
+ keep_ext = 0;
+ }
+ }
+
+ if (keep_ext == 1)
+ strncpy (&vms_new_nam[name_len], ext, item_list[3].length);
+ }
+ }
+
+ if (result)
+ {
+ char * lastslash;
+ char * dollar;
+ char * dotexe;
+ char * lastdot;
+ char * extension;
+
+ /* This means it is probably the name from a DCL command */
+ /* Find the last slash which separates the file from the */
+ /* path. */
+ lastslash = strrchr (argv0, '/');
+
+ if (lastslash != NULL) {
+ int i;
+
+ lastslash++;
+
+ /* There may be a xxx$ prefix on the image name. Linux */
+ /* programs do not handle that well, so strip the prefix */
+ dollar = strrchr (lastslash, '$');
+
+ if (dollar != NULL) {
+ dollar++;
+ lastslash = dollar;
+ }
+
+ strcpy (vms_new_nam, lastslash);
+
+ /* In UNIX mode + EFS character set, there should not be a */
+ /* version present, as it is not possible when parsing to */
+ /* tell if it is a version or part of the UNIX filename as */
+ /* UNIX programs use numeric extensions for many reasons. */
+
+ lastdot = strrchr (vms_new_nam, '.');
+ if (lastdot != NULL) {
+ int i;
+
+ i = 1;
+ while (isdigit (lastdot[i])) {
+ i++;
+ }
+ if (lastdot[i] == 0) {
+ *lastdot = 0;
+ }
+ }
+
+ /* Find the .exe on the name (case insenstive) and toss it */
+ dotexe = strrchr (vms_new_nam, '.');
+ if (dotexe != NULL) {
+ if ((dotexe[1] == 'e' || dotexe[1] == 'E') &&
+ (dotexe[2] == 'x' || dotexe[2] == 'X') &&
+ (dotexe[3] == 'e' || dotexe[3] == 'E') &&
+ (dotexe[4] == 0)) {
+
+ *dotexe = 0;
+ } else {
+ /* Also need to handle a null extension because of a */
+ /* CRTL bug. */
+ if (dotexe[1] == 0) {
+ *dotexe = 0;
+ }
+ }
+ }
+
+ /* Commit to new name */
+ program_name = vms_new_nam;
+
+ } else {
+ /* There is no way that the code should ever get here */
+ /* As we already verified that the '/' was present */
+ fprintf (stderr, "Sanity failure somewhere we lost a '/'\n");
+ }
+ }
+}
+
+#ifdef DEBUG
+
+int
+main (int argc, char ** argv, char **env)
+{
+
+ char command[1024];
+
+ set_program_name (argv[0]);
+
+ printf ("modified argv[0] = %s\n", program_name);
+
+ return 0;
+}
+#endif
diff --git a/vmsjobs.c b/vmsjobs.c
index b11bca1..df93a4d 100644
--- a/vmsjobs.c
+++ b/vmsjobs.c
@@ -20,13 +20,67 @@ this program. If not, see <http://www.gnu.org/licenses/>. */
#include <descrip.h>
#include <clidef.h>
+/* TODO - VMS specific header file conditionally included in makeint.h */
+
+#include <stsdef.h>
+#include <ssdef.h>
+void
+decc$exit (int status);
+
+/* Lowest legal non-success VMS exit code is 8 */
+/* GNU make only defines codes 0, 1, 2 */
+/* So assume any exit code > 8 is a VMS exit code */
+
+#ifndef MAX_EXPECTED_EXIT_CODE
+# define MAX_EXPECTED_EXIT_CODE 7
+#endif
+
+
+#if __CRTL_VER >= 70302000 && !defined(__VAX)
+# define MAX_DCL_LINE_LENGTH 4095
+#else
+# define MAX_DCL_LINE_LENGTH 1023
+#endif
+
char *vmsify (char *name, int type);
static int vms_jobsefnmask = 0;
+/* returns whether path is assumed to be a unix like shell. */
+int
+_is_unixy_shell (const char *path)
+{
+ if (path == NULL)
+ return 0;
+
+ /* When in doubt assume a unix like shell */
+ return 1;
+}
+
+#define VMS_GETMSG_MAX 256
+static char vms_strsignal_text[VMS_GETMSG_MAX + 2];
+
+char *
+vms_strsignal (int status)
+{
+ if (status <= MAX_EXPECTED_EXIT_CODE)
+ sprintf (vms_strsignal_text, "lib$spawn returned %x", status);
+ else
+ {
+ int vms_status;
+ unsigned short * msg_len;
+ unsigned char out[4];
+ vms_status = SYS$GETMSG (status, &msg_len,
+ vms_strsignal_text, 7, *out);
+ }
+
+ return vms_strsignal_text;
+}
+
+
/* Wait for nchildren children to terminate */
static void
-vmsWaitForChildren(int *status)
+vmsWaitForChildren (int *status)
{
while (1)
{
@@ -132,9 +186,19 @@ vmsHandleChildTerm(struct child *child)
(void) sigblock (fatal_signal_mask);
- child_failed = !(child->cstatus & 1);
- if (child_failed)
- exit_code = child->cstatus;
+ /* First check to see if this is a POSIX exit status and handle */
+ if ((child->cstatus & VMS_POSIX_EXIT_MASK) == VMS_POSIX_EXIT_MASK)
+ {
+ exit_code = (child->cstatus >> 3) & 255;
+ if (exit_code != MAKE_SUCCESS)
+ child_failed = 1;
+ }
+ else
+ {
+ child_failed = !$VMS_STATUS_SUCCESS (child->cstatus);
+ if (child_failed)
+ exit_code = child->cstatus;
+ }
/* Search for a child matching the deceased one. */
lastc = 0;
@@ -145,69 +209,16 @@ vmsHandleChildTerm(struct child *child)
c = child;
#endif
- if (child_failed && !c->noerror && !ignore_errors_flag)
+ if ($VMS_STATUS_SUCCESS (child->vms_launch_status))
{
- /* The commands failed. Write an error message,
- delete non-precious targets, and abort. */
- child_error (c, c->cstatus, 0, 0, 0);
- c->file->update_status = us_failed;
- delete_child_targets (c);
- }
- else
- {
- if (child_failed)
- {
- /* The commands failed, but we don't care. */
- child_error (c, c->cstatus, 0, 0, 1);
- child_failed = 0;
- }
-
-#if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
- /* If there are more commands to run, try to start them. */
- start_job (c);
-
- switch (c->file->command_state)
- {
- case cs_running:
- /* Successfully started. */
- break;
-
- case cs_finished:
- if (c->file->update_status != us_success)
- /* We failed to start the commands. */
- delete_child_targets (c);
- break;
-
- default:
- OS (error, NILF,
- _("internal error: '%s' command_state"), c->file->name);
- abort ();
- break;
- }
-#endif /* RECURSIVEJOBS */
+ /* Convert VMS success status to 0 for UNIX code to be happy */
+ child->vms_launch_status = 0;
}
/* Set the state flag to say the commands have finished. */
c->file->command_state = cs_finished;
notice_finished_file (c->file);
-#if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
- /* Remove the child from the chain and free it. */
- if (lastc == 0)
- children = c->next;
- else
- lastc->next = c->next;
- free_child (c);
-#endif /* RECURSIVEJOBS */
-
- /* There is now another slot open. */
- if (job_slots_used > 0)
- --job_slots_used;
-
- /* If the job failed, and the -k flag was not given, die. */
- if (child_failed && !keep_going_flag)
- die (exit_code);
-
(void) sigsetmask (sigblock (0) & ~(fatal_signal_mask));
return 1;
@@ -216,8 +227,6 @@ vmsHandleChildTerm(struct child *child)
/* VMS:
Spawn a process executing the command in ARGV and return its pid. */
-#define MAXCMDLEN 200
-
/* local helpers to make ctrl+c and ctrl+y working, see below */
#include <iodef.h>
#include <libclidef.h>
@@ -508,10 +517,8 @@ child_execute_job (char *argv, struct child *child)
}
}
/* expand ':' aka 'do nothing' builtin for bash and friends */
- else if (cmd[0]==':' && cmd[1]=='\0')
- {
- cmd = "continue";
- }
+ else if (cmd[0]==':')
+ cmd[0] = '!';
}
else
{
@@ -614,23 +621,23 @@ child_execute_job (char *argv, struct child *child)
cmd = tmp_cmd;
}
-#ifdef USE_DCL_COM_FILE
- /* Enforce the creation of a command file.
+ /* Enforce the creation of a command file if "vms_always_use_cmd_file" is
+ non-zero.
Then all the make environment variables are written as DCL symbol
assignments into the command file as well, so that they are visible
in the sub-process but do not affect the current process.
Further, this way DCL reads the input stream and therefore does
'forced' symbol substitution, which it doesn't do for one-liners when
they are 'lib$spawn'ed. */
-#else
+
+ /* Otherwise the behavior is: */
/* Create a *.com file if either the command is too long for
lib$spawn, or the command contains a newline, or if redirection
is desired. Forcing commands with newlines into DCLs allows to
store search lists on user mode logicals. */
- if (strlen (cmd) > MAXCMDLEN
+ if (vms_always_use_cmd_file || strlen (cmd) > (MAX_DCL_LINE_LENGTH - 30)
|| (have_redirection != 0)
|| (have_newline != 0))
-#endif
{
FILE *outfile;
char c;
@@ -696,9 +703,9 @@ child_execute_job (char *argv, struct child *child)
DB (DB_JOBS, (_("Redirected output to %s\n"), ofile));
ofiledsc.dsc$w_length = 0;
}
-#ifdef USE_DCL_COM_FILE
+
/* Export the child environment into DCL symbols */
- if (child->environment != 0)
+ if (vms_always_use_cmd_file || (child->environment != 0))
{
char **ep = child->environment;
char *valstr;
@@ -712,7 +719,7 @@ child_execute_job (char *argv, struct child *child)
ep++;
}
}
-#endif
+
fprintf (outfile, "$ %.*s_ = f$verify(%.*s_1)\n", tmpstrlen, tmpstr, tmpstrlen, tmpstr);
/* TODO: give 78 a name! Whether 78 is a good number is another question.
@@ -834,6 +841,17 @@ child_execute_job (char *argv, struct child *child)
vms_jobsefnmask |= (1 << (child->efn - 32));
+ /* Export the child environment into DCL symbols */
+ if (!vms_always_use_cmd_file && child->environment != 0)
+ {
+ char **ep = child->environment;
+ while (*ep != 0)
+ {
+ vms_putenv_symbol (*ep);
+ *ep++;
+ }
+ }
+
/*
LIB$SPAWN [command-string]
[,input-file]
@@ -886,21 +904,23 @@ child_execute_job (char *argv, struct child *child)
if (!setupYAstTried)
tryToSetupYAst();
- status = lib$spawn (&cmddsc, /* cmd-string */
- (ifiledsc.dsc$w_length == 0)?0:&ifiledsc, /* input-file */
- (ofiledsc.dsc$w_length == 0)?0:&ofiledsc, /* output-file */
- &spflags, /* flags */
- &pnamedsc, /* proc name */
- &child->pid, &child->cstatus, &child->efn,
- 0, 0,
- 0, 0, 0);
- if (status & 1)
+ child->vms_launch_status = lib$spawn (&cmddsc, /* cmd-string */
+ (ifiledsc.dsc$w_length == 0)?0:&ifiledsc, /* input-file */
+ (ofiledsc.dsc$w_length == 0)?0:&ofiledsc, /* output-file */
+ &spflags, /* flags */
+ &pnamedsc, /* proc name */
+ &child->pid, &child->cstatus, &child->efn,
+ 0, 0,
+ 0, 0, 0);
+
+ status = child->vms_launch_status;
+ if ($VMS_STATUS_SUCCESS (status))
{
- status= sys$waitfr (child->efn);
- vmsHandleChildTerm(child);
+ status = sys$waitfr (child->efn);
+ vmsHandleChildTerm (child);
}
#else
- status = lib$spawn (&cmddsc,
+ child->vms_launch_status = lib$spawn (&cmddsc,
(ifiledsc.dsc$w_length == 0)?0:&ifiledsc,
(ofiledsc.dsc$w_length == 0)?0:&ofiledsc,
&spflags,
@@ -908,15 +928,14 @@ child_execute_job (char *argv, struct child *child)
&child->pid, &child->cstatus, &child->efn,
vmsHandleChildTerm, child,
0, 0, 0);
+ status = child->vms_launch_status;
#endif
- if (!(status & 1))
+ if (!$VMS_STATUS_SUCCESS (status))
{
- printf (_("Error spawning, %d\n") ,status);
- fflush (stdout);
switch (status)
{
- case 0x1c:
+ case SS$_EXQUOTA:
errno = EPROCLIM;
break;
default:
@@ -924,5 +943,16 @@ child_execute_job (char *argv, struct child *child)
}
}
+ /* Restore the VMS symbols that were changed */
+ if (!vms_always_use_cmd_file && child->environment != 0)
+ {
+ char **ep = child->environment;
+ while (*ep != 0)
+ {
+ vms_restore_symbol (*ep);
+ *ep++;
+ }
+ }
+
return (status & 1);
}