File: newexec.com

package info (click to toggle)
pgplot5 5.2.2-19.3
  • links: PTS
  • area: non-free
  • in suites: buster, stretch
  • size: 7,136 kB
  • ctags: 6,763
  • sloc: fortran: 39,792; ansic: 22,549; objc: 1,534; sh: 1,298; makefile: 385; perl: 234; pascal: 233; tcl: 190; awk: 51; csh: 25
file content (134 lines) | stat: -rw-r--r-- 3,838 bytes parent folder | download | duplicates (15)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
$ ver='F$VERIFY(0)
$ SET NOON
$ ECHO = "WRITE SYS$OUTPUT"
$ ECHO "Creating device-dispatch routine GREXEC.F from DRIVERS.LIST"
$!
$! This command file deletes the existing GREXEC.F routine and
$! then creates a new version that includes calls to all device
$! handlers sepecified in file DRIVERS.LIST.
$!
$! modified 8/11/93 bht to check for existence of SYS$LIBRARY:UISSHR.EXE
$! and SYS$LIBRARY:DECW$XLIBSHR.EXE before including windowing drivers
$!
$	ON control_y THEN GOTO Ex
$! Delete any existing GREXEC.F routines (so as to not confuse things).
$	IF F$SEARCH("GREXEC.F;*") .NES. "" THEN -
$		DELETE/NOLOG/NOCONFIRM GREXEC.F;*
$!
$! Now scan the [.DRIVERS] directory for %%DRIVER.F routines and count
$! them.
$!
$	NDEV=0
$	NAMES = ""
$	UIS = F$SEARCH("SYS$LIBRARY:UISSHR.EXE") 
$	XLIB = F$SEARCH("SYS$LIBRARY:DECW$XLIBSHR.EXE")
$	open list DRIVERS.LIST /read
$
$ 40:	read list line /end=50
$       line = f$edit(line,"COMPRESS,TRIM,UNCOMMENT,UPCASE")
$	if line .eqs. "" then goto 40
$	name = f$element(0," ",line)
$! for WSDRIVER check that SYS$LIBRARY:UISSHR.EXE is online
$	IF F$EXTRACT(0,2,NAME) .eqs. "WS" .and. UIS .eqs. "" 
$	    THEN
$		ECHO "Rejecting WSDRIVER -- UIS is not installed"
$		GOTO 40
$           ENDIF
$! for XEDRIVER check that SYS$LIBRARY:DECW$XLIBSHR.EXE is online
$	IF F$EXTRACT(0,2,NAME) .eqs. "XE" .and. XLIB .eqs. ""
$	    THEN
$		ECHO "Rejecting XEDRIVER -- DECWindows is not installed"
$		GOTO 40
$           ENDIF 
$	IF F$EXTRACT(0,2,NAME) .eqs. "X2" .and. XLIB .eqs. ""
$	    THEN
$		ECHO "Rejecting X2DRIVER -- DECWindows is not installed"
$		GOTO 40
$           ENDIF 
$	NDEV = NDEV+1
$	DRIVER'NDEV' = F$EXTRACT(0,6,NAME)
$	CODE'NDEV' = F$ELEMENT(1," ",line)
$	NAMES = NAMES + "," + F$EXTRACT(0,2,DRIVER'ndev')
$	goto 40
$ 50:	close list
$!
$! Create the dispatch routine.  Open file and write header info.
$!
$ Make:
$	ECHO NDEV," device handlers found:"
$	NAMES = NAMES - "," + "."
$	ECHO NAMES
$	OPEN/WRITE TMP TMP.F
$	WRT = "WRITE TMP"
$ WRT "C*GREXEC -- PGPLOT device handler dispatch routine"
$ WRT "C+
$ WRT "      SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR)"
$ WRT "      INTEGER IDEV, IFUNC, NBUF, LCHR"
$ WRT "      REAL    RBUF(*)"
$ WRT "      CHARACTER*(*) CHR"
$ WRT "C"
$ WRT "C DO NOT MODIFY THIS ROUTINE."
$ WRT "C You should always create a new version by re-executing"
$ WRT "C the command file NEWEXEC.COM."
$ WRT "C---"
$ WRT "      INTEGER NDEV
$ WRT "      PARAMETER (NDEV=",NDEV,")"
$ WRT "      CHARACTER*10 MSG"
$ WRT "C---"
$!
$! Now construct the computed GOTO statement.
$!
$	ICNT=0
$	CBUF="      GOTO("
$ Cgoto:
$	ICNT=ICNT+1
$       IF ICNT .GT. NDEV THEN GOTO Done
$	CBUF=CBUF+"''ICNT'"
$	IF ICNT.NE.NDEV THEN CBUF=CBUF+","
$	IF F$LENGTH(CBUF).LT.60 THEN GOTO Cgoto
$	WRT CBUF
$	CBUF="     :   "
$	GOTO Cgoto
$!
$ Done:
$ WRT CBUF+") IDEV"
$ WRT "      IF (IDEV.EQ.0) THEN"
$ WRT "          RBUF(1) = NDEV"
$ WRT "          NBUF = 1"
$ WRT "      ELSE"
$ WRT "          WRITE (MSG,'(I10)') IDEV"
$ WRT "          CALL GRQUIT('Unknown device code in GREXEC: '//MSG)"
$ WRT "      END IF"
$ WRT "      RETURN"
$ WRT "C---"
$!
$! Now add lines that actually call the device handlers.
$!
$	ICNT=0
$ Mloop:
$	ICNT=ICNT+1
$       IF ICNT.GT.NDEV THEN GOTO Last
$       IF (CODE'ICNT' .GT. 0)
$       THEN
$ WRT f$fao("!5UL CALL !AS(IFUNC,RBUF,NBUF,CHR,LCHR,!AS)", ICNT, -
		DRIVER'ICNT', CODE'ICNT')
$       ELSE
$ WRT f$fao("!5UL CALL !AS(IFUNC,RBUF,NBUF,CHR,LCHR)", ICNT, -
                DRIVER'ICNT')
$       ENDIF
$ WRT "      RETURN"
$	GOTO Mloop
$!
$ Last:
$ WRT "C"
$ WRT "      END"
$	CLOSE TMP
$	RENAME TMP.F GREXEC.F
$	FILE = F$SEARCH("GREXEC.F")
$	ECHO FILE," created"
$	FORTRAN/WARN=ALL/STAND=ALL 'FILE'
$	LIBRARY/REPLACE GRPCKG.OLB GREXEC.OBJ
$	SET FILE/PROT=(O:RWED,S:RWED) GREXEC.OBJ;*
$	DELETE/NOCONFIRM GREXEC.OBJ;*
$ Ex:
$	IF ver THEN SET VERIFY