.TITLE	PNAME		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	1 ARG		<ATOM>
; EXIT:		1 ARG		<STRING>
; ERRORS:	NONE
; CALLS:	ATM2ASCII
;		STRBLD
	.GLOBL	PNAME,ZPNAME,QATM2ASCII,QSTRBLD
PNAME:	CLR	RSWVAL	;USE NON-LISP READABLE FORMAT
	QATM2ASCII
	BCC	1$
	CLR	@R5	;RETURN NILL IF ILL FORMED ARG
	JMP	@-(R4)
1$:	BPL	.+4
	INC	R3	;BUMP PAST ' IF STRING
	TST	(R5)+	;POP ARG
	QSTRBLD		;MAKE A NEW STRING AND RETURN IT
	.WORD	0
;
;
;
; UTILITY:	CONVERT ATOM TO ASCII
; ENTRY:	1 ARG		<S>
; EXIT:		R3 POINTS TO PNAME BUFFER START
;		C BIT SET AND ARG RETURNED (UNCHANGED)
;			IF IT WAS NOT ATOMIC
;		N BIT SET IF ARG WAS STRING
; ERRORS:	NONE
; CALLS:	PNBUFI
;		ATM2N
;		LEXICL
;		ICO
;		GCO
;		OCO
; NOTE: FOR STRING ATOMS THE FIRST CHARACTER IN THE BUFFER IS '
	.GLOBL	ATM2AS,QPNBUFI,RSWVAL,OSWVAL,QOCO
	.GLOBL	QATM2N,QLEXICL,QICO,QGCO
ATM2AS:	ROOM	3
	CLR	R3	;RESET PNAME BUFFER POINTER
	QPNBUFI
	MOV	@R5,R0
	BIT	#2,(R0)+
	BNE	NUM01	;JUMP IF NUMBER
	BIT	#3,@R0
	BNE	ATM01	;JUMP IF LITERAL OR STRING ATOM
	SEC		;OTHERWISE SIGNAL NON-ATOMIC
	JMP	@-(R4)	;AND RETURN
ATM01:	BIT	#2,@R0
	BNE	STR01	;JUMP IF STRING ATOM
	MOV	-(R0),R1;LITERAL OR GENSYM ATOM
	TST	2(R1)
	BPL	LIT01	;JUMP IF LITERAL ATOM
	MOV	@(R1)+,R0	;GET GENSYM INTEGER
	MOV	R3,-(SP)
	MOVB	@R1,(R3)+	;GET GENSYM LETTER
	MOV	R3,-(SP)
	MOV	#6,-(SP)
	MOV	R0,-(SP)
	QOCO		;CONVERT TO O6
	MOV	(SP)+,R3;POP BUFFER START
	CLRB	7(R3)	;TERMINATE BUFFER
	MOV	R3,R2
GEN01:	TSTB	@R2	;CHANGE LEADING SPACES TO ZEROS
	BEQ	GEN05
	CMPB	@R2,#40
	BNE	GEN02
	MOVB	#60,@R2
GEN02:	INC	R2
	BR	GEN01
GEN05:	CLR	(R5)+	;POP GENSYM ATOM(C,N BITS CLEAR)
	JMP	@-(R4)
;
STR01:	MOV	#47,R3	;INSERT '
	QPNBUFI
	MOV	@(R5)+,R2	;POP STRING
	BEQ	STR10	;JUMP IF NULL STRING
STR02:	MOV	2(R2),-(SP)	;GET TWO CHARACTERS
	MOVB	@SP,R3
	BEQ	STR09
	JSR	PC,INSRTS
	MOVB	1(SP),R3
	BEQ	STR09
	JSR	PC,INSRTS
	MOV	@R2,R2
	TST	(SP)+
	BIC	#2,R2
	BNE	STR02
	BR	STR10
STR09:	TST	(SP)+
STR10:	CLR	R3	;RETURN BUFFER POINTER
	QPNBUFI
	TST	#-1	;SET N BIT TO SIGNAL STRING (CLEAR C BIT)
	JMP	@-(R4)
;
LIT01:	MOV	@(R5)+,R2	;POP PNAME
	CLR	LITFLG	;FLAG FIRST TWO CHARS
LIT02:	MOV	2(R2),-(SP)	;GET TWO CHARS
	MOVB	@SP,R3
	BEQ	LIT09
	JSR	PC,INSRTL
	MOVB	1(SP),R3
	BEQ	LIT09
	JSR	PC,INSRTL
	TST	(SP)+
	MOV	@R2,R2
	BIC	#2,R2
	BNE	LIT02
	BR	LIT10
LIT09:	TST	(SP)+
LIT10:	CLR	R3
	QPNBUFI
	CCC		;CLEAR N AND C BITS SINCE NOT STRING ATOM
	JMP	@-(R4)
;
NUM01:	MOV	R3,-(SP);SAVE BUFFER ADDRESS
	QATM2N		;GET NUMBER
	BCS	NUM10	;JUMP IF FLOATING POINT
	MOV	(SP)+,R0
	MOV	R3,-(SP);BUFFER START
	MOV	#7,-(SP);FIELD LENGTH
	MOV	R0,-(SP);NUMBER
	TST	OSWVAL
	BEQ	NUM02
	QOCO		;O7 CONVERSION
	MOV	(SP)+,R3
	MOVB	#'Q,7(R3)
	CLRB	8.(R3)
	BR	CMPRES
NUM02:	QICO		;I7 CONVERSION
	MOV	(SP)+,R3
	CLRB	7(R3)
	BR	CMPRES
NUM10:	MOV	(SP)+,R0;POP FLOATING POINT NUMBER AND CHECK
	MOV	(SP)+,R1;FOR +/- INFINITY
	BIT	#77777,R0
	BNE	NUM12
	TST	R1
	BEQ	NUM12
	MOV	#INFBUF,R3	;USE SPECIAL BUFFER FOR INFINITY
	ROL	R0
	BCS	.+4
	INC	R3
	CLR	(SP)+	;C,N BITS CLEAR SINCE NOT STRING ATOM
	JMP	@-(R4)
NUM12:	MOV	R3,-(SP);BUFFER START
	MOV	#20.,-(SP)	;FIELD LENGTH
	MOV	#7,-(SP)
	CLR	-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	QGCO		;G20.7 CONVERSION
	MOV	(SP)+,R3
	CLRB	20.(R3)	;INSERT TERMINATING ZERO BYTE
	MOV	R3,R2	;CHECK FOR E FORMAT
NUM13:	TSTB	@R2
	BEQ	NUM15
	CMPB	(R2)+,#'E
	BNE	NUM13
	CMPB	(R2)+,#40	;DON'T ALLOW SPACE AFTER E
	BNE	CMPRES
	MOVB	#'+,-(R2)
	BR	CMPRES
NUM15:	MOV	R3,R2	;F FORMAT: TRIM TO 7 SIGNIFICANT DIGITS
	CLR	R0	;COUNT DIGITS BEFORE DECIMAL
NUM16:	CMPB	(R2)+,#56
	BEQ	NUM17	;JUMP IF DECIMAL POINT FOUND
	BLT	NUM16	;KEEP LOOKING IF CHAR IS +- OR SPACE
	INC	R0	;OTHERWISE COUNT THE DIGIT
	BR	NUM16
NUM17:	SUB	#7,R0	;ALLOW 7-<NBEFORE> DIGITS AFTER DECIMAL
	BGE	NUM19
	MOV	R2,R1
	SUB	R0,R2
NUM18:	CMPB	-(R2),#'0	;GET RID OF TRAILING ZEROS
	BEQ	NUM18	;AFTER DECIMAL POINT IN F FORMAT
	INC	R2
	CMP	R2,R1
	BNE	NUM19	;BUT ALWAYS LEAVE AT LEAST ONE DIRECTLY AFTER
	INC	R2
NUM19:	CLRB	@R2
CMPRES:	CMPB	(R3)+,#40	;DELETE LEADING BLANKS
	BEQ	CMPRES
	TSTB	-(R3)	;RETURN BUFFER AND CLEAR C,N BITS
	JMP	@-(R4)
;
INSRTS:	TST	RSWVAL
	BEQ	INSRT2
	QLEXICL		;INSERT ^ IF CHAR IS CLASS 7 OR 17.
	CMP	R0,#7
	BEQ	INSRT1
	CMP	R0,#17.
	BNE	INSRT2
INSRT1:	SWAB	R3
	BISB	#'^,R3
	QPNBUFI
	SWAB	R3
INSRT2:	QPNBUFI		;PUT CHAR IN PNAME BUFFER
	RTS	PC
INSRTL:	TST	RSWVAL
	BEQ	INSRT2
	QLEXICL		;INSERT ^ IF CHAR IS CLASS 7-19.
	TST	LITFLG
	BGT	INSRT4
	BEQ	INSRT5
	COM	LITFLG
	CMP	R0,#2
	BEQ	INSRT1
	BR	INSRT4
INSRT5:	CMP	R0,#2
	BNE	INSRT3
	INC	LITFLG	;IF 1ST CHAR IS <DIGIT> THEN INSERT ^
	BR	INSRT1
INSRT3:	CMP	R0,#6	;IF 1ST CHAR IS <SIGN> THEN CHECK NEXT
	BNE	INSRT6	;FOR BEING A DIGIT
	DEC	LITFLG
	BR	INSRT2
INSRT6:	INC	LITFLG
	CMP	R0,#19.	;CLASS 19. IS OKAY AS 1ST CHAR
	BEQ	INSRT2
INSRT4:	CMP	R0,#7
	BLT	INSRT2
	BR	INSRT1
;
LITFLG:	.WORD	0
INFBUF:	.ASCIZ	/-1E999/
	.EVEN
ZPNAME=.-PNAME
	.END