C SYNMCH--	SYNTAX MATCHER
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
C THIS ROUTINE DETAILS ON BIT 4 OF PRSFLG
C
	LOGICAL FUNCTION SYNMCH
	IMPLICIT INTEGER(A-Z)
	LOGICAL SYNEQL,TAKEIT,DFLAG
C
C PARSER OUTPUT
C
	LOGICAL PRSWON
	COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
	COMMON /DEBUG/ DBGFLG,PRSFLG
C
	COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME
	COMMON /PV/ ACT,O1,O2,P1,P2
	COMMON /SYNTAX/VFLAG,DOBJ,DFL1,DFL2,DFW1,DFW2,
	1	IOBJ,IFL1,IFL2,IFW1,IFW2
	COMMON /VRBVOC/ VVOC(950)
	COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK
	COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
	DATA R50MIN/1RA/
C
	SYNMCH=.FALSE.
D	DFLAG=(PRSFLG.AND."20).NE.0
	J=ACT					!SET UP PTR TO SYNTAX.
	DRIVE=0					!NO DEFAULT.
	DFORCE=0				!NO FORCED DEFAULT.
	QPREP=OFLAG.AND.OPREP			!VALID ORPHAN PREP FLAG.
100	J=J+2					!FIND START OF SYNTAX.
	IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100
	LIMIT=J+VVOC(J)+1			!COMPUTE LIMIT.
	J=J+1					!ADVANCE TO NEXT.
C
200	CALL UNPACK(J,NEWJ)			!UNPACK SYNTAX.
D	IF(DFLAG) TYPE 60,O1,P1,DOBJ,DFL1,DFL2
D60	FORMAT(' SYNMCH INPUTS TO SYNEQL- ',5I7)
	SPREP=DOBJ.AND.VPMASK			!SAVE EXPECTED PREP.
	IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000
D	IF(DFLAG) TYPE 60,O2,P2,IOBJ,IFL1,IFL2
	SPREP=IOBJ.AND.VPMASK			!SAVE EXPECTED PREP.
	IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000
C
C SYNTAX MATCH FAILS, TRY NEXT ONE.
C
	IF(O2) 3000,500,3000			!IF O2=0, SET DFLT.
1000	IF(O1) 3000,500,3000			!IF O1=0, SET DFLT.
500	IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J	 !IF PREP MCH.
	IF((VFLAG.AND.SDRIV).NE.0) DRIVE=J	!IF DRIVER, RECORD.
3000	J=NEWJ
	IF(J.LT.LIMIT) GO TO 200		!MORE TO DO?
C SYNMCH, PAGE 2
C
C MATCH HAS FAILED.  IF DEFAULT SYNTAX EXISTS, TRY TO SNARF
C ORPHANS OR GWIMS, OR MAKE NEW ORPHANS.
C
D	IF(DFLAG) TYPE 20,DRIVE,DFORCE
D20	FORMAT(' SYNMCH, DRIVE=',2I6)
	IF(DRIVE.EQ.0) DRIVE=DFORCE		!NO DRIVER? USE FORCE.
	IF(DRIVE.EQ.0) GO TO 10000		!ANY DRIVER?
	CALL UNPACK(DRIVE,DFORCE)		!UNPACK DFLT SYNTAX.
C
C TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
C
	IF(((VFLAG.AND.SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000
C
C FIRST TRY TO SNARF ORPHAN OBJECT.
C
	O1=OFLAG.AND.OSLOT
	IF(O1.EQ.0) GO TO 3500			!ANY ORPHAN?
	IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000
C
C ORPHAN FAILS, TRY GWIM.
C
3500	O1=GWIM(DOBJ,DFW1,DFW2)			!GET GWIM.
D	IF(DFLAG) TYPE 30,O1
D30	FORMAT(' SYNMCH- DO GWIM= ',I6)
	IF(O1.GT.0) GO TO 4000		!TEST RESULT.
	CALL ORPHAN(-1,ACT,0,DOBJ.AND.VPMASK,0)	!FAILS, ORPHAN.
	CALL RSPEAK(623)
	RETURN
C
C TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
C
4000	IF(((VFLAG.AND.SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000
	O2=GWIM(IOBJ,IFW1,IFW2)			!GWIM.
D	IF(DFLAG) TYPE 40,O2
D40	FORMAT(' SYNMCH- IO GWIM= ',I6)
	IF(O2.GT.0) GO TO 6000
	IF(O1.EQ.0) O1=OFLAG.AND.OSLOT
	CALL ORPHAN(-1,ACT,O1,DOBJ.AND.VPMASK,0)
	CALL RSPEAK(624)
	RETURN
C
C TOTAL CHOMP
C
10000	CALL RSPEAK(601)			!CANT DO ANYTHING.
	RETURN
C SYNMCH, PAGE 3
C
C NOW TRY TO TAKE INDIVIDUAL OBJECTS AND
C IN GENERAL CLEAN UP THE PARSE VECTOR.
C
6000	IF((VFLAG.AND.SFLIP).EQ.0) GO TO 5000	!FLIP?
	J=O1					!YES.
	O1=O2
	O2=J
C
5000	PRSA=VFLAG.AND.SVMASK			!GET VERB.
	PRSO=O1					!GET DIR OBJ.
	PRSI=O2					!GET IND OBJ.
	IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN	!TRY TAKE.
	IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN	!TRY TAKE.
	SYNMCH=.TRUE.
D	IF(DFLAG) TYPE 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2
D50	FORMAT(' SYNMCH- RESULTS ',L1,6I7)
	RETURN
C
	END
C UNPACK-	UNPACK SYNTAX SPECIFICATION, ADV POINTER
C
C DECLARATIONS
C
	SUBROUTINE UNPACK(OLDJ,J)
	IMPLICIT INTEGER(A-Z)
C
	COMMON /VRBVOC/ VVOC(950)
C
	COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK
	COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
	COMMON /SYNTAX/ VFLAG,DOBJ,DFL1,DFL2,DFW1,DFW2,
	1	IOBJ,IFL1,IFL2,IFW1,IFW2
	INTEGER SYN(11)
	EQUIVALENCE (SYN(1),VFLAG)
C
	DO 10 I=1,11				!CLEAR SYNTAX.
	  SYN(I)=0
10	CONTINUE
C
	VFLAG=VVOC(OLDJ)
	J=OLDJ+1
	IF((VFLAG.AND.SDIR).EQ.0) RETURN	!DIR OBJECT?
	DFL1=-1					!ASSUME STD.
	DFL2=-1
	IF((VFLAG.AND.SSTD).EQ.0) GO TO 100	!STD OBJECT?
	DFW1=-1					!YES.
	DFW2=-1
	DOBJ=VABIT+VRBIT+VFBIT
	GO TO 200
C
100	DOBJ=VVOC(J)				!NOT STD.
	DFW1=VVOC(J+1)
	DFW2=VVOC(J+2)
	J=J+3
	IF((DOBJ.AND.VEBIT).EQ.0) GO TO 200	!VBIT = VFWIM?
	DFL1=DFW1				!YES.
	DFL2=DFW2
C
200	IF((VFLAG.AND.SIND).EQ.0) RETURN	!IND OBJECT?
	IFL1=-1					!ASSUME STD.
	IFL2=-1
	IOBJ=VVOC(J)
	IFW1=VVOC(J+1)
	IFW2=VVOC(J+2)
	J=J+3
	IF((IOBJ.AND.VEBIT).EQ.0) RETURN	!VBIT = VFWIM?
	IFL1=IFW1				!YES.
	IFL2=IFW2
	RETURN
C
	END
C SYNEQL-	TEST FOR SYNTAX EQUALITY
C
C DECLARATIONS
C
	LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2)
	IMPLICIT INTEGER(A-Z)
C
C OBJECTS
C
	COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
	1	OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
	2	OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
	3	OADV(220),OCAN(220),OREAD(220)
C
	COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
C
	IF(OBJ.EQ.0) GO TO 100			!ANY OBJECT?
	SYNEQL=(PREP.EQ.(SPREP.AND.VPMASK)).AND.
	1	(((SFL1.AND.OFLAG1(OBJ)).OR.
	2	  (SFL2.AND.OFLAG2(OBJ))).NE.0)
	RETURN
C
100	SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0)
	RETURN
C
	END
C TAKEIT-	PARSER BASED TAKE OF OBJECT
C
C DECLARATIONS
C
	LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
	IMPLICIT INTEGER(A-Z)
C
	COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
	COMMON /STAR/ MBASE,STRBIT
C
C GAME STATE
C
	LOGICAL TELFLG
	COMMON /PLAY/ WINNER,HERE,TELFLG
	COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
	1	LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C OBJECTS
C
	COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
	1	OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
	2	OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
	3	OADV(220),OCAN(220),OREAD(220)
C
	COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
	1	NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
	2	TOOLBT,TURNBT,ONBT
	COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
	1	WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
	2	TCHBT,VEHBT,SCHBT
C
C ADVENTURERS
C
	COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
	1	AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C TAKEIT, PAGE 2
C
	TAKEIT=.FALSE.				!ASSUME LOSES.
	IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT)) GO TO 4000	!NULL/STARS WIN.
	ODO2=ODESC2(OBJ)			!GET DESC.
	X=OCAN(OBJ)				!GET CONTAINER.
	IF((X.EQ.0).OR.((SFLAG.AND.VFBIT).EQ.0)) GO TO 500
	IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 500
	CALL RSPSUB(566,ODO2)			!CANT REACH.
	RETURN
C
500	IF((SFLAG.AND.VRBIT).EQ.0) GO TO 1000	!SHLD BE IN ROOM?
	IF((SFLAG.AND.VTBIT).EQ.0) GO TO 2000	!CAN BE TAKEN?
C
C SHOULD BE IN ROOM (VRBIT NE 0) AND CAN BE TAKEN (VTBIT NE 0)
C
	IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 !IF NOT, OK.
C
C ITS IN THE ROOM AND CAN BE TAKEN.
C
	IF(((OFLAG1(OBJ).AND.TAKEBT).NE.0).AND.
	1	((OFLAG2(OBJ).AND.TRYBT).EQ.0)) GO TO 3000
C
C NOT TAKEABLE.  IF WE CARE, FAIL.
C
	IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000	!IF NO CARE, RETURN.
	CALL RSPSUB(445,ODO2)
	RETURN
C
C 1000--	IT SHOULD NOT BE IN THE ROOM.
C 2000--	IT CANT BE TAKEN.
C
2000	IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000	!IF NO CARE, RETURN
1000	IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
	CALL RSPSUB(665,ODO2)
	RETURN
C TAKEIT, PAGE 3
C
C OBJECT IS IN THE ROOM, CAN BE TAKEN BY THE PARSER,
C AND IS TAKEABLE IN GENERAL.  IT IS NOT A STAR.
C TAKING IT SHOULD NOT HAVE SIDE AFFECTS.
C IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN.
C THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE.
C
3000	IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500	!TAKE VEHICLE?
	CALL RSPEAK(672)
	RETURN
C
3500	IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
	1 ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD))
	2 GO TO 3700
	CALL RSPEAK(558)			!TOO BIG.
	RETURN
C
3700	CALL NEWSTA(OBJ,559,0,0,WINNER)		!DO TAKE.
	OFLAG2(OBJ)=OFLAG2(OBJ).OR.TCHBT	!TOUCHED.
	CALL SCRUPD(OFVAL(OBJ))
	OFVAL(OBJ)=0
C
4000	TAKEIT=.TRUE.				!SUCCESS.
	RETURN
C
	END
C GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS
C
C DECLARATIONS
C
	INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
	IMPLICIT INTEGER(A-Z)
	LOGICAL TAKEIT,NOCARE
C
	COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
	COMMON /STAR/ MBASE,STRBIT
C
C GAME STATE
C
	LOGICAL TELFLG
	COMMON /PLAY/ WINNER,HERE,TELFLG
C
C OBJECTS
C
	COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
	1	OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
	2	OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
	3	OADV(220),OCAN(220),OREAD(220)
C
	COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
	1	NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
	2	TOOLBT,TURNBT,ONBT
	COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
	1	WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
	2	TCHBT,VEHBT,SCHBT
C
C ADVENTURERS
C
	COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
	1	AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C GWIM, PAGE 2
C
	GWIM=-1					!ASSUME LOSE.
	AV=AVEHIC(WINNER)
	NOBJ=0
	NOCARE=(SFLAG.AND.VCBIT).EQ.0
C
C FIRST SEARCH ADVENTURER
C
	IF((SFLAG.AND.VABIT).NE.0)
	1	NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
	IF((SFLAG.AND.VRBIT).NE.0) GO TO 100
50	GWIM=NOBJ
	RETURN
C
C ALSO SEARCH ROOM
C
100	ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE)
	IF(ROBJ) 500,50,200			!TEST RESULT.
C
C ROBJ > 0
C
200	IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
	1	((OFLAG2(ROBJ).AND.FINDBT).NE.0)) GO TO 300
	IF(OCAN(ROBJ).NE.AV) GO TO 50		!UNREACHABLE? TRY NOBJ
300	IF(NOBJ.NE.0) RETURN			!IF AMBIGUOUS, RETURN.
	IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN	!IF UNTAKEABLE, RETURN
	GWIM=ROBJ
500	RETURN
C
	END