Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/locate/locate.lis
There are 5 other files named locate.lis in the archive. Click here to see a list.
                               					22-Nov-1983 20:26:11	VAX-11 FORTRAN V3.3-45              Page   1
								18-Mar-1983 11:22:45	SYS$SYSDEVICE:[PETERSS.LOCATE]LOCATE.FOR;1  

0001    	PROGRAM locate
0002    C
0003    C	Change or display information regarding a user's default printer.
0004    C
0005    C	Created:	28-July-82 QCJ
0006    C	Last Modified:	25-Jan-83 QCJ
0007    C
0008    	INCLUDE	    'locdef.inc/list'
%FORT-W-INVSTALAB, Invalid statement label ignored 
 	in module LOCATE at line 9

0009  1 y
0010  1 C	LOCDEF.INC Include file.
0011  1 C
%FORT-F-INVLEFSID, Left side of assignment must be variable or array element 
 	in module LOCATE at line 9

0012  1 	PARAMETER   loc_max=4	    !number of locations defined
0013  1 	PARAMETER   token_max=5	    !number of valid tokens that may be
0014  1 				    ! used to specify this location.
0015  1 	PARAMETER   text_line_max=5 !number of text lines to describe loc.
0016  1  
0017  1 	IMPLICIT	INTEGER*4	(a-z)
0018  1 	CHARACTER*15	queue(0:loc_max-1)
0019  1 	CHARACTER*32	place(0:loc_max-1)
0020  1 	CHARACTER*8	tokens(0:loc_max-1,token_max)
0021  1 	CHARACTER*80	text(0:loc_max-1,text_line_max)
0022  1 	INTEGER*2	n_tokens(0:loc_max-1)
0023  1 	INTEGER*2	n_text_lines(0:loc_max-1)
0024  1 C
0025  1 C	Data base.
0026  1 C
0027  1 	PARAMETER   lpd0=0
0028  1 	PARAMETER   lpd0_S='0'
0029  1 	DATA	    queue(lpd0)		/'LPD0:'/
0030  1 	DATA	    place(lpd0)		/'425 CB (Computer Room)'/
0031  1 	DATA	    n_tokens(lpd0)      /5/
0032  1 	DATA	    (tokens(lpd0,i),i=1,5) /lpd0_s,'LPD0','LPD0:','B1000','FAST'/
0033  1 	DATA	    n_text_lines(lpd0)	/2/
0034  1 	DATA	    (text(lpd0,i),i=1,2)
0035  1 	1/'Data Products B1000 "Charaband" impact printer, 1000 lpm,'
0036  1 	1,'upper/lower case, no special forms.'/
0037  1  
0038  1 	PARAMETER   lpa0=1
0039  1 	PARAMETER   lpa0_S='1'
0040  1 	DATA	    queue(lpa0)		/'LPA0:'/
0041  1 	DATA	    place(lpa0)		/'425 CB (Computer Room)'/
0042  1 	DATA	    n_tokens(lpa0)      /5/
0043  1 	DATA	    (tokens(lpa0,i),i=1,5) /lpa0_s,'LPA0','LPA0:','425','CB'/
0044  1 	DATA	    n_text_lines(lpa0)	/2/
0045  1 	DATA	    (text(lpa0,i),i=1,2)
0046  1 	1/'Printronix P600 dot-matrix printer, 600 lines per minute,'
0047  1 	2,'upper/lower case, plotting, no special forms.'/
0048  1  
0049  1 	PARAMETER   lpb0=2
0050  1 	PARAMETER   lpb0_S='2'
0051  1 	DATA	    queue(lpb0)		/'LPB0:'/
LOCATE                         					22-Nov-1983 20:26:11	VAX-11 FORTRAN V3.3-45              Page   2
								18-Mar-1983 11:22:45	SYS$SYSDEVICE:[PETERSS.LOCATE]LOCATE.FOR;1  

0052  1 	DATA	    place(lpb0)		/'240 ESC'/
0053  1 	DATA	    n_tokens(lpb0)      /5/
0054  1 	DATA	    (tokens(lpb0,i),i=1,5)  /lpb0_s,'LPB0','LPB0:','240','ESC'/
0055  1 	DATA	    n_text_lines(lpb0)	/2/
0056  1 	DATA	    (text(lpb0,i),i=1,2)
0057  1 	1/'Printronix P600 dot-matrix printer, 600 lines per minute,'
0058  1 	2,'upper/lower case, plotting, no special forms.'/
0059  1  
0060  1 	PARAMETER   lpc0=3
0061  1 	PARAMETER   lpc0_S='3'
0062  1 	DATA	    queue(lpc0)		/'LPC0:'/
0063  1 	DATA	    place(lpc0)		/'861 SWKT'/
0064  1 	DATA	    n_tokens(lpc0)      /5/
0065  1 	DATA	    (tokens(lpc0,i),i=1,5)  /lpc0_s,'LPC0','LPC0:','861','SWKT'/
0066  1 	DATA	    n_text_lines(lpc0)	/2/
0067  1 	DATA	    (text(lpc0,i),i=1,2)
0068  1 	1/'Printronix P300 dot-matrix printer, 300 lines per minute,'
0069  1 	2,'upper/lower case, plotting, no special forms.'/
0070  1  
0071  1 	COMMON /loc/	queue
0072  1 	1               ,place
0073  1 	1               ,tokens
0074  1 	2               ,text
0075  1 	3               ,n_tokens
0076  1 	4               ,n_text_lines
0077  1 C
0078  1 C	END of LOCDEF.INC.
0079  1 C
0080     
0081    	CHARACTER*80	arg,device
0082    C
0083    C	Get the argument the user passed.
0084    C
0085    	istat=CLI$GET_VALUE('ARG',arg)
0086    C	IF(.NOT.istat)CALL LIB$STOP(%VAL(istat))
0087    	f_fast=CLI$PRESENT('BRIEF')
0088    	f_log=CLI$PRESENT('LOG')
0089    C
0090    C	Determine action.
0091    C
0092    	IF(arg.EQ.' ')THEN
0093    	    istat=SYS$TRNLOG('SYS$PRINT',device_l,device,,,)
0094    	    IF(.NOT.istat)CALL LIB$STOP(%VAL(istat))
0095    	    IF(f_log)THEN
0096    		TYPE*,'Your default printer location is currently:'
0097    	        TYPE*
0098    	    ENDIF
0099    	    loc=find_loc(device(1:device_l))
0100    	    IF(loc.NE.-1)THEN
0101    		CALL show_loc(loc,f_fast)
0102    	    ELSE
0103    		IF(f_log)THEN
0104    		    TYPE*
0105    		    TYPE*,'	'//device
0106    		    TYPE*
0107    		    TYPE*,'Which is not a valid location'
0108    		ELSE
LOCATE                         					22-Nov-1983 20:26:11	VAX-11 FORTRAN V3.3-45              Page   3
								18-Mar-1983 11:22:45	SYS$SYSDEVICE:[PETERSS.LOCATE]LOCATE.FOR;1  

