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
|
Last modified: 1989-12-01
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 2013 |
|