improve WIN32 support and installation

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2170 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/adtdefs.c

@@ -273,6 +273,28 @@ LookupWideAtom(wchar_t *atom)
   return na;
 }
 
+Atom
+Yap_LookupMaybeWideAtom(wchar_t *atom)
+{				/* lookup atom in atom table            */
+  wchar_t *p = atom, c;
+  size_t len = 0;
+  char *ptr, *ptr0;
+  Atom at;
+
+  while ((c = *p++)) { 
+    if (c > 255) return LookupWideAtom(atom);
+    len++;
+  }
+  /* not really a wide atom */
+  ptr0 = ptr = Yap_AllocCodeSpace(len+1);
+  if (!ptr)
+    return NIL;
+  while ((*ptr++ = *p++));
+  at = LookupAtom(ptr0);
+  Yap_FreeCodeSpace(ptr0);
+  return at;
+}
+
 Atom
 Yap_LookupAtom(char *atom)
 {				/* lookup atom in atom table            */

C/errors.c

@@ -858,6 +858,21 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case EXISTENCE_ERROR_KEY:
+    {
+      int i;
+      Term ti[2];
+
+      i = strlen(tmpbuf);
+      ti[0] = MkAtomTerm(Yap_LookupAtom("key"));
+      ti[1] = where;
+      nt[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("existence_error"),2), 2, ti);
+      tp = tmpbuf+i;
+      psize -= i;
+      fun = Yap_MkFunctor(Yap_LookupAtom("error"),2);
+      serious = TRUE;
+    }
+    break;
   case EXISTENCE_ERROR_STREAM:
     {
       int i;

C/save.c

@@ -1431,8 +1431,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
   int mode = FAIL_RESTORE;
 
   //  Yap_ErrorMessage = NULL;
-  if (inpf == NULL)
-    inpf = StartUpFile;
+  if (inpf == NULL) {
+#if _MSC_VER || defined(__MINGW32__)
+    if (!(inpf = Yap_RegistryGetString("startup")))
+#endif
+      inpf = StartUpFile;
+  }
 #if __simplescalar__
   /* does not implement getcwd */
   strncpy(Yap_FileNameBuf,yap_pwd,YAP_FILENAME_MAX);

C/sysbits.c

@@ -186,6 +186,16 @@ char *libdir = NULL;
 
 void
 Yap_InitSysPath(void) {
+#if _MSC_VER || defined(__MINGW32__)
+  {
+    char *dir;
+    if ((dir = Yap_RegistryGetString("library"))) {
+      Yap_PutValue(Yap_LookupAtom("system_library_directory"),
+		   MkAtomTerm(Yap_LookupAtom(dir)));
+      return;
+    }
+  }
+#endif
   strncpy(Yap_FileNameBuf, SHARE_DIR, YAP_FILENAME_MAX);
 #if _MSC_VER || defined(__MINGW32__)
   {
@@ -1665,13 +1675,17 @@ TrueFileName (char *source, char *root, char *result, int in_lib)
     strncpy (result, source, YAP_FILENAME_MAX);
   }
 #if defined(_WIN32)
-  res1 = result;
-  /* step 2 WINDOWS: replacing \ by / */
-  while ((ch = *res1++)) {
-    if (ch == '\\' && dir_separator('\\')) {
-      res1[-1] = '/';
-    }
-  }
+ {
+   int ch;
+
+   res0 = result;
+   /* step 2 WINDOWS: replacing \ by / */
+   while ((ch = *res0++)) {
+     if (ch == '\\' && dir_separator('\\')) {
+       res0[-1] = '/';
+     }
+   }
+ }
 #endif
   /* step 3: get the full file name */
   if (!dir_separator(result[0]) && !volume_header(result)) {
@@ -2657,6 +2671,193 @@ p_ld_path(void)
 
 
 
+#ifdef _WIN32
+
+/* This code is from SWI-Prolog by Jan Wielemaker */
+
+#define wstreq(s,q) (wcscmp((s), (q)) == 0)
+
+static HKEY
+reg_open_key(const wchar_t *which, int create)
+{ HKEY key = HKEY_CURRENT_USER;
+  DWORD disp;
+  LONG rval;
+
+  while(*which)
+  { wchar_t buf[256];
+    wchar_t *s;
+    HKEY tmp;
+
+    for(s=buf; *which && !(*which == '/' || *which == '\\'); )
+      *s++ = *which++;
+    *s = '\0';
+    if ( *which )
+      which++;
+
+    if ( wstreq(buf, L"HKEY_CLASSES_ROOT") )
+    { key = HKEY_CLASSES_ROOT;
+      continue;
+    } else if ( wstreq(buf, L"HKEY_CURRENT_USER") )
+    { key = HKEY_CURRENT_USER;
+      continue;
+    } else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") )
+    { key = HKEY_LOCAL_MACHINE;
+      continue;
+    } else if ( wstreq(buf, L"HKEY_USERS") )
+    { key = HKEY_USERS;
+      continue;
+    }
+
+    if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS )
+    { RegCloseKey(key);
+      key = tmp;
+      continue;
+    }
+
+    if ( !create )
+      return NULL;
+
+    rval = RegCreateKeyExW(key, buf, 0, L"", 0,
+			  KEY_ALL_ACCESS, NULL, &tmp, &disp);
+    RegCloseKey(key);
+    if ( rval == ERROR_SUCCESS )
+      key = tmp;
+    else
+      return NULL;
+  }
+
+  return key;
+}
+
+#define MAXREGSTRLEN 1024
+
+static void
+recover_space(wchar_t *k, Atom At)
+{
+  if (At->WStrOfAE != k)
+    Yap_FreeCodeSpace((char *)k);
+}
+
+static wchar_t *
+WideStringFromAtom(Atom KeyAt)
+{
+  if (IsWideAtom(KeyAt)) {
+    return KeyAt->WStrOfAE;
+  } else {
+    int len = strlen(KeyAt->StrOfAE);
+    int sz = sizeof(wchar_t)*(len+1);
+    char *chp = KeyAt->StrOfAE;
+    wchar_t *kptr, *k;
+
+    k = (wchar_t *)Yap_AllocCodeSpace(sz);
+    while (k == NULL) {
+      if (!Yap_growheap(FALSE, sz, NULL)) {
+	Yap_Error(OUT_OF_HEAP_ERROR, MkIntegerTerm(sz), "generating key in win_registry_get_value/3");
+	return FALSE;
+      }      
+    }
+    kptr = k;
+    while ((*kptr++ = *chp++));
+    return k;
+  }
+}
+
+static Int
+p_win_registry_get_value(void)
+{
+  DWORD type;
+  BYTE  data[MAXREGSTRLEN];
+  DWORD len = sizeof(data);
+  wchar_t *k, *name;
+  HKEY key;
+  Term Key = Deref(ARG1);
+  Term Name = Deref(ARG2);
+  Atom KeyAt, NameAt;
+
+  if (IsVarTerm(Key)) {
+    Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound");
+    return FALSE;
+  }
+  if (!IsAtomTerm(Key)) {
+    Yap_Error(TYPE_ERROR_ATOM,Key,"argument to win_registry_get_value");
+    return FALSE;
+  }
+  KeyAt = AtomOfTerm(Key);
+  if (IsVarTerm(Name)) {
+    Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound");
+    return FALSE;
+  }
+  if (!IsAtomTerm(Name)) {
+    Yap_Error(TYPE_ERROR_ATOM,Key,"argument to win_registry_get_value");
+    return FALSE;
+  }
+  NameAt = AtomOfTerm(Name);
+
+  k = WideStringFromAtom(KeyAt);
+  if ( !(key=reg_open_key(k, FALSE)) ) {
+    Yap_Error(EXISTENCE_ERROR_KEY, Key, "argument to win_registry_get_value");
+    recover_space(k, KeyAt);
+    return FALSE;
+  }
+  name = WideStringFromAtom(NameAt);
+
+  if ( RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
+    RegCloseKey(key);
+    switch(type) {
+    case REG_SZ:
+      recover_space(k, KeyAt);
+      recover_space(name, NameAt);
+      ((wchar_t *)data)[len] = '\0';
+      return Yap_unify(MkAtomTerm(Yap_LookupMaybeWideAtom((wchar_t *)data)),ARG3);
+    case REG_DWORD:
+      recover_space(k, KeyAt);
+      recover_space(name, NameAt);
+      return Yap_unify(MkIntegerTerm(*((DWORD *)data)),ARG3);
+    default:
+      recover_space(k, KeyAt);
+      recover_space(name, NameAt);
+      return FALSE;
+    }
+  }
+  recover_space(k, KeyAt);
+  recover_space(name, NameAt);
+  return FALSE;
+}
+
+char *
+Yap_RegistryGetString(char *name)
+{
+  DWORD type;
+  BYTE  data[MAXREGSTRLEN];
+  DWORD len = sizeof(data);
+  HKEY key;
+  char *ptr;
+  int i;
+
+  if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE)) ) {
+    return NULL;
+  }
+  if ( RegQueryValueEx(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
+    RegCloseKey(key);
+    switch(type) {
+    case REG_SZ:
+      ptr = malloc(len+2);
+      if (!ptr)
+	return NULL;
+      for (i=0; i<= len; i++)
+	ptr[i] = data[i];
+      ptr[len+1] = '\0';
+      return ptr;
+    default:
+      return NULL;
+    }
+  }
+  return NULL;
+}
+
+
+#endif
+
 void
 Yap_InitSysPreds(void)
 {
@@ -2686,6 +2887,9 @@ Yap_InitSysPreds(void)
   Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
   Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);
   Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
+#ifdef _WIN32
+  Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
+#endif
   CurrentModule = SYSTEM_MODULE;
   Yap_InitCPred ("true_file_name", 2, p_true_file_name, SyncPredFlag);
   Yap_InitCPred ("true_file_name", 3, p_true_file_name3, SyncPredFlag);