<> <> <> <> <> DIRECTORY AMBridge, AMEvents, AMEventsBackdoor, AMEventsBackdoorExtra, AMModel, AMModelBridge, AMTypes, AMViewerOps, Basics, BasicTime, CedarProcess, Commander, ComputeServerClient, ComputeServer, ComputeServerControl, ComputeServerCallbacks, ComputeServerCallbacksRpcControl, ComputeServerInternal, EvalQuote, FS, Interpreter, InterpreterOps, InterpreterToolPrivate, IO, MBQueue, PrincOps, PrincOpsUtils, Process, Pup USING [Address, nullAddress], PupStream USING [AllocateSocket, LocalAddress, SendMark, Sockets, StreamClosing, waitForever, WaitForRendezvous], SymTab, Rope, RPC, RuntimeError, WorldVM; ComputeServerDebuggerImpl: CEDAR PROGRAM IMPORTS AMBridge, AMEvents, AMEventsBackdoor, AMEventsBackdoorExtra, AMModel, AMModelBridge, AMTypes, AMViewerOps, BasicTime, CedarProcess, ComputeServerCallbacksRpcControl, ComputeServerInternal, EvalQuote, FS, Interpreter, InterpreterOps, IO, MBQueue, PrincOpsUtils, Process, PupStream, Rope, RPC, RuntimeError, SymTab, WorldVM = BEGIN <> STREAM: TYPE = IO.STREAM; ROPE: TYPE = Rope.ROPE; AMTypesError: ERROR = CODE; ActiveServicesItem: TYPE = ComputeServerInternal.ActiveServicesItem; ActiveServicesPointer: TYPE = ComputeServerInternal.ActiveServicesPointer; BufStreamData: TYPE = ComputeServerInternal.BufStreamData; BufStreamDataObject: TYPE = ComputeServerInternal.BufStreamDataObject; <> guestLocalEvent: PROC[event: AMEvents.Event, f: PrincOps.FrameHandle, stack: POINTER TO PrincOps.StateVector, return: BOOL _ FALSE] RETURNS[debugLocally: BOOL _ FALSE] = TRUSTED BEGIN << modified from AMEventsImpl.LocalEvent>> serverPupAddress: Pup.Address; outcome: AMEvents.Outcome; interface: ComputeServerCallbacksRpcControl.InterfaceRecord _ NIL; serviceItemPointer: ActiveServicesPointer; IF ~PrincOpsUtils.IsBound[LOOPHOLE[AMEventsBackdoorExtra.PSBIToTV]] THEN RETURN[TRUE]; -- skip if the interface isn't exported <> serviceItemPointer _ LOOPHOLE[ComputeServerInternal.GetGuestProcessData[LOOPHOLE[Process.GetCurrent[]]]]; IF serviceItemPointer = NIL THEN RETURN[TRUE]; interface _ serviceItemPointer.callbacksInterface; <> <> << ! RPC.ImportFailed => {>> <> <<};>> <<];>> IF interface = NIL THEN RETURN[TRUE]; event.world _ AMEventsBackdoorExtra.LocalActor.world; event.session _ AMEventsBackdoorExtra.LocalActor.bootCount; event.process _ AMEventsBackdoorExtra.PSBIToTV[PrincOpsUtils.PsbHandleToIndex[PrincOpsUtils.ReadPSB[]], AMEventsBackdoorExtra.LocalActor.world]; <> <> <> event.frame _ AMBridge.TVForFrame[f, stack, return, event.type = break]; event.worry _ FALSE; IF AMEventsBackdoorExtra.Informing THEN RuntimeError.InformationalSignal[AMEvents.Debugging]; [outcome, serverPupAddress, debugLocally] _ remoteEventHandler[event, interface, serviceItemPointer]; --used to call InvokeEvent who called InterpreterToolImpl.EventHandler [] _ ComputeServerInternal.DeletePupAddress[serverPupAddress]; IF AMEventsBackdoorExtra.Informing THEN RuntimeError.InformationalSignal[AMEvents.Debugged]; IF ~debugLocally THEN { WITH o: outcome SELECT FROM proceed => NULL; quit => ERROR ABORTED -- I don't like it, but that's the convention for now --; retry, returnFrom => ERROR AMEventsBackdoorExtra.NotImplemented[]; ENDCASE => ERROR; }; END; remoteEventHandler: PROC[event: AMEvents.Event, interface: ComputeServerCallbacksRpcControl.InterfaceRecord, serviceItemPointer: ActiveServicesPointer] RETURNS[outcome: AMEvents.Outcome, serverPupAddress: Pup.Address, debugLocally: BOOL _ FALSE] = TRUSTED { <> h: InterpreterToolPrivate.Handle; context: AMModel.Context = IF event = NIL THEN AMModel.RootContext[WorldVM.LocalWorld[]] ELSE AMModelBridge.ContextForFrame[event.frame]; remoteWorld: WorldVM.World _ NIL; oldPriority: CedarProcess.Priority _ CedarProcess.GetPriority[]; debugServicesItem: ActiveServicesItem _ NIL; byteStreamOK: BOOL; name: ROPE _ NIL; in, out: STREAM; inData, outData: BufStreamData ; copyProcess: PROCESS; procMainLoop: PROC [h: InterpreterToolPrivate.Handle] RETURNS [outcome: AMEvents.Outcome ]; sockets: PupStream.Sockets _ PupStream.AllocateSocket[serviceItemPointer.listenerPupAddress]; serverPupAddress _ PupStream.LocalAddress[sockets]; CedarProcess.SetPriority[normal]; IF context = NIL THEN ERROR; IF WorldVM.LocalWorld[] # AMModel.ContextWorld[context] THEN remoteWorld _ AMModel.ContextWorld[context]; h _ NEW[ InterpreterToolPrivate.InterpreterObject _ [remoteWorld: remoteWorld, context: context, event: event, menuHitQueue: MBQueue.Create[], symTab: SymTab.Create[], readEvalPrintProcess: LOOPHOLE[Process.GetCurrent[]]]]; -- LOOPHOLE should not be needed, but the compiler give a bogus type error name _ NewViewer[h ! AMTypesError => GOTO err]; <> debugServicesItem _ ComputeServerInternal.AddPupAddress[serverPupAddress, NIL, sockets]; debugServicesItem.debugItem _ TRUE; debugServicesItem.h _ h; debugServicesItem.originalListenerPupAddress _ serviceItemPointer.listenerPupAddress; TRUSTED { Process.Detach[FORK ComputeServerDebuggerRendezvousProcess[debugServicesItem, sockets]]}; byteStreamOK _ interface.OpenDebugStream[listenerPupAddress: serviceItemPointer.listenerPupAddress, newListenerPupAddress: serverPupAddress, name: name, serverMachine: ComputeServerInternal.myHostName ! RPC.CallFailed => { byteStreamOK _ FALSE; debugServicesItem.quitRendezvousAttempt _ TRUE; CONTINUE; }; ]; IF byteStreamOK THEN { -- RPC might be faster than stream establishment start: BasicTime.GMT; start _ BasicTime.Now[]; WHILE ~debugServicesItem.rendezvousDone DO counter: INT _ 0 ; WHILE ~debugServicesItem.rendezvousDone AND counter < 100 DO Process.Pause[1]; counter _ counter + 1; ENDLOOP; IF ~debugServicesItem.rendezvousDone AND BasicTime.Period[from: start, to: BasicTime.Now[]] > 7 THEN EXIT; ENDLOOP; IF ~debugServicesItem.rendezvousDone THEN byteStreamOK _ FALSE; }; IF byteStreamOK THEN { in _ IO.CreateStream[streamProcs: ComputeServerInternal.inStreamProcs, streamData: inData _ NEW[BufStreamDataObject _ [listenerItem: debugServicesItem]]]; out _ IO.CreateStream[streamProcs: ComputeServerInternal.outStreamProcs, streamData: outData _ NEW[BufStreamDataObject _ [listenerItem: debugServicesItem]]]; debugServicesItem.remoteStream.PutRope[Rope.Cat[name, "\n"]]; debugServicesItem.remoteStream.Flush[]; h.tsInStream _ in; h.tsOutStream _ out; TRUSTED { Process.Detach[copyProcess _ FORK DebugStreamCopy[debugServicesItem, in, out, inData, outData]]}; <> procMainLoop _ LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.MainLoop"].result]]; outcome _ procMainLoop[h]; } ELSE { outcome _ [quit[]]; }; <> < CONTINUE;] ;>> debugServicesItem.callOver _ TRUE; [] _ ComputeServerInternal.DeletePupAddress[serverPupAddress]; CedarProcess.SetPriority[oldPriority]; EXITS err => { RETURN[[quit[]], Pup.nullAddress, FALSE] }; }; ComputeServerDebuggerRendezvousProcess: PROC[debugServicesItem: ActiveServicesItem, sockets: PupStream.Sockets] = { WHILE debugServicesItem.remoteStream = NIL AND ~debugServicesItem.quitRendezvousAttempt DO debugServicesItem.remoteStream _ PupStream.WaitForRendezvous[sockets: sockets, getTimeout: 1000, putTimeout: PupStream.waitForever, waitTimeout: 1000 ! PupStream.StreamClosing => { debugServicesItem.quitRendezvousAttempt _ TRUE; CONTINUE; }; ]; ENDLOOP; IF ~debugServicesItem.quitRendezvousAttempt THEN debugServicesItem.rendezvousDone _ TRUE; }; DebugStreamCopy: PROC[debugServicesItem: ActiveServicesItem, in, out: STREAM, inData, outData: BufStreamData] = { lastLoop: BOOL _ FALSE; WHILE ~debugServicesItem.inEOF OR debugServicesItem.outEOF ~= true DO doneSomething: BOOL _ FALSE; <> IF debugServicesItem.outEOF ~= true AND ComputeServerInternal.inCharsAvail[out, FALSE] > 0 THEN { WHILE ComputeServerInternal.inCharsAvail[out, FALSE] > 0 AND debugServicesItem.outEOF = false DO debugServicesItem.remoteStream.PutChar[ComputeServerInternal.inBufGetChar[out ! IO.EndOfStream => {debugServicesItem.outEOF _ pending; CONTINUE;}]]; ENDLOOP; debugServicesItem.remoteStream.Flush[ ! PupStream.StreamClosing => {debugServicesItem.outEOF _ true; CONTINUE;}; ]; IF debugServicesItem.outEOF = pending THEN { PupStream.SendMark[debugServicesItem.remoteStream, 27B ! PupStream.StreamClosing => CONTINUE]; debugServicesItem.outEOF _ true; }; doneSomething _ TRUE; }; <> WHILE debugServicesItem.remoteStream.CharsAvail[] > 0 AND ~debugServicesItem.inEOF AND (inData.inPointer - (inData.outPointer + 1)) MOD ComputeServerInternal.BufStreamBufferSize # 0 DO doneSomething _ TRUE; ComputeServerInternal.outBufPutChar[in, debugServicesItem.remoteStream.GetChar[ ! IO.EndOfStream => { FOR i:INT IN [0..5) DO ComputeServerInternal.outBufPutChar[in, '\n]; ENDLOOP; TRUSTED {abort[debugServicesItem.h]; }; inData.EOF _ pending; debugServicesItem.inEOF _ TRUE; CONTINUE; } ]]; ENDLOOP; IF lastLoop THEN EXIT; IF debugServicesItem.callOver THEN { lastLoop _ TRUE; LOOP;}; IF ~doneSomething THEN Process.Pause[5]; ENDLOOP; PupStream.SendMark[debugServicesItem.remoteStream, 26B ! PupStream.StreamClosing => CONTINUE]; debugServicesItem.remoteStream.Close[! IO.Error => CONTINUE;] ; }; NewViewer: PROC[h: InterpreterToolPrivate.Handle] RETURNS[name: ROPE _ NIL] = TRUSTED { LocalRegister: PROC [name: ROPE, ref: REF, help: ROPE] = TRUSTED { ENABLE AMTypes.Error => GO TO err; InterpreterOps.RegisterTV[ name: name, tv: AMBridge.TVForReferent[ref], help: help, symTab: h.symTab ]; EXITS err => { <> ERROR AMTypesError; }; }; IF h.event # NIL THEN { procEventToName: PROC [event: AMEvents.Event] RETURNS [name: ROPE ]; procEventToName _ LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.EventToName"].result]]; IF h.event.world # WorldVM.LocalWorld[] THEN name _ "WORLDSWAP "; name _ Rope.Cat[name, "Event: ", procEventToName[h.event]]; } ELSE name _ Rope.Cat["Interp: ", AMModel.ContextName[h.context]]; LocalRegister[ "&H", NEW[InterpreterToolPrivate.Handle _ h], "this interpretertool's handle"]; LocalRegister[ "&depth", NEW[INT _ 4], "printing depth for this interpretertool"]; LocalRegister[ "&width", NEW[INT _ 32], "printing width for this interpretertool"]; LocalRegister[ "&WalkStack", NEW[UNSAFE PROC[nFrames: INT _ 1, h: InterpreterToolPrivate.Handle _ NIL] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.WalkStack"].result]] ], "set a local frame context (eventhandler)"]; LocalRegister[ "&slf", NEW[UNSAFE PROC[nFrames: INT _ 1, h: InterpreterToolPrivate.Handle _ NIL] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.WalkStack"].result]] ], "set a local frame context (eventhandler)"]; LocalRegister[ "&ShowFrame", NEW[UNSAFE PROC[h: InterpreterToolPrivate.Handle _ NIL] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.ShowFrame"].result]] ], "show the current lf context (eventhandler)"]; LocalRegister[ "&Source", NEW[UNSAFE PROC[h: InterpreterToolPrivate.Handle _ NIL] _ Source], "show source loc of current lf context (eventhandler)"]; EvalQuote.Register["&sgf", LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.SetGlobalFrameHelper"].result]], h.symTab, h]; LocalRegister[ "&sgf", NEW[UNSAFE PROC[progName: ROPE, h: InterpreterToolPrivate.Handle _ NIL] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.SetGlobalFrameContext"].result]] ], "&sgf[rope]\tset context to be that for the given module"]; EvalQuote.Register["&gf", LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.GlobalFrameHelper"].result]], h.symTab, h]; LocalRegister[ "&gf", NEW[UNSAFE PROC[progName: ROPE, h: InterpreterToolPrivate.Handle _ NIL] RETURNS [AMTypes.TV] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.GlobalFrameContext"].result]] ], "&gf[rope]\tget the given module's context"]; EvalQuote.Register["&sir", LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.SetIRHelper"].result]], h.symTab, h]; LocalRegister[ "&sir", NEW[UNSAFE PROC[interfaceName: ROPE, h: InterpreterToolPrivate.Handle _ NIL] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.SetIRContext"].result]] ], "&sir[rope]\tset context to be that for the given IR"]; EvalQuote.Register["&type", LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.TypeHelper"].result]], h.symTab, h]; LocalRegister[ "&type", NEW[UNSAFE PROC[expr: ROPE, h: InterpreterToolPrivate.Handle _ NIL] RETURNS[AMTypes.Type] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.TypeGetter"].result]] ], "&type[expr]\tget the type of the given expr"]; EvalQuote.Register["&ir", LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.IRHelper"].result]], h.symTab, h]; LocalRegister[ "&ir", NEW[UNSAFE PROC[interfaceName: ROPE, h: InterpreterToolPrivate.Handle _ NIL] RETURNS[AMTypes.TV] _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate[ "InterpreterToolImpl.IRContext"].result]] ], "&ir[rope]\tget the given IR"]; LocalRegister[ "&ABORT", NEW[UNSAFE PROC[h: InterpreterToolPrivate.Handle _ NIL] _ abort], "abort button hit"];}; abort: UNSAFE PROC[h: InterpreterToolPrivate.Handle _ NIL] = TRUSTED { giveFinalCR: BOOL_ TRUE; procSetAbortRequested: PROC[h: InterpreterToolPrivate.Handle]; procSetAbortRequested _ LOOPHOLE[ AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.SetAbortRequested"].result]]; procSetAbortRequested[h]; Process.Abort[h.readEvalPrintProcess ! Process.InvalidProcess => {giveFinalCR _ FALSE; CONTINUE;}; ]; -- ERROR possible due to timing error, but the Process.Abort is only being used to wake up the interperter and the timeing error is that the interperter woke up, so it is ok. IF giveFinalCR THEN StuffIt[h, "\n"]; }; Source: PROC [h: InterpreterToolPrivate.Handle _ NIL] = { name: ROPE; index: INT; fName: ROPE _ NIL; report: AMViewerOps.ReportProc = -- [msg: ROPE, severity: Severity] TRUSTED {h.tsOutStream.PutRope[msg]}; TRUSTED { IF h = NIL THEN { procGetHandlePlease: PROC RETURNS [InterpreterToolPrivate.Handle]; procGetHandlePlease _ LOOPHOLE[AMBridge.TVToProc[Interpreter.Evaluate["InterpreterToolImpl.GetHandlePlease"].result]]; h _ procGetHandlePlease[]; }; }; [name, index] _ AMViewerOps.SourceFromTV[h.context, report]; IF name # NIL THEN { fName _ FS.FileInfo[name: name, remoteCheck: FALSE ! FS.Error => CONTINUE;].attachedTo; }; IF fName # NIL THEN { interface: ComputeServerCallbacksRpcControl.InterfaceRecord _ NIL; debuggerItem: ActiveServicesItem _ ComputeServerInternal.findDebuggerItemFromInterpreterHandle[h].item; IF debuggerItem = NIL OR debuggerItem.callbacksInterface = NIL THEN { h.tsOutStream.PutRope["\nUnable to contact server for debugging\n"]; } ELSE { debuggerItem.callbacksInterface.OpenSourceViewer[debuggerItem.originalListenerPupAddress, fName, index ! RPC.CallFailed => CONTINUE]; }; }; }; StuffIt: PROC [h: InterpreterToolPrivate.Handle, rope: ROPE] = { h.tsOutStream.PutRope[rope]; }; disableGuest: PROC [localFS: BOOL] = { process: PROCESS = LOOPHOLE[Process.GetCurrent[]]; IF localFS THEN ComputeServerInternal.MarkProcessNotGuest[process] ELSE ComputeServerInternal.RemoveMarkProcessNotGuest[process]; }; <> newProcs: REF AMEventsBackdoor.GuestProcsRec _ NEW[AMEventsBackdoor.GuestProcsRec _ [ IsGuestProcess: ComputeServerInternal.IsGuestProcess, disableGuest: disableGuest, guestLocalEvent: guestLocalEvent ]]; TRUSTED {AMEventsBackdoor.RegisterGuestProcs[newProcs];}; END. <> <> <> <> <> <> <> <<>>