![[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.