PDP-10 Archive: cobol/source/num.mac from BB-H506D-SM

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/num.mac

There are 7 other files named num.mac in the archive. Click here to see a list.

; UPD ID= 2851 on 5/16/80 at 11:52 AM by NIXON                          
TITLE	NUM FOR LIBOL
SUBTTL	DETERMINE IF A STRING IS NUMERIC	/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:

;	16-MAY-80	[631] FIX IF NUMERIC TEST OF EVEN DIGIT COMP-3 ITEM.
;	13-AUG-76	[450] ADD ANSII STD NUMERIC TESTING
;	5/15/75		/DBT	BIS
;	13-DEC-74	CREATION.
;*****

	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	EBCMP.==:EBCMP.
	TRAILB==:TRAILB
	NUMSTD==:NUMSTD	; [450] ADD ANSII STD NUMERIC TESTING
	BIS==:BIS

	EXTERN	EASTB.		;FORCE EASTBL TO BE LOADED.

	HISEG

COMMENT	\

	THIS ROUTINE CHECKS A STRING TO SEE IF IT CONTAINS ONLY NUMERIC 
CHARACTERS.  IF THE STRING'S PICTURE INDICATES THAT IT MAY CONTAIN
A SIGN, THE SIGN MAY APPEAR IN ANY OR ALL OF THE FOLLOWING POSITIONS
AND NEED NOT BE CONSISTANT.
	1.	AS A LEADING "+" OR "-".
	2.	AS A TRAILING "+" OR "-".
	3.	AS AN 11-OVERPUNCH OR 12-OVERPUNCH IN THE LAST
		DIGIT OF THE NUMBER.

CALL:
	MOVEI	16,PARAMETER ADDRESS
	PUSHJ	17,NUM.6/NUM.7/NUM.9

PARAMETERS:
	BITS	0-5	BYTE POINTER RESIDUE FOR THE INPUT FIELD.
	BIT	6	1 IF AN OPERATIONAL SIGN IS PRESENT.
	BITS	7-17	SIZE OF THE INPUT FIELD.
	BITS	18-35	ADDRESS OF THE FIRST CHARACTER OF THE INPUT FIELD.

RETURNS:
	CALL+1	IF THE STRING LENGTH IS ZERO OR IS IS NOT
		A VALID NUMERIC STRING.
	CALL+2	IF THE STRING IS A VALID NUMERIC STRING.

REGISTERS USED:
	CH, SW, MASK, JAC, IPTR, CNT, CPTR

\

	ENTRY	NUM.6		;IF THE INPUT IS SIXBIT.
	ENTRY	NUM.7		;IF THE INPUT IS ASCII.
IFN EBCMP.,<
	ENTRY	NUM.9		;IF THE INPUT IS EBCDIC.
>

IFE	BIS,<

;LOCAL AC DEFINTIONS:

	TPTR==TAC3
	TOKE==TAC4
	STATE==TAC5

	EXTERN	SET1.		;PICKS UP THE PARAMETERS.
	EXTERN	RET.1		;RETURNS TO CALL+1.

	EXTERN	PTRTK.		;TABLE OF POINTERS TO THE TOKEN TABLES.

NUM.6:	JSP	CH,	NUM		;ENTER HERE IF THE INPUT IS SIXBIT,
NUM.7:	JSP	CH,	NUM		; HERE IF IT IS ASCII AND
IFN EBCMP.,<
NUM.9:	JSP	CH,	NUM		; HERE IF IT IS EBCDIC.
>
NUM:	SUBI	CH,	NUM.6-5		;SEE WHAT THE INPUT LOOKS LIKE.
	JSP	JAC,	SET1.		;GO SET UP THE PARAMETERS.
	MOVE	CPTR,	PTRTK.-6(SW)	;GET THE POINTER TO THE TOKEN TABLE.
	MOVEI	STATE,	1		;ASSUME WE START IN STATE 1.
	SKIPGE		SW		;DO WE?
	MOVEI	STATE,	SS		;NO, THE INPUT IS SIGNED.  START
					; IN STATE SS.

NUM1:	ILDB	CH,	IPTR		;GET THE NEXT CHAR.
	LDB	TOKE,	CPTR		;GET THE TOKEN.
	LDB	STATE,	PTRTBL(TOKE)	;GET THE NEXT STATE.
	JUMPE	STATE,	RET.1		;IF IT'S ZERO FAIL.
	SOJG	CNT,	NUM1		;LOOP IF THERE ARE MORE CHARS.
	SKIPL		STATBL-1(STATE)	;ARE WE IN A FAILURE STATE?
	AOS		(PP)		;NO, SKIP RETURN.
	POPJ	PP,			;RETURN.

	SUBTTL	TRANSITION TABLES.

