pcs/sources/stl.s

120 lines
4.7 KiB
ArmAsm
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; PC Scheme toplevel
;;; Copyright 1987 (c) Texas Instruments
;;; The following is the PC Scheme standard toplevel function.
;;; This definition of it is suitable for loading via an .INI file.
; When this is loaded, the fluid variable SCHEME-TOP-LEVEL is set
; to the outer lambda expression. When PC Scheme finishes loading
; the .INI file, it does an internal SCHEME-RESET. That activates
; this function, and also snapshots the VM state; further SCHEME-RESET's
; will always restore the state of PC Scheme to this initial snapshot.
; The outer lambda expression's body calls the local function ==SCHEME-RESET==.
; The fluid variables INPUT-PORT and OUTPUT-PORT are initialized to the
; values of STANDARD-INPUT and STANDARD-OUTPUT, which in turn are always
; bound to 'CONSOLE unless you explicitly set them otherwise.
; The history list is set to nil. The debug-mode flag is examined and
; an appropriate message is output. Then comes the most interesting
; part--a continuation snapshots the context at this point of execution
; in the function and is assigned to the variable ==RESET==. Then the
; fluid variable SCHEME-TOP-LEVEL is rebound to this continuation.
; Henceforth, further RESET's will start execution of the toplevel function
; at this point, skipping the above initializations. A GC is done before
; executing the local function MORE.
; MORE is the read-eval-print section of the toplevel. The prompt is
; displayed. Input is read, consed onto the history list, and evaluated,
; with the result printed with WRITE and also consed onto the history list.
; In the midst of this, the local variable NEXT is bound to SCHEME-TOP-LEVEL's
; value. It is possible that the evaluation of the input form might have
; changed SCHEME-TOP-LEVEL. If NEXT is still bound to ==RESET==, the
; continuation derived above, then the current toplevel function is still
; in control and we loop back to MORE, skipping the initializations that
; RESET or SCHEME-RESET would perform. Otherwise, a new toplevel is
; indicated, and we call it.
; To summarize, the system's toplevel function has 3 entry points.
; First, SCHEME-RESET restarts the outer lambda expression,
; which invokes the local function ==SCHEME-RESET==, and that
; resets the history list and input and output ports, among other things.
; Second, RESET restarts the continuation marked by the CALL/CC,
; and a GC occurs. Finally, the local function MORE takes care
; of the read-eval-print loop. Once entered, MORE is never exited
; unless a RESET or SCHEME-RESET are executed to redo their appropriate
; levels of initialization.
;;; define standard toplevel loop and support functions
(set! (fluid scheme-top-level)
(lambda () ; outer lambda
(letrec
((==reset== '())
(==scheme-reset== ; here for SCHEME-RESET
(lambda ()
(set! (fluid input-port) standard-input)
(set! (fluid output-port) standard-output)
(putprop '%PCS-STL-HISTORY (list '()) %pcs-stl-history)
(newline)
(display "[PCS-DEBUG-MODE is ")
(display (if pcs-debug-mode "ON]" "OFF]"))
(newline)
(call/cc
(lambda (k)
(set! ==reset== (lambda () (k '())))
(set! (fluid scheme-top-level)
==reset==)))
; here for RESET
(gc)
(more)))
(more ; read-eval-print loop
(lambda ()
(fresh-line)
(display "[")
(display (length (getprop '%PCS-STL-HISTORY %pcs-stl-history)))
(display "]> ")
(let ((problem (read)))
(flush-input)
(if (eof-object? problem)
(display "[End of file read by SCHEME-TOP-LEVEL]")
(begin
(putprop '%PCS-STL-HISTORY
(cons (list problem)
(getprop '%PCS-STL-HISTORY
%pcs-stl-history))
%pcs-stl-history)
(let* ((answer (eval problem))
(next (fluid scheme-top-level)))
(when (not (eq? answer *the-non-printing-object*))
(write answer))
(putprop '%PCS-STL-HISTORY
(cons (cons problem answer)
(cdr (getprop '%PCS-STL-HISTORY
%pcs-stl-history)))
%pcs-stl-history)
(if (eq? next ==reset==)
(more)
(next))))))))) ;end of letrec vars
(==scheme-reset==) ;letrec body
)))
;;; %C accesses the nth user command
;;; %D accesses the result of the nth user command
(define %c ; %C
(lambda (n)
(let ((history (getprop '%PCS-STL-HISTORY %pcs-stl-history)))
(and (positive? n)
(< n (length history))
(car (list-ref (reverse history) n))))))
(define %d ; %D
(lambda (n)
(let ((history (getprop '%PCS-STL-HISTORY %pcs-stl-history)))
(and (positive? n)
(< n (length history))
(cdr (list-ref (reverse history) n))))))