UNIVERSAL	NUMEQV FOR RPGLIB V1.
SUBTTL	NUMERIC EQUIVALENCES	30-DEC-74	/ACK
;LIBOL VERSION
;COPYRIGHT 1974, 1975, DIGITAL EQUIPMENT CORP., MAYNARD MASS.
;RPGII VERSION COPYRIGHT 1976, BOB CURRIER
;RPGII MODIFICATIONS COPYRIGHT BOB CURRIER, 1976
;REVISION HISTORY:
;V10 *****
;	30-DEC-74	/ACK	CREATION.
;	5/15/75		/DBT	"[" DID NOT GET ZERO VALUE
;				COMMENT OUT ZEROS AS LEADING CHARS
;*****
.DIRECTIVE .NOBIN

	SEARCH	RPGPRM		;DEFINE ASSEMBLY PARAMETERS.
	%%LBLP==:%%LBLP
	TRAILB==:TRAILB
	SEARCH	CHREQV		;DEFINE EQUIVALENCES BETWEEN THE
				; CHARACTER SETS.
	SALL			;DON'T EXPAND THE MACROS.
COMMENT	\
	THIS MODULE DEFINES THE NUMERIC VALUE INTO WHICH A CHARACTER,
IN THE SIXBIT, ASCII OR EBCIDC CHARACTER SET, WILL BE CONVERTED.  IT
DOES THIS BY DEFINING A SET OF SYMBOLS FOR EACH CHARACTER SET.  THE
FORM OF A SYMBOL IS:
	<LETTER>N%<NUMBER>
WHERE:
	LETTER	INDICATES THE CHARACTER SET TO WHICH THE SYMBOL BELONGS.
	NUMBER	INDICATES THE SPECIFIC CHARACTER.
	THE VALUE OF THE SYMBOL CONTAINS THE FOLLOWING INFORMATION:
		BIT	26	1==>THIS CHARACTER IS A LEADING CHAR.
		BIT	27	1==>THIS CHARACTER IS A SPECIAL CHAR.
		BIT	28	1==>THIS CHARACTER HAS AN OVERPUNCHED "-".
		BITS	29-35	THE NUMERIC VALUE OF THE CHARACTER UNLESS
				 IT IS A SPECIAL CHARACTER IN WHICH CASE
				 THIS FIELD CONTAINS A NUMBER WHICH TELLS
				 WHICH SPECIAL CHARACTER IT IS.
	THE LEADING CHARACTERS ARE:
		<NULL>, <BLANK>, <TAB>.
	THE SPECIAL CHARACTERS ARE:
		CHARACTER	VALUE
		<NULL>		0
		"+"		1
		"-"		2
		TERMINATING	3
	THE TERMINATING CHARACTERS ARE <TAB> AND, IF THE SWITCH TRAILB
IS SET TO 0, <BLANK>.
FOR SIXBIT AND ASCII:
	THE CHARACTERS 0-9 ARE TRANSLITERATED TO THE NUMBERS 0-9.
	THE CHARACTERS A-I (UPPER AND LOWER CASE) ARE TRANSLITERATED
TO THE NUMBERS 1-9.
	THE CHARACTERS J-R (UPPER AND LOWER CASE) ARE TRANSLITERATED
TO THE NUMBERS 1-9.
	THE CHARACTERS S-Z (UPPER AND LOWER CASE) ARE TRANSLITERATED
TO THE NUMBERS 2-9.
	THE CHARACTERS <BLANK>, "]", "!", ":", "[", "?", "{" AND "}"
ARE TRANSLITERATED TO 0.
	THE CHARACTERS J-R (UPPER AND LOWER CASE), "]", "}", "!" AND
":" HAVE THE OVERPUNCHED "-" FLAG SET TO 1.
	ALL OTHER CHARACTERS ARE FIRST CONVERTED TO ASCII IF THEY ARE
SIXBIT AND THEN THEY HAVE 60 SUBTRACTED FROM THE ASCII REPRESENTATION.
FOR EBCDIC:
	ALL CHARACTERS ARE CONVERTED BY SIMPLY USING THE LAST FOUR
BITS OF THE CHARACTER MOD ^D10.
	THE CODES 260-271 AND 320-331 HAVE THE OVERPUNCHED "-" FLAG
SET TO 1.
\
	SUBTTL	MACROS USED TO DEFINE THE EQUIVALENCES.
