.TITLE	RPLACA		
; JEFFREY KODOSKY	ARL	NOV75
;
; 2 SUBRS
; ENTRY:	2 ARGS		<NAT>;<S>
; EXIT:		1 ARG		<NAT>
; ERRORS:	NONE
; CALLS:	NONE
; R2,R3 PRESERVED
	.GLOBL	RPLACA,ZRPLACA,RPLD,ZRPLD
RPLACA:	MOV	(R5)+,R0
	MOV	@R5,R1
	BIT	#2,(R0)+
	BNE	RPL2	;IGNORE CALL IF NOT <NAT>
	BIT	#3,@R0
	BNE	RPL2
	MOV	R1,-(R0);REPLACE CAR FIELD
RPL1:	MOV	R0,@R5
	JMP	@-(R4)
RPL2:	TST	-(R0)	;RETURN ARG1 UNCHANGED
	BR	RPL1
ZRPLACA=.-RPLACA
;
RPLD:	MOV	(R5)+,R0
	MOV	@R5,R1
	BIT	#2,(R0)+
	BNE	RPL2
	BIT	#3,@R0
	BNE	RPL2
	MOV	R1,@R0	;REPLACE CDR FIELD
	BR	RPL2
ZRPLD=.-RPLD
	.END