Permalink
Browse files

ssa call() now only accepts function pointers

  • Loading branch information...
1 parent 910509b commit 81e56894a5e50e5c7892d8ea36a32c75b847657a @vgeddes committed Jun 14, 2010
Showing with 40 additions and 20 deletions.
  1. +1 −0 .gitignore
  2. +3 −0 Makefile
  3. +7 −2 pass.scm
  4. +15 −10 ssa-ops.scm
  5. +14 −8 ssa.scm
View
@@ -3,6 +3,7 @@
*.dot
*.tar.gz
scc
+TAGS
test-fast-match
docs/manual.info
docs/manual
View
@@ -48,6 +48,9 @@ tarball: dist-prep
tar -czf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION)
rm -rf $(PACKAGE)-$(VERSION)
+tags:
+ etags *.scm
+
.PHONY : clean
clean:
rm -rf $(PACKAGE)-$(VERSION) $(PACKAGE)-$(VERSION).tar.gz
View
@@ -650,8 +650,12 @@
(let* ((target (fetch name table))
(args (map (lambda (arg)
(fetch arg table))
- args)))
- (ssa-build-call block 'tail target args)))
+ args))
+ (len (length args))
+ (type (ssa-type-pointer-get (ssa-type-function-get <ssa-void> (list-of <ssa-i64> len) len)))
+ (t0 (ssa-build-inttoptr block type target))
+ (t1 (ssa-build-call block 'tail t0 args)))
+ '()))
((nil) '())
((if test conseq altern)
(let* ((test (fetch test table))
@@ -708,6 +712,7 @@
(ssa-node-attr-set! fun 'is-definition #f)
'()))
+
(define (ssa-convert node)
(struct-case node
((fix defs body)
View
@@ -245,11 +245,11 @@
;; call
-(define (ssa-call-fun x)
+(define (ssa-call-target x)
(assertp ssa-call? x)
(ssa-node-in1 x))
-(define (ssa-call-fun-set! x v)
+(define (ssa-call-target-set! x v)
(assertp ssa-call? x)
(ssa-node-in1-set! x v))
@@ -262,23 +262,26 @@
(ssa-node-in2 x v))
(define (ssa-call-iterate-uses f x)
- (f (ssa-call-fun x))
+ (f (ssa-call-target x))
(for-each f (ssa-call-args x)))
(define (ssa-call-replace-uses f x)
- (ssa-call-fun-set! x (f (ssa-call-fun x)))
+ (ssa-call-target-set! x (f (ssa-call-target x)))
(ssa-call-args-set! x (map f (ssa-call-args x))))
(define (ssa-call-list-uses f x)
- (cons (ssa-call-fun x) (ssa-call-args x)))
+ (cons (ssa-call-target x) (ssa-call-args x)))
(define (ssa-call-format node)
- (format "call ~a ~a (~a)"
+ (sprintf "call ~a ~a (~a)"
(ssa-format-type (ssa-node-type node))
- (ssa-format-value (ssa-call-fun node))
+ (ssa-format-value (ssa-call-target node))
(string-join
- (map (lambda (arg)
- (ssa-format-value arg))
+ (map (lambda (arg-type arg)
+ (sprintf "~a ~a"
+ (ssa-format-type arg-type)
+ (ssa-format-value arg)))
+ (ssa-type-function-param-types (ssa-type-pointer-points-to-type (ssa-node-type (ssa-call-target node))))
(ssa-call-args node))
", ")))
@@ -408,10 +411,12 @@
(ssa-brc-labely x)))
(define (ssa-brc-format node)
- (format "brc ~a ~a, ~a, ~a"
+ (format "brc ~a ~a, ~a ~a, ~a ~a"
(ssa-format-type (ssa-node-type (ssa-brc-cond node)))
(ssa-format-value (ssa-brc-cond node))
+ (ssa-format-type (ssa-node-type (ssa-brc-labelx node)))
(ssa-format-value (ssa-brc-labelx node))
+ (ssa-format-type (ssa-node-type (ssa-brc-labely node)))
(ssa-format-value (ssa-brc-labely node))))
;; unconditional branch
View
@@ -149,7 +149,7 @@
(define (ssa-make-function type name mod)
(let ((node
(ssa-node-with-attrs
- (type type)
+ (type (ssa-type-pointer-get type))
(tag 'function)
(attrs `((name . ,name))))))
(ssa-module-add-function! mod node)
@@ -194,9 +194,7 @@
(define (ssa-make-call block callconv target args)
(let ((node
(ssa-node-with-attrs
- (type (if (ssa-function? target)
- (ssa-type-function-return-type (ssa-node-type target))
- <ssa-void>))
+ (type (ssa-type-function-return-type (ssa-type-pointer-points-to-type (ssa-node-type target))))
(tag 'instr)
(op <ssa-op-call>)
(in1 target)
@@ -485,6 +483,14 @@
;; function
+(define (ssa-function-return-type x)
+ (assertp ssa-function? x)
+ (ssa-type-function-return-type (ssa-type-pointer-points-to-type (ssa-node-type x))))
+
+(define (ssa-function-param-types x)
+ (assertp ssa-function? x)
+ (ssa-type-function-param-types (ssa-type-pointer-points-to-type (ssa-node-type x))))
+
(define (ssa-function-name x)
(assertp ssa-function? x)
(ssa-node-attr x 'name))
@@ -556,16 +562,16 @@
(print-declaration
(ssa-function-name x)
(ssa-function-args x)
- (ssa-type-function-return-type (ssa-node-type x))
- (ssa-type-function-param-types (ssa-node-type x))
+ (ssa-function-return-type x)
+ (ssa-function-param-types x)
port)
(print-body x port))
((ssa-function-is-declaration? x)
(print-declaration
(ssa-function-name x)
(ssa-function-args x)
- (ssa-type-function-return-type (ssa-node-type x))
- (ssa-type-function-param-types (ssa-node-type x))
+ (ssa-function-return-type x)
+ (ssa-function-param-types x)
port))
(else (assert-not-reached))))

0 comments on commit 81e5689

Please sign in to comment.