#| -*-Scheme-*-
-$Id: lapgn1.scm,v 4.16 1993/12/08 17:43:55 gjr Exp $
+$Id: lapgn1.scm,v 4.17 1998/02/19 21:28:24 adams Exp $
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-1998 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(define *insert-rtl?*)
(define (generate-lap rgraphs remote-links process-constants-block)
+ (pre-lapgen-analysis rgraphs)
(fluid-let ((*insert-rtl?*
(and compiler:generate-lap-files?
compiler:intersperse-rtl-in-lap?)))
#| -*-Scheme-*-
-$Id: lapgen.scm,v 1.10 1993/11/13 06:44:26 gjr Exp $
+$Id: lapgen.scm,v 1.11 1998/02/19 21:28:55 adams Exp $
Copyright (c) 1992-1993 Massachusetts Institute of Technology
set! define lookup-apply primitive-error
quotient remainder modulo
reflect-to-interface interrupt-continuation-2
- compiled-code-bkpt compiled-closure-bkpt))
\ No newline at end of file
+ compiled-code-bkpt compiled-closure-bkpt))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: lapgen.scm,v 1.4 1993/02/18 01:28:29 gjr Exp $
+$Id: lapgen.scm,v 1.5 1998/02/19 21:29:32 adams Exp $
Copyright (c) 1992-1993 Digital Equipment Corporation (D.E.C.)
(LAP ,@clear-regs
,@load-regs
,@(clear-map!)))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: lapgen.scm,v 4.49 1993/07/08 01:06:53 gjr Exp $
+$Id: lapgen.scm,v 4.50 1998/02/19 21:29:38 adams Exp $
Copyright (c) 1988-1993 Massachusetts Institute of Technology
(define-integrable (invoke-interface-jsr code)
(LAP (MOVEQ (& ,code) (D 0))
- (JSR ,entry:compiler-scheme-to-interface-jsr)))
\ No newline at end of file
+ (JSR ,entry:compiler-scheme-to-interface-jsr)))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: lapgen.scm,v 1.25 1998/02/18 07:55:07 adams Exp $
+$Id: lapgen.scm,v 1.26 1998/02/19 21:28:34 adams Exp $
Copyright (c) 1992-1998 Massachusetts Institute of Technology
(define (lookup-arithmetic-method operator methods)
(cdr (or (assq operator (cdr methods))
- (error "Unknown operator" operator))))
\ No newline at end of file
+ (error "Unknown operator" operator))))
+
+(define (pre-lapgen-analysis rgraphs)
+ (for-each (lambda (rgraph)
+ (for-each (lambda (edge)
+ (determine-interrupt-checks (edge-right-node edge)))
+ (rgraph-entry-edges rgraph)))
+ rgraphs))
#| -*-Scheme-*-
-$Id: rules3.scm,v 1.32 1998/02/16 03:55:28 cph Exp $
+$Id: rules3.scm,v 1.33 1998/02/19 21:28:10 adams Exp $
Copyright (c) 1992-1998 Massachusetts Institute of Technology
(INVOCATION:CACHE-REFERENCE (? frame-size) (? continuation) (? extension))
(QUALIFIER (interpreter-call-argument? extension))
continuation
+ (expect-no-exit-interrupt-checks)
(let* ((set-extension
(interpreter-call-argument->machine-register! extension ecx))
(set-address
(INVOCATION:LOOKUP (? frame-size) (? continuation) (? environment) (? name))
(QUALIFIER (interpreter-call-argument? environment))
continuation
+ (expect-no-entry-interrupt-checks)
(let* ((set-environment
(interpreter-call-argument->machine-register! environment ecx))
(set-name (object->machine-register! name edx)))
(INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
continuation ; ignored
;;
- ;;(expect-no-exit-interrupt-checks)
(let-syntax ((invoke
#|
(macro (code entry)
(? continuation)
,(make-primitive-procedure name true))
frame-size continuation
- '(expect-no-exit-interrupt-checks)
+ (expect-no-exit-interrupt-checks)
(special-primitive-invocation
,(symbol-append 'CODE:COMPILER- name)))))
(? continuation)
,(make-primitive-procedure name true))
frame-size continuation
- '(expect-no-exit-interrupt-checks)
+ (expect-no-exit-interrupt-checks)
(optimized-primitive-invocation
,(symbol-append 'ENTRY:COMPILER- name))))))
(define-rule statement
(IC-PROCEDURE-HEADER (? internal-label))
+ (get-entry-interrupt-checks) ; force search
(let ((procedure (label->object internal-label)))
(let ((external-label (rtl-procedure/external-label procedure))
(gc-label (generate-label)))
;; HEAP heap check required here
;; INTERRUPT check required here to avoid loops without checks.
;;
-;; The traversal and decision making is done on the first call and
-;; cached. It would have been better to have a back-end specific
-;; pre-lapgen pass to do the decision making. Then the cfg marking
-;; abstraction could have been used, but we can't use it here because
-;; the lapgen control is already using it.
+;; The traversal and decision making is done immediately prior to LAP
+;; generation (from PRE-LAPGEN-ANALYSIS.)
(define (get-entry-interrupt-checks)
(get-interupt-checks 'ENTRY-INTERRUPT-CHECKS))
(error "No exit interrupt checks expected here" *current-bblock*)))
(define (get-interupt-checks kind)
- (let retry ((failed? #F))
- (cond ((cfg-node-get *current-bblock* kind)
- => cdr)
- (failed? (error "DETERMINE-INTERRUPT-CHECKS failed" kind) #F)
- (else
- (determine-interrupt-checks)
- (retry #T)))))
-
+ (cond ((cfg-node-get *current-bblock* kind)
+ => cdr)
+ (else (error "DETERMINE-INTERRUPT-CHECKS failed" kind))))
;; This algorithm finds leaf-procedure-like paths in the rtl control
;; flow graph. If a procedure entry point can only reach a return, it
;; The algorithm has three phases: (1) explore the CFG to find all
;; entry and exit points, (2) propagate entry (exit) information so
;; that each potential interrupt check point knows what kinds of exits
-;; (entrys) it reaches (is reached from), and (3) decide on the kninds
+;; (entrys) it reaches (is reached from), and (3) decide on the kinds
;; of interrupt check that are required at each entry and exit.
;;
;; [TOFU is just a header node for the list of interrupt checks, to
;; distingish () and #F]
-(define (determine-interrupt-checks)
+(define (determine-interrupt-checks bblock)
(let ((entries '())
(exits '()))
(for-each-previous-node bblock explore)
(for-each-subsequent-node bblock explore)
(if (and (snode? bblock)
- (not (snode-next bblock)))
+ (or (not (snode-next bblock))
+ (let ((last (last-insn bblock)))
+ (or (rtl:invocation:special-primitive? last)
+ (rtl:invocation:primitive? last)))))
(set! exits (cons bblock exits))))))
(define (for-each-subsequent-node node procedure)
(checks! '()))
(checks! '())))
- (explore *current-bblock*)
+ (explore bblock)
(for-each propagate-entry-info entries)
(for-each propagate-exit-info exits)
#| -*-Scheme-*-
-$Id: lapgen.scm,v 1.14 1997/03/30 23:33:17 cph Exp $
+$Id: lapgen.scm,v 1.15 1998/02/19 21:29:01 adams Exp $
Copyright (c) 1988-97 Massachusetts Institute of Technology
(begin
(delete-register! rtl-reg)
(flush-register! machine-reg)
- (add-pseudo-register-alias! rtl-reg machine-reg))))
\ No newline at end of file
+ (add-pseudo-register-alias! rtl-reg machine-reg))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/sparc/lapgen.scm,v 1.1 1993/06/08 06:11:02 gjr Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/sparc/lapgen.scm,v 1.2 1998/02/19 21:29:18 adams Exp $
Copyright (c) 1988-1992 Massachusetts Institute of Technology
(begin
(delete-register! rtl-reg)
(flush-register! machine-reg)
- (add-pseudo-register-alias! rtl-reg machine-reg))))
\ No newline at end of file
+ (add-pseudo-register-alias! rtl-reg machine-reg))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: lapgen.scm,v 4.46 1993/12/08 17:48:53 gjr Exp $
+$Id: lapgen.scm,v 4.47 1998/02/19 21:28:43 adams Exp $
Copyright (c) 1988-1993 Massachusetts Institute of Technology
,@(load-reg fourth regnum:fourth-arg))))
(LAP ,@clear-regs
,@load-regs
- ,@(clear-map!)))))
\ No newline at end of file
+ ,@(clear-map!)))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/lapgen.scm,v 4.14 1992/08/17 16:36:28 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/lapgen.scm,v 4.15 1998/02/19 21:29:24 adams Exp $
Copyright (c) 1987-1992 Massachusetts Institute of Technology
(define-integrable (invoke-interface-jsb code)
(LAP ,@(load-rn code 0)
- (JSB ,entry:compiler-scheme-to-interface-jsb)))
\ No newline at end of file
+ (JSB ,entry:compiler-scheme-to-interface-jsb)))
+
+
+(define (pre-lapgen-analysis rgraphs)
+ rgraphs
+ unspecific)
\ No newline at end of file
projects / mit-scheme.git / commitdiff