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 6410, checked in by Gary Byers, 18 years ago
Add nmkunwind vinsn, which handles interrupt-level binding out-of-line. Use it for unwind-protect, but not progv (which gets confused by the extra binding, anyway.)
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 123.7 KB

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

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

Context Navigation

source: branches/x8664-call/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp

Download in other formats: