Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0001/getnnb.for
There is 1 other file named getnnb.for in the archive. Click here to see a list.
C
C
C
C COPYRIGHT (c) 1977 BY
C DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS.
C
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
C ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
C OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
C TRANSFERRED.
C
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
C AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
C CORPORATION.
C
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
C
C
C
C
C
C
C
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C + +
C + CALC VERSION X01-01 +
C + +
C + PETER BAUM 1-SEP-77 +
C + DIGITAL EQUIPMENT CORPORATION +
C + 146 MAIN STREET +
C + MAYNARD, MASSACHUSETTS 01754 +
C + +
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C
C
C
C **************************************************
C * *
C * SUBROUTINE GETNNB(IPT,RETCD) *
C * *
C **************************************************
C
C
C GET NEXT NON-BLANK ELEMENT FROM LINE STARTING AT NONBLK+1
C
C RETCD = 1 O.K.
C 2 NO NON-BLANK FOUND
C
C IPT POINTS TO POSITION IN LINE WHERE NEXT NON-BLANK IS FOUND.
C IT IS UP TO CALLING PROGRAM TO RESET NONBLK FOR NEXT SCAN.
C
C
C
C
C
C
C
C GETNNB IS CALLED BY
C
C AT
C BASCNG
C CMND
C NEXTEL
C STRCMP
C
C
C MODIFICATION CLASSES: M2
C
C
C
C
C VARIABLE USE
C
C BLANK ' '
C IPT RETURNS POSITION OF NEXT NON-BLANK.
C K HOLDS TEMPORARY VALUES.
C LEND LAST NON-BLANK IN LINE(80).
C NONBLK HOLDS CHARACTER TO LEFT OF THE START OF THE SCAN.
C RETCD HOLDS THE RETURN CODE. 1=O.K. 2=THE REST IS BLANKS.
C
C
C
C
SUBROUTINE GETNNB(IPT,RETCD)
C
C
C
INTEGER*2 LEVEL,NONBLK,LEND
INTEGER*2 VIEWSW,BASED,BASE,RETCD
INTEGER*2 K
C
LOGICAL*1 LINE(80),ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ
C
COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
COMMON /CONS/ ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
C
RETCD=1
IF (NONBLK.GE.LEND) GOTO 999
C
C AT LEAST 1 NON-BLANK EXISTS.
K=NONBLK+1
DO 10 IPT=K,LEND
IF (LINE(IPT).NE.BLANK) GOTO 1000
10 CONTINUE
C
C
C ACTUALLY, SHOULD NEVER FALL THROUGH IF 'LEND' IS SET CORRECTLY.
C
C
C THE REST ARE BLANKS
999 RETCD=2
1000 RETURN
END