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