.TITLE	COPY		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	1 ARG		<S>
; EXIT:		1 ARG		COPY OF <S>
; ERRORS:	NONE
; CALLS:	GETC
; R2,R3 PRESERVED
	.GLOBL	COPY,ZCOPY,QGETC
COPY:	ROOM	2
	MOV	@R5,R0
	BIT	#2,(R0)+;COPY NUMBERS AND STRINGS
	BNE	COPY5
	BIT	#2,@R0
	BNE	COPY5
	BIT	#1,@R0
	BEQ	COPY1
	JMP	@-(R4)	;DON'T COPY LITATMS
COPY1:	MOV	@R0,@R5	;T--->CONS[COPY[CAR[<ARG>]];
	MOV	-(R0),-(R5)	; COPY[CDR[<ARG>]]]
	MOV	#COPY2,(R4)+	;FAKE A TRAP TO COPY CAR
	BR	COPY
COPY2:	MOV	(R5)+,R0
	MOV	@R5,-(R5)
	MOV	R0,2(R5);SAVE CAR COPY AND RECURSE TO COPY CDR
	MOV	#COPY3,(R4)+	;FAKE A TRAP
	BR	COPY
COPY3:	QGETC
	MOV	(R5)+,R0
	TST	(R0)+
	MOV	(R5)+,@R0	;CONS THE COPIES
	MOV	@R5,-(R0)
	MOV	R0,@R5
	JMP	@-(R4)
COPY5:	MOV	R2,-(SP);SAVE REGS
	MOV	R3,-(SP)
	MOV	(R5)+,R3;COPY A LINEAR CHAIN
	QGETC
	MOV	@R5,R2
COPY6:	MOV	R2,-(R5);OPEN CAR
	MOV	#2,(R2)+;SET DATA BIT
	MOV	2(R3),@R2	;COPY DATA
	MOV	@R3,R3	;GET NEXT CELL TO COPY
	BIC	#3,R3
	BEQ	COPY8	;JUMP IF DONE
	QGETC
	MOV	(R5)+,R2
	BIS	R2,@(R5)+	;CHAIN TO PREVIOUS RESULT
	BR	COPY6
COPY8:	TST	(R5)+	;POP OPEN CAR
	MOV	(SP)+,R3;RESTORE REGS
	MOV	(SP)+,R2
	JMP	@-(R4)
ZCOPY=.-COPY
	.END