From ba5b84d124bc2dfd534bccb6bca02b2440a991b9 Mon Sep 17 00:00:00 2001
From: John Malmberg <wb8tyw@qsl.net>
Date: Tue, 27 May 2014 23:50:06 -0500
Subject: [PATCH] vms_export_symbol_fix_pass1

VMS needs to simulate exporting symbols for running nested make
commands.

This also includes setting and exporting a foreign command for the
make image used to invoke make.

The vms_progname.c is designed as a drop-in replacement for the gnulib
progname.c used in various gnu packages.
---
 main.c                        |   31 +++-
 makefile.com                  |   41 +++--
 makefile.vms                  |   17 +-
 makeint.h                     |   29 ++-
 tests/scripts/functions/value |   12 +-
 vms_export_symbol.c           |  457 +++++++++++++++++++++++++++++++++++++++++
 vms_export_symbol_test.com    |   37 ++++
 vms_progname.c                |  446 ++++++++++++++++++++++++++++++++++++++++
 vmsjobs.c                     |   22 ++
 9 files changed, 1056 insertions(+), 36 deletions(-)
 create mode 100644 vms_export_symbol.c
 create mode 100644 vms_export_symbol_test.com
 create mode 100644 vms_progname.c

diff --git a/main.c b/main.c
index 3a3d016..d45fd6d 100644
--- a/main.c
+++ b/main.c
@@ -1161,11 +1161,7 @@ main (int argc, char **argv, char **envp)
     program = "make";
   else
     {
-#ifdef VMS
-      program = strrchr (argv[0], ']');
-#else
       program = strrchr (argv[0], '/');
-#endif
 #if defined(__MSDOS__) || defined(__EMX__)
       if (program == 0)
         program = strrchr (argv[0], '\\');
@@ -1194,10 +1190,19 @@ main (int argc, char **argv, char **envp)
             }
         }
 #endif
+#ifdef VMS
+      set_program_name(argv[0]);
+      program = program_name;
+      if (need_vms_symbol())
+        {
+          create_foreign_command(program_name, argv[0]);
+        }
+#else
       if (program == 0)
         program = argv[0];
       else
         ++program;
+#endif
     }
 
   /* Set up to access user data (files).  */
@@ -1581,7 +1586,11 @@ main (int argc, char **argv, char **envp)
 
   /* The extra indirection through $(MAKE_COMMAND) is done
      for hysterical raisins.  */
+#ifdef VMS_FOREIGN_COMMAND
+  define_variable_cname ("MAKE_COMMAND", program, o_default, 0);
+#else
   define_variable_cname ("MAKE_COMMAND", argv[0], o_default, 0);
+#endif
   define_variable_cname ("MAKE", "$(MAKE_COMMAND)", o_default, 1);
 
   if (command_variables != 0)
@@ -1725,7 +1734,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
@@ -2335,12 +2344,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;
                   }
               }
@@ -2365,6 +2380,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);
@@ -2508,8 +2526,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 6359c47..239b9e8 100644
--- a/makefile.com
+++ b/makefile.com
@@ -1,8 +1,7 @@
 $!
 $! Makefile.com - builds GNU Make for VMS
 $!
-$! P1 is non-empty if you want to link with the VAXCRTL library instead
-$!    of the shareable executable
+$! P1 = LIST will provide compiler listings.
 $! P2 = DEBUG will build an image with debug information
 $! P3 = WALL will enable all warning messages (some are suppressed since
 $!      one macro intentionally causes an error condition)
@@ -50,6 +49,12 @@ $      endif
 $   endif
 $ endif
 $!
+$!
+$ if (p1 .eqs. "LIST")
+$ then
+$   ccopt = ccopt + "/list/show=(expan,inclu)"
+$ endif
+$!
 $! Should we build a debug image
 $!
 $ if (p2.eqs."DEBUG")
@@ -67,9 +72,12 @@ $ then
 $   gosub check_cc_qual
 $ endif
 $ filelist = "alloca ar arscan commands default dir expand file function " + -
-             "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"
+             "guile hash implicit job load main misc read remake " + -
+             "remote-stub rule output signame variable version " + -
+             "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
 $ open/write optf make.opt
@@ -77,18 +85,14 @@ $ loop:
 $ cfile = f$elem(n," ",filelist)
 $ if cfile .eqs. " " then goto linkit
 $ write sys$output "Compiling ''cfile'..."
-$ call compileit 'cfile' 'p1'
+$ call compileit 'cfile'
 $ n = n + 1
 $ goto loop
 $ linkit:
 $ close optf
-$ if p1 .nes. "" then goto link_using_library
 $ link/exe=make make.opt/opt'lopt
 $ goto cleanup
 $
-$ link_using_library:
-$ link/exe=make make.opt/opt,sys$library:vaxcrtl/lib'lopt
-$
 $ cleanup:
 $ if f$trnlnm("SYS").nes."" then $ deassign sys
 $ if f$trnlnm("OPTF").nes."" then $ close optf
@@ -128,11 +132,18 @@ $!-----------------------------------------------------------------------------
 $!
 $ compileit : subroutine
 $ ploc = f$locate("]",p1)
-$ filnam = p1
-$ if ploc .lt. f$length(p1) then filnam=f$extract(ploc+1,100,p1)
-$ write optf "''filnam'"
-$ cc'ccopt'/include=([],[.glob]) -
-  /define=("allocated_variable_expand_for_file=alloc_var_expand_for_file","unlink=remove","HAVE_CONFIG_H","VMS") -
+$! filnam = p1
+$ if ploc .lt. f$length(p1)
+$ then
+$   objdir = f$extract(0, ploc+1, p1)
+$   write optf p1
+$ 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") -
   'p1'
 $ exit
 $ endsubroutine : compileit
diff --git a/makefile.vms b/makefile.vms
index e5950b7..450dc3c 100644
--- a/makefile.vms
+++ b/makefile.vms
@@ -88,18 +88,20 @@ mandir = []
 # Number to put on the man page filename.
 manext = 1
 
-#guile = ,guile.obj
+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\
-       $(ARCHIVES)$(ALLOCA)$(extras)$(getopt)$(glob)$(guile)
+       vpath.obj,version.obj,vms_progname.obj,vms_exit.obj,\
+       vms_export_symbol.obj,$(guile)\
+       $(ARCHIVES)$(ALLOCA)$(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
 
 
@@ -131,11 +133,11 @@ file.obj: file.c makeint.h commands.h dep.h filedef.h variable.h job.h debug.h
 function.obj: function.c makeint.h variable.h dep.h commands.h filedef.h debug.h job.h
 getopt.obj: getopt.c getopt.h config.h gettext.h
 getopt1.obj: getopt1.c getopt.h config.h
-guile.obj: guile.c makeint.h debug.h dep.h gmk-default.h
+guile.obj: guile.c makeint.h debug.h dep.h
 hash.obj: hash.c makeint.h hash.h
 implicit.obj: implicit.c makeint.h rule.h dep.h filedef.h debug.h variable.h job.h commands.h
 job.obj: job.c vmsjobs.c makeint.h commands.h job.h filedef.h variable.h debug.h
-output.obj: output.c vmsjobs.c makeint.h output.h filedef.h debug.h
+output.obj: output.c makeint.h output.h filedef.h debug.h
 load.obj: load.c makeint.h debug.h filedef.h variable.h
 main.obj: main.c makeint.h commands.h dep.h filedef.h variable.h job.h rule.h debug.h getopt.h
 misc.obj: misc.c makeint.h dep.h debug.h
@@ -150,6 +152,9 @@ version.obj: version.c config.h
 vmsfunctions.obj: vmsfunctions.c makeint.h vmsdir.h debug.h job.h
 vmsify.obj: vmsify.c
 vpath.obj: vpath.c makeint.h filedef.h variable.h
+vms_progname.obj: vms_progname.c
+vms_exit.obj: vms_exit.c
+vms_export_symbol.obj: vms_export_symbol.c
 [.glob]fnmatch.obj: [.glob]fnmatch.c [.glob]fnmatch.h config.h
 [.glob]glob.obj: [.glob]glob.c [.glob]glob.h [.glob]fnmatch.h config.h
 
diff --git a/makeint.h b/makeint.h
index 7c695f5..2c43011 100644
--- a/makeint.h
+++ b/makeint.h
@@ -626,14 +626,29 @@ extern int handling_fatal_signal;
 #define MAX(_a,_b) ((_a)>(_b)?(_a):(_b))
 #endif
 
+#define MAKE_SUCCESS 0
+#define MAKE_TROUBLE 1
+#define MAKE_FAILURE 2
+
 #ifdef VMS
-#  define MAKE_SUCCESS 1
-#  define MAKE_TROUBLE 2
-#  define MAKE_FAILURE 3
-#else
-#  define MAKE_SUCCESS 0
-#  define MAKE_TROUBLE 1
-#  define MAKE_FAILURE 2
+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
 
 /* Set up heap debugging library dmalloc.  */
diff --git a/tests/scripts/functions/value b/tests/scripts/functions/value
index 8e1a6f0..601fd15 100644
--- a/tests/scripts/functions/value
+++ b/tests/scripts/functions/value
@@ -6,6 +6,13 @@ $details = "This is a test of the value function in GNU make.
 This function will evaluate to the value of the named variable with no
 further expansion performed on it.\n";
 
+# VMS specific note:
+# $^O eq 'VMS' is for a behavior always neeeded for VMS
+# $vms is for VMS with out a GNV Bash shell
+
+$vms = 0;
+$vms = 1 if ($^O eq 'VMS' && !defined $ENV{"SHELL"});
+
 open(MAKEFILE,"> $makefile");
 
 print MAKEFILE <<'EOF';
@@ -23,7 +30,10 @@ close(MAKEFILE);
 
 # Create the answer to what should be produced by this Makefile
 $answer = "FOO = OO FOO = foo FOO = foo FOO = foo\n";
-
+if ($vms) {
+# VMS currently does not do shell expansion
+$answer = "FOO = OO FOO = \$FOO FOO = foo FOO = foo\n";
+}
 
 &compare_output($answer,&get_logfile(1));
 
diff --git a/vms_export_symbol.c b/vms_export_symbol.c
new file mode 100644
index 0000000..a59b26c
--- /dev/null
+++ b/vms_export_symbol.c
@@ -0,0 +1,457 @@
+/* File: vms_export_symbol.c
+ *
+ * Some programs need special environment variables deported as DCL
+ * DCL symbols.
+ */
+
+/* Copyright 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 during 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;
+
+    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 = (char *) value;
+    string_len = strlen(value);
+    if (string_len > MAX_DCL_SYMBOL_VALUE) {
+        string_len = MAX_DCL_SYMBOL_VALUE;
+    }
+    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;
+}
+
+#ifdef __VAX
+static char transpath[MAX_DCL_SYMBOL_VALUE];
+#else
+#define transpath_parm transpath
+#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..b2c97f9
--- /dev/null
+++ b/vms_export_symbol_test.com
@@ -0,0 +1,37 @@
+$! VMS_EXPORT_SYMBOL_TEST.COM
+$!
+$! Verify the VMS_EXPORT_SYMBOL_TEST.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..bc60841
--- /dev/null
+++ b/vms_progname.c
@@ -0,0 +1,446 @@
+/* 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 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;
+int need_vms_translate;
+
+#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 8109b5b..78e56e9 100644
--- a/vmsjobs.c
+++ b/vmsjobs.c
@@ -625,6 +625,17 @@ child_execute_job (char *argv, struct child *child)
 
   vms_jobsefnmask |= (1 << (child->efn - 32));
 
+  /* Export the child environment into DCL symbols */
+  if (child->environment != 0)
+    {
+      char **ep = child->environment;
+      while (*ep != 0)
+        {
+          vms_putenv_symbol(*ep);
+          *ep++;
+        }
+    }
+
   /*
     LIB$SPAWN  [command-string]
     [,input-file]
@@ -715,5 +726,16 @@ child_execute_job (char *argv, struct child *child)
         }
     }
 
+  /* Restore the VMS symbols that were changed */
+  if (child->environment != 0)
+    {
+      char **ep = child->environment;
+      while (*ep != 0)
+        {
+          vms_restore_symbol(*ep);
+          *ep++;
+        }
+    }
+
   return (status & 1);
 }
-- 
1.7.9

