mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

rename goto/args and friends to tail-call, tail-apply, etc

Browse source 
* libguile/vm-i-system.c (tail-call, tail-call/nargs, tail-apply)
  (tail-call/cc): Rename these back to tail-* from goto/*. We should
  reserve the rename-then-goto name for when you actually do a rename
  and goto, not when you shuffle the stack.

* doc/ref/vm.texi:
* module/language/glil/decompile-assembly.scm:
* module/language/tree-il/compile-glil.scm:
* test-suite/tests/tree-il.test: Adapt all callers and documentation.
This commit is contained in:
Andy Wingo 2010-01-03 14:49:40 +01:00
parent 87a6a23669
commit a5bbb22e83
5 changed files with 34 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/glil/decompile-assembly.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM code converters
;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -183,9 +183,9 @@
(cons (make-glil-call 'mul 2)
(emit-constants (list-head stack 2) out))
(+ pos 1)))
((goto/args ,n)
((tail-call ,n)
(lp (cdr in) (list-tail stack (1+ n))
(cons (make-glil-call 'goto/args n)
(cons (make-glil-call 'tail-call n)
(emit-constants (list-head stack (1+ n)) out))
(+ pos 2)))
(else (error "unsupported decompilation" (car in)))))))))

12
module/language/tree-il/compile-glil.scm
View file

@ -1,6 +1,6 @@
;;; TREE-IL -> GLIL compiler
;; Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
;; Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -277,7 +277,7 @@
((tail)
(comp-push proc)
(for-each comp-push args)
(emit-code src (make-glil-call 'goto/apply (1+ (length args)))))
(emit-code src (make-glil-call 'tail-apply (1+ (length args)))))
((push)
(emit-code src (make-glil-call 'new-frame 0))
(comp-push proc)
@ -344,12 +344,12 @@
(comp-push producer)
(emit-code src (make-glil-mv-call 0 MV))
(case context
((tail) (emit-code src (make-glil-call 'goto/args 1)))
((tail) (emit-code src (make-glil-call 'tail-call 1)))
(else (emit-code src (make-glil-call 'call 1))
(emit-branch #f 'br POST)))
(emit-label MV)
(case context
((tail) (emit-code src (make-glil-call 'goto/nargs 0)))
((tail) (emit-code src (make-glil-call 'tail-call/nargs 0)))
(else (emit-code src (make-glil-call 'call/nargs 0))
(emit-label POST)
(if (eq? context 'drop)
@ -362,7 +362,7 @@
(case context
((tail)
(comp-push (car args))
(emit-code src (make-glil-call 'goto/cc 1)))
(emit-code src (make-glil-call 'tail-call/cc 1)))
((vals)
(comp-vals
(make-application
@ -482,7 +482,7 @@
(for-each comp-push args)
(let ((len (length args)))
(case context
((tail) (emit-code src (make-glil-call 'goto/args len)))
((tail) (emit-code src (make-glil-call 'tail-call len)))
((push) (emit-code src (make-glil-call 'call len))
(maybe-emit-return))
((vals) (emit-code src (make-glil-mv-call len MVRA))