C	PROGRAM GENSYM.FT
C	-------------------
C
C
C
	FUNCTION GENSYM(ICHARS,NUMBER)
C
C
C	P LEMKIN
C	NIH
C	BETHESDA, MD
C	
C
C	JAN 23, 1977
C
C	PURPOSE
C	-------
C	COMPUTE THE CONCATINATION OF
C		GENSYM= ICHARS[1 FOR 2] & CVS(NUMBER);
C
C	======================================================
C	NOTE: GENSYM.FT ALSO CONTAINS:
C
C	##      SUBROUTINE CHKGENSYM(SYMBOL,IGENSYM)
C	IF SYMBOL="GENSYM"
C		THEN RETURN WITH NO CHANGE TO SYMBOL;
C		ELSE 
C		RETURN SYMBOL<==GENSYM(IGENSYM(1),IGENSYM(2)')
C	=========================================================
C
C
C
C	OPDEFS
C	------
S	OPDEF	DVI	7407
S	OPDEF	MQL	7421
S	OPDEF	MQA	7501
S	OPDEF	BSW	7002
C
C
C
	DIMENSION IB(3),IC(3)
	EQUIVALENCE(IB(1),B), (IC(1),C)
C
	N=NUMBER
C
C	COPY THE FIRST CHARS
	IC=ICHARS
C
C	COMPUTE THE DECIMAL DIGITS
S	TAD \N
S	MQL
S	CPAGE 2
S	DVI
S	1750 /D1000
S	DCA \N /SAVE REMAINDER
S	MQA
S	DCA \N1000 /QUOTIENT
C
S	TAD \N
S	MQL
S	CPAGE 2
S	DVI
S	144 /D100
S	DCA \N
S	MQA
S	DCA \N100
C
S	TAD \N
S	MQL
S	CPAGE 2
S	DVI
S	12 /D10
S	DCA \N1
S	MQA
S	DCA \N10
C
C
C
C	STUFF THEM INTO IC.
S	TAD \N1000
S	BSW
S	TAD \N100 /100'S
S	TAD (6060
S	DCA \IC# /IC(2)
C
S	TAD \N10 /10'S
S	BSW
S	TAD \N1
S	TAD (6060
S	DCA \N
	IC(3)=N
	FC=C
	GENSYM=C
	RETURN
C
C
	N1000=0
	N100=0
	N10=0
	N1=0
C
C
C	##      SUBROUTINE CHKGENSYM(SYMBOL,IGENSYM)
C	IF SYMBOL="GENSYM"
C		THEN RETURN WITH NO CHANGE TO SYMBOL;
C		ELSE 
C		RETURN SYMBOL<==GENSYM(IGENSYM(1),IGENSYM(2)')
C
C
S	ENTRY CHKGE
S	CHKGE, BLOCK 2
C
S	DUMMY SYMBO
S	TAD I CHKGE
S	DCA SYMBO
S	INC CHKGE#
S	TAD I CHKGE
S	DCA SYMBO#
S	INC CHKGE#
C
S	DUMMY IGENS
S	TAD I CHKGE
S	DCA IGENS
S	INC CHKGE#
S	TAD I CHKGE
S	DCA IGENS#
S	INC CHKGE#
C
C
C	TEST IF SYMBOL="GENSYM"
S	CPAGE 4
S	CALL 1,IFAD
S	ARG SYMBO
C
S	CPAGE 4
S	CALL 1,STO
S	ARG \C
C
	B='GENSYM'
	DO 500 N=1,3
	IF(IB(N)-IC(N))2046,500,2046
500	CONTINUE
C
C	MATCH NOW INCREMENT AND FETCH THE GENSYM
S	TAD I IGENS /GET THE NAME
S	DCA \NNAME
C
S	INC IGENS# /SET UP 2ND PTR
S	INC I IGENS /IGENSYM(2)<==IGENSYM(2)+1
S	NOP
S	TAD I IGENS
S	DCA \NNUMBER
C
C	COMPUTE:	A=GENSYM(NNAME,NNUMBER)
S	CPAGE 6
S	CALL 2,GENSY
S	ARG \NNAME
S	ARG \NNUMBER
C
S	CPAGE 4
S	CALL 1,ISTO
S	ARG SYMBO /CHANGE IT
C
2046	CONTINUE
S	RETRN CHKGE
C
C
C	CPAGE 2
S	SYMBO, BLOCK 2
C	CPAGE 2
S	IGENS, BLOCK 2
C
	NNAME=0
	NNUMBER=0
	END
  