Changeset 9261
 Timestamp:
 Apr 24, 2008, 9:32:53 AM (13 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/source/compiler/PPC/ppc2.lisp
r9163 r9261 5522 5522 (ppc2vset seg vreg xfer :simplevector vector index value (nxlookuptargetuvectorsubtag :simplevector))) 5523 5523 5524 (defppc2 ppc2typedform typedform (seg vreg xfer typespec form) 5525 (declare (ignore typespec)) ; Boy, do we ever ! 5526 (ppc2form seg vreg xfer form)) 5524 (defppc2 ppc2typedform typedform (seg vreg xfer typespec form &optional check) 5525 (if check 5526 (ppc2typecheckedform seg vreg xfer typespec form) 5527 (ppc2form seg vreg xfer form))) 5527 5528 5528 5529 (defppc2 ppc2%primitive %primitive (seg vreg xfer &rest ignore) … … 7967 7968 (defppc2require ppc2requires8 requireu64)) 7968 7969 7970 (defun ppc2typecheckedform (seg vreg xfer typespec form) 7971 (withppclocalvinsnmacros (seg vreg xfer) 7972 (let* ((op 7973 (cond ((eq typespec 'fixnum) (%nx1operator requirefixnum)) 7974 ((eq typespec 'integer) (%nx1operator requireinteger)) 7975 ((memq typespec '(basechar character)) 7976 (%nx1operator requirecharacter)) 7977 ((eq typespec 'symbol) (%nx1operator requiresymbol)) 7978 ((eq typespec 'list) (%nx1operator requirelist)) 7979 ((eq typespec 'real) (%nx1operator requirereal)) 7980 ((memq typespec '(simplebasestring simplestring)) 7981 (%nx1operator requiresimplestring)) 7982 ((eq typespec 'number) (%nx1operator requirenumber)) 7983 ((eq typespec 'simplevector) (%nx1operator requiresimplevector)) 7984 (t 7985 (let* ((ctype (specifiertype typespec))) 7986 (cond ((type= ctype (loadtimevalue (specifiertype '(signedbyte 8)))) 7987 (%nx1operator requires8)) 7988 ((type= ctype (loadtimevalue (specifiertype '(unsignedbyte 8)))) 7989 (%nx1operator requireu8)) 7990 ((type= ctype (loadtimevalue (specifiertype '(signedbyte 16)))) 7991 (%nx1operator requires16)) 7992 ((type= ctype (loadtimevalue (specifiertype '(unsignedbyte 16)))) 7993 (%nx1operator requireu16)) 7994 ((type= ctype (loadtimevalue (specifiertype '(signedbyte 32)))) 7995 (%nx1operator requires32)) 7996 ((type= ctype (loadtimevalue (specifiertype '(unsignedbyte 32)))) 7997 (%nx1operator requireu32)) 7998 ((type= ctype (loadtimevalue (specifiertype '(signedbyte 64)))) 7999 (%nx1operator requires64)) 8000 ((type= ctype (loadtimevalue (specifiertype '(unsignedbyte 64)))) 8001 (%nx1operator requireu64)))))))) 8002 (if op 8003 (ppc2useoperator op seg vreg xfer form) 8004 (if (or (eq typespec t) 8005 (eq typespec '*)) 8006 (ppc2form seg vreg xfer form) 8007 (let* ((ok (backendgetnextlabel))) 8008 (ppc2onetargetedregform seg form ($ ppc::arg_y)) 8009 (ppc2storeimmediate seg typespec ($ ppc::arg_z)) 8010 (ppc2storeimmediate seg 'typep ($ ppc::fname)) 8011 (ppc2setnargs seg 2) 8012 (ppc2vpushregister seg ($ ppc::arg_y)) 8013 (! callknownsymbol ($ ppc::arg_z)) 8014 (withcrftarget () crf 8015 (! comparetonil crf ($ ppc::arg_z)) 8016 (ppc2vpopregister seg ($ ppc::arg_y)) 8017 (! cbranchfalse (aref *backendlabels* ok) crf ppc::ppceqbit)) 8018 (ppc2lri seg ($ ppc::arg_x) (ash $XWRONGTYPE *ppc2targetfixnumshift*)) 8019 (ppc2storeimmediate seg typespec ($ ppc::arg_z)) 8020 (ppc2setnargs seg 3) 8021 (! ksignalerr) 8022 (@ ok) 8023 (< ($ ppc::arg_y)) 8024 (^))))))) 8025 7969 8026 (defppc2 ppc2%badarg2 %badarg2 (seg vreg xfer badthing goodthing) 7970 8027 (ppc2twotargetedregforms seg badthing ($ ppc::arg_y) goodthing ($ ppc::arg_z))
Note: See TracChangeset
for help on using the changeset viewer.