UNIVERSAL	CHREQV FOR COBOL/LIBOL/RPGII V10.
SUBTTL	CHARACTER SET EQUIVALENCES	23-DEC-74	/ACK
;USED TO BE
;COPYRIGHT 1974, 1975, DIGITAL EQUIPMENT CORP., MAYNARD MASS.
;BUT MODIFIED TO RPGII VERSION BY BOB CURRIER
;REVISION HISTORY:
;V10 *****
;	23-DEC-74	/ACK	CREATION.
;*****

.DIRECTIVE .NOBIN
	SEARCH	RPGPRM		;DEFINE ASSEMBLY PARAMETERS.
	%%LBLP==:%%LBLP
	IFNDEF	CKRDF.,<CKRDF.==0>	;DEFAULT IS DON'T PRINT A
					; MESSAGE IF WE TRY TO
					; REDEFINE SOMETHING.
	SALL				;DON'T EXPAND THE MACROS.
COMMENT	\
	THIS ROUTINE DEFINES THE EQUIVALENCES BETWEEN THE ASCII,
SIXBIT AND EBCDIC CHARACTER SETS.  IT DOES THIS BY DEFINING A SET
OF SYMBOLS FOR EACH CHARACTER SET.  THE FORM OF A SYMBOL IS:
	<LETTER 1><LETTER 2>%<NUMBER>
WHERE:
	LETTER 1	INDICATES THE CHARACTER SET TO WHICH THIS
			 SYMBOL BELONGS.
	LETTER 2	INDICATES THE CHARACTER SET TO WHICH THE
			 VALUE OF THIS SYMBOL BELONGS.
	NUMBER		INDICATES THE PARTICULAR CHARACTER TO WHICH
			 THIS SYMBOL BELONGS.
	THE VALUE OF THE SYMBOL IS THE CHARACTER, IN THE CHARACTER SET
INDICATED BY <LETTER 2>, TO WHICH THE CHARACTER REPRESENTED BY THE
SYMBOL IS EQUIVALENT.
	THE CHARACTER SETS AND THE LETTERS USED TO REPRESENT THEM ARE:
		SIXBIT	S
		ASCII	A
		EBCDIC	E
EXAMPLES:
	SYMBOL	VALUE			EXPLANATION
	SA%20	 60	SIXBIT 20 ("0") IS EQUIVALENT TO ASCII 60 ("0").
	SE%20	 360	SIXBIT 20 ("0") IS EQUIVALENT TO EBCDIC 360 ("0").
	AS%60	 20	ASCII 60 ("0") IS EQUIVALENT TO SIXBIT 20 ("0").
	ES%360	 20	EBCDIC 360 ("0") IS EQUIVALENT TO SIXBIT 20 ("0").
	IF A SYMBOL IS ASSIGNED A DEFAULT VALUE BECAUSE IT HAS NO
EQUIVALENT IN THE CHARACTER SET, THE VALUE WILL HAVE BIT 18 SET TO 1.
\
	SUBTTL	MACROS USED TO DEFINE THE EQUIVALENCES.
;;NAME:		SET
;;PURPOSE:	DEFINE ALL MACROS USED FOR EQUATING SYMBOLS.
;;CALL:		SET <LETTER 1>,<LETTER 2>,<DEFAULT CHAR 1>,<DEFAULT CHAR 2>
	DEFINE	SET	(L1, L2, D1, D2)<
;;NAME:		E
;;PURPOSE:	EQUATE TWO SYMBOLS TO THEIR VALUES.
;;CALL:		E <VALUE 1>,<VALUE 2>
	DEFINE	E	(V1, V2)<
	V1A==V1
	V2A==V2
	%E1	\V1A,\V2A
>;; END OF DEFINITION OF E.
	DEFINE	%E1	(V1, V2)<
	IFDEF	L1''L2'%'V1,<
		IFN	L1''L2'%'V1-V2,<
		%RDF	L1''L2'%'V1',\L1''L2'%'V1',\V2>>
	IFNDEF	L1''L2'%'V1,<L1''L2'%'V1==V2>
	IFDEF	L2''L1'%'V2,<
		IFN	L2''L1'%'V2-V1,<
		%RDF	L2''L1'%'V2',\L2''L1'%'V2',\V1>>
	IFNDEF	L2''L1'%'V2,<L2''L1'%'V2==V1>