COMMENT	\

	STRUCTURE:
		BIT	0	1 ==: THIS IS A FAILURE STATE (IF WE ARE
					IN THIS STATE AND THERE IS NO
					MORE INPUT, FAIL.)
		THE REST OF THE WORD IS BROKEN INTO FOUR BIT BYTES
	CONTAINING THE NEXT STATE FOR EACH OF THE TOKENS.  THE TOKENS
	ARE:
		0	NULL
		1	TAB
		2	BLANK
		3	DIGIT
		4	OVERPUNCHED DIGIT
		5	GRAPHIC SIGN
		6	OTHER
	A NEXT STATE OF 0 INDICATES FAILURE.

	THE ALGORITHM:
		1.	GET A CHARACTER.
		2.	CONVERT THE CHAR TO A TOKEN.
		3.	DETERMINE THE NEXT STATE.
		4.	IF THE NEXT STATE IS 0 FAIL.
		5.	MAKE THE NEXT STATE BE THE CURRENT STATE.
		6.	DETERMINE IF THERE IS ANY MORE INPUT.
		7.	IF THERE IS GO TO 1.
		8.	DETERMINE IF WE ARE IN A FAILURE STATE.
		9.	IF WE ARE FAIL OTHERWISE TAKE THE "TRUE" RETURN.

\

	DEFINE	SWS(STATE, F, N, T, B, D, S, G, O)<BYTE	(1)F(4)N,T,B,D,S,G,O>

IFE TRAILB,<	;USE THE FOLLOWING TABLE IF BLANKS TERMINATE THE FIELD.

	IFE NUMSTD,<	;[450]
STATBL:	SWS	1,1,1,1,1,2,0,0,0
	SWS	2,0,2,3,3,2,0,0,0
	SWS	3,0,3,3,3,0,0,0,0
	SWS	4,1,4,4,4,5,3,5,0
	SWS	5,0,5,3,3,5,3,3,0

;IF THE ITEM'S PICTURE STRING CONTAINS AN "S" WE START AT STATE 4.

	SS==4
>	; END IFE NUMSTD
>	; END IFE TRAILB

IFN TRAILB,<	;USE THE FOLLOWING TABLE IF BLANKS ARE CONVERTED TO 0.

STATBL:	SWS	1,1,1,1,2,3,0,0,0
	SWS	2,0,2,2,2,3,0,0,0
	SWS	3,0,3,4,3,3,0,0,0
	SWS	4,0,4,4,4,0,0,0,0
	SWS	5,1,5,5,6,7,4,7,0
	SWS	6,0,6,6,6,7,4,7,0
	SWS	7,0,7,4,7,7,4,4,0

;IF THE ITEM'S PICTURE STRING CONTAINS AN "S" WE START AT STATE 5.

	SS==5
>
IFN	NUMSTD,<	; [450]  USE THE FOLLOWING TABLE IF ANSII STANDARD NUMERIC TESTING DESIRED
	IFE TRAILB <
STATBL:	SWS	1,0,0,0,0,1,0,0,0
	SWS	2,1,0,0,0,3,4,5,0
	SWS	3,0,0,0,0,3,4,4,0
	SWS	4,0,0,0,0,0,0,0,0
	SWS	5,1,0,0,0,1,0,0,0
; FOR SIGNED ITEM START AT STATE 2
	SS==2
	>
	> ;  [450] END IFN NUMSTD

;TABLE OF POINTERS INTO THE TRANSITION TABLES - INDEX BY TOKE.

PTRTBL:	BLOCK	0

	N==4
REPEAT 7,<	POINT	4,STATBL-1(STATE),N
	N==N+4>

>	;END OF NON-BIS

IFN	BIS,<

EXTERN	NUMS.6,NUMS.7,NUMS.9		;TRANSLATION TABLES
EXTERN	RET.2
EXTERN	BPTOK.		;CONVERT TO TOKEN POINTER

; FLAGS FOR LEFT OF SW
SAWSGN==1B35		;LEADING GRAPHIC SIGN SEEN

NUMS.T:	CVTDBT	NUMS.6			;SIXBIT
	CVTDBT	NUMS.7			;ASCII
	0
	CVTDBT	NUMS.9			;EBCDIC


NUM.6:	JSP	BISCH,	NUM		;SIXBIT
NUM.7:	JSP	BISCH,	NUM		;ASCII
	BLOCK	1
NUM.9:	JSP	BISCH,	NUM		;EBCDIC

NUM:
	SUBI	BISCH,	NUM.6-5		;CONVERT TO BYTE SIZE
	JSP	JAC,	BSET1.##	;GET PARAMETER

NUM1:	EXTEND	B.FLAG,	NUMS.T-6(SW)	;GO
	JRST		ABRTCK		;ABORT??

	TLNE	B.FLAG,BFLG.N		;ALL DONE - NUMERIC???
	AOS	(PP)			;YES
	POPJ	PP,			;NO

ABRTCK:	;INSTRUCTION ABORTED - WHY????
	LDB	BISCH,	SRCPT		;GET OFFENDING CHARACTER
	LDB	BISCH,	BPTOK.-6(SW)	;TOKEN VALUE

	XCT	TOKTAB(BISCH)		;DISPATCH

	IFE NUMSTD,<	; [450] DEC STD NUMERIC TESTING