DEFINE	SET (LTR)<
	DEFINE	LTR'GEN 
		<
		%%T1==0
		IFIDN	<LTR> <A>,<
			%%T1==177
			DEFINE	ADVN (N)<AV'N==N&17
					IFGE AV'N-^D10,<AV'N==AV'N-10>
					>
			>
		IFIDN	<LTR> <E>,<
			%%T1==377
			DEFINE	EDVN (N)<EV'N==N&17
					 IFGE EV'N-^D10,<EV'N==EV'N-10>
					>
			>
		IFE	%%T1,<
			PRINTX	?BAD CALL TO MACRO "SET".
			PASS2
			END>
		%%T2==0
		REPEAT	%%T1+1,<
			LTR'SYM	\%%T2
			%%T2==%%T2+1>>
	DEFINE	LTR'SYM (N)<
		IFNDEF	LTR'L'N,<LTR'L'N==0>
		LTR'L'N==LTR'L'N&1
		IFNDEF	LTR'O'N,<LTR'O'N==0>
		LTR'O'N==LTR'O'N&1
		IFN	LTR'O'N,<LTR'S'N==1>	;;CHARACTERS WITH OVERPUNCHED
						;; "-" SIGNS ARE ALSO
						;; SPECIAL CHARS.
		IFNDEF	LTR'S'N,<LTR'S'N==0>
		LTR'S'N==LTR'S'N&1
		IFNDEF	LTR'V'N,<LTR'DVN	\N>
		LTR'V'N==LTR'V'N&177
		LTR'N%'N==BYTE	(26)0(1)LTR'L'N,LTR'S'N,LTR'O'N(7)LTR'V'N
		PURGE	LTR'L'N,LTR'S'N,LTR'O'N,LTR'V'N>
	DEFINE	LTR'LC (CHR)<
		%%T1==CHR
		LTR'LC1	\%%T1>
	DEFINE	LTR'LC1	(CHR)<LTR'L'CHR==1>
	DEFINE	LTR'SC (CHR, IDX)<
		%%T1==CHR
		%%T2==IDX
		LTR'SC1	\%%T1,\%%T2>
	DEFINE	LTR'SC1 (CHR, IDX)<
		LTR'S'CHR==1
		LTR'V'CHR==IDX>
	DEFINE	LTR'VR (CNT, STC, STV)<
		%%T1==STC
		%%T2==STV
		REPEAT	CNT,<
			LTR'VC1	\%%T1,\%%T2
			%%T1==%%T1+1
			%%T2==%%T2+1>>
	DEFINE	LTR'VC (CHR, VAL)<
		%%T1==CHR
		%%T2==VAL
		LTR'VC1	\%%T1,\%%T2>
	DEFINE	LTR'VC1 (CHR,VAL)<LTR'V'CHR==VAL>
	DEFINE	LTR'OR (CNT,STC)<
		%%T1==STC
		REPEAT	CNT,<
			LTR'OC1	\%%T1
			%%T1==%%T1+1>>
	DEFINE	LTR'OC (CHR)<
		%%T1==CHR
		LTR'OC1	\%%T1>
	DEFINE	LTR'OC1 (CHR)<LTR'O'CHR==1>
>;END OF DEFINE SET.
	SUBTTL	ASCII TO NUMERIC EQUIVALENCES
	SET	A
;ASSIGN THE VALUES.
	AVR	^D10,"0",0	;0-9
	AVR	^D9,"A",1	;A-I
	AVR	^D9,"a",1	;a-i
	AVR	^D9,"J",1	;J-R
	AVR	^D9,"j",1	;j-r
	AVR	^D8,"S",2	;S-Z
	AVR	^D8,"s",2	;s-z
IFN	TRAILB,<AVC	" ",0>
	AVC	"]",0
	AVC	"!",0
	AVC	":",0
	AVC	"{",0
	AVC	"[",0
	AVC	"?",0
	AVC	"}",0
;SET THE FLAGS:
;	LEADING CHARS:
	ALC	0		;<NULL>
	ALC	" "		;<BLANK>
	ALC	"	"	;<TAB>
;	ALC	"0"
;	ALC	"]"
;	ALC	"!"
;	ALC	":"
;	ALC	"{"
;	ALC	"["
;	ALC	"?"
;	ALC	"}"
;	SPECIAL CHARS:
	ASC	0,0		;<NULL>
	ASC	"+",1
	ASC	"-",2
	ASC	"	",3	;<TAB>
IFE	TRAILB,<ASC	" ",3>	;<SPACE>
;	CHARACTERS WITH AN OVERPUNCHED "-".
	AOR	^D9,"J"	;J-R
	AOR	^D9,"j"	;j-r
	AOC	"]"
	AOC	"!"
	AOC	":"
	AOC	"}"
;GENERATE THE SYMBOLS:
	AGEN
	SUBTTL	SIXBIT TO NUMERIC EQUIVALENCES.
COMMENT	\
	USE THE ASCII TO NUMERIC EQUIVALENCES AND THE ASCII TO SIXBIT
CHARACTER EQUIVALENCES TO DEFINE THE SIXBIT TO NUMERIC EQUIVALENCES SO
THAT WE KEEP THINGS CONSISTANT.
\
	DEFINE	A0 (N1, N2)<SN%'N1==AN%'N2>
	DEFINE	A1 (N1)<A0	\N1,\SA%'N1>
	%%T1==0
	REPEAT	100,<
		A1	\%%T1
		%%T1==%%T1+1>
	SUBTTL	EBCDIC TO NUMERIC EQUIVALENCES
	SET	E
;SET THE FLAGS:
;	LEADING CHARS:
	ELC	5	;<TAB>
	%%T1==0
	REPEAT	20,<
		IFN	140-%%T1,<ELC	\%%T1>
		%%T1==%%T1+20>
;	SPECIAL CHARS:
	ESC	0,0	;<NULL>
	ESC	116,1	;"+"
	ESC	140,2	;"-"
	ESC	5,3	;<TAB>
IFE	TRAILB,<ESC	100,3>	;<SPACE>
;	CHARACTERS WITH AN OVERPUNCHED "-".
	EOR	^D10,260
	EOR	^D10,320
;GENERATE THE SYMBOLS
	EGEN
	END