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


You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.