.TITLE	SUBST		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	3 ARGS		<S1>;<S2>;<S3>
; EXIT:		1 ARG		<S>
; ERRORS:	NONE
; CALLS:	EQUAL
;		ATOM
;		CAR
;		CDR
;		CONS
	.GLOBL	SUBST,ZSUBST,QEQUAL,QATOM,QCAR,QCDR,QCONS
SUBST:	ROOM	5
	MOV	4(R5),-(R5)
	MOV	4(R5),-(R5)
	QEQUAL		;EQUAL[<S2>;<S3>]--->
	TST	(R5)+
	BEQ	SUBST1
	MOV	(R5)+,@R5	;<S1>
	MOV	(R5)+,@R5
	JMP	@-(R4)
SUBST1:	MOV	4(R5),-(R5)	;ATOM[<S3>]--->
	QATOM
	TST	(R5)+
	BEQ	SUBST2
	CMP	(R5)+,(R5)+	;<S3>
	JMP	@-(R4)
SUBST2:	MOV	4(R5),R3;T---> CONS[SUBST[<S1>;<S2>;
	MOV	R3,-(R5);    CAR[<S3>]];SUBST[<S1>;<S2>;
	QCDR		;    CDR[<S3>]]]
	MOV	(R5)+,4(R5)
	MOV	R3,-(R5)
	QCAR
	MOV	4(R5),-(R5)
	MOV	4(R5),-(R5)
	MOV	#SUBST3,(R4)+	;FAKE A TRAP TO SUBST CAR
	BR	SUBST
SUBST3:	MOV	(R5)+,R3;POP RESULT
	MOV	@R5,-(R5)	;SLIDE DOWN STACK
	MOV	4(R5),2(R5)
	MOV	6(R5),4(R5)
	MOV	R3,6(R5)	;INSERT CAR SUBST
	MOV	#SUBST4,(R4)+	;FAKE A TRAP TO SUBST CDR
	BR	SUBST
SUBST4:	MOV	(R5)+,R3;POP RESULT
	MOV	@R5,-(R5)	;SWITCH ORDER
	MOV	R3,2(R5)
	QCONS		;RETURN CONS[SUBSTCAR; SUBSTCDR]
	.WORD	0
ZSUBST=.-SUBST
	.END