>;; END OF DEFINITION OF %E1.
;;NAME:		D<LETTER 1><LETTER 2>
;;PURPOSE:	DEFAULT A RANGE OF SYMBOLS.
;;CALL:		D<LETTER 1><LETTER 2>	<FIRST>,<LAST>
	DEFINE	D'L1''L2	(F, L)<
	%%T1==F
	REPEAT	L-F+1,<%D'L1''L2	\%%T1,\D1
	%%T1==%%T1+1>
>;; END OF DEFINITION OF D'L1''L2'.
	DEFINE	%D'L1''L2	(T1,T2)<
	IFNDEF L1''L2'%'T1,<L1''L2'%'T1==T2!1B18>
>;; END OF DEFINITION OF %D'L1''L2'.
;;NAME:		D<LETTER 2><LETTER 1>
;;PURPOSE:	DEFAULT A RANGE OF SYMBOLS.
;;CALL:		D<LETTER 2><LETTER 1>	<FIRST>,<LAST>
	DEFINE	D'L2''L1	(F, L)<
	%%T1==F
	REPEAT	L-F+1,<%D'L2''L1	\%%T1,\D2
	%%T1==%%T1+1>
>;; END OF DEFINITION OF D'L2''L1.
	DEFINE	%D'L2''L1	(T1,T2)<
	IFNDEF L2''L1'%'T1,<L2''L1'%'T1==T2!1B18>
>;; END OF DEFINITION OF %D'L2''L1.
;;NAME:		DS<LETTER 1><LETTER 2>
;;PURPOSE:	DEFAULT A SINGLE SYMBOL TO A NON-STANDARD DEFAULT CHAR.
;;CALL:		DS<LETTER 1><LETTER 2>	<VALUE>,<CHAR>
	DEFINE	DS'L1''L2	(V, C)<
	%D'L1''L2	\V,\C
>;;END OF DEFINITION OF DS'L1''L2
;;NAME:		DS<LETTER 2><LETTER 1>
;;PURPOSE:	DEFAULT A SINGLE SYMBOL TO A NON-STANDARD DEFAULT CHAR.
;;CALL:		DS<LETTER 2><LETTER 1>	<VALUE>,<CHAR>
	DEFINE	DS'L2''L1	(V, C)<
	%D'L2''L1	\V,\C
>;;END OF DEFINITION OF DS'L2''L1'.
;;NAME:		C<LETTER 1><LETTER 2>
;;PURPOSE:	CHECK THAT ALL SYMBOLS IN A CHARACTER SET ARE DEFINED.
;;CALL:		C<LETTER 1><LETTER 2>
	DEFINE	C'L1''L2	<
	%CHK	L1,L2
	C'L1''L2
>;;END OF DEFINITION OF C'L1''L2'.
;;NAME:		C<LETTER 2><LETTER 1>
;;PURPOSE	CHECK THAT ALL SYMBOLS IN A CHARACTER SET ARE DEFINED.
;;CALL:		C<LETTER 2><LETTER 1>
	DEFINE	C'L2''L1	<
	%CHK	L2,L1
	C'L2''L1
>;;END OF DEFINITION OF C'L2''L1'.
>;;END OF DEFINITION OF SET.
;MISCELLANIOUS MACROS USED BY SET:
	DEFINE	%RDF	(SYMBOL, V1, V2)<
	IFN	CKRDF.,<
	PRINTX	%ATTEMPT TO REDEFINE SYMBOL FROM V1 TO V2'.
>>;END OF DEFINITION OF %RDF.
	DEFINE	%CHK	(L1, L2)<
	DEFINE	C'L1''L2	<
	%%T1==0
	IFIDN	<L1> <S>,<%%T1==77>
	IFIDN	<L1> <A>,<%%T1==177>
	IFIDN	<L1> <E>,<%%T1==377>
	IFE	%%T1,<
	PRINTX	?BAD CALL TO MACRO "SET".
	PASS2
	END
>;;END OF IFE %%T1.
	%%T2==0
	REPEAT	%%T1+1,<%C'L1''L2	\%%T2
	%%T2==%%T2+1>
>;;END OF DEFINITION OF C'L1''L2'.
	DEFINE	%C'L1''L2	(VALUE)<
	IFNDEF	L1''L2'%'VALUE,<
	PRINTX	%	L1''L2'%'VALUE IS NOT DEFINED.
>>;;END OF DEFINITION OF %C'L1''L2'.
>;;END OF DEFINITION OF %CHK.
SUBTTL		  TABLE OF ASCII/EBCDIC EQUIVALENCES
IF1,<	;ONLY DEFINE THE SYMBOLS ONCE.
	SET	A,E,0,134
