reorganization to move ufsmount ops to be vnode ops; blkatoff

[unix-history] / usr / src / contrib / dungeon / np.F

C RDLINE-	READ INPUT LINE
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
	SUBROUTINE RDLINE(BUFFER,LENGTH,WHO)
	IMPLICIT INTEGER(A-Z)
	CHARACTER BUFFER(78)
#ifndef PDP
	character*78 sysbuf
#endif
#include "parser.h"
#include "io.h"

#ifdef PDP
5	if (WHO .eq. 1) call prompt
C	read a line of input
90	call rdlin(BUFFER,LENGTH)
#else
5	GO TO (90,10),WHO+1
C						!SEE WHO TO PROMPT FOR.
10	WRITE(OUTCH,50)
C						!PROMPT FOR GAME.
#ifdef NOCC
50	FORMAT('>',$)
#else NOCC
50	FORMAT(' >',$)
#endif NOCC

90	READ(INPCH,100, END=210) BUFFER
100	FORMAT(78A1)

	DO 200 LENGTH=78,1,-1
	  IF(BUFFER(LENGTH).NE.' ') GO TO 250
200	CONTINUE
	GO TO 5
C						!END OF FILE
210	STOP
C						!TRY AGAIN.

C
C	check for shell escape here before things are
C	converted to upper case
C
250	if (buffer(1) .ne. '!') go to 300
	do 275 j=2,length
	  sysbuf(j-1:j-1) = buffer(j)
275	continue
	sysbuf(length:length) = char(0)
	call system(sysbuf)
	go to 5

C CONVERT TO UPPER CASE
300	DO 400 I=1,LENGTH
 	  IF(and((BUFFER(I).GE.'a'),(BUFFER(I).LE.'z')))
&		BUFFER(I)=char(ichar(BUFFER(I))-32)
400	CONTINUE
#endif PDP

	if(LENGTH.EQ.0) GO TO 5
	PRSCON=1
C						!RESTART LEX SCAN.
	RETURN
	END
C PARSE-	TOP LEVEL PARSE ROUTINE
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 0 OF PRSFLG
C
	LOGICAL FUNCTION PARSE(INBUF,INLNT,VBFLAG)
	IMPLICIT INTEGER(A-Z)
	CHARACTER INBUF(78)
	LOGICAL LEX,SYNMCH,VBFLAG
	INTEGER OUTBUF(40)
#include "debug.h"
#include "parser.h"
#include "xsrch.h"
C
#ifdef debug
	DFLAG=and(PRSFLG,1).NE.0
#endif
	PARSE=.FALSE.
C						!ASSUME FAILS.
	PRSA=0
C						!ZERO OUTPUTS.
	PRSI=0
	PRSO=0
C
#ifdef PDP
C	LEX recoded in C for pdp version (see lex.c)
	if(.not. lex(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG,PRSCON)) goto 100
#else
	IF(.NOT.LEX(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG)) GO TO 100
#endif
	IF(SPARSE(OUTBUF,OUTLNT,VBFLAG)) 100,200,300
C						!DO SYN SCAN.
C
C PARSE REQUIRES VALIDATION
C
200	IF(.NOT.VBFLAG) GO TO 350
C						!ECHO MODE, FORCE FAIL.
	IF(.NOT.SYNMCH(X)) GO TO 100
C						!DO SYN MATCH.
	IF(and((PRSO.GT.0),(PRSO.LT.XMIN))) LASTIT=PRSO
C
C SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION
C
300	PARSE=.TRUE.
350	CALL ORPHAN(0,0,0,0,0)
C						!CLEAR ORPHANS.
#ifdef debug
	if(dflag) write(0,*) "parse good"
	IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI
#ifdef NOCC
10	FORMAT('PARSE RESULTS- ',L7,3I7)
#else NOCC
10	FORMAT(' PARSE RESULTS- ',L7,3I7)
#endif NOCC
#endif
	RETURN
C
C PARSE FAILS, DISALLOW CONTINUATION
C
100	PRSCON=1
#ifdef debug
	if(dflag) write(0,*) "parse failed"
	IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI
#endif
	RETURN
C
	END
C ORPHAN- SET UP NEW ORPHANS
C
C DECLARATIONS
C
	SUBROUTINE ORPHAN(O1,O2,O3,O4,O5)
	IMPLICIT INTEGER(A-Z)
	COMMON /ORPHS/ A,B,C,D,E
C
	A=O1
