aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/br-saturn.boot22
-rw-r--r--src/interp/cfuns.lisp3
-rw-r--r--src/interp/server.boot17
-rw-r--r--src/interp/sockio.lisp15
-rw-r--r--src/interp/sys-os.boot6
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-19 16:00:07 +0000