.TITLE	GENSYM		
; JEFFREY KODOSKY	ARL	NOV75
;
; FSUBR
; ENTRY:	1 ARG		<LIST OF 0 OR 1 LITATM>
; EXIT:		1 ARG		<LITATM>
; ERRORS:	NONE
; CALLS:	CAR
;		GETC
	.GLOBL	GENSYM,ZGENSYM,QCAR,QGETC
GENSYM:	TST	@R5	;NULL LIST?
	BEQ	GEN1
	QCAR		;NO: GET 1ST LITATM
	MOV	@R5,R0	;(IGNORE IT UNLESS ITS A LITATM)
	BIT	#2,(R0)+
	BNE	GEN1
	BIT	#2,@R0
	BNE	GEN1
	BIT	#1,@R0
	BEQ	GEN1
	MOV	-(R0),R1;GET FIRST LETTER OF PNAME
	MOVB	2(R1),R0
	SUB	#101,R0
	CMP	R0,#25.	;IGNORE IT IF ITS NOT ALPHABETIC
	BHI	GEN1
	MOV	R0,SYM	;STORE IT FOR NEXT TIME
	BR	GEN2
GEN1:	MOV	SYM,R0	;GET LAST SYMBOL
GEN2:	ASL	R0	;MAKE A BYTE OFFSET
	MOV	GTBL(R0),-(SP)	;GET LATEST NUMBER
	INC	GTBL(R0);UPDATE NUMBER
	QGETC		;3 CELLS NEEDED FOR NEW ATOM
	MOV	(R5)+,R3
	QGETC
	MOV	(R5)+,R2
	QGETC
	MOV	(R5)+,R1
	MOV	R1,@R5	;BUILD ATOM
	MOV	R2,(R1)+
	INC	@R1	;NULL PROP LIST; LITATM BIT SET
	MOV	#2,(R3)+;DATA BIT
	MOV	(SP)+,@R3	;NUMBER
	MOV	R3,(R2)+;POINTER PLUS DATA BIT
	MOV	SYM,@R2	;GENSYM LETTER-'A
	ADD	#100101,@R2	;GENSYM PNAME FORMAT BIT
	JMP	@-(R4)
SYM:	.WORD	'G-'A
GTBL:	.REPT	26.
	.WORD	0
	.ENDM
ZGENSYM=.-GENSYM
	.END