Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/num.mac
There are 7 other files named num.mac in the archive. Click here to see a list.
; UPD ID= 1370 on 9/21/83 at 5:29 PM by HOFFMAN                         
TITLE	NUM FOR COBOTS
	TRAILB==:0
SUBTTL	DETERMINE IF A STRING IS NUMERIC	/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

	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
IFN TOPS20,<SEARCH MACSYM>
IFE TOPS20,<SEARCH MACTEN>

	EXTERN	EASTB.		;FORCE EASTBL TO BE LOADED.

	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file

;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.
;*****

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.
	ENTRY	NUM.9		;IF THE INPUT IS EBCDIC.
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

; [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

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

	TXNE	SW,SW.SGN		;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
	TXNE	SW,SW.SGN		;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

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
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