.TITLE	ATOM		
; JEFFREY KODOSKY	ARL	NOV75
;
; 11 SUBRS
; ENTRY:	1 ARG		<EXPR>
; EXIT:		1 ARG		<BOOL>
; ERRORS:	NONE
; CALLS:	NONE
; R2,R3 PRESERVED
	.GLOBL	ATOM,ZATOM,NUMBERP,ZNUMBERP,STRGP,ZSTRGP
	.GLOBL	NULL,ZNULL,NOT,ZNOT,FIXP,ZFIXP,FLOTP,ZFLOTP
	.GLOBL	MNUSP,ZMNUSP,ZEROP,ZZEROP,ONEP,ZONEP,INFP,ZINFP
	.GLOBL	.T.
ATOM:	MOV	@R5,R0	;TRUE IF NUMBER, STRING OR LITERAL ATOM
	BIT	#2,(R0)+
	BNE	TRUE
	BIT	#3,@R0
	BNE	TRUE
	BR	FALSE
ZATOM=.-ATOM
;
NUMBERP:MOV	@R5,R0	;TRUE IF NUMBER
	BIT	#2,@R0
	BNE	TRUE
	BR	FALSE
ZNUMBERP=.-NUMBERP
;
STRGP:	MOV	@R5,R0	;TRUE IF STRING VALUED ATOM
	BIT	#2,(R0)+
	BNE	FALSE
	BIT	#2,@R0
	BNE	TRUE
	BR	FALSE
ZSTRGP=.-STRGP
;
NULL:
ZNULL=0
NOT:	MOV	@R5,R0	;TRUE IF ARG IS NIL
	BEQ	TRUE
	BR	FALSE
ZNOT=.-NOT
;
FIXP:	MOV	@R5,R0	;TRUE IF ARG IS INTEGER
	CMP	@R0,#2
	BEQ	TRUE
	BR	FALSE
ZFIXP=.-FIXP
;
FLOTP:	MOV	@R5,R0	;TRUE IF ARG IS FLOATING POINT NUMBER
	BIT	#2,@R0
	BEQ	FALSE
	CMP	@R0,#2
	BNE	TRUE
	BR	FALSE
ZFLOTP=.-FLOTP
;
MNUSP:	MOV	@R5,R0	;TRUE IF ARG IS NUMBER<0
	BIT	#2,(R0)+
	BEQ	FALSE
	TST	@R0
	BMI	TRUE
	BR	FALSE
ZMNUSP=.-MNUSP
;
ZEROP:	MOV	@R5,R0	;TRUE IF ARG IS ZERO
	BIT	#2,(R0)+
	BEQ	FALSE
	TST	@R0
	BNE	FALSE
	MOV	-(R0),R1
	CMP	R1,#2
	BEQ	TRUE	;JUMP IF INTEGER 0
	TST	@R1
	BEQ	TRUE	;JUMP IF 0.0
	BR	FALSE
ZZEROP=.-ZEROP
;
ONEP:	MOV	@R5,R0	;TRUE IF ARG IS 1 OR 1.0
	BIT	#2,@R0
	BEQ	FALSE
	CMP	(R0)+,#2
	BNE	ONEP1	;JUMP IF FLOATING POINT NUMBER
	CMP	@R0,#1
	BEQ	TRUE	;JUMP IF 1
	BR	FALSE
ONEP1:	CMP	@R0,#^F1.0
	BNE	FALSE
	TST	@-(R0)
	BEQ	TRUE	;JUMP IF 1.0
	BR	FALSE
ZONEP=.-ONEP
;
INFP:	MOV	@R5,R0	;TRUE IF ARG IS +- INFINITY
	BIT	#2,@R0
	BEQ	FALSE
	CMP	@(R0)+,#-1
	BNE	FALSE
	MOV	@R0,R0
	ASL	R0
	BEQ	TRUE
ZINFP=.-INFP
;
FALSE:	CLR	@R5
	JMP	@-(R4)
TRUE:	MOV	.T.,@R5
	JMP	@-(R4)
	.END