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: 679
Valid CSS Valid XHTML 1.0 Strict