Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - 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