From 7e465ce1b99903491c6132466808c9fa51ae500e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 29 Apr 2008 15:25:28 +0000 Subject: Cleanup, part 2. --- src/interp/br-saturn.boot | 22 ++++++++++++++++++---- src/interp/cfuns.lisp | 3 --- src/interp/server.boot | 17 ++++++----------- src/interp/sockio.lisp | 15 --------------- src/interp/sys-os.boot | 6 ++++-- 5 files changed, 28 insertions(+), 35 deletions(-) (limited to 'src/interp') 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_fillpst.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 -- cgit v1.2.3