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(INBUF,INLNT,WHO) IMPLICIT INTEGER(A-Z) LOGICAL*1 INBUF(78) C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C COMMON /CHAN/ INPCH,OUTCH,DBCH C 5 GO TO (90,10),WHO+1 !SEE WHO TO PROMPT FOR. 10 WRITE(OUTCH,50) !PROMPT FOR GAME. 50 FORMAT(' >',$) C 90 READ(INPCH,100) INBUF !GET INPUT. 100 FORMAT(78A1) C DO 200 INLNT=78,1,-1 IF(INBUF(INLNT).NE.' ') GO TO 300 !NOT BLANK? 200 CONTINUE GO TO 5 !TRY AGAIN. C 300 DO 400 I=1,INLNT !CONVERT TO UPPER CASE. IF((INBUF(I).GE.'a').AND.(INBUF(I).LE.'z')) 1 INBUF(I)=INBUF(I)-"40 400 CONTINUE PRSCON=1 !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) LOGICAL*1 INBUF(78) LOGICAL LEX,SYNMCH,DFLAG,VBFLAG INTEGER OUTBUF(40) COMMON /DEBUG/ DBGFLG,PRSFLG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON COMMON /LAST/ LASTIT COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP, 1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST C D DFLAG=(PRSFLG.AND."1).NE.0 PARSE=.FALSE. !ASSUME FAILS. PRSA=0 !ZERO OUTPUTS. PRSI=0 PRSO=0 C IF(.NOT.LEX(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG)) GO TO 100 IF(SPARSE(OUTBUF,OUTLNT,VBFLAG)) 100,200,300 !DO SYN SCAN. C C PARSE REQUIRES VALIDATION C 200 IF(.NOT.VBFLAG) GO TO 350 !ECHO MODE, FORCE FAIL. IF(.NOT.SYNMCH(X)) GO TO 100 !DO SYN MATCH. IF((PRSO.GT.0).AND.(PRSO.LT.XMIN)) LASTIT=PRSO C C SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION C 300 PARSE=.TRUE. 350 CALL ORPHAN(0,0,0,0,0) !CLEAR ORPHANS. D IF(DFLAG) TYPE 10,PARSE,PRSA,PRSO,PRSI D10 FORMAT(' PARSE RESULTS- ',L7,3I7) RETURN C C PARSE FAILS, DISALLOW CONTINUATION C 100 PRSCON=1 D IF(DFLAG) TYPE 10,PARSE,PRSA,PRSO,PRSI 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 !SET UP NEW ORPHANS. B=O2 C=O3 D=O4 E=O5 RETURN END C LEX- LEXICAL ANALYZER C C DECLARATIONS C C THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG C LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP,VBFLAG) IMPLICIT INTEGER(A-Z) LOGICAL*1 INBUF(78),J,DLIMIT(9) INTEGER OUTBUF(40) LOGICAL DFLAG,VBFLAG C C PARSER OUTPUT C LOGICAL PRSWON COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON C COMMON /DEBUG/ DBGFLG,PRSFLG C DATA DLIMIT/'A','Z',"100,'1','9',"22,'-','-',"22/ C DO 100 I=1,40 !CLEAR OUTPUT BUF. OUTBUF(I)=0 100 CONTINUE C D DFLAG=(PRSFLG.AND."2).NE.0 LEX=.FALSE. !ASSUME LEX FAILS. OP=-1 !OUTPUT PTR. 50 OP=OP+2 !ADV OUTPUT PTR. CP=0 !CHAR PTR=0. C 200 IF(PRSCON.GT.INLNT) GO TO 1000 !END OF INPUT? J=INBUF(PRSCON) !NO, GET CHARACTER, PRSCON=PRSCON+1 !ADVANCE PTR. IF(J.EQ.'.') GO TO 1000 !END OF COMMAND? IF(J.EQ.',') GO TO 1000 !END OF COMMAND? IF(J.EQ.' ') GO TO 6000 !SPACE? DO 500 I=1,9,3 !SCH FOR CHAR. IF((J.GE.DLIMIT(I)).AND.(J.LE.DLIMIT(I+1))) 1 GO TO 4000 500 CONTINUE C IF(VBFLAG) CALL RSPEAK(601) !GREEK TO ME, FAIL. RETURN C C END OF INPUT, SEE IF PARTIAL WORD AVAILABLE. C 1000 IF(PRSCON.GT.INLNT) PRSCON=1 !FORCE PARSE RESTART. IF((CP.EQ.0).AND.(OP.EQ.1)) RETURN !ANY RESULTS? IF(CP.EQ.0) OP=OP-2 !ANY LAST WORD? LEX=.TRUE. D IF(DFLAG) TYPE 10,CP,OP,PRSCON,(OUTBUF(I),I=1,OP+1) D10 FORMAT(' LEX RESULTS- ',3I7/1X,10O7) RETURN C C LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN. C 4000 J1=J-DLIMIT(I+2) !CVT TO R50. D IF(DFLAG) TYPE 20,J,J1,CP D20 FORMAT(' LEX- CHAR= ',3I7) IF(CP.GE.6) GO TO 200 !IGNORE IF TOO MANY CHAR. K=OP+(CP/3) !COMPUTE WORD INDEX. GO TO (4100,4200,4300),(MOD(CP,3)+1) !BRANCH ON CHAR. 4100 J2=J1*780 !CHAR 1... *780 OUTBUF(K)=OUTBUF(K)+J2+J2 !*1560 (40 ADDED BELOW). 4200 OUTBUF(K)=OUTBUF(K)+(J1*39) !*39 (1 ADDED BELOW). 4300 OUTBUF(K)=OUTBUF(K)+J1 !*1. CP=CP+1 GO TO 200 !GET NEXT CHAR. C C SPACE C 6000 IF(CP.EQ.0) GO TO 200 !ANY WORD YET? GO TO 50 !YES, ADV OP. C END