Changeset 5357
- Timestamp:
- Oct 17, 2006, 12:39:50 PM (18 years ago)
- Location:
- trunk/ccl
- Files:
-
- 2 edited
-
level-1/l1-streams.lisp (modified) (28 diffs)
-
lib/streams.lisp (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/level-1/l1-streams.lisp
r5354 r5357 3645 3645 (defmethod stream-read-char ((s basic-character-input-stream)) 3646 3646 (let* ((ioblock (basic-stream-ioblock s))) 3647 (funcall (ioblock-read-char-function ioblock) ioblock))) 3647 (declare (optimize (speed 3))) 3648 (without-interrupts 3649 (values 3650 (funcall (ioblock-read-char-function ioblock) ioblock))))) 3648 3651 3649 3652 … … 3651 3654 (let* ((ioblock (basic-stream-ioblock stream))) 3652 3655 (with-ioblock-input-locked (ioblock) 3653 (%ioblock-tyi-no-hang ioblock)))) 3656 (locally (declare (optimize (speed 3))) 3657 (without-interrupts 3658 (values 3659 (%ioblock-tyi-no-hang ioblock))))))) 3654 3660 3655 3661 (defmethod stream-peek-char ((stream basic-character-input-stream)) 3656 3662 (let* ((ioblock (basic-stream-ioblock stream))) 3657 3663 (with-ioblock-input-locked (ioblock) 3658 (%ioblock-peek-char ioblock)))) 3664 (locally (declare (optimize (speed 3))) 3665 (without-interrupts 3666 (values 3667 (%ioblock-peek-char ioblock))))))) 3659 3668 3660 3669 (defmethod stream-clear-input ((stream basic-character-input-stream)) 3661 3670 (let* ((ioblock (basic-stream-ioblock stream))) 3662 3671 (with-ioblock-input-locked (ioblock) 3663 (%ioblock-clear-input ioblock)))) 3672 (locally (declare (optimize (speed 3))) 3673 (without-interrupts 3674 (values 3675 (%ioblock-clear-input ioblock))))))) 3664 3676 3665 3677 (defmethod stream-unread-char ((s basic-character-input-stream) char) 3666 3678 (let* ((ioblock (basic-stream-ioblock s))) 3667 3679 (with-ioblock-input-locked (ioblock) 3668 (%ioblock-untyi ioblock char)))) 3680 (locally (declare (optimize (speed 3))) 3681 (without-interrupts 3682 (values 3683 (%ioblock-untyi ioblock char))))))) 3669 3684 3670 3685 (defmethod stream-read-ivector ((s basic-character-input-stream) … … 3672 3687 (let* ((ioblock (basic-stream-ioblock s))) 3673 3688 (with-ioblock-input-locked (ioblock) 3674 (%ioblock-character-in-ivect ioblock iv start nb)))) 3689 (locally (declare (optimize (speed 3))) 3690 (without-interrupts 3691 (values 3692 (%ioblock-character-in-ivect ioblock iv start nb))))))) 3675 3693 3676 3694 (defmethod stream-read-vector ((stream basic-character-input-stream) … … 3681 3699 (let* ((ioblock (basic-stream-ioblock stream))) 3682 3700 (with-ioblock-input-locked (ioblock) 3683 (funcall (ioblock-character-read-vector-function ioblock) 3684 ioblock vector start end))))) 3701 (locally (declare (optimize (speed 3))) 3702 (without-interrupts 3703 (values 3704 (funcall (ioblock-character-read-vector-function ioblock) 3705 ioblock vector start end)))))))) 3685 3706 3686 3707 (defmethod stream-read-line ((stream basic-character-input-stream)) 3687 3708 (let* ((ioblock (basic-stream-ioblock stream))) 3688 3709 (with-ioblock-input-locked (ioblock) 3689 (funcall (ioblock-read-line-function ioblock) ioblock)))) 3710 (locally (declare (optimize (speed 3))) 3711 (without-interrupts 3712 (values 3713 (funcall (ioblock-read-line-function ioblock) ioblock))))))) 3690 3714 3691 3715 … … 4387 4411 (let* ((ioblock (stream-ioblock stream nil))) 4388 4412 (when ioblock 4389 (%ioblock-close ioblock)))) 4413 (locally (declare (optimize (speed 3))) 4414 (without-interrupts 4415 (values 4416 (%ioblock-close ioblock))))))) 4390 4417 4391 4418 (defmethod close :before ((stream buffered-output-stream-mixin) &key abort) … … 4403 4430 (let* ((ioblock (basic-stream.state stream))) 4404 4431 (when ioblock 4405 (%ioblock-close ioblock)))) 4432 (locally (declare (optimize (speed 3))) 4433 (without-interrupts 4434 (values 4435 (%ioblock-close ioblock))))))) 4406 4436 4407 4437 … … 4458 4488 (defmethod stream-read-char ((stream buffered-character-input-stream-mixin)) 4459 4489 (let* ((ioblock (stream-ioblock stream t))) 4460 (funcall (ioblock-read-char-function ioblock) ioblock))) 4490 (locally (declare (optimize (speed 3))) 4491 (without-interrupts 4492 (values 4493 (funcall (ioblock-read-char-function ioblock) ioblock)))))) 4461 4494 4462 4495 (defmethod stream-read-char-no-hang ((stream buffered-character-input-stream-mixin)) 4463 4496 (with-stream-ioblock-input (ioblock stream :speedy t) 4464 (%ioblock-tyi-no-hang ioblock))) 4497 (locally (declare (optimize (speed 3))) 4498 (without-interrupts 4499 (values 4500 (%ioblock-tyi-no-hang ioblock)))))) 4465 4501 4466 4502 (defmethod stream-peek-char ((stream buffered-character-input-stream-mixin)) 4467 4503 (with-stream-ioblock-input (ioblock stream :speedy t) 4468 (%ioblock-peek-char ioblock))) 4504 (locally (declare (optimize (speed 3))) 4505 (without-interrupts 4506 (values 4507 (%ioblock-peek-char ioblock)))))) 4469 4508 4470 4509 (defmethod stream-clear-input ((stream buffered-input-stream-mixin)) 4471 4510 (with-stream-ioblock-input (ioblock stream :speedy t) 4472 (%ioblock-clear-input ioblock))) 4511 (locally (declare (optimize (speed 3))) 4512 (without-interrupts 4513 (values 4514 (%ioblock-clear-input ioblock)))))) 4473 4515 4474 4516 (defmethod stream-unread-char ((stream buffered-character-input-stream-mixin) char) … … 4479 4521 (defmethod stream-read-byte ((stream buffered-binary-input-stream-mixin)) 4480 4522 (with-stream-ioblock-input (ioblock stream :speedy t) 4481 (funcall (ioblock-read-byte-function ioblock) ioblock))) 4523 (locally (declare (optimize (speed 3))) 4524 (without-interrupts 4525 (values 4526 (funcall (ioblock-read-byte-function ioblock) ioblock)))))) 4482 4527 4483 4528 (defmethod stream-read-byte ((stream basic-binary-input-stream)) 4484 4529 (let* ((ioblock (basic-stream-ioblock stream))) 4485 4530 (with-ioblock-input-locked (ioblock) 4486 (funcall (ioblock-read-byte-function ioblock) ioblock)))) 4531 (locally (declare (optimize (speed 3))) 4532 (without-interrupts 4533 (values 4534 (funcall (ioblock-read-byte-function ioblock) ioblock))))))) 4487 4535 4488 4536 (defmethod stream-eofp ((stream buffered-input-stream-mixin)) 4489 4537 (with-stream-ioblock-input (ioblock stream :speedy t) 4490 (%ioblock-eofp ioblock))) 4538 (locally (declare (optimize (speed 3))) 4539 (without-interrupts 4540 (values 4541 (%ioblock-eofp ioblock)))))) 4491 4542 4492 4543 (defmethod stream-eofp ((stream basic-input-stream)) … … 4497 4548 (defmethod stream-listen ((stream buffered-input-stream-mixin)) 4498 4549 (with-stream-ioblock-input (ioblock stream :speedy t) 4499 (%ioblock-listen ioblock))) 4550 (locally (declare (optimize (speed 3))) 4551 (without-interrupts 4552 (values 4553 (%ioblock-listen ioblock)))))) 4500 4554 4501 4555 (defmethod stream-listen ((stream basic-input-stream)) 4502 4556 (let* ((ioblock (basic-stream-ioblock stream))) 4503 4557 (with-ioblock-input-locked (ioblock) 4504 ( %ioblock-listen ioblock))))4505 4506 (defun flush-ioblock (ioblock finish-p) 4507 (with-ioblock-output-locked (ioblock)4508 (%ioblock-force-output ioblock finish-p))) 4558 (locally (declare (optimize (speed 3))) 4559 (without-interrupts 4560 (values 4561 (%ioblock-listen ioblock))))))) 4562 4509 4563 4510 4564 (defmethod stream-write-byte ((stream buffered-binary-output-stream-mixin) 4511 4565 byte) 4512 4566 (let* ((ioblock (stream-ioblock stream t))) 4513 (funcall (ioblock-write-byte-function ioblock) ioblock byte))) 4567 (locally (declare (optimize (speed 3))) 4568 (without-interrupts 4569 (values 4570 (funcall (ioblock-write-byte-function ioblock) ioblock byte)))))) 4514 4571 4515 4572 (defmethod stream-write-byte ((stream basic-binary-output-stream) byte) 4516 4573 (let* ((ioblock (basic-stream-ioblock stream))) 4517 (funcall (ioblock-write-byte-function ioblock) ioblock byte))) 4574 (locally (declare (optimize (speed 3))) 4575 (without-interrupts 4576 (values 4577 (funcall (ioblock-write-byte-function ioblock) ioblock byte)))))) 4518 4578 4519 4579 (defmethod stream-write-char ((stream buffered-character-output-stream-mixin) char) 4520 4580 (let* ((ioblock (stream-ioblock stream t))) 4521 (funcall (ioblock-write-char-function ioblock) ioblock char))) 4581 (locally (declare (optimize (speed 3))) 4582 (without-interrupts 4583 (values 4584 (funcall (ioblock-write-char-function ioblock) ioblock char)))))) 4522 4585 4523 4586 (defmethod stream-write-char ((stream basic-character-output-stream) char) 4524 4587 (let* ((ioblock (basic-stream-ioblock stream))) 4525 (funcall (ioblock-write-char-function ioblock) ioblock char))) 4588 (locally (declare (optimize (speed 3))) 4589 (without-interrupts 4590 (values 4591 (funcall (ioblock-write-char-function ioblock) ioblock char)))))) 4526 4592 4527 4593 4528 4594 (defmethod stream-clear-output ((stream buffered-output-stream-mixin)) 4529 4595 (with-stream-ioblock-output (ioblock stream :speedy t) 4530 (%ioblock-clear-output ioblock)) 4596 (locally (declare (optimize (speed 3))) 4597 (without-interrupts 4598 (values 4599 (%ioblock-clear-output ioblock))))) 4531 4600 nil) 4532 4601 … … 4534 4603 (let* ((ioblock (basic-stream-ioblock stream))) 4535 4604 (with-ioblock-output-locked (ioblock) 4536 (%ioblock-clear-output ioblock)) 4605 (locally (declare (optimize (speed 3))) 4606 (without-interrupts 4607 (values 4608 (%ioblock-clear-output ioblock))))) 4537 4609 nil)) 4538 4610 … … 4559 4631 (defmethod stream-force-output ((stream buffered-output-stream-mixin)) 4560 4632 (with-stream-ioblock-output (ioblock stream :speedy t) 4561 (%ioblock-force-output ioblock nil) 4633 (locally (declare (optimize (speed 3))) 4634 (without-interrupts 4635 (values 4636 (%ioblock-force-output ioblock nil)))) 4562 4637 nil)) 4563 4638 … … 4565 4640 (let* ((ioblock (basic-stream-ioblock stream))) 4566 4641 (with-ioblock-output-locked (ioblock) 4567 (%ioblock-force-output ioblock nil) 4642 (locally (declare (optimize (speed 3))) 4643 (without-interrupts 4644 (values 4645 (%ioblock-force-output ioblock nil)))) 4568 4646 nil))) 4569 4647 4570 4648 (defmethod maybe-stream-force-output ((stream buffered-output-stream-mixin)) 4571 4649 (with-stream-ioblock-output-maybe (ioblock stream :speedy t) 4572 (%ioblock-force-output ioblock nil) 4650 (locally (declare (optimize (speed 3))) 4651 (without-interrupts 4652 (values 4653 (%ioblock-force-output ioblock nil)))) 4573 4654 nil)) 4574 4655 … … 4576 4657 (let* ((ioblock (basic-stream-ioblock stream))) 4577 4658 (with-ioblock-output-locked-maybe (ioblock) 4578 (%ioblock-force-output ioblock nil) 4659 (locally (declare (optimize (speed 3))) 4660 (without-interrupts 4661 (values 4662 (%ioblock-force-output ioblock nil)))) 4579 4663 nil))) 4580 4664 4581 4665 (defmethod stream-finish-output ((stream buffered-output-stream-mixin)) 4582 4666 (with-stream-ioblock-output (ioblock stream :speedy t) 4583 (%ioblock-force-output ioblock t) 4667 (locally (declare (optimize (speed 3))) 4668 (without-interrupts 4669 (values 4670 (%ioblock-force-output ioblock t)))) 4584 4671 nil)) 4585 4672 … … 4587 4674 (let* ((ioblock (basic-stream-ioblock stream))) 4588 4675 (with-ioblock-output-locked (ioblock) 4589 (%ioblock-force-output ioblock t) 4676 (locally (declare (optimize (speed 3))) 4677 (without-interrupts 4678 (values 4679 (%ioblock-force-output ioblock t)))) 4590 4680 nil))) 4591 4681 … … 4598 4688 (if (and (typep string 'simple-string) 4599 4689 (not start-p)) 4600 (funcall (ioblock-write-simple-string-function ioblock) 4601 ioblock string 0 (length string)) 4690 (locally (declare (optimize (speed 3))) 4691 (without-interrupts 4692 (values 4693 (funcall (ioblock-write-simple-string-function ioblock) 4694 ioblock string 0 (length string))))) 4602 4695 (progn 4603 4696 (setq end (check-sequence-bounds string start end)) … … 4610 4703 (incf start offset) 4611 4704 (incf end offset)) 4612 (funcall (ioblock-write-simple-string-function ioblock) 4613 ioblock arr start (the fixnum (- end start)))))))) 4705 (locally (declare (optimize (speed 3))) 4706 (without-interrupts 4707 (values 4708 (funcall (ioblock-write-simple-string-function ioblock) 4709 ioblock arr start (the fixnum (- end start))))))))))) 4614 4710 string) 4615 4711 … … 4621 4717 (if (and (typep string 'simple-string) 4622 4718 (not start-p)) 4623 (funcall (ioblock-write-simple-string-function ioblock) 4624 ioblock string 0 (length string)) 4719 (locally (declare (optimize (speed 3))) 4720 (without-interrupts 4721 (values 4722 (funcall (ioblock-write-simple-string-function ioblock) 4723 ioblock string 0 (length string))))) 4625 4724 (progn 4626 4725 (setq end (check-sequence-bounds string start end)) … … 4633 4732 (incf start offset) 4634 4733 (incf end offset)) 4635 (funcall (ioblock-write-simple-string-function ioblock) 4636 ioblock arr start (the fixnum (- end start))))))))) 4734 (locally (declare (optimize (speed 3))) 4735 (without-interrupts 4736 (values 4737 (funcall (ioblock-write-simple-string-function ioblock) 4738 ioblock arr start (the fixnum (- end start)))))))))))) 4637 4739 string) 4638 4740 … … 4641 4743 iv start length) 4642 4744 (with-stream-ioblock-output (ioblock s :speedy t) 4643 (%ioblock-out-ivect ioblock iv start length))) 4745 (locally (declare (optimize (speed 3))) 4746 (without-interrupts 4747 (values 4748 (%ioblock-out-ivect ioblock iv start length)))))) 4644 4749 4645 4750 (defmethod stream-write-ivector ((s basic-output-stream) … … 4647 4752 (let* ((ioblock (basic-stream-ioblock s))) 4648 4753 (with-ioblock-output-locked (ioblock) 4649 (%ioblock-out-ivect ioblock iv start length)))) 4754 (locally (declare (optimize (speed 3))) 4755 (without-interrupts 4756 (values 4757 (%ioblock-out-ivect ioblock iv start length))))))) 4650 4758 4651 4759 … … 4653 4761 iv start nb) 4654 4762 (with-stream-ioblock-input (ioblock s :speedy t) 4655 (%ioblock-character-in-ivect ioblock iv start nb))) 4763 (locally (declare (optimize (speed 3))) 4764 (without-interrupts 4765 (values 4766 (%ioblock-character-in-ivect ioblock iv start nb)))))) 4656 4767 4657 4768 (defmethod stream-read-ivector ((s buffered-binary-input-stream-mixin) 4658 4769 iv start nb) 4659 4770 (with-stream-ioblock-input (ioblock s :speedy t) 4660 (%ioblock-binary-in-ivect ioblock iv start nb))) 4771 (locally (declare (optimize (speed 3))) 4772 (without-interrupts 4773 (values 4774 (%ioblock-binary-in-ivect ioblock iv start nb)))))) 4661 4775 4662 4776 … … 4669 4783 (let* ((total (- end start))) 4670 4784 (declare (fixnum total)) 4671 (funcall (ioblock-write-simple-string-function ioblock) 4672 ioblock vector start total))))) 4785 (locally (declare (optimize (speed 3))) 4786 (without-interrupts 4787 (values 4788 (funcall (ioblock-write-simple-string-function ioblock) 4789 ioblock vector start total)))))))) 4673 4790 4674 4791 (defmethod stream-write-vector ((stream basic-character-output-stream) … … 4681 4798 (declare (fixnum total)) 4682 4799 (with-ioblock-output-locked (ioblock) 4683 (funcall (ioblock-write-simple-string-function ioblock) 4684 ioblock vector start total))))) 4800 (locally (declare (optimize (speed 3))) 4801 (without-interrupts 4802 (values 4803 (funcall (ioblock-write-simple-string-function ioblock) 4804 ioblock vector start total)))))))) 4685 4805 4686 4806 (defmethod stream-write-vector ((stream buffered-binary-output-stream-mixin) … … 4688 4808 (declare (fixnum start end)) 4689 4809 (with-stream-ioblock-output (ioblock stream :speedy t) 4690 (let* ((out (ioblock-outbuf ioblock)) 4691 (buf (io-buffer-buffer out)) 4692 (written 0) 4693 (limit (io-buffer-limit out)) 4694 (total (- end start)) 4695 (buftype (typecode buf))) 4696 (declare (fixnum buftype written total limit)) 4697 (if (not (= (the fixnum (typecode vector)) buftype)) 4698 (do* ((i start (1+ i)) 4699 (wbf (ioblock-write-byte-function ioblock))) 4700 ((= i end)) 4701 (let ((byte (uvref vector i))) 4702 (when (characterp byte) 4703 (setq byte (char-code byte))) 4704 (funcall wbf ioblock byte))) 4705 (do* ((pos start (+ pos written)) 4706 (left total (- left written))) 4707 ((= left 0)) 4708 (declare (fixnum pos left)) 4709 (setf (ioblock-dirty ioblock) t) 4710 (let* ((index (io-buffer-idx out)) 4711 (count (io-buffer-count out)) 4712 (avail (- limit index))) 4713 (declare (fixnum index avail count)) 4714 (cond 4715 ((= (setq written avail) 0) 4716 (%ioblock-force-output ioblock nil)) 4717 (t 4718 (if (> written left) 4719 (setq written left)) 4720 (%copy-ivector-to-ivector 4721 vector 4722 (ioblock-elements-to-octets ioblock pos) 4723 buf 4724 (ioblock-elements-to-octets ioblock index) 4725 (ioblock-elements-to-octets ioblock written)) 4726 (setf (ioblock-dirty ioblock) t) 4727 (incf index written) 4728 (if (> index count) 4729 (setf (io-buffer-count out) index)) 4730 (setf (io-buffer-idx out) index) 4731 (if (= index limit) 4732 (%ioblock-force-output ioblock nil)))))))))) 4810 (without-interrupts 4811 (let* ((out (ioblock-outbuf ioblock)) 4812 (buf (io-buffer-buffer out)) 4813 (written 0) 4814 (limit (io-buffer-limit out)) 4815 (total (- end start)) 4816 (buftype (typecode buf))) 4817 (declare (fixnum buftype written total limit)) 4818 (if (not (= (the fixnum (typecode vector)) buftype)) 4819 (do* ((i start (1+ i)) 4820 (wbf (ioblock-write-byte-function ioblock))) 4821 ((= i end)) 4822 (let ((byte (uvref vector i))) 4823 (funcall wbf ioblock byte))) 4824 (do* ((pos start (+ pos written)) 4825 (left total (- left written))) 4826 ((= left 0)) 4827 (declare (fixnum pos left)) 4828 (setf (ioblock-dirty ioblock) t) 4829 (let* ((index (io-buffer-idx out)) 4830 (count (io-buffer-count out)) 4831 (avail (- limit index))) 4832 (declare (fixnum index avail count)) 4833 (cond 4834 ((= (setq written avail) 0) 4835 (%ioblock-force-output ioblock nil)) 4836 (t 4837 (if (> written left) 4838 (setq written left)) 4839 (%copy-ivector-to-ivector 4840 vector 4841 (ioblock-elements-to-octets ioblock pos) 4842 buf 4843 (ioblock-elements-to-octets ioblock index) 4844 (ioblock-elements-to-octets ioblock written)) 4845 (setf (ioblock-dirty ioblock) t) 4846 (incf index written) 4847 (if (> index count) 4848 (setf (io-buffer-count out) index)) 4849 (setf (io-buffer-idx out) index) 4850 (if (= index limit) 4851 (%ioblock-force-output ioblock nil))))))))))) 4733 4852 4734 4853 (defmethod stream-write-vector ((stream basic-binary-output-stream) … … 4737 4856 (let* ((ioblock (basic-stream-ioblock stream))) 4738 4857 (with-ioblock-output-locked (ioblock) 4739 (let* ((out (ioblock-outbuf ioblock)) 4740 (buf (io-buffer-buffer out)) 4741 (written 0) 4742 (limit (io-buffer-limit out)) 4743 (total (- end start)) 4744 (buftype (typecode buf))) 4745 (declare (fixnum buftype written total limit)) 4746 (if (not (= (the fixnum (typecode vector)) buftype)) 4747 (do* ((i start (1+ i)) 4748 (wbf (ioblock-write-byte-function ioblock))) 4749 ((= i end)) 4750 (let ((byte (uvref vector i))) 4751 (when (characterp byte) 4752 (setq byte (char-code byte))) 4753 (funcall wbf ioblock byte))) 4754 (do* ((pos start (+ pos written)) 4755 (left total (- left written))) 4756 ((= left 0)) 4757 (declare (fixnum pos left)) 4758 (setf (ioblock-dirty ioblock) t) 4759 (let* ((index (io-buffer-idx out)) 4760 (count (io-buffer-count out)) 4761 (avail (- limit index))) 4762 (declare (fixnum index avail count)) 4763 (cond 4764 ((= (setq written avail) 0) 4765 (%ioblock-force-output ioblock nil)) 4766 (t 4767 (if (> written left) 4768 (setq written left)) 4769 (%copy-ivector-to-ivector 4770 vector 4771 (ioblock-elements-to-octets ioblock pos) 4772 buf 4773 (ioblock-elements-to-octets ioblock index) 4774 (ioblock-elements-to-octets ioblock written)) 4775 (setf (ioblock-dirty ioblock) t) 4776 (incf index written) 4777 (if (> index count) 4778 (setf (io-buffer-count out) index)) 4779 (setf (io-buffer-idx out) index) 4780 (if (= index limit) 4781 (%ioblock-force-output ioblock nil))))))))))) 4858 (without-interrupts 4859 (let* ((out (ioblock-outbuf ioblock)) 4860 (buf (io-buffer-buffer out)) 4861 (written 0) 4862 (limit (io-buffer-limit out)) 4863 (total (- end start)) 4864 (buftype (typecode buf))) 4865 (declare (fixnum buftype written total limit)) 4866 (if (not (= (the fixnum (typecode vector)) buftype)) 4867 (do* ((i start (1+ i)) 4868 (wbf (ioblock-write-byte-function ioblock))) 4869 ((= i end)) 4870 (let ((byte (uvref vector i))) 4871 (when (characterp byte) 4872 (setq byte (char-code byte))) 4873 (funcall wbf ioblock byte))) 4874 (do* ((pos start (+ pos written)) 4875 (left total (- left written))) 4876 ((= left 0)) 4877 (declare (fixnum pos left)) 4878 (setf (ioblock-dirty ioblock) t) 4879 (let* ((index (io-buffer-idx out)) 4880 (count (io-buffer-count out)) 4881 (avail (- limit index))) 4882 (declare (fixnum index avail count)) 4883 (cond 4884 ((= (setq written avail) 0) 4885 (%ioblock-force-output ioblock nil)) 4886 (t 4887 (if (> written left) 4888 (setq written left)) 4889 (%copy-ivector-to-ivector 4890 vector 4891 (ioblock-elements-to-octets ioblock pos) 4892 buf 4893 (ioblock-elements-to-octets ioblock index) 4894 (ioblock-elements-to-octets ioblock written)) 4895 (setf (ioblock-dirty ioblock) t) 4896 (incf index written) 4897 (if (> index count) 4898 (setf (io-buffer-count out) index)) 4899 (setf (io-buffer-idx out) index) 4900 (if (= index limit) 4901 (%ioblock-force-output ioblock nil)))))))))))) 4782 4902 4783 4903 … … 4790 4910 (let* ((ioblock (basic-stream-ioblock stream))) 4791 4911 (with-ioblock-input-locked (ioblock) 4792 (%ioblock-binary-read-vector ioblock vector start end))))) 4912 (locally (declare (optimize (speed 3))) 4913 (without-interrupts 4914 (values 4915 (%ioblock-binary-read-vector ioblock vector start end)))))))) 4793 4916 4794 4917 (defmethod stream-read-vector ((stream buffered-character-input-stream-mixin) … … 4798 4921 (call-next-method) 4799 4922 (with-stream-ioblock-input (ioblock stream :speedy t) 4800 (funcall (ioblock-character-read-vector-function ioblock) 4801 ioblock vector start end)))) 4923 (locally (declare (optimize (speed 3))) 4924 (without-interrupts 4925 (values 4926 (funcall (ioblock-character-read-vector-function ioblock) 4927 ioblock vector start end))))))) 4802 4928 4803 4929 … … 4809 4935 (call-next-method) 4810 4936 (with-stream-ioblock-input (ioblock stream :speedy t) 4811 (%ioblock-binary-read-vector ioblock vector start end)))) 4937 (locally (declare (optimize (speed 3))) 4938 (without-interrupts 4939 (values 4940 (%ioblock-binary-read-vector ioblock vector start end))))))) 4812 4941 4813 4942 -
trunk/ccl/lib/streams.lisp
r5231 r5357 34 34 (defun read-line (&optional input-stream (eof-error-p t) eof-value recursive-p) 35 35 36 (declare (ignore recursive-p)) 36 (declare (ignore recursive-p) 37 (optimize (speed 3))) 37 38 (let* ((input-stream (designated-input-stream input-stream))) 38 39 (multiple-value-bind (string eof) 39 40 (if (typep input-stream 'basic-stream) 40 41 (let* ((ioblock (basic-stream-ioblock input-stream))) 41 (with-ioblock-input-locked (ioblock) 42 (funcall (ioblock-read-line-function ioblock) ioblock))) 42 (without-interrupts 43 (with-ioblock-input-locked (ioblock) 44 (funcall (ioblock-read-line-function ioblock) ioblock)))) 43 45 (stream-read-line input-stream)) 44 46 (if eof … … 55 57 (setq input-stream (designated-input-stream input-stream)) 56 58 (if (typep input-stream 'basic-stream) 57 (let* ((ioblock (basic-stream .stateinput-stream)))58 ( if ioblock59 (check-eof60 (funcall (ioblock-read-char-function ioblock) ioblock)61 input-stream eof-error-p eof-value)62 (stream-is-closed input-stream)))59 (let* ((ioblock (basic-stream-ioblock input-stream))) 60 (check-eof 61 (without-interrupts 62 (values 63 (funcall (ioblock-read-char-function ioblock) ioblock))) 64 input-stream eof-error-p eof-value)) 63 65 (check-eof (stream-read-char input-stream) 64 66 input-stream … … 68 70 (defun unread-char (char &optional input-stream) 69 71 (let* ((input-stream (designated-input-stream input-stream))) 70 (stream-unread-char input-stream char) 72 (if (typep input-stream 'basic-stream) 73 (let* ((flags (basic-stream.flags input-stream))) 74 (declare (fixnum flags)) 75 (if (= (the fixnum (logand flags (logior (ash 1 basic-stream-flag.open-input) 76 (ash 1 basic-stream-flag.open-character)))) 77 (logior (ash 1 basic-stream-flag.open-input) 78 (ash 1 basic-stream-flag.open-character))) 79 (let* ((ioblock (basic-stream-ioblock input-stream))) 80 (without-interrupts 81 (%ioblock-untyi ioblock char))) 82 (stream-unread-char input-stream char))) 83 (stream-unread-char input-stream char)) 71 84 nil)) 72 85 … … 96 109 97 110 (defun read-byte (stream &optional (eof-error-p t) eof-value) 111 (declare (optimize (speed 3) (space 0))) 98 112 (if (typep stream 'basic-stream) 99 (let* ((ioblock (basic-stream.state stream))) 100 (if ioblock 101 (check-eof (funcall (ioblock-read-byte-function ioblock) ioblock) 102 stream 103 eof-error-p 104 eof-value) 105 (stream-is-closed ioblock))) 113 (let* ((ioblock (basic-stream-ioblock stream))) 114 (check-eof (without-interrupts 115 (values (funcall (ioblock-read-byte-function ioblock) ioblock))) 116 stream 117 eof-error-p 118 eof-value)) 106 119 (check-eof 107 120 (stream-read-byte stream) … … 129 142 130 143 (defun write-byte (byte stream) 144 (declare (optimize (speed 3) (space 0))) 131 145 "Write one byte, BYTE, to STREAM." 132 146 (if (typep stream 'basic-stream) 133 147 (let* ((ioblock (basic-stream-ioblock stream))) 134 (funcall (ioblock-write-byte-function ioblock) ioblock byte)) 148 (without-interrupts 149 (values 150 (funcall (ioblock-write-byte-function ioblock) ioblock byte)))) 135 151 (stream-write-byte stream byte)) 136 152 byte)
Note:
See TracChangeset
for help on using the changeset viewer.
