From adaf2c55d61d78398e3be355a9390551db47516f Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 6 Oct 2020 08:01:58 -0400 Subject: Rename repl module to repl-server. --- Makefile.am | 2 +- starling/kernel.scm | 13 ++++--- starling/repl-server.scm | 99 ++++++++++++++++++++++++++++++++++++++++++++++++ starling/repl.scm | 99 ------------------------------------------------ 4 files changed, 107 insertions(+), 106 deletions(-) create mode 100644 starling/repl-server.scm delete mode 100644 starling/repl.scm diff --git a/Makefile.am b/Makefile.am index cad01a9..cfd94c4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -44,7 +44,7 @@ SOURCES = \ starling/asset.scm \ starling/node.scm \ starling/scene.scm \ - starling/repl.scm \ + starling/repl-server.scm \ starling/minibuffer.scm \ starling/kernel.scm \ starling/node-2d.scm \ diff --git a/starling/kernel.scm b/starling/kernel.scm index 15e05e3..0608241 100644 --- a/starling/kernel.scm +++ b/starling/kernel.scm @@ -46,7 +46,8 @@ #:use-module (starling config) #:use-module (starling node) #:use-module (starling node-2d) - #:use-module (starling repl) + ;;#:use-module (starling repl) + #:use-module (starling repl-server) #:use-module (starling minibuffer) #:use-module (starling scene) #:use-module (starling system) @@ -166,7 +167,7 @@ ;; FPS counter (make #:name 'fps) ;; REPL server - (make #:name 'repl)) + (make #:name 'repl-server)) (run-script kernel (forever (sleep 60) @@ -303,7 +304,7 @@ (if developer-mode? (let ((title (sdl2:window-title (window kernel)))) (sdl2:set-window-title! (window kernel) (string-append "[ERROR] " title)) - (on-error (& kernel repl) stack key args) + (on-error (& kernel repl-server) stack key args) (sdl2:set-window-title! (window kernel) title)) (apply throw key args))) @@ -384,17 +385,17 @@ kernel. A convenient procedure for developers." (add-minibuffer-command "show-fps" show-fps) (add-minibuffer-command "hide-fps" hide-fps) -(define-meta-command ((debug-game lisparuga) repl) +(define-meta-command ((debug-game starling) repl) "debug-game Enter a debugger for the current game loop error." (debugger (& (current-kernel) repl))) -(define-meta-command ((resume-game lisparuga) repl) +(define-meta-command ((resume-game starling) repl) "resume-game Resume the game loop without entering a debugger." (set! (repl-debugging? (& (current-kernel) repl)) #f)) -(define-meta-command ((reboot lisparuga) repl) +(define-meta-command ((reboot starling) repl) "reboot Reboot the current scene." (reboot-current-scene)) diff --git a/starling/repl-server.scm b/starling/repl-server.scm new file mode 100644 index 0000000..b546a0f --- /dev/null +++ b/starling/repl-server.scm @@ -0,0 +1,99 @@ +;;; Starling Game Engine +;;; Copyright © 2018 David Thompson +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Starling. If not, see . + +;;; Commentary: +;; +;; REPL server for live hacking and debugging from Emacs or whatever. +;; +;;; Code: + +(define-module (starling repl-server) + #:use-module (oop goops) + #:use-module (ice-9 match) + #:use-module (starling node) + #:use-module (system repl coop-server) + #:use-module (system repl debug) + #:use-module (system repl repl) + #:export ( + repl-server + repl-debug + repl-debugging? + on-error + debugger)) + +(define-class () + (repl-server #:accessor repl-server) + (repl-debug #:accessor repl-debug #:init-form #f) + (repl-debugging? #:accessor repl-debugging? #:init-form #f)) + +(define-method (on-boot (repl )) + (set! (repl-server repl) (spawn-coop-repl-server))) + +(define-method (on-error (repl ) stack key args) + ;; Display backtrace. + (let ((port (current-error-port))) + (display "an error has occurred!\n\n" port) + (display "Backtrace:\n" port) + (display-backtrace stack port) + (newline port) + (match args + ((subr message . args) + (display-error (stack-ref stack 0) port subr message args '()))) + (newline port)) + ;; Setup the REPL debug object. + (let* ((tag (and (pair? (fluid-ref %stacks)) + (cdr (fluid-ref %stacks)))) + (stack (narrow-stack->vector + stack + ;; Take the stack from the given frame, cutting 0 + ;; frames. + 0 + ;; Narrow the end of the stack to the most recent + ;; start-stack. + ;;tag + ;; And one more frame, because %start-stack + ;; invoking the start-stack thunk has its own frame + ;; too. + ;;0 (and tag 1) + )) + (error-string (call-with-output-string + (lambda (port) + (let ((frame (and (< 0 (vector-length stack)) + (vector-ref stack 0)))) + (print-exception port frame key args)))))) + (set! (repl-debug repl) (make-debug stack 0 error-string)) + (set! (repl-debugging? repl) #t) + ;; Wait for the user to exit the debugger. + (display "waiting for developer to debug..." (current-error-port)) + (while (repl-debugging? repl) + (poll-coop-repl-server (repl-server repl)) + (usleep 160000) + #t) + (set! (repl-debug repl) #f) + (display " done!\n"))) + +(define-method (update (repl ) dt) + (poll-coop-repl-server (repl-server repl))) + +(define-method (debugger (repl )) + (if (repl-debug repl) + (begin + (format #t "~a~%" (debug-error-message (repl-debug repl))) + (format #t "Entering a new prompt. ") + (format #t "Type `,bt' for a backtrace or `,q' to resume the game loop.\n") + (start-repl #:debug (repl-debug repl)) + (set! (repl-debugging? repl) #f)) + (display "nothing to debug!\n"))) diff --git a/starling/repl.scm b/starling/repl.scm deleted file mode 100644 index cfaf5b0..0000000 --- a/starling/repl.scm +++ /dev/null @@ -1,99 +0,0 @@ -;;; Starling Game Engine -;;; Copyright © 2018 David Thompson -;;; -;;; This program is free software: you can redistribute it and/or -;;; modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation, either version 3 of the -;;; License, or (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Starling. If not, see . - -;;; Commentary: -;; -;; REPL for live hacking and debugging. -;; -;;; Code: - -(define-module (starling repl) - #:use-module (oop goops) - #:use-module (ice-9 match) - #:use-module (starling node) - #:use-module (system repl coop-server) - #:use-module (system repl debug) - #:use-module (system repl repl) - #:export ( - repl-server - repl-debug - repl-debugging? - on-error - debugger)) - -(define-class () - (repl-server #:accessor repl-server) - (repl-debug #:accessor repl-debug #:init-form #f) - (repl-debugging? #:accessor repl-debugging? #:init-form #f)) - -(define-method (on-boot (repl )) - (set! (repl-server repl) (spawn-coop-repl-server))) - -(define-method (on-error (repl ) stack key args) - ;; Display backtrace. - (let ((port (current-error-port))) - (display "an error has occurred!\n\n" port) - (display "Backtrace:\n" port) - (display-backtrace stack port) - (newline port) - (match args - ((subr message . args) - (display-error (stack-ref stack 0) port subr message args '()))) - (newline port)) - ;; Setup the REPL debug object. - (let* ((tag (and (pair? (fluid-ref %stacks)) - (cdr (fluid-ref %stacks)))) - (stack (narrow-stack->vector - stack - ;; Take the stack from the given frame, cutting 0 - ;; frames. - 0 - ;; Narrow the end of the stack to the most recent - ;; start-stack. - ;;tag - ;; And one more frame, because %start-stack - ;; invoking the start-stack thunk has its own frame - ;; too. - ;;0 (and tag 1) - )) - (error-string (call-with-output-string - (lambda (port) - (let ((frame (and (< 0 (vector-length stack)) - (vector-ref stack 0)))) - (print-exception port frame key args)))))) - (set! (repl-debug repl) (make-debug stack 0 error-string)) - (set! (repl-debugging? repl) #t) - ;; Wait for the user to exit the debugger. - (display "waiting for developer to debug..." (current-error-port)) - (while (repl-debugging? repl) - (poll-coop-repl-server (repl-server repl)) - (usleep 160000) - #t) - (set! (repl-debug repl) #f) - (display " done!\n"))) - -(define-method (update (repl ) dt) - (poll-coop-repl-server (repl-server repl))) - -(define-method (debugger (repl )) - (if (repl-debug repl) - (begin - (format #t "~a~%" (debug-error-message (repl-debug repl))) - (format #t "Entering a new prompt. ") - (format #t "Type `,bt' for a backtrace or `,q' to resume the game loop.\n") - (start-repl #:debug (repl-debug repl)) - (set! (repl-debugging? repl) #f)) - (display "nothing to debug!\n"))) -- cgit v1.2.3