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