;CONTROL CHARACTERS
;	      ASCII,EBCDIC		ASCII		EBCDIC
	E	000,000		;	<NULL>		<NULL>
	E	001,001		;	<SOH>
	E	002,002		;	<STX>
	E	003,003		;	<ETX>
	E	004,067		;	<EOT>		<EOT>
	E	005,055		;	<ENQ>
	E	006,056		;	<ACK>
	E	007,057		;	<BELL>
	E	010,026		;	<BS>		<BS>
	E	011,005		;	<HT>		<HT>
	E	012,045		;	<LF>		<LF>
	E	013,013		;	<VT>
	E	014,014		;	<FF>
	E	015,025		;	<CR>		<NL>
	E	016,006		;	<SO>		<LC>
	E	017,066		;	<SI>		<UC>
	E	020,044		;	<DLE>		<BYP>
	E	021,024		;	<DC1>		<RES>
	E	022,064		;	<DC2>		<PN>
	E	023,065		;	<DC3>		<RS>
	E	024,004		;	<DC4>		<PF>
	E	025,075		;	<NAK>
	E	026,027		;	<SYN>		<IL>
	E	027,046		;	<ETB>		<EOB>
	E	030,052		;	<CAN>		<SM>
	E	031,031		;	<EM>
	E	032,032		;	<SUB>		<CC>
	E	033,047		;	<ESC>		<PRE>
	E	034,023		;	<FS>		<TM>
	E	035,041		;	<GS>		<SOS>
	E	036,040		;	<RS>		<DS>
	E	037,042		;	<US>		<FS>
;GRAPHICS:
;	      ASCII,EBCDIC		GRAPHIC
	E	040,100		;	<SPACE>
	E	041,132		;	!
	E	042,177		;	"
	E	043,173		;	#
	E	044,133		;	$
	E	045,154		;	%
	E	046,120		;	&
	E	047,175		;	'
	E	050,115		;	(
	E	051,135		;	)
	E	052,134		;	*
	E	053,116		;	+
	E	054,153		;	,
	E	055,140		;	-
	E	056,113		;	.
	E	057,141		;	/
	E	060,360		;	0
	E	061,361		;	1
	E	062,362		;	2
	E	063,363		;	3
	E	064,364		;	4
	E	065,365		;	5
	E	066,366		;	6
	E	067,367		;	7
	E	070,370		;	8
	E	071,371		;	9
	E	072,172		;	:
	E	073,136		;	;
	E	074,114		;	<
	E	075,176		;	=
	E	076,156		;	>
	E	077,157		;	?
;	      ASCII,EBCDIC		GRAPHIC
	E	100,174		;	@
	E	101,301		;	A
	E	102,302		;	B
	E	103,303		;	C
	E	104,304		;	D
	E	105,305		;	E
	E	106,306		;	F
	E	107,307		;	G
	E	110,310		;	H
	E	111,311		;	I
	E	112,321		;	J
	E	113,322		;	K
	E	114,323		;	L
	E	115,324		;	M
	E	116,325		;	N
	E	117,326		;	O
	E	120,327		;	P
	E	121,330		;	Q
	E	122,331		;	R
	E	123,342		;	S
	E	124,343		;	T
	E	125,344		;	U
	E	126,345		;	V
	E	127,346		;	W
	E	130,347		;	X
	E	131,350		;	Y
	E	132,351		;	Z
	E	133,340		;	[	[THIS IS NOT REALLY
				;	  EQUIVALENT, IT IS EBCDIC'S
				;	  "+0".]
	;	134		;	\	[NO EBCDIC EQUIVALENT.]
	E	135,320		;	]	[THIS IS NOT REALLY
				;	  EQUIVALENT, IT IS EBCDIC'S
				;	  "-0".]
	;	136		;	^	[NO EBCDIC EQUIVALENT.]
	E	137,155		;	_
;	      ASCII,EBCDIC		GRAPHIC
	;	140		;	`	[NO EBCIDC EQUIVALENT.]
	E	141,201		;	a
	E	142,202		;	b
	E	143,203		;	c
	E	144,204		;	d
	E	145,205		;	e
	E	146,206		;	f
	E	147,207		;	g
	E	150,210		;	h
	E	151,211		;	i
	E	152,221		;	j
	E	153,222		;	k
	E	154,223		;	l
	E	155,224		;	m
	E	156,225		;	n
	E	157,226		;	o
	E	160,227		;	p
	E	161,230		;	q
	E	162,231		;	r
	E	163,242		;	s
	E	164,243		;	t
	E	165,244		;	u
	E	166,245		;	v
	E	167,246		;	w
	E	170,247		;	x
	E	171,250		;	y
	E	172,251		;	z
	E	173,300		;	{	[THIS IS NOT REALLY
				;	 EQUIVALENT, IT IS EBCIDC'S
				;	 "+0".]
	E	174,117		;	|
	E	175,260		;	}	[THIS IS NOT REALLY
				;	 EQUIVALENT, IT IS EBCIDC'S
				;	 "-0".]
	;	176		;	~	[NO EBCDIC EQUIVALENT.]
	E	177,007		;	<DEL>
;DEFAULT THE ASCII CHARACTERS WHICH HAVE NO EBCDIC EQUIVALENTS.
;					ASCII		EBCDIC
	DSAE	134,155		;	\		_
	DSAE	136,117		;	^		|
	DSAE	140,174		;	`		@
	DSAE	176,155		;	~		_
;MAKE SURE ALL ASCII CHARS ARE DEFINED.
	CAE
;DEFAULT EBCDIC CHARS WHICH HAVE NO ASCII EQUIVALENT TO "\".
	DEA	0,377
;MAKE SURE ALL EBCDIC CHARS ARE DEFINED.
	CEA
>	;END OF IF1 CONDITIONAL.
	SUBTTL	ASCII/SIXBIT CHARACTER EQUIVALENCES.
IF1,<	;ONLY DEFINE THE SYMBOLS ONCE.
	SET	A,S,74,0
;DEFINE THE NORMAL ASCII TO SIXBIT EQUIVALENCES.
	I==40
	REPEAT 100,<
	E	I,I-40
	I==I+1
>
;EQUATE THE LOWER CASE ASCII LETTERS TO THE UPPER CASE SIXBIT LETTERS.
	I==141
	REPEAT 32,<
	E	I,I-100
	I==I+1
>
;MAKE SURE ALL THE SIXBIT CHARS ARE DEFINED.
	CSA
;DEFAULT ASCII CHARACTERS WHICH HAVE NO SIXBIT EQUIVALENT.
;						ASCII	SIXBIT
	DSAS	11,0			;	<TAB>	<BLANK>
	DSAS	173,73			;	{	[
	DSAS	175,75			;	}	]
	DAS	0,177			; EVERYTHING ELSE BECOMES "\".
;MAKE SURE ALL THE ASCII CHARS ARE DEFINED.
	CAS
>	;END OF IF1 CONDITIONAL.
	SUBTTL	EBCDIC/SIXBIT CHARACTER EQUIVALENCES.
IF1,<	;ONLY DEFINE THE SYMBOLS ONCE.
	SET	E,S,0,0
;DO THIS BY USING EBCDIC TO ASCII AND ASCII TO SIXBIT EQUIVALENCES SO
; THAT WE KEEP THINGS CONSISTANT.
;MACROS:
	DEFINE	A0 (A, B)<
	%A0A==A&777
	%A0B==B&777
	A1	\%A0A,\%A0B
>
	DEFINE	A1 (A, B)<
	%A1A==EA%'A'&777
	%A1B==B&777
	A2	\%A1A,\%A1B
>
	DEFINE	A2 (A, B)<
	%A2A==AS%'A'&777
	%A2B==B&777
	E	\%A2B,\%A2A
>
;GENERATE THE EQUIVALENCES:
;DEFAULT THE SIXBIT CHARS WHICH HAVE NO EBCDIC EQUIVALENT.
;					SIXBIT		EBCDIC
	DSSE	74,155		;	\		_
	DSSE	76,177		;	^		.
;DO THE UPPER CASE LETTERS FIRST OTHERWISE SIXBIT LETTERS WILL
; BE CONVERTED TO LOWER CASE EBCDIC LETTERS.
	I==301
	REPEAT 77,<
	A0	\I,I
	I==I+1
>
;THE SAME PROBLEM OCCURS WITH SIXBIT BLANKS AND EBCDIC TABS.

	A0	100,100

;NOW DO THE REST.
	I==0
	REPEAT 301,<
	A0	\I,I
	I==I+1
>
;MAKE SURE ALL THE SIXBIT CHARS ARE DEFINED.
	CSE
;MAKE SURE ALL THE EBCDIC CHARS ARE DEFINED.
	CES
>	;END OF IF1 CONDITIONAL.
; HERE IS A MACRO TO GIVE AN EBCDIC CHARACTER CODE BASED UPON ASCII 
; LITERAL
;		CALL:	EBC.CH("$")
;
;		GIVES THE EBCDIC CHARACTER CODE AS A VALUE

DEFINE	SYM79(CH)<AE%'CH>

DEFINE	EBC.CH(CH)<SYM79(\CH)>


	END