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

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

Context Navigation

source: branches/acode-rewrite/source/compiler/PPC/PPC32/ppc32-vinsns.lisp

Download in other formats: