# 2.11BSD#431 - /usr/src/new/PORT/dungeon/np.F

       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: 668 |