Cleanup, part 2.

5 files changed, 28 insertions, 35 deletions

diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index b4960abb..6c18cdfd 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -1176,6 +1176,18 @@ htShowPageStarSaturn() ==
 --              Redefinitions from br-op2.boot
 --=======================================================================
 
+++ returns true if op designate a niladic constructor.  Note that
+++ constructors are symbols whereas ordinary operations are strings.
+operationIsNiladicConstructor op ==
+  IDENTP op => niladicConstructorFromDB op
+  false
+
+++ Like operationIsNiladicConstructor() except that we just want
+++ to know whether `op' is a constructor, arity is unimportant.
+operationIsConstructor op ==
+  IDENTP op => getDualSignatureFromDB op
+  nil
+
 --------------> NEW DEFINITION (see br-op2.boot.pamphlet)
 displayDomainOp(htPage,which,origin,op,sig,predicate,
                 doc,index,chooseFn,unexposed?,$generalSearch?) ==
@@ -1209,12 +1221,14 @@ displayDomainOp(htPage,which,origin,op,sig,predicate,
   ops := escapeSpecialChars STRINGIMAGE op
   n := #sig
   do
-    n = 2 and LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}")
-    n = 3 and LASSOC('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}")
+    n = 2 and LASSOC('Nud,PROPLIST op) => 
+      htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}")
+    n = 3 and LASSOC('Led,PROPLIST op) => 
+      htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}")
     if unexposed? and $includeUnexposed? then
       htSayUnexposed()
     htSay(ops)
-    predicate='ASCONST or niladicConstructorFromDB op or member(op,'(0 1)) => 'skip
+    predicate='ASCONST or operationIsNiladicConstructor op or member(op,'(0 1)) => 'skip
     which = '"attribute" and null args => 'skip
     htSay('"(")
     if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}")
@@ -1254,7 +1268,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate,
       htSaySaturn '"{\em Arguments:}"
       htSaySaturnAmpersand()
       firstTime := true
-      coSig := KDR getDualSignatureFromDB op  --check if op is constructor
+      coSig := KDR operationIsConstructor op  --check if op is constructor
       for a in args for t in rest $sig repeat
             if not firstTime then
               htSaySaturn '"\\ "
diff --git a/src/interp/cfuns.lisp b/src/interp/cfuns.lisp
index 9ae4f3bc..84ce0ac3 100644
--- a/src/interp/cfuns.lisp
+++ b/src/interp/cfuns.lisp
@@ -35,9 +35,6 @@
 (import-module "boot-pkg")
 (in-package "BOOT")
 
-#+:GCL
-(defun |getEnv| (var-name)  (system::getenv var-name))
-
 ;;stolen from AXIOM-XL src/strops.c
 #+(AND KCL (NOT ELF))
 (Clines 
diff --git a/src/interp/server.boot b/src/interp/server.boot
index 02525de7..ea65ff3c 100644
--- a/src/interp/server.boot
+++ b/src/interp/server.boot
@@ -79,17 +79,15 @@ serverReadLine(stream) ==
        $EndServerSession := true
      action = $LispCommand =>
        $NeedToSignalSessionManager := true
-       stringBuf := MAKE_-STRING $sockBufferLength
-       sockGetString($MenuServer, stringBuf, $sockBufferLength)
-       form := unescapeStringsInForm READ_-FROM_-STRING stringBuf
+       buf := sockGetString $MenuServer
+       form := unescapeStringsInForm READ_-FROM_-STRING buf
        protectedEVAL form
      action = $QuietSpadCommand =>
        $NeedToSignalSessionManager := true
        executeQuietCommand()
      action = $SpadCommand =>
        $NeedToSignalSessionManager := true
-       stringBuf := MAKE_-STRING 512
-       sockGetString($MenuServer, stringBuf, 512)
+       stringBuf := sockGetString $MenuServer
        CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
 	 parseAndInterpret stringBuf)))
        PRINC MKPROMPT()
@@ -116,8 +114,7 @@ oldParseAndInterpret str ==
 
 executeQuietCommand() ==
   $QuietCommand: fluid := true
-  stringBuf := MAKE_-STRING 512
-  sockGetString($MenuServer, stringBuf, 512)
+  stringBuf := sockGetString $MenuServer
   CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
     parseAndInterpret stringBuf)))
 
@@ -150,15 +147,13 @@ serverLoop() ==
     action = $EndSession =>
       $EndServerSession := true
     action = $LispCommand =>
-      stringBuf := MAKE_-STRING 512
-      sockGetString($MenuServer, stringBuf, 512)
+      stringBuf := sockGetString $MenuServer
       form := unescapeStringsInForm READ_-FROM_-STRING stringBuf
       EVAL form
     action = $QuietSpadCommand =>
       executeQuietCommand()
     action = $SpadCommand =>
-      stringBuf := MAKE_-STRING 512
-      sockGetString($MenuServer, stringBuf, 512)
+      stringBuf := sockGetString $MenuServer
       CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
         parseAndInterpret stringBuf)))
       PRINC MKPROMPT()
diff --git a/src/interp/sockio.lisp b/src/interp/sockio.lisp
index ab963588..0ed33463 100644
--- a/src/interp/sockio.lisp
+++ b/src/interp/sockio.lisp
@@ -36,21 +36,6 @@
 (import-module "boot-pkg")
 (in-package "BOOT")
 
-#+KCL
-(progn
-;; GCL may pass strings by value.  'sock_get_string_buf' should fill
-;; string with data read from connection, therefore needs address of
-;; actual string buffer. We use 'sock_get_string_buf_wrapper' to
-;; resolve the problem
-  (clines "int sock_get_string_buf_wrapper(int i, object x, int j)"
-          "{ if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x);"
-          "  if (x->st.st_fillp<j)"
-          "    FEerror(\"string too small in sock_get_string_buf_wrapper\",0);"
-          "  return sock_get_string_buf(i, x->st.st_self, j); }")
-  (defentry |sockGetString| (int object int) 
-     (int "sock_get_string_buf_wrapper"))
-  )
-
 ;; Macros for use in Boot
 
 ;; Socket types.  This list must be consistent with the one in com.h
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index 019228d2..61ace016 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -63,6 +63,9 @@ import renameFile for
 import mkdir for
   oa__mkdir: string -> int  -- 0: sucess, -1: failure.
 
+import getEnv for
+  oa__getenv: string -> string
+
 ++ socket interface
 import openServer for
   open__server: string -> int
@@ -73,9 +76,8 @@ import sockGetInt for
 import sockSendInt for
   sock__send__int: (int,int) -> int
 
-)if not %hasFeature KEYWORD::GCL
 import sockGetString for
-  sock__get__string__buf: (int,pointer,int) -> int
+  sock__get__string: int -> string
 )endif
 
 import doSendString for