Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/chreqv.mac
There are 9 other files named chreqv.mac in the archive. Click here to see a list.
; UPD ID= 1227 on 9/5/78 at 1:38 PM
UNIVERSAL CHREQV FOR COBOL/LIBOL.
SUBTTL CHARACTER SET EQUIVALENCES /ACK
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;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.
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:
; 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