Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
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 V12C
SUBTTL DETERMINE IF A STRING IS NUMERIC /ACK
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;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
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
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