home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / compiler / machines / sparc / assmd.scm next >
Encoding:
Text File  |  1999-01-02  |  2.7 KB  |  82 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: assmd.scm,v 1.2 1999/01/02 06:06:43 cph Exp $
  4. $MC68020-Header: assmd.scm,v 1.36 89/08/28 18:33:33 GMT cph Exp $
  5.  
  6. Copyright (c) 1988, 1989, 1990, 1999 Massachusetts Institute of Technology
  7.  
  8. This program is free software; you can redistribute it and/or modify
  9. it under the terms of the GNU General Public License as published by
  10. the Free Software Foundation; either version 2 of the License, or (at
  11. your option) any later version.
  12.  
  13. This program is distributed in the hope that it will be useful, but
  14. WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. General Public License for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with this program; if not, write to the Free Software
  20. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21. |#
  22.  
  23. ;;;; Assembler Machine Dependencies
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (let-syntax ((ucode-type (macro (name) `',(microcode-type name))))
  28.  
  29. (define-integrable maximum-padding-length
  30.   ;; Instruction length is always a multiple of 32 bits
  31.   ;; Would 0 work here?
  32.   32)
  33.  
  34. (define padding-string
  35.   ;; Pad with `UNIMP' instructions
  36.   (unsigned-integer->bit-string maximum-padding-length
  37.                 #b00000000000000000000000000000000 ))
  38.  
  39. (define-integrable block-offset-width
  40.   ;; Block offsets are always 16 bit words
  41.   16)
  42.  
  43. (define-integrable maximum-block-offset
  44.   ;; PC always aligned on longword boundary.  Use the extra bit.
  45.   (- (expt 2 (1+ block-offset-width)) 4))
  46.  
  47. (define (block-offset->bit-string offset start?)
  48.   (unsigned-integer->bit-string block-offset-width
  49.                 (+ (quotient offset 2)
  50.                    (if start? 0 1))))
  51.  
  52. (define (make-nmv-header n)
  53.   (bit-string-append (unsigned-integer->bit-string scheme-datum-width n)
  54.              nmv-type-string))
  55.  
  56. (define nmv-type-string
  57.   (unsigned-integer->bit-string scheme-type-width
  58.                 (ucode-type manifest-nm-vector)))
  59.  
  60. (define (object->bit-string object)
  61.   (bit-string-append
  62.    (unsigned-integer->bit-string scheme-datum-width
  63.                  (careful-object-datum object))
  64.    (unsigned-integer->bit-string scheme-type-width (object-type object))))
  65.  
  66. ;;; Machine dependent instruction order
  67.  
  68. (define (instruction-insert! bits block position receiver)
  69.   (let ((l (bit-string-length bits)))
  70.     (if (eq? endianness 'LITTLE)
  71.     (begin
  72.       (bit-substring-move-right! bits 0 l block position)
  73.       (receiver (+ position l)))
  74.     (let ((new-position (- position l)))
  75.       (bit-substring-move-right! bits 0 l block new-position)
  76.       (receiver new-position)))))
  77.  
  78. (define-integrable instruction-initial-position bit-string-length)
  79. (define-integrable instruction-append bit-string-append-reversed)
  80.  
  81. ;;; end let-syntax
  82. )