Commit | Line | Data |
---|---|---|
8b22683c KB |
1 | C RDLINE- READ INPUT LINE |
2 | C | |
3 | C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 | |
4 | C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED | |
5 | C WRITTEN BY R. M. SUPNIK | |
6 | C | |
7 | C DECLARATIONS | |
8 | C | |
9 | SUBROUTINE RDLINE(BUFFER,LENGTH,WHO) | |
10 | IMPLICIT INTEGER(A-Z) | |
11 | CHARACTER BUFFER(78) | |
12 | #ifndef PDP | |
13 | character*78 sysbuf | |
14 | #endif | |
15 | #include "parser.h" | |
16 | #include "io.h" | |
17 | ||
18 | #ifdef PDP | |
19 | 5 if (WHO .eq. 1) call prompt | |
20 | C read a line of input | |
21 | 90 call rdlin(BUFFER,LENGTH) | |
22 | #else | |
23 | 5 GO TO (90,10),WHO+1 | |
24 | C !SEE WHO TO PROMPT FOR. | |
25 | 10 WRITE(OUTCH,50) | |
26 | C !PROMPT FOR GAME. | |
27 | #ifdef NOCC | |
28 | 50 FORMAT('>',$) | |
29 | #else NOCC | |
30 | 50 FORMAT(' >',$) | |
31 | #endif NOCC | |
32 | ||
33 | 90 READ(INPCH,100, END=210) BUFFER | |
34 | 100 FORMAT(78A1) | |
35 | ||
36 | DO 200 LENGTH=78,1,-1 | |
37 | IF(BUFFER(LENGTH).NE.' ') GO TO 250 | |
38 | 200 CONTINUE | |
39 | GO TO 5 | |
40 | C !END OF FILE | |
41 | 210 STOP | |
42 | C !TRY AGAIN. | |
43 | ||
44 | C | |
45 | C check for shell escape here before things are | |
46 | C converted to upper case | |
47 | C | |
48 | 250 if (buffer(1) .ne. '!') go to 300 | |
49 | do 275 j=2,length | |
50 | sysbuf(j-1:j-1) = buffer(j) | |
51 | 275 continue | |
52 | sysbuf(length:length) = char(0) | |
53 | call system(sysbuf) | |
54 | go to 5 | |
55 | ||
56 | C CONVERT TO UPPER CASE | |
57 | 300 DO 400 I=1,LENGTH | |
58 | IF(and((BUFFER(I).GE.'a'),(BUFFER(I).LE.'z'))) | |
59 | & BUFFER(I)=char(ichar(BUFFER(I))-32) | |
60 | 400 CONTINUE | |
61 | #endif PDP | |
62 | ||
63 | if(LENGTH.EQ.0) GO TO 5 | |
64 | PRSCON=1 | |
65 | C !RESTART LEX SCAN. | |
66 | RETURN | |
67 | END | |
68 | C PARSE- TOP LEVEL PARSE ROUTINE | |
69 | C | |
70 | C DECLARATIONS | |
71 | C | |
72 | C THIS ROUTINE DETAILS ON BIT 0 OF PRSFLG | |
73 | C | |
74 | LOGICAL FUNCTION PARSE(INBUF,INLNT,VBFLAG) | |
75 | IMPLICIT INTEGER(A-Z) | |
76 | CHARACTER INBUF(78) | |
77 | LOGICAL LEX,SYNMCH,VBFLAG | |
78 | INTEGER OUTBUF(40) | |
79 | #include "debug.h" | |
80 | #include "parser.h" | |
81 | #include "xsrch.h" | |
82 | C | |
83 | #ifdef debug | |
84 | DFLAG=and(PRSFLG,1).NE.0 | |
85 | #endif | |
86 | PARSE=.FALSE. | |
87 | C !ASSUME FAILS. | |
88 | PRSA=0 | |
89 | C !ZERO OUTPUTS. | |
90 | PRSI=0 | |
91 | PRSO=0 | |
92 | C | |
93 | #ifdef PDP | |
94 | C LEX recoded in C for pdp version (see lex.c) | |
95 | if(.not. lex(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG,PRSCON)) goto 100 | |
96 | #else | |
97 | IF(.NOT.LEX(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG)) GO TO 100 | |
98 | #endif | |
99 | IF(SPARSE(OUTBUF,OUTLNT,VBFLAG)) 100,200,300 | |
100 | C !DO SYN SCAN. | |
101 | C | |
102 | C PARSE REQUIRES VALIDATION | |
103 | C | |
104 | 200 IF(.NOT.VBFLAG) GO TO 350 | |
105 | C !ECHO MODE, FORCE FAIL. | |
106 | IF(.NOT.SYNMCH(X)) GO TO 100 | |
107 | C !DO SYN MATCH. | |
108 | IF(and((PRSO.GT.0),(PRSO.LT.XMIN))) LASTIT=PRSO | |
109 | C | |
110 | C SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION | |
111 | C | |
112 | 300 PARSE=.TRUE. | |
113 | 350 CALL ORPHAN(0,0,0,0,0) | |
114 | C !CLEAR ORPHANS. | |
115 | #ifdef debug | |
116 | if(dflag) write(0,*) "parse good" | |
117 | IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI | |
118 | #ifdef NOCC | |
119 | 10 FORMAT('PARSE RESULTS- ',L7,3I7) | |
120 | #else NOCC | |
121 | 10 FORMAT(' PARSE RESULTS- ',L7,3I7) | |
122 | #endif NOCC | |
123 | #endif | |
124 | RETURN | |
125 | C | |
126 | C PARSE FAILS, DISALLOW CONTINUATION | |
127 | C | |
128 | 100 PRSCON=1 | |
129 | #ifdef debug | |
130 | if(dflag) write(0,*) "parse failed" | |
131 | IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI | |
132 | #endif | |
133 | RETURN | |
134 | C | |
135 | END | |
136 | C ORPHAN- SET UP NEW ORPHANS | |
137 | C | |
138 | C DECLARATIONS | |
139 | C | |
140 | SUBROUTINE ORPHAN(O1,O2,O3,O4,O5) | |
141 | IMPLICIT INTEGER(A-Z) | |
142 | COMMON /ORPHS/ A,B,C,D,E | |
143 | C | |
144 | A=O1 | |
145 | C !SET UP NEW ORPHANS. | |
146 | B=O2 | |
147 | C=O3 | |
148 | D=O4 | |
149 | E=O5 | |
150 | RETURN | |
151 | END | |
152 | #ifndef PDP | |
153 | C LEX- LEXICAL ANALYZER | |
154 | C | |
155 | C | |
156 | C THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG | |
157 | C | |
158 | LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP,VBFLAG) | |
159 | IMPLICIT INTEGER(A-Z) | |
160 | CHARACTER INBUF(78),J,DLIMIT(9) | |
161 | INTEGER OUTBUF(40),ZLIMIT(9) | |
162 | LOGICAL VBFLAG | |
163 | #include "parser.h" | |
164 | C | |
165 | #include "debug.h" | |
166 | C | |
167 | c the System V compiler doesn't like octal initialization of character | |
168 | c arrays, so the following is done for its benefit | |
169 | c | |
170 | c DATA DLIMIT/'A','Z',o'100','1','9',o'22','-','-',o'22'/ | |
171 | c | |
172 | DATA ZLIMIT/o'101',o'132',o'100',o'61',o'71',o'22',o'55',o'55',o'22'/ | |
173 | c | |
174 | do 99 i=1,9 | |
175 | dlimit(i) = char(zlimit(i)) | |
176 | c ! copy integers to chars | |
177 | 99 continue | |
178 | C | |
179 | DO 100 I=1,40 | |
180 | C !CLEAR OUTPUT BUF. | |
181 | OUTBUF(I)=0 | |
182 | 100 CONTINUE | |
183 | C | |
184 | #ifdef debug | |
185 | DFLAG=and(PRSFLG,2).NE.0 | |
186 | #endif debug | |
187 | LEX=.FALSE. | |
188 | C !ASSUME LEX FAILS. | |
189 | OP=-1 | |
190 | C !OUTPUT PTR. | |
191 | 50 OP=OP+2 | |
192 | C !ADV OUTPUT PTR. | |
193 | CP=0 | |
194 | C !CHAR PTR=0. | |
195 | C | |
196 | 200 IF(PRSCON.GT.INLNT) GO TO 1000 | |
197 | C !END OF INPUT? | |
198 | J=INBUF(PRSCON) | |
199 | C !NO, GET CHARACTER, | |
200 | PRSCON=PRSCON+1 | |
201 | C !ADVANCE PTR. | |
202 | IF(J.EQ.'.') GO TO 1000 | |
203 | C !END OF COMMAND? | |
204 | IF(J.EQ.',') GO TO 1000 | |
205 | C !END OF COMMAND? | |
206 | IF(J.EQ.' ') GO TO 6000 | |
207 | C !SPACE? | |
208 | DO 500 I=1,9,3 | |
209 | C !SCH FOR CHAR. | |
210 | IF(and((J.GE.DLIMIT(I)),(J.LE.DLIMIT(I+1)))) | |
211 | & GO TO 4000 | |
212 | 500 CONTINUE | |
213 | C | |
214 | IF(VBFLAG) CALL RSPEAK(601) | |
215 | C !GREEK TO ME, FAIL. | |
216 | RETURN | |
217 | C | |
218 | C END OF INPUT, SEE IF PARTIAL WORD AVAILABLE. | |
219 | C | |
220 | 1000 IF(PRSCON.GT.INLNT) PRSCON=1 | |
221 | C !FORCE PARSE RESTART. | |
222 | IF(and((CP.EQ.0),(OP.EQ.1))) RETURN | |
223 | IF(CP.EQ.0) OP=OP-2 | |
224 | C !ANY LAST WORD? | |
225 | LEX=.TRUE. | |
226 | #ifdef debug | |
227 | IF(DFLAG) PRINT 10,CP,OP,PRSCON,(OUTBUF(I),I=1,OP+1) | |
228 | #ifdef NOCC | |
229 | 10 FORMAT('LEX RESULTS- ',3I7/1X,10O7) | |
230 | #else NOCC | |
231 | 10 FORMAT(' LEX RESULTS- ',3I7/1X,10O7) | |
232 | #endif NOCC | |
233 | #endif debug | |
234 | RETURN | |
235 | C | |
236 | C LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN. | |
237 | C | |
238 | 4000 J1=ichar(J)-ichar(DLIMIT(I+2)) | |
239 | #ifdef debug | |
240 | IF(DFLAG) PRINT 20,J,J1,CP | |
241 | #ifdef NOCC | |
242 | 20 FORMAT('LEX- CHAR= ',3I7) | |
243 | #else NOCC | |
244 | 20 FORMAT(' LEX- CHAR= ',3I7) | |
245 | #endif NOCC | |
246 | #endif debug | |
247 | IF(CP.GE.6) GO TO 200 | |
248 | C !IGNORE IF TOO MANY CHAR. | |
249 | K=OP+(CP/3) | |
250 | C !COMPUTE WORD INDEX. | |
251 | GO TO (4100,4200,4300),(MOD(CP,3)+1) | |
252 | C !BRANCH ON CHAR. | |
253 | 4100 J2=J1*780 | |
254 | C !CHAR 1... *780 | |
255 | OUTBUF(K)=OUTBUF(K)+J2+J2 | |
256 | C !*1560 (40 ADDED BELOW). | |
257 | 4200 OUTBUF(K)=OUTBUF(K)+(J1*39) | |
258 | C !*39 (1 ADDED BELOW). | |
259 | 4300 OUTBUF(K)=OUTBUF(K)+J1 | |
260 | C !*1. | |
261 | CP=CP+1 | |
262 | GO TO 200 | |
263 | C !GET NEXT CHAR. | |
264 | C | |
265 | C SPACE | |
266 | C | |
267 | 6000 IF(CP.EQ.0) GO TO 200 | |
268 | C !ANY WORD YET? | |
269 | GO TO 50 | |
270 | C !YES, ADV OP. | |
271 | C | |
272 | END | |
273 | #endif PDP |