1#| -*-Scheme-*- 2 3Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts 6 Institute of Technology 7 8This file is part of MIT/GNU Scheme. 9 10MIT/GNU Scheme is free software; you can redistribute it and/or modify 11it under the terms of the GNU General Public License as published by 12the Free Software Foundation; either version 2 of the License, or (at 13your option) any later version. 14 15MIT/GNU Scheme is distributed in the hope that it will be useful, but 16WITHOUT ANY WARRANTY; without even the implied warranty of 17MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18General Public License for more details. 19 20You should have received a copy of the GNU General Public License 21along with MIT/GNU Scheme; if not, write to the Free Software 22Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 23USA. 24 25|# 26 27;;;; LAP Generation Rules: Data Transfers. 28;;; package: (compiler lap-syntaxer) 29 30(declare (usual-integrations)) 31 32;;;; Register Assignments 33 34;;; All assignments to pseudo registers are required to delete the 35;;; dead registers BEFORE performing the assignment. However, it is 36;;; necessary to derive the effective address of the source 37;;; expression(s) before deleting the dead registers. Otherwise any 38;;; source expression containing dead registers might refer to aliases 39;;; which have been reused. 40 41(define-rule statement 42 (ASSIGN (REGISTER (? target)) (REGISTER (? source))) 43 (assign-register->register target source)) 44 45(define-rule statement 46 (ASSIGN (REGISTER (? target)) 47 (OFFSET-ADDRESS (REGISTER (? source)) 48 (REGISTER (? index)))) 49 (load-indexed-register target source index 4)) 50 51(define-rule statement 52 (ASSIGN (REGISTER (? target)) 53 (OFFSET-ADDRESS (REGISTER (? source)) 54 (MACHINE-CONSTANT (? n)))) 55 (load-displaced-register target source (* 4 n))) 56 57(define-rule statement 58 (ASSIGN (REGISTER (? target)) 59 (BYTE-OFFSET-ADDRESS (REGISTER (? source)) 60 (REGISTER (? index)))) 61 (load-indexed-register target source index 1)) 62 63(define-rule statement 64 (ASSIGN (REGISTER (? target)) 65 (BYTE-OFFSET-ADDRESS (REGISTER (? source)) 66 (MACHINE-CONSTANT (? n)))) 67 (load-displaced-register target source n)) 68 69(define-rule statement 70 (ASSIGN (REGISTER (? target)) 71 (FLOAT-OFFSET-ADDRESS (REGISTER (? source)) 72 (REGISTER (? index)))) 73 (load-indexed-register target source index 8)) 74 75(define-rule statement 76 (ASSIGN (REGISTER (? target)) 77 (FLOAT-OFFSET-ADDRESS (REGISTER (? source)) 78 (MACHINE-CONSTANT (? n)))) 79 (load-displaced-register target source (* 8 n))) 80 81(define-rule statement 82 ;; This is an intermediate rule -- not intended to produce code. 83 (ASSIGN (REGISTER (? target)) 84 (CONS-POINTER (MACHINE-CONSTANT (? type)) 85 (OFFSET-ADDRESS (REGISTER (? source)) 86 (MACHINE-CONSTANT (? n))))) 87 (load-displaced-register/typed target source type (* 4 n))) 88 89(define-rule statement 90 (ASSIGN (REGISTER (? target)) 91 (CONS-POINTER (MACHINE-CONSTANT (? type)) 92 (BYTE-OFFSET-ADDRESS (REGISTER (? source)) 93 (MACHINE-CONSTANT (? n))))) 94 (load-displaced-register/typed target source type n)) 95 96(define-rule statement 97 (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source)))) 98 (object->type (standard-move-to-target! source target))) 99 100(define-rule statement 101 (ASSIGN (REGISTER (? target)) 102 (CONS-POINTER (REGISTER (? type)) (REGISTER (? datum)))) 103 (let ((temp (standard-move-to-temporary! type))) 104 (LAP (ROR W ,temp (&U ,scheme-type-width)) 105 (OR W ,(standard-move-to-target! datum target) ,temp)))) 106 107(define-rule statement 108 (ASSIGN (REGISTER (? target)) 109 (CONS-POINTER (MACHINE-CONSTANT (? type)) (REGISTER (? datum)))) 110 (if (zero? type) 111 (assign-register->register target datum) 112 (let ((literal (make-non-pointer-literal type 0))) 113 (define (three-arg source) 114 (let ((target (target-register-reference target))) 115 (LAP (LEA ,target (@RO UW ,source ,literal))))) 116 117 (define (two-arg target) 118 (LAP (OR W ,target (&U ,literal)))) 119 120 (let ((alias (register-alias datum 'GENERAL))) 121 (cond ((not alias) 122 (two-arg (standard-move-to-target! datum target))) 123 ((register-copy-if-available datum 'GENERAL target) 124 => 125 (lambda (get-tgt) 126 (two-arg (get-tgt)))) 127 (else 128 (three-arg alias))))))) 129 130(define-rule statement 131 (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (REGISTER (? source)))) 132 (object->datum (standard-move-to-target! source target))) 133 134(define-rule statement 135 (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source)))) 136 (object->address (standard-move-to-target! source target))) 137 138;;;; Loading Constants 139 140(define-rule statement 141 (ASSIGN (REGISTER (? target)) (CONSTANT (? source))) 142 (load-constant (target-register-reference target) source)) 143 144(define-rule statement 145 (ASSIGN (REGISTER (? target)) (MACHINE-CONSTANT (? n))) 146 (load-immediate (target-register-reference target) n)) 147 148(define-rule statement 149 (ASSIGN (REGISTER (? target)) 150 (CONS-POINTER (MACHINE-CONSTANT (? type)) 151 (MACHINE-CONSTANT (? datum)))) 152 (load-non-pointer (target-register-reference target) type datum)) 153 154(define-rule statement 155 (ASSIGN (REGISTER (? target)) (ENTRY:PROCEDURE (? label))) 156 (load-pc-relative-address 157 (target-register-reference target) 158 (rtl-procedure/external-label (label->object label)))) 159 160(define-rule statement 161 (ASSIGN (REGISTER (? target)) (ENTRY:CONTINUATION (? label))) 162 (load-pc-relative-address (target-register-reference target) label)) 163 164(define-rule statement 165 ;; This is an intermediate rule -- not intended to produce code. 166 (ASSIGN (REGISTER (? target)) 167 (CONS-POINTER (MACHINE-CONSTANT (? type)) 168 (ENTRY:PROCEDURE (? label)))) 169 (load-pc-relative-address/typed (target-register-reference target) 170 type 171 (rtl-procedure/external-label 172 (label->object label)))) 173 174(define-rule statement 175 ;; This is an intermediate rule -- not intended to produce code. 176 (ASSIGN (REGISTER (? target)) 177 (CONS-POINTER (MACHINE-CONSTANT (? type)) 178 (ENTRY:CONTINUATION (? label)))) 179 (load-pc-relative-address/typed (target-register-reference target) 180 type label)) 181 182(define-rule statement 183 (ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name))) 184 (load-pc-relative (target-register-reference target) 185 (free-reference-label name))) 186 187(define-rule statement 188 (ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name))) 189 (load-pc-relative (target-register-reference target) 190 (free-assignment-label name))) 191 192(define-rule statement 193 (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (CONSTANT (? constant)))) 194 (convert-object/constant->register target constant object->datum)) 195 196(define-rule statement 197 (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (CONSTANT (? constant)))) 198 (convert-object/constant->register target constant object->address)) 199 200;;;; Transfers from Memory 201 202(define-rule statement 203 (ASSIGN (REGISTER (? target)) (? expression rtl:simple-offset?)) 204 (let ((source (offset->reference! expression))) 205 (LAP (MOV W ,(target-register-reference target) ,source)))) 206 207(define-rule statement 208 (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 4) 1)) 209 (LAP (POP ,(target-register-reference target)))) 210 211;;;; Transfers to Memory 212 213(define-rule statement 214 (ASSIGN (? expression rtl:simple-offset?) (REGISTER (? r))) 215 (QUALIFIER (register-value-class=word? r)) 216 (let ((source (source-register-reference r))) 217 (LAP (MOV W 218 ,(offset->reference! expression) 219 ,source)))) 220 221(define-rule statement 222 (ASSIGN (? expression rtl:simple-offset?) (CONSTANT (? value))) 223 (QUALIFIER (non-pointer-object? value)) 224 (LAP (MOV W ,(offset->reference! expression) 225 (&U ,(non-pointer->literal value))))) 226 227(define-rule statement 228 (ASSIGN (? expression rtl:simple-offset?) 229 (CONS-POINTER (MACHINE-CONSTANT (? type)) 230 (MACHINE-CONSTANT (? datum)))) 231 (LAP (MOV W ,(offset->reference! expression) 232 (&U ,(make-non-pointer-literal type datum))))) 233 234(define-rule statement 235 (ASSIGN (? expression rtl:simple-offset?) 236 (BYTE-OFFSET-ADDRESS (? expression) 237 (MACHINE-CONSTANT (? n)))) 238 (if (zero? n) 239 (LAP) 240 (LAP (ADD W ,(offset->reference! expression) (& ,n))))) 241 242;;;; Consing 243 244(define-rule statement 245 (ASSIGN (POST-INCREMENT (REGISTER 7) 1) (REGISTER (? r))) 246 (QUALIFIER (register-value-class=word? r)) 247 (LAP (MOV W (@R 7) ,(source-register-reference r)) 248 (ADD W (R 7) (& 4)))) 249 250;;;; Pushes 251 252(define-rule statement 253 (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) (REGISTER (? r))) 254 (QUALIFIER (register-value-class=word? r)) 255 (LAP (PUSH ,(source-register-reference r)))) 256 257(define-rule statement 258 (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) (CONSTANT (? value))) 259 (QUALIFIER (non-pointer-object? value)) 260 (LAP (PUSH W (&U ,(non-pointer->literal value))))) 261 262(define-rule statement 263 (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) 264 (CONS-POINTER (MACHINE-CONSTANT (? type)) 265 (MACHINE-CONSTANT (? datum)))) 266 (LAP (PUSH W (&U ,(make-non-pointer-literal type datum))))) 267 268;;;; CHAR->ASCII/BYTE-OFFSET 269 270(define-rule statement 271 (ASSIGN (REGISTER (? target)) 272 (CHAR->ASCII (? expression rtl:simple-offset?))) 273 (load-char-into-register 0 274 (offset->reference! expression) 275 target)) 276 277(define-rule statement 278 (ASSIGN (REGISTER (? target)) 279 (CHAR->ASCII (REGISTER (? source)))) 280 (load-char-into-register 0 281 (source-register-reference source) 282 target)) 283 284(define-rule statement 285 (ASSIGN (REGISTER (? target)) (? expression rtl:simple-byte-offset?)) 286 (load-char-into-register 0 287 (byte-offset->reference! expression) 288 target)) 289 290(define-rule statement 291 (ASSIGN (REGISTER (? target)) 292 (CONS-POINTER (MACHINE-CONSTANT (? type)) 293 (? expression rtl:simple-byte-offset?))) 294 (load-char-into-register type 295 (byte-offset->reference! expression) 296 target)) 297 298(define-rule statement 299 (ASSIGN (? expression rtl:simple-byte-offset?) 300 (CHAR->ASCII (CONSTANT (? character)))) 301 (LAP (MOV B 302 ,(byte-offset->reference! expression) 303 (& ,(char->signed-8-bit-immediate character))))) 304 305(define-rule statement 306 (ASSIGN (? expression rtl:simple-byte-offset?) 307 (REGISTER (? source))) 308 (let* ((source (source-register-reference source)) 309 (target (byte-offset->reference! expression))) 310 (LAP (MOV B ,target ,source)))) 311 312(define-rule statement 313 (ASSIGN (? expression rtl:simple-byte-offset?) 314 (CHAR->ASCII (REGISTER (? source)))) 315 (let ((source (source-register-reference source)) 316 (target (byte-offset->reference! expression))) 317 (LAP (MOV B ,target ,source)))) 318 319(define (char->signed-8-bit-immediate character) 320 (let ((ascii (char->ascii character))) 321 (if (< ascii 128) ascii (- ascii 256)))) 322 323;;;; Utilities specific to rules1 324 325(define (load-displaced-register/internal target source n signed?) 326 (cond ((zero? n) 327 (assign-register->register target source)) 328 ((and (= target source) 329 (= target esp)) 330 (if signed? 331 (LAP (ADD W (R ,esp) (& ,n))) 332 (LAP (ADD W (R ,esp) (&U ,n))))) 333 (signed? 334 (let* ((source (indirect-byte-reference! source n)) 335 (target (target-register-reference target))) 336 (LAP (LEA ,target ,source)))) 337 (else 338 (let* ((source (indirect-unsigned-byte-reference! source n)) 339 (target (target-register-reference target))) 340 (LAP (LEA ,target ,source)))))) 341 342(define-integrable (load-displaced-register target source n) 343 (load-displaced-register/internal target source n true)) 344 345(define-integrable (load-displaced-register/typed target source type n) 346 (load-displaced-register/internal target 347 source 348 (if (zero? type) 349 n 350 (+ (make-non-pointer-literal type 0) 351 n)) 352 false)) 353 354(define (load-indexed-register target source index scale) 355 (let* ((source (indexed-ea source index scale 0)) 356 (target (target-register-reference target))) 357 (LAP (LEA ,target ,source)))) 358 359(define (load-pc-relative-address/typed target type label) 360 (with-pc 361 (lambda (pc-label pc-register) 362 (LAP (LEA ,target (@RO UW 363 ,pc-register 364 (+ ,(make-non-pointer-literal type 0) 365 (- ,label ,pc-label)))))))) 366 367(define (load-char-into-register type source target) 368 (let ((target (target-register-reference target))) 369 (cond ((zero? type) 370 ;; No faster, but smaller 371 (LAP (MOVZX B ,target ,source))) 372 (else 373 (LAP ,@(load-non-pointer target type 0) 374 (MOV B ,target ,source)))))) 375 376(define (indirect-unsigned-byte-reference! register offset) 377 (byte-unsigned-offset-reference (allocate-indirection-register! register) 378 offset)) 379 380;;;; Improved vector and string references 381 382(define-rule statement 383 (ASSIGN (REGISTER (? target)) 384 (? expression rtl:detagged-offset?)) 385 (with-detagged-vector-location expression false 386 (lambda (temp) 387 (LAP (MOV W ,(target-register-reference target) ,temp))))) 388 389(define-rule statement 390 (ASSIGN (? expression rtl:detagged-offset?) 391 (REGISTER (? source))) 392 (QUALIFIER (register-value-class=word? source)) 393 (with-detagged-vector-location expression source 394 (lambda (temp) 395 (LAP (MOV W ,temp ,(source-register-reference source)))))) 396 397(define (with-detagged-vector-location rtl-expression protect recvr) 398 (with-decoded-detagged-offset rtl-expression 399 (lambda (base index offset) 400 (with-indexed-address base index 4 (* 4 offset) protect recvr)))) 401 402(define (rtl:detagged-offset? expression) 403 (and (rtl:offset? expression) 404 (rtl:machine-constant? (rtl:offset-offset expression)) 405 (let ((base (rtl:offset-base expression))) 406 (and (rtl:offset-address? base) 407 (rtl:detagged-index? (rtl:offset-address-base base) 408 (rtl:offset-address-offset base)))) 409 expression)) 410 411(define (with-decoded-detagged-offset expression recvr) 412 (let ((base (rtl:offset-base expression))) 413 (let ((base* (rtl:offset-address-base base)) 414 (index (rtl:offset-address-offset base))) 415 (recvr (rtl:register-number (if (rtl:register? base*) 416 base* 417 (rtl:object->address-expression base*))) 418 (rtl:register-number (if (rtl:register? index) 419 index 420 (rtl:object->datum-expression index))) 421 (rtl:machine-constant-value (rtl:offset-offset expression)))))) 422 423;;;; Improved string references 424 425(define-rule statement 426 (ASSIGN (REGISTER (? target)) (? expression rtl:detagged-byte-offset?)) 427 (load-char-indexed/detag 0 target expression)) 428 429(define-rule statement 430 (ASSIGN (REGISTER (? target)) 431 (CONS-POINTER (MACHINE-CONSTANT (? type)) 432 (? expression rtl:detagged-byte-offset?))) 433 (load-char-indexed/detag type target expression)) 434 435(define-rule statement 436 (ASSIGN (? expression rtl:detagged-byte-offset?) 437 (REGISTER (? source))) 438 (store-char-indexed/detag expression 439 source 440 (source-register-reference source))) 441 442(define-rule statement 443 (ASSIGN (? expression rtl:detagged-byte-offset?) 444 (CHAR->ASCII (REGISTER (? source)))) 445 (store-char-indexed/detag expression 446 source 447 (source-register-reference source))) 448 449(define-rule statement 450 (ASSIGN (? expression rtl:detagged-byte-offset?) 451 (CHAR->ASCII (CONSTANT (? character)))) 452 (store-char-indexed/detag expression 453 false 454 (INST-EA (& ,(char->signed-8-bit-immediate 455 character))))) 456 457(define (load-char-indexed/detag tag target rtl-source-expression) 458 (with-detagged-string-location rtl-source-expression false 459 (lambda (temp) 460 (load-char-into-register tag temp target)))) 461 462(define (store-char-indexed/detag rtl-target-expression protect source) 463 (with-detagged-string-location rtl-target-expression protect 464 (lambda (temp) 465 (LAP (MOV B ,temp ,source))))) 466 467(define (with-detagged-string-location rtl-expression protect recvr) 468 (with-decoded-detagged-byte-offset rtl-expression 469 (lambda (base index offset) 470 (with-indexed-address base index 1 offset protect recvr)))) 471 472(define (rtl:detagged-byte-offset? expression) 473 (and (rtl:byte-offset? expression) 474 (rtl:machine-constant? (rtl:byte-offset-offset expression)) 475 (let ((base (rtl:byte-offset-base expression))) 476 (and (rtl:byte-offset-address? base) 477 (rtl:detagged-index? (rtl:byte-offset-address-base base) 478 (rtl:byte-offset-address-offset base)))) 479 expression)) 480 481(define (with-decoded-detagged-byte-offset expression recvr) 482 (let ((base (rtl:byte-offset-base expression))) 483 (let ((base* (rtl:byte-offset-address-base base)) 484 (index (rtl:byte-offset-address-offset base))) 485 (recvr (rtl:register-number (if (rtl:register? base*) 486 base* 487 (rtl:object->address-expression base*))) 488 (rtl:register-number (if (rtl:register? index) 489 index 490 (rtl:object->datum-expression index))) 491 (rtl:machine-constant-value 492 (rtl:byte-offset-offset expression))))))