Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0001/at.for
There is 1 other file named at.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 * SUBROUTINE AT *
C * *
C *******************************************************
C
C
C SUBROUTINE AT IS CALLED WHEN THE *@ CALC COMMAND IS ENCOUNTERED.
C IT CHANGES THE VALUE OF LEVEL WHICH HOLDS THE NUMBER OF THE
C LOGICAL I/O UNIT WHERE INPUT COMMAND LINES ARE TO BE OBTAINED.
C THE FILE ASSOCIATED WITH THAT I/O UNIT IS OPENED UNDER THE PROPER
C CONDITIONS.
C
C
C
C
C MODIFICATION CLASSES: M1,M2,M9
C
C LAST MODIFIED 3-OCT-77 P.B.
C
C
C
C
C
C AT CALLS
C
C ASSIGN (TO ASSOCIATE A FILE NAME WITH A LOGICAL I/O UNIT)
C ERRMSG (TO PRINT ERROR MESSAGES)
C GETNNB (TO GET NEXT NON-BLANK FROM THE INPUT LINE)
C ZNEG (TO TEST IF A VARIABLE IS POSITIVE)
C
C
C
C AT IS CALLED BY ROUTINE CMND WHICH IS THE MODULE THAT DETERMINES
C WHAT CALC COMMAND WAS REQUESTED.
C
C
C
C VARIABLE USE
C
C ALPHA(27) HOLDS LEGAL VARIABLE NAMES.
C I,J HOLD TEMPORARY VALUES.
C IPT POINTS TO NEXT NON-BLANK CHARACTER IN LINE(80).
C ITCNTV(6) INDEXED BY LEVEL. HOLDS 0 IF NO ITERATION ON THAT
C LEVEL, OTHERWISE INDEX INTO VBLS FOR THE VARIABLE
C THAT CONTROLS ITERATION.
C LEVEL HOLDS NUMBER OF LOGICAL I/O UNIT WHERE NEXT INPUT
C LINE IS EXPECTED.
C LINE(80) HOLDS COMMAND INPUT LINE.
C NBLINE(78) HOLDS THE INPUT FILE NAME WITHOUT BLANKS.
C NONBLK POINTS TO THE LAST NON-BLANK CHARACTER IN LINE(80).
C RETCD RETURN CODE: 1=O.K. 2=ERROR.
C
C
C
C
C
SUBROUTINE AT (RETCD)
C
INTEGER*2 IPT,J,I
INTEGER*2 LEVEL,NONBLK,LEND
INTEGER*2 RETCD,VIEWSW,BASED
INTEGER*2 ITCNTV(6),ZNEG
C
LOGICAL*1 LINE(80),NBLINE(78)
LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ
C
COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
COMMON /CONS/ ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
COMMON/ITERA/ITCNTV
C
C
C UPON ENTRANCE, NONBLK POINTS TO THE CHARACTER @
C
C MODIFICATION CLASSES: M1,M2,M9
C
C PICK UP FIRST NON-BLANK AFTER THE @
CALL GETNNB(IPT,RETCD)
GO TO (10,1050),RETCD
STOP 10
C
C
C START BUILDING FILE NAME AS A COMPRESSED VERSION (BLANKS REMOVED)
C OF THE REST OF LINE(80)
10 J=0
15 NONBLK=IPT
J=J+1
NBLINE(J)=LINE(NONBLK)
CALL GETNNB(IPT,RETCD)
GO TO (15,50),RETCD
STOP 50
C
C
C SET RETURN CODE AND INDICATE THAT WE WILL BE AT A NEW LEVEL.
C J HOLDS THE COUNT OF THE NUMBER OF CHARACTERS IN NBLINE.
C IF J=1 THEN NO ITERATION IS POSSIBLE BECAUSE FILENAME IS THE
C SINGLE CHARACTER.
50 RETCD=1
LEVEL=LEVEL+1
IF (LEVEL.GT.6) GOTO 1000
IF(J.EQ.1)GO TO 200
C
C
C NBLINE HOLDS THE COMPRESSED FILENAME. NOW WE CHECK TO SEE IF AN
C ITERATION VARIABLE WAS SPECIFIED. THIS IS INDICATED BY A LEGAL
C VARIABLE NAME PRECEEDED BY A BLANK (IN LINE(80))
DO 60 I=1,27
IF(ALPHA(I).EQ.LINE(NONBLK))GO TO 100
60 CONTINUE
GO TO 200
100 IF(LINE(NONBLK-1).NE.BLANK)GO TO 200
C
C
C ITERATION INDICATOR IS PRESENT
C (ALPHABETIC CHARACTER OR % PRECEEDED BY A BLANK)
C IF THE VALUE OF THE VARIABLE IS NOT POSITIVE, THE FILE IS IGNORED.
IF(ZNEG(I).EQ.1)GO TO 150
C
C
C RETAIN INDEX INTO VBLS AND DECREASE J SO THAT THE FILENAME
C DOES NOT INCLUDE THE ITERATION SPECIFICATION.
ITCNTV(LEVEL)=I
J=J-1
GO TO 300
C
C
C FILE NOT ENTERED, ITERATION VARIABLE IS ZERO, NEGATIVE, OR UNDEFINED
150 LEVEL=LEVEL-1
GO TO 350
C
C
C IF NO ITERATION, SET ITCNTV TO ZERO BECAUSE NOT ZEROED BY EXIT
C ROUTINES
200 ITCNTV(LEVEL)=0
300 CALL ASSIGN (LEVEL,NBLINE,J)
350 RETURN
C
C
C
C *** ERROR PROCESSING ***
C
C TOO MANY LEVELS
1000 I=2
1010 CALL ERRMSG(I)
1020 RETCD=2
RETURN
C
C
C UNIDENTIFIED COMMAND (ARGUMENT)
1050 I=3
GO TO 1010
END