0109    		    TYPE*,'Current location invalid '//device
0110    		ENDIF
0111    	    ENDIF
0112    	    IF(f_log)THEN
0113    	        TYPE*
0114                    TYPE*,'Valid locations are:'
0115    	        TYPE*
0116    	        DO loc=0,loc_max-1
0117    	            CALL show_loc(loc,f_fast)
0118    	        ENDDO
0119    	    ENDIF
0120    	ELSE
0121    	    loc=find_loc(arg)
0122    	    IF(loc.NE.-1)THEN
0123    	        IF(f_log)THEN
0124    	            TYPE*,'Your default printer is now:'
0125    		    TYPE*
0126    		    CALL show_loc(loc,f_fast)
0127    		ENDIF
0128    		istat=LIB$SET_LOGICAL
0129    	1	    ('SYS$PRINT',queue(loc)(1:QCJ_TRIM(queue(loc))))
0130    	    ELSE
0131    	        IF(f_log)THEN
0132    		    TYPE*
0133    		    TYPE*,'    '//arg(1:QCJ_TRIM(arg))//' is not a valid location'
0134    		    TYPE*
0135    	            TYPE*,'Valid locations are:'
0136    		    TYPE*
0137    	            DO loc=0,loc_max-1
0138    	                CALL show_loc(loc,f_fast)
0139    	            ENDDO
0140    		ELSE
0141    		    TYPE*,arg(1:QCJ_TRIM(arg))//' is not valid'
0142    		ENDIF
0143    	    ENDIF
0144    	ENDIF
0145     
0146    	END
                               					22-Nov-1983 20:26:11	VAX-11 FORTRAN V3.3-45              Page   4
								18-Mar-1983 11:22:45	SYS$SYSDEVICE:[PETERSS.LOCATE]LOCATE.FOR;1  

0001     
0002    	INTEGER*4 FUNCTION show
0003     
0004    	INCLUDE	    'locdef.inc'
0076     
0077    	CHARACTER*(*)	token
0078     
0079    	ENTRY find_loc(token)
0080     
0081    	    l=0
0082    	    found=.FALSE.
0083    	    DO WHILE (l.LE.loc_max-1.AND..NOT.found)
0084    		tok=1
0085    		DO WHILE (tok.LE.n_tokens(l).AND..NOT.found)
0086    		    found=token.EQ.tokens(l,tok)
0087    		    tok=tok+1
0088    		ENDDO
0089    		l=l+1
0090    	    ENDDO
0091    	    IF(.NOT.found)THEN
0092    		find_loc=-1
0093    	    ELSE
0094    		find_loc=l-1
0095    	    ENDIF
0096     
0097    	RETURN
0098     
0099    	ENTRY show_loc(loc,f_fast)
0100    	    TYPE00102
0101    	1	,loc
0102    	2       ,queue(loc)(1:QCJ_TRIM(queue(loc)))
0103    	3	,place(loc)(1:QCJ_TRIM(place(loc)))
0104    00102	    FORMAT(
0105    	2       X'    Location 'I2' -- Line Printer 'A' -- 'A
0106    	5       )
0107    	    IF(.NOT.f_fast)THEN
0108    	        TYPE00101
0109    	2           ,(text(loc,line)
0110    	3           (1:QCJ_TRIM(text(loc,line))),line=1,n_text_lines(loc))
0111    00101	        FORMAT(
0112    	4           <n_text_lines(loc)>(/X,8X,A)
0113    	1           ,/
0114    	5           )
0115    	    ENDIF
0116     
0117    	RETURN
0118     
0119    	END
SHOW                           					22-Nov-1983 20:26:11	VAX-11 FORTRAN V3.3-45              Page   5
								18-Mar-1983 11:22:45	SYS$SYSDEVICE:[PETERSS.LOCATE]LOCATE.FOR;1  

COMMAND QUALIFIERS

  FORTRAN /LIST LOCATE

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /STANDARD=(NOSYNTAX,NOSOURCE_FORM)
  /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP)
  /F77  /NOG_FLOATING  /I4  /OPTIMIZE  /WARNINGS  /NOD_LINES  /NOCROSS_REFERENCE  /NOMACHINE_CODE  /CONTINUATIONS=19


COMPILATION STATISTICS

  Run Time:           2.31 seconds
  Elapsed Time:       17.85 seconds
  Page Faults:        163
  Dynamic Memory:     142 pages