Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/chreqv.mac
There are 9 other files named chreqv.mac in the archive. Click here to see a list.
; UPD ID= 1353 on 8/22/83 at 1:40 PM by FONG                            
UNIVERSAL	CHREQV FOR COBOL/LIBOL.
SUBTTL	CHARACTER SET EQUIVALENCES	/ACK

	SEARCH COPYRT
	SALL


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

;REVISION HISTORY:

;V12 *****
				;FIX UP ASCII - EBCDIC CONVERSION ERRORS

;V10 *****

;	23-DEC-74	/ACK	CREATION.

;*****

	SEARCH	LBLPRM		;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.

.DIRECTIVE .NOBIN
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
		UPPER	U

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").
	AU%141	101	ASCII 141 ("a") IS EQUIVALENT TO ASCII 101 ("A")

	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:
;To put the translation table back the way it was so that the translation of
;graphics is correct when there is minus zero, put in the following correction:
;change
;	E 133,255 to E 133,340
;	E 134,340 to ;	134
;	E 135,275 to E 135,320
;	E 136,137 to ;	136
;	E 140,171 to ;	140
;	E 175,320 to E 175,260
;	E 176,241 to ;	176
;
;and before CAE insert
;	DSAE 134,155
;	DSAE 136,117
;	DSAE 140,174
;	DASE 176,155
;

;	      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,255		;	[
	E	134,340		;	\
	E	135,275		;	]
	E	136,137		;	^
	E	137,155		;	_
;	      ASCII,EBCDIC		GRAPHIC

	E	140,171		;	`
	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		;	{
	E	174,117		;	|
	E	175,320		;	}
	E	176,241		;	~
	E	177,007		;	<DEL>
;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:

;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)>
SUBTTL		  TABLE OF ASCII/UPPER EQUIVALENCES

IF1,<	;ONLY DEFINE THE SYMBOLS ONCE.

	SET	A,U,0,0

;DEFINE THE CONTROL AND UPPER CASE CHARACTERS

I==0
REPEAT	141,<
	E	I,I
	I==I+1
>

;THE LOWER CASE CHARACTERS

REPEAT ^D26,<
	E	I,I-40
	I==I+1
>

;THE LAST 5 CHARACTERS

REPEAT 5,<
	E	I,I
	I==I+1
>
>	;END OF IF1 CONDITIONAL.
SUBTTL	TABLE OF EBCDIC/UPPER ASCII EQUIVALENCES

IF1,<	;ONLY DEFINE THE SYMBOLS ONCE

	SET	U,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,255		;	[
	E	134,340		;	\
	E	135,275		;	]
	E	136,137		;	^
	E	137,155		;	_
;	      ASCII,EBCDIC		GRAPHIC

	E	140,171		;	`
	E	101,201		;	a
	E	102,202		;	b
	E	103,203		;	c
	E	104,204		;	d
	E	105,205		;	e
	E	106,206		;	f
	E	107,207		;	g

	E	110,210		;	h
	E	111,211		;	i
	E	112,221		;	j
	E	113,222		;	k
	E	114,223		;	l
	E	115,224		;	m
	E	116,225		;	n
	E	117,226		;	o

	E	120,227		;	p
	E	121,230		;	q
	E	122,231		;	r
	E	123,242		;	s
	E	124,243		;	t
	E	125,244		;	u
	E	126,245		;	v
	E	127,246		;	w

	E	130,247		;	x
	E	131,250		;	y
	E	132,251		;	z
	E	173,300		;	{
	E	174,117		;	|
	E	175,320		;	}
	E	176,241		;	~
	E	177,007		;	<DEL>
;MAKE SURE ALL ASCII CHARS ARE DEFINED.

	CAE

;DEFAULT EBCDIC CHARS WHICH HAVE NO ASCII EQUIVALENT TO "\".

	DEU	0,377

;MAKE SURE ALL EBCDIC CHARS ARE DEFINED.

	CEU

>	;END OF IF1 CONDITIONAL.

	END