Google
 

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