1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32)package "BOOT" 33 34-- Socket types. This list must be consistent with the one in com.h 35DEFCONSTANT($SessionManager, 1) 36DEFCONSTANT($ViewportServer, 2) 37DEFCONSTANT($MenuServer, 3) 38DEFCONSTANT($SessionIO, 4) 39DEFCONSTANT($MessageServer, 5) 40DEFCONSTANT($InterpWindow, 6) 41DEFCONSTANT($KillSpad, 7) 42DEFCONSTANT($DebugWindow, 8) 43DEFCONSTANT($Forker, 9) 44 45-- Session Manager action requests 46DEFCONSTANT($CreateFrame, 1) 47DEFCONSTANT($SwitchFrames, 2) 48DEFCONSTANT($EndOfOutput, 3) 49DEFCONSTANT($CallInterp, 4) 50DEFCONSTANT($EndSession, 5) 51DEFCONSTANT($LispCommand, 6) 52DEFCONSTANT($SpadCommand, 7) 53DEFCONSTANT($SendXEventToHyperTeX, 8) 54DEFCONSTANT($QuietSpadCommand, 9) 55DEFCONSTANT($CloseClient, 10) 56DEFCONSTANT($QueryClients, 11) 57DEFCONSTANT($QuerySpad, 12) 58DEFCONSTANT($NonSmanSession, 13) 59DEFCONSTANT($KillLispSystem, 14) 60 61DEFCONSTANT($CreateFrameAnswer, 50) 62 63-- Scratchpad-II server 64 65-- Assoc list of interpreter frame names and unique integer identifiers 66 67DEFPARAMETER($frameAlist, nil) 68DEFPARAMETER($frameNumber, 0) 69DEFPARAMETER($currentFrameNum, 0) 70DEFPARAMETER($EndServerSession, false) 71DEFPARAMETER($NeedToSignalSessionManager, false) 72 73serverReadLine(stream) == 74-- used in place of read_-line in a scratchpad server system. 75 FORCE_-OUTPUT() 76 not $SpadServer => 77 read_line(stream) 78 _*EOF_*: fluid := NIL 79 line := 80 while not $EndServerSession and not _*EOF_* repeat 81 if $NeedToSignalSessionManager then 82 sockSendInt($SessionManager, $EndOfOutput) 83 $NeedToSignalSessionManager := false 84 action := serverSwitch() 85 action = $CallInterp => 86 l := read_line(stream) 87 $NeedToSignalSessionManager := true 88 return l 89 action = $CreateFrame => 90 frameName := GENTEMP('"frame") 91 addNewInterpreterFrame(frameName) 92 $frameAlist := [[$frameNumber,:frameName], :$frameAlist] 93 $currentFrameNum := $frameNumber 94 sockSendInt($SessionManager, $CreateFrameAnswer) 95 sockSendInt($SessionManager, $frameNumber) 96 $frameNumber := $frameNumber + 1 97-- MRX I'm not sure whether I should call ioHook("startPrompt")/ioHook("endOfPrompt") here 98 sockSendString($SessionManager, MKPROMPT()) 99 action = $SwitchFrames => 100 $currentFrameNum := sockGetInt($SessionManager) 101 currentFrame := LASSOC($currentFrameNum, $frameAlist) 102 changeToNamedInterpreterFrame currentFrame 103 action = $EndSession => 104 $EndServerSession := true 105 action = $LispCommand => 106 $NeedToSignalSessionManager := true 107 stringBuf := sockGetStringFrom($MenuServer) 108 form := unescapeStringsInForm READ_-FROM_-STRING stringBuf 109 protectedEVAL form 110 action = $QuietSpadCommand => 111 $NeedToSignalSessionManager := true 112 executeQuietCommand() 113 action = $SpadCommand => 114 $NeedToSignalSessionManager := true 115 stringBuf := sockGetStringFrom($MenuServer) 116 CATCH('coerceFailure, CATCH('top_level, CATCH('SPAD_READER, 117 parseAndInterpret stringBuf))) 118-- MRX I'm not sure whether I should call ioHook("startPrompt")/ioHook("endOfPrompt") here 119 princPrompt() 120 FORCE_-OUTPUT() 121 action = $NonSmanSession => 122 $SpadServer := nil 123 action = $KillLispSystem => 124 QUIT() 125 NIL 126 line => line 127 "" 128 129parseAndInterpret str == 130 $InteractiveMode :fluid := true 131 $e:fluid := $InteractiveFrame 132 ncParseAndInterpretString str 133 134executeQuietCommand() == 135 $QuietCommand: fluid := true 136 sockGetStringFrom($MenuServer) 137 CATCH('coerceFailure, CATCH('top_level, CATCH('SPAD_READER, 138 parseAndInterpret stringBuf))) 139 140parseAndEvalToHypertex str == 141 lines := parseAndEvalToStringEqNum(str) 142 len := LENGTH lines 143 sockSendInt($MenuServer, len) 144 for s in lines repeat 145 sockSendString($MenuServer, s) 146 147parseAndEvalToString str == 148 $collectOutput:local := true 149 $outputLines: local := nil 150 $IOindex: local := nil 151 v := CATCH('SPAD_READER, CATCH('top_level, parseAndEvalStr str)) 152 v = 'restart => ['"error"] 153 NREVERSE $outputLines 154 155parseAndEvalToStringEqNum str == 156 $collectOutput:local := true 157 $outputLines: local := nil 158 v := CATCH('SPAD_READER, CATCH('top_level, parseAndEvalStr str)) 159 v = 'restart => ['"error"] 160 NREVERSE $outputLines 161 162parseAndInterpToString str == 163 v := applyWithOutputToString('parseAndEvalStr, [str]) 164 breakIntoLines rest v 165 166parseAndEvalStr string == 167 $InteractiveMode :fluid := true 168 $e:fluid := $InteractiveFrame 169 parseAndEvalStr1 string 170 171parseAndEvalStr1 string == 172 string.0 = char '")" => 173 doSystemCommand SUBSEQ(string, 1) 174 sform := ncParseFromString string 175 $QuietCommand : local := $QuietCommand_tmp 176 processInteractive(sform, NIL) 177 178protectedEVAL x == 179 error := true 180 val := NIL 181 UNWIND_-PROTECT((val := EVAL x; error := NIL), 182 error => (resetStackLimits(); sendHTErrorSignal())) 183 val 184