.TITLE	CAR		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	1 ARG		<NAT>
; EXIT:		1 ARG		CAR[<NAT>]
; ERRORS:	A10, CAR OF AN ATOM (SUPPRESSED WITH X SW)
; CALLS:	GETC, FETCH A FREE CELL
;		GET, SEARCH PROPERTY LIST
; R2,R3 PRESERVED
	.GLOBL	CAR,ZCAR,QGETC,QGET,QA10ERR,XSW,APVAL
CAR:	MOV	@R5,R0	;GET ARG
	MOV	@R0,R1	;GET CAR (ASSUMING NON-ATOMIC)
	BIT	#3,R1	;IS ARG NUMERIC?
	BNE	CAR01	;JUMP IF SO
	BIT	#3,2(R0);IS IT ATOMIC?
	BNE	CAR02	;JUMP IF SO
	MOV	R1,@R5	;OTHERWISE RETURN CAR
CAR01:	JMP	@-(R4)	;CAR OF NUMBER OR STRING IS ITSELF
CAR02:	BIT	@PC,2(R0)	;IS ARG A LITATM?
	BNE	CAR01	;JUMP IF NOT
	ROOM	3	;CHECK FOR ADEQUATE STACK SPACE
	MOV	APVAL,-(R5)	;CHECK X SWITCH
	MOV	XSW,-(R5)
	QGET
	TST	(R5)+
	BNE	CAR03	;JUMP IF IT IS ON
	QA10ERR		;OTHERWISE A10 ERROR TRAP
CAR03:	QGETC		;FETCH A NEW CELL
	MOV	(R5)+,R0;POINT TO IT
	MOV	@R5,R1	;POINT TO <LITATM>
	MOV	R0,@R5	;RETURN A NEW STRING ATOM WHICH
	MOV	@R1,(R0)+	;IS THE ATOM'S PNAME
	MOV	#3,@R0	;FLAG IT A STRING
	JMP	@-(R4)
ZCAR=.-CAR
	.END