.TITLE	SET		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	2 ARGS		<LITATM>;<S>
; EXIT:		1 ARG		<S>
; ERRORS:	A7, INVALID FIRST ARG
; CALLS:	PRIN1
;		PRINT
;		PRNT
;		PUT
;		SASSOC
;		EVLIS
;		CDR
;		GET
;		INDEX
;		CONS
	.GLOBL	SET,ZSET,QPRIN1,QPRINT,QPRNT,QSASSOC,QPUT
	.GLOBL	ADPROG,TSRETN,$ALIST,APVAL,QA7ERR,YALIST
	.GLOBL	YARRAY,QGET,QCONS,QEVLIS,QCDR,QINDEX
SET:	CMP	-2(R4),#ADPROG	;ARE WE AT THE TOP LEVEL OF A PROG?
	BNE	SET01
	CMP	-4(R4),#TSRETN	;YES: TRACESETTING?
	BNE	SET01
	QPRIN1		;YES: PRINT ARG1=ARG2
	MOV	#BUFEQ,R3
	QPRNT
	MOV	2(R5),-(R5)
	QPRINT
	TST	(R5)+
SET01:	ROOM	4
	MOV	@R5,R0
	BIT	#3,(R0)+
	BNE	SETERR
	BIT	#2,@R0
	BNE	SETERR
	BIT	#1,@R0
	BNE	SET02
	TST	@R0	;(SETQ (ALIST) <LIST>) IS A SPECIAL
	BNE	SET01A	;CONSTRUCTION
	CMP	-(R0),YALIST
	BNE	SETERR
	MOV	@R5,$ALIST
	JMP	@-(R4)
SET01A:	MOV	@R5,-(R5)
	MOV	YARRAY,-(R5)
	MOV	-(R0),-(R5)
	QGET
	MOV	(R5)+,2(R5)
	BEQ	SETERR
	MOV	@R5,-(R5)	;(SETQ (<ARRAY ATOM><SUB1>...<SUBN>) <S>)
	QCDR		;IS ALSO A SPECIAL CONSTRUCTION
	QEVLIS		;EVALUATE THE SUBSCRIPT LIST
	MOV	2(R5),R3
	MOV	(R5)+,@R5
	MOV	@R3,-(R5)
	QCONS
	QINDEX
	MOV	@R5,@R0	;SET INDEXED ARRAY ELEMENT
	JMP	@-(R4)
SETERR:	QA7ERR
SET02:	CLR	-(R5)	;SASSOC[<ARG1>;ALIST;NIL]--->
	MOV	$ALIST,-(R5)
	MOV	4(R5),-(R5)
	QSASSOC
	TST	@R5
	BEQ	SET03
	MOV	(R5)+,R0;RPLACD[SASSOC[...];<ARG2>]
	CMP	(R5)+,(R0)+
	MOV	@R5,@R0
	JMP	@-(R4)
SET03:	TST	(R5)+	;T--->PUT[<ARG1>;APVAL;<ARG2>]
	MOV	(R5)+,R0
	MOV	@R5,-(R5)
	MOV	APVAL,-(R5)
	MOV	R0,-(R5)
	QPUT
	TST	(R5)+
	JMP	@-(R4)
BUFEQ:	.ASCIZ	/ = /
	.EVEN
ZSET=.-SET
	.PAGE
; FSUBR
; ENTRY:	1 ARG		(<LITATM> <S>)
; EXIT:		1 ARG		SET[CAR[<ARG>];EVAL[CADR[<ARG>]]]
; ERRORS:	NONE
; CALLS:	EVAL
;		CAR
;		CDR
;		SET
	.GLOBL	SETQ,ZSETQ,QCAR,QCDR,QEVAL
SETQ:	ROOM	3
	MOV	$ALIST,-(R5)	;SAVE PRESENT CONTEXT
	MOV	2(R5),-(R5)
	QCDR
	QCAR
	QEVAL		;EVAL[CADR[<ARG>]]
	MOV	(R5)+,R3
	MOV	(R5)+,$ALIST	;RESTORE CONTEXT
	QCAR
	MOV	@R5,-(R5)
	MOV	R3,2(R5)
	JMP	SET
ZSETQ=.-SETQ
	.END