Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

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

ppc32-vinsns.lisp

Visit:

Last change on this file was 13075, checked in by R. Matthew Emerson, 15 years ago
Merge trunk changes r13066 through r13067. (copyright notices)
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 143.7 KB

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

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

Context Navigation

source: release/1.4/source/compiler/PPC/PPC32/ppc32-vinsns.lisp

Download in other formats: