More work on cp0 which can now swallow the compiler but cannot yet

fold any primitives.
This commit is contained in:
Abdulaziz Ghuloum 2008-06-22 22:10:05 -07:00
parent 5a2501d4bb
commit 7d9ed176ac
8 changed files with 1050 additions and 129 deletions

View File

@ -24,7 +24,7 @@ EXTRA_DIST=ikarus.boot.prebuilt ikarus.enumerations.ss \
psyntax.internal.ss psyntax.library-manager.ss \
unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss \
ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
ikarus.string-to-number.ss
ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss
all: $(nodist_pkglib_DATA)

View File

@ -178,7 +178,7 @@ EXTRA_DIST = ikarus.boot.prebuilt ikarus.enumerations.ss \
psyntax.internal.ss psyntax.library-manager.ss \
unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss \
ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
ikarus.string-to-number.ss
ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss
revno = "$(shell sed 's/ .*//' ../.bzr/branch/last-revision 2>/dev/null)"
CLEANFILES = $(nodist_pkglib_DATA) ikarus.config.ss

View File

@ -1493,6 +1493,7 @@
(mark-nfv/frms-conf! d fs)
(R s vs rs fs (add-nfv d ns)))])]
[else (error who "invalid op d" (unparse x))])))]
[(nop) (values vs rs fs ns)]
[(logand logor logxor sll sra srl int+ int- int* bswap!
sll/overflow)
(cond

File diff suppressed because it is too large Load Diff

View File

@ -15,10 +15,11 @@
(library (ikarus.compiler)
(export compile-core-expr-to-port optimize-level
(export compile-core-expr-to-port
assembler-output scc-letrec optimize-cp
current-primitive-locations eval-core
compile-core-expr)
compile-core-expr
cp0-effort-limit cp0-size-limit)
(import
(rnrs hashtables)
(ikarus system $fx)
@ -29,7 +30,8 @@
optimize-level
fasl-write scc-letrec optimize-cp
compile-core-expr-to-port assembler-output
current-primitive-locations eval-core)
current-primitive-locations eval-core
cp0-size-limit cp0-effort-limit)
(ikarus.fasl.write)
(ikarus.intel-assembler))
@ -435,7 +437,7 @@
,(E-args (case-info-proper info) (case-info-args info))
,(E body))]
[(clambda g cls* cp free)
`(clambda (label: ,g cp: ,(E cp) ) ;free: ,(map E free))
`(clambda (label: ,g) ; cp: ,(E cp) ) ;free: ,(map E free))
,@(map E cls*))]
[(clambda label clauses free)
`(code ,label . ,(map E clauses))]
@ -2997,6 +2999,8 @@
(printf " ~s\n" x)]))
(define optimizer 'old)
(define (compile-core-expr->code p)
(let* ([p (recordize p)]
[p (parameterize ([open-mvcalls #f])
@ -3004,9 +3008,13 @@
[p (if (scc-letrec)
(optimize-letrec/scc p)
(optimize-letrec p))]
[p (source-optimize p)]
[p (if (eq? optimizer 'new)
(source-optimize p)
p)]
[p (uncover-assigned/referenced p)]
[p (copy-propagate p)]
[p (if (eq? optimizer 'old)
(copy-propagate p)
p)]
[p (rewrite-assignments p)]
[p (sanitize-bindings p)]
[p (optimize-for-direct-jumps p)]

View File

@ -1 +1 @@
1520
1521

View File

@ -17,7 +17,8 @@
;;; vim:syntax=scheme
(import (only (ikarus) import))
(import (except (ikarus)
optimize-level assembler-output scc-letrec optimize-cp))
assembler-output scc-letrec optimize-cp
cp0-size-limit cp0-effort-limit))
(import (ikarus.compiler))
(import (except (psyntax system $bootstrap)
eval-core
@ -25,6 +26,9 @@
compile-core-expr-to-port))
(import (ikarus.compiler)) ; just for fun
(pretty-width 160)
((pretty-format 'fix) ((pretty-format 'letrec)))
(define scheme-library-files
;;; Listed in the order in which they're loaded.
;;;
@ -1428,7 +1432,8 @@
[ellipsis-map ]
[scc-letrec i]
[optimize-cp i]
[optimize-level i]
[cp0-size-limit i]
[cp0-effort-limit i]
))
(define (macro-identifier? x)

View File

@ -421,7 +421,8 @@
(K (+ (* i wordsize) (- disp-vector-data vector-tag)))))]
[else #f])
(prm 'mref (T x)
(prm 'int+ (T i) (K (- disp-vector-data vector-tag)))))])
(prm 'int+ (T i) (K (- disp-vector-data vector-tag)))))]
[(E x i) (nop)])
(define-primop $vector-length unsafe
[(V x) (prm 'mref (T x) (K (- disp-vector-length vector-tag)))]
@ -1471,8 +1472,7 @@
(define-primop $struct-ref unsafe
[(V x i) (cogen-value-$vector-ref x i)]
[(E x i) (cogen-effect-$vector-ref x i)]
[(P x i) (cogen-pred-$vector-ref x i)])
[(E x i) (nop)])
(define-primop $struct-set! unsafe
[(V x i v)