home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / comp / assembler / count.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  3.7 KB  |  86 lines
  1. (herald (assembler count t 37)
  2.         (env t (assembler as_open) (assembler fg) (assembler ib)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Count number of marks, and number of span-dependent fg's
  28.  
  29. (define (count-spans ibv)
  30.   (let ((ibv-length (vector-length ibv)))
  31.     (iterate loop ((i 0) (marks 0) (sdfs 0))
  32.        (cond ((fx>= i ibv-length) (return marks sdfs))
  33.              (else 
  34.               (receive (m' s') (count-ib (vref ibv i) marks sdfs)
  35.                  (loop (fx+ i 1) m' s')))))))
  36.  
  37. (define (count-ib ib m first-s)
  38.   (let ((new-s (cond ((pair? (ib-align ib))
  39.                       (set (ib-sdf-number ib) first-s)
  40.                       (fx+ first-s 1))
  41.                      (else first-s))))
  42.     (iterate loop ((i's (ib-instructions ib)) (m m) (s new-s))
  43.       (cond ((null? i's)
  44.              (return m s))
  45.             (else
  46.              (receive (m' s') (count-fg (car i's) m s)
  47.                 (loop (cdr i's) m' s')))))))
  48.  
  49. (define (count-fg fg m s)
  50.   (let* ((fgt (fg-type fg))
  51.          (vars (fg-vars fg))
  52.          (vals (fg-type-vals fgt)))
  53.     (iterate loop ((ops (fg-type-ops fgt))
  54.                    (m m)
  55.                    (s s))
  56.       (cond ((null? ops) (return m s))
  57.             (else
  58.              (xselect (car ops)
  59.                ((wop/fix)
  60.                 (destructure (((#f sign width vop voc1 . ops) ops))
  61.                   (loop ops m s)))
  62.                ((wop/@fix)
  63.                 (destructure (((#f sign width-i vop voc1 . ops) ops))
  64.                   (loop ops m s)))
  65.                ((wop/proc)
  66.                 (destructure (((#f sign cw-i proc-i vop voc1 . ops) ops))
  67.                   (loop ops m s)))
  68.                ((wop/var)
  69.                 (destructure (((#f sign cw-i opt-i vop voc1 . ops) ops))
  70.                   (loop ops m s)))
  71.                ((wop/depending-on)
  72.                 (destructure (((#f sdf#-i sdf-i mark-i fge-i . ops) ops))
  73.                   (set (vref vars sdf#-i) s)
  74.                   (loop ops m (fx+ s 1))))
  75.                ((wop/subfield-ic)
  76.                 (destructure (((#f sf-i vop voc1 . ops) ops))
  77.                   (receive (m' s') (count-fg (vref vars sf-i) m s)
  78.                     (loop ops m' s'))))
  79.                ((wop/mark)
  80.                 (destructure (((#f count-i . ops) ops))
  81.                   (set (vref vars count-i) m)
  82.                   (loop ops (fx+ m 1) s)))
  83.                ))))))
  84.  
  85.  
  86.