Changeset 15339
- Timestamp:
- Apr 21, 2012, 4:07:02 AM (13 years ago)
- File:
-
- 1 edited
-
trunk/source/level-0/ARM/arm-def.lisp (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-0/ARM/arm-def.lisp
r15093 r15339 328 328 (nargs (ash (the fixnum (1- len)) -1))) 329 329 (declare (fixnum nargs)) 330 (if (and (arm-hard-float-p) 331 (or (eq result-spec :double-float) 332 (eq result-spec :single-float) 333 (let* ((specs specs-and-vals)) 334 (dotimes (i nargs) 335 (let* ((spec (car specs))) 336 (when (or (eq spec :double-float) 337 (eq spec :single-float)) 338 (return t))))))) 339 (%ff-call-hard-float entry specs-and-vals) 340 341 (ecase result-spec 342 ((:address :unsigned-doubleword :signed-doubleword 343 :single-float :double-float 344 :signed-fullword :unsigned-fullword 345 :signed-halfword :unsigned-halfword 346 :signed-byte :unsigned-byte 347 :void) 348 (do* ((i 0 (1+ i)) 349 (specs specs-and-vals (cddr specs)) 350 (spec (car specs) (car specs))) 351 ((= i nargs)) 352 (declare (fixnum i)) 353 (case spec 354 ((:address :single-float 355 :signed-fullword :unsigned-fullword 356 :signed-halfword :unsigned-halfword 357 :signed-byte :unsigned-byte) 358 (incf total-words)) 359 ((:double-float :unsigned-doubleword :signed-doubleword) 360 #-darwin-target 361 (setq total-words (+ total-words (logand total-words 1))) 362 (incf total-words 2)) 363 364 (t (if (typep spec 'unsigned-byte) 365 (incf total-words spec) 366 (error "unknown arg spec ~s" spec))))) 367 ;; It's necessary to ensure that the C frame is the youngest thing on 368 ;; the foreign stack here. 369 (let* ((tag (cons nil nil))) 370 (declare (dynamic-extent tag)) 371 (%stack-block ((result 8)) 372 (catch tag 373 (with-macptrs ((argptr)) 374 (with-variable-c-frame 375 total-words frame 376 (%setf-macptr-to-object argptr frame) 377 (let* ((arg-offset 8)) 378 (declare (fixnum arg-offset)) 379 (do* ((i 0 (1+ i)) 380 (specs specs-and-vals (cddr specs)) 381 (spec (car specs) (car specs)) 382 (val (cadr specs) (cadr specs))) 383 ((= i nargs)) 384 (declare (fixnum i)) 385 (case spec 386 (:address 387 (setf (%get-ptr argptr arg-offset) val) 388 (incf arg-offset 4)) 389 (:signed-doubleword 390 #-darwin-target 391 (when (logtest 7 arg-offset) 392 (incf arg-offset 4)) 393 (setf (%%get-signed-longlong argptr arg-offset) val) 394 (incf arg-offset 8)) 395 ((:signed-fullword :signed-halfword :signed-byte) 396 (setf (%get-signed-long argptr arg-offset) val) 397 (incf arg-offset 4)) 398 (:unsigned-doubleword 399 #-darwin-target 400 (when (logtest 7 arg-offset) 401 (incf arg-offset 4)) 402 (setf (%%get-unsigned-longlong argptr arg-offset) val) 403 (incf arg-offset 8)) 404 ((:unsigned-fullword :unsigned-halfword :unsigned-byte) 405 (setf (%get-unsigned-long argptr arg-offset) val) 406 (incf arg-offset 4)) 407 (:double-float 408 #-darwin-target 409 (when (logtest 7 arg-offset) 410 (incf arg-offset 4)) 411 (setf (%get-double-float argptr arg-offset) val) 412 (incf arg-offset 8)) 413 (:single-float 414 (setf (%get-single-float argptr arg-offset) val) 415 (incf arg-offset 4)) 416 (t 417 (let* ((p 0)) 418 (declare (fixnum p)) 419 (dotimes (i (the fixnum spec)) 420 (setf (%get-ptr argptr arg-offset) (%get-ptr val p)) 421 (incf p 4) 422 (incf arg-offset 4))))))) 423 (%do-ff-call tag result entry)))) 424 (ecase result-spec 425 (:void nil) 426 (:address (%get-ptr result 0)) 427 (:unsigned-byte (%get-unsigned-byte result 0)) 428 (:signed-byte (%get-signed-byte result 0)) 429 (:unsigned-halfword (%get-unsigned-word result 0)) 430 (:signed-halfword (%get-signed-word result 0)) 431 (:unsigned-fullword (%get-unsigned-long result 0)) 432 (:signed-fullword (%get-signed-long result 0)) 433 (:unsigned-doubleword (%%get-unsigned-longlong result 0)) 434 (:signed-doubleword (%%get-signed-longlong result 0)) 435 (:single-float (%get-single-float result 0)) 436 (:double-float (%get-double-float result 0))))))))))) 437 438 439 (defarmlapfunction %do-ff-call-hard-float ((tag arg_x) (result arg_y) (entry arg_z)) 440 (stmdb (:! vsp) (tag result)) 441 (sploadlr .SPeabi-ff-callhf) 442 (blx lr) 443 (ldmia (:! vsp) (tag result)) 444 (macptr-ptr imm2 result) 445 (str imm0 (:@ imm2 (:$ 0))) 446 (str imm1 (:@ imm2 (:$ 4))) 447 (fstd d0 (:@ imm2 (:$ 8))) 448 (vpush1 tag) 449 (mov arg_z 'nil) 450 (vpush1 arg_z) 451 (set-nargs 1) 452 (sploadlr .SPthrow) 453 (blx lr)) 454 455 (defun %ff-call-hard-float (entry specs-and-vals) 456 (let* ((len (length specs-and-vals)) 457 (total-words 0) 458 (fp-words 16)) 459 (declare (fixnum len total-words fp-words)) 460 (let* ((result-spec (or (car (last specs-and-vals)) :void)) 461 (nargs (ash (the fixnum (1- len)) -1))) 462 (declare (fixnum nargs)) 330 463 (ecase result-spec 331 464 ((:address :unsigned-doubleword :signed-doubleword … … 341 474 (declare (fixnum i)) 342 475 (case spec 343 ((:address :single-float 344 :signed-fullword :unsigned-fullword 476 ((:address :signed-fullword :unsigned-fullword 345 477 :signed-halfword :unsigned-halfword 346 478 :signed-byte :unsigned-byte) 347 479 (incf total-words)) 348 ((:double-float :unsigned-doubleword :signed-doubleword) 349 #-darwin-target 480 (:single-float 481 (if (> fp-words 0) 482 (decf fp-words) 483 (incf total-words))) 484 (:double-float 485 (if (>= fp-words 2) 486 (if (oddp fp-words) 487 (decf fp-words 3) 488 (decf fp-words 2)) 489 (if (oddp total-words) 490 (incf total-words 3) 491 (incf total-words 2)))) 492 ((:unsigned-doubleword :signed-doubleword) 350 493 (setq total-words (+ total-words (logand total-words 1))) 351 494 (incf total-words 2)) … … 358 501 (let* ((tag (cons nil nil))) 359 502 (declare (dynamic-extent tag)) 360 (%stack-block ((result 8))503 (%stack-block ((result 16)) 361 504 (catch tag 362 505 (with-macptrs ((argptr)) 363 506 (with-variable-c-frame 364 total-wordsframe507 (+ total-words 16) frame 365 508 (%setf-macptr-to-object argptr frame) 366 (let* ((arg-offset 8)) 367 (declare (fixnum arg-offset)) 509 (let* ((fp-arg-offset 8) 510 (arg-offset 72)) 511 (declare (fixnum arg-offset fp-arg-offset)) 368 512 (do* ((i 0 (1+ i)) 369 513 (specs specs-and-vals (cddr specs)) … … 377 521 (incf arg-offset 4)) 378 522 (:signed-doubleword 379 #-darwin-target380 523 (when (logtest 7 arg-offset) 381 524 (incf arg-offset 4)) … … 386 529 (incf arg-offset 4)) 387 530 (:unsigned-doubleword 388 #-darwin-target389 531 (when (logtest 7 arg-offset) 390 532 (incf arg-offset 4)) … … 395 537 (incf arg-offset 4)) 396 538 (:double-float 397 #-darwin-target 398 (when (logtest 7 arg-offset) 399 (incf arg-offset 4)) 400 (setf (%get-double-float argptr arg-offset) val) 401 (incf arg-offset 8)) 539 (cond ((<= fp-arg-offset 64) 540 (when (logtest 7 fp-arg-offset) 541 (incf fp-arg-offset 4)) 542 (setf (%get-double-float argptr fp-arg-offset) val) 543 (incf fp-arg-offset 8)) 544 (t 545 (when (logtest 7 arg-offset) 546 (incf arg-offset 4)) 547 (setf (%get-double-float argptr arg-offset) val) 548 (incf arg-offset 8)))) 402 549 (:single-float 403 (setf (%get-single-float argptr arg-offset) val) 404 (incf arg-offset 4)) 550 (cond ((< fp-arg-offset 72) 551 (incf fp-arg-offset 4) 552 (setf (%get-single-float argptr fp-arg-offset) val) 553 (incf fp-arg-offset 4)) 554 (t 555 (setf (%get-single-float argptr arg-offset) val) 556 (incf arg-offset 4)))) 405 557 (t 406 558 (let* ((p 0)) … … 410 562 (incf p 4) 411 563 (incf arg-offset 4))))))) 412 (%do-ff-call tag result entry))))564 (%do-ff-call-hard-float tag result entry)))) 413 565 (ecase result-spec 414 566 (:void nil) … … 422 574 (:unsigned-doubleword (%%get-unsigned-longlong result 0)) 423 575 (:signed-doubleword (%%get-signed-longlong result 0)) 424 (:single-float (%get-single-float result 0))425 (:double-float (%get-double-float result 0))))))))))576 (:single-float (%get-single-float result 8)) 577 (:double-float (%get-double-float result 8)))))))))) 426 578 427 579 … … 583 735 (bx lr)) 584 736 737 (defarmlapfunction arm-hard-float-p () 738 (check-nargs 0) 739 (ref-global arg_z arm::float-abi) 740 (tst arg_z arg_z) 741 (mov arg_z 'nil) 742 (addne arg_z arg_z (:$ arm::t-offset)) 743 (bx lr)) 744 585 745 ;;; end of arm-def.lisp
Note:
See TracChangeset
for help on using the changeset viewer.
