commented out references to some unused register names
This commit is contained in:
parent
7c26c2b19e
commit
f10a8ffccd
|
@ -553,7 +553,7 @@ KVW_BENCHMARKS="ack array1 cat string sum1 sumloop tail wc"
|
|||
C_BENCHMARKS="fft fib fibfp mbrot pnpoly sum sumfp tak $KVW_BENCHMARKS"
|
||||
|
||||
#OTHER_BENCHMARKS="conform dynamic earley fibc graphs lattice matrix maze mazefun nqueens paraffins peval pi primes ray scheme simplex slatex"
|
||||
OTHER_BENCHMARKS="conform dynamic earley fibc graphs lattice matrix maze mazefun nqueens paraffins peval primes ray scheme simplex slatex perm9 nboyer sboyer gcbench"
|
||||
OTHER_BENCHMARKS="conform dynamic earley fibc graphs lattice matrix maze mazefun nqueens paraffins peval primes ray scheme simplex slatex perm9 nboyer sboyer gcbench symbtesting"
|
||||
|
||||
NEW_BENCHMARKS="parsing gcold"
|
||||
|
||||
|
|
|
@ -65,3 +65,5 @@
|
|||
(define parsing-iters 1000)
|
||||
(define gcold-iters 10000)
|
||||
;(define nbody-iters 1) ; nondeterministic (order of evaluation)
|
||||
|
||||
|
||||
|
|
|
@ -908,3 +908,225 @@ Words allocated: 2754230651
|
|||
Words reclaimed: 0
|
||||
Elapsed time...: 24878 ms (User: 20763 ms; System: 4107 ms)
|
||||
Elapsed GC time: 13446 ms (CPU: 13424 in 10508 collections.)
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:00:40 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtest under Larceny-r6rs
|
||||
Compiling...
|
||||
cat: ../../src/symtest.scm: No such file or directory
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
> bench DIED!
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:00:51 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
cat: ../../src/symtesting.scm: No such file or directory
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
> bench DIED!
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:01:45 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing fib under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
Words allocated: 0
|
||||
Words reclaimed: 0
|
||||
Elapsed time...: 2020 ms (User: 1907 ms; System: 9 ms)
|
||||
Elapsed GC time: 0 ms (CPU: 0 in 0 collections.)
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:02:12 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
cat: ../../src/symtesting.scm: No such file or directory
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
> bench DIED!
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:03:58 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
cat: ../../src/symtesting.scm: No such file or directory
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
> bench DIED!
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:04:15 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
cat: ../../src/symtesting.scm: No such file or directory
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
> bench DIED!
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:11:19 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
bench DIED!
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:27:31 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
Words allocated: 0
|
||||
Words reclaimed: 0
|
||||
Elapsed time...: 608 ms (User: 583 ms; System: 3 ms)
|
||||
Elapsed GC time: 0 ms (CPU: 0 in 0 collections.)
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:31:09 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
Words allocated: 0
|
||||
Words reclaimed: 0
|
||||
Elapsed time...: 604 ms (User: 582 ms; System: 3 ms)
|
||||
Elapsed GC time: 0 ms (CPU: 0 in 0 collections.)
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:31:40 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
Words allocated: 0
|
||||
Words reclaimed: 0
|
||||
Elapsed time...: 643 ms (User: 619 ms; System: 3 ms)
|
||||
Elapsed GC time: 0 ms (CPU: 0 in 0 collections.)
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 02:32:09 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
Words allocated: 0
|
||||
Words reclaimed: 0
|
||||
Elapsed time...: 589 ms (User: 558 ms; System: 3 ms)
|
||||
Elapsed GC time: 0 ms (CPU: 0 in 0 collections.)
|
||||
|
||||
****************************
|
||||
Benchmarking Larceny-r6rs on Sat Feb 10 11:48:02 EST 2007 under Darwin ppp-70-231-126-3.dsl.bltnin.ameritech.net 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing symtesting under Larceny-r6rs
|
||||
Compiling...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
>
|
||||
Running...
|
||||
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
|
||||
|
||||
|
||||
>
|
||||
Words allocated: 0
|
||||
Words reclaimed: 0
|
||||
Elapsed time...: 558 ms (User: 557 ms; System: 1 ms)
|
||||
Elapsed GC time: 0 ms (CPU: 0 in 0 collections.)
|
||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -3149,9 +3149,9 @@
|
|||
(define (ja label) (list 'ja label))
|
||||
(define (jo label) (list 'jo label))
|
||||
(define (jmp label) (list 'jmp label))
|
||||
(define edi '%edx) ; closure pointer
|
||||
(define esi '%esi) ; pcb
|
||||
(define ebp '%ebp) ; allocation pointer
|
||||
; (define edi '%edx) ; closure pointer
|
||||
; (define esi '%esi) ; pcb
|
||||
; (define ebp '%ebp) ; allocation pointer
|
||||
(define esp '%esp) ; stack base pointer
|
||||
(define al '%al)
|
||||
(define ah '%ah)
|
||||
|
@ -3161,10 +3161,10 @@
|
|||
(define ebx '%ebx)
|
||||
(define ecx '%ecx)
|
||||
(define edx '%edx)
|
||||
(define apr '%ebp)
|
||||
(define fpr '%esp)
|
||||
(define cpr '%edi)
|
||||
(define pcr '%esi)
|
||||
(define apr '%ebp) ; allocation pointer
|
||||
(define fpr '%esp) ; frame pointer
|
||||
(define cpr '%edi) ; closure pointer
|
||||
(define pcr '%esi) ; pcb pointer
|
||||
(define register? symbol?)
|
||||
(define (argc-convention n)
|
||||
(fx- 0 (fxsll n fx-shift))))
|
||||
|
|
|
@ -12,7 +12,7 @@
|
|||
#'(i . i*))]))
|
||||
(define (generate-body ctxt cls*)
|
||||
(syntax-case cls* (else)
|
||||
[() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v #'x))]
|
||||
[() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v 'x))]
|
||||
[([else b b* ...]) #'(begin b b* ...)]
|
||||
[([(rec-name rec-field* ...) b b* ...] . rest) (identifier? #'rec-name)
|
||||
(with-syntax ([altern (generate-body ctxt #'rest)]
|
||||
|
@ -41,6 +41,42 @@
|
|||
(define (mkseq e0 e1) (make-seq e0 e1))
|
||||
(define-record conditional (e0 e1 e2))
|
||||
(define (mkif e0 e1 e2) (make-conditional e0 e1 e2))
|
||||
(define-record app (rator rand*))
|
||||
(define (mkapp rator . rands) (make-app rator rands))
|
||||
(define-record clambda (free cases))
|
||||
(define-record clambda-case (fml* proper body))
|
||||
(define-record var (name index))
|
||||
(define-record bind (lhs* rhs* body))
|
||||
(define (mkbind lhs* rhs* body)
|
||||
(if (null? lhs*)
|
||||
body
|
||||
(make-bind lhs* rhs* body)))
|
||||
;;;
|
||||
(define (unparse x)
|
||||
(define (flat x ac)
|
||||
(record-case x
|
||||
[(seq e0 e1)
|
||||
(flat e0 (flat e1 ac))]
|
||||
[else
|
||||
(cons (E x) ac)]))
|
||||
(define (E x)
|
||||
(record-case x
|
||||
[(constant c) `(const ,c)]
|
||||
[(int i) `(int ,i)]
|
||||
[(var name) `(var ,name)]
|
||||
[(set lhs rhs) `(set ,(E lhs) ,(E rhs))]
|
||||
[(reg r) `(reg ,r)]
|
||||
[(primcall op rands) `(,op . ,(map E rands))]
|
||||
[(seq e0 e1)
|
||||
`(seq . ,(flat e0 (flat e1 '())))]
|
||||
[(conditional e0 e1 e2)
|
||||
`(if ,(E e0) ,(E e1) ,(E e2))]
|
||||
[else (error 'unparse "invalid ~s" x)]))
|
||||
(E x))
|
||||
;;;
|
||||
(define (pretty-code x)
|
||||
(parameterize ([print-gensym 'pretty])
|
||||
(pretty-print (unparse x))))
|
||||
;;;
|
||||
(module (primitive? arg-count-ok? primitive-context)
|
||||
(define primitives
|
||||
|
@ -92,8 +128,24 @@
|
|||
(define (E* x* r)
|
||||
(map (lambda (x) (E x r)) x*))
|
||||
;;;
|
||||
(define (list->seq ls)
|
||||
(let f ([a (car ls)] [ls (cdr ls)])
|
||||
(cond
|
||||
[(null? ls) a]
|
||||
[else
|
||||
(f (make-seq a (car ls)) (cdr ls))])))
|
||||
;;;
|
||||
(define (lookup x r)
|
||||
(cond
|
||||
[(null? r) #f]
|
||||
[(assq x (car r)) => cdr]
|
||||
[else (lookup x (cdr r))]))
|
||||
;;;
|
||||
(define (E x r)
|
||||
(cond
|
||||
[(symbol? x)
|
||||
(or (lookup x r)
|
||||
(error who "unbound variable ~s" x))]
|
||||
[(and (pair? x) (symbol? (car x)))
|
||||
(case (car x)
|
||||
[(quote) (mkconst (cadr x))]
|
||||
|
@ -101,7 +153,33 @@
|
|||
(mkif (E (cadr x) r)
|
||||
(E (caddr x) r)
|
||||
(E (cadddr x) r))]
|
||||
[else (error who "invalid expression ~s" x)])]
|
||||
[(case-lambda)
|
||||
(make-clambda #f
|
||||
(map (lambda (x)
|
||||
(define (parse-fml* fml*)
|
||||
(cond
|
||||
[(null? fml*)
|
||||
(values '() '() #t)]
|
||||
[(symbol? fml*)
|
||||
(let ([f (make-var fml* #f)])
|
||||
(values (list f)
|
||||
(list (cons fml* f))
|
||||
#f))]
|
||||
[else
|
||||
(let-values ([(f* r p)
|
||||
(parse-fml* (cdr fml*))])
|
||||
(let ([f (make-var (car fml*) #f)])
|
||||
(values (cons f f*)
|
||||
(cons (cons (car fml*) f) r)
|
||||
p)))]))
|
||||
(let ([fml* (car x)]
|
||||
[body* (cdr x)])
|
||||
(let-values ([(fml* nr proper)
|
||||
(parse-fml* fml*)])
|
||||
(make-clambda-case fml* proper
|
||||
(list->seq (E* body* (cons nr r)))))))
|
||||
(cdr x)))]
|
||||
[else (make-app (E (car x) r) (E* (cdr x) r))])]
|
||||
[(pair? x)
|
||||
(let ([a (car x)])
|
||||
(cond
|
||||
|
@ -114,11 +192,55 @@
|
|||
(error who "incorrect args in ~s" x)]
|
||||
[else
|
||||
(make-primcall op (E* (cdr x) r))]))]
|
||||
[else (error who "invalid expression ~s" x)]))]
|
||||
[else
|
||||
(make-app (E a r) (E* (cdr x) r))]))]
|
||||
[else (error who "invalid expression ~s" x)]))
|
||||
;;;
|
||||
(E x '()))
|
||||
;;;
|
||||
(define (optimize-direct-calls x)
|
||||
(define who 'optimize-direct-call)
|
||||
(define (optimize rator rands)
|
||||
(define (args-match fml* proper rands)
|
||||
(if proper
|
||||
(= (length fml*) (length rands))
|
||||
(error who "unhandled improper list")))
|
||||
(define (bindem fml* proper rands body)
|
||||
(if proper
|
||||
(mkbind fml* rands body)
|
||||
(error who "unhandled improper list")))
|
||||
(record-case rator
|
||||
[(clambda free cases)
|
||||
(let f ([ls cases])
|
||||
(cond
|
||||
[(null? ls) (make-app rator rands)]
|
||||
[(record-case (car ls)
|
||||
[(clambda-case fml* proper body)
|
||||
(if (args-match fml* proper rands)
|
||||
(bindem fml* proper rands body)
|
||||
#f)])]
|
||||
[else (f (cdr ls))]))]
|
||||
[else (make-app rator rands)]))
|
||||
(define (E x)
|
||||
(record-case x
|
||||
[(constant) x]
|
||||
[(var) x]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (E e0) (E e1) (E e2))]
|
||||
[(clambda free cases)
|
||||
(make-clambda free
|
||||
(map (lambda (c)
|
||||
(record-case c
|
||||
[(clambda-case fml* proper body)
|
||||
(make-clambda-case fml* proper (E body))]))
|
||||
cases))]
|
||||
[(primcall op rands)
|
||||
(make-primcall op (map E rands))]
|
||||
[(app rator rands)
|
||||
(optimize (E rator) (map E rands))]
|
||||
[else (error who "invalid expression ~s" x)]))
|
||||
(E x))
|
||||
;;;
|
||||
(define (normalize-context x)
|
||||
(define who 'normalize-context)
|
||||
;;;
|
||||
|
@ -129,8 +251,11 @@
|
|||
(make-constant #t)))
|
||||
(record-case x
|
||||
[(constant c) (make-constant (if c #t #f))]
|
||||
[(var x) (predicafy x)]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (P e1) (P e2))]
|
||||
[(bind lhs* rhs* body)
|
||||
(make-bind lhs* (map V rhs*) (P body))]
|
||||
[(primcall op rands)
|
||||
(case (primitive-context op)
|
||||
[(v) (predicafy (V x))]
|
||||
|
@ -142,8 +267,11 @@
|
|||
(define (V x)
|
||||
(record-case x
|
||||
[(constant) x]
|
||||
[(var) x]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (V e1) (V e2))]
|
||||
[(bind lhs* rhs* body)
|
||||
(make-bind lhs* (map V rhs*) (V body))]
|
||||
[(primcall op rands)
|
||||
(case (primitive-context op)
|
||||
[(v) (make-primcall op (map V rands))]
|
||||
|
@ -203,6 +331,8 @@
|
|||
[(constant) x]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (P e1) (P e2))]
|
||||
[(bind lhs* rhs* body)
|
||||
(make-bind lhs* (map V rhs*) (P body))]
|
||||
[(primcall op rands)
|
||||
(case op
|
||||
[(fixnum?) (tagcmp rands fixnum-mask fixnum-tag)]
|
||||
|
@ -232,6 +362,9 @@
|
|||
x)]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (V e1) (V e2))]
|
||||
[(var) x]
|
||||
[(bind lhs* rhs* body)
|
||||
(make-bind lhs* (map V rhs*) (V body))]
|
||||
[(primcall op rands)
|
||||
(case op
|
||||
[($fxadd1)
|
||||
|
@ -291,6 +424,72 @@
|
|||
[(int) #t]
|
||||
[else #f]))
|
||||
;;;
|
||||
(define (do-bind lhs* rhs* body)
|
||||
(cond
|
||||
[(null? lhs*) body]
|
||||
[else
|
||||
(mkseq (D (car lhs*) (car rhs*))
|
||||
(do-bind (cdr lhs*) (cdr rhs*) body))]))
|
||||
;;;
|
||||
(define (D d x)
|
||||
(define (assoc op a b)
|
||||
(cond
|
||||
[(simple? a)
|
||||
(let ([t (new-uvar)])
|
||||
(mkseq (D t b)
|
||||
(mkseq (mkset t (mkprm op t a))
|
||||
(mkset d t))))]
|
||||
[(simple? b)
|
||||
(let ([t (new-uvar)])
|
||||
(mkseq (D t a)
|
||||
(mkseq (mkset t (mkprm op t b))
|
||||
(mkset d t))))]
|
||||
[else (error who "two complex operands ~s ~s" a b)]))
|
||||
(record-case x
|
||||
[(constant) (mkset d x)]
|
||||
[(int) (mkset d x)]
|
||||
[(var) (mkset d x)]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (D d e1) (D d e2))]
|
||||
[(primcall op rands)
|
||||
(case op
|
||||
[(int+)
|
||||
(assoc 'int+ (car rands) (cadr rands))]
|
||||
[(int*)
|
||||
(assoc 'int* (car rands) (cadr rands))]
|
||||
[(intxor)
|
||||
(assoc 'intxor (car rands) (cadr rands))]
|
||||
[(intor)
|
||||
(assoc 'intor (car rands) (cadr rands))]
|
||||
[(intand)
|
||||
(assoc 'intand (car rands) (cadr rands))]
|
||||
[(int-)
|
||||
(let ([a (car rands)] [b (cadr rands)])
|
||||
(cond
|
||||
[(simple? b)
|
||||
(let ([t (new-uvar)])
|
||||
(mkseq (D t a)
|
||||
(mkseq (mkset t (mkprm 'int- t b))
|
||||
(mkset d t))))]
|
||||
[(simple? a)
|
||||
(let ([t (new-uvar)])
|
||||
(mkseq (D t b)
|
||||
(mkseq (D d a)
|
||||
(mkset d (mkprm 'int- d t)))))]
|
||||
[else (error who "two complex operands ~s ~s" a b)]))]
|
||||
[(intsll intsra)
|
||||
(let ([a (car rands)] [b (cadr rands)])
|
||||
(record-case b
|
||||
[(int)
|
||||
(let ([t (new-uvar)])
|
||||
(mkseq (D t a)
|
||||
(mkseq (mkset t (mkprm op t b))
|
||||
(mkset d t))))]
|
||||
[else
|
||||
(error who "unhandled intsll ~s" b)]))]
|
||||
[else (error who "invalid value prim ~s" op)])]
|
||||
[else (error who "invalid value value ~s" x)]))
|
||||
;;;
|
||||
(define (P x)
|
||||
(define (prim op op^ a b)
|
||||
(cond
|
||||
|
@ -330,6 +529,7 @@
|
|||
(record-case x
|
||||
[(constant) (mkset rv-register x)]
|
||||
[(int) (mkset rv-register x)]
|
||||
[(var) (mkset rv-register x)]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (V e1) (V e2))]
|
||||
[(primcall op rands)
|
||||
|
@ -372,7 +572,10 @@
|
|||
(record-case x
|
||||
[(constant) (return (V x))]
|
||||
[(int) (return (V x))]
|
||||
[(var) (return (V x))]
|
||||
[(primcall) (return (V x))]
|
||||
[(bind lhs* rhs* body)
|
||||
(do-bind lhs* rhs* (Tail body))]
|
||||
[(conditional e0 e1 e2)
|
||||
(mkif (P e0) (Tail e1) (Tail e2))]
|
||||
[else (error who "invalid tail ~s" x)]))
|
||||
|
@ -562,7 +765,8 @@
|
|||
`(,asmprm ,(op b) ,(op targ))
|
||||
ac)]
|
||||
[else (error who "invalid ops")])))]
|
||||
[else (error who "invalid op ~s" prim)])])]
|
||||
[else (error who "invalid op ~s" prim)])]
|
||||
[else (error who "invalid rhs ~s" v)])]
|
||||
[else (error who "invalid effect ~s" x)]))
|
||||
;;;
|
||||
(define (Tail x ac)
|
||||
|
@ -582,6 +786,8 @@
|
|||
[else (error who "invalid tail prim ~s" op)])]
|
||||
[else (error who "invalid tail ~s" x)]))
|
||||
;;;
|
||||
(printf "linearing:\n")
|
||||
(pretty-code x)
|
||||
(list (list* 0
|
||||
(Tail x '()))))
|
||||
;;;
|
||||
|
@ -591,6 +797,7 @@
|
|||
($make-environment '|#system| #t)])
|
||||
(expand x))]
|
||||
[x (recordize x)]
|
||||
[x (optimize-direct-calls x)]
|
||||
[x (normalize-context x)]
|
||||
[x (specify-representation x)]
|
||||
[x (impose-calling-convention x)]
|
||||
|
@ -634,5 +841,6 @@
|
|||
(load "tests/tests-1.3-req.scm")
|
||||
(load "tests/tests-1.4-req.scm")
|
||||
(load "tests/tests-1.5-req.scm")
|
||||
(load "tests/tests-1.6-req.scm")
|
||||
|
||||
(printf "ALL IS GOOD :-)\n")
|
||||
|
|
Loading…
Reference in New Issue