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 / rules1.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  10.4 KB  |  297 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: rules1.scm,v 1.2 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1989-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; LAP Generation Rules: Data Transfers
  23.  
  24. (declare (usual-integrations))
  25.  
  26. ;;;; Simple Operations
  27.  
  28. ;;; All assignments to pseudo registers are required to delete the
  29. ;;; dead registers BEFORE performing the assignment.  However, it is
  30. ;;; necessary to derive the effective address of the source
  31. ;;; expression(s) before deleting the dead registers.  Otherwise any
  32. ;;; source expression containing dead registers might refer to aliases
  33. ;;; which have been reused.
  34.  
  35. (define-rule statement
  36.   (ASSIGN (REGISTER (? target)) (REGISTER (? source)))
  37.   (standard-move-to-target! source target)
  38.   (LAP))
  39.  
  40. (define-rule statement
  41.   (ASSIGN (REGISTER (? target))
  42.       (CONS-POINTER (REGISTER (? type)) (REGISTER (? datum))))
  43.   (let* ((type (standard-move-to-temporary! type))
  44.      (target (standard-move-to-target! datum target)))
  45.     (LAP (SLL ,type ,type ,(- 32 scheme-type-width))
  46.      (ANDR ,target ,target ,regnum:address-mask)
  47.      (ORR ,target ,type ,target))))
  48.  
  49. (define-rule statement
  50.   (ASSIGN (REGISTER (? target))
  51.       (CONS-NON-POINTER (REGISTER (? type)) (REGISTER (? datum))))
  52.   (let* ((type (standard-move-to-temporary! type))
  53.      (target (standard-move-to-target! datum target)))
  54.     (LAP (SLL ,type ,type ,(- 32 scheme-type-width))
  55.      (ORR ,target ,type ,target))))
  56.  
  57. (define-rule statement
  58.   (ASSIGN (REGISTER (? target))
  59.       (CONS-POINTER (MACHINE-CONSTANT (? type)) (REGISTER (? source))))
  60.   (let ((target (standard-move-to-target! source target)))
  61.     (deposit-type type target)))
  62.  
  63. (define-rule statement
  64.   (ASSIGN (REGISTER (? target))
  65.       (CONS-NON-POINTER (MACHINE-CONSTANT (? type)) (REGISTER (? source))))
  66.   (standard-unary-conversion source target
  67.     (lambda (source target)
  68.       (deposit-type type source))))
  69.  
  70. (define-rule statement
  71.   (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source))))
  72.   (standard-unary-conversion source target object->type))
  73.  
  74. (define-rule statement
  75.   (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (REGISTER (? source))))
  76.   (standard-unary-conversion source target object->datum))
  77.  
  78. (define-rule statement
  79.   (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source))))
  80.   (standard-unary-conversion source target object->address))
  81.  
  82. (define-rule statement
  83.   (ASSIGN (REGISTER (? target))
  84.       (OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
  85.   (standard-unary-conversion source target
  86.     (lambda (source target)
  87.       (add-immediate (* 4 offset) source target))))
  88.  
  89. (define-rule statement
  90.   (ASSIGN (REGISTER (? target))
  91.       (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
  92.   (standard-unary-conversion source target
  93.     (lambda (source target)
  94.       (add-immediate offset source target))))
  95.  
  96. ;;;; Loading of Constants
  97.  
  98. (define-rule statement
  99.   ;; load a machine constant
  100.   (ASSIGN (REGISTER (? target)) (MACHINE-CONSTANT (? source)))
  101.   (load-immediate (standard-target! target) source #T))
  102.  
  103. (define-rule statement
  104.   ;; load a Scheme constant
  105.   (ASSIGN (REGISTER (? target)) (CONSTANT (? source)))
  106.   (load-constant (standard-target! target) source #T #T))
  107.  
  108. (define-rule statement
  109.   ;; load the type part of a Scheme constant
  110.   (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (CONSTANT (? constant))))
  111.   (load-immediate (standard-target! target)
  112.           (make-non-pointer-literal 0 (object-type constant))
  113.           #T))
  114.  
  115. (define-rule statement
  116.   ;; load the datum part of a Scheme constant
  117.   (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (CONSTANT (? constant))))
  118.   (QUALIFIER (non-pointer-object? constant))
  119.   (load-immediate (standard-target! target)
  120.           (make-non-pointer-literal 0 (careful-object-datum constant))
  121.           #T))
  122.  
  123. (define-rule statement
  124.   ;; load a synthesized constant
  125.   (ASSIGN (REGISTER (? target))
  126.       (CONS-NON-POINTER (MACHINE-CONSTANT (? type))
  127.                 (MACHINE-CONSTANT (? datum))))
  128.   (load-immediate (standard-target! target)
  129.           (make-non-pointer-literal type datum)
  130.           #T))
  131.  
  132. (define-rule statement
  133.   ;; load the address of a variable reference cache
  134.   (ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name)))
  135.   (load-pc-relative (standard-target! target)
  136.             'CONSTANT
  137.             (free-reference-label name)
  138.             true))
  139.  
  140. (define-rule statement
  141.   ;; load the address of an assignment cache
  142.   (ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name)))
  143.   (load-pc-relative (standard-target! target)
  144.             'CONSTANT
  145.             (free-assignment-label name)
  146.             true))
  147.  
  148. (define-rule statement
  149.   ;; load the address of a procedure's entry point
  150.   (ASSIGN (REGISTER (? target)) (ENTRY:PROCEDURE (? label)))
  151.   (load-pc-relative-address (standard-target! target) 'CODE label))
  152.  
  153. (define-rule statement
  154.   ;; load the address of a continuation
  155.   (ASSIGN (REGISTER (? target)) (ENTRY:CONTINUATION (? label)))
  156.   (load-pc-relative-address (standard-target! target) 'CODE label))
  157.  
  158. (define-rule statement
  159.   ;; load a procedure object
  160.   (ASSIGN (REGISTER (? target))
  161.       (CONS-POINTER (MACHINE-CONSTANT (? type))
  162.             (ENTRY:PROCEDURE (? label))))
  163.   (load-entry target type label))
  164.  
  165. (define-rule statement
  166.   ;; load a return address object
  167.   (ASSIGN (REGISTER (? target))
  168.       (CONS-POINTER (MACHINE-CONSTANT (? type))
  169.             (ENTRY:CONTINUATION (? label))))
  170.   (load-entry target type label))
  171.  
  172. (define (load-entry target type label)
  173.   (let ((temporary (standard-temporary!))
  174.     (target (standard-target! target)))
  175.     ;; Loading the address into a temporary makes it more useful,
  176.     ;; because it can be reused later.
  177.     (LAP ,@(load-pc-relative-address temporary 'CODE label)
  178.      (ADDI ,target ,temporary 0)
  179.      ,@(deposit-type type target))))
  180.  
  181. ;;;; Transfers from memory
  182.  
  183. (define-rule statement
  184.   (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset)))
  185.   (standard-unary-conversion address target
  186.     (lambda (address target)
  187.       (LAP (LD ,target (OFFSET ,(* 4 offset) ,address))
  188.        (NOP)))))
  189.  
  190. (define-rule statement
  191.   (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 17) 1))
  192.   (LAP (LD ,(standard-target! target) (OFFSET 0 ,regnum:stack-pointer))
  193.        (ADDI ,regnum:stack-pointer ,regnum:stack-pointer 4)))
  194.  
  195. ;;;; Transfers to memory
  196.  
  197. (define-rule statement
  198.   ;; store an object in memory
  199.   (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
  200.       (? source register-expression))
  201.   (QUALIFIER (word-register? source))
  202.   (LAP (ST ,(standard-source! source)
  203.        (OFFSET ,(* 4 offset) ,(standard-source! address)))))
  204.  
  205. (define-rule statement
  206.   ;; Push an object register on the heap
  207.   (ASSIGN (POST-INCREMENT (REGISTER 19) 1)
  208.       (? source register-expression))
  209.   (QUALIFIER (word-register? source))
  210.   (LAP (ST ,(standard-source! source) (OFFSET 0 ,regnum:free))
  211.        (ADDI ,regnum:free ,regnum:free 4)))
  212.  
  213. (define-rule statement
  214.   ;; Push an object register on the stack
  215.   (ASSIGN (PRE-INCREMENT (REGISTER 17) -1)
  216.       (? source register-expression))
  217.   (QUALIFIER (word-register? source))
  218.   (LAP (ADDI ,regnum:stack-pointer ,regnum:stack-pointer -4)
  219.        (ST ,(standard-source! source)
  220.        (OFFSET 0 ,regnum:stack-pointer))))
  221.  
  222. ;; Cheaper, common patterns.
  223.  
  224. (define-rule statement
  225.   (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
  226.       (MACHINE-CONSTANT 0))
  227.   (LAP (ST 0 (OFFSET ,(* 4 offset) ,(standard-source! address)))))
  228.  
  229. (define-rule statement
  230.   ; Push NIL (or whatever is represented by a machine 0) on heap
  231.   (ASSIGN (POST-INCREMENT (REGISTER 19) 1) (MACHINE-CONSTANT 0))
  232.   (LAP (ST 0 (OFFSET 0 ,regnum:free))
  233.        (ADDI ,regnum:free ,regnum:free 4)))
  234.  
  235. (define-rule statement
  236.   ; Ditto, but on stack
  237.   (ASSIGN (PRE-INCREMENT (REGISTER 17) -1) (MACHINE-CONSTANT 0))
  238.   (LAP (ADDI ,regnum:stack-pointer ,regnum:stack-pointer -4)
  239.        (ST 0 (OFFSET 0 ,regnum:stack-pointer))))
  240.  
  241. ;;;; CHAR->ASCII/BYTE-OFFSET
  242.  
  243. (define-rule statement
  244.   ;; load char object from memory and convert to ASCII byte
  245.   (ASSIGN (REGISTER (? target))
  246.       (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
  247.   (standard-unary-conversion address target
  248.     (lambda (address target)
  249.       (LAP (LDUB ,target
  250.         (OFFSET ,(let ((offset (* 4 offset)))
  251.                (if (eq? endianness 'LITTLE)
  252.                    offset
  253.                    (+ offset 3)))
  254.             ,address))
  255.        (NOP)))))
  256.  
  257. (define-rule statement
  258.   ;; load ASCII byte from memory
  259.   (ASSIGN (REGISTER (? target))
  260.       (BYTE-OFFSET (REGISTER (? address)) (? offset)))
  261.   (standard-unary-conversion address target
  262.     (lambda (address target)
  263.       (LAP (LDUB ,target (OFFSET ,offset ,address))
  264.        (NOP)))))
  265.  
  266. (define-rule statement
  267.   ;; convert char object to ASCII byte
  268.   ;; Missing optimization: If source is home and this is the last
  269.   ;; reference (it is dead afterwards), an LB could be done instead of
  270.   ;; an LW followed by an ANDI.  This is unlikely since the value will
  271.   ;; be home only if we've spilled it, which happens rarely.
  272.   (ASSIGN (REGISTER (? target))
  273.       (CHAR->ASCII (REGISTER (? source))))
  274.   (standard-unary-conversion source target
  275.     (lambda (source target)
  276.       (LAP (ANDI ,target ,source #xFF)))))
  277.  
  278. (define-rule statement
  279.   ;; store null byte in memory
  280.   (ASSIGN (BYTE-OFFSET (REGISTER (? source)) (? offset))
  281.       (CHAR->ASCII (CONSTANT #\NUL)))
  282.   (LAP (STB 0 (OFFSET ,offset ,(standard-source! source)))))
  283.  
  284. (define-rule statement
  285.   ;; store ASCII byte in memory
  286.   (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
  287.       (REGISTER (? source)))
  288.   (LAP (STB ,(standard-source! source)
  289.        (OFFSET ,offset ,(standard-source! address)))))
  290.  
  291. (define-rule statement
  292.   ;; convert char object to ASCII byte and store it in memory
  293.   ;; register + byte offset <- contents of register (clear top bits)
  294.   (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
  295.       (CHAR->ASCII (REGISTER (? source))))
  296.   (LAP (STB ,(standard-source! source)
  297.        (OFFSET ,offset ,(standard-source! address)))))