![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to np.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to np.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.