mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
*** empty log message ***
This commit is contained in:
Keisuke Nishida
parent
a6df585ae7
commit
46f215f85b
7 changed files with 465 additions and 26 deletions
247
emacs/guile-scheme.el
Normal file
247
emacs/guile-scheme.el
Normal file
|
|
@ -0,0 +1,247 @@
|
|||
;;; guile-scheme.el --- Guile Scheme editing mode.
|
||||
|
||||
;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
|
||||
|
||||
;; GNU Emacs 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 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'scheme)
|
||||
|
||||
(defgroup guile-scheme nil
|
||||
"Editing Guile-Scheme code"
|
||||
:group 'lisp)
|
||||
|
||||
(defvar guile-scheme-syntax-keywords
|
||||
'((begin 0) (if 1) (cond 0) (case 1) (do 2) (try 1)
|
||||
quote syntax lambda and or else delay receive
|
||||
(match 1) (match-lambda 0) (match-lambda* 0)
|
||||
(let scheme-let-indent) (let* 1) (letrec 1) (and-let* 1)
|
||||
(let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
|
||||
|
||||
(defvar guile-scheme-special-procedures
|
||||
'((catch 1) (lazy-catch 1) (stack-catch 1)
|
||||
map for-each (dynamic-wind 3)))
|
||||
|
||||
(dolist (x (append guile-scheme-syntax-keywords
|
||||
guile-scheme-special-procedures))
|
||||
(when (consp x)
|
||||
(put (car x) 'scheme-indent-function (cadr x))))
|
||||
|
||||
;; This is shared by cmuscheme and xscheme.
|
||||
(defcustom guile-scheme-program-name "guile"
|
||||
"*Program invoked by the `run-scheme' command."
|
||||
:type 'string
|
||||
:group 'guile-scheme)
|
||||
|
||||
(defconst guile-scheme-font-lock-keywords
|
||||
(eval-when-compile
|
||||
(list
|
||||
(list (concat "(\\(define\\*?\\("
|
||||
;; Function names.
|
||||
"\\(\\|-public\\|-method\\|-generic\\)\\|"
|
||||
;; Macro names, as variable names. A bit dubious, this.
|
||||
"\\(-syntax\\|-macro\\)\\|"
|
||||
;; Others
|
||||
"-\\sw+\\)\\)\\>"
|
||||
;; Any whitespace and declared object.
|
||||
"\\s *(?\\(\\sw+\\)?")
|
||||
'(1 font-lock-keyword-face)
|
||||
'(5 (cond ((match-beginning 3) font-lock-function-name-face)
|
||||
((match-beginning 4) font-lock-variable-name-face)
|
||||
(t font-lock-type-face)) nil t))
|
||||
(list (concat
|
||||
"(" (regexp-opt
|
||||
(mapcar (lambda (e)
|
||||
(prin1-to-string (if (consp e) (car e) e)))
|
||||
(append guile-scheme-syntax-keywords
|
||||
guile-scheme-special-procedures)) 'words))
|
||||
'(1 font-lock-keyword-face))
|
||||
'("<\\sw+>" . font-lock-type-face)
|
||||
'("\\<:\\sw+\\>" . font-lock-builtin-face)
|
||||
))
|
||||
"Expressions to highlight in Guile-Scheme modes.")
|
||||
|
||||
(defvar guile-scheme-mode-syntax-table nil)
|
||||
(unless guile-scheme-mode-syntax-table
|
||||
(let ((i 0))
|
||||
(setq guile-scheme-mode-syntax-table (make-syntax-table))
|
||||
(set-syntax-table guile-scheme-mode-syntax-table)
|
||||
|
||||
;; Default is atom-constituent.
|
||||
(while (< i 256)
|
||||
(modify-syntax-entry i "_ ")
|
||||
(setq i (1+ i)))
|
||||
|
||||
;; Word components.
|
||||
(setq i ?0)
|
||||
(while (<= i ?9)
|
||||
(modify-syntax-entry i "w ")
|
||||
(setq i (1+ i)))
|
||||
(setq i ?A)
|
||||
(while (<= i ?Z)
|
||||
(modify-syntax-entry i "w ")
|
||||
(setq i (1+ i)))
|
||||
(setq i ?a)
|
||||
(while (<= i ?z)
|
||||
(modify-syntax-entry i "w ")
|
||||
(setq i (1+ i)))
|
||||
|
||||
;; Whitespace
|
||||
(modify-syntax-entry ?\t " ")
|
||||
(modify-syntax-entry ?\n "> ")
|
||||
(modify-syntax-entry ?\f " ")
|
||||
(modify-syntax-entry ?\r " ")
|
||||
(modify-syntax-entry ? " ")
|
||||
|
||||
;; These characters are delimiters but otherwise undefined.
|
||||
;; Brackets and braces balance for editing convenience.
|
||||
(modify-syntax-entry ?\[ "(] ")
|
||||
(modify-syntax-entry ?\] ")[ ")
|
||||
(modify-syntax-entry ?{ "(} ")
|
||||
(modify-syntax-entry ?} "){ ")
|
||||
(modify-syntax-entry ?\| " 23")
|
||||
|
||||
;; Other atom delimiters
|
||||
(modify-syntax-entry ?\( "() ")
|
||||
(modify-syntax-entry ?\) ")( ")
|
||||
(modify-syntax-entry ?\; "< ")
|
||||
(modify-syntax-entry ?\" "\" ")
|
||||
(modify-syntax-entry ?' " p")
|
||||
(modify-syntax-entry ?` " p")
|
||||
(modify-syntax-entry ?. " p")
|
||||
|
||||
;; Special characters
|
||||
(modify-syntax-entry ?, "_ p")
|
||||
(modify-syntax-entry ?# "_ p14")
|
||||
(modify-syntax-entry ?\\ "\\ ")))
|
||||
|
||||
(defvar guile-scheme-mode-line-process "")
|
||||
|
||||
(defvar guile-scheme-mode-map nil
|
||||
"Keymap for Guile Scheme mode.
|
||||
All commands in `lisp-mode-shared-map' are inherited by this map.")
|
||||
|
||||
(unless guile-scheme-mode-map
|
||||
(let ((map (make-sparse-keymap "Guile-Scheme")))
|
||||
(setq guile-scheme-mode-map (make-sparse-keymap))
|
||||
(set-keymap-parent guile-scheme-mode-map lisp-mode-shared-map)
|
||||
(define-key guile-scheme-mode-map [menu-bar] (make-sparse-keymap))
|
||||
(define-key guile-scheme-mode-map [menu-bar guile-scheme]
|
||||
(cons "Guile Scheme" map))
|
||||
(define-key map [run-guile-scheme]
|
||||
'("Run Inferior Guile-Scheme" . run-guile-scheme))
|
||||
(define-key map [uncomment-region]
|
||||
'("Uncomment Out Region" . (lambda (beg end)
|
||||
(interactive "r")
|
||||
(comment-region beg end '(4)))))
|
||||
(define-key map [comment-region] '("Comment Out Region" . comment-region))
|
||||
(define-key map [indent-region] '("Indent Region" . indent-region))
|
||||
(define-key map [indent-line] '("Indent Line" . lisp-indent-line))
|
||||
(put 'comment-region 'menu-enable 'mark-active)
|
||||
(put 'uncomment-region 'menu-enable 'mark-active)
|
||||
(put 'indent-region 'menu-enable 'mark-active)))
|
||||
|
||||
(defcustom guile-scheme-mode-hook nil
|
||||
"Normal hook run when entering `guile-scheme-mode'.
|
||||
See `run-hooks'."
|
||||
:type 'hook
|
||||
:group 'guile-scheme)
|
||||
|
||||
|
||||
;;;
|
||||
;;; Guile Scheme mode
|
||||
;;;
|
||||
|
||||
;;;###autoload
|
||||
(defun guile-scheme-mode ()
|
||||
"Major mode for editing Guile-Scheme code.
|
||||
Editing commands are similar to those of `lisp-mode'.
|
||||
|
||||
In addition, if an inferior Scheme process is running, some additional
|
||||
commands will be defined, for evaluating expressions and controlling
|
||||
the interpreter, and the state of the process will be displayed in the
|
||||
modeline of all Scheme buffers. The names of commands that interact
|
||||
with the Scheme process start with \"xscheme-\" if you use the MIT
|
||||
Scheme-specific `xscheme' package; for more information see the
|
||||
documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
|
||||
start an inferior Scheme using the more general `cmuscheme' package.
|
||||
|
||||
Commands:
|
||||
Delete converts tabs to spaces as it moves back.
|
||||
Blank lines separate paragraphs. Semicolons start comments.
|
||||
\\{scheme-mode-map}
|
||||
Entry to this mode calls the value of `scheme-mode-hook'
|
||||
if that value is non-nil."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(setq mode-name "Guile Scheme")
|
||||
(setq major-mode 'guile-scheme-mode)
|
||||
(use-local-map guile-scheme-mode-map)
|
||||
(guile-scheme-mode-variables)
|
||||
(run-hooks 'guile-scheme-mode-hook))
|
||||
|
||||
(defun guile-scheme-mode-variables ()
|
||||
(set-syntax-table guile-scheme-mode-syntax-table)
|
||||
(setq local-abbrev-table scheme-mode-abbrev-table)
|
||||
(make-local-variable 'paragraph-start)
|
||||
(setq paragraph-start (concat "$\\|" page-delimiter))
|
||||
(make-local-variable 'paragraph-separate)
|
||||
(setq paragraph-separate paragraph-start)
|
||||
(make-local-variable 'paragraph-ignore-fill-prefix)
|
||||
(setq paragraph-ignore-fill-prefix t)
|
||||
(make-local-variable 'fill-paragraph-function)
|
||||
(setq fill-paragraph-function 'lisp-fill-paragraph)
|
||||
;; Adaptive fill mode gets in the way of auto-fill,
|
||||
;; and should make no difference for explicit fill
|
||||
;; because lisp-fill-paragraph should do the job.
|
||||
(make-local-variable 'adaptive-fill-mode)
|
||||
(setq adaptive-fill-mode nil)
|
||||
(make-local-variable 'normal-auto-fill-function)
|
||||
(setq normal-auto-fill-function 'lisp-mode-auto-fill)
|
||||
(make-local-variable 'indent-line-function)
|
||||
(setq indent-line-function 'lisp-indent-line)
|
||||
(make-local-variable 'parse-sexp-ignore-comments)
|
||||
(setq parse-sexp-ignore-comments t)
|
||||
(make-local-variable 'outline-regexp)
|
||||
(setq outline-regexp ";;; \\|(....")
|
||||
(make-local-variable 'comment-start)
|
||||
(setq comment-start ";")
|
||||
(make-local-variable 'comment-start-skip)
|
||||
;; Look within the line for a ; following an even number of backslashes
|
||||
;; after either a non-backslash or the line beginning.
|
||||
(setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
|
||||
(make-local-variable 'comment-column)
|
||||
(setq comment-column 40)
|
||||
(make-local-variable 'comment-indent-function)
|
||||
(setq comment-indent-function 'lisp-comment-indent)
|
||||
(make-local-variable 'parse-sexp-ignore-comments)
|
||||
(setq parse-sexp-ignore-comments t)
|
||||
(make-local-variable 'lisp-indent-function)
|
||||
(set lisp-indent-function 'scheme-indent-function)
|
||||
(setq mode-line-process '("" guile-scheme-mode-line-process))
|
||||
(set (make-local-variable 'imenu-case-fold-search) t)
|
||||
(set (make-local-variable 'imenu-syntax-alist)
|
||||
'(("+-*/.<>=?!$%_&~^:" . "w")))
|
||||
(make-local-variable 'font-lock-defaults)
|
||||
(setq font-lock-defaults
|
||||
'((guile-scheme-font-lock-keywords)
|
||||
nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
|
||||
(font-lock-mark-block-function . mark-defun))))
|
||||
|
||||
(provide 'guile-scheme)
|
||||
|
||||
;;; guile-scheme.el ends here
|
||||
110
emacs/guile.el
Normal file
110
emacs/guile.el
Normal file
|
|
@ -0,0 +1,110 @@
|
|||
;;; guile.el --- Emacs Guile interface
|
||||
|
||||
;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
|
||||
|
||||
;; GNU Emacs 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 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun guile:make-adapter (command)
|
||||
(let* ((buff (generate-new-buffer " *guile object channel*"))
|
||||
(proc (start-process "guile-oa" buff command "-q")))
|
||||
(process-kill-without-query proc)
|
||||
(process-send-string proc "(use-modules (guile channel))\n")
|
||||
(process-send-string proc "(open-object-channel)\n")
|
||||
(accept-process-output proc)
|
||||
proc))
|
||||
|
||||
(defun guile:eval (exp adapter)
|
||||
(let ((str (format "eval %S\n" exp)))
|
||||
(guile-process-require adapter str "channel> " 'guile:eval-filter)))
|
||||
|
||||
(defun guile:eval-filter (proc)
|
||||
(cond
|
||||
((looking-at "value = ")
|
||||
(car (read-from-string (buffer-substring (match-end 0) (point-max)))))
|
||||
((looking-at "token = ")
|
||||
(caar (read-from-string (buffer-substring (match-end 0) (point-max)))))
|
||||
((looking-at "exception = ")
|
||||
(apply 'signal (car (read-from-string
|
||||
(buffer-substring (match-end 0) (point-max))))))
|
||||
(t
|
||||
(error "Unsupported result"))))
|
||||
|
||||
;;;
|
||||
;;; Process handling
|
||||
;;;
|
||||
|
||||
(defvar guile-process-output-start nil)
|
||||
(defvar guile-process-output-value nil)
|
||||
(defvar guile-process-output-filter nil)
|
||||
(defvar guile-process-output-finished nil)
|
||||
(defvar guile-process-output-separator nil)
|
||||
(defvar guile-process-output-separator-lines 2)
|
||||
|
||||
(defun guile-process-require (process string separator &optional filter)
|
||||
(setq guile-process-output-value nil)
|
||||
(setq guile-process-output-filter filter)
|
||||
(setq guile-process-output-finished nil)
|
||||
(setq guile-process-output-separator separator)
|
||||
(let (temp-buffer)
|
||||
(unless (process-buffer process)
|
||||
(setq temp-buffer (guile-temp-buffer))
|
||||
(set-process-buffer process temp-buffer))
|
||||
(with-current-buffer (process-buffer process)
|
||||
(goto-char (point-max))
|
||||
(insert string)
|
||||
(setq guile-process-output-start (point))
|
||||
(set-process-filter process 'guile-process-filter)
|
||||
(process-send-string process string)
|
||||
(while (not guile-process-output-finished)
|
||||
(unless (accept-process-output process 5)
|
||||
(when (> (point) guile-process-output-start)
|
||||
(display-buffer (current-buffer))
|
||||
(error "BUG in the filter!!")))))
|
||||
(when temp-buffer
|
||||
(set-process-buffer process nil)
|
||||
(kill-buffer temp-buffer)))
|
||||
guile-process-output-value)
|
||||
|
||||
(defun guile-process-filter (process string)
|
||||
(with-current-buffer (process-buffer process)
|
||||
(insert string)
|
||||
(forward-line (- guile-process-output-separator-lines))
|
||||
(if (< (point) guile-process-output-start)
|
||||
(goto-char guile-process-output-start))
|
||||
(when (re-search-forward guile-process-output-separator nil 0)
|
||||
(goto-char (match-beginning 0))
|
||||
(if guile-process-output-filter
|
||||
(save-current-buffer
|
||||
(narrow-to-region guile-process-output-start (point))
|
||||
(goto-char (point-min))
|
||||
(setq guile-process-output-value
|
||||
(funcall guile-process-output-filter process))
|
||||
(widen))
|
||||
(setq guile-process-output-value
|
||||
(buffer-substring guile-process-output-start (point))))
|
||||
(setq guile-process-output-finished t))))
|
||||
|
||||
(defun guile-process-kill (process)
|
||||
(set-process-filter process nil)
|
||||
(delete-process process)
|
||||
(if (process-buffer process)
|
||||
(kill-buffer (process-buffer process))))
|
||||
|
||||
(provide 'guile)
|
||||
|
||||
;;; guile.el ends here
|
||||
|
|
@ -1,2 +1,3 @@
|
|||
Makefile
|
||||
Makefile.in
|
||||
slibcat
|
||||
|
|
|
|||
79
module/guile/channel.scm
Normal file
79
module/guile/channel.scm
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
;;; Guile object channel
|
||||
|
||||
;; Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
|
||||
;; 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 2, 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 this program; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(define-module (guile channel)
|
||||
:use-syntax (system base syntax)
|
||||
:export (open-object-channel))
|
||||
|
||||
(define-record (<channel> (stdin (current-input-port))
|
||||
(stdout (current-output-port))
|
||||
(token-module (make-module))))
|
||||
|
||||
(define (make-channel) (<channel>))
|
||||
|
||||
(define (native-type? x)
|
||||
(or (boolean? x) (integer? x) (null? x) (symbol? x) (string? x)
|
||||
(pair? x) (vector? x)))
|
||||
|
||||
(define (open-object-channel)
|
||||
(let ((ch (make-channel)))
|
||||
(let loop ()
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(channel:prompt ch)
|
||||
(let ((cmd (read ch.stdin)))
|
||||
(if (eof-object? cmd)
|
||||
(throw 'quit)
|
||||
(case cmd
|
||||
((eval)
|
||||
(module-use! (current-module) ch.token-module)
|
||||
(let ((val (eval (read ch.stdin) (current-module))))
|
||||
(if (native-type? val)
|
||||
(format ch.stdout "value = ~S\n" val)
|
||||
(let* ((token (gensym "%object-token%"))
|
||||
(pair (cons token (object->string val))))
|
||||
(format ch.stdout "token = ~S\n" pair)
|
||||
(module-define! ch.token-module token val)))))
|
||||
((destroy)
|
||||
(let ((token (read ch.stdin)))
|
||||
(if (module-defined? ch.token-module token)
|
||||
(module-remove! ch.token-module token)
|
||||
(channel:error ch "Invalid token: ~S" token))))
|
||||
((quit)
|
||||
(throw 'quit))
|
||||
(else
|
||||
(channel:error ch "Unknown command: ~S" cmd)))))
|
||||
(loop))
|
||||
(lambda args
|
||||
(case (car args)
|
||||
((quit) (throw 'quit))
|
||||
(else
|
||||
(format ch.stdout "exception = ~S\n" args)
|
||||
(loop))))))))
|
||||
|
||||
(define (channel:prompt ch)
|
||||
(display "channel> " ch.stdout)
|
||||
(force-output ch.stdout))
|
||||
|
||||
(define (channel:error ch msg . args)
|
||||
(display "ERROR: " ch.stdout)
|
||||
(apply format ch.stdout msg args)
|
||||
(newline ch.stdout))
|
||||
|
|
@ -37,14 +37,14 @@
|
|||
(make-frame-chain (vm-last-frame vm) (vm:ip vm)))
|
||||
|
||||
(define (make-frame-chain frame addr)
|
||||
(let ((link (frame-dynamic-link frame)))
|
||||
(if (eq? link #t)
|
||||
'()
|
||||
(let ((chain (make-frame-chain link (frame-return-address frame)))
|
||||
(base (program-base (frame-program frame))))
|
||||
(set! (frame-number frame) (1+ (length chain)))
|
||||
(set! (frame-address frame) (- addr base))
|
||||
(cons frame chain)))))
|
||||
(let* ((link (frame-dynamic-link frame))
|
||||
(chain (if (eq? link #t)
|
||||
'()
|
||||
(cons frame (make-frame-chain
|
||||
link (frame-return-address frame))))))
|
||||
(set! (frame-number frame) (length chain))
|
||||
(set! (frame-address frame) (- addr (program-base (frame-program frame))))
|
||||
chain))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -322,13 +322,28 @@ do { \
|
|||
|
||||
#define FREE_FRAME() \
|
||||
{ \
|
||||
SCM *last_sp = sp; \
|
||||
SCM *last_fp = fp; \
|
||||
SCM *p = fp + bp->nargs + bp->nlocs; \
|
||||
if (!SCM_FALSEP (p[1])) \
|
||||
vp->this_frame = p[1]; \
|
||||
else \
|
||||
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; \
|
||||
fp = SCM_FRAME_STACK_CAST (p[2]); \
|
||||
\
|
||||
/* Restore pointers */ \
|
||||
ip = SCM_FRAME_BYTE_CAST (p[3]); \
|
||||
fp = SCM_FRAME_STACK_CAST (p[2]); \
|
||||
\
|
||||
if (!SCM_FALSEP (p[1])) \
|
||||
{ \
|
||||
/* Unlink the heap stack */ \
|
||||
vp->this_frame = p[1]; \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
/* Move stack items */ \
|
||||
p += 4; \
|
||||
sp = SCM_FRAME_LOWER_ADDRESS (last_fp); \
|
||||
while (p <= last_sp) \
|
||||
*sp++ = *p++; \
|
||||
sp--; \
|
||||
} \
|
||||
}
|
||||
|
||||
#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
|
||||
|
|
|
|||
|
|
@ -421,18 +421,8 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
|
|||
*/
|
||||
if (SCM_PROGRAM_P (x))
|
||||
{
|
||||
SCM *limit = sp;
|
||||
SCM *base = sp - nargs - 1;
|
||||
|
||||
/* Exit the current frame */
|
||||
EXIT_HOOK ();
|
||||
FREE_FRAME ();
|
||||
|
||||
/* Move arguments */
|
||||
while (base < limit)
|
||||
*++sp = *++base;
|
||||
|
||||
/* Call the program */
|
||||
program = x;
|
||||
goto vm_call_program;
|
||||
}
|
||||
|
|
@ -489,18 +479,15 @@ VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1, 1, 1)
|
|||
|
||||
VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
|
||||
{
|
||||
SCM ret;
|
||||
vm_return:
|
||||
EXIT_HOOK ();
|
||||
RETURN_HOOK ();
|
||||
POP (ret);
|
||||
FREE_FRAME ();
|
||||
|
||||
/* Restore the last program */
|
||||
program = SCM_FRAME_PROGRAM (fp);
|
||||
CACHE_PROGRAM ();
|
||||
CACHE_EXTERNAL ();
|
||||
PUSH (ret);
|
||||
NEXT;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue