mirror of
https://github.com/PDP-10/its.git
synced 2026-01-20 01:45:49 +00:00
152 lines
3.6 KiB
Common Lisp
Executable File
152 lines
3.6 KiB
Common Lisp
Executable File
;;;-*-Lisp-*-
|
|
|
|
(declare (load '((alan) lspenv init)))
|
|
|
|
(defstruct (frame default-pointer conc-name
|
|
(eval-when (eval compile)))
|
|
n
|
|
evf
|
|
(up nil)
|
|
(down nil))
|
|
|
|
(eval-when (eval compile)
|
|
|
|
(defmacro frame-type (&optional (frame 'frame))
|
|
`(car (frame-evf ,frame)))
|
|
|
|
(defmacro frame-pdl (&optional (frame 'frame))
|
|
`(cadr (frame-evf ,frame)))
|
|
|
|
(defmacro frame-stuff (&optional (frame 'frame))
|
|
`(caddr (frame-evf ,frame)))
|
|
|
|
(defmacro frame-env (&optional (frame 'frame))
|
|
`(cadddr (frame-evf ,frame)))
|
|
|
|
)
|
|
|
|
(defun crawl ()
|
|
(do ((prev nil frame)
|
|
(evf (evalframe nil)
|
|
(evalframe (cadr evf)))
|
|
(n 0 (1+ n))
|
|
(top)
|
|
(frame))
|
|
((null evf) (crawl-loop top frame))
|
|
(setq frame (make-frame n n
|
|
up prev
|
|
evf evf))
|
|
(if (null prev)
|
|
(setq top frame)
|
|
(setf (frame-down prev) frame))))
|
|
|
|
(defun crawl-loop (top bottom)
|
|
(let ((frame top))
|
|
(print-crawl-frame frame)
|
|
(do ((flag nil))
|
|
(())
|
|
(terpri)
|
|
(tyo #/.)
|
|
forgive (setq flag nil)
|
|
next-char (caseq (tyi)
|
|
((#/d #/D)
|
|
(setq frame (crawl-new-frame frame (frame-down))))
|
|
((#/u #/U)
|
|
(setq frame (crawl-new-frame frame (frame-up))))
|
|
((#/r #/R)
|
|
(terpri)
|
|
(princ "Form to evaluate and return: ")
|
|
(errset (freturn (frame-pdl) (eval (read) (frame-env)))))
|
|
((#/e #/E)
|
|
(terpri)
|
|
(princ "Form to evaluate: ")
|
|
(errset (print (eval (read) (frame-env)))))
|
|
((#/c #/C)
|
|
(fretry (frame-pdl)
|
|
(frame-evf)))
|
|
((#/g #/G)
|
|
(or (get 'gprint1 'lsubr)
|
|
(load '((liblsp) gprint fasl)))
|
|
(terpri)
|
|
(gprint1 (frame-stuff) nil nil nil nil nil nil))
|
|
((#/t #/T)
|
|
(setq frame (crawl-new-frame frame top)))
|
|
((#/b #/B)
|
|
(setq frame (crawl-new-frame frame bottom)))
|
|
((#/j #/J)
|
|
(princ " -> ")
|
|
(setq frame (crawl-find-numbered-frame frame top (read))))
|
|
((#\form #/l #/L)
|
|
(print-crawl-frame frame))
|
|
((#/q #/Q)
|
|
(return 'done))
|
|
((#/i #/I)
|
|
(cond (flag (inspect (frame-stuff)))
|
|
(t
|
|
(terpri)
|
|
(princ "Form to evaluate and inspect: ")
|
|
(errset (inspect (eval (read) (frame-env)))))))
|
|
((#/p #/P)
|
|
(cond (flag (describe (frame-stuff)))
|
|
(t
|
|
(terpri)
|
|
(princ "Form to evaluate and describe: ")
|
|
(errset (describe (eval (read) (frame-env)))))))
|
|
((#\alt) (setq flag t) (go next-char))
|
|
((#/? #//)
|
|
(princ "
|
|
CRAWL Commands:
|
|
|
|
U - Up a frame
|
|
D - Down a frame
|
|
T - go to Top frame
|
|
B - go to Bottom frame
|
|
J - Jump to a numbered frame
|
|
E - Evaluate a form in current frame
|
|
R - Return from current frame
|
|
C - Continue current frame (start over)
|
|
G - Grind stuff in current frame
|
|
I - Inspect
|
|
<alt>I - Inspect contents of current frame
|
|
P - describe (Print cute)
|
|
<alt>P - describe contents of current frame
|
|
Q - Quit"))
|
|
((#\space #\cr #\lf)
|
|
(go forgive))
|
|
(t
|
|
(princ " ???"))))))
|
|
|
|
(defun crawl-new-frame (old new)
|
|
(cond ((null new)
|
|
(princ " No more.")
|
|
old)
|
|
(t
|
|
(print-crawl-frame new)
|
|
new)))
|
|
|
|
(defun print-crawl-frame (frame)
|
|
(let ((prinlength 4)
|
|
(prinlevel 3))
|
|
(caseq (frame-type)
|
|
(eval
|
|
(terpri)
|
|
(princ (frame-n))
|
|
(princ " Evaluating ")
|
|
(prin1 (frame-stuff)))
|
|
(apply
|
|
(terpri)
|
|
(princ (frame-n))
|
|
(princ " Applying ")
|
|
(prin1 (car (frame-stuff)))
|
|
(terpri)
|
|
(princ "To ")
|
|
(prin1 (cadr (frame-stuff))))
|
|
(t (error "-- wierd evalframe." (frame-type))))))
|
|
|
|
(defun crawl-find-numbered-frame (old top n)
|
|
(do ((frame top (frame-down)))
|
|
((null frame)
|
|
(princ " Not found.")
|
|
old)
|
|
(and (= n (frame-n))
|
|
(return (crawl-new-frame old frame))))) |