TOKTAB:	EXP	0			;NULLS ARE IGNORED
	JRST	NUMFN1			;TAB
	JRST	NUMFN1			;BLANK
	EXP	0			;DIGIT
	JRST	OVPCHK			;OVERPUNCH
	JRST	GPHCHK			;GRAPHIC
	POPJ	PP,			;OTHER - LOSES
	> ; END IF IFE NUMSTD [450]

	IFN NUMSTD, <	; [450] ANSII STD NUMERIC TESTING
TOKTAB:	POPJ	PP,			; [450] NULLS ARE ILLEGAL
	POPJ	PP,			; [450] TABS ARE ILLEGAL
	POPJ	PP,			; [450] BLANKS AE ILLEGAL
	EXP	0			; [450] DIGIT
	JRST	OVPCHK			; [450] OVERPUNCH
	JRST	GPHCHK			; [450] GRAPHIC
	POPJ	PP,			; [450] OTHER - LOSES
	> 	; [450] END IFN NUMSTD

OVPCHK:	;OVERPUHCH SIGN CHARACTER
	; CHECK TO SEE THAT IT IS LAST AND
	; THAT NO SIGN HAS BEEN SEEN BEFORE

	SKIPGE	SW			;CAN IT BE SIGNED
	TLNE	SW,SAWSGN		;YES-HAVE WE SEEN A LEADING SIGN?
	POPJ	PP,			;UNSIGNED OR TWO SIGNS LOSE
	JRST	NUMFN1			;OK SO FAR

GPHCHK:	;GRAPHIC SIGN
	SKIPGE	SW			;CAN IT BE SIGNED
	TLOE	SW,SAWSGN		;YES - HAVE WE SEEN ONE ALREADY?
	POPJ	PP,			;UNSIGNED OR TWO SIGNS LOSE
	TLNN	B.FLAG,BFLG.N		;IS IT LEADING?
	JRST	NUM1			;YES CONTINUE
					;NO - TRAILING

	IFE NUMSTD,<	; [450]
NUMFN1:	;HAVE A LIGIT NUMBER - MAKE SURE JUST BLANKS/TAB
	; FOLLOW

	TLZ	B.FLAG,BFLG.		;CLEAR ALL FLAGS SO WE CAN 
					;RESTART AND SO FOLLOWING COMPARE
					; WILL WORK
	JUMPE	SRCCNT,RET.2		;DONE - IF AT END OF FIELD

	; SKIP TRAILING BLANKS / TABS
	EXTEND	B.FLAG,NUMS.T-6(SW)
	POPJ	PP,			;ABORT MEANS OTHER THAN B/T

	;MAKE SURE THERE WERE NO DIGITS
	TLNN	B.FLAG,BFLG.N
	AOS	(PP)			;GOOD NUMBER
	POPJ	PP,			;SORRY
	> ; [450] END IFE NUMSTD

	IFN NUMSTD, <
NUMFN1:	; NO OTHER DIGITS MAY FOLLOW
	TLZ	B.FLAG,BFLG.		;CLEAR ALL FLAGS SO WE CAN 
					;RESTART AND SO FOLLOWING COMPARE
					; WILL WORK
	JUMPE	SRCCNT,RET.2		;DONE - IF AT END OF FIELD
	POPJ	PP,			; [450] FAIL BECAUSE MORE CHARS FOLLOW TRAILING OR IMBEDDED SIGN
	> ;[450] END IFN NUMSTD

>	;END OF BIS

SUBTTL	COMP-3 NUMERIC TEST

ENTRY	NUM.3

NUM.3:	MOVEI	CH,8		;TELL SET1. ITS EBCDIC
	JSP	JAC,SET1.##	;SET UP THE PARAMETERS.
	TRNE	CNT,1		;ODD OR EVEN NO. OF DIGITS
	JRST	NUM3A		;ODD
	ILDB	T1,IPTR		;GET THE FIRST BYTE
	ANDI	T1,17		;MASK OUT JUNK
	SOJA	CNT,NUM3B	;[631] AND CONTINUE

NUM3A:	ILDB	T1,IPTR		;GET NEXT BYTE
	SUBI	CNT,2		;ACCOUNT FOR IT
NUM3B:	LSHC	T1,-4		;SPLIT OFF LOWER NIBBLE
	LSH	T2,-^D32
	CAILE	T1,9		;HIGH NIBBLE MUST BE NUMERIC
	POPJ	PP,		;FAILURE
	JUMPL	CNT,NUM3C	;LAST NIBBLE IS THE SIGN
	CAILE	T2,9		;LOWER NIBBLE MUST BE NUMERIC
	POPJ	PP,		;FAILURE
	JRST	NUM3A		;OK, LOOP

NUM3C:	CAILE	T2,9		;IT BETTER BE A SIGN
	AOS	(PP)		;IT IS (12 THRU 17 ARE OK)
	POPJ	PP,


	END