From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 1 Nov 1997 07:10:30 +0000 (+0000)
Subject: Add new primitives GET-HOST-NAME and CANONICAL-HOST-NAME.
X-Git-Tag: 20090517-FFI~4954
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e90b0445e52af7cef852068199c825a52e903a38;p=mit-scheme.git

Add new primitives GET-HOST-NAME and CANONICAL-HOST-NAME.
---

diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c
index c9ae5b491..6e0a14431 100644
--- a/v7/src/microcode/pruxsock.c
+++ b/v7/src/microcode/pruxsock.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: pruxsock.c,v 1.11 1997/10/26 08:05:01 cph Exp $
+$Id: pruxsock.c,v 1.12 1997/11/01 07:10:30 cph Exp $
 
 Copyright (c) 1990-97 Massachusetts Institute of Technology
 
@@ -124,6 +124,40 @@ The result is a vector of strings, or #F if no such host exists.")
     });
 }
 
+DEFINE_PRIMITIVE ("GET-HOST-NAME", Prim_get_host_name, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  SOCKET_CODE
+    ({
+      CONST char * host_name = (OS_get_host_name ());
+      if (host_name == 0)
+	PRIMITIVE_RETURN (SHARP_F);
+      {
+	SCHEME_OBJECT result
+	  = (char_pointer_to_string ((unsigned char *) host_name));
+	OS_free (host_name);
+	PRIMITIVE_RETURN (result);
+      }
+    });
+}
+
+DEFINE_PRIMITIVE ("CANONICAL-HOST-NAME", Prim_canonical_host_name, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  SOCKET_CODE
+    ({
+      CONST char * host_name = (OS_full_host_name (STRING_ARG (1)));
+      if (host_name == 0)
+	PRIMITIVE_RETURN (SHARP_F);
+      {
+	SCHEME_OBJECT result
+	  = (char_pointer_to_string ((unsigned char *) host_name));
+	OS_free (host_name);
+	PRIMITIVE_RETURN (result);
+      }
+    });
+}
+
 #ifdef HAVE_SOCKETS
 
 static char *