Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

close Warning: Can't use blame annotator:
No changeset 1403 in the repository

ppc32-vinsns.lisp

Visit:

Last change on this file was 16688, checked in by R. Matthew Emerson, 9 years ago
Merge copyright/license header changes to 1.11 release branch.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 155.9 KB

Rev	Line
	1	;;;-- Mode: Lisp; Package: CCL --
	2	;;;
	3	;;; Copyright 1994-2009 Clozure Associates
	4	;;;
	5	;;; Licensed under the Apache License, Version 2.0 (the "License");
	6	;;; you may not use this file except in compliance with the License.
	7	;;; You may obtain a copy of the License at
	8	;;;
	9	;;; http://www.apache.org/licenses/LICENSE-2.0
	10	;;;
	11	;;; Unless required by applicable law or agreed to in writing, software
	12	;;; distributed under the License is distributed on an "AS IS" BASIS,
	13	;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	14	;;; See the License for the specific language governing permissions and
	15	;;; limitations under the License.
	16
	17
	18	(in-package "CCL")
	19
	20	(eval-when (:compile-toplevel :load-toplevel :execute)
	21	(require "VINSN")
	22	(require "PPC32-BACKEND"))
	23
	24	(eval-when (:compile-toplevel :execute)
	25	(require "PPCENV"))
	26
	27	(defmacro define-ppc32-vinsn (vinsn-name (results args &optional temps) &body body)
	28	(%define-vinsn ppc32-backend vinsn-name results args temps body))
	29
	30
	31	;;; Index "scaling" and constant-offset misc-ref vinsns.
	32
	33	(define-ppc32-vinsn scale-node-misc-index (((dest :u32))
	34	((idx :imm) ; A fixnum
	35	)
	36	())
	37	(addi dest idx ppc32::misc-data-offset))
	38
	39	(define-ppc32-vinsn scale-32bit-misc-index (((dest :u32))
	40	((idx :imm) ; A fixnum
	41	)
	42	())
	43	(addi dest idx ppc32::misc-data-offset))
	44
	45	(define-ppc32-vinsn scale-16bit-misc-index (((dest :u32))
	46	((idx :imm) ; A fixnum
	47	)
	48	())
	49	(srwi dest idx 1)
	50	(addi dest dest ppc32::misc-data-offset))
	51
	52	(define-ppc32-vinsn scale-8bit-misc-index (((dest :u32))
	53	((idx :imm) ; A fixnum
	54	)
	55	())
	56	(srwi dest idx 2)
	57	(addi dest dest ppc32::misc-data-offset))
	58
	59	(define-ppc32-vinsn scale-64bit-misc-index (((dest :u32))
	60	((idx :imm) ; A fixnum
	61	)
	62	())
	63	(slwi dest idx 1)
	64	(addi dest dest ppc32::misc-dfloat-offset))
	65
	66
	67	(define-ppc32-vinsn scale-128bit-misc-index (((dest :u32))
	68	((idx :imm) ; A fixnum
	69	)
	70	())
	71	(slwi dest idx 2)
	72	(addi dest dest ppc32::complex-double-float.realpart))
	73
	74	(define-ppc32-vinsn scale-1bit-misc-index (((word-index :u32)
	75	(bitnum :u8)) ; (unsigned-byte 5)
	76	((idx :imm) ; A fixnum
	77	)
	78	)
	79	; Logically, we want to:
	80	; 1) Unbox the index by shifting it right 2 bits.
	81	; 2) Shift (1) right 5 bits
	82	; 3) Scale (2) by shifting it left 2 bits.
	83	; We get to do all of this with one instruction
	84	(rlwinm word-index idx (- ppc32::nbits-in-word 5) 5 (- ppc32::least-significant-bit ppc32::fixnum-shift))
	85	(addi word-index word-index ppc32::misc-data-offset) ; Hmmm. Also one instruction, but less impressive somehow.
	86	(extrwi bitnum idx 5 (- ppc32::nbits-in-word (+ ppc32::fixnum-shift 5))))
	87
	88
	89
	90	(define-ppc32-vinsn misc-ref-u32 (((dest :u32))
	91	((v :lisp)
	92	(scaled-idx :u32))
	93	())
	94	(lwzx dest v scaled-idx))
	95
	96
	97	(define-ppc32-vinsn misc-ref-c-u32 (((dest :u32))
	98	((v :lisp)
	99	(idx :u32const))
	100	())
	101	(lwz dest (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	102
	103	(define-ppc32-vinsn misc-ref-s32 (((dest :s32))
	104	((v :lisp)
	105	(scaled-idx :u32))
	106	())
	107	(lwzx dest v scaled-idx))
	108
	109	(define-ppc32-vinsn misc-ref-c-s32 (((dest :s32))
	110	((v :lisp)
	111	(idx :u32const))
	112	())
	113	(lwz dest (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	114
	115
	116	(define-ppc32-vinsn misc-set-c-u32 (()
	117	((val :u32)
	118	(v :lisp)
	119	(idx :u32const)))
	120	(stw val (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	121
	122	(define-ppc32-vinsn misc-set-c-s32 (()
	123	((val :s32)
	124	(v :lisp)
	125	(idx :u32const)))
	126	(stw val (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	127
	128	(define-ppc32-vinsn misc-set-u32 (()
	129	((val :u32)
	130	(v :lisp)
	131	(scaled-idx :u32)))
	132	(stwx val v scaled-idx))
	133
	134	(define-ppc32-vinsn misc-set-s32 (()
	135	((val :s32)
	136	(v :lisp)
	137	(scaled-idx :u32)))
	138	(stwx val v scaled-idx))
	139
	140
	141	(define-ppc32-vinsn misc-ref-single-float (((dest :single-float))
	142	((v :lisp)
	143	(scaled-idx :u32))
	144	())
	145	(lfsx dest v scaled-idx))
	146
	147	(define-ppc32-vinsn misc-ref-c-single-float (((dest :single-float))
	148	((v :lisp)
	149	(idx :u32const))
	150	())
	151	(lfs dest (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	152
	153	(define-ppc32-vinsn misc-ref-double-float (((dest :double-float))
	154	((v :lisp)
	155	(scaled-idx :u32))
	156	())
	157	(lfdx dest v scaled-idx))
	158
	159
	160	(define-ppc32-vinsn misc-ref-c-double-float (((dest :double-float))
	161	((v :lisp)
	162	(idx :u32const))
	163	())
	164	(lfd dest (:apply + ppc32::misc-dfloat-offset (:apply ash idx 3)) v))
	165
	166	(define-ppc32-vinsn misc-set-c-double-float (((val :double-float))
	167	((v :lisp)
	168	(idx :u32const)))
	169	(stfd val (:apply + ppc32::misc-dfloat-offset (:apply ash idx 3)) v))
	170
	171	(define-ppc32-vinsn misc-set-double-float (()
	172	((val :double-float)
	173	(v :lisp)
	174	(scaled-idx :u32)))
	175	(stfdx val v scaled-idx))
	176
	177
	178	(define-ppc32-vinsn misc-ref-complex-single-float (((dest :complex-single-float))
	179	((v :lisp)
	180	(scaled-idx :u32))
	181	((idx2 :u32)))
	182	(addi idx2 scaled-idx 4)
	183	(lfsx dest v scaled-idx)
	184	(lfsx (:apply 1+ (:apply %hard-regspec-value dest)) v idx2))
	185
	186
	187
	188	(define-ppc32-vinsn misc-ref-c-complex-single-float (((dest :complex-single-float))
	189	((v :lisp)
	190	(idx :u32const))
	191	())
	192	(lfs dest (:apply + ppc32::complex-single-float.realpart (:apply ash idx 3)) v)
	193	(lfs (:apply 1+ (:apply %hard-regspec-value dest))
	194	(:apply + (+ ppc32::complex-single-float.realpart 4) (:apply ash idx 3)) v))
	195
	196	(define-ppc32-vinsn misc-set-c-complex-single-float (((val :complex-single-float))
	197	((v :lisp)
	198	(idx :u32const)))
	199	(stfs val (:apply + ppc32::complex-single-float.realpart (:apply ash idx 3)) v)
	200	(stfs (:apply 1+ (:apply %hard-regspec-value val))
	201	(:apply + (+ ppc32::complex-single-float.realpart 4) (:apply ash idx 3))
	202	v))
	203
	204	(define-ppc32-vinsn misc-set-complex-single-float (()
	205	((val :complex-single-float)
	206	(v :lisp)
	207	(scaled-idx :u32))
	208	((idx2 :u32)))
	209	(addi idx2 scaled-idx 4)
	210	(stfsx val v scaled-idx)
	211	(stfsx val v idx2))
	212
	213
	214	(define-ppc32-vinsn misc-ref-complex-double-float (((dest :complex-double-float))
	215	((v :lisp)
	216	(scaled-idx :u32))
	217	((idx2 :u32)))
	218	(addi idx2 scaled-idx 8)
	219	(lfdx dest v scaled-idx)
	220	(lfdx (:apply 1+ (:apply %hard-regspec-value dest)) v idx2))
	221
	222
	223	(define-ppc32-vinsn misc-ref-c-complex-double-float (((dest :complex-double-float))
	224	((v :lisp)
	225	(idx :u32const))
	226	())
	227	(lfd dest (:apply + ppc32::complex-double-float.realpart (:apply ash idx 4)) v)
	228	(lfd (:apply 1+ (:apply %hard-regspec-value dest))
	229	(:apply + (+ ppc32::complex-double-float.realpart 8) (:apply ash idx 4)) v))
	230
	231	(define-ppc32-vinsn misc-set-c-complex-double-float (((val :complex-double-float))
	232	((v :lisp)
	233	(idx :u32const)))
	234	(stfd val (:apply + ppc32::complex-double-float.realpart (:apply ash idx 4)) v)
	235	(stfd (:apply 1+ (:apply %hard-regspec-value val))
	236	(:apply + (+ ppc32::complex-double-float.realpart 8) (:apply ash idx 4))
	237	v))
	238
	239	(define-ppc32-vinsn misc-set-complex-double-float (()
	240	((val :complex-double-float)
	241	(v :lisp)
	242	(scaled-idx :u32))
	243	((idx2 :u32)))
	244	(addi idx2 scaled-idx 8)
	245	(stfdx val v scaled-idx)
	246	(stfdx val v idx2))
	247
	248	(define-ppc32-vinsn misc-set-c-single-float (((val :single-float))
	249	((v :lisp)
	250	(idx :u32const)))
	251	(stfs val (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	252
	253	(define-ppc32-vinsn misc-set-single-float (()
	254	((val :single-float)
	255	(v :lisp)
	256	(scaled-idx :u32)))
	257	(stfsx val v scaled-idx))
	258
	259
	260	(define-ppc32-vinsn misc-ref-u16 (((dest :u16))
	261	((v :lisp)
	262	(scaled-idx :u32))
	263	())
	264	(lhzx dest v scaled-idx))
	265
	266	(define-ppc32-vinsn misc-ref-c-u16 (((dest :u16))
	267	((v :lisp)
	268	(idx :u32const))
	269	())
	270	(lhz dest (:apply + ppc32::misc-data-offset (:apply ash idx 1)) v))
	271
	272	(define-ppc32-vinsn misc-set-c-u16 (((val :u16))
	273	((v :lisp)
	274	(idx :u32const))
	275	())
	276	(sth val (:apply + ppc32::misc-data-offset (:apply ash idx 1)) v))
	277
	278	(define-ppc32-vinsn misc-set-u16 (((val :u16))
	279	((v :lisp)
	280	(scaled-idx :s32)))
	281	(sthx val v scaled-idx))
	282
	283	(define-ppc32-vinsn misc-ref-s16 (((dest :s16))
	284	((v :lisp)
	285	(scaled-idx :u32))
	286	())
	287	(lhax dest v scaled-idx))
	288
	289	(define-ppc32-vinsn misc-ref-c-s16 (((dest :s16))
	290	((v :lisp)
	291	(idx :u32const))
	292	())
	293	(lha dest (:apply + ppc32::misc-data-offset (:apply ash idx 1)) v))
	294
	295
	296	(define-ppc32-vinsn misc-set-c-s16 (((val :s16))
	297	((v :lisp)
	298	(idx :u32const))
	299	())
	300	(sth val (:apply + ppc32::misc-data-offset (:apply ash idx 1)) v))
	301
	302	(define-ppc32-vinsn misc-set-s16 (((val :s16))
	303	((v :lisp)
	304	(scaled-idx :s32)))
	305	(sthx val v scaled-idx))
	306
	307	(define-ppc32-vinsn misc-ref-u8 (((dest :u8))
	308	((v :lisp)
	309	(scaled-idx :u32))
	310	())
	311	(lbzx dest v scaled-idx))
	312
	313	(define-ppc32-vinsn misc-ref-c-u8 (((dest :u8))
	314	((v :lisp)
	315	(idx :u32const))
	316	())
	317	(lbz dest (:apply + ppc32::misc-data-offset idx) v))
	318
	319	(define-ppc32-vinsn misc-set-c-u8 (((val :u8))
	320	((v :lisp)
	321	(idx :u32const))
	322	())
	323	(stb val (:apply + ppc32::misc-data-offset idx) v))
	324
	325	(define-ppc32-vinsn misc-set-u8 (((val :u8))
	326	((v :lisp)
	327	(scaled-idx :u32))
	328	())
	329	(stbx val v scaled-idx))
	330
	331	(define-ppc32-vinsn misc-ref-s8 (((dest :s8))
	332	((v :lisp)
	333	(scaled-idx :u32))
	334	())
	335	(lbzx dest v scaled-idx)
	336	(extsb dest dest))
	337
	338	(define-ppc32-vinsn misc-ref-c-s8 (((dest :s8))
	339	((v :lisp)
	340	(idx :u32const))
	341	())
	342	(lbz dest (:apply + ppc32::misc-data-offset idx) v)
	343	(extsb dest dest))
	344
	345	(define-ppc32-vinsn misc-set-c-s8 (((val :s8))
	346	((v :lisp)
	347	(idx :u32const))
	348	())
	349	(stb val (:apply + ppc32::misc-data-offset idx) v))
	350
	351	(define-ppc32-vinsn misc-set-s8 (((val :s8))
	352	((v :lisp)
	353	(scaled-idx :u32))
	354	())
	355	(stbx val v scaled-idx))
	356
	357	(define-ppc32-vinsn misc-ref-c-bit (((dest :u8))
	358	((v :lisp)
	359	(idx :u32const))
	360	())
	361	(lwz dest (:apply + ppc32::misc-data-offset (:apply ash (:apply ash idx -5) 2)) v)
	362	(rlwinm dest dest (:apply 1+ (:apply logand idx #x1f)) 31 31))
	363
	364	(define-ppc32-vinsn misc-ref-c-bit-fixnum (((dest :imm))
	365	((v :lisp)
	366	(idx :u32const))
	367	((temp :u32)))
	368	(lwz temp (:apply + ppc32::misc-data-offset (:apply ash (:apply ash idx -5) 2)) v)
	369	(rlwinm dest
	370	temp
	371	(:apply + 1 ppc32::fixnumshift (:apply logand idx #x1f))
	372	(- ppc32::least-significant-bit ppc32::fixnumshift)
	373	(- ppc32::least-significant-bit ppc32::fixnumshift)))
	374
	375
	376	(define-ppc32-vinsn misc-ref-node (((dest :lisp))
	377	((v :lisp)
	378	(scaled-idx :s32))
	379	())
	380	(lwzx dest v scaled-idx))
	381
	382
	383
	384
	385	(define-ppc32-vinsn misc-ref-c-node (((dest :lisp))
	386	((v :lisp)
	387	(idx :s16const))
	388	())
	389	(lwz dest (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	390
	391	(define-ppc32-vinsn misc-set-node (()
	392	((val :lisp)
	393	(v :lisp)
	394	(scaled-idx :u32)))
	395	(stwx val v scaled-idx))
	396
	397	;;; This should only be used for initialization (when the value being
	398	;;; stored is known to be older than the vector V.)
	399	(define-ppc32-vinsn misc-set-c-node (()
	400	((val :lisp)
	401	(v :lisp)
	402	(idx :s16const))
	403	())
	404	(stw val (:apply + ppc32::misc-data-offset (:apply ash idx 2)) v))
	405
	406
	407	(define-ppc32-vinsn misc-element-count-fixnum (((dest :imm))
	408	((v :lisp))
	409	((temp :u32)))
	410	(lwz temp ppc32::misc-header-offset v)
	411	(rlwinm dest
	412	temp
	413	(- ppc32::nbits-in-word (- ppc32::num-subtag-bits ppc32::fixnumshift))
	414	(- ppc32::num-subtag-bits ppc32::fixnumshift)
	415	(- ppc32::least-significant-bit ppc32::fixnumshift)))
	416
	417	(define-ppc32-vinsn check-misc-bound (()
	418	((idx :imm)
	419	(v :lisp))
	420	((temp :u32)))
	421	(lwz temp ppc32::misc-header-offset v)
	422	(rlwinm temp
	423	temp
	424	(- ppc32::nbits-in-word (- ppc32::num-subtag-bits ppc32::fixnumshift))
	425	(- ppc32::num-subtag-bits ppc32::fixnumshift)
	426	(- ppc32::least-significant-bit ppc32::fixnumshift))
	427	(twlge idx temp))
	428
	429	(define-ppc32-vinsn 2d-unscaled-index (((dest :imm)
	430	(dim1 :u32))
	431	((dim1 :u32)
	432	(i :imm)
	433	(j :imm)))
	434	(mullw dim1 i dim1)
	435	(add dest dim1 j))
	436
	437	;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
	438	(define-ppc32-vinsn 3d-unscaled-index (((dest :imm)
	439	(dim1 :u32)
	440	(dim2 :u32))
	441	((dim1 :u32)
	442	(dim2 :u32)
	443	(i :imm)
	444	(j :imm)
	445	(k :imm)))
	446	(mullw dim1 dim1 dim2)
	447	(mullw dim2 j dim2)
	448	(mullw dim1 i dim1)
	449	(add dim2 dim1 dim2)
	450	(add dest dim2 k))
	451
	452
	453	(define-ppc32-vinsn 2d-dim1 (((dest :u32))
	454	((header :lisp)))
	455	(lwz dest (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
	456	(srawi dest dest ppc32::fixnumshift))
	457
	458	(define-ppc32-vinsn 3d-dims (((dim1 :u32)
	459	(dim2 :u32))
	460	((header :lisp)))
	461	(lwz dim1 (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
	462	(lwz dim2 (+ ppc32::misc-data-offset (* 4 (+ 2 ppc32::arrayH.dim0-cell))) header)
	463	(srawi dim1 dim1 ppc32::fixnumshift)
	464	(srawi dim2 dim2 ppc32::fixnumshift))
	465
	466	;; Return dim1 (unboxed)
	467	(define-ppc32-vinsn check-2d-bound (((dim :u32))
	468	((i :imm)
	469	(j :imm)
	470	(header :lisp)))
	471	(lwz dim (+ ppc32::misc-data-offset (* 4 ppc32::arrayH.dim0-cell)) header)
	472	(twlge i dim)
	473	(lwz dim (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
	474	(twlge j dim)
	475	(srawi dim dim ppc32::fixnumshift))
	476
	477	(define-ppc32-vinsn check-3d-bound (((dim1 :u32)
	478	(dim2 :u32))
	479	((i :imm)
	480	(j :imm)
	481	(k :imm)
	482	(header :lisp)))
	483	(lwz dim1 (+ ppc32::misc-data-offset (* 4 ppc32::arrayH.dim0-cell)) header)
	484	(twlge i dim1)
	485	(lwz dim1 (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
	486	(twlge j dim1)
	487	(lwz dim2 (+ ppc32::misc-data-offset (* 4 (+ 2 ppc32::arrayH.dim0-cell))) header)
	488	(twlge k dim2)
	489	(srawi dim1 dim1 ppc32::fixnumshift)
	490	(srawi dim2 dim2 ppc32::fixnumshift))
	491
	492	(define-ppc32-vinsn array-data-vector-ref (((dest :lisp))
	493	((header :lisp)))
	494	(lwz dest ppc32::arrayH.data-vector header))
	495
	496
	497	(define-ppc32-vinsn check-arrayH-rank (()
	498	((header :lisp)
	499	(expected :u32const))
	500	((rank :imm)))
	501	(lwz rank ppc32::arrayH.rank header)
	502	(twi 27 rank (:apply ash expected ppc32::fixnumshift)))
	503
	504	(define-ppc32-vinsn check-arrayH-flags (()
	505	((header :lisp)
	506	(expected :u16const))
	507	((flags :imm)
	508	(xreg :u32)))
	509	(lis xreg (:apply ldb (byte 16 16) (:apply ash expected ppc32::fixnumshift)))
	510	(ori xreg xreg (:apply ldb (byte 16 0) (:apply ash expected ppc32::fixnumshift)))
	511	(lwz flags ppc32::arrayH.flags header)
	512	(tw 27 flags xreg))
	513
	514
	515
	516
	517
	518	(define-ppc32-vinsn node-slot-ref (((dest :lisp))
	519	((node :lisp)
	520	(cellno :u32const)))
	521	(lwz dest (:apply + ppc32::misc-data-offset (:apply ash cellno 2)) node))
	522
	523
	524
	525	(define-ppc32-vinsn %slot-ref (((dest :lisp))
	526	((instance (:lisp (:ne dest)))
	527	(index :lisp))
	528	((scaled :u32)))
	529	(la scaled ppc32::misc-data-offset index)
	530	(lwzx dest instance scaled)
	531	(tweqi dest ppc32::slot-unbound-marker))
	532
	533
	534	;;; Untagged memory reference & assignment.
	535
	536	(define-ppc32-vinsn mem-ref-c-fullword (((dest :u32))
	537	((src :address)
	538	(index :s16const)))
	539	(lwz dest index src))
	540
	541
	542	(define-ppc32-vinsn mem-ref-c-signed-fullword (((dest :s32))
	543	((src :address)
	544	(index :s16const)))
	545	(lwz dest index src))
	546
	547	(define-ppc32-vinsn mem-ref-c-natural (((dest :u32))
	548	((src :address)
	549	(index :s16const)))
	550	(lwz dest index src))
	551
	552
	553	(define-ppc32-vinsn mem-ref-fullword (((dest :u32))
	554	((src :address)
	555	(index :s32)))
	556	(lwzx dest src index))
	557
	558	(define-ppc32-vinsn mem-ref-signed-fullword (((dest :u32))
	559	((src :address)
	560	(index :s32)))
	561	(lwzx dest src index))
	562
	563	(define-ppc32-vinsn mem-ref-natural (((dest :u32))
	564	((src :address)
	565	(index :s32)))
	566	(lwzx dest src index))
	567
	568
	569	(define-ppc32-vinsn mem-ref-c-u16 (((dest :u16))
	570	((src :address)
	571	(index :s16const)))
	572	(lhz dest index src))
	573
	574
	575	(define-ppc32-vinsn mem-ref-u16 (((dest :u16))
	576	((src :address)
	577	(index :s32)))
	578	(lhzx dest src index))
	579
	580
	581
	582	(define-ppc32-vinsn mem-ref-c-s16 (((dest :s16))
	583	((src :address)
	584	(index :s16const)))
	585	(lha dest index src))
	586
	587	(define-ppc32-vinsn mem-ref-s16 (((dest :s16))
	588	((src :address)
	589	(index :s32)))
	590	(lhax dest src index))
	591
	592	(define-ppc32-vinsn mem-ref-c-u8 (((dest :u8))
	593	((src :address)
	594	(index :s16const)))
	595	(lbz dest index src))
	596
	597	(define-ppc32-vinsn mem-ref-u8 (((dest :u8))
	598	((src :address)
	599	(index :s32)))
	600	(lbzx dest src index))
	601
	602	(define-ppc32-vinsn mem-ref-c-s8 (((dest :s8))
	603	((src :address)
	604	(index :s16const)))
	605	(lbz dest index src)
	606	(extsb dest dest))
	607
	608	(define-ppc32-vinsn mem-ref-s8 (((dest :s8))
	609	((src :address)
	610	(index :s32)))
	611	(lbzx dest src index)
	612	(extsb dest dest))
	613
	614	(define-ppc32-vinsn mem-ref-c-bit (((dest :u8))
	615	((src :address)
	616	(byte-index :s16const)
	617	(bit-shift :u8const)))
	618	(lbz dest byte-index src)
	619	(rlwinm dest dest bit-shift 31 31))
	620
	621	(define-ppc32-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
	622	((src :address)
	623	(byte-index :s16const)
	624	(bit-shift :u8const))
	625	((byteval :u8)))
	626	(lbz byteval byte-index src)
	627	(rlwinm dest byteval bit-shift 29 29))
	628
	629	(define-ppc32-vinsn mem-ref-bit (((dest :u8))
	630	((src :address)
	631	(bit-index :lisp))
	632	((byte-index :s16)
	633	(bit-shift :u8)))
	634	(srwi byte-index bit-index (+ ppc32::fixnumshift 3))
	635	(extrwi bit-shift bit-index 3 27)
	636	(addi bit-shift bit-shift 29)
	637	(lbzx dest src byte-index)
	638	(rlwnm dest dest bit-shift 31 31))
	639
	640
	641	(define-ppc32-vinsn mem-ref-bit-fixnum (((dest :lisp))
	642	((src :address)
	643	(bit-index :lisp))
	644	((byte-index :s16)
	645	(bit-shift :u8)))
	646	(srwi byte-index bit-index (+ ppc32::fixnumshift 3))
	647	(extrwi bit-shift bit-index 3 27)
	648	(addi bit-shift bit-shift 27)
	649	(lbzx byte-index src byte-index)
	650	(rlwnm dest
	651	byte-index
	652	bit-shift
	653	(- ppc32::least-significant-bit ppc32::fixnum-shift)
	654	(- ppc32::least-significant-bit ppc32::fixnum-shift)))
	655
	656	(define-ppc32-vinsn mem-ref-c-double-float (((dest :double-float))
	657	((src :address)
	658	(index :s16const)))
	659	(lfd dest index src))
	660
	661	(define-ppc32-vinsn mem-ref-double-float (((dest :double-float))
	662	((src :address)
	663	(index :s32)))
	664	(lfdx dest src index))
	665
	666	(define-ppc32-vinsn mem-set-c-double-float (()
	667	((val :double-float)
	668	(src :address)
	669	(index :s16const)))
	670	(stfd val index src))
	671
	672	(define-ppc32-vinsn mem-set-double-float (()
	673	((val :double-float)
	674	(src :address)
	675	(index :s32)))
	676	(stfdx val src index))
	677
	678	(define-ppc32-vinsn mem-ref-c-single-float (((dest :single-float))
	679	((src :address)
	680	(index :s16const)))
	681	(lfs dest index src))
	682
	683	(define-ppc32-vinsn mem-ref-single-float (((dest :single-float))
	684	((src :address)
	685	(index :s32)))
	686	(lfsx dest src index))
	687
	688	(define-ppc32-vinsn mem-set-c-single-float (()
	689	((val :single-float)
	690	(src :address)
	691	(index :s16const)))
	692	(stfs val index src))
	693
	694	(define-ppc32-vinsn mem-set-single-float (()
	695	((val :single-float)
	696	(src :address)
	697	(index :s32)))
	698	(stfsx val src index))
	699
	700
	701	(define-ppc32-vinsn mem-set-c-address (()
	702	((val :address)
	703	(src :address)
	704	(index :s16const)))
	705	(stw val index src))
	706
	707	(define-ppc32-vinsn mem-set-address (()
	708	((val :address)
	709	(src :address)
	710	(index :s32)))
	711	(stwx val src index))
	712
	713	(define-ppc32-vinsn mem-set-c-fullword (()
	714	((val :u32)
	715	(src :address)
	716	(index :s16const)))
	717	(stw val index src))
	718
	719	(define-ppc32-vinsn mem-set-fullword (()
	720	((val :u32)
	721	(src :address)
	722	(index :s32)))
	723	(stwx val src index))
	724
	725	(define-ppc32-vinsn mem-set-c-halfword (()
	726	((val :u16)
	727	(src :address)
	728	(index :s16const)))
	729	(sth val index src))
	730
	731	(define-ppc32-vinsn mem-set-halfword (()
	732	((val :u16)
	733	(src :address)
	734	(index :s32)))
	735	(sthx val src index))
	736
	737	(define-ppc32-vinsn mem-set-c-byte (()
	738	((val :u16)
	739	(src :address)
	740	(index :s16const)))
	741	(stb val index src))
	742
	743	(define-ppc32-vinsn mem-set-byte (()
	744	((val :u8)
	745	(src :address)
	746	(index :s32)))
	747	(stbx val src index))
	748
	749	(define-ppc32-vinsn mem-set-c-bit-0 (()
	750	((src :address)
	751	(byte-index :s16const)
	752	(mask-begin :u8const)
	753	(mask-end :u8const))
	754	((val :u8)))
	755	(lbz val byte-index src)
	756	(rlwinm val val 0 mask-begin mask-end)
	757	(stb val byte-index src))
	758
	759	(define-ppc32-vinsn mem-set-c-bit-1 (()
	760	((src :address)
	761	(byte-index :s16const)
	762	(mask :u8const))
	763	((val :u8)))
	764	(lbz val byte-index src)
	765	(ori val val mask)
	766	(stb val byte-index src))
	767
	768	(define-ppc32-vinsn mem-set-c-bit (()
	769	((src :address)
	770	(byte-index :s16const)
	771	(bit-index :u8const)
	772	(val :imm))
	773	((byteval :u8)))
	774	(lbz byteval byte-index src)
	775	(rlwimi byteval val (:apply logand 31 (:apply - 29 bit-index)) bit-index bit-index)
	776	(stb byteval byte-index src))
	777
	778	;;; Hey, they should be happy that it even works. Who cares how big it is or how
	779	;;; long it takes ...
	780	(define-ppc32-vinsn mem-set-bit (()
	781	((src :address)
	782	(bit-index :lisp)
	783	(val :lisp))
	784	((bit-shift :u32)
	785	(mask :u32)
	786	(byte-index :u32)
	787	(crf :crf)))
	788	(cmplwi crf val (ash 1 ppc32::fixnumshift))
	789	(extrwi bit-shift bit-index 3 27)
	790	(li mask #x80)
	791	(srw mask mask bit-shift)
	792	(ble+ crf :got-it)
	793	(uuo_interr arch::error-object-not-bit src)
	794	:got-it
	795	(srwi bit-shift bit-index (+ 3 ppc32::fixnumshift))
	796	(lbzx bit-shift src bit-shift)
	797	(beq crf :set)
	798	(andc mask bit-shift mask)
	799	(b :done)
	800	:set
	801	(or mask bit-shift mask)
	802	:done
	803	(srwi bit-shift bit-index (+ 3 ppc32::fixnumshift))
	804	(stbx mask src bit-shift))
	805
	806	;;; Tag and subtag extraction, comparison, checking, trapping ...
	807
	808	(define-ppc32-vinsn extract-tag (((tag :u8))
	809	((object :lisp))
	810	())
	811	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits)))
	812
	813	(define-ppc32-vinsn extract-tag-fixnum (((tag :imm))
	814	((object :lisp)))
	815	(rlwinm tag
	816	object
	817	ppc32::fixnum-shift
	818	(- ppc32::nbits-in-word
	819	(+ ppc32::nlisptagbits ppc32::fixnum-shift))
	820	(- ppc32::least-significant-bit ppc32::fixnum-shift)))
	821
	822	(define-ppc32-vinsn extract-fulltag (((tag :u8))
	823	((object :lisp))
	824	())
	825	(clrlwi tag object (- ppc32::nbits-in-word ppc32::ntagbits)))
	826
	827
	828	(define-ppc32-vinsn extract-fulltag-fixnum (((tag :imm))
	829	((object :lisp)))
	830	(rlwinm tag
	831	object
	832	ppc32::fixnum-shift
	833	(- ppc32::nbits-in-word
	834	(+ ppc32::ntagbits ppc32::fixnum-shift))
	835	(- ppc32::least-significant-bit ppc32::fixnum-shift)))
	836
	837	(define-ppc32-vinsn extract-typecode (((code :u8))
	838	((object :lisp))
	839	((crf :crf)))
	840	(clrlwi code object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	841	(cmpwi crf code ppc32::tag-misc)
	842	(bne crf :not-misc)
	843	(lbz code ppc32::misc-subtag-offset object)
	844	:not-misc)
	845
	846	(define-ppc32-vinsn extract-typecode-fixnum (((code :imm))
	847	((object (:lisp (:ne code))))
	848	((crf :crf) (subtag :u8)))
	849	(rlwinm code
	850	object
	851	ppc32::fixnum-shift
	852	(- ppc32::nbits-in-word
	853	(+ ppc32::nlisptagbits ppc32::fixnum-shift))
	854	(- ppc32::least-significant-bit ppc32::fixnum-shift))
	855	(cmpwi crf code (ash ppc32::tag-misc ppc32::fixnum-shift))
	856	(bne crf :not-misc)
	857	(lbz subtag ppc32::misc-subtag-offset object)
	858	(slwi code subtag ppc32::fixnum-shift)
	859	:not-misc)
	860
	861
	862	(define-ppc32-vinsn require-fixnum (()
	863	((object :lisp))
	864	((crf0 (:crf 0))
	865	(tag :u8)))
	866	:again
	867	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	868	(beq+ crf0 :got-it)
	869	(uuo_intcerr arch::error-object-not-fixnum object)
	870	(b :again)
	871	:got-it)
	872
	873	(define-ppc32-vinsn require-integer (()
	874	((object :lisp))
	875	((crf0 (:crf 0))
	876	(tag :u8)))
	877	:again
	878	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	879	(beq+ crf0 :got-it)
	880	(cmpwi crf0 tag ppc32::tag-misc)
	881	(bne crf0 :no-got)
	882	(lbz tag ppc32::misc-subtag-offset object)
	883	(cmpwi crf0 tag ppc32::subtag-bignum)
	884	(beq+ crf0 :got-it)
	885	:no-got
	886	(uuo_intcerr arch::error-object-not-integer object)
	887	(b :again)
	888	:got-it)
	889
	890	(define-ppc32-vinsn require-simple-vector (()
	891	((object :lisp))
	892	((tag :u8)
	893	(crf :crf)))
	894	:again
	895	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	896	(cmpwi crf tag ppc32::tag-misc)
	897	(bne crf :no-got)
	898	(lbz tag ppc32::misc-subtag-offset object)
	899	(cmpwi crf tag ppc32::subtag-simple-vector)
	900	(beq+ crf :got-it)
	901	:no-got
	902	(uuo_intcerr arch::error-object-not-simple-vector object)
	903	(b :again)
	904	:got-it)
	905
	906	(define-ppc32-vinsn require-simple-string (()
	907	((object :lisp))
	908	((tag :u8)
	909	(crf :crf)
	910	(crf2 :crf)))
	911	:again
	912	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	913	(cmpwi crf tag ppc32::tag-misc)
	914	(bne crf :no-got)
	915	(lbz tag ppc32::misc-subtag-offset object)
	916	(cmpwi crf tag ppc32::subtag-simple-base-string)
	917	(beq+ crf :got-it)
	918	:no-got
	919	(uuo_intcerr arch::error-object-not-simple-string object)
	920	(b :again)
	921	:got-it)
	922
	923
	924	(define-ppc32-vinsn require-real (()
	925	((object :lisp))
	926	((crf0 (:crf 0))
	927	(tag :u8)))
	928	:again
	929	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	930	(beq+ crf0 :got-it)
	931	(cmpwi crf0 tag ppc32::tag-misc)
	932	(bne crf0 :no-got)
	933	(lbz tag ppc32::misc-subtag-offset object)
	934	(cmplwi crf0 tag ppc32::max-real-subtag)
	935	(ble+ crf0 :got-it)
	936	:no-got
	937	(uuo_intcerr arch::error-object-not-real object)
	938	(b :again)
	939	:got-it)
	940
	941	(define-ppc32-vinsn require-number (()
	942	((object :lisp))
	943	((crf0 (:crf 0))
	944	(tag :u8)
	945	(crf1 :crf)
	946	(crf2 :crf)))
	947	:again
	948	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	949	(beq+ crf0 :got-it)
	950	(cmpwi crf0 tag ppc32::tag-misc)
	951	(bne crf0 :no-got)
	952	(lbz tag ppc32::misc-subtag-offset object)
	953	(cmpwi crf1 tag ppc32::subtag-complex-double-float)
	954	(cmpwi crf2 tag ppc32::subtag-complex-single-float)
	955	(cmplwi crf0 tag ppc32::max-numeric-subtag)
	956	(beq crf1 :got-it)
	957	(beq crf2 :got-it)
	958	(ble+ crf0 :got-it)
	959	:no-got
	960	(uuo_intcerr arch::error-object-not-number object)
	961	(b :again)
	962	:got-it)
	963
	964
	965	(define-ppc32-vinsn require-list (()
	966	((object :lisp))
	967	((tag :u8)
	968	(crf :crf)))
	969	:again
	970	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	971	(cmpwi crf tag ppc32::tag-list)
	972	(beq+ crf :got-it)
	973	(uuo_intcerr arch::error-object-not-list object)
	974	(b :again)
	975	:got-it)
	976
	977	(define-ppc32-vinsn require-symbol (()
	978	((object :lisp))
	979	((tag :u8)
	980	(crf :crf)))
	981	:again
	982	(cmpwi crf object (:apply target-nil-value))
	983	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	984	(beq crf :got-it)
	985	(cmpwi crf tag ppc32::tag-misc)
	986	(bne crf :no-got)
	987	(lbz tag ppc32::misc-subtag-offset object)
	988	(cmpwi crf tag ppc32::subtag-symbol)
	989	(beq+ crf :got-it)
	990	:no-got
	991	(uuo_intcerr arch::error-object-not-symbol object)
	992	(b :again)
	993	:got-it)
	994
	995	(define-ppc32-vinsn require-character (()
	996	((object :lisp))
	997	((tag :u8)
	998	(crf :crf)))
	999	:again
	1000	(clrlwi tag object (- ppc32::nbits-in-word ppc32::num-subtag-bits))
	1001	(cmpwi crf tag ppc32::subtag-character)
	1002	(beq+ crf :got-it)
	1003	(uuo_intcerr arch::error-object-not-character object)
	1004	(b :again)
	1005	:got-it)
	1006
	1007
	1008	(define-ppc32-vinsn require-s8 (()
	1009	((object :lisp))
	1010	((crf :crf)
	1011	(tag :u32)))
	1012	:again
	1013	(slwi tag object (- ppc32::nbits-in-word (+ 8 ppc32::fixnumshift)))
	1014	(srawi tag tag (- ppc32::nbits-in-word 8 ))
	1015	(slwi tag tag ppc32::fixnumshift)
	1016	(cmpw crf tag object)
	1017	(beq+ crf :got-it)
	1018	:bad
	1019	(uuo_intcerr arch::error-object-not-signed-byte-8 object)
	1020	(b :again)
	1021	:got-it)
	1022
	1023	(define-ppc32-vinsn require-u8 (()
	1024	((object :lisp))
	1025	((crf0 (:crf 0))
	1026	(tag :u32)))
	1027	:again
	1028	;; The bottom ppc32::fixnumshift bits and the top (- 32 (+
	1029	;; ppc32::fixnumshift 8)) must all be zero.
	1030	(rlwinm. tag object 0 (- ppc32::nbits-in-word ppc32::fixnumshift) (- ppc32::least-significant-bit (+ ppc32::fixnumshift 8)))
	1031	(beq+ crf0 :got-it)
	1032	(uuo_intcerr arch::error-object-not-unsigned-byte-8 object)
	1033	(b :again)
	1034	:got-it)
	1035
	1036	(define-ppc32-vinsn require-s16 (()
	1037	((object :lisp))
	1038	((crf :crf)
	1039	(tag :u32)))
	1040	:again
	1041	(slwi tag object (- ppc32::nbits-in-word (+ 16 ppc32::fixnumshift)))
	1042	(srawi tag tag (- ppc32::nbits-in-word 16))
	1043	(slwi tag tag ppc32::fixnumshift)
	1044	(cmpw crf tag object)
	1045	(beq+ crf :got-it)
	1046	:bad
	1047	(uuo_intcerr arch::error-object-not-signed-byte-16 object)
	1048	(b :again)
	1049	:got-it)
	1050
	1051	(define-ppc32-vinsn require-u16 (()
	1052	((object :lisp))
	1053	((crf0 (:crf 0))
	1054	(tag :u32)))
	1055	:again
	1056	;; The bottom ppc32::fixnumshift bits and the top (- 32 (+
	1057	;; ppc32::fixnumshift 16)) must all be zero.
	1058	(rlwinm. tag object 0 (- ppc32::nbits-in-word ppc32::fixnumshift) (- ppc32::least-significant-bit (+ ppc32::fixnumshift 16)))
	1059	(beq+ crf0 :got-it)
	1060	(uuo_intcerr arch::error-object-not-unsigned-byte-16 object)
	1061	(b :again)
	1062	:got-it)
	1063
	1064	(define-ppc32-vinsn require-s32 (()
	1065	((src :lisp))
	1066	((crfx :crf)
	1067	(crfy :crf)
	1068	(tag :u32)))
	1069	:again
	1070	(clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1071	(cmpwi crfx tag ppc32::tag-fixnum)
	1072	(cmpwi crfy tag ppc32::tag-misc)
	1073	(beq+ crfx :got-it)
	1074	(bne- crfy :bad)
	1075	(lwz tag ppc32::misc-header-offset src)
	1076	(cmpwi crfx tag ppc32::one-digit-bignum-header)
	1077	(beq+ crfx :got-it)
	1078	:bad
	1079	(uuo_intcerr arch::error-object-not-signed-byte-32 src)
	1080	(b :again)
	1081	:got-it)
	1082
	1083
	1084	(define-ppc32-vinsn require-u32 (()
	1085	((src :lisp))
	1086	((crf0 (:crf 0))
	1087	(crf1 :crf)
	1088	(temp :u32)))
	1089	:again
	1090	(rlwinm. temp src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) 0)
	1091	(beq+ crf0 :got-it)
	1092	(clrlwi temp src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1093	(cmpwi crf0 temp ppc32::tag-misc)
	1094	(bne- crf0 :bad)
	1095	(lwz temp ppc32::misc-header-offset src)
	1096	(cmpwi crf1 temp ppc32::two-digit-bignum-header)
	1097	(cmpwi crf0 temp ppc32::one-digit-bignum-header)
	1098	(lwz temp ppc32::misc-data-offset src)
	1099	(beq crf1 :two)
	1100	(bne crf0 :bad)
	1101	(cmpwi crf0 temp 0)
	1102	(bgt+ crf0 :got-it)
	1103	:bad
	1104	(uuo_intcerr arch::error-object-not-unsigned-byte-32 src)
	1105	(b :again)
	1106	:two
	1107	(lwz temp (+ ppc32::misc-data-offset 4) src)
	1108	(cmpwi crf0 temp 0)
	1109	(bne- crf0 :bad)
	1110	:got-it)
	1111
	1112	(define-ppc32-vinsn require-s64 (()
	1113	((src :lisp))
	1114	((crfx :crf)
	1115	(crfy :crf)
	1116	(tag :u32)))
	1117	:again
	1118	(clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1119	(cmpwi crfx tag ppc32::tag-fixnum)
	1120	(cmpwi crfy tag ppc32::tag-misc)
	1121	(beq+ crfx :got-it)
	1122	(bne- crfy :bad)
	1123	(lwz tag ppc32::misc-header-offset src)
	1124	(cmpwi crfx tag ppc32::one-digit-bignum-header)
	1125	(cmpwi crfy tag ppc32::two-digit-bignum-header)
	1126	(lwz tag ppc32::misc-data-offset src)
	1127	(beq+ crfx :got-it)
	1128	(beq+ crfy :got-it)
	1129	:bad
	1130	(uuo_intcerr arch::error-object-not-signed-byte-64 src)
	1131	(b :again)
	1132	:got-it)
	1133
	1134	(define-ppc32-vinsn require-u64 (()
	1135	((src :lisp))
	1136	((crf0 (:crf 0))
	1137	(crf1 :crf)
	1138	(crf2 :crf)
	1139	(temp :u32)))
	1140	:again
	1141	(rlwinm. temp src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) 0)
	1142	(beq+ crf0 :got-it)
	1143	(clrlwi temp src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1144	(cmpwi crf0 temp ppc32::tag-misc)
	1145	(bne- crf0 :bad)
	1146	(lwz temp ppc32::misc-header-offset src)
	1147	(cmpwi crf2 temp ppc32::three-digit-bignum-header)
	1148	(cmpwi crf1 temp ppc32::two-digit-bignum-header)
	1149	(cmpwi crf0 temp ppc32::one-digit-bignum-header)
	1150	(lwz temp ppc32::misc-data-offset src)
	1151	(beq crf2 :three)
	1152	(beq crf1 :two)
	1153	(bne crf0 :bad)
	1154	(cmpwi crf0 temp 0)
	1155	(bgt+ crf0 :got-it)
	1156	:bad
	1157	(uuo_intcerr arch::error-object-not-unsigned-byte-64 src)
	1158	(b :again)
	1159	:three
	1160	(lwz temp (+ ppc32::misc-data-offset 8) src)
	1161	(cmpwi crf0 temp 0)
	1162	(beq+ crf0 :got-it)
	1163	(b :bad)
	1164	:two
	1165	(lwz temp (+ ppc32::misc-data-offset 4) src)
	1166	(cmpwi crf0 temp 0)
	1167	(blt- crf0 :bad)
	1168	:got-it)
	1169
	1170
	1171
	1172	(define-ppc32-vinsn require-char-code (()
	1173	((object :lisp))
	1174	((crf0 (:crf 0))
	1175	(crf1 :crf)
	1176	(tag :u32)))
	1177	:again
	1178	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1179	(lis tag (ash (ash #x110000 ppc32::fixnumshift) -16))
	1180	(cmplw crf1 object tag)
	1181	(bne crf0 :bad)
	1182	(blt+ crf1 :got-it)
	1183	:bad
	1184	(uuo_intcerr arch::error-object-not-mod-char-code-limit object)
	1185	(b :again)
	1186	:got-it)
	1187
	1188
	1189	(define-ppc32-vinsn box-fixnum (((dest :imm))
	1190	((src :s32)))
	1191	(slwi dest src ppc32::fixnumshift))
	1192
	1193	(define-ppc32-vinsn fixnum->signed-natural (((dest :s32))
	1194	((src :imm)))
	1195	(srawi dest src ppc32::fixnumshift))
	1196
	1197	(define-ppc32-vinsn fixnum->unsigned-natural (((dest :u32))
	1198	((src :imm)))
	1199	(srwi dest src ppc32::fixnumshift))
	1200
	1201	;;; An object is of type (UNSIGNED-BYTE 32) iff
	1202	;;; a) it's of type (UNSIGNED-BYTE 30) (e.g., an unsigned fixnum)
	1203	;;; b) it's a bignum of length 1 and the 0'th digit is positive
	1204	;;; c) it's a bignum of length 2 and the sign-digit is 0.
	1205
	1206	(define-ppc32-vinsn unbox-u32 (((dest :u32))
	1207	((src :lisp))
	1208	((crf0 (:crf 0))
	1209	(crf1 :crf)))
	1210	(rlwinm. dest src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) 0)
	1211	(srwi dest src ppc32::fixnumshift)
	1212	(beq+ crf0 :got-it)
	1213	(clrlwi dest src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1214	(cmpwi crf0 dest ppc32::tag-misc)
	1215	(bne- crf0 :bad)
	1216	(lwz dest ppc32::misc-header-offset src)
	1217	(cmpwi crf1 dest ppc32::two-digit-bignum-header)
	1218	(cmpwi crf0 dest ppc32::one-digit-bignum-header)
	1219	(lwz dest ppc32::misc-data-offset src)
	1220	(beq crf1 :two)
	1221	(bne crf0 :bad)
	1222	(cmpwi crf0 dest 0)
	1223	(bgt+ crf0 :got-it)
	1224	:bad
	1225	(uuo_interr arch::error-object-not-unsigned-byte-32 src)
	1226	:two
	1227	(lwz dest (+ ppc32::misc-data-offset 4) src)
	1228	(cmpwi crf0 dest 0)
	1229	(bne- crf0 :bad)
	1230	(lwz dest ppc32::misc-data-offset src)
	1231	:got-it)
	1232
	1233	;;; an object is of type (SIGNED-BYTE 32) iff
	1234	;;; a) it's a fixnum
	1235	;;; b) it's a bignum with exactly one digit.
	1236
	1237	(define-ppc32-vinsn unbox-s32 (((dest :s32))
	1238	((src :lisp))
	1239	((crfx :crf)
	1240	(crfy :crf)
	1241	(tag :u32)))
	1242	(clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1243	(cmpwi crfx tag ppc32::tag-fixnum)
	1244	(cmpwi crfy tag ppc32::tag-misc)
	1245	(srawi dest src ppc32::fixnumshift)
	1246	(beq+ crfx :got-it)
	1247	(bne- crfy :bad)
	1248	(lwz tag ppc32::misc-header-offset src)
	1249	(cmpwi crfx tag ppc32::one-digit-bignum-header)
	1250	(lwz dest ppc32::misc-data-offset src)
	1251	(beq+ crfx :got-it)
	1252	:bad
	1253	(uuo_interr arch::error-object-not-signed-byte-32 src)
	1254	:got-it)
	1255
	1256	;;; For the sake of argument, "dest" is u32.
	1257	;;; Return dest if src is either (signed-byte 32) or (unsigned-byte 32).
	1258	;;; Say that it's not (signed-byte 32) if neither.
	1259	(define-ppc32-vinsn unbox-x32 (((dest :u32))
	1260	((src :lisp))
	1261	((crfx :crf)
	1262	(crfy :crf)
	1263	(tag :u32)))
	1264	(clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1265	(cmpwi crfx tag ppc32::tag-fixnum)
	1266	(cmpwi crfy tag ppc32::tag-misc)
	1267	(srawi dest src ppc32::fixnumshift)
	1268	(beq+ crfx :got-it)
	1269	(bne- crfy :bad)
	1270	(lwz tag ppc32::misc-header-offset src)
	1271	(cmpwi crfx tag (logior (ash 1 ppc32::num-subtag-bits) ppc32::subtag-bignum))
	1272	(cmpwi crfy tag (logior (ash 2 ppc32::num-subtag-bits) ppc32::subtag-bignum))
	1273	(lwz dest ppc32::misc-data-offset src)
	1274	(beq crfx :got-it)
	1275	(lwz tag (+ 4 ppc32::misc-data-offset) src)
	1276	(cmpwi crfx tag 0)
	1277	(bne crfy :bad)
	1278	(beq+ crfx :got-it)
	1279	:bad
	1280	(uuo_interr arch::error-object-not-signed-byte-32 src)
	1281	:got-it)
	1282
	1283	(define-ppc32-vinsn unbox-u16 (((dest :u16))
	1284	((src :lisp))
	1285	((crf0 (:crf 0))))
	1286	; The bottom ppc32::fixnumshift bits and the top (- 31 (+ ppc32::fixnumshift 16)) must all be zero.
	1287	(rlwinm. dest src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) (- ppc32::least-significant-bit (+ ppc32::fixnumshift 16)))
	1288	(rlwinm dest src (- 32 ppc32::fixnumshift) 16 31)
	1289	(beq+ crf0 :got-it)
	1290	(uuo_interr arch::error-object-not-unsigned-byte-16 src)
	1291	:got-it)
	1292
	1293	(define-ppc32-vinsn unbox-s16 (((dest :s16))
	1294	((src :lisp))
	1295	((crf :crf)))
	1296	(slwi dest src (- ppc32::nbits-in-word (+ 16 ppc32::fixnumshift)))
	1297	(srawi dest dest (- ppc32::nbits-in-word 16))
	1298	(slwi dest dest ppc32::fixnumshift)
	1299	(cmpw crf dest src)
	1300	(srawi dest src ppc32::fixnumshift)
	1301	(beq+ crf :got-it)
	1302	:bad
	1303	(uuo_interr arch::error-object-not-signed-byte-16 src)
	1304	:got-it)
	1305
	1306
	1307
	1308	(define-ppc32-vinsn unbox-u8 (((dest :u8))
	1309	((src :lisp))
	1310	((crf0 (:crf 0))))
	1311	;; The bottom ppc32::fixnumshift bits and the top (- 31 (+
	1312	;; ppc32::fixnumshift 8)) must all be zero.
	1313	(rlwinm. dest src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) (- ppc32::least-significant-bit (+ ppc32::fixnumshift 8)))
	1314	(rlwinm dest src (- 32 ppc32::fixnumshift) 24 31)
	1315	(beq+ crf0 :got-it)
	1316	(uuo_interr arch::error-object-not-unsigned-byte-8 src)
	1317	:got-it)
	1318
	1319	(define-ppc32-vinsn %unbox-u8 (((dest :u8))
	1320	((src :lisp))
	1321	)
	1322	(rlwinm dest src (- 32 ppc32::fixnumshift) 24 31))
	1323
	1324	(define-ppc32-vinsn unbox-s8 (((dest :s8))
	1325	((src :lisp))
	1326	((crf :crf)))
	1327	(slwi dest src (- ppc32::nbits-in-word (+ 8 ppc32::fixnumshift)))
	1328	(srawi dest dest (- ppc32::nbits-in-word 8))
	1329	(slwi dest dest ppc32::fixnumshift)
	1330	(cmpw crf dest src)
	1331	(srawi dest src ppc32::fixnumshift)
	1332	(beq+ crf :got-it)
	1333	:bad
	1334	(uuo_interr arch::error-object-not-signed-byte-8 src)
	1335	:got-it)
	1336
	1337	(define-ppc32-vinsn unbox-base-char (((dest :u32))
	1338	((src :lisp))
	1339	((crf :crf)))
	1340	(rlwinm dest src 0 24 31)
	1341	(cmpwi crf dest ppc32::subtag-character)
	1342	(srwi dest src ppc32::charcode-shift)
	1343	(beq+ crf :got-it)
	1344	(uuo_interr arch::error-object-not-base-char src)
	1345	:got-it)
	1346
	1347
	1348	(define-ppc32-vinsn unbox-bit (((dest :u32))
	1349	((src :lisp))
	1350	((crf :crf)))
	1351	(cmplwi crf src (ash 1 ppc32::fixnumshift))
	1352	(srawi dest src ppc32::fixnumshift)
	1353	(ble+ crf :got-it)
	1354	(uuo_interr arch::error-object-not-bit src)
	1355	:got-it)
	1356
	1357	(define-ppc32-vinsn unbox-bit-bit0 (((dest :u32))
	1358	((src :lisp))
	1359	((crf :crf)))
	1360	(cmplwi crf src (ash 1 ppc32::fixnumshift))
	1361	(rlwinm dest src (- 32 (1+ ppc32::fixnumshift)) 0 0)
	1362	(ble+ crf :got-it)
	1363	(uuo_interr arch::error-object-not-bit src)
	1364	:got-it)
	1365
	1366	(define-ppc32-vinsn fixnum->fpr (((dest :double-float))
	1367	((src :lisp))
	1368	((imm :s32)))
	1369	(stfd ppc::fp-s32conv -8 ppc::sp)
	1370	(srawi imm src ppc32::fixnumshift)
	1371	(xoris imm imm #x8000)
	1372	(stw imm -4 ppc::sp)
	1373	(lfd dest -8 ppc::sp)
	1374	(fsub dest dest ppc::fp-s32conv))
	1375
	1376
	1377	(define-ppc32-vinsn shift-right-variable-word (((dest :u32))
	1378	((src :u32)
	1379	(sh :u32)))
	1380	(srw dest src sh))
	1381
	1382	(define-ppc32-vinsn u32logandc2 (((dest :u32))
	1383	((x :u32)
	1384	(y :u32)))
	1385	(andc dest x y))
	1386
	1387	(define-ppc32-vinsn u32logior (((dest :u32))
	1388	((x :u32)
	1389	(y :u32)))
	1390	(or dest x y))
	1391
	1392	(define-ppc32-vinsn rotate-left-variable-word (((dest :u32))
	1393	((src :u32)
	1394	(rot :u32)))
	1395	(rlwnm dest src rot 0 31))
	1396
	1397	(define-ppc32-vinsn complement-shift-count (((dest :u32))
	1398	((src :u32)))
	1399	(subfic dest src 32))
	1400
	1401	(define-ppc32-vinsn extract-lowbyte (((dest :u32))
	1402	((src :lisp)))
	1403	(clrlwi dest src (- ppc32::nbits-in-word ppc32::num-subtag-bits)))
	1404
	1405	;;; Set DEST to the difference between the low byte of SRC and BYTEVAL.
	1406	(define-ppc32-vinsn extract-compare-lowbyte (((dest :u32))
	1407	((src :lisp)
	1408	(byteval :u8const)))
	1409	(clrlwi dest src (- ppc32::nbits-in-word ppc32::num-subtag-bits))
	1410	(subi dest dest byteval))
	1411
	1412
	1413	;;; Set the "EQ" bit in condition-register field CRF if object is
	1414	;;; a fixnum. Leave the object's tag in TAG.
	1415	;;; This is a little easier if CRF is CR0.
	1416	(define-ppc32-vinsn eq-if-fixnum (((crf :crf)
	1417	(tag :u8))
	1418	((object :lisp))
	1419	())
	1420	((:eq crf 0)
	1421	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits)))
	1422	((:not (:eq crf 0))
	1423	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1424	(cmpwi crf tag ppc32::tag-fixnum)))
	1425
	1426
	1427
	1428	(define-ppc32-vinsn trap-unless-fixnum (()
	1429	((object :lisp))
	1430	((tag :u8)))
	1431	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1432	(twnei tag ppc32::tag-fixnum))
	1433
	1434	(define-ppc32-vinsn trap-unless-list (()
	1435	((object :lisp))
	1436	((tag :u8)))
	1437	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1438	(twnei tag ppc32::tag-list))
	1439
	1440	(define-ppc32-vinsn trap-unless-single-float (()
	1441	((object :lisp))
	1442	((tag :u8)
	1443	(crf :crf)))
	1444	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1445	(cmpwi crf tag ppc32::tag-misc)
	1446	(bne crf :do-trap)
	1447	(lbz tag ppc32::misc-subtag-offset object)
	1448	:do-trap
	1449	(twnei tag ppc32::subtag-single-float))
	1450
	1451	(define-ppc32-vinsn trap-unless-double-float (()
	1452	((object :lisp))
	1453	((tag :u8)
	1454	(crf :crf)))
	1455	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1456	(cmpwi crf tag ppc32::tag-misc)
	1457	(bne crf :do-trap)
	1458	(lbz tag ppc32::misc-subtag-offset object)
	1459	:do-trap
	1460	(twnei tag ppc32::subtag-double-float))
	1461
	1462
	1463	(define-ppc32-vinsn trap-unless-complex-single-float (()
	1464	((object :lisp))
	1465	((tag :u8)
	1466	(crf :crf)))
	1467	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1468	(cmpwi crf tag ppc32::tag-misc)
	1469	(bne crf :do-trap)
	1470	(lbz tag ppc32::misc-subtag-offset object)
	1471	:do-trap
	1472	(twnei tag ppc32::subtag-complex-single-float))
	1473
	1474	(define-ppc32-vinsn trap-unless-complex-double-float (()
	1475	((object :lisp))
	1476	((tag :u8)
	1477	(crf :crf)))
	1478	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1479	(cmpwi crf tag ppc32::tag-misc)
	1480	(bne crf :do-trap)
	1481	(lbz tag ppc32::misc-subtag-offset object)
	1482	:do-trap
	1483	(twnei tag ppc32::subtag-complex-double-float))
	1484
	1485	(define-ppc32-vinsn trap-unless-array-header (()
	1486	((object :lisp))
	1487	((tag :u8)
	1488	(crf :crf)))
	1489	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1490	(cmpwi crf tag ppc32::tag-misc)
	1491	(bne crf :do-trap)
	1492	(lbz tag ppc32::misc-subtag-offset object)
	1493	:do-trap
	1494	(twnei tag ppc32::subtag-arrayH))
	1495
	1496	(define-ppc32-vinsn trap-unless-macptr (()
	1497	((object :lisp))
	1498	((tag :u8)
	1499	(crf :crf)))
	1500	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1501	(cmpwi crf tag ppc32::tag-misc)
	1502	(bne crf :do-trap)
	1503	(lbz tag ppc32::misc-subtag-offset object)
	1504	:do-trap
	1505	(twnei tag ppc32::subtag-macptr))
	1506
	1507
	1508
	1509	(define-ppc32-vinsn trap-unless-uvector (()
	1510	((object :lisp))
	1511	((tag :u8)))
	1512	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1513	(twnei tag ppc32::tag-misc))
	1514
	1515	(define-ppc32-vinsn trap-unless-fulltag= (()
	1516	((object :lisp)
	1517	(tagval :u16const))
	1518	((tag :u8)))
	1519	(clrlwi tag object (- ppc32::nbits-in-word ppc32::ntagbits))
	1520	(twnei tag tagval))
	1521
	1522	(define-ppc32-vinsn trap-unless-lowbyte= (()
	1523	((object :lisp)
	1524	(tagval :u16const))
	1525	((tag :u8)))
	1526	(clrlwi tag object (- ppc32::nbits-in-word 8))
	1527	(twnei tag tagval))
	1528
	1529	(define-ppc32-vinsn trap-unless-character (()
	1530	((object :lisp))
	1531	((tag :u8)))
	1532	(clrlwi tag object (- ppc32::nbits-in-word 8))
	1533	(twnei tag ppc32::subtag-character))
	1534
	1535	(define-ppc32-vinsn trap-unless-cons (()
	1536	((object :lisp))
	1537	((tag :u8)))
	1538	(clrlwi tag object (- ppc32::nbits-in-word ppc32::ntagbits))
	1539	(twnei tag ppc32::fulltag-cons))
	1540
	1541	(define-ppc32-vinsn trap-unless-typecode= (()
	1542	((object :lisp)
	1543	(tagval :u16const))
	1544	((tag :u8)
	1545	(crf :crf)))
	1546	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1547	(cmpwi crf tag ppc32::tag-misc)
	1548	(bne crf :do-trap)
	1549	(lbz tag ppc32::misc-subtag-offset object)
	1550	:do-trap
	1551	(twnei tag tagval))
	1552
	1553	(define-ppc32-vinsn subtract-constant (((dest :imm))
	1554	((src :imm)
	1555	(const :s16const)))
	1556	(subi dest src const))
	1557
	1558	(define-ppc32-vinsn trap-unless-numeric-type (()
	1559	((object :lisp)
	1560	(maxtype :u16const))
	1561	((crf0 (:crf 0))
	1562	(tag :u8)
	1563	(crfX :crf)))
	1564	(clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	1565	(cmpwi tag ppc32::tag-misc)
	1566	(beq+ crf0 :fixnum)
	1567	(bne crfX :scale-tag)
	1568	(lbz tag ppc32::misc-subtag-offset object)
	1569	:scale-tag
	1570	(subi tag tag ppc32::min-numeric-subtag)
	1571	(twlgti tag (:apply - maxtype ppc32::min-numeric-subtag))
	1572	:fixnum)
	1573
	1574
	1575	;; Bit-extraction & boolean operations
	1576
	1577	(eval-when (:compile-toplevel :execute)
	1578	(assert (= ppc32::t-offset #b10001))) ; PPC-bits 31 and 27 set
	1579
	1580	;; For some mind-numbing reason, IBM decided to call the most significant
	1581	;; bit in a 32-bit word "bit 0" and the least significant bit "bit 31"
	1582	;; (this despite the fact that it's essentially a big-endian architecture
	1583	;; (it was exclusively big-endian when this decision was made.))
	1584	;; We'll probably be least confused if we consistently use this backwards
	1585	;; bit ordering (letting things that have a "sane" bit-number worry about
	1586	;; it at compile-time or run-time (subtracting the "sane" bit number from
	1587	;; 31.))
	1588
	1589	(define-ppc32-vinsn extract-variable-bit (((dest :u8))
	1590	((src :u32)
	1591	(bitnum :u8))
	1592	())
	1593	(rotlw dest src bitnum)
	1594	(extrwi dest dest 1 0))
	1595
	1596
	1597	(define-ppc32-vinsn extract-variable-bit-fixnum (((dest :imm))
	1598	((src :u32)
	1599	(bitnum :u8))
	1600	((temp :u32)))
	1601	(rotlw temp src bitnum)
	1602	(rlwinm dest
	1603	temp
	1604	(1+ ppc32::fixnumshift)
	1605	(- ppc32::least-significant-bit ppc32::fixnumshift)
	1606	(- ppc32::least-significant-bit ppc32::fixnumshift)))
	1607
	1608
	1609	;; Sometimes we try to extract a single bit from some source register
	1610	;; into a destination bit (typically 31, sometimes fixnum bit 0 = 29).
	1611	;; If we copy bit 0 (whoops, I mean "bit 31") to bit 4 (aka 27) in a
	1612	;; given register, we get a value that's either 17 (the arithmetic difference
	1613	;; between T and NIL) or 0.
	1614
	1615	(define-ppc32-vinsn lowbit->truth (((dest :lisp)
	1616	(bits :u32))
	1617	((bits :u32))
	1618	())
	1619	(rlwimi bits bits (- ppc32::least-significant-bit 27) 27 27) ; bits = 0000...X000X
	1620	(addi dest bits (:apply target-nil-value)))
	1621
	1622	(define-ppc32-vinsn invert-lowbit (((bits :u32))
	1623	((bits :u32))
	1624	())
	1625	(xori bits bits 1))
	1626
	1627
	1628
	1629	;; Some of the obscure-looking instruction sequences - which map some relation
	1630	;; to PPC bit 31 of some register - were found by the GNU SuperOptimizer.
	1631	;; Some of them use extended-precision instructions (which may cause interlocks
	1632	;; on some superscalar PPCs, if I remember correctly.) In general, sequences
	1633	;; that GSO found that -don't- do extended precision are longer and/or use
	1634	;; more temporaries.
	1635	;; On the 604, the penalty for using an instruction that uses the CA bit is
	1636	;; "at least" one cycle: it can't complete execution until all "older" instructions
	1637	;; have. That's not horrible, especially given that the alternative is usually
	1638	;; to use more instructions (and, more importantly, more temporaries) to avoid
	1639	;; using extended-precision.
	1640
	1641
	1642	(define-ppc32-vinsn eq0->bit31 (((bits :u32))
	1643	((src (t (:ne bits)))))
	1644	(cntlzw bits src)
	1645	(srwi bits bits 5)) ; bits = 0000...000X
	1646
	1647	(define-ppc32-vinsn ne0->bit31 (((bits :u32))
	1648	((src (t (:ne bits)))))
	1649	(cntlzw bits src)
	1650	(slw bits src bits)
	1651	(srwi bits bits 31)) ; bits = 0000...000X
	1652
	1653	(define-ppc32-vinsn lt0->bit31 (((bits :u32))
	1654	((src (t (:ne bits)))))
	1655	(srwi bits src 31)) ; bits = 0000...000X
	1656
	1657
	1658	(define-ppc32-vinsn ge0->bit31 (((bits :u32))
	1659	((src (t (:ne bits)))))
	1660	(srwi bits src 31)
	1661	(xori bits bits 1)) ; bits = 0000...000X
	1662
	1663
	1664	(define-ppc32-vinsn le0->bit31 (((bits :u32))
	1665	((src (t (:ne bits)))))
	1666	(neg bits src)
	1667	(orc bits bits src)
	1668	(srwi bits bits 31)) ; bits = 0000...000X
	1669
	1670	(define-ppc32-vinsn gt0->bit31 (((bits :u32))
	1671	((src (t (:ne bits)))))
	1672	(subi bits src 1)
	1673	(nor bits bits src)
	1674	(srwi bits bits 31)) ; bits = 0000...000X
	1675
	1676	(define-ppc32-vinsn ne->bit31 (((bits :u32))
	1677	((x t)
	1678	(y t))
	1679	((temp :u32)))
	1680	(subf temp x y)
	1681	(cntlzw bits temp)
	1682	(slw bits temp bits)
	1683	(srwi bits bits 31)) ; bits = 0000...000X
	1684
	1685	(define-ppc32-vinsn fulltag->bit31 (((bits :u32))
	1686	((lispobj :lisp)
	1687	(tagval :u8const))
	1688	())
	1689	(clrlwi bits lispobj (- ppc32::nbits-in-word ppc32::ntagbits))
	1690	(subi bits bits tagval)
	1691	(cntlzw bits bits)
	1692	(srwi bits bits 5))
	1693
	1694
	1695	(define-ppc32-vinsn eq->bit31 (((bits :u32))
	1696	((x t)
	1697	(y t)))
	1698	(subf bits x y)
	1699	(cntlzw bits bits)
	1700	(srwi bits bits 5)) ; bits = 0000...000X
	1701
	1702	(define-ppc32-vinsn eqnil->bit31 (((bits :u32))
	1703	((x t)))
	1704	(subi bits x (:apply target-nil-value))
	1705	(cntlzw bits bits)
	1706	(srwi bits bits 5))
	1707
	1708	(define-ppc32-vinsn ne->bit31 (((bits :u32))
	1709	((x t)
	1710	(y t)))
	1711	(subf bits x y)
	1712	(cntlzw bits bits)
	1713	(srwi bits bits 5)
	1714	(xori bits bits 1))
	1715
	1716	(define-ppc32-vinsn nenil->bit31 (((bits :u32))
	1717	((x t)))
	1718	(subi bits x (:apply target-nil-value))
	1719	(cntlzw bits bits)
	1720	(srwi bits bits 5)
	1721	(xori bits bits 1))
	1722
	1723	(define-ppc32-vinsn lt->bit31 (((bits :u32))
	1724	((x (t (:ne bits)))
	1725	(y (t (:ne bits)))))
	1726
	1727	(xor bits x y)
	1728	(srawi bits bits 31)
	1729	(or bits bits x)
	1730	(subf bits y bits)
	1731	(srwi bits bits 31)) ; bits = 0000...000X
	1732
	1733	(define-ppc32-vinsn ltu->bit31 (((bits :u32))
	1734	((x :u32)
	1735	(y :u32)))
	1736	(subfc bits y x)
	1737	(subfe bits bits bits)
	1738	(neg bits bits))
	1739
	1740	(define-ppc32-vinsn le->bit31 (((bits :u32))
	1741	((x (t (:ne bits)))
	1742	(y (t (:ne bits)))))
	1743
	1744	(xor bits x y)
	1745	(srawi bits bits 31)
	1746	(nor bits bits y)
	1747	(add bits bits x)
	1748	(srwi bits bits 31)) ; bits = 0000...000X
	1749
	1750	(define-ppc32-vinsn leu->bit31 (((bits :u32))
	1751	((x :u32)
	1752	(y :u32)))
	1753	(subfc bits x y)
	1754	(addze bits ppc::rzero))
	1755
	1756	(define-ppc32-vinsn gt->bit31 (((bits :u32))
	1757	((x (t (:ne bits)))
	1758	(y (t (:ne bits)))))
	1759
	1760	(eqv bits x y)
	1761	(srawi bits bits 31)
	1762	(and bits bits x)
	1763	(subf bits bits y)
	1764	(srwi bits bits 31)) ; bits = 0000...000X
	1765
	1766	(define-ppc32-vinsn gtu->bit31 (((bits :u32))
	1767	((x :u32)
	1768	(y :u32)))
	1769	(subfc bits x y)
	1770	(subfe bits bits bits)
	1771	(neg bits bits))
	1772
	1773	(define-ppc32-vinsn ge->bit31 (((bits :u32))
	1774	((x (t (:ne bits)))
	1775	(y (t (:ne bits)))))
	1776	(eqv bits x y)
	1777	(srawi bits bits 31)
	1778	(andc bits bits x)
	1779	(add bits bits y)
	1780	(srwi bits bits 31)) ; bits = 0000...000X
	1781
	1782	(define-ppc32-vinsn geu->bit31 (((bits :u32))
	1783	((x :u32)
	1784	(y :u32)))
	1785	(subfc bits y x)
	1786	(addze bits ppc::rzero))
	1787
	1788
	1789	;;; there are big-time latencies associated with MFCR on more heavily
	1790	;;; pipelined processors; that implies that we should avoid this like
	1791	;;; the plague.
	1792	;;; GSO can't find anything much quicker for LT or GT, even though
	1793	;;; MFCR takes three cycles and waits for previous instructions to complete.
	1794	;;; Of course, using a CR field costs us something as well.
	1795	(define-ppc32-vinsn crbit->bit31 (((bits :u32))
	1796	((crf :crf)
	1797	(bitnum :crbit))
	1798	())
	1799	(mfcr bits) ; Suffer.
	1800	(rlwinm bits bits (:apply + 1 bitnum (:apply ash crf 2)) 31 31)) ; bits = 0000...000X
	1801
	1802
	1803	(define-ppc32-vinsn compare (((crf :crf))
	1804	((arg0 t)
	1805	(arg1 t))
	1806	())
	1807	(cmpw crf arg0 arg1))
	1808
	1809	(define-ppc32-vinsn compare-to-nil (((crf :crf))
	1810	((arg0 t)))
	1811	(cmpwi crf arg0 (:apply target-nil-value)))
	1812
	1813	(define-ppc32-vinsn compare-logical (((crf :crf))
	1814	((arg0 t)
	1815	(arg1 t))
	1816	())
	1817	(cmplw crf arg0 arg1))
	1818
	1819	(define-ppc32-vinsn double-float-compare (((crf :crf))
	1820	((arg0 :double-float)
	1821	(arg1 :double-float))
	1822	())
	1823	(fcmpo crf arg0 arg1))
	1824
	1825
	1826	(define-ppc32-vinsn double-float+-2 (((result :double-float))
	1827	((x :double-float)
	1828	(y :double-float))
	1829	((crf (:crf 4))))
	1830	(fadd result x y))
	1831
	1832	(define-ppc32-vinsn double-float--2 (((result :double-float))
	1833	((x :double-float)
	1834	(y :double-float))
	1835	((crf (:crf 4))))
	1836	(fsub result x y))
	1837
	1838	(define-ppc32-vinsn double-float*-2 (((result :double-float))
	1839	((x :double-float)
	1840	(y :double-float))
	1841	((crf (:crf 4))))
	1842	(fmul result x y))
	1843
	1844	(define-ppc32-vinsn double-float/-2 (((result :double-float))
	1845	((x :double-float)
	1846	(y :double-float))
	1847	((crf (:crf 4))))
	1848	(fdiv result x y))
	1849
	1850	(define-ppc32-vinsn single-float+-2 (((result :single-float))
	1851	((x :single-float)
	1852	(y :single-float))
	1853	((crf (:crf 4))))
	1854	(fadds result x y))
	1855
	1856	(define-ppc32-vinsn single-float--2 (((result :single-float))
	1857	((x :single-float)
	1858	(y :single-float))
	1859	((crf (:crf 4))))
	1860	(fsubs result x y))
	1861
	1862	(define-ppc32-vinsn single-float*-2 (((result :single-float))
	1863	((x :single-float)
	1864	(y :single-float))
	1865	((crf (:crf 4))))
	1866	(fmuls result x y))
	1867
	1868	(define-ppc32-vinsn single-float/-2 (((result :single-float))
	1869	((x :single-float)
	1870	(y :single-float))
	1871	((crf (:crf 4))))
	1872	(fdivs result x y))
	1873
	1874
	1875
	1876
	1877
	1878	(define-ppc32-vinsn compare-unsigned (((crf :crf))
	1879	((arg0 :imm)
	1880	(arg1 :imm))
	1881	())
	1882	(cmplw crf arg0 arg1))
	1883
	1884	(define-ppc32-vinsn compare-signed-s16const (((crf :crf))
	1885	((arg0 :imm)
	1886	(imm :s16const))
	1887	())
	1888	(cmpwi crf arg0 imm))
	1889
	1890	(define-ppc32-vinsn compare-unsigned-u16const (((crf :crf))
	1891	((arg0 :u32)
	1892	(imm :u16const))
	1893	())
	1894	(cmplwi crf arg0 imm))
	1895
	1896
	1897
	1898	;; Extract a constant bit (0-31) from src; make it be bit 31 of dest.
	1899	;; Bitnum is treated mod 32.
	1900	(define-ppc32-vinsn extract-constant-ppc-bit (((dest :u32))
	1901	((src :imm)
	1902	(bitnum :u16const))
	1903	())
	1904	(rlwinm dest src (:apply + 1 bitnum) 31 31))
	1905
	1906
	1907	(define-ppc32-vinsn set-constant-ppc-bit-to-variable-value (((dest :u32))
	1908	((src :u32)
	1909	(bitval :u32) ; 0 or 1
	1910	(bitnum :u8const)))
	1911	(rlwimi dest bitval (:apply - 32 bitnum) bitnum bitnum))
	1912
	1913	(define-ppc32-vinsn set-constant-ppc-bit-to-1 (((dest :u32))
	1914	((src :u32)
	1915	(bitnum :u8const)))
	1916	((:pred < bitnum 16)
	1917	(oris dest src (:apply ash #x8000 (:apply - bitnum))))
	1918	((:pred >= bitnum 16)
	1919	(ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
	1920
	1921	(define-ppc32-vinsn set-constant-ppc-bit-to-0 (((dest :u32))
	1922	((src :u32)
	1923	(bitnum :u8const)))
	1924	(rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
	1925
	1926
	1927	(define-ppc32-vinsn insert-bit-0 (((dest :u32))
	1928	((src :u32)
	1929	(val :u32)))
	1930	(rlwimi dest val 0 0 0))
	1931
	1932	;;; The bit number is boxed and wants to think of the least-significant bit as 0.
	1933	;;; Imagine that.
	1934	;;; To turn the boxed, lsb-0 bitnumber into an unboxed, msb-0 rotate count,
	1935	;;; we (conceptually) unbox it, add ppc32::fixnumshift to it, subtract it from
	1936	;;; 31, and add one. This can also be done as "unbox and subtract from 28",
	1937	;;; I think ...
	1938	;;; Actually, it'd be "unbox, then subtract from 30".
	1939	(define-ppc32-vinsn extract-variable-non-insane-bit (((dest :u32))
	1940	((src :imm)
	1941	(bit :imm))
	1942	((temp :u32)))
	1943	(srwi temp bit ppc32::fixnumshift)
	1944	(subfic temp temp (- 32 ppc32::fixnumshift))
	1945	(rlwnm dest src temp 31 31))
	1946
	1947	;;; Operations on lists and cons cells
	1948
	1949	(define-ppc32-vinsn %cdr (((dest :lisp))
	1950	((src :lisp)))
	1951	(lwz dest ppc32::cons.cdr src))
	1952
	1953	(define-ppc32-vinsn %car (((dest :lisp))
	1954	((src :lisp)))
	1955	(lwz dest ppc32::cons.car src))
	1956
	1957	(define-ppc32-vinsn %set-car (()
	1958	((cell :lisp)
	1959	(new :lisp)))
	1960	(stw new ppc32::cons.car cell))
	1961
	1962	(define-ppc32-vinsn %set-cdr (()
	1963	((cell :lisp)
	1964	(new :lisp)))
	1965	(stw new ppc32::cons.cdr cell))
	1966
	1967	(define-ppc32-vinsn load-adl (()
	1968	((n :u32const)))
	1969	(lis ppc::nargs (:apply ldb (byte 16 16) n))
	1970	(ori ppc::nargs ppc::nargs (:apply ldb (byte 16 0) n)))
	1971
	1972	(define-ppc32-vinsn set-nargs (()
	1973	((n :s16const)))
	1974	(li ppc::nargs (:apply ash n ppc32::word-shift)))
	1975
	1976	(define-ppc32-vinsn scale-nargs (()
	1977	((nfixed :s16const)))
	1978	((:pred > nfixed 0)
	1979	(la ppc::nargs (:apply - (:apply ash nfixed ppc32::word-shift)) ppc::nargs)))
	1980
	1981
	1982
	1983	(define-ppc32-vinsn (vpush-register :push :node :vsp)
	1984	(()
	1985	((reg :lisp)))
	1986	(stwu reg -4 ppc::vsp))
	1987
	1988	(define-ppc32-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
	1989	(()
	1990	((reg :lisp)))
	1991	(stwu reg -4 ppc::vsp))
	1992
	1993	(define-ppc32-vinsn (vpop-register :pop :node :vsp)
	1994	(((dest :lisp))
	1995	())
	1996	(lwz dest 0 ppc::vsp)
	1997	(la ppc::vsp 4 ppc::vsp))
	1998
	1999
	2000	(define-ppc32-vinsn copy-node-gpr (((dest :lisp))
	2001	((src :lisp)))
	2002	((:not (:pred =
	2003	(:apply %hard-regspec-value dest)
	2004	(:apply %hard-regspec-value src)))
	2005	(mr dest src)))
	2006
	2007	(define-ppc32-vinsn copy-gpr (((dest t))
	2008	((src t)))
	2009	((:not (:pred =
	2010	(:apply %hard-regspec-value dest)
	2011	(:apply %hard-regspec-value src)))
	2012	(mr dest src)))
	2013
	2014
	2015	(define-ppc32-vinsn copy-fpr (((dest :double-float))
	2016	((src :double-float)))
	2017	((:not (:pred =
	2018	(:apply %hard-regspec-value dest)
	2019	(:apply %hard-regspec-value src)))
	2020	(fmr dest src)))
	2021
	2022	(define-ppc32-vinsn copy-complex-double-float (((dest :complex-double-float))
	2023	((src :complex-double-float)))
	2024	((:not (:pred =
	2025	(:apply %hard-regspec-value dest)
	2026	(:apply %hard-regspec-value src)))
	2027	(fmr dest src)
	2028	(fmr (:apply 1+ (:apply %hard-regspec-value dest))
	2029	(:apply 1+ (:apply %hard-regspec-value src)))))
	2030
	2031	(define-ppc32-vinsn copy-complex-single-float (((dest :complex-single-float))
	2032	((src :complex-single-float)))
	2033	((:not (:pred =
	2034	(:apply %hard-regspec-value dest)
	2035	(:apply %hard-regspec-value src)))
	2036	(fmr dest src)
	2037	(fmr (:apply 1+ (:apply %hard-regspec-value dest))
	2038	(:apply 1+ (:apply %hard-regspec-value src)))))
	2039
	2040
	2041
	2042	(define-ppc32-vinsn vcell-ref (((dest :lisp))
	2043	((vcell :lisp)))
	2044	(lwz dest ppc32::misc-data-offset vcell))
	2045
	2046
	2047	(define-ppc32-vinsn make-vcell (((dest :lisp))
	2048	((closed (:lisp :ne dest)))
	2049	((header :u32)))
	2050	(li header ppc32::value-cell-header)
	2051	(la ppc::allocptr (- ppc32::fulltag-misc ppc32::value-cell.size) ppc::allocptr)
	2052	(twllt ppc::allocptr ppc::allocbase)
	2053	(stw header ppc32::misc-header-offset ppc::allocptr)
	2054	(mr dest ppc::allocptr)
	2055	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2056	(stw closed ppc32::value-cell.value dest))
	2057
	2058	(define-ppc32-vinsn make-tsp-vcell (((dest :lisp))
	2059	((closed :lisp))
	2060	((header :u32)))
	2061	(li header ppc32::value-cell-header)
	2062	(stwu ppc::tsp -16 ppc::tsp)
	2063	(stw ppc::tsp 4 ppc::tsp)
	2064	(stfd ppc::fp-zero 8 ppc::tsp)
	2065	(stw ppc::rzero 4 ppc::tsp)
	2066	(stw header (+ 8 ppc32::fulltag-misc ppc32::value-cell.header) ppc::tsp)
	2067	(stw closed (+ 8 ppc32::fulltag-misc ppc32::value-cell.value) ppc::tsp)
	2068	(la dest (+ 8 ppc32::fulltag-misc) ppc::tsp))
	2069
	2070	(define-ppc32-vinsn make-tsp-cons (((dest :lisp))
	2071	((car :lisp) (cdr :lisp))
	2072	())
	2073	(stwu ppc::tsp -16 ppc::tsp)
	2074	(stw ppc::tsp 4 ppc::tsp)
	2075	(stfd ppc::fp-zero 8 ppc::tsp)
	2076	(stw ppc::rzero 4 ppc::tsp)
	2077	(stw car (+ 8 ppc32::fulltag-cons ppc32::cons.car) ppc::tsp)
	2078	(stw cdr (+ 8 ppc32::fulltag-cons ppc32::cons.cdr) ppc::tsp)
	2079	(la dest (+ 8 ppc32::fulltag-cons) ppc::tsp))
	2080
	2081
	2082	(define-ppc32-vinsn %closure-code% (((dest :lisp))
	2083	())
	2084	(lwz dest (:apply + ppc32::symbol.vcell (ppc32::nrs-offset %closure-code%) (:apply target-nil-value)) 0))
	2085
	2086
	2087	(define-ppc32-vinsn single-float-bits (((dest :u32))
	2088	((src :lisp)))
	2089	(lwz dest ppc32::single-float.value src))
	2090
	2091	(define-ppc32-vinsn (call-subprim :call :subprim) (()
	2092	((spno :s32const)))
	2093	(bla spno))
	2094
	2095	(define-ppc32-vinsn (jump-subprim :jumpLR) (()
	2096	((spno :s32const)))
	2097	(ba spno))
	2098
	2099	;;; Same as "call-subprim", but gives us a place to
	2100	;;; track args, results, etc.
	2101	(define-ppc32-vinsn (call-subprim-0 :call :subprim) (((dest t))
	2102	((spno :s32const)))
	2103	(bla spno))
	2104
	2105	(define-ppc32-vinsn (call-subprim-1 :call :subprim) (((dest t))
	2106	((spno :s32const)
	2107	(z t)))
	2108	(bla spno))
	2109
	2110	(define-ppc32-vinsn (call-subprim-2 :call :subprim) (((dest t))
	2111	((spno :s32const)
	2112	(y t)
	2113	(z t)))
	2114	(bla spno))
	2115
	2116	(define-ppc32-vinsn (call-subprim-3 :call :subprim) (((dest t))
	2117	((spno :s32const)
	2118	(x t)
	2119	(y t)
	2120	(z t)))
	2121	(bla spno))
	2122
	2123	(define-ppc32-vinsn event-poll (()
	2124	()
	2125	((crf :crf)))
	2126	(lwz ppc::nargs ppc32::tcr.tlb-pointer ppc32::rcontext)
	2127	(lwz ppc::nargs ppc32::interrupt-level-binding-index ppc::nargs)
	2128	(cmpwi crf ppc::nargs 0)
	2129	(blt crf :done)
	2130	(bgt crf :trap)
	2131	(lwz ppc::nargs ppc32::tcr.interrupt-pending ppc32::rcontext)
	2132	:trap
	2133	(twgti ppc::nargs 0)
	2134	:done)
	2135
	2136	(define-ppc32-vinsn ref-interrupt-level (((dest :imm))
	2137	()
	2138	((temp :u32)))
	2139	(lwz temp ppc32::tcr.tlb-pointer ppc32::rcontext)
	2140	(lwz dest ppc32::INTERRUPT-LEVEL-BINDING-INDEX temp))
	2141
	2142
	2143	;;; Unconditional (pc-relative) branch
	2144	(define-ppc32-vinsn (jump :jump) (()
	2145	((label :label)))
	2146	(b label))
	2147
	2148	(define-ppc32-vinsn (call-label :call) (()
	2149	((label :label)))
	2150	(bl label))
	2151
	2152	;;; just like JUMP, only (implicitly) asserts that the following
	2153	;;; code is somehow reachable.
	2154	(define-ppc32-vinsn (non-barrier-jump :xref) (()
	2155	((label :label)))
	2156	(b label))
	2157
	2158
	2159	(define-ppc32-vinsn (cbranch-true :branch) (()
	2160	((label :label)
	2161	(crf :crf)
	2162	(crbit :u8const)))
	2163	(bt (:apply + crf crbit) label))
	2164
	2165	(define-ppc32-vinsn (cbranch-false :branch) (()
	2166	((label :label)
	2167	(crf :crf)
	2168	(crbit :u8const)))
	2169	(bf (:apply + crf crbit) label))
	2170
	2171	(define-ppc32-vinsn check-trap-error (()
	2172	())
	2173	(beq+ 0 :no-error)
	2174	(uuo_interr arch::error-reg-regnum ppc::arg_z)
	2175	:no-error)
	2176
	2177
	2178	(define-ppc32-vinsn lisp-word-ref (((dest t))
	2179	((base t)
	2180	(offset t)))
	2181	(lwzx dest base offset))
	2182
	2183	(define-ppc32-vinsn lisp-word-ref-c (((dest t))
	2184	((base t)
	2185	(offset :s16const)))
	2186	(lwz dest offset base))
	2187
	2188
	2189
	2190	;; Load an unsigned, 32-bit constant into a destination register.
	2191	(define-ppc32-vinsn (lri :constant-ref) (((dest :imm))
	2192	((intval :u32const))
	2193	())
	2194	((:or (:pred = (:apply ash intval -15) #x1ffff)
	2195	(:pred = (:apply ash intval -15) #x0))
	2196	(li dest (:apply %word-to-int (:apply logand #xffff intval))))
	2197	((:not ; that's :else to you, bub.
	2198	(:or (:pred = (:apply ash intval -15) #x1ffff)
	2199	(:pred = (:apply ash intval -15) #x0)))
	2200	((:pred = (:apply ash intval -15) 1)
	2201	(ori dest ppc::rzero (:apply logand intval #xffff)))
	2202	((:not (:pred = (:apply ash intval -15) 1))
	2203	(lis dest (:apply ash intval -16))
	2204	((:not (:pred = 0 (:apply logand intval #xffff)))
	2205	(ori dest dest (:apply logand intval #xffff))))))
	2206
	2207
	2208	(define-ppc32-vinsn (discard-temp-frame :tsp :pop :discard) (()
	2209	())
	2210	(lwz ppc::tsp 0 ppc::tsp))
	2211
	2212
	2213	;;; Somewhere, deep inside the "OS_X_PPC_RuntimeConventions.pdf"
	2214	;;; document, they bother to document the fact that SP should
	2215	;;; maintain 16-byte alignment on OSX. (The example prologue
	2216	;;; code in that document incorrectly assumes 8-byte alignment.
	2217	;;; Or something. It's wrong in a number of other ways.)
	2218	;;; The caller always has to reserve a 24-byte linkage area
	2219	;;; (large chunks of which are unused).
	2220	(define-ppc32-vinsn alloc-c-frame (()
	2221	((n-c-args :u16const)))
	2222	;; Always reserve space for at least 8 args and space for a lisp
	2223	;; frame (for the kernel) underneath it.
	2224	;; Zero the c-frame's savelr field, not that the GC cares ..
	2225	((:pred <= n-c-args 10)
	2226	(stwu ppc::sp (- (+ 8 ppc32::c-frame.size ppc32::lisp-frame.size)) ppc::sp))
	2227	((:pred > n-c-args 10)
	2228	;; A normal C frame has room for 10 args (when padded out to
	2229	;; 16-byte alignment. Add enough double words to accomodate the
	2230	;; remaining args, in multiples of 4.
	2231	(stwu ppc::sp (:apply - (:apply +
	2232	8
	2233	(+ ppc32::c-frame.size ppc32::lisp-frame.size)
	2234	(:apply ash
	2235	(:apply logand
	2236	(lognot 3)
	2237	(:apply
	2238	+
	2239	3
	2240	(:apply - n-c-args 10)))
	2241	2)))
	2242	ppc::sp))
	2243	(stw ppc::rzero ppc32::c-frame.savelr ppc::sp))
	2244
	2245	(define-ppc32-vinsn alloc-variable-c-frame (()
	2246	((n-c-args :lisp))
	2247	((crf :crf)
	2248	(size :s32)))
	2249	(cmpwi crf n-c-args (ash 10 ppc32::fixnumshift))
	2250	(subi size n-c-args (ash 10 ppc32::fixnumshift))
	2251	(bgt :variable)
	2252	;; Always reserve space for at least 8 args and space for a lisp
	2253	;; frame (for the kernel) underneath it.
	2254	(stwu ppc::sp (- (+ 8 ppc32::c-frame.size ppc32::lisp-frame.size)) ppc::sp)
	2255	(b :done)
	2256	:variable
	2257	(addi size size (+ (+ 8 ppc32::c-frame.size ppc32::lisp-frame.size) (ash 3 ppc32::fixnumshift)))
	2258	(clrrwi size size 3)
	2259	(neg size size)
	2260	(stwux ppc::sp ppc::sp size)
	2261	:done
	2262	(stw ppc::rzero ppc32::c-frame.savelr ppc::sp))
	2263
	2264	(define-ppc32-vinsn alloc-eabi-c-frame (()
	2265	((n-c-args :u16const)))
	2266	;; Always reserve space for at least 8 args and space for a lisp
	2267	;; frame (for the kernel) underneath it. Store NIL inthe c-frame's
	2268	;; savelr field, so that the kernel doesn't mistake this for a lisp
	2269	;; frame.
	2270	((:pred <= n-c-args 8)
	2271	(stwu ppc::sp (- (+ ppc32::eabi-c-frame.size ppc32::lisp-frame.size)) ppc::sp))
	2272	((:pred > n-c-args 8)
	2273	;; A normal C frame has room for 8 args. Add enough double words to
	2274	;; accomodate the remaining args
	2275	(stwu ppc::sp (:apply - (:apply +
	2276	(+ ppc32::eabi-c-frame.size ppc32::lisp-frame.size)
	2277	(:apply ash
	2278	(:apply logand
	2279	(lognot 1)
	2280	(:apply
	2281	1+
	2282	(:apply - n-c-args 8)))
	2283	2)))
	2284	ppc::sp))
	2285	(stw ppc::sp ppc32::eabi-c-frame.savelr ppc::sp))
	2286
	2287	(define-ppc32-vinsn alloc-variable-eabi-c-frame (()
	2288	((n-c-args :lisp))
	2289	((crf :crf)
	2290	(size :s32)))
	2291	(cmpwi crf n-c-args (ash 8 ppc32::fixnumshift))
	2292	(subi size n-c-args (ash 8 ppc32::fixnumshift))
	2293	(bgt :variable)
	2294	;; Always reserve space for at least 8 args and space for a lisp
	2295	;; frame (for the kernel) underneath it.
	2296	(stwu ppc::sp (- (+ ppc32::eabi-c-frame.size ppc32::lisp-frame.size)) ppc::sp)
	2297	(b :done)
	2298	:variable
	2299	(addi size size (+ (+ ppc32::eabi-c-frame.size ppc32::lisp-frame.size) (ash 1 ppc32::fixnumshift)))
	2300	(clrrwi size size 2)
	2301	(neg size size)
	2302	(stwux ppc::sp ppc::sp size)
	2303	:done
	2304	(stw ppc::rzero ppc32::c-frame.savelr ppc::sp))
	2305
	2306
	2307
	2308	;;; We should rarely have to do this. It's easier to just generate code
	2309	;;; to do the memory reference than it would be to keep track of the size
	2310	;;; of each frame.
	2311	(define-ppc32-vinsn (discard-c-frame :csp :pop :discard) (()
	2312	())
	2313	(lwz ppc::sp 0 ppc::sp))
	2314
	2315
	2316
	2317
	2318	(define-ppc32-vinsn set-c-arg (()
	2319	((argval :u32)
	2320	(argnum :u16const)))
	2321	(stw argval (:apply + ppc32::c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2322
	2323	(define-ppc32-vinsn set-single-c-arg (()
	2324	((argval :single-float)
	2325	(argnum :u16const)))
	2326	(stfs argval (:apply + ppc32::c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2327
	2328	(define-ppc32-vinsn set-double-c-arg (()
	2329	((argval :double-float)
	2330	(argnum :u16const)))
	2331	(stfd argval (:apply + ppc32::c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2332
	2333	(define-ppc32-vinsn reload-single-c-arg (((argval :single-float))
	2334	((argnum :u16const)))
	2335	(lfs argval (:apply + ppc32::c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2336
	2337	(define-ppc32-vinsn reload-double-c-arg (((argval :double-float))
	2338	((argnum :u16const)))
	2339	(lfd argval (:apply + ppc32::c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2340
	2341	(define-ppc32-vinsn set-eabi-c-arg (()
	2342	((argval :u32)
	2343	(argnum :u16const)))
	2344	(stw argval (:apply + ppc32::eabi-c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2345
	2346	(define-ppc32-vinsn set-single-eabi-c-arg (()
	2347	((argval :single-float)
	2348	(argnum :u16const)))
	2349	(stfs argval (:apply + ppc32::eabi-c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2350
	2351	(define-ppc32-vinsn set-double-eabi-c-arg (()
	2352	((argval :double-float)
	2353	(argnum :u16const)))
	2354	(stfd argval (:apply + ppc32::eabi-c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2355
	2356	(define-ppc32-vinsn reload-single-eabi-c-arg (((argval :single-float))
	2357	((argnum :u16const)))
	2358	(lfs argval (:apply + ppc32::eabi-c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2359
	2360	(define-ppc32-vinsn reload-double-eabi-c-arg (((argval :double-float))
	2361	((argnum :u16const)))
	2362	(lfd argval (:apply + ppc32::eabi-c-frame.param0 (:apply ash argnum ppc32::word-shift)) ppc::sp))
	2363
	2364	(define-ppc32-vinsn (load-nil :constant-ref) (((dest t))
	2365	())
	2366	(li dest (:apply target-nil-value)))
	2367
	2368	(define-ppc32-vinsn (load-t :constant-ref) (((dest t))
	2369	())
	2370	(li dest (:apply + ppc32::t-offset (:apply target-nil-value))))
	2371
	2372	(define-ppc32-vinsn set-eq-bit (((dest :crf))
	2373	())
	2374	(creqv (:apply + ppc::ppc-eq-bit dest)
	2375	(:apply + ppc::ppc-eq-bit dest)
	2376	(:apply + ppc::ppc-eq-bit dest)))
	2377
	2378	(define-ppc32-vinsn (ref-constant :constant-ref) (((dest :lisp))
	2379	((src :s16const)))
	2380	(lwz dest (:apply + ppc32::misc-data-offset (:apply ash (:apply 1+ src) 2)) ppc::fn))
	2381
	2382	(define-ppc32-vinsn ref-indexed-constant (((dest :lisp))
	2383	((idxreg :s32)))
	2384	(lwzx dest ppc::fn idxreg))
	2385
	2386
	2387	(define-ppc32-vinsn cons (((dest :lisp))
	2388	((newcar :lisp)
	2389	(newcdr :lisp)))
	2390	(la ppc::allocptr (- ppc32::fulltag-cons ppc32::cons.size) ppc::allocptr)
	2391	(twllt ppc::allocptr ppc::allocbase)
	2392	(stw newcdr ppc32::cons.cdr ppc::allocptr)
	2393	(stw newcar ppc32::cons.car ppc::allocptr)
	2394	(mr dest ppc::allocptr)
	2395	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits))
	2396
	2397
	2398
	2399	;; subtag had better be a PPC-NODE-SUBTAG of some sort!
	2400	(define-ppc32-vinsn %ppc-gvector (((dest :lisp))
	2401	((Rheader :u32)
	2402	(nbytes :u32const))
	2403	((immtemp0 :u32)
	2404	(nodetemp :lisp)
	2405	(crf :crf)))
	2406	(la ppc::allocptr (:apply - ppc32::fulltag-misc
	2407	(:apply logand (lognot 7)
	2408	(:apply + (+ 7 4) nbytes)))
	2409	ppc::allocptr)
	2410	(twllt ppc::allocptr ppc::allocbase)
	2411	(stw Rheader ppc32::misc-header-offset ppc::allocptr)
	2412	(mr dest ppc::allocptr)
	2413	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2414	((:not (:pred = nbytes 0))
	2415	(li immtemp0 (:apply + ppc32::misc-data-offset nbytes))
	2416	:loop
	2417	(subi immtemp0 immtemp0 4)
	2418	(cmpwi crf immtemp0 ppc32::misc-data-offset)
	2419	(lwz nodetemp 0 ppc::vsp)
	2420	(la ppc::vsp 4 ppc::vsp)
	2421	(stwx nodetemp dest immtemp0)
	2422	(bne crf :loop)))
	2423
	2424	;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
	2425	(define-ppc32-vinsn %alloc-misc-fixed (((dest :lisp))
	2426	((Rheader :u32)
	2427	(nbytes :u32const)))
	2428	(la ppc::allocptr (:apply - ppc32::fulltag-misc
	2429	(:apply logand (lognot 7)
	2430	(:apply + (+ 7 4) nbytes)))
	2431	ppc::allocptr)
	2432	(twllt ppc::allocptr ppc::allocbase)
	2433	(stw Rheader ppc32::misc-header-offset ppc::allocptr)
	2434	(mr dest ppc::allocptr)
	2435	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits))
	2436
	2437	(define-ppc32-vinsn (vstack-discard :vsp :pop :discard) (()
	2438	((nwords :u32const)))
	2439	((:not (:pred = nwords 0))
	2440	(la ppc::vsp (:apply ash nwords ppc32::word-shift) ppc::vsp)))
	2441
	2442
	2443	(define-ppc32-vinsn lcell-load (((dest :lisp))
	2444	((cell :lcell)
	2445	(top :lcell)))
	2446	(lwz dest (:apply -
	2447	(:apply - (:apply calc-lcell-depth top) 4)
	2448	(:apply calc-lcell-offset cell)) ppc::vsp))
	2449
	2450	(define-ppc32-vinsn vframe-load (((dest :lisp))
	2451	((frame-offset :u16const)
	2452	(cur-vsp :u16const)))
	2453	(lwz dest (:apply - (:apply - cur-vsp 4) frame-offset) ppc::vsp))
	2454
	2455	(define-ppc32-vinsn lcell-store (()
	2456	((src :lisp)
	2457	(cell :lcell)
	2458	(top :lcell)))
	2459	(stw src (:apply -
	2460	(:apply - (:apply calc-lcell-depth top) 4)
	2461	(:apply calc-lcell-offset cell)) ppc::vsp))
	2462
	2463	(define-ppc32-vinsn vframe-store (()
	2464	((src :lisp)
	2465	(frame-offset :u16const)
	2466	(cur-vsp :u16const)))
	2467	(stw src (:apply - (:apply - cur-vsp 4) frame-offset) ppc::vsp))
	2468
	2469	(define-ppc32-vinsn load-vframe-address (((dest :imm))
	2470	((offset :s16const)))
	2471	(la dest offset ppc::vsp))
	2472
	2473	(define-ppc32-vinsn copy-lexpr-argument (()
	2474	()
	2475	((temp :lisp)))
	2476	(lwzx temp ppc::vsp ppc::nargs)
	2477	(stwu temp -4 ppc::vsp))
	2478
	2479	;;; Boxing/unboxing of integers.
	2480
	2481	;;; Treat the low 8 bits of VAL as an unsigned integer; set RESULT to the equivalent fixnum.
	2482	(define-ppc32-vinsn u8->fixnum (((result :imm))
	2483	((val :u8))
	2484	())
	2485	(rlwinm result val ppc32::fixnumshift (- ppc32::nbits-in-word (+ 8 ppc32::fixnumshift)) (- ppc32::least-significant-bit ppc32::fixnumshift)))
	2486
	2487	;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
	2488	(define-ppc32-vinsn s8->fixnum (((result :imm))
	2489	((val :s8))
	2490	())
	2491	(extlwi result val 8 (- ppc32::nbits-in-word 8))
	2492	(srawi result result (- (- ppc32::nbits-in-word 8) ppc32::fixnumshift)))
	2493
	2494
	2495	;;; Treat the low 16 bits of VAL as an unsigned integer; set RESULT to the equivalent fixnum.
	2496	(define-ppc32-vinsn u16->fixnum (((result :imm))
	2497	((val :u16))
	2498	())
	2499	(rlwinm result val ppc32::fixnumshift (- ppc32::nbits-in-word (+ 16 ppc32::fixnumshift)) (- ppc32::least-significant-bit ppc32::fixnumshift)))
	2500
	2501	;;; Treat the low 16 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
	2502	(define-ppc32-vinsn s16->fixnum (((result :imm))
	2503	((val :s16))
	2504	())
	2505	(extlwi result val 16 (- ppc32::nbits-in-word 16))
	2506	(srawi result result (- (- ppc32::nbits-in-word 16) ppc32::fixnumshift)))
	2507
	2508	(define-ppc32-vinsn fixnum->s16 (((result :s16))
	2509	((src :imm)))
	2510	(srawi result src ppc32::fixnumshift))
	2511
	2512	;;; A signed 32-bit untagged value can be at worst a 1-digit bignum.
	2513	;;; There should be something very much like this that takes a stack-consed
	2514	;;; bignum result ...
	2515	(define-ppc32-vinsn s32->integer (((result :lisp))
	2516	((src :s32))
	2517	((crf (:crf 0)) ; a casualty
	2518	(temp :s32)))
	2519	(addo temp src src)
	2520	(addo. result temp temp)
	2521	(bns+ :done)
	2522	(mtxer ppc::rzero)
	2523	(li temp ppc32::one-digit-bignum-header)
	2524	(la ppc::allocptr (- ppc32::fulltag-misc 8) ppc::allocptr)
	2525	(twllt ppc::allocptr ppc::allocbase)
	2526	(stw temp ppc32::misc-header-offset ppc::allocptr)
	2527	(mr result ppc::allocptr)
	2528	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2529	(stw src ppc32::misc-data-offset result)
	2530	:done)
	2531
	2532
	2533	;;; An unsigned 32-bit untagged value can be either a 1 or a 2-digit bignum.
	2534	(define-ppc32-vinsn u32->integer (((result :lisp))
	2535	((src :u32))
	2536	((crf (:crf 0)) ; a casualty
	2537	(temp :s32)
	2538	(size :u32)))
	2539	(clrrwi. temp src (- ppc32::least-significant-bit ppc32::nfixnumtagbits))
	2540	(slwi result src ppc32::fixnumshift)
	2541	(beq+ crf :done)
	2542	(cmpwi src 0)
	2543	(li temp ppc32::one-digit-bignum-header)
	2544	(li size (- 8 ppc32::fulltag-misc))
	2545	(bgt :common)
	2546	(li temp ppc32::two-digit-bignum-header)
	2547	(li size (- 16 ppc32::fulltag-misc))
	2548	:common
	2549	(sub ppc::allocptr ppc::allocptr size)
	2550	(twllt ppc::allocptr ppc::allocbase)
	2551	(stw temp ppc32::misc-header-offset ppc::allocptr)
	2552	(mr result ppc::allocptr)
	2553	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2554	(stw src ppc32::misc-data-offset result)
	2555	:done)
	2556
	2557	(define-ppc32-vinsn u16->u32 (((dest :u32))
	2558	((src :u16)))
	2559	(clrlwi dest src 16))
	2560
	2561	(define-ppc32-vinsn u8->u32 (((dest :u32))
	2562	((src :u8)))
	2563	(clrlwi dest src 24))
	2564
	2565
	2566	(define-ppc32-vinsn s16->s32 (((dest :s32))
	2567	((src :s16)))
	2568	(extsh dest src))
	2569
	2570	(define-ppc32-vinsn s8->s32 (((dest :s32))
	2571	((src :s8)))
	2572	(extsb dest src))
	2573
	2574
	2575	;;; ... of floats ...
	2576
	2577	;;; Heap-cons a double-float to store contents of FPREG. Hope that we don't do
	2578	;;; this blindly.
	2579	(define-ppc32-vinsn double->heap (((result :lisp)) ; tagged as a double-float
	2580	((fpreg :double-float))
	2581	((header-temp :u32)))
	2582	(li header-temp (arch::make-vheader ppc32::double-float.element-count ppc32::subtag-double-float))
	2583	(la ppc::allocptr (- ppc32::fulltag-misc ppc32::double-float.size) ppc::allocptr)
	2584	(twllt ppc::allocptr ppc::allocbase)
	2585	(stw header-temp ppc32::misc-header-offset ppc::allocptr)
	2586	(mr result ppc::allocptr)
	2587	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2588	(stfd fpreg ppc32::double-float.value result) )
	2589
	2590	(define-ppc32-vinsn complex-double->heap (((result :lisp)) ; tagged as a double-float
	2591	((fpreg :complex-double-float))
	2592	((header-temp :u32)))
	2593	(li header-temp (arch::make-vheader ppc32::complex-double-float.element-count ppc32::subtag-complex-double-float))
	2594	(la ppc::allocptr (- ppc32::fulltag-misc ppc32::complex-double-float.size) ppc::allocptr)
	2595	(twllt ppc::allocptr ppc::allocbase)
	2596	(stw header-temp ppc32::misc-header-offset ppc::allocptr)
	2597	(mr result ppc::allocptr)
	2598	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2599	(stfd fpreg ppc32::complex-double-float.realpart result)
	2600	(stfd (:apply 1+ (:apply %hard-regspec-value fpreg))
	2601	ppc32::complex-double-float.imagpart result))
	2602
	2603
	2604	;;; This is about as bad as heap-consing a double-float. (In terms of
	2605	;;; verbosity). Wouldn't kill us to do either/both out-of-line, but
	2606	;;; need to make visible to compiler so unnecessary heap-consing can
	2607	;;; be elided.
	2608	(define-ppc32-vinsn single->node (((result :lisp)) ; tagged as a single-float
	2609	((fpreg :single-float))
	2610	((header-temp :u32)))
	2611	(li header-temp (arch::make-vheader ppc32::single-float.element-count ppc32::subtag-single-float))
	2612	(la ppc::allocptr (- ppc32::fulltag-misc ppc32::single-float.size) ppc::allocptr)
	2613	(twllt ppc::allocptr ppc::allocbase)
	2614	(stw header-temp ppc32::misc-header-offset ppc::allocptr)
	2615	(mr result ppc::allocptr)
	2616	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2617	(stfs fpreg ppc32::single-float.value result))
	2618
	2619
	2620	(define-ppc32-vinsn complex-single->node (((result :lisp)) ; tagged as a single-float
	2621	((fpreg :complex-single-float))
	2622	((header-temp :u32)))
	2623	(li header-temp (arch::make-vheader ppc32::complex-single-float.element-count ppc32::subtag-complex-single-float))
	2624	(la ppc::allocptr (- ppc32::fulltag-misc ppc32::complex-single-float.size) ppc::allocptr)
	2625	(twllt ppc::allocptr ppc::allocbase)
	2626	(stw header-temp ppc32::misc-header-offset ppc::allocptr)
	2627	(mr result ppc::allocptr)
	2628	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2629	(stfs fpreg ppc32::complex-single-float.realpart result)
	2630	(stfs (:apply 1+ (:apply %hard-regspec-value fpreg))
	2631	ppc32::complex-single-float.imagpart result))
	2632
	2633
	2634	;;; "dest" is preallocated, presumably on a stack somewhere.
	2635	(define-ppc32-vinsn store-double (()
	2636	((dest :lisp)
	2637	(source :double-float))
	2638	())
	2639	(stfd source ppc32::double-float.value dest))
	2640
	2641	(define-ppc32-vinsn get-double (((target :double-float))
	2642	((source :lisp))
	2643	())
	2644	(lfd target ppc32::double-float.value source))
	2645
	2646	(define-ppc32-vinsn get-complex-double (((target :complex-double-float))
	2647	((source :lisp))
	2648	())
	2649	(lfd target ppc32::complex-double-float.realpart source)
	2650	(lfd (:apply 1+ (:apply %hard-regspec-value target))
	2651	ppc32::complex-double-float.imagpart source))
	2652
	2653	(define-ppc32-vinsn get-complex-single (((target :complex-single-float))
	2654	((source :lisp))
	2655	())
	2656	(lfs target ppc32::complex-single-float.realpart source)
	2657	(lfs (:apply 1+ (:apply %hard-regspec-value target))
	2658	ppc32::complex-single-float.imagpart source))
	2659
	2660
	2661	;;; Extract a double-float value, typechecking in the process.
	2662	;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
	2663	;;; instead of replicating it ..
	2664
	2665	(define-ppc32-vinsn get-double? (((target :double-float))
	2666	((source :lisp))
	2667	((tag :u8)
	2668	(crf :crf)))
	2669	(clrlwi tag source (- ppc32::nbits-in-word ppc32::nlisptagbits))
	2670	(cmpwi crf tag ppc32::tag-misc)
	2671	(bne crf :do-trap)
	2672	(lbz tag ppc32::misc-subtag-offset source)
	2673	:do-trap
	2674	(twnei tag ppc32::subtag-double-float)
	2675	(lfd target ppc32::double-float.value source))
	2676
	2677
	2678	(define-ppc32-vinsn double-to-single (((result :single-float))
	2679	((arg :double-float)))
	2680	(frsp result arg))
	2681
	2682	(define-ppc32-vinsn store-single (()
	2683	((dest :lisp)
	2684	(source :single-float))
	2685	())
	2686	(stfs source ppc32::single-float.value dest))
	2687
	2688	(define-ppc32-vinsn get-single (((target :single-float))
	2689	((source :lisp))
	2690	())
	2691	(lfs target ppc32::single-float.value source))
	2692
	2693	;;; ... of characters ...
	2694
	2695
	2696	(define-ppc32-vinsn character->fixnum (((dest :lisp))
	2697	((src :lisp))
	2698	())
	2699	(rlwinm dest
	2700	src
	2701	(- ppc32::nbits-in-word (- ppc32::charcode-shift ppc32::fixnumshift))
	2702	(- ppc32::nbits-in-word (+ ppc32::ncharcodebits ppc32::fixnumshift))
	2703	(- ppc32::least-significant-bit ppc32::fixnumshift)))
	2704
	2705	(define-ppc32-vinsn character->code (((dest :u32))
	2706	((src :lisp)))
	2707	(srwi dest src ppc32::charcode-shift))
	2708
	2709
	2710	(define-ppc32-vinsn fixnum->char (((dest :lisp))
	2711	((src :imm))
	2712	((temp :u32)
	2713	(crf0 (:crf 0))))
	2714	(srwi temp src (+ ppc32::fixnumshift 1))
	2715	(cmplwi temp (ash #xffff -1))
	2716	(srwi temp src (+ ppc32::fixnumshift 11))
	2717	(beq :bad)
	2718	(cmpwi temp 27)
	2719	(slwi dest src (- ppc32::charcode-shift ppc32::fixnumshift))
	2720	(bne+ :ok)
	2721	:bad
	2722	(li dest (:apply target-nil-value))
	2723	(b :done)
	2724	:ok
	2725	(addi dest dest ppc32::subtag-character)
	2726	:done)
	2727
	2728	;;; src is known to be a code for which CODE-CHAR returns non-nil.
	2729	(define-ppc32-vinsn code-char->char (((dest :lisp))
	2730	((src :imm))
	2731	())
	2732	(slwi dest src (- ppc32::charcode-shift ppc32::fixnum-shift))
	2733	(addi dest dest ppc32::subtag-character))
	2734
	2735	(define-ppc32-vinsn u32->char (((dest :lisp))
	2736	((src :u32))
	2737	())
	2738	(slwi dest src ppc32::charcode-shift)
	2739	(addi dest dest ppc32::subtag-character))
	2740
	2741	;; ... Macptrs ...
	2742
	2743	(define-ppc32-vinsn deref-macptr (((addr :address))
	2744	((src :lisp))
	2745	())
	2746	(lwz addr ppc32::macptr.address src))
	2747
	2748	(define-ppc32-vinsn set-macptr-address (()
	2749	((addr :address)
	2750	(src :lisp))
	2751	())
	2752	(stw addr ppc32::macptr.address src))
	2753
	2754
	2755	(define-ppc32-vinsn macptr->heap (((dest :lisp))
	2756	((address :address))
	2757	((header :u32)))
	2758	(li header (logior (ash ppc32::macptr.element-count ppc32::num-subtag-bits) ppc32::subtag-macptr))
	2759	(la ppc::allocptr (- ppc32::fulltag-misc ppc32::macptr.size) ppc::allocptr)
	2760	(twllt ppc::allocptr ppc::allocbase)
	2761	(stw header ppc32::misc-header-offset ppc::allocptr)
	2762	(mr dest ppc::allocptr)
	2763	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	2764	;; It's not necessary to zero out the domain/type fields, since newly
	2765	;; heap-allocated memory's guaranteed to be 0-filled.
	2766	(stw address ppc32::macptr.address dest))
	2767
	2768	(define-ppc32-vinsn macptr->stack (((dest :lisp))
	2769	((address :address))
	2770	((header :u32)))
	2771	(li header ppc32::macptr-header)
	2772	(stwu ppc::tsp (- (+ 8 ppc32::macptr.size)) ppc::tsp)
	2773	(stw ppc::tsp 4 ppc::tsp)
	2774	(stw header (+ 8 ppc32::fulltag-misc ppc32::macptr.header) ppc::tsp)
	2775	(stw address (+ 8 ppc32::fulltag-misc ppc32::macptr.address) ppc::tsp)
	2776	;; It -is- necessary to zero out the domain/type fields here, since
	2777	;; stack-allocated memory isn't guaranteed to be 0-filled.
	2778	(stfd ppc::fp-zero (+ 8 ppc32::fulltag-misc ppc32::macptr.domain) ppc::tsp)
	2779	(la dest (+ 8 ppc32::fulltag-misc) ppc::tsp))
	2780
	2781
	2782	(define-ppc32-vinsn adjust-stack-register (()
	2783	((reg t)
	2784	(amount :s16const)))
	2785	(la reg amount reg))
	2786
	2787	(define-ppc32-vinsn adjust-vsp (()
	2788	((amount :s16const)))
	2789	(la ppc::vsp amount ppc::vsp))
	2790
	2791	(define-ppc32-vinsn adjust-sp (()
	2792	((amount :s16const)))
	2793	(la ppc::sp amount ppc::sp))
	2794
	2795	;; Arithmetic on fixnums & unboxed numbers
	2796
	2797	(define-ppc32-vinsn u32-lognot (((dest :u32))
	2798	((src :u32))
	2799	())
	2800	(not dest src))
	2801
	2802	(define-ppc32-vinsn fixnum-lognot (((dest :imm))
	2803	((src :imm))
	2804	((temp :u32)))
	2805	(not temp src)
	2806	(clrrwi dest temp ppc32::nfixnumtagbits))
	2807
	2808
	2809	(define-ppc32-vinsn negate-fixnum-set-flags (((dest :lisp)
	2810	(flags (:crf 0)))
	2811	((src :imm)))
	2812	(nego. dest src))
	2813
	2814
	2815
	2816
	2817	(define-ppc32-vinsn negate-fixnum-no-ovf (((dest :lisp))
	2818	((src :imm)))
	2819
	2820	(neg dest src))
	2821
	2822
	2823	(define-ppc32-vinsn logior-high (((dest :imm))
	2824	((src :imm)
	2825	(high :u16const)))
	2826	(oris dest src high))
	2827
	2828	(define-ppc32-vinsn logior-low (((dest :imm))
	2829	((src :imm)
	2830	(low :u16const)))
	2831	(ori dest src low))
	2832
	2833
	2834
	2835	(define-ppc32-vinsn %logior2 (((dest :imm))
	2836	((x :imm)
	2837	(y :imm))
	2838	())
	2839	(or dest x y))
	2840
	2841	(define-ppc32-vinsn logand-high (((dest :imm))
	2842	((src :imm)
	2843	(high :u16const))
	2844	((crf0 (:crf 0))))
	2845	(andis. dest src high))
	2846
	2847	(define-ppc32-vinsn logand-low (((dest :imm))
	2848	((src :imm)
	2849	(low :u16const))
	2850	((crf0 (:crf 0))))
	2851	(andi. dest src low))
	2852
	2853
	2854	(define-ppc32-vinsn %logand2 (((dest :imm))
	2855	((x :imm)
	2856	(y :imm))
	2857	())
	2858	(and dest x y))
	2859
	2860	(define-ppc32-vinsn clear-left (((dest :imm))
	2861	((src :imm)
	2862	(nbits :s8const)))
	2863	(rlwinm dest src 0 (:apply 1+ nbits) 31))
	2864
	2865	(define-ppc32-vinsn clear-right (((dest :imm))
	2866	((src :imm)
	2867	(nbits :s8const)))
	2868	(rlwinm dest src 0 0 (:apply - 31 nbits)))
	2869
	2870
	2871	(define-ppc32-vinsn logxor-high (((dest :imm))
	2872	((src :imm)
	2873	(high :u16const)))
	2874	(xoris dest src high))
	2875
	2876	(define-ppc32-vinsn logxor-low (((dest :imm))
	2877	((src :imm)
	2878	(low :u16const)))
	2879	(xori dest src low))
	2880
	2881
	2882
	2883	(define-ppc32-vinsn %logxor2 (((dest :imm))
	2884	((x :imm)
	2885	(y :imm))
	2886	())
	2887	(xor dest x y))
	2888
	2889	(define-ppc32-vinsn %ilsl (((dest :imm))
	2890	((count :imm)
	2891	(src :imm))
	2892	((temp :u32)
	2893	(crx :crf)))
	2894	(cmplwi crx count (ash 31 ppc32::fixnumshift))
	2895	(srwi temp count ppc32::fixnumshift)
	2896	(slw dest src temp)
	2897	(ble+ crx :foo)
	2898	(li dest 0)
	2899	:foo)
	2900
	2901	(define-ppc32-vinsn %ilsl-c (((dest :imm))
	2902	((count :u8const)
	2903	(src :imm)))
	2904	;; Hard to use ppcmacroinstructions that expand into expressions
	2905	;; involving variables.
	2906	(rlwinm dest src count 0 (:apply - ppc32::least-significant-bit count)))
	2907
	2908
	2909	(define-ppc32-vinsn %ilsr-c (((dest :imm))
	2910	((count :u8const)
	2911	(src :imm)))
	2912	(rlwinm dest src (:apply - ppc32::nbits-in-word count) count (- ppc32::least-significant-bit
	2913	ppc32::fixnumshift)))
	2914
	2915
	2916
	2917	;;; 68k did the right thing for counts < 64 - fixnumshift but not if greater
	2918	;;; so load-byte fails in 3.0 also
	2919
	2920
	2921	(define-ppc32-vinsn %iasr (((dest :imm))
	2922	((count :imm)
	2923	(src :imm))
	2924	((temp :s32)
	2925	(crx :crf)))
	2926	(cmpwi crx count (ash 31 ppc32::fixnumshift))
	2927	(srawi temp count ppc32::fixnumshift)
	2928	(sraw temp src temp)
	2929	(ble+ crx :foo)
	2930	(srawi temp src 31)
	2931	:foo
	2932	(clrrwi dest temp ppc32::fixnumshift))
	2933
	2934	(define-ppc32-vinsn %iasr-c (((dest :imm))
	2935	((count :u8const)
	2936	(src :imm))
	2937	((temp :s32)))
	2938	(srawi temp src count)
	2939	(clrrwi dest temp ppc32::fixnumshift))
	2940
	2941	(define-ppc32-vinsn %ilsr (((dest :imm))
	2942	((count :imm)
	2943	(src :imm))
	2944	((temp :s32)
	2945	(crx :crf)))
	2946	(cmpwi crx count (ash 31 ppc32::fixnumshift))
	2947	(srwi temp count ppc32::fixnumshift)
	2948	(srw temp src temp)
	2949	(clrrwi dest temp ppc32::fixnumshift)
	2950	(ble+ crx :foo)
	2951	(li dest 0)
	2952	:foo
	2953	)
	2954
	2955	#+maybe
	2956	(define-ppc32-vinsn %ilsr-c (((dest :imm))
	2957	((count :u8const)
	2958	(src :imm))
	2959	((temp :s32)))
	2960	(rlwinm temp src (:apply - 32 count) count 31)
	2961	(clrrwi dest temp ppc32::fixnumshift))
	2962
	2963	(define-ppc32-vinsn natural-shift-left (((dest :u32))
	2964	((src :u32)
	2965	(count :u8const)))
	2966	(rlwinm dest src count 0 (:apply - 31 count)))
	2967
	2968	(define-ppc32-vinsn natural-shift-right (((dest :u32))
	2969	((src :u32)
	2970	(count :u8const)))
	2971	(rlwinm dest src (:apply - 32 count) count 31))
	2972
	2973	(define-ppc32-vinsn fixnum-ash-left (((dest :lisp))
	2974	((num :lisp)
	2975	(amt :lisp))
	2976	((count :s32)))
	2977	(srawi count amt ppc32::fixnumshift)
	2978	(slw dest num count))
	2979
	2980	(define-ppc32-vinsn fixnum-ash (((dest :lisp))
	2981	((num :lisp)
	2982	(amt :lisp))
	2983	((count :s32)
	2984	(crf0 (:crf 0))))
	2985	(srawi. count amt ppc32::fixnumshift)
	2986	(blt :right)
	2987	(slw dest num count)
	2988	(b :done)
	2989	:right
	2990	(neg count count)
	2991	(sraw count num count)
	2992	(clrrwi dest count ppc32::fixnumshift)
	2993	:done)
	2994
	2995
	2996	(define-ppc32-vinsn trap-unless-simple-array-2 (()
	2997	((object :lisp)
	2998	(expected-flags :u32const)
	2999	(type-error :u8const))
	3000	((tag :u8)
	3001	(flags :u32)
	3002	(crf :crf)))
	3003	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	3004	(cmpwi crf tag ppc32::tag-misc)
	3005	(bne crf :bad)
	3006	(lbz tag ppc32::misc-subtag-offset object)
	3007	(cmpwi crf tag ppc32::subtag-arrayH)
	3008	(bne crf :bad)
	3009	(lwz tag ppc32::arrayH.rank object)
	3010	(cmpwi crf tag (ash 2 ppc32::fixnumshift))
	3011	(lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc32::fixnumshift)))
	3012
	3013	(lwz flags ppc32::arrayH.flags object)
	3014	(ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags ppc32::fixnumshift)))
	3015	(bne crf :bad)
	3016	(cmpw crf tag flags)
	3017	(beq crf :good)
	3018	:bad
	3019	(uuo_interr type-error object)
	3020	:good)
	3021
	3022	(define-ppc32-vinsn trap-unless-simple-array-3 (()
	3023	((object :lisp)
	3024	(expected-flags :u32const)
	3025	(type-error :u8const))
	3026	((tag :u8)
	3027	(flags :u32)
	3028	(crf :crf)))
	3029	(clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
	3030	(cmpwi crf tag ppc32::tag-misc)
	3031	(bne crf :bad)
	3032	(lbz tag ppc32::misc-subtag-offset object)
	3033	(cmpwi crf tag ppc32::subtag-arrayH)
	3034	(bne crf :bad)
	3035	(lwz tag ppc32::arrayH.rank object)
	3036	(cmpwi crf tag (ash 3 ppc32::fixnumshift))
	3037	(lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc32::fixnumshift)))
	3038
	3039	(lwz flags ppc32::arrayH.flags object)
	3040	(ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags ppc32::fixnumshift)))
	3041	(bne crf :bad)
	3042	(cmpw crf tag flags)
	3043	(beq crf :good)
	3044	:bad
	3045	(uuo_interr type-error object)
	3046	:good)
	3047
	3048
	3049
	3050
	3051	(define-ppc32-vinsn sign-extend-halfword (((dest :imm))
	3052	((src :imm)))
	3053	(slwi dest src (- 16 ppc32::fixnumshift))
	3054	(srawi dest dest (- 16 ppc32::fixnumshift)))
	3055
	3056	(define-ppc32-vinsn s32-highword (((dest :imm))
	3057	((src :s32))
	3058	((temp :s32)))
	3059	(srawi temp src 16)
	3060	(slwi dest temp ppc32::fixnumshift))
	3061
	3062
	3063
	3064	(define-ppc32-vinsn fixnum-add (((dest t))
	3065	((x t)
	3066	(y t)))
	3067	(add dest x y))
	3068
	3069	(define-ppc32-vinsn fixnum-add-set-flags (((dest t)
	3070	(cr0 (:crf 0)))
	3071	((x t)
	3072	(y t)))
	3073	(addo. dest x y))
	3074
	3075
	3076
	3077
	3078
	3079
	3080	;;; (setq dest (- x y))
	3081	(define-ppc32-vinsn fixnum-sub (((dest t))
	3082	((x t)
	3083	(y t)))
	3084	(subf dest y x))
	3085
	3086	(define-ppc32-vinsn fixnum-sub-set-flags (((dest t)
	3087	(flags (:crf 0)))
	3088	((x t)
	3089	(y t)))
	3090	(subfo. dest y x))
	3091
	3092	(define-ppc32-vinsn fixnum-sub-from-constant (((dest :imm))
	3093	((x :s16const)
	3094	(y :imm)))
	3095	(subfic dest y (:apply ash x ppc32::fixnumshift)))
	3096
	3097
	3098
	3099
	3100	(define-ppc32-vinsn fixnum-sub-overflow-ool (()
	3101	((x :imm)
	3102	(y :imm)))
	3103	(subo. ppc::arg_z x y)
	3104	(bsola- .SPfix-overflow))
	3105
	3106	(define-ppc32-vinsn handle-fixnum-overflow-inline (((dest :lisp))
	3107	((src :imm))
	3108	((unboxed :s32)
	3109	(header :u32)))
	3110	(mtxer ppc::rzero)
	3111	(srawi unboxed src ppc32::fixnumshift)
	3112	(li header ppc32::one-digit-bignum-header)
	3113	(xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc32::fixnumshift))))
	3114	(la ppc::allocptr (- ppc32::fulltag-misc 8) ppc::allocptr)
	3115	(twllt ppc::allocptr ppc::allocbase)
	3116	(stw header ppc32::misc-header-offset ppc::allocptr)
	3117	(mr dest ppc::allocptr)
	3118	(clrrwi ppc::allocptr ppc::allocptr ppc32::ntagbits)
	3119	(stw unboxed ppc32::misc-data-offset dest))
	3120
	3121
	3122	;;; This is, of course, also "subtract-immediate."
	3123	(define-ppc32-vinsn add-immediate (((dest t))
	3124	((src t)
	3125	(upper :u32const)
	3126	(lower :u32const)))
	3127	((:not (:pred = upper 0))
	3128	(addis dest src upper)
	3129	((:not (:pred = lower 0))
	3130	(addi dest dest lower)))
	3131	((:and (:pred = upper 0) (:not (:pred = lower 0)))
	3132	(addi dest src lower)))
	3133
	3134	;This must unbox one reg, but hard to tell which is better.
	3135	;(The one with the smaller absolute value might be)
	3136	(define-ppc32-vinsn multiply-fixnums (((dest :imm))
	3137	((a :imm)
	3138	(b :imm))
	3139	((unboxed :s32)))
	3140	(srawi unboxed b ppc32::fixnumshift)
	3141	(mullw dest a unboxed))
	3142
	3143	(define-ppc32-vinsn multiply-immediate (((dest :imm))
	3144	((boxed :imm)
	3145	(const :s16const)))
	3146	(mulli dest boxed const))
	3147
	3148	;;; Mask out the code field of a base character; the result
	3149	;;; should be EXACTLY = to subtag-base-char
	3150	(define-ppc32-vinsn mask-base-char (((dest :u32))
	3151	((src :imm)))
	3152	(clrlwi dest src (- ppc32::nbits-in-word ppc32::charcode-shift)))
	3153
	3154	;;; Set dest (of type :s32!) to 0 iff VAL is an istruct of type TYPE
	3155	(define-ppc32-vinsn istruct-typep (((dest :s32))
	3156	((val :lisp)
	3157	(type :lisp))
	3158	((crf :crf)
	3159	(temp :lisp)))
	3160	(clrlwi dest val (- ppc32::nbits-in-word ppc32::nlisptagbits))
	3161	(cmpwi crf dest ppc32::tag-misc)
	3162	(li dest -1)
	3163	(bne crf :done)
	3164	(lbz dest ppc32::misc-subtag-offset val)
	3165	(cmpwi crf dest ppc32::subtag-istruct)
	3166	(bne crf :done)
	3167	(lwz temp ppc32::misc-data-offset val)
	3168	(subf dest type temp)
	3169	:done)
	3170
	3171
	3172	;; Boundp, fboundp stuff.
	3173	(define-ppc32-vinsn (ref-symbol-value :call :subprim)
	3174	(((val :lisp))
	3175	((sym (:lisp (:ne val)))))
	3176	(bla .SPspecrefcheck))
	3177
	3178	(define-ppc32-vinsn ref-symbol-value-inline (((dest :lisp))
	3179	((src (:lisp (:ne dest))))
	3180	((table :imm)
	3181	(idx :imm)))
	3182	(lwz idx ppc32::symbol.binding-index src)
	3183	(lwz table ppc32::tcr.tlb-limit ppc32::rcontext)
	3184	(cmpw idx table)
	3185	(lwz table ppc32::tcr.tlb-pointer ppc32::rcontext)
	3186	(bge :symbol)
	3187	(lwzx dest table idx)
	3188	(cmpwi dest ppc32::subtag-no-thread-local-binding)
	3189	(bne :done)
	3190	:symbol
	3191	(lwz dest ppc32::symbol.vcell src)
	3192	:done
	3193	(tweqi dest ppc32::unbound-marker))
	3194
	3195	(define-ppc32-vinsn (%ref-symbol-value :call :subprim)
	3196	(((val :lisp))
	3197	((sym (:lisp (:ne val)))))
	3198	(bla .SPspecref))
	3199
	3200	(define-ppc32-vinsn %ref-symbol-value-inline (((dest :lisp))
	3201	((src (:lisp (:ne dest))))
	3202	((table :imm)
	3203	(idx :imm)))
	3204	(lwz idx ppc32::symbol.binding-index src)
	3205	(lwz table ppc32::tcr.tlb-limit ppc32::rcontext)
	3206	(cmpw idx table)
	3207	(lwz table ppc32::tcr.tlb-pointer ppc32::rcontext)
	3208	(bge :symbol)
	3209	(lwzx dest table idx)
	3210	(cmpwi dest ppc32::subtag-no-thread-local-binding)
	3211	(bne :done)
	3212	:symbol
	3213	(lwz dest ppc32::symbol.vcell src)
	3214	:done
	3215	)
	3216
	3217	(define-ppc32-vinsn (setq-special :call :subprim)
	3218	(()
	3219	((sym :lisp)
	3220	(val :lisp)))
	3221	(bla .SPspecset))
	3222
	3223
	3224	(define-ppc32-vinsn symbol-function (((val :lisp))
	3225	((sym (:lisp (:ne val))))
	3226	((crf :crf)
	3227	(tag :u32)))
	3228	(lwz val ppc32::symbol.fcell sym)
	3229	(clrlwi tag val (- 32 ppc32::nlisptagbits))
	3230	(cmpwi crf tag ppc32::tag-misc)
	3231	(bne- crf :bad)
	3232	(lbz tag ppc32::misc-subtag-offset val)
	3233	(cmpwi crf tag ppc32::subtag-function)
	3234	(beq+ crf :good)
	3235	:bad
	3236	(uuo_interr arch::error-udf sym)
	3237	:good)
	3238
	3239
	3240
	3241	(define-ppc32-vinsn save-nfp (()
	3242	()
	3243	((temp :imm)))
	3244	((:pred > (:apply ppc2-max-nfp-depth) 0)
	3245	(stwu ppc::sp (:apply - (:apply + (:apply ppc2-max-nfp-depth) 8)) ppc::sp)
	3246	(lwz temp ppc32::tcr.nfp ppc32::rcontext)
	3247	(stw temp 4 ppc::sp)
	3248	(stw ppc::sp ppc32::tcr.nfp ppc32::rcontext)))
	3249
	3250	(define-ppc32-vinsn restore-nfp (()
	3251	()
	3252	((temp :imm)))
	3253	((:pred > (:apply ppc2-max-nfp-depth) 0)
	3254	(lwz temp 4 ppc::sp)
	3255	(stw temp ppc32::tcr.nfp ppc32::rcontext)
	3256	(lwz ppc::sp 0 ppc::sp)))
	3257
	3258	(define-ppc32-vinsn (nfp-store-complex-double-float :nfp :set) (()
	3259	((val :complex-double-float)
	3260	(nfp :imm)
	3261	(offset :u16const)))
	3262	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3263	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3264	(stfd val (:apply + offset 16) nfp)
	3265	(stfd (:apply 1+ (:apply %hard-regspec-value val)) (:apply + offset 24) nfp))
	3266
	3267	(define-ppc32-vinsn (nfp-load-complex-double-float :nfp :ref) (((val :complex-double-float))
	3268	(
	3269	(nfp :imm)
	3270	(offset :u16const)))
	3271	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3272	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3273	(lfd val (:apply + offset 16) nfp)
	3274	(lfd (:apply 1+ (:apply %hard-regspec-value val)) (:apply + offset 24) nfp))
	3275
	3276	(define-ppc32-vinsn (nfp-store-complex-single-float :nfp :set) (()
	3277	((val :complex-single-float)
	3278	(nfp :imm)
	3279	(offset :u16const)))
	3280	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3281	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3282	(stfs val (:apply + offset 16) nfp)
	3283	(stfs (:apply 1+ (:apply %hard-regspec-value val)) (:apply + offset 20) nfp))
	3284
	3285	(define-ppc32-vinsn (nfp-load-complex-single-float :nfp :ref) (((val :complex-single-float))
	3286	(
	3287	(nfp :imm)
	3288	(offset :u16const)))
	3289	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3290	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3291	(lfs val (:apply + offset 16) nfp)
	3292	(lfs (:apply 1+ (:apply %hard-regspec-value val)) (:apply + offset 20) nfp))
	3293
	3294
	3295
	3296	(define-ppc32-vinsn (nfp-store-double-float :nfp :set) (()
	3297	((val :double-float)
	3298	(nfp :imm)
	3299	(offset :u16const))
	3300	)
	3301	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3302	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3303	(stfd val (:apply + offset 16) nfp))
	3304
	3305	(define-ppc32-vinsn (nfp-load-double-float :nfp :ref) (((val :double-float))
	3306	((nfp :imm)
	3307	(offset :u16const)))
	3308	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3309	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3310	(lfd val (:apply + offset 16) nfp))
	3311
	3312
	3313
	3314	(define-ppc32-vinsn (nfp-store-single-float :nfp :set) (()
	3315	((val :single-float)
	3316	(nfp (:u32 #.ppc::nargs))
	3317	(offset :u16const)))
	3318
	3319	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3320	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3321	(stfs val (:apply + offset 16) nfp))
	3322
	3323	(define-ppc32-vinsn (nfp-load-single-float :nfp :ref) (((val :single-float))
	3324	((nfp :imm)
	3325	(offset :u16const)))
	3326	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3327	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3328	(lfs val (:apply + offset 16) nfp))
	3329
	3330	(define-ppc32-vinsn (nfp-store-unboxed-word :nfp :set) (()
	3331	((w :u32)
	3332	(nfp :imm)
	3333	(offset :u16const)))
	3334	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3335	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3336	(stw w (:apply + offset 16) nfp))
	3337
	3338	(define-ppc32-vinsn (nfp-load-unboxed-word :nfp :ref) (((w :u32))
	3339	((nfp :imm)
	3340	(offset :u16const)))
	3341	((:pred /= ppc::sp (:apply %hard-regspec-value nfp))
	3342	(lwz nfp ppc32::tcr.nfp ppc32::rcontext))
	3343	(lwz w (:apply + offset 16) nfp))
	3344
	3345	(define-ppc32-vinsn (temp-push-unboxed-word :push :word :tsp)
	3346	(()
	3347	((w :u32)))
	3348	(stwu ppc::tsp -16 ppc::tsp)
	3349	(stw ppc::tsp 4 ppc::tsp)
	3350	(stw w 8 ppc::tsp))
	3351
	3352	(define-ppc32-vinsn (temp-pop-unboxed-word :pop :word :tsp)
	3353	(((w :u32))
	3354	())
	3355	(lwz w 8 ppc::tsp)
	3356	(la ppc::tsp 16 ppc::tsp))
	3357
	3358	(define-ppc32-vinsn (temp-push-double-float :push :doubleword :tsp)
	3359	(((d :double-float))
	3360	())
	3361	(stwu ppc::tsp -16 ppc::tsp)
	3362	(stw ppc::tsp 4 ppc::tsp)
	3363	(stfd d 8 ppc::tsp))
	3364
	3365	(define-ppc32-vinsn (temp-pop-double-float :pop :doubleword :tsp)
	3366	(()
	3367	((d :double-float)))
	3368	(lfd d 8 ppc::tsp)
	3369	(la ppc::tsp 16 ppc::tsp))
	3370
	3371	(define-ppc32-vinsn (temp-push-single-float :push :word :tsp)
	3372	(((s :single-float))
	3373	())
	3374	(stwu ppc::tsp -16 ppc::tsp)
	3375	(stw ppc::tsp 4 ppc::tsp)
	3376	(stfs s 8 ppc::tsp))
	3377
	3378	(define-ppc32-vinsn (temp-pop-single-float :pop :word :tsp)
	3379	(()
	3380	((s :single-float)))
	3381	(lfs s 8 ppc::tsp)
	3382	(la ppc::tsp 16 ppc::tsp))
	3383
	3384
	3385	(define-ppc32-vinsn (save-nvrs-individually :push :node :vsp :multiple)
	3386	(()
	3387	((first :u8const)))
	3388	(stwu ppc::save0 -4 ppc::vsp)
	3389	((:pred <= first ppc::save1)
	3390	(stwu ppc::save1 -4 ppc::vsp)
	3391	((:pred <= first ppc::save2)
	3392	(stwu ppc::save2 -4 ppc::vsp)
	3393	((:pred <= first ppc::save3)
	3394	(stwu ppc::save3 -4 ppc::vsp)
	3395	((:pred <= first ppc::save4)
	3396	(stwu ppc::save4 -4 ppc::vsp)
	3397	((:pred <= first ppc::save5)
	3398	(stwu ppc::save5 -4 ppc::vsp)
	3399	((:pred <= first ppc::save6)
	3400	(stwu ppc::save6 -4 ppc::vsp)
	3401	((:pred = first ppc::save7)
	3402	(stwu ppc::save7 -4 ppc::vsp)))))))))
	3403
	3404	(define-ppc32-vinsn (save-nvrs :push :node :vsp :multiple)
	3405	(()
	3406	((first :u8const)))
	3407	((:pred <= first ppc::save3)
	3408	(subi ppc::vsp ppc::vsp (:apply * 4 (:apply - 32 first)))
	3409	(stmw first 0 ppc::vsp))
	3410	((:pred >= first ppc::save2)
	3411	(stwu ppc::save0 -4 ppc::vsp)
	3412	((:pred <= first ppc::save1)
	3413	(stwu ppc::save1 -4 ppc::vsp)
	3414	((:pred = first ppc::save2)
	3415	(stwu ppc::save2 -4 ppc::vsp)))))
	3416
	3417
	3418	(define-ppc32-vinsn (restore-nvrs :pop :node :vsp :multiple)
	3419	(()
	3420	((firstreg :u8const)
	3421	(basereg :imm)
	3422	(offset :s16const)))
	3423	((:pred <= firstreg ppc::save3)
	3424	(lmw firstreg offset basereg))
	3425	((:pred = firstreg ppc::save2)
	3426	(lwz ppc::save2 offset basereg)
	3427	(lwz ppc::save1 (:apply + offset 4) basereg)
	3428	(lwz ppc::save0 (:apply + offset 8) basereg))
	3429	((:pred = firstreg ppc::save1)
	3430	(lwz ppc::save1 offset basereg)
	3431	(lwz ppc::save0 (:apply + offset 4) basereg))
	3432	((:pred = firstreg ppc::save0)
	3433	(lwz ppc::save0 offset basereg)))
	3434
	3435	(define-ppc32-vinsn %current-frame-ptr (((dest :imm))
	3436	())
	3437	(mr dest ppc::sp))
	3438
	3439	(define-ppc32-vinsn %current-tcr (((dest :imm))
	3440	())
	3441	(mr dest ppc32::rcontext))
	3442
	3443	(define-ppc32-vinsn (dpayback :call :subprim) (()
	3444	((n :s16const))
	3445	((temp (:u32 #.ppc::imm0))))
	3446	((:pred > n 1)
	3447	(li temp n)
	3448	(bla .SPunbind-n))
	3449	((:pred = n 1)
	3450	(bla .SPunbind)))
	3451
	3452	(define-ppc32-vinsn zero-double-float-register
	3453	(((dest :double-float))
	3454	())
	3455	(fmr dest ppc::fp-zero))
	3456
	3457	(define-ppc32-vinsn zero-single-float-register
	3458	(((dest :single-float))
	3459	())
	3460	(fmr dest ppc::fp-zero))
	3461
	3462	(define-ppc32-vinsn load-double-float-constant
	3463	(((dest :double-float))
	3464	((high t)
	3465	(low t)))
	3466	(stw high -8 ppc::sp)
	3467	(stw low -4 ppc::sp)
	3468	(lfd dest -8 ppc::sp ))
	3469
	3470	(define-ppc32-vinsn load-single-float-constant
	3471	(((dest :single-float))
	3472	((src t)))
	3473	(stw src -4 ppc::sp)
	3474	(lfs dest -4 ppc::sp))
	3475
	3476	(define-ppc32-vinsn load-indexed-node (((node :lisp))
	3477	((base :lisp)
	3478	(offset :s16const)))
	3479	(lwz node offset base))
	3480
	3481	(define-ppc32-vinsn check-exact-nargs (()
	3482	((n :u16const)))
	3483	(twnei ppc::nargs (:apply ash n 2)))
	3484
	3485	(define-ppc32-vinsn check-min-nargs (()
	3486	((min :u16const)))
	3487	(twllti ppc::nargs (:apply ash min 2)))
	3488
	3489	(define-ppc32-vinsn check-max-nargs (()
	3490	((max :u16const)))
	3491	(twlgti ppc::nargs (:apply ash max 2)))
	3492
	3493	;;; Save context and establish FN. The current VSP is the the
	3494	;;; same as the caller's, e.g., no arguments were vpushed.
	3495	(define-ppc32-vinsn save-lisp-context-vsp (()
	3496	()
	3497	((imm :u32)))
	3498	(lwz imm ppc32::tcr.cs-limit ppc32::rcontext)
	3499	(stwu ppc::sp (- ppc32::lisp-frame.size) ppc::sp)
	3500	(stw ppc::fn ppc32::lisp-frame.savefn ppc::sp)
	3501	(stw ppc::loc-pc ppc32::lisp-frame.savelr ppc::sp)
	3502	(stw ppc::vsp ppc32::lisp-frame.savevsp ppc::sp)
	3503	(mr ppc::fn ppc::nfn)
	3504	;; Do a stack-probe ...
	3505	(twllt ppc::sp imm))
	3506
	3507	;;; Do the same thing via a subprim call.
	3508	(define-ppc32-vinsn (save-lisp-context-vsp-ool :call :subprim)
	3509	(()
	3510	()
	3511	((imm (:u32 #.ppc::imm0))))
	3512	(bla .SPsavecontextvsp))
	3513
	3514	(define-ppc32-vinsn save-lisp-context-offset (()
	3515	((nbytes-vpushed :u16const))
	3516	((imm :u32)))
	3517	(la imm nbytes-vpushed ppc::vsp)
	3518	(stwu ppc::sp (- ppc32::lisp-frame.size) ppc::sp)
	3519	(stw ppc::fn ppc32::lisp-frame.savefn ppc::sp)
	3520	(stw ppc::loc-pc ppc32::lisp-frame.savelr ppc::sp)
	3521	(stw imm ppc32::lisp-frame.savevsp ppc::sp)
	3522	(mr ppc::fn ppc::nfn)
	3523	;; Do a stack-probe ...
	3524	(lwz imm ppc32::tcr.cs-limit ppc32::rcontext)
	3525	(twllt ppc::sp imm))
	3526
	3527	(define-ppc32-vinsn save-lisp-context-offset-ool (()
	3528	((nbytes-vpushed :u16const))
	3529	((imm (:u32 #.ppc::imm0))))
	3530	(li imm nbytes-vpushed)
	3531	(bla .SPsavecontext0))
	3532
	3533
	3534	(define-ppc32-vinsn save-lisp-context-lexpr (()
	3535	()
	3536	((imm :u32)))
	3537	(stwu ppc::sp (- ppc32::lisp-frame.size) ppc::sp)
	3538	(stw ppc::rzero ppc32::lisp-frame.savefn ppc::sp)
	3539	(stw ppc::loc-pc ppc32::lisp-frame.savelr ppc::sp)
	3540	(stw ppc::vsp ppc32::lisp-frame.savevsp ppc::sp)
	3541	(mr ppc::fn ppc::nfn)
	3542	;; Do a stack-probe ...
	3543	(lwz imm ppc32::tcr.cs-limit ppc32::rcontext)
	3544	(twllt ppc::sp imm))
	3545
	3546	(define-ppc32-vinsn save-cleanup-context (()
	3547	())
	3548	;; SP was this deep just a second ago, so no need to do a stack-probe.
	3549	(mflr ppc::loc-pc)
	3550	(stwu ppc::sp (- ppc32::lisp-frame.size) ppc::sp)
	3551	(stw ppc::rzero ppc32::lisp-frame.savefn ppc::sp)
	3552	(stw ppc::loc-pc ppc32::lisp-frame.savelr ppc::sp)
	3553	(stw ppc::vsp ppc32::lisp-frame.savevsp ppc::sp))
	3554
	3555	;; Vpush the argument registers. We got at least "min-fixed" args;
	3556	;; that knowledge may help us generate better code.
	3557	(define-ppc32-vinsn (save-lexpr-argregs :call :subprim)
	3558	(()
	3559	((min-fixed :u16const))
	3560	((crfx :crf)
	3561	(crfy :crf)
	3562	(entry-vsp (:u32 #.ppc::imm0))
	3563	(arg-temp :u32)))
	3564	((:pred >= min-fixed $numppcargregs)
	3565	(stwu ppc::arg_x -4 ppc::vsp)
	3566	(stwu ppc::arg_y -4 ppc::vsp)
	3567	(stwu ppc::arg_z -4 ppc::vsp))
	3568	((:pred = min-fixed 2) ; at least 2 args
	3569	(cmplwi crfx ppc::nargs (ash 2 ppc32::word-shift))
	3570	(beq crfx :yz2) ; skip arg_x if exactly 2
	3571	(stwu ppc::arg_x -4 ppc::vsp)
	3572	:yz2
	3573	(stwu ppc::arg_y -4 ppc::vsp)
	3574	(stwu ppc::arg_z -4 ppc::vsp))
	3575	((:pred = min-fixed 1) ; at least one arg
	3576	(cmplwi crfx ppc::nargs (ash 2 ppc32::word-shift))
	3577	(blt crfx :z1) ; branch if exactly one
	3578	(beq crfx :yz1) ; branch if exactly two
	3579	(stwu ppc::arg_x -4 ppc::vsp)
	3580	:yz1
	3581	(stwu ppc::arg_y -4 ppc::vsp)
	3582	:z1
	3583	(stwu ppc::arg_z -4 ppc::vsp))
	3584	((:pred = min-fixed 0)
	3585	(cmplwi crfx ppc::nargs (ash 2 ppc32::word-shift))
	3586	(cmplwi crfy ppc::nargs 0)
	3587	(beq crfx :yz0) ; exactly two
	3588	(beq crfy :none) ; exactly zero
	3589	(blt crfx :z0) ; one
	3590	; Three or more ...
	3591	(stwu ppc::arg_x -4 ppc::vsp)
	3592	:yz0
	3593	(stwu ppc::arg_y -4 ppc::vsp)
	3594	:z0
	3595	(stwu ppc::arg_z -4 ppc::vsp)
	3596	:none
	3597	)
	3598	((:pred = min-fixed 0)
	3599	(stwu ppc::nargs -4 ppc::vsp))
	3600	((:not (:pred = min-fixed 0))
	3601	(subi arg-temp ppc::nargs (:apply ash min-fixed ppc32::word-shift))
	3602	(stwu arg-temp -4 ppc::vsp))
	3603	(add entry-vsp ppc::vsp ppc::nargs)
	3604	(la entry-vsp 4 entry-vsp)
	3605	(bla .SPlexpr-entry))
	3606
	3607
	3608	(define-ppc32-vinsn (jump-return-pc :jumpLR)
	3609	(()
	3610	())
	3611	(blr))
	3612
	3613	(define-ppc32-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore)
	3614	(()
	3615	())
	3616	(lwz ppc::loc-pc ppc32::lisp-frame.savelr ppc::sp)
	3617	(lwz ppc::vsp ppc32::lisp-frame.savevsp ppc::sp)
	3618	(lwz ppc::fn ppc32::lisp-frame.savefn ppc::sp)
	3619	(mtlr ppc::loc-pc)
	3620	(la ppc::sp ppc32::lisp-frame.size ppc::sp))
	3621
	3622
	3623
	3624	(define-ppc32-vinsn (restore-full-lisp-context-ool :lispcontext :pop :csp :lrRestore)
	3625	(()
	3626	())
	3627	(bla .SPrestorecontext)
	3628	(mtlr ppc::loc-pc))
	3629
	3630	(define-ppc32-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
	3631	(()
	3632	())
	3633	(ba .SPpopj))
	3634
	3635	;;; Exiting from an UNWIND-PROTECT cleanup is similar to
	3636	;;; (and a little simpler than) returning from a function.
	3637	(define-ppc32-vinsn restore-cleanup-context (()
	3638	())
	3639	(lwz ppc::loc-pc ppc32::lisp-frame.savelr ppc::sp)
	3640	(mtlr ppc::loc-pc)
	3641	(la ppc::sp ppc32::lisp-frame.size ppc::sp))
	3642
	3643
	3644
	3645	(define-ppc32-vinsn default-1-arg (()
	3646	((min :u16const))
	3647	((crf :crf)))
	3648	(cmplwi crf ppc::nargs (:apply ash min 2))
	3649	(bne crf :done)
	3650	((:pred >= min 3)
	3651	(stwu ppc::arg_x -4 ppc::vsp))
	3652	((:pred >= min 2)
	3653	(mr ppc::arg_x ppc::arg_y))
	3654	((:pred >= min 1)
	3655	(mr ppc::arg_y ppc::arg_z))
	3656	(li ppc::arg_z (:apply target-nil-value))
	3657	:done)
	3658
	3659	(define-ppc32-vinsn default-2-args (()
	3660	((min :u16const))
	3661	((crf :crf)))
	3662	(cmplwi crf ppc::nargs (:apply ash (:apply 1+ min) 2))
	3663	(bgt crf :done)
	3664	(beq crf :one)
	3665	; We got "min" args; arg_y & arg_z default to nil
	3666	((:pred >= min 3)
	3667	(stwu ppc::arg_x -4 ppc::vsp))
	3668	((:pred >= min 2)
	3669	(stwu ppc::arg_y -4 ppc::vsp))
	3670	((:pred >= min 1)
	3671	(mr ppc::arg_x ppc::arg_z))
	3672	(li ppc::arg_y (:apply target-nil-value))
	3673	(b :last)
	3674	:one
	3675	; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
	3676	((:pred >= min 2)
	3677	(stwu ppc::arg_x -4 ppc::vsp))
	3678	((:pred >= min 1)
	3679	(mr ppc::arg_x ppc::arg_y))
	3680	(mr ppc::arg_y ppc::arg_z)
	3681	:last
	3682	(li ppc::arg_z (:apply target-nil-value))
	3683	:done)
	3684
	3685	(define-ppc32-vinsn default-3-args (()
	3686	((min :u16const))
	3687	((crfx :crf)
	3688	(crfy :crf)))
	3689	(cmplwi crfx ppc::nargs (:apply ash (:apply + 2 min) 2))
	3690	(cmplwi crfy ppc::nargs (:apply ash min 2))
	3691	(bgt crfx :done)
	3692	(beq crfx :two)
	3693	(beq crfy :none)
	3694	; The first (of three) &optional args was supplied.
	3695	((:pred >= min 2)
	3696	(stwu ppc::arg_x -4 ppc::vsp))
	3697	((:pred >= min 1)
	3698	(stwu ppc::arg_y -4 ppc::vsp))
	3699	(mr ppc::arg_x ppc::arg_z)
	3700	(b :last-2)
	3701	:two
	3702	; The first two (of three) &optional args were supplied.
	3703	((:pred >= min 1)
	3704	(stwu ppc::arg_x -4 ppc::vsp))
	3705	(mr ppc::arg_x ppc::arg_y)
	3706	(mr ppc::arg_y ppc::arg_z)
	3707	(b :last-1)
	3708	; None of the three &optional args was provided.
	3709	:none
	3710	((:pred >= min 3)
	3711	(stwu ppc::arg_x -4 ppc::vsp))
	3712	((:pred >= min 2)
	3713	(stwu ppc::arg_y -4 ppc::vsp))
	3714	((:pred >= min 1)
	3715	(stwu ppc::arg_z -4 ppc::vsp))
	3716	(li ppc::arg_x (:apply target-nil-value))
	3717	:last-2
	3718	(li ppc::arg_y (:apply target-nil-value))
	3719	:last-1
	3720	(li ppc::arg_z (:apply target-nil-value))
	3721	:done)
	3722
	3723	(define-ppc32-vinsn save-lr (()
	3724	())
	3725	(mflr ppc::loc-pc))
	3726
	3727	;;; "n" is the sum of the number of required args +
	3728	;;; the number of &optionals.
	3729	(define-ppc32-vinsn (default-optionals :call :subprim) (()
	3730	((n :u16const)))
	3731	(li ppc::imm0 (:apply ash n 2))
	3732	(bla .SPdefault-optional-args))
	3733
	3734	;;; fname contains a known symbol
	3735	(define-ppc32-vinsn (call-known-symbol :call) (((result (:lisp ppc::arg_z)))
	3736	())
	3737	(lwz ppc::nfn ppc32::symbol.fcell ppc::fname)
	3738	(lwz ppc::temp0 ppc32::misc-data-offset ppc::nfn)
	3739	(mtctr ppc::temp0)
	3740	(bctrl))
	3741
	3742	(define-ppc32-vinsn (jump-known-symbol :jumplr) (()
	3743	())
	3744	(lwz ppc::nfn ppc32::symbol.fcell ppc::fname)
	3745	(lwz ppc::temp0 ppc32::misc-data-offset ppc::nfn)
	3746	(mtctr ppc::temp0)
	3747	(bctr))
	3748
	3749	(define-ppc32-vinsn (call-known-function :call) (()
	3750	())
	3751	(lwz ppc::temp0 ppc32::misc-data-offset ppc::nfn)
	3752	(mtctr ppc::temp0)
	3753	(bctrl))
	3754
	3755	(define-ppc32-vinsn (jump-known-function :jumplr) (()
	3756	())
	3757	(lwz ppc::temp0 ppc32::misc-data-offset ppc::nfn)
	3758	(mtctr ppc::temp0)
	3759	(bctr))
	3760
	3761	(define-ppc32-vinsn %schar8 (((char :imm))
	3762	((str :lisp)
	3763	(idx :imm))
	3764	((imm :u32)))
	3765	(srwi imm idx ppc32::fixnumshift)
	3766	(addi imm imm ppc32::misc-data-offset)
	3767	(lbzx imm str imm)
	3768	(slwi imm imm ppc32::charcode-shift)
	3769	(addi char imm ppc32::subtag-character))
	3770
	3771	(define-ppc32-vinsn %schar32 (((char :imm))
	3772	((str :lisp)
	3773	(idx :imm))
	3774	((imm :u32)))
	3775	(addi imm idx ppc32::misc-data-offset)
	3776	(lwzx imm str imm)
	3777	(slwi imm imm ppc32::charcode-shift)
	3778	(addi char imm ppc32::subtag-character))
	3779
	3780
	3781	(define-ppc32-vinsn %set-schar8 (()
	3782	((str :lisp)
	3783	(idx :imm)
	3784	(char :imm))
	3785	((imm :u32)
	3786	(imm1 :u32)
	3787	(cr0 (:crf 0))))
	3788	(srwi imm idx ppc32::fixnumshift)
	3789	(addi imm imm ppc32::misc-data-offset)
	3790	(srwi imm1 char ppc32::charcode-shift)
	3791	(stbx imm1 str imm)
	3792	)
	3793
	3794	(define-ppc32-vinsn %set-schar32 (()
	3795	((str :lisp)
	3796	(idx :imm)
	3797	(char :imm))
	3798	((imm :u32)
	3799	(imm1 :u32)
	3800	(cr0 (:crf 0))))
	3801	(addi imm idx ppc32::misc-data-offset)
	3802	(srwi imm1 char ppc32::charcode-shift)
	3803	(stwx imm1 str imm)
	3804	)
	3805
	3806	(define-ppc32-vinsn %set-scharcode8 (()
	3807	((str :lisp)
	3808	(idx :imm)
	3809	(code :imm))
	3810	((imm :u32)
	3811	(imm1 :u32)
	3812	(cr0 (:crf 0))))
	3813	(srwi imm idx ppc32::fixnumshift)
	3814	(addi imm imm ppc32::misc-data-offset)
	3815	(srwi imm1 code ppc32::fixnumshift)
	3816	(stbx imm1 str imm)
	3817	)
	3818
	3819
	3820	(define-ppc32-vinsn %set-scharcode32 (()
	3821	((str :lisp)
	3822	(idx :imm)
	3823	(code :imm))
	3824	((imm :u32)
	3825	(imm1 :u32)))
	3826	(addi imm idx ppc32::misc-data-offset)
	3827	(srwi imm1 code ppc32::fixnumshift)
	3828	(stwx imm1 str imm)
	3829	)
	3830
	3831	(define-ppc32-vinsn %scharcode8 (((code :imm))
	3832	((str :lisp)
	3833	(idx :imm))
	3834	((imm :u32)
	3835	(cr0 (:crf 0))))
	3836	(srwi imm idx ppc32::fixnumshift)
	3837	(addi imm imm ppc32::misc-data-offset)
	3838	(lbzx imm str imm)
	3839	(slwi code imm ppc32::fixnumshift))
	3840
	3841	(define-ppc32-vinsn %scharcode32 (((code :imm))
	3842	((str :lisp)
	3843	(idx :imm))
	3844	((imm :u32)
	3845	(cr0 (:crf 0))))
	3846	(addi imm idx ppc32::misc-data-offset)
	3847	(lwzx imm str imm)
	3848	(slwi code imm ppc32::fixnumshift))
	3849
	3850	;;; Clobbers LR
	3851	(define-ppc32-vinsn (%debug-trap :call :subprim) (()
	3852	())
	3853	(bla .SPbreakpoint)
	3854	)
	3855
	3856
	3857	(define-ppc32-vinsn eep.address (((dest t))
	3858	((src (:lisp (:ne dest )))))
	3859	(lwz dest (+ (ash 1 2) ppc32::misc-data-offset) src)
	3860	(tweqi dest (:apply target-nil-value)))
	3861
	3862	(define-ppc32-vinsn %natural+ (((dest :u32))
	3863	((x :u32) (y :u32)))
	3864	(add dest x y))
	3865
	3866	(define-ppc32-vinsn %natural+-c (((dest :u32))
	3867	((x :u32) (y :u16const)))
	3868	(addi dest x y))
	3869
	3870	(define-ppc32-vinsn %natural- (((dest :u32))
	3871	((x :u32) (y :u32)))
	3872	(sub dest x y))
	3873
	3874	(define-ppc32-vinsn %natural--c (((dest :u32))
	3875	((x :u32) (y :u16const)))
	3876	(subi dest x y))
	3877
	3878	(define-ppc32-vinsn %natural-logior (((dest :u32))
	3879	((x :u32) (y :u32)))
	3880	(or dest x y))
	3881
	3882	(define-ppc32-vinsn %natural-logior-c (((dest :u32))
	3883	((x :u32) (high :u16const) (low :u16const)))
	3884	((:not (:pred = high 0))
	3885	(oris dest x high))
	3886	((:not (:pred = low 0))
	3887	(ori dest x low)))
	3888
	3889	(define-ppc32-vinsn %natural-logxor (((dest :u32))
	3890	((x :u32) (y :u32)))
	3891	(xor dest x y))
	3892
	3893	(define-ppc32-vinsn %natural-logxor-c (((dest :u32))
	3894	((x :u32) (high :u16const) (low :u16const)))
	3895	((:not (:pred = high 0))
	3896	(xoris dest x high))
	3897	((:not (:pred = low 0))
	3898	(xori dest x low)))
	3899
	3900	(define-ppc32-vinsn %natural-logand (((dest :u32))
	3901	((x :u32) (y :u32)))
	3902	(and dest x y))
	3903
	3904	(define-ppc32-vinsn %natural-logand-high-c (((dest :u32))
	3905	((x :u32) (high :u16const))
	3906	((cr0 (:crf 0))))
	3907	(andis. dest x high))
	3908
	3909	(define-ppc32-vinsn %natural-logand-low-c (((dest :u32))
	3910	((x :u32) (low :u16const))
	3911	((cr0 (:crf 0))))
	3912	(andi. dest x low))
	3913
	3914	(define-ppc32-vinsn %natural-logand-mask-c (((dest :u32))
	3915	((x :u32)
	3916	(start :u8const)
	3917	(end :u8const)))
	3918	(rlwinm dest x 0 start end))
	3919
	3920	(define-ppc32-vinsn disable-interrupts (((dest :lisp))
	3921	()
	3922	((temp :imm)
	3923	(temp2 :imm)))
	3924	(lwz temp2 ppc32::tcr.tlb-pointer ppc32::rcontext)
	3925	(li temp -4)
	3926	(lwz dest ppc32::interrupt-level-binding-index temp2)
	3927	(stw temp ppc32::interrupt-level-binding-index temp2))
	3928
	3929	(define-ppc32-vinsn load-character-constant (((dest :lisp))
	3930	((code :u32const)))
	3931	(ori dest ppc::rzero (:apply logior (:apply ash (:apply logand #xff code) ppc32::charcode-shift) ppc32::subtag-character))
	3932	((:not (:pred = 0 (:apply ldb (byte 16 8) code)))
	3933	(oris dest dest (:apply ldb (byte 16 8) code))))
	3934
	3935
	3936	(define-ppc32-vinsn %symbol->symptr (((dest :lisp))
	3937	((src :lisp))
	3938	((tag :u8)
	3939	(crf0 :crf)
	3940	(crf1 :crf)))
	3941	(clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
	3942	(cmpwi crf0 src (:apply target-nil-value))
	3943	(cmpwi crf1 tag ppc32::tag-misc)
	3944	(beq crf0 :nilsym)
	3945	(bne crf1 :do-trap)
	3946	(lbz tag ppc32::misc-subtag-offset src)
	3947	:do-trap
	3948	(twnei tag ppc32::subtag-symbol)
	3949	((:not (:pred =
	3950	(:apply %hard-regspec-value dest)
	3951	(:apply %hard-regspec-value src)))
	3952	(mr dest src))
	3953	(b :done)
	3954	:nilsym
	3955	(li dest (:apply + ppc32::nilsym-offset (:apply target-nil-value)))
	3956	:done)
	3957
	3958	;;; Subprim calls. Done this way for the benefit of VINSN-OPTIMIZE.
	3959	(defmacro define-ppc32-subprim-call-vinsn ((name &rest other-attrs) spno)
	3960	`(define-ppc32-vinsn (,name :call :subprim ,@other-attrs) (() ())
	3961	(bla ,spno)))
	3962
	3963	(defmacro define-ppc32-subprim-jump-vinsn ((name &rest other-attrs) spno)
	3964	`(define-ppc32-vinsn (,name :jumpLR ,@other-attrs) (() ())
	3965	(ba ,spno)))
	3966
	3967	(define-ppc32-subprim-jump-vinsn (restore-interrupt-level) .SPrestoreintlevel)
	3968
	3969	(define-ppc32-subprim-call-vinsn (save-values) .SPsave-values)
	3970
	3971	(define-ppc32-subprim-call-vinsn (recover-values) .SPrecover-values)
	3972
	3973	(define-ppc32-subprim-call-vinsn (add-values) .SPadd-values)
	3974
	3975	(define-ppc32-subprim-jump-vinsn (jump-known-symbol-ool) .SPjmpsym)
	3976
	3977	(define-ppc32-subprim-call-vinsn (call-known-symbol-ool) .SPjmpsym)
	3978
	3979	(define-ppc32-subprim-call-vinsn (pass-multiple-values) .SPmvpass)
	3980
	3981	(define-ppc32-subprim-call-vinsn (pass-multiple-values-symbol) .SPmvpasssym)
	3982
	3983	(define-ppc32-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
	3984
	3985	(define-ppc32-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
	3986
	3987	(define-ppc32-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
	3988
	3989	(define-ppc32-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
	3990
	3991	(define-ppc32-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
	3992
	3993	(define-ppc32-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
	3994
	3995	(define-ppc32-subprim-call-vinsn (funcall) .SPfuncall)
	3996
	3997	(define-ppc32-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
	3998
	3999	(define-ppc32-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
	4000
	4001	(define-ppc32-subprim-jump-vinsn (tail-funcall-vsp) .SPtfuncallvsp)
	4002
	4003	(define-ppc32-subprim-call-vinsn (spread-lexpr) .SPspread-lexpr-z)
	4004
	4005	(define-ppc32-subprim-call-vinsn (spread-list) .SPspreadargz)
	4006
	4007	(define-ppc32-subprim-call-vinsn (pop-argument-registers) .SPvpopargregs)
	4008
	4009	(define-ppc32-subprim-call-vinsn (getu32) .SPgetu32)
	4010
	4011	(define-ppc32-subprim-call-vinsn (gets32) .SPgets32)
	4012
	4013	(define-ppc32-subprim-call-vinsn (getxlong) .SPgetXlong)
	4014
	4015	(define-ppc32-subprim-call-vinsn (stack-cons-list) .SPstkconslist)
	4016
	4017	(define-ppc32-subprim-call-vinsn (list) .SPconslist)
	4018
	4019	(define-ppc32-subprim-call-vinsn (stack-cons-list*) .SPstkconslist-star)
	4020
	4021	(define-ppc32-subprim-call-vinsn (list*) .SPconslist-star)
	4022
	4023	(define-ppc32-subprim-call-vinsn (make-stack-block) .SPmakestackblock)
	4024
	4025	(define-ppc32-subprim-call-vinsn (make-stack-block0) .Spmakestackblock0)
	4026
	4027	(define-ppc32-subprim-call-vinsn (make-stack-list) .Spmakestacklist)
	4028
	4029	(define-ppc32-subprim-call-vinsn (make-stack-vector) .SPmkstackv)
	4030
	4031	(define-ppc32-subprim-call-vinsn (make-stack-gvector) .SPstkgvector)
	4032
	4033	(define-ppc32-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
	4034
	4035	(define-ppc32-subprim-call-vinsn (stack-misc-alloc-init) .SPstack-misc-alloc-init)
	4036
	4037	(define-ppc32-subprim-call-vinsn (bind-nil) .SPbind-nil)
	4038
	4039	(define-ppc32-subprim-call-vinsn (bind-self) .SPbind-self)
	4040
	4041	(define-ppc32-subprim-call-vinsn (bind-self-boundp-check) .SPbind-self-boundp-check)
	4042
	4043	(define-ppc32-subprim-call-vinsn (bind) .SPbind)
	4044
	4045	(define-ppc32-subprim-jump-vinsn (nvalret :jumpLR) .SPnvalret)
	4046
	4047	(define-ppc32-subprim-call-vinsn (nthrowvalues) .SPnthrowvalues)
	4048
	4049	(define-ppc32-subprim-call-vinsn (nthrow1value) .SPnthrow1value)
	4050
	4051	(define-ppc32-subprim-call-vinsn (slide-values) .SPmvslide)
	4052
	4053	(define-ppc32-subprim-call-vinsn (macro-bind) .SPmacro-bind)
	4054
	4055	(define-ppc32-subprim-call-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
	4056
	4057	(define-ppc32-subprim-call-vinsn (destructuring-bind) .SPdestructuring-bind)
	4058
	4059	(define-ppc32-subprim-call-vinsn (simple-keywords) .SPsimple-keywords)
	4060
	4061	(define-ppc32-subprim-call-vinsn (keyword-args) .SPkeyword-args)
	4062
	4063	(define-ppc32-subprim-call-vinsn (keyword-bind) .SPkeyword-bind)
	4064
	4065	(define-ppc32-subprim-call-vinsn (stack-rest-arg) .SPstack-rest-arg)
	4066
	4067	(define-ppc32-subprim-call-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
	4068
	4069	(define-ppc32-subprim-call-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
	4070
	4071	(define-ppc32-subprim-call-vinsn (heap-rest-arg) .SPheap-rest-arg)
	4072
	4073	(define-ppc32-subprim-call-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
	4074
	4075	(define-ppc32-subprim-call-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
	4076
	4077	(define-ppc32-subprim-call-vinsn (opt-supplied-p) .SPopt-supplied-p)
	4078
	4079	(define-ppc32-subprim-call-vinsn (gvector) .SPgvector)
	4080
	4081	(define-ppc32-vinsn (nth-value :call :subprim) (((result :lisp))
	4082	())
	4083	(bla .SPnthvalue))
	4084
	4085	(define-ppc32-subprim-call-vinsn (fitvals) .SPfitvals)
	4086
	4087	(define-ppc32-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
	4088
	4089	(define-ppc32-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
	4090
	4091	(define-ppc32-subprim-call-vinsn (integer-sign) .SPinteger-sign)
	4092
	4093	;;; Even though it's implemented by calling a subprim, THROW is really
	4094	;;; a JUMP (to a possibly unknown destination). If the destination's
	4095	;;; really known, it should probably be inlined (stack-cleanup, value
	4096	;;; transfer & jump ...)
	4097	(define-ppc32-vinsn (throw :jump-unknown) (()
	4098	())
	4099	(bla .SPthrow))
	4100
	4101	(define-ppc32-subprim-call-vinsn (mkcatchmv) .SPmkcatchmv)
	4102
	4103	(define-ppc32-subprim-call-vinsn (mkcatch1v) .SPmkcatch1v)
	4104
	4105	(define-ppc32-subprim-call-vinsn (setqsym) .SPsetqsym)
	4106
	4107	(define-ppc32-subprim-call-vinsn (ksignalerr) .SPksignalerr)
	4108
	4109	(define-ppc32-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
	4110
	4111	(define-ppc32-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
	4112
	4113	(define-ppc32-subprim-call-vinsn (mkunwind) .SPmkunwind)
	4114	(define-ppc32-subprim-call-vinsn (nmkunwind) .SPnmkunwind)
	4115
	4116
	4117	(define-ppc32-subprim-call-vinsn (progvsave) .SPprogvsave)
	4118
	4119	(define-ppc32-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
	4120
	4121	(define-ppc32-subprim-call-vinsn (eabi-syscall) .SPeabi-syscall)
	4122
	4123	(define-ppc32-subprim-call-vinsn (misc-ref) .SPmisc-ref)
	4124
	4125	(define-ppc32-subprim-call-vinsn (misc-set) .SPmisc-set)
	4126
	4127	(define-ppc32-subprim-call-vinsn (gets64) .SPgets64)
	4128
	4129	(define-ppc32-subprim-call-vinsn (getu64) .SPgetu64)
	4130
	4131	(define-ppc32-subprim-call-vinsn (makeu64) .SPmakeu64)
	4132
	4133	(define-ppc32-subprim-call-vinsn (makes64) .SPmakes64)
	4134
	4135	(define-ppc32-vinsn (poweropen-syscall :call :subprim) (()
	4136	())
	4137	(stw ppc::rzero ppc32::c-frame.crsave ppc::sp)
	4138	(bla .SPpoweropen-syscall))
	4139
	4140	(define-ppc32-vinsn (poweropen-syscall-s64 :call :subprim) (()
	4141	())
	4142	(stw ppc::sp ppc32::c-frame.crsave ppc::sp)
	4143	(bla .SPpoweropen-syscall))
	4144
	4145	(define-ppc32-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
	4146
	4147	(define-ppc32-subprim-call-vinsn (poweropen-ff-call) .SPpoweropen-ffcall)
	4148
	4149	(define-ppc32-subprim-call-vinsn (poweropen-ff-callX) .SPpoweropen-ffcallX)
	4150
	4151	(define-ppc32-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
	4152
	4153	(define-ppc32-vinsn bind-interrupt-level-0-inline (()
	4154	()
	4155	((tlb :imm)
	4156	(value :imm)
	4157	(link :imm)
	4158	(temp :imm)))
	4159	(lwz tlb ppc32::tcr.tlb-pointer ppc32::rcontext)
	4160	(lwz value ppc32::interrupt-level-binding-index tlb)
	4161	(lwz link ppc32::tcr.db-link ppc32::rcontext)
	4162	(cmpwi value 0)
	4163	(li temp ppc32::interrupt-level-binding-index)
	4164	(stwu value -4 ppc::vsp)
	4165	(stwu temp -4 ppc::vsp)
	4166	(stwu link -4 ppc::vsp)
	4167	(stw ppc::rzero ppc32::interrupt-level-binding-index tlb)
	4168	(stw ppc::vsp ppc32::tcr.db-link ppc32::rcontext)
	4169	(beq+ :done)
	4170	(mr ppc::nargs value)
	4171	(bgt :do-trap)
	4172	(lwz ppc::nargs ppc32::tcr.interrupt-pending ppc32::rcontext)
	4173	:do-trap
	4174	(twgti ppc::nargs 0)
	4175	:done)
	4176
	4177
	4178
	4179	(define-ppc32-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
	4180
	4181	(define-ppc32-vinsn bind-interrupt-level-m1-inline (()
	4182	()
	4183	((tlb :imm)
	4184	(oldvalue :imm)
	4185	(link :imm)
	4186	(newvalue :imm)
	4187	(idx :imm)))
	4188	(li newvalue (ash -1 ppc32::fixnumshift))
	4189	(li idx ppc32::interrupt-level-binding-index)
	4190	(lwz tlb ppc32::tcr.tlb-pointer ppc32::rcontext)
	4191	(lwz oldvalue ppc32::interrupt-level-binding-index tlb)
	4192	(lwz link ppc32::tcr.db-link ppc32::rcontext)
	4193	(stwu oldvalue -4 ppc::vsp)
	4194	(stwu idx -4 ppc::vsp)
	4195	(stwu link -4 ppc::vsp)
	4196	(stw newvalue ppc32::interrupt-level-binding-index tlb)
	4197	(stw ppc::vsp ppc32::tcr.db-link ppc32::rcontext)
	4198	:done)
	4199
	4200	(define-ppc32-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
	4201
	4202	(define-ppc32-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
	4203
	4204	(define-ppc32-vinsn unbind-interrupt-level-inline (()
	4205	()
	4206	((tlb :imm)
	4207	(link :imm)
	4208	(value :imm)
	4209	(save-nargs :u32)
	4210	(crf0 :crf)
	4211	(crf1 :crf)))
	4212	(lwz tlb ppc32::tcr.tlb-pointer ppc32::rcontext)
	4213	(lwz value ppc32::interrupt-level-binding-index tlb)
	4214	(lwz link ppc32::tcr.db-link ppc32::rcontext)
	4215	(cmpwi crf1 value 0)
	4216	(lwz value 8 link)
	4217	(lwz link 0 link)
	4218	(cmpwi crf0 value 0)
	4219	(stw value ppc32::interrupt-level-binding-index tlb)
	4220	(stw link ppc32::tcr.db-link ppc32::rcontext)
	4221	(bge crf1 :done)
	4222	(blt crf0 :done)
	4223	(mr save-nargs ppc::nargs)
	4224	(lwz ppc::nargs ppc32::tcr.interrupt-pending ppc32::rcontext)
	4225	(twgti ppc::nargs 0)
	4226	(mr ppc::nargs save-nargs)
	4227	:done)
	4228
	4229	(define-ppc32-vinsn test-fixnum (((flags (:crf 0)))
	4230	((x t))
	4231	((tag :u8)))
	4232	(andi. tag x ppc32::fixnummask))
	4233
	4234
	4235	(define-ppc32-vinsn test-fixnums (((flags (:crf 0)))
	4236	((x t)
	4237	(y t))
	4238	((tag :u8)))
	4239	(or tag x y)
	4240	(andi. tag tag ppc32::fixnummask))
	4241
	4242
	4243
	4244	(define-ppc32-vinsn %ilognot (((dest :imm))
	4245	((src :imm)))
	4246	(subfic dest src (ash -1 ppc32::fixnumshift)))
	4247
	4248	(define-ppc32-vinsn double-float-negate (((dest :double-float))
	4249	((src :double-float)))
	4250	(fneg dest src))
	4251
	4252	(define-ppc32-vinsn single-float-negate (((dest :single-float))
	4253	((src :single-float)))
	4254	(fneg dest src))
	4255
	4256	(define-ppc32-vinsn fixnum-ref-c-double-float (((dest :double-float))
	4257	((base :imm)
	4258	(idx :u16const)))
	4259	(lfd dest (:apply ash idx 3) base))
	4260
	4261	(define-ppc32-vinsn fixnum-ref-double-float (((dest :double-float))
	4262	((base :imm)
	4263	(idx :imm))
	4264	((temp :imm)))
	4265	(add temp idx idx)
	4266	(lfdx dest base temp))
	4267
	4268
	4269	(define-ppc32-vinsn fixnum-set-c-double-float (()
	4270	((base :imm)
	4271	(idx :u16const)
	4272	(val :double-float)))
	4273	(stfd val (:apply ash idx 3) base))
	4274
	4275	(define-ppc32-vinsn fixnum-set-double-float (()
	4276	((base :imm)
	4277	(idx :imm)
	4278	(val :double-float))
	4279	((temp :imm)))
	4280	(add temp idx idx)
	4281	(stfdx val base temp))
	4282
	4283	(define-ppc32-vinsn ivector-typecode-p (((dest :lisp))
	4284	((src :lisp))
	4285	((temp :u32)))
	4286	(clrlwi temp src (- 32 ppc32::ntagbits ppc32::fixnumshift))
	4287	(cmpwi temp (ash ppc32::fulltag-immheader ppc32::fixnumshift))
	4288	((:not (:pred =
	4289	(:apply %hard-regspec-value dest)
	4290	(:apply %hard-regspec-value src)))
	4291	(mr dest src))
	4292	(beq :done)
	4293	(mr dest ppc::rzero)
	4294	:done)
	4295
	4296	(define-ppc32-vinsn gvector-typecode-p (((dest :lisp))
	4297	((src :lisp))
	4298	((temp :u32)))
	4299	(clrlwi temp src (- 32 ppc32::ntagbits ppc32::fixnumshift))
	4300	(cmpwi temp (ash ppc32::fulltag-nodeheader ppc32::fixnumshift))
	4301	((:not (:pred =
	4302	(:apply %hard-regspec-value dest)
	4303	(:apply %hard-regspec-value src)))
	4304	(mr dest src))
	4305	(beq :done)
	4306	(mr dest ppc::rzero)
	4307	:done)
	4308
	4309
	4310	(define-ppc32-vinsn %complex-single-float-realpart (((dest :single-float))
	4311	((src :complex-single-float)))
	4312	(fmr dest src))
	4313
	4314	(define-ppc32-vinsn %complex-single-float-imagpart (((dest :single-float))
	4315	((src :complex-single-float)))
	4316	(fmr dest (:apply 1+ (:apply %hard-regspec-value src))))
	4317
	4318	(define-ppc32-vinsn %complex-double-float-realpart (((dest :double-float))
	4319	((src :complex-double-float)))
	4320	(fmr dest src))
	4321
	4322	(define-ppc32-vinsn %complex-double-float-imagpart (((dest :double-float))
	4323	((src :complex-double-float)))
	4324	(fmr dest (:apply 1+ (:apply %hard-regspec-value src))))
	4325
	4326
	4327
	4328
	4329	;;; In case ppc32::ppc-opcodes was changed since this file was compiled.
	4330	(queue-fixup
	4331	(fixup-vinsn-templates ppc32-vinsn-templates ppc::ppc-opcode-numbers))
	4332
	4333	(provide "PPC32-VINSNS")
	4334

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: release/1.11/source/compiler/PPC/PPC32/ppc32-vinsns.lisp

Download in other formats: