mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 15:40:19 +02:00
Code Activity

Continuation labels and variable identifiers may be integers

Browse source 
* module/language/cps.scm (label-counter, var-counter): New parameters,
  for producing fresh label and var names.
  (fresh-label, fresh-var): New procedures.
  (let-fresh): New macro, will replace let-gensyms.
  (build-cps-term): Use let-fresh.

* module/language/tree-il/compile-cps.scm: Use let-fresh to generate
  fresh names.

* module/system/vm/assembler.scm (make-meta, begin-kw-arity): Allow
  exact integers as labels.
  (link-debug): Explicitly mark low-pc as being an "addr" value.
This commit is contained in:
Andy Wingo 2014-03-28 14:21:06 +01:00
parent ecc7987427
commit 9a1dfb7d2e
4 changed files with 70 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/system/vm/assembler.scm
View file

@ -153,7 +153,7 @@
(arities meta-arities set-meta-arities!))
(define (make-meta label properties low-pc)
(assert-match label (? symbol?) "symbol")
(assert-match label (or (? exact-integer?) (? symbol?)) "symbol")
(assert-match properties (((? symbol?) . _) ...) "alist with symbolic keys")
(%make-meta label properties low-pc #f '()))
@ -750,7 +750,7 @@ returned instead."
"alist of keyword -> integer")
(assert-match allow-other-keys? (? boolean?) "boolean")
(assert-match nlocals (? integer?) "integer")
(assert-match alternate (or #f (? symbol?)) "#f or symbol")
(assert-match alternate (or #f (? exact-integer?) (? symbol?)) "#f or symbol")
(let* ((meta (car (asm-meta asm)))
(arity (make-arity req opt rest kw-indices allow-other-keys?
(asm-start asm) #f))
@ -1961,6 +1961,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
(cond
((string? val) 'strp)
((eq? attr 'stmt-list) 'sec-offset)
((eq? attr 'low-pc) 'addr)
((exact-integer? code)
(cond
((< code 0) 'sleb128)
@ -1969,7 +1970,6 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
((<= code #xffffffff) 'data4)
((<= code #xffffffffffffffff) 'data8)
(else 'uleb128)))
((symbol? val) 'addr)
(else (error "unhandled case" attr val code))))
(define (add-die-relocation! kind sym)