Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

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

ppc64-vinsns.lisp

Visit:

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

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

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

Context Navigation

source: release/1.11/source/compiler/PPC/PPC64/ppc64-vinsns.lisp

Download in other formats: