OS/2 Shareware BBS: 10 Tools/10-Tools.zip/mitsch75.zip/scheme-7_5_17-src.zip/scheme-7.5.17/src/compiler/base/subprb.scm

Text File | 1999-01-02 | 6KB | 157 lines

#| -*-Scheme-*-

$Id: subprb.scm,v 4.8 1999/01/02 06:06:43 cph Exp $

Copyright (c) 1988, 1989, 1999 Massachusetts Institute of Technology

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|#

;;;; Subproblem Type

(declare (usual-integrations))

#|

Subproblems come in two forms, canonical and non-canonical.  In a
canonical subproblem, the `prefix' is always exited by a return
statement whose operator is the subproblem's `continuation'.  The
`rvalue' is always the parameter of the `continuation'.

In a non-canonical subproblem, there is no `continuation' -- the
`rvalue' is sufficiently simple that no complex computation is
required to compute its value.  Instead, the `prefix' is some setup
code that must be executed for effect, while the value of the
subproblem is just `rvalue'.

The non-canonical subproblem is used as an optimization by several
parts of the compiler, where better code can be generated if it is
known that the continuation need not be used.

|#

(define-structure (subproblem
           (constructor make-subproblem
                (prefix continuation rvalue)))
  (prefix false read-only true)
  (continuation false read-only true)
  (rvalue false read-only true)
  (simple? 'UNKNOWN)
  (free-variables 'UNKNOWN))

(define-integrable (subproblem-entry-node subproblem)
  (cfg-entry-node (subproblem-prefix subproblem)))

(define-integrable (subproblem-canonical? subproblem)
  (procedure? (subproblem-continuation subproblem)))

(define-integrable (subproblem-type subproblem)
  (continuation*/type (subproblem-continuation subproblem)))

(define-integrable (set-subproblem-type! subproblem type)
  (set-continuation*/type! (subproblem-continuation subproblem) type))

(define-integrable (subproblem-register subproblem)
  (continuation*/register (subproblem-continuation subproblem)))

(define (subproblem-context subproblem)
  (continuation*/context (subproblem-continuation subproblem)))

(define (continuation*/type continuation)
  (if (procedure? continuation)
      (continuation/type continuation)
      (virtual-continuation/type continuation)))

(define (set-continuation*/type! continuation type)
  (if (procedure? continuation)
      (set-continuation/type! continuation type)
      (set-virtual-continuation/type! continuation type)))

(define (continuation*/register continuation)
  (if (procedure? continuation)
      (continuation/register continuation)
      (virtual-continuation/register continuation)))

(define (continuation*/context continuation)
  (let ((continuation/context
     (lambda (continuation)
       (make-reference-context
        (block-parent (continuation/block continuation))))))
    (cond ((procedure? continuation)
       (continuation/context continuation))
      ((virtual-continuation/reified? continuation)
       (continuation/context
        (virtual-continuation/reification continuation)))
      (else
       (virtual-continuation/context continuation)))))

;;;; Virtual Continuations

;;; These are constructed in the FG generation phase for the purpose
;;; of delaying generation of real continuations until the last
;;; possible moment.  After the FG generation, non-reified virtual
;;; continuations are used to hold several values that normally would
;;; have resided in the real continuation.

(define-structure (virtual-continuation
           (constructor virtual-continuation/%make)
           (conc-name virtual-continuation/)
           (print-procedure
            (standard-unparser (symbol->string 'VIRTUAL-CONTINUATION)
              (lambda (state continuation)
            (let ((type (virtual-continuation/type continuation)))
              (if type
                  (unparse-object
                   state
                   (enumeration/index->name continuation-types
                            type))))))))
  context
  parent
  type
  debugging)

(define-integrable (virtual-continuation/make block type)
  ;; Used exclusively after FG generation.
  (virtual-continuation/%make block false type false))

(define-integrable (virtual-continuation/reified? continuation)
  (not (virtual-continuation/type continuation)))

(define-integrable virtual-continuation/reification
  virtual-continuation/context)

(define (virtual-continuation/reify! continuation)
  ;; This is used only during FG generation when it is decided that we
  ;; need a real continuation to handle a subproblem.
  (if (virtual-continuation/type continuation)
      (let ((reification
         (make-continuation
          (virtual-continuation/context continuation)
          (virtual-continuation/parent continuation)
          (virtual-continuation/type continuation))))
    (set-continuation/debugging-info!
     reification
     (virtual-continuation/debugging continuation))
    (set-virtual-continuation/context! continuation reification)
    (set-virtual-continuation/parent! continuation false)
    (set-virtual-continuation/type! continuation false)
    reification)
      (virtual-continuation/context continuation)))

(define (virtual-continuation/register continuation)
  (or (virtual-continuation/parent continuation)
      (let ((register (rtl:make-pseudo-register)))
    (set-virtual-continuation/parent! continuation register)
    register)))