diff options
author | dos-reis <gdr@axiomatics.org> | 2007-10-15 07:32:38 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-10-15 07:32:38 +0000 |
commit | 6c715d9b21d64a8d6e46563d238c5526cab811a3 (patch) | |
tree | 3f47b1e28138da174f98cfe7c7a028c98b96de5d /src/interp/server.boot | |
parent | 438fc2b3dca328c5e9a10e75ccb6ec25d8cf782e (diff) | |
download | open-axiom-6c715d9b21d64a8d6e46563d238c5526cab811a3.tar.gz |
remove more pamphlets from interp/
Diffstat (limited to 'src/interp/server.boot')
-rw-r--r-- | src/interp/server.boot | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/src/interp/server.boot b/src/interp/server.boot new file mode 100644 index 00000000..9bb1c271 --- /dev/null +++ b/src/interp/server.boot @@ -0,0 +1,223 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +import '"macros" +)package "BOOT" + +-- Scratchpad-II server + +-- Assoc list of interpreter frame names and unique integer identifiers + +$frameAlist := nil +$frameNumber := 0 +$currentFrameNum := 0 +$EndServerSession := false +$NeedToSignalSessionManager := false +$sockBufferLength := 9217 + +serverReadLine(stream) == +-- used in place of READ-LINE in a scratchpad server system. + FORCE_-OUTPUT() + not $SpadServer or not IS_-CONSOLE stream => + read_-line(stream) + IN_-STREAM: fluid := stream + _*EOF_*: fluid := NIL + line := + while not $EndServerSession and not _*EOF_* repeat + if $NeedToSignalSessionManager then + sockSendInt($SessionManager, $EndOfOutput) + $NeedToSignalSessionManager := false + action := serverSwitch() + action = $CallInterp => + l := read_-line(stream) + $NeedToSignalSessionManager := true + return l + action = $CreateFrame => + frameName := GENTEMP('"frame") + addNewInterpreterFrame(frameName) + $frameAlist := [[$frameNumber,:frameName], :$frameAlist] + $currentFrameNum := $frameNumber + sockSendInt($SessionManager, $frameNumber) + $frameNumber := $frameNumber + 1 + sockSendString($SessionManager, MKPROMPT()) + action = $SwitchFrames => + $currentFrameNum := sockGetInt($SessionManager) + currentFrame := LASSOC($currentFrameNum, $frameAlist) + changeToNamedInterpreterFrame currentFrame + action = $EndSession => + $EndServerSession := true + action = $LispCommand => + $NeedToSignalSessionManager := true + stringBuf := MAKE_-STRING $sockBufferLength + sockGetString($MenuServer, stringBuf, $sockBufferLength) + form := unescapeStringsInForm READ_-FROM_-STRING stringBuf + protectedEVAL form + action = $QuietSpadCommand => + $NeedToSignalSessionManager := true + executeQuietCommand() + action = $SpadCommand => + $NeedToSignalSessionManager := true + stringBuf := MAKE_-STRING 512 + sockGetString($MenuServer, stringBuf, 512) + CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER, + parseAndInterpret stringBuf))) + PRINC MKPROMPT() + FINISH_-OUTPUT() + action = $NonSmanSession => + $SpadServer := nil + action = $KillLispSystem => + BYE() + NIL + line => line + "" + +parseAndInterpret str == + $InteractiveMode :fluid := true + $BOOT: fluid := NIL + $SPAD: fluid := true + $e:fluid := $InteractiveFrame + $useNewParser => + ncParseAndInterpretString str + oldParseAndInterpret str + +oldParseAndInterpret str == + tree := string2SpadTree str + tree => processInteractive(parseTransform postTransform tree, NIL) + NIL + +executeQuietCommand() == + $QuietCommand: fluid := true + stringBuf := MAKE_-STRING 512 + sockGetString($MenuServer, stringBuf, 512) + CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER, + parseAndInterpret stringBuf))) + +-- Includued for compatability with old-parser systems +serverLoop() == + IN_-STREAM: fluid := CURINSTREAM + _*EOF_*: fluid := NIL + while not $EndServerSession and not _*EOF_* repeat + if $Prompt then (PRINC MKPROMPT(); FINISH_-OUTPUT()) + $Prompt := NIL + action := serverSwitch() + action = $CallInterp => + CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER, + parseAndInterpret read_-line(CURINSTREAM) ))) + PRINC MKPROMPT() + FINISH_-OUTPUT() + sockSendInt($SessionManager, $EndOfOutput) + action = $CreateFrame => + frameName := GENTEMP('"frame") + addNewInterpreterFrame(frameName) + $frameAlist := [[$frameNumber,:frameName], :$frameAlist] + $currentFrameNum := $frameNumber + sockSendInt($SessionManager, $frameNumber) + $frameNumber := $frameNumber + 1 + sockSendString($SessionManager, MKPROMPT()) + action = $SwitchFrames => + $currentFrameNum := sockGetInt($SessionManager) + currentFrame := LASSOC($currentFrameNum, $frameAlist) + changeToNamedInterpreterFrame currentFrame + action = $EndSession => + $EndServerSession := true + action = $LispCommand => + stringBuf := MAKE_-STRING 512 + sockGetString($MenuServer, stringBuf, 512) + form := unescapeStringsInForm READ_-FROM_-STRING stringBuf + EVAL form + action = $QuietSpadCommand => + executeQuietCommand() + action = $SpadCommand => + stringBuf := MAKE_-STRING 512 + sockGetString($MenuServer, stringBuf, 512) + CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER, + parseAndInterpret stringBuf))) + PRINC MKPROMPT() + FINISH_-OUTPUT() + sockSendInt($SessionManager, $EndOfOutput) + NIL + if _*EOF_* then $Prompt := true + NIL + +parseAndEvalToHypertex str == + lines := parseAndEvalToStringForHypertex str + len := LENGTH lines + sockSendInt($MenuServer, len) + for s in lines repeat + sockSendString($MenuServer, s) + +parseAndEvalToString str == + $collectOutput:local := true + $outputLines: local := nil + $IOindex: local := nil + v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr str)) + v = 'restart => ['"error"] + NREVERSE $outputLines + +parseAndEvalToStringForHypertex str == + $collectOutput:local := true + $outputLines: local := nil + v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr str)) + v = 'restart => ['"error"] + NREVERSE $outputLines + +parseAndEvalToStringEqNum str == + $collectOutput:local := true + $outputLines: local := nil + v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr str)) + v = 'restart => ['"error"] + NREVERSE $outputLines + +parseAndInterpToString str == + v := applyWithOutputToString('parseAndEvalStr, [str]) + breakIntoLines CDR v + +parseAndEvalStr string == + $InteractiveMode :fluid := true + $BOOT: fluid := NIL + $SPAD: fluid := true + $e:fluid := $InteractiveFrame + parseAndEvalStr1 string + +parseAndEvalStr1 string == + string.0 = char '")" => + doSystemCommand SUBSEQ(string, 1) + processInteractive(ncParseFromString string, NIL) + +protectedEVAL x == + error := true + val := NIL + UNWIND_-PROTECT((val := EVAL x; error := NIL), + error => (resetStackLimits(); sendHTErrorSignal())) + val |