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

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

Context Navigation

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

Download in other formats: