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 6434, checked in by Gary Byers, 18 years ago
Use .SPgetu32/.SPgets33, no more .SPgetxlong.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 143.0 KB

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

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

Context Navigation

source: branches/x8664-call/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp

Download in other formats: