#| -*-Scheme-*-
-$Id: dbgred.scm,v 1.12 1995/08/04 19:48:50 adams Exp $
+$Id: dbgred.scm,v 1.13 1995/08/18 21:52:42 adams Exp $
Copyright (c) 1994-1995 Massachusetts Institute of Technology
edge))
(define (dbg-rewrites->graph infos)
- (let* ((table (make-eq-hash-table))
+ (let* ((table (make-monotonic-strong-eq-hash-table))
(expressions '())
(static-edges '()))
(define (find-node key)
- (or (hash-table/get table key #F)
+ (or (monotonic-strong-eq-hash-table/get table key #F)
(let ((node (dbg-red/node/make key)))
- (hash-table/put! table key node)
+ (monotonic-strong-eq-hash-table/put! table key node)
node)))
(define (add-references! expr edge)
(set! expressions (cons node expressions))))))
(cdr infos))
(for-each dbg-red/edge/statically-available! static-edges)
- (if compiler:enable-statistics?
+ #|(if compiler:enable-statistics?
(hash-table/for-each table
(lambda (key entry)
key
(sample/1 '(DBG-RED/IN-DEGREE HISTOGRAM)
(vector-ref (dbg-red/node/references entry) 0))
(sample/1 '(DBG-RED/STATIC-OUT-DEGREE HISTOGRAM)
- (length (dbg-red/node/static-definitions entry))))))
+ (length (dbg-red/node/static-definitions entry))))))|#
(dbg-red/graph/make table expressions)))
\f
(define (dbg-red/edge/statically-available! edge)
(define (dbg-red/find-node name)
- (hash-table/get (dbg-red/graph/table *dbg-graph*) name #F))
+ (monotonic-strong-eq-hash-table/get
+ (dbg-red/graph/table *dbg-graph*) name #F))
(define (dbg-red/env/mark-available-subgraph! env)
(define (available! name)
(else
(internal-error "CC-entries done statically")
`((CC-ENTRY . ,offset-or-name))))))
- ((hash-table/get (dbg-red/graph/table graph) item #F)
+ ((monotonic-strong-eq-hash-table/get (dbg-red/graph/table graph)
+ item #F)
=> reconstruct-node)
(else #F)))
(define dbgred/CLOSURE (dbg-reduce/indexed-path 'CLOSURE))
(define dbgred/CELL (dbg-reduce/indexed-path 'CELL))
-(define dbg-reduce/equivalent-operators (make-eq-hash-table))
+(define dbg-reduce/equivalent-operators (make-monotonic-strong-eq-hash-table))
(define (dbg-reduce/equivalent-primitive operator)
- (hash-table/get dbg-reduce/equivalent-operators operator #F))
+ (monotonic-strong-eq-hash-table/get
+ dbg-reduce/equivalent-operators operator #F))
(let ()
(define (->prim op)
(define (allow . ops)
(for-each (lambda (op)
(let ((op (->prim op)))
- (hash-table/put! dbg-reduce/equivalent-operators op op)))
+ (monotonic-strong-eq-hash-table/put!
+ dbg-reduce/equivalent-operators op op)))
ops))
(define (replace op op2)
- (hash-table/put! dbg-reduce/equivalent-operators op (->prim op2)))
+ (monotonic-strong-eq-hash-table/put!
+ dbg-reduce/equivalent-operators op (->prim op2)))
(replace %vector-length vector-length)
(allow '%record-length 'ascii->char 'bit-string->unsigned-integer
(cond ((or (eq? op %stack-closure-ref)
(eq? op %heap-closure-ref))
(compress-closure-ref op))
- ((hash-table/get *dbg-forbidden-operators* op #F) #F)
+ ((monotonic-strong-eq-hash-table/get *dbg-forbidden-operators* op #F) #F)
(else
(compress-ordinary-call form)))))
(else #F)))
(else (good to)))))))
-(define *dbg-forbidden-operators* (make-eq-hash-table))
+(define *dbg-forbidden-operators* (make-monotonic-strong-eq-hash-table))
(define (dbg-info/for-all-dbg-expressions! procedure)
(for-each (lambda (from+to)
(let ((forbid
(lambda (operator)
- (hash-table/put! *dbg-forbidden-operators* operator #T))))
+ (monotonic-strong-eq-hash-table/put! *dbg-forbidden-operators*
+ operator #T))))
(forbid %make-heap-closure)
(forbid CONS)
(forbid %cons)