Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/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