Changeset 11540
 Timestamp:
 01/04/09 16:44:21 (12 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass2.lisp
r11534 r11540 2122 2122 g)) 2123 2123 2124 2124 2125 (defknown compileconstant (t t t) t) 2125 2126 (defun compileconstant (form target representation) … … 2273 2274 (installp2handler name 'p2predicate)) 2274 2275 2276 (defmacro defineinlinedfunction (name params preambleandtest &body body) 2277 (let* ((test (second preambleandtest)) 2278 (preamble (and test (first preambleandtest))) 2279 (test (or test (first preambleandtest)))) 2280 `(defun ,name ,params 2281 ,preamble 2282 (unless ,test 2283 (compilefunctioncall ,@params) 2284 (returnfrom ,name)) 2285 ,@body))) 2286 2275 2287 (defknown p2predicate (t t t) t) 2276 (defun p2predicate (form target representation) 2277 (unless (= (length form) 2) 2278 (compilefunctioncall form target representation) 2279 (returnfrom p2predicate)) 2288 (defineinlinedfunction p2predicate (form target representation) 2289 ((= (length form) 2)) 2280 2290 (let* ((op (car form)) 2281 2291 (info (gethash op *predicates*)) … … 2401 2411 2402 2412 (defknown p2eq/neq (t t t) t) 2403 (defun p2eq/neq (form target representation) 2404 (aver (or (null representation) (eq representation :boolean))) 2405 (unless (checkargcount form 2) 2406 (compilefunctioncall form target representation) 2407 (returnfrom p2eq/neq)) 2413 (defineinlinedfunction p2eq/neq (form target representation) 2414 ((aver (or (null representation) (eq representation :boolean))) 2415 (checkargcount form 2)) 2408 2416 (let* ((op (%car form)) 2409 2417 (args (%cdr form)) … … 2438 2446 2439 2447 (defknown p2eql (t t t) t) 2440 (defun p2eql (form target representation) 2441 (aver (or (null representation) (eq representation :boolean))) 2442 (unless (checkargcount form 2) 2443 (compilefunctioncall form target representation) 2444 (returnfrom p2eql)) 2448 (defineinlinedfunction p2eql (form target representation) 2449 ((aver (or (null representation) (eq representation :boolean))) 2450 (checkargcount form 2)) 2445 2451 (let* ((arg1 (%cadr form)) 2446 2452 (arg2 (%caddr form)) … … 2490 2496 2491 2497 (defknown p2memq (t t t) t) 2492 (defun p2memq (form target representation) 2493 ;; (format t "p2memq representation = ~S~%" representation) 2494 (unless (checkargcount form 2) 2495 (compilefunctioncall form target representation) 2496 (returnfrom p2memq)) 2498 (defineinlinedfunction p2memq (form target representation) 2499 ((checkargcount form 2)) 2497 2500 (cond ((eq representation :boolean) 2498 2501 (let* ((args (cdr form)) … … 2508 2511 2509 2512 (defknown p2memql (t t t) t) 2510 (defun p2memql (form target representation) 2511 (unless (checkargcount form 2) 2512 (compilefunctioncall form target representation) 2513 (returnfrom p2memql)) 2513 (defineinlinedfunction p2memql (form target representation) 2514 ((checkargcount form 2)) 2514 2515 (cond ((eq representation :boolean) 2515 2516 (let* ((args (cdr form)) … … 4357 4358 4358 4359 (defknown p2atom (t t t) t) 4359 (defun p2atom (form target representation) 4360 (aver (or (null representation) (eq representation :boolean))) 4361 (unless (checkargcount form 1) 4362 (compilefunctioncall form target representation) 4363 (returnfrom p2atom)) 4360 (defineinlinedfunction p2atom (form target representation) 4361 ((aver (or (null representation) (eq representation :boolean))) 4362 (checkargcount form 1)) 4364 4363 (compileformsandmaybeemitclearvalues (cadr form) 'stack nil) 4365 4364 (emit 'instanceof +lispconsclass+) … … 4439 4438 (p2instanceofpredicate form target representation +lispabstractvectorclass+)) 4440 4439 4441 (defun p2coercetofunction (form target representation) 4442 (unless (checkargcount form 1) 4443 (compilefunctioncall form target representation) 4444 (returnfrom p2coercetofunction)) 4440 (defineinlinedfunction p2coercetofunction (form target representation) 4441 ((checkargcount form 1)) 4445 4442 (compileformsandmaybeemitclearvalues (%cadr form) 'stack nil) 4446 4443 (emitinvokestatic +lispclass+ "coerceToFunction" … … 4567 4564 (emitinvokemethod field target representation)) 4568 4565 4569 (defun p2car (form target representation) 4570 (unless (checkargcount form 1) 4571 (compilefunctioncall form target representation) 4572 (returnfrom p2car)) 4566 (defineinlinedfunction p2car (form target representation) 4567 ((checkargcount form 1)) 4573 4568 (let ((arg (%cadr form))) 4574 4569 (cond ((and (null target) (< *safety* 3)) … … 4580 4575 (emitcar/cdr arg target representation "car"))))) 4581 4576 4582 (defun p2cdr (form target representation) 4583 (unless (checkargcount form 1) 4584 (compilefunctioncall form target representation) 4585 (returnfrom p2cdr)) 4577 (defineinlinedfunction p2cdr (form target representation) 4578 ((checkargcount form 1)) 4586 4579 (let ((arg (%cadr form))) 4587 4580 (emitcar/cdr arg target representation "cdr"))) 4588 4581 4589 (defun p2cons (form target representation) 4590 (unless (checkargcount form 2) 4591 (compilefunctioncall form target representation) 4592 (returnfrom p2cons)) 4582 (defineinlinedfunction p2cons (form target representation) 4583 ((checkargcount form 2)) 4593 4584 (emit 'new +lispconsclass+) 4594 4585 (emit 'dup) … … 4688 4679 (compilerunsupported "COMPILEQUOTE: unsupported case: ~S" form))))) 4689 4680 4690 (defun p2rplacd (form target representation) 4691 (unless (checkargcount form 2) 4692 (compilefunctioncall form target representation) 4693 (returnfrom p2rplacd)) 4681 (defineinlinedfunction p2rplacd (form target representation) 4682 ((checkargcount form 2)) 4694 4683 (let ((args (cdr form))) 4695 4684 (compileform (first args) 'stack nil) … … 4705 4694 (emitmovefromstack target representation)))) 4706 4695 4707 (defun p2setcar/cdr (form target representation) 4708 (unless (checkargcount form 2) 4709 (compilefunctioncall form target representation) 4710 (returnfrom p2setcar/cdr)) 4696 (defineinlinedfunction p2setcar/cdr (form target representation) 4697 ((checkargcount form 2)) 4711 4698 (let ((op (%car form)) 4712 4699 (args (%cdr form))) … … 4989 4976 4990 4977 (defknown p2ash (t t t) t) 4991 (defun p2ash (form target representation) 4992 (unless (checkargcount form 2) 4993 (compilefunctioncall form target representation) 4994 (returnfrom p2ash)) 4978 (defineinlinedfunction p2ash (form target representation) 4979 ((checkargcount form 2)) 4995 4980 (let* ((args (%cdr form)) 4996 4981 (arg1 (%car args)) … … 5329 5314 5330 5315 (defknown p2lognot (t t t) t) 5331 (defun p2lognot (form target representation) 5332 (unless (checkargcount form 1) 5333 (compilefunctioncall form target representation) 5334 (returnfrom p2lognot)) 5316 (defineinlinedfunction p2lognot (form target representation) 5317 ((checkargcount form 1)) 5335 5318 (cond ((and (fixnumtypep (derivecompilertype form))) 5336 5319 (let ((arg (%cadr form))) … … 5350 5333 ;; %ldb size position integer => byte 5351 5334 (defknown p2%ldb (t t t) t) 5352 (defun p2%ldb (form target representation) 5353 ;; (format t "~&p2%ldb~%") 5354 (unless (checkargcount form 3) 5355 (compilefunctioncall form target representation) 5356 (returnfrom p2%ldb)) 5335 (defineinlinedfunction p2%ldb (form target representation) 5336 ((checkargcount form 3)) 5357 5337 (let* ((args (cdr form)) 5358 5338 (sizearg (%car args)) … … 5423 5403 5424 5404 (defknown p2mod (t t t) t) 5425 (defun p2mod (form target representation) 5426 (unless (checkargcount form 2) 5427 (compilefunctioncall form target representation) 5428 (returnfrom p2mod)) 5405 (defineinlinedfunction p2mod (form target representation) 5406 ((checkargcount form 2)) 5429 5407 (let* ((args (cdr form)) 5430 5408 (arg1 (%car args)) … … 5484 5462 5485 5463 (defknown p2zerop (t t t) t) 5486 (defun p2zerop (form target representation) 5487 (aver (or (null representation) (eq representation :boolean))) 5488 (unless (checkargcount form 1) 5489 (compilefunctioncall form target representation) 5490 (returnfrom p2zerop)) 5464 (defineinlinedfunction p2zerop (form target representation) 5465 ((aver (or (null representation) (eq representation :boolean))) 5466 (checkargcount form 1)) 5491 5467 (let* ((arg (cadr form)) 5492 5468 (type (derivecompilertype arg))) … … 5586 5562 5587 5563 (defknown p2stdslotvalue (t t t) t) 5588 (defun p2stdslotvalue (form target representation) 5589 (unless (checkargcount form 2) 5590 (compilefunctioncall form target representation) 5591 (returnfrom p2stdslotvalue)) 5564 (defineinlinedfunction p2stdslotvalue (form target representation) 5565 ((checkargcount form 2)) 5592 5566 (let* ((args (cdr form)) 5593 5567 (arg1 (first args)) … … 5602 5576 ;; setstdslotvalue instance slotname newvalue => newvalue 5603 5577 (defknown p2setstdslotvalue (t t t) t) 5604 (defun p2setstdslotvalue (form target representation) 5605 (unless (checkargcount form 3) 5606 (compilefunctioncall form target representation) 5607 (returnfrom p2setstdslotvalue)) 5578 (defineinlinedfunction p2setstdslotvalue (form target representation) 5579 ((checkargcount form 3)) 5608 5580 (let* ((args (cdr form)) 5609 5581 (arg1 (first args)) … … 5642 5614 5643 5615 ;; makesequence resulttype size &key initialelement => sequence 5644 (def un p2makesequence (form target representation)5616 (defineinlinedfunction p2makesequence (form target representation) 5645 5617 ;; In safe code, we want to make sure the requested length does not exceed 5646 5618 ;; ARRAYDIMENSIONLIMIT. 5647 ( unless(and (< *safety* 3)5619 ((and (< *safety* 3) 5648 5620 (= (length form) 3) 5649 (null representation)) 5650 (compilefunctioncall form target representation) 5651 (returnfrom p2makesequence)) 5621 (null representation))) 5652 5622 (let* ((args (cdr form)) 5653 5623 (arg1 (first args)) … … 5735 5705 5736 5706 (defknown p2streamelementtype (t t t) t) 5737 (defun p2streamelementtype (form target representation) 5738 (unless (checkargcount form 1) 5739 (compilefunctioncall form target representation) 5740 (returnfrom p2streamelementtype)) 5707 (defineinlinedfunction p2streamelementtype (form target representation) 5708 ((checkargcount form 1)) 5741 5709 (let ((arg (%cadr form))) 5742 5710 (cond ((eq (derivecompilertype arg) 'STREAM) … … 5751 5719 ;; write8bits byte stream => nil 5752 5720 (defknown p2write8bits (t t t) t) 5753 (defun p2write8bits (form target representation) 5754 (unless (checkargcount form 2) 5755 (compilefunctioncall form target representation) 5756 (returnfrom p2write8bits)) 5721 (defineinlinedfunction p2write8bits (form target representation) 5722 ((checkargcount form 2)) 5757 5723 (let* ((arg1 (%cadr form)) 5758 5724 (arg2 (%caddr form)) … … 6326 6292 (compilefunctioncall form target representation)) 6327 6293 6328 (defun p2length (form target representation) 6329 (unless (checkargcount form 1) 6330 (compilefunctioncall form target representation) 6331 (returnfrom p2length)) 6294 (defineinlinedfunction p2length (form target representation) 6295 ((checkargcount form 1)) 6332 6296 (let ((arg (cadr form))) 6333 6297 (compileformsandmaybeemitclearvalues arg 'stack nil) … … 6444 6408 (compilefunctioncall form target representation))))) 6445 6409 6446 (defun compilenth (form target representation) 6447 (unless (checkargcount form 2) 6448 (compilefunctioncall form target representation) 6449 (returnfrom compilenth)) 6410 (defineinlinedfunction compilenth (form target representation) 6411 ((checkargcount form 2)) 6450 6412 (let ((indexform (second form)) 6451 6413 (listform (third form))) … … 6784 6746 ;; char/schar string index => character 6785 6747 (defknown p2char/schar (t t t) t) 6786 (defun p2char/schar (form target representation) 6787 (unless (checkargcount form 2) 6788 (compilefunctioncall form target representation) 6789 (returnfrom p2char/schar)) 6748 (defineinlinedfunction p2char/schar (form target representation) 6749 ((checkargcount form 2)) 6790 6750 (let* ((op (%car form)) 6791 6751 (args (%cdr form)) … … 6828 6788 ;; setchar/schar string index character => character 6829 6789 (defknown p2setchar/schar (t t t) t) 6830 (defun p2setchar/schar (form target representation) 6831 ;; (format t "p2setchar/schar~%") 6832 (unless (checkargcount form 3) 6833 (compilefunctioncall form target representation) 6834 (returnfrom p2setchar/schar)) 6790 (defineinlinedfunction p2setchar/schar (form target representation) 6791 ((checkargcount form 3)) 6835 6792 (let* ((op (%car form)) 6836 6793 (args (%cdr form)) … … 7055 7012 7056 7013 (defknown p2structureref (t t t) t) 7057 (defun p2structureref (form target representation) 7058 (unless (checkargcount form 2) 7059 (compilefunctioncall form target representation) 7060 (returnfrom p2structureref)) 7014 (defineinlinedfunction p2structureref (form target representation) 7015 ((checkargcount form 2)) 7061 7016 (let* ((args (cdr form)) 7062 7017 (arg1 (first args)) … … 7110 7065 7111 7066 (defknown p2structureset (t t t) t) 7112 (defun p2structureset (form target representation) 7113 (unless (checkargcount form 3) 7114 (compilefunctioncall form target representation) 7115 (returnfrom p2structureset)) 7067 (defineinlinedfunction p2structureset (form target representation) 7068 ((checkargcount form 3)) 7116 7069 (let* ((args (cdr form)) 7117 7070 (arg1 (first args)) … … 7154 7107 7155 7108 7156 (defun p2not/null (form target representation) 7157 (aver (or (null representation) (eq representation :boolean))) 7158 (unless (checkargcount form 1) 7159 (compilefunctioncall form target representation) 7160 (returnfrom p2not/null)) 7109 (defineinlinedfunction p2not/null (form target representation) 7110 ((aver (or (null representation) (eq representation :boolean))) 7111 (checkargcount form 1)) 7161 7112 (let ((arg (second form))) 7162 7113 (cond ((null arg) … … 7203 7154 (emitmovefromstack target representation)) 7204 7155 7205 (defun p2nthcdr (form target representation) 7206 (unless (checkargcount form 2) 7207 (compilefunctioncall form target representation) 7208 (returnfrom p2nthcdr)) 7156 (defineinlinedfunction p2nthcdr (form target representation) 7157 ((checkargcount form 2)) 7209 7158 (let* ((args (%cdr form)) 7210 7159 (arg1 (%car args)) … … 7670 7619 7671 7620 (defknown p2symbolname (t t t) t) 7672 (defun p2symbolname (form target representation) 7673 (unless (checkargcount form 1) 7674 (compilefunctioncall form target representation) 7675 (returnfrom p2symbolname)) 7621 (defineinlinedfunction p2symbolname (form target representation) 7622 ((checkargcount form 1)) 7676 7623 (let ((arg (%cadr form))) 7677 7624 (cond ((and (eq (derivecompilertype arg) 'SYMBOL) (< *safety* 3)) … … 7684 7631 7685 7632 (defknown p2symbolpackage (t t t) t) 7686 (defun p2symbolpackage (form target representation) 7687 (unless (checkargcount form 1) 7688 (compilefunctioncall form target representation) 7689 (returnfrom p2symbolpackage)) 7633 (defineinlinedfunction p2symbolpackage (form target representation) 7634 ((checkargcount form 1)) 7690 7635 (let ((arg (%cadr form))) 7691 7636 (cond ((and (eq (derivecompilertype arg) 'SYMBOL) (< *safety* 3)) … … 7775 7720 7776 7721 (defknown p2charcode (t t t) t) 7777 (defun p2charcode (form target representation) 7778 (unless (checkargcount form 1) 7779 (compilefunctioncall form target representation) 7780 (returnfrom p2charcode)) 7722 (defineinlinedfunction p2charcode (form target representation) 7723 ((checkargcount form 1)) 7781 7724 (let ((arg (second form))) 7782 7725 (cond ((characterp arg) … … 7792 7735 7793 7736 (defknown p2javajclass (t t t) t) 7794 (defun p2javajclass (form target representation) 7795 (unless (and (= 2 (length form)) 7796 (stringp (cadr form))) 7797 (compilefunctioncall form target representation) 7798 (returnfrom p2javajclass)) 7737 (defineinlinedfunction p2javajclass (form target representation) 7738 ((and (= 2 (length form)) 7739 (stringp (cadr form)))) 7799 7740 (let ((c (ignoreerrors (java:jclass (cadr form))))) 7800 7741 (if c (compileconstant c target representation) … … 7803 7744 7804 7745 (defknown p2javajconstructor (t t t) t) 7805 (defun p2javajconstructor (form target representation) 7806 (unless (and (< 1 (length form)) 7807 (every #'stringp (cdr form))) 7808 (compilefunctioncall form target representation) 7809 (returnfrom p2javajconstructor)) 7746 (defineinlinedfunction p2javajconstructor (form target representation) 7747 ((and (< 1 (length form)) 7748 (every #'stringp (cdr form)))) 7810 7749 (let ((c (ignoreerrors (apply #'java:jconstructor (cdr form))))) 7811 7750 (if c (compileconstant c target representation) … … 7814 7753 7815 7754 (defknown p2javajmethod (t t t) t) 7816 (defun p2javajmethod (form target representation) 7817 (unless (and (< 1 (length form)) 7818 (every #'stringp (cdr form))) 7819 (compilefunctioncall form target representation) 7820 (returnfrom p2javajmethod)) 7755 (defineinlinedfunction p2javajmethod (form target representation) 7756 ((and (< 1 (length form)) 7757 (every #'stringp (cdr form)))) 7821 7758 (let ((m (ignoreerrors (apply #'java:jmethod (cdr form))))) 7822 7759 (if m (compileconstant m target representation)
Note: See TracChangeset
for help on using the changeset viewer.