Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/numeqv.mac
There are 9 other files named numeqv.mac in the archive. Click here to see a list.
UNIVERSAL NUMEQV FOR LIBOL.
SUBTTL NUMERIC EQUIVALENCES /ACK
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
;REVISION HISTORY:
;V10 *****
; 04-APR-76 ; [433] FIX LOSS OF EBCDIC ZEROS
; 30-DEC-74 /ACK CREATION.
; 5/15/75 /DBT "[" DID NOT GET ZERO VALUE
; COMMENT OUT ZEROS AS LEADING CHARS
;*****
SEARCH LBLPRM ;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 <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
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
; [433] HANDLE VARIOUS EBCDIC ZEROS INCLUDING OVERPUNCHES
REPEAT 20,<
IFN 140-%%T1,<
IFN 200-%%T1,<
IFN 220-%%T1,<
IFN 300-%%T1,<
IFN 320-%%T1,<
IFN 360-%%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