C						!SET UP NEW ORPHANS.
	B=O2
	C=O3
	D=O4
	E=O5
	RETURN
	END
#ifndef PDP
C LEX-	LEXICAL ANALYZER
C
C
C THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG
C
	LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP,VBFLAG)
	IMPLICIT INTEGER(A-Z)
	CHARACTER INBUF(78),J,DLIMIT(9)
	INTEGER OUTBUF(40),ZLIMIT(9)
	LOGICAL VBFLAG
#include "parser.h"
C
#include "debug.h"
C
c the System V compiler doesn't like octal initialization of character
c arrays, so the following is done for its benefit
c
c	DATA DLIMIT/'A','Z',o'100','1','9',o'22','-','-',o'22'/
c
	DATA ZLIMIT/o'101',o'132',o'100',o'61',o'71',o'22',o'55',o'55',o'22'/
c
	do 99 i=1,9
	  dlimit(i) = char(zlimit(i))
c					! copy integers to chars
99	continue
C
	DO 100 I=1,40
C						!CLEAR OUTPUT BUF.
	  OUTBUF(I)=0
100	CONTINUE
C
#ifdef debug
	DFLAG=and(PRSFLG,2).NE.0
#endif debug
	LEX=.FALSE.
C						!ASSUME LEX FAILS.
	OP=-1
C						!OUTPUT PTR.
50	OP=OP+2
C						!ADV OUTPUT PTR.
	CP=0
C						!CHAR PTR=0.
C
200	IF(PRSCON.GT.INLNT) GO TO 1000
C						!END OF INPUT?
	J=INBUF(PRSCON)
C						!NO, GET CHARACTER,
	PRSCON=PRSCON+1
C						!ADVANCE PTR.
	IF(J.EQ.'.') GO TO 1000
C						!END OF COMMAND?
	IF(J.EQ.',') GO TO 1000
C						!END OF COMMAND?
	IF(J.EQ.' ') GO TO 6000
C						!SPACE?
	DO 500 I=1,9,3
C						!SCH FOR CHAR.
	  IF(and((J.GE.DLIMIT(I)),(J.LE.DLIMIT(I+1))))
&		GO TO 4000
500	CONTINUE
C
	IF(VBFLAG) CALL RSPEAK(601)
C						!GREEK TO ME, FAIL.
	RETURN
C
C END OF INPUT, SEE IF PARTIAL WORD AVAILABLE.
C
1000	IF(PRSCON.GT.INLNT) PRSCON=1
C						!FORCE PARSE RESTART.
	IF(and((CP.EQ.0),(OP.EQ.1))) RETURN
	IF(CP.EQ.0) OP=OP-2
C						!ANY LAST WORD?
	LEX=.TRUE.
#ifdef debug
	IF(DFLAG) PRINT 10,CP,OP,PRSCON,(OUTBUF(I),I=1,OP+1)
#ifdef NOCC
10	FORMAT('LEX RESULTS- ',3I7/1X,10O7)
#else NOCC
10	FORMAT(' LEX RESULTS- ',3I7/1X,10O7)
#endif NOCC
#endif debug
	RETURN
C
C LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN.
C
4000	J1=ichar(J)-ichar(DLIMIT(I+2))
#ifdef debug
	IF(DFLAG) PRINT 20,J,J1,CP
#ifdef NOCC
20	FORMAT('LEX- CHAR= ',3I7)
#else NOCC
20	FORMAT(' LEX- CHAR= ',3I7)
#endif NOCC
#endif debug
	IF(CP.GE.6) GO TO 200
C						!IGNORE IF TOO MANY CHAR.
	K=OP+(CP/3)
C						!COMPUTE WORD INDEX.
	GO TO (4100,4200,4300),(MOD(CP,3)+1)
C						!BRANCH ON CHAR.
4100	J2=J1*780
C						!CHAR 1... *780
	OUTBUF(K)=OUTBUF(K)+J2+J2
C						!*1560 (40 ADDED BELOW).
4200	OUTBUF(K)=OUTBUF(K)+(J1*39)
C						!*39 (1 ADDED BELOW).
4300	OUTBUF(K)=OUTBUF(K)+J1
C						!*1.
	CP=CP+1
	GO TO 200
C						!GET NEXT CHAR.
C
C SPACE
C
6000	IF(CP.EQ.0) GO TO 200
C						!ANY WORD YET?
	GO TO 50
C						!YES, ADV OP.
C
	END
#endif PDP