[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 2/9] add procedure prelude macro-instructions
|
From: |
Andy Wingo |
|
Subject: |
[PATCH 2/9] add procedure prelude macro-instructions |
|
Date: |
Tue, 4 Jun 2013 16:44:03 +0200 |
* module/system/vm/assembler.scm (pack-flags): New helper.
(standard-prelude, opt-prelude, kw-prelude): New macro-instructions.
* test-suite/tests/rtl.test: Update tests to use standard-prelude.
---
module/system/vm/assembler.scm | 48 ++++++++++++++++++++++++++++++++++++++++
test-suite/tests/rtl.test | 40 ++++++++++++++++-----------------
2 files changed, 68 insertions(+), 20 deletions(-)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index b355b85..9538d71 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -36,6 +36,12 @@
link-assembly
assemble-program))
+(define-syntax pack-flags
+ (syntax-rules ()
+ ;; Add clauses as needed.
+ ((pack-flags f1 f2) (logior (if f1 (ash 1 0) 0)
+ (if f2 (ash 2 0) 0)))))
+
(define-syntax-rule (pack-u8-u24 x y)
(logior x (ash y 8)))
@@ -459,6 +465,48 @@
(let ((meta (car (asm-meta asm))))
(set-meta-high-pc! meta (asm-start asm))))
+(define-macro-assembler (standard-prelude asm nreq nlocals alternate)
+ (cond
+ (alternate
+ (emit-br-if-nargs-ne asm nreq alternate)
+ (emit-reserve-locals asm nlocals))
+ ((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12)))
+ (emit-assert-nargs-ee/locals asm nreq (- nlocals nreq)))
+ (else
+ (emit-assert-nargs-ee asm nreq)
+ (emit-reserve-locals asm nlocals))))
+
+(define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate)
+ (if alternate
+ (emit-br-if-nargs-lt asm nreq alternate)
+ (emit-assert-nargs-ge asm nreq))
+ (cond
+ (rest?
+ (emit-bind-rest asm (+ nreq nopt)))
+ (alternate
+ (emit-br-if-nargs-gt asm (+ nreq nopt) alternate))
+ (else
+ (emit-assert-nargs-le asm (+ nreq nopt))))
+ (emit-reserve-locals asm nlocals))
+
+(define-macro-assembler (kw-prelude asm nreq nopt rest? kw-indices
+ allow-other-keys? nlocals alternate)
+ (if alternate
+ (emit-br-if-nargs-lt asm nreq alternate)
+ (emit-assert-nargs-ge asm nreq))
+ (let ((ntotal (fold (lambda (kw ntotal)
+ (match kw
+ (((? keyword?) . idx)
+ (max (1+ idx) ntotal))))
+ (+ nreq nopt) kw-indices)))
+ ;; FIXME: port 581f410f
+ (emit-bind-kwargs asm nreq
+ (pack-flags allow-other-keys? rest?)
+ (+ nreq nopt)
+ ntotal
+ kw-indices)
+ (emit-reserve-locals asm nlocals)))
+
(define-macro-assembler (label asm sym)
(set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm))))
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index 2f5918f..02e6993 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -29,7 +29,7 @@
(define (return-constant val)
(assemble-program `((begin-program foo
((name . foo)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-constant 0 ,val)
(return 0)
(end-program))))
@@ -66,13 +66,13 @@
(assert-equal 42
(((assemble-program `((begin-program foo
((name . foo)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-static-procedure 0 bar)
(return 0)
(end-program)
(begin-program bar
((name . bar)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-constant 0 42)
(return 0)
(end-program)))))))
@@ -86,7 +86,7 @@
;; 2: accum
'((begin-program countdown
((name . countdown)))
- (assert-nargs-ee/locals 1 2)
+ (standard-prelude 1 3 #f)
(br fix-body)
(label loop-head)
(br-if-= 1 0 out)
@@ -111,7 +111,7 @@
;; 2: head
'((begin-program make-accum
((name . make-accum)))
- (assert-nargs-ee/locals 0 2)
+ (standard-prelude 0 2 #f)
(load-constant 0 0)
(box 0 0)
(make-closure 1 accum (0))
@@ -119,7 +119,7 @@
(end-program)
(begin-program accum
((name . accum)))
- (assert-nargs-ee/locals 1 2)
+ (standard-prelude 1 3 #f)
(free-ref 1 0)
(box-ref 2 1)
(add 2 2 0)
@@ -137,7 +137,7 @@
(assemble-program
'((begin-program call
((name . call)))
- (assert-nargs-ee/locals 1 0)
+ (standard-prelude 1 1 #f)
(call 1 0 ())
(return 1) ;; MVRA from call
(return 1) ;; RA from call
@@ -149,7 +149,7 @@
(assemble-program
'((begin-program call-with-3
((name . call-with-3)))
- (assert-nargs-ee/locals 1 1)
+ (standard-prelude 1 2 #f)
(load-constant 1 3)
(call 2 0 (1))
(return 2) ;; MVRA from call
@@ -163,7 +163,7 @@
(assemble-program
'((begin-program call
((name . call)))
- (assert-nargs-ee/locals 1 0)
+ (standard-prelude 1 1 #f)
(tail-call 0 0)
(end-program)))))
(call (lambda () 3))))
@@ -173,7 +173,7 @@
(assemble-program
'((begin-program call-with-3
((name . call-with-3)))
- (assert-nargs-ee/locals 1 1)
+ (standard-prelude 1 2 #f)
(mov 1 0) ;; R1 <- R0
(load-constant 0 3) ;; R0 <- 3
(tail-call 1 1)
@@ -186,7 +186,7 @@
(assemble-program
'((begin-program get-sqrt-trampoline
((name . get-sqrt-trampoline)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(cache-current-module! 0 sqrt-scope)
(load-static-procedure 0 sqrt-trampoline)
(return 0)
@@ -194,7 +194,7 @@
(begin-program sqrt-trampoline
((name . sqrt-trampoline)))
- (assert-nargs-ee/locals 1 1)
+ (standard-prelude 1 2 #f)
(cached-toplevel-ref 1 sqrt-scope sqrt)
(tail-call 1 1)
(end-program)))))
@@ -209,7 +209,7 @@
(assemble-program
'((begin-program make-top-incrementor
((name . make-top-incrementor)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(cache-current-module! 0 top-incrementor)
(load-static-procedure 0 top-incrementor)
(return 0)
@@ -217,7 +217,7 @@
(begin-program top-incrementor
((name . top-incrementor)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(cached-toplevel-ref 0 top-incrementor *top-val*)
(add1 0 0)
(cached-toplevel-set! 0 top-incrementor *top-val*)
@@ -232,14 +232,14 @@
(assemble-program
'((begin-program get-sqrt-trampoline
((name . get-sqrt-trampoline)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-static-procedure 0 sqrt-trampoline)
(return 0)
(end-program)
(begin-program sqrt-trampoline
((name . sqrt-trampoline)))
- (assert-nargs-ee/locals 1 1)
+ (standard-prelude 1 2 #f)
(cached-module-ref 1 (guile) #t sqrt)
(tail-call 1 1)
(end-program)))))
@@ -252,14 +252,14 @@
(assemble-program
'((begin-program make-top-incrementor
((name . make-top-incrementor)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-static-procedure 0 top-incrementor)
(return 0)
(end-program)
(begin-program top-incrementor
((name . top-incrementor)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(cached-module-ref 0 (tests rtl) #f *top-val*)
(add1 0 0)
(cached-module-set! 0 (tests rtl) #f *top-val*)
@@ -271,7 +271,7 @@
(with-test-prefix "debug contexts"
(let ((return-3 (assemble-program
'((begin-program return-3 ((name . return-3)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-constant 0 3)
(return 0)
(end-program)))))
@@ -292,7 +292,7 @@
(procedure-name
(assemble-program
'((begin-program foo ((name . foo)))
- (assert-nargs-ee/locals 0 1)
+ (standard-prelude 0 1 #f)
(load-constant 0 42)
(return 0)
(end-program))))))
--
1.7.10.4
- Serialize procedure metadata into ELF for RTL programs, Andy Wingo, 2013/06/04
- [PATCH 2/9] add procedure prelude macro-instructions,
Andy Wingo <=
- [PATCH 3/9] Beginnings of tracking of procedure arities in assembler, Andy Wingo, 2013/06/04
- [PATCH 1/9] begin-program takes properties alist, Andy Wingo, 2013/06/04
- [PATCH 4/9] RTL assembler writes arities information into separate section., Andy Wingo, 2013/06/04
- [PATCH 6/9] Wire up ability to print RTL program arities, Andy Wingo, 2013/06/04
- [PATCH 5/9] (system vm debug) can read arity information, Andy Wingo, 2013/06/04
- [PATCH 7/9] Write docstrings into RTL ELF images, Andy Wingo, 2013/06/04
- [PATCH 8/9] procedure-documentation works on RTL procedures, Andy Wingo, 2013/06/04
- [PATCH 9/9] procedure-properties for RTL functions, Andy Wingo, 2013/06/04