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 16081, checked in by Gary Byers, 11 years ago
Pass test suite on PPC on this branch.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 137.3 KB

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

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

Context Navigation

source: branches/acode-rewrite/source/compiler/PPC/PPC64/ppc64-vinsns.lisp

Download